package HTML::Element::Library;
-use 5.006001;
+
use strict;
use warnings;
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;
-our $VERSION = '3.51';
+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;
$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::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, @to_preserve) = @_;
+
+ warn "ARGS: my ($tree, @to_preserve)" if $DEBUG;
+ warn $tree->as_HTML(undef, ' ') if $DEBUG;
+
+ 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 (first { $s->attr('id') eq $_ } @to_preserve) {
+ ;
+ } else {
+ $s->delete;
+ }
+ }
+
+ return $exodus; # Goodbye Egypt! http://en.wikipedia.org/wiki/Passover
+
+}
+
sub HTML::Element::sibdex {
my $element = shift;
sub HTML::Element::content_handler {
- my ($tree, $id_name, $content) = @_;
+ my ($tree, %content_hash) = @_;
- $tree->set_child_content(id => $id_name, $content);
+ for my $k (keys %content_hash) {
+ $tree->set_child_content(id => $k, $content_hash{$k});
+ }
+
+
+}
+sub HTML::Element::assign {
+ goto &HTML::Element::content_handler;
}
my @item = map {
my $new_item = clone $p;
$new_item->replace_content($_);
- # $new_item->attr('id', $id_incr->( $p->attr('id') ));
$new_item;
} @data;
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} ;
# ++$DEBUG if $table{debug} ;
# Get the table element
- warn 1;
+ #warn 1;
$table->{table_node} = ref_or_ld( $tree, $p{table_ld} ) ;
- warn 2;
+ #warn 2;
$table->{table_node} or confess
"table tag not found via " . Dumper($p{table_ld}) ;
if defined $p{tr_proc};
warn "data row redux: " . Dumper $row if $p{debug};
- warn 3.3;
+ #warn 3.3;
$p{td_proc}->($new_tr_node, $row);
push @table_rows, $new_tr_node;
- warn 4.4;
+ #warn 4.4;
redo;
}
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};
}
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<HTML::Tree>.
-
-=head1 METHODS
-
-The test suite contains examples of each of these methods in a
-file C<t/$method.t>
-
-=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<HTML::ElementSuper> calls this method C<addr> but I don't think
-that is a descriptive name. And such naming is deceptively close to the
-C<address> function of C<HTML::Element>. 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<HTML::Element>, 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<super_literal> 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<EXPORT> 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:
-
- <a id=fixme href=http://www.somesite.org>replace_content</a>
-
-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<if-then-else> style, only one child
-will survive. For example, given this HTML template:
-
- <span klass="highlander" id="age_dialog">
- <span id="under10">
- Hello, does your mother know you're
- using her AOL account?
- </span>
- <span id="under18">
- Sorry, you're not old enough to enter
- (and too dumb to lie about your age)
- </span>
- <span id="welcome">
- Welcome
- </span>
- </span>
-
-We only want one child of the C<span> tag with id C<age_dialog> 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<under10> remains. For age less than 18, the node with id C<under18>
-remains.
-Otherwise our "else" condition fires and the child with id C<welcome> remains.
-
-=head3 $tree->highlander2($tree, $conditionals, @conditionals_args)
-
-Right around the same time that C<table2()> 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<highlander2()>.
-
-So let's look at our HTML which requires post-selection processing:
-
- <span klass="highlander" id="age_dialog">
- <span id="under10">
- Hello, little <span id=age>AGE</span>-year old,
- does your mother know you're using her AOL account?
- </span>
- <span id="under18">
- Sorry, you're only <span id=age>AGE</span>
- (and too dumb to lie about your age)
- </span>
- <span id="welcome">
- Welcome, isn't it good to be <span id=age>AGE</span> years old?
- </span>
-</span>
-
-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<span> with the age.
-Here is how we use C<highlander2()> 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<cond>) and an arrayref of arguments which are passed to the
-C<cond>s and to the replacement subs.
-
-The C<under10>, C<under18> and C<welcome> 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:
-
- <img src="/img/smiley-face.jpg" fixup="src lnc">
- <img src="/img/hot-babe.jpg" fixup="src playboy">
- <img src="/img/footer.jpg" fixup="src foobar">
-
-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:
-
- <img src="http://lnc.usc.edu/img/smiley-face.jpg" fixup="src lnc">
- <img src="http://playboy.com/img/hot-babe.jpg" fixup="src playboy">
- <img src="http://foobar.info/img/footer.jpg" fixup="src foobar">
-
-=head3 $tree->mute_elem($mutation_attr => $mutating_closures, [ $post_hook ] )
-
-This is a generalization of C<overwrite_attr>. C<overwrite_attr>
-assumes the return value of the
-closure is supposed overwrite an attribute value and does it for you.
-C<mute_elem> 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<overwrite_attr>
-to give you a taste of how C<mute_attr> 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 (<ul> container)
-
-This is best described by example. Given this HTML:
-
- <strong>Here are the things I need from the store:</strong>
- <ul>
- <li class="store_items">Sample item</li>
- </ul>
-
-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:
-
-
- <html>
- <head></head>
- <body>Here are the things I need from the store:
- <ul>
- <li class="store_items">bread</li>
- <li class="store_items">butter</li>
- <li class="store_items">vodka</li>
- </ul>
- </body>
- </html>
-
-=head2 Tree-Building Methods: Unrolling an array via n sample elements (<dl> container)
-
-C<iter()> was fine for awhile, but some things
-(e.g. definition lists) need a more general function to make them easy to
-do. Hence C<iter2()>. This function will be explained by example of unrolling
-a simple definition list.
-
-So here's our mock-up HTML from the designer:
-
- <dl class="dual_iter" id="service_plan">
- <dt>
- Artist
- </dt>
- <dd>
- A person who draws blood.
- </dd>
-
- <dt>
- Musician
- </dt>
- <dd>
- A clone of Iggy Pop.
- </dd>
-
- <dt>
- Poet
- </dt>
- <dd>
- A relative of Edgar Allan Poe.
- </dd>
-
- <dt class="adstyle">sample header</dt>
- <dd class="adstyle2">sample data</dd>
-
- </dl>
-
-
-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<iter2()>.
-Let's assume that we want only the last <dt> and it's accompanying <dd>
-(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<iter2()> 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 <dl> 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<HTML::Element::look_down()>.
-
-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<wrapper_data>.
-
-=item * wrapper_proc
-
-After we find the container via C<wrapper_ld>, 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<wrapper_proc>
-which will do this.
-
-default: undef
-
-=item * item_ld
-
-This anonymous subroutine returns an array ref of C<HTML::Element>s that will
-be cloned and populated with item data
-(item data is a "row" of C<wrapper_data>).
-
-default: returns an arrayref consisting of the dt and dd element inside the
-container.
-
-=item * item_data
-
-This is a subroutine that takes C<wrapper_data> and retrieves one "row"
-to be "pasted" into the array ref of C<HTML::Element>s found via C<item_ld>.
-I hope that makes sense.
-
-default: shifts C<wrapper_data>.
-
-=item * item_proc
-
-This is a subroutine that takes the C<item_data> and the C<HTML::Element>s
-found via C<item_ld> and produces an arrayref of C<HTML::Element>s 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<item_data> to be an arrayref of two elements and
-C<item_elems> to be an arrayref of two C<HTML::Element>s. It replaces the
-content of the C<HTML::Element>s with the C<item_data>.
-
-=item * splice
-
-After building up an array of C<@item_elems>, the subroutine passed as
-C<splice> 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<unroll_select> 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<HTML::ElementTable|HTML::ElementTable>.
-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<HTML::Tree> API calls. Then the C<table> 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
-
- <html>
-
- <table id="load_data">
-
- <tr> <th>name</th><th>age</th><th>weight</th> </tr>
-
- <tr id="iterate">
-
- <td id="name"> NATURE BOY RIC FLAIR </td>
- <td id="age"> 35 </td>
- <td id="weight"> 220 </td>
-
- </tr>
-
- </table>
-
- </html>
-
-
-=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 <table> and <tr>
- 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 <table> and <tr> 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 <tr>
- 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 <tr> 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 <td> 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
-
- <html>
-
- <table id="load_data" CELLPADDING=8 BORDER=2>
-
- <tr> <th>name</th><th>age</th><th>weight</th> </tr>
-
- <tr id="iterate1" BGCOLOR="white" >
-
- <td id="name"> NATURE BOY RIC FLAIR </td>
- <td id="age"> 35 </td>
- <td id="weight"> 220 </td>
-
- </tr>
- <tr id="iterate2" BGCOLOR="#CCCC99">
-
- <td id="name"> NATURE BOY RIC FLAIR </td>
- <td id="age"> 35 </td>
- <td id="weight"> 220 </td>
-
- </tr>
-
- </table>
-
- </html>
-
-
-* 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<table()>, 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<id> 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<table> element in C<$tree>. If C<$look_down> is an
-arrayref, then use C<look_down>. 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<Must> 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<tr_proc> and C<td_proc>.
-
-=item * C<< tr_ld => $look_down >> : optional
-
-Same as C<table_ld> but for finding the table row elements. Please note
-that the C<tr_ld> is done on the table node that was found I<instead>
-of the whole HTML tree. This makes sense. The C<tr>s 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<table_data> 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<id>
-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<td> cells that
-are children of the C<tr>. See C<t/table2.t> 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 C<next>able 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<table_ld> and C<table_data>
-respectively. A little more on C<table_ld>. If this happens to be a CODE ref,
-then execution
-of the code ref is presumed to return the C<HTML::Element>
-representing the table in the HTML tree.
-
-Next, we get the row or rows which serve as sample C<tr> elements by doing
-a C<look_down> from the C<table_elem>. 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<tr> row by
-mutating the element in C<tr_proc>,
-discussed below. The default C<tr_ld> 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<HTML::Element>(s)
-which are C<tr> element(s).
-The reason a subroutine might be preferred is in the case
-that the HTML designers gave you 8 sample C<tr> 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<tr_proc> and C<td_proc> 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<table_data> via C<tr_data>
-
-The default procedure assumes the C<table_data> 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<tr> element and mutate it via C<tr_proc>
-
-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<td_proc> so that it can
-take the data and the C<td> cells in this C<tr> and process them.
-This function I<must> 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:
-
- <span id=no_data>
- <table><tr><td>No Data is Good Data</td></tr></table>
- </span>
- <span id=load_data>
- <html>
-
- <table id="load_data">
-
- <tr> <th>name</th><th>age</th><th>weight</th> </tr>
-
- <tr id="iterate">
-
- <td id="name"> NATURE BOY RIC FLAIR </td>
- <td id="age"> 35 </td>
- <td id="weight"> 220 </td>
-
- </tr>
-
- </table>
-
- </html>
-
- </span>
-
-
-
-
-=head1 SEE ALSO
-
-=over
-
-=item * L<HTML::Tree>
-
-A perl package for creating and manipulating HTML trees
-
-=item * L<HTML::ElementTable>
-
-An L<HTML::Tree> - based module which allows for manipulation of HTML
-trees using cartesian coordinations.
-
-=item * L<HTML::Seamstress>
-
-An L<HTML::Tree> - based module inspired by
-XMLC (L<http://xmlc.enhydra.org>), 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<under10>, and C<under18> 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<HTML::Seamstress>
-
-=head1 AUTHOR
-
-Terrence Brannon, E<lt>tbone@cpan.orgE<gt>
-
-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
projects / html-element-library.git / blobdiff