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