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