]>
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.51';
30 # Preloaded methods go here.
32 sub HTML
::Element
::siblings
{
34 my $p = $element->parent;
39 sub HTML
::Element
::sibdex
{
42 firstidx
{ $_ eq $element } $element->siblings
46 sub HTML
::Element
::addr
{ goto &HTML
::Element
::sibdex
}
48 sub HTML
::Element
::replace_content
{
50 $elem->delete_content;
51 $elem->push_content(@_);
54 sub HTML
::Element
::wrap_content
{
55 my($self, $wrap) = @_;
56 my $content = $self->content;
58 $wrap->push_content(@
$content);
62 $self->push_content($wrap);
67 sub HTML
::Element
::Library
::super_literal
{
70 HTML
::Element
->new('~literal', text
=> $text);
74 sub HTML
::Element
::position
{
75 # Report coordinates by chasing addr's up the
76 # HTML::ElementSuper tree. We know we've reached
77 # the top when a) there is no parent, or b) the
78 # parent is some HTML::Element unable to report
84 unshift(@pos, $a) if defined $a;
91 sub HTML
::Element
::content_handler
{
92 my ($tree, $id_name, $content) = @_;
94 $tree->set_child_content(id
=> $id_name, $content);
107 sub HTML
::Element
::iter
{
108 my ($tree, $p, @data) = @_;
110 # warn 'P: ' , $p->attr('id') ;
111 # warn 'H: ' , $p->as_HTML;
113 # my $id_incr = make_counter;
115 my $new_item = clone
$p;
116 $new_item->replace_content($_);
117 # $new_item->attr('id', $id_incr->( $p->attr('id') ));
121 $p->replace_with(@item);
126 sub HTML
::Element
::iter2
{
130 #warn "INPUT TO TABLE2: ", Dumper \@_;
134 wrapper_ld
=> { default => ['_tag' => 'dl'] },
136 wrapper_proc
=> { default => undef },
137 item_ld
=> { default => sub {
140 $tree->look_down('_tag' => 'dt'),
141 $tree->look_down('_tag' => 'dd')
145 item_data
=> { default => sub { my ($wrapper_data) = @_;
146 shift(@
{$wrapper_data}) ;
150 my ($item_elems, $item_data, $row_count) = @_;
151 $item_elems->[$_]->replace_content($item_data->[$_]) for (0,1) ;
154 splice => { default => sub {
155 my ($container, @item_elems) = @_;
156 $container->splice_content(0, 2, @item_elems);
159 debug
=> {default => 0}
163 warn "wrapper_data: " . Dumper
$p{wrapper_data
} if $p{debug
} ;
165 my $container = ref_or_ld
($tree, $p{wrapper_ld
});
166 warn "wrapper_(preproc): " . $container->as_HTML if $p{debug
} ;
167 $p{wrapper_proc
}->($container) if defined $p{wrapper_proc
} ;
168 warn "wrapper_(postproc): " . $container->as_HTML if $p{debug
} ;
170 my $_item_elems = $p{item_ld
}->($container);
177 my $item_data = $p{item_data
}->($p{wrapper_data
});
178 last unless defined $item_data;
180 warn Dumper
("item_data", $item_data);
183 my $item_elems = [ map { $_->clone } @
{$_item_elems} ] ;
186 for (@
{$item_elems}) {
187 warn "ITEM_ELEMS ", $_->as_HTML;
191 my $new_item_elems = $p{item_proc
}->($item_elems, $item_data, ++$row_count);
194 for (@
{$new_item_elems}) {
195 warn "NEWITEM_ELEMS ", $_->as_HTML;
200 push @item_elem, @
{$new_item_elems} ;
205 warn "pushing " . @item_elem . " elems " if $p{debug
} ;
207 $p{splice}->($container, @item_elem);
211 sub HTML
::Element
::dual_iter
{
212 my ($parent, $data) = @_;
214 my ($prototype_a, $prototype_b) = $parent->content_list;
216 # my $id_incr = make_counter;
221 confess
'dataset does not contain an even number of members';
223 my @iterable_data = ngroup
2 => @
$data;
226 my ($new_a, $new_b) = map { clone
$_ } ($prototype_a, $prototype_b) ;
227 $new_a->splice_content(0,1, $_->[0]);
228 $new_b->splice_content(0,1, $_->[1]);
229 #$_->attr('id', $id_incr->($_->attr('id'))) for ($new_a, $new_b) ;
233 $parent->splice_content(0, 2, @item);
238 sub HTML
::Element
::set_child_content
{
243 my $content_tag = $tree->look_down(@look_down);
245 unless ($content_tag) {
246 warn "criteria [@look_down] not found";
250 $content_tag->replace_content($content);
254 sub HTML
::Element
::highlander
{
255 my ($tree, $local_root_id, $aref, @arg) = @_;
257 ref $aref eq 'ARRAY' or confess
258 "must supply array reference";
261 @aref % 2 == 0 or confess
262 "supplied array ref must have an even number of entries";
264 warn __PACKAGE__
if $DEBUG;
267 while (my ($id, $test) = splice @aref, 0, 2) {
276 my @id_survivor = (id
=> $survivor);
277 my $survivor_node = $tree->look_down(@id_survivor);
279 # warn $local_root_id;
282 warn "survivor: $survivor" if $DEBUG;
283 warn "tree: " . $tree->as_HTML if $DEBUG;
285 $survivor_node or die "search for @id_survivor failed in tree($tree): " . $tree->as_HTML;
287 my $survivor_node_parent = $survivor_node->parent;
288 $survivor_node = $survivor_node->clone;
289 $survivor_node_parent->replace_content($survivor_node);
291 warn "new tree: " . $tree->as_HTML if $DEBUG;
297 sub HTML
::Element
::highlander2
{
300 my %p = validate
(@_, {
301 cond
=> { type
=> ARRAYREF
},
302 cond_arg
=> { type
=> ARRAYREF
,
305 debug
=> { default => 0 }
310 my @cond = @
{$p{cond
}};
311 @cond % 2 == 0 or confess
312 "supplied array ref must have an even number of entries";
314 warn __PACKAGE__
if $p{debug
};
316 my @cond_arg = @
{$p{cond_arg
}};
318 my $survivor; my $then;
319 while (my ($id, $if_then) = splice @cond, 0, 2) {
321 warn $id if $p{debug
};
324 if (ref $if_then eq 'ARRAY') {
325 ($if, $_then) = @
$if_then;
327 ($if, $_then) = ($if_then, sub {});
330 if ($if->(@cond_arg)) {
338 my @ld = (ref $survivor eq 'ARRAY')
343 warn "survivor: ", $survivor if $p{debug
};
344 warn "survivor_ld: ", Dumper \
@ld if $p{debug
};
347 my $survivor_node = $tree->look_down(@ld);
349 $survivor_node or confess
350 "search for @ld failed in tree($tree): " . $tree->as_HTML;
352 my $survivor_node_parent = $survivor_node->parent;
353 $survivor_node = $survivor_node->clone;
354 $survivor_node_parent->replace_content($survivor_node);
357 # **************** NEW FUNCTIONALITY *******************
359 # apply transforms on survivor node
362 warn "SURV::pre_trans " . $survivor_node->as_HTML if $p{debug
};
363 $then->($survivor_node, @cond_arg);
364 warn "SURV::post_trans " . $survivor_node->as_HTML if $p{debug
};
366 # **************** NEW FUNCTIONALITY *******************
375 sub overwrite_action
{
376 my ($mute_node, %X) = @_;
378 $mute_node->attr($X{local_attr
}{name
} => $X{local_attr
}{value
}{new
});
382 sub HTML
::Element
::overwrite_attr
{
385 $tree->mute_elem(@_, \
&overwrite_action
);
390 sub HTML
::Element
::mute_elem
{
391 my ($tree, $mute_attr, $closures, $post_hook) = @_;
393 warn "my mute_node = $tree->look_down($mute_attr => qr/.*/) ;";
394 my @mute_node = $tree->look_down($mute_attr => qr/.*/) ;
396 for my $mute_node (@mute_node) {
397 my ($local_attr,$mute_key) = split /\s+/, $mute_node->attr($mute_attr);
398 my $local_attr_value_current = $mute_node->attr($local_attr);
399 my $local_attr_value_new = $closures->{$mute_key}->($tree, $mute_node, $local_attr_value_current);
406 current
=> $local_attr_value_current,
407 new
=> $local_attr_value_new
416 sub HTML
::Element
::table
{
418 my ($s, %table) = @_;
422 # use Data::Dumper; warn Dumper \%table;
424 # ++$DEBUG if $table{debug} ;
427 # Get the table element
428 $table->{table_node
} = $s->look_down(id
=> $table{gi_table
});
429 $table->{table_node
} or confess
430 "table tag not found via (id => $table{gi_table}";
432 # Get the prototype tr element(s)
433 my @table_gi_tr = listify
$table{gi_tr
} ;
436 my $tr = $table->{table_node
}->look_down(id
=> $_);
437 $tr or confess
"tr with id => $_ not found";
441 warn "found " . @iter_node . " iter nodes " if $DEBUG;
442 # tie my $iter_node, 'Tie::Cycle', \@iter_node;
443 my $iter_node = List
::Rotation
::Cycle
->new(@iter_node);
446 warn Dumper
($iter_node, \
@iter_node) if $DEBUG;
448 # $table->{content} = $table{content};
449 #$table->{parent} = $table->{table_node}->parent;
452 # $table->{table_node}->detach;
453 # $_->detach for @iter_node;
458 my $row = $table{tr_data
}->($table, $table{table_data
});
459 last unless defined $row;
461 # get a sample table row and clone it.
462 my $I = $iter_node->next;
463 warn "I: $I" if $DEBUG;
464 my $new_iter_node = $I->clone;
467 $table{td_data
}->($new_iter_node, $row);
468 push @table_rows, $new_iter_node;
475 my $replace_with_elem = $s->look_down(id
=> shift @table_gi_tr) ;
477 $s->look_down(id
=> $_)->detach;
480 $replace_with_elem->replace_with(@table_rows);
488 my ($tree, $slot) = @_;
490 if (ref($slot) eq 'CODE') {
493 $tree->look_down(@
$slot);
499 sub HTML
::Element
::table2
{
507 table_ld
=> { default => ['_tag' => 'table'] },
509 table_proc
=> { default => undef },
511 tr_ld
=> { default => ['_tag' => 'tr'] },
512 tr_data
=> { default => sub { my ($self, $data) = @_;
515 tr_base_id
=> { default => undef },
516 tr_proc
=> { default => sub {} },
518 debug
=> {default => 0}
522 warn "INPUT TO TABLE2: ", Dumper \
@_ if $p{debug
};
524 warn "table_data: " . Dumper
$p{table_data
} if $p{debug
} ;
528 # use Data::Dumper; warn Dumper \%table;
530 # ++$DEBUG if $table{debug} ;
532 # Get the table element
534 $table->{table_node
} = ref_or_ld
( $tree, $p{table_ld
} ) ;
536 $table->{table_node
} or confess
537 "table tag not found via " . Dumper
($p{table_ld
}) ;
539 warn "table: " . $table->{table_node
}->as_HTML if $p{debug
};
542 # Get the prototype tr element(s)
543 my @proto_tr = ref_or_ld
( $table->{table_node
}, $p{tr_ld
} ) ;
545 warn "found " . @proto_tr . " iter nodes " if $p{debug
};
547 @proto_tr or return ;
550 warn $_->as_HTML for @proto_tr;
552 my $proto_tr = List
::Rotation
::Cycle
->new(@proto_tr);
554 my $tr_parent = $proto_tr[0]->parent;
555 warn "parent element of trs: " . $tr_parent->as_HTML if $p{debug
};
562 my $row = $p{tr_data
}->($table, $p{table_data
}, $row_count);
563 warn "data row: " . Dumper
$row if $p{debug
};
564 last unless defined $row;
566 # wont work: my $new_iter_node = $table->{iter_node}->clone;
567 my $new_tr_node = $proto_tr->next->clone;
568 warn "new_tr_node: $new_tr_node" if $p{debug
};
570 $p{tr_proc
}->($tree, $new_tr_node, $row, $p{tr_base_id
}, ++$row_count)
571 if defined $p{tr_proc
};
573 warn "data row redux: " . Dumper
$row if $p{debug
};
576 $p{td_proc
}->($new_tr_node, $row);
577 push @table_rows, $new_tr_node;
584 $_->detach for @proto_tr;
586 $tr_parent->push_content(@table_rows) if (@table_rows) ;
591 sub HTML
::Element
::unroll_select
{
593 my ($s, %select) = @_;
597 my $select_node = $s->look_down(id
=> $select{select_label
});
599 my $option = $select_node->look_down('_tag' => 'option');
606 while (my $row = $select{data_iter
}->($select{data
}))
609 my $o = $option->clone;
610 $o->attr('value', $select{option_value
}->($row));
611 $o->attr('SELECTED', 1) if ($select{option_selected
}->($row)) ;
613 $o->replace_content($select{option_content
}->($row));
614 $select_node->push_content($o);
622 sub HTML
::Element
::set_sibling_content
{
623 my ($elt, $content) = @_;
625 $elt->parent->splice_content($elt->pindex + 1, 1, $content);
629 sub HTML
::TreeBuilder
::parse_string
{
630 my ($package, $string) = @_;
632 my $h = HTML
::TreeBuilder
->new;
633 HTML
::TreeBuilder
->parse($string);
641 # Below is stub documentation for your module. You'd better edit it!
645 HTML::Element::Library - HTML::Element convenience functions
649 use HTML::Element::Library;
650 use HTML::TreeBuilder;
654 This method provides API calls for common actions on trees when using
659 The test suite contains examples of each of these methods in a
662 =head2 Positional Querying Methods
664 =head3 $elem->siblings
666 Return a list of all nodes under the same parent.
670 Return the index of C<$elem> into the array of siblings of which it is
671 a part. L<HTML::ElementSuper> calls this method C<addr> but I don't think
672 that is a descriptive name. And such naming is deceptively close to the
673 C<address> function of C<HTML::Element>. HOWEVER, in the interest of
674 backwards compatibility, both methods are available.
680 =head3 $elem->position()
682 Returns the coordinates of this element in the tree it inhabits.
683 This is accomplished by succesively calling addr() on ancestor
684 elements until either a) an element that does not support these
685 methods is found, or b) there are no more parents. The resulting
686 list is the n-dimensional coordinates of the element in the tree.
688 =head2 Element Decoration Methods
690 =head3 HTML::Element::Library::super_literal($text)
692 In L<HTML::Element>, Sean Burke discusses super-literals. They are
693 text which does not get escaped. Great for includng Javascript in
694 HTML. Also great for including foreign language into a document.
696 So, you basically toss C<super_literal> your text and back comes
697 your text wrapped in a C<~literal> element.
699 One of these days, I'll around to writing a nice C<EXPORT> section.
701 =head2 Tree Rewriting Methods
703 =head3 $elem->replace_content(@new_elem)
705 Replaces all of C<$elem>'s content with C<@new_elem>.
707 =head3 $elem->wrap_content($wrapper_element)
709 Wraps the existing content in the provided element. If the provided element
710 happens to be a non-element, a push_content is performed instead.
712 =head3 $elem->set_child_content(@look_down, $content)
714 This method looks down $tree using the criteria specified in @look_down using the the HTML::Element look_down() method.
716 After finding the node, it detaches the node's content and pushes $content as the node's content.
718 =head3 $tree->content_handler($sid_value , $content)
720 This is a convenience method. Because the look_down criteria will often simply be:
726 <a id=fixme href=http://www.somesite.org>replace_content</a>
728 You can call this method to shorten your typing a bit. You can simply type
730 $elem->content_handler( fixme => 'new text' )
734 $elem->set_child_content(sid => 'fixme', 'new text')
736 =head3 $tree->highlander($subtree_span_id, $conditionals, @conditionals_args)
738 This allows for "if-then-else" style processing. Highlander was a movie in
739 which only one would survive. Well, in terms of a tree when looking at a
740 structure that you want to process in C<if-then-else> style, only one child
741 will survive. For example, given this HTML template:
743 <span klass="highlander" id="age_dialog">
745 Hello, does your mother know you're
746 using her AOL account?
749 Sorry, you're not old enough to enter
750 (and too dumb to lie about your age)
757 We only want one child of the C<span> tag with id C<age_dialog> to remain
758 based on the age of the person visiting the page.
760 So, let's setup a call that will prune the subtree as a function of age:
764 my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander.html');
769 under10 => sub { $_[0] < 10} ,
770 under18 => sub { $_[0] < 18} ,
776 And there we have it. If the age is less than 10, then the node with
777 id C<under10> remains. For age less than 18, the node with id C<under18>
779 Otherwise our "else" condition fires and the child with id C<welcome> remains.
781 =head3 $tree->highlander2($tree, $conditionals, @conditionals_args)
783 Right around the same time that C<table2()> came into being, Seamstress
784 began to tackle tougher and tougher processing problems. It became clear that
785 a more powerful highlander was needed... one that not only snipped the tree
786 of the nodes that should not survive, but one that allows for
787 post-processing of the survivor node. And one that was more flexible with
788 how to find the nodes to snip.
790 Thus (drum roll) C<highlander2()>.
792 So let's look at our HTML which requires post-selection processing:
794 <span klass="highlander" id="age_dialog">
796 Hello, little <span id=age>AGE</span>-year old,
797 does your mother know you're using her AOL account?
800 Sorry, you're only <span id=age>AGE</span>
801 (and too dumb to lie about your age)
804 Welcome, isn't it good to be <span id=age>AGE</span> years old?
808 In this case, a branch survives, but it has dummy data in it. We must take
809 the surviving segment of HTML and rewrite the age C<span> with the age.
810 Here is how we use C<highlander2()> to do so:
815 $branch->look_down(id => 'age')->replace_content($age);
818 my $if_then = $tree->look_down(id => 'age_dialog');
820 $if_then->highlander2(
838 We pass it the tree (C<$if_then>), an arrayref of conditions
839 (C<cond>) and an arrayref of arguments which are passed to the
840 C<cond>s and to the replacement subs.
842 The C<under10>, C<under18> and C<welcome> are id attributes in the
843 tree of the siblings of which only one will survive. However,
844 should you need to do
845 more complex look-downs to find the survivor,
846 then supply an array ref instead of a simple
850 $if_then->highlander2(
852 [class => 'r12'] => [
856 [class => 'z22'] => [
860 [class => 'w88'] => [
869 =head3 $tree->overwrite_attr($mutation_attr => $mutating_closures)
871 This method is designed for taking a tree and reworking a set of nodes in
872 a stereotyped fashion. For instance let's say you have 3 remote image
873 archives, but you don't want to put long URLs in your img src
874 tags for reasons of abstraction, re-use and brevity. So instead you do this:
876 <img src="/img/smiley-face.jpg" fixup="src lnc">
877 <img src="/img/hot-babe.jpg" fixup="src playboy">
878 <img src="/img/footer.jpg" fixup="src foobar">
880 and then when the tree of HTML is being processed, you make this call:
883 lnc => sub { my ($tree, $mute_node, $attr_value)= @_; "http://lnc.usc.edu$attr_value" },
884 playboy => sub { my ($tree, $mute_node, $attr_value)= @_; "http://playboy.com$attr_value" }
885 foobar => sub { my ($tree, $mute_node, $attr_value)= @_; "http://foobar.info$attr_value" }
888 $tree->overwrite_attr(fixup => \%closures) ;
890 and the tags come out modified like so:
892 <img src="http://lnc.usc.edu/img/smiley-face.jpg" fixup="src lnc">
893 <img src="http://playboy.com/img/hot-babe.jpg" fixup="src playboy">
894 <img src="http://foobar.info/img/footer.jpg" fixup="src foobar">
896 =head3 $tree->mute_elem($mutation_attr => $mutating_closures, [ $post_hook ] )
898 This is a generalization of C<overwrite_attr>. C<overwrite_attr>
899 assumes the return value of the
900 closure is supposed overwrite an attribute value and does it for you.
901 C<mute_elem> is a more general function which does nothing but
902 hand the closure the element and let it mutate it as it jolly well pleases :)
904 In fact, here is the implementation of C<overwrite_attr>
905 to give you a taste of how C<mute_attr> is used:
907 sub overwrite_action {
908 my ($mute_node, %X) = @_;
910 $mute_node->attr($X{local_attr}{name} => $X{local_attr}{value}{new});
914 sub HTML::Element::overwrite_attr {
917 $tree->mute_elem(@_, \&overwrite_action);
923 =head2 Tree-Building Methods: Unrolling an array via a single sample element (<ul> container)
925 This is best described by example. Given this HTML:
927 <strong>Here are the things I need from the store:</strong>
929 <li class="store_items">Sample item</li>
932 We can unroll it like so:
934 my $li = $tree->look_down(class => 'store_items');
936 my @items = qw(bread butter vodka);
938 $tree->iter($li => @items);
945 <body>Here are the things I need from the store:
947 <li class="store_items">bread</li>
948 <li class="store_items">butter</li>
949 <li class="store_items">vodka</li>
954 =head2 Tree-Building Methods: Unrolling an array via n sample elements (<dl> container)
956 C<iter()> was fine for awhile, but some things
957 (e.g. definition lists) need a more general function to make them easy to
958 do. Hence C<iter2()>. This function will be explained by example of unrolling
959 a simple definition list.
961 So here's our mock-up HTML from the designer:
963 <dl class="dual_iter" id="service_plan">
968 A person who draws blood.
982 A relative of Edgar Allan Poe.
985 <dt class="adstyle">sample header</dt>
986 <dd class="adstyle2">sample data</dd>
991 And we want to unroll our data set:
994 ['the pros' => 'never have to worry about service again'],
995 ['the cons' => 'upfront extra charge on purchase'],
996 ['our choice' => 'go with the extended service plan']
1000 Now, let's make this problem a bit harder to show off the power of C<iter2()>.
1001 Let's assume that we want only the last <dt> and it's accompanying <dd>
1002 (the one with "sample data") to be used as the sample data
1003 for unrolling with our data set. Let's further assume that we want them to
1004 remain in the final output.
1006 So now, the API to C<iter2()> will be discussed and we will explain how our
1007 goal of getting our data into HTML fits into the API.
1013 This is how to look down and find the container of all the elements we will
1014 be unrolling. The <dl> tag is the container for the dt and dd tags we will be
1017 If you pass an anonymous subroutine, then it is presumed that execution of
1018 this subroutine will return the HTML::Element representing the container tag.
1019 If you pass an array ref, then this will be dereferenced and passed to
1020 C<HTML::Element::look_down()>.
1022 default value: C<< ['_tag' => 'dl'] >>
1024 Based on the mock HTML above, this default is fine for finding our container
1025 tag. So let's move on.
1027 =item * wrapper_data
1029 This is an array reference of data that we will be putting into the container.
1030 You must supply this. C<@items> above is our C<wrapper_data>.
1032 =item * wrapper_proc
1034 After we find the container via C<wrapper_ld>, we may want to pre-process
1035 some aspect of this tree. In our case the first two sets of dt and dd need
1036 to be removed, leaving the last dt and dd. So, we supply a C<wrapper_proc>
1043 This anonymous subroutine returns an array ref of C<HTML::Element>s that will
1044 be cloned and populated with item data
1045 (item data is a "row" of C<wrapper_data>).
1047 default: returns an arrayref consisting of the dt and dd element inside the
1052 This is a subroutine that takes C<wrapper_data> and retrieves one "row"
1053 to be "pasted" into the array ref of C<HTML::Element>s found via C<item_ld>.
1054 I hope that makes sense.
1056 default: shifts C<wrapper_data>.
1060 This is a subroutine that takes the C<item_data> and the C<HTML::Element>s
1061 found via C<item_ld> and produces an arrayref of C<HTML::Element>s which will
1062 eventually be spliced into the container.
1064 Note that this subroutine MUST return the new items. This is done
1065 So that more items than were passed in can be returned. This is
1066 useful when, for example, you must return 2 dts for an input data item.
1067 And when would you do this? When a single term has multiple spellings
1070 default: expects C<item_data> to be an arrayref of two elements and
1071 C<item_elems> to be an arrayref of two C<HTML::Element>s. It replaces the
1072 content of the C<HTML::Element>s with the C<item_data>.
1076 After building up an array of C<@item_elems>, the subroutine passed as
1077 C<splice> will be given the parent container HTML::Element and the
1078 C<@item_elems>. How the C<@item_elems> end up in the container is up to this
1079 routine: it could put half of them in. It could unshift them or whatever.
1081 default: C<< $container->splice_content(0, 2, @item_elems) >>
1082 In other words, kill the 2 sample elements with the newly generated
1087 So now that we have documented the API, let's see the call we need:
1090 # default wrapper_ld ok.
1091 wrapper_data => \@items,
1092 wrapper_proc => sub {
1093 my ($container) = @_;
1095 # only keep the last 2 dts and dds
1096 my @content_list = $container->content_list;
1097 $container->splice_content(0, @content_list - 2);
1100 # default item_ld is fine.
1101 # default item_data is fine.
1102 # default item_proc is fine.
1104 my ($container, @item_elems) = @_;
1105 $container->unshift_content(@item_elems);
1111 =head2 Tree-Building Methods: Select Unrolling
1113 The C<unroll_select> method has this API:
1115 $tree->unroll_select(
1116 select_label => $id_label,
1117 option_value => $closure, # how to get option value from data row
1118 option_content => $closure, # how to get option content from data row
1119 option_selected => $closure, # boolean to decide if SELECTED
1120 data => $data # the data to be put into the SELECT
1121 data_iter => $closure # the thing that will get a row of data
1126 $tree->unroll_select(
1127 select_label => 'clan_list',
1128 option_value => sub { my $row = shift; $row->clan_id },
1129 option_content => sub { my $row = shift; $row->clan_name },
1130 option_selected => sub { my $row = shift; $row->selected },
1131 data => \@query_results,
1132 data_iter => sub { my $data = shift; $data->next }
1137 =head2 Tree-Building Methods: Table Generation
1139 Matthew Sisk has a much more intuitive (imperative)
1140 way to generate tables via his module
1141 L<HTML::ElementTable|HTML::ElementTable>.
1142 However, for those with callback fever, the following
1143 method is available. First, we look at a nuts and bolts way to build a table
1144 using only standard L<HTML::Tree> API calls. Then the C<table> method
1145 available here is discussed.
1149 package Simple::Class;
1153 my @name = qw(bob bill brian babette bobo bix);
1154 my @age = qw(99 12 44 52 12 43);
1155 my @weight = qw(99 52 80 124 120 230);
1160 bless {}, ref($this) || $this;
1168 age => $age[rand $#age] + int rand 20,
1169 name => shift @name,
1170 weight => $weight[rand $#weight] + int rand 40
1174 Set::Array->new(@data);
1181 =head4 Sample Usage:
1183 my $data = Simple::Class->load_data;
1184 ++$_->{age} for @$data
1186 =head3 Inline Code to Unroll a Table
1192 <table id="load_data">
1194 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1198 <td id="name"> NATURE BOY RIC FLAIR </td>
1199 <td id="age"> 35 </td>
1200 <td id="weight"> 220 </td>
1209 =head4 The manual way (*NOT* recommended)
1211 require 'simple-class.pl';
1212 use HTML::Seamstress;
1215 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
1218 my $o = Simple::Class->new;
1219 my $data = $o->load_data;
1221 # find the <table> and <tr>
1222 my $table_node = $seamstress->look_down('id', 'load_data');
1223 my $iter_node = $table_node->look_down('id', 'iterate');
1224 my $table_parent = $table_node->parent;
1227 # drop the sample <table> and <tr> from the HTML
1228 # only add them in if there is data in the model
1229 # this is achieved via the $add_table flag
1231 $table_node->detach;
1235 # Get a row of model data
1236 while (my $row = shift @$data) {
1238 # We got row data. Set the flag indicating ok to hook the table into the HTML
1241 # clone the sample <tr>
1242 my $new_iter_node = $iter_node->clone;
1244 # find the tags labeled name age and weight and
1245 # set their content to the row data
1246 $new_iter_node->content_handler($_ => $row->{$_})
1247 for qw(name age weight);
1249 $table_node->push_content($new_iter_node);
1253 # reattach the table to the HTML tree if we loaded data into some table rows
1255 $table_parent->push_content($table_node) if $add_table;
1257 print $seamstress->as_HTML;
1261 =head3 $tree->table() : API call to Unroll a Table
1263 require 'simple-class.pl';
1264 use HTML::Seamstress;
1267 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
1269 my $o = Simple::Class->new;
1273 # tell seamstress where to find the table, via the method call
1274 # ->look_down('id', $gi_table). Seamstress detaches the table from the
1275 # HTML tree automatically if no table rows can be built
1277 gi_table => 'load_data',
1279 # tell seamstress where to find the tr. This is a bit useless as
1280 # the <tr> usually can be found as the first child of the parent
1284 # the model data to be pushed into the table
1286 table_data => $o->load_data,
1288 # the way to take the model data and obtain one row
1289 # if the table data were a hashref, we would do:
1290 # my $key = (keys %$data)[0]; my $val = $data->{$key}; delete $data->{$key}
1292 tr_data => sub { my ($self, $data) = @_;
1296 # the way to take a row of data and fill the <td> tags
1298 td_data => sub { my ($tr_node, $tr_data) = @_;
1299 $tr_node->content_handler($_ => $tr_data->{$_})
1300 for qw(name age weight) }
1305 print $seamstress->as_HTML;
1309 =head4 Looping over Multiple Sample Rows
1315 <table id="load_data" CELLPADDING=8 BORDER=2>
1317 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1319 <tr id="iterate1" BGCOLOR="white" >
1321 <td id="name"> NATURE BOY RIC FLAIR </td>
1322 <td id="age"> 35 </td>
1323 <td id="weight"> 220 </td>
1326 <tr id="iterate2" BGCOLOR="#CCCC99">
1328 <td id="name"> NATURE BOY RIC FLAIR </td>
1329 <td id="age"> 35 </td>
1330 <td id="weight"> 220 </td>
1339 * Only one change to last API call.
1347 gi_tr => ['iterate1', 'iterate2']
1349 =head3 $tree->table2() : New API Call to Unroll a Table
1351 After 2 or 3 years with C<table()>, I began to develop
1352 production websites with it and decided it needed a cleaner
1353 interface, particularly in the area of handling the fact that
1354 C<id> tags will be the same after cloning a table row.
1356 First, I will give a dry listing of the function's argument parameters.
1357 This will not be educational most likely. A better way to understand how
1358 to use the function is to read through the incremental unrolling of the
1359 function's interface given in conversational style after the dry listing.
1360 But take your pick. It's the same information given in two different
1363 =head4 Dry/technical parameter documentation
1365 C<< $tree->table2(%param) >> takes the following arguments:
1369 =item * C<< table_ld => $look_down >> : optional
1371 How to find the C<table> element in C<$tree>. If C<$look_down> is an
1372 arrayref, then use C<look_down>. If it is a CODE ref, then call it,
1373 passing it C<$tree>.
1375 Defaults to C<< ['_tag' => 'table'] >> if not passed in.
1377 =item * C<< table_data => $tabular_data >> : required
1379 The data to fill the table with. I<Must> be passed in.
1381 =item * C<< table_proc => $code_ref >> : not implemented
1383 A subroutine to do something to the table once it is found.
1384 Not currently implemented. Not obviously necessary. Just
1385 created because there is a C<tr_proc> and C<td_proc>.
1387 =item * C<< tr_ld => $look_down >> : optional
1389 Same as C<table_ld> but for finding the table row elements. Please note
1390 that the C<tr_ld> is done on the table node that was found I<instead>
1391 of the whole HTML tree. This makes sense. The C<tr>s that you want exist
1392 below the table that was just found.
1394 Defaults to C<< ['_tag' => 'tr'] >> if not passed in.
1396 =item * C<< tr_data => $code_ref >> : optional
1398 How to take the C<table_data> and return a row. Defaults to:
1400 sub { my ($self, $data) = @_;
1404 =item * C<< tr_proc => $code_ref >> : optional
1406 Something to do to the table row we are about to add to the
1407 table we are making. Defaults to a routine which makes the C<id>
1411 my ($self, $tr, $tr_data, $tr_base_id, $row_count) = @_;
1412 $tr->attr(id => sprintf "%s_%d", $tr_base_id, $row_count);
1415 =item * C<< td_proc => $code_ref >> : required
1417 This coderef will take the row of data and operate on the C<td> cells that
1418 are children of the C<tr>. See C<t/table2.t> for several usage examples.
1420 Here's a sample one:
1423 my ($tr, $data) = @_;
1424 my @td = $tr->look_down('_tag' => 'td');
1425 for my $i (0..$#td) {
1426 $td[$i]->splice_content(0, 1, $data->[$i]);
1432 =head4 Conversational parameter documentation
1434 The first thing you need is a table. So we need a look down for that. If you
1435 don't give one, it defaults to
1439 What good is a table to display in without data to display?!
1440 So you must supply a scalar representing your tabular
1441 data source. This scalar might be an array reference, a C<next>able iterator,
1442 a DBI statement handle. Whatever it is, it can be iterated through to build
1443 up rows of table data.
1444 These two required fields (the way to find the table and the data to
1445 display in the table) are C<table_ld> and C<table_data>
1446 respectively. A little more on C<table_ld>. If this happens to be a CODE ref,
1448 of the code ref is presumed to return the C<HTML::Element>
1449 representing the table in the HTML tree.
1451 Next, we get the row or rows which serve as sample C<tr> elements by doing
1452 a C<look_down> from the C<table_elem>. While normally one sample row
1453 is enough to unroll a table, consider when you have alternating
1454 table rows. This API call would need one of each row so that it can
1456 sample rows as it loops through the data.
1457 Alternatively, you could always just use one row and
1458 make the necessary changes to the single C<tr> row by
1459 mutating the element in C<tr_proc>,
1460 discussed below. The default C<tr_ld> is
1461 C<< ['_tag' => 'tr'] >> but you can overwrite it. Note well, if you overwrite
1462 it with a subroutine, then it is expected that the subroutine will return
1463 the C<HTML::Element>(s)
1464 which are C<tr> element(s).
1465 The reason a subroutine might be preferred is in the case
1466 that the HTML designers gave you 8 sample C<tr> rows but only one
1467 prototype row is needed.
1468 So you can write a subroutine, to splice out the 7 rows you don't need
1469 and leave the one sample
1470 row remaining so that this API call can clone it and supply it to
1471 the C<tr_proc> and C<td_proc> calls.
1473 Now, as we move through the table rows with table data,
1474 we need to do two different things on
1479 =item * get one row of data from the C<table_data> via C<tr_data>
1481 The default procedure assumes the C<table_data> is an array reference and
1482 shifts a row off of it:
1484 sub { my ($self, $data) = @_;
1488 Your function MUST return undef when there is no more rows to lay out.
1490 =item * take the C<tr> element and mutate it via C<tr_proc>
1492 The default procedure simply makes the id of the table row unique:
1494 sub { my ($self, $tr, $tr_data, $row_count, $root_id) = @_;
1495 $tr->attr(id => sprintf "%s_%d", $root_id, $row_count);
1500 Now that we have our row of data, we call C<td_proc> so that it can
1501 take the data and the C<td> cells in this C<tr> and process them.
1502 This function I<must> be supplied.
1505 =head3 Whither a Table with No Rows
1507 Often when a table has no rows, we want to display a message
1508 indicating this to the view. Use conditional processing to decide what
1512 <table><tr><td>No Data is Good Data</td></tr></table>
1517 <table id="load_data">
1519 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1523 <td id="name"> NATURE BOY RIC FLAIR </td>
1524 <td id="age"> 35 </td>
1525 <td id="weight"> 220 </td>
1542 =item * L<HTML::Tree>
1544 A perl package for creating and manipulating HTML trees
1546 =item * L<HTML::ElementTable>
1548 An L<HTML::Tree> - based module which allows for manipulation of HTML
1549 trees using cartesian coordinations.
1551 =item * L<HTML::Seamstress>
1553 An L<HTML::Tree> - based module inspired by
1554 XMLC (L<http://xmlc.enhydra.org>), allowing for dynamic
1555 HTML generation via tree rewriting.
1563 currently the API expects the subtrees to survive or be pruned to be
1566 $if_then->highlander2([
1567 under10 => sub { $_[0] < 10} ,
1568 under18 => sub { $_[0] < 18} ,
1573 $branch->look_down(id => 'age')->replace_content($age);
1580 but, it should be more flexible. the C<under10>, and C<under18> are
1581 expected to be ids in the tree... but it is not hard to have a check to
1582 see if this field is an array reference and if it, then to do a look
1585 $if_then->highlander2([
1586 [class => 'under10'] => sub { $_[0] < 10} ,
1587 [class => 'under18'] => sub { $_[0] < 18} ,
1588 [class => 'welcome'] => [
1592 $branch->look_down(id => 'age')->replace_content($age);
1609 Terrence Brannon, E<lt>tbone@cpan.orgE<gt>
1611 Many thanks to BARBIE for his RT bug report.
1613 =head1 COPYRIGHT AND LICENSE
1615 Copyright (C) 2004 by Terrence Brannon
1617 This library is free software; you can redistribute it and/or modify
1618 it under the same terms as Perl itself, either Perl version 5.8.4 or,
1619 at your option, any later version of Perl 5 you may have available.
This page took 0.090108 seconds and 4 git commands to generate.