Microsoft (R) Program Maintenance Utility Version 7.00.8882
Copyright (C) Microsoft Corp 1988-2000. All rights reserved.
C:\cpanrun-5.8\build\5-8-0\bin\perl.exe "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib\lib', 'blib\arch')" 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\00-prerequisites..............................1..3
ok 1 - use Test::Builder;
ok 2 - use HTML::TokeParser;
ok 3 - use Test::HTML::Content;
ok
t\01-fallback-libxml............................1..4
XML/XPath.pm did not return a true value at C:\cpanrun-5.8\depot\main\contrib-patched\perl\CPAN\src\Test-HTML-Content\blib\lib/Test/HTML/Content.pm line 552.
ok 1 - use Test::HTML::Content;
ok 2 - Finding a link works without libxml
ok 3 - Missing prerequisites don't let the tests fail
ok 4 - Skipped or passed when XML::XPath is missing
ok
t\01-fallback-pureperl..........................1..4
XML/XPath.pm did not return a true value at C:\cpanrun-5.8\depot\main\contrib-patched\perl\CPAN\src\Test-HTML-Content\blib\lib/Test/HTML/Content.pm line 552.
XML/XPath.pm did not return a true value at C:\cpanrun-5.8\depot\main\contrib-patched\perl\CPAN\src\Test-HTML-Content\blib\lib/Test/HTML/Content.pm line 552.
ok 1 - use Test::HTML::Content;
ok 2 - Finding a link works without xpath
ok 3 - Missing prerequisites don't let the tests fail
ok 4 - Missing prerequisites make the tests skip instead
ok
t\01-fallback-xpath.............................1..4
ok 1 - use Test::HTML::Content;
ok 2 - Finding a link works without XML::LibXML
# Failed test (t\01-fallback-xpath.t at line 20)
# got: 'No such method textContent in XML::XPath::Node::ElementImpl at C:\cpanrun-5.8\depot\main\contrib-patched\perl\CPAN\src\Test-HTML-Content\blib\lib/Test/HTML/Content.pm line 277
# '
# expected: ''
not ok 3 - Missing prerequisites don't let the tests fail
# Failed test (t\01-fallback-xpath.t at line 21)
# Expected 'skip' or '1', but got ''
not ok 4 - Skipped or passed when XML::LibXML is missing
# Looks like you failed 2 tests of 4.
dubious
Test returned status 2 (wstat 512, 0x200)
DIED. FAILED tests 3-4
Failed 2/4 tests, 50.00% okay
t\01-internal-api...............................1..197
ok 1 - use Test::HTML::Content;
ok 2 - dwim compare(foo=~bar)
ok 3 - dwim compare(foo=~...)
ok 4 - dwim compare(bar=~foo)
ok 5 - dwim compare(bar=~barra)
ok 6 - dwim compare(barra=~bar)
ok 7 - dwim compare(foo=~(?-xism:bar))
ok 8 - dwim compare(foo=~(?-xism:...))
ok 9 - dwim compare(bar=~(?-xism:foo))
ok 10 - dwim compare(bar=~(?-xism:barra))
ok 11 - dwim compare(barra=~(?-xism:bar))
ok 12 - dwim compare(foo=~(?-xism:^oo))
ok 13 - dwim compare(foo=~(?-xism:oo$))
ok 14 - dwim compare(FOO=~(?-xism:foo$))
ok 15 - dwim compare(FOO=~(?i-xsm:foo$))
ok 16 - match comment(hidden message=~(?-xism:hidden\s+message))
ok 17 - match comment(FOO=~(?i-xsm:foo$))
ok 18 - match comment( FOO=~(?i-xsm:foo$))
ok 19 - match comment(FOO =~(?i-xsm:foo$))
ok 20 - match comment(FOO =~(?i-xsm:^foo$))
ok 21 - match comment( hidden message =~hidden message)
ok 22 - match comment( hidden message =~hidden message)
ok 23 - match declaration(hidden message=~(?-xism:hidden\s+message))
ok 24 - match declaration(FOO=~(?i-xsm:foo$))
ok 25 - match declaration( FOO=~(?i-xsm:foo$))
ok 26 - match declaration(FOO =~(?i-xsm:foo$))
ok 27 - match declaration(FOO =~(?i-xsm:^foo$))
ok 28 - match declaration( hidden message =~hidden message)
ok 29 - match declaration( hidden message =~hidden message)
ok 30 - match text(hidden message=~(?-xism:hidden\s+message))
ok 31 - match text(FOO=~(?i-xsm:foo$))
ok 32 - match text( FOO=~(?i-xsm:foo$))
ok 33 - match text(FOO =~(?i-xsm:foo$))
ok 34 - match text(FOO =~(?i-xsm:^foo$))
ok 35 - match text( hidden message =~hidden message)
ok 36 - match text( hidden message =~hidden message)
ok 37 - match(HASH(0x1f391d4)=~HASH(0x1f3b408)=~href)
ok 38 - match(HASH(0x1f3b540)=~HASH(0x1f3b570)=~alt)
ok 39 - match(HASH(0x1f3b588)=~HASH(0x1f3b5b8)=~alt)
ok 40 - match(HASH(0x1f3b5dc)=~HASH(0x1f3b60c)=~href)
ok 41 - match(HASH(0x1f3b630)=~HASH(0x1f3b660)=~href)
ok 42 - match(HASH(0x1f3b684)=~HASH(0x1f3b6b4)=~href)
ok 43 - match(HASH(0x1f3b6e4)=~HASH(0x1f3b714)=~href)
ok 44 - match(HASH(0x1f3b750)=~HASH(0x1f3b774)=~href)
ok 45 - match(HASH(0x1f3c978)=~HASH(0x1f3c9a8)=~href)
ok 46 - Counting tags 1
ok 47 - Checking possible candidates
ok 48 - Counting tags 2
ok 49 - Checking possible candidates
ok 50 - Counting tags 3
ok 51 - Checking possible candidates
ok 52 - Counting tags 4
ok 53 - Checking possible candidates
ok 54 - Counting tags 6
ok 55 - Checking possible candidates
ok 56 - Counting tags 7
ok 57 - Checking possible candidates
ok 58 - Counting tags 8
ok 59 - Checking possible candidates
ok 60 - Counting tags 9
ok 61 - Checking possible candidates
ok 62 - Counting tags 10
ok 63 - Checking possible candidates
ok 64 - Counting comments 0
ok 65 - Counting possible candidates 0
ok 66 - Counting comments 1
ok 67 - Counting possible candidates 1
ok 68 - Counting comments 2
ok 69 - Counting possible candidates 2
ok 70 - Counting comments 3
ok 71 - Counting possible candidates 3
ok 72 - Counting comments 4
ok 73 - Counting possible candidates 4
ok 74 - Counting comments 5
ok 75 - Counting possible candidates 5
ok 76 - Counting comments 6
ok 77 - Counting possible candidates 6
ok 78 - Counting comments 7
ok 79 - Counting possible candidates 7
ok 80 - Counting comments 8
ok 81 - Counting possible candidates 8
ok 82 - Counting comments 9
ok 83 - Counting possible candidates 9
ok 84 - Counting comments 10
ok 85 - Counting possible candidates 10
ok 86 - Counting comments 11
ok 87 - Counting possible candidates 11
ok 88 - Counting text occurrences 0
ok 89 - Counting possible candidates 0
ok 90 - counting text occurrences 1
ok 91 - Counting possible candidates 1
ok 92 - counting text occurrences 2
ok 93 - Counting possible candidates 2
ok 94 - counting text occurrences 4
ok 95 - Counting possible candidates 4
ok 96 - counting text occurrences 5
ok 97 - Counting possible candidates 5
ok 98 - Checking RE for text 6
ok 99 - Counting possible candidates 6
ok 100 - dwim compare(foo=~bar)
ok 101 - dwim compare(foo=~...)
ok 102 - dwim compare(bar=~foo)
ok 103 - dwim compare(bar=~barra)
ok 104 - dwim compare(barra=~bar)
ok 105 - dwim compare(foo=~(?-xism:bar))
ok 106 - dwim compare(foo=~(?-xism:...))
ok 107 - dwim compare(bar=~(?-xism:foo))
ok 108 - dwim compare(bar=~(?-xism:barra))
ok 109 - dwim compare(barra=~(?-xism:bar))
ok 110 - dwim compare(foo=~(?-xism:^oo))
ok 111 - dwim compare(foo=~(?-xism:oo$))
ok 112 - dwim compare(FOO=~(?-xism:foo$))
ok 113 - dwim compare(FOO=~(?i-xsm:foo$))
ok 114 - match comment(hidden message=~(?-xism:hidden\s+message))
ok 115 - match comment(FOO=~(?i-xsm:foo$))
ok 116 - match comment( FOO=~(?i-xsm:foo$))
ok 117 - match comment(FOO =~(?i-xsm:foo$))
ok 118 - match comment(FOO =~(?i-xsm:^foo$))
ok 119 - match comment( hidden message =~hidden message)
ok 120 - match comment( hidden message =~hidden message)
ok 121 - match declaration(hidden message=~(?-xism:hidden\s+message))
ok 122 - match declaration(FOO=~(?i-xsm:foo$))
ok 123 - match declaration( FOO=~(?i-xsm:foo$))
ok 124 - match declaration(FOO =~(?i-xsm:foo$))
ok 125 - match declaration(FOO =~(?i-xsm:^foo$))
ok 126 - match declaration( hidden message =~hidden message)
ok 127 - match declaration( hidden message =~hidden message)
ok 128 - match text(hidden message=~(?-xism:hidden\s+message))
ok 129 - match text(FOO=~(?i-xsm:foo$))
ok 130 - match text( FOO=~(?i-xsm:foo$))
ok 131 - match text(FOO =~(?i-xsm:foo$))
ok 132 - match text(FOO =~(?i-xsm:^foo$))
ok 133 - match text( hidden message =~hidden message)
ok 134 - match text( hidden message =~hidden message)
ok 135 - match(HASH(0x1f391d4)=~HASH(0x1f3b408)=~href)
ok 136 - match(HASH(0x1f3b540)=~HASH(0x1f3b570)=~alt)
ok 137 - match(HASH(0x1f3b588)=~HASH(0x1f3b5b8)=~alt)
ok 138 - match(HASH(0x1f3b5dc)=~HASH(0x1f3b60c)=~href)
ok 139 - match(HASH(0x1f3b630)=~HASH(0x1f3b660)=~href)
ok 140 - match(HASH(0x1f3b684)=~HASH(0x1f3b6b4)=~href)
ok 141 - match(HASH(0x1f3b6e4)=~HASH(0x1f3b714)=~href)
ok 142 - match(HASH(0x1f3b750)=~HASH(0x1f3b774)=~href)
ok 143 - match(HASH(0x1f3c978)=~HASH(0x1f3c9a8)=~href)
ok 144 - Counting tags 1
ok 145 - Checking possible candidates
ok 146 - Counting tags 2
ok 147 - Checking possible candidates
ok 148 - Counting tags 3
ok 149 - Checking possible candidates
ok 150 - Counting tags 4
ok 151 - Checking possible candidates
ok 152 - Counting tags 6
ok 153 - Checking possible candidates
ok 154 - Counting tags 7
ok 155 - Checking possible candidates
ok 156 - Counting tags 8
ok 157 - Checking possible candidates
ok 158 - Counting tags 9
ok 159 - Checking possible candidates
ok 160 - Counting tags 10
ok 161 - Checking possible candidates
ok 162 - Counting comments 0
ok 163 - Counting possible candidates 0
ok 164 - Counting comments 1
ok 165 - Counting possible candidates 1
ok 166 - Counting comments 2
ok 167 - Counting possible candidates 2
ok 168 - Counting comments 3
ok 169 - Counting possible candidates 3
ok 170 - Counting comments 4
ok 171 - Counting possible candidates 4
ok 172 - Counting comments 5
ok 173 - Counting possible candidates 5
ok 174 - Counting comments 6
ok 175 - Counting possible candidates 6
ok 176 - Counting comments 7
ok 177 - Counting possible candidates 7
ok 178 - Counting comments 8
ok 179 - Counting possible candidates 8
ok 180 - Counting comments 9
ok 181 - Counting possible candidates 9
ok 182 - Counting comments 10
ok 183 - Counting possible candidates 10
ok 184 - Counting comments 11
ok 185 - Counting possible candidates 11
ok 186 - Counting text occurrences 0
ok 187 - Counting possible candidates 0
ok 188 - counting text occurrences 1
ok 189 - Counting possible candidates 1
ok 190 - counting text occurrences 2
ok 191 - Counting possible candidates 2
ok 192 - counting text occurrences 4
ok 193 - Counting possible candidates 4
ok 194 - counting text occurrences 5
ok 195 - Counting possible candidates 5
ok 196 - Checking RE for text 6
ok 197 - Counting possible candidates 6
ok
t\01-xpath-query-builder........................1..9
ok 1 - use Test::HTML::Content;
ok 2 - //tag[@alt = "foo" and @href = "http://www.perl.com"]
ok 3 - //tag[@alt = "foo" and @href]
ok 4 - //tag[not(@alt) and @href]
ok 5 - //tag2[not(@alt) and @href]
ok 6 - //tag[@alt = "foo" and @href = "http://www.perl.com"]
ok 7 - //tag[@alt = "foo" and @href]
ok 8 - //tag[not(@alt) and @href]
ok 9 - //tag2[not(@alt) and @href]
ok
t\02-tags.......................................1..65
ok 1 - use Test::HTML::Content;
ok 2 - Single attribute
ok 3 - Uppercase query finds lowercase tag
ok 4 - Lowercase query finds uppercase tag
ok 5 - Uppercase query finds uppercase tag
ok 6 - Lowercase query finds lowercase tag
ok 7 - No attributes
ok 8 - Undef attributes
ok 9 - Forgotten attributes
ok 10 - Single attribute gets counted once
ok 11 - Superfluous attributes are ignored
ok 12 - Superfluous attributes are ignored and still the matchcount stays
ok 13 - Tags that appear twice get reported
ok 14 - Tags that appear twice get reported twice
ok 15 - Plain strings get matched exactly
ok 16 - Regular expressions for attributes
ok 17 - Mixing regular expressions with strings
ok 18 - Specifying more than one RE
ok 19 - Optional RE
ok 20 - Ignored tags
ok 21 - Absent tags
ok 22 - Misspelled attribute is not found
ok 23 - Misspelled attribute is reported zero times
ok 24 - Tag with same attribute but different tag is not found
ok 25 - Tag with same attribute but different tag is reported zero times
ok 26 - Tag with different attribute value is not found
ok 27 - Tag with different attribute value is reported zero times
ok 28 - Tag within a comment is not found
ok 29 - Tag within a comment is reported zero times
ok 30 - Tag within a (different) comment is not found
ok 31 - Tag within a (different) comment is reported zero times
ok 32 - Nonmatching via RE
ok 33 - Tag attribute counting
ok 34 - Single attribute
ok 35 - Uppercase query finds lowercase tag
ok 36 - Lowercase query finds uppercase tag
ok 37 - Uppercase query finds uppercase tag
ok 38 - Lowercase query finds lowercase tag
ok 39 - No attributes
ok 40 - Undef attributes
ok 41 - Forgotten attributes
ok 42 - Single attribute gets counted once
ok 43 - Superfluous attributes are ignored
ok 44 - Superfluous attributes are ignored and still the matchcount stays
ok 45 - Tags that appear twice get reported
ok 46 - Tags that appear twice get reported twice
ok 47 - Plain strings get matched exactly
ok 48 - Regular expressions for attributes
ok 49 - Mixing regular expressions with strings
ok 50 - Specifying more than one RE
ok 51 - Optional RE
ok 52 - Ignored tags
ok 53 - Absent tags
ok 54 - Misspelled attribute is not found
ok 55 - Misspelled attribute is reported zero times
ok 56 - Tag with same attribute but different tag is not found
ok 57 - Tag with same attribute but different tag is reported zero times
ok 58 - Tag with different attribute value is not found
ok 59 - Tag with different attribute value is reported zero times
ok 60 - Tag within a comment is not found
ok 61 - Tag within a comment is reported zero times
ok 62 - Tag within a (different) comment is not found
ok 63 - Tag within a (different) comment is reported zero times
ok 64 - Nonmatching via RE
ok 65 - Tag attribute counting
ok
t\03-links......................................1..11
ok 1 - use Test::HTML::Content;
ok 2 - Simple non-existing link
ok 3 - Plain text gets not interpreted as link
ok 4 - A link is found
ok 5 - A link that appears twice is reported twice
ok 6 - Links are not found if commented out
ok 7 - Simple non-existing link
ok 8 - Plain text gets not interpreted as link
ok 9 - A link is found
ok 10 - A link that appears twice is reported twice
ok 11 - Links are not found if commented out
ok
t\04-comments...................................1..33
ok 1 - use Test::HTML::Content;
ok 2 - use Test::HTML::Content;
ok 3 - Comments are found if there
ok 4 - Whitespace at front
ok 5 - Whitespace at front and end
ok 6 - Whitespace at end
ok 7 - Whitespace at HTML front
ok 8 - Whitespace at HTML end
ok 9 - RE over comments
ok 10 - Comments are found if there
ok 11 - Comments are found if there
ok 12 - Comments are counted correctly
ok 13 - RE-Comments are counted correctly
ok 14 - Comments are not found if not there
ok 15 - Comments are not found if not there
ok 16 - RE-Comments are found correctly
ok 17 - RE-Comments not stringified
ok 18 - use Test::HTML::Content;
ok 19 - Comments are found if there
ok 20 - Whitespace at front
ok 21 - Whitespace at front and end
ok 22 - Whitespace at end
ok 23 - Whitespace at HTML front
ok 24 - Whitespace at HTML end
ok 25 - RE over comments
ok 26 - Comments are found if there
ok 27 - Comments are found if there
ok 28 - Comments are counted correctly
ok 29 - RE-Comments are counted correctly
ok 30 - Comments are not found if not there
ok 31 - Comments are not found if not there
ok 32 - RE-Comments are found correctly
ok 33 - RE-Comments not stringified
ok
t\05-doctype....................................1..11
ok 1 - use Test::HTML::Content;
ok 2 - use Test::HTML::Content;
ok 3 - Doctype 3.2
ok 4 - Doctype via RE
ok 5 - Doctype via other RE
ok 6 - Doctype via other RE
ok 7 - use Test::HTML::Content;
ok 8 - Doctype 3.2
ok 9 - Doctype via RE
ok 10 - Doctype via other RE
ok 11 - Doctype via other RE
ok
t\06-text.......................................1..23
ok 1 - use Test::HTML::Content;
ok 2 - REs for text work
ok 3 - Counting text elements works
ok 4 - Negation works as well
ok 5 - Negation also works with REs
ok 6 - Complete elements are matched
ok 7 - Complete elements are matched with whitespace at the ends
ok 8 - Counting elements works with REs
ok 9 - Counting elements works with REs
ok 10 - No stringification of REs in no_text()
ok 11 - No stringification of REs in text_count()
ok 12 - Text is not broken up
ok 13 - REs for text work
ok 14 - Counting text elements works
ok 15 - Negation works as well
ok 16 - Negation also works with REs
ok 17 - Complete elements are matched
ok 18 - Complete elements are matched with whitespace at the ends
ok 19 - Counting elements works with REs
ok 20 - Counting elements works with REs
ok 21 - No stringification of REs in no_text()
ok 22 - No stringification of REs in text_count()
ok 23 - Text is not broken up
ok
t\07-errors.link................................1..11
ok 1 - use Test::HTML::Content;
ok 2 - Finding no link works
ok 3 - Finding no link returns all other links
ok 4 - Finding a link where one should be returns all other links
ok 5 - Diagnosing too few links works
ok 6 - Diagnosing too many links works
ok 7 - Finding no link works
ok 8 - Finding no link returns all other links
ok 9 - Finding a link where one should be returns all other links
ok 10 - Diagnosing too few links works
ok 11 - Diagnosing too many links works
ok
t\08-errors.comment.............................1..11
ok 1 - use Test::HTML::Content;
ok 2 - Finding no comment works
ok 3 - Finding no comment returns all other comments
ok 4 - Finding a comment where none should be returns all comments
ok 5 - Diagnosing too few comments works
ok 6 - Diagnosing too many comments works
ok 7 - Finding no comment works
ok 8 - Finding no comment returns all other comments
ok 9 - Finding a comment where none should be returns all comments
ok 10 - Diagnosing too few comments works
ok 11 - Diagnosing too many comments works
ok
t\09-errors.declaration.........................1..1
ok 1 - use Test::HTML::Content;
ok
t\09-errors.xpath...............................1..7
ok 1 - use Test::HTML::Content;
# Failed test (t\09-errors.xpath.t at line 42)
# STDERR is:
# # Failed test (t\09-errors.xpath.t at line 41)
# # Got
# #
# # 1
# # 2
#
# not:
# # Failed test (t\09-errors.xpath.t at line 41)
# # Got
# #
# # 1
# # 2
#
# as expected
not ok 2 - Finding no xpath results where some should be outputs the fallback
ok 3 - Finding no xpath results (implicit)
# Failed test (t\09-errors.xpath.t at line 57)
# STDERR is:
# # Failed test (t\09-errors.xpath.t at line 56)
# # Got
# #
# # 1
# # 2
#
# not:
# # Failed test (t\09-errors.xpath.t at line 56)
# # Got
# #
# # 1
# # 2
#
# as expected
not ok 4 - Finding xpath results where none should be outputs the fallback
# Failed test (t\09-errors.xpath.t at line 66)
# STDERR is:
# # Failed test (t\09-errors.xpath.t at line 65)
# # Got
# #
# # 1
# # 2
#
# not:
# # Failed test (t\09-errors.xpath.t at line 65)
# # Got
# #
# # 1
# # 2
#
# as expected
not ok 5 - Finding xpath results (implicit fallback)
# Failed test (t\09-errors.xpath.t at line 75)
# STDERR is:
# # Failed test (t\09-errors.xpath.t at line 74)
# # Got
# #
# # 1
# # 2
#
# not:
# # Failed test (t\09-errors.xpath.t at line 74)
# # Got
# #
# # 1
# # 2
#
# as expected
not ok 6 - Too few hits get reported
# Failed test (t\09-errors.xpath.t at line 84)
# STDERR is:
# # Failed test (t\09-errors.xpath.t at line 83)
# # Got
# #
# # 1
# # 2
#
# not:
# # Failed test (t\09-errors.xpath.t at line 83)
# # Got
# #
# # 1
# # 2
#
# as expected
not ok 7 - Too many hits get reported
FAILED tests 2, 4-7
Failed 5/7 tests, 28.57% okay
t\10-errors.text................................1..3
ok 1 - use Test::HTML::Content;
ok 2 - Empty document gets reported
ok 3 - Empty document gets reported
ok
t\12-title-fallback.............................1..13
ok 1 - use Test::HTML::Content;
ok 2 # skip XML::LibXML or XML::XPath not loaded
ok 3 - Gracefull title fallback (title_ok)
ok 4 # skip XML::LibXML or XML::XPath not loaded
ok 5 - Gracefull title fallback (title_ok)
ok 6 # skip XML::LibXML or XML::XPath not loaded
ok 7 - Gracefull title fallback (title_ok)
ok 8 # skip XML::LibXML or XML::XPath not loaded
ok 9 - Gracefull title fallback (title_ok)
ok 10 # skip XML::LibXML or XML::XPath not loaded
ok 11 - Gracefull title fallback (no_title)
ok 12 # skip XML::LibXML or XML::XPath not loaded
ok 13 - Gracefull title fallback (no_title)
ok
6/13 skipped: XML::LibXML or XML::XPath not loaded
t\12-title......................................1..7
ok 1 - use Test::HTML::Content;
No such method textContent in XML::XPath::Node::ElementImpl at C:\cpanrun-5.8\depot\main\contrib-patched\perl\CPAN\src\Test-HTML-Content\blib\lib/Test/HTML/Content.pm line 277
# Looks like you planned 7 tests but only ran 1.
# Looks like your test died just after 1.
dubious
Test returned status 255 (wstat 65280, 0xff00)
DIED. FAILED tests 2-7
Failed 6/7 tests, 14.29% okay
t\13-xpath-gracefull-errors.....................1..7
ok 1 - use Test::HTML::Content;
ok 2 - use Test::HTML::Content;
ok 3 # skip XML::XPath or XML::LibXML required
ok 4 # skip XML::XPath or XML::LibXML required
ok 5 - use Test::HTML::Content;
ok 6 - Invalid HTML does not crash the test
no element found at line 1, column 69, byte 69:
====================================================================^
at C:/cpanrun-5.8/build/5-8-0/site/lib/XML/Parser.pm line 185
ok 7 - Invalid HTML does not crash the test
ok
2/7 skipped: various reasons
t\99-manifest...................................1..8
ok 1 - MANIFEST exists
ok 2 - No empty lines in MANIFEST
ok 3 - No whitespace-only lines in MANIFEST
ok 4 - No trailing whitespace on lines in MANIFEST
ok 5 - MANIFEST.skip exists
ok 6 - No empty lines in MANIFEST.skip
ok 7 - No whitespace-only lines in MANIFEST.skip
ok 8 - No trailing whitespace on lines in MANIFEST.skip
ok
t\99-Pod........................................1..3
ok 1 - POD test for blib\lib/Test/HTML/Content.pm
ok 2 - POD test for blib\lib/Test/HTML/Content/NoXPath.pm
ok 3 - POD test for blib\lib/Test/HTML/Content/XPathExtensions.pm
ok
t\99-todo.......................................1..3
ok 1 - Looking for XXXes in blib\lib/Test/HTML/Content.pm
ok 2 - Looking for XXXes in blib\lib/Test/HTML/Content/NoXPath.pm
ok 3 - Looking for XXXes in blib\lib/Test/HTML/Content/XPathExtensions.pm
ok
t\99-unix-text..................................1..7
# Failed test (t\99-unix-text.t at line 34)
# got: '742'
# expected: '0'
not ok 1 - 'blib\lib/Test/HTML/Content.pm' contains no windows newlines
# 0: package Test::HTML::Content;
# 1:
# 2: require 5.005_62;
# 3: use strict;
# 4: use File::Spec;
# 5: use Carp qw(carp croak);
# 6:
# 7: use HTML::TokeParser;
# 8:
# 9: # we want to stay compatible to 5.5 and use warnings if
# 10: # we can
# 11: eval 'use warnings' if $] >= 5.006;
# 12: use Test::Builder;
# 13: require Exporter;
# 14:
# 15: use vars qw/@ISA @EXPORT_OK @EXPORT $VERSION $can_xpath/;
# 16:
# 17: @ISA = qw(Exporter);
# 18:
# 19: use vars qw( $tidy );
# 20:
# 21: # DONE:
# 22: # * use Test::Builder;
# 23: # * Add comment_ok() method
# 24: # * Allow RE instead of plain strings in the functions (for tag attributes and comments)
# 25: # * Create a function to check the DOCTYPE and other directives
# 26: # * Have a better way to diagnose ignored candidates in tag_ok(), tag_count
# 27: # and no_tag() in case a test fails
# 28:
# 29: @EXPORT = qw(
# 30: link_ok no_link link_count
# 31: tag_ok no_tag tag_count
# 32: comment_ok no_comment comment_count
# 33: has_declaration no_declaration
# 34: text_ok no_text text_count
# 35: title_ok no_title
# 36: xpath_ok no_xpath xpath_count
# 37: );
# 38:
# 39: $VERSION = '0.07';
# 40:
# 41: my $Test = Test::Builder->new;
# 42:
# 43: use vars qw($HTML_PARSER_StripsTags);
# 44:
# 45: # Cribbed from the Test::Builder synopsis
# 46: sub import {
# 47: my($self) = shift;
# 48: my $pack = caller;
# 49: $Test->exported_to($pack);
# 50: $Test->plan(@_);
# 51: $self->export_to_level(1, $self, @EXPORT);
# 52: }
# 53:
# 54: sub __dwim_compare {
# 55: # Do the Right Thing (Perl 6 style) with the RHS being a Regex or a string
# 56: my ($target,$template) = @_;
# 57: if (ref $template) { # supposedly a Regexp, but possibly blessed, so no eq comparision
# 58: return ($target =~ $template )
# 59: } else {
# 60: return $target eq $template;
# 61: };
# 62: };
# 63:
# 64: sub __node_content {
# 65: my $node = shift;
# 66: if ($can_xpath eq 'XML::XPath') { return XML::XPath::XMLParser::as_string($node) };
# 67: if ($can_xpath eq 'XML::LibXML') { return $node->toString };
# 68: };
# 69:
# 70: sub __match_comment {
# 71: my ($text,$template) = @_;
# 72: $text =~ s/^$/$1/sm unless $HTML_PARSER_StripsTags;
# 73: unless (ref $template eq "Regexp") {
# 74: $text =~ s/^\s*(.*?)\s*$/$1/;
# 75: $template =~ s/^\s*(.*?)\s*$/$1/;
# 76: };
# 77: return __dwim_compare($text, $template);
# 78: };
# 79:
# 80: sub __count_comments {
# 81: my ($HTML,$comment) = @_;
# 82: my $tree;
# 83: $tree = __get_node_tree($HTML,'//comment()');
# 84: return (undef,undef) unless ($tree);
# 85:
# 86: my $result = 0;
# 87: my @seen;
# 88:
# 89: foreach my $node ($tree->get_nodelist) {
# 90: my $content = __node_content($node);
# 91: $content =~ s/\A\Z/$1/gsm;
# 92: push @seen, $content;
# 93: $result++ if __match_comment($content,$comment);
# 94: };
# 95:
# 96: $_ = "" for @seen;
# 97: return ($result, \@seen);
# 98: };
# 99:
# 100: sub __output_diag {
# 101: my ($cond,$match,$descr,$kind,$name,$seen) = @_;
# 102:
# 103: local $Test::Builder::Level = $Test::Builder::Level + 2;
# 104:
# 105: unless ($Test->ok($cond,$name)) {
# 106: if (@$seen) {
# 107: $Test->diag( "Saw '$_'" ) for @$seen;
# 108: } else {
# 109: $Test->diag( "No $kind found at all" );
# 110: };
# 111: $Test->diag( "Expected $descr like '$match'" );
# 112: };
# 113: };
# 114:
# 115: sub __invalid_html {
# 116: my ($HTML,$name) = @_;
# 117: carp "No test name given" unless $name;
# 118: $Test->ok(0,$name);
# 119: $Test->diag( "Invalid HTML:");
# 120: $Test->diag($HTML);
# 121: };
# 122:
# 123: sub __output_comment {
# 124: my ($check,$expectation,$HTML,$comment,$name) = @_;
# 125: my ($result,$seen) = __count_comments($HTML,$comment);
# 126:
# 127: if (defined $result) {
# 128: $result = $check->($result);
# 129: __output_diag($result,$comment,$expectation,"comment",$name,$seen);
# 130: } else {
# 131: local $Test::Builder::Level = $Test::Builder::Level +2;
# 132: __invalid_html($HTML,$name);
# 133: };
# 134:
# 135: $result;
# 136: };
# 137:
# 138: sub comment_ok {
# 139: my ($HTML,$comment,$name) = @_;
# 140: __output_comment(sub{shift},"at least one comment",$HTML,$comment,$name);
# 141: };
# 142:
# 143: sub no_comment {
# 144: my ($HTML,$comment,$name) = @_;
# 145: __output_comment(sub{shift == 0},"no comment",$HTML,$comment,$name);
# 146: };
# 147:
# 148: sub comment_count {
# 149: my ($HTML,$comment,$count,$name) = @_;
# 150: __output_comment(sub{shift == $count},"exactly $count comments",$HTML,$comment,$name);
# 151: };
# 152:
# 153: sub __match_text {
# 154: my ($text,$template) = @_;
# 155: unless (ref $template eq "Regexp") {
# 156: $text =~ s/^\s*(.*?)\s*$/$1/;
# 157: $template =~ s/^\s*(.*?)\s*$/$1/;
# 158: };
# 159: return __dwim_compare($text, $template);
# 160: };
# 161:
# 162: sub __count_text {
# 163: my ($HTML,$text) = @_;
# 164: my $tree = __get_node_tree($HTML,'//text()');
# 165: return (undef,undef) unless $tree;
# 166:
# 167: my $result = 0;
# 168: my @seen;
# 169:
# 170: foreach my $node ($tree->get_nodelist) {
# 171: my $content = __node_content($node);
# 172: push @seen, $content
# 173: unless $content =~ /\A\r?\n?\Z/sm;
# 174: $result++ if __match_text($content,$text);
# 175: };
# 176:
# 177: return ($result, \@seen);
# 178: };
# 179:
# 180: sub __output_text {
# 181: my ($check,$expectation,$HTML,$text,$name) = @_;
# 182: my ($result,$seen) = __count_text($HTML,$text);
# 183:
# 184: if (defined $result) {
# 185: local $Test::Builder::Level = $Test::Builder::Level;
# 186: $result = $check->($result);
# 187: __output_diag($result,$text,$expectation,"text",$name,$seen);
# 188: } else {
# 189: local $Test::Builder::Level = $Test::Builder::Level +2;
# 190: __invalid_html($HTML,$name);
# 191: };
# 192:
# 193: $result;
# 194: };
# 195:
# 196: sub text_ok {
# 197: my ($HTML,$text,$name) = @_;
# 198: __output_text(sub{shift > 0}, "at least one text element",$HTML,$text,$name);
# 199: };
# 200:
# 201: sub no_text {
# 202: my ($HTML,$text,$name) = @_;
# 203: __output_text(sub{shift == 0}, "no text elements",$HTML,$text,$name);
# 204: };
# 205:
# 206: sub text_count {
# 207: my ($HTML,$text,$count,$name) = @_;
# 208: __output_text(sub{shift == $count}, "exactly $count elements",$HTML,$text,$name);
# 209: };
# 210:
# 211: sub __match {
# 212: my ($attrs,$currattr,$key) = @_;
# 213: my $result = 1;
# 214:
# 215: if (exists $currattr->{$key}) {
# 216: if (! defined $attrs->{$key}) {
# 217: $result = 0; # We don't want to see this attribute here
# 218: } else {
# 219: $result = 0 unless __dwim_compare($currattr->{$key}, $attrs->{$key});
# 220: };
# 221: } else {
# 222: if (! defined $attrs->{$key}) {
# 223: $result = 0 if (exists $currattr->{$key});
# 224: } else {
# 225: $result = 0;
# 226: };
# 227: };
# 228: return $result;
# 229: };
# 230:
# 231: sub __get_node_tree {
# 232: my ($HTML,$query) = @_;
# 233:
# 234: croak "No HTML given" unless defined $HTML;
# 235: croak "No query given" unless defined $query;
# 236:
# 237: my ($tree,$find,$result);
# 238: if ($HTML !~ m!\A\s*\Z!ms) {
# 239: eval {
# 240: require XML::LibXML; XML::LibXML->import;
# 241: my $parser = XML::LibXML->new();
# 242: $parser->recover(1);
# 243: $tree = $parser->parse_html_string($HTML);
# 244: $find = 'findnodes';
# 245: $HTML_PARSER_StripsTags = 1;
# 246: };
# 247: unless ($tree) {
# 248: eval {
# 249: require XML::XPath; XML::XPath->import;
# 250: require XML::Parser;
# 251:
# 252: my $p = XML::Parser->new( ErrorContext => 2, ParseParamEnt => 0, NoLWP => 1 );
# 253: $tree = XML::XPath->new( parser => $p, xml => $HTML );
# 254: $find = 'find';
# 255: };
# 256: };
# 257: undef $tree if $@;
# 258:
# 259: if ($tree) {
# 260: eval {
# 261: $result = $tree->$find($query);
# 262: unless ($result) {
# 263: $result = {};
# 264: bless $result, 'Test::HTML::Content::EmptyXPathResult';
# 265: };
# 266: };
# 267: warn $@ if $@;
# 268: };
# 269: } else { };
# 270: return $result;
# 271: };
# 272:
# 273: sub __get_node_content {
# 274: my ($node,$name) = @_;
# 275:
# 276: if ($name eq '_content') {
# 277: return $node->textContent()
# 278: } else {
# 279: return $node->getAttribute($name)
# 280: };
# 281: };
# 282:
# 283: sub __build_xpath_query {
# 284: my ($query,$attrref) = @_;
# 285: my @postvalidation;
# 286: if ($attrref) {
# 287: my @query;
# 288: for (sort keys %$attrref) {
# 289: my $name = $_;
# 290: my $value = $attrref->{$name};
# 291: my $xpath_name = '@' . $name;
# 292: if ($name eq '_content') { $xpath_name = "text()" };
# 293: if (! defined $value) {
# 294: push @query, "not($xpath_name)"
# 295: } elsif ((ref $value) ne 'Regexp') {
# 296: push @query, "$xpath_name = \"$value\"";
# 297: push @postvalidation, sub {
# 298: return __get_node_content( shift,$name ) eq $value
# 299: };
# 300: } else {
# 301: push @query, "$xpath_name";
# 302: push @postvalidation, sub {
# 303: return __get_node_content( shift,$name ) =~ $value
# 304: };
# 305: };
# 306: };
# 307: $query .= "[" . join( " and ", map {"$_"} @query ) . "]"
# 308: if @query;
# 309: };
# 310: my $postvalidation = sub {
# 311: my $node = shift;
# 312: my $test;
# 313: for $test (@postvalidation) {
# 314: return () unless $test->($node);
# 315: };
# 316: return 1;
# 317: };
# 318: ($query,$postvalidation);
# 319: };
# 320:
# 321: sub __count_tags {
# 322: my ($HTML,$tag,$attrref) = @_;
# 323: $attrref = {} unless defined $attrref;
# 324:
# 325: my $fallback = lc "//$tag";
# 326: my ($query,$valid) = __build_xpath_query( lc "//$tag", $attrref );
# 327: my $tree = __get_node_tree($HTML,$query);
# 328: return (undef,undef) unless $tree;
# 329:
# 330: my @found = grep { $valid->($_) } ($tree->get_nodelist);
# 331:
# 332: # Collect the nodes we did see for later reference :
# 333: my @seen;
# 334: foreach my $node (__get_node_tree($HTML,$fallback)->get_nodelist) {
# 335: push @seen, __node_content($node);
# 336: };
# 337: return scalar(@found),\@seen;
# 338: };
# 339:
# 340: sub __tag_diag {
# 341: my ($tag,$num,$attrs,$found) = @_;
# 342: my $phrase = "Expected to find $num <$tag> tag(s)";
# 343: $phrase .= " matching" if (scalar keys %$attrs > 0);
# 344: $Test->diag($phrase);
# 345: $Test->diag(" $_ = " . (defined $attrs->{$_} ? $attrs->{$_} : ''))
# 346: for sort keys %$attrs;
# 347: if (@$found) {
# 348: $Test->diag("Got");
# 349: $Test->diag(" " . $_) for @$found;
# 350: } else {
# 351: $Test->diag("Got none");
# 352: };
# 353: };
# 354:
# 355: sub __output_tag {
# 356: my ($check,$expectation,$HTML,$tag,$attrref,$name) = @_;
# 357: ($attrref,$name) = ({},$attrref)
# 358: unless defined $name;
# 359: $attrref = {}
# 360: unless defined $attrref;
# 361: croak "$attrref dosen't look like a hash reference for the attributes"
# 362: unless ref $attrref eq 'HASH';
# 363: my ($currcount,$seen) = __count_tags($HTML,$tag,$attrref);
# 364: my $result;
# 365: if (defined $currcount) {
# 366: if ($currcount eq 'skip') {
# 367: $Test->skip($seen);
# 368: } else {
# 369: local $Test::Builder::Level = $Test::Builder::Level +1;
# 370: $result = $check->($currcount);
# 371: unless ($Test->ok($result, $name)) {
# 372: __tag_diag($tag,$expectation,$attrref,$seen) ;
# 373: };
# 374: };
# 375: } else {
# 376: local $Test::Builder::Level = $Test::Builder::Level +2;
# 377: __invalid_html($HTML,$name);
# 378: };
# 379:
# 380: $result;
# 381: };
# 382:
# 383: sub tag_count {
# 384: my ($HTML,$tag,$attrref,$count,$name) = @_;
# 385: __output_tag(sub { shift == $count }, "exactly $count",$HTML,$tag,$attrref,$name);
# 386: };
# 387:
# 388: sub tag_ok {
# 389: my ($HTML,$tag,$attrref,$name) = @_;
# 390: __output_tag(sub { shift > 0 }, "at least one",$HTML,$tag,$attrref,$name);
# 391: };
# 392:
# 393: sub no_tag {
# 394: my ($HTML,$tag,$attrref,$name) = @_;
# 395: __output_tag(sub { shift == 0 }, "no",$HTML,$tag,$attrref,$name);
# 396: };
# 397:
# 398: sub link_count {
# 399: my ($HTML,$link,$count,$name) = @_;
# 400: local $Test::Builder::Level = 2;
# 401: return tag_count($HTML,"a",{href => $link},$count,$name);
# 402: };
# 403:
# 404: sub link_ok {
# 405: my ($HTML,$link,$name) = (@_);
# 406: local $Test::Builder::Level = 2;
# 407: return tag_ok($HTML,'a',{ href => $link },$name);
# 408: };
# 409:
# 410: sub no_link {
# 411: my ($HTML,$link,$name) = (@_);
# 412: local $Test::Builder::Level = 2;
# 413: return no_tag($HTML,'a',{ href => $link },$name);
# 414: };
# 415:
# 416: sub title_ok {
# 417: my ($HTML,$title,$name) = @_;
# 418: local $Test::Builder::Level = 2;
# 419: return tag_ok($HTML,"title",{_content => $title},$name);
# 420: };
# 421:
# 422: sub no_title {
# 423: my ($HTML,$title,$name) = (@_);
# 424: local $Test::Builder::Level = 2;
# 425: return no_tag($HTML,'title',{ _content => $title },$name);
# 426: };
# 427:
# 428: sub __match_declaration {
# 429: my ($text,$template) = @_;
# 430: $text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
# 431: unless (ref $template eq "Regexp") {
# 432: $text =~ s/^\s*(.*?)\s*$/$1/;
# 433: $template =~ s/^\s*(.*?)\s*$/$1/;
# 434: };
# 435: return __dwim_compare($text, $template);
# 436: };
# 437:
# 438: sub __count_declarations {
# 439: my ($HTML,$doctype) = @_;
# 440: my $result = 0;
# 441: my $seen = [];
# 442:
# 443: my $p = HTML::TokeParser->new(\$HTML);
# 444: my $token;
# 445: while ($token = $p->get_token) {
# 446: my ($type,$text) = @$token;
# 447: if ($type eq "D") {
# 448: push @$seen, $text;
# 449: $result++ if __match_declaration($text,$doctype);
# 450: };
# 451: };
# 452:
# 453: return $result, $seen;
# 454: };
# 455:
# 456: sub has_declaration {
# 457: my ($HTML,$declaration,$name) = @_;
# 458: my ($result,$seen) = __count_declarations($HTML,$declaration);
# 459:
# 460: if (defined $result) {
# 461: __output_diag($result == 1,$declaration,"exactly one declaration","declaration",$name,$seen);
# 462: } else {
# 463: local $Test::Builder::Level = $Test::Builder::Level +1;
# 464: __invalid_html($HTML,$name);
# 465: };
# 466:
# 467: $result;
# 468: };
# 469:
# 470: sub no_declaration {
# 471: my ($HTML,$declaration,$name) = @_;
# 472: my ($result,$seen) = __count_declarations($HTML,$declaration);
# 473:
# 474: if (defined $result) {
# 475: __output_diag($result == 0,$declaration,"no declaration","declaration",$name,$seen);
# 476: } else {
# 477: local $Test::Builder::Level = $Test::Builder::Level +1;
# 478: __invalid_html($HTML,$name);
# 479: };
# 480:
# 481: $result;
# 482: };
# 483:
# 484: sub __count_xpath {
# 485: my ($HTML,$query,$fallback) = @_;
# 486:
# 487: $fallback = $query unless defined $fallback;
# 488: my $tree = __get_node_tree($HTML,$query);
# 489: return (undef,undef) unless $tree;
# 490:
# 491: my @found = ($tree->get_nodelist);
# 492:
# 493: # Collect the nodes we did see for later reference :
# 494: my @seen;
# 495: foreach my $node (__get_node_tree($HTML,$fallback)->get_nodelist) {
# 496: push @seen, __node_content($node);
# 497: };
# 498: return scalar(@found),\@seen;
# 499: };
# 500:
# 501: sub __xpath_diag {
# 502: my ($query,$num,$found) = @_;
# 503: my $phrase = "Expected to find $num nodes matching on '$query'";
# 504: if (@$found) {
# 505: $Test->diag("Got");
# 506: $Test->diag(" $_") for @$found;
# 507: } else {
# 508: $Test->diag("Got none");
# 509: };
# 510: };
# 511:
# 512: sub __output_xpath {
# 513: my ($check,$expectation,$HTML,$query,$fallback,$name) = @_;
# 514: ($fallback,$name) = ($query,$fallback) unless $name;
# 515: my ($currcount,$seen) = __count_xpath($HTML,$query,$fallback);
# 516: my $result;
# 517: if (defined $currcount) {
# 518: if ($currcount eq 'skip') {
# 519: $Test->skip($seen);
# 520: } else {
# 521: local $Test::Builder::Level = $Test::Builder::Level +1;
# 522: $result = $check->($currcount);
# 523: unless ($Test->ok($result, $name)) {
# 524: __xpath_diag($query,$expectation,$seen) ;
# 525: };
# 526: };
# 527: } else {
# 528: local $Test::Builder::Level = $Test::Builder::Level +1;
# 529: __invalid_html($HTML,$name);
# 530: };
# 531:
# 532: $result;
# 533: };
# 534:
# 535: sub xpath_count {
# 536: my ($HTML,$query,$count,$fallback,$name) = @_;
# 537: __output_xpath( sub {shift == $count},"exactly $count",$HTML,$query,$fallback,$name);
# 538: };
# 539:
# 540: sub xpath_ok {
# 541: my ($HTML,$query,$fallback,$name) = @_;
# 542: __output_xpath( sub{shift > 0},"at least one",$HTML,$query,$fallback,$name);
# 543: };
# 544:
# 545: sub no_xpath {
# 546: my ($HTML,$query,$fallback,$name) = @_;
# 547: __output_xpath( sub{shift == 0},"no",$HTML,$query,$fallback,$name);
# 548: };
# 549:
# 550: sub install_xpath {
# 551: require XML::XPath;
# 552: XML::XPath->import();
# 553: die "Need XML::XPath 1.13 or higher"
# 554: unless $XML::XPath::VERSION >= 1.13;
# 555: $can_xpath = 'XML::XPath';
# 556: };
# 557:
# 558: sub install_libxml {
# 559: local $^W;
# 560: require XML::LibXML;
# 561: XML::LibXML->import();
# 562: $can_xpath = 'XML::LibXML';
# 563: };
# 564:
# 565: # And install our plain handlers if we have to :
# 566: sub install_pureperl {
# 567: require Test::HTML::Content::NoXPath;
# 568: Test::HTML::Content::NoXPath->import;
# 569: };
# 570:
# 571: BEGIN {
# 572: # Load the XML-variant if our prerequisites are there :
# 573: eval { install_libxml }
# 574: or eval { install_xpath }
# 575: or install_pureperl;
# 576: };
# 577:
# 578: {
# 579: package Test::HTML::Content::EmptyXPathResult;
# 580: sub size { 0 };
# 581: sub get_nodelist { () };
# 582: };
# 583:
# 584: 1;
# 585:
# 586: __END__
# 587:
# 588: =head1 NAME
# 589:
# 590: Test::HTML::Content - Perl extension for testing HTML output
# 591:
# 592: =head1 SYNOPSIS
# 593:
# 594: use Test::HTML::Content( tests => 13 );
# 595:
# 596: =for example begin
# 597:
# 598: $HTML = "A test pageHome page
# 599: 
# 600: Perl
# 601:
# 602: ";
# 603:
# 604: link_ok($HTML,"http://www.perl.com","We link to Perl");
# 605: no_link($HTML,"http://www.pearl.com","We have no embarassing typos");
# 606: link_ok($HTML,qr"http://[a-z]+\.perl.com","We have a link to perl.com");
# 607:
# 608: title_count($HTML,1,"We have one title tag");
# 609: title_ok($HTML,qr/test/);
# 610:
# 611: tag_ok($HTML,"img", {src => "http://www.perl.com/camel.png"},
# 612: "We have an image of a camel on the page");
# 613: tag_count($HTML,"img", {src => "http://www.perl.com/camel.png"}, 2,
# 614: "In fact, we have exactly two camel images on the page");
# 615: no_tag($HTML,"blink",{}, "No annoying blink tags ..." );
# 616:
# 617: # We can check the textual contents
# 618: text_ok($HTML,"Perl");
# 619:
# 620: # We can also check the contents of comments
# 621: comment_ok($HTML,"Hidden message");
# 622:
# 623: # Advanced stuff
# 624:
# 625: # Using a regular expression to match against
# 626: # tag attributes - here checking there are no ugly styles
# 627: no_tag($HTML,"p",{ style => qr'ugly$' }, "No ugly styles" );
# 628:
# 629: # REs also can be used for substrings in comments
# 630: comment_ok($HTML,qr"[hH]idden\s+mess");
# 631:
# 632: # and if you have XML::LibXML or XML::XPath, you can
# 633: # even do XPath queries yourself:
# 634: xpath_ok($HTML,'/html/body/p','HTML is somewhat wellformed');
# 635: no_xpath($HTML,'/html/head/p','HTML is somewhat wellformed');
# 636:
# 637: =for example end
# 638:
# 639: =head1 DESCRIPTION
# 640:
# 641: This is a module to test the HTML output of your programs in simple
# 642: test scripts. It can test a scalar (presumably containing HTML) for
# 643: the presence (or absence, or a specific number) of tags having (or
# 644: lacking) specific attributes. Unspecified attributes are ignored,
# 645: and the attribute values can be specified as either scalars (meaning
# 646: a match succeeds if the strings are identical) or regular expressions
# 647: (meaning that a match succeeds if the actual attribute value is matched
# 648: by the given RE) or undef (meaning that the attribute must not
# 649: be present).
# 650:
# 651: If you want to specify or test the deeper structure
# 652: of the HTML (for example, META tags within the BODY) or the (textual)
# 653: content of tags, you will have to resort to C,C
# 654: and C, which take an XPath expression. If you find yourself crafting
# 655: very complex XPath expression to verify the structure of your output, it is
# 656: time to rethink your testing process and maybe use a template based solution
# 657: or simply compare against prefabricated files as a whole.
# 658:
# 659: The used HTML parser is HTML::TokeParser, the used XPath module
# 660: is XML::XPath or XML::LibXML. XML::XPath needs valid xHTML, XML::LibXML
# 661: will try its best to force your code into xHTML, but it is best to
# 662: supply valid xHTML (snippets) to the test functions.
# 663:
# 664: If no XPath parsers/interpreters are available, the tests will automatically
# 665: skip, so your users won't need to install XML::XPath or XML::LibXML. The module
# 666: then falls back onto a crude implementation of the core functions for tags,
# 667: links, comments and text, and the diagnostic output of the tests varies a bit.
# 668:
# 669: The test functionality is derived from L, and the export
# 670: behaviour is the same. When you use Test::HTML::Content, a set of
# 671: HTML testing functions is exported into the namespace of the caller.
# 672:
# 673: =head2 EXPORT
# 674:
# 675: Exports the bunch of test functions :
# 676:
# 677: link_ok() no_link() link_count()
# 678: tag_ok() no_tag() tag_count()
# 679: text_ok no_text() text_count()
# 680: comment_ok() no_comment() comment_count()
# 681: xpath_ok() no_xpath() xpath_count()
# 682: has_declaration() no_declaration()
# 683:
# 684: =head2 CONSIDERATIONS
# 685:
# 686: The module reparses the HTML string every time a test function is called.
# 687: This will make running many tests over the same, large HTML stream relatively
# 688: slow. A possible speedup could be simple minded caching mechanism that keeps the most
# 689: recent HTML stream in a cache.
# 690:
# 691: =head2 CAVEATS
# 692:
# 693: The test output differs between XPath and HTML parsing, because XML::XPath
# 694: delivers the complete node including the content, where my HTML parser only
# 695: delivers the start tag. So don't make your tests depend on the _exact_
# 696: output of my tests. It was a pain to do so in my test scripts for this module
# 697: and if you really want to, take a look at the included test scripts.
# 698:
# 699: The title functions C and C rely on the XPath functionality
# 700: and will thus skip if XPath functionality is unavailable.
# 701:
# 702: =head2 BUGS
# 703:
# 704: Currently, if there is text split up by comments, the text will be seen
# 705: as two separate entities, so the following dosen't work :
# 706:
# 707: is_text( "Hello World", "Hello World" );
# 708:
# 709: Whether this is a real bug or not, I don't know at the moment - most likely,
# 710: I'll modify text_ok() and siblings to ignore embedded comments.
# 711:
# 712: =head2 TODO
# 713:
# 714: My things on the todo list for this module. Patches are welcome !
# 715:
# 716: =over 4
# 717:
# 718: =item * Refactor the code to fold some of the internal routines
# 719:
# 720: =item * Implement a cache for the last parsed tree / token sequence
# 721:
# 722: =item * Possibly diag() the row/line number for failing tests
# 723:
# 724: =item * Allow RE instead of plain strings in the functions (for tags themselves). This
# 725: one is most likely useless.
# 726:
# 727: =back
# 728:
# 729: =head1 LICENSE
# 730:
# 731: This code may be distributed under the same terms as Perl itself.
# 732:
# 733: =head1 AUTHOR
# 734:
# 735: Max Maischein Ecorion@cpan.orgE
# 736:
# 737: =head1 SEE ALSO
# 738:
# 739: perl(1), L,L,L.
# 740:
# 741: =cut
# Failed test (t\99-unix-text.t at line 34)
# got: '225'
# expected: '0'
# 0: package Test::HTML::Content::NoXPath;
not ok 2 - 'blib\lib/Test/HTML/Content/NoXPath.pm' contains no windows newlines
# 1:
# 2: require 5.005_62;
# 3: use strict;
# 4: use File::Spec;
# 5: use HTML::TokeParser;
# 6:
# 7: # we want to stay compatible to 5.5 and use warnings if
# 8: # we can
# 9: eval 'use warnings;' if ($] >= 5.006);
# 10: use vars qw( $HTML_PARSER_StripsTags $VERSION @exports );
# 11:
# 12: $VERSION = '0.07';
# 13:
# 14: BEGIN {
# 15: # Check whether HTML::Parser is v3 and delivers the comments starting
# 16: # with the ";
# 18: my $p = HTML::TokeParser->new(\$HTML);
# 19: my ($type,$text) = @{$p->get_token()};
# 20: if ($text eq "") {
# 21: $HTML_PARSER_StripsTags = 0
# 22: } else {
# 23: $HTML_PARSER_StripsTags = 1
# 24: };
# 25: };
# 26:
# 27: # import what we need
# 28: { no strict 'refs';
# 29: *{$_} = *{"Test::HTML::Content::$_"}
# 30: for qw( __dwim_compare __output_diag __invalid_html );
# 31: };
# 32:
# 33: @exports = qw( __match_comment __count_comments __match_text __count_text
# 34: __match __count_tags __match_declaration __count_declarations );
# 35:
# 36: sub __match_comment {
# 37: my ($text,$template) = @_;
# 38: $text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
# 39: unless (ref $template eq "Regexp") {
# 40: $text =~ s/^\s*(.*?)\s*$/$1/;
# 41: $template =~ s/^\s*(.*?)\s*$/$1/;
# 42: };
# 43: return __dwim_compare($text, $template);
# 44: };
# 45:
# 46: sub __count_comments {
# 47: my ($HTML,$comment) = @_;
# 48: my $result = 0;
# 49: my $seen = [];
# 50:
# 51: my $p = HTML::TokeParser->new(\$HTML);
# 52: my $token;
# 53: while ($token = $p->get_token) {
# 54: my ($type,$text) = @$token;
# 55: if ($type eq "C") {
# 56: push @$seen, $token->[1];
# 57: $result++ if __match_comment($text,$comment);
# 58: };
# 59: };
# 60:
# 61: return ($result, $seen);
# 62: };
# 63:
# 64: sub __match_text {
# 65: my ($text,$template) = @_;
# 66: unless (ref $template eq "Regexp") {
# 67: $text =~ s/^\s*(.*?)\s*$/$1/;
# 68: $template =~ s/^\s*(.*?)\s*$/$1/;
# 69: };
# 70: return __dwim_compare($text, $template);
# 71: };
# 72:
# 73: sub __count_text {
# 74: my ($HTML,$text) = @_;
# 75: my $result = 0;
# 76: my $seen = [];
# 77:
# 78: my $p = HTML::TokeParser->new(\$HTML);
# 79: $p->unbroken_text(1);
# 80:
# 81: my $token;
# 82: while ($token = $p->get_token) {
# 83: my ($type,$foundtext) = @$token;
# 84: if ($type eq "T") {
# 85: push @$seen, $token->[1];
# 86: $result++ if __match_text($foundtext,$text);
# 87: };
# 88: };
# 89:
# 90: return $result,$seen;
# 91: };
# 92:
# 93: sub __match {
# 94: my ($attrs,$currattr,$key) = @_;
# 95: my $result = 1;
# 96:
# 97: if (exists $currattr->{$key}) {
# 98: if (! defined $attrs->{$key}) {
# 99: $result = 0; # We don't want to see this attribute here
# 100: } else {
# 101: $result = 0 unless __dwim_compare($currattr->{$key}, $attrs->{$key});
# 102: };
# 103: } else {
# 104: if (! defined $attrs->{$key}) {
# 105: $result = 0 if (exists $currattr->{$key});
# 106: } else {
# 107: $result = 0;
# 108: };
# 109: };
# 110: return $result;
# 111: };
# 112:
# 113: sub __count_tags {
# 114: my ($HTML,$tag,$attrref) = @_;
# 115: $attrref = {} unless defined $attrref;
# 116: return ('skip','XML::LibXML or XML::XPath not loaded')
# 117: if exists $attrref->{_content};
# 118:
# 119: my $result = 0;
# 120: $tag = lc $tag;
# 121:
# 122: my $p = HTML::TokeParser->new(\$HTML);
# 123: my $token;
# 124: my @seen;
# 125: while ($token = $p->get_token) {
# 126: my ($type,$currtag,$currattr,$attrseq,$origtext) = @$token;
# 127: if ($type eq "S" && $tag eq $currtag) {
# 128: my (@keys) = keys %$attrref;
# 129: my $key;
# 130: my $complete = 1;
# 131: foreach $key (@keys) {
# 132: $complete = __match($attrref,$currattr,$key) if $complete;
# 133: };
# 134: $result += $complete;
# 135: # Now munge the thing to resemble what the XPath variant returns :
# 136: push @seen, $token->[4];
# 137: };
# 138: };
# 139:
# 140: return $result,\@seen;
# 141: };
# 142:
# 143: sub __match_declaration {
# 144: my ($text,$template) = @_;
# 145: $text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
# 146: unless (ref $template eq "Regexp") {
# 147: $text =~ s/^\s*(.*?)\s*$/$1/;
# 148: $template =~ s/^\s*(.*?)\s*$/$1/;
# 149: };
# 150: return __dwim_compare($text, $template);
# 151: };
# 152:
# 153: sub __count_declarations {
# 154: my ($HTML,$doctype) = @_;
# 155: my $result = 0;
# 156: my $seen = [];
# 157:
# 158: my $p = HTML::TokeParser->new(\$HTML);
# 159: my $token;
# 160: while ($token = $p->get_token) {
# 161: my ($type,$text) = @$token;
# 162: if ($type eq "D") {
# 163: push @$seen, $text;
# 164: $result++ if __match_declaration($text,$doctype);
# 165: };
# 166: };
# 167:
# 168: return $result, $seen;
# 169: };
# 170:
# 171: sub import {
# 172: goto &install;
# 173: };
# 174:
# 175: sub install {
# 176: for (@exports) {
# 177: no strict 'refs';
# 178: *{"Test::HTML::Content::$_"} = *{"Test::HTML::Content::NoXPath::$_"};
# 179: };
# 180: $Test::HTML::Content::can_xpath = 0;
# 181: };
# 182:
# 183: 1;
# 184:
# 185: __END__
# 186:
# 187: =head1 NAME
# 188:
# 189: Test::HTML::Content::NoXPath - HTML::TokeParser fallback for Test::HTML::Content
# 190:
# 191: =head1 SYNOPSIS
# 192:
# 193: =for example begin
# 194:
# 195: # This module is implicitly loaded by Test::HTML::Content
# 196: # if XML::XPath or HTML::Tidy::Simple are unavailable.
# 197:
# 198: =for example end
# 199:
# 200: =head1 DESCRIPTION
# 201:
# 202: This is the module that gets loaded when Test::HTML::Content
# 203: can't find its prerequisites :
# 204:
# 205: XML::XPath
# 206: HTML::Tidy
# 207:
# 208: =head2 EXPORT
# 209:
# 210: Nothing. It stomps over the Test::HTML::Content namespace.
# 211:
# 212: =head1 LICENSE
# 213:
# 214: This code may be distributed under the same terms as Perl itself.
# 215:
# 216: =head1 AUTHOR
# 217:
# 218: Max Maischein, corion@cpan.org
# 219:
# 220: =head1 SEE ALSO
# 221:
# 222: L,L,L,L,L
# 223:
# 224: =cut
# Failed test (t\99-unix-text.t at line 34)
# got: '99'
# expected: '0'
# 0: package Test::HTML::Content::XPathExtensions;
not ok 3 - 'blib\lib/Test/HTML/Content/XPathExtensions.pm' contains no windows newlines
# 1:
# 2: require 5.005_62;
# 3: use strict;
# 4: use File::Spec;
# 5: use HTML::TokeParser;
# 6:
# 7: # we want to stay compatible to 5.5 and use warnings if
# 8: # we can
# 9: eval 'use warnings;' if ($] >= 5.006);
# 10: use vars qw( $HTML_PARSER_StripsTags $VERSION @exports );
# 11:
# 12: $VERSION = '0.01';
# 13:
# 14: @exports = qw( matches comment );
# 15:
# 16: sub matches {
# 17: my $self = shift;
# 18: my ($node, @params) = @_;
# 19: die "starts-with: incorrect number of params\n" unless @params == 2;
# 20: my $re = $params[1]->string_value;
# 21: return($params[0]->string_value =~ /$re/)
# 22: ? XML::XPath::Boolean->True
# 23: : XML::XPath::Boolean->False;
# 24: }
# 25:
# 26: sub comment {
# 27: my $self = shift;
# 28: my ($node, @params) = @_;
# 29: die "starts-with: incorrect number of params\n" unless @params == 1;
# 30: my $re = $params[1]->string_value;
# 31: return(ref $node =~ /Comment$/)
# 32: ? XML::XPath::Boolean->True
# 33: : XML::XPath::Boolean->False;
# 34: };
# 35:
# 36:
# 37: sub import {
# 38: for (@exports) {
# 39: no strict 'refs';
# 40: # Install our extensions unless they already exist :
# 41: *{"XML::XPath::Function::$_"} = *{"Test::HTML::Content::XPathExtensions::$_"}
# 42: unless defined *{"XML::XPath::Function::$_"}{CODE};
# 43: };
# 44: };
# 45:
# 46: 1;
# 47:
# 48: __END__
# 49:
# 50: =head1 NAME
# 51:
# 52: Test::HTML::Content::XPathExtensions - Perlish XPath extensions
# 53:
# 54: =head1 SYNOPSIS
# 55:
# 56: =for example begin
# 57:
# 58: # This module patches the XML::XPath::Function namespace
# 59: use Test::HTML::Content::XPathExtensions;
# 60:
# 61: =for example end
# 62:
# 63: =head1 DESCRIPTION
# 64:
# 65: This is the module that provides RE support for XML::XPath
# 66: and support for matching comments through the two functions
# 67: C and C.
# 68:
# 69: The two functions are modeled after what I found on the Saxon
# 70: website on the C namespace :
# 71:
# 72: =over 4
# 73:
# 74: =item *
# 75: http://saxon.sourceforge.net/saxon7.3.1/functions.html
# 76:
# 77: =item *
# 78: http://www.w3.org/TR/xquery-operators/
# 79:
# 80: =back
# 81:
# 82: =head2 EXPORT
# 83:
# 84: Nothing. It stomps over the XML::XPath::Function namespace.
# 85:
# 86: =head1 LICENSE
# 87:
# 88: This code may be distributed under the same terms as Perl itself.
# 89:
# 90: =head1 AUTHOR
# 91:
# 92: Max Maischein, corion@cpan.org
# 93:
# 94: =head1 SEE ALSO
# 95:
# 96: L
# 97:
# 98: =cut
# Failed test (t\99-unix-text.t at line 34)
# got: '42'
# expected: '0'
not ok 4 - 't/testlib.pm' contains no windows newlines
# 0: use strict;
# 1: use Test::More;
# 2:
# 3: use vars qw(%modules);
# 4: BEGIN {
# 5: $modules{pureperl} = \&run_pureperl;
# 6: eval { require XML::XPath; $XML::XPath::VERSION >= 1.13 and $modules{xpath} = \&run_xpath };
# 7: eval { require XML::LibXML; $modules{libxml} = \&run_libxml };
# 8: };
# 9:
# 10: sub main::runtests {
# 11: my ($count,$code) = @_;
# 12: my @candidates = (sort keys %modules);
# 13:
# 14: plan( tests => 1+ $count * scalar @candidates );
# 15: use_ok('Test::HTML::Content');
# 16:
# 17: for my $implementation (@candidates) {
# 18: my $test = $modules{$implementation};
# 19: $test->($count,$code);
# 20: };
# 21: };
# 22:
# 23: sub run_libxml {
# 24: my ($count,$code) = @_;
# 25: Test::HTML::Content::install_libxml();
# 26: $code->('XML::LibXML');
# 27: };
# 28:
# 29: sub run_xpath {
# 30: my ($count,$code) = @_;
# 31: Test::HTML::Content::install_xpath();
# 32: $code->('XML::XPath');
# 33: };
# 34:
# 35: sub run_pureperl {
# 36: my ($count,$code) = @_;
# 37: Test::HTML::Content::install_pureperl();
# 38: $code->('PurePerl');
# 39: };
# 40:
# 41: 1;
# Failed test (t\99-unix-text.t at line 34)
# got: '742'
# expected: '0'
# 0: package Test::HTML::Content;
not ok 5 - 'lib/Test/HTML/Content.pm' contains no windows newlines
# 1:
# 2: require 5.005_62;
# 3: use strict;
# 4: use File::Spec;
# 5: use Carp qw(carp croak);
# 6:
# 7: use HTML::TokeParser;
# 8:
# 9: # we want to stay compatible to 5.5 and use warnings if
# 10: # we can
# 11: eval 'use warnings' if $] >= 5.006;
# 12: use Test::Builder;
# 13: require Exporter;
# 14:
# 15: use vars qw/@ISA @EXPORT_OK @EXPORT $VERSION $can_xpath/;
# 16:
# 17: @ISA = qw(Exporter);
# 18:
# 19: use vars qw( $tidy );
# 20:
# 21: # DONE:
# 22: # * use Test::Builder;
# 23: # * Add comment_ok() method
# 24: # * Allow RE instead of plain strings in the functions (for tag attributes and comments)
# 25: # * Create a function to check the DOCTYPE and other directives
# 26: # * Have a better way to diagnose ignored candidates in tag_ok(), tag_count
# 27: # and no_tag() in case a test fails
# 28:
# 29: @EXPORT = qw(
# 30: link_ok no_link link_count
# 31: tag_ok no_tag tag_count
# 32: comment_ok no_comment comment_count
# 33: has_declaration no_declaration
# 34: text_ok no_text text_count
# 35: title_ok no_title
# 36: xpath_ok no_xpath xpath_count
# 37: );
# 38:
# 39: $VERSION = '0.07';
# 40:
# 41: my $Test = Test::Builder->new;
# 42:
# 43: use vars qw($HTML_PARSER_StripsTags);
# 44:
# 45: # Cribbed from the Test::Builder synopsis
# 46: sub import {
# 47: my($self) = shift;
# 48: my $pack = caller;
# 49: $Test->exported_to($pack);
# 50: $Test->plan(@_);
# 51: $self->export_to_level(1, $self, @EXPORT);
# 52: }
# 53:
# 54: sub __dwim_compare {
# 55: # Do the Right Thing (Perl 6 style) with the RHS being a Regex or a string
# 56: my ($target,$template) = @_;
# 57: if (ref $template) { # supposedly a Regexp, but possibly blessed, so no eq comparision
# 58: return ($target =~ $template )
# 59: } else {
# 60: return $target eq $template;
# 61: };
# 62: };
# 63:
# 64: sub __node_content {
# 65: my $node = shift;
# 66: if ($can_xpath eq 'XML::XPath') { return XML::XPath::XMLParser::as_string($node) };
# 67: if ($can_xpath eq 'XML::LibXML') { return $node->toString };
# 68: };
# 69:
# 70: sub __match_comment {
# 71: my ($text,$template) = @_;
# 72: $text =~ s/^$/$1/sm unless $HTML_PARSER_StripsTags;
# 73: unless (ref $template eq "Regexp") {
# 74: $text =~ s/^\s*(.*?)\s*$/$1/;
# 75: $template =~ s/^\s*(.*?)\s*$/$1/;
# 76: };
# 77: return __dwim_compare($text, $template);
# 78: };
# 79:
# 80: sub __count_comments {
# 81: my ($HTML,$comment) = @_;
# 82: my $tree;
# 83: $tree = __get_node_tree($HTML,'//comment()');
# 84: return (undef,undef) unless ($tree);
# 85:
# 86: my $result = 0;
# 87: my @seen;
# 88:
# 89: foreach my $node ($tree->get_nodelist) {
# 90: my $content = __node_content($node);
# 91: $content =~ s/\A\Z/$1/gsm;
# 92: push @seen, $content;
# 93: $result++ if __match_comment($content,$comment);
# 94: };
# 95:
# 96: $_ = "" for @seen;
# 97: return ($result, \@seen);
# 98: };
# 99:
# 100: sub __output_diag {
# 101: my ($cond,$match,$descr,$kind,$name,$seen) = @_;
# 102:
# 103: local $Test::Builder::Level = $Test::Builder::Level + 2;
# 104:
# 105: unless ($Test->ok($cond,$name)) {
# 106: if (@$seen) {
# 107: $Test->diag( "Saw '$_'" ) for @$seen;
# 108: } else {
# 109: $Test->diag( "No $kind found at all" );
# 110: };
# 111: $Test->diag( "Expected $descr like '$match'" );
# 112: };
# 113: };
# 114:
# 115: sub __invalid_html {
# 116: my ($HTML,$name) = @_;
# 117: carp "No test name given" unless $name;
# 118: $Test->ok(0,$name);
# 119: $Test->diag( "Invalid HTML:");
# 120: $Test->diag($HTML);
# 121: };
# 122:
# 123: sub __output_comment {
# 124: my ($check,$expectation,$HTML,$comment,$name) = @_;
# 125: my ($result,$seen) = __count_comments($HTML,$comment);
# 126:
# 127: if (defined $result) {
# 128: $result = $check->($result);
# 129: __output_diag($result,$comment,$expectation,"comment",$name,$seen);
# 130: } else {
# 131: local $Test::Builder::Level = $Test::Builder::Level +2;
# 132: __invalid_html($HTML,$name);
# 133: };
# 134:
# 135: $result;
# 136: };
# 137:
# 138: sub comment_ok {
# 139: my ($HTML,$comment,$name) = @_;
# 140: __output_comment(sub{shift},"at least one comment",$HTML,$comment,$name);
# 141: };
# 142:
# 143: sub no_comment {
# 144: my ($HTML,$comment,$name) = @_;
# 145: __output_comment(sub{shift == 0},"no comment",$HTML,$comment,$name);
# 146: };
# 147:
# 148: sub comment_count {
# 149: my ($HTML,$comment,$count,$name) = @_;
# 150: __output_comment(sub{shift == $count},"exactly $count comments",$HTML,$comment,$name);
# 151: };
# 152:
# 153: sub __match_text {
# 154: my ($text,$template) = @_;
# 155: unless (ref $template eq "Regexp") {
# 156: $text =~ s/^\s*(.*?)\s*$/$1/;
# 157: $template =~ s/^\s*(.*?)\s*$/$1/;
# 158: };
# 159: return __dwim_compare($text, $template);
# 160: };
# 161:
# 162: sub __count_text {
# 163: my ($HTML,$text) = @_;
# 164: my $tree = __get_node_tree($HTML,'//text()');
# 165: return (undef,undef) unless $tree;
# 166:
# 167: my $result = 0;
# 168: my @seen;
# 169:
# 170: foreach my $node ($tree->get_nodelist) {
# 171: my $content = __node_content($node);
# 172: push @seen, $content
# 173: unless $content =~ /\A\r?\n?\Z/sm;
# 174: $result++ if __match_text($content,$text);
# 175: };
# 176:
# 177: return ($result, \@seen);
# 178: };
# 179:
# 180: sub __output_text {
# 181: my ($check,$expectation,$HTML,$text,$name) = @_;
# 182: my ($result,$seen) = __count_text($HTML,$text);
# 183:
# 184: if (defined $result) {
# 185: local $Test::Builder::Level = $Test::Builder::Level;
# 186: $result = $check->($result);
# 187: __output_diag($result,$text,$expectation,"text",$name,$seen);
# 188: } else {
# 189: local $Test::Builder::Level = $Test::Builder::Level +2;
# 190: __invalid_html($HTML,$name);
# 191: };
# 192:
# 193: $result;
# 194: };
# 195:
# 196: sub text_ok {
# 197: my ($HTML,$text,$name) = @_;
# 198: __output_text(sub{shift > 0}, "at least one text element",$HTML,$text,$name);
# 199: };
# 200:
# 201: sub no_text {
# 202: my ($HTML,$text,$name) = @_;
# 203: __output_text(sub{shift == 0}, "no text elements",$HTML,$text,$name);
# 204: };
# 205:
# 206: sub text_count {
# 207: my ($HTML,$text,$count,$name) = @_;
# 208: __output_text(sub{shift == $count}, "exactly $count elements",$HTML,$text,$name);
# 209: };
# 210:
# 211: sub __match {
# 212: my ($attrs,$currattr,$key) = @_;
# 213: my $result = 1;
# 214:
# 215: if (exists $currattr->{$key}) {
# 216: if (! defined $attrs->{$key}) {
# 217: $result = 0; # We don't want to see this attribute here
# 218: } else {
# 219: $result = 0 unless __dwim_compare($currattr->{$key}, $attrs->{$key});
# 220: };
# 221: } else {
# 222: if (! defined $attrs->{$key}) {
# 223: $result = 0 if (exists $currattr->{$key});
# 224: } else {
# 225: $result = 0;
# 226: };
# 227: };
# 228: return $result;
# 229: };
# 230:
# 231: sub __get_node_tree {
# 232: my ($HTML,$query) = @_;
# 233:
# 234: croak "No HTML given" unless defined $HTML;
# 235: croak "No query given" unless defined $query;
# 236:
# 237: my ($tree,$find,$result);
# 238: if ($HTML !~ m!\A\s*\Z!ms) {
# 239: eval {
# 240: require XML::LibXML; XML::LibXML->import;
# 241: my $parser = XML::LibXML->new();
# 242: $parser->recover(1);
# 243: $tree = $parser->parse_html_string($HTML);
# 244: $find = 'findnodes';
# 245: $HTML_PARSER_StripsTags = 1;
# 246: };
# 247: unless ($tree) {
# 248: eval {
# 249: require XML::XPath; XML::XPath->import;
# 250: require XML::Parser;
# 251:
# 252: my $p = XML::Parser->new( ErrorContext => 2, ParseParamEnt => 0, NoLWP => 1 );
# 253: $tree = XML::XPath->new( parser => $p, xml => $HTML );
# 254: $find = 'find';
# 255: };
# 256: };
# 257: undef $tree if $@;
# 258:
# 259: if ($tree) {
# 260: eval {
# 261: $result = $tree->$find($query);
# 262: unless ($result) {
# 263: $result = {};
# 264: bless $result, 'Test::HTML::Content::EmptyXPathResult';
# 265: };
# 266: };
# 267: warn $@ if $@;
# 268: };
# 269: } else { };
# 270: return $result;
# 271: };
# 272:
# 273: sub __get_node_content {
# 274: my ($node,$name) = @_;
# 275:
# 276: if ($name eq '_content') {
# 277: return $node->textContent()
# 278: } else {
# 279: return $node->getAttribute($name)
# 280: };
# 281: };
# 282:
# 283: sub __build_xpath_query {
# 284: my ($query,$attrref) = @_;
# 285: my @postvalidation;
# 286: if ($attrref) {
# 287: my @query;
# 288: for (sort keys %$attrref) {
# 289: my $name = $_;
# 290: my $value = $attrref->{$name};
# 291: my $xpath_name = '@' . $name;
# 292: if ($name eq '_content') { $xpath_name = "text()" };
# 293: if (! defined $value) {
# 294: push @query, "not($xpath_name)"
# 295: } elsif ((ref $value) ne 'Regexp') {
# 296: push @query, "$xpath_name = \"$value\"";
# 297: push @postvalidation, sub {
# 298: return __get_node_content( shift,$name ) eq $value
# 299: };
# 300: } else {
# 301: push @query, "$xpath_name";
# 302: push @postvalidation, sub {
# 303: return __get_node_content( shift,$name ) =~ $value
# 304: };
# 305: };
# 306: };
# 307: $query .= "[" . join( " and ", map {"$_"} @query ) . "]"
# 308: if @query;
# 309: };
# 310: my $postvalidation = sub {
# 311: my $node = shift;
# 312: my $test;
# 313: for $test (@postvalidation) {
# 314: return () unless $test->($node);
# 315: };
# 316: return 1;
# 317: };
# 318: ($query,$postvalidation);
# 319: };
# 320:
# 321: sub __count_tags {
# 322: my ($HTML,$tag,$attrref) = @_;
# 323: $attrref = {} unless defined $attrref;
# 324:
# 325: my $fallback = lc "//$tag";
# 326: my ($query,$valid) = __build_xpath_query( lc "//$tag", $attrref );
# 327: my $tree = __get_node_tree($HTML,$query);
# 328: return (undef,undef) unless $tree;
# 329:
# 330: my @found = grep { $valid->($_) } ($tree->get_nodelist);
# 331:
# 332: # Collect the nodes we did see for later reference :
# 333: my @seen;
# 334: foreach my $node (__get_node_tree($HTML,$fallback)->get_nodelist) {
# 335: push @seen, __node_content($node);
# 336: };
# 337: return scalar(@found),\@seen;
# 338: };
# 339:
# 340: sub __tag_diag {
# 341: my ($tag,$num,$attrs,$found) = @_;
# 342: my $phrase = "Expected to find $num <$tag> tag(s)";
# 343: $phrase .= " matching" if (scalar keys %$attrs > 0);
# 344: $Test->diag($phrase);
# 345: $Test->diag(" $_ = " . (defined $attrs->{$_} ? $attrs->{$_} : ''))
# 346: for sort keys %$attrs;
# 347: if (@$found) {
# 348: $Test->diag("Got");
# 349: $Test->diag(" " . $_) for @$found;
# 350: } else {
# 351: $Test->diag("Got none");
# 352: };
# 353: };
# 354:
# 355: sub __output_tag {
# 356: my ($check,$expectation,$HTML,$tag,$attrref,$name) = @_;
# 357: ($attrref,$name) = ({},$attrref)
# 358: unless defined $name;
# 359: $attrref = {}
# 360: unless defined $attrref;
# 361: croak "$attrref dosen't look like a hash reference for the attributes"
# 362: unless ref $attrref eq 'HASH';
# 363: my ($currcount,$seen) = __count_tags($HTML,$tag,$attrref);
# 364: my $result;
# 365: if (defined $currcount) {
# 366: if ($currcount eq 'skip') {
# 367: $Test->skip($seen);
# 368: } else {
# 369: local $Test::Builder::Level = $Test::Builder::Level +1;
# 370: $result = $check->($currcount);
# 371: unless ($Test->ok($result, $name)) {
# 372: __tag_diag($tag,$expectation,$attrref,$seen) ;
# 373: };
# 374: };
# 375: } else {
# 376: local $Test::Builder::Level = $Test::Builder::Level +2;
# 377: __invalid_html($HTML,$name);
# 378: };
# 379:
# 380: $result;
# 381: };
# 382:
# 383: sub tag_count {
# 384: my ($HTML,$tag,$attrref,$count,$name) = @_;
# 385: __output_tag(sub { shift == $count }, "exactly $count",$HTML,$tag,$attrref,$name);
# 386: };
# 387:
# 388: sub tag_ok {
# 389: my ($HTML,$tag,$attrref,$name) = @_;
# 390: __output_tag(sub { shift > 0 }, "at least one",$HTML,$tag,$attrref,$name);
# 391: };
# 392:
# 393: sub no_tag {
# 394: my ($HTML,$tag,$attrref,$name) = @_;
# 395: __output_tag(sub { shift == 0 }, "no",$HTML,$tag,$attrref,$name);
# 396: };
# 397:
# 398: sub link_count {
# 399: my ($HTML,$link,$count,$name) = @_;
# 400: local $Test::Builder::Level = 2;
# 401: return tag_count($HTML,"a",{href => $link},$count,$name);
# 402: };
# 403:
# 404: sub link_ok {
# 405: my ($HTML,$link,$name) = (@_);
# 406: local $Test::Builder::Level = 2;
# 407: return tag_ok($HTML,'a',{ href => $link },$name);
# 408: };
# 409:
# 410: sub no_link {
# 411: my ($HTML,$link,$name) = (@_);
# 412: local $Test::Builder::Level = 2;
# 413: return no_tag($HTML,'a',{ href => $link },$name);
# 414: };
# 415:
# 416: sub title_ok {
# 417: my ($HTML,$title,$name) = @_;
# 418: local $Test::Builder::Level = 2;
# 419: return tag_ok($HTML,"title",{_content => $title},$name);
# 420: };
# 421:
# 422: sub no_title {
# 423: my ($HTML,$title,$name) = (@_);
# 424: local $Test::Builder::Level = 2;
# 425: return no_tag($HTML,'title',{ _content => $title },$name);
# 426: };
# 427:
# 428: sub __match_declaration {
# 429: my ($text,$template) = @_;
# 430: $text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
# 431: unless (ref $template eq "Regexp") {
# 432: $text =~ s/^\s*(.*?)\s*$/$1/;
# 433: $template =~ s/^\s*(.*?)\s*$/$1/;
# 434: };
# 435: return __dwim_compare($text, $template);
# 436: };
# 437:
# 438: sub __count_declarations {
# 439: my ($HTML,$doctype) = @_;
# 440: my $result = 0;
# 441: my $seen = [];
# 442:
# 443: my $p = HTML::TokeParser->new(\$HTML);
# 444: my $token;
# 445: while ($token = $p->get_token) {
# 446: my ($type,$text) = @$token;
# 447: if ($type eq "D") {
# 448: push @$seen, $text;
# 449: $result++ if __match_declaration($text,$doctype);
# 450: };
# 451: };
# 452:
# 453: return $result, $seen;
# 454: };
# 455:
# 456: sub has_declaration {
# 457: my ($HTML,$declaration,$name) = @_;
# 458: my ($result,$seen) = __count_declarations($HTML,$declaration);
# 459:
# 460: if (defined $result) {
# 461: __output_diag($result == 1,$declaration,"exactly one declaration","declaration",$name,$seen);
# 462: } else {
# 463: local $Test::Builder::Level = $Test::Builder::Level +1;
# 464: __invalid_html($HTML,$name);
# 465: };
# 466:
# 467: $result;
# 468: };
# 469:
# 470: sub no_declaration {
# 471: my ($HTML,$declaration,$name) = @_;
# 472: my ($result,$seen) = __count_declarations($HTML,$declaration);
# 473:
# 474: if (defined $result) {
# 475: __output_diag($result == 0,$declaration,"no declaration","declaration",$name,$seen);
# 476: } else {
# 477: local $Test::Builder::Level = $Test::Builder::Level +1;
# 478: __invalid_html($HTML,$name);
# 479: };
# 480:
# 481: $result;
# 482: };
# 483:
# 484: sub __count_xpath {
# 485: my ($HTML,$query,$fallback) = @_;
# 486:
# 487: $fallback = $query unless defined $fallback;
# 488: my $tree = __get_node_tree($HTML,$query);
# 489: return (undef,undef) unless $tree;
# 490:
# 491: my @found = ($tree->get_nodelist);
# 492:
# 493: # Collect the nodes we did see for later reference :
# 494: my @seen;
# 495: foreach my $node (__get_node_tree($HTML,$fallback)->get_nodelist) {
# 496: push @seen, __node_content($node);
# 497: };
# 498: return scalar(@found),\@seen;
# 499: };
# 500:
# 501: sub __xpath_diag {
# 502: my ($query,$num,$found) = @_;
# 503: my $phrase = "Expected to find $num nodes matching on '$query'";
# 504: if (@$found) {
# 505: $Test->diag("Got");
# 506: $Test->diag(" $_") for @$found;
# 507: } else {
# 508: $Test->diag("Got none");
# 509: };
# 510: };
# 511:
# 512: sub __output_xpath {
# 513: my ($check,$expectation,$HTML,$query,$fallback,$name) = @_;
# 514: ($fallback,$name) = ($query,$fallback) unless $name;
# 515: my ($currcount,$seen) = __count_xpath($HTML,$query,$fallback);
# 516: my $result;
# 517: if (defined $currcount) {
# 518: if ($currcount eq 'skip') {
# 519: $Test->skip($seen);
# 520: } else {
# 521: local $Test::Builder::Level = $Test::Builder::Level +1;
# 522: $result = $check->($currcount);
# 523: unless ($Test->ok($result, $name)) {
# 524: __xpath_diag($query,$expectation,$seen) ;
# 525: };
# 526: };
# 527: } else {
# 528: local $Test::Builder::Level = $Test::Builder::Level +1;
# 529: __invalid_html($HTML,$name);
# 530: };
# 531:
# 532: $result;
# 533: };
# 534:
# 535: sub xpath_count {
# 536: my ($HTML,$query,$count,$fallback,$name) = @_;
# 537: __output_xpath( sub {shift == $count},"exactly $count",$HTML,$query,$fallback,$name);
# 538: };
# 539:
# 540: sub xpath_ok {
# 541: my ($HTML,$query,$fallback,$name) = @_;
# 542: __output_xpath( sub{shift > 0},"at least one",$HTML,$query,$fallback,$name);
# 543: };
# 544:
# 545: sub no_xpath {
# 546: my ($HTML,$query,$fallback,$name) = @_;
# 547: __output_xpath( sub{shift == 0},"no",$HTML,$query,$fallback,$name);
# 548: };
# 549:
# 550: sub install_xpath {
# 551: require XML::XPath;
# 552: XML::XPath->import();
# 553: die "Need XML::XPath 1.13 or higher"
# 554: unless $XML::XPath::VERSION >= 1.13;
# 555: $can_xpath = 'XML::XPath';
# 556: };
# 557:
# 558: sub install_libxml {
# 559: local $^W;
# 560: require XML::LibXML;
# 561: XML::LibXML->import();
# 562: $can_xpath = 'XML::LibXML';
# 563: };
# 564:
# 565: # And install our plain handlers if we have to :
# 566: sub install_pureperl {
# 567: require Test::HTML::Content::NoXPath;
# 568: Test::HTML::Content::NoXPath->import;
# 569: };
# 570:
# 571: BEGIN {
# 572: # Load the XML-variant if our prerequisites are there :
# 573: eval { install_libxml }
# 574: or eval { install_xpath }
# 575: or install_pureperl;
# 576: };
# 577:
# 578: {
# 579: package Test::HTML::Content::EmptyXPathResult;
# 580: sub size { 0 };
# 581: sub get_nodelist { () };
# 582: };
# 583:
# 584: 1;
# 585:
# 586: __END__
# 587:
# 588: =head1 NAME
# 589:
# 590: Test::HTML::Content - Perl extension for testing HTML output
# 591:
# 592: =head1 SYNOPSIS
# 593:
# 594: use Test::HTML::Content( tests => 13 );
# 595:
# 596: =for example begin
# 597:
# 598: $HTML = "A test pageHome page
# 599:
# 600: Perl
# 601:
# 602: ";
# 603:
# 604: link_ok($HTML,"http://www.perl.com","We link to Perl");
# 605: no_link($HTML,"http://www.pearl.com","We have no embarassing typos");
# 606: link_ok($HTML,qr"http://[a-z]+\.perl.com","We have a link to perl.com");
# 607:
# 608: title_count($HTML,1,"We have one title tag");
# 609: title_ok($HTML,qr/test/);
# 610:
# 611: tag_ok($HTML,"img", {src => "http://www.perl.com/camel.png"},
# 612: "We have an image of a camel on the page");
# 613: tag_count($HTML,"img", {src => "http://www.perl.com/camel.png"}, 2,
# 614: "In fact, we have exactly two camel images on the page");
# 615: no_tag($HTML,"blink",{}, "No annoying blink tags ..." );
# 616:
# 617: # We can check the textual contents
# 618: text_ok($HTML,"Perl");
# 619:
# 620: # We can also check the contents of comments
# 621: comment_ok($HTML,"Hidden message");
# 622:
# 623: # Advanced stuff
# 624:
# 625: # Using a regular expression to match against
# 626: # tag attributes - here checking there are no ugly styles
# 627: no_tag($HTML,"p",{ style => qr'ugly$' }, "No ugly styles" );
# 628:
# 629: # REs also can be used for substrings in comments
# 630: comment_ok($HTML,qr"[hH]idden\s+mess");
# 631:
# 632: # and if you have XML::LibXML or XML::XPath, you can
# 633: # even do XPath queries yourself:
# 634: xpath_ok($HTML,'/html/body/p','HTML is somewhat wellformed');
# 635: no_xpath($HTML,'/html/head/p','HTML is somewhat wellformed');
# 636:
# 637: =for example end
# 638:
# 639: =head1 DESCRIPTION
# 640:
# 641: This is a module to test the HTML output of your programs in simple
# 642: test scripts. It can test a scalar (presumably containing HTML) for
# 643: the presence (or absence, or a specific number) of tags having (or
# 644: lacking) specific attributes. Unspecified attributes are ignored,
# 645: and the attribute values can be specified as either scalars (meaning
# 646: a match succeeds if the strings are identical) or regular expressions
# 647: (meaning that a match succeeds if the actual attribute value is matched
# 648: by the given RE) or undef (meaning that the attribute must not
# 649: be present).
# 650:
# 651: If you want to specify or test the deeper structure
# 652: of the HTML (for example, META tags within the BODY) or the (textual)
# 653: content of tags, you will have to resort to C,C
# 654: and C, which take an XPath expression. If you find yourself crafting
# 655: very complex XPath expression to verify the structure of your output, it is
# 656: time to rethink your testing process and maybe use a template based solution
# 657: or simply compare against prefabricated files as a whole.
# 658:
# 659: The used HTML parser is HTML::TokeParser, the used XPath module
# 660: is XML::XPath or XML::LibXML. XML::XPath needs valid xHTML, XML::LibXML
# 661: will try its best to force your code into xHTML, but it is best to
# 662: supply valid xHTML (snippets) to the test functions.
# 663:
# 664: If no XPath parsers/interpreters are available, the tests will automatically
# 665: skip, so your users won't need to install XML::XPath or XML::LibXML. The module
# 666: then falls back onto a crude implementation of the core functions for tags,
# 667: links, comments and text, and the diagnostic output of the tests varies a bit.
# 668:
# 669: The test functionality is derived from L, and the export
# 670: behaviour is the same. When you use Test::HTML::Content, a set of
# 671: HTML testing functions is exported into the namespace of the caller.
# 672:
# 673: =head2 EXPORT
# 674:
# 675: Exports the bunch of test functions :
# 676:
# 677: link_ok() no_link() link_count()
# 678: tag_ok() no_tag() tag_count()
# 679: text_ok no_text() text_count()
# 680: comment_ok() no_comment() comment_count()
# 681: xpath_ok() no_xpath() xpath_count()
# 682: has_declaration() no_declaration()
# 683:
# 684: =head2 CONSIDERATIONS
# 685:
# 686: The module reparses the HTML string every time a test function is called.
# 687: This will make running many tests over the same, large HTML stream relatively
# 688: slow. A possible speedup could be simple minded caching mechanism that keeps the most
# 689: recent HTML stream in a cache.
# 690:
# 691: =head2 CAVEATS
# 692:
# 693: The test output differs between XPath and HTML parsing, because XML::XPath
# 694: delivers the complete node including the content, where my HTML parser only
# 695: delivers the start tag. So don't make your tests depend on the _exact_
# 696: output of my tests. It was a pain to do so in my test scripts for this module
# 697: and if you really want to, take a look at the included test scripts.
# 698:
# 699: The title functions C and C rely on the XPath functionality
# 700: and will thus skip if XPath functionality is unavailable.
# 701:
# 702: =head2 BUGS
# 703:
# 704: Currently, if there is text split up by comments, the text will be seen
# 705: as two separate entities, so the following dosen't work :
# 706:
# 707: is_text( "Hello World", "Hello World" );
# 708:
# 709: Whether this is a real bug or not, I don't know at the moment - most likely,
# 710: I'll modify text_ok() and siblings to ignore embedded comments.
# 711:
# 712: =head2 TODO
# 713:
# 714: My things on the todo list for this module. Patches are welcome !
# 715:
# 716: =over 4
# 717:
# 718: =item * Refactor the code to fold some of the internal routines
# 719:
# 720: =item * Implement a cache for the last parsed tree / token sequence
# 721:
# 722: =item * Possibly diag() the row/line number for failing tests
# 723:
# 724: =item * Allow RE instead of plain strings in the functions (for tags themselves). This
# 725: one is most likely useless.
# 726:
# 727: =back
# 728:
# 729: =head1 LICENSE
# 730:
# 731: This code may be distributed under the same terms as Perl itself.
# 732:
# 733: =head1 AUTHOR
# 734:
# 735: Max Maischein Ecorion@cpan.orgE
# 736:
# 737: =head1 SEE ALSO
# 738:
# 739: perl(1), L,L,L.
# 740:
# 741: =cut
# Failed test (t\99-unix-text.t at line 34)
# got: '225'
# expected: '0'
# 0: package Test::HTML::Content::NoXPath;
not ok 6 - 'lib/Test/HTML/Content/NoXPath.pm' contains no windows newlines
# 1:
# 2: require 5.005_62;
# 3: use strict;
# 4: use File::Spec;
# 5: use HTML::TokeParser;
# 6:
# 7: # we want to stay compatible to 5.5 and use warnings if
# 8: # we can
# 9: eval 'use warnings;' if ($] >= 5.006);
# 10: use vars qw( $HTML_PARSER_StripsTags $VERSION @exports );
# 11:
# 12: $VERSION = '0.07';
# 13:
# 14: BEGIN {
# 15: # Check whether HTML::Parser is v3 and delivers the comments starting
# 16: # with the ";
# 18: my $p = HTML::TokeParser->new(\$HTML);
# 19: my ($type,$text) = @{$p->get_token()};
# 20: if ($text eq "") {
# 21: $HTML_PARSER_StripsTags = 0
# 22: } else {
# 23: $HTML_PARSER_StripsTags = 1
# 24: };
# 25: };
# 26:
# 27: # import what we need
# 28: { no strict 'refs';
# 29: *{$_} = *{"Test::HTML::Content::$_"}
# 30: for qw( __dwim_compare __output_diag __invalid_html );
# 31: };
# 32:
# 33: @exports = qw( __match_comment __count_comments __match_text __count_text
# 34: __match __count_tags __match_declaration __count_declarations );
# 35:
# 36: sub __match_comment {
# 37: my ($text,$template) = @_;
# 38: $text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
# 39: unless (ref $template eq "Regexp") {
# 40: $text =~ s/^\s*(.*?)\s*$/$1/;
# 41: $template =~ s/^\s*(.*?)\s*$/$1/;
# 42: };
# 43: return __dwim_compare($text, $template);
# 44: };
# 45:
# 46: sub __count_comments {
# 47: my ($HTML,$comment) = @_;
# 48: my $result = 0;
# 49: my $seen = [];
# 50:
# 51: my $p = HTML::TokeParser->new(\$HTML);
# 52: my $token;
# 53: while ($token = $p->get_token) {
# 54: my ($type,$text) = @$token;
# 55: if ($type eq "C") {
# 56: push @$seen, $token->[1];
# 57: $result++ if __match_comment($text,$comment);
# 58: };
# 59: };
# 60:
# 61: return ($result, $seen);
# 62: };
# 63:
# 64: sub __match_text {
# 65: my ($text,$template) = @_;
# 66: unless (ref $template eq "Regexp") {
# 67: $text =~ s/^\s*(.*?)\s*$/$1/;
# 68: $template =~ s/^\s*(.*?)\s*$/$1/;
# 69: };
# 70: return __dwim_compare($text, $template);
# 71: };
# 72:
# 73: sub __count_text {
# 74: my ($HTML,$text) = @_;
# 75: my $result = 0;
# 76: my $seen = [];
# 77:
# 78: my $p = HTML::TokeParser->new(\$HTML);
# 79: $p->unbroken_text(1);
# 80:
# 81: my $token;
# 82: while ($token = $p->get_token) {
# 83: my ($type,$foundtext) = @$token;
# 84: if ($type eq "T") {
# 85: push @$seen, $token->[1];
# 86: $result++ if __match_text($foundtext,$text);
# 87: };
# 88: };
# 89:
# 90: return $result,$seen;
# 91: };
# 92:
# 93: sub __match {
# 94: my ($attrs,$currattr,$key) = @_;
# 95: my $result = 1;
# 96:
# 97: if (exists $currattr->{$key}) {
# 98: if (! defined $attrs->{$key}) {
# 99: $result = 0; # We don't want to see this attribute here
# 100: } else {
# 101: $result = 0 unless __dwim_compare($currattr->{$key}, $attrs->{$key});
# 102: };
# 103: } else {
# 104: if (! defined $attrs->{$key}) {
# 105: $result = 0 if (exists $currattr->{$key});
# 106: } else {
# 107: $result = 0;
# 108: };
# 109: };
# 110: return $result;
# 111: };
# 112:
# 113: sub __count_tags {
# 114: my ($HTML,$tag,$attrref) = @_;
# 115: $attrref = {} unless defined $attrref;
# 116: return ('skip','XML::LibXML or XML::XPath not loaded')
# 117: if exists $attrref->{_content};
# 118:
# 119: my $result = 0;
# 120: $tag = lc $tag;
# 121:
# 122: my $p = HTML::TokeParser->new(\$HTML);
# 123: my $token;
# 124: my @seen;
# 125: while ($token = $p->get_token) {
# 126: my ($type,$currtag,$currattr,$attrseq,$origtext) = @$token;
# 127: if ($type eq "S" && $tag eq $currtag) {
# 128: my (@keys) = keys %$attrref;
# 129: my $key;
# 130: my $complete = 1;
# 131: foreach $key (@keys) {
# 132: $complete = __match($attrref,$currattr,$key) if $complete;
# 133: };
# 134: $result += $complete;
# 135: # Now munge the thing to resemble what the XPath variant returns :
# 136: push @seen, $token->[4];
# 137: };
# 138: };
# 139:
# 140: return $result,\@seen;
# 141: };
# 142:
# 143: sub __match_declaration {
# 144: my ($text,$template) = @_;
# 145: $text =~ s/^$/$1/ unless $HTML_PARSER_StripsTags;
# 146: unless (ref $template eq "Regexp") {
# 147: $text =~ s/^\s*(.*?)\s*$/$1/;
# 148: $template =~ s/^\s*(.*?)\s*$/$1/;
# 149: };
# 150: return __dwim_compare($text, $template);
# 151: };
# 152:
# 153: sub __count_declarations {
# 154: my ($HTML,$doctype) = @_;
# 155: my $result = 0;
# 156: my $seen = [];
# 157:
# 158: my $p = HTML::TokeParser->new(\$HTML);
# 159: my $token;
# 160: while ($token = $p->get_token) {
# 161: my ($type,$text) = @$token;
# 162: if ($type eq "D") {
# 163: push @$seen, $text;
# 164: $result++ if __match_declaration($text,$doctype);
# 165: };
# 166: };
# 167:
# 168: return $result, $seen;
# 169: };
# 170:
# 171: sub import {
# 172: goto &install;
# 173: };
# 174:
# 175: sub install {
# 176: for (@exports) {
# 177: no strict 'refs';
# 178: *{"Test::HTML::Content::$_"} = *{"Test::HTML::Content::NoXPath::$_"};
# 179: };
# 180: $Test::HTML::Content::can_xpath = 0;
# 181: };
# 182:
# 183: 1;
# 184:
# 185: __END__
# 186:
# 187: =head1 NAME
# 188:
# 189: Test::HTML::Content::NoXPath - HTML::TokeParser fallback for Test::HTML::Content
# 190:
# 191: =head1 SYNOPSIS
# 192:
# 193: =for example begin
# 194:
# 195: # This module is implicitly loaded by Test::HTML::Content
# 196: # if XML::XPath or HTML::Tidy::Simple are unavailable.
# 197:
# 198: =for example end
# 199:
# 200: =head1 DESCRIPTION
# 201:
# 202: This is the module that gets loaded when Test::HTML::Content
# 203: can't find its prerequisites :
# 204:
# 205: XML::XPath
# 206: HTML::Tidy
# 207:
# 208: =head2 EXPORT
# 209:
# 210: Nothing. It stomps over the Test::HTML::Content namespace.
# 211:
# 212: =head1 LICENSE
# 213:
# 214: This code may be distributed under the same terms as Perl itself.
# 215:
# 216: =head1 AUTHOR
# 217:
# 218: Max Maischein, corion@cpan.org
# 219:
# 220: =head1 SEE ALSO
# 221:
# 222: L,L,L,L,L
# 223:
# 224: =cut
# Failed test (t\99-unix-text.t at line 34)
# got: '99'
# expected: '0'
# 0: package Test::HTML::Content::XPathExtensions;
not ok 7 - 'lib/Test/HTML/Content/XPathExtensions.pm' contains no windows newlines
# 1:
# 2: require 5.005_62;
# 3: use strict;
# 4: use File::Spec;
# 5: use HTML::TokeParser;
# 6:
# 7: # we want to stay compatible to 5.5 and use warnings if
# 8: # we can
# 9: eval 'use warnings;' if ($] >= 5.006);
# 10: use vars qw( $HTML_PARSER_StripsTags $VERSION @exports );
# 11:
# 12: $VERSION = '0.01';
# 13:
# 14: @exports = qw( matches comment );
# 15:
# 16: sub matches {
# 17: my $self = shift;
# 18: my ($node, @params) = @_;
# 19: die "starts-with: incorrect number of params\n" unless @params == 2;
# 20: my $re = $params[1]->string_value;
# 21: return($params[0]->string_value =~ /$re/)
# 22: ? XML::XPath::Boolean->True
# 23: : XML::XPath::Boolean->False;
# 24: }
# 25:
# 26: sub comment {
# 27: my $self = shift;
# 28: my ($node, @params) = @_;
# 29: die "starts-with: incorrect number of params\n" unless @params == 1;
# 30: my $re = $params[1]->string_value;
# 31: return(ref $node =~ /Comment$/)
# 32: ? XML::XPath::Boolean->True
# 33: : XML::XPath::Boolean->False;
# 34: };
# 35:
# 36:
# 37: sub import {
# 38: for (@exports) {
# 39: no strict 'refs';
# 40: # Install our extensions unless they already exist :
# 41: *{"XML::XPath::Function::$_"} = *{"Test::HTML::Content::XPathExtensions::$_"}
# 42: unless defined *{"XML::XPath::Function::$_"}{CODE};
# 43: };
# 44: };
# 45:
# 46: 1;
# 47:
# 48: __END__
# 49:
# 50: =head1 NAME
# 51:
# 52: Test::HTML::Content::XPathExtensions - Perlish XPath extensions
# 53:
# 54: =head1 SYNOPSIS
# 55:
# 56: =for example begin
# 57:
# 58: # This module patches the XML::XPath::Function namespace
# 59: use Test::HTML::Content::XPathExtensions;
# 60:
# 61: =for example end
# 62:
# 63: =head1 DESCRIPTION
# 64:
# 65: This is the module that provides RE support for XML::XPath
# 66: and support for matching comments through the two functions
# 67: C and C.
# 68:
# 69: The two functions are modeled after what I found on the Saxon
# 70: website on the C namespace :
# 71:
# 72: =over 4
# 73:
# 74: =item *
# 75: http://saxon.sourceforge.net/saxon7.3.1/functions.html
# 76:
# 77: =item *
# 78: http://www.w3.org/TR/xquery-operators/
# 79:
# 80: =back
# 81:
# 82: =head2 EXPORT
# 83:
# 84: Nothing. It stomps over the XML::XPath::Function namespace.
# 85:
# 86: =head1 LICENSE
# 87:
# 88: This code may be distributed under the same terms as Perl itself.
# 89:
# 90: =head1 AUTHOR
# 91:
# 92: Max Maischein, corion@cpan.org
# 93:
# 94: =head1 SEE ALSO
# 95:
# 96: L
# 97:
# 98: =cut
# Looks like you failed 7 tests of 7.
dubious
Test returned status 7 (wstat 1792, 0x700)
DIED. FAILED tests 1-7
Failed 7/7 tests, 0.00% okay
t\embedded-Test-HTML-Content-NoXPath............ok 1 - example from line 195
1..1
ok
t\embedded-Test-HTML-Content-XPathExtensions....ok 1 - example from line 58
1..1
ok
t\embedded-Test-HTML-Content....................ok 1 - example from line 598
1..1
ok
Failed 4/26 test scripts, 84.62% okay. 20/448 subtests failed, 95.54% okay.
Failed Test Stat Wstat Total Fail Failed List of Failed
-------------------------------------------------------------------------------
t\01-fallback-xpath.t 2 512 4 2 50.00% 3-4
t\09-errors.xpath.t 7 5 71.43% 2 4-7
t\12-title.t 255 65280 7 6 85.71% 2-7
t\99-unix-text.t 7 1792 7 7 100.00% 1-7
8 subtests skipped.
NMAKE : fatal error U1077: 'C:\cpanrun-5.8\build\5-8-0\bin\perl.exe' : return code '0xff'
Stop.