Permalink
Browse files

Integrated Oliver Charles's CSS selector support

Changed things around, though, with just one additional argument that can be a string or a code refernce. This opens things up to the possibility of other filters going forward. Note that the recursive testing is not quite right, though, due to a but in HTML::Selector::XPath (RT #50131). Will likely delay release till I hear from Tatsuhiko-San.
  • Loading branch information...
1 parent d808632 commit 2200bdd97969f37783ad96c99573a99c62220b30 @theory committed Sep 30, 2009
Showing with 151 additions and 36 deletions.
  1. +1 −6 Build.PL
  2. +3 −0 Changes
  3. +41 −28 lib/Test/XPath.pm
  4. +102 −0 t/css_selector.t
  5. +1 −0 t/pod-spelling.t
  6. +3 −2 t/simple.t
View
@@ -18,12 +18,7 @@ Module::Build->new(
recommends => {
'Test::Pod' => '1.20',
'Test::Pod::Coverage' => '1.06',
- },
- auto_features => {
- selectors => {
- description => 'CSS selectors support',
- requires => { 'HTML::Selector::XPath' => '0.03', }
- }
+ 'HTML::Selector::XPath' => '0.03',
},
meta_merge => {
resources => {
View
@@ -1,6 +1,9 @@
Revision history for Perl extension Test::XPath.
0.13
+ - 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.
0.12 2009-09-05T23:30:05
- Added support for PerlX::MethodCallWithBlock.
View
@@ -17,18 +17,32 @@ sub new {
}
}
return bless {
- xpc => $xpc,
- node => $doc->documentElement,
- gen => $p{xpath_generator}
- || ($p{css_selector} ? \&_css_selector : sub { shift })
+ xpc => $xpc,
+ node => $doc->documentElement,
+ filter => do {
+ if (my $f = $p{filter}) {
+ if (ref $f eq 'CODE') {
+ $f;
+ } elsif ($f eq 'css_selector') {
+ eval 'require HTML::Selector::XPath';
+ die 'Please install HTML::Selector::XPath to use CSS selectors'
+ if $@;
+ sub { HTML::Selector::XPath::selector_to_xpath(shift) }
+ } else {
+ die "Unknown filter: $f\n";
+ }
+ } else {
+ sub { shift },
+ }
+ },
};
}
sub ok {
my ($self, $xpath, $code, $desc) = @_;
my $xpc = $self->{xpc};
my $Test = Test::Builder->new;
- $xpath = $self->{gen}->($xpath);
+ $xpath = $self->{filter}->($xpath);
# Code and desc can be reversed, to support PerlX::MethodCallWithBlock.
($code, $desc) = ($desc, $code) if ref $desc eq 'CODE';
@@ -57,7 +71,7 @@ sub ok {
sub not_ok {
my ($self, $xpath, $desc) = @_;
- $xpath = $self->{gen}->($xpath);
+ $xpath = $self->{filter}->($xpath);
my $Test = Test::Builder->new;
$Test->ok( !$self->{xpc}->exists($xpath, $self->{node}), $desc);
}
@@ -73,7 +87,7 @@ sub xpc { shift->{xpc} }
sub _findv {
my $self = shift;
- $self->{xpc}->findvalue($self->{gen}->(shift), $self->{node});
+ $self->{xpc}->findvalue( $self->{filter}->(shift), $self->{node} );
}
sub _doc {
@@ -108,14 +122,6 @@ sub _doc {
);
}
-sub _css_selector {
- my $path = shift;
- eval 'require HTML::Selector::XPath';
- die "Please install HTML::Selector::XPath to use CSS selectors"
- if $@;
- return HTML::Selector::XPath->new($path)->to_xpath;
-}
-
# Add Test::XML::XPath compatibility?
# sub like_xpath($$;$) { __PACKAGE__->new( xml => shift )->ok( @_ ) }
# sub unlike_xpath($$;$) { __PACKAGE__->new( xml => shift )->not_ok( @_ ) }
@@ -178,6 +184,10 @@ Test::XPath - Test XML and HTML content and structure with XPath expressions
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
@@ -377,27 +387,30 @@ L<XML::LibXML::Parser options|XML::LibXML::Parser/"PARSER OPTIONS">, such as
"validation", "recover", and "no_network". These can be useful for tweaking
the behavior of the parser.
-=item C<css_selector>
+=item C<filter>
- css_selector => 1,
+ filter => 'css_selector',
+ filter => sub { my $xpath = shift; },
-Any paths passed to ok(), is() etc will be first preprocessed by
-HTML::Selector::XPath. This allows you to use CSS selector syntax, which can
-be more compact for simple expressions. For example:
+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.
- $tx->is('div#content div.article h1', '...')
+There is currently only one built-in filter, C<css_selector>. So if you pass
-Is equivilent to:
+ filter => 'css_selector',
- $tx->is('//div[@id="content"]//div[@class="article"]//h1', '...')
+Then any paths passed to C<ok()>, C<is()>, etc., will be passed through
+L<HTML::Selector::XPath|HTML::Selector::XPath>. This allows you to use CSS
+selector syntax, which can be more compact for simple expressions. For
+example, this CSS selector:
-=item C<path_generator>
+ $tx->is('div#content div.article h1', '...')
- path_generator => sub { my $xpath = shift; }
+Is equivalent to this XPath expression:
-Allows a subroutine reference to be passed in, which will be used whenever a XPath
-is required. This allows you to transform the XPath, for example you may have
-some custom syntax which is much more concise than an XPath.
+ $tx->is('//div[@id="content"]//div[@class="article"]//h1', '...')
=back
View
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::Builder::Tester;
+use Test::More;
+use File::Spec;
+
+BEGIN {
+ eval 'require HTML::Selector::XPath';
+ plan skip_all => 'Install HTML::Selector::XPath to use CSS selectors'
+ if $@;
+ plan tests => 16;
+}
+
+BEGIN { use_ok 'Test::XPath' or die; }
+
+my $html = '<html><head><title>Hello</title><body><p class="foo"><em><b>first</b></em></p><p><em><b>post</b></em></p></body></html>';
+
+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__;
+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.
+SKIP: {
+ skip 'http://rt.cpan.org/Ticket/Display.html?id=50131' => 1;
+
+ 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 {
+ diag 'em: ', $_[0]->{node}->toString;
+ $_->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 101.});
+$xp->not_ok(' > html > head > title', 'whatever');
+test_test('not_ok fail works');
View
@@ -23,3 +23,4 @@ lang
libxml
src
uri
+GitHub
View
@@ -19,8 +19,9 @@ $xp->ok('/html/head/title', 'whatever');
test_test('ok works');
# Try failed ok.
+my $file = __FILE__;
test_out('not ok 1 - whatever');
-test_err(qq{# Failed test 'whatever'\n# at t/simple.t line 24.});
+test_err(qq{# Failed test 'whatever'\n# at $file line 25.});
$xp->ok('/html/head/foo', 'whatever');
test_test('ok fail works');
@@ -108,6 +109,6 @@ test_test('not_ok works');
# Try failed ok.
test_out('not ok 1 - whatever');
-test_err(qq{# Failed test 'whatever'\n# at t/simple.t line 112.});
+test_err(qq{# Failed test 'whatever'\n# at $file line 113.});
$xp->not_ok('/html/head/title', 'whatever');
test_test('not_ok fail works');

0 comments on commit 2200bdd

Please sign in to comment.