Test-XPath-0.16000755000767000024 011663101527 12760 5ustar00davidstaff000000000000Test-XPath-0.16/Build.PL000444000767000024 156511663101527 14420 0ustar00davidstaff000000000000use strict; use warnings; use Module::Build; Module::Build->new( module_name => 'Test::XPath', license => 'perl', configure_requires => { 'Module::Build' => '0.30', }, build_requires => { 'Module::Build' => '0.30', 'Test::More' => '0.70', }, requires => { 'Test::Builder' => '0.70', 'XML::LibXML' => '1.70', 'perl' => 5.006002, }, recommends => { 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.06', 'HTML::Selector::XPath' => '0.06', }, meta_merge => { resources => { homepage => 'http://search.cpan.org/dist/Test-XPath/', bugtracker => 'http://github.com/theory/test-xpath/issues/', repository => 'http://github.com/theory/test-xpath/tree/', } }, )->create_build_script; Test-XPath-0.16/Changes000444000767000024 412111663101527 14406 0ustar00davidstaff000000000000Revision history for Perl extension Test::XPath. 0.16 2011-11-23T05:24:03Z - Bumped Test::Pod requirement up to 1.41 to support L directives. Thanks to Fitz Elliott for the report. 0.15 2011-07-17T02:40:11 - Require XML::LibXML 1.70, as that seems to be the first version to offer `set_option()`. - Make sure that HTML::Selector::XPath 0.06 or higher is installed before allowing use of CSS selectors. Should fix some test failures from cpan-testers. 0.14 2011-06-29T18:31:39 - The constructor now croaks instead of carping when no XML or HTML parameter has been pased to it. Thanks to GitHub user "sshaw" for the spot. - Added the `find_value()` method to provide easy access to values in the document relative to the current node. Suggested by Moritz Onken. - XPaths generated via the `css_selector` filter are now properly created relative to th current node. That means you can use CSS expressions in the recursive block passed to `ok()`. 0.13 2010-06-01T18:39:28 - Added the `filter` option, which allows custom filtering of XPath expressions and the use of CSS selectors instead of XPath expresions. Based on a patch from Oliver Charles. - Fixed bug that prevented Test::XPath from being subclassable. Patch from Michael Schout (with tests, huzzah!). - Added support for XML::LibXML options, such as "suppress_errors", that aren't set by accessors. Thanks to Michael S. Fischer for the report. - Fixed test failures on Windows. 0.12 2009-09-05T23:30:05 - Added support for PerlX::MethodCallWithBlock. - Added Test::HTML::Content to the "See Also" section of the docs. 0.11 2009-09-04T22:16:11 - Edited the documentation for accuracy, grammar, etc. - Added `not_ok()`. - Updated minimum Test::More requirement to 0.70. Sometime between 0.64 and 0.70, the format of diagnostics changed, so older versions make Test::XPath tests fail. 0.10 2009-08-31T21:34:37 - Initial version. Test-XPath-0.16/MANIFEST000444000767000024 34311663101527 14226 0ustar00davidstaff000000000000Build.PL Changes lib/Test/XPath.pm MANIFEST This list of files META.json META.yml README t/atom.xml t/blocks.t t/css_selector.t t/ex.t t/menu.xml t/pod.t t/simple.t t/strongrrl.html t/subclass.t t/xhtml.t t/xmlns.t t/xpath.t Test-XPath-0.16/META.json000444000767000024 302611663101527 14537 0ustar00davidstaff000000000000{ "abstract" : "Test XML and HTML content and structure with XPath expressions", "author" : [ "David E. Wheeler " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.112150", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-XPath", "prereqs" : { "build" : { "requires" : { "Module::Build" : "0.30", "Test::More" : "0.70" } }, "configure" : { "requires" : { "Module::Build" : "0.30" } }, "runtime" : { "recommends" : { "HTML::Selector::XPath" : "0.06", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.06" }, "requires" : { "Test::Builder" : "0.70", "XML::LibXML" : "1.70", "perl" : "5.006002" } } }, "provides" : { "Test::XPath" : { "file" : "lib/Test/XPath.pm", "version" : "0.16" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/theory/test-xpath/issues/" }, "homepage" : "http://search.cpan.org/dist/Test-XPath/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/theory/test-xpath/tree/" } }, "version" : "0.16" } Test-XPath-0.16/META.yml000444000767000024 162111663101527 14366 0ustar00davidstaff000000000000--- abstract: 'Test XML and HTML content and structure with XPath expressions' author: - 'David E. Wheeler ' build_requires: Module::Build: 0.30 Test::More: 0.70 configure_requires: Module::Build: 0.30 dynamic_config: 1 generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.112150' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Test-XPath provides: Test::XPath: file: lib/Test/XPath.pm version: 0.16 recommends: HTML::Selector::XPath: 0.06 Test::Pod: 1.41 Test::Pod::Coverage: 1.06 requires: Test::Builder: 0.70 XML::LibXML: 1.70 perl: 5.006002 resources: bugtracker: http://github.com/theory/test-xpath/issues/ homepage: http://search.cpan.org/dist/Test-XPath/ license: http://dev.perl.org/licenses/ repository: http://github.com/theory/test-xpath/tree/ version: 0.16 Test-XPath-0.16/README000444000767000024 156711663101527 14006 0ustar00davidstaff000000000000Test/XPath version 0.16 ======================= This library's module, Test::XPath, provides an interface for testing the content and structure of XML and HTML documents using XPath query expressions. This will be most useful for those who need to write TAP-emitting unit tests for HTML or XML output. INSTALLATION To install this module, type the following: perl Build.PL ./Build ./Build test ./Build install Or, if you don't have Module::Build installed, type the following: perl Makefile.PL make make test make install Dependencies ------------ Test::XPath requires the following modules: * Test::Builder 0.17 * XML::LibXML 1.69 Copyright and Licence --------------------- Copyright (c) 2009 David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Test-XPath-0.16/lib000755000767000024 011663101527 13526 5ustar00davidstaff000000000000Test-XPath-0.16/lib/Test000755000767000024 011663101527 14445 5ustar00davidstaff000000000000Test-XPath-0.16/lib/Test/XPath.pm000444000767000024 4437711663101527 16223 0ustar00davidstaff000000000000package Test::XPath; use strict; use 5.6.2; use XML::LibXML '1.69'; use Test::Builder; our $VERSION = '0.16'; sub new { my ($class, %p) = @_; my $doc = delete $p{doc} || _doc(\%p); my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement ); if (my $ns = $p{xmlns}) { while (my ($k, $v) = each %{ $ns }) { $xpc->registerNs( $k => $v ); } } return bless { xpc => $xpc, node => $doc->documentElement, filter => do { if (my $f = $p{filter}) { if (ref $f eq 'CODE') { $f; } elsif ($f eq 'css_selector') { eval 'use HTML::Selector::XPath 0.06'; die 'Please install HTML::Selector::XPath to use CSS selectors' if $@; sub { my $xpath = do { my $xp = HTML::Selector::XPath->new(shift)->to_xpath(root => '//'); if (eval { $_->isa(__PACKAGE__) } && $_->node ne $doc->documentElement) { # Make it relative to the current node. $xp =~ s{^///[*]}{.}; } else { # Start from the top. $xp =~ s{^///[*]}{}; } $xp; }; return $xpath; } } else { die "Unknown filter: $f\n"; } } else { sub { shift }, } }, }, $class; } sub ok { my ($self, $xpath, $code, $desc) = @_; my $xpc = $self->{xpc}; my $Test = Test::Builder->new; $xpath = $self->{filter}->($xpath, $self); # Code and desc can be reversed, to support PerlX::MethodCallWithBlock. ($code, $desc) = ($desc, $code) if ref $desc eq 'CODE'; if (ref $code eq 'CODE') { # Gonna do some recursive testing. my @nodes = $xpc->findnodes($xpath, $self->{node}) or return $Test->ok(0, $desc); # Record the current test result. my $ret = $Test->ok(1, $desc); # Call the code ref on each found node. local $_ = $self; for my $node (@nodes) { local $self->{node} = $node; $code->($self); } return $ret; } else { # We're just testing for existence ($code is description). $Test->ok( $xpc->exists($xpath, $self->{node}), $code); } } sub not_ok { my ($self, $xpath, $desc) = @_; $xpath = $self->{filter}->($xpath); my $Test = Test::Builder->new; $Test->ok( !$self->{xpc}->exists($xpath, $self->{node}), $desc); } sub is { Test::Builder::new->is_eq( shift->find_value(shift), @_) } sub isnt { Test::Builder::new->isnt_eq( shift->find_value(shift), @_) } sub like { Test::Builder::new->like( shift->find_value(shift), @_) } sub unlike { Test::Builder::new->unlike( shift->find_value(shift), @_) } sub cmp_ok { Test::Builder::new->cmp_ok( shift->find_value(shift), @_) } sub node { shift->{node} } sub xpc { shift->{xpc} } sub find_value { my $self = shift; $self->{xpc}->findvalue( $self->{filter}->(shift), $self->{node} ); } sub _doc { my $p = shift; # Create and configure the parser. my $parser = XML::LibXML->new; # Apply any parser options. if (my $opts = $p->{options}) { while (my ($k, $v) = each %{ $opts }) { if (my $meth = $parser->can($k)) { $parser->$meth($v) } else { $parser->set_option($k => $v); } } } # Parse and return the document. if ($p->{xml}) { return $p->{is_html} ? $parser->parse_html_string($p->{xml}) : $parser->parse_string($p->{xml}); } if ($p->{file}) { return $p->{is_html} ? $parser->parse_html_file($p->{file}) : $parser->parse_file($p->{file}); } require Carp; Carp::croak( 'Test::XPath->new requires the "xml", "file", or "doc" parameter' ); } # Add Test::XML::XPath compatibility? # sub like_xpath($$;$) { __PACKAGE__->new( xml => shift )->ok( @_ ) } # sub unlike_xpath($$;$) { __PACKAGE__->new( xml => shift )->not_ok( @_ ) } # sub is_xpath($$$;$) { __PACKAGE__->new( xml => shift )->is( @_ ) } 1; __END__ =head1 Name Test::XPath - Test XML and HTML content and structure with XPath expressions =head1 Synopsis use Test::More tests => 5; use Test::XPath; my $xml = <<'XML'; Hello

Welcome to my lair.

XML my $tx = Test::XPath->new( xml => $xml ); $tx->ok( '/html/head', 'There should be a head' ); $tx->is( '/html/head/title', 'Hello', 'The title should be correct' ); # Recursing into a document: my @css = qw(foo.css bar.css); $tx->ok( '/html/head/style[@type="text/css"]', sub { my $css = shift @css; shift->is( './@src', $css, "Style src should be $css"); }, 'Should have style' ); # Better yet, use PerlX::MethodCallWithBlock: use PerlX::MethodCallWithBlock; my @css = qw(foo.css bar.css); use PerlX::MethodCallWithBlock; $tx->ok( '/html/head/style[@type="text/css"]', 'Should have style' ) { my $css = shift @css; shift->is( './@src', $css, "Style src should be $css"); }; # Or use CSS Selectors: $tx = Test::XPath->new( xml => $xml, filter => 'css_selector' ); $tx->ok( '> html > head', 'There should be a head' ); =head1 Description Use the power of XPath expressions to validate the structure of your XML and HTML documents. =head2 About XPath XPath is a powerful query language for XML documents. Test::XPath relies on the libxml2 implementation provided by L. libxml2 -- pretty much the canonical library for XML processing -- provides an efficient and complete implementation of the XPath spec. XPath works by selecting nodes in an XML document. Nodes, in general, correspond to the elements (a.k.a. tags) defined in the XML, text within those elements, attribute values, and comments. The expressions for making such selections use a URI-like syntax, the basics of which are: =over =item C<$nodename> Selects all child nodes with the name. =item C Selects the root node. =item C Selects nodes from the current node that match the selection, regardless of where they are in the node hierarchy. =item C<.> Selects the current node. =item C<..> Selects the parent of the current node. =item C<@> Selects attributes. =back And some examples: =over =item C Selects all of the child nodes of the "head" element. =item C Selects the root "html" element. =item C Selects all "p" elements that are children of the "body" element. =item C Selects all "p" elements no matter where they are in the document. =item C Selects all "p" elements that are descendants of the "body" element, no matter where they appear under the "body" element. =item C Selects all attributes named "lang". =back There are also useful predicates to select certain nodes. Some examples: =over =item C Select the first paragraph under the body element. =item C Select the last paragraph under the body element. =item C Select all "script" nodes that have a "src" attribute. =item C Select all "script" nodes that have a "src" attribute set to "foo.js". =item C<< //img[@height > 400] >> Select all "img" nodes with a height attribute greater than 400. =item C Select all child nodes below the "head" node. =item C Select all "p" nodes that have any attribute. =item C Select a count of all "p" nodes in the document. =back There are a bunch of core functions in XPath. In addition to the (C and C) examples above, there are functions for node sets, booleans, numbers, and strings. See the L, for thorough (and quite readable) documentation of XPath support, including syntax and the core functions. The L provides a nice overview of XPath. =head2 Testing HTML If you want to use XPath to test the content and structure of an HTML document, be sure to pass the C option to C, like so: my $tx = Test::XPath->new( xml => $html, is_html => 1 ); Test::XPath will then use XML::LibXML's HTML parser to parse the document, rather than its XML parser. The upshot is that you won't have to worry about namespace prefixes, and XML::LibXML won't try to fetch any DTD specified in the DOCTYPE section of your HTML. =head1 Class Interface =head2 Constructor =head3 C my $tx = Test::XPath->new( xml => $xml ); Creates and returns an XML::XPath object. This object can be used to run XPath tests on the XML passed to it. The supported parameters are: =over =item C xml => 'hey', The XML to be parsed and tested. Required unless the C or C option is passed. =item C file => 'rss.xml', Name of a file containing the XML to be parsed and tested. Required unless the C or C option is passed. =item C doc => XML::LibXML->new->parse_file($xml_file), An XML::LibXML document object. Required unless the C or C option is passed. =item C is_html => 1, If the XML you're testing is actually HTML, pass this option a true value and XML::LibXML's HTML parser will be used instead of the XML parser. This is especially useful if your HTML has a DOCTYPE declaration or an XML namespace (xmlns attribute) and you don't want the parser grabbing the DTD over the Internet and you don't want to mess with a namespace prefix in your XPath expressions. =item C xmlns => { x => 'http://www.w3.org/1999/xhtml', a => 'http://www.w3.org/2007/app', }, Set up prefixes for XML namespaces. Required if your XML uses namespaces and you want to write reasonable XPath expressions. =item C options => { recover_silently => 1, no_network => 1 }, Optional hash reference of L, such as "validation", "recover", "suppress_errors", and "no_network". These can be useful for tweaking the behavior of the parser. =item C filter => 'css_selector', filter => sub { my $xpath = shift; }, Pass a filter name or a code reference for Test::XPath to use to filter XPath expressions before passing them on to XML::LibXML. The code reference argument allows you to transform XPath expressions if, for example, you use a custom XPath syntax that's more concise than XPath. There is currently only one built-in filter, C. So if you pass filter => 'css_selector', Then any paths passed to C, C, etc., will be passed through L. This allows you to use CSS selector syntax, which can be more compact for simple expressions. For example, this CSS selector: $tx->is('div#content div.article h1', '...') Is equivalent to this XPath expression: $tx->is('//div[@id="content"]//div[@class="article"]//h1', '...') =back =head1 Instance Interface =head2 Assertions =head3 C $tx->ok( $xpath, $description ) $tx->ok( $xpath, $coderef, $description ) Test that an XPath expression evaluated against the XML document returns a true value. If the XPath expression finds no nodes, the result will be false. If it finds a value, the value must be a true value (in the Perl sense). $tx->ok( '//foo/bar', 'Should have bar element under foo element' ); $tx->ok( 'contains(//title, "Welcome")', 'Title should "Welcome"' ); You can also run recursive tests against your document by passing a code reference as the second argument to C. Once the initial selection has been completed, each selected node will be assigned to the C attribute and the XML::XPath object passed to the code reference. For example, if you wanted to test for the presence of "story" elements in your document, and to test that each such element had an incremented "id" attribute, you'd do something like this: my $i = 0; $tx->ok( '//assets/story', sub { shift->is('./@id', ++$i, "ID should be $i in story $i"); }, 'Should have story elements' ); Even better, use L to pass a block to the method instead of a code reference: use PerlX::MethodCallWithBlock; my $i = 0; $tx->ok( '//assets/story', 'Should have story elements' ) { shift->is('./@id', ++$i, "ID should be $i in story $i"); }; For convenience, the XML::XPath object is also assigned to C<$_> for the duration of the call to the code reference. Either way, you can call C and pass code references anywhere in the hierarchy. For example, to ensure that an Atom feed has entries and that each entry has a title, a link, and a very specific author element with name, uri, and email subnodes, you can do this: $tx->ok( '/feed/entry', sub { $_->ok( './title', 'Should have a title' ); $_->ok( './author', sub { $_->is( './name', 'Mark Pilgrim', 'Mark should be author' ); $_->is( './uri', 'http://example.org/', 'URI should be correct' ); $_->is( './email', 'f8dy@example.com', 'Email should be right' ); }, 'Should have author elements' ); }, 'Should have entry elments' ); =head3 C $tx->not_ok( $xpath, $description ) The reverse of the non-recursive C, the test succeeds if the XPath expression matches no part of the document. $tx->not_ok( '//foo/bar[@id=0]', 'Should have no bar elements with Id 0' ); =head3 C =head3 C $tx->is( $xpath, $want, $description ); $tx->isnt( $xpath, $dont_want, $description ); C and C compare the value returned by evaluation of the XPath expression against the document to a value using C and C, respectively. $tx->is( '/html/head/title', 'Welcome', 'Title should be welcoming' ); $tx->isnt( '/html/head/link/@type', 'hello', 'Link type should not' ); As with C, a failing test will yield a useful diagnostic message, something like: # Failed test 'Title should be welcoming' # at t/foo.t line 47. # got: 'Bienvenidos' # expected: 'Hello' =head3 C =head3 C $tx->like( $xpath, qr/want/, $description ); $tx->unlike( $xpath, qr/dont_want/, $description ); Similar to C and C, but these methods match the value returned by the XPath expression against a regular expression. $tx->like( '/html/head/title', qr/^Foobar Inc.: .+/, 'Title context' ); $tx->unlike( '/html/head/title', qr/Error/, 'Should be no error in title' ); As with C, a failing test will yield a useful diagnostic message, something like: # Failed test 'Title should, like, welcome' # at t/foo.t line 62. # 'Bye' # doesn't match '(?-xism:^Howdy$)' =head3 C $tx->cmp_ok( $xpath, $op, $want, $description ); Like C, this method allows you to compare the value returned by an XPath expression to a value using any binary Perl operator. $tx->cmp_ok( '/html/head/title', 'eq', 'Welcome' ); $tx->cmp_ok( '//story[1]/@id', '==', 1 ); As with C, a failing test will yield a useful diagnostic message, something like: # Failed test # at t/foo.t line 104. # '0' # && # '1' =head2 Accessors =head3 C my $node = $tx->node; Returns the current context node. This will usually be the node for the entire document, but in recursive tests run in code references passed to C, the node will be one of the nodes selected for the test. =head3 C Returns the L used to execute the XPath expressions. It can be useful to access this object in order to create new XPath functions to use in your tests. For example, say that you wanted to define a C XPath function that returns true for a node value that matches a regular expression. You can define one like so: $tx->xpc->registerFunction( grep => sub { my ($nodelist, $regex) = @_; my $result = XML::LibXML::NodeList->new; for my $node ($nodelist->get_nodelist) { $result->push($node) if $node->textContent =~ $regex; } return $result; } ); You can then use C like any other XPath function to select only those nodes with content matching a regular expression. This example makes sure that there are "email" nodes under "author" nodes that end in "@example.com" or "example.org": $tx->ok( 'grep(//author/email, "@example[.](?:com|org)$")', 'Should have example email' ); =head2 Utilities =head3 C my $val = $tx->find_value($xpath); Returns the value returned by evaluation of the XPath expression against the document relative to the current node. This is the method used internally to fetch the value to be compared by C, C, C, C, and C. A simple example: my $val = $tx->find_value('/html/head/title'); =head1 See Also =over =item * L. =item * L. =item * L - The XML::LibXML XPath evaluation library. =item * L - Another library for testing XPath assertions using a functional interface. Ships with L. =item * L - Another module that that offers C and C test functions. =back =head1 Support This module is stored in an open L. Feel free to fork and contribute! Please file bug reports via L or by sending mail to L. =head1 Author David E. Wheeler =head1 Copyright and License Copyright (c) 2009-2010 David E. Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Test-XPath-0.16/t000755000767000024 011663101527 13223 5ustar00davidstaff000000000000Test-XPath-0.16/t/atom.xml000444000767000024 456211663101527 15051 0ustar00davidstaff000000000000 dive into mark A <em>lot</em> of effort went into making this effortless 2005-07-31T12:29:29Z tag:example.org,2003:3 Copyright (c) 2003, Mark Pilgrim Example Toolkit Atom draft-07 snapshot tag:example.org,2003:3.2397 2005-07-31T12:29:29Z 2003-12-13T08:29:29-04:00 Mark Pilgrim http://example.org/ f8dy@example.com Sam Ruby Joe Gregorio

[Update: The Atom draft is finished.]

 Atom draft-08 snapshot tag:example.org,2003:3.2398 2005-08-31T12:29:29Z 2003-12-18T08:29:29-04:00 Mark Pilgrim http://example.org/ f8dy@example.com Sam Ruby Joe Gregorio

[Update: The Atom draft is finished.]

 Test-XPath-0.16/t/blocks.t000444000767000024 140011663101527 15015 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More; BEGIN { eval { require PerlX::MethodCallWithBlock; }; plan skip_all => "PerlX::MethodCallWithBlock not installed" if $@; } use PerlX::MethodCallWithBlock; plan tests => 11; use Test::XPath; my $html = 'Hello

first

post

'; ok my $xp = Test::XPath->new( xml => $html, is_html => 1, ), 'Should be able to parse HTML'; # Try a recursive call. $xp->ok( '/html/body/p', 'Find paragraphs' ) { shift->ok('./em', 'Find em under para') { shift->ok('./b', 'Find b under em'); }; }; # Now without descriptions. $xp->ok( '/html/body/p' ) { shift->ok('./em') { shift->ok('./b'); }; }; Test-XPath-0.16/t/css_selector.t000444000767000024 566011663101527 16244 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::Builder::Tester; use Test::More; use File::Spec; BEGIN { eval 'use HTML::Selector::XPath 0.06'; plan skip_all => 'Install HTML::Selector::XPath to use CSS selectors' if $@; plan tests => 16; } BEGIN { use_ok 'Test::XPath' or die; } my $html = 'Hello

first

post

'; ok my $xp = Test::XPath->new( xml => $html, is_html => 1, filter => 'css_selector', ), 'Create Test::XPath object with CSS selector support'; # Try successful ok. test_out( 'ok 1 - whatever'); $xp->ok('> html > head > title', 'whatever'); test_test('ok works'); # Try failed ok. my $file = File::Spec->catfile(split m{/} => __FILE__); test_out('not ok 1 - whatever'); test_err(qq{# Failed test 'whatever'\n# at $file line 34.}); $xp->ok('> html > head > foo', 'whatever'); test_test('ok fail works'); # Try a recursive call. test_out( 'ok 1 - p'); test_out( 'ok 2 - em'); test_out( 'ok 3 - b'); test_out( 'ok 4 - em'); test_out( 'ok 5 - b'); $xp->ok( '> html > body > p', sub { shift->ok('> em', sub { $_->ok('> b', 'b'); }, 'em'); }, 'p'); test_test('recursive ok should work'); # Try is, like, and cmp_ok. $xp->is( ' > html > head > title', 'Hello', 'is should work'); $xp->isnt( ' > html > head > title', 'Bye', 'isnt should work'); $xp->like( ' > html > head > title', qr{^Hel{2}o$}, 'like should work'); $xp->unlike( ' > html > head > title', qr{^Bye$}, 'unlike should work'); $xp->cmp_ok(' > html > head > title', 'eq', 'Hello', 'cmp_ok should work'); # Make them fail. test_out('not ok 1 - is should work'); test_out('not ok 2 - isnt should work'); test_out('not ok 3 - like should work'); test_out('not ok 4 - unlike should work'); test_out('not ok 5 - cmp_ok should work'); $xp->is( ' > html > head > title', 'Bye', 'is should work'); $xp->isnt( ' > html > head > title', 'Hello', 'isnt should work'); $xp->like( ' > html > head > title', qr{^Bye$}, 'like should work'); $xp->unlike( ' > html > head > title', qr{^Hel{2}o$}, 'unlike should work'); $xp->cmp_ok(' > html > head > title', 'ne', 'Hello', 'cmp_ok should work'); test_test( skip_err => 1, title => 'Failures in the simple methods should work', ); # Try multiples. $xp->is(' > html > body > p', 'firstpost', 'Should work for multiples'); # Try an attribute. $xp->ok(' > html > body > p[class="foo"]', 'Should find by attribute value'); # Try a non-existent node. test_out('not ok 1'); $xp->ok(' > foo > baz'); test_test( skip_err => 1, title => 'Nonexistent node should be false in ok()', ); # Try successful ok. test_out( 'ok 1 - whatever'); $xp->not_ok(' > html > head > foo', 'whatever'); test_test('not_ok works'); # Try failed ok. test_out('not ok 1 - whatever'); test_err(qq{# Failed test 'whatever'\n# at $file line 97.}); $xp->not_ok(' > html > head > title', 'whatever'); test_test('not_ok fail works'); Test-XPath-0.16/t/ex.t000444000767000024 534311663101527 14166 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use File::Spec::Functions 'catfile'; # Synopsis. # use Test::More tests => 28; # Use when PerlX::MethodCallWithBlock tests uncommented. use Test::More tests => 22; use Test::XPath; my $xml = <<'XML'; Hello

Welcome to my lair.

XML my $tx = Test::XPath->new( xml => $xml ); $tx->ok( '/html/head', 'There should be a head' ); $tx->is( '/html/head/title', 'Hello', 'The title should be correct' ); # Recursing into a document: my @css = qw(foo.css bar.css); $tx->ok( '/html/head/style[@type="text/css"]', sub { my $css = shift @css; shift->is( './@src', $css, "Style src should be $css"); }, 'Should have style' ); # Better yet, use PerlX::MethodCallWithBlock: # @css = qw(foo.css bar.css); # use PerlX::MethodCallWithBlock; # $tx->ok( '/html/head/style[@type="text/css"]', 'Should have style' ) { # my $css = shift @css; # shift->is( './@src', $css, "Style src should be $css"); # }; # ok() $tx = Test::XPath->new( xml => 'Welcome'); $tx->ok( '//foo/bar', 'Should have bar element under foo element' ); $tx->ok( 'contains(//title, "Welcome")', 'Title should "Welcome"' ); # ok() recursive. $tx = Test::XPath->new( xml => ''); my $i = 0; $tx->ok( '//assets/story', sub { shift->is('./@id', ++$i, "ID should be $i in story $i"); }, 'Should have story elements' ); # use PerlX::MethodCallWithBlock; # $i = 0; # $tx->ok( '//assets/story', 'Should have story elements' ) { # shift->is('./@id', ++$i, "ID should be $i in story $i"); # }; # ok() deep atom example. $tx = Test::XPath->new( file => catfile(qw(t atom.xml)) ); $tx->ok( '/feed/entry', sub { $_->ok( './title', 'Should have a title' ); $_->ok( './author', sub { $_->is( './name', 'Mark Pilgrim', 'Mark should be author' ); $_->is( './uri', 'http://example.org/', 'URI should be correct' ); $_->is( './email', 'f8dy@example.com', 'Email should be right' ); }, 'Should have author elements' ); }, 'Should have entry elments' ); # xpc, adding an XPath function. $tx->xpc->registerFunction( grep => sub { my ($nodelist, $regex) = @_; my $result = XML::LibXML::NodeList->new; for my $node ($nodelist->get_nodelist) { $result->push($node) if $node->textContent =~ $regex; } return $result; } ); $tx->ok( 'grep(//author/email, "@example[.](?:com|org)$")', 'Should have example email' ); Test-XPath-0.16/t/menu.xml000444000767000024 426311663101527 15053 0ustar00davidstaff000000000000 Trébol Pollo en Fuego Lento con un Ragout de Calabasa $17 Atun Empanisado con papas, Calabacitas y Tomates $16 Crusted & Seared Albacore Tuna with a Potato, Squash Gratin & a Sassy Tomato Broth Enchiladas de Calabasa, Cebollas, Verduras, Queso Fresco y un Huevo Frito $16 Traditional Enchilada with Summer Squash, Caramelized Onions, Wilted Greens, Queso Fresco & a Fried Egg Layuda con Frijoles Negros, Pollo Cocinado en Fuego Lento y Salsita de Aguacate $14 House Made Flat Bread topped with Braised Chicken, Black Beans & Avocado Sauce Tostada de Pescada Ahumado con Ensalada Mixto $15 Mesquite Smoked Fish Tostada with Mixed Greens Caldo de Mariscos $17 Heirloom Tomato & Red Wine Stew of Calamari, Fish, Clams, Serrano Chili’s & Wilted Greens Crepa de Calabacita, Cebollas y Ensalada Mixto $14 Crepe Stuffed with Grilled Zucchini, Caramelized Onions & Fresh Greens Puerco a la Parilla con un Torta de Calabacita, Vejetales de Verano $18 Grilled Pork Loin with Zucchini Torta & Mulato Cider Vinaigrette Trébol Torta Hamburgesa, con Mayonesa de Jalapeños, Escabeche y Verduras $9 Trébol Ground Sirloin on a Onion Bun, Jalapeño Aioli, Pickles, Mixed Greens Bacon Asadero Cheese Guacamole Test-XPath-0.16/t/pod.t000555000767000024 23011663101527 14305 0ustar00davidstaff000000000000#!perl -w use strict; use Test::More; eval "use Test::Pod 1.20"; plan skip_all => "Test::Pod 1.20 required for testing POD" if $@; all_pod_files_ok(); Test-XPath-0.16/t/simple.t000444000767000024 657311663101527 15051 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::Builder::Tester tests => 23; use Test::More; use File::Spec; BEGIN { use_ok 'Test::XPath' or die; } my $html = 'Hello

first

post

'; ok my $xp = Test::XPath->new( xml => $html, is_html => 1, ), 'Create Test::XPath object'; # Try successful ok. test_out( 'ok 1 - whatever'); $xp->ok('/html/head/title', 'whatever'); test_test('ok works'); # Try failed ok. my $file = File::Spec->catfile(split m{/} => __FILE__); test_out('not ok 1 - whatever'); test_err(qq{# Failed test 'whatever'\n# at $file line 26.}); $xp->ok('/html/head/foo', 'whatever'); test_test('ok fail works'); # Try a recursive call. test_out( 'ok 1 - p'); test_out( 'ok 2 - em'); test_out( 'ok 3 - b'); test_out( 'ok 4 - em'); test_out( 'ok 5 - b'); $xp->ok( '/html/body/p', sub { shift->ok('./em', sub { $_->ok('./b', 'b'); }, 'em'); }, 'p'); test_test('recursive ok should work'); # Try is, like, and cmp_ok. $xp->is( '/html/head/title', 'Hello', 'is should work'); $xp->isnt( '/html/head/title', 'Bye', 'isnt should work'); $xp->like( '/html/head/title', qr{^Hel{2}o$}, 'like should work'); $xp->unlike( '/html/head/title', qr{^Bye$}, 'unlike should work'); $xp->cmp_ok('/html/head/title', 'eq', 'Hello', 'cmp_ok should work'); # Make them fail. test_out('not ok 1 - is should work'); test_out('not ok 2 - isnt should work'); test_out('not ok 3 - like should work'); test_out('not ok 4 - unlike should work'); test_out('not ok 5 - cmp_ok should work'); $xp->is( '/html/head/title', 'Bye', 'is should work'); $xp->isnt( '/html/head/title', 'Hello', 'isnt should work'); $xp->like( '/html/head/title', qr{^Bye$}, 'like should work'); $xp->unlike( '/html/head/title', qr{^Hel{2}o$}, 'unlike should work'); $xp->cmp_ok('/html/head/title', 'ne', 'Hello', 'cmp_ok should work'); test_test( skip_err => 1, title => 'Failures in the simple methods should work', ); # Try multiples. $xp->is('/html/body/p', 'firstpost', 'Should work for multiples'); # Try an attribute. $xp->is('/html/body/p/@class', 'foo', 'Should get attribute value'); $xp->ok('/html/body/p[@class="foo"]', 'Should find by attribute value'); # Try a function. $xp->is('count(/html/body/p)', 2, 'Should work for functions'); # Try boolean function. $xp->ok('boolean(1)', 'boolean(1) should be true'); $xp->ok('true()', 'true() should be true'); # Try a false boolean. test_out('not ok 1 - false boolean'); $xp->ok('false()', 'false boolean'); test_test( skip_err => 1, title => 'Boolean true returned by XPath should be true in ok()', ); # Try a comparison function. $xp->ok('contains(//title, "Hell")', 'Title should contain "hell"'); # Try a false comparison. test_out('not ok 1 - heck'); $xp->ok('contains(//title, "Heck")', 'heck'); test_test( skip_err => 1, title => 'Boolean false returned by XPath should be false in ok()', ); # Try a non-existent node. test_out('not ok 1'); $xp->ok('/foo/baz'); test_test( skip_err => 1, title => 'Nonexistent node should be false in ok()', ); # Try successful ok. test_out( 'ok 1 - whatever'); $xp->not_ok('/html/head/foo', 'whatever'); test_test('not_ok works'); # Try failed ok. test_out('not ok 1 - whatever'); test_err(qq{# Failed test 'whatever'\n# at $file line 114.}); $xp->not_ok('/html/head/title', 'whatever'); test_test('not_ok fail works'); Test-XPath-0.16/t/strongrrl.html000444000767000024 152311663101527 16303 0ustar00davidstaff000000000000 Strongrrl: Design with muscle
Strongrrl: Design with Muscle
Test-XPath-0.16/t/subclass.t000444000767000024 47711663101527 15354 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 2; BEGIN { use_ok 'Test::XPath' or die; } my $xml = <<'XML'; foo XML package Test::XPath::Subclass; use base 'Test::XPath'; package main; my $sub = Test::XPath::Subclass->new(xml => $xml); isa_ok $sub, 'Test::XPath::Subclass'; Test-XPath-0.16/t/xhtml.t000444000767000024 211611663101527 14701 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::Builder::Tester tests => 7; use Test::More; use File::Spec::Functions 'catfile'; BEGIN { use_ok 'Test::XPath' or die; } my $file = catfile qw(t strongrrl.html); ok my $xp = Test::XPath->new( file => $file, options => { no_network => 1, recover_silently => 1 }, ), 'Create object for HTML file'; test_out 'not ok 1 - oops'; $xp->ok('/html/head/title', 'oops'); test_test skip_err => 1, title => 'Should fail without a namespace'; # Try it with a namespace. ok $xp = Test::XPath->new( file => $file, xmlns => { x => 'http://www.w3.org/1999/xhtml' }, options => { no_network => 1, recover_silently => 1 }, ), 'Create object with a namespace prefix'; test_out 'ok 1 - yay'; $xp->ok('/x:html/x:head/x:title', 'yay'); test_test title => 'Should succeed with namespace prefix'; # Now use the HTML parser. ok $xp = Test::XPath->new( file => $file, is_html => 1, ), 'Create object that uses the HTML parser'; test_out 'ok 1 - yay'; $xp->ok('/html/head/title', 'yay'); test_test title => 'Should succeed with no namespace prefix'; Test-XPath-0.16/t/xmlns.t000444000767000024 157211663101527 14713 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 4; BEGIN { use_ok 'Test::XPath' or die; } # Borrowed from http://www.w3schools.com/XML/xml_namespaces.asp my $xml = <<'XML'; Fruit
Apples Bananas
African Coffee Table80120
 XML ok my $xp = Test::XPath->new( xml => $xml, xmlns => { x => 'http://www.w3.org/TR/html4/', f => 'http://www.w3schools.com/furniture', }, ), 'Create object with two namespaces'; $xp->is('/root/x:table/x:name', 'Fruit', 'Should get HTML table'); $xp->is('/root/f:table/f:name', 'African Coffee Table', 'Should furniture table'); Test-XPath-0.16/t/xpath.t000444000767000024 563111663101527 14676 0ustar00davidstaff000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 57; #use Test::More 'no_plan'; use File::Spec::Functions 'catfile'; use utf8; BEGIN { use_ok 'Test::XPath' or die; } # Try failure. eval { Test::XPath->new }; like $@, qr{Test::XPath->new requires the "xml", "file", or "doc" parameter}, 'Should get an exception for invalid params'; my $xml = 'firstpost'; my $html = 'Hello

first

post

'; ok my $xp = Test::XPath->new( xml => $xml, ), 'Should be able to create an object'; isa_ok $xp, 'Test::XPath'; isa_ok $xp->{xpc}, 'XML::LibXML::XPathContext'; ok +Test::XPath->new( xml => $xml, options => { no_network => 1, keep_blanks => 1, suppress_errors => 1 }, ), 'Should be able to configure the parser'; ok $xp = Test::XPath->new( xml => $html, is_html => 1, ), 'Should be able to parse HTML'; isa_ok $xp, 'Test::XPath'; isa_ok $xp->{xpc}, 'XML::LibXML::XPathContext'; # Do some tests with it. $xp->ok('/html/head/title', 'Should find the title'); # Try a recursive call. $xp->ok( '/html/body/p', sub { shift->ok('./em', sub { $_->ok('./b', 'Find b under em'); }, 'Find em under para'); }, 'Find paragraphs'); # Make sure that find_value() works. is $xp->find_value('/html/head/title'), 'Hello', 'find_value should work'; # Try is, like, and cmp_ok. $xp->is( '/html/head/title', 'Hello', 'is should work'); $xp->isnt( '/html/head/title', 'Bye', 'isnt should work'); $xp->like( '/html/head/title', qr{^Hel{2}o$}, 'like should work'); $xp->unlike( '/html/head/title', qr{^Bye$}, 'unlike should work'); $xp->cmp_ok('/html/head/title', 'eq', 'Hello', 'cmp_ok should work'); # Try multiples. $xp->is('/html/body/p', 'firstpost', 'Two values should concatenate'); # Try loading a file. my $file = catfile qw(t menu.xml); ok $xp = Test::XPath->new( file => $file ), 'Should create with file'; # Do some tests on the XML. $xp->is('/menu/restaurant', 'Trébol', 'Should find Unicode value in file'); # Use recursive ok() to ensure all items have the appropriate parts. my $i = 0; $xp->ok('/menu/item', sub { ++$i; $_->ok('./name', "Item $i should have a name"); $_->ok('./price', "Item $i should have a price"); $_->ok('./description', "Item $i should have a description"); }, 'Should have items' ); # Hey, so no try using the doc param. ok $xp = Test::XPath->new( doc => XML::LibXML->new->parse_file($file), ), 'Should create with doc'; $xp->is('/menu/restaurant', 'Trébol', 'Should find Unicode value in doc'); # Use a namespace. ok $xp = Test::XPath->new( xml => $xml, xmlns => { 'ex' => 'http://w3.org/ex' }, ), 'Should create with real namespace'; $xp->ok('/ex:foo/ex:bar', 'We should find an ex:bar'); $xp->is('/ex:foo/ex:bar[1]', 'first', 'Should be able to check the first ex:bar value');