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