lib/HTML/Zoom/FilterBuilder.pm

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