+++ /dev/null
-use lib '.';
-use Arsenal;
-
-Arsenal->new->load_data;
+++ /dev/null
-package Arsenal;
-
-use strict;
-use Data::Dumper;
-
-my %player;
-
-sub new {
- my $this = shift;
- bless {}, ref($this) || $this;
-}
-
-my $number = qr!\d{1,2}!;
-my $name = qr!\w+(?:\s\w{2,}){1,2}!;
-my $position = qr!\w!;
-my $height = qr!\d[-]\d{1,2}!;
-my $weight = qr!\d{2,3}!;
-my $birthday = qr!\w{3}\s\d{1,2},\s\d{4}!;
-my $birthplace= qr!\w+(?:\s\w+)*(?:,\s\S+)*!;
-
-sub load_data {
- my @data;
-
- while (<DATA>) {
- last if /__END__/;
-
- @player{qw(number name pos height weight birthday birthplace)}
- =
- m!
- ($number)\s+
- ($name)\s+
- ($position)\s+
- ($height)\s+
- ($weight)\s+
- ($birthday)\s+
- ($birthplace)
- !x;
-
- warn $_;
- warn Dumper \%player;
- }
-}
-
-1;
-__DATA__
-24 Manuel Almunia G 6-3 190 May 19, 1977 Pamplona, Spain
- 10 Dennis Bergkamp F 6-0 172 May 10, 1969 Amsterdam, Netherlands
- 23 Sol Campbell D 6-2 201 Sep 18, 1974 Newham, England
- 22 Gael Clichy D 5-11 159 Jul 26, 1985 Clichy, France
- 3 Ashley Cole D 5-7 148 Dec 20, 1980 Stepney, England
- 18 Pascal Cygan D 6-4 192 Apr 19, 1974 Lens, France
- 27 Emmanuel Eboue D 5-10 159 Jun 4, 1983 Abidjan, Cote d'Ivoire
- 15 Francesc Fabregas Soler M 5-7 152 Apr 4, 1987 Arenys del Mar, Spain
- 16 Mathieu Flamini M 5-10 148 Mar 7, 1984 Marseille, France
- 40 Ryan Garry D 6-2 181 Sep 29, 1983 Hornchurch, England
- 14 Thierry Henry F 6-2 179 Aug 17, 1977 Paris, France
- 13 Aliksandr Hleb M 6-1 154 May 1, 1981 Minsk, USSR
- 12 Lauren D 5-11 157 Jan 19, 1977 Londi Kribi, Cameroon
- 1 Jens Lehmann G 6-3 192 Nov 10, 1969 Essen, West Germany
- 8 Fredrik Ljungberg M 5-9 165 Apr 16, 1977 Halmstads, Sweden
- 26 Quincy Owusu Abeyie F 5-11 163 Apr 15, 1986 Amsterdam, Netherlands
- 7 Robert Pires M 6-1 163 Oct 29, 1973 Reims, France
- 21 Mart Poom G 6-4 187 Feb 3, 1972 Tallinn, USSR
- 9 Jose Antonio Reyes F 6-0 181 Sep 1, 1983 Utrera, Spain
- 20 Philippe Senderos D 6-3 185 Feb 14, 1985 Geneva, Switzerland
- 19 Gilberto Silva M 6-3 172 Oct 7, 1976 Belo Horizonte, Brazil
- 17 Alexandre Song M 6-0 168 Apr 9, 1987 Cameroon
- 28 Kolo Toure D 6-0 168 Mar 19, 1981 Sokoura Bouake, Cote d'Ivoire
- 11 Robin van Persie F 6-0 157 Aug 6, 1983 Rotterdam, Netherlands
-__END__
+++ /dev/null
-package SelectData;
-
-
-
-my @clan_data = (
- { clan_name => 'janglers', clan_id => 12, selected => 1 },
- { clan_name => 'thugknights', clan_id => 14 },
- { clan_name => 'cavaliers' , clan_id => 13 }
- );
-
-
-sub new {
- my $this = shift;
- bless {}, ref($this) || $this;
-}
-
-sub load_data {
- \@clan_data
-}
-
-
-1;
+++ /dev/null
-package SimpleClass;
-
-
-my @name = qw(bob bill brian babette bobo bix);
-my @age = qw(99 12 44 52 12 43);
-my @weight = qw(99 52 80 124 120 230);
-
-
-sub new {
- my $this = shift;
- bless {}, ref($this) || $this;
-}
-
-sub load_data {
- my @data;
-
- for (0 .. 5) {
- push @data, {
- age => shift @age,
- name => shift @name,
- weight => shift @weight
- }
- }
-
- \@data
-}
-
-
-1;
+++ /dev/null
-#!/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->content_handler(corpus => 'all gone!');
-isxml $t1, \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', 'content_handler';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-
-my $tree = mktree 't/html/crunch.html';
-$tree->crunch(look_down => [ class => 'imageElement' ], leave => 1);
-isxml $tree, 't/html/crunch.exp', 'crunch';
+++ /dev/null
-437,MS-DOS,United States,0,1,1,1,1
-708,Arabic (ASMO 708),0,1,0,0,1
-709,Arabic (ASMO 449+ BCON V4),0,1,0,0,1
-710,Arabic (Transparent Arabic),0,1,0,0,1
-720,Arabic (Transparent ASMO),0,1,0,0,1
\ No newline at end of file
+++ /dev/null
-1200,Unicode (BMP of ISO 10646),0,0,1,1,2
-1250,Windows 3.1 Eastern European,1,0,1,1,1
-1251,Windows 3.1 Cyrillic,1,0,1,1,1
-1252,Windows 3.1 US (ANSI),1,0,1,1,1
-1253,Windows 3.1 Greek,1,0,1,1,1
-1254,Windows 3.1 Turkish,1,0,1,1,1
-1255,Hebrew,1,0,0,0,1
-1256,Arabic,1,0,0,0,1
-1257,Baltic,1,0,0,0,1
-1361,Korean (Johab),1,0,0,3,1
\ No newline at end of file
+++ /dev/null
-package data::table2;
-
-use strict;
-use warnings;
-
-use Cwd;
-use Data::Dumper;
-
-#warn __PACKAGE__ . ' cwd - ' . getcwd() ;
-
-sub new {
- my $this = shift;
- bless {}, ref($this) || $this;
-}
-
-sub load_data {
-
- my @file = qw(4dig 3dig);
-
- my %data;
-
- for my $file (@file) {
- my $f = "t/data/$file.dat";
- my @data;
- open F, $f or die "couldnt open $f: $!";
- while (<F>) {
- push @data, [ split ',', $_ ] ;
- }
- $data{$file} = \@data;
- }
- #warn Dumper \%data;
- \%data;
-
-}
-
-1;
-
+++ /dev/null
-#!/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';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-
-my $tree = mktree 't/html/dual_iter.html';
-
-$tree->iter2(
- 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';
+++ /dev/null
-#!/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';
+++ /dev/null
-#!/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';
+++ /dev/null
-#!/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";
-}
-
-test $_ for qw(5 15 50);
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 3;
-
-sub replace_age {
- my ($branch, $age) = @_;
- $branch->look_down(id => 'age')->replace_content($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");
-}
-
-test $_ for qw(5 15 27);
--- /dev/null
+<html>
+<head>
+</head>
+<body>
+<table>
+<tr>
+ <td>a <td>a <td>a <td>a
+</tr>
+<tr>
+ <td>a <td>a <td id=findme>a <td>a
+</tr>
+</table>
+</body>
+</html>
--- /dev/null
+<html>
+<body>
+<div>There was man named Jed</div><div>He did not have a head</div><div>He lived beneath a sled</div><div>Now he's afraid of Fred...</div> </body>
+</html>
--- /dev/null
+<html>
+<head>
+ <title></title>
+</head>
+<body>
+ <div>There was man named Jed</div>
+<div>He did not have a head</div>
+<div>He lived beneath a sled</div>
+<div>Now he's afraid of Fred...</div>
+<div>
+</div>
+ </body>
+</html>
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-
-my $tree = mktree 't/html/iter.html';
-my $li = $tree->look_down(class => 'store_items');
-$tree->iter($li, qw/bread butter vodka/);
-isxml $tree, 't/html/iter.exp', 'iter';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-
-my $tree = mktree 't/html/iter2.html';
-
-$tree->iter2(
- # 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 SelectData;
-
-
-
-my @clan_data = (
- { clan_name => 'janglers', clan_id => 12, selected => 1 },
- { clan_name => 'thugknights', clan_id => 14 },
- { clan_name => 'cavaliers' , clan_id => 13 }
- );
-
-
-sub new {
- my $this = shift;
- bless {}, ref($this) || $this;
-}
-
-sub load_data {
- \@clan_data
-}
-
-
-1;
+++ /dev/null
-package SimpleClass;
-
-
-my @name = qw(bob bill brian babette bobo bix);
-my @age = qw(99 12 44 52 12 43);
-my @weight = qw(99 52 80 124 120 230);
-
-
-sub new {
- my $this = shift;
- bless {}, ref($this) || $this;
-}
-
-sub load_data {
- my @data;
-
- for (0 .. 5) {
- push @data, {
- age => shift @age,
- name => shift @name,
- weight => shift @weight
- }
- }
-
- \@data
-}
-
-
-1;
--- /dev/null
+#!/usr/bin/perl -T
+use lib '.';
+use t::lib tests => 26;
+
+##################################################
+# Short tests based on mklol
+
+sub mklol {
+ 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'],
+ ['div', {jack => 'olantern'}, '456']]]);
+}
+
+my $tree_replaced = \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>';
+my $tree;
+
+$tree = mklol;
+$tree->content_handler(corpus => 'all gone!');
+isxml $tree, $tree_replaced, 'content_handler';
+
+$tree = mklol;
+$tree->set_child_content(id => 'corpus', 'all gone!');
+isxml $tree, $tree_replaced, 'set_child_content';
+
+$tree = mklol;
+$tree->look_down('_tag' => 'body')->replace_content('all gone!');
+isxml $tree, $tree_replaced, 'replace_content';
+
+$tree = mklol;
+my $p = $tree->look_down('_tag' => 'body')->look_down(_tag => 'p');
+is $p->sibdex, 1, 'p tag has 1 as its index';
+
+$tree = mklol;
+my $div = $tree->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 is a div tag";
+is scalar @sibs, 4, "4 siblings total";
+
+$tree = mklol;
+my $bold = HTML::Element->new('b', id => 'wrapper');
+my $w = $tree->look_down(_tag => 'p');
+$w->wrap_content($bold);
+isxml $w, \'<p class="par123"><b id="wrapper">um, p < 4!</b></p>', 'wrap_content';
+
+##################################################
+# Short tests
+
+$tree = mktree 't/html/crunch.html';
+$tree->crunch(look_down => [ class => 'imageElement' ], leave => 1);
+isxml $tree, 't/html/crunch.exp', 'crunch';
+
+$tree = mktree 't/html/defmap.html';
+$tree->defmap(smap => {pause => 'arsenal rules'}, $ENV{TEST_VERBOSE});
+isxml $tree, 't/html/defmap.exp', 'defmap';
+
+$tree = mktree 't/html/fillinform.html';
+isxml \($tree->fillinform({state => 'catatonic'})), 't/html/fillinform.exp', 'fillinform';
+
+$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';
+
+$tree = mktree 't/html/iter.html';
+my $li = $tree->look_down(class => 'store_items');
+$tree->iter($li, qw/bread butter vodka/);
+isxml $tree, 't/html/iter.exp', 'iter';
+
+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);
+my $expected = [note => [list => [item => 'bread'], [item => 'butter'], [item => 'beans']]];
+is_deeply $new_lol, $expected, 'newchild unrolling';
+
+$tree = mktree 't/html/highlander2.html';
+$tree->passover('under18');
+isxml $tree, 't/html/highlander2-passover.exp', 'passover';
+
+$tree = mktree 't/html/position.html';
+my $found = $tree->look_down(id => 'findme');
+my $pos = join ' ', $found->position;
+is $pos, '-1 1 0 1 2', 'position';
+
+$tree = mktree 't/html/prune.html';
+$tree->prune;
+isxml $tree, 't/html/prune.exp', 'prune';
+
+##################################################
+# Longer tests
+
+$tree = mktree 't/html/dual_iter.html';
+
+$tree->iter2(
+ 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';
+
+###
+
+for my $age (qw/5 15 50/) {
+ $tree = mktree 't/html/highlander.html';
+ $tree->highlander(
+ age_dialog => [
+ under10 => sub { $_[0] < 10 },
+ under18 => sub { $_[0] < 18 },
+ welcome => sub { 1 }
+ ],
+ $age
+ );
+ isxml $tree, "t/html/highlander-$age.exp", "highlander for $age";
+}
+
+###
+
+sub replace_age {
+ my ($branch, $age) = @_;
+ $branch->look_down(id => 'age')->replace_content($age);
+}
+
+for my $age (qw/5 15 27/) {
+ $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 ]
+ );
+
+ isxml ($tree, "t/html/highlander2-$age.exp", "highlander2 for age $age");
+}
+
+###
+
+$tree = mktree 't/html/iter2.html';
+
+$tree->iter2(
+ # 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';
+
+###
+
+my @data = (
+ { clan_name => 'janglers', clan_id => 12, selected => 1 },
+ { clan_name => 'thugknights', clan_id => 14 },
+ { clan_name => 'cavaliers' , clan_id => 13 }
+);
+$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 => \@data,
+ data_iter => sub { my $data = shift; shift @$data });
+
+isxml $tree, 't/html/unroll_select.exp', 'unroll_select';
+++ /dev/null
-#!/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);
-
-my $expected = [note => [list => [item => 'bread'], [item => 'butter'], [item => 'beans']]];
-Test::More::is_deeply($new_lol, $expected, 'test unrolling');
+++ /dev/null
-#!/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';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-
-my $html =<<'EOHTML';
-<html>
-<head>
-</head>
-<body>
-<table>
-<tr>
- <td>a <td>a <td>a <td>a
-</tr>
-<tr>
- <td>a <td>a <td id=findme>a <td>a
-</tr>
-</table>
-</body>
-</html>
-EOHTML
-
-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';
+++ /dev/null
-#!/usr/bin/perl -T
-use lib '.';
-use t::lib tests => 1;
-
-my $root = HTML::TreeBuilder->new_from_content(<<'EOHTML');
-<html>
-<head>
- <title></title>
-</head>
-<body>
- <div>There was man named Jed</div>
-<div>He did not have a head</div>
-<div>He lived beneath a sled</div>
-<div>Now he's afraid of Fred...</div>
-<div>
-</div>
- </body>
-</html>
-EOHTML
-
-$root->prune;
-
-my $expected = '
-<html>
-<body>
-<div>There was man named Jed</div><div>He did not have a head</div><div>He lived beneath a sled</div><div>Now he's afraid of Fred...</div> </body>
-</html>
-';
-
-isxml($root, \$expected, 'prune');
+++ /dev/null
-#!/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!');
-
-isxml $t1, \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', 'replace_content';
+++ /dev/null
-#!/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->set_child_content(id => 'corpus', 'all gone!');
-isxml $t1, \'<html><head><title>I like stuff!</title></head><body id="corpus" lang="en-JP">all gone!</body></html>', 'set_child_content';
+++ /dev/null
-#!/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, 'p tag has 1 as its index';
+++ /dev/null
-#!/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 is a div tag";
-is scalar @sibs, 4, "4 siblings total";
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-use lib 't';
-use SimpleClass;
-
-my $o = SimpleClass->new;
-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)';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-use lib 't';
-use SimpleClass;
-
-my $o = SimpleClass->new;
-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';
+++ /dev/null
-#!/usr/bin/perl
-# Test the 3 possible look_down calls to table2()
-# a = default
-# b = supplied array ref
-# c = supplied code ref
-use t::lib tests => 3;
-use lib qw(t/ t/m/);
-use data::table2;
-
-my $o = data::table2->new;
-
-# a - default table_ld
-
-my $tree = mktree 't/html/table2.html';
-
-my $table = HTML::Element::Library::ref_or_ld(
- $tree,
- ['_tag' => 'table']
-);
-
-isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down default';
-
-# b - arrayref table_ld
-
-$table = HTML::Element::Library::ref_or_ld(
- $tree,
- [frame => 'hsides', rules => 'groups']
- );
-
-isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down arrayref';
-
-# c - coderef table_ld
-
-$table = HTML::Element::Library::ref_or_ld(
- $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';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 3;
-
-# a - default table_ld
-
-my $tree = mktree 't/html/table2.html';
-
-my @tr = HTML::Element::Library::ref_or_ld(
- $tree,
- ['_tag' => 'tr']
-);
-
-is (scalar @tr, 16, 'table2 tr look_down (default)');
-
-# b - arrayref tr_ld
-
-$tree = mktree 't/html/table2-tr_ld-arrayref.html';
-
-my $tr = HTML::Element::Library::ref_or_ld(
- $tree,
- [class => 'findMe']
-);
-
-isxml $tr, 't/html/table2-tr_ld-arrayref.exp', 'table2 tr look_down (arrayref)';
-
-# c - coderef tr_ld
-# removes windows listings before returning @tr
-
-$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;
- }
- }
- push @keep, $tr unless $detached;
- }
- @keep;
- }
-);
-
-isxml $tree, 't/html/table2-tr_ld-coderef.exp', 'table2 tr look_down (coderef)';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-use lib 't';
-use data::table2;
-
-my $root = 't/html/table2';
-my $d = data::table2->load_data;
-my $tree = mktree 't/html/table2.html';
-
-for my $dataset (keys %$d) {
- 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]);
- }
- }
- );
-}
-
-isxml $tree, 't/html/table2.exp', 'table2';
--- /dev/null
+#!/usr/bin/perl -T
+use lib '.';
+use t::lib tests => 9;
+
+my $tree;
+sub data () {
+ [map { +{name => $_->[0], age => $_->[1], weight => $_->[2]} } (
+ [qw/bob 99 99/],
+ [qw/bill 12 52/],
+ [qw/brian 44 80/],
+ [qw/babette 52 124/],
+ [qw/bobo 12 120/],
+ [qw/bix 43 230/],
+ )];
+}
+
+sub data2 () {
+ {
+ '3dig' => [
+ ['437', 'MS-DOS', 'United States', '0', '1', '1', '1', '1'],
+ ['708', 'Arabic (ASMO 708)', '0', '1', '0', '0', '1'],
+ ['709', 'Arabic (ASMO 449+ BCON V4)', '0', '1', '0', '0', '1'],
+ ['710', 'Arabic (Transparent Arabic)', '0', '1', '0', '0', '1'],
+ ['720', 'Arabic (Transparent ASMO)', '0', '1', '0', '0', '1']],
+ '4dig' => [
+ ['1200', 'Unicode (BMP of ISO 10646)', '0', '0', '1', '1', '2'],
+ ['1250', 'Windows 3.1 Eastern European', '1', '0', '1', '1', '1'],
+ ['1251', 'Windows 3.1 Cyrillic', '1', '0', '1', '1', '1'],
+ ['1252', 'Windows 3.1 US (ANSI)', '1', '0', '1', '1', '1'],
+ ['1253', 'Windows 3.1 Greek', '1', '0', '1', '1', '1'],
+ ['1254', 'Windows 3.1 Turkish', '1', '0', '1', '1', '1'],
+ ['1255', 'Hebrew', '1', '0', '0', '0', '1'],
+ ['1256', 'Arabic', '1', '0', '0', '0', '1'],
+ ['1257', 'Baltic', '1', '0', '0', '0', '1'],
+ ['1361', 'Korean (Johab)', '1', '0', '0', '3', '1']]
+ };
+}
+
+$tree = mktree 't/html/table.html';
+
+$tree->table(
+ gi_table => 'load_data',
+ gi_tr => 'data_row',
+ table_data => 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';
+
+###
+
+$tree = mktree 't/html/table-alt.html';
+
+$tree->table(
+ gi_table => 'load_data',
+ gi_tr => ['iterate1', 'iterate2'],
+ table_data => 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)';
+
+###
+
+my $d = data2;
+$tree = mktree 't/html/table2.html';
+
+for my $dataset (keys %$d) {
+ 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]);
+ }
+ }
+ );
+}
+
+isxml $tree, 't/html/table2.exp', 'table2';
+
+###
+
+# a - default table_ld
+$tree = mktree 't/html/table2.html';
+my $table = HTML::Element::Library::ref_or_ld(
+ $tree,
+ ['_tag' => 'table']
+);
+isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down default';
+
+###
+
+# b - arrayref table_ld
+$table = HTML::Element::Library::ref_or_ld(
+ $tree,
+ [frame => 'hsides', rules => 'groups']
+);
+isxml $table, 't/html/table2-table_ld.exp', 'table2 look_down arrayref';
+
+# c - coderef table_ld
+$table = HTML::Element::Library::ref_or_ld(
+ $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';
+
+###
+
+# a - default table_ld
+my @tr = HTML::Element::Library::ref_or_ld(
+ $tree,
+ ['_tag' => 'tr']
+);
+is (scalar @tr, 16, 'table2 tr look_down (default)');
+
+# b - coderef tr_ld
+# removes windows listings before returning @tr
+
+HTML::Element::Library::ref_or_ld(
+ $tree,
+ sub {
+ my ($t) = @_;
+ my @trs = $t->look_down('_tag' => 'tr');
+ my @keep;
+ for my $tr (@trs) {
+
+ 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;
+ }
+);
+isxml $tree, 't/html/table2-tr_ld-coderef.exp', 'table2 tr look_down (coderef)';
+
+# c - arrayref tr_ld
+
+$tree = mktree 't/html/table2-tr_ld-arrayref.html';
+my $tr = HTML::Element::Library::ref_or_ld(
+ $tree,
+ [class => 'findMe']
+);
+isxml $tr, 't/html/table2-tr_ld-arrayref.exp', 'table2 tr look_down (arrayref)';
+++ /dev/null
-#!/usr/bin/perl
-use t::lib tests => 1;
-use lib 't';
-
-use SelectData;
-
-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 });
-
-isxml ($tree, 't/html/unroll_select.exp', 'unroll_select');
+++ /dev/null
-#!/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', ['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);
-isxml $w, \'<span id="wrapme"><b id="wrapper">um, p < 4!</b></span>', 'wrap_content';
projects / html-element-library.git / commitdiff