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