my ($self, $args) = @_;
my ($name, $value) = @{$args}{qw(name value)};
sub {
- my $a = (my $evt = shift)->{attrs};
+ my $a = (my $evt = $_[0])->{attrs};
my $e = exists $a->{$name};
+{ %$evt, raw => undef, raw_attrs => undef,
attrs => { %$a, $name => $value },
my ($self, $args) = @_;
my ($name, $value) = @{$args}{qw(name value)};
sub {
- my $a = (my $evt = shift)->{attrs};
+ my $a = (my $evt = $_[0])->{attrs};
my $e = exists $a->{$name};
+{ %$evt, raw => undef, raw_attrs => undef,
attrs => {
my ($self, $args) = @_;
my $name = $args->{name};
sub {
- my $a = (my $evt = shift)->{attrs};
+ my $a = (my $evt = $_[0])->{attrs};
return $evt unless exists $a->{$name};
$a = { %$a }; delete $a->{$name};
+{ %$evt, raw => undef, raw_attrs => undef,
sub add_before {
my ($self, $events) = @_;
- sub { return $self->_stream_from_array(@$events, shift) };
+ sub { return $self->_stream_from_array(@$events, $_[0]) };
}
sub add_after {
my ($self, $events) = @_;
sub {
- my ($evt, $stream) = @_;
+ my ($evt) = @_;
my $emit = $self->_stream_from_array(@$events);
my $coll = $self->collect({ passthrough => 1 })->(@_);
return ref($coll) eq 'HASH' # single event, no collect
? [ $coll, $emit ]
: [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
};
-}
+}
sub prepend_inside {
my ($self, $events) = @_;
sub {
- my $evt = shift;
+ my ($evt) = @_;
if ($evt->{is_in_place_close}) {
$evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
return [ $evt, $self->_stream_from_array(
};
}
+sub append_inside {
+ my ($self, $events) = @_;
+ sub {
+ my ($evt) = @_;
+ 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} }
+ ) ];
+ }
+ my $coll = $self->collect({ passthrough => 1, inside => 1 })->(@_);
+ my $emit = $self->_stream_from_array(@$events);
+ return [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
+ };
+}
+
sub replace {
my ($self, $events) = @_;
sub {
sub collect {
my ($self, $attrs) = @_;
- my ($into, $passthrough) = @{$attrs}{qw(into passthrough)};
+ my ($into, $passthrough, $inside) = @{$attrs}{qw(into passthrough inside)};
sub {
my ($evt, $stream) = @_;
- push(@$into, $evt) if $into;
+ push(@$into, $evt) if $into && !$inside;
if ($evt->{is_in_place_close}) {
- return $evt if $passthrough;
+ return $evt if $passthrough || $inside;
return;
}
my $name = $evt->{name};
my $depth = 1;
+ my $_next = $inside ? 'peek' : 'next';
my $collector = $self->_stream_from_code(sub {
return unless $stream;
- while (my ($evt) = $stream->next) {
+ while (my ($evt) = $stream->$_next) {
$depth++ if ($evt->{type} eq 'OPEN');
$depth-- if ($evt->{type} eq 'CLOSE');
- push(@$into, $evt) if $into;
unless ($depth) {
undef $stream;
+ return if $inside;
+ push(@$into, $evt) if $into;
return $evt if $passthrough;
return;
}
+ push(@$into, $evt) if $into;
+ $stream->next if $inside;
return $evt if $passthrough;
}
die "Never saw closing </${name}> before end of source";
});
- return $passthrough ? [ $evt, $collector ] : $collector;
+ return ($passthrough||$inside) ? [ $evt, $collector ] : $collector;
};
}
)
}
-(my $expect = $tmpl) =~ s/(?=<div)/O HAI/;
+my ($expect, @ev);
+
+($expect = $tmpl) =~ s/class="main"/class="foo"/;
+
+is(
+ run_for { $_->set_attribute({ name => 'class', value => 'foo' }) },
+ $expect,
+ 'set attribute on existing attribute'
+);
+
+($expect = $tmpl) =~ s/class="main"/class="main" foo="bar"/;
+
+is(
+ run_for { $_->set_attribute({ name => 'foo', value => 'bar' }) },
+ $expect,
+ 'set attribute on non existing attribute'
+);
+
+($expect = $tmpl) =~ s/class="main"/class="main foo"/;
+
+is(
+ run_for { $_->add_attribute({ name => 'class', value => 'foo' }) },
+ $expect,
+ 'add attribute on existing attribute'
+);
+
+($expect = $tmpl) =~ s/class="main"/class="main" foo="bar"/;
+
+is(
+ run_for { $_->add_attribute({ name => 'foo', value => 'bar' }) },
+ $expect,
+ 'add attribute on non existing attribute'
+);
+
+($expect = $tmpl) =~ s/ class="main"//;
+
+is(
+ run_for { $_->remove_attribute({ name => 'class' }) },
+ $expect,
+ 'remove attribute on existing attribute'
+);
+
+is(
+ run_for { $_->remove_attribute({ name => 'foo' }) },
+ $tmpl,
+ 'remove attribute on non existing attribute'
+);
+
+($expect = $tmpl) =~ s/(?=<div)/O HAI/;
my $ohai = [ { type => 'TEXT', raw => 'O HAI' } ];
'replace ok'
);
-my @ev;
+@ev = ();
is(
run_for { $_->collect({ into => \@ev }) },
'collect collected right events'
);
-($expect = $tmpl) =~ s/class="main"/class="foo"/;
-
-is(
- run_for { $_->set_attribute({ name => 'class', value => 'foo' }) },
- $expect,
- 'set attribute on existing attribute'
-);
-
-($expect = $tmpl) =~ s/class="main"/class="main" foo="bar"/;
-
-is(
- run_for { $_->set_attribute({ name => 'foo', value => 'bar' }) },
- $expect,
- 'set attribute on non existing attribute'
-);
-
-($expect = $tmpl) =~ s/class="main"/class="main foo"/;
-
-is(
- run_for { $_->add_attribute({ name => 'class', value => 'foo' }) },
- $expect,
- 'add attribute on existing attribute'
-);
-
-($expect = $tmpl) =~ s/class="main"/class="main" foo="bar"/;
-
-is(
- run_for { $_->add_attribute({ name => 'foo', value => 'bar' }) },
- $expect,
- 'add attribute on non existing attribute'
-);
-
-($expect = $tmpl) =~ s/ class="main"//;
+@ev = ();
is(
- run_for { $_->remove_attribute({ name => 'class' }) },
- $expect,
- 'remove attribute on existing attribute'
+ run_for { $_->collect({ into => \@ev, inside => 1 }) },
+ '<body>
+ <div class="main"></div>
+</body>
+',
+ 'collect w/inside removes correctly'
);
is(
- run_for { $_->remove_attribute({ name => 'foo' }) },
- $tmpl,
- 'remove attribute on non existing attribute'
+ HTML::Zoom::Producer::BuiltIn->html_from_events(\@ev),
+ '
+ <span class="hilight name">Bob</span>
+ <span class="career">Builder</span>
+ <hr />
+ ',
+ 'collect w/inside collects correctly'
);
done_testing;