Test-XML-0.08/0000770002326000001440000000000011223047503012746 5ustar domusers00000000000000Test-XML-0.08/META.yml0000444002326000001440000000151311223047503014220 0ustar domusers00000000000000--- name: Test-XML version: 0.08 author: [] abstract: Compare XML in perl tests license: perl resources: license: http://dev.perl.org/licenses/ requires: Test::More: 0 XML::Parser: 2.34 XML::SemanticDiff: 0.95 perl: 5.6.0 recommends: XML::SAX: 0 XML::SAX::Writer: 0 XML::Twig: 0 XML::XPath: 0 provides: Test::XML: file: lib/Test/XML.pm version: 0.08 Test::XML::SAX: file: lib/Test/XML/SAX.pm version: 0.01 Test::XML::Twig: file: lib/Test/XML/Twig.pm version: 0.01 Test::XML::XPath: file: lib/Test/XML/XPath.pm version: 0.03 Test::XML::XPath::XML::LibXML: file: lib/Test/XML/XPath.pm Test::XML::XPath::XML::XPath: file: lib/Test/XML/XPath.pm generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Test-XML-0.08/Changes0000444002326000001440000000202211223047503014236 0ustar domusers00000000000000Revision history for Perl extension Test::XML. 0.08 Wed Jul 1 23:53:57 BST 2009 - Don't cache things that are no longer singletons. Thanks to Ovid. 0.07 Thu Jul 21 12:44:31 BST 2005 - Added is_well_formed_xml() from Curtis Ovid Poe. - Make minimum perl version 5.6.0. 0.06 Fri May 16 23:37:30 BST 2003 - Allow is_xpath() to choose one of XML::XPath or XML::LibXML. 0.05 Thu May 15 00:30:52 BST 2003 - Added is_xpath(), based on a suggestion by Mark Fowler 0.04 Sun May 11 18:33:31 BST 2003 - Added Test::XML::XPath, based on an idea from Kate Pugh - Document XML::SemanticDiff problems in Test::XML. - Add TODO tests for XML::SemanticDiff problems. 0.03 Mon Mar 17 09:39:27 GMT 2003 - Update recommends list in Build.PL. - Fix tests to skip correctly in absence of modules. 0.02 Fri Mar 14 16:03:46 GMT 2003 - Added proper exports, based on Test::Pod. - Added isnt_xml(). - Fix Makefile.PL to ignore Build.PL. 0.01 Fri Mar 14 14:59:03 GMT 2003 - original version @(#) $Id$ Test-XML-0.08/README0000444002326000001440000000150611223047503013631 0ustar domusers00000000000000Test::XML version ================= This module provides tools for testing code which deals with XML. These tools are compatible with the Test::More and Test::Simple modules. At present, there is generic XML comparison support, as well as modules for dealing with XML::SAX, XML::Twig and XML::XPath handlers. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Test::More XML::SemanticDiff These modules are not required, but will provide more functionality. XML::SAX XML::Twig XML::XPath COPYRIGHT AND LICENCE Copyright (C) 2002 semantico This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. # @(#) $Id$ Test-XML-0.08/lib/0000770002326000001440000000000011223047502013513 5ustar domusers00000000000000Test-XML-0.08/lib/Test/0000770002326000001440000000000011223047503014433 5ustar domusers00000000000000Test-XML-0.08/lib/Test/XML/0000770002326000001440000000000011223047503015073 5ustar domusers00000000000000Test-XML-0.08/lib/Test/XML/Twig.pm0000444002326000001440000001110611223047502016342 0ustar domusers00000000000000package 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, '', '', 'turns foo to bar', ); test_twig_handlers( { twig_handlers => { 'foo' => \&handler } }, '', '', '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 (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 similiar 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, as well as multiple Is together. =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Dominic Mitchell, Ecpan2 (at) semantico.comE =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 : Test-XML-0.08/lib/Test/XML/XPath.pm0000444002326000001440000001653511223047503016470 0ustar domusers00000000000000package Test::XML::XPath; # @(#) $Id$ use strict; use warnings; use Carp; use Test::More; use Test::Builder; our $VERSION = '0.03'; # Call this early so that lack of a suitable class will be picked up # when we're imported, not on first use. _find_xpath_class(); #--------------------------------------------------------------------- # Import shenanigans. Copied from Test::Pod... #--------------------------------------------------------------------- sub import { my $self = shift; my $caller = caller; no strict 'refs'; *{ $caller . '::is_xpath' } = \&is_xpath; *{ $caller . '::like_xpath' } = \&like_xpath; *{ $caller . '::set_xpath_processor' } = \&set_xpath_processor; *{ $caller . '::unlike_xpath' } = \&unlike_xpath; my $Test = Test::Builder->new; $Test->exported_to( $caller ); $Test->plan( @_ ); } #--------------------------------------------------------------------- # Tool. #--------------------------------------------------------------------- sub like_xpath { my ($input, $statement, $test_name) = @_; croak "usage: like_xpath(xml,xpath[,name])" unless $input && $statement; my $Test = Test::Builder->new; my $ok = eval { my $xp = _make_xpath( $input ); return $xp->exists( $statement ); }; if ($@) { $Test->ok( 0, $test_name ); $Test->diag( " Parse Failure: $@" ); return 0; } else { ok( $ok, $test_name ); unless ( $ok ) { diag ( " input: $input" ); diag ( " does not match: $statement" ); } return $ok; } } sub unlike_xpath { my ($input, $statement, $test_name) = @_; croak "usage: unlike_xpath(xml,xpath[,name])" unless $input && $statement; my $Test = Test::Builder->new; my $ok = eval { my $xp = _make_xpath( $input ); return ! $xp->exists( $statement ); }; if ($@) { $Test->ok( 0, $test_name ); $Test->diag( " Parse Failure: $@" ); return 0; } else { ok( $ok, $test_name ); unless ( $ok ) { diag ( " input: $input" ); diag ( " does match: $statement" ); } return $ok; } } sub is_xpath { my ($input, $statement, $expected, $test_name) = @_; croak "usage: is_xpath(xml,xpath,expected[,name])" unless $input && $statement && $expected; my $Test = Test::Builder->new; my $got = eval { my $xp = _make_xpath( $input ); $xp->findvalue( $statement ); }; if ($@) { $Test->ok( 0, $test_name ); $Test->diag( " Parse Failure: $@" ); return 0; } else { my $retval = $Test->is_eq( $got, $expected, $test_name ); unless ( $retval ) { diag( " evaluating: $statement" ); diag( " against: $input" ); } return $retval; } } #--------------------------------------------------------------------- # Abstract interface to XPath processing. #--------------------------------------------------------------------- { my $xpath_class; sub set_xpath_processor { $xpath_class = join('::', __PACKAGE__, @_ ); } sub _make_xpath { $xpath_class ||= _find_xpath_class(); return $xpath_class->new( @_ ); } } sub _find_xpath_class { foreach (qw( XML::LibXML XML::XPath )) { eval "use $_"; return __PACKAGE__ . "::$_" unless $@; } # Ooops, we're unusable. die $@; } { package Test::XML::XPath::XML::XPath; sub new { my $class = shift; bless { xpath => XML::XPath->new( xml => @_ ) }, $class; } sub exists { my $self = shift; return $self->{xpath}->exists( @_ ); } sub findvalue { my $self = shift; return $self->{xpath}->findvalue( @_ ); } } { package Test::XML::XPath::XML::LibXML; sub new { my $class = shift; my $p = XML::LibXML->new; bless { xpath => $p->parse_string( @_ ) }, $class; } sub exists { my $self = shift; my @nodes = $self->{xpath}->findnodes( @_ ); return @nodes ? 1 : 0; } sub findvalue { my $self = shift; return $self->{xpath}->findvalue( @_ ); } } 1; __END__ =head1 NAME Test::XML::XPath - Test XPath assertions =head1 SYNOPSIS use Test::XML::XPath tests => 3; like_xpath( '', '/foo' ); # PASS like_xpath( '', '/bar' ); # FAIL unlike_xpath( '', '/bar' ); # PASS is_xpath( 'bar', '/foo', 'bar' ); # PASS is_xpath( 'bar', '/bar', 'foo' ); # FAIL # More interesting examples of xpath assertions. my $xml = 'pub'; # Do testing for attributes. like_xpath( $xml, '/foo[@attrib="1"]' ); # PASS # Find an element anywhere in the document. like_xpath( $xml, '//bosh' ); # PASS # Both. like_xpath( $xml, '//bosh[@args="42"]' ); # PASS =head1 DESCRIPTION This module allows you to assert statements about your XML in the form of XPath statements. You can say that a piece of XML must contain certain tags, with so-and-so attributes, etc. It will try to use any installed XPath module that it knows about. Currently, this means XML::LibXML and XML::XPath, in that order. B: Normally in XPath processing, the statement occurs from a I node. In the case of like_xpath(), the context node will always be the root node. In practice, this means that these two statements are identical: # Absolute path. like_xpath( '', '/foo' ); # Path relative to root. like_xpath( '', 'foo' ); It's probably best to use absolute paths everywhere in order to keep things simple. B: Beware of specifying attributes. Because they use an @-sign, perl will complain about trying to interpolate arrays if you don't escape them or use single quotes. =head1 FUNCTIONS =over 4 =item like_xpath ( XML, XPATH [, NAME ] ) Assert that XML (a string containing XML) matches the statement XPATH. NAME is the name of the test. Returns true or false depending upon test success. =item unlike_xpath ( XML, XPATH [, NAME ] ) This is the reverse of like_xpath(). The test will only pass if XPATH I generates any matches in XML. Returns true or false depending upon test success. =item is_xpath ( XML, XPATH, EXPECTED [, NAME ] ) Evaluates XPATH against XML, and pass the test if the is EXPECTED. Uses findvalue() internally. Returns true or false depending upon test success. =item set_xpath_processor ( CLASS ) Set the class name of the XPath processor used. It is up to you to ensure that this class is loaded. =back In all cases, XML must be well formed, or the test will fail. =head1 SEE ALSO L. L, which is the basis for this module. If you are not conversant with XPath, there are many tutorials available on the web. Google will point you at them. The first one that I saw was: L, which appears to offer interactive XPath as well as the tutorials. =head1 AUTHOR Dominic Mitchell Ecpan2 (at) semantico.comE =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 : Test-XML-0.08/lib/Test/XML/SAX.pm0000444002326000001440000000716211223047503016073 0ustar domusers00000000000000package Test::XML::SAX; # @(#) $Id$ use strict; use warnings; use Carp; use Test::More; use Test::XML; use Test::Builder; use XML::SAX; use XML::SAX::ParserFactory; use XML::SAX::Writer; our $VERSION = '0.01'; sub import { my $self = shift; my $caller = caller; no strict 'refs'; *{ $caller . '::test_sax' } = \&test_sax; *{ $caller . '::test_all_sax_parsers' } = \&test_all_sax_parsers; my $Test = Test::Builder->new; $Test->exported_to( $caller ); $Test->plan( @_ ); } sub test_sax { my ( $handler, $input, $expected, $test_name ) = @_; croak "usage: test_sax(handler,input,expected,[test_name])" unless $handler && ref $handler && $input && $expected; my $Test = Test::Builder->new; my $result = ''; eval { my $w = XML::SAX::Writer->new( Output => \$result ); $handler->set_handler( $w ); my $p = XML::SAX::ParserFactory->parser( Handler => $handler ); $p->parse_string( $input ); }; if ( $@ ) { $Test->ok( 0, $test_name ); $Test->diag( "Error during parse: $@" ); } return is_xml( $result, $expected, $test_name ); } sub test_all_sax_parsers { my ( $sub, $numtests ) = @_; croak "usage: test_all_sax_parsers(sub,[numtests])" unless $sub && ref($sub) eq 'CODE'; my @parsers = map { $_->{Name} } @{ XML::SAX->parsers }; plan tests => ($numtests * scalar( @parsers ) ) if $numtests; # NB: Have to sort by shortest parser first so that # XML::SAX::ParserFactory # loads them all in correctly. foreach my $parser ( sort { length $a <=> length $b } @parsers ) { local $XML::SAX::ParserPackage = $parser; $sub->( $parser, $numtests ); } } 1; __END__ =head1 NAME Test::XML::SAX - Test XML::SAX handlers =head1 SYNOPSIS use Test::XML::SAX tests => 1; use My::XML::Filter; my $handler = My::XML::Filter->new; test_sax( $handler, '', '', 'translates foo to bar' ); # ... In Another File ... use Test::XML::SAX; use My::XML::Filter; sub do_tests { my $handler = My::XML::Filter->new; test_sax( $handler, '', '', 'translates foo to bar' ); } test_all_sax_parsers( \&do_tests, 1 ); =head1 DESCRIPTION This module is for testing XML::SAX handlers. =head1 FUNCTIONS All functions are exported. =over 4 =item test_sax ( HANDLER, INPUT, EXPECTED [, TESTNAME ] ) This function will process INPUT using HANDLER, and compare the result with EXPECTED. TESTNAME can optionally be used to name the test in the output (a good idea). =item test_all_sax_parsers ( SUB [, NUMTESTS ] ) This function will repeat a set of tests for all installed SAX parsers. SUB must be a coderef to run a series of tests. NUMTESTS is the number of tests inside SUB. B: You must not issue a plan to Test::More if you call this function! The plan will be set for you, according to the number of parsers installed and NUMTESTS. This also means that you must not have any tests outside of SUB or you will get an error. When SUB is called, it will be passed two arguments. The name of the parser being used and the number of tests. It can use this information to decide whether or not to skip this set of tests. =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Dominic Mitchell, Ecpan2 (at) semantico.comE =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 : Test-XML-0.08/lib/Test/XML.pm0000444002326000001440000001216111223047503015433 0ustar domusers00000000000000package Test::XML; # @(#) $Id$ use strict; use warnings; use Carp; use Test::Builder; use XML::SemanticDiff; use XML::Parser; our $VERSION = '0.08'; #--------------------------------------------------------------------- # Import shenanigans. Copied from Test::Pod... #--------------------------------------------------------------------- sub import { my $self = shift; my $caller = caller; no strict 'refs'; *{ $caller . '::is_xml' } = \&is_xml; *{ $caller . '::isnt_xml' } = \&isnt_xml; *{ $caller . '::is_well_formed_xml' } = \&is_well_formed_xml; *{ $caller . '::is_good_xml' } = \&is_well_formed_xml; my $Test = Test::Builder->new; $Test->exported_to( $caller ); $Test->plan( @_ ); } #--------------------------------------------------------------------- # Tool. #--------------------------------------------------------------------- sub is_xml { my ($input, $expected, $test_name) = @_; croak "usage: is_xml(input,expected,test_name)" unless defined $input && defined $expected; my $Test = Test::Builder->new; my $differ = XML::SemanticDiff->new; my @diffs = eval { $differ->compare( $expected, $input ) }; if ( @diffs ) { $Test->ok( 0, $test_name ); $Test->diag( "Found " . scalar(@diffs) . " differences with expected:" ); $Test->diag( " $_->{message}" ) foreach @diffs; $Test->diag( "in processed XML:\n $input" ); return 0; } elsif ( $@ ) { $Test->ok( 0, $test_name ); # Make the output a bit more testable. $@ =~ s/ at \/.*//; $Test->diag( "During compare:$@" ); return 0; } else { $Test->ok( 1, $test_name ); return 1; } } sub isnt_xml { my ($input, $mustnotbe, $test_name) = @_; croak "usage: isnt_xml(input,mustnotbe,test_name)" unless defined $input && defined $mustnotbe; my $Test = Test::Builder->new; my $differ = XML::SemanticDiff->new; my @diffs = eval { $differ->compare( $mustnotbe, $input ) }; if ( $@ ) { $Test->ok( 0, $test_name ); # Make the output a bit more testable. $@ =~ s/ at \/.*//; $Test->diag( "During compare:$@" ); return 0; } elsif ( @diffs == 0 ) { $Test->ok( 0, $test_name ); $Test->diag( "Found no differences in processed XML:\n $input" ); return 0; } else { $Test->ok( 1, $test_name ); return 1; } } sub is_well_formed_xml { my ($input, $test_name) = @_; croak "usage: is_well_formed_xml(input,test_name)" unless defined $input; my $Test = Test::Builder->new; my $parser = XML::Parser->new; eval { $parser->parse($input) }; if ( $@ ) { $Test->ok( 0, $test_name ); # Make the output a bit more testable. $@ =~ s/ at \/.*//; $Test->diag( "During parse: $@" ); return 0; } else { $Test->ok( 1, $test_name ); return 1; } } 1; __END__ =head1 NAME Test::XML - Compare XML in perl tests =head1 SYNOPSIS use Test::XML tests => 3; is_xml( '', '' ); # PASS is_xml( '', '' ); # FAIL isnt_xml( '', '' ); # PASS is_well_formed_xml(''); # PASS is_well_formed_xml(''); # FAIL =head1 DESCRIPTION This module contains generic XML testing tools. See below for a list of other modules with functions relating to specific XML modules. =head1 FUNCTIONS =over 4 =item is_xml ( GOT, EXPECTED [, TESTNAME ] ) This function compares GOT and EXPECTED, both of which are strings of XML. The comparison works semantically and will ignore differences in syntax which are meaningless in xml, such as different quote characters for attributes, order of attributes or empty tag styles. Returns true or false, depending upon test success. =item isnt_xml( GOT, MUST_NOT_BE [, TESTNAME ] ) This function is similiar to is_xml(), except that it will fail if GOT and MUST_NOT_BE are identical. =item is_well_formed_xml( XML [, TESTNAME ] ) This function determines whether or not a given XML string is parseable as XML. =item is_good_xml ( XML [, TESTNAME ] ) This is an alias for is_well_formed_xml(). =back =head1 NOTES There are several features of XML::SemanticDiff that may suprise you if you are not aware of them. In particular: =over 4 =item * Leading and trailing whitespace is always stripped, even in elements with character content. =item * Whitespace inside character content is always stripped down to a single space. =item * In mixed content elements (ie: an element with both text and elements beneath it), all text is treated as a single value. =item * The order of elements is ignored. =back =head1 SEE ALSO L, L. L, L. =head1 AUTHOR Dominic Mitchell, Ecpan2 (at) semantico.comE =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 : Test-XML-0.08/.gitignore0000444002326000001440000000005011223047503014732 0ustar domusers00000000000000Build _build blib MANIFEST.bak *.tar.gz Test-XML-0.08/Makefile.PL0000444002326000001440000000104111223047503014715 0ustar domusers00000000000000# @(#) $Id$ use strict; require 5.006; use ExtUtils::MakeMaker; my $main_module = 'lib/Test/XML.pm'; WriteMakefile( NAME => 'Test::XML', VERSION_FROM => $main_module, PREREQ_PM => { 'Test::More' => 0, 'XML::SemanticDiff' => 0.95, 'XML::Parser' => 2.34, }, AUTHOR => 'Dominic Mitchell ', PL_FILES => {}, # To ignore Build.PL. ); # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 : Test-XML-0.08/MANIFEST0000444002326000001440000000033611223047503014102 0ustar domusers00000000000000.gitignore Build.PL Changes lib/Test/XML.pm lib/Test/XML/SAX.pm lib/Test/XML/Twig.pm lib/Test/XML/XPath.pm Makefile.PL MANIFEST META.yml README t/1.t t/basic.t t/maint.t t/order.t t/sax.t t/twig.t t/whitespace.t t/xpath.t Test-XML-0.08/Build.PL0000444002326000001440000000074211223047503014246 0ustar domusers00000000000000# @(#) $Id$ use strict; use Module::Build; Module::Build->new( module_name => 'Test::XML', license => 'perl', requires => { 'perl' => '5.6.0', 'Test::More' => 0, 'XML::SemanticDiff' => 0.95, 'XML::Parser' => 2.34, }, recommends => { 'XML::SAX' => 0, 'XML::SAX::Writer' => 0, 'XML::Twig' => 0, 'XML::XPath' => 0, }, )->create_build_script; Test-XML-0.08/t/0000770002326000001440000000000011223047503013211 5ustar domusers00000000000000Test-XML-0.08/t/whitespace.t0000444002326000001440000000055611223047503015541 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More tests => 1; use Test::XML; { local $TODO = 'make whitespace significant'; isnt_xml( '

foo

', '

foo

', 'whitespace is significant', ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/1.t0000444002326000001440000000033111223047503013534 0ustar domusers00000000000000use strict; use warnings; use Test::More tests => 1; BEGIN { use_ok( 'Test::XML' ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/xpath.t0000444002326000001440000000511411223047503014524 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More; my %processors; BEGIN { foreach ( qw( XML::XPath XML::LibXML ) ) { eval "use $_"; $processors{ $_ }++ unless $@; } plan skip_all => "no available xpath processors" unless %processors; plan tests => (4 + 30 * scalar(keys(%processors))); } BEGIN { use_ok( 'Test::XML::XPath' ); } eval { like_xpath() }; like( $@, qr/^usage: /, 'like_xpath() no args failure' ); eval { like_xpath( '' ) }; like( $@, qr/^usage: /, 'like_xpath() 1 args failure' ); eval { like_xpath( undef, '/foo' ) }; like( $@, qr/^usage: /, 'like_xpath() undef first arg failure' ); run_the_tests_with( $_ ) foreach keys %processors; sub run_the_tests_with { my $class = shift; set_xpath_processor( $class ); # Test everything mentioned in the docs... my $silly_xml = 'pub'; my @tests = ( [ '', '/foo', 1 ], [ '', '/bar', 0 ], [ '', '/bar', 0 ], [ $silly_xml, '/foo[@attrib="1"]', 1 ], [ $silly_xml, '//bosh', 1 ], [ $silly_xml, '//bosh[@args="42"]', 1 ], [ '', '/foo', 1 ], [ '', 'foo', 1 ], ); foreach my $t ( @tests ) { my $func = $t->[2] ? 'like_xpath' : 'unlike_xpath'; my $name = "$func( $t->[0] => $t->[1] )"; if ( $t->[2] ) { eval { like_xpath( $t->[0], $t->[1], "$name [$class]" ) }; } else { eval { unlike_xpath( $t->[0], $t->[1], "$name [$class]" ) }; } is( $@, '', "$name did not blow up [$class]" ); } my @other_tests = ( [ 'bar', '/' => 'bar' ], [ 'bar', '/foo' => 'bar' ], [ $silly_xml, '/' => 'pub' ], [ $silly_xml, '/foo/bish' => 'pub' ], [ $silly_xml, '/foo/bish/bosh' => 'pub' ], [ $silly_xml, '/foo/@attrib' => '1' ], [ $silly_xml, '/foo/bish/bosh/@args' => '42' ], # Uncomment this to see a sample failure. #[ 'bar', '/bar' => 'foo' ], ); foreach my $t ( @other_tests ) { eval { is_xpath( @$t, "is_xpath() $t->[1] is $t->[2] [$class]" ) }; is( $@, '', "is_xpath() did not blow up [$class]" ); } } # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/maint.t0000444002326000001440000000322211223047503014506 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More; BEGIN { foreach (qw( Test::Builder::Tester XML::SAX XML::Twig ) ) { eval "use $_"; plan skip_all => "$_ not present" if $@; } } use Test::XML; plan tests => 4; #--------------------------------------------------------------------- test_out( "ok 1" ); is_xml( '', '' ); test_test( 'is_xml() spots same bits of xml' ); #--------------------------------------------------------------------- { local $TODO = "buggery uppage"; test_out( "not ok 1" ); test_fail( +2 ); test_diag( "Found 2 differences:", " Child element 'foo' missing from element ''.", " Rogue element 'bar' in element ''." ); is_xml( '', '' ); test_test( 'is_xml() spots different bits of xml' ); } #--------------------------------------------------------------------- { local $TODO = "buggery uppage"; test_out( "not ok 1" ); test_fail( +2 ); test_diag( "During compare:", "not well-formed (invalid token) at line 1, column 1, byte 1" ); is_xml( '', '' ); test_test( 'is_xml() whinges about broken source xml' ); } #--------------------------------------------------------------------- { local $TODO = "buggery uppage"; test_out( "not ok 1" ); test_fail( +2 ); test_diag( "During compare:", "no element found at line 1, column 0, byte -1" ); is_xml( '', '' ); test_test( 'is_xml() whinges about broken dest xml' ); } #--------------------------------------------------------------------- # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/twig.t0000444002326000001440000000337111223047503014355 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More; BEGIN { foreach ( qw( XML::Twig ) ) { eval "use $_"; plan skip_all => "$_ not present" if $@; } } use Test::XML::Twig; plan tests => 10; #--------------------------------------------------------------------- sub handler { my ( $t, $el ) = @_; $el->set_gi( 'bar' ); } #--------------------------------------------------------------------- my $t = get_twig( '>' ); is( $t, undef, 'get_twig() bad input' ); $t = get_twig( '' ); isa_ok( $t, 'XML::Twig' ); #--------------------------------------------------------------------- eval { test_twig_handler() }; like( $@, qr/^usage: /, 'test_twig_handler() no args failure' ); eval { test_twig_handler( \&handler ) }; like( $@, qr/^usage: /, 'test_twig_handler() 1 args failure' ); eval { test_twig_handler( \&handler, '' ) }; like( $@, qr/^usage: /, 'test_twig_handler() 2 args failure' ); eval { test_twig_handler( \&handler, '', '' ) }; like( $@, qr/^usage: /, 'test_twig_handler() 3 args failure' ); eval { test_twig_handler( 'handler', '', '', 'testname' ) }; like( $@, qr/^usage: /, 'test_twig_handler() arg 1 type failure' ); test_twig_handler( \&handler, '', '', 'test_twig_handler() with handler()', ); test_twig_handler( \&handler, '', qr/\bbar\b/, 'test_twig_handler() with qr//', ); #--------------------------------------------------------------------- test_twig_handlers( { start_tag_handlers => { 'foo' => \&handler } }, '', '', 'test_twig_handlers() with handler()', ); # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/order.t0000444002326000001440000000115711223047503014516 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More tests => 3; use Test::XML; { local $TODO = 'make order significant'; isnt_xml( '

ace

', '

ace

', 'characters are not clustered', ); isnt_xml( '

ace

', '

ace

', 'order is significant', ); isnt_xml( '

', '

', 'order is significant when not mixed content', ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/sax.t0000444002326000001440000000312611223047503014174 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More; BEGIN { foreach ( qw( XML::SAX::Base XML::SAX::Writer ) ) { eval "use $_"; plan skip_all => "$_ not present" if $@; } } use Test::XML::SAX; # A Dummy SAX Filter. { package My::XML::Filter; @My::XML::Filter::ISA = 'XML::SAX::Base'; sub start_element { my ($self, $data) = @_; $data->{ Name } =~ s/\bfoo\b/bar/; $data->{ LocalName } =~ s/\bfoo\b/bar/; $self->SUPER::start_element( $data ); } sub end_element { my ($self, $data) = @_; $data->{ Name } =~ s/\bfoo\b/bar/; $data->{ LocalName } =~ s/\bfoo\b/bar/; $self->SUPER::end_element( $data ); } } test_all_sax_parsers( \&do_tests, 6 ); sub do_tests { my ($p, $numtests) = @_; my $handler = My::XML::Filter->new; # XXX These should really come seperately as they are not parser # specific... eval { test_sax() }; like( $@, qr/^usage: /, 'test_sax() no args failure' ); eval { test_sax( $handler ) }; like( $@, qr/^usage: /, 'test_sax() 1 args failure' ); eval { test_sax( $handler, '' ) }; like( $@, qr/^usage: /, 'test_sax() 2 args failure' ); eval { test_sax( 'handler', '', '' ) }; like( $@, qr/^usage: /, 'test_sax() 1st arg type failure' ); test_sax( $handler, '', '', "translates foo to bar ($p)" ); test_sax( $handler, '', '', "leaves moo alone ($p)" ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl : Test-XML-0.08/t/basic.t0000444002326000001440000000174111223047503014463 0ustar domusers00000000000000# @(#) $Id$ use strict; use warnings; use Test::More tests => 9; use Test::XML; eval { is_xml() }; like( $@, qr/^usage: /, 'is_xml() no args failure' ); eval { is_xml( '' ) }; like( $@, qr/^usage: /, 'is_xml() 1 args failure' ); is_xml( '', '', 'first usage example' ); #--------------------------------------------------------------------- eval { isnt_xml() }; like( $@, qr/^usage: /, 'isnt_xml() no args failure' ); eval { isnt_xml( '' ) }; like( $@, qr/^usage: /, 'isnt_xml() 1 args failure' ); isnt_xml( '', '', 'isnt_xml() works' ); #--------------------------------------------------------------------- eval { is_well_formed_xml() }; like( $@, qr/^usage: /, 'is_well_formed_xml() no args failure' ); is_well_formed_xml( '', 'first usage example' ); is_good_xml( '', 'first usage example' ); # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim: set ai et sw=4 syntax=perl :