Test-HTML-Content-0.09/ 0000755 0001750 0001750 00000000000 12104524130 014067 5 ustar corion corion Test-HTML-Content-0.09/MANIFEST.skip 0000755 0001750 0001750 00000000345 12104524073 016200 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$
^MYMETA.*
^.git/
Test-HTML-Content-0.09/MANIFEST 0000755 0001750 0001750 00000001654 12104524130 015231 0 ustar corion corion .gitignore
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-libxml-xpath-abstraction.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-changes.t
t/99-manifest.t
t/99-Pod.t
t/99-todo.t
t/99-unix-text.t
t/99-versions.t
t/embedded-Test-HTML-Content-NoXPath.t
t/embedded-Test-HTML-Content-XPathExtensions.t
t/embedded-Test-HTML-Content.t
t/testlib.pm
META.json Module JSON meta-data (added by MakeMaker)
Test-HTML-Content-0.09/Changes 0000755 0001750 0001750 00000004241 12104524073 015374 0 ustar corion corion Revision history for Perl extension Test::HTML::Content.
0.09 20130206
- Apply patch from RT 70099, by gregor herrmann and dom
This fixes bugs in the test suite
and RT 70099
- Apply patch from RT 42072 by gyles19@visi.com
This fixes the crash when using XML::XPath instead of XML::LibXML
0.08 20081112
???
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.09/README 0000755 0001750 0001750 00000001172 12104524073 014761 0 ustar corion corion Test::HTML::Content version 0.09
=========================
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-2013 Max Maischein, corion@cpan.org Test-HTML-Content-0.09/Makefile.PL 0000755 0001750 0001750 00000001234 12104521166 016052 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.09/.gitignore 0000644 0001750 0001750 00000000341 12104524023 016056 0 ustar corion corion Thumbs.db
_Inline
ccv-src/
out.png
blib/
*.bak
Makefile
Makefile.old
pm_to_blib
CCV.def
CCV.inl
CCV.c
*.bs
*.old
*.o
dll.base
dll.exp
.releaserc
Test-HTML-Content-*.tar
Test-HTML-Content-*.tar.gz
Test-HTML-Content-*/
MYMETA.* Test-HTML-Content-0.09/META.yml 0000644 0001750 0001750 00000000747 12104524130 015350 0 ustar corion corion ---
abstract: unknown
author:
- unknown
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Test-HTML-Content
no_index:
directory:
- t
- inc
requires:
HTML::TokeParser: 0
Test::Builder: 0
Test::More: 0
version: 0.09
Test-HTML-Content-0.09/META.json 0000644 0001750 0001750 00000001603 12104524130 015510 0 ustar corion corion {
"abstract" : "unknown",
"author" : [
"unknown"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Test-HTML-Content",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : 0
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : 0
}
},
"runtime" : {
"requires" : {
"HTML::TokeParser" : 0,
"Test::Builder" : 0,
"Test::More" : 0
}
}
},
"release_status" : "stable",
"version" : "0.09"
}
Test-HTML-Content-0.09/t/ 0000755 0001750 0001750 00000000000 12104524130 014332 5 ustar corion corion Test-HTML-Content-0.09/t/08-errors.comment.t 0000755 0001750 0001750 00000006651 12104524073 017742 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";
}
# perldelta 5.14
# Accept both old and new-style stringification
my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? "^" : "-xism";
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 '(?$modifiers: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 '(?$modifiers: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 '(?$modifiers: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.09/t/13-xpath-gracefull-errors.t 0000755 0001750 0001750 00000002042 12104521166 021347 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.09/t/99-versions.t 0000644 0001750 0001750 00000002422 12104524023 016627 0 ustar corion corion #!perl -w
# Stolen from ChrisDolan on use.perl.org
# http://use.perl.org/comments.pl?sid=29264&cid=44309
use warnings;
use strict;
use File::Find;
use Test::More;
BEGIN {
eval 'use File::Slurp; 1';
if ($@) {
plan skip_all => "File::Slurp needed for testing";
exit 0;
};
};
plan 'no_plan';
my $last_version = undef;
sub check {
return if (! m{blib/script/}xms && ! m{\.pm \z}xms);
my $content = read_file($_);
# only look at perl scripts, not sh scripts
return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms);
my @version_lines = $content =~ m/ ( [^\n]* \$VERSION \s* = [^=] [^\n]* ) /gxms;
if (@version_lines == 0) {
fail($_);
}
for my $line (@version_lines) {
$line =~ s/^\s+//;
$line =~ s/\s+$//;
if (!defined $last_version) {
$last_version = shift @version_lines;
diag "Checking for $last_version";
pass($_);
} else {
is($line, $last_version, $_);
}
}
}
find({wanted => \&check, no_chdir => 1}, 'blib');
if (! defined $last_version) {
fail('Failed to find any files with $VERSION');
}
Test-HTML-Content-0.09/t/99-changes.t 0000644 0001750 0001750 00000001273 12104524023 016372 0 ustar corion corion #!perl -w
use warnings;
use strict;
use File::Find;
use Test::More tests => 2;
=head1 PURPOSE
This test ensures that the Changes file
mentions the current version and that a
release date is mentioned as well
=cut
my $module = 'Test::HTML::Content';
(my $file = $module) =~ s!::!/!g;
require "$file.pm";
my $version = sprintf '%0.2f', $module->VERSION;
diag "Checking for version " . $version;
my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> };
ok $changes =~ /^(.*$version.*)$/m, "We find version $version";
my $changes_line = $1;
ok $changes_line =~ /$version\s+20\d{6}/, "We find a release date on the same line"
or diag $changes_line;
Test-HTML-Content-0.09/t/03-links.t 0000755 0001750 0001750 00000001460 12104521166 016071 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.09/t/99-Pod.t 0000755 0001750 0001750 00000001235 12104521166 015512 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.09/t/00-prerequisites.t 0000755 0001750 0001750 00000000734 12104521166 017655 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.09/t/12-title-fallback.t 0000755 0001750 0001750 00000002521 12104521166 017626 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.09/t/embedded-Test-HTML-Content-XPathExtensions.t 0000644 0001750 0001750 00000002127 12104521166 024451 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.09/t/06-text.t 0000755 0001750 0001750 00000020304 12104521166 015736 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.09/t/01-internal-api.t 0000755 0001750 0001750 00000022203 12104521166 017330 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.09/t/99-todo.t 0000755 0001750 0001750 00000001554 12104521166 015741 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.09/t/99-unix-text.t 0000755 0001750 0001750 00000001424 12104521166 016735 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.09/t/05-doctype.t 0000755 0001750 0001750 00000001456 12104521166 016427 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.09/t/testlib.pm 0000755 0001750 0001750 00000001603 12104521166 016347 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.09/t/02-tags.t 0000755 0001750 0001750 00000012514 12104521166 015710 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.09/t/12-title.t 0000755 0001750 0001750 00000001651 12104521166 016074 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.09/t/embedded-Test-HTML-Content.t 0000644 0001750 0001750 00000005046 12104521166 021352 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.09/t/01-fallback-xpath.t 0000755 0001750 0001750 00000001322 12104521166 017625 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.09/t/01-xpath-query-builder.t 0000755 0001750 0001750 00000001717 12104521166 020667 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.09/t/embedded-Test-HTML-Content-NoXPath.t 0000644 0001750 0001750 00000002127 12104521166 022666 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.09/t/01-libxml-xpath-abstraction.t 0000755 0001750 0001750 00000001437 12104521166 021673 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More;
use lib 't';
use testlib;
# This test file tests the abstraction
# of XML::LibXML and XML::XPath nodes
my $HTML = 'test';
sub run {
my ($implementation) = @_;
SKIP: {
skip "Tests irrelevant for pure Perl implementation", 4
if $implementation eq 'PurePerl';
use_ok('Test::HTML::Content');
my $tree = Test::HTML::Content::__get_node_tree($HTML, '/html/body');
isn't( $tree, undef, "Got body node");
foreach my $node ($tree->get_nodelist) {
is( Test::HTML::Content::__get_node_content($node,'onload'), 'foo()', 'onload attribute');
is( Test::HTML::Content::__get_node_content($node,'_content'), 'test','_content pseudo attribute');
};
};
};
runtests( 4,\&run );
Test-HTML-Content-0.09/t/01-fallback-libxml.t 0000755 0001750 0001750 00000001333 12104521166 017772 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.09/t/99-manifest.t 0000755 0001750 0001750 00000001072 12104521166 016575 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.09/t/07-errors.link.t 0000755 0001750 0001750 00000010466 12104524073 017233 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";
}
};
# perldelta 5.14
# Accept both old and new-style stringification
my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? "^" : "-xism";
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 = (?$modifiers:.)",
"Got",
' foo',
' Home');
} else {
test_diag("Expected to find no tag(s) matching",
" href = (?$modifiers:.)",
"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 = (?$modifiers:.)",
"Got",
' foo',
' Home');
} else {
test_diag("Expected to find exactly 3 tag(s) matching",
" href = (?$modifiers:.)",
"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 = (?$modifiers:.)",
"Got",
' bar',
' .',
' foo',
' Home');
} else {
test_diag("Expected to find exactly 3 tag(s) matching",
" href = (?$modifiers:.)",
"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.09/t/09-errors.xpath.t 0000755 0001750 0001750 00000004452 12104521166 017422 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.09/t/10-errors.text.t 0000755 0001750 0001750 00000001600 12104521166 017242 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.09/t/01-fallback-pureperl.t 0000755 0001750 0001750 00000001316 12104521166 020342 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.09/t/04-comments.t 0000755 0001750 0001750 00000005134 12104521166 016601 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.09/t/09-errors.declaration.t 0000755 0001750 0001750 00000000566 12104521166 020565 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.09/lib/ 0000755 0001750 0001750 00000000000 12104524130 014635 5 ustar corion corion Test-HTML-Content-0.09/lib/Test/ 0000755 0001750 0001750 00000000000 12104524130 015554 5 ustar corion corion Test-HTML-Content-0.09/lib/Test/HTML/ 0000755 0001750 0001750 00000000000 12104524130 016320 5 ustar corion corion Test-HTML-Content-0.09/lib/Test/HTML/Content.pm 0000755 0001750 0001750 00000050174 12104524073 020310 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.09';
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 __text_content {
my $node = shift;
if ($can_xpath eq 'XML::XPath') { return $node->string_value };
if ($can_xpath eq 'XML::LibXML') { return $node->textContent };
}
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 __text_content( $node )
# 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.09/lib/Test/HTML/Content/ 0000755 0001750 0001750 00000000000 12104524130 017732 5 ustar corion corion Test-HTML-Content-0.09/lib/Test/HTML/Content/XPathExtensions.pm 0000755 0001750 0001750 00000003765 12104524073 023420 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.09';
@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.09/lib/Test/HTML/Content/NoXPath.pm 0000755 0001750 0001750 00000011623 12104524073 021625 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.09';
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