add transform_attribute, which runs a coderef on the value of an attribute, and can...
[catagits/HTML-Zoom.git] / lib / HTML / Zoom / FilterBuilder.pm
index a90a987..45b57f2 100644 (file)
@@ -1,7 +1,6 @@
 package HTML::Zoom::FilterBuilder;
 
-use strict;
-use warnings FATAL => 'all';
+use strictures 1;
 use base qw(HTML::Zoom::SubObject);
 use HTML::Zoom::CodeStream;
 
@@ -84,6 +83,38 @@ sub remove_attribute {
   };
 }
 
+sub transform_attribute {
+  my $self = shift;
+  my ( $name, $code ) = @_ > 1 ? @_ : @{$_[0]}{qw(name code)};
+
+  sub {
+    my $evt = $_[0];
+    my %a = %{ $evt->{attrs} };
+    my @names = @{ $evt->{attr_names} };
+
+    my $existed_before = exists $a{$name};
+    my $v = $code->( $a{$name} );
+    my $deleted =   $existed_before && ! defined $v;
+    my $added   = ! $existed_before &&   defined $v;
+    if( $added ) {
+        push @names, $name;
+        $a{$name} = $v;
+    }
+    elsif( $deleted ) {
+        delete $a{$name};
+        @names = grep $_ ne $name, @names;
+    } else {
+        $a{$name} = $v;
+    }
+    +{ %$evt, raw => undef, raw_attrs => undef,
+       attrs => \%a,
+      ( $deleted || $added
+        ? (attr_names => \@names )
+        : () )
+     }
+   };
+}
+
 sub collect {
   my ($self, $options) = @_;
   my ($into, $passthrough, $content, $filter, $flush_before) =
@@ -104,7 +135,20 @@ sub collect {
     my $name = $evt->{name};
     my $depth = 1;
     my $_next = $content ? 'peek' : 'next';
-    $stream = do { local $_ = $stream; $filter->($stream) } if $filter;
+    if ($filter) {
+      if ($content) {
+        $stream = do { local $_ = $stream; $filter->($stream) };
+      } else {
+        $stream = do {
+          local $_ = $self->_stream_concat(
+                       $self->_stream_from_array($evt),
+                       $stream,
+                     );
+          $filter->($_);
+        };
+        $evt = $stream->next;
+      }
+    }
     my $collector = $self->_stream_from_code(sub {
       return unless $stream;
       while (my ($evt) = $stream->$_next) {
@@ -421,6 +465,20 @@ Removes an attribute and all its values.
 
 Removes attributes from the original stream or events already added.
 
+=head2 transform_attribute
+
+Transforms (or creates or deletes) an attribute by running the passed
+coderef on it.  If the coderef returns nothing, the attribute is
+removed.
+
+    $html_zoom
+      ->select('a')
+      ->transform_attribute( href => sub {
+            ( my $a = shift ) =~ s/localhost/example.com/;
+            return $a;
+          },
+        );
+
 =head2 collect
 
 Collects and extracts results of L<HTML::Zoom/select>.  It takes the following