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