X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FHTML%2FZoom%2FFilterBuilder.pm;h=5c79584e82a661690ce0a7bcafe0008df3bc727e;hb=5fa3d10f24e0a9aeaa77e5c7b1a22e6339959dd6;hp=a90a987aaea626450fe067725ad06f00fcc0d91a;hpb=ac3acd87cf286ac9be7fe0969e71f1fe1beccfe3;p=catagits%2FHTML-Zoom.git

diff --git a/lib/HTML/Zoom/FilterBuilder.pm b/lib/HTML/Zoom/FilterBuilder.pm
index a90a987..5c79584 100644
--- a/lib/HTML/Zoom/FilterBuilder.pm
+++ b/lib/HTML/Zoom/FilterBuilder.pm
@@ -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;
 
@@ -25,47 +24,57 @@ sub _flatten_stream_of_streams {
   shift->_zconfig->stream_utils->flatten_stream_of_streams(@_)
 }
 
+sub set_attr { shift->set_attribute(@_); }
+
 sub set_attribute {
   my $self = shift;
-  my ($name, $value) = $self->_parse_attribute_args(@_);
+  my $attr = $self->_parse_attribute_args(@_);
   sub {
     my $a = (my $evt = $_[0])->{attrs};
-    my $e = exists $a->{$name};
+    my @kadd = grep {!exists $a->{$_}} keys %$attr;
     +{ %$evt, raw => undef, raw_attrs => undef,
-       attrs => { %$a, $name => $value },
-      ($e # add to name list if not present
-        ? ()
-        : (attr_names => [ @{$evt->{attr_names}}, $name ]))
+       attrs => { %$a, %$attr },
+       @kadd ? (attr_names => [ @{$evt->{attr_names}}, @kadd ]) : ()
      }
    };
 }
 
 sub _parse_attribute_args {
   my $self = shift;
-  # allow ->add_to_attribute(name => 'value')
-  #    or ->add_to_attribute({ name => 'name', value => 'value' })
-  my ($name, $value) = @_ > 1 ? @_ : @{$_[0]}{qw(name value)};
-  return ($name, $self->_zconfig->parser->html_escape($value));
+
+  warn "WARNING: Long form arg (name => 'class', value => 'x') is deprecated. This may not do what you originally intended..."
+    if(@_ == 1 && $_[0]->{'name'} && $_[0]->{'value'});
+    
+  my $opts = ref($_[0]) eq 'HASH' ? $_[0] : {$_[0] => $_[1]};
+  for (values %{$opts}) { $self->_zconfig->parser->html_escape($_); }
+  return $opts;
 }
 
 sub add_attribute {
     die "renamed to add_to_attribute. killing this entirely for 1.0";
 }
 
+sub add_class { shift->add_to_attribute('class',@_) }
+
+sub remove_class { shift->remove_attribute('class',@_) }
+
+sub set_class { shift->set_attribute('class',@_) }
+
+sub set_id { shift->set_attribute('id',@_) }
+
 sub add_to_attribute {
   my $self = shift;
-  my ($name, $value) = $self->_parse_attribute_args(@_);
+  my $attr = $self->_parse_attribute_args(@_);
   sub {
     my $a = (my $evt = $_[0])->{attrs};
-    my $e = exists $a->{$name};
+    my @kadd = grep {!exists $a->{$_}} keys %$attr;
     +{ %$evt, raw => undef, raw_attrs => undef,
        attrs => {
          %$a,
-         $name => join(' ', ($e ? $a->{$name} : ()), $value)
+         map {$_ => join(' ', (exists $a->{$_} ? $a->{$_} : ()), $attr->{$_}) } 
+          keys %$attr
       },
-      ($e # add to name list if not present
-        ? ()
-        : (attr_names => [ @{$evt->{attr_names}}, $name ]))
+      @kadd ? (attr_names => [ @{$evt->{attr_names}}, @kadd ]) : ()
     }
   };
 }
@@ -84,6 +93,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 +145,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) {
@@ -143,7 +197,21 @@ sub collect_content {
 
 sub add_before {
   my ($self, $events) = @_;
-  sub { return $self->_stream_from_array(@$events, $_[0]) };
+  my $coll_proto = $self->collect({ passthrough => 1 });
+  sub {
+    my $emit = $self->_stream_from_proto($events);
+    my $coll = &$coll_proto;
+    if($coll) {
+      if(ref $coll eq 'ARRAY') {
+        my $firstbit = $self->_stream_from_proto([$coll->[0]]);
+        return $self->_stream_concat($emit, $firstbit, $coll->[1]);
+      } elsif(ref $coll eq 'HASH') {
+        return [$emit, $coll];
+      } else {
+        return $self->_stream_concat($emit, $coll);
+      }
+    } else { return $emit }
+  }
 }
 
 sub add_after {
@@ -151,7 +219,7 @@ sub add_after {
   my $coll_proto = $self->collect({ passthrough => 1 });
   sub {
     my ($evt) = @_;
-    my $emit = $self->_stream_from_array(@$events);
+    my $emit = $self->_stream_from_proto($events);
     my $coll = &$coll_proto;
     return ref($coll) eq 'HASH' # single event, no collect
       ? [ $coll, $emit ]
@@ -161,15 +229,18 @@ sub add_after {
 
 sub prepend_content {
   my ($self, $events) = @_;
+  my $coll_proto = $self->collect({ passthrough => 1, content => 1 });
   sub {
     my ($evt) = @_;
+    my $emit = $self->_stream_from_proto($events);
     if ($evt->{is_in_place_close}) {
       $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
       return [ $evt, $self->_stream_from_array(
-        @$events, { type => 'CLOSE', name => $evt->{name} }
+        $emit->next, { type => 'CLOSE', name => $evt->{name} }
       ) ];
     }
-    return $self->_stream_from_array($evt, @$events);
+    my $coll = &$coll_proto;
+    return [ $coll->[0], $self->_stream_concat($emit, $coll->[1]) ];
   };
 }
 
@@ -178,14 +249,14 @@ sub append_content {
   my $coll_proto = $self->collect({ passthrough => 1, content => 1 });
   sub {
     my ($evt) = @_;
+    my $emit = $self->_stream_from_proto($events);
     if ($evt->{is_in_place_close}) {
       $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
       return [ $evt, $self->_stream_from_array(
-        @$events, { type => 'CLOSE', name => $evt->{name} }
+        $emit->next, { type => 'CLOSE', name => $evt->{name} }
       ) ];
     }
     my $coll = &$coll_proto;
-    my $emit = $self->_stream_from_array(@$events);
     return [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
   };
 }
@@ -243,7 +314,7 @@ sub repeat {
   if ($repeat_between) {
     $options->{filter} = sub {
       $_->select($repeat_between)->collect({ into => \@between })
-    };
+    }
   }
   my $repeater = sub {
     my $s = $self->_stream_from_proto($repeat_for);
@@ -389,8 +460,7 @@ Sets an attribute of a given name to a given value for all matching selections.
       ->select('p')
       ->set_attribute(class=>'paragraph')
       ->select('div')
-      ->set_attribute(name=>'class', value=>'divider');
-
+      ->set_attribute({name=>'class', value=>'divider'});
 
 Overrides existing values, if such exist.  When multiple L</set_attribute>
 calls are made against the same or overlapping selection sets, the final
@@ -399,13 +469,13 @@ call wins.
 =head2 add_to_attribute
 
 Adds a value to an existing attribute, or creates one if the attribute does not
-yet exist.
+yet exist.  You may call this method with either an Array or HashRef of Args.
 
     $html_zoom
       ->select('p')
-      ->set_attribute(class=>'paragraph')
+      ->set_attribute({class => 'paragraph', name => 'test'})
       ->then
-      ->add_to_attribute(name=>'class', value=>'divider');
+      ->add_to_attribute(class=>'divider');
 
 Attributes with more than one value will have a dividing space.
 
@@ -421,6 +491,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
@@ -551,11 +635,31 @@ You can add zoom events directly
 
 =head2 prepend_content
 
-    TBD
+Similar to add_before, but adds the content to the match.
+
+  HTML::Zoom
+    ->from_html(q[<p>World</p>])
+    ->select('p')
+    ->prepend_content("Hello ")
+    ->to_html
+    
+  ## <p>Hello World</p>
+  
+Acceptable values are strings, scalar refs and L<HTML::Zoom> objects
 
 =head2 append_content
 
-    TBD
+Similar to add_after, but adds the content to the match.
+
+  HTML::Zoom
+    ->from_html(q[<p>Hello </p>])
+    ->select('p')
+    ->prepend_content("World")
+    ->to_html
+    
+  ## <p>Hello World</p>
+
+Acceptable values are strings, scalar refs and L<HTML::Zoom> objects
 
 =head2 replace
 
@@ -574,34 +678,12 @@ or another L<HTML::Zoom> object.
 
 =head2 repeat
 
-    $zoom->select('.item')->repeat(sub {
-      if (my $row = $db_thing->next) {
-        return sub { $_->select('.item-name')->replace_content($row->name) }
-      } else {
-        return
-      }
-    }, { flush_before => 1 });
-
-Run I<$repeat_for>, which should be iterator (code reference) returning
-subroutines, reference to array of subroutines, or other zoom-able object
-consisting of transformations.  Those subroutines would be run with $_
-local-ized to result of L<HTML::Zoom/select> (of collected elements), and with
-said result passed as parameter to subroutine.
-
-You might want to use iterator when you don't have all elements upfront
+For a given selection, repeat over transformations, typically for the purposes
+of populating lists.  Takes either an array of anonymous subroutines or a zoom-
+able object consisting of transformation.
 
-    $zoom = $zoom->select('.contents')->repeat(sub {
-      while (my $line = $fh->getline) {
-        return sub {
-          $_->select('.lno')->replace_content($fh->input_line_number)
-            ->select('.line')->replace_content($line)
-        }
-      }
-      return
-    });
-
-You might want to use array reference if it doesn't matter that all iterations
-are pre-generated
+Example of array reference style (when it doesn't matter that all iterations are
+pre-generated)
 
     $zoom->select('table')->repeat([
       map {
@@ -611,8 +693,27 @@ are pre-generated
         }
       } @list
     ]);
+    
+Subroutines would be run with $_ localized to result of L<HTML::Zoom/select> (of
+collected elements), and with said result passed as parameter to subroutine.
+
+You might want to use CodeStream when you don't have all elements upfront
+
+    $zoom->select('.contents')->repeat(sub {
+      HTML::Zoom::CodeStream->new({
+        code => sub {
+          while (my $line = $fh->getline) {
+            return sub {
+              $_->select('.lno')->replace_content($fh->input_line_number)
+                ->select('.line')->replace_content($line)
+            }
+          }
+          return
+        },
+      })
+    });
 
-In addition to common options as in L</collect>, it also supports
+In addition to common options as in L</collect>, it also supports:
 
 =over