lib/HTML/Element/Library.pm

   1 package HTML::Element::Library;
   2 # ABSTRACT: Convenience methods for HTML::TreeBuilder and HTML::Element
   3
   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::Util qw(first);
  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
  28 our $VERSION = '4.3';
  29
  30
  31
  32 # Preloaded methods go here.
  33
  34 # https://rt.cpan.org/Ticket/Display.html?id=44105
  35 sub HTML::Element::fillinform {
  36
  37     my ($tree, $hashref, $return_tree, $guts)=@_;
  38
  39     (ref $hashref) eq 'HASH' or die 'hashref not supplied as argument' ;
  40
  41     use HTML::FillInForm;
  42     my $html = $tree->as_HTML;
  43     my $new_html = HTML::FillInForm->fill(\$html, $hashref);
  44
  45     if ($return_tree) {
  46         my $tree = HTML::TreeBuilder->new_from_content($new_html);
  47         $tree = $guts ? $tree->guts : $tree ;
  48     } else {
  49         $new_html;
  50     }
  51
  52 }
  53
  54 sub HTML::Element::siblings {
  55   my $element = shift;
  56   my $p = $element->parent;
  57   return () unless $p;
  58   $p->content_list;
  59 }
  60
  61 sub HTML::Element::defmap {
  62     my($tree,$attr,$hashref,$debug)=@_;
  63
  64     while (my ($k, $v) = (each %$hashref)) {
  65         warn "defmap looks for ($attr => $k)" if $debug;
  66         my $found = $tree->look_down($attr => $k);
  67         if ($found) {
  68             warn "($attr => $k) was found.. replacing with '$v'" if $debug;
  69             $found->replace_content( $v );
  70         }
  71     }
  72
  73 }
  74
  75 sub HTML::Element::_only_empty_content {
  76   my ($self)=@_;
  77   my @c = $self->content_list;
  78   my $length  = scalar @c;
  79
  80   #use Data::Dumper;
  81   #warn sprintf 'Testing %s (%s)' , $self->starttag, Dumper(\@c);
  82   #warn sprintf "\t\tlength of content: %d ", $length;
  83
  84   scalar @c == 1 and not length($c[0]);
  85 }
  86
  87 sub HTML::Element::prune {
  88   my ($self)=@_;
  89
  90   for my $c ($self->content_list) {
  91     next unless ref $c;
  92     #warn "C: " . Dumper($c);
  93     $c->prune;
  94   }
  95
  96   # post-order:
  97   $self->delete if ($self->is_empty or $self->_only_empty_content);
  98   $self;
  99 }
 100
 101
 102 sub HTML::Element::crunch {
 103     my $container = shift;
 104
 105     my %p = validate(@_, {
 106                           look_down => { type => ARRAYREF },
 107                           leave => { default => 1 },
 108                          });
 109
 110     my @look_down = @{$p{look_down}} ;
 111     my @elem = $container->look_down( @look_down ) ;
 112
 113     my $left;
 114
 115     for my $elem (@elem) {
 116         $elem->detach if $left++ >= $p{leave} ;
 117     }
 118
 119 }
 120
 121 sub HTML::Element::hash_map {
 122     my $container = shift;
 123
 124     my %p = validate(@_, {
 125                           hash => { type => HASHREF },
 126                           to_attr => 1,
 127                           excluding => { type => ARRAYREF , default => [] },
 128                           debug => { default => 0 },
 129                          });
 130
 131     warn 'The container tag is ', $container->tag if $p{debug} ;
 132     warn 'hash' . Dumper($p{hash}) if $p{debug} ;
 133     #warn 'at_under' . Dumper(\@_) if $p{debug} ;
 134
 135     my @same_as = $container->look_down( $p{to_attr} => qr/.+/ ) ;
 136
 137     warn 'Found ' . scalar(@same_as) . ' nodes' if $p{debug} ;
 138
 139
 140     for my $same_as (@same_as) {
 141         my $attr_val = $same_as->attr($p{to_attr}) ;
 142         if (first { $attr_val eq $_ } @{$p{excluding}}) {
 143             warn "excluding $attr_val" if $p{debug} ;
 144             next;
 145         }
 146         warn "processing $attr_val" if $p{debug} ;
 147         $same_as->replace_content( $p{hash}->{$attr_val} ) ;
 148     }
 149
 150 }
 151
 152 sub HTML::Element::hashmap {
 153     my ($container, $attr_name, $hashref, $excluding, $debug) = @_;
 154
 155     $excluding ||= [] ;
 156
 157     $container->hash_map(hash => $hashref,
 158                           to_attr => $attr_name,
 159                           excluding => $excluding,
 160                           debug => $debug);
 161
 162 }
 163
 164
 165 sub HTML::Element::passover {
 166   my ($tree, @to_preserve) = @_;
 167
 168   warn "ARGS:   my ($tree, @to_preserve)" if $DEBUG;
 169   warn $tree->as_HTML(undef, ' ') if $DEBUG;
 170
 171   my $exodus = $tree->look_down(id => $to_preserve[0]);
 172
 173   warn "E: $exodus" if $DEBUG;
 174
 175   my @s = HTML::Element::siblings($exodus);
 176
 177   for my $s (@s) {
 178     next unless ref $s;
 179     if (first { $s->attr('id') eq $_ } @to_preserve) {
 180       ;
 181     } else {
 182       $s->delete;
 183     }
 184   }
 185
 186   return $exodus; # Goodbye Egypt! http://en.wikipedia.org/wiki/Passover
 187
 188 }
 189
 190 sub HTML::Element::sibdex {
 191
 192   my $element = shift;
 193   firstidx { $_ eq $element } $element->siblings
 194
 195 }
 196
 197 sub HTML::Element::addr { goto &HTML::Element::sibdex }
 198
 199 sub HTML::Element::replace_content {
 200   my $elem = shift;
 201   $elem->delete_content;
 202   $elem->push_content(@_);
 203 }
 204
 205 sub HTML::Element::wrap_content {
 206   my($self, $wrap) = @_;
 207   my $content = $self->content;
 208   if (ref $content) {
 209     $wrap->push_content(@$content);
 210     @$content = ($wrap);
 211   }
 212   else {
 213     $self->push_content($wrap);
 214   }
 215   $wrap;
 216 }
 217
 218 sub HTML::Element::Library::super_literal {
 219   my($text) = @_;
 220
 221   HTML::Element->new('~literal', text => $text);
 222 }
 223
 224
 225 sub HTML::Element::position {
 226   # Report coordinates by chasing addr's up the
 227   # HTML::ElementSuper tree.  We know we've reached
 228   # the top when a) there is no parent, or b) the
 229   # parent is some HTML::Element unable to report
 230   # it's position.
 231   my $p = shift;
 232   my @pos;
 233   while ($p) {
 234     my $a = $p->addr;
 235     unshift(@pos, $a) if defined $a;
 236     $p = $p->parent;
 237   }
 238   @pos;
 239 }
 240
 241
 242 sub HTML::Element::content_handler {
 243   my ($tree, %content_hash) = @_;
 244
 245   for my $k (keys %content_hash) {
 246       $tree->set_child_content(id => $k, $content_hash{$k});
 247   }
 248
 249
 250 }
 251
 252 sub HTML::Element::assign {
 253     goto &HTML::Element::content_handler;
 254 }
 255
 256
 257 sub make_counter {
 258   my $i = 1;
 259   sub {
 260     shift() . ':' . $i++
 261   }
 262 }
 263
 264
 265 sub HTML::Element::iter {
 266   my ($tree, $p, @data) = @_;
 267
 268   #  warn 'P: ' , $p->attr('id') ;
 269   #  warn 'H: ' , $p->as_HTML;
 270
 271   #  my $id_incr = make_counter;
 272   my @item = map {
 273     my $new_item = clone $p;
 274     $new_item->replace_content($_);
 275     $new_item;
 276   } @data;
 277
 278   $p->replace_with(@item);
 279
 280 }
 281
 282
 283 sub HTML::Element::iter2 {
 284
 285   my $tree = shift;
 286
 287   #warn "INPUT TO TABLE2: ", Dumper \@_;
 288
 289   my %p = validate(
 290     @_, {
 291       wrapper_ld    => { default => ['_tag' => 'dl'] },
 292       wrapper_data  => 1,
 293       wrapper_proc  => { default => undef },
 294       item_ld       => { default => sub {
 295                            my $tree = shift;
 296                            [
 297                              $tree->look_down('_tag' => 'dt'),
 298                              $tree->look_down('_tag' => 'dd')
 299                             ];
 300                          }
 301                         },
 302       item_data     => { default => sub { my ($wrapper_data) = @_;
 303                                           shift(@{$wrapper_data}) ;
 304                                         }},
 305       item_proc     => {
 306         default => sub {
 307           my ($item_elems, $item_data, $row_count) = @_;
 308           $item_elems->[$_]->replace_content($item_data->[$_]) for (0,1) ;
 309           $item_elems;
 310         }},
 311       splice        => { default => sub {
 312                            my ($container, @item_elems) = @_;
 313                            $container->splice_content(0, 2, @item_elems);
 314                          }
 315                         },
 316       debug => {default => 0}
 317      }
 318    );
 319
 320   warn "wrapper_data: " . Dumper $p{wrapper_data} if $p{debug} ;
 321
 322   my $container = ref_or_ld($tree, $p{wrapper_ld});
 323   warn "container: " . $container if $p{debug} ;
 324   warn "wrapper_(preproc): " . $container->as_HTML if $p{debug} ;
 325   $p{wrapper_proc}->($container) if defined $p{wrapper_proc} ;
 326   warn "wrapper_(postproc): " . $container->as_HTML if $p{debug} ;
 327
 328   my $_item_elems = $p{item_ld}->($container);
 329
 330
 331
 332   my $row_count;
 333   my @item_elem;
 334   {
 335     my $item_data  = $p{item_data}->($p{wrapper_data});
 336     last unless defined $item_data;
 337
 338     warn Dumper("item_data", $item_data);
 339
 340
 341     my $item_elems = [ map { $_->clone } @{$_item_elems} ] ;
 342
 343     if ($p{debug}) {
 344       for (@{$item_elems}) {
 345         warn "ITEM_ELEMS ", $_->as_HTML;
 346       }
 347     }
 348
 349     my $new_item_elems = $p{item_proc}->($item_elems, $item_data, ++$row_count);
 350
 351     if ($p{debug}) {
 352       for (@{$new_item_elems}) {
 353         warn "NEWITEM_ELEMS ", $_->as_HTML;
 354       }
 355     }
 356
 357
 358     push @item_elem, @{$new_item_elems} ;
 359
 360     redo;
 361   }
 362
 363   warn "pushing " . @item_elem . " elems " if $p{debug} ;
 364
 365   $p{splice}->($container, @item_elem);
 366
 367 }
 368
 369 sub HTML::Element::dual_iter {
 370   my ($parent, $data) = @_;
 371
 372   my ($prototype_a, $prototype_b) = $parent->content_list;
 373
 374   #  my $id_incr = make_counter;
 375
 376   my $i;
 377
 378   @$data %2 == 0 or
 379     confess 'dataset does not contain an even number of members';
 380
 381   my @iterable_data = ngroup 2 => @$data;
 382
 383   my @item = map {
 384     my ($new_a, $new_b) = map { clone $_ } ($prototype_a, $prototype_b) ;
 385     $new_a->splice_content(0,1, $_->[0]);
 386     $new_b->splice_content(0,1, $_->[1]);
 387     #$_->attr('id', $id_incr->($_->attr('id'))) for ($new_a, $new_b) ;
 388     ($new_a, $new_b)
 389   } @iterable_data;
 390
 391   $parent->splice_content(0, 2, @item);
 392
 393 }
 394
 395
 396 sub HTML::Element::set_child_content {
 397   my $tree      = shift;
 398   my $content   = pop;
 399   my @look_down = @_;
 400
 401   my $content_tag = $tree->look_down(@look_down);
 402
 403   unless ($content_tag) {
 404     warn "criteria [@look_down] not found";
 405     return;
 406   }
 407
 408   $content_tag->replace_content($content);
 409
 410 }
 411
 412 sub HTML::Element::highlander {
 413   my ($tree, $local_root_id, $aref, @arg) = @_;
 414
 415   ref $aref eq 'ARRAY' or confess
 416     "must supply array reference";
 417
 418   my @aref = @$aref;
 419   @aref % 2 == 0 or confess
 420     "supplied array ref must have an even number of entries";
 421
 422   warn __PACKAGE__ if $DEBUG;
 423
 424   my $survivor;
 425   while (my ($id, $test) = splice @aref, 0, 2) {
 426     warn $id if $DEBUG;
 427     if ($test->(@arg)) {
 428       $survivor = $id;
 429       last;
 430     }
 431   }
 432
 433
 434   my @id_survivor = (id => $survivor);
 435   my $survivor_node = $tree->look_down(@id_survivor);
 436 #  warn $survivor;
 437 #  warn $local_root_id;
 438 #  warn $node;
 439
 440   warn "survivor: $survivor" if $DEBUG;
 441   warn "tree: "  . $tree->as_HTML if $DEBUG;
 442
 443   $survivor_node or die "search for @id_survivor failed in tree($tree): " . $tree->as_HTML;
 444
 445   my $survivor_node_parent = $survivor_node->parent;
 446   $survivor_node = $survivor_node->clone;
 447   $survivor_node_parent->replace_content($survivor_node);
 448
 449   warn "new tree: " . $tree->as_HTML if $DEBUG;
 450
 451   $survivor_node;
 452 }
 453
 454
 455 sub HTML::Element::highlander2 {
 456   my $tree = shift;
 457
 458   my %p = validate(@_, {
 459     cond => { type => ARRAYREF },
 460     cond_arg => { type => ARRAYREF,
 461                   default => []
 462                  },
 463     debug => { default => 0 }
 464    }
 465                   );
 466
 467
 468   my @cond = @{$p{cond}};
 469   @cond % 2 == 0 or confess
 470     "supplied array ref must have an even number of entries";
 471
 472   warn __PACKAGE__ if $p{debug};
 473
 474   my @cond_arg = @{$p{cond_arg}};
 475
 476   my $survivor; my $then;
 477   while (my ($id, $if_then) = splice @cond, 0, 2) {
 478
 479     warn $id if $p{debug};
 480     my ($if, $_then);
 481
 482     if (ref $if_then eq 'ARRAY') {
 483       ($if, $_then) = @$if_then;
 484     } else {
 485       ($if, $_then) = ($if_then, sub {});
 486     }
 487
 488     if ($if->(@cond_arg)) {
 489       $survivor = $id;
 490       $then = $_then;
 491       last;
 492     }
 493
 494   }
 495
 496   my @ld = (ref $survivor eq 'ARRAY')
 497       ? @$survivor
 498           : (id => $survivor)
 499               ;
 500
 501   warn "survivor:    ", $survivor if $p{debug};
 502   warn "survivor_ld: ", Dumper \@ld if $p{debug};
 503
 504
 505   my $survivor_node = $tree->look_down(@ld);
 506
 507   $survivor_node or confess
 508       "search for @ld failed in tree($tree): " . $tree->as_HTML;
 509
 510   my $survivor_node_parent = $survivor_node->parent;
 511   $survivor_node = $survivor_node->clone;
 512   $survivor_node_parent->replace_content($survivor_node);
 513
 514
 515   # **************** NEW FUNCTIONALITY *******************
 516
 517   # apply transforms on survivor node
 518
 519
 520   warn "SURV::pre_trans "  . $survivor_node->as_HTML if $p{debug};
 521   $then->($survivor_node, @cond_arg);
 522   warn "SURV::post_trans "  . $survivor_node->as_HTML if $p{debug};
 523
 524   # **************** NEW FUNCTIONALITY *******************
 525
 526
 527
 528
 529   $survivor_node;
 530 }
 531
 532
 533 sub overwrite_action {
 534   my ($mute_node, %X) = @_;
 535
 536   $mute_node->attr($X{local_attr}{name} => $X{local_attr}{value}{new});
 537 }
 538
 539
 540 sub HTML::Element::overwrite_attr {
 541   my $tree = shift;
 542
 543   $tree->mute_elem(@_, \&overwrite_action);
 544 }
 545
 546
 547
 548 sub HTML::Element::mute_elem {
 549   my ($tree, $mute_attr, $closures, $post_hook) = @_;
 550
 551   warn "my mute_node = $tree->look_down($mute_attr => qr/.*/) ;";
 552   my @mute_node = $tree->look_down($mute_attr => qr/.*/) ;
 553
 554   for my $mute_node (@mute_node) {
 555     my ($local_attr,$mute_key)        = split /\s+/, $mute_node->attr($mute_attr);
 556     my $local_attr_value_current      = $mute_node->attr($local_attr);
 557     my $local_attr_value_new          = $closures->{$mute_key}->($tree, $mute_node, $local_attr_value_current);
 558     $post_hook->(
 559       $mute_node,
 560       tree => $tree,
 561       local_attr => {
 562         name => $local_attr,
 563         value => {
 564           current => $local_attr_value_current,
 565           new     => $local_attr_value_new
 566          }
 567        }
 568      ) if ($post_hook) ;
 569   }
 570 }
 571
 572
 573
 574 sub HTML::Element::table {
 575
 576   my ($s, %table) = @_;
 577
 578   my $table = {};
 579
 580   #  use Data::Dumper; warn Dumper \%table;
 581
 582   #  ++$DEBUG if $table{debug} ;
 583
 584
 585   # Get the table element
 586   $table->{table_node} = $s->look_down(id => $table{gi_table});
 587   $table->{table_node} or confess
 588     "table tag not found via (id => $table{gi_table}";
 589
 590   # Get the prototype tr element(s)
 591   my @table_gi_tr = listify $table{gi_tr} ;
 592   my @iter_node = map
 593     {
 594       my $tr = $table->{table_node}->look_down(id => $_);
 595       $tr or confess "tr with id => $_ not found";
 596       $tr;
 597     } @table_gi_tr;
 598
 599   warn "found " . @iter_node . " iter nodes " if $DEBUG;
 600   #  tie my $iter_node, 'Tie::Cycle', \@iter_node;
 601   my $iter_node =  List::Rotation::Cycle->new(@iter_node);
 602
 603   #  warn $iter_node;
 604   warn Dumper ($iter_node, \@iter_node) if $DEBUG;
 605
 606   # $table->{content}    = $table{content};
 607   #$table->{parent}     = $table->{table_node}->parent;
 608
 609
 610   #  $table->{table_node}->detach;
 611   #  $_->detach for @iter_node;
 612
 613   my @table_rows;
 614
 615   {
 616     my $row = $table{tr_data}->($table, $table{table_data});
 617     last unless defined $row;
 618
 619     # get a sample table row and clone it.
 620     my $I = $iter_node->next;
 621     warn  "I: $I" if $DEBUG;
 622     my $new_iter_node = $I->clone;
 623
 624
 625       $table{td_data}->($new_iter_node, $row);
 626       push @table_rows, $new_iter_node;
 627
 628     redo;
 629   }
 630
 631   if (@table_rows) {
 632
 633     my $replace_with_elem = $s->look_down(id => shift @table_gi_tr) ;
 634     for (@table_gi_tr) {
 635       $s->look_down(id => $_)->detach;
 636     }
 637
 638     $replace_with_elem->replace_with(@table_rows);
 639
 640   }
 641
 642 }
 643
 644 sub ref_or_ld {
 645
 646   my ($tree, $slot) = @_;
 647
 648   if (ref($slot) eq 'CODE') {
 649     $slot->($tree);
 650   } else {
 651     $tree->look_down(@$slot);
 652   }
 653 }
 654
 655
 656
 657 sub HTML::Element::table2 {
 658
 659   my $tree = shift;
 660
 661
 662
 663   my %p = validate(
 664     @_, {
 665       table_ld    => { default => ['_tag' => 'table'] },
 666       table_data  => 1,
 667       table_proc  => { default => undef },
 668
 669       tr_ld       => { default => ['_tag' => 'tr']    },
 670       tr_data     => { default => sub { my ($self, $data) = @_;
 671                                       shift(@{$data}) ;
 672                                     }},
 673       tr_base_id  => { default => undef },
 674       tr_proc     => { default => sub {} },
 675       td_proc     => 1,
 676       debug => {default => 0}
 677      }
 678    );
 679
 680   warn "INPUT TO TABLE2: ", Dumper \@_ if $p{debug};
 681
 682   warn "table_data: " . Dumper $p{table_data} if $p{debug} ;
 683
 684   my $table = {};
 685
 686   #  use Data::Dumper; warn Dumper \%table;
 687
 688   #  ++$DEBUG if $table{debug} ;
 689
 690   # Get the table element
 691   #warn 1;
 692   $table->{table_node} = ref_or_ld( $tree, $p{table_ld} ) ;
 693   #warn 2;
 694   $table->{table_node} or confess
 695     "table tag not found via " . Dumper($p{table_ld}) ;
 696
 697   warn "table: " . $table->{table_node}->as_HTML if $p{debug};
 698
 699
 700   # Get the prototype tr element(s)
 701   my @proto_tr = ref_or_ld( $table->{table_node},  $p{tr_ld} ) ;
 702
 703   warn "found " . @proto_tr . " iter nodes " if $p{debug};
 704
 705   @proto_tr or return ;
 706
 707   if ($p{debug}) {
 708     warn $_->as_HTML for @proto_tr;
 709   }
 710   my $proto_tr =  List::Rotation::Cycle->new(@proto_tr);
 711
 712   my $tr_parent = $proto_tr[0]->parent;
 713   warn "parent element of trs: " . $tr_parent->as_HTML if $p{debug};
 714
 715   my $row_count;
 716
 717   my @table_rows;
 718
 719   {
 720     my $row = $p{tr_data}->($table, $p{table_data}, $row_count);
 721     warn  "data row: " . Dumper $row if $p{debug};
 722     last unless defined $row;
 723
 724     # wont work:      my $new_iter_node = $table->{iter_node}->clone;
 725     my $new_tr_node = $proto_tr->next->clone;
 726     warn  "new_tr_node: $new_tr_node" if $p{debug};
 727
 728     $p{tr_proc}->($tree, $new_tr_node, $row, $p{tr_base_id}, ++$row_count)
 729         if defined $p{tr_proc};
 730
 731     warn  "data row redux: " . Dumper $row if $p{debug};
 732     #warn 3.3;
 733
 734     $p{td_proc}->($new_tr_node, $row);
 735     push @table_rows, $new_tr_node;
 736
 737     #warn 4.4;
 738
 739     redo;
 740   }
 741
 742   $_->detach for @proto_tr;
 743
 744   $tr_parent->push_content(@table_rows) if (@table_rows) ;
 745
 746 }
 747
 748
 749 sub HTML::Element::unroll_select {
 750
 751   my ($s, %select) = @_;
 752
 753   my $select = {};
 754
 755   warn "Select Hash: " . Dumper(\%select) if $select{debug};
 756
 757   my $select_node = $s->look_down(id => $select{select_label});
 758   warn "Select Node: " . $select_node if $select{debug};
 759
 760   unless ($select{append}) {
 761       for my $option ($select_node->look_down('_tag' => 'option')) {
 762           $option->delete;
 763       }
 764   }
 765
 766
 767   my $option = HTML::Element->new('option');
 768   warn "Option Node: " . $option if $select{debug};
 769
 770   $option->detach;
 771
 772   while (my $row = $select{data_iter}->($select{data}))
 773     {
 774         warn "Data Row:" . Dumper($row) if $select{debug};
 775         my $o = $option->clone;
 776         $o->attr('value', $select{option_value}->($row));
 777         $o->attr('SELECTED', 1) if (exists $select{option_selected} and $select{option_selected}->($row)) ;
 778
 779         $o->replace_content($select{option_content}->($row));
 780         $select_node->push_content($o);
 781         warn $o->as_HTML if $select{debug};
 782     }
 783
 784
 785 }
 786
 787
 788
 789 sub HTML::Element::set_sibling_content {
 790   my ($elt, $content) = @_;
 791
 792   $elt->parent->splice_content($elt->pindex + 1, 1, $content);
 793
 794 }
 795
 796 sub HTML::TreeBuilder::parse_string {
 797   my ($package, $string) = @_;
 798
 799   my $h = HTML::TreeBuilder->new;
 800   HTML::TreeBuilder->parse($string);
 801
 802 }
 803
 804
 805
 806 1;
 807 __END__