lib/HTML/Zoom/FilterBuilder.pm

   1 package HTML::Zoom::FilterBuilder;
   2
   3 use strictures 1;
   4 use base qw(HTML::Zoom::SubObject);
   5 use HTML::Zoom::CodeStream;
   6
   7 sub _stream_from_code {
   8   shift->_zconfig->stream_utils->stream_from_code(@_)
   9 }
  10
  11 sub _stream_from_array {
  12   shift->_zconfig->stream_utils->stream_from_array(@_)
  13 }
  14
  15 sub _stream_from_proto {
  16   shift->_zconfig->stream_utils->stream_from_proto(@_)
  17 }
  18
  19 sub _stream_concat {
  20   shift->_zconfig->stream_utils->stream_concat(@_)
  21 }
  22
  23 sub _flatten_stream_of_streams {
  24   shift->_zconfig->stream_utils->flatten_stream_of_streams(@_)
  25 }
  26
  27 sub set_attribute {
  28   my $self = shift;
  29   my ($name, $value) = $self->_parse_attribute_args(@_);
  30   sub {
  31     my $a = (my $evt = $_[0])->{attrs};
  32     my $e = exists $a->{$name};
  33     +{ %$evt, raw => undef, raw_attrs => undef,
  34        attrs => { %$a, $name => $value },
  35       ($e # add to name list if not present
  36         ? ()
  37         : (attr_names => [ @{$evt->{attr_names}}, $name ]))
  38      }
  39    };
  40 }
  41
  42 sub _parse_attribute_args {
  43   my $self = shift;
  44   # allow ->add_to_attribute(name => 'value')
  45   #    or ->add_to_attribute({ name => 'name', value => 'value' })
  46   my ($name, $value) = @_ > 1 ? @_ : @{$_[0]}{qw(name value)};
  47   return ($name, $self->_zconfig->parser->html_escape($value));
  48 }
  49
  50 sub add_attribute {
  51     die "renamed to add_to_attribute. killing this entirely for 1.0";
  52 }
  53
  54 sub add_to_attribute {
  55   my $self = shift;
  56   my ($name, $value) = $self->_parse_attribute_args(@_);
  57   sub {
  58     my $a = (my $evt = $_[0])->{attrs};
  59     my $e = exists $a->{$name};
  60     +{ %$evt, raw => undef, raw_attrs => undef,
  61        attrs => {
  62          %$a,
  63          $name => join(' ', ($e ? $a->{$name} : ()), $value)
  64       },
  65       ($e # add to name list if not present
  66         ? ()
  67         : (attr_names => [ @{$evt->{attr_names}}, $name ]))
  68     }
  69   };
  70 }
  71
  72 sub remove_attribute {
  73   my ($self, $args) = @_;
  74   my $name = (ref($args) eq 'HASH') ? $args->{name} : $args;
  75   sub {
  76     my $a = (my $evt = $_[0])->{attrs};
  77     return $evt unless exists $a->{$name};
  78     $a = { %$a }; delete $a->{$name};
  79     +{ %$evt, raw => undef, raw_attrs => undef,
  80        attrs => $a,
  81        attr_names => [ grep $_ ne $name, @{$evt->{attr_names}} ]
  82     }
  83   };
  84 }
  85
  86 sub collect {
  87   my ($self, $options) = @_;
  88   my ($into, $passthrough, $content, $filter, $flush_before) =
  89     @{$options}{qw(into passthrough content filter flush_before)};
  90   sub {
  91     my ($evt, $stream) = @_;
  92     # We wipe the contents of @$into here so that other actions depending
  93     # on this (such as a repeater) can be invoked multiple times easily.
  94     # I -suspect- it's better for that state reset to be managed here; if it
  95     # ever becomes painful the decision should be revisited
  96     if ($into) {
  97       @$into = $content ? () : ($evt);
  98     }
  99     if ($evt->{is_in_place_close}) {
 100       return $evt if $passthrough || $content;
 101       return;
 102     }
 103     my $name = $evt->{name};
 104     my $depth = 1;
 105     my $_next = $content ? 'peek' : 'next';
 106     if ($filter) {
 107       if ($content) {
 108         $stream = do { local $_ = $stream; $filter->($stream) };
 109       } else {
 110         $stream = do {
 111           local $_ = $self->_stream_concat(
 112                        $self->_stream_from_array($evt),
 113                        $stream,
 114                      );
 115           $filter->($_);
 116         };
 117         $evt = $stream->next;
 118       }
 119     }
 120     my $collector = $self->_stream_from_code(sub {
 121       return unless $stream;
 122       while (my ($evt) = $stream->$_next) {
 123         $depth++ if ($evt->{type} eq 'OPEN');
 124         $depth-- if ($evt->{type} eq 'CLOSE');
 125         unless ($depth) {
 126           undef $stream;
 127           return if $content;
 128           push(@$into, $evt) if $into;
 129           return $evt if $passthrough;
 130           return;
 131         }
 132         push(@$into, $evt) if $into;
 133         $stream->next if $content;
 134         return $evt if $passthrough;
 135       }
 136       die "Never saw closing </${name}> before end of source";
 137     });
 138     if ($flush_before) {
 139       if ($passthrough||$content) {
 140         $evt = { %$evt, flush => 1 };
 141       } else {
 142         $evt = { type => 'EMPTY', flush => 1 };
 143       }
 144     }
 145     return ($passthrough||$content||$flush_before)
 146              ? [ $evt, $collector ]
 147              : $collector;
 148   };
 149 }
 150
 151 sub collect_content {
 152   my ($self, $options) = @_;
 153   $self->collect({ %{$options||{}}, content => 1 })
 154 }
 155
 156 sub add_before {
 157   my ($self, $events) = @_;
 158   my $coll_proto = $self->collect({ passthrough => 1 });
 159   sub {
 160     my $emit = $self->_stream_from_proto($events);
 161     my $coll = &$coll_proto;
 162     if($coll) {
 163       if(ref $coll eq 'ARRAY') {
 164         my $firstbit = $self->_stream_from_proto([$coll->[0]]);
 165         return $self->_stream_concat($emit, $firstbit, $coll->[1]);
 166       } elsif(ref $coll eq 'HASH') {
 167         return [$emit, $coll];
 168       } else {
 169         return $self->_stream_concat($emit, $coll);
 170       }
 171     } else { return $emit }
 172   }
 173 }
 174
 175 sub add_after {
 176   my ($self, $events) = @_;
 177   my $coll_proto = $self->collect({ passthrough => 1 });
 178   sub {
 179     my ($evt) = @_;
 180     my $emit = $self->_stream_from_proto($events);
 181     my $coll = &$coll_proto;
 182     return ref($coll) eq 'HASH' # single event, no collect
 183       ? [ $coll, $emit ]
 184       : [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
 185   };
 186 }
 187
 188
 189       #$emit = $self->_stream_concat(
 190       #          $emit,
 191       #          $self->_stream_from_array($close),
 192       #        );
 193
 194 sub prepend_content {
 195   my ($self, $events) = @_;
 196   my $coll_proto = $self->collect({ passthrough => 1, content => 1 });
 197   sub {
 198     my ($evt) = @_;
 199     my $emit = $self->_stream_from_proto($events);
 200     if ($evt->{is_in_place_close}) {
 201       $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
 202       return [ $evt, $self->_stream_from_array(
 203         $emit->next, { type => 'CLOSE', name => $evt->{name} }
 204       ) ];
 205     }
 206     my $coll = &$coll_proto;
 207     return [ $coll->[0], $self->_stream_concat($emit, $coll->[1]) ];
 208   };
 209 }
 210
 211 sub append_content {
 212   my ($self, $events) = @_;
 213   my $coll_proto = $self->collect({ passthrough => 1, content => 1 });
 214   sub {
 215     my ($evt) = @_;
 216     my $emit = $self->_stream_from_proto($events);
 217     if ($evt->{is_in_place_close}) {
 218       $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
 219       return [ $evt, $self->_stream_from_array(
 220         $emit->next, { type => 'CLOSE', name => $evt->{name} }
 221       ) ];
 222     }
 223     my $coll = &$coll_proto;
 224     return [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
 225   };
 226 }
 227
 228 sub replace {
 229   my ($self, $replace_with, $options) = @_;
 230   my $coll_proto = $self->collect($options);
 231   sub {
 232     my ($evt, $stream) = @_;
 233     my $emit = $self->_stream_from_proto($replace_with);
 234     my $coll = &$coll_proto;
 235     # if we're replacing the contents of an in place close
 236     # then we need to handle that here
 237     if ($options->{content}
 238         && ref($coll) eq 'HASH'
 239         && $coll->{is_in_place_close}
 240       ) {
 241       my $close = $stream->next;
 242       # shallow copy and nuke in place and raw (to force smart print)
 243       $_ = { %$_ }, delete @{$_}{qw(is_in_place_close raw)} for ($coll, $close);
 244       $emit = $self->_stream_concat(
 245                 $emit,
 246                 $self->_stream_from_array($close),
 247               );
 248     }
 249     # For a straightforward replace operation we can, in fact, do the emit
 250     # -before- the collect, and my first cut did so. However in order to
 251     # use the captured content in generating the new content, we need
 252     # the collect stage to happen first - and it seems highly unlikely
 253     # that in normal operation the collect phase will take long enough
 254     # for the difference to be noticeable
 255     return
 256       ($coll
 257         ? (ref $coll eq 'ARRAY' # [ event, stream ]
 258             ? [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ]
 259             : (ref $coll eq 'HASH' # event or stream?
 260                  ? [ $coll, $emit ]
 261                  : $self->_stream_concat($coll, $emit))
 262           )
 263         : $emit
 264       );
 265   };
 266 }
 267
 268 sub replace_content {
 269   my ($self, $replace_with, $options) = @_;
 270   $self->replace($replace_with, { %{$options||{}}, content => 1 })
 271 }
 272
 273 sub repeat {
 274   my ($self, $repeat_for, $options) = @_;
 275   $options->{into} = \my @into;
 276   my @between;
 277   my $repeat_between = delete $options->{repeat_between};
 278   if ($repeat_between) {
 279     $options->{filter} = sub {
 280       $_->select($repeat_between)->collect({ into => \@between })
 281     }
 282   }
 283   my $repeater = sub {
 284     my $s = $self->_stream_from_proto($repeat_for);
 285     # We have to test $repeat_between not @between here because
 286     # at the point we're constructing our return stream @between
 287     # hasn't been populated yet - but we can test @between in the
 288     # map routine because it has been by then and that saves us doing
 289     # the extra stream construction if we don't need it.
 290     $self->_flatten_stream_of_streams(do {
 291       if ($repeat_between) {
 292         $s->map(sub {
 293               local $_ = $self->_stream_from_array(@into);
 294               (@between && $s->peek)
 295                 ? $self->_stream_concat(
 296                     $_[0]->($_), $self->_stream_from_array(@between)
 297                   )
 298                 : $_[0]->($_)
 299             })
 300       } else {
 301         $s->map(sub {
 302               local $_ = $self->_stream_from_array(@into);
 303               $_[0]->($_)
 304           })
 305       }
 306     })
 307   };
 308   $self->replace($repeater, $options);
 309 }
 310
 311 sub repeat_content {
 312   my ($self, $repeat_for, $options) = @_;
 313   $self->repeat($repeat_for, { %{$options||{}}, content => 1 })
 314 }
 315
 316 sub select {
 317   my ($self, $selector) = @_;
 318   return HTML::Zoom::TransformBuilder->new({
 319     zconfig => $self->_zconfig,
 320     selector => $selector,
 321     filters => [],
 322     proto => $self,
 323   });
 324 }
 325
 326 1;
 327
 328 =head1 NAME
 329
 330 HTML::Zoom::FilterBuilder - Add Filters to a Stream
 331
 332 =head1 SYNOPSIS
 333
 334 Create an L<HTML::Zoom> instance:
 335
 336   use HTML::Zoom;
 337   my $root = HTML::Zoom
 338       ->from_html(<<MAIN);
 339   <html>
 340     <head>
 341       <title>Default Title</title>
 342     </head>
 343     <body bad_attr='junk'>
 344       Default Content
 345     </body>
 346   </html>
 347   MAIN
 348
 349 Create a new attribute on the  C<body> tag:
 350
 351   $root = $root
 352     ->select('body')
 353     ->set_attribute(class=>'main');
 354
 355 Add a extra value to an existing attribute:
 356
 357   $root = $root
 358     ->select('body')
 359     ->add_to_attribute(class=>'one-column');
 360
 361 Set the content of the C<title> tag:
 362
 363   $root = $root
 364     ->select('title')
 365     ->replace_content('Hello World');
 366
 367 Set content from another L<HTML::Zoom> instance:
 368
 369   my $body = HTML::Zoom
 370       ->from_html(<<BODY);
 371   <div id="stuff">
 372       <p>Well Now</p>
 373       <p id="p2">Is the Time</p>
 374   </div>
 375   BODY
 376
 377   $root = $root
 378     ->select('body')
 379     ->replace_content($body);
 380
 381 Set an attribute on multiple matches:
 382
 383   $root = $root
 384     ->select('p')
 385     ->set_attribute(class=>'para');
 386
 387 Remove an attribute:
 388
 389   $root = $root
 390     ->select('body')
 391     ->remove_attribute('bad_attr');
 392
 393 will produce:
 394
 395 =begin testinfo
 396
 397   my $output = $root->to_html;
 398   my $expect = <<HTML;
 399
 400 =end testinfo
 401
 402   <html>
 403     <head>
 404       <title>Hello World</title>
 405     </head>
 406     <body class="main one-column"><div id="stuff">
 407       <p class="para">Well Now</p>
 408       <p id="p2" class="para">Is the Time</p>
 409   </div>
 410   </body>
 411   </html>
 412
 413 =begin testinfo
 414
 415   HTML
 416   is($output, $expect, 'Synopsis code works ok');
 417
 418 =end testinfo
 419
 420 =head1 DESCRIPTION
 421
 422 Given a L<HTML::Zoom> stream, provide methods to apply filters which
 423 alter the content of that stream.
 424
 425 =head1 METHODS
 426
 427 This class defines the following public API
 428
 429 =head2 set_attribute
 430
 431 Sets an attribute of a given name to a given value for all matching selections.
 432
 433     $html_zoom
 434       ->select('p')
 435       ->set_attribute(class=>'paragraph')
 436       ->select('div')
 437       ->set_attribute({name=>'class', value=>'divider'});
 438
 439
 440 Overrides existing values, if such exist.  When multiple L</set_attribute>
 441 calls are made against the same or overlapping selection sets, the final
 442 call wins.
 443
 444 =head2 add_to_attribute
 445
 446 Adds a value to an existing attribute, or creates one if the attribute does not
 447 yet exist.  You may call this method with either an Array or HashRef of Args.
 448
 449 Here's the 'long form' HashRef:
 450
 451     $html_zoom
 452       ->select('p')
 453       ->set_attribute(class=>'paragraph')
 454       ->then
 455       ->add_to_attribute({name=>'class', value=>'divider'});
 456
 457 And the exact same effect using the 'short form' Array:
 458
 459     $html_zoom
 460       ->select('p')
 461       ->set_attribute(class=>'paragraph')
 462       ->then
 463       ->add_to_attribute(class=>'divider');
 464
 465 Attributes with more than one value will have a dividing space.
 466
 467 =head2 remove_attribute
 468
 469 Removes an attribute and all its values.
 470
 471     $html_zoom
 472       ->select('p')
 473       ->set_attribute(class=>'paragraph')
 474       ->then
 475       ->remove_attribute('class');
 476
 477 Removes attributes from the original stream or events already added.
 478
 479 =head2 collect
 480
 481 Collects and extracts results of L<HTML::Zoom/select>.  It takes the following
 482 optional common options as hash reference.
 483
 484 =over
 485
 486 =item into [ARRAY REFERENCE]
 487
 488 Where to save collected events (selected elements).
 489
 490     $z1->select('#main-content')
 491        ->collect({ into => \@body })
 492        ->run;
 493     $z2->select('#main-content')
 494        ->replace(\@body)
 495        ->memoize;
 496
 497 =item filter [CODE]
 498
 499 Run filter on collected elements (locally setting $_ to stream, and passing
 500 stream as an argument to given code reference).  Filtered stream would be
 501 returned.
 502
 503     $z->select('.outer')
 504       ->collect({
 505         filter => sub { $_->select('.inner')->replace_content('bar!') },
 506         passthrough => 1,
 507       })
 508
 509 It can be used to further filter selection.  For example
 510
 511     $z->select('tr')
 512       ->collect({
 513         filter => sub { $_->select('td') },
 514         passthrough => 1,
 515       })
 516
 517 is equivalent to (not implemented yet) descendant selector combination, i.e.
 518
 519     $z->select('tr td')
 520
 521 =item passthrough [BOOLEAN]
 522
 523 Extract copy of elements; the stream is unchanged (it does not remove collected
 524 elements).  For example without 'passthrough'
 525
 526     HTML::Zoom->from_html('<foo><bar /></foo>')
 527       ->select('foo')
 528       ->collect({ content => 1 })
 529       ->to_html
 530
 531 returns '<foo></foo>', while with C<passthrough> option
 532
 533     HTML::Zoom->from_html('<foo><bar /></foo>')
 534       ->select('foo')
 535       ->collect({ content => 1, passthough => 1 })
 536       ->to_html
 537
 538 returns '<foo><bar /></foo>'.
 539
 540 =item content [BOOLEAN]
 541
 542 Collect content of the element, and not the element itself.
 543
 544 For example
 545
 546     HTML::Zoom->from_html('<h1>Title</h1><p>foo</p>')
 547       ->select('h1')
 548       ->collect
 549       ->to_html
 550
 551 would return '<p>foo</p>', while
 552
 553     HTML::Zoom->from_html('<h1>Title</h1><p>foo</p>')
 554       ->select('h1')
 555       ->collect({ content => 1 })
 556       ->to_html
 557
 558 would return '<h1></h1><p>foo</p>'.
 559
 560 See also L</collect_content>.
 561
 562 =item flush_before [BOOLEAN]
 563
 564 Generate C<flush> event before collecting, to ensure that the HTML generated up
 565 to selected element being collected is flushed throught to the browser.  Usually
 566 used in L</repeat> or L</repeat_content>.
 567
 568 =back
 569
 570 =head2 collect_content
 571
 572 Collects contents of L<HTML::Zoom/select> result.
 573
 574     HTML::Zoom->from_file($foo)
 575               ->select('#main-content')
 576               ->collect_content({ into => \@foo_body })
 577               ->run;
 578     $z->select('#foo')
 579       ->replace_content(\@foo_body)
 580       ->memoize;
 581
 582 Equivalent to running L</collect> with C<content> option set.
 583
 584 =head2 add_before
 585
 586 Given a L<HTML::Zoom/select> result, add given content (which might be string,
 587 array or another L<HTML::Zoom> object) before it.
 588
 589     $html_zoom
 590         ->select('input[name="foo"]')
 591         ->add_before(\ '<span class="warning">required field</span>');
 592
 593 =head2 add_after
 594
 595 Like L</add_before>, only after L<HTML::Zoom/select> result.
 596
 597     $html_zoom
 598         ->select('p')
 599         ->add_after("\n\n");
 600
 601 You can add zoom events directly
 602
 603     $html_zoom
 604         ->select('p')
 605         ->add_after([ { type => 'TEXT', raw => 'O HAI' } ]);
 606
 607 =head2 prepend_content
 608
 609 Similar to add_before, but adds the content to the match.
 610
 611   HTML::Zoom
 612     ->from_html(q[<p>World</p>])
 613     ->select('p')
 614     ->prepend_content("Hello ")
 615     ->to_html
 616
 617   ## <p>Hello World</p>
 618
 619 Acceptable values are strings, scalar refs and L<HTML::Zoom> objects
 620
 621 =head2 append_content
 622
 623 Similar to add_after, but adds the content to the match.
 624
 625   HTML::Zoom
 626     ->from_html(q[<p>Hello </p>])
 627     ->select('p')
 628     ->prepend_content("World")
 629     ->to_html
 630
 631   ## <p>Hello World</p>
 632
 633 Acceptable values are strings, scalar refs and L<HTML::Zoom> objects
 634
 635 =head2 replace
 636
 637 Given a L<HTML::Zoom/select> result, replace it with a string, array or another
 638 L<HTML::Zoom> object.  It takes the same optional common options as L</collect>
 639 (via hash reference).
 640
 641 =head2 replace_content
 642
 643 Given a L<HTML::Zoom/select> result, replace the content with a string, array
 644 or another L<HTML::Zoom> object.
 645
 646     $html_zoom
 647       ->select('title, #greeting')
 648       ->replace_content('Hello world!');
 649
 650 =head2 repeat
 651
 652 For a given selection, repeat over transformations, typically for the purposes
 653 of populating lists.  Takes either an array of anonymous subroutines or a zoom-
 654 able object consisting of transformation.
 655
 656 Example of array reference style (when it doesn't matter that all iterations are
 657 pre-generated)
 658
 659     $zoom->select('table')->repeat([
 660       map {
 661         my $elem = $_;
 662         sub {
 663           $_->select('td')->replace_content($e);
 664         }
 665       } @list
 666     ]);
 667
 668 Subroutines would be run with $_ localized to result of L<HTML::Zoom/select> (of
 669 collected elements), and with said result passed as parameter to subroutine.
 670
 671 You might want to use CodeStream when you don't have all elements upfront
 672
 673     $zoom->select('.contents')->repeat(sub {
 674       HTML::Zoom::CodeStream->new({
 675         code => sub {
 676           while (my $line = $fh->getline) {
 677             return sub {
 678               $_->select('.lno')->replace_content($fh->input_line_number)
 679                 ->select('.line')->replace_content($line)
 680             }
 681           }
 682           return
 683         },
 684       })
 685     });
 686
 687 In addition to common options as in L</collect>, it also supports:
 688
 689 =over
 690
 691 =item repeat_between [SELECTOR]
 692
 693 Selects object to be repeated between items.  In the case of array this object
 694 is put between elements, in case of iterator it is put between results of
 695 subsequent iterations, in the case of streamable it is put between events
 696 (->to_stream->next).
 697
 698 See documentation for L</repeat_content>
 699
 700 =back
 701
 702 =head2 repeat_content
 703
 704 Given a L<HTML::Zoom/select> result, run provided iterator passing content of
 705 this result to this iterator.  Accepts the same options as L</repeat>.
 706
 707 Equivalent to using C<contents> option with L</repeat>.
 708
 709     $html_zoom
 710        ->select('#list')
 711        ->repeat_content(
 712           [
 713              sub {
 714                 $_->select('.name')->replace_content('Matt')
 715                   ->select('.age')->replace_content('26')
 716              },
 717              sub {
 718                 $_->select('.name')->replace_content('Mark')
 719                   ->select('.age')->replace_content('0x29')
 720              },
 721              sub {
 722                 $_->select('.name')->replace_content('Epitaph')
 723                   ->select('.age')->replace_content('<redacted>')
 724              },
 725           ],
 726           { repeat_between => '.between' }
 727        );
 728
 729
 730 =head1 ALSO SEE
 731
 732 L<HTML::Zoom>
 733
 734 =head1 AUTHORS
 735
 736 See L<HTML::Zoom> for authors.
 737
 738 =head1 LICENSE
 739
 740 See L<HTML::Zoom> for the license.
 741
 742 =cut
 743