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 collect {
+ my ($self, $options) = @_;
+ my ($into, $passthrough, $inside) = @{$options}{qw(into passthrough inside)};
+ sub {
+ my ($evt, $stream) = @_;
+ # We wipe the contents of @$into here so that other actions depending
+ # on this (such as a repeater) can be invoked multiple times easily.
+ # I -suspect- it's better for that state reset to be managed here; if it
+ # ever becomes painful the decision should be revisited
+ if ($into) {
+ @$into = $inside ? () : ($evt);
+ }
+ if ($evt->{is_in_place_close}) {
+ 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) {
+ $depth++ if ($evt->{type} eq 'OPEN');
+ $depth-- if ($evt->{type} eq 'CLOSE');
+ 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||$inside) ? [ $evt, $collector ] : $collector;
+ };
+}
+
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) = @_;
+ my $coll_proto = $self->collect({ passthrough => 1 });
sub {
- my ($evt, $stream) = @_;
+ my ($evt) = @_;
my $emit = $self->_stream_from_array(@$events);
- if ($evt->{is_in_place_close}) {
- return [ $evt, $emit ];
- }
- my ($filtered_evt, $coll) = @{$self->collect(undef, 1)->(@_)};
- return [ $filtered_evt, $self->_stream_concat($coll, $emit) ];
+ my $coll = &$coll_proto;
+ 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 replace {
+sub append_inside {
my ($self, $events) = @_;
+ my $coll_proto = $self->collect({ passthrough => 1, inside => 1 });
sub {
- my ($evt, $stream) = @_;
- my $emit = $self->_stream_from_array(@$events);
+ my ($evt) = @_;
if ($evt->{is_in_place_close}) {
- return $emit
+ $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
+ return [ $evt, $self->_stream_from_array(
+ @$events, { type => 'CLOSE', name => $evt->{name} }
+ ) ];
}
- return $self->_stream_concat($emit, $self->collect->(@_));
+ my $coll = &$coll_proto;
+ my $emit = $self->_stream_from_array(@$events);
+ return [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
};
}
-sub collect {
- my ($self, $into, $passthrough) = @_;
+sub replace {
+ my ($self, $events, $options) = @_;
+ my $coll_proto = $self->collect($options);
sub {
my ($evt, $stream) = @_;
- push(@$into, $evt) if $into;
- if ($evt->{is_in_place_close}) {
- return $evt if $passthrough;
- return;
- }
- my $name = $evt->{name};
- my $depth = 1;
- my $collector = $self->_stream_from_code(sub {
- return unless $stream;
- while (my ($evt) = $stream->next) {
- $depth++ if ($evt->{type} eq 'OPEN');
- $depth-- if ($evt->{type} eq 'CLOSE');
- unless ($depth) {
- undef $stream;
- return $evt if $passthrough;
- return;
- }
- push(@$into, $evt) if $into;
- return $evt if $passthrough;
- }
- die "Never saw closing </${name}> before end of source";
- });
- return $passthrough ? [ $evt, $collector ] : $collector;
+ my $emit = $self->_stream_from_array(@$events);
+ my $coll = &$coll_proto;
+ # For a straightforward replace operation we can, in fact, do the emit
+ # -before- the collect, and my first cut did so. However in order to
+ # use the captured content in generating the new content, we need
+ # the collect stage to happen first - and it seems highly unlikely
+ # that in normal operation the collect phase will take long enough
+ # for the difference to be noticeable
+ return
+ ($coll
+ ? (ref $coll eq 'ARRAY'
+ ? [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ]
+ : $self->_stream_concat($coll, $emit)
+ )
+ : $emit
+ );
};
}