]>
iEval git - html-element-library.git/blob - lib/HTML/Element/Library.pm
1 package HTML
::Element
::Library
;
11 use Array
::Group
qw(:all);
15 use List
::MoreUtils qw
/:all/;
16 use Params
::Validate
qw(:all);
19 use List
::Rotation
::Cycle
;
21 our %EXPORT_TAGS = ( 'all' => [ qw() ] );
22 our @EXPORT_OK = ( @
{ $EXPORT_TAGS{'all'} } );
27 our $VERSION = '3.53';
30 # Preloaded methods go here.
32 sub HTML
::Element
::siblings
{
34 my $p = $element->parent;
39 sub HTML
::Element
::passover
{
40 my ($tree, $child_id) = @_;
42 #warn "ARGS: my ($tree, $child)";
44 my $exodus = $tree->look_down(id
=> $child_id);
46 my @s = HTML
::Element
::siblings
($exodus);
50 if ($s->attr('id') eq $child_id) {
57 return $exodus; # Goodbye Egypt! http://en.wikipedia.org/wiki/Passover
61 sub HTML
::Element
::sibdex
{
64 firstidx
{ $_ eq $element } $element->siblings
68 sub HTML
::Element
::addr
{ goto &HTML
::Element
::sibdex
}
70 sub HTML
::Element
::replace_content
{
72 $elem->delete_content;
73 $elem->push_content(@_);
76 sub HTML
::Element
::wrap_content
{
77 my($self, $wrap) = @_;
78 my $content = $self->content;
80 $wrap->push_content(@
$content);
84 $self->push_content($wrap);
89 sub HTML
::Element
::Library
::super_literal
{
92 HTML
::Element
->new('~literal', text
=> $text);
96 sub HTML
::Element
::position
{
97 # Report coordinates by chasing addr's up the
98 # HTML::ElementSuper tree. We know we've reached
99 # the top when a) there is no parent, or b) the
100 # parent is some HTML::Element unable to report
106 unshift(@pos, $a) if defined $a;
113 sub HTML
::Element
::content_handler
{
114 my ($tree, $id_name, $content) = @_;
116 $tree->set_child_content(id
=> $id_name, $content);
129 sub HTML
::Element
::iter
{
130 my ($tree, $p, @data) = @_;
132 # warn 'P: ' , $p->attr('id') ;
133 # warn 'H: ' , $p->as_HTML;
135 # my $id_incr = make_counter;
137 my $new_item = clone
$p;
138 $new_item->replace_content($_);
139 # $new_item->attr('id', $id_incr->( $p->attr('id') ));
143 $p->replace_with(@item);
148 sub HTML
::Element
::iter2
{
152 #warn "INPUT TO TABLE2: ", Dumper \@_;
156 wrapper_ld
=> { default => ['_tag' => 'dl'] },
158 wrapper_proc
=> { default => undef },
159 item_ld
=> { default => sub {
162 $tree->look_down('_tag' => 'dt'),
163 $tree->look_down('_tag' => 'dd')
167 item_data
=> { default => sub { my ($wrapper_data) = @_;
168 shift(@
{$wrapper_data}) ;
172 my ($item_elems, $item_data, $row_count) = @_;
173 $item_elems->[$_]->replace_content($item_data->[$_]) for (0,1) ;
176 splice => { default => sub {
177 my ($container, @item_elems) = @_;
178 $container->splice_content(0, 2, @item_elems);
181 debug
=> {default => 0}
185 warn "wrapper_data: " . Dumper
$p{wrapper_data
} if $p{debug
} ;
187 my $container = ref_or_ld
($tree, $p{wrapper_ld
});
188 warn "wrapper_(preproc): " . $container->as_HTML if $p{debug
} ;
189 $p{wrapper_proc
}->($container) if defined $p{wrapper_proc
} ;
190 warn "wrapper_(postproc): " . $container->as_HTML if $p{debug
} ;
192 my $_item_elems = $p{item_ld
}->($container);
199 my $item_data = $p{item_data
}->($p{wrapper_data
});
200 last unless defined $item_data;
202 warn Dumper
("item_data", $item_data);
205 my $item_elems = [ map { $_->clone } @
{$_item_elems} ] ;
208 for (@
{$item_elems}) {
209 warn "ITEM_ELEMS ", $_->as_HTML;
213 my $new_item_elems = $p{item_proc
}->($item_elems, $item_data, ++$row_count);
216 for (@
{$new_item_elems}) {
217 warn "NEWITEM_ELEMS ", $_->as_HTML;
222 push @item_elem, @
{$new_item_elems} ;
227 warn "pushing " . @item_elem . " elems " if $p{debug
} ;
229 $p{splice}->($container, @item_elem);
233 sub HTML
::Element
::dual_iter
{
234 my ($parent, $data) = @_;
236 my ($prototype_a, $prototype_b) = $parent->content_list;
238 # my $id_incr = make_counter;
243 confess
'dataset does not contain an even number of members';
245 my @iterable_data = ngroup
2 => @
$data;
248 my ($new_a, $new_b) = map { clone
$_ } ($prototype_a, $prototype_b) ;
249 $new_a->splice_content(0,1, $_->[0]);
250 $new_b->splice_content(0,1, $_->[1]);
251 #$_->attr('id', $id_incr->($_->attr('id'))) for ($new_a, $new_b) ;
255 $parent->splice_content(0, 2, @item);
260 sub HTML
::Element
::set_child_content
{
265 my $content_tag = $tree->look_down(@look_down);
267 unless ($content_tag) {
268 warn "criteria [@look_down] not found";
272 $content_tag->replace_content($content);
276 sub HTML
::Element
::highlander
{
277 my ($tree, $local_root_id, $aref, @arg) = @_;
279 ref $aref eq 'ARRAY' or confess
280 "must supply array reference";
283 @aref % 2 == 0 or confess
284 "supplied array ref must have an even number of entries";
286 warn __PACKAGE__
if $DEBUG;
289 while (my ($id, $test) = splice @aref, 0, 2) {
298 my @id_survivor = (id
=> $survivor);
299 my $survivor_node = $tree->look_down(@id_survivor);
301 # warn $local_root_id;
304 warn "survivor: $survivor" if $DEBUG;
305 warn "tree: " . $tree->as_HTML if $DEBUG;
307 $survivor_node or die "search for @id_survivor failed in tree($tree): " . $tree->as_HTML;
309 my $survivor_node_parent = $survivor_node->parent;
310 $survivor_node = $survivor_node->clone;
311 $survivor_node_parent->replace_content($survivor_node);
313 warn "new tree: " . $tree->as_HTML if $DEBUG;
319 sub HTML
::Element
::highlander2
{
322 my %p = validate
(@_, {
323 cond
=> { type
=> ARRAYREF
},
324 cond_arg
=> { type
=> ARRAYREF
,
327 debug
=> { default => 0 }
332 my @cond = @
{$p{cond
}};
333 @cond % 2 == 0 or confess
334 "supplied array ref must have an even number of entries";
336 warn __PACKAGE__
if $p{debug
};
338 my @cond_arg = @
{$p{cond_arg
}};
340 my $survivor; my $then;
341 while (my ($id, $if_then) = splice @cond, 0, 2) {
343 warn $id if $p{debug
};
346 if (ref $if_then eq 'ARRAY') {
347 ($if, $_then) = @
$if_then;
349 ($if, $_then) = ($if_then, sub {});
352 if ($if->(@cond_arg)) {
360 my @ld = (ref $survivor eq 'ARRAY')
365 warn "survivor: ", $survivor if $p{debug
};
366 warn "survivor_ld: ", Dumper \
@ld if $p{debug
};
369 my $survivor_node = $tree->look_down(@ld);
371 $survivor_node or confess
372 "search for @ld failed in tree($tree): " . $tree->as_HTML;
374 my $survivor_node_parent = $survivor_node->parent;
375 $survivor_node = $survivor_node->clone;
376 $survivor_node_parent->replace_content($survivor_node);
379 # **************** NEW FUNCTIONALITY *******************
381 # apply transforms on survivor node
384 warn "SURV::pre_trans " . $survivor_node->as_HTML if $p{debug
};
385 $then->($survivor_node, @cond_arg);
386 warn "SURV::post_trans " . $survivor_node->as_HTML if $p{debug
};
388 # **************** NEW FUNCTIONALITY *******************
397 sub overwrite_action
{
398 my ($mute_node, %X) = @_;
400 $mute_node->attr($X{local_attr
}{name
} => $X{local_attr
}{value
}{new
});
404 sub HTML
::Element
::overwrite_attr
{
407 $tree->mute_elem(@_, \
&overwrite_action
);
412 sub HTML
::Element
::mute_elem
{
413 my ($tree, $mute_attr, $closures, $post_hook) = @_;
415 warn "my mute_node = $tree->look_down($mute_attr => qr/.*/) ;";
416 my @mute_node = $tree->look_down($mute_attr => qr/.*/) ;
418 for my $mute_node (@mute_node) {
419 my ($local_attr,$mute_key) = split /\s+/, $mute_node->attr($mute_attr);
420 my $local_attr_value_current = $mute_node->attr($local_attr);
421 my $local_attr_value_new = $closures->{$mute_key}->($tree, $mute_node, $local_attr_value_current);
428 current
=> $local_attr_value_current,
429 new
=> $local_attr_value_new
438 sub HTML
::Element
::table
{
440 my ($s, %table) = @_;
444 # use Data::Dumper; warn Dumper \%table;
446 # ++$DEBUG if $table{debug} ;
449 # Get the table element
450 $table->{table_node
} = $s->look_down(id
=> $table{gi_table
});
451 $table->{table_node
} or confess
452 "table tag not found via (id => $table{gi_table}";
454 # Get the prototype tr element(s)
455 my @table_gi_tr = listify
$table{gi_tr
} ;
458 my $tr = $table->{table_node
}->look_down(id
=> $_);
459 $tr or confess
"tr with id => $_ not found";
463 warn "found " . @iter_node . " iter nodes " if $DEBUG;
464 # tie my $iter_node, 'Tie::Cycle', \@iter_node;
465 my $iter_node = List
::Rotation
::Cycle
->new(@iter_node);
468 warn Dumper
($iter_node, \
@iter_node) if $DEBUG;
470 # $table->{content} = $table{content};
471 #$table->{parent} = $table->{table_node}->parent;
474 # $table->{table_node}->detach;
475 # $_->detach for @iter_node;
480 my $row = $table{tr_data
}->($table, $table{table_data
});
481 last unless defined $row;
483 # get a sample table row and clone it.
484 my $I = $iter_node->next;
485 warn "I: $I" if $DEBUG;
486 my $new_iter_node = $I->clone;
489 $table{td_data
}->($new_iter_node, $row);
490 push @table_rows, $new_iter_node;
497 my $replace_with_elem = $s->look_down(id
=> shift @table_gi_tr) ;
499 $s->look_down(id
=> $_)->detach;
502 $replace_with_elem->replace_with(@table_rows);
510 my ($tree, $slot) = @_;
512 if (ref($slot) eq 'CODE') {
515 $tree->look_down(@
$slot);
521 sub HTML
::Element
::table2
{
529 table_ld
=> { default => ['_tag' => 'table'] },
531 table_proc
=> { default => undef },
533 tr_ld
=> { default => ['_tag' => 'tr'] },
534 tr_data
=> { default => sub { my ($self, $data) = @_;
537 tr_base_id
=> { default => undef },
538 tr_proc
=> { default => sub {} },
540 debug
=> {default => 0}
544 warn "INPUT TO TABLE2: ", Dumper \
@_ if $p{debug
};
546 warn "table_data: " . Dumper
$p{table_data
} if $p{debug
} ;
550 # use Data::Dumper; warn Dumper \%table;
552 # ++$DEBUG if $table{debug} ;
554 # Get the table element
556 $table->{table_node
} = ref_or_ld
( $tree, $p{table_ld
} ) ;
558 $table->{table_node
} or confess
559 "table tag not found via " . Dumper
($p{table_ld
}) ;
561 warn "table: " . $table->{table_node
}->as_HTML if $p{debug
};
564 # Get the prototype tr element(s)
565 my @proto_tr = ref_or_ld
( $table->{table_node
}, $p{tr_ld
} ) ;
567 warn "found " . @proto_tr . " iter nodes " if $p{debug
};
569 @proto_tr or return ;
572 warn $_->as_HTML for @proto_tr;
574 my $proto_tr = List
::Rotation
::Cycle
->new(@proto_tr);
576 my $tr_parent = $proto_tr[0]->parent;
577 warn "parent element of trs: " . $tr_parent->as_HTML if $p{debug
};
584 my $row = $p{tr_data
}->($table, $p{table_data
}, $row_count);
585 warn "data row: " . Dumper
$row if $p{debug
};
586 last unless defined $row;
588 # wont work: my $new_iter_node = $table->{iter_node}->clone;
589 my $new_tr_node = $proto_tr->next->clone;
590 warn "new_tr_node: $new_tr_node" if $p{debug
};
592 $p{tr_proc
}->($tree, $new_tr_node, $row, $p{tr_base_id
}, ++$row_count)
593 if defined $p{tr_proc
};
595 warn "data row redux: " . Dumper
$row if $p{debug
};
598 $p{td_proc
}->($new_tr_node, $row);
599 push @table_rows, $new_tr_node;
606 $_->detach for @proto_tr;
608 $tr_parent->push_content(@table_rows) if (@table_rows) ;
613 sub HTML
::Element
::unroll_select
{
615 my ($s, %select) = @_;
619 my $select_node = $s->look_down(id
=> $select{select_label
});
621 my $option = $select_node->look_down('_tag' => 'option');
628 while (my $row = $select{data_iter
}->($select{data
}))
631 my $o = $option->clone;
632 $o->attr('value', $select{option_value
}->($row));
633 $o->attr('SELECTED', 1) if ($select{option_selected
}->($row)) ;
635 $o->replace_content($select{option_content
}->($row));
636 $select_node->push_content($o);
644 sub HTML
::Element
::set_sibling_content
{
645 my ($elt, $content) = @_;
647 $elt->parent->splice_content($elt->pindex + 1, 1, $content);
651 sub HTML
::TreeBuilder
::parse_string
{
652 my ($package, $string) = @_;
654 my $h = HTML
::TreeBuilder
->new;
655 HTML
::TreeBuilder
->parse($string);
663 # Below is stub documentation for your module. You'd better edit it!
667 HTML::Element::Library - HTML::Element convenience functions
671 use HTML::Element::Library;
672 use HTML::TreeBuilder;
676 This method provides API calls for common actions on trees when using
681 The test suite contains examples of each of these methods in a
684 =head2 Positional Querying Methods
686 =head3 $elem->siblings
688 Return a list of all nodes under the same parent.
692 Return the index of C<$elem> into the array of siblings of which it is
693 a part. L<HTML::ElementSuper> calls this method C<addr> but I don't think
694 that is a descriptive name. And such naming is deceptively close to the
695 C<address> function of C<HTML::Element>. HOWEVER, in the interest of
696 backwards compatibility, both methods are available.
702 =head3 $elem->position()
704 Returns the coordinates of this element in the tree it inhabits.
705 This is accomplished by succesively calling addr() on ancestor
706 elements until either a) an element that does not support these
707 methods is found, or b) there are no more parents. The resulting
708 list is the n-dimensional coordinates of the element in the tree.
710 =head2 Element Decoration Methods
712 =head3 HTML::Element::Library::super_literal($text)
714 In L<HTML::Element>, Sean Burke discusses super-literals. They are
715 text which does not get escaped. Great for includng Javascript in
716 HTML. Also great for including foreign language into a document.
718 So, you basically toss C<super_literal> your text and back comes
719 your text wrapped in a C<~literal> element.
721 One of these days, I'll around to writing a nice C<EXPORT> section.
723 =head2 Tree Rewriting Methods
725 =head3 $elem->replace_content(@new_elem)
727 Replaces all of C<$elem>'s content with C<@new_elem>.
729 =head3 $elem->wrap_content($wrapper_element)
731 Wraps the existing content in the provided element. If the provided element
732 happens to be a non-element, a push_content is performed instead.
734 =head3 $elem->set_child_content(@look_down, $content)
736 This method looks down $tree using the criteria specified in @look_down using the the HTML::Element look_down() method.
738 After finding the node, it detaches the node's content and pushes $content as the node's content.
740 =head3 $tree->content_handler($sid_value , $content)
742 This is a convenience method. Because the look_down criteria will often simply be:
748 <a id=fixme href=http://www.somesite.org>replace_content</a>
750 You can call this method to shorten your typing a bit. You can simply type
752 $elem->content_handler( fixme => 'new text' )
756 $elem->set_child_content(sid => 'fixme', 'new text')
758 =head3 $tree->highlander($subtree_span_id, $conditionals, @conditionals_args)
760 This allows for "if-then-else" style processing. Highlander was a movie in
761 which only one would survive. Well, in terms of a tree when looking at a
762 structure that you want to process in C<if-then-else> style, only one child
763 will survive. For example, given this HTML template:
765 <span klass="highlander" id="age_dialog">
767 Hello, does your mother know you're
768 using her AOL account?
771 Sorry, you're not old enough to enter
772 (and too dumb to lie about your age)
779 We only want one child of the C<span> tag with id C<age_dialog> to remain
780 based on the age of the person visiting the page.
782 So, let's setup a call that will prune the subtree as a function of age:
786 my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander.html');
791 under10 => sub { $_[0] < 10} ,
792 under18 => sub { $_[0] < 18} ,
798 And there we have it. If the age is less than 10, then the node with
799 id C<under10> remains. For age less than 18, the node with id C<under18>
801 Otherwise our "else" condition fires and the child with id C<welcome> remains.
803 =head3 $tree->passover($id_of_element)
805 In some cases, you know exactly which element should survive. In this case,
806 you can simply call C<passover> to remove it's siblings. For the HTML
807 above, you could delete C<under10> and C<welcome> by simply calling:
809 $tree->passover('under18');
811 =head3 $tree->highlander2($tree, $conditionals, @conditionals_args)
813 Right around the same time that C<table2()> came into being, Seamstress
814 began to tackle tougher and tougher processing problems. It became clear that
815 a more powerful highlander was needed... one that not only snipped the tree
816 of the nodes that should not survive, but one that allows for
817 post-processing of the survivor node. And one that was more flexible with
818 how to find the nodes to snip.
820 Thus (drum roll) C<highlander2()>.
822 So let's look at our HTML which requires post-selection processing:
824 <span klass="highlander" id="age_dialog">
826 Hello, little <span id=age>AGE</span>-year old,
827 does your mother know you're using her AOL account?
830 Sorry, you're only <span id=age>AGE</span>
831 (and too dumb to lie about your age)
834 Welcome, isn't it good to be <span id=age>AGE</span> years old?
838 In this case, a branch survives, but it has dummy data in it. We must take
839 the surviving segment of HTML and rewrite the age C<span> with the age.
840 Here is how we use C<highlander2()> to do so:
845 $branch->look_down(id => 'age')->replace_content($age);
848 my $if_then = $tree->look_down(id => 'age_dialog');
850 $if_then->highlander2(
868 We pass it the tree (C<$if_then>), an arrayref of conditions
869 (C<cond>) and an arrayref of arguments which are passed to the
870 C<cond>s and to the replacement subs.
872 The C<under10>, C<under18> and C<welcome> are id attributes in the
873 tree of the siblings of which only one will survive. However,
874 should you need to do
875 more complex look-downs to find the survivor,
876 then supply an array ref instead of a simple
880 $if_then->highlander2(
882 [class => 'r12'] => [
886 [class => 'z22'] => [
890 [class => 'w88'] => [
899 =head3 $tree->overwrite_attr($mutation_attr => $mutating_closures)
901 This method is designed for taking a tree and reworking a set of nodes in
902 a stereotyped fashion. For instance let's say you have 3 remote image
903 archives, but you don't want to put long URLs in your img src
904 tags for reasons of abstraction, re-use and brevity. So instead you do this:
906 <img src="/img/smiley-face.jpg" fixup="src lnc">
907 <img src="/img/hot-babe.jpg" fixup="src playboy">
908 <img src="/img/footer.jpg" fixup="src foobar">
910 and then when the tree of HTML is being processed, you make this call:
913 lnc => sub { my ($tree, $mute_node, $attr_value)= @_; "http://lnc.usc.edu$attr_value" },
914 playboy => sub { my ($tree, $mute_node, $attr_value)= @_; "http://playboy.com$attr_value" }
915 foobar => sub { my ($tree, $mute_node, $attr_value)= @_; "http://foobar.info$attr_value" }
918 $tree->overwrite_attr(fixup => \%closures) ;
920 and the tags come out modified like so:
922 <img src="http://lnc.usc.edu/img/smiley-face.jpg" fixup="src lnc">
923 <img src="http://playboy.com/img/hot-babe.jpg" fixup="src playboy">
924 <img src="http://foobar.info/img/footer.jpg" fixup="src foobar">
926 =head3 $tree->mute_elem($mutation_attr => $mutating_closures, [ $post_hook ] )
928 This is a generalization of C<overwrite_attr>. C<overwrite_attr>
929 assumes the return value of the
930 closure is supposed overwrite an attribute value and does it for you.
931 C<mute_elem> is a more general function which does nothing but
932 hand the closure the element and let it mutate it as it jolly well pleases :)
934 In fact, here is the implementation of C<overwrite_attr>
935 to give you a taste of how C<mute_attr> is used:
937 sub overwrite_action {
938 my ($mute_node, %X) = @_;
940 $mute_node->attr($X{local_attr}{name} => $X{local_attr}{value}{new});
944 sub HTML::Element::overwrite_attr {
947 $tree->mute_elem(@_, \&overwrite_action);
953 =head2 Tree-Building Methods: Unrolling an array via a single sample element (<ul> container)
955 This is best described by example. Given this HTML:
957 <strong>Here are the things I need from the store:</strong>
959 <li class="store_items">Sample item</li>
962 We can unroll it like so:
964 my $li = $tree->look_down(class => 'store_items');
966 my @items = qw(bread butter vodka);
968 $tree->iter($li => @items);
975 <body>Here are the things I need from the store:
977 <li class="store_items">bread</li>
978 <li class="store_items">butter</li>
979 <li class="store_items">vodka</li>
984 =head2 Tree-Building Methods: Unrolling an array via n sample elements (<dl> container)
986 C<iter()> was fine for awhile, but some things
987 (e.g. definition lists) need a more general function to make them easy to
988 do. Hence C<iter2()>. This function will be explained by example of unrolling
989 a simple definition list.
991 So here's our mock-up HTML from the designer:
993 <dl class="dual_iter" id="service_plan">
998 A person who draws blood.
1005 A clone of Iggy Pop.
1012 A relative of Edgar Allan Poe.
1015 <dt class="adstyle">sample header</dt>
1016 <dd class="adstyle2">sample data</dd>
1021 And we want to unroll our data set:
1024 ['the pros' => 'never have to worry about service again'],
1025 ['the cons' => 'upfront extra charge on purchase'],
1026 ['our choice' => 'go with the extended service plan']
1030 Now, let's make this problem a bit harder to show off the power of C<iter2()>.
1031 Let's assume that we want only the last <dt> and it's accompanying <dd>
1032 (the one with "sample data") to be used as the sample data
1033 for unrolling with our data set. Let's further assume that we want them to
1034 remain in the final output.
1036 So now, the API to C<iter2()> will be discussed and we will explain how our
1037 goal of getting our data into HTML fits into the API.
1043 This is how to look down and find the container of all the elements we will
1044 be unrolling. The <dl> tag is the container for the dt and dd tags we will be
1047 If you pass an anonymous subroutine, then it is presumed that execution of
1048 this subroutine will return the HTML::Element representing the container tag.
1049 If you pass an array ref, then this will be dereferenced and passed to
1050 C<HTML::Element::look_down()>.
1052 default value: C<< ['_tag' => 'dl'] >>
1054 Based on the mock HTML above, this default is fine for finding our container
1055 tag. So let's move on.
1057 =item * wrapper_data
1059 This is an array reference of data that we will be putting into the container.
1060 You must supply this. C<@items> above is our C<wrapper_data>.
1062 =item * wrapper_proc
1064 After we find the container via C<wrapper_ld>, we may want to pre-process
1065 some aspect of this tree. In our case the first two sets of dt and dd need
1066 to be removed, leaving the last dt and dd. So, we supply a C<wrapper_proc>
1073 This anonymous subroutine returns an array ref of C<HTML::Element>s that will
1074 be cloned and populated with item data
1075 (item data is a "row" of C<wrapper_data>).
1077 default: returns an arrayref consisting of the dt and dd element inside the
1082 This is a subroutine that takes C<wrapper_data> and retrieves one "row"
1083 to be "pasted" into the array ref of C<HTML::Element>s found via C<item_ld>.
1084 I hope that makes sense.
1086 default: shifts C<wrapper_data>.
1090 This is a subroutine that takes the C<item_data> and the C<HTML::Element>s
1091 found via C<item_ld> and produces an arrayref of C<HTML::Element>s which will
1092 eventually be spliced into the container.
1094 Note that this subroutine MUST return the new items. This is done
1095 So that more items than were passed in can be returned. This is
1096 useful when, for example, you must return 2 dts for an input data item.
1097 And when would you do this? When a single term has multiple spellings
1100 default: expects C<item_data> to be an arrayref of two elements and
1101 C<item_elems> to be an arrayref of two C<HTML::Element>s. It replaces the
1102 content of the C<HTML::Element>s with the C<item_data>.
1106 After building up an array of C<@item_elems>, the subroutine passed as
1107 C<splice> will be given the parent container HTML::Element and the
1108 C<@item_elems>. How the C<@item_elems> end up in the container is up to this
1109 routine: it could put half of them in. It could unshift them or whatever.
1111 default: C<< $container->splice_content(0, 2, @item_elems) >>
1112 In other words, kill the 2 sample elements with the newly generated
1117 So now that we have documented the API, let's see the call we need:
1120 # default wrapper_ld ok.
1121 wrapper_data => \@items,
1122 wrapper_proc => sub {
1123 my ($container) = @_;
1125 # only keep the last 2 dts and dds
1126 my @content_list = $container->content_list;
1127 $container->splice_content(0, @content_list - 2);
1130 # default item_ld is fine.
1131 # default item_data is fine.
1132 # default item_proc is fine.
1134 my ($container, @item_elems) = @_;
1135 $container->unshift_content(@item_elems);
1141 =head2 Tree-Building Methods: Select Unrolling
1143 The C<unroll_select> method has this API:
1145 $tree->unroll_select(
1146 select_label => $id_label,
1147 option_value => $closure, # how to get option value from data row
1148 option_content => $closure, # how to get option content from data row
1149 option_selected => $closure, # boolean to decide if SELECTED
1150 data => $data # the data to be put into the SELECT
1151 data_iter => $closure # the thing that will get a row of data
1156 $tree->unroll_select(
1157 select_label => 'clan_list',
1158 option_value => sub { my $row = shift; $row->clan_id },
1159 option_content => sub { my $row = shift; $row->clan_name },
1160 option_selected => sub { my $row = shift; $row->selected },
1161 data => \@query_results,
1162 data_iter => sub { my $data = shift; $data->next }
1167 =head2 Tree-Building Methods: Table Generation
1169 Matthew Sisk has a much more intuitive (imperative)
1170 way to generate tables via his module
1171 L<HTML::ElementTable|HTML::ElementTable>.
1172 However, for those with callback fever, the following
1173 method is available. First, we look at a nuts and bolts way to build a table
1174 using only standard L<HTML::Tree> API calls. Then the C<table> method
1175 available here is discussed.
1179 package Simple::Class;
1183 my @name = qw(bob bill brian babette bobo bix);
1184 my @age = qw(99 12 44 52 12 43);
1185 my @weight = qw(99 52 80 124 120 230);
1190 bless {}, ref($this) || $this;
1198 age => $age[rand $#age] + int rand 20,
1199 name => shift @name,
1200 weight => $weight[rand $#weight] + int rand 40
1204 Set::Array->new(@data);
1211 =head4 Sample Usage:
1213 my $data = Simple::Class->load_data;
1214 ++$_->{age} for @$data
1216 =head3 Inline Code to Unroll a Table
1222 <table id="load_data">
1224 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1228 <td id="name"> NATURE BOY RIC FLAIR </td>
1229 <td id="age"> 35 </td>
1230 <td id="weight"> 220 </td>
1239 =head4 The manual way (*NOT* recommended)
1241 require 'simple-class.pl';
1242 use HTML::Seamstress;
1245 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
1248 my $o = Simple::Class->new;
1249 my $data = $o->load_data;
1251 # find the <table> and <tr>
1252 my $table_node = $seamstress->look_down('id', 'load_data');
1253 my $iter_node = $table_node->look_down('id', 'iterate');
1254 my $table_parent = $table_node->parent;
1257 # drop the sample <table> and <tr> from the HTML
1258 # only add them in if there is data in the model
1259 # this is achieved via the $add_table flag
1261 $table_node->detach;
1265 # Get a row of model data
1266 while (my $row = shift @$data) {
1268 # We got row data. Set the flag indicating ok to hook the table into the HTML
1271 # clone the sample <tr>
1272 my $new_iter_node = $iter_node->clone;
1274 # find the tags labeled name age and weight and
1275 # set their content to the row data
1276 $new_iter_node->content_handler($_ => $row->{$_})
1277 for qw(name age weight);
1279 $table_node->push_content($new_iter_node);
1283 # reattach the table to the HTML tree if we loaded data into some table rows
1285 $table_parent->push_content($table_node) if $add_table;
1287 print $seamstress->as_HTML;
1291 =head3 $tree->table() : API call to Unroll a Table
1293 require 'simple-class.pl';
1294 use HTML::Seamstress;
1297 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
1299 my $o = Simple::Class->new;
1303 # tell seamstress where to find the table, via the method call
1304 # ->look_down('id', $gi_table). Seamstress detaches the table from the
1305 # HTML tree automatically if no table rows can be built
1307 gi_table => 'load_data',
1309 # tell seamstress where to find the tr. This is a bit useless as
1310 # the <tr> usually can be found as the first child of the parent
1314 # the model data to be pushed into the table
1316 table_data => $o->load_data,
1318 # the way to take the model data and obtain one row
1319 # if the table data were a hashref, we would do:
1320 # my $key = (keys %$data)[0]; my $val = $data->{$key}; delete $data->{$key}
1322 tr_data => sub { my ($self, $data) = @_;
1326 # the way to take a row of data and fill the <td> tags
1328 td_data => sub { my ($tr_node, $tr_data) = @_;
1329 $tr_node->content_handler($_ => $tr_data->{$_})
1330 for qw(name age weight) }
1335 print $seamstress->as_HTML;
1339 =head4 Looping over Multiple Sample Rows
1345 <table id="load_data" CELLPADDING=8 BORDER=2>
1347 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1349 <tr id="iterate1" BGCOLOR="white" >
1351 <td id="name"> NATURE BOY RIC FLAIR </td>
1352 <td id="age"> 35 </td>
1353 <td id="weight"> 220 </td>
1356 <tr id="iterate2" BGCOLOR="#CCCC99">
1358 <td id="name"> NATURE BOY RIC FLAIR </td>
1359 <td id="age"> 35 </td>
1360 <td id="weight"> 220 </td>
1369 * Only one change to last API call.
1377 gi_tr => ['iterate1', 'iterate2']
1379 =head3 $tree->table2() : New API Call to Unroll a Table
1381 After 2 or 3 years with C<table()>, I began to develop
1382 production websites with it and decided it needed a cleaner
1383 interface, particularly in the area of handling the fact that
1384 C<id> tags will be the same after cloning a table row.
1386 First, I will give a dry listing of the function's argument parameters.
1387 This will not be educational most likely. A better way to understand how
1388 to use the function is to read through the incremental unrolling of the
1389 function's interface given in conversational style after the dry listing.
1390 But take your pick. It's the same information given in two different
1393 =head4 Dry/technical parameter documentation
1395 C<< $tree->table2(%param) >> takes the following arguments:
1399 =item * C<< table_ld => $look_down >> : optional
1401 How to find the C<table> element in C<$tree>. If C<$look_down> is an
1402 arrayref, then use C<look_down>. If it is a CODE ref, then call it,
1403 passing it C<$tree>.
1405 Defaults to C<< ['_tag' => 'table'] >> if not passed in.
1407 =item * C<< table_data => $tabular_data >> : required
1409 The data to fill the table with. I<Must> be passed in.
1411 =item * C<< table_proc => $code_ref >> : not implemented
1413 A subroutine to do something to the table once it is found.
1414 Not currently implemented. Not obviously necessary. Just
1415 created because there is a C<tr_proc> and C<td_proc>.
1417 =item * C<< tr_ld => $look_down >> : optional
1419 Same as C<table_ld> but for finding the table row elements. Please note
1420 that the C<tr_ld> is done on the table node that was found I<instead>
1421 of the whole HTML tree. This makes sense. The C<tr>s that you want exist
1422 below the table that was just found.
1424 Defaults to C<< ['_tag' => 'tr'] >> if not passed in.
1426 =item * C<< tr_data => $code_ref >> : optional
1428 How to take the C<table_data> and return a row. Defaults to:
1430 sub { my ($self, $data) = @_;
1434 =item * C<< tr_proc => $code_ref >> : optional
1436 Something to do to the table row we are about to add to the
1437 table we are making. Defaults to a routine which makes the C<id>
1441 my ($self, $tr, $tr_data, $tr_base_id, $row_count) = @_;
1442 $tr->attr(id => sprintf "%s_%d", $tr_base_id, $row_count);
1445 =item * C<< td_proc => $code_ref >> : required
1447 This coderef will take the row of data and operate on the C<td> cells that
1448 are children of the C<tr>. See C<t/table2.t> for several usage examples.
1450 Here's a sample one:
1453 my ($tr, $data) = @_;
1454 my @td = $tr->look_down('_tag' => 'td');
1455 for my $i (0..$#td) {
1456 $td[$i]->splice_content(0, 1, $data->[$i]);
1462 =head4 Conversational parameter documentation
1464 The first thing you need is a table. So we need a look down for that. If you
1465 don't give one, it defaults to
1469 What good is a table to display in without data to display?!
1470 So you must supply a scalar representing your tabular
1471 data source. This scalar might be an array reference, a C<next>able iterator,
1472 a DBI statement handle. Whatever it is, it can be iterated through to build
1473 up rows of table data.
1474 These two required fields (the way to find the table and the data to
1475 display in the table) are C<table_ld> and C<table_data>
1476 respectively. A little more on C<table_ld>. If this happens to be a CODE ref,
1478 of the code ref is presumed to return the C<HTML::Element>
1479 representing the table in the HTML tree.
1481 Next, we get the row or rows which serve as sample C<tr> elements by doing
1482 a C<look_down> from the C<table_elem>. While normally one sample row
1483 is enough to unroll a table, consider when you have alternating
1484 table rows. This API call would need one of each row so that it can
1486 sample rows as it loops through the data.
1487 Alternatively, you could always just use one row and
1488 make the necessary changes to the single C<tr> row by
1489 mutating the element in C<tr_proc>,
1490 discussed below. The default C<tr_ld> is
1491 C<< ['_tag' => 'tr'] >> but you can overwrite it. Note well, if you overwrite
1492 it with a subroutine, then it is expected that the subroutine will return
1493 the C<HTML::Element>(s)
1494 which are C<tr> element(s).
1495 The reason a subroutine might be preferred is in the case
1496 that the HTML designers gave you 8 sample C<tr> rows but only one
1497 prototype row is needed.
1498 So you can write a subroutine, to splice out the 7 rows you don't need
1499 and leave the one sample
1500 row remaining so that this API call can clone it and supply it to
1501 the C<tr_proc> and C<td_proc> calls.
1503 Now, as we move through the table rows with table data,
1504 we need to do two different things on
1509 =item * get one row of data from the C<table_data> via C<tr_data>
1511 The default procedure assumes the C<table_data> is an array reference and
1512 shifts a row off of it:
1514 sub { my ($self, $data) = @_;
1518 Your function MUST return undef when there is no more rows to lay out.
1520 =item * take the C<tr> element and mutate it via C<tr_proc>
1522 The default procedure simply makes the id of the table row unique:
1524 sub { my ($self, $tr, $tr_data, $row_count, $root_id) = @_;
1525 $tr->attr(id => sprintf "%s_%d", $root_id, $row_count);
1530 Now that we have our row of data, we call C<td_proc> so that it can
1531 take the data and the C<td> cells in this C<tr> and process them.
1532 This function I<must> be supplied.
1535 =head3 Whither a Table with No Rows
1537 Often when a table has no rows, we want to display a message
1538 indicating this to the view. Use conditional processing to decide what
1542 <table><tr><td>No Data is Good Data</td></tr></table>
1547 <table id="load_data">
1549 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1553 <td id="name"> NATURE BOY RIC FLAIR </td>
1554 <td id="age"> 35 </td>
1555 <td id="weight"> 220 </td>
1572 =item * L<HTML::Tree>
1574 A perl package for creating and manipulating HTML trees
1576 =item * L<HTML::ElementTable>
1578 An L<HTML::Tree> - based module which allows for manipulation of HTML
1579 trees using cartesian coordinations.
1581 =item * L<HTML::Seamstress>
1583 An L<HTML::Tree> - based module inspired by
1584 XMLC (L<http://xmlc.enhydra.org>), allowing for dynamic
1585 HTML generation via tree rewriting.
1593 currently the API expects the subtrees to survive or be pruned to be
1596 $if_then->highlander2([
1597 under10 => sub { $_[0] < 10} ,
1598 under18 => sub { $_[0] < 18} ,
1603 $branch->look_down(id => 'age')->replace_content($age);
1610 but, it should be more flexible. the C<under10>, and C<under18> are
1611 expected to be ids in the tree... but it is not hard to have a check to
1612 see if this field is an array reference and if it, then to do a look
1615 $if_then->highlander2([
1616 [class => 'under10'] => sub { $_[0] < 10} ,
1617 [class => 'under18'] => sub { $_[0] < 18} ,
1618 [class => 'welcome'] => [
1622 $branch->look_down(id => 'age')->replace_content($age);
1639 Terrence Brannon, E<lt>tbone@cpan.orgE<gt>
1641 Many thanks to BARBIE for his RT bug report.
1643 =head1 COPYRIGHT AND LICENSE
1645 Copyright (C) 2004 by Terrence Brannon
1647 This library is free software; you can redistribute it and/or modify
1648 it under the same terms as Perl itself, either Perl version 5.8.4 or,
1649 at your option, any later version of Perl 5 you may have available.
This page took 0.230773 seconds and 5 git commands to generate.