add transform_attribute, which runs a coderef on the value of an attribute, and can...

[catagits/HTML-Zoom.git] / lib / HTML / Zoom / FilterBuilder.pm

diff --git a/lib/HTML/Zoom/FilterBuilder.pm b/lib/HTML/Zoom/FilterBuilder.pm
index 92961dc..45b57f2 100644 (file)
--- a/lib/HTML/Zoom/FilterBuilder.pm
+++ b/lib/HTML/Zoom/FilterBuilder.pm
@@ -83,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) =
@@ -433,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