my $item_data = $p{item_data}->($p{wrapper_data});
last unless defined $item_data;
- warn Dumper('item_data', $item_data);
+ warn Dumper('item_data', $item_data) if $p{debug};
my $item_elems = [ map { $_->clone } @{$_item_elems} ] ;
if ($p{debug}) {
for (@{$item_elems}) {
- warn 'ITEM_ELEMS ', $_->as_HTML;
+ warn 'ITEM_ELEMS ', $_->as_HTML if $p{debug};
}
}
if ($p{debug}) {
for (@{$new_item_elems}) {
- warn 'NEWITEM_ELEMS ', $_->as_HTML;
+ warn 'NEWITEM_ELEMS ', $_->as_HTML if $p{debug};
}
}
-# Welcome to a -*- perl -*- test script
+#!/usr/bin/perl
use strict;
-use Test::More qw(no_plan);
+use warnings;
-sub req_ver {
- my $string = shift;
- my $eval = "#Using $string version v\$${string}::VERSION\n";
- my $eval2 = sprintf 'warn "%s"', $eval;
- require_ok($string);
- eval $eval2 ;
-}
+use Test::More tests => 1;
-my @module =
- qw(
- Array::Group
- File::Slurp
-
- HTML::PrettyPrinter
- HTML::Tree
- HTML::Element
- HTML::Parser
- HTML::Entities
- HTML::Tagset
-
- List::Rotation::Cycle
- List::MoreUtils
-
- Params::Validate
-
- Scalar::Listify
- ) ;
-
-req_ver($_) for @module;
-
-warn "# Running under perl version $] for $^O",
- (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n";
-warn "# Win32::BuildNumber ", &Win32::BuildNumber(), "\n"
- if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber();
-warn "# MacPerl verison $MacPerl::Version\n"
- if defined $MacPerl::Version;
-warn sprintf
- "# Current time local: %s\n# Current time GMT: %s\n",
- scalar(localtime($^T)), scalar(gmtime($^T));
-
-ok 1;
+diag "Running under perl version $] for $^O", (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n";
+diag "Win32::BuildNumber ", &Win32::BuildNumber(), "\n" if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber();
+diag "MacPerl verison $MacPerl::Version\n" if defined $MacPerl::Version;
+diag sprintf "Current time local: %s\n", scalar localtime;
+diag sprintf "Current time GMT: %s\n", scalar gmtime;
+pass;
+++ /dev/null
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl HTML-Element-Library.t'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 1 };
-use HTML::Element::Library;
-ok(1); # If we made it this far, we're ok.
-
-#########################
-
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-
-use strict;
-use Test::More qw(no_plan);
+#!/usr/bin/perl
+use t::lib tests => 1;
+
+my $t1 = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ [ 'title', 'I like stuff!' ]],
+ ['body', {id => 'corpus'}, {'lang', 'en-JP'},
+ 'stuff',
+ ['p', 'um, p < 4!', {'class' => 'par123'}],
+ ['div', {foo => 'bar'}, '123'], # at 0.1.2
+ ['div', {jack => 'olantern'}, '456']]]); # at 0.1.2
-use HTML::Element::Library;
-
-
-my $t1;
-my $lol;
-$t1 = HTML::Element->new_from_lol
- (
- $lol =
- ['html',
- ['head',
- [ 'title', 'I like stuff!' ],
- ],
- ['body', {id => 'corpus'},
- {
- 'lang', 'en-JP'},
- 'stuff',
- ['p', 'um, p < 4!', {'class' => 'par123'}],
- ['div', {foo => 'bar'}, '123'], # at 0.1.2
- ['div', {jack => 'olantern'}, '456'], # at 0.1.2
- ]
- ]
- )
- ;
-
-
-#$t1->look_down('_tag' => 'body')->replace_content('all gone!');
$t1->content_handler(corpus => 'all gone!');
-is( $t1->as_HTML, '<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', "replaced all of body");
-
-
+isxml $t1, \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', 'content_handler';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;use warnings;
+#!/usr/bin/perl
+use t::lib tests => 1;
-use File::Slurp qw/read_file/;
-use Test::More;
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-sub tage {
-
- my $root = "t/html/crunch/crunch";
-
- my $tree = HTML::TreeBuilder->new_from_file("$root.initial")->guts;
-
- $tree->crunch(look_down => [ class => 'imageElement' ], leave => 1);
-
- is_xml $tree->as_XML, scalar read_file("$root.exp"), 'XML for crunch';
-}
-
-
-tage();
-
-done_testing;
+my $tree = mktree 't/html/crunch.html';
+$tree->crunch(look_down => [ class => 'imageElement' ], leave => 1);
+isxml $tree, 't/html/crunch.exp', 'crunch';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;use warnings;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-use Test::XML;
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-
-sub tage {
-
- my $root = "t/html/defmap/defmap";
-
- my $tree = HTML::TreeBuilder->new_from_file("$root.initial")->guts;
-
- #warn "TREE: $tree" . $tree->as_HTML;
-
- my %data = (pause => 'arsenal rules');
-
- $tree->defmap(smap => \%data, 1);
-
- my $g = $tree->as_XML;
- my $e = File::Slurp::read_file("$root.exp");
- warn "generated:$g:\nexpected:$e:";
-
- is_xml ($g, $e, "XML for defmap");
-}
-
-
-tage();
+#!/usr/bin/perl
+use t::lib tests => 1;
+my $tree = mktree 't/html/defmap.html';
+$tree->defmap(smap => {pause => 'arsenal rules'}, $ENV{TEST_VERBOSE});
+isxml $tree, 't/html/defmap.exp', 'defmap';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-# this is a simpler call to iter2()
-
-my $root = 't/html/dual_iter';
-
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-my $dl = $tree->look_down(id => 'service_plan');
-
-
-my @items = (
- ['the pros' => 'never have to worry about service again'],
- ['the cons' => 'upfront extra charge on purchase'],
- ['our choice' => 'go with the extended service plan']
- );
+#!/usr/bin/perl
+use t::lib tests => 1;
+my $tree = mktree 't/html/dual_iter.html';
$tree->iter2(
-
- wrapper_data => \@items,
-
- wrapper_proc => sub {
- my ($container) = @_;
-
- # only keep the last 2 dts and dds
- my @content_list = $container->content_list;
- $container->splice_content(0, @content_list - 2);
- },
-
-
- splice => sub {
- my ($container, @item_elems) = @_;
- $container->unshift_content(@item_elems);
- },
-
- debug => 1,
-
- );
-
-
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"),
- "XML for generated li");
+ wrapper_data => [
+ ['the pros' => 'never have to worry about service again'],
+ ['the cons' => 'upfront extra charge on purchase'],
+ ['our choice' => 'go with the extended service plan']
+ ],
+ wrapper_proc => sub {
+ my ($container) = @_;
+ # only keep the last 2 dts and dds
+ my @content_list = $container->content_list;
+ $container->splice_content(0, @content_list - 2);
+ },
+ splice => sub {
+ my ($container, @item_elems) = @_;
+ $container->unshift_content(@item_elems);
+ },
+ debug => $ENV{TEST_VERBOSE},
+);
+
+isxml $tree, 't/html/dual_iter.exp', 'dual_iter';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;use warnings;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-sub tage {
-
- my $root = "t/html/fillinform/fillinform";
-
- my $tree = HTML::TreeBuilder->new_from_file("$root.initial")->guts;
-
- my %data = (state => 'catatonic');
-
- my $new_tree = HTML::TreeBuilder->new_from_content( $tree->fillinform(\%data) ) ;
-
- is_xml ($new_tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "HTML for fillinform");
-}
-
-
-tage();
+#!/usr/bin/perl
+use t::lib tests => 1;
+my $tree = mktree 't/html/fillinform.html';
+isxml \($tree->fillinform({state => 'catatonic'})), 't/html/fillinform.exp', 'fillinform';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-sub replace_age {
- my $branch = shift;
- my $age = shift;
- $branch->look_down(id => 'age')->replace_content($age);
-}
-
-
-sub tage {
-
- my $root = "t/html/same_as/same_as";
-
- my $tree = HTML::TreeBuilder->new_from_file("$root.initial");
-
- #warn "TREE: $tree" . $tree->as_HTML;
-
- my %data = (people_id => 888, phone => '444-4444', email => 'm@xml.com');
-
- $tree->hash_map
- (hash => \%data,
- to_attr => 'sid',
- excluding => [ 'email' ]
- );
-
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "XML for same_as");
-}
-
-
-tage();
+#!/usr/bin/perl
+use t::lib tests => 1;
+
+my $tree = mktree 't/html/hashmap.html';
+$tree->hash_map(
+ hash => {people_id => 888, phone => '444-4444', email => 'm@xml.com'},
+ to_attr => 'sid',
+ excluding => ['email']
+);
+isxml $tree, 't/html/hashmap.exp', 'hash_map';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-sub tage {
- my $age = shift;
- my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander.html');
-
-
- $tree->highlander
- (age_dialog =>
- [
- under10 => sub { $_[0] < 10} ,
- under18 => sub { $_[0] < 18} ,
- welcome => sub { 1 }
- ],
- $age
- );
-
- my $root = "t/html/highlander-$age";
-
- local $_; # XML::Parser does not like read-only $_ (RT #101129)
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "XML for $age");
+#!/usr/bin/perl
+use t::lib tests => 3;
+
+sub test {
+ my $age = shift;
+ my $tree = mktree 't/html/highlander.html';
+
+ $tree->highlander(
+ age_dialog => [
+ under10 => sub { $_[0] < 10 },
+ under18 => sub { $_[0] < 18 },
+ welcome => sub { 1 }
+ ],
+ $age
+ );
+
+ local $_; # XML::Parser does not like read-only $_ (RT #101129)
+ isxml $tree, "t/html/highlander-$age.exp", "highlander for $age";
}
-
-tage($_) for qw(5 15 50);
+test $_ for qw(5 15 50);
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
+#!/usr/bin/perl
+use t::lib tests => 3;
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-sub replace_age {
- my $branch = shift;
- my $age = shift;
- $branch->look_down(id => 'age')->replace_content($age);
+sub replace_age {
+ my ($branch, $age) = @_;
+ $branch->look_down(id => 'age')->replace_content($age);
}
-
-sub tage {
- my $age = shift;
- my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander2.html');
- my $if_then = $tree->look_down(id => 'age_dialog');
-
- $if_then->highlander2(
- cond => [
- under10 => [
- sub { $_[0] < 10} ,
- \&replace_age
- ],
- under18 => [
- sub { $_[0] < 18} ,
- \&replace_age
- ],
- welcome => [
- sub { 1 },
- \&replace_age
- ]
- ],
- cond_arg => [ $age ]
- );
-
- my $root = "t/html/highlander2-$age";
-
- local $_; # XML::Parser does not like read-only $_ (RT #101129)
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "HTML for $age");
+sub test {
+ my $age = shift;
+ my $tree = mktree 't/html/highlander2.html';
+ my $if_then = $tree->look_down(id => 'age_dialog')->highlander2(
+ cond => [
+ under10 => [
+ sub { $_[0] < 10 },
+ \&replace_age
+ ],
+ under18 => [
+ sub { $_[0] < 18 },
+ \&replace_age
+ ],
+ welcome => [
+ sub { 1 },
+ \&replace_age
+ ]
+ ],
+ cond_arg => [ $age ]
+ );
+
+ local $_; # XML::Parser does not like read-only $_ (RT #101129)
+ isxml ($tree, "t/html/highlander2-$age.exp", "highlander2 for age $age");
}
-
-tage($_) for qw(5 15 27);
+test $_ for qw(5 15 27);
--- /dev/null
+<html>
+ <head>
+<script src="smooth/scripts/mootools-1.2.1-core-yc.js" type="text/javascript"></script>
+<script src="smooth/scripts/mootools-1.2-more.js" type="text/javascript"></script>
+<script src="smooth/scripts/jd.gallery.js" type="text/javascript"></script>
+ <link rel="stylesheet" href="smooth/css/jd.gallery.css"
+ media="screen" type="text/css"/>
+ </head>
+ <body>
+<script type="text/javascript">
+function startGallery() {
+var myGallery = new gallery($('myGallery'), {
+timed: true
+});
+}
+window.addEvent('domready', startGallery);
+</script>
+ <div id="myGallery">
+ <div class="imageElement">
+ <h3>Item 1 Title</h3>
+ <p>Item 1 Description</p>
+ <a href="gallery-images/item-1/" title="open image" class="open"></a>
+ <img alt="Item 1 Title"
+ src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-gallery.jpg"
+ class="full"/> <img alt="thumbnail of Item 1 Title"
+ src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-mini.jpg"
+ class="thumbnail"/></div>
+ </div>
+ </body>
+</html>
--- /dev/null
+<html>
+ <head>
+
+ <script src="smooth/scripts/mootools-1.2.1-core-yc.js" type="text/javascript"></script>
+ <script src="smooth/scripts/mootools-1.2-more.js" type="text/javascript"></script>
+ <script src="smooth/scripts/jd.gallery.js" type="text/javascript"></script>
+
+ <link rel="stylesheet" href="smooth/css/jd.gallery.css" type="text/css" media="screen" />
+
+ </head>
+ <body>
+
+<script type="text/javascript">
+function startGallery() {
+var myGallery = new gallery($('myGallery'), {
+timed: true
+});
+}
+window.addEvent('domready', startGallery);
+</script>
+
+ <div id="myGallery">
+
+ <div class="imageElement">
+ <h3>Item 1 Title</h3>
+ <p>Item 1 Description</p>
+<a href="gallery-images/item-1/" title="open image" class="open"></a>
+
+ <img src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-gallery.jpg" class="full" alt="Item 1 Title" />
+ <img src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-mini.jpg" class="thumbnail" alt="thumbnail of Item 1 Title" />
+ </div>
+
+ <div class="imageElement">
+ <h3>Item 2 Title</h3>
+ <p>Item 2 Description</p>
+<a href="gallery-images/item-1/" title="open image" class="open"></a>
+
+ <img src="http://lh3.ggpht.com/_Pu5idg9RIVo/S1G0Krsr6iI/AAAAAAAAAB8/Hzl-tKkclmo/s640/IMG_0488.jpg" class="full" alt="Item 2 Title" />
+ <img src="http://lh3.ggpht.com/_Pu5idg9RIVo/S1G0Krsr6iI/AAAAAAAAAB8/Hzl-tKkclmo/s128/IMG_0488.jpg" class="thumbnail" alt="thumbnail of Item 2 Title" />
+ </div>
+
+ <div class="imageElement">
+ <h3>Item 2 Title</h3>
+ <p>Item 2 Description</p>
+<a href="gallery-images/item-1/" title="open image" class="open"></a>
+
+ <img src="http://smoothgallery.jondesign.net/assets/images/samples/165392_5486-gallery.jpg" class="full" alt="Item 2 Title" />
+ <img src="http://smoothgallery.jondesign.net/assets/images/samples/165392_5486-mini.jpg" class="thumbnail" alt="thumbnail of Item 2 Title" />
+ </div>
+
+ <div class="imageElement">
+
+ <h3>Item 3 Title</h3>
+ <p>Item 3 Description</p>
+<a href="gallery-images/item-1/" title="open image" class="open"></a>
+
+ <img src="http://smoothgallery.jondesign.net/assets/images/samples/83808_7948-gallery.jpg" class="full" alt="Item 3 Title" />
+ <img src="http://smoothgallery.jondesign.net/assets/images/samples/83808_7948-mini.jpg" class="thumbnail" alt="thumbnail of Item 3 Title" />
+ </div>
+ </div>
+
+
+ </body>
+
+</html>
+++ /dev/null
-<html>
- <head>
-<script src="smooth/scripts/mootools-1.2.1-core-yc.js" type="text/javascript"></script>
-<script src="smooth/scripts/mootools-1.2-more.js" type="text/javascript"></script>
-<script src="smooth/scripts/jd.gallery.js" type="text/javascript"></script>
- <link rel="stylesheet" href="smooth/css/jd.gallery.css"
- media="screen" type="text/css"/>
- </head>
- <body>
-<script type="text/javascript">
-function startGallery() {
-var myGallery = new gallery($('myGallery'), {
-timed: true
-});
-}
-window.addEvent('domready', startGallery);
-</script>
- <div id="myGallery">
- <div class="imageElement">
- <h3>Item 1 Title</h3>
- <p>Item 1 Description</p>
- <a href="gallery-images/item-1/" title="open image" class="open"></a>
- <img alt="Item 1 Title"
- src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-gallery.jpg"
- class="full"/> <img alt="thumbnail of Item 1 Title"
- src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-mini.jpg"
- class="thumbnail"/></div>
- </div>
- </body>
-</html>
+++ /dev/null
-<html>
- <head>
-
- <script src="smooth/scripts/mootools-1.2.1-core-yc.js" type="text/javascript"></script>
- <script src="smooth/scripts/mootools-1.2-more.js" type="text/javascript"></script>
- <script src="smooth/scripts/jd.gallery.js" type="text/javascript"></script>
-
- <link rel="stylesheet" href="smooth/css/jd.gallery.css" type="text/css" media="screen" />
-
- </head>
- <body>
-
-<script type="text/javascript">
-function startGallery() {
-var myGallery = new gallery($('myGallery'), {
-timed: true
-});
-}
-window.addEvent('domready', startGallery);
-</script>
-
- <div id="myGallery">
-
- <div class="imageElement">
- <h3>Item 1 Title</h3>
- <p>Item 1 Description</p>
-<a href="gallery-images/item-1/" title="open image" class="open"></a>
-
- <img src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-gallery.jpg" class="full" alt="Item 1 Title" />
- <img src="http://smoothgallery.jondesign.net/assets/images/samples/77196_6784-mini.jpg" class="thumbnail" alt="thumbnail of Item 1 Title" />
- </div>
-
- <div class="imageElement">
- <h3>Item 2 Title</h3>
- <p>Item 2 Description</p>
-<a href="gallery-images/item-1/" title="open image" class="open"></a>
-
- <img src="http://lh3.ggpht.com/_Pu5idg9RIVo/S1G0Krsr6iI/AAAAAAAAAB8/Hzl-tKkclmo/s640/IMG_0488.jpg" class="full" alt="Item 2 Title" />
- <img src="http://lh3.ggpht.com/_Pu5idg9RIVo/S1G0Krsr6iI/AAAAAAAAAB8/Hzl-tKkclmo/s128/IMG_0488.jpg" class="thumbnail" alt="thumbnail of Item 2 Title" />
- </div>
-
- <div class="imageElement">
- <h3>Item 2 Title</h3>
- <p>Item 2 Description</p>
-<a href="gallery-images/item-1/" title="open image" class="open"></a>
-
- <img src="http://smoothgallery.jondesign.net/assets/images/samples/165392_5486-gallery.jpg" class="full" alt="Item 2 Title" />
- <img src="http://smoothgallery.jondesign.net/assets/images/samples/165392_5486-mini.jpg" class="thumbnail" alt="thumbnail of Item 2 Title" />
- </div>
-
- <div class="imageElement">
-
- <h3>Item 3 Title</h3>
- <p>Item 3 Description</p>
-<a href="gallery-images/item-1/" title="open image" class="open"></a>
-
- <img src="http://smoothgallery.jondesign.net/assets/images/samples/83808_7948-gallery.jpg" class="full" alt="Item 3 Title" />
- <img src="http://smoothgallery.jondesign.net/assets/images/samples/83808_7948-mini.jpg" class="thumbnail" alt="thumbnail of Item 3 Title" />
- </div>
- </div>
-
-
- </body>
-
-</html>
--- /dev/null
+<tr>
+ <td smap="active">Yes</td>
+ <td smap="pause">arsenal rules</td>
+ <td smap="hold">No</td>
+</tr>
--- /dev/null
+<tr>
+ <td smap="active" >Yes</td>
+
+ <td smap="pause">No</td>
+
+ <td smap="hold">No</td>
+</tr>
+++ /dev/null
-<tr>
- <td smap="active">Yes</td>
- <td smap="pause">arsenal rules</td>
- <td smap="hold">No</td>
-</tr>
+++ /dev/null
-<tr>
- <td smap="active" >Yes</td>
-
- <td smap="pause">No</td>
-
- <td smap="hold">No</td>
-</tr>
-<html>
- <head></head>
- <body>
- <dl class="dual_iter" id="service_plan">
- <dt class="adstyle">the pros</dt>
- <dd class="adstyle2">never have to worry about service again</dd>
- <dt class="adstyle">the cons</dt>
- <dd class="adstyle2">upfront extra charge on purchase</dd>
- <dt class="adstyle">our choice</dt>
- <dd class="adstyle2">go with the extended service plan</dd>
- <dt class="adstyle">sample header</dt>
- <dd class="adstyle2">sample data</dd>
- </dl>
- </body>
-</html>
+<dl class="dual_iter" id="service_plan">
+ <dt class="adstyle">the pros</dt>
+ <dd class="adstyle2">never have to worry about service again</dd>
+ <dt class="adstyle">the cons</dt>
+ <dd class="adstyle2">upfront extra charge on purchase</dd>
+ <dt class="adstyle">our choice</dt>
+ <dd class="adstyle2">go with the extended service plan</dd>
+ <dt class="adstyle">sample header</dt>
+ <dd class="adstyle2">sample data</dd>
+</dl>
--- /dev/null
+<div>
+ <h1>Dialer</h1>
+ <form name="appform" id="appform" method="post">
+ <div id="city_div"> City:
+ <input name="city" type="text"/>
+ </div>
+ <div id="state_div"> State:
+ <input value="catatonic" name="state" type="text"/>
+ </div>
+ <div id="company_div"> Company:
+ <input name="company" type="text"/>
+ </div>
+ <div id="data_source_div"> Data Source:
+ <input name="data_source" type="text"/>
+ </div>
+ <input value="locate records" type="submit"/>
+ </form>
+</div>
--- /dev/null
+ <div>
+ <h1>Dialer</h1>
+
+ <form id="appform" method="post" name="appform">
+ <div id="city_div">
+ City: <input type="text" name="city"/>
+ </div>
+
+ <div id="state_div">
+ State: <input type="text" name="state"/>
+ </div>
+
+ <div id="company_div">
+ Company: <input type="text" name="company"/>
+ </div>
+
+ <div id="data_source_div">
+ Data Source: <input type="text" name="data_source"/>
+ </div><input type="submit" value="locate records"/>
+ </form>
+ </div>
+++ /dev/null
-<html>
- <head></head>
- <body>
- <div>
- <h1>Dialer</h1>
- <form name="appform" id="appform" method="post">
- <div id="city_div"> City:
- <input name="city" type="text"/>
- </div>
- <div id="state_div"> State:
- <input value="catatonic" name="state" type="text"/>
- </div>
- <div id="company_div"> Company:
- <input name="company" type="text"/>
- </div>
- <div id="data_source_div"> Data Source:
- <input name="data_source" type="text"/>
- </div>
- <input value="locate records" type="submit"/>
- </form>
- </div>
- </body>
-</html>
+++ /dev/null
- <div>
- <h1>Dialer</h1>
-
- <form id="appform" method="post" name="appform">
- <div id="city_div">
- City: <input type="text" name="city"/>
- </div>
-
- <div id="state_div">
- State: <input type="text" name="state"/>
- </div>
-
- <div id="company_div">
- Company: <input type="text" name="company"/>
- </div>
-
- <div id="data_source_div">
- Data Source: <input type="text" name="data_source"/>
- </div><input type="submit" value="locate records"/>
- </form>
- </div>
--- /dev/null
+<html>
+ <head>
+ <title>HO HO HA HA HA</title>
+ </head>
+ <body>
+ <table>
+ <tr align="left" sclass="tr" valign="top" class="alt">
+ <td sid="people_id">888</td>
+ <td sid="phone">444-4444</td>
+ <td sid="email"><a href="mailto:leave-me-alone@gmail.com" id="a_email"
+ >should-not-be-touched@seamstress.com</a></td>
+ </tr>
+ </table>
+ </body>
+</html>
--- /dev/null
+<html>
+<head>
+ <title>HO HO HA HA HA</title>
+</head>
+
+<body>
+ <table>
+ <tr sclass="tr" class="alt" align="left" valign="top">
+ <td sid="people_id">1</td>
+ <td sid="phone">(877) 255-3239</td>
+ <td sid="email"><a id="a_email" href="mailto:leave-me-alone@gmail.com">should-not-be-touched@seamstress.com</a></td>
+ </tr>
+ </table>
+</body>
+
+</html>
\ No newline at end of file
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"><span id="under18"> Sorry,
+<span id="age_dialog" klass="highlander"><span id="under18"> Sorry,
you're not old enough to enter (and too dumb to lie about your age)
- </span></span></body>
-</html>
+ </span></span>
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"><span id="under10"> Hello,
+<span id="age_dialog" klass="highlander"><span id="under10"> Hello,
does your mother know you're using her AOL account?
- </span></span></body>
-</html>
+ </span></span>
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"><span id="welcome"> Welcome
- </span></span></body>
-</html>
+<span id="age_dialog" klass="highlander"><span id="welcome"> Welcome
+ </span></span>
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"><span id="under18"> Sorry,
+<span id="age_dialog" klass="highlander"><span id="under18"> Sorry,
you're only <span id="age">15</span> (and too dumb to lie about your
- age) </span></span></body>
-</html>
+ age) </span></span>
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"><span id="welcome"> Welcome,
+<span id="age_dialog" klass="highlander"><span id="welcome"> Welcome,
isn't it good to be <span id="age">27</span> years old?
- </span></span></body>
-</html>
+</span></span>
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"><span id="under10"> Hello,
+<span id="age_dialog" klass="highlander"><span id="under10"> Hello,
little <span id="age">5</span>-year old, does your mother know you're
- using her AOL account? </span></span></body>
-</html>
+ using her AOL account? </span></span>
-<html>
- <head></head>
- <body><span id="age_dialog" klass="highlander"> <span id="under18"> Sorry,
+<span id="age_dialog" klass="highlander"> <span id="under18"> Sorry,
you're only <span id="age">AGE</span> (and too dumb to lie about your
- age) </span> </span></body>
-</html>
+ age) </span> </span>
-<html>
- <head></head>
- <body>Here are the things I need from the store:
+<body>
+Here are the things I need from the store:
<ul>
<li class="store_items">bread</li>
<li class="store_items">butter</li>
<li class="store_items">vodka</li>
</ul>
- </body>
-</html>
+</body>
+<body>
Here are the things I need from the store:
<ul>
<li class="store_items">Sample item</li>
-</ul>
\ No newline at end of file
+</ul>
+</body>
-<html>
- <head></head>
- <body>Here are the type of people you meet at XYZ, inc:
+<div>
+Here are the type of people you meet at XYZ, inc:
<dl>
<dt>Programmer</dt>
<dd>one who likes Perl and Seamstress</dd>
<dt> Poet </dt>
<dd> A relative of Edgar Allan Poe. </dd>
</dl>
- </body>
-</html>
+</div>
+<div>
Here are the type of people you meet at XYZ, inc:
<dl>
</dl>
+</div>
+++ /dev/null
-<html>
-<head>
- <title>HO HO HA HA HA</title>
-</head>
-
-<body>
- <table>
- <tr sclass="tr" class="alt" align="left" valign="top">
- <td sid="people_id">1</td>
- <td sid="phone">(877) 255-3239</td>
- <td sid="email"><a sid="a_email" href="mailto:jim@gmail.com">jim@gmail.com</a></td>
- </tr>
- </table>
-</body>
-
-</html>
\ No newline at end of file
+++ /dev/null
-<html>
- <head>
- <title>HO HO HA HA HA</title>
- </head>
- <body>
- <table>
- <tr align="left" sclass="tr" valign="top" class="alt">
- <td sid="people_id">888</td>
- <td sid="phone">444-4444</td>
- <td sid="email"><a href="mailto:leave-me-alone@gmail.com" id="a_email"
- >should-not-be-touched@seamstress.com</a></td>
- </tr>
- </table>
- </body>
-</html>
+++ /dev/null
-<html>
-<head>
- <title>HO HO HA HA HA</title>
-</head>
-
-<body>
- <table>
- <tr sclass="tr" class="alt" align="left" valign="top">
- <td sid="people_id">1</td>
- <td sid="phone">(877) 255-3239</td>
- <td sid="email"><a id="a_email" href="mailto:leave-me-alone@gmail.com">should-not-be-touched@seamstress.com</a></td>
- </tr>
- </table>
-</body>
-
-</html>
\ No newline at end of file
-<html>
- <head></head>
- <body>
<table class="supply" id="load_data">
<tr>
<th>name</th>
<td id="weight">230</td>
</tr>
</table>
- </body>
-</html>
-<html>
- <head></head>
- <body>
<table class="supply" id="load_data">
<tr>
<th>name</th>
<td id="weight">230</td>
</tr>
</table>
- </body>
-</html>
+++ /dev/null
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
-<html>
- <head>
- <title>Complex HTML Table</title>
- </head>
-
- <body style="font-family: Arial, Helvetica, sans-serif" >
- <h1>Complex HTML Table</h1>
-
- <P>
- This table comes from
- <a
- href="http://www.w3.org/TR/REC-html40/struct/tables.html#h-11.5">
- the w3 spec on tables
- </a>. I am using it to try out the <code>table2()</code> API call
- that is part of the new release of
- <a
- href=http://search.cpan.org/search?query=Element%3A%3ALibrary&mode=all>
- <code>HTML::Element::Library</code>
- </a>.
- </p>
-
-
- <P>
-
- <TABLE border="2" frame="hsides" rules="groups">
- <CAPTION>CODE-PAGE SUPPORT IN MICROSOFT WINDOWS</CAPTION>
- <COLGROUP align="center">
- <COLGROUP align="left">
- <COLGROUP align="center" span="2">
- <COLGROUP align="center" span="3">
- <THEAD valign="top">
- <TR>
- <TH>Code-Page<BR>ID
- <TH>Name
- <TH>ACP
- <TH>OEMCP
- <TH>Windows<BR>NT 3.1
- <TH>Windows<BR>NT 3.51
- <TH>Windows<BR>95
- </th>
- </tr>
- <TBODY>
- <TR><TD>1200<TD>Unicode (BMP of ISO/IEC-10646)<TD><TD><TD>X<TD>X<TD>*
- <TR><TD>1250<TD>Windows 3.1 Eastern European<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1251<TD>Windows 3.1 Cyrillic<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1252<TD>Windows 3.1 US (ANSI)<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1253<TD>Windows 3.1 Greek<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1254<TD>Windows 3.1 Turkish<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1255<TD>Hebrew<TD>X<TD><TD><TD><TD>X
- <TR><TD>1256<TD>Arabic<TD>X<TD><TD><TD><TD>X
- <TR><TD>1257<TD>Baltic<TD>X<TD><TD><TD><TD>X
- <TR><TD>1361<TD>Korean (Johab)<TD>X<TD><TD><TD>**<TD>X
- </td>
- </tr>
- </tbody>
- <TBODY>
- <TR><TD>437<TD>MS-DOS United States<TD><TD>X<TD>X<TD>X<TD>X
- <TR><TD>708<TD>Arabic (ASMO 708)<TD><TD>X<TD><TD><TD>X
- <TR><TD>709<TD>Arabic (ASMO 449+, BCON V4)<TD><TD>X<TD><TD><TD>X
- <TR><TD>710<TD>Arabic (Transparent Arabic)<TD><TD>X<TD><TD><TD>X
- <TR><TD>720<TD>Arabic (Transparent ASMO)<TD><TD>X<TD><TD><TD>X</td>
- </tr>
- </tbody>
-
- </TABLE>
-
-
-
-
- <hr>
- <address><a href="mailto:metaperl@gmail.com">metaperl</a></address>
-<!-- Created: Fri Nov 25 08:48:48 PST 2005 -->
-<!-- hhmts start -->
-Last modified: Fri Nov 25 08:57:41 PST 2005
-<!-- hhmts end -->
- </body>
-</html>
+++ /dev/null
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
-<html>
- <head>
- <title>Complex HTML Table</title>
- </head>
-
- <body style="font-family: Arial, Helvetica, sans-serif" >
- <h1>Complex HTML Table</h1>
-
- <P>
- This table comes from
- <a
- href="http://www.w3.org/TR/REC-html40/struct/tables.html#h-11.5">
- the w3 spec on tables
- </a>. I am using it to try out the <code>table2()</code> API call
- that is part of the new release of
- <a
- href=http://search.cpan.org/search?query=Element%3A%3ALibrary&mode=all>
- <code>HTML::Element::Library</code>
- </a>.
- </p>
-
-
- <P>
-
- <TABLE border="2" frame="hsides" rules="groups"
- summary="Code page support in different versions
- of MS Windows.">
- <CAPTION>CODE-PAGE SUPPORT IN MICROSOFT WINDOWS</CAPTION>
- <COLGROUP align="center">
- <COLGROUP align="left">
- <COLGROUP align="center" span="2">
- <COLGROUP align="center" span="3">
- <THEAD valign="top">
- <TR>
- <TH>Code-Page<BR>ID
- <TH>Name
- <TH>ACP
- <TH>OEMCP
- <TH>Windows<BR>NT 3.1
- <TH>Windows<BR>NT 3.51
- <TH>Windows<BR>95
- </th>
- </tr>
- <TBODY>
- <TR><TD>1200<TD>Unicode (BMP of ISO/IEC-10646)<TD><TD><TD>X<TD>X<TD>*
- <TR><TD>1250<TD>Windows 3.1 Eastern European<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1251<TD>Windows 3.1 Cyrillic<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1252<TD>Windows 3.1 US (ANSI)<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1253<TD>Windows 3.1 Greek<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1254<TD>Windows 3.1 Turkish<TD>X<TD><TD>X<TD>X<TD>X
- <TR><TD>1255<TD>Hebrew<TD>X<TD><TD><TD><TD>X
- <TR><TD>1256<TD>Arabic<TD>X<TD><TD><TD><TD>X
- <TR><TD>1257<TD>Baltic<TD>X<TD><TD><TD><TD>X
- <TR><TD>1361<TD>Korean (Johab)<TD>X<TD><TD><TD>**<TD>X
- </td>
- </tr>
- </tbody>
- <TBODY>
- <TR><TD>437<TD>MS-DOS United States<TD><TD>X<TD>X<TD>X<TD>X
- <TR><TD>708<TD>Arabic (ASMO 708)<TD><TD>X<TD><TD><TD>X
- <TR><TD>709<TD>Arabic (ASMO 449+, BCON V4)<TD><TD>X<TD><TD><TD>X
- <TR><TD>710<TD>Arabic (Transparent Arabic)<TD><TD>X<TD><TD><TD>X
- <TR><TD>720<TD>Arabic (Transparent ASMO)<TD><TD>X<TD><TD><TD>X</td>
- </tr>
- </tbody>
-
- </TABLE>
-
-
-
-
- <hr>
- <address><a href="mailto:metaperl@gmail.com">metaperl</a></address>
-<!-- Created: Fri Nov 25 08:48:48 PST 2005 -->
-<!-- hhmts start -->
-Last modified: Fri Nov 25 08:57:41 PST 2005
-<!-- hhmts end -->
- </body>
-</html>
+++ /dev/null
-<html>
- <head>
- <title>Complex HTML Table</title>
- </head>
- <body style="font-family: Arial, Helvetica, sans-serif">
- <h1>Complex HTML Table</h1>
- <p> This table comes from <a
- href="http://www.w3.org/TR/REC-html40/struct/tables.html#h-11.5"> the
- w3 spec on tables </a>. I am using it to try out the
- <code>table2()</code> API call that is part of the new release of <a
- href="http://search.cpan.org/search?query=Element%3A%3ALibrary&mode=all">
- <code>HTML::Element::Library</code> </a>. </p>
- <p>
- <table
- summary="Code page support in different versions
- of MS Windows."
- frame="hsides" rules="groups" border="2">
- <caption>CODE-PAGE SUPPORT IN MICROSOFT WINDOWS</caption>
- <colgroup align="center"></colgroup>
- <colgroup align="left"></colgroup>
- <colgroup align="center" span="2"></colgroup>
- <colgroup align="center" span="3">
- <thead valign="top">
- <tr>
- <th>Code-Page<br>ID </th>
- <th>Name </th>
- <th>ACP </th>
- <th>OEMCP </th>
- <th>Windows<br>NT 3.1 </th>
- <th>Windows<br>NT 3.51 </th>
- <th>Windows<br>95 </th>
- </tr>
- <tbody>
- <tr>
- <td>1200</td>
- <td>Unicode (BMP of ISO/IEC-10646)</td>
- <td></td>
- <td></td>
- <td>X</td>
- <td>X</td>
- <td>* </td>
- </tr>
- <tr>
- <td>1255</td>
- <td>Hebrew</td>
- <td>X</td>
- <td></td>
- <td></td>
- <td></td>
- <td>X </td>
- </tr>
- <tr>
- <td>1256</td>
- <td>Arabic</td>
- <td>X</td>
- <td></td>
- <td></td>
- <td></td>
- <td>X </td>
- </tr>
- <tr>
- <td>1257</td>
- <td>Baltic</td>
- <td>X</td>
- <td></td>
- <td></td>
- <td></td>
- <td>X </td>
- </tr>
- <tr>
- <td>1361</td>
- <td>Korean (Johab)</td>
- <td>X</td>
- <td></td>
- <td></td>
- <td>**</td>
- <td>X </td>
- </tr>
- </tbody>
- <tbody>
- <tr>
- <td>437</td>
- <td>MS-DOS United States</td>
- <td></td>
- <td>X</td>
- <td>X</td>
- <td>X</td>
- <td>X </td>
- </tr>
- <tr>
- <td>708</td>
- <td>Arabic (ASMO 708)</td>
- <td></td>
- <td>X</td>
- <td></td>
- <td></td>
- <td>X </td>
- </tr>
- <tr>
- <td>709</td>
- <td>Arabic (ASMO 449+, BCON V4)</td>
- <td></td>
- <td>X</td>
- <td></td>
- <td></td>
- <td>X </td>
- </tr>
- <tr>
- <td>710</td>
- <td>Arabic (Transparent Arabic)</td>
- <td></td>
- <td>X</td>
- <td></td>
- <td></td>
- <td>X </td>
- </tr>
- <tr>
- <td>720</td>
- <td>Arabic (Transparent ASMO)</td>
- <td></td>
- <td>X</td>
- <td></td>
- <td></td>
- <td>X</td>
- </tr>
- </tbody>
- </thead>
- </colgroup>
- </table>
- <hr>
- <address><a href="mailto:metaperl@gmail.com">metaperl</a></address>
- Last modified: Fri Nov 25 08:57:41 PST 2005 </p>
- </body>
-</html>
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-my $root = 't/html/iter';
-
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
+#!/usr/bin/perl
+use t::lib tests => 1;
+my $tree = mktree 't/html/iter.html';
my $li = $tree->look_down(class => 'store_items');
-
-my @items = qw(bread butter vodka);
-
-$tree->iter($li, @items);
-
-
-is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"),
- "HTML for generated li");
+$tree->iter($li, qw/bread butter vodka/);
+isxml $tree, 't/html/iter.exp', 'iter';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
+#!/usr/bin/perl
+use t::lib tests => 1;
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-my $root = 't/html/iter2';
-
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-my @items = (
- [ Programmer => 'one who likes Perl and Seamstress', ],
- [ DBA => 'one who does business as', ],
- [ Admin => 'one who plays Tetris all day' ]
- );
+my $tree = mktree 't/html/iter2.html';
$tree->iter2(
- # default wrapper_ld ok
- wrapper_data => \@items,
- wrapper_proc => sub {
- my ($container) = @_;
-
- # only keep the last 2 dts and dds
- my @content_list = $container->content_list;
- $container->splice_content(0, @content_list - 2);
- },
- # default item_ld is k00l
- # default item_data is phrEsh
- # default item_proc will do w0rk
- splice => sub {
- my ($container, @item_elems) = @_;
- $container->unshift_content(@item_elems);
- },
-
- debug => 1,
- );
-
-
-is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "XML for generated li");
+ # default wrapper_ld ok
+ wrapper_data => [
+ [ Programmer => 'one who likes Perl and Seamstress' ],
+ [ DBA => 'one who does business as' ],
+ [ Admin => 'one who plays Tetris all day' ]
+ ],
+ wrapper_proc => sub {
+ my ($container) = @_;
+
+ # only keep the last 2 dts and dds
+ my @content_list = $container->content_list;
+ $container->splice_content(0, @content_list - 2);
+ },
+ # default item_ld is k00l
+ # default item_data is phrEsh
+ # default item_proc will do w0rk
+ splice => sub {
+ my ($container, @item_elems) = @_;
+ $container->unshift_content(@item_elems);
+ },
+
+ debug => $ENV{TEST_VERBOSE},
+);
+
+isxml $tree, 't/html/iter2.exp', 'iter2';
--- /dev/null
+package t::lib;
+use strict;
+use warnings;
+
+use File::Slurp qw/read_file/;
+use HTML::TreeBuilder;
+use HTML::Element::Library;
+use Test::More ();
+use Test::XML;
+
+use parent qw/Exporter/;
+our @EXPORT = qw/is is_deeply is_xml slurp mktree isxml/;
+our $VERSION = '0.001'; # Exporter needs a $VERSION
+
+sub import {
+ my ($self, @args) = @_;
+ strict->import;
+ warnings->import;
+ Test::More->import(@args);
+
+ $self->export_to_level(1, $self);
+}
+
+sub slurp { scalar read_file @_ }
+
+sub mktree {
+ my ($file) = @_;
+ HTML::TreeBuilder->new_from_file($file)->disembowel;
+}
+
+sub isxml {
+ my ($tree, $file, $name) = @_;
+ my $res = ref $tree eq 'SCALAR' ? $$tree : $tree->as_XML;
+ my $exp = ref $file eq 'SCALAR' ? $$file : slurp $file;
+ is_xml $res, $exp, $name
+}
#!/usr/bin/perl -T
+use lib '.';
+use t::lib tests => 1;
+my @list = map { [item => $_] } qw/bread butter beans/;
+my $initial_lol = [ note => [ list => [ item => 'sample' ] ] ];
+my ($new_lol) = HTML::Element::newchild($initial_lol, list => @list);
-use warnings;
-use strict;
-
-use Test::More;
-use Test::XML;
-
-BEGIN {
- use_ok('HTML::TreeBuilder');
- use_ok('HTML::Element::Library');
-}
-
-
-my $initial_lol = [ note => [ shopping => [ item => 'sample' ] ] ];
-my $new_lol = HTML::Element::newchild($initial_lol, shopping => shopping_items());
-
-
-sub shopping_items {
- my @shopping_items = map { [ item => $_ ] } qw(bread butter beans);
- @shopping_items;
-}
-
-my $expected = [
- 'note',
- [
- 'shopping',
- [
- 'item',
- 'bread'
- ],
- [
- 'item',
- 'butter'
- ],
- [
- 'item',
- 'beans'
- ]
- ]
- ];
-
-use Data::Dumper;
-warn Dumper($new_lol);
-
-is_deeply($new_lol, $expected, 'test unrolling');
-
-
-
-done_testing;
+my $expected = [note => [list => [item => 'bread'], [item => 'butter'], [item => 'beans']]];
+Test::More::is_deeply($new_lol, $expected, 'test unrolling');
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
-sub replace_age {
- my $branch = shift;
- my $age = shift;
- $branch->look_down(id => 'age')->replace_content($age);
-}
-
-
-sub tage {
- my $age = shift;
-
- my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander2.html');
-
- my $saved_child = $tree->passover('under18');
-
- my $root = "t/html/highlander2-passover";
-
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "XML for $age");
-}
-
-
-tage('666');
+#!/usr/bin/perl
+use t::lib tests => 1;
+my $tree = mktree 't/html/highlander2.html';
+$tree->passover('under18');
+isxml $tree, 't/html/highlander2-passover.exp', 'passover';
-use strict;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
+#!/usr/bin/perl
+use t::lib tests => 1;
my $html =<<'EOHTML';
<html>
</html>
EOHTML
-my $t1;
-my $lol;
-
-$t1 = HTML::TreeBuilder->new_from_content ( $html ) ;
-
-my $found= $t1->look_down(id => 'findme');
-
-
-my @found = $found->position;
-#warn "@found";
-
-is("@found", '-1 1 0 1 2');
-
+my $t1 = HTML::TreeBuilder->new_from_content ($html) ;
+my $found = $t1->look_down(id => 'findme');
+my $pos = join ' ', $found->position;
+is $pos, '-1 1 0 1 2';
#!/usr/bin/perl -T
+use lib '.';
+use t::lib tests => 1;
-
-use warnings;
-use strict;
-
-use Test::More;
-use Test::XML;
-
-BEGIN {
- use_ok('HTML::TreeBuilder');
- use_ok('HTML::Element::Library');
-}
-
-
-
-my $root = HTML::TreeBuilder->new();
-my $html =<<'EOHTML';
-<html>
+my $root = HTML::TreeBuilder->new_from_content(<<'EOHTML');
+<html>
<head>
<title></title>
</head>
</html>
EOHTML
-$root->parse($html);
-$root->delete_ignorable_whitespace;
$root->prune;
my $expected = '
</html>
';
-#warn sprintf 'HTML:%s:HTML', $root->as_HTML;
-
-is_xml($root->as_HTML, $expected, 'test pruning');
-
-
-
-done_testing;
+isxml($root, \$expected, 'prune');
-use strict;
-use Test::More qw(no_plan);
-
-use HTML::Element::Library;
-
-
-my $t1;
-my $lol;
-$t1 = HTML::Element->new_from_lol
- (
- $lol =
- ['html',
- ['head',
- [ 'title', 'I like stuff!' ],
- ],
- ['body',
- {
- 'lang', 'en-JP'},
- 'stuff',
- ['p', 'um, p < 4!', {'class' => 'par123'}],
- ['div', {foo => 'bar'}, '123'], # at 0.1.2
- ['div', {jack => 'olantern'}, '456'], # at 0.1.2
- ]
- ]
- )
- ;
+#!/usr/bin/perl
+use t::lib tests => 1;
+my $t1 = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ [ 'title', 'I like stuff!' ]],
+ ['body', {id => 'corpus'}, {'lang', 'en-JP'},
+ 'stuff',
+ ['p', 'um, p < 4!', {'class' => 'par123'}],
+ ['div', {foo => 'bar'}, '123'], # at 0.1.2
+ ['div', {jack => 'olantern'}, '456']]]); # at 0.1.2
$t1->look_down('_tag' => 'body')->replace_content('all gone!');
-is( $t1->as_HTML, '<html><head><title>I like stuff!</title></head><body lang="en-JP">all gone!</body></html>', "replaced all of body");
-
+isxml $t1, \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', 'replace_content';
-use strict;
-use Test::More qw(no_plan);
+#!/usr/bin/perl
+use t::lib tests => 1;
+
+my $t1 = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ [ 'title', 'I like stuff!' ]],
+ ['body', {id => 'corpus'}, {'lang', 'en-JP'},
+ 'stuff',
+ ['p', 'um, p < 4!', {'class' => 'par123'}],
+ ['div', {foo => 'bar'}, '123'], # at 0.1.2
+ ['div', {jack => 'olantern'}, '456']]]); # at 0.1.2
-use HTML::Element::Library;
-
-
-my $t1;
-my $lol;
-$t1 = HTML::Element->new_from_lol
- (
- $lol =
- ['html',
- ['head',
- [ 'title', 'I like stuff!' ],
- ],
- ['body', {id => 'corpus'},
- {
- 'lang', 'en-JP'},
- 'stuff',
- ['p', 'um, p < 4!', {'class' => 'par123'}],
- ['div', {foo => 'bar'}, '123'], # at 0.1.2
- ['div', {jack => 'olantern'}, '456'], # at 0.1.2
- ]
- ]
- )
- ;
-
-
-#$t1->look_down('_tag' => 'body')->replace_content('all gone!');
$t1->set_child_content(id => 'corpus', 'all gone!');
-is( $t1->as_HTML, '<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', "replaced all of body");
-
-
+isxml $t1, \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', 'set_child_content';
-use strict;
-use Test::More qw(no_plan);
-
-use HTML::Element::Library;
-
-
-my $t1;
-my $lol;
-$t1 = HTML::Element->new_from_lol
- (
- $lol =
- ['html',
- ['head',
- [ 'title', 'I like stuff!' ],
- ],
- ['body',
- {
- 'lang', 'en-JP'},
- 'stuff',
- ['p', 'um, p < 4!', {'class' => 'par123'}],
- ['div', {foo => 'bar'}, '123'], # at 0.1.2
- ['div', {jack => 'olantern'}, '456'], # at 0.1.2
- ]
- ]
- )
- ;
+#!/usr/bin/perl
+use t::lib tests => 1;
+
+my $t1 = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ [ 'title', 'I like stuff!' ]],
+ ['body', {id => 'corpus'}, {'lang', 'en-JP'},
+ 'stuff',
+ ['p', 'um, p < 4!', {'class' => 'par123'}],
+ ['div', {foo => 'bar'}, '123'], # at 0.1.2
+ ['div', {jack => 'olantern'}, '456']]]); # at 0.1.2
my $p = $t1->look_down('_tag' => 'body')->look_down(_tag => 'p');
-
-is($p->sibdex, 1, "does the p tag have 1 as its index");
-
-
+is $p->sibdex, 1, 'p tag has 1 as its index';
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl HTML-Element-Library.t'
-
-
-
-
-use strict;
-use Test::More qw(no_plan);
-
-use HTML::Element::Library;
-
-
-my $t1;
-my $lol;
-$t1 = HTML::Element->new_from_lol
- (
- $lol =
- ['html',
- ['head',
- [ 'title', 'I like stuff!' ],
- ],
- ['body',
- {
- 'lang', 'en-JP'},
- 'stuff',
- ['p', 'um, p < 4!', {'class' => 'par123'}],
- ['div', {foo => 'bar'}, '123'], # at 0.1.2
- ['div', {jack => 'olantern'}, '456'], # at 0.1.2
- ]
- ]
- )
- ;
+#!/usr/bin/perl
+use t::lib tests => 3;
+
+my $t1 = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ [ 'title', 'I like stuff!' ]],
+ ['body', {id => 'corpus'}, {'lang', 'en-JP'},
+ 'stuff',
+ ['p', 'um, p < 4!', {'class' => 'par123'}],
+ ['div', {foo => 'bar'}, '123'], # at 0.1.2
+ ['div', {jack => 'olantern'}, '456']]]); # at 0.1.2
my $div = $t1->look_down('_tag' => 'body')->look_down(_tag => 'p');
my @sibs = $div->siblings;
-is($sibs[0], 'stuff', "first sibling is simple text");
-is($sibs[2]->tag, 'div', "3rd tag a div tag");
-is(scalar @sibs, 4, "4 siblings total");
-
+is $sibs[0], 'stuff', "first sibling is simple text";
+is $sibs[2]->tag, 'div', "3rd tag is a div tag";
+is scalar @sibs, 4, "4 siblings total";
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-use lib qw(t/ t/m/);
-
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
+#!/usr/bin/perl
+use t::lib tests => 1;
+use lib 't';
use SimpleClass;
-my $root = 't/html/table-alt';
my $o = SimpleClass->new;
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-
-$tree->table
- (
- # tell seamstress where to find the table, via the method call
- # ->look_down('id', $gi_table). Seamstress detaches the table from the
- # HTML tree automatically if no table rows can be built
-
- gi_table => 'load_data',
-
- # tell seamstress where to find the tr. This is a bit useless as
- # the <tr> usually can be found as the first child of the parent
-
- gi_tr => ['iterate1', 'iterate2'],
-
- # the model data to be pushed into the table
-
- table_data => $o->load_data,
-
- # the way to take the model data and obtain one row
- # if the table data were a hashref, we would do:
- # my $key = (keys %$data)[0]; my $val = $data->{$key}; delete $data->{$key}
-
- tr_data => sub { my ($self, $data) = @_;
- shift(@{$data}) ;
- },
-
- # the way to take a row of data and fill the <td> tags
-
- td_data => sub { my ($tr_node, $tr_data) = @_;
- $tr_node->content_handler($_ => $tr_data->{$_})
- for qw(name age weight) }
-
- );
-
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"),
- "HTML for non-alternating table");
+my $tree = mktree 't/html/table-alt.html';
+
+$tree->table(
+ gi_table => 'load_data',
+ gi_tr => ['iterate1', 'iterate2'],
+ table_data => $o->load_data,
+ tr_data => sub {
+ my ($self, $data) = @_;
+ shift @{$data};
+ },
+ td_data => sub {
+ my ($tr_node, $tr_data) = @_;
+ $tr_node->content_handler($_ => $tr_data->{$_}) for qw(name age weight)
+ });
+
+isxml $tree, 't/html/table-alt.exp', 'table (alternating)';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-use lib qw(t/ t/m/);
-
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
+#!/usr/bin/perl
+use t::lib tests => 1;
+use lib 't';
use SimpleClass;
-my $root = 't/html/table';
my $o = SimpleClass->new;
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-
-$tree->table
- (
- # tell seamstress where to find the table, via the method call
- # ->look_down('id', $gi_table). Seamstress detaches the table from the
- # HTML tree automatically if no table rows can be built
-
- gi_table => 'load_data',
-
- # tell seamstress where to find the tr. This is a bit useless as
- # the <tr> usually can be found as the first child of the parent
-
- gi_tr => 'data_row',
-
- # the model data to be pushed into the table
-
- table_data => $o->load_data,
-
- # the way to take the model data and obtain one row
- # if the table data were a hashref, we would do:
- # my $key = (keys %$data)[0]; my $val = $data->{$key}; delete $data->{$key}
-
- tr_data => sub { my ($self, $data) = @_;
- shift(@{$data}) ;
- },
-
- # the way to take a row of data and fill the <td> tags
-
- td_data => sub { my ($tr_node, $tr_data) = @_;
- $tr_node->content_handler($_ => $tr_data->{$_})
- for qw(name age weight) }
-
- );
-
- is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"),
- "HTML for non-alternating table");
+my $tree = mktree 't/html/table.html';
+
+$tree->table(
+ gi_table => 'load_data',
+ gi_tr => 'data_row',
+ table_data => $o->load_data,
+ tr_data => sub {
+ my ($self, $data) = @_;
+ shift(@{$data}) ;
+ },
+ td_data => sub {
+ my ($tr_node, $tr_data) = @_;
+ $tr_node->content_handler($_ => $tr_data->{$_}) for qw(name age weight)
+ });
+
+isxml $tree, 't/html/table.exp', 'table';
-# This might look like shell script, but it's actually -*- perl -*-
+#!/usr/bin/perl
# Test the 3 possible look_down calls to table2()
# a = default
# b = supplied array ref
# c = supplied code ref
-
-use strict;
+use t::lib tests => 3;
use lib qw(t/ t/m/);
-
-
-use File::Slurp;
-use Test::More;
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
use data::table2;
-
my $o = data::table2->new;
# a - default table_ld
-my $root = 't/html/table2';
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
+my $tree = mktree 't/html/table2.html';
my $table = HTML::Element::Library::ref_or_ld(
- $tree,
- ['_tag' => 'table']
- );
+ $tree,
+ ['_tag' => 'table']
+);
-is_xml ($table->as_XML, scalar File::Slurp::read_file("$root-table_ld.exp"), $root);
+isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down default';
# b - arrayref table_ld
-$tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-
$table = HTML::Element::Library::ref_or_ld(
- $tree,
- [frame => 'hsides', rules => 'groups']
+ $tree,
+ [frame => 'hsides', rules => 'groups']
);
-is_xml ($table->as_XML, scalar File::Slurp::read_file("$root-table_ld.exp"), $root);
+isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down arrayref';
# c - coderef table_ld
-$tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-
$table = HTML::Element::Library::ref_or_ld(
- $tree,
- sub {
- my ($t) = @_;
- my $caption = $t->look_down('_tag' => 'caption');
- $caption->parent;
- }
- );
-
-is_xml ($table->as_XML, scalar File::Slurp::read_file("$root-table_ld.exp"), $root);
-
-
-done_testing;
+ $tree,
+ sub {
+ my ($t) = @_;
+ my $caption = $t->look_down('_tag' => 'caption');
+ $caption->parent;
+ }
+);
+
+isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down coderef';
-# This might look like shell script, but it's actually -*- perl -*-
-# Test the 3 possible look_down calls to table2()
-# a = default
-# b = supplied array ref
-# c = supplied code ref
-
-use strict;
-use lib qw(t/ t/m/);
-
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Scalar::Listify;
-use Test::XML;
-
-use data::table2;
-
-
-my $o = data::table2->new;
+#!/usr/bin/perl
+use t::lib tests => 3;
# a - default table_ld
-my $root = 't/html/table2';
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
+my $tree = mktree 't/html/table2.html';
my @tr = HTML::Element::Library::ref_or_ld(
- $tree,
- ['_tag' => 'tr']
- );
+ $tree,
+ ['_tag' => 'tr']
+);
-is (scalar @tr, 16, 'default ld_tr');
+is (scalar @tr, 16, 'table2 tr look_down (default)');
# b - arrayref tr_ld
-$root = 't/html/table2-tr_ld-arrayref';
-$tree = HTML::TreeBuilder->new_from_file("$root.html");
-
+$tree = mktree 't/html/table2-tr_ld-arrayref.html';
my $tr = HTML::Element::Library::ref_or_ld(
- $tree,
- [class => 'findMe']
- );
+ $tree,
+ [class => 'findMe']
+);
-is_xml ($tr->as_XML, scalar File::Slurp::read_file("$root.exp"), $root);
+isxml $tr, 't/html/table2-tr_ld-arrayref.exp', 'table2 tr look_down (arrayref)';
# c - coderef tr_ld
# removes windows listings before returning @tr
-$root = 't/html/table2';
-$tree = HTML::TreeBuilder->new_from_file("$root.html");
-
+$tree = mktree 't/html/table2.html';
@tr = HTML::Element::Library::ref_or_ld(
- $tree,
- sub {
- my ($t) = @_;
- my @tr = $t->look_down('_tag' => 'tr');
- my @keep;
- for my $tr (@tr) {
-
- my @td = $tr->look_down ('_tag' => 'td') ;
- my $detached;
- for my $td (@td) {
- if (grep { $_ =~ /Windows/ } $td->content_list) {
- $tr->detach();
- ++$detached;
- last;
+ $tree,
+ sub {
+ my ($t) = @_;
+ my @tr = $t->look_down('_tag' => 'tr');
+ my @keep;
+ for my $tr (@tr) {
+
+ my @td = $tr->look_down ('_tag' => 'td') ;
+ my $detached;
+ for my $td (@td) {
+ if (grep { $_ =~ /Windows/ } $td->content_list) {
+ $tr->detach;
+ ++$detached;
+ last;
+ }
+ }
+ push @keep, $tr unless $detached;
+ }
+ @keep;
}
- }
- push @keep, $tr unless $detached;
- }
- @keep;
- }
- );
-
-#warn $_->as_HTML, $/ for @tr;
+);
-is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root-tr_ld-coderef.exp"), $root);
+isxml $tree, 't/html/table2-tr_ld-coderef.exp', 'table2 tr look_down (coderef)';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-use lib qw(t/ t/m/);
-
-
-use File::Slurp;
-use Test::More;
-use Test::XML;
-
-use Data::Dumper;
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
-
+#!/usr/bin/perl
+use t::lib tests => 1;
+use lib 't';
use data::table2;
my $root = 't/html/table2';
-my $o = data::table2->new;
my $d = data::table2->load_data;
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
-#warn 'D:', Dumper $d;
+my $tree = mktree 't/html/table2.html';
for my $dataset (keys %$d) {
- my %tbody = ('4dig' => 0, '3dig' => 1);
- $tree->table2 (
-# debug => 1,
- table_data => $d->{$dataset},
- tr_base_id => $dataset,
- tr_ld => sub {
- my $t = shift;
- my $tbody = ($t->look_down('_tag' => 'tbody'))[$tbody{$dataset}];
- my @tbody_child = $tbody->content_list;
- $tbody_child[$_]->detach for (1 .. $#tbody_child) ;
- $tbody->content_list;
- },
- td_proc => sub {
- my ($tr, $data) = @_;
- my @td = $tr->look_down('_tag' => 'td');
- for my $i (0..$#td) {
-# warn $i;
- $td[$i]->splice_content(0, 1, $data->[$i]);
- }
- }
- );
+ my %tbody = ('4dig' => 0, '3dig' => 1);
+ $tree->table2 (
+ debug => $ENV{TEST_VERBOSE},
+ table_data => $d->{$dataset},
+ tr_base_id => $dataset,
+ tr_ld => sub {
+ my $t = shift;
+ my $tbody = ($t->look_down('_tag' => 'tbody'))[$tbody{$dataset}];
+ my @tbody_child = $tbody->content_list;
+ $tbody_child[$_]->detach for (1 .. $#tbody_child) ;
+ $tbody->content_list;
+ },
+ td_proc => sub {
+ my ($tr, $data) = @_;
+ my @td = $tr->look_down('_tag' => 'td');
+ for my $i (0..$#td) {
+ # warn $i;
+ $td[$i]->splice_content(0, 1, $data->[$i]);
+ }
+ }
+ );
}
-
-is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), 'genhtml');
-
-
-done_testing;
+isxml $tree, 't/html/table2.exp', 'table2';
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-use lib qw(t/ t/m/);
-
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-use Test::XML;
+#!/usr/bin/perl
+use t::lib tests => 1;
+use lib 't';
use SelectData;
-my $root = 't/html/unroll_select';
-
-my $tree = HTML::TreeBuilder->new_from_file("$root.html");
-
+my $tree = mktree 't/html/unroll_select.html';
-$tree->unroll_select
- (
- select_label => 'clan_list',
- option_value => sub { my $row = shift; $row->{clan_id} },
- option_content => sub { my $row = shift; $row->{clan_name} },
- option_selected => sub { my $row = shift; $row->{selected} },
- data => SelectData->load_data,
- data_iter => sub { my $data = shift; shift @$data }
- );
+$tree->unroll_select(
+ select_label => 'clan_list',
+ option_value => sub { my $row = shift; $row->{clan_id} },
+ option_content => sub { my $row = shift; $row->{clan_name} },
+ option_selected => sub { my $row = shift; $row->{selected} },
+ data => SelectData->load_data,
+ data_iter => sub { my $data = shift; shift @$data });
-is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"),
- "HTML for non-alternating table");
+isxml ($tree, 't/html/unroll_select.exp', 'unroll_select');
-use strict;
-use Test::More qw(no_plan);
+#!/usr/bin/perl
+use t::lib tests => 1;
-use HTML::Element::Library;
-
-
-my $t1;
-my $lol;
-$t1 = HTML::Element->new_from_lol
- (
- $lol =
- ['html',
- ['head',
- [ 'title', 'I like stuff!' ],
- ],
- ['body',
- {
- 'lang', 'en-JP'},
- 'stuff',
- ['p',
- ['span', {id => 'wrapme'},
- 'um, p < 4!',
- ],
- {'class' => 'par123'}],
- ['div', {foo => 'bar'}, '123'], # at 0.1.2
- ['div', {jack => 'olantern'}, '456'], # at 0.1.2
- ]
- ]
- )
- ;
+my $t1 = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ [ 'title', 'I like stuff!' ]],
+ ['body', {id => 'corpus'}, {'lang', 'en-JP'},
+ 'stuff',
+ ['p', ['span', {id => 'wrapme'}, 'um, p < 4!'], {'class' => 'par123'}],
+ ['div', {foo => 'bar'}, '123'], # at 0.1.2
+ ['div', {jack => 'olantern'}, '456']]]); # at 0.1.2
my $bold = HTML::Element->new('b', id => 'wrapper');
-my $W = $t1->look_down('id' => 'wrapme');
-$W->wrap_content($bold);
-is( $W->as_HTML, '<span id="wrapme"><b id="wrapper">um, p < 4!</b></span>', "wrapped text");
-
-
+my $w = $t1->look_down('id' => 'wrapme');
+$w->wrap_content($bold);
+isxml $w, \'<span id="wrapme"><b id="wrapper">um, p < 4!</b></span>', 'wrap_content';
projects / html-element-library.git / commitdiff