From: Marius Gavrilescu Date: Fri, 26 Dec 2014 11:37:55 +0000 (+0200) Subject: Refactor tests (first pass) X-Git-Tag: 5.200_001~13 X-Git-Url: http://git.ieval.ro/?p=html-element-library.git;a=commitdiff_plain;h=aa0161264c67d7802e79492b05aff88533d79d20 Refactor tests (first pass) --- diff --git a/lib/HTML/Element/Library.pm b/lib/HTML/Element/Library.pm index 5336eef..553fb0c 100644 --- a/lib/HTML/Element/Library.pm +++ b/lib/HTML/Element/Library.pm @@ -301,13 +301,13 @@ sub HTML::Element::iter2 { ## no critic (RequireArgUnpacking) 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}; } } @@ -315,7 +315,7 @@ sub HTML::Element::iter2 { ## no critic (RequireArgUnpacking) if ($p{debug}) { for (@{$new_item_elems}) { - warn 'NEWITEM_ELEMS ', $_->as_HTML; + warn 'NEWITEM_ELEMS ', $_->as_HTML if $p{debug}; } } diff --git a/t/00system.t b/t/00system.t index 10066ce..4801fe4 100644 --- a/t/00system.t +++ b/t/00system.t @@ -1,46 +1,13 @@ -# 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; diff --git a/t/HTML-Element-Library.t b/t/HTML-Element-Library.t deleted file mode 100644 index 83f9e44..0000000 --- a/t/HTML-Element-Library.t +++ /dev/null @@ -1,17 +0,0 @@ -# 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. - diff --git a/t/content_handler.t b/t/content_handler.t index 8264d70..5a2b203 100644 --- a/t/content_handler.t +++ b/t/content_handler.t @@ -1,33 +1,15 @@ -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, 'I like stuff!all gone!', "replaced all of body"); - - +isxml $t1, \'I like stuff!all gone!', 'content_handler'; diff --git a/t/crunch.t b/t/crunch.t index 627ef2a..241cc3f 100644 --- a/t/crunch.t +++ b/t/crunch.t @@ -1,25 +1,6 @@ -# 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'; diff --git a/t/defmap.t b/t/defmap.t index 26eeeed..880b998 100644 --- a/t/defmap.t +++ b/t/defmap.t @@ -1,32 +1,6 @@ -# 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'; diff --git a/t/dual_iter.t b/t/dual_iter.t index dbcfb28..2c93fd4 100644 --- a/t/dual_iter.t +++ b/t/dual_iter.t @@ -1,51 +1,25 @@ -# 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'; diff --git a/t/fillinform.t b/t/fillinform.t index d989f4e..1d88b2a 100644 --- a/t/fillinform.t +++ b/t/fillinform.t @@ -1,26 +1,5 @@ -# 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'; diff --git a/t/hashmap.t b/t/hashmap.t index 9ed2864..ed81f06 100644 --- a/t/hashmap.t +++ b/t/hashmap.t @@ -1,38 +1,10 @@ -# 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'; diff --git a/t/highlander.t b/t/highlander.t index e9f754c..c224988 100644 --- a/t/highlander.t +++ b/t/highlander.t @@ -1,33 +1,21 @@ -# 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); diff --git a/t/highlander2.t b/t/highlander2.t index c145b68..dd8252d 100644 --- a/t/highlander2.t +++ b/t/highlander2.t @@ -1,48 +1,34 @@ -# 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); diff --git a/t/html/crunch.exp b/t/html/crunch.exp new file mode 100644 index 0000000..272e334 --- /dev/null +++ b/t/html/crunch.exp @@ -0,0 +1,30 @@ + + + + + + + + + +
+
+

Item 1 Title

+

Item 1 Description

+ + Item 1 Title thumbnail of Item 1 Title
+
+ + diff --git a/t/html/crunch.html b/t/html/crunch.html new file mode 100644 index 0000000..01353d1 --- /dev/null +++ b/t/html/crunch.html @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + +
+ +
+

Item 1 Title

+

Item 1 Description

+ + + Item 1 Title + thumbnail of Item 1 Title +
+ +
+

Item 2 Title

+

Item 2 Description

+ + + Item 2 Title + thumbnail of Item 2 Title +
+ +
+

Item 2 Title

+

Item 2 Description

+ + + Item 2 Title + thumbnail of Item 2 Title +
+ +
+ +

Item 3 Title

+

Item 3 Description

+ + + Item 3 Title + thumbnail of Item 3 Title +
+
+ + + + + diff --git a/t/html/crunch/crunch.exp b/t/html/crunch/crunch.exp deleted file mode 100644 index 272e334..0000000 --- a/t/html/crunch/crunch.exp +++ /dev/null @@ -1,30 +0,0 @@ - - - - - - - - - -
-
-

Item 1 Title

-

Item 1 Description

- - Item 1 Title thumbnail of Item 1 Title
-
- - diff --git a/t/html/crunch/crunch.initial b/t/html/crunch/crunch.initial deleted file mode 100644 index 01353d1..0000000 --- a/t/html/crunch/crunch.initial +++ /dev/null @@ -1,65 +0,0 @@ - - - - - - - - - - - - - - -
- -
-

Item 1 Title

-

Item 1 Description

- - - Item 1 Title - thumbnail of Item 1 Title -
- -
-

Item 2 Title

-

Item 2 Description

- - - Item 2 Title - thumbnail of Item 2 Title -
- -
-

Item 2 Title

-

Item 2 Description

- - - Item 2 Title - thumbnail of Item 2 Title -
- -
- -

Item 3 Title

-

Item 3 Description

- - - Item 3 Title - thumbnail of Item 3 Title -
-
- - - - - diff --git a/t/html/defmap.exp b/t/html/defmap.exp new file mode 100644 index 0000000..f5aabd8 --- /dev/null +++ b/t/html/defmap.exp @@ -0,0 +1,5 @@ + + Yes + arsenal rules + No + diff --git a/t/html/defmap.html b/t/html/defmap.html new file mode 100644 index 0000000..7e24e57 --- /dev/null +++ b/t/html/defmap.html @@ -0,0 +1,7 @@ + + Yes + + No + + No + diff --git a/t/html/defmap/defmap.exp b/t/html/defmap/defmap.exp deleted file mode 100644 index f5aabd8..0000000 --- a/t/html/defmap/defmap.exp +++ /dev/null @@ -1,5 +0,0 @@ - - Yes - arsenal rules - No - diff --git a/t/html/defmap/defmap.initial b/t/html/defmap/defmap.initial deleted file mode 100644 index 7e24e57..0000000 --- a/t/html/defmap/defmap.initial +++ /dev/null @@ -1,7 +0,0 @@ - - Yes - - No - - No - diff --git a/t/html/dual_iter.exp b/t/html/dual_iter.exp index 64c6c8f..c2e9d44 100644 --- a/t/html/dual_iter.exp +++ b/t/html/dual_iter.exp @@ -1,15 +1,10 @@ - - - -
-
the pros
-
never have to worry about service again
-
the cons
-
upfront extra charge on purchase
-
our choice
-
go with the extended service plan
-
sample header
-
sample 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
+
sample header
+
sample data
+
diff --git a/t/html/fillinform.exp b/t/html/fillinform.exp new file mode 100644 index 0000000..75b3b6e --- /dev/null +++ b/t/html/fillinform.exp @@ -0,0 +1,18 @@ +
+

Dialer

+
+
City: + +
+
State: + +
+
Company: + +
+
Data Source: + +
+ +
+
diff --git a/t/html/fillinform.html b/t/html/fillinform.html new file mode 100644 index 0000000..2661798 --- /dev/null +++ b/t/html/fillinform.html @@ -0,0 +1,21 @@ +
+

Dialer

+ +
+
+ City: +
+ +
+ State: +
+ +
+ Company: +
+ +
+ Data Source: +
+
+
diff --git a/t/html/fillinform/fillinform.exp b/t/html/fillinform/fillinform.exp deleted file mode 100644 index bbe603e..0000000 --- a/t/html/fillinform/fillinform.exp +++ /dev/null @@ -1,23 +0,0 @@ - - - -
-

Dialer

-
-
City: - -
-
State: - -
-
Company: - -
-
Data Source: - -
- -
-
- - diff --git a/t/html/fillinform/fillinform.initial b/t/html/fillinform/fillinform.initial deleted file mode 100644 index 2661798..0000000 --- a/t/html/fillinform/fillinform.initial +++ /dev/null @@ -1,21 +0,0 @@ -
-

Dialer

- -
-
- City: -
- -
- State: -
- -
- Company: -
- -
- Data Source: -
-
-
diff --git a/t/html/hashmap.exp b/t/html/hashmap.exp new file mode 100644 index 0000000..22486ba --- /dev/null +++ b/t/html/hashmap.exp @@ -0,0 +1,15 @@ + + + HO HO HA HA HA + + + + + + + + +
888444-4444should-not-be-touched@seamstress.com
+ + diff --git a/t/html/hashmap.html b/t/html/hashmap.html new file mode 100644 index 0000000..6d818cd --- /dev/null +++ b/t/html/hashmap.html @@ -0,0 +1,16 @@ + + + HO HO HA HA HA + + + + + + + + + +
1(877) 255-3239should-not-be-touched@seamstress.com
+ + + \ No newline at end of file diff --git a/t/html/highlander-15.exp b/t/html/highlander-15.exp index 48fe062..dbd4acf 100644 --- a/t/html/highlander-15.exp +++ b/t/html/highlander-15.exp @@ -1,6 +1,3 @@ - - - Sorry, + Sorry, you're not old enough to enter (and too dumb to lie about your age) - - + diff --git a/t/html/highlander-5.exp b/t/html/highlander-5.exp index 96df6fc..5baaa1d 100644 --- a/t/html/highlander-5.exp +++ b/t/html/highlander-5.exp @@ -1,6 +1,3 @@ - - - Hello, + Hello, does your mother know you're using her AOL account? - - + diff --git a/t/html/highlander-50.exp b/t/html/highlander-50.exp index 1f03edd..8511ff2 100644 --- a/t/html/highlander-50.exp +++ b/t/html/highlander-50.exp @@ -1,5 +1,2 @@ - - - Welcome - - + Welcome + diff --git a/t/html/highlander2-15.exp b/t/html/highlander2-15.exp index 20be935..56bd431 100644 --- a/t/html/highlander2-15.exp +++ b/t/html/highlander2-15.exp @@ -1,6 +1,3 @@ - - - Sorry, + Sorry, you're only 15 (and too dumb to lie about your - age) - + age) diff --git a/t/html/highlander2-27.exp b/t/html/highlander2-27.exp index dd7b2fa..3671bbe 100644 --- a/t/html/highlander2-27.exp +++ b/t/html/highlander2-27.exp @@ -1,6 +1,3 @@ - - - Welcome, + Welcome, isn't it good to be 27 years old? - - + diff --git a/t/html/highlander2-5.exp b/t/html/highlander2-5.exp index b62e6e0..ecc6e88 100644 --- a/t/html/highlander2-5.exp +++ b/t/html/highlander2-5.exp @@ -1,6 +1,3 @@ - - - Hello, + Hello, little 5-year old, does your mother know you're - using her AOL account? - + using her AOL account? diff --git a/t/html/highlander2-passover.exp b/t/html/highlander2-passover.exp index 8de5305..8bfaa65 100644 --- a/t/html/highlander2-passover.exp +++ b/t/html/highlander2-passover.exp @@ -1,6 +1,3 @@ - - - Sorry, + Sorry, you're only AGE (and too dumb to lie about your - age) - + age) diff --git a/t/html/iter.exp b/t/html/iter.exp index 746633e..013b019 100644 --- a/t/html/iter.exp +++ b/t/html/iter.exp @@ -1,10 +1,8 @@ - - - Here are the things I need from the store: + +Here are the things I need from the store: - - + diff --git a/t/html/iter.html b/t/html/iter.html index 289809f..3f609f1 100644 --- a/t/html/iter.html +++ b/t/html/iter.html @@ -1,4 +1,6 @@ + Here are the things I need from the store: \ No newline at end of file + + diff --git a/t/html/iter2.exp b/t/html/iter2.exp index 17148cf..992ffa3 100644 --- a/t/html/iter2.exp +++ b/t/html/iter2.exp @@ -1,6 +1,5 @@ - - - Here are the type of people you meet at XYZ, inc: +
+Here are the type of people you meet at XYZ, inc:
Programmer
one who likes Perl and Seamstress
@@ -11,5 +10,4 @@
Poet
A relative of Edgar Allan Poe.
- - +
diff --git a/t/html/iter2.html b/t/html/iter2.html index 1a93671..acb026e 100644 --- a/t/html/iter2.html +++ b/t/html/iter2.html @@ -1,3 +1,4 @@ +
Here are the type of people you meet at XYZ, inc:
@@ -25,3 +26,4 @@ Here are the type of people you meet at XYZ, inc:
+
diff --git a/t/html/same_as.html b/t/html/same_as.html deleted file mode 100644 index f70d378..0000000 --- a/t/html/same_as.html +++ /dev/null @@ -1,16 +0,0 @@ - - - HO HO HA HA HA - - - - - - - - - -
1(877) 255-3239jim@gmail.com
- - - \ No newline at end of file diff --git a/t/html/same_as/same_as.exp b/t/html/same_as/same_as.exp deleted file mode 100644 index 22486ba..0000000 --- a/t/html/same_as/same_as.exp +++ /dev/null @@ -1,15 +0,0 @@ - - - HO HO HA HA HA - - - - - - - - -
888444-4444should-not-be-touched@seamstress.com
- - diff --git a/t/html/same_as/same_as.initial b/t/html/same_as/same_as.initial deleted file mode 100644 index 6d818cd..0000000 --- a/t/html/same_as/same_as.initial +++ /dev/null @@ -1,16 +0,0 @@ - - - HO HO HA HA HA - - - - - - - - - -
1(877) 255-3239should-not-be-touched@seamstress.com
- - - \ No newline at end of file diff --git a/t/html/table-alt.exp b/t/html/table-alt.exp index 60c9f06..9cff2c0 100644 --- a/t/html/table-alt.exp +++ b/t/html/table-alt.exp @@ -1,6 +1,3 @@ - - - @@ -38,5 +35,3 @@
name230
- - diff --git a/t/html/table.exp b/t/html/table.exp index c11b8f4..95b8566 100644 --- a/t/html/table.exp +++ b/t/html/table.exp @@ -1,6 +1,3 @@ - - - @@ -38,5 +35,3 @@
name230
- - diff --git a/t/html/table2-tr_ld-coderef.html b/t/html/table2-tr_ld-coderef.html deleted file mode 100644 index cffaba2..0000000 --- a/t/html/table2-tr_ld-coderef.html +++ /dev/null @@ -1,78 +0,0 @@ - - - - Complex HTML Table - - - -

Complex HTML Table

- -

- This table comes from - - the w3 spec on tables - . I am using it to try out the table2() API call - that is part of the new release of - - HTML::Element::Library - . -

- - -

- - - - - - - - - - - - - - - - - - - - -
CODE-PAGE SUPPORT IN MICROSOFT WINDOWS
Code-Page
ID - 		Name - ACP - OEMCP - Windows
NT 3.1 - 		Windows
NT 3.51 - 		Windows
95 -
1200Unicode (BMP of ISO/IEC-10646)XX* -
1250Windows 3.1 Eastern EuropeanXXXX -
1251Windows 3.1 CyrillicXXXX -
1252Windows 3.1 US (ANSI)XXXX -
1253Windows 3.1 GreekXXXX -
1254Windows 3.1 TurkishXXXX -
1255HebrewXX -
1256ArabicXX -
1257BalticXX -
1361Korean (Johab)X**X -
437MS-DOS United StatesXXXX -
708Arabic (ASMO 708)XX -
709Arabic (ASMO 449+, BCON V4)XX -
710Arabic (Transparent Arabic)XX -
720Arabic (Transparent ASMO)XX
- - - - -

-
metaperl
- - -Last modified: Fri Nov 25 08:57:41 PST 2005 - - - diff --git a/t/html/table2-tr_ld-default.html b/t/html/table2-tr_ld-default.html deleted file mode 100644 index 544553b..0000000 --- a/t/html/table2-tr_ld-default.html +++ /dev/null @@ -1,80 +0,0 @@ - - - - Complex HTML Table - - - -

Complex HTML Table

- -

- This table comes from - - the w3 spec on tables - . I am using it to try out the table2() API call - that is part of the new release of - - HTML::Element::Library - . -

- - -

- - - - - - - - - - - - - - - - - - - - -
CODE-PAGE SUPPORT IN MICROSOFT WINDOWS
Code-Page
ID - 		Name - ACP - OEMCP - Windows
NT 3.1 - 		Windows
NT 3.51 - 		Windows
95 -
1200Unicode (BMP of ISO/IEC-10646)XX* -
1250Windows 3.1 Eastern EuropeanXXXX -
1251Windows 3.1 CyrillicXXXX -
1252Windows 3.1 US (ANSI)XXXX -
1253Windows 3.1 GreekXXXX -
1254Windows 3.1 TurkishXXXX -
1255HebrewXX -
1256ArabicXX -
1257BalticXX -
1361Korean (Johab)X**X -
437MS-DOS United StatesXXXX -
708Arabic (ASMO 708)XX -
709Arabic (ASMO 449+, BCON V4)XX -
710Arabic (Transparent Arabic)XX -
720Arabic (Transparent ASMO)XX
- - - - -

-
metaperl
- - -Last modified: Fri Nov 25 08:57:41 PST 2005 - - - diff --git a/t/html/table2-tr_ld_coderef.exp b/t/html/table2-tr_ld_coderef.exp deleted file mode 100644 index 6df0c73..0000000 --- a/t/html/table2-tr_ld_coderef.exp +++ /dev/null @@ -1,134 +0,0 @@ - - - Complex HTML Table - - -

Complex HTML Table

-

This table comes from the - w3 spec on tables . I am using it to try out the - table2() API call that is part of the new release of - HTML::Element::Library .

-

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
CODE-PAGE SUPPORT IN MICROSOFT WINDOWS
Code-Page
ID 		Name ACP OEMCP Windows
NT 3.1 		Windows
NT 3.51 		Windows
95
1200Unicode (BMP of ISO/IEC-10646)XX*
1255HebrewXX
1256ArabicXX
1257BalticXX
1361Korean (Johab)X**X
437MS-DOS United StatesXXXX
708Arabic (ASMO 708)XX
709Arabic (ASMO 449+, BCON V4)XX
710Arabic (Transparent Arabic)XX
720Arabic (Transparent ASMO)XX
-

-
metaperl
- Last modified: Fri Nov 25 08:57:41 PST 2005

- - diff --git a/t/iter.t b/t/iter.t index 182abd1..6e86b44 100644 --- a/t/iter.t +++ b/t/iter.t @@ -1,23 +1,7 @@ -# 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'; diff --git a/t/iter2.t b/t/iter2.t index 8f3f312..5d48877 100644 --- a/t/iter2.t +++ b/t/iter2.t @@ -1,43 +1,31 @@ -# 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'; diff --git a/t/lib.pm b/t/lib.pm new file mode 100644 index 0000000..87704c1 --- /dev/null +++ b/t/lib.pm @@ -0,0 +1,36 @@ +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 +} diff --git a/t/newchild.t b/t/newchild.t index 43b641d..edeff5e 100644 --- a/t/newchild.t +++ b/t/newchild.t @@ -1,51 +1,10 @@ #!/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'); diff --git a/t/passover.t b/t/passover.t index 09951ab..2a0a901 100644 --- a/t/passover.t +++ b/t/passover.t @@ -1,32 +1,6 @@ -# 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'; diff --git a/t/position.t b/t/position.t index b48463d..93dbfb5 100644 --- a/t/position.t +++ b/t/position.t @@ -1,8 +1,5 @@ -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'; @@ -21,17 +18,8 @@ my $html =<<'EOHTML'; 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'; diff --git a/t/prune.t b/t/prune.t index af343db..654e656 100644 --- a/t/prune.t +++ b/t/prune.t @@ -1,22 +1,9 @@ #!/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'; - +my $root = HTML::TreeBuilder->new_from_content(<<'EOHTML'); + @@ -31,8 +18,6 @@ my $html =<<'EOHTML'; EOHTML -$root->parse($html); -$root->delete_ignorable_whitespace; $root->prune; my $expected = ' @@ -42,10 +27,4 @@ my $expected = ' '; -#warn sprintf 'HTML:%s:HTML', $root->as_HTML; - -is_xml($root->as_HTML, $expected, 'test pruning'); - - - -done_testing; +isxml($root, \$expected, 'prune'); diff --git a/t/replace_content.t b/t/replace_content.t index 40b0b7e..4723593 100644 --- a/t/replace_content.t +++ b/t/replace_content.t @@ -1,32 +1,16 @@ -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, 'I like stuff!all gone!', "replaced all of body"); - +isxml $t1, \'I like stuff!all gone!', 'replace_content'; diff --git a/t/set_child_content.t b/t/set_child_content.t index 231ce7a..ce8a18c 100644 --- a/t/set_child_content.t +++ b/t/set_child_content.t @@ -1,33 +1,15 @@ -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, 'I like stuff!all gone!', "replaced all of body"); - - +isxml $t1, \'I like stuff!all gone!', 'set_child_content'; diff --git a/t/sibdex.t b/t/sibdex.t index 7c959f5..1181e06 100644 --- a/t/sibdex.t +++ b/t/sibdex.t @@ -1,32 +1,15 @@ -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'; diff --git a/t/siblings.t b/t/siblings.t index d1e753e..50b8c2f 100644 --- a/t/siblings.t +++ b/t/siblings.t @@ -1,40 +1,19 @@ -# 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"; diff --git a/t/table-alt.t b/t/table-alt.t index 9b84079..f759da4 100644 --- a/t/table-alt.t +++ b/t/table-alt.t @@ -1,54 +1,22 @@ -# 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 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 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)'; diff --git a/t/table.t b/t/table.t index 2351038..fe9fbf4 100644 --- a/t/table.t +++ b/t/table.t @@ -1,54 +1,22 @@ -# 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 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 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'; diff --git a/t/table2-table_ld.t b/t/table2-table_ld.t index c53735a..1a359da 100644 --- a/t/table2-table_ld.t +++ b/t/table2-table_ld.t @@ -1,65 +1,43 @@ -# 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'; diff --git a/t/table2-tr_ld.t b/t/table2-tr_ld.t index 6e01c51..c685205 100644 --- a/t/table2-tr_ld.t +++ b/t/table2-tr_ld.t @@ -1,82 +1,54 @@ -# 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)'; diff --git a/t/table2.t b/t/table2.t index f72096e..3566c63 100644 --- a/t/table2.t +++ b/t/table2.t @@ -1,52 +1,34 @@ -# 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'; diff --git a/t/unroll_select.t b/t/unroll_select.t index a21c712..d29870a 100644 --- a/t/unroll_select.t +++ b/t/unroll_select.t @@ -1,31 +1,17 @@ -# 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'); diff --git a/t/wrap_content.t b/t/wrap_content.t index 976420e..7c766bc 100644 --- a/t/wrap_content.t +++ b/t/wrap_content.t @@ -1,38 +1,18 @@ -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, 'um, p < 4!', "wrapped text"); - - +my $w = $t1->look_down('id' => 'wrapme'); +$w->wrap_content($bold); +isxml $w, \'um, p < 4!', 'wrap_content';