Test-HTML-Content-0.08/ 0000755 0001750 0001750 00000000000 11106611350 014070 5 ustar corion corion Test-HTML-Content-0.08/t/ 0000755 0001750 0001750 00000000000 11106611350 014333 5 ustar corion corion Test-HTML-Content-0.08/t/07-errors.link.t 0000755 0001750 0001750 00000010235 07771616401 017237 0 ustar corion corion # Test script to test the failure modes of Test::HTML::Content
use Test::More;
use lib 't';
use testlib;
BEGIN {
eval {
require Test::Builder::Tester;
Test::Builder::Tester->import;
};
if ($@) {
plan skip_all => "Test::Builder::Tester required for testing error messages";
}
};
sub run {
# Test that each exported function fails as documented
test_out("not ok 1 - Link failure (no links)");
test_fail(+8);
if ($Test::HTML::Content::can_xpath eq 'XML::LibXML') {
test_diag("Invalid HTML:","");
} else {
test_diag("Expected to find at least one tag(s) matching",
" href = http://www.perl.com",
"Got none");
};
link_ok("","http://www.perl.com","Link failure (no links)");
test_test("Finding no link works");
test_out("not ok 1 - Link failure (two links that don't match)");
test_fail(+14);
if ($Test::HTML::Content::can_xpath eq 'XML::LibXML') {
test_diag("Expected to find at least one tag(s) matching",
" href = http://www.perl.com",
"Got",
' foo',
' Home');
} else {
test_diag("Expected to find at least one tag(s) matching",
" href = http://www.perl.com",
"Got",
" ",
" ");
};
link_ok("fooHome",
"http://www.perl.com","Link failure (two links that don't match)");
test_test("Finding no link returns all other links");
test_out("not ok 1 - Link failure (two links shouldn't exist do)");
test_fail(+14);
if ($Test::HTML::Content::can_xpath eq 'XML::LibXML') {
test_diag("Expected to find no tag(s) matching",
" href = (?-xism:.)",
"Got",
' foo',
' Home');
} else {
test_diag("Expected to find no tag(s) matching",
" href = (?-xism:.)",
"Got",
" ",
" ");
};
no_link("fooHome",
qr".","Link failure (two links shouldn't exist do)");
test_test("Finding a link where one should be returns all other links");
test_out("not ok 1 - Link failure (too few links)");
test_fail(+14);
if ($Test::HTML::Content::can_xpath eq 'XML::LibXML') {
test_diag("Expected to find exactly 3 tag(s) matching",
" href = (?-xism:.)",
"Got",
' foo',
' Home');
} else {
test_diag("Expected to find exactly 3 tag(s) matching",
" href = (?-xism:.)",
"Got",
" ",
" ");
};
link_count("fooHome",qr".",3,"Link failure (too few links)");
test_test("Diagnosing too few links works");
test_out("not ok 1 - Link failure (too many links)");
test_fail(+18);
if ($Test::HTML::Content::can_xpath eq 'XML::LibXML') {
test_diag("Expected to find exactly 3 tag(s) matching",
" href = (?-xism:.)",
"Got",
' bar',
' .',
' foo',
' Home');
} else {
test_diag("Expected to find exactly 3 tag(s) matching",
" href = (?-xism:.)",
"Got",
" ",
" ",
" ",
" ");
};
link_count("bar.fooHome",qr".",3,"Link failure (too many links)");
test_test("Diagnosing too many links works");
};
runtests( 5,\&run);
Test-HTML-Content-0.08/t/embedded-Test-HTML-Content-XPathExtensions.t 0000644 0001750 0001750 00000002127 07774331127 024465 0 ustar corion corion #!D:\perl\5.8.2\bin\perl.exe -w
use Test::More 'no_plan';
package Catch;
sub TIEHANDLE {
my($class, $var) = @_;
return bless { var => $var }, $class;
}
sub PRINT {
my($self) = shift;
${'main::'.$self->{var}} .= join '', @_;
}
sub OPEN {} # XXX Hackery in case the user redirects
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
sub READ {}
sub READLINE {}
sub GETC {}
my $Original_File = 'lib\Test\HTML\Content\XPathExtensions.pm';
package main;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
tie *STDERR, 'Catch', '_STDERR_' or die $!;
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 58 lib/Test/HTML/Content/XPathExtensions.pm
# This module patches the XML::XPath::Function namespace
use Test::HTML::Content::XPathExtensions;
;
}
};
is($@, '', "example from line 58");
undef $main::_STDOUT_;
undef $main::_STDERR_;
Test-HTML-Content-0.08/t/12-title.t 0000755 0001750 0001750 00000001651 07770273227 016112 0 ustar corion corion use strict;
use Test::More tests => 7;
BEGIN {
use_ok( "Test::HTML::Content" );
};
SKIP: {
skip "XML::XPath or XML::LibXML is needed for title testing", 6
unless $Test::HTML::Content::can_xpath;
title_ok('A test title',qr"A test title","Title RE");
title_ok('A test title',qr"^A test title$","Anchored title RE");
title_ok('A test title',qr"test","Title RE works for partial matches");
title_ok('A test title',"A test title","Title string");
no_title('A test title',"test","Complete title string gets compared");
no_title('A test title',"A toast title","no_title string");
}; Test-HTML-Content-0.08/t/99-Pod.t 0000755 0001750 0001750 00000001235 07770301463 015522 0 ustar corion corion use Test::More;
# Check our Pod
# The test was provided by Andy Lester,
# who stole it from Brian D. Foy
# Thanks to both !
use File::Spec;
use File::Find;
use strict;
eval {
require Test::Pod;
Test::Pod->import;
};
my @files;
if ($@) {
plan skip_all => "Test::Pod required for testing POD";
}
elsif ($Test::Pod::VERSION < 0.95) {
plan skip_all => "Test::Pod 0.95 required for testing POD";
}
else {
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d $_ } ($blib, 'bin'));
plan tests => scalar @files;
foreach my $file (@files) {
pod_file_ok($file);
}
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
Test-HTML-Content-0.08/t/06-text.t 0000755 0001750 0001750 00000020304 07770273227 015754 0 ustar corion corion use strict;
use lib 't';
use testlib;
my $HTML = <<'HTML';
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very long text.This is a very long text.This is a very long text.
This is a very long text.This is a very long text.This is a very lang text.This is a very long text.This is a very long text.
HTML
my $HTML2 = "This is some text. And some more text. And some other stuff
";
# use Test::HTML::Content;
sub run {
text_ok($HTML,qr"This is a very lang text."ism,"REs for text work");
text_count($HTML,qr"This is a very lang text.",1,"Counting text elements works");
no_text($HTML, "This is a very long test","Negation works as well");
no_text($HTML, qr"This is a very long test","Negation also works with REs");
text_ok($HTML2,"This is some text.","Complete elements are matched");
text_ok($HTML2,"And some more text.","Complete elements are matched with whitespace at the ends");
text_count($HTML2,qr"text",2,"Counting elements works with REs");
text_count($HTML2,qr"[aA]nd",2,"Counting elements works with REs");
# Now guard against inadverent stringification of REs :
#$text =~ s/^\s*(.*?)\s*$/$1/;
no_text("[A] simple test",qr"[A] simple test","No stringification of REs in no_text()");
text_count("[A] simple test",qr"[A] simple test",0,"No stringification of REs in text_count()");
text_ok("A simple test",qr"A simple test","Text is not broken up");
};
runtests( 11, \&run ); Test-HTML-Content-0.08/t/09-errors.declaration.t 0000755 0001750 0001750 00000000566 07646345217 020604 0 ustar corion corion # Test script to test the failure modes of Test::HTML::Content
use Test::More;
eval {
require Test::Builder::Tester;
Test::Builder::Tester->import;
};
if ($@) {
plan skip_all => "Test::Builder::Tester required for testing error messages";
}
plan tests => 1;
use_ok('Test::HTML::Content');
# Test that doctype_ok fails as documented
# to be done Test-HTML-Content-0.08/t/01-xpath-query-builder.t 0000755 0001750 0001750 00000001717 07770273341 020702 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More;
use lib 't';
use testlib;
# This test file tests the generation of the XPath queries
# The XPath queries have to work for both, XML::XPath
# and XML::LibXML, so not all features of XML::XPath
# can be used ...
my (@cases);
BEGIN {
@cases=(
[ tag => {href => 'http://www.perl.com', alt =>"foo"} => '//tag[@alt = "foo" and @href = "http://www.perl.com"]' ],
[ tag => {href => qr'http://', alt =>"foo"} => '//tag[@alt = "foo" and @href]' ],
[ tag => {href => qr'http://', alt => undef} => '//tag[not(@alt) and @href]' ],
[ tag2 => {href => qr'http://', alt => undef} => '//tag2[not(@alt) and @href]' ],
);
# plan( tests => scalar @cases +1 );
};
sub run_case {
my ($tag,$attr,$result) = @_;
my ($query,$code) = Test::HTML::Content::__build_xpath_query("//".$tag,$attr);
is( $query, $result, $query );
};
sub run {
for my $case (@cases) {
run_case( @$case );
};
};
runtests( scalar @cases, \&run );
Test-HTML-Content-0.08/t/01-internal-api.t 0000755 0001750 0001750 00000022203 07770273227 017346 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More;
use lib 't';
use testlib;
# This test file tests the internal routines of Test::HTML.
# The internal routines aren't really intended for public
# consumption, but the tests you'll find in here should
# document the behaviour enough ...
my (%cases_2,%cases_3);
my $count;
BEGIN {
$cases_2{__dwim_compare} = [
"foo" => "bar" => 0,
"foo" => "..." => 0,
"bar" => "foo" => 0,
"bar" => "barra" => 0,
"barra" => "bar" => 0,
"foo" => qr"bar" => 0,
"foo" => qr"..." => 1,
"bar" => qr"foo" => 0,
"bar" => qr"barra" => 0,
"barra" => qr"bar" => 1,
"foo" => qr"^oo" => 0,
"foo" => qr"oo$" => 1,
"FOO" => qr"foo$" => 0,
"FOO" => qr"foo$"i => 1,
];
$cases_2{__match_comment} = [
"hidden message" => qr"hidden\s+message" => 1,
"FOO" => qr"foo$"i => 1,
" FOO" => qr"foo$"i => 1,
"FOO " => qr"foo$"i => 0,
"FOO " => qr"^foo$"i => 0,
" hidden message " => "hidden message" => 1,
" hidden message " => "hidden message" => 0,
];
$cases_2{__match_text} = [
"hidden message" => qr"hidden\s+message" => 1,
"FOO" => qr"foo$"i => 1,
" FOO" => qr"foo$"i => 1,
"FOO " => qr"foo$"i => 0,
"FOO " => qr"^foo$"i => 0,
" hidden message " => "hidden message" => 1,
" hidden message " => "hidden message" => 0,
];
$cases_2{__match_declaration} = [
"hidden message" => qr"hidden\s+message" => 1,
"FOO" => qr"foo$"i => 1,
" FOO" => qr"foo$"i => 1,
"FOO " => qr"foo$"i => 0,
"FOO " => qr"^foo$"i => 0,
" hidden message " => "hidden message" => 1,
" hidden message " => "hidden message" => 0,
];
$cases_3{__match} = [
{href => 'http://www.perl.com', alt =>"foo"},{}, "href" => 0,
{href => 'http://www.perl.com', alt =>"foo"},{}, "alt" => 0,
{href => 'http://www.perl.com', alt =>undef},{alt => "boo"}, "alt" => 0,
{href => undef, alt =>"foo"},{href => 'http://www.perl.com'}, "href" => 0,
{href => 'http://www.perl.com', alt =>"foo"},{href => 'www.perl.com'}, "href" => 0,
{href => 'http://www.perl.com', alt =>"foo"},{href => '.', alt => "foo"}, "href" => 0,
{href => 'http://www.perl.com', alt =>"foo"},{href => 'http://www.perl.com'}, "href" => 1,
{href => qr'www\.perl\.com'},{href => 'http://www.perl.com', alt =>"foo"}, "href" => 1,
{href => qr'.', alt => "foo"},{href => 'http://www.perl.com', alt =>"foo"}, "href" => 1,
];
$count = (18 + 24 + 12);
$count += (@{$cases_2{$_}} / 3) for (keys %cases_2);
$count += (@{$cases_3{$_}} / 4) for (keys %cases_3);
};
sub run_case {
my ($count,$methods) = @_;
my $method;
for $method (sort keys %$methods) {
my @cases = @{$methods->{$method}};
while (@cases) {
my (@params) = splice @cases, 0, $count;
my $outcome = pop @params;
my ($visual);
($visual = $method) =~ tr/_/ /;
$visual =~ s/^\s*(.*?)\s*$/$1/;
no strict 'refs';
cmp_ok("Test::HTML::Content::$method"->(@params), '==',$outcome,"$visual(". join( "=~",@params ).")");
};
};
};
sub run {
run_case( 3, \%cases_2 );
run_case( 4, \%cases_3 );
my ($count,$seen);
($count,$seen) = Test::HTML::Content::__count_tags->("foo","a",{href => "http://www.perl.com"});
is($count, 0,"Counting tags 1");
is(@$seen, 0,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("Perl","a",{href => "http://www.perl.com"});
is($count, 0,"Counting tags 2");
is(@$seen, 1,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("Perl","a",{href => "http://www.perl.com"});
is($count, 0,"Counting tags 3");
is(@$seen, 0,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("Perl","a",{href => "http://www.perl.com"});
is($count, 0,"Counting tags 4");
is(@$seen, 0,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("Perl","a",{href => "http://www.perl.com"});
is($count, 1,"Counting tags 6");
is(@$seen, 1,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("Perl","a",{href => "http://www.perl.com"});
is($count, 1,"Counting tags 7");
is(@$seen, 1,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("PerlPerl","a",{href => "http://www.perl.com", alt => undef});
is($count, 1,"Counting tags 8");
is(@$seen, 2,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("PerlPerl","a",{href => "http://www.perl.com"});
is($count, 2,"Counting tags 9");
is(@$seen, 2,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_tags->("PerlPerl
","a",{href => "http://www.perl.com"});
is($count, 2,"Counting tags 10");
is(@$seen, 2,"Checking possible candidates");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,0,"Counting comments 0");
is(@$seen,0,"Counting possible candidates 0");
($count,$seen) = Test::HTML::Content::__count_comments( "foo" => "foo" );
is($count,0,"Counting comments 1");
is(@$seen,0,"Counting possible candidates 1");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,1,"Counting comments 2");
is(@$seen,1,"Counting possible candidates 2");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,0,"Counting comments 3");
is(@$seen,1,"Counting possible candidates 3");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,0,"Counting comments 4");
is(@$seen,1,"Counting possible candidates 4");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,0,"Counting comments 5");
is(@$seen,1,"Counting possible candidates 5");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo " );
is($count,1,"Counting comments 6");
is(@$seen,1,"Counting possible candidates 6");
($count,$seen) = Test::HTML::Content::__count_comments( "" => qr"foo" );
is($count,1,"Counting comments 7");
is(@$seen,1,"Counting possible candidates 7");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,1,"Counting comments 8");
is(@$seen,1,"Counting possible candidates 8");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,2,"Counting comments 9");
is(@$seen,2,"Counting possible candidates 9");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,3,"Counting comments 10");
is(@$seen,3,"Counting possible candidates 10");
($count,$seen) = Test::HTML::Content::__count_comments( "" => "foo" );
is($count,2,"Counting comments 11");
is(@$seen,3,"Counting possible candidates 11");
($count,$seen) = Test::HTML::Content::__count_text( "" => "foo" );
is($count,0,"Counting text occurrences 0");
is(@$seen,0,"Counting possible candidates 0");
($count,$seen) = Test::HTML::Content::__count_text( "foo" => "foo" );
is($count,1,"counting text occurrences 1");
is(@$seen,1,"Counting possible candidates 1");
($count,$seen) = Test::HTML::Content::__count_text( "" => "foo" );
is($count,0,"counting text occurrences 2");
is(@$seen,0,"Counting possible candidates 2");
# This test disabled, as it is not consistent between XPath and NoXPath...
#($count,$seen) = Test::HTML::Content::__count_text( "
" => "foo" );
#is($count,0,"counting text occurrences 3");
#is(@$seen,2,"Counting possible candidates 3");
($count,$seen) = Test::HTML::Content::__count_text( "foo bar" => "foo" );
is($count,1,"counting text occurrences 4");
is(@$seen,2,"Counting possible candidates 4");
($count,$seen) = Test::HTML::Content::__count_text( "foo" => "foo" );
is($count,0,"counting text occurrences 5");
is(@$seen,3,"Counting possible candidates 5");
($count,$seen) = Test::HTML::Content::__count_text( "Hello foo World" => qr"foo" );
is($count,1,"Checking RE for text 6");
is(@$seen,1,"Counting possible candidates 6");
};
runtests( $count, \&run );
Test-HTML-Content-0.08/t/03-links.t 0000755 0001750 0001750 00000001460 07770273227 016107 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use lib 't';
use testlib;
sub run {
# Tests for links
no_link('','http://www.perl.com', "Simple non-existing link");
no_link('http://www.perl.com',"http://www.perl.com", "Plain text gets not interpreted as link");
link_ok('Title',"http://www.perl.com", "A link is found");
link_count('IconTitle',"http://www.perl.com", 2,"A link that appears twice is reported twice");
link_ok('Mail me at
some address',
'corion@somewhere.else', "Links are not found if commented out");
};
runtests(5,\&run); Test-HTML-Content-0.08/t/13-xpath-gracefull-errors.t 0000755 0001750 0001750 00000002042 07770273227 021365 0 ustar corion corion # Test script to test the failure modes of Test::HTML::Content
use Test::More;
use lib 't';
use testlib;
eval {
require Test::Builder::Tester;
Test::Builder::Tester->import;
};
if ($@) {
plan skip_all => "Test::Builder::Tester required for testing error messages";
}
sub run {
use_ok('Test::HTML::Content');
SKIP: {
{ no warnings 'once';
$Test::HTML::Content::can_xpath
or skip "XML::XPath or XML::LibXML required", 2;
};
my ($tree,$result,$seen);
eval {
($result,$seen) = Test::HTML::Content::__count_comments("", "hidden message");
};
is($@,'',"Invalid HTML does not crash the test");
eval {
($tree) = Test::HTML::Content::__get_node_tree("",'//comment()');
};
is($@,'',"Invalid HTML does not crash the test");
# is($tree,undef,"The result of __get_node_tree is undef");
}
};
runtests( 3, \&run); Test-HTML-Content-0.08/t/01-fallback-xpath.t 0000755 0001750 0001750 00000001322 07770300065 017632 0 ustar corion corion use strict;
use Test::More tests => 4;
my $HTML = "dot";
SKIP: {
eval {
require Test::Without::Module;
Test::Without::Module->import( 'XML::LibXML' );
};
skip "Need Test::Without::Module to test the fallback", 4
if $@;
use_ok("Test::HTML::Content");
link_ok($HTML,'target',"Finding a link works without XML::LibXML");
my ($result,$args);
eval {
($result,$args) = Test::HTML::Content::__count_tags($HTML,'a',{_content=>'dot'});
};
is($@,'',"Missing prerequisites don't let the tests fail");
ok($result eq 'skip' || $result == 1,'Skipped or passed when XML::LibXML is missing')
or diag "Expected 'skip' or '1', but got '$result'";
};
Test-HTML-Content-0.08/t/99-unix-text.t 0000755 0001750 0001750 00000001424 07770302101 016733 0 ustar corion corion use Test::More;
# Check that all released module files are in
# UNIX text format
use File::Spec;
use File::Find;
use strict;
my @files;
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d $_ } ($blib, 'bin', 't', 'lib'));
plan tests => scalar @files;
foreach my $file (@files) {
unix_file_ok($file);
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
sub unix_file_ok {
my ($filename) = @_;
local $/;
open F, "< $filename"
or die "Couldn't open '$filename' : $!\n";
binmode F;
my $content = ;
my $i;
my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content;
unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) {
diag $_ for @lines;
};
close F;
};
Test-HTML-Content-0.08/t/99-manifest.t 0000755 0001750 0001750 00000001072 07770302101 016573 0 ustar corion corion use strict;
use Test::More;
# Check that MANIFEST and MANIFEST.skip are sane :
use File::Find;
use File::Spec;
my @files = qw( MANIFEST MANIFEST.skip );
plan tests => scalar @files * 4;
for my $file (@files) {
ok(-f $file, "$file exists");
open F, "<$file"
or die "Couldn't open $file : $!";
my @lines = ;
is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file");
is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file");
is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file");
close F;
};
Test-HTML-Content-0.08/t/embedded-Test-HTML-Content.t 0000644 0001750 0001750 00000005046 07774331127 021366 0 ustar corion corion #!D:\perl\5.8.2\bin\perl.exe -w
use Test::More 'no_plan';
package Catch;
sub TIEHANDLE {
my($class, $var) = @_;
return bless { var => $var }, $class;
}
sub PRINT {
my($self) = shift;
${'main::'.$self->{var}} .= join '', @_;
}
sub OPEN {} # XXX Hackery in case the user redirects
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
sub READ {}
sub READLINE {}
sub GETC {}
my $Original_File = 'lib\Test\HTML\Content.pm';
package main;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
tie *STDERR, 'Catch', '_STDERR_' or die $!;
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 598 lib/Test/HTML/Content.pm
$HTML = "A test pageHome page
Perl
";
link_ok($HTML,"http://www.perl.com","We link to Perl");
no_link($HTML,"http://www.pearl.com","We have no embarassing typos");
link_ok($HTML,qr"http://[a-z]+\.perl.com","We have a link to perl.com");
title_count($HTML,1,"We have one title tag");
title_ok($HTML,qr/test/);
tag_ok($HTML,"img", {src => "http://www.perl.com/camel.png"},
"We have an image of a camel on the page");
tag_count($HTML,"img", {src => "http://www.perl.com/camel.png"}, 2,
"In fact, we have exactly two camel images on the page");
no_tag($HTML,"blink",{}, "No annoying blink tags ..." );
# We can check the textual contents
text_ok($HTML,"Perl");
# We can also check the contents of comments
comment_ok($HTML,"Hidden message");
# Advanced stuff
# Using a regular expression to match against
# tag attributes - here checking there are no ugly styles
no_tag($HTML,"p",{ style => qr'ugly$' }, "No ugly styles" );
# REs also can be used for substrings in comments
comment_ok($HTML,qr"[hH]idden\s+mess");
# and if you have XML::LibXML or XML::XPath, you can
# even do XPath queries yourself:
xpath_ok($HTML,'/html/body/p','HTML is somewhat wellformed');
no_xpath($HTML,'/html/head/p','HTML is somewhat wellformed');
;
}
};
is($@, '', "example from line 598");
undef $main::_STDOUT_;
undef $main::_STDERR_;
Test-HTML-Content-0.08/t/08-errors.comment.t 0000755 0001750 0001750 00000006437 07771616401 017756 0 ustar corion corion # Test script to test the failure modes of Test::HTML::Content
use Test::More;
use lib 't';
use testlib;
use vars qw( $Test::HTML::Content::can_xpath );
eval {
require Test::Builder::Tester;
Test::Builder::Tester->import;
};
if ($@) {
plan skip_all => "Test::Builder::Tester required for testing error messages";
}
sub run {
# Test that each exported function fails as documented
test_out("not ok 1 - Comment failure (no comments)");
test_fail(+7);
if ($Test::HTML::Content::can_xpath eq 'XML::LibXML') {
test_diag("Invalid HTML:","");
} else {
test_diag("No comment found at all",
"Expected at least one comment like 'hidden message'",);
};
comment_ok("","hidden message","Comment failure (no comments)");
test_test("Finding no comment works");
test_out("not ok 1 - Comment failure (nonmatching comments)");
test_fail(+9);
#if ($Test::HTML::Content::can_xpath eq 'XML::XPath') {
# test_diag("Invalid HTML:","");
#} else {
test_diag("Saw ''",
"Saw ''",
"Saw ''",
"Expected at least one comment like 'hidden message'");
#};
comment_ok("",
"hidden message","Comment failure (nonmatching comments)");
test_test("Finding no comment returns all other comments");
test_out("not ok 1 - Comment failure (two comments that shouldn't exist do)");
test_fail(+8);
#if ($Test::HTML::Content::can_xpath eq 'XML::XPath') {
# test_diag("Invalid HTML:","");
#} else {
test_diag("Saw ''",
"Saw ''",
"Expected no comment like '(?-xism:hidden m.ssage)'");
#};
no_comment("",
qr"hidden m.ssage","Comment failure (two comments that shouldn't exist do)");
test_test("Finding a comment where none should be returns all comments");
test_out("not ok 1 - Comment failure (too few comments)");
test_fail(+8);
#if ($Test::HTML::Content::can_xpath eq 'XML::XPath') {
# test_diag("Invalid HTML:","");
#} else {
test_diag("Saw ''",
"Saw ''",
"Expected exactly 3 comments like '(?-xism:hidden m.ssage)'");
#};
comment_count("",
qr"hidden m.ssage",3,"Comment failure (too few comments)");
test_test("Diagnosing too few comments works");
test_out("not ok 1 - Comment failure (too few comments)");
test_fail(+8);
#if ($Test::HTML::Content::can_xpath eq 'XML::XPath') {
# test_diag("Invalid HTML:","");
#} else {
test_diag("Saw ''",
"Saw ''",
"Expected exactly 1 comments like '(?-xism:hidden m.ssage)'");
#};
comment_count("",
qr"hidden m.ssage",1,"Comment failure (too few comments)");
test_test("Diagnosing too many comments works");
};
runtests( 5, \&run );
Test-HTML-Content-0.08/t/12-title-fallback.t 0000755 0001750 0001750 00000002521 07646111317 017635 0 ustar corion corion use strict;
use Test::More tests => 1+6*2;
BEGIN {
use_ok( "Test::HTML::Content");
if ($Test::HTML::Content::can_xpath) {
require Test::HTML::Content::NoXPath;
&Test::HTML::Content::NoXPath::install;
};
};
eval {
title_ok('A test title',qr"A test title","Title RE");
};
is( $@, "", "Gracefull title fallback (title_ok)" );
eval {
title_ok('A test title',qr"^A test title$","Anchored title RE");
};
is( $@, "", "Gracefull title fallback (title_ok)" );
eval {
title_ok('A test title',qr"test","Title RE works for partial matches");
};
is( $@, "", "Gracefull title fallback (title_ok)" );
eval {
title_ok('A test title',"A test title","Title string");
};
is( $@, "", "Gracefull title fallback (title_ok)" );
eval {
no_title('A test title',"test","Complete title string gets compared");
};
is( $@, "", "Gracefull title fallback (no_title)" );
eval {
no_title('A test title',"A toast title","no_title string");
};
is( $@, "", "Gracefull title fallback (no_title)" );
Test-HTML-Content-0.08/t/09-errors.xpath.t 0000755 0001750 0001750 00000004452 07774330477 017445 0 ustar corion corion # Test script to test the failure modes of Test::HTML::Content
use Test::More;
BEGIN{
eval {
require Test::Builder::Tester;
Test::Builder::Tester->import;
};
if ($@) {
plan skip_all => "Test::Builder::Tester required for testing error messages";
}
};
BEGIN {
plan tests => 7;
use_ok('Test::HTML::Content');
};
SKIP: {
if (! $Test::HTML::Content::can_xpath) {
skip "Need XPath functionality to test it", 6;
exit;
};
my $HTML = q{Test
1
2
};
test_out("not ok 1 - no XPath results found");
test_fail(+5);
test_diag(q{Got},
q{ },
q{ 1
},
q{ 2
});
xpath_ok($HTML,'//p[@boo]','//p',"no XPath results found");
test_test("Finding no xpath results where some should be outputs the fallback");
test_out("not ok 1 - no XPath results found");
test_fail(+2);
test_diag(q{Got none});
xpath_ok($HTML,'//p[@boo]',"no XPath results found");
test_test("Finding no xpath results (implicit)");
test_out("not ok 1 - no XPath results found");
test_fail(+5);
test_diag(q{Got},
q{ },
q{ 1
},
q{ 2
});
no_xpath($HTML,'//p[@foo]','//p',"no XPath results found");
test_test("Finding xpath results where none should be outputs the fallback");
test_out("not ok 1 - no XPath results found");
test_fail(+5);
test_diag(q{Got},
q{ },
q{ 1
},
q{ 2
});
no_xpath($HTML,'//p',"no XPath results found");
test_test("Finding xpath results (implicit fallback)");
test_out("not ok 1 - no XPath results found");
test_fail(+5);
test_diag(q{Got},
q{ },
q{ 1
},
q{ 2
});
xpath_count($HTML,'//p',4,"no XPath results found");
test_test("Too few hits get reported");
test_out("not ok 1 - no XPath results found");
test_fail(+5);
test_diag(q{Got},
q{ },
q{ 1
},
q{ 2
});
xpath_count($HTML,'//p',2,"no XPath results found");
test_test("Too many hits get reported");
}; Test-HTML-Content-0.08/t/embedded-Test-HTML-Content-NoXPath.t 0000644 0001750 0001750 00000002127 07774331130 022674 0 ustar corion corion #!D:\perl\5.8.2\bin\perl.exe -w
use Test::More 'no_plan';
package Catch;
sub TIEHANDLE {
my($class, $var) = @_;
return bless { var => $var }, $class;
}
sub PRINT {
my($self) = shift;
${'main::'.$self->{var}} .= join '', @_;
}
sub OPEN {} # XXX Hackery in case the user redirects
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
sub READ {}
sub READLINE {}
sub GETC {}
my $Original_File = 'lib\Test\HTML\Content\NoXPath.pm';
package main;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
tie *STDERR, 'Catch', '_STDERR_' or die $!;
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 195 lib/Test/HTML/Content/NoXPath.pm
# This module is implicitly loaded by Test::HTML::Content
# if XML::XPath or HTML::Tidy::Simple are unavailable.
;
}
};
is($@, '', "example from line 195");
undef $main::_STDOUT_;
undef $main::_STDERR_;
Test-HTML-Content-0.08/t/10-errors.text.t 0000755 0001750 0001750 00000001600 07645654053 017261 0 ustar corion corion # Test script to test the failure modes of Test::HTML::Content
use Test::More;
eval {
require Test::Builder::Tester;
Test::Builder::Tester->import;
};
if ($@) {
plan skip_all => "Test::Builder::Tester required for testing error messages";
}
plan tests => 1+1*2;
use_ok('Test::HTML::Content');
# Test that each exported function fails as documented
sub run_tests {
test_out("not ok 1 - Text failure (empty document)");
test_fail(+1);
text_ok("","Perl","Text failure (empty document)");
no warnings 'once';
if ($Test::HTML::Content::can_xpath) {
test_diag( 'Invalid HTML:', "" );
} else {
test_diag( 'No text found at all', "Expected at least one text element like 'Perl'" );
};
test_test("Empty document gets reported");
};
run_tests;
require Test::HTML::Content::NoXPath;
Test::HTML::Content::NoXPath->install;
run_tests; Test-HTML-Content-0.08/t/04-comments.t 0000755 0001750 0001750 00000005134 07770273227 016617 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use lib 't';
use testlib;
sub run {
use_ok('Test::HTML::Content');
# Tests for comments
comment_ok('Mail me at some address',
'(c) 2002 corion@cpan.org', "Comments are found if there");
comment_ok('Mail me at some address',
' (c) 2002 corion@cpan.org', "Whitespace at front");
comment_ok('Mail me at some address',
' (c) 2002 corion@cpan.org ', "Whitespace at front and end");
comment_ok('Mail me at some address',
'(c) 2002 corion@cpan.org ', "Whitespace at end");
comment_ok('Mail me at some address',
'(c) 2002 corion@cpan.org', "Whitespace at HTML front");
comment_ok('Mail me at some address',
'(c) 2002 corion@cpan.org', "Whitespace at HTML end");
comment_ok('Mail me at some address',
qr'corion@cpan.org', "RE over comments");
comment_ok('Mail me at foo some address', 'corion@cpan.org', "Comments are found if there");
comment_count('Mail me at foo some address', 'corion@cpan.org',1, "Comments are found if there");
comment_count('Mail me at foo
some address', 'corion@cpan.org',2, "Comments are counted correctly");
comment_count('Mail me at foo some address', qr'\@cpan\.org',2, "RE-Comments are counted correctly");
no_comment('Mail me at (c) 2002 corion@cpan.org some address',
'(c) 2002 corion@cpan.org', "Comments are not found if not there");
no_comment('Mail me at corion@cpan.org some address',
'corion@cpan.org', "Comments are not found if not there");
no_comment('Mail me at foo some address', qr'\@cpan\.com', "RE-Comments are found correctly");
no_comment('Mail me at foo some address', qr'corion\@[c]pan\.org', "RE-Comments not stringified");
};
runtests( 1+15, \&run );
Test-HTML-Content-0.08/t/05-doctype.t 0000755 0001750 0001750 00000001456 07770273227 016445 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use lib 't';
use testlib;
sub run {
use_ok('Test::HTML::Content');
# Tests for comments
has_declaration('
', 'DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"', "Doctype 3.2");
has_declaration('
', qr'HTML', "Doctype via RE");
has_declaration('
', qr'DOCTYPE.*?HTML 3\.2',"Doctype via other RE");
no_declaration('
', qr'DOCTYPE.*?HtML 3\.2',"Doctype via other RE");
};
# Borked javadoc HTML DOCTYPE ...
#
runtests( 1+4, \&run );
Test-HTML-Content-0.08/t/testlib.pm 0000755 0001750 0001750 00000001603 07771616401 016361 0 ustar corion corion use strict;
use Test::More;
use vars qw(%modules);
BEGIN {
$modules{pureperl} = \&run_pureperl;
eval { require XML::XPath; $XML::XPath::VERSION >= 1.13 and $modules{xpath} = \&run_xpath };
eval { require XML::LibXML; $modules{libxml} = \&run_libxml };
};
sub main::runtests {
my ($count,$code) = @_;
my @candidates = (sort keys %modules);
plan( tests => 1+ $count * scalar @candidates );
use_ok('Test::HTML::Content');
for my $implementation (@candidates) {
my $test = $modules{$implementation};
$test->($count,$code);
};
};
sub run_libxml {
my ($count,$code) = @_;
Test::HTML::Content::install_libxml();
$code->('XML::LibXML');
};
sub run_xpath {
my ($count,$code) = @_;
Test::HTML::Content::install_xpath();
$code->('XML::XPath');
};
sub run_pureperl {
my ($count,$code) = @_;
Test::HTML::Content::install_pureperl();
$code->('PurePerl');
};
1;
Test-HTML-Content-0.08/t/01-fallback-libxml.t 0000755 0001750 0001750 00000001333 07770300065 017777 0 ustar corion corion use strict;
use Test::More tests => 4;
SKIP: {
eval {
require Test::Without::Module;
Test::Without::Module->import( 'XML::XPath' );
};
skip "Need Test::Without::Module to test the fallback", 4
if $@;
use_ok("Test::HTML::Content");
link_ok("dot",'here',"Finding a link works without libxml");
my ($result,$args);
eval { ($result,$args) = Test::HTML::Content::__count_tags("dot",'a',{_content=>'dot'}); };
is($@,'',"Missing prerequisites don't let the tests fail");
ok($result eq 'skip' || $result == 1,'Skipped or passed when XML::XPath is missing')
or diag "Expected 'skip' or '1', but got '$result'";
};
Test-HTML-Content-0.08/t/01-fallback-pureperl.t 0000755 0001750 0001750 00000001316 07770302101 020340 0 ustar corion corion use strict;
use Test::More tests => 4;
SKIP: {
eval {
require Test::Without::Module;
Test::Without::Module->import( 'XML::XPath' );
Test::Without::Module->import( 'XML::LibXML' );
};
skip "Need Test::Without::Module to test the fallback", 4
if $@;
use_ok("Test::HTML::Content");
link_ok("dot",'here',"Finding a link works without xpath");
my ($result,$args);
eval {
($result,$args) = Test::HTML::Content::__count_tags("dot",'a',{_content=>'dot'});
};
is($@,'',"Missing prerequisites don't let the tests fail");
is($result,'skip','Missing prerequisites make the tests skip instead');
};
Test-HTML-Content-0.08/t/00-prerequisites.t 0000755 0001750 0001750 00000000734 07644112322 017657 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More tests => 3;
# TODO:
# * Better prerequisites checking
# * Split up the tests into separate files
# First, check the prerequisites
use_ok('Test::Builder')
or BAILOUT("The tests require Test::Builder");
use_ok('HTML::TokeParser')
or BAILOUT("The tests require HTML::TokeParser");
use_ok('Test::HTML::Content')
or Test::Builder::BAILOUT("The tests require Test::HTML::Content - this shouldn't happen at all");
Test-HTML-Content-0.08/t/02-tags.t 0000755 0001750 0001750 00000012514 07770273227 015726 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use lib 't';
use testlib;
sub run {
# Tests for tags
tag_ok('Title',
"a",{href => "http://www.perl.com" }, "Single attribute");
tag_ok('Title',
"A",{href => "http://www.perl.com" }, "Uppercase query finds lowercase tag");
tag_ok('Title',
"a",{href => "http://www.perl.com" }, "Lowercase query finds uppercase tag");
tag_ok('Title',
"A",{href => "http://www.perl.com" }, "Uppercase query finds uppercase tag");
tag_ok('Title',
"a",{href => "http://www.perl.com" }, "Lowercase query finds lowercase tag");
tag_ok('Title',
"a",{}, "No attributes");
tag_ok('Title',
"a",undef, "Undef attributes");
tag_ok('Title',
"a", "Forgotten attributes");
tag_count('Title',
"a",{href => "http://www.perl.com" },1, "Single attribute gets counted once");
tag_ok('Title',
"a",{href => "http://www.perl.com" }, "Superfluous attributes are ignored");
tag_count('Title',
"a",{href => "http://www.perl.com" }, 1, "Superfluous attributes are ignored and still the matchcount stays");
tag_ok('TitleIcon',
"a",{href => "http://www.perl.com" }, "Tags that appear twice get reported");
tag_count('TitleIcon',
"a",{href => "http://www.perl.com" },2, "Tags that appear twice get reported twice");
no_tag('Title',
"a",{href => "http://www.perl.com" }, "Plain strings get matched exactly");
tag_ok('Title',
"a",{href => qr"^http://.*$" }, "Regular expressions for attributes");
tag_ok('Title',
"a",{href => qr"^http://.*$", name => "Perl" }, "Mixing regular expressions with strings");
tag_ok('Title',
"a",{href => qr"^http://.*$", name => qr"^P.*l$" }, "Specifying more than one RE");
tag_ok('Title',
"a",{href => qr"http://www.pea?rl.com", name => qr"^Pea?rl$" }, "Optional RE");
tag_count('TitleAnother link',
"a",{href => "http://www.perl.com" },2, "Ignored tags");
tag_count('TitleAnother link',
"a",{href => "http://www.perl.com", name => undef },1, "Absent tags");
no_tag('Title',
"a",{href => "http://www.perl.com" }, "Misspelled attribute is not found");
tag_count('Title',
"a",{href => "http://www.perl.com" },0, "Misspelled attribute is reported zero times");
no_tag('Title',
"a",{href => "http://www.perl.com" }, "Tag with same attribute but different tag is not found");
tag_count('Title',
"a",{href => "http://www.perl.com" }, 0,"Tag with same attribute but different tag is reported zero times");
no_tag('Title',
"a",{href => "http://www.perl.com" },"Tag with different attribute value is not found");
tag_count('Title',
"a",{href => "http://www.perl.com" },0,"Tag with different attribute value is reported zero times");
no_tag('',
"a",{href => "http://www.perl.com" }, "Tag within a comment is not found");
tag_count('',
"a",{href => "http://www.perl.com" }, 0, "Tag within a comment is reported zero times");
no_tag('Title',
"a",{href => "http://www.perl.com" }, "Tag within a (different) comment is not found");
tag_count('Title',
"a",{href => "http://www.perl.com" }, 0, "Tag within a (different) comment is reported zero times");
# RE parameters
no_tag('Title',
"a",{href => "http://www.perl.com", name => qr"^Pearl$" }, "Nonmatching via RE");
tag_count('
Nice style
Ugly style
Super-ugly style
',
"p",{style => qr"ugly$" }, 2, "Tag attribute counting");
};
runtests(32,\&run); Test-HTML-Content-0.08/t/99-todo.t 0000755 0001750 0001750 00000001554 07770302101 015737 0 ustar corion corion use Test::More;
use File::Spec;
use File::Find;
use strict;
# Check that all files do not contain any
# lines with "XXX" - such markers should
# either have been converted into Todo-stuff
# or have been resolved.
# The test was provided by Andy Lester.
my @files;
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d $_ } ($blib, 'bin'));
plan tests => scalar @files;
foreach my $file (@files) {
source_file_ok($file);
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
sub source_file_ok {
my $file = shift;
open( my $fh, "<", $file ) or die "Can't open $file: $!";
my @lines = <$fh>;
close $fh;
my $n = 0;
for ( @lines ) {
++$n;
s/^/$file ($n): /;
}
my @x = grep /XXX/, @lines;
if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) {
diag( $_ ) for @x;
}
}
Test-HTML-Content-0.08/Changes 0000755 0001750 0001750 00000003517 11106611123 015372 0 ustar corion corion Revision history for Perl extension Test::HTML::Content.
0.07 20031230
- Fixed test bug reported by Kate Pugh (KAKE):
t/09-errors.xpath.t was missing a SKIP: label
- still no resolution on the other reported errors, as XML::XPath "works"
on my Win32 machine, but dosen't work elsewhere :-(
Most of the failures seem to be failures due to different text output
of the tests:
# #
vs.
# #
but as I can't replicate them here, it's hard to fix those :-(
0.08 20081112
+ Added $parsing_method to allow XML to be tested as well.
0.06 20031222
- Fixed tests against XML::XPath
- added another test testing the internal abstraction
API and differences between XML::XPath and XML::LibXML
0.05 20031204
- Added XPath functionality (xpath_ok, no_xpath, xpath_count)
- Added fallback to old functionality if neither XML::LibXML nor
XML::XPath are available
- refactored code to have less duplication, at the cost of
some functions passed as parameters (this shouldn't bother you,
as it is all hidden)
0.04 lost in the void
0.03 Mon Sep 23 2002
- Fixed Pod (Thanks to Andy Lester)
- Added a test for the synopsis (Thanks to Andy Lester)
- Added a test for Pod consistency (Thanks to Andy Lester and brian d foy)
- Added text_ok(), no_text() and text_count()
- Fixed reporting of errors to the correct level. Errors now
get reported in your test file instead of somewhere within
Content.pm
0.02 Sun Sep 22 2002
- Renamed from Test::HTML to Test::HTML::Content
- Added warnings for the module again, if available
- Fixed inconsistencies between usage of
HTML::Parser v2 and HTML::Parser v3 (as displayed through
HTML::TokeParser)
0.01 Wed Sep 18 13:53:54 2002
- original version; created by h2xs 1.20 with options
-X Test::HTML
Test-HTML-Content-0.08/MANIFEST 0000755 0001750 0001750 00000001346 07770302574 015251 0 ustar corion corion Changes
lib/Test/HTML/Content.pm
lib/Test/HTML/Content/NoXPath.pm
lib/Test/HTML/Content/XPathExtensions.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.skip
META.yml
README
t/00-prerequisites.t
t/01-fallback-libxml.t
t/01-fallback-pureperl.t
t/01-fallback-xpath.t
t/01-internal-api.t
t/01-xpath-query-builder.t
t/02-tags.t
t/03-links.t
t/04-comments.t
t/05-doctype.t
t/06-text.t
t/07-errors.link.t
t/08-errors.comment.t
t/09-errors.declaration.t
t/09-errors.xpath.t
t/10-errors.text.t
t/12-title-fallback.t
t/12-title.t
t/13-xpath-gracefull-errors.t
t/99-manifest.t
t/99-Pod.t
t/99-todo.t
t/99-unix-text.t
t/embedded-Test-HTML-Content-NoXPath.t
t/embedded-Test-HTML-Content-XPathExtensions.t
t/embedded-Test-HTML-Content.t
t/testlib.pm
Test-HTML-Content-0.08/META.yml 0000644 0001750 0001750 00000000705 11106611350 015343 0 ustar corion corion --- #YAML:1.0
name: Test-HTML-Content
version: 0.08
abstract: ~
license: ~
author: ~
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
HTML::TokeParser: 0
Test::Builder: 0
Test::More: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
Test-HTML-Content-0.08/lib/ 0000755 0001750 0001750 00000000000 11106611350 014636 5 ustar corion corion Test-HTML-Content-0.08/lib/Test/ 0000755 0001750 0001750 00000000000 11106611350 015555 5 ustar corion corion Test-HTML-Content-0.08/lib/Test/HTML/ 0000755 0001750 0001750 00000000000 11106611350 016321 5 ustar corion corion Test-HTML-Content-0.08/lib/Test/HTML/Content/ 0000755 0001750 0001750 00000000000 11106611350 017733 5 ustar corion corion Test-HTML-Content-0.08/lib/Test/HTML/Content/NoXPath.pm 0000755 0001750 0001750 00000011623 11106610655 021627 0 ustar corion corion package Test::HTML::Content::NoXPath;
require 5.005_62;
use strict;
use File::Spec;
use HTML::TokeParser;
# we want to stay compatible to 5.5 and use warnings if
# we can
eval 'use warnings;' if ($] >= 5.006);
use vars qw( $HTML_PARSER_StripsTags $VERSION @exports );
$VERSION = '0.08';
BEGIN {
# Check whether HTML::Parser is v3 and delivers the comments starting
# with the ";
my $p = HTML::TokeParser->new(\$HTML);
my ($type,$text) = @{$p->get_token()};
if ($text eq "") {
$HTML_PARSER_StripsTags = 0
} else {
$HTML_PARSER_StripsTags = 1
};
};
# import what we need
{ no strict 'refs';
*{$_} = *{"Test::HTML::Content::$_"}
for qw( __dwim_compare __output_diag __invalid_html );
};
@exports = qw( __match_comment __count_comments __match_text __count_text
__match __count_tags __match_declaration __count_declarations );
sub __match_comment {
my ($text,$template) = @_;
$text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
unless (ref $template eq "Regexp") {
$text =~ s/^\s*(.*?)\s*$/$1/;
$template =~ s/^\s*(.*?)\s*$/$1/;
};
return __dwim_compare($text, $template);
};
sub __count_comments {
my ($HTML,$comment) = @_;
my $result = 0;
my $seen = [];
my $p = HTML::TokeParser->new(\$HTML);
my $token;
while ($token = $p->get_token) {
my ($type,$text) = @$token;
if ($type eq "C") {
push @$seen, $token->[1];
$result++ if __match_comment($text,$comment);
};
};
return ($result, $seen);
};
sub __match_text {
my ($text,$template) = @_;
unless (ref $template eq "Regexp") {
$text =~ s/^\s*(.*?)\s*$/$1/;
$template =~ s/^\s*(.*?)\s*$/$1/;
};
return __dwim_compare($text, $template);
};
sub __count_text {
my ($HTML,$text) = @_;
my $result = 0;
my $seen = [];
my $p = HTML::TokeParser->new(\$HTML);
$p->unbroken_text(1);
my $token;
while ($token = $p->get_token) {
my ($type,$foundtext) = @$token;
if ($type eq "T") {
push @$seen, $token->[1];
$result++ if __match_text($foundtext,$text);
};
};
return $result,$seen;
};
sub __match {
my ($attrs,$currattr,$key) = @_;
my $result = 1;
if (exists $currattr->{$key}) {
if (! defined $attrs->{$key}) {
$result = 0; # We don't want to see this attribute here
} else {
$result = 0 unless __dwim_compare($currattr->{$key}, $attrs->{$key});
};
} else {
if (! defined $attrs->{$key}) {
$result = 0 if (exists $currattr->{$key});
} else {
$result = 0;
};
};
return $result;
};
sub __count_tags {
my ($HTML,$tag,$attrref) = @_;
$attrref = {} unless defined $attrref;
return ('skip','XML::LibXML or XML::XPath not loaded')
if exists $attrref->{_content};
my $result = 0;
$tag = lc $tag;
my $p = HTML::TokeParser->new(\$HTML);
my $token;
my @seen;
while ($token = $p->get_token) {
my ($type,$currtag,$currattr,$attrseq,$origtext) = @$token;
if ($type eq "S" && $tag eq $currtag) {
my (@keys) = keys %$attrref;
my $key;
my $complete = 1;
foreach $key (@keys) {
$complete = __match($attrref,$currattr,$key) if $complete;
};
$result += $complete;
# Now munge the thing to resemble what the XPath variant returns :
push @seen, $token->[4];
};
};
return $result,\@seen;
};
sub __match_declaration {
my ($text,$template) = @_;
$text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
unless (ref $template eq "Regexp") {
$text =~ s/^\s*(.*?)\s*$/$1/;
$template =~ s/^\s*(.*?)\s*$/$1/;
};
return __dwim_compare($text, $template);
};
sub __count_declarations {
my ($HTML,$doctype) = @_;
my $result = 0;
my $seen = [];
my $p = HTML::TokeParser->new(\$HTML);
my $token;
while ($token = $p->get_token) {
my ($type,$text) = @$token;
if ($type eq "D") {
push @$seen, $text;
$result++ if __match_declaration($text,$doctype);
};
};
return $result, $seen;
};
sub import {
goto &install;
};
sub install {
for (@exports) {
no strict 'refs';
*{"Test::HTML::Content::$_"} = *{"Test::HTML::Content::NoXPath::$_"};
};
$Test::HTML::Content::can_xpath = 0;
};
1;
__END__
=head1 NAME
Test::HTML::Content::NoXPath - HTML::TokeParser fallback for Test::HTML::Content
=head1 SYNOPSIS
=for example begin
# This module is implicitly loaded by Test::HTML::Content
# if XML::XPath or HTML::Tidy::Simple are unavailable.
=for example end
=head1 DESCRIPTION
This is the module that gets loaded when Test::HTML::Content
can't find its prerequisites :
XML::XPath
HTML::Tidy
=head2 EXPORT
Nothing. It stomps over the Test::HTML::Content namespace.
=head1 LICENSE
This code may be distributed under the same terms as Perl itself.
=head1 AUTHOR
Max Maischein, corion@cpan.org
=head1 SEE ALSO
L,L,L,L,L
=cut
Test-HTML-Content-0.08/lib/Test/HTML/Content/XPathExtensions.pm 0000755 0001750 0001750 00000003765 11106610665 023423 0 ustar corion corion package Test::HTML::Content::XPathExtensions;
require 5.005_62;
use strict;
use File::Spec;
use HTML::TokeParser;
# we want to stay compatible to 5.5 and use warnings if
# we can
eval 'use warnings;' if ($] >= 5.006);
use vars qw( $HTML_PARSER_StripsTags $VERSION @exports );
$VERSION = '0.08';
@exports = qw( matches comment );
sub matches {
my $self = shift;
my ($node, @params) = @_;
die "starts-with: incorrect number of params\n" unless @params == 2;
my $re = $params[1]->string_value;
return($params[0]->string_value =~ /$re/)
? XML::XPath::Boolean->True
: XML::XPath::Boolean->False;
}
sub comment {
my $self = shift;
my ($node, @params) = @_;
die "starts-with: incorrect number of params\n" unless @params == 1;
my $re = $params[1]->string_value;
return(ref $node =~ /Comment$/)
? XML::XPath::Boolean->True
: XML::XPath::Boolean->False;
};
sub import {
for (@exports) {
no strict 'refs';
# Install our extensions unless they already exist :
*{"XML::XPath::Function::$_"} = *{"Test::HTML::Content::XPathExtensions::$_"}
unless defined *{"XML::XPath::Function::$_"}{CODE};
};
};
1;
__END__
=head1 NAME
Test::HTML::Content::XPathExtensions - Perlish XPath extensions
=head1 SYNOPSIS
=for example begin
# This module patches the XML::XPath::Function namespace
use Test::HTML::Content::XPathExtensions;
=for example end
=head1 DESCRIPTION
This is the module that provides RE support for XML::XPath
and support for matching comments through the two functions
C and C.
The two functions are modeled after what I found on the Saxon
website on the C namespace :
=over 4
=item *
http://saxon.sourceforge.net/saxon7.3.1/functions.html
=item *
http://www.w3.org/TR/xquery-operators/
=back
=head2 EXPORT
Nothing. It stomps over the XML::XPath::Function namespace.
=head1 LICENSE
This code may be distributed under the same terms as Perl itself.
=head1 AUTHOR
Max Maischein, corion@cpan.org
=head1 SEE ALSO
L
=cut
Test-HTML-Content-0.08/lib/Test/HTML/Content.pm 0000755 0001750 0001750 00000047650 11106610636 020316 0 ustar corion corion package Test::HTML::Content;
require 5.005_62;
use strict;
use File::Spec;
use Carp qw(carp croak);
use HTML::TokeParser;
# we want to stay compatible to 5.5 and use warnings if
# we can
eval 'use warnings' if $] >= 5.006;
use Test::Builder;
require Exporter;
use vars qw/@ISA @EXPORT_OK @EXPORT $VERSION $can_xpath/;
@ISA = qw(Exporter);
use vars qw( $tidy );
# DONE:
# * use Test::Builder;
# * Add comment_ok() method
# * Allow RE instead of plain strings in the functions (for tag attributes and comments)
# * Create a function to check the DOCTYPE and other directives
# * Have a better way to diagnose ignored candidates in tag_ok(), tag_count
# and no_tag() in case a test fails
@EXPORT = qw(
link_ok no_link link_count
tag_ok no_tag tag_count
comment_ok no_comment comment_count
has_declaration no_declaration
text_ok no_text text_count
title_ok no_title
xpath_ok no_xpath xpath_count
);
$VERSION = '0.08';
my $Test = Test::Builder->new;
use vars qw($HTML_PARSER_StripsTags $parsing_method);
$parsing_method = 'parse_html_string';
# Cribbed from the Test::Builder synopsis
sub import {
my($self) = shift;
my $pack = caller;
$Test->exported_to($pack);
$Test->plan(@_);
$self->export_to_level(1, $self, @EXPORT);
}
sub __dwim_compare {
# Do the Right Thing (Perl 6 style) with the RHS being a Regex or a string
my ($target,$template) = @_;
if (ref $template) { # supposedly a Regexp, but possibly blessed, so no eq comparision
return ($target =~ $template )
} else {
return $target eq $template;
};
};
sub __node_content {
my $node = shift;
if ($can_xpath eq 'XML::XPath') { return XML::XPath::XMLParser::as_string($node) };
if ($can_xpath eq 'XML::LibXML') { return $node->toString };
};
sub __match_comment {
my ($text,$template) = @_;
$text =~ s/^$/$1/sm unless $HTML_PARSER_StripsTags;
unless (ref $template eq "Regexp") {
$text =~ s/^\s*(.*?)\s*$/$1/;
$template =~ s/^\s*(.*?)\s*$/$1/;
};
return __dwim_compare($text, $template);
};
sub __count_comments {
my ($HTML,$comment) = @_;
my $tree;
$tree = __get_node_tree($HTML,'//comment()');
return (undef,undef) unless ($tree);
my $result = 0;
my @seen;
foreach my $node ($tree->get_nodelist) {
my $content = __node_content($node);
$content =~ s/\A\Z/$1/gsm;
push @seen, $content;
$result++ if __match_comment($content,$comment);
};
$_ = "" for @seen;
return ($result, \@seen);
};
sub __output_diag {
my ($cond,$match,$descr,$kind,$name,$seen) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 2;
unless ($Test->ok($cond,$name)) {
if (@$seen) {
$Test->diag( "Saw '$_'" ) for @$seen;
} else {
$Test->diag( "No $kind found at all" );
};
$Test->diag( "Expected $descr like '$match'" );
};
};
sub __invalid_html {
my ($HTML,$name) = @_;
carp "No test name given" unless $name;
$Test->ok(0,$name);
$Test->diag( "Invalid HTML:");
$Test->diag($HTML);
};
sub __output_comment {
my ($check,$expectation,$HTML,$comment,$name) = @_;
my ($result,$seen) = __count_comments($HTML,$comment);
if (defined $result) {
$result = $check->($result);
__output_diag($result,$comment,$expectation,"comment",$name,$seen);
} else {
local $Test::Builder::Level = $Test::Builder::Level +2;
__invalid_html($HTML,$name);
};
$result;
};
sub comment_ok {
my ($HTML,$comment,$name) = @_;
__output_comment(sub{shift},"at least one comment",$HTML,$comment,$name);
};
sub no_comment {
my ($HTML,$comment,$name) = @_;
__output_comment(sub{shift == 0},"no comment",$HTML,$comment,$name);
};
sub comment_count {
my ($HTML,$comment,$count,$name) = @_;
__output_comment(sub{shift == $count},"exactly $count comments",$HTML,$comment,$name);
};
sub __match_text {
my ($text,$template) = @_;
unless (ref $template eq "Regexp") {
$text =~ s/^\s*(.*?)\s*$/$1/;
$template =~ s/^\s*(.*?)\s*$/$1/;
};
return __dwim_compare($text, $template);
};
sub __count_text {
my ($HTML,$text) = @_;
my $tree = __get_node_tree($HTML,'//text()');
return (undef,undef) unless $tree;
my $result = 0;
my @seen;
foreach my $node ($tree->get_nodelist) {
my $content = __node_content($node);
push @seen, $content
unless $content =~ /\A\r?\n?\Z/sm;
$result++ if __match_text($content,$text);
};
return ($result, \@seen);
};
sub __output_text {
my ($check,$expectation,$HTML,$text,$name) = @_;
my ($result,$seen) = __count_text($HTML,$text);
if (defined $result) {
local $Test::Builder::Level = $Test::Builder::Level;
$result = $check->($result);
__output_diag($result,$text,$expectation,"text",$name,$seen);
} else {
local $Test::Builder::Level = $Test::Builder::Level +2;
__invalid_html($HTML,$name);
};
$result;
};
sub text_ok {
my ($HTML,$text,$name) = @_;
__output_text(sub{shift > 0}, "at least one text element",$HTML,$text,$name);
};
sub no_text {
my ($HTML,$text,$name) = @_;
__output_text(sub{shift == 0}, "no text elements",$HTML,$text,$name);
};
sub text_count {
my ($HTML,$text,$count,$name) = @_;
__output_text(sub{shift == $count}, "exactly $count elements",$HTML,$text,$name);
};
sub __match {
my ($attrs,$currattr,$key) = @_;
my $result = 1;
if (exists $currattr->{$key}) {
if (! defined $attrs->{$key}) {
$result = 0; # We don't want to see this attribute here
} else {
$result = 0 unless __dwim_compare($currattr->{$key}, $attrs->{$key});
};
} else {
if (! defined $attrs->{$key}) {
$result = 0 if (exists $currattr->{$key});
} else {
$result = 0;
};
};
return $result;
};
sub __get_node_tree {
my ($HTML,$query) = @_;
croak "No HTML given" unless defined $HTML;
croak "No query given" unless defined $query;
my ($tree,$find,$result);
if ($HTML !~ m!\A\s*\Z!ms) {
eval {
require XML::LibXML; XML::LibXML->import;
my $parser = XML::LibXML->new();
$parser->recover(1);
$tree = $parser->$parsing_method($HTML);
$find = 'findnodes';
$HTML_PARSER_StripsTags = 1;
};
unless ($tree) {
eval {
require XML::XPath; XML::XPath->import;
require XML::Parser;
my $p = XML::Parser->new( ErrorContext => 2, ParseParamEnt => 0, NoLWP => 1 );
$tree = XML::XPath->new( parser => $p, xml => $HTML );
$find = 'find';
};
};
undef $tree if $@;
if ($tree) {
eval {
$result = $tree->$find($query);
unless ($result) {
$result = {};
bless $result, 'Test::HTML::Content::EmptyXPathResult';
};
};
warn $@ if $@;
};
} else { };
return $result;
};
sub __get_node_content {
my ($node,$name) = @_;
if ($name eq '_content') {
return $node->textContent()
} else {
return $node->getAttribute($name)
};
};
sub __build_xpath_query {
my ($query,$attrref) = @_;
my @postvalidation;
if ($attrref) {
my @query;
for (sort keys %$attrref) {
my $name = $_;
my $value = $attrref->{$name};
my $xpath_name = '@' . $name;
if ($name eq '_content') { $xpath_name = "text()" };
if (! defined $value) {
push @query, "not($xpath_name)"
} elsif ((ref $value) ne 'Regexp') {
push @query, "$xpath_name = \"$value\"";
push @postvalidation, sub {
return __get_node_content( shift,$name ) eq $value
};
} else {
push @query, "$xpath_name";
push @postvalidation, sub {
return __get_node_content( shift,$name ) =~ $value
};
};
};
$query .= "[" . join( " and ", map {"$_"} @query ) . "]"
if @query;
};
my $postvalidation = sub {
my $node = shift;
my $test;
for $test (@postvalidation) {
return () unless $test->($node);
};
return 1;
};
($query,$postvalidation);
};
sub __count_tags {
my ($HTML,$tag,$attrref) = @_;
$attrref = {} unless defined $attrref;
my $fallback = lc "//$tag";
my ($query,$valid) = __build_xpath_query( lc "//$tag", $attrref );
my $tree = __get_node_tree($HTML,$query);
return (undef,undef) unless $tree;
my @found = grep { $valid->($_) } ($tree->get_nodelist);
# Collect the nodes we did see for later reference :
my @seen;
foreach my $node (__get_node_tree($HTML,$fallback)->get_nodelist) {
push @seen, __node_content($node);
};
return scalar(@found),\@seen;
};
sub __tag_diag {
my ($tag,$num,$attrs,$found) = @_;
my $phrase = "Expected to find $num <$tag> tag(s)";
$phrase .= " matching" if (scalar keys %$attrs > 0);
$Test->diag($phrase);
$Test->diag(" $_ = " . (defined $attrs->{$_} ? $attrs->{$_} : ''))
for sort keys %$attrs;
if (@$found) {
$Test->diag("Got");
$Test->diag(" " . $_) for @$found;
} else {
$Test->diag("Got none");
};
};
sub __output_tag {
my ($check,$expectation,$HTML,$tag,$attrref,$name) = @_;
($attrref,$name) = ({},$attrref)
unless defined $name;
$attrref = {}
unless defined $attrref;
croak "$attrref dosen't look like a hash reference for the attributes"
unless ref $attrref eq 'HASH';
my ($currcount,$seen) = __count_tags($HTML,$tag,$attrref);
my $result;
if (defined $currcount) {
if ($currcount eq 'skip') {
$Test->skip($seen);
} else {
local $Test::Builder::Level = $Test::Builder::Level +1;
$result = $check->($currcount);
unless ($Test->ok($result, $name)) {
__tag_diag($tag,$expectation,$attrref,$seen) ;
};
};
} else {
local $Test::Builder::Level = $Test::Builder::Level +2;
__invalid_html($HTML,$name);
};
$result;
};
sub tag_count {
my ($HTML,$tag,$attrref,$count,$name) = @_;
__output_tag(sub { shift == $count }, "exactly $count",$HTML,$tag,$attrref,$name);
};
sub tag_ok {
my ($HTML,$tag,$attrref,$name) = @_;
__output_tag(sub { shift > 0 }, "at least one",$HTML,$tag,$attrref,$name);
};
sub no_tag {
my ($HTML,$tag,$attrref,$name) = @_;
__output_tag(sub { shift == 0 }, "no",$HTML,$tag,$attrref,$name);
};
sub link_count {
my ($HTML,$link,$count,$name) = @_;
local $Test::Builder::Level = 2;
return tag_count($HTML,"a",{href => $link},$count,$name);
};
sub link_ok {
my ($HTML,$link,$name) = (@_);
local $Test::Builder::Level = 2;
return tag_ok($HTML,'a',{ href => $link },$name);
};
sub no_link {
my ($HTML,$link,$name) = (@_);
local $Test::Builder::Level = 2;
return no_tag($HTML,'a',{ href => $link },$name);
};
sub title_ok {
my ($HTML,$title,$name) = @_;
local $Test::Builder::Level = 2;
return tag_ok($HTML,"title",{_content => $title},$name);
};
sub no_title {
my ($HTML,$title,$name) = (@_);
local $Test::Builder::Level = 2;
return no_tag($HTML,'title',{ _content => $title },$name);
};
sub __match_declaration {
my ($text,$template) = @_;
$text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
unless (ref $template eq "Regexp") {
$text =~ s/^\s*(.*?)\s*$/$1/;
$template =~ s/^\s*(.*?)\s*$/$1/;
};
return __dwim_compare($text, $template);
};
sub __count_declarations {
my ($HTML,$doctype) = @_;
my $result = 0;
my $seen = [];
my $p = HTML::TokeParser->new(\$HTML);
my $token;
while ($token = $p->get_token) {
my ($type,$text) = @$token;
if ($type eq "D") {
push @$seen, $text;
$result++ if __match_declaration($text,$doctype);
};
};
return $result, $seen;
};
sub has_declaration {
my ($HTML,$declaration,$name) = @_;
my ($result,$seen) = __count_declarations($HTML,$declaration);
if (defined $result) {
__output_diag($result == 1,$declaration,"exactly one declaration","declaration",$name,$seen);
} else {
local $Test::Builder::Level = $Test::Builder::Level +1;
__invalid_html($HTML,$name);
};
$result;
};
sub no_declaration {
my ($HTML,$declaration,$name) = @_;
my ($result,$seen) = __count_declarations($HTML,$declaration);
if (defined $result) {
__output_diag($result == 0,$declaration,"no declaration","declaration",$name,$seen);
} else {
local $Test::Builder::Level = $Test::Builder::Level +1;
__invalid_html($HTML,$name);
};
$result;
};
sub __count_xpath {
my ($HTML,$query,$fallback) = @_;
$fallback = $query unless defined $fallback;
my $tree = __get_node_tree($HTML,$query);
return (undef,undef) unless $tree;
my @found = ($tree->get_nodelist);
# Collect the nodes we did see for later reference :
my @seen;
foreach my $node (__get_node_tree($HTML,$fallback)->get_nodelist) {
push @seen, __node_content($node);
};
return scalar(@found),\@seen;
};
sub __xpath_diag {
my ($query,$num,$found) = @_;
my $phrase = "Expected to find $num nodes matching on '$query'";
if (@$found) {
$Test->diag("Got");
$Test->diag(" $_") for @$found;
} else {
$Test->diag("Got none");
};
};
sub __output_xpath {
my ($check,$expectation,$HTML,$query,$fallback,$name) = @_;
($fallback,$name) = ($query,$fallback) unless $name;
my ($currcount,$seen) = __count_xpath($HTML,$query,$fallback);
my $result;
if (defined $currcount) {
if ($currcount eq 'skip') {
$Test->skip($seen);
} else {
local $Test::Builder::Level = $Test::Builder::Level +1;
$result = $check->($currcount);
unless ($Test->ok($result, $name)) {
__xpath_diag($query,$expectation,$seen) ;
};
};
} else {
local $Test::Builder::Level = $Test::Builder::Level +1;
__invalid_html($HTML,$name);
};
$result;
};
sub xpath_count {
my ($HTML,$query,$count,$fallback,$name) = @_;
__output_xpath( sub {shift == $count},"exactly $count",$HTML,$query,$fallback,$name);
};
sub xpath_ok {
my ($HTML,$query,$fallback,$name) = @_;
__output_xpath( sub{shift > 0},"at least one",$HTML,$query,$fallback,$name);
};
sub no_xpath {
my ($HTML,$query,$fallback,$name) = @_;
__output_xpath( sub{shift == 0},"no",$HTML,$query,$fallback,$name);
};
sub install_xpath {
require XML::XPath;
XML::XPath->import();
die "Need XML::XPath 1.13 or higher"
unless $XML::XPath::VERSION >= 1.13;
$can_xpath = 'XML::XPath';
};
sub install_libxml {
local $^W;
require XML::LibXML;
XML::LibXML->import();
$can_xpath = 'XML::LibXML';
};
# And install our plain handlers if we have to :
sub install_pureperl {
require Test::HTML::Content::NoXPath;
Test::HTML::Content::NoXPath->import;
};
BEGIN {
# Load the XML-variant if our prerequisites are there :
eval { install_libxml }
or eval { install_xpath }
or install_pureperl;
};
{
package Test::HTML::Content::EmptyXPathResult;
sub size { 0 };
sub get_nodelist { () };
};
1;
__END__
=head1 NAME
Test::HTML::Content - Perl extension for testing HTML output
=head1 SYNOPSIS
use Test::HTML::Content( tests => 13 );
=for example begin
$HTML = "A test pageHome page
Perl
";
link_ok($HTML,"http://www.perl.com","We link to Perl");
no_link($HTML,"http://www.pearl.com","We have no embarassing typos");
link_ok($HTML,qr"http://[a-z]+\.perl.com","We have a link to perl.com");
title_count($HTML,1,"We have one title tag");
title_ok($HTML,qr/test/);
tag_ok($HTML,"img", {src => "http://www.perl.com/camel.png"},
"We have an image of a camel on the page");
tag_count($HTML,"img", {src => "http://www.perl.com/camel.png"}, 2,
"In fact, we have exactly two camel images on the page");
no_tag($HTML,"blink",{}, "No annoying blink tags ..." );
# We can check the textual contents
text_ok($HTML,"Perl");
# We can also check the contents of comments
comment_ok($HTML,"Hidden message");
# Advanced stuff
# Using a regular expression to match against
# tag attributes - here checking there are no ugly styles
no_tag($HTML,"p",{ style => qr'ugly$' }, "No ugly styles" );
# REs also can be used for substrings in comments
comment_ok($HTML,qr"[hH]idden\s+mess");
# and if you have XML::LibXML or XML::XPath, you can
# even do XPath queries yourself:
xpath_ok($HTML,'/html/body/p','HTML is somewhat wellformed');
no_xpath($HTML,'/html/head/p','HTML is somewhat wellformed');
=for example end
=head1 DESCRIPTION
This is a module to test the HTML output of your programs in simple
test scripts. It can test a scalar (presumably containing HTML) for
the presence (or absence, or a specific number) of tags having (or
lacking) specific attributes. Unspecified attributes are ignored,
and the attribute values can be specified as either scalars (meaning
a match succeeds if the strings are identical) or regular expressions
(meaning that a match succeeds if the actual attribute value is matched
by the given RE) or undef (meaning that the attribute must not
be present).
If you want to specify or test the deeper structure
of the HTML (for example, META tags within the BODY) or the (textual)
content of tags, you will have to resort to C,C
and C, which take an XPath expression. If you find yourself crafting
very complex XPath expression to verify the structure of your output, it is
time to rethink your testing process and maybe use a template based solution
or simply compare against prefabricated files as a whole.
The used HTML parser is HTML::TokeParser, the used XPath module
is XML::XPath or XML::LibXML. XML::XPath needs valid xHTML, XML::LibXML
will try its best to force your code into xHTML, but it is best to
supply valid xHTML (snippets) to the test functions.
If no XPath parsers/interpreters are available, the tests will automatically
skip, so your users won't need to install XML::XPath or XML::LibXML. The module
then falls back onto a crude implementation of the core functions for tags,
links, comments and text, and the diagnostic output of the tests varies a bit.
The test functionality is derived from L, and the export
behaviour is the same. When you use Test::HTML::Content, a set of
HTML testing functions is exported into the namespace of the caller.
=head2 EXPORT
Exports the bunch of test functions :
link_ok() no_link() link_count()
tag_ok() no_tag() tag_count()
text_ok no_text() text_count()
comment_ok() no_comment() comment_count()
xpath_ok() no_xpath() xpath_count()
has_declaration() no_declaration()
=head2 CONSIDERATIONS
The module reparses the HTML string every time a test function is called.
This will make running many tests over the same, large HTML stream relatively
slow. A possible speedup could be simple minded caching mechanism that keeps the most
recent HTML stream in a cache.
=head2 CAVEATS
The test output differs between XPath and HTML parsing, because XML::XPath
delivers the complete node including the content, where my HTML parser only
delivers the start tag. So don't make your tests depend on the _exact_
output of my tests. It was a pain to do so in my test scripts for this module
and if you really want to, take a look at the included test scripts.
The title functions C and C rely on the XPath functionality
and will thus skip if XPath functionality is unavailable.
=head2 BUGS
Currently, if there is text split up by comments, the text will be seen
as two separate entities, so the following dosen't work :
is_text( "Hello World", "Hello World" );
Whether this is a real bug or not, I don't know at the moment - most likely,
I'll modify text_ok() and siblings to ignore embedded comments.
=head2 TODO
My things on the todo list for this module. Patches are welcome !
=over 4
=item * Refactor the code to fold some of the internal routines
=item * Implement a cache for the last parsed tree / token sequence
=item * Possibly diag() the row/line number for failing tests
=item * Allow RE instead of plain strings in the functions (for tags themselves). This
one is most likely useless.
=back
=head1 LICENSE
This code may be distributed under the same terms as Perl itself.
=head1 AUTHOR
Max Maischein Ecorion@cpan.orgE
=head1 SEE ALSO
perl(1), L,L,L.
=cut
Test-HTML-Content-0.08/MANIFEST.skip 0000755 0001750 0001750 00000000324 07770301463 016205 0 ustar corion corion ^blib/
^Makefile$
^Makefile\.old$
^pm_to_blib$
^\.lwpcookies$
CVS/.*
,v$
^tmp/
\.old$
\.bak$
~$
^#
\.shar$
\.tar$
\.tgz$
\.tar\.gz$
\.zip$
_uu$
\.cvsignore$
^\.releaserc$
^Test-HTML-Content-.*/
.*\.db$
^cvstest$
Test-HTML-Content-0.08/Makefile.PL 0000755 0001750 0001750 00000001234 11106611335 016050 0 ustar corion corion use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Test::HTML::Content',
'VERSION_FROM' => 'lib/Test/HTML/Content.pm', # finds $VERSION
'PREREQ_PM' => {
'Test::Builder' => 0.0,
'Test::More' => 0.0,
'HTML::TokeParser' => 0.0}, # e.g., Module::Name => 1.1
);
use vars qw($have_test_inline);
BEGIN {
eval { require Test::Inline;
$have_test_inline = 1 };
undef $@;
if (! $have_test_inline) {
print "Test::Inline is nice for testing the examples, but not necessary\n"
};
};
1;
Test-HTML-Content-0.08/README 0000755 0001750 0001750 00000001165 07644112322 014765 0 ustar corion corion Test::HTML::Content version 0.04
=========================
This module provides an easy way to test elements of
generated HTML. It is intended for tests of templating
systems or generally generated HTML.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
HTML::TokeParser to parse the HTML
Test::Builder to implement test functionality
COPYRIGHT AND LICENCE
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Copyright (C) 2002 Max Maischein, corion@cpan.org