/usr/share/perl5/Test/XML/Twig.pm is in libtest-xml-perl 0.08-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | package Test::XML::Twig;
# @(#) $Id$
use strict;
use warnings;
use Carp;
use Test::More;
use Test::XML;
use Test::Builder;
use XML::Twig;
our $VERSION = '0.01';
sub import {
my $self = shift;
my $caller = caller;
no strict 'refs';
*{ $caller . '::get_twig' } = \&get_twig;
*{ $caller . '::test_twig_handler' } = \&test_twig_handler;
*{ $caller . '::test_twig_handlers' } = \&test_twig_handlers;
my $Test = Test::Builder->new;
$Test->exported_to( $caller );
$Test->plan( @_ );
}
# Just a useful convenience function.
sub get_twig {
my ( $input, %args ) = @_;
croak "get_twig: no input provided"
unless defined $input;
my $t = XML::Twig->new( keep_spaces => 1, %args );
eval { $t->parse( $input ) };
return $@ ? undef: $t;
}
sub test_twig_handler {
my ( $handler, $input, $expected, $test_name, $cond ) = @_;
croak "usage: test_twig_handler(twig_args,input,expected,test_name[,cond])"
unless $handler
&& ref($handler) eq 'CODE'
&& $input
&& $expected
&& $test_name;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $Test = Test::Builder->new;
my $t = get_twig( $input );
if ( $t ) {
my $el = ( $cond ? $t->root->first_child( $cond ) : $t->root );
eval { $handler->( $t, $el ) };
if ( $@ ) {
$Test->ok( 0, $test_name );
$Test->diag( "handler said: $@" );
return 0;
} elsif ( ref $expected ) {
return $Test->like( $t->sprint, $expected, $test_name );
} else {
return is_xml( $t->sprint, $expected, $test_name );
}
} else {
$Test->ok( 0, $test_name );
$Test->diag( "during parse of: '$input'$@" );
return 0;
}
}
# Test multiple twig handlers in combination.
sub test_twig_handlers {
my ( $twig_args, $input, $expected, $test_name ) = @_;
croak "usage: test_twig_handlers(twig_args,input,expected,test_name)"
unless $twig_args
&& ref($twig_args) eq 'HASH'
&& $input
&& $expected
&& $test_name;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $Test = Test::Builder->new;
my $t = get_twig( $input, %$twig_args );
if ( $t ) {
if (ref $expected) {
return $Test->like( $t->sprint, $expected, $test_name );
} else {
return is_xml( $t->sprint, $expected, $test_name );
}
} else {
$Test->ok( 0, $test_name );
$Test->diag( "during parse of: '$input'$@" );
return 0;
}
}
1;
__END__
=head1 NAME
Test::XML::Twig - Test XML::Twig handlers
=head1 SYNOPSIS
use Test::XML::Twig tests => 2;
use My::Twig qw( handler );
test_twig_handler(
\&handler,
'<foo/>', '<bar/>',
'turns foo to bar',
);
test_twig_handlers(
{ twig_handlers => { 'foo' => \&handler } },
'<foo/>', '<bar/>',
'turns foo into bar',
);
=head1 DESCRIPTION
This module is for testing XML::Twig handlers.
=head1 FUNCTIONS
All functions are exported.
=over 4
=item get_twig ( INPUT [, ARGS ] )
Return a parsed twig of INPUT, or undef on parse failure. Optionally,
ARGS may be supplied as a set of hash-like parameters to be passed into
the twig constructor.
=item test_twig_handler ( HANDLER, INPUT, EXPECTED, TESTNAME [, COND ] )
Parse INPUT, using HANDLER as a I<twig_handler> (i.e: it gets called
after the parse tree has been built). Tests that the result is the same
as EXPECTED (which can be either a string of XML or a quoted regex).
HANDLER must be a code ref.
Optionally, COND can be supplied. Instead of the handler being called
with the root element of INPUT, COND will be used with first_child() to
select an alternative element.
Returns true / false depending upon test success.
=item test_twig_handlers ( ARGS, INPUT, EXPECTED, TESTNAME )
This is similar to test_twig_handler(), but with more flexibility. The
first argument, ARGS, is a hash reference which can be used to specify
any of the ordinary parameters to twig's constructor. This lets you
test things like I<start_tag_handlers>, as well as multiple
I<twig_handler>s together.
=back
=head1 SEE ALSO
L<Test::More>, L<Test::XML>, L<XML::Twig>.
=head1 AUTHOR
Dominic Mitchell, E<lt>cpan2 (at) semantico.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2002 by semantico
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# indent-tabs-mode: nil
# End:
# vim: set ai et sw=4 :
|