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   sub { return $self->_stream_from_array(@$events, $_[0]) };
 159 }
 160
 161 sub add_after {
 162   my ($self, $events) = @_;
 163   my $coll_proto = $self->collect({ passthrough => 1 });
 164   sub {
 165     my ($evt) = @_;
 166     my $emit = $self->_stream_from_array(@$events);
 167     my $coll = &$coll_proto;
 168     return ref($coll) eq 'HASH' # single event, no collect
 169       ? [ $coll, $emit ]
 170       : [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
 171   };
 172 }
 173
 174 sub prepend_content {
 175   my ($self, $events) = @_;
 176   sub {
 177     my ($evt) = @_;
 178     if ($evt->{is_in_place_close}) {
 179       $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
 180       return [ $evt, $self->_stream_from_array(
 181         @$events, { type => 'CLOSE', name => $evt->{name} }
 182       ) ];
 183     }
 184     return $self->_stream_from_array($evt, @$events);
 185   };
 186 }
 187
 188 sub append_content {
 189   my ($self, $events) = @_;
 190   my $coll_proto = $self->collect({ passthrough => 1, content => 1 });
 191   sub {
 192     my ($evt) = @_;
 193     if ($evt->{is_in_place_close}) {
 194       $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
 195       return [ $evt, $self->_stream_from_array(
 196         @$events, { type => 'CLOSE', name => $evt->{name} }
 197       ) ];
 198     }
 199     my $coll = &$coll_proto;
 200     my $emit = $self->_stream_from_array(@$events);
 201     return [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
 202   };
 203 }
 204
 205 sub replace {
 206   my ($self, $replace_with, $options) = @_;
 207   my $coll_proto = $self->collect($options);
 208   sub {
 209     my ($evt, $stream) = @_;
 210     my $emit = $self->_stream_from_proto($replace_with);
 211     my $coll = &$coll_proto;
 212     # if we're replacing the contents of an in place close
 213     # then we need to handle that here
 214     if ($options->{content}
 215         && ref($coll) eq 'HASH'
 216         && $coll->{is_in_place_close}
 217       ) {
 218       my $close = $stream->next;
 219       # shallow copy and nuke in place and raw (to force smart print)
 220       $_ = { %$_ }, delete @{$_}{qw(is_in_place_close raw)} for ($coll, $close);
 221       $emit = $self->_stream_concat(
 222                 $emit,
 223                 $self->_stream_from_array($close),
 224               );
 225     }
 226     # For a straightforward replace operation we can, in fact, do the emit
 227     # -before- the collect, and my first cut did so. However in order to
 228     # use the captured content in generating the new content, we need
 229     # the collect stage to happen first - and it seems highly unlikely
 230     # that in normal operation the collect phase will take long enough
 231     # for the difference to be noticeable
 232     return
 233       ($coll
 234         ? (ref $coll eq 'ARRAY' # [ event, stream ]
 235             ? [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ]
 236             : (ref $coll eq 'HASH' # event or stream?
 237                  ? [ $coll, $emit ]
 238                  : $self->_stream_concat($coll, $emit))
 239           )
 240         : $emit
 241       );
 242   };
 243 }
 244
 245 sub replace_content {
 246   my ($self, $replace_with, $options) = @_;
 247   $self->replace($replace_with, { %{$options||{}}, content => 1 })
 248 }
 249
 250 sub repeat {
 251   my ($self, $repeat_for, $options) = @_;
 252   $options->{into} = \my @into;
 253   my @between;
 254   my $repeat_between = delete $options->{repeat_between};
 255   if ($repeat_between) {
 256     $options->{filter} = sub {
 257       $_->select($repeat_between)->collect({ into => \@between })
 258     };
 259   }
 260   my $repeater = sub {
 261     my $s = $self->_stream_from_proto($repeat_for);
 262     # We have to test $repeat_between not @between here because
 263     # at the point we're constructing our return stream @between
 264     # hasn't been populated yet - but we can test @between in the
 265     # map routine because it has been by then and that saves us doing
 266     # the extra stream construction if we don't need it.
 267     $self->_flatten_stream_of_streams(do {
 268       if ($repeat_between) {
 269         $s->map(sub {
 270               local $_ = $self->_stream_from_array(@into);
 271               (@between && $s->peek)
 272                 ? $self->_stream_concat(
 273                     $_[0]->($_), $self->_stream_from_array(@between)
 274                   )
 275                 : $_[0]->($_)
 276             })
 277       } else {
 278         $s->map(sub {
 279               local $_ = $self->_stream_from_array(@into);
 280               $_[0]->($_)
 281           })
 282       }
 283     })
 284   };
 285   $self->replace($repeater, $options);
 286 }
 287
 288 sub repeat_content {
 289   my ($self, $repeat_for, $options) = @_;
 290   $self->repeat($repeat_for, { %{$options||{}}, content => 1 })
 291 }
 292
 293 1;
 294
 295 =head1 NAME
 296
 297 HTML::Zoom::FilterBuilder - Add Filters to a Stream
 298
 299 =head1 SYNOPSIS
 300
 301 Create an L<HTML::Zoom> instance:
 302
 303   use HTML::Zoom;
 304   my $root = HTML::Zoom
 305       ->from_html(<<MAIN);
 306   <html>
 307     <head>
 308       <title>Default Title</title>
 309     </head>
 310     <body bad_attr='junk'>
 311       Default Content
 312     </body>
 313   </html>
 314   MAIN
 315
 316 Create a new attribute on the  C<body> tag:
 317
 318   $root = $root
 319     ->select('body')
 320     ->set_attribute(class=>'main');
 321
 322 Add a extra value to an existing attribute:
 323
 324   $root = $root
 325     ->select('body')
 326     ->add_to_attribute(class=>'one-column');
 327
 328 Set the content of the C<title> tag:
 329
 330   $root = $root
 331     ->select('title')
 332     ->replace_content('Hello World');
 333
 334 Set content from another L<HTML::Zoom> instance:
 335
 336   my $body = HTML::Zoom
 337       ->from_html(<<BODY);
 338   <div id="stuff">
 339       <p>Well Now</p>
 340       <p id="p2">Is the Time</p>
 341   </div>
 342   BODY
 343
 344   $root = $root
 345     ->select('body')
 346     ->replace_content($body);
 347
 348 Set an attribute on multiple matches:
 349
 350   $root = $root
 351     ->select('p')
 352     ->set_attribute(class=>'para');
 353
 354 Remove an attribute:
 355
 356   $root = $root
 357     ->select('body')
 358     ->remove_attribute('bad_attr');
 359
 360 will produce:
 361
 362 =begin testinfo
 363
 364   my $output = $root->to_html;
 365   my $expect = <<HTML;
 366
 367 =end testinfo
 368
 369   <html>
 370     <head>
 371       <title>Hello World</title>
 372     </head>
 373     <body class="main one-column"><div id="stuff">
 374       <p class="para">Well Now</p>
 375       <p id="p2" class="para">Is the Time</p>
 376   </div>
 377   </body>
 378   </html>
 379
 380 =begin testinfo
 381
 382   HTML
 383   is($output, $expect, 'Synopsis code works ok');
 384
 385 =end testinfo
 386
 387 =head1 DESCRIPTION
 388
 389 Given a L<HTML::Zoom> stream, provide methods to apply filters which
 390 alter the content of that stream.
 391
 392 =head1 METHODS
 393
 394 This class defines the following public API
 395
 396 =head2 set_attribute
 397
 398 Sets an attribute of a given name to a given value for all matching selections.
 399
 400     $html_zoom
 401       ->select('p')
 402       ->set_attribute(class=>'paragraph')
 403       ->select('div')
 404       ->set_attribute(name=>'class', value=>'divider');
 405
 406
 407 Overrides existing values, if such exist.  When multiple L</set_attribute>
 408 calls are made against the same or overlapping selection sets, the final
 409 call wins.
 410
 411 =head2 add_to_attribute
 412
 413 Adds a value to an existing attribute, or creates one if the attribute does not
 414 yet exist.
 415
 416     $html_zoom
 417       ->select('p')
 418       ->set_attribute(class=>'paragraph')
 419       ->then
 420       ->add_to_attribute(name=>'class', value=>'divider');
 421
 422 Attributes with more than one value will have a dividing space.
 423
 424 =head2 remove_attribute
 425
 426 Removes an attribute and all its values.
 427
 428     $html_zoom
 429       ->select('p')
 430       ->set_attribute(class=>'paragraph')
 431       ->then
 432       ->remove_attribute('class');
 433
 434 Removes attributes from the original stream or events already added.
 435
 436 =head2 collect
 437
 438 Collects and extracts results of L<HTML::Zoom/select>.  It takes the following
 439 optional common options as hash reference.
 440
 441 =over
 442
 443 =item into [ARRAY REFERENCE]
 444
 445 Where to save collected events (selected elements).
 446
 447     $z1->select('#main-content')
 448        ->collect({ into => \@body })
 449        ->run;
 450     $z2->select('#main-content')
 451        ->replace(\@body)
 452        ->memoize;
 453
 454 =item filter [CODE]
 455
 456 Run filter on collected elements (locally setting $_ to stream, and passing
 457 stream as an argument to given code reference).  Filtered stream would be
 458 returned.
 459
 460     $z->select('.outer')
 461       ->collect({
 462         filter => sub { $_->select('.inner')->replace_content('bar!') },
 463         passthrough => 1,
 464       })
 465
 466 It can be used to further filter selection.  For example
 467
 468     $z->select('tr')
 469       ->collect({
 470         filter => sub { $_->select('td') },
 471         passthrough => 1,
 472       })
 473
 474 is equivalent to (not implemented yet) descendant selector combination, i.e.
 475
 476     $z->select('tr td')
 477
 478 =item passthrough [BOOLEAN]
 479
 480 Extract copy of elements; the stream is unchanged (it does not remove collected
 481 elements).  For example without 'passthrough'
 482
 483     HTML::Zoom->from_html('<foo><bar /></foo>')
 484       ->select('foo')
 485       ->collect({ content => 1 })
 486       ->to_html
 487
 488 returns '<foo></foo>', while with C<passthrough> option
 489
 490     HTML::Zoom->from_html('<foo><bar /></foo>')
 491       ->select('foo')
 492       ->collect({ content => 1, passthough => 1 })
 493       ->to_html
 494
 495 returns '<foo><bar /></foo>'.
 496
 497 =item content [BOOLEAN]
 498
 499 Collect content of the element, and not the element itself.
 500
 501 For example
 502
 503     HTML::Zoom->from_html('<h1>Title</h1><p>foo</p>')
 504       ->select('h1')
 505       ->collect
 506       ->to_html
 507
 508 would return '<p>foo</p>', while
 509
 510     HTML::Zoom->from_html('<h1>Title</h1><p>foo</p>')
 511       ->select('h1')
 512       ->collect({ content => 1 })
 513       ->to_html
 514
 515 would return '<h1></h1><p>foo</p>'.
 516
 517 See also L</collect_content>.
 518
 519 =item flush_before [BOOLEAN]
 520
 521 Generate C<flush> event before collecting, to ensure that the HTML generated up
 522 to selected element being collected is flushed throught to the browser.  Usually
 523 used in L</repeat> or L</repeat_content>.
 524
 525 =back
 526
 527 =head2 collect_content
 528
 529 Collects contents of L<HTML::Zoom/select> result.
 530
 531     HTML::Zoom->from_file($foo)
 532               ->select('#main-content')
 533               ->collect_content({ into => \@foo_body })
 534               ->run;
 535     $z->select('#foo')
 536       ->replace_content(\@foo_body)
 537       ->memoize;
 538
 539 Equivalent to running L</collect> with C<content> option set.
 540
 541 =head2 add_before
 542
 543 Given a L<HTML::Zoom/select> result, add given content (which might be string,
 544 array or another L<HTML::Zoom> object) before it.
 545
 546     $html_zoom
 547         ->select('input[name="foo"]')
 548         ->add_before(\ '<span class="warning">required field</span>');
 549
 550 =head2 add_after
 551
 552 Like L</add_before>, only after L<HTML::Zoom/select> result.
 553
 554     $html_zoom
 555         ->select('p')
 556         ->add_after("\n\n");
 557
 558 You can add zoom events directly
 559
 560     $html_zoom
 561         ->select('p')
 562         ->add_after([ { type => 'TEXT', raw => 'O HAI' } ]);
 563
 564 =head2 prepend_content
 565
 566     TBD
 567
 568 =head2 append_content
 569
 570     TBD
 571
 572 =head2 replace
 573
 574 Given a L<HTML::Zoom/select> result, replace it with a string, array or another
 575 L<HTML::Zoom> object.  It takes the same optional common options as L</collect>
 576 (via hash reference).
 577
 578 =head2 replace_content
 579
 580 Given a L<HTML::Zoom/select> result, replace the content with a string, array
 581 or another L<HTML::Zoom> object.
 582
 583     $html_zoom
 584       ->select('title, #greeting')
 585       ->replace_content('Hello world!');
 586
 587 =head2 repeat
 588
 589     $zoom->select('.item')->repeat(sub {
 590       if (my $row = $db_thing->next) {
 591         return sub { $_->select('.item-name')->replace_content($row->name) }
 592       } else {
 593         return
 594       }
 595     }, { flush_before => 1 });
 596
 597 Run I<$repeat_for>, which should be iterator (code reference) returning
 598 subroutines, reference to array of subroutines, or other zoom-able object
 599 consisting of transformations.  Those subroutines would be run with $_
 600 local-ized to result of L<HTML::Zoom/select> (of collected elements), and with
 601 said result passed as parameter to subroutine.
 602
 603 You might want to use iterator when you don't have all elements upfront
 604
 605     $zoom = $zoom->select('.contents')->repeat(sub {
 606       while (my $line = $fh->getline) {
 607         return sub {
 608           $_->select('.lno')->replace_content($fh->input_line_number)
 609             ->select('.line')->replace_content($line)
 610         }
 611       }
 612       return
 613     });
 614
 615 You might want to use array reference if it doesn't matter that all iterations
 616 are pre-generated
 617
 618     $zoom->select('table')->repeat([
 619       map {
 620         my $elem = $_;
 621         sub {
 622           $_->select('td')->replace_content($e);
 623         }
 624       } @list
 625     ]);
 626
 627 In addition to common options as in L</collect>, it also supports
 628
 629 =over
 630
 631 =item repeat_between [SELECTOR]
 632
 633 Selects object to be repeated between items.  In the case of array this object
 634 is put between elements, in case of iterator it is put between results of
 635 subsequent iterations, in the case of streamable it is put between events
 636 (->to_stream->next).
 637
 638 See documentation for L</repeat_content>
 639
 640 =back
 641
 642 =head2 repeat_content
 643
 644 Given a L<HTML::Zoom/select> result, run provided iterator passing content of
 645 this result to this iterator.  Accepts the same options as L</repeat>.
 646
 647 Equivalent to using C<contents> option with L</repeat>.
 648
 649     $html_zoom
 650        ->select('#list')
 651        ->repeat_content(
 652           [
 653              sub {
 654                 $_->select('.name')->replace_content('Matt')
 655                   ->select('.age')->replace_content('26')
 656              },
 657              sub {
 658                 $_->select('.name')->replace_content('Mark')
 659                   ->select('.age')->replace_content('0x29')
 660              },
 661              sub {
 662                 $_->select('.name')->replace_content('Epitaph')
 663                   ->select('.age')->replace_content('<redacted>')
 664              },
 665           ],
 666           { repeat_between => '.between' }
 667        );
 668
 669
 670 =head1 ALSO SEE
 671
 672 L<HTML::Zoom>
 673
 674 =head1 AUTHORS
 675
 676 See L<HTML::Zoom> for authors.
 677
 678 =head1 LICENSE
 679
 680 See L<HTML::Zoom> for the license.
 681
 682 =cut
 683