X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FHTML%2FElement%2FLibrary.pm;h=cb9cec3e5d423454e19e29c82f24e38ef3bbe48e;hb=271d5078dc10f92db0d9927bd84065a0b9a38397;hp=08f6ee5cf0fa293fd3203880f37938e9cfbde61a;hpb=5f53bf212e506831653abc6442b846782211e12c;p=html-element-library.git diff --git a/lib/HTML/Element/Library.pm b/lib/HTML/Element/Library.pm index 08f6ee5..cb9cec3 100644 --- a/lib/HTML/Element/Library.pm +++ b/lib/HTML/Element/Library.pm @@ -1,6 +1,6 @@ package HTML::Element::Library; +# ABSTRACT: Convenience methods for HTML::TreeBuilder and HTML::Element -use 5.006001; use strict; use warnings; @@ -12,6 +12,7 @@ use Array::Group qw(:all); use Carp qw(confess); use Data::Dumper; use HTML::Element; +use List::Util qw(first); use List::MoreUtils qw/:all/; use Params::Validate qw(:all); use Scalar::Listify; @@ -24,11 +25,32 @@ our @EXPORT = qw(); -our $VERSION = '3.53'; +our $VERSION = '4.3'; + # Preloaded methods go here. +# https://rt.cpan.org/Ticket/Display.html?id=44105 +sub HTML::Element::fillinform { + + my ($tree, $hashref, $return_tree, $guts)=@_; + + (ref $hashref) eq 'HASH' or die 'hashref not supplied as argument' ; + + use HTML::FillInForm; + my $html = $tree->as_HTML; + my $new_html = HTML::FillInForm->fill(\$html, $hashref); + + if ($return_tree) { + my $tree = HTML::TreeBuilder->new_from_content($new_html); + $tree = $guts ? $tree->guts : $tree ; + } else { + $new_html; + } + +} + sub HTML::Element::siblings { my $element = shift; my $p = $element->parent; @@ -36,18 +58,145 @@ sub HTML::Element::siblings { $p->content_list; } +sub HTML::Element::defmap { + my($tree,$attr,$hashref,$debug)=@_; + + while (my ($k, $v) = (each %$hashref)) { + warn "defmap looks for ($attr => $k)" if $debug; + my $found = $tree->look_down($attr => $k); + if ($found) { + warn "($attr => $k) was found.. replacing with '$v'" if $debug; + $found->replace_content( $v ); + } + } + +} + +sub HTML::Element::_only_empty_content { + my ($self)=@_; + my @c = $self->content_list; + my $length = scalar @c; + + #use Data::Dumper; + #warn sprintf 'Testing %s (%s)' , $self->starttag, Dumper(\@c); + #warn sprintf "\t\tlength of content: %d ", $length; + + scalar @c == 1 and not length($c[0]); +} + +sub HTML::Element::prune { + my ($self)=@_; + + for my $c ($self->content_list) { + next unless ref $c; + #warn "C: " . Dumper($c); + $c->prune; + } + + # post-order: + $self->delete if ($self->is_empty or $self->_only_empty_content); + $self; +} + +sub HTML::Element::newnode { + my ($lol, $node_label, $new_node)=@_; + + use Data::Rmap qw(rmap_array); + + my ($mapresult) = rmap_array { + + + if ($_->[0] eq $node_label) { + $_ = $new_node; + Data::Rmap::cut($_); + } else { + $_; + } + + } $lol; + + $mapresult; + +} + +sub HTML::Element::crunch { + my $container = shift; + + my %p = validate(@_, { + look_down => { type => ARRAYREF }, + leave => { default => 1 }, + }); + + my @look_down = @{$p{look_down}} ; + my @elem = $container->look_down( @look_down ) ; + + my $left; + + for my $elem (@elem) { + $elem->detach if $left++ >= $p{leave} ; + } + +} + +sub HTML::Element::hash_map { + my $container = shift; + + my %p = validate(@_, { + hash => { type => HASHREF }, + to_attr => 1, + excluding => { type => ARRAYREF , default => [] }, + debug => { default => 0 }, + }); + + warn 'The container tag is ', $container->tag if $p{debug} ; + warn 'hash' . Dumper($p{hash}) if $p{debug} ; + #warn 'at_under' . Dumper(\@_) if $p{debug} ; + + my @same_as = $container->look_down( $p{to_attr} => qr/.+/ ) ; + + warn 'Found ' . scalar(@same_as) . ' nodes' if $p{debug} ; + + + for my $same_as (@same_as) { + my $attr_val = $same_as->attr($p{to_attr}) ; + if (first { $attr_val eq $_ } @{$p{excluding}}) { + warn "excluding $attr_val" if $p{debug} ; + next; + } + warn "processing $attr_val" if $p{debug} ; + $same_as->replace_content( $p{hash}->{$attr_val} ) ; + } + +} + +sub HTML::Element::hashmap { + my ($container, $attr_name, $hashref, $excluding, $debug) = @_; + + $excluding ||= [] ; + + $container->hash_map(hash => $hashref, + to_attr => $attr_name, + excluding => $excluding, + debug => $debug); + +} + + sub HTML::Element::passover { - my ($tree, $child_id) = @_; + my ($tree, @to_preserve) = @_; - #warn "ARGS: my ($tree, $child)"; + warn "ARGS: my ($tree, @to_preserve)" if $DEBUG; + warn $tree->as_HTML(undef, ' ') if $DEBUG; - my $exodus = $tree->look_down(id => $child_id); + my $exodus = $tree->look_down(id => $to_preserve[0]); + + warn "E: $exodus" if $DEBUG; my @s = HTML::Element::siblings($exodus); for my $s (@s) { next unless ref $s; - if ($s->attr('id') eq $child_id) { + if (first { $s->attr('id') eq $_ } @to_preserve) { ; } else { $s->delete; @@ -111,12 +260,19 @@ sub HTML::Element::position { sub HTML::Element::content_handler { - my ($tree, $id_name, $content) = @_; + my ($tree, %content_hash) = @_; + + for my $k (keys %content_hash) { + $tree->set_child_content(id => $k, $content_hash{$k}); + } - $tree->set_child_content(id => $id_name, $content); } +sub HTML::Element::assign { + goto &HTML::Element::content_handler; +} + sub make_counter { my $i = 1; @@ -136,7 +292,6 @@ sub HTML::Element::iter { my @item = map { my $new_item = clone $p; $new_item->replace_content($_); - # $new_item->attr('id', $id_incr->( $p->attr('id') )); $new_item; } @data; @@ -185,6 +340,7 @@ sub HTML::Element::iter2 { warn "wrapper_data: " . Dumper $p{wrapper_data} if $p{debug} ; my $container = ref_or_ld($tree, $p{wrapper_ld}); + warn "container: " . $container if $p{debug} ; warn "wrapper_(preproc): " . $container->as_HTML if $p{debug} ; $p{wrapper_proc}->($container) if defined $p{wrapper_proc} ; warn "wrapper_(postproc): " . $container->as_HTML if $p{debug} ; @@ -616,24 +772,33 @@ sub HTML::Element::unroll_select { my $select = {}; + warn "Select Hash: " . Dumper(\%select) if $select{debug}; + my $select_node = $s->look_down(id => $select{select_label}); + warn "Select Node: " . $select_node if $select{debug}; - my $option = $select_node->look_down('_tag' => 'option'); + unless ($select{append}) { + for my $option ($select_node->look_down('_tag' => 'option')) { + $option->delete; + } + } -# warn $option; + my $option = HTML::Element->new('option'); + warn "Option Node: " . $option if $select{debug}; $option->detach; while (my $row = $select{data_iter}->($select{data})) { -# warn Dumper($row); - my $o = $option->clone; - $o->attr('value', $select{option_value}->($row)); - $o->attr('SELECTED', 1) if ($select{option_selected}->($row)) ; - - $o->replace_content($select{option_content}->($row)); - $select_node->push_content($o); + warn "Data Row:" . Dumper($row) if $select{debug}; + my $o = $option->clone; + $o->attr('value', $select{option_value}->($row)); + $o->attr('SELECTED', 1) if (exists $select{option_selected} and $select{option_selected}->($row)) ; + + $o->replace_content($select{option_content}->($row)); + $select_node->push_content($o); + warn $o->as_HTML if $select{debug}; } @@ -660,993 +825,3 @@ sub HTML::TreeBuilder::parse_string { 1; __END__ -# Below is stub documentation for your module. You'd better edit it! - -=head1 NAME - -HTML::Element::Library - HTML::Element convenience functions - -=head1 SYNOPSIS - - use HTML::Element::Library; - use HTML::TreeBuilder; - -=head1 DESCRIPTION - -This method provides API calls for common actions on trees when using -L. - -=head1 METHODS - -The test suite contains examples of each of these methods in a -file C - -=head2 Positional Querying Methods - -=head3 $elem->siblings - -Return a list of all nodes under the same parent. - -=head3 $elem->sibdex - -Return the index of C<$elem> into the array of siblings of which it is -a part. L calls this method C but I don't think -that is a descriptive name. And such naming is deceptively close to the -C
function of C. HOWEVER, in the interest of -backwards compatibility, both methods are available. - -=head3 $elem->addr - -Same as sibdex - -=head3 $elem->position() - -Returns the coordinates of this element in the tree it inhabits. -This is accomplished by succesively calling addr() on ancestor -elements until either a) an element that does not support these -methods is found, or b) there are no more parents. The resulting -list is the n-dimensional coordinates of the element in the tree. - -=head2 Element Decoration Methods - -=head3 HTML::Element::Library::super_literal($text) - -In L, Sean Burke discusses super-literals. They are -text which does not get escaped. Great for includng Javascript in -HTML. Also great for including foreign language into a document. - -So, you basically toss C your text and back comes -your text wrapped in a C<~literal> element. - -One of these days, I'll around to writing a nice C section. - -=head2 Tree Rewriting Methods - -=head3 $elem->replace_content(@new_elem) - -Replaces all of C<$elem>'s content with C<@new_elem>. - -=head3 $elem->wrap_content($wrapper_element) - -Wraps the existing content in the provided element. If the provided element -happens to be a non-element, a push_content is performed instead. - -=head3 $elem->set_child_content(@look_down, $content) - - This method looks down $tree using the criteria specified in @look_down using the the HTML::Element look_down() method. - -After finding the node, it detaches the node's content and pushes $content as the node's content. - -=head3 $tree->content_handler($sid_value , $content) - -This is a convenience method. Because the look_down criteria will often simply be: - - id => 'fixme' - -to find things like: - - replace_content - -You can call this method to shorten your typing a bit. You can simply type - - $elem->content_handler( fixme => 'new text' ) - -Instead of typing: - - $elem->set_child_content(sid => 'fixme', 'new text') - -=head3 $tree->highlander($subtree_span_id, $conditionals, @conditionals_args) - -This allows for "if-then-else" style processing. Highlander was a movie in -which only one would survive. Well, in terms of a tree when looking at a -structure that you want to process in C style, only one child -will survive. For example, given this HTML template: - - - - Hello, does your mother know you're - using her AOL account? - - - Sorry, you're not old enough to enter - (and too dumb to lie about your age) - - - Welcome - - - -We only want one child of the C tag with id C to remain -based on the age of the person visiting the page. - -So, let's setup a call that will prune the subtree as a function of age: - - sub process_page { - 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 - ); - -And there we have it. If the age is less than 10, then the node with -id C remains. For age less than 18, the node with id C -remains. -Otherwise our "else" condition fires and the child with id C remains. - -=head3 $tree->passover($id_of_element) - -In some cases, you know exactly which element should survive. In this case, -you can simply call C to remove it's siblings. For the HTML -above, you could delete C and C by simply calling: - - $tree->passover('under18'); - -=head3 $tree->highlander2($tree, $conditionals, @conditionals_args) - -Right around the same time that C came into being, Seamstress -began to tackle tougher and tougher processing problems. It became clear that -a more powerful highlander was needed... one that not only snipped the tree -of the nodes that should not survive, but one that allows for -post-processing of the survivor node. And one that was more flexible with -how to find the nodes to snip. - -Thus (drum roll) C. - -So let's look at our HTML which requires post-selection processing: - - - - Hello, little AGE-year old, - does your mother know you're using her AOL account? - - - Sorry, you're only AGE - (and too dumb to lie about your age) - - - Welcome, isn't it good to be AGE years old? - - - -In this case, a branch survives, but it has dummy data in it. We must take -the surviving segment of HTML and rewrite the age C with the age. -Here is how we use C to do so: - - sub replace_age { - my $branch = shift; - my $age = shift; - $branch->look_down(id => 'age')->replace_content($age); - } - - 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 ] - ); - -We pass it the tree (C<$if_then>), an arrayref of conditions -(C) and an arrayref of arguments which are passed to the -Cs and to the replacement subs. - -The C, C and C are id attributes in the -tree of the siblings of which only one will survive. However, -should you need to do -more complex look-downs to find the survivor, -then supply an array ref instead of a simple -scalar: - - - $if_then->highlander2( - cond => [ - [class => 'r12'] => [ - sub { $_[0] < 10} , - \&replace_age - ], - [class => 'z22'] => [ - sub { $_[0] < 18} , - \&replace_age - ], - [class => 'w88'] => [ - sub { 1 }, - \&replace_age - ] - ], - cond_arg => [ $age ] - ); - - -=head3 $tree->overwrite_attr($mutation_attr => $mutating_closures) - -This method is designed for taking a tree and reworking a set of nodes in -a stereotyped fashion. For instance let's say you have 3 remote image -archives, but you don't want to put long URLs in your img src -tags for reasons of abstraction, re-use and brevity. So instead you do this: - - - - - -and then when the tree of HTML is being processed, you make this call: - - my %closures = ( - lnc => sub { my ($tree, $mute_node, $attr_value)= @_; "http://lnc.usc.edu$attr_value" }, - playboy => sub { my ($tree, $mute_node, $attr_value)= @_; "http://playboy.com$attr_value" } - foobar => sub { my ($tree, $mute_node, $attr_value)= @_; "http://foobar.info$attr_value" } - ) - - $tree->overwrite_attr(fixup => \%closures) ; - -and the tags come out modified like so: - - - - - -=head3 $tree->mute_elem($mutation_attr => $mutating_closures, [ $post_hook ] ) - -This is a generalization of C. C -assumes the return value of the -closure is supposed overwrite an attribute value and does it for you. -C is a more general function which does nothing but -hand the closure the element and let it mutate it as it jolly well pleases :) - -In fact, here is the implementation of C -to give you a taste of how C is used: - - sub overwrite_action { - my ($mute_node, %X) = @_; - - $mute_node->attr($X{local_attr}{name} => $X{local_attr}{value}{new}); - } - - - sub HTML::Element::overwrite_attr { - my $tree = shift; - - $tree->mute_elem(@_, \&overwrite_action); - } - - - - -=head2 Tree-Building Methods: Unrolling an array via a single sample element (
    container) - -This is best described by example. Given this HTML: - - Here are the things I need from the store: -
      -
    • Sample item
      • -
    - -We can unroll it like so: - - my $li = $tree->look_down(class => 'store_items'); - - my @items = qw(bread butter vodka); - - $tree->iter($li => @items); - -To produce this: - - - - - Here are the things I need from the store: -
      -
    • bread
      • -
    • butter
      • -
    • vodka
      • -
    - - - -=head2 Tree-Building Methods: Unrolling an array via n sample elements (
    container) - -C was fine for awhile, but some things -(e.g. definition lists) need a more general function to make them easy to -do. Hence C. This function will be explained by example of unrolling -a simple definition list. - -So here's our mock-up HTML from the designer: - -
    -
    - Artist -
    -
    - A person who draws blood. -
    - -
    - Musician -
    -
    - A clone of Iggy Pop. -
    - -
    - Poet -
    -
    - A relative of Edgar Allan Poe. -
    - -
    sample header
    -
    sample data
    - -
    - - -And we want to unroll our data set: - - 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'] - ); - - -Now, let's make this problem a bit harder to show off the power of C. -Let's assume that we want only the last
    and it's accompanying
    -(the one with "sample data") to be used as the sample data -for unrolling with our data set. Let's further assume that we want them to -remain in the final output. - -So now, the API to C will be discussed and we will explain how our -goal of getting our data into HTML fits into the API. - -=over 4 - -=item * wrapper_ld - -This is how to look down and find the container of all the elements we will -be unrolling. The
    tag is the container for the dt and dd tags we will be -unrolling. - -If you pass an anonymous subroutine, then it is presumed that execution of -this subroutine will return the HTML::Element representing the container tag. -If you pass an array ref, then this will be dereferenced and passed to -C. - -default value: C<< ['_tag' => 'dl'] >> - -Based on the mock HTML above, this default is fine for finding our container -tag. So let's move on. - -=item * wrapper_data - -This is an array reference of data that we will be putting into the container. -You must supply this. C<@items> above is our C. - -=item * wrapper_proc - -After we find the container via C, we may want to pre-process -some aspect of this tree. In our case the first two sets of dt and dd need -to be removed, leaving the last dt and dd. So, we supply a C -which will do this. - -default: undef - -=item * item_ld - -This anonymous subroutine returns an array ref of Cs that will -be cloned and populated with item data -(item data is a "row" of C). - -default: returns an arrayref consisting of the dt and dd element inside the -container. - -=item * item_data - -This is a subroutine that takes C and retrieves one "row" -to be "pasted" into the array ref of Cs found via C. -I hope that makes sense. - -default: shifts C. - -=item * item_proc - -This is a subroutine that takes the C and the Cs -found via C and produces an arrayref of Cs which will -eventually be spliced into the container. - -Note that this subroutine MUST return the new items. This is done -So that more items than were passed in can be returned. This is -useful when, for example, you must return 2 dts for an input data item. -And when would you do this? When a single term has multiple spellings -for instance. - -default: expects C to be an arrayref of two elements and -C to be an arrayref of two Cs. It replaces the -content of the Cs with the C. - -=item * splice - -After building up an array of C<@item_elems>, the subroutine passed as -C will be given the parent container HTML::Element and the -C<@item_elems>. How the C<@item_elems> end up in the container is up to this -routine: it could put half of them in. It could unshift them or whatever. - -default: C<< $container->splice_content(0, 2, @item_elems) >> -In other words, kill the 2 sample elements with the newly generated -@item_elems - -=back - -So now that we have documented the API, let's see the call we need: - - $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 fine. - # default item_data is fine. - # default item_proc is fine. - splice => sub { - my ($container, @item_elems) = @_; - $container->unshift_content(@item_elems); - }, - debug => 1, - ); - - -=head2 Tree-Building Methods: Select Unrolling - -The C method has this API: - - $tree->unroll_select( - select_label => $id_label, - option_value => $closure, # how to get option value from data row - option_content => $closure, # how to get option content from data row - option_selected => $closure, # boolean to decide if SELECTED - data => $data # the data to be put into the SELECT - data_iter => $closure # the thing that will get a row of data - ); - -Here's an example: - - $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 => \@query_results, - data_iter => sub { my $data = shift; $data->next } - ) - - - -=head2 Tree-Building Methods: Table Generation - -Matthew Sisk has a much more intuitive (imperative) -way to generate tables via his module -L. -However, for those with callback fever, the following -method is available. First, we look at a nuts and bolts way to build a table -using only standard L API calls. Then the C method -available here is discussed. - -=head3 Sample Model - - package Simple::Class; - - use Set::Array; - - 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 => $age[rand $#age] + int rand 20, - name => shift @name, - weight => $weight[rand $#weight] + int rand 40 - } - } - - Set::Array->new(@data); - } - - - 1; - - -=head4 Sample Usage: - - my $data = Simple::Class->load_data; - ++$_->{age} for @$data - -=head3 Inline Code to Unroll a Table - -=head4 HTML - - - -
    - - - - - - - - - - - -
    nameageweight
    NATURE BOY RIC FLAIR 35 220
    - - - - -=head4 The manual way (*NOT* recommended) - - require 'simple-class.pl'; - use HTML::Seamstress; - - # load the view - my $seamstress = HTML::Seamstress->new_from_file('simple.html'); - - # load the model - my $o = Simple::Class->new; - my $data = $o->load_data; - - # find the and - my $table_node = $seamstress->look_down('id', 'load_data'); - my $iter_node = $table_node->look_down('id', 'iterate'); - my $table_parent = $table_node->parent; - - - # drop the sample
    and from the HTML - # only add them in if there is data in the model - # this is achieved via the $add_table flag - - $table_node->detach; - $iter_node->detach; - my $add_table; - - # Get a row of model data - while (my $row = shift @$data) { - - # We got row data. Set the flag indicating ok to hook the table into the HTML - ++$add_table; - - # clone the sample - my $new_iter_node = $iter_node->clone; - - # find the tags labeled name age and weight and - # set their content to the row data - $new_iter_node->content_handler($_ => $row->{$_}) - for qw(name age weight); - - $table_node->push_content($new_iter_node); - - } - - # reattach the table to the HTML tree if we loaded data into some table rows - - $table_parent->push_content($table_node) if $add_table; - - print $seamstress->as_HTML; - - - -=head3 $tree->table() : API call to Unroll a Table - - require 'simple-class.pl'; - use HTML::Seamstress; - - # load the view - my $seamstress = HTML::Seamstress->new_from_file('simple.html'); - # load the model - my $o = Simple::Class->new; - - $seamstress->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 => 'iterate', - - # 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) } - - ); - - - print $seamstress->as_HTML; - - - -=head4 Looping over Multiple Sample Rows - -* HTML - - - - - - - - - - - - - - - - - - - - - - -
    nameageweight
    NATURE BOY RIC FLAIR 35 220
    NATURE BOY RIC FLAIR 35 220
    - - - - -* Only one change to last API call. - -This: - - gi_tr => 'iterate', - -becomes this: - - gi_tr => ['iterate1', 'iterate2'] - -=head3 $tree->table2() : New API Call to Unroll a Table - -After 2 or 3 years with C, I began to develop -production websites with it and decided it needed a cleaner -interface, particularly in the area of handling the fact that -C tags will be the same after cloning a table row. - -First, I will give a dry listing of the function's argument parameters. -This will not be educational most likely. A better way to understand how -to use the function is to read through the incremental unrolling of the -function's interface given in conversational style after the dry listing. -But take your pick. It's the same information given in two different -ways. - -=head4 Dry/technical parameter documentation - -C<< $tree->table2(%param) >> takes the following arguments: - -=over - -=item * C<< table_ld => $look_down >> : optional - -How to find the C element in C<$tree>. If C<$look_down> is an -arrayref, then use C. If it is a CODE ref, then call it, -passing it C<$tree>. - -Defaults to C<< ['_tag' => 'table'] >> if not passed in. - -=item * C<< table_data => $tabular_data >> : required - -The data to fill the table with. I be passed in. - -=item * C<< table_proc => $code_ref >> : not implemented - -A subroutine to do something to the table once it is found. -Not currently implemented. Not obviously necessary. Just -created because there is a C and C. - -=item * C<< tr_ld => $look_down >> : optional - -Same as C but for finding the table row elements. Please note -that the C is done on the table node that was found I -of the whole HTML tree. This makes sense. The Cs that you want exist -below the table that was just found. - -Defaults to C<< ['_tag' => 'tr'] >> if not passed in. - -=item * C<< tr_data => $code_ref >> : optional - -How to take the C and return a row. Defaults to: - - sub { my ($self, $data) = @_; - shift(@{$data}) ; - } - -=item * C<< tr_proc => $code_ref >> : optional - -Something to do to the table row we are about to add to the -table we are making. Defaults to a routine which makes the C -attribute unique: - - sub { - my ($self, $tr, $tr_data, $tr_base_id, $row_count) = @_; - $tr->attr(id => sprintf "%s_%d", $tr_base_id, $row_count); - } - -=item * C<< td_proc => $code_ref >> : required - -This coderef will take the row of data and operate on the C. See C for several usage examples. - -Here's a sample one: - - sub { - my ($tr, $data) = @_; - my @td = $tr->look_down('_tag' => 'td'); - for my $i (0..$#td) { - $td[$i]->splice_content(0, 1, $data->[$i]); - } - } - -=cut - -=head4 Conversational parameter documentation - -The first thing you need is a table. So we need a look down for that. If you -don't give one, it defaults to - - ['_tag' => 'table'] - -What good is a table to display in without data to display?! -So you must supply a scalar representing your tabular -data source. This scalar might be an array reference, a Cable iterator, -a DBI statement handle. Whatever it is, it can be iterated through to build -up rows of table data. -These two required fields (the way to find the table and the data to -display in the table) are C and C -respectively. A little more on C. If this happens to be a CODE ref, -then execution -of the code ref is presumed to return the C -representing the table in the HTML tree. - -Next, we get the row or rows which serve as sample C elements by doing -a C from the C. While normally one sample row -is enough to unroll a table, consider when you have alternating -table rows. This API call would need one of each row so that it can -cycle through the -sample rows as it loops through the data. -Alternatively, you could always just use one row and -make the necessary changes to the single C row by -mutating the element in C, -discussed below. The default C is -C<< ['_tag' => 'tr'] >> but you can overwrite it. Note well, if you overwrite -it with a subroutine, then it is expected that the subroutine will return -the C(s) -which are C element(s). -The reason a subroutine might be preferred is in the case -that the HTML designers gave you 8 sample C rows but only one -prototype row is needed. -So you can write a subroutine, to splice out the 7 rows you don't need -and leave the one sample -row remaining so that this API call can clone it and supply it to -the C and C calls. - -Now, as we move through the table rows with table data, -we need to do two different things on -each table row: - -=over 4 - -=item * get one row of data from the C via C - -The default procedure assumes the C is an array reference and -shifts a row off of it: - - sub { my ($self, $data) = @_; - shift(@{$data}) ; - } - -Your function MUST return undef when there is no more rows to lay out. - -=item * take the C element and mutate it via C - -The default procedure simply makes the id of the table row unique: - - sub { my ($self, $tr, $tr_data, $row_count, $root_id) = @_; - $tr->attr(id => sprintf "%s_%d", $root_id, $row_count); - } - -=back - -Now that we have our row of data, we call C so that it can -take the data and the C and process them. -This function I be supplied. - - -=head3 Whither a Table with No Rows - -Often when a table has no rows, we want to display a message -indicating this to the view. Use conditional processing to decide what -to display: - - -
    cells that -are children of the C
    cells in this C
    No Data is Good Data
    - - - - - - - - - - - - - - - - -
    nameageweight
    NATURE BOY RIC FLAIR 35 220
    - - - -     - - - - -=head1 SEE ALSO - -=over - -=item * L - -A perl package for creating and manipulating HTML trees - -=item * L - -An L - based module which allows for manipulation of HTML -trees using cartesian coordinations. - -=item * L - -An L - based module inspired by -XMLC (L), allowing for dynamic -HTML generation via tree rewriting. - -=head1 TODO - -=over - -=item * highlander2 - -currently the API expects the subtrees to survive or be pruned to be -identified by id: - - $if_then->highlander2([ - under10 => sub { $_[0] < 10} , - under18 => sub { $_[0] < 18} , - welcome => [ - sub { 1 }, - sub { - my $branch = shift; - $branch->look_down(id => 'age')->replace_content($age); - } - ] - ], - $age - ); - -but, it should be more flexible. the C, and C are -expected to be ids in the tree... but it is not hard to have a check to -see if this field is an array reference and if it, then to do a look -down instead: - - $if_then->highlander2([ - [class => 'under10'] => sub { $_[0] < 10} , - [class => 'under18'] => sub { $_[0] < 18} , - [class => 'welcome'] => [ - sub { 1 }, - sub { - my $branch = shift; - $branch->look_down(id => 'age')->replace_content($age); - } - ] - ], - $age - ); - - - -=cut - -=head1 SEE ALSO - -L - -=head1 AUTHOR - -Terrence Brannon, Etbone@cpan.orgE - -Many thanks to BARBIE for his RT bug report. - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2004 by Terrence Brannon - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself, either Perl version 5.8.4 or, -at your option, any later version of Perl 5 you may have available. - - -=cut