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 1;
 317
 318 =head1 NAME
 319
 320 HTML::Zoom::FilterBuilder - Add Filters to a Stream
 321
 322 =head1 SYNOPSIS
 323
 324 Create an L<HTML::Zoom> instance:
 325
 326   use HTML::Zoom;
 327   my $root = HTML::Zoom
 328       ->from_html(<<MAIN);
 329   <html>
 330     <head>
 331       <title>Default Title</title>
 332     </head>
 333     <body bad_attr='junk'>
 334       Default Content
 335     </body>
 336   </html>
 337   MAIN
 338
 339 Create a new attribute on the  C<body> tag:
 340
 341   $root = $root
 342     ->select('body')
 343     ->set_attribute(class=>'main');
 344
 345 Add a extra value to an existing attribute:
 346
 347   $root = $root
 348     ->select('body')
 349     ->add_to_attribute(class=>'one-column');
 350
 351 Set the content of the C<title> tag:
 352
 353   $root = $root
 354     ->select('title')
 355     ->replace_content('Hello World');
 356
 357 Set content from another L<HTML::Zoom> instance:
 358
 359   my $body = HTML::Zoom
 360       ->from_html(<<BODY);
 361   <div id="stuff">
 362       <p>Well Now</p>
 363       <p id="p2">Is the Time</p>
 364   </div>
 365   BODY
 366
 367   $root = $root
 368     ->select('body')
 369     ->replace_content($body);
 370
 371 Set an attribute on multiple matches:
 372
 373   $root = $root
 374     ->select('p')
 375     ->set_attribute(class=>'para');
 376
 377 Remove an attribute:
 378
 379   $root = $root
 380     ->select('body')
 381     ->remove_attribute('bad_attr');
 382
 383 will produce:
 384
 385 =begin testinfo
 386
 387   my $output = $root->to_html;
 388   my $expect = <<HTML;
 389
 390 =end testinfo
 391
 392   <html>
 393     <head>
 394       <title>Hello World</title>
 395     </head>
 396     <body class="main one-column"><div id="stuff">
 397       <p class="para">Well Now</p>
 398       <p id="p2" class="para">Is the Time</p>
 399   </div>
 400   </body>
 401   </html>
 402
 403 =begin testinfo
 404
 405   HTML
 406   is($output, $expect, 'Synopsis code works ok');
 407
 408 =end testinfo
 409
 410 =head1 DESCRIPTION
 411
 412 Given a L<HTML::Zoom> stream, provide methods to apply filters which
 413 alter the content of that stream.
 414
 415 =head1 METHODS
 416
 417 This class defines the following public API
 418
 419 =head2 set_attribute
 420
 421 Sets an attribute of a given name to a given value for all matching selections.
 422
 423     $html_zoom
 424       ->select('p')
 425       ->set_attribute(class=>'paragraph')
 426       ->select('div')
 427       ->set_attribute({name=>'class', value=>'divider'});
 428
 429
 430 Overrides existing values, if such exist.  When multiple L</set_attribute>
 431 calls are made against the same or overlapping selection sets, the final
 432 call wins.
 433
 434 =head2 add_to_attribute
 435
 436 Adds a value to an existing attribute, or creates one if the attribute does not
 437 yet exist.  You may call this method with either an Array or HashRef of Args.
 438
 439 Here's the 'long form' HashRef:
 440
 441     $html_zoom
 442       ->select('p')
 443       ->set_attribute(class=>'paragraph')
 444       ->then
 445       ->add_to_attribute({name=>'class', value=>'divider'});
 446
 447 And the exact same effect using the 'short form' Array:
 448
 449     $html_zoom
 450       ->select('p')
 451       ->set_attribute(class=>'paragraph')
 452       ->then
 453       ->add_to_attribute(class=>'divider');
 454
 455 Attributes with more than one value will have a dividing space.
 456
 457 =head2 remove_attribute
 458
 459 Removes an attribute and all its values.
 460
 461     $html_zoom
 462       ->select('p')
 463       ->set_attribute(class=>'paragraph')
 464       ->then
 465       ->remove_attribute('class');
 466
 467 Removes attributes from the original stream or events already added.
 468
 469 =head2 collect
 470
 471 Collects and extracts results of L<HTML::Zoom/select>.  It takes the following
 472 optional common options as hash reference.
 473
 474 =over
 475
 476 =item into [ARRAY REFERENCE]
 477
 478 Where to save collected events (selected elements).
 479
 480     $z1->select('#main-content')
 481        ->collect({ into => \@body })
 482        ->run;
 483     $z2->select('#main-content')
 484        ->replace(\@body)
 485        ->memoize;
 486
 487 =item filter [CODE]
 488
 489 Run filter on collected elements (locally setting $_ to stream, and passing
 490 stream as an argument to given code reference).  Filtered stream would be
 491 returned.
 492
 493     $z->select('.outer')
 494       ->collect({
 495         filter => sub { $_->select('.inner')->replace_content('bar!') },
 496         passthrough => 1,
 497       })
 498
 499 It can be used to further filter selection.  For example
 500
 501     $z->select('tr')
 502       ->collect({
 503         filter => sub { $_->select('td') },
 504         passthrough => 1,
 505       })
 506
 507 is equivalent to (not implemented yet) descendant selector combination, i.e.
 508
 509     $z->select('tr td')
 510
 511 =item passthrough [BOOLEAN]
 512
 513 Extract copy of elements; the stream is unchanged (it does not remove collected
 514 elements).  For example without 'passthrough'
 515
 516     HTML::Zoom->from_html('<foo><bar /></foo>')
 517       ->select('foo')
 518       ->collect({ content => 1 })
 519       ->to_html
 520
 521 returns '<foo></foo>', while with C<passthrough> option
 522
 523     HTML::Zoom->from_html('<foo><bar /></foo>')
 524       ->select('foo')
 525       ->collect({ content => 1, passthough => 1 })
 526       ->to_html
 527
 528 returns '<foo><bar /></foo>'.
 529
 530 =item content [BOOLEAN]
 531
 532 Collect content of the element, and not the element itself.
 533
 534 For example
 535
 536     HTML::Zoom->from_html('<h1>Title</h1><p>foo</p>')
 537       ->select('h1')
 538       ->collect
 539       ->to_html
 540
 541 would return '<p>foo</p>', while
 542
 543     HTML::Zoom->from_html('<h1>Title</h1><p>foo</p>')
 544       ->select('h1')
 545       ->collect({ content => 1 })
 546       ->to_html
 547
 548 would return '<h1></h1><p>foo</p>'.
 549
 550 See also L</collect_content>.
 551
 552 =item flush_before [BOOLEAN]
 553
 554 Generate C<flush> event before collecting, to ensure that the HTML generated up
 555 to selected element being collected is flushed throught to the browser.  Usually
 556 used in L</repeat> or L</repeat_content>.
 557
 558 =back
 559
 560 =head2 collect_content
 561
 562 Collects contents of L<HTML::Zoom/select> result.
 563
 564     HTML::Zoom->from_file($foo)
 565               ->select('#main-content')
 566               ->collect_content({ into => \@foo_body })
 567               ->run;
 568     $z->select('#foo')
 569       ->replace_content(\@foo_body)
 570       ->memoize;
 571
 572 Equivalent to running L</collect> with C<content> option set.
 573
 574 =head2 add_before
 575
 576 Given a L<HTML::Zoom/select> result, add given content (which might be string,
 577 array or another L<HTML::Zoom> object) before it.
 578
 579     $html_zoom
 580         ->select('input[name="foo"]')
 581         ->add_before(\ '<span class="warning">required field</span>');
 582
 583 =head2 add_after
 584
 585 Like L</add_before>, only after L<HTML::Zoom/select> result.
 586
 587     $html_zoom
 588         ->select('p')
 589         ->add_after("\n\n");
 590
 591 You can add zoom events directly
 592
 593     $html_zoom
 594         ->select('p')
 595         ->add_after([ { type => 'TEXT', raw => 'O HAI' } ]);
 596
 597 =head2 prepend_content
 598
 599 Similar to add_before, but adds the content to the match.
 600
 601   HTML::Zoom
 602     ->from_html(q[<p>World</p>])
 603     ->select('p')
 604     ->prepend_content("Hello ")
 605     ->to_html
 606
 607   ## <p>Hello World</p>
 608
 609 Acceptable values are strings, scalar refs and L<HTML::Zoom> objects
 610
 611 =head2 append_content
 612
 613 Similar to add_after, but adds the content to the match.
 614
 615   HTML::Zoom
 616     ->from_html(q[<p>Hello </p>])
 617     ->select('p')
 618     ->prepend_content("World")
 619     ->to_html
 620
 621   ## <p>Hello World</p>
 622
 623 Acceptable values are strings, scalar refs and L<HTML::Zoom> objects
 624
 625 =head2 replace
 626
 627 Given a L<HTML::Zoom/select> result, replace it with a string, array or another
 628 L<HTML::Zoom> object.  It takes the same optional common options as L</collect>
 629 (via hash reference).
 630
 631 =head2 replace_content
 632
 633 Given a L<HTML::Zoom/select> result, replace the content with a string, array
 634 or another L<HTML::Zoom> object.
 635
 636     $html_zoom
 637       ->select('title, #greeting')
 638       ->replace_content('Hello world!');
 639
 640 =head2 repeat
 641
 642 For a given selection, repeat over transformations, typically for the purposes
 643 of populating lists.  Takes either an array of anonymous subroutines or a zoom-
 644 able object consisting of transformation.
 645
 646 Example of array reference style (when it doesn't matter that all iterations are
 647 pre-generated)
 648
 649     $zoom->select('table')->repeat([
 650       map {
 651         my $elem = $_;
 652         sub {
 653           $_->select('td')->replace_content($e);
 654         }
 655       } @list
 656     ]);
 657
 658 Subroutines would be run with $_ localized to result of L<HTML::Zoom/select> (of
 659 collected elements), and with said result passed as parameter to subroutine.
 660
 661 You might want to use CodeStream when you don't have all elements upfront
 662
 663     $zoom->select('.contents')->repeat(sub {
 664       HTML::Zoom::CodeStream->new({
 665         code => sub {
 666           while (my $line = $fh->getline) {
 667             return sub {
 668               $_->select('.lno')->replace_content($fh->input_line_number)
 669                 ->select('.line')->replace_content($line)
 670             }
 671           }
 672           return
 673         },
 674       })
 675     });
 676
 677 In addition to common options as in L</collect>, it also supports:
 678
 679 =over
 680
 681 =item repeat_between [SELECTOR]
 682
 683 Selects object to be repeated between items.  In the case of array this object
 684 is put between elements, in case of iterator it is put between results of
 685 subsequent iterations, in the case of streamable it is put between events
 686 (->to_stream->next).
 687
 688 See documentation for L</repeat_content>
 689
 690 =back
 691
 692 =head2 repeat_content
 693
 694 Given a L<HTML::Zoom/select> result, run provided iterator passing content of
 695 this result to this iterator.  Accepts the same options as L</repeat>.
 696
 697 Equivalent to using C<contents> option with L</repeat>.
 698
 699     $html_zoom
 700        ->select('#list')
 701        ->repeat_content(
 702           [
 703              sub {
 704                 $_->select('.name')->replace_content('Matt')
 705                   ->select('.age')->replace_content('26')
 706              },
 707              sub {
 708                 $_->select('.name')->replace_content('Mark')
 709                   ->select('.age')->replace_content('0x29')
 710              },
 711              sub {
 712                 $_->select('.name')->replace_content('Epitaph')
 713                   ->select('.age')->replace_content('<redacted>')
 714              },
 715           ],
 716           { repeat_between => '.between' }
 717        );
 718
 719
 720 =head1 ALSO SEE
 721
 722 L<HTML::Zoom>
 723
 724 =head1 AUTHORS
 725
 726 See L<HTML::Zoom> for authors.
 727
 728 =head1 LICENSE
 729
 730 See L<HTML::Zoom> for the license.
 731
 732 =cut
 733