]> iEval git - html-element-library.git/blame - lib/HTML/Element/Library.pm
optionally return tree
[html-element-library.git] / lib / HTML / Element / Library.pm
CommitLineData
67e78ff2 1package HTML::Element::Library;
2
3use 5.006001;
4use strict;
5use warnings;
6
7
8our $DEBUG = 0;
9#our $DEBUG = 1;
10
11use Array::Group qw(:all);
12use Carp qw(confess);
13use Data::Dumper;
14use HTML::Element;
3dad7198 15use List::Util qw(first);
67e78ff2 16use List::MoreUtils qw/:all/;
17use Params::Validate qw(:all);
18use Scalar::Listify;
19#use Tie::Cycle;
20use List::Rotation::Cycle;
21
22our %EXPORT_TAGS = ( 'all' => [ qw() ] );
23our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
24our @EXPORT = qw();
25
26
27
de64e3d9 28our $VERSION = '3.53';
67e78ff2 29
30
2fcbbeb3 31
67e78ff2 32# Preloaded methods go here.
33
2fcbbeb3
TB
34# https://rt.cpan.org/Ticket/Display.html?id=44105
35sub HTML::Element::fillinform {
36
63007e38 37 my ($tree, $hashref, $return_tree)=@_;
2fcbbeb3 38
674cdd66
TB
39 (ref $hashref) eq 'HASH' or die 'hashref not supplied as argument' ;
40
2fcbbeb3
TB
41 use HTML::FillInForm;
42 my $html = $tree->as_HTML;
43 my $new_html = HTML::FillInForm->fill(\$html, $hashref);
44
63007e38
TB
45 if ($return_tree) {
46 HTML::TreeBuilder->new_from_content($new_html);
47 } else {
48 $new_html;
49 }
50
2fcbbeb3
TB
51}
52
67e78ff2 53sub HTML::Element::siblings {
54 my $element = shift;
55 my $p = $element->parent;
56 return () unless $p;
57 $p->content_list;
58}
59
f25dca7f 60sub HTML::Element::defmap {
9a087986 61 my($tree,$attr,$hashref,$debug)=@_;
f25dca7f
TB
62
63 while (my ($k, $v) = (each %$hashref)) {
9a087986 64 warn "defmap looks for ($attr => $k)" if $debug;
f25dca7f
TB
65 my $found = $tree->look_down($attr => $k);
66 if ($found) {
9a087986 67 warn "($attr => $k) was found.. replacing with '$v'" if $debug;
f25dca7f
TB
68 $found->replace_content( $v );
69 }
70 }
71
72}
73
74
9b7a5679
TB
75sub HTML::Element::hash_map {
76 my $container = shift;
77
78 my %p = validate(@_, {
79 hash => { type => HASHREF },
80 to_attr => 1,
d9f4bd5a 81 excluding => { type => ARRAYREF , default => [] },
9b7a5679
TB
82 debug => { default => 0 },
83 });
84
d9f4bd5a
TB
85 warn 'The container tag is ', $container->tag if $p{debug} ;
86 warn 'hash' . Dumper($p{hash}) if $p{debug} ;
f25dca7f 87 warn 'at_under' . Dumper(\@_) if $p{debug} ;
d9f4bd5a
TB
88
89 my @same_as = $container->look_down( $p{to_attr} => qr/.+/ ) ;
90
91 warn 'Found ' . scalar(@same_as) . ' nodes' if $p{debug} ;
92
9b7a5679
TB
93
94 for my $same_as (@same_as) {
d9f4bd5a
TB
95 my $attr_val = $same_as->attr($p{to_attr}) ;
96 if (first { $attr_val eq $_ } @{$p{excluding}}) {
97 warn "excluding $attr_val" if $p{debug} ;
98 next;
99 }
100 warn "processing $attr_val" if $p{debug} ;
101 $same_as->replace_content( $p{hash}->{$attr_val} ) ;
9b7a5679 102 }
3dad7198
TB
103
104}
105
f25dca7f
TB
106sub HTML::Element::hashmap {
107 my ($container, $attr_name, $hashref, $excluding, $debug) = @_;
108
109 $excluding ||= [] ;
110
111 $container->hash_map(hash => $hashref,
112 to_attr => $attr_name,
113 excluding => $excluding,
114 debug => $debug);
115
116}
117
3dad7198 118
de64e3d9 119sub HTML::Element::passover {
96cec221 120 my ($tree, @to_preserve) = @_;
de64e3d9 121
96cec221 122 warn "ARGS: my ($tree, @to_preserve)" if $DEBUG;
3dad7198 123 warn $tree->as_HTML(undef, ' ') if $DEBUG;
de64e3d9 124
96cec221 125 my $exodus = $tree->look_down(id => $to_preserve[0]);
de64e3d9 126
3dad7198
TB
127 warn "E: $exodus" if $DEBUG;
128
de64e3d9 129 my @s = HTML::Element::siblings($exodus);
130
de64e3d9 131 for my $s (@s) {
de64e3d9 132 next unless ref $s;
96cec221 133 if (first { $s->attr('id') eq $_ } @to_preserve) {
de64e3d9 134 ;
135 } else {
136 $s->delete;
137 }
138 }
139
140 return $exodus; # Goodbye Egypt! http://en.wikipedia.org/wiki/Passover
141
142}
143
67e78ff2 144sub HTML::Element::sibdex {
145
146 my $element = shift;
147 firstidx { $_ eq $element } $element->siblings
148
149}
150
151sub HTML::Element::addr { goto &HTML::Element::sibdex }
152
153sub HTML::Element::replace_content {
154 my $elem = shift;
155 $elem->delete_content;
156 $elem->push_content(@_);
157}
158
159sub HTML::Element::wrap_content {
160 my($self, $wrap) = @_;
161 my $content = $self->content;
162 if (ref $content) {
163 $wrap->push_content(@$content);
164 @$content = ($wrap);
165 }
166 else {
167 $self->push_content($wrap);
168 }
169 $wrap;
170}
171
172sub HTML::Element::Library::super_literal {
173 my($text) = @_;
174
175 HTML::Element->new('~literal', text => $text);
176}
177
178
179sub HTML::Element::position {
180 # Report coordinates by chasing addr's up the
181 # HTML::ElementSuper tree. We know we've reached
182 # the top when a) there is no parent, or b) the
183 # parent is some HTML::Element unable to report
184 # it's position.
185 my $p = shift;
186 my @pos;
187 while ($p) {
188 my $a = $p->addr;
189 unshift(@pos, $a) if defined $a;
190 $p = $p->parent;
191 }
192 @pos;
193}
194
195
196sub HTML::Element::content_handler {
3c14ea1e 197 my ($tree, %content_hash) = @_;
198
199 for my $k (keys %content_hash) {
200 $tree->set_child_content(id => $k, $content_hash{$k});
201 }
67e78ff2 202
67e78ff2 203
204}
205
206
207sub make_counter {
208 my $i = 1;
209 sub {
210 shift() . ':' . $i++
211 }
212}
213
214
215sub HTML::Element::iter {
216 my ($tree, $p, @data) = @_;
217
218 # warn 'P: ' , $p->attr('id') ;
219 # warn 'H: ' , $p->as_HTML;
220
221 # my $id_incr = make_counter;
222 my @item = map {
223 my $new_item = clone $p;
224 $new_item->replace_content($_);
67e78ff2 225 $new_item;
226 } @data;
227
228 $p->replace_with(@item);
229
230}
231
232
233sub HTML::Element::iter2 {
234
235 my $tree = shift;
236
237 #warn "INPUT TO TABLE2: ", Dumper \@_;
238
239 my %p = validate(
240 @_, {
241 wrapper_ld => { default => ['_tag' => 'dl'] },
242 wrapper_data => 1,
243 wrapper_proc => { default => undef },
244 item_ld => { default => sub {
245 my $tree = shift;
246 [
247 $tree->look_down('_tag' => 'dt'),
248 $tree->look_down('_tag' => 'dd')
249 ];
250 }
251 },
252 item_data => { default => sub { my ($wrapper_data) = @_;
253 shift(@{$wrapper_data}) ;
254 }},
255 item_proc => {
256 default => sub {
257 my ($item_elems, $item_data, $row_count) = @_;
258 $item_elems->[$_]->replace_content($item_data->[$_]) for (0,1) ;
259 $item_elems;
260 }},
261 splice => { default => sub {
262 my ($container, @item_elems) = @_;
263 $container->splice_content(0, 2, @item_elems);
264 }
265 },
266 debug => {default => 0}
267 }
268 );
269
270 warn "wrapper_data: " . Dumper $p{wrapper_data} if $p{debug} ;
271
272 my $container = ref_or_ld($tree, $p{wrapper_ld});
3dad7198 273 warn "container: " . $container if $p{debug} ;
67e78ff2 274 warn "wrapper_(preproc): " . $container->as_HTML if $p{debug} ;
275 $p{wrapper_proc}->($container) if defined $p{wrapper_proc} ;
276 warn "wrapper_(postproc): " . $container->as_HTML if $p{debug} ;
277
278 my $_item_elems = $p{item_ld}->($container);
279
280
281
282 my $row_count;
283 my @item_elem;
284 {
285 my $item_data = $p{item_data}->($p{wrapper_data});
286 last unless defined $item_data;
287
288 warn Dumper("item_data", $item_data);
289
290
291 my $item_elems = [ map { $_->clone } @{$_item_elems} ] ;
292
293 if ($p{debug}) {
294 for (@{$item_elems}) {
295 warn "ITEM_ELEMS ", $_->as_HTML;
296 }
297 }
298
299 my $new_item_elems = $p{item_proc}->($item_elems, $item_data, ++$row_count);
300
301 if ($p{debug}) {
302 for (@{$new_item_elems}) {
303 warn "NEWITEM_ELEMS ", $_->as_HTML;
304 }
305 }
306
307
308 push @item_elem, @{$new_item_elems} ;
309
310 redo;
311 }
312
313 warn "pushing " . @item_elem . " elems " if $p{debug} ;
314
315 $p{splice}->($container, @item_elem);
316
317}
318
319sub HTML::Element::dual_iter {
320 my ($parent, $data) = @_;
321
322 my ($prototype_a, $prototype_b) = $parent->content_list;
323
324 # my $id_incr = make_counter;
325
326 my $i;
327
328 @$data %2 == 0 or
329 confess 'dataset does not contain an even number of members';
330
331 my @iterable_data = ngroup 2 => @$data;
332
333 my @item = map {
334 my ($new_a, $new_b) = map { clone $_ } ($prototype_a, $prototype_b) ;
335 $new_a->splice_content(0,1, $_->[0]);
336 $new_b->splice_content(0,1, $_->[1]);
337 #$_->attr('id', $id_incr->($_->attr('id'))) for ($new_a, $new_b) ;
338 ($new_a, $new_b)
339 } @iterable_data;
340
341 $parent->splice_content(0, 2, @item);
342
343}
344
345
346sub HTML::Element::set_child_content {
347 my $tree = shift;
348 my $content = pop;
349 my @look_down = @_;
350
351 my $content_tag = $tree->look_down(@look_down);
352
353 unless ($content_tag) {
354 warn "criteria [@look_down] not found";
355 return;
356 }
357
358 $content_tag->replace_content($content);
359
360}
361
362sub HTML::Element::highlander {
363 my ($tree, $local_root_id, $aref, @arg) = @_;
364
365 ref $aref eq 'ARRAY' or confess
366 "must supply array reference";
367
368 my @aref = @$aref;
369 @aref % 2 == 0 or confess
370 "supplied array ref must have an even number of entries";
371
372 warn __PACKAGE__ if $DEBUG;
373
374 my $survivor;
375 while (my ($id, $test) = splice @aref, 0, 2) {
376 warn $id if $DEBUG;
377 if ($test->(@arg)) {
378 $survivor = $id;
379 last;
380 }
381 }
382
383
384 my @id_survivor = (id => $survivor);
385 my $survivor_node = $tree->look_down(@id_survivor);
386# warn $survivor;
387# warn $local_root_id;
388# warn $node;
389
390 warn "survivor: $survivor" if $DEBUG;
391 warn "tree: " . $tree->as_HTML if $DEBUG;
392
393 $survivor_node or die "search for @id_survivor failed in tree($tree): " . $tree->as_HTML;
394
395 my $survivor_node_parent = $survivor_node->parent;
396 $survivor_node = $survivor_node->clone;
397 $survivor_node_parent->replace_content($survivor_node);
398
399 warn "new tree: " . $tree->as_HTML if $DEBUG;
400
401 $survivor_node;
402}
403
404
405sub HTML::Element::highlander2 {
406 my $tree = shift;
407
408 my %p = validate(@_, {
409 cond => { type => ARRAYREF },
410 cond_arg => { type => ARRAYREF,
411 default => []
412 },
413 debug => { default => 0 }
414 }
415 );
416
417
418 my @cond = @{$p{cond}};
419 @cond % 2 == 0 or confess
420 "supplied array ref must have an even number of entries";
421
422 warn __PACKAGE__ if $p{debug};
423
424 my @cond_arg = @{$p{cond_arg}};
425
426 my $survivor; my $then;
427 while (my ($id, $if_then) = splice @cond, 0, 2) {
428
429 warn $id if $p{debug};
430 my ($if, $_then);
431
432 if (ref $if_then eq 'ARRAY') {
433 ($if, $_then) = @$if_then;
434 } else {
435 ($if, $_then) = ($if_then, sub {});
436 }
437
438 if ($if->(@cond_arg)) {
439 $survivor = $id;
440 $then = $_then;
441 last;
442 }
443
444 }
445
446 my @ld = (ref $survivor eq 'ARRAY')
447 ? @$survivor
448 : (id => $survivor)
449 ;
450
451 warn "survivor: ", $survivor if $p{debug};
452 warn "survivor_ld: ", Dumper \@ld if $p{debug};
453
454
455 my $survivor_node = $tree->look_down(@ld);
456
457 $survivor_node or confess
458 "search for @ld failed in tree($tree): " . $tree->as_HTML;
459
460 my $survivor_node_parent = $survivor_node->parent;
461 $survivor_node = $survivor_node->clone;
462 $survivor_node_parent->replace_content($survivor_node);
463
464
465 # **************** NEW FUNCTIONALITY *******************
466
467 # apply transforms on survivor node
468
469
470 warn "SURV::pre_trans " . $survivor_node->as_HTML if $p{debug};
471 $then->($survivor_node, @cond_arg);
472 warn "SURV::post_trans " . $survivor_node->as_HTML if $p{debug};
473
474 # **************** NEW FUNCTIONALITY *******************
475
476
477
478
479 $survivor_node;
480}
481
482
483sub overwrite_action {
484 my ($mute_node, %X) = @_;
485
486 $mute_node->attr($X{local_attr}{name} => $X{local_attr}{value}{new});
487}
488
489
490sub HTML::Element::overwrite_attr {
491 my $tree = shift;
492
493 $tree->mute_elem(@_, \&overwrite_action);
494}
495
496
497
498sub HTML::Element::mute_elem {
499 my ($tree, $mute_attr, $closures, $post_hook) = @_;
500
501 warn "my mute_node = $tree->look_down($mute_attr => qr/.*/) ;";
502 my @mute_node = $tree->look_down($mute_attr => qr/.*/) ;
503
504 for my $mute_node (@mute_node) {
505 my ($local_attr,$mute_key) = split /\s+/, $mute_node->attr($mute_attr);
506 my $local_attr_value_current = $mute_node->attr($local_attr);
507 my $local_attr_value_new = $closures->{$mute_key}->($tree, $mute_node, $local_attr_value_current);
508 $post_hook->(
509 $mute_node,
510 tree => $tree,
511 local_attr => {
512 name => $local_attr,
513 value => {
514 current => $local_attr_value_current,
515 new => $local_attr_value_new
516 }
517 }
518 ) if ($post_hook) ;
519 }
520}
521
522
523
524sub HTML::Element::table {
525
526 my ($s, %table) = @_;
527
528 my $table = {};
529
530 # use Data::Dumper; warn Dumper \%table;
531
532 # ++$DEBUG if $table{debug} ;
533
534
535 # Get the table element
536 $table->{table_node} = $s->look_down(id => $table{gi_table});
537 $table->{table_node} or confess
538 "table tag not found via (id => $table{gi_table}";
539
540 # Get the prototype tr element(s)
541 my @table_gi_tr = listify $table{gi_tr} ;
542 my @iter_node = map
543 {
544 my $tr = $table->{table_node}->look_down(id => $_);
545 $tr or confess "tr with id => $_ not found";
546 $tr;
547 } @table_gi_tr;
548
549 warn "found " . @iter_node . " iter nodes " if $DEBUG;
550 # tie my $iter_node, 'Tie::Cycle', \@iter_node;
551 my $iter_node = List::Rotation::Cycle->new(@iter_node);
552
553 # warn $iter_node;
554 warn Dumper ($iter_node, \@iter_node) if $DEBUG;
555
556 # $table->{content} = $table{content};
557 #$table->{parent} = $table->{table_node}->parent;
558
559
560 # $table->{table_node}->detach;
561 # $_->detach for @iter_node;
562
563 my @table_rows;
564
565 {
566 my $row = $table{tr_data}->($table, $table{table_data});
567 last unless defined $row;
568
569 # get a sample table row and clone it.
570 my $I = $iter_node->next;
571 warn "I: $I" if $DEBUG;
572 my $new_iter_node = $I->clone;
573
574
575 $table{td_data}->($new_iter_node, $row);
576 push @table_rows, $new_iter_node;
577
578 redo;
579 }
580
581 if (@table_rows) {
582
583 my $replace_with_elem = $s->look_down(id => shift @table_gi_tr) ;
584 for (@table_gi_tr) {
585 $s->look_down(id => $_)->detach;
586 }
587
588 $replace_with_elem->replace_with(@table_rows);
589
590 }
591
592}
593
594sub ref_or_ld {
595
596 my ($tree, $slot) = @_;
597
598 if (ref($slot) eq 'CODE') {
599 $slot->($tree);
600 } else {
601 $tree->look_down(@$slot);
602 }
603}
604
605
606
607sub HTML::Element::table2 {
608
609 my $tree = shift;
610
611
612
613 my %p = validate(
614 @_, {
615 table_ld => { default => ['_tag' => 'table'] },
616 table_data => 1,
617 table_proc => { default => undef },
618
619 tr_ld => { default => ['_tag' => 'tr'] },
620 tr_data => { default => sub { my ($self, $data) = @_;
621 shift(@{$data}) ;
622 }},
623 tr_base_id => { default => undef },
624 tr_proc => { default => sub {} },
625 td_proc => 1,
626 debug => {default => 0}
627 }
628 );
629
630 warn "INPUT TO TABLE2: ", Dumper \@_ if $p{debug};
631
632 warn "table_data: " . Dumper $p{table_data} if $p{debug} ;
633
634 my $table = {};
635
636 # use Data::Dumper; warn Dumper \%table;
637
638 # ++$DEBUG if $table{debug} ;
639
640 # Get the table element
5f53bf21 641 #warn 1;
67e78ff2 642 $table->{table_node} = ref_or_ld( $tree, $p{table_ld} ) ;
5f53bf21 643 #warn 2;
67e78ff2 644 $table->{table_node} or confess
645 "table tag not found via " . Dumper($p{table_ld}) ;
646
647 warn "table: " . $table->{table_node}->as_HTML if $p{debug};
648
649
650 # Get the prototype tr element(s)
651 my @proto_tr = ref_or_ld( $table->{table_node}, $p{tr_ld} ) ;
652
653 warn "found " . @proto_tr . " iter nodes " if $p{debug};
654
655 @proto_tr or return ;
656
657 if ($p{debug}) {
658 warn $_->as_HTML for @proto_tr;
659 }
660 my $proto_tr = List::Rotation::Cycle->new(@proto_tr);
661
662 my $tr_parent = $proto_tr[0]->parent;
663 warn "parent element of trs: " . $tr_parent->as_HTML if $p{debug};
664
665 my $row_count;
666
667 my @table_rows;
668
669 {
670 my $row = $p{tr_data}->($table, $p{table_data}, $row_count);
671 warn "data row: " . Dumper $row if $p{debug};
672 last unless defined $row;
673
674 # wont work: my $new_iter_node = $table->{iter_node}->clone;
675 my $new_tr_node = $proto_tr->next->clone;
676 warn "new_tr_node: $new_tr_node" if $p{debug};
677
678 $p{tr_proc}->($tree, $new_tr_node, $row, $p{tr_base_id}, ++$row_count)
679 if defined $p{tr_proc};
680
681 warn "data row redux: " . Dumper $row if $p{debug};
5f53bf21 682 #warn 3.3;
67e78ff2 683
684 $p{td_proc}->($new_tr_node, $row);
685 push @table_rows, $new_tr_node;
686
5f53bf21 687 #warn 4.4;
67e78ff2 688
689 redo;
690 }
691
692 $_->detach for @proto_tr;
693
694 $tr_parent->push_content(@table_rows) if (@table_rows) ;
695
696}
697
698
699sub HTML::Element::unroll_select {
700
701 my ($s, %select) = @_;
702
703 my $select = {};
704
f25dca7f
TB
705 warn "Select Hash: " . Dumper(\%select) if $select{debug};
706
67e78ff2 707 my $select_node = $s->look_down(id => $select{select_label});
3caedb5b 708 warn "Select Node: " . $select_node if $select{debug};
67e78ff2 709
3caedb5b
TB
710 unless ($select{append}) {
711 for my $option ($select_node->look_down('_tag' => 'option')) {
712 $option->delete;
713 }
714 }
67e78ff2 715
67e78ff2 716
3caedb5b
TB
717 my $option = HTML::Element->new('option');
718 warn "Option Node: " . $option if $select{debug};
67e78ff2 719
720 $option->detach;
721
722 while (my $row = $select{data_iter}->($select{data}))
723 {
3caedb5b
TB
724 warn "Data Row:" . Dumper($row) if $select{debug};
725 my $o = $option->clone;
726 $o->attr('value', $select{option_value}->($row));
727 $o->attr('SELECTED', 1) if (exists $select{option_selected} and $select{option_selected}->($row)) ;
728
729 $o->replace_content($select{option_content}->($row));
730 $select_node->push_content($o);
731 warn $o->as_HTML if $select{debug};
67e78ff2 732 }
733
734
735}
736
737
738
739sub HTML::Element::set_sibling_content {
740 my ($elt, $content) = @_;
741
742 $elt->parent->splice_content($elt->pindex + 1, 1, $content);
743
744}
745
746sub HTML::TreeBuilder::parse_string {
747 my ($package, $string) = @_;
748
749 my $h = HTML::TreeBuilder->new;
750 HTML::TreeBuilder->parse($string);
751
752}
753
754
755
7561;
757__END__
758# Below is stub documentation for your module. You'd better edit it!
759
760=head1 NAME
761
762HTML::Element::Library - HTML::Element convenience functions
763
764=head1 SYNOPSIS
765
766 use HTML::Element::Library;
767 use HTML::TreeBuilder;
768
769=head1 DESCRIPTION
770
771This method provides API calls for common actions on trees when using
772L<HTML::Tree>.
773
774=head1 METHODS
775
776The test suite contains examples of each of these methods in a
777file C<t/$method.t>
778
779=head2 Positional Querying Methods
780
781=head3 $elem->siblings
782
783Return a list of all nodes under the same parent.
784
785=head3 $elem->sibdex
786
787Return the index of C<$elem> into the array of siblings of which it is
788a part. L<HTML::ElementSuper> calls this method C<addr> but I don't think
789that is a descriptive name. And such naming is deceptively close to the
790C<address> function of C<HTML::Element>. HOWEVER, in the interest of
791backwards compatibility, both methods are available.
792
793=head3 $elem->addr
794
795Same as sibdex
796
797=head3 $elem->position()
798
799Returns the coordinates of this element in the tree it inhabits.
800This is accomplished by succesively calling addr() on ancestor
801elements until either a) an element that does not support these
802methods is found, or b) there are no more parents. The resulting
803list is the n-dimensional coordinates of the element in the tree.
804
805=head2 Element Decoration Methods
806
807=head3 HTML::Element::Library::super_literal($text)
808
809In L<HTML::Element>, Sean Burke discusses super-literals. They are
810text which does not get escaped. Great for includng Javascript in
811HTML. Also great for including foreign language into a document.
812
813So, you basically toss C<super_literal> your text and back comes
814your text wrapped in a C<~literal> element.
815
816One of these days, I'll around to writing a nice C<EXPORT> section.
817
818=head2 Tree Rewriting Methods
819
2fcbbeb3
TB
820=head3 Simplifying calls to HTML::FillInForm
821
822Since HTML::FillInForm gets and returns strings, using HTML::Element instances
823becomes tedious:
824
825 1. Seamstress has an HTML tree that it wants the form filled in on
826 2. Seamstress converts this tree to a string
827 3. FillInForm parses the string into an HTML tree and then fills in the form
828 4. FillInForm converts the HTML tree to a string
829 5. Seamstress re-parses the HTML for additional processing
830
831I've filed a bug about this:
832L<https://rt.cpan.org/Ticket/Display.html?id=44105>
833
834This function, fillinform,
835allows you to pass a tree to fillinform (along with your data structure) and
836get back a tree:
837
838 my $new_tree = $html_tree->fillinform($data_structure);
839
840
9a087986
TB
841=head3 Mapping a hashref to HTML elements
842
843It is very common to get a hashref of data from some external source - flat file, database, XML, etc.
844Therefore, it is important to have a convenient way of mapping this data to HTML.
845
846As it turns out, there are 3 ways to do this in HTML::Element::Library.
847The most strict and structured way to do this is with
848C<content_handler>. Two other methods, C<hashmap> and C<datamap> require less manual mapping and may prove
849even more easy to use in certain cases.
850
851As is usual with Perl, a practical example is always best. So let's take some sample HTML:
852
853 <h1>user data</h1>
854 <span id="name">?</span>
855 <span id="email">?</span>
856 <span id="gender">?</span>
857
858Now, let's say our data structure is this:
859
860 $ref = { email => 'jim@beam.com', gender => 'lots' } ;
861
862And let's start with the most strict way to get what you want:
863
864 $tree->content_handler(email => $ref->{email} , gender => $ref->{gender}) ;
865
866
867In this case, you manually state the mapping between id tags and hashref keys and
868then C<content_handler> retrieves the hashref data and pops it in the specified place.
869
870Now let's look at the two (actually 2 and a half) other hash-mapping methods.
871
872 $tree->hashmap(id => $ref);
873
874Now, what this function does is super-destructive. It finds every element in the tree
875with an attribute named id (since 'id' is a parameter, it could find every element with
876some other attribute also) and replaces the content of those elements with the hashref
877value.
878
879So, in the case above, the
880
881 <span id="name">?</span>
882
883would come out as
884
885 <span id="name"></span>
886
887(it would be blank) - because there is nothing in the hash with that value, so it substituted
888
889 $ref->{name}
890
891which was blank and emptied the contents.
892
893Now, let's assume we want to protect name from being auto-assigned. Here is what you do:
894
895 $tree->hashmap(id => $ref, ['name']);
896
897That last array ref is an exclusion list.
898
899But wouldnt it be nice if you could do a hashmap, but only assigned things which are defined
900in the hashref? C<< defmap() >> to the rescue:
901
902 $tree->defmap(id => $ref);
903
904does just that, so
905
906 <span id="name">?</span>
907
908would be left alone.
909
910
911=head4 $elem->hashmap($attr_name, \%hashref, \@excluded, $debug)
9b7a5679
TB
912
913This method is designed to take a hashref and populate a series of elements. For example:
914
915
916 <table>
917 <tr sclass="tr" class="alt" align="left" valign="top">
3caedb5b
TB
918 <td smap="people_id">1</td>
919 <td smap="phone">(877) 255-3239</td>
920 <td smap="password">*********</td>
9b7a5679
TB
921 </tr>
922 </table>
923
3caedb5b 924In the table above, there are several attributes named C<< smap >>. If we have a hashref whose keys are the same:
9b7a5679
TB
925
926 my %data = (people_id => 888, phone => '444-4444', password => 'dont-you-dare-render');
927
928Then a single API call allows us to populate the HTML while excluding those ones we dont:
929
96cec221 930 $tree->hashmap(smap => \%data, ['password']);
f25dca7f 931
9b7a5679 932
f25dca7f 933Note: the other way to prevent rendering some of the hash mapping is to not give that element the attr
9b7a5679
TB
934you plan to use for hash mapping.
935
f25dca7f
TB
936Also note: the function C<< hashmap >> has a simple easy-to-type API. Interally, it calls C<< hash_map >>
937(which has a more verbose keyword calling API). Thus, the above call to C<hashmap()> results in this call:
938
939 $tree->hash_map(hash => \%data, to_attr => 'sid', excluding => ['password']);
940
9a087986
TB
941=head4 $elem->defmap($attr_name, \%hashref, $debug)
942
943C<defmap> was described above.
944
945
946=head4 $elem->content_handler(%hashref)
947
948C<content_handler> is described below.
949
9b7a5679 950
67e78ff2 951=head3 $elem->replace_content(@new_elem)
952
953Replaces all of C<$elem>'s content with C<@new_elem>.
954
955=head3 $elem->wrap_content($wrapper_element)
956
957Wraps the existing content in the provided element. If the provided element
958happens to be a non-element, a push_content is performed instead.
959
960=head3 $elem->set_child_content(@look_down, $content)
961
962 This method looks down $tree using the criteria specified in @look_down using the the HTML::Element look_down() method.
963
964After finding the node, it detaches the node's content and pushes $content as the node's content.
965
3c14ea1e 966=head3 $tree->content_handler(%id_content)
67e78ff2 967
968This is a convenience method. Because the look_down criteria will often simply be:
969
970 id => 'fixme'
971
972to find things like:
973
974 <a id=fixme href=http://www.somesite.org>replace_content</a>
975
976You can call this method to shorten your typing a bit. You can simply type
977
978 $elem->content_handler( fixme => 'new text' )
979
980Instead of typing:
981
982 $elem->set_child_content(sid => 'fixme', 'new text')
983
9a087986 984ALSO NOTE: you can pass a hash whose keys are C<id>s and whose values are the content you want there and it will perform the replacement on each hash member:
3c14ea1e 985
986 my %id_content = (name => "Terrence Brannon",
987 email => 'tbrannon@in.com',
988 balance => 666,
989 content => $main_content);
990
991 $tree->content_handler(%id_content);
992
67e78ff2 993=head3 $tree->highlander($subtree_span_id, $conditionals, @conditionals_args)
994
995This allows for "if-then-else" style processing. Highlander was a movie in
996which only one would survive. Well, in terms of a tree when looking at a
997structure that you want to process in C<if-then-else> style, only one child
998will survive. For example, given this HTML template:
999
1000 <span klass="highlander" id="age_dialog">
1001 <span id="under10">
1002 Hello, does your mother know you're
1003 using her AOL account?
1004 </span>
1005 <span id="under18">
1006 Sorry, you're not old enough to enter
1007 (and too dumb to lie about your age)
1008 </span>
1009 <span id="welcome">
1010 Welcome
1011 </span>
1012 </span>
1013
1014We only want one child of the C<span> tag with id C<age_dialog> to remain
1015based on the age of the person visiting the page.
1016
1017So, let's setup a call that will prune the subtree as a function of age:
1018
1019 sub process_page {
1020 my $age = shift;
1021 my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander.html');
1022
1023 $tree->highlander
1024 (age_dialog =>
1025 [
1026 under10 => sub { $_[0] < 10} ,
1027 under18 => sub { $_[0] < 18} ,
1028 welcome => sub { 1 }
1029 ],
1030 $age
1031 );
1032
1033And there we have it. If the age is less than 10, then the node with
1034id C<under10> remains. For age less than 18, the node with id C<under18>
1035remains.
1036Otherwise our "else" condition fires and the child with id C<welcome> remains.
1037
96cec221 1038=head3 $tree->passover(@id_of_element)
4b02c173 1039
96cec221
TB
1040In some cases, you know exactly which element(s) should survive. In this case,
1041you can simply call C<passover> to remove it's (their) siblings. For the HTML
4b02c173 1042above, you could delete C<under10> and C<welcome> by simply calling:
1043
1044 $tree->passover('under18');
1045
96cec221
TB
1046Because passover takes an array, you can specify several children to preserve.
1047
67e78ff2 1048=head3 $tree->highlander2($tree, $conditionals, @conditionals_args)
1049
1050Right around the same time that C<table2()> came into being, Seamstress
1051began to tackle tougher and tougher processing problems. It became clear that
1052a more powerful highlander was needed... one that not only snipped the tree
1053of the nodes that should not survive, but one that allows for
1054post-processing of the survivor node. And one that was more flexible with
1055how to find the nodes to snip.
1056
1057Thus (drum roll) C<highlander2()>.
1058
1059So let's look at our HTML which requires post-selection processing:
1060
1061 <span klass="highlander" id="age_dialog">
1062 <span id="under10">
1063 Hello, little <span id=age>AGE</span>-year old,
1064 does your mother know you're using her AOL account?
1065 </span>
1066 <span id="under18">
1067 Sorry, you're only <span id=age>AGE</span>
1068 (and too dumb to lie about your age)
1069 </span>
1070 <span id="welcome">
1071 Welcome, isn't it good to be <span id=age>AGE</span> years old?
1072 </span>
1073</span>
1074
1075In this case, a branch survives, but it has dummy data in it. We must take
1076the surviving segment of HTML and rewrite the age C<span> with the age.
1077Here is how we use C<highlander2()> to do so:
1078
1079 sub replace_age {
1080 my $branch = shift;
1081 my $age = shift;
1082 $branch->look_down(id => 'age')->replace_content($age);
1083 }
1084
1085 my $if_then = $tree->look_down(id => 'age_dialog');
1086
1087 $if_then->highlander2(
1088 cond => [
1089 under10 => [
1090 sub { $_[0] < 10} ,
1091 \&replace_age
1092 ],
1093 under18 => [
1094 sub { $_[0] < 18} ,
1095 \&replace_age
1096 ],
1097 welcome => [
1098 sub { 1 },
1099 \&replace_age
1100 ]
1101 ],
1102 cond_arg => [ $age ]
1103 );
1104
1105We pass it the tree (C<$if_then>), an arrayref of conditions
1106(C<cond>) and an arrayref of arguments which are passed to the
1107C<cond>s and to the replacement subs.
1108
1109The C<under10>, C<under18> and C<welcome> are id attributes in the
1110tree of the siblings of which only one will survive. However,
1111should you need to do
1112more complex look-downs to find the survivor,
1113then supply an array ref instead of a simple
1114scalar:
1115
1116
1117 $if_then->highlander2(
1118 cond => [
1119 [class => 'r12'] => [
1120 sub { $_[0] < 10} ,
1121 \&replace_age
1122 ],
1123 [class => 'z22'] => [
1124 sub { $_[0] < 18} ,
1125 \&replace_age
1126 ],
1127 [class => 'w88'] => [
1128 sub { 1 },
1129 \&replace_age
1130 ]
1131 ],
1132 cond_arg => [ $age ]
1133 );
1134
1135
1136=head3 $tree->overwrite_attr($mutation_attr => $mutating_closures)
1137
1138This method is designed for taking a tree and reworking a set of nodes in
1139a stereotyped fashion. For instance let's say you have 3 remote image
1140archives, but you don't want to put long URLs in your img src
1141tags for reasons of abstraction, re-use and brevity. So instead you do this:
1142
1143 <img src="/img/smiley-face.jpg" fixup="src lnc">
1144 <img src="/img/hot-babe.jpg" fixup="src playboy">
1145 <img src="/img/footer.jpg" fixup="src foobar">
1146
1147and then when the tree of HTML is being processed, you make this call:
1148
1149 my %closures = (
1150 lnc => sub { my ($tree, $mute_node, $attr_value)= @_; "http://lnc.usc.edu$attr_value" },
1151 playboy => sub { my ($tree, $mute_node, $attr_value)= @_; "http://playboy.com$attr_value" }
1152 foobar => sub { my ($tree, $mute_node, $attr_value)= @_; "http://foobar.info$attr_value" }
1153 )
1154
1155 $tree->overwrite_attr(fixup => \%closures) ;
1156
1157and the tags come out modified like so:
1158
1159 <img src="http://lnc.usc.edu/img/smiley-face.jpg" fixup="src lnc">
1160 <img src="http://playboy.com/img/hot-babe.jpg" fixup="src playboy">
1161 <img src="http://foobar.info/img/footer.jpg" fixup="src foobar">
1162
1163=head3 $tree->mute_elem($mutation_attr => $mutating_closures, [ $post_hook ] )
1164
1165This is a generalization of C<overwrite_attr>. C<overwrite_attr>
1166assumes the return value of the
1167closure is supposed overwrite an attribute value and does it for you.
1168C<mute_elem> is a more general function which does nothing but
1169hand the closure the element and let it mutate it as it jolly well pleases :)
1170
1171In fact, here is the implementation of C<overwrite_attr>
1172to give you a taste of how C<mute_attr> is used:
1173
1174 sub overwrite_action {
1175 my ($mute_node, %X) = @_;
1176
1177 $mute_node->attr($X{local_attr}{name} => $X{local_attr}{value}{new});
1178 }
1179
1180
1181 sub HTML::Element::overwrite_attr {
1182 my $tree = shift;
1183
1184 $tree->mute_elem(@_, \&overwrite_action);
1185 }
1186
1187
1188
1189
9b7a5679
TB
1190=head2 Tree-Building Methods
1191
1192
1193
1194=head3 Unrolling an array via a single sample element (<ul> container)
67e78ff2 1195
1196This is best described by example. Given this HTML:
1197
1198 <strong>Here are the things I need from the store:</strong>
1199 <ul>
1200 <li class="store_items">Sample item</li>
1201 </ul>
1202
1203We can unroll it like so:
1204
1205 my $li = $tree->look_down(class => 'store_items');
1206
1207 my @items = qw(bread butter vodka);
1208
1209 $tree->iter($li => @items);
1210
1211To produce this:
1212
1213
1214 <html>
1215 <head></head>
1216 <body>Here are the things I need from the store:
1217 <ul>
1218 <li class="store_items">bread</li>
1219 <li class="store_items">butter</li>
1220 <li class="store_items">vodka</li>
1221 </ul>
1222 </body>
1223 </html>
1224
9a087986
TB
1225Now, you might be wondering why the API call is:
1226
1227 $tree->iter($li => @items)
1228
1229instead of:
1230
1231 $li->iter(@items)
1232
1233and there is no good answer. The latter would be more concise and it is what I
1234should have done.
1235
9b7a5679 1236=head3 Unrolling an array via n sample elements (<dl> container)
67e78ff2 1237
1238C<iter()> was fine for awhile, but some things
1239(e.g. definition lists) need a more general function to make them easy to
1240do. Hence C<iter2()>. This function will be explained by example of unrolling
1241a simple definition list.
1242
1243So here's our mock-up HTML from the designer:
1244
1245 <dl class="dual_iter" id="service_plan">
1246 <dt>
1247 Artist
1248 </dt>
1249 <dd>
1250 A person who draws blood.
1251 </dd>
1252
1253 <dt>
1254 Musician
1255 </dt>
1256 <dd>
1257 A clone of Iggy Pop.
1258 </dd>
1259
1260 <dt>
1261 Poet
1262 </dt>
1263 <dd>
1264 A relative of Edgar Allan Poe.
1265 </dd>
1266
1267 <dt class="adstyle">sample header</dt>
1268 <dd class="adstyle2">sample data</dd>
1269
1270 </dl>
1271
1272
1273And we want to unroll our data set:
1274
1275 my @items = (
1276 ['the pros' => 'never have to worry about service again'],
1277 ['the cons' => 'upfront extra charge on purchase'],
1278 ['our choice' => 'go with the extended service plan']
1279 );
1280
1281
1282Now, let's make this problem a bit harder to show off the power of C<iter2()>.
1283Let's assume that we want only the last <dt> and it's accompanying <dd>
1284(the one with "sample data") to be used as the sample data
1285for unrolling with our data set. Let's further assume that we want them to
1286remain in the final output.
1287
1288So now, the API to C<iter2()> will be discussed and we will explain how our
1289goal of getting our data into HTML fits into the API.
1290
1291=over 4
1292
1293=item * wrapper_ld
1294
1295This is how to look down and find the container of all the elements we will
1296be unrolling. The <dl> tag is the container for the dt and dd tags we will be
1297unrolling.
1298
1299If you pass an anonymous subroutine, then it is presumed that execution of
1300this subroutine will return the HTML::Element representing the container tag.
1301If you pass an array ref, then this will be dereferenced and passed to
1302C<HTML::Element::look_down()>.
1303
1304default value: C<< ['_tag' => 'dl'] >>
1305
1306Based on the mock HTML above, this default is fine for finding our container
1307tag. So let's move on.
1308
1309=item * wrapper_data
1310
1311This is an array reference of data that we will be putting into the container.
1312You must supply this. C<@items> above is our C<wrapper_data>.
1313
1314=item * wrapper_proc
1315
1316After we find the container via C<wrapper_ld>, we may want to pre-process
1317some aspect of this tree. In our case the first two sets of dt and dd need
1318to be removed, leaving the last dt and dd. So, we supply a C<wrapper_proc>
1319which will do this.
1320
1321default: undef
1322
1323=item * item_ld
1324
1325This anonymous subroutine returns an array ref of C<HTML::Element>s that will
1326be cloned and populated with item data
1327(item data is a "row" of C<wrapper_data>).
1328
1329default: returns an arrayref consisting of the dt and dd element inside the
1330container.
1331
1332=item * item_data
1333
1334This is a subroutine that takes C<wrapper_data> and retrieves one "row"
1335to be "pasted" into the array ref of C<HTML::Element>s found via C<item_ld>.
1336I hope that makes sense.
1337
1338default: shifts C<wrapper_data>.
1339
1340=item * item_proc
1341
1342This is a subroutine that takes the C<item_data> and the C<HTML::Element>s
1343found via C<item_ld> and produces an arrayref of C<HTML::Element>s which will
1344eventually be spliced into the container.
1345
1346Note that this subroutine MUST return the new items. This is done
1347So that more items than were passed in can be returned. This is
1348useful when, for example, you must return 2 dts for an input data item.
1349And when would you do this? When a single term has multiple spellings
1350for instance.
1351
1352default: expects C<item_data> to be an arrayref of two elements and
1353C<item_elems> to be an arrayref of two C<HTML::Element>s. It replaces the
1354content of the C<HTML::Element>s with the C<item_data>.
1355
1356=item * splice
1357
1358After building up an array of C<@item_elems>, the subroutine passed as
1359C<splice> will be given the parent container HTML::Element and the
1360C<@item_elems>. How the C<@item_elems> end up in the container is up to this
1361routine: it could put half of them in. It could unshift them or whatever.
1362
1363default: C<< $container->splice_content(0, 2, @item_elems) >>
1364In other words, kill the 2 sample elements with the newly generated
1365@item_elems
1366
1367=back
1368
1369So now that we have documented the API, let's see the call we need:
1370
1371 $tree->iter2(
1372 # default wrapper_ld ok.
1373 wrapper_data => \@items,
1374 wrapper_proc => sub {
1375 my ($container) = @_;
1376
1377 # only keep the last 2 dts and dds
1378 my @content_list = $container->content_list;
1379 $container->splice_content(0, @content_list - 2);
1380 },
1381
1382 # default item_ld is fine.
1383 # default item_data is fine.
1384 # default item_proc is fine.
1385 splice => sub {
1386 my ($container, @item_elems) = @_;
1387 $container->unshift_content(@item_elems);
1388 },
1389 debug => 1,
1390 );
1391
1392
9b7a5679
TB
1393
1394
1395=head3 Select Unrolling
67e78ff2 1396
1397The C<unroll_select> method has this API:
1398
1399 $tree->unroll_select(
1400 select_label => $id_label,
1401 option_value => $closure, # how to get option value from data row
1402 option_content => $closure, # how to get option content from data row
1403 option_selected => $closure, # boolean to decide if SELECTED
1404 data => $data # the data to be put into the SELECT
1405 data_iter => $closure # the thing that will get a row of data
3caedb5b
TB
1406 debug => $boolean,
1407 append => $boolean, # remove the sample <OPTION> data or append?
67e78ff2 1408 );
1409
1410Here's an example:
1411
1412 $tree->unroll_select(
1413 select_label => 'clan_list',
1414 option_value => sub { my $row = shift; $row->clan_id },
1415 option_content => sub { my $row = shift; $row->clan_name },
1416 option_selected => sub { my $row = shift; $row->selected },
1417 data => \@query_results,
3caedb5b
TB
1418 data_iter => sub { my $data = shift; $data->next },
1419 append => 0,
1420 debug => 0
1421 );
67e78ff2 1422
1423
1424
1425=head2 Tree-Building Methods: Table Generation
1426
1427Matthew Sisk has a much more intuitive (imperative)
1428way to generate tables via his module
1429L<HTML::ElementTable|HTML::ElementTable>.
1430However, for those with callback fever, the following
1431method is available. First, we look at a nuts and bolts way to build a table
1432using only standard L<HTML::Tree> API calls. Then the C<table> method
1433available here is discussed.
1434
1435=head3 Sample Model
1436
1437 package Simple::Class;
1438
1439 use Set::Array;
1440
1441 my @name = qw(bob bill brian babette bobo bix);
1442 my @age = qw(99 12 44 52 12 43);
1443 my @weight = qw(99 52 80 124 120 230);
1444
1445
1446 sub new {
1447 my $this = shift;
1448 bless {}, ref($this) || $this;
1449 }
1450
1451 sub load_data {
1452 my @data;
1453
1454 for (0 .. 5) {
1455 push @data, {
1456 age => $age[rand $#age] + int rand 20,
1457 name => shift @name,
1458 weight => $weight[rand $#weight] + int rand 40
1459 }
1460 }
1461
1462 Set::Array->new(@data);
1463 }
1464
1465
1466 1;
1467
1468
1469=head4 Sample Usage:
1470
1471 my $data = Simple::Class->load_data;
1472 ++$_->{age} for @$data
1473
1474=head3 Inline Code to Unroll a Table
1475
1476=head4 HTML
1477
1478 <html>
1479
1480 <table id="load_data">
1481
1482 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1483
1484 <tr id="iterate">
1485
1486 <td id="name"> NATURE BOY RIC FLAIR </td>
1487 <td id="age"> 35 </td>
1488 <td id="weight"> 220 </td>
1489
1490 </tr>
1491
1492 </table>
1493
1494 </html>
1495
1496
1497=head4 The manual way (*NOT* recommended)
1498
1499 require 'simple-class.pl';
1500 use HTML::Seamstress;
1501
1502 # load the view
1503 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
1504
1505 # load the model
1506 my $o = Simple::Class->new;
1507 my $data = $o->load_data;
1508
1509 # find the <table> and <tr>
1510 my $table_node = $seamstress->look_down('id', 'load_data');
1511 my $iter_node = $table_node->look_down('id', 'iterate');
1512 my $table_parent = $table_node->parent;
1513
1514
1515 # drop the sample <table> and <tr> from the HTML
1516 # only add them in if there is data in the model
1517 # this is achieved via the $add_table flag
1518
1519 $table_node->detach;
1520 $iter_node->detach;
1521 my $add_table;
1522
1523 # Get a row of model data
1524 while (my $row = shift @$data) {
1525
1526 # We got row data. Set the flag indicating ok to hook the table into the HTML
1527 ++$add_table;
1528
1529 # clone the sample <tr>
1530 my $new_iter_node = $iter_node->clone;
1531
1532 # find the tags labeled name age and weight and
1533 # set their content to the row data
1534 $new_iter_node->content_handler($_ => $row->{$_})
1535 for qw(name age weight);
1536
1537 $table_node->push_content($new_iter_node);
1538
1539 }
1540
1541 # reattach the table to the HTML tree if we loaded data into some table rows
1542
1543 $table_parent->push_content($table_node) if $add_table;
1544
1545 print $seamstress->as_HTML;
1546
1547
1548
1549=head3 $tree->table() : API call to Unroll a Table
1550
1551 require 'simple-class.pl';
1552 use HTML::Seamstress;
1553
1554 # load the view
1555 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
1556 # load the model
1557 my $o = Simple::Class->new;
1558
1559 $seamstress->table
1560 (
1561 # tell seamstress where to find the table, via the method call
1562 # ->look_down('id', $gi_table). Seamstress detaches the table from the
1563 # HTML tree automatically if no table rows can be built
1564
1565 gi_table => 'load_data',
1566
1567 # tell seamstress where to find the tr. This is a bit useless as
1568 # the <tr> usually can be found as the first child of the parent
1569
1570 gi_tr => 'iterate',
1571
1572 # the model data to be pushed into the table
1573
1574 table_data => $o->load_data,
1575
1576 # the way to take the model data and obtain one row
1577 # if the table data were a hashref, we would do:
1578 # my $key = (keys %$data)[0]; my $val = $data->{$key}; delete $data->{$key}
1579
1580 tr_data => sub { my ($self, $data) = @_;
1581 shift(@{$data}) ;
1582 },
1583
1584 # the way to take a row of data and fill the <td> tags
1585
1586 td_data => sub { my ($tr_node, $tr_data) = @_;
1587 $tr_node->content_handler($_ => $tr_data->{$_})
1588 for qw(name age weight) }
1589
1590 );
1591
1592
1593 print $seamstress->as_HTML;
1594
1595
1596
1597=head4 Looping over Multiple Sample Rows
1598
1599* HTML
1600
1601 <html>
1602
1603 <table id="load_data" CELLPADDING=8 BORDER=2>
1604
1605 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1606
1607 <tr id="iterate1" BGCOLOR="white" >
1608
1609 <td id="name"> NATURE BOY RIC FLAIR </td>
1610 <td id="age"> 35 </td>
1611 <td id="weight"> 220 </td>
1612
1613 </tr>
1614 <tr id="iterate2" BGCOLOR="#CCCC99">
1615
1616 <td id="name"> NATURE BOY RIC FLAIR </td>
1617 <td id="age"> 35 </td>
1618 <td id="weight"> 220 </td>
1619
1620 </tr>
1621
1622 </table>
1623
1624 </html>
1625
1626
1627* Only one change to last API call.
1628
1629This:
1630
1631 gi_tr => 'iterate',
1632
1633becomes this:
1634
1635 gi_tr => ['iterate1', 'iterate2']
1636
1637=head3 $tree->table2() : New API Call to Unroll a Table
1638
1639After 2 or 3 years with C<table()>, I began to develop
1640production websites with it and decided it needed a cleaner
1641interface, particularly in the area of handling the fact that
1642C<id> tags will be the same after cloning a table row.
1643
1644First, I will give a dry listing of the function's argument parameters.
1645This will not be educational most likely. A better way to understand how
1646to use the function is to read through the incremental unrolling of the
1647function's interface given in conversational style after the dry listing.
1648But take your pick. It's the same information given in two different
1649ways.
1650
1651=head4 Dry/technical parameter documentation
1652
1653C<< $tree->table2(%param) >> takes the following arguments:
1654
1655=over
1656
1657=item * C<< table_ld => $look_down >> : optional
1658
1659How to find the C<table> element in C<$tree>. If C<$look_down> is an
1660arrayref, then use C<look_down>. If it is a CODE ref, then call it,
1661passing it C<$tree>.
1662
1663Defaults to C<< ['_tag' => 'table'] >> if not passed in.
1664
1665=item * C<< table_data => $tabular_data >> : required
1666
1667The data to fill the table with. I<Must> be passed in.
1668
1669=item * C<< table_proc => $code_ref >> : not implemented
1670
1671A subroutine to do something to the table once it is found.
1672Not currently implemented. Not obviously necessary. Just
1673created because there is a C<tr_proc> and C<td_proc>.
1674
1675=item * C<< tr_ld => $look_down >> : optional
1676
1677Same as C<table_ld> but for finding the table row elements. Please note
1678that the C<tr_ld> is done on the table node that was found I<instead>
1679of the whole HTML tree. This makes sense. The C<tr>s that you want exist
1680below the table that was just found.
1681
1682Defaults to C<< ['_tag' => 'tr'] >> if not passed in.
1683
1684=item * C<< tr_data => $code_ref >> : optional
1685
1686How to take the C<table_data> and return a row. Defaults to:
1687
1688 sub { my ($self, $data) = @_;
1689 shift(@{$data}) ;
1690 }
1691
1692=item * C<< tr_proc => $code_ref >> : optional
1693
1694Something to do to the table row we are about to add to the
1695table we are making. Defaults to a routine which makes the C<id>
1696attribute unique:
1697
1698 sub {
1699 my ($self, $tr, $tr_data, $tr_base_id, $row_count) = @_;
1700 $tr->attr(id => sprintf "%s_%d", $tr_base_id, $row_count);
1701 }
1702
1703=item * C<< td_proc => $code_ref >> : required
1704
1705This coderef will take the row of data and operate on the C<td> cells that
1706are children of the C<tr>. See C<t/table2.t> for several usage examples.
1707
1708Here's a sample one:
1709
1710 sub {
1711 my ($tr, $data) = @_;
1712 my @td = $tr->look_down('_tag' => 'td');
1713 for my $i (0..$#td) {
1714 $td[$i]->splice_content(0, 1, $data->[$i]);
1715 }
1716 }
1717
1718=cut
1719
1720=head4 Conversational parameter documentation
1721
1722The first thing you need is a table. So we need a look down for that. If you
1723don't give one, it defaults to
1724
1725 ['_tag' => 'table']
1726
1727What good is a table to display in without data to display?!
1728So you must supply a scalar representing your tabular
1729data source. This scalar might be an array reference, a C<next>able iterator,
1730a DBI statement handle. Whatever it is, it can be iterated through to build
1731up rows of table data.
1732These two required fields (the way to find the table and the data to
1733display in the table) are C<table_ld> and C<table_data>
1734respectively. A little more on C<table_ld>. If this happens to be a CODE ref,
1735then execution
1736of the code ref is presumed to return the C<HTML::Element>
1737representing the table in the HTML tree.
1738
1739Next, we get the row or rows which serve as sample C<tr> elements by doing
1740a C<look_down> from the C<table_elem>. While normally one sample row
1741is enough to unroll a table, consider when you have alternating
1742table rows. This API call would need one of each row so that it can
1743cycle through the
1744sample rows as it loops through the data.
1745Alternatively, you could always just use one row and
1746make the necessary changes to the single C<tr> row by
1747mutating the element in C<tr_proc>,
1748discussed below. The default C<tr_ld> is
1749C<< ['_tag' => 'tr'] >> but you can overwrite it. Note well, if you overwrite
1750it with a subroutine, then it is expected that the subroutine will return
1751the C<HTML::Element>(s)
1752which are C<tr> element(s).
1753The reason a subroutine might be preferred is in the case
1754that the HTML designers gave you 8 sample C<tr> rows but only one
1755prototype row is needed.
1756So you can write a subroutine, to splice out the 7 rows you don't need
1757and leave the one sample
1758row remaining so that this API call can clone it and supply it to
1759the C<tr_proc> and C<td_proc> calls.
1760
1761Now, as we move through the table rows with table data,
1762we need to do two different things on
1763each table row:
1764
1765=over 4
1766
1767=item * get one row of data from the C<table_data> via C<tr_data>
1768
1769The default procedure assumes the C<table_data> is an array reference and
1770shifts a row off of it:
1771
1772 sub { my ($self, $data) = @_;
1773 shift(@{$data}) ;
1774 }
1775
1776Your function MUST return undef when there is no more rows to lay out.
1777
1778=item * take the C<tr> element and mutate it via C<tr_proc>
1779
1780The default procedure simply makes the id of the table row unique:
1781
1782 sub { my ($self, $tr, $tr_data, $row_count, $root_id) = @_;
1783 $tr->attr(id => sprintf "%s_%d", $root_id, $row_count);
1784 }
1785
1786=back
1787
1788Now that we have our row of data, we call C<td_proc> so that it can
1789take the data and the C<td> cells in this C<tr> and process them.
1790This function I<must> be supplied.
1791
1792
1793=head3 Whither a Table with No Rows
1794
1795Often when a table has no rows, we want to display a message
1796indicating this to the view. Use conditional processing to decide what
1797to display:
1798
1799 <span id=no_data>
1800 <table><tr><td>No Data is Good Data</td></tr></table>
1801 </span>
1802 <span id=load_data>
1803 <html>
1804
1805 <table id="load_data">
1806
1807 <tr> <th>name</th><th>age</th><th>weight</th> </tr>
1808
1809 <tr id="iterate">
1810
1811 <td id="name"> NATURE BOY RIC FLAIR </td>
1812 <td id="age"> 35 </td>
1813 <td id="weight"> 220 </td>
1814
1815 </tr>
1816
1817 </table>
1818
1819 </html>
1820
1821 </span>
1822
1823
1824
1825
1826=head1 SEE ALSO
1827
1828=over
1829
1830=item * L<HTML::Tree>
1831
1832A perl package for creating and manipulating HTML trees
1833
1834=item * L<HTML::ElementTable>
1835
1836An L<HTML::Tree> - based module which allows for manipulation of HTML
1837trees using cartesian coordinations.
1838
1839=item * L<HTML::Seamstress>
1840
1841An L<HTML::Tree> - based module inspired by
1842XMLC (L<http://xmlc.enhydra.org>), allowing for dynamic
1843HTML generation via tree rewriting.
1844
1845=head1 TODO
1846
1847=over
1848
1849=item * highlander2
1850
1851currently the API expects the subtrees to survive or be pruned to be
1852identified by id:
1853
1854 $if_then->highlander2([
1855 under10 => sub { $_[0] < 10} ,
1856 under18 => sub { $_[0] < 18} ,
1857 welcome => [
1858 sub { 1 },
1859 sub {
1860 my $branch = shift;
1861 $branch->look_down(id => 'age')->replace_content($age);
1862 }
1863 ]
1864 ],
1865 $age
1866 );
1867
1868but, it should be more flexible. the C<under10>, and C<under18> are
1869expected to be ids in the tree... but it is not hard to have a check to
1870see if this field is an array reference and if it, then to do a look
1871down instead:
1872
1873 $if_then->highlander2([
1874 [class => 'under10'] => sub { $_[0] < 10} ,
1875 [class => 'under18'] => sub { $_[0] < 18} ,
1876 [class => 'welcome'] => [
1877 sub { 1 },
1878 sub {
1879 my $branch = shift;
1880 $branch->look_down(id => 'age')->replace_content($age);
1881 }
1882 ]
1883 ],
1884 $age
1885 );
1886
1887
1888
1889=cut
1890
1891=head1 SEE ALSO
1892
1893L<HTML::Seamstress>
1894
f25dca7f 1895=head1 AUTHOR / SOURCE
67e78ff2 1896
1897Terrence Brannon, E<lt>tbone@cpan.orgE<gt>
1898
1899Many thanks to BARBIE for his RT bug report.
1900
f25dca7f
TB
1901The source is at L<http://github.com/metaperl/html-element-library/tree/master>
1902
67e78ff2 1903=head1 COPYRIGHT AND LICENSE
1904
1905Copyright (C) 2004 by Terrence Brannon
1906
1907This library is free software; you can redistribute it and/or modify
1908it under the same terms as Perl itself, either Perl version 5.8.4 or,
1909at your option, any later version of Perl 5 you may have available.
1910
1911
1912=cut
This page took 0.229632 seconds and 4 git commands to generate.