1 package HTML::Zoom::FilterBuilder;
4 use warnings FATAL => 'all';
5 use base qw(HTML::Zoom::SubObject);
6 use HTML::Zoom::CodeStream;
8 sub _stream_from_code {
9 shift->_zconfig->stream_utils->stream_from_code(@_)
12 sub _stream_from_array {
13 shift->_zconfig->stream_utils->stream_from_array(@_)
16 sub _stream_from_proto {
17 shift->_zconfig->stream_utils->stream_from_proto(@_)
21 shift->_zconfig->stream_utils->stream_concat(@_)
24 sub _flatten_stream_of_streams {
25 shift->_zconfig->stream_utils->flatten_stream_of_streams(@_)
29 my ($self, $args) = @_;
30 my ($name, $value) = @{$args}{qw(name value)};
32 my $a = (my $evt = $_[0])->{attrs};
33 my $e = exists $a->{$name};
34 +{ %$evt, raw => undef, raw_attrs => undef,
35 attrs => { %$a, $name => $value },
36 ($e # add to name list if not present
38 : (attr_names => [ @{$evt->{attr_names}}, $name ]))
44 my ($self, $args) = @_;
45 my ($name, $value) = @{$args}{qw(name value)};
47 my $a = (my $evt = $_[0])->{attrs};
48 my $e = exists $a->{$name};
49 +{ %$evt, raw => undef, raw_attrs => undef,
52 $name => join(' ', ($e ? $a->{$name} : ()), $value)
54 ($e # add to name list if not present
56 : (attr_names => [ @{$evt->{attr_names}}, $name ]))
61 sub remove_attribute {
62 my ($self, $args) = @_;
63 my $name = $args->{name};
65 my $a = (my $evt = $_[0])->{attrs};
66 return $evt unless exists $a->{$name};
67 $a = { %$a }; delete $a->{$name};
68 +{ %$evt, raw => undef, raw_attrs => undef,
70 attr_names => [ grep $_ ne $name, @{$evt->{attr_names}} ]
76 my ($self, $options) = @_;
77 my ($into, $passthrough, $content, $filter) =
78 @{$options}{qw(into passthrough content filter)};
80 my ($evt, $stream) = @_;
81 # We wipe the contents of @$into here so that other actions depending
82 # on this (such as a repeater) can be invoked multiple times easily.
83 # I -suspect- it's better for that state reset to be managed here; if it
84 # ever becomes painful the decision should be revisited
86 @$into = $content ? () : ($evt);
88 if ($evt->{is_in_place_close}) {
89 return $evt if $passthrough || $content;
92 my $name = $evt->{name};
94 my $_next = $content ? 'peek' : 'next';
95 $stream = do { local $_ = $stream; $filter->($stream) } if $filter;
96 my $collector = $self->_stream_from_code(sub {
97 return unless $stream;
98 while (my ($evt) = $stream->$_next) {
99 $depth++ if ($evt->{type} eq 'OPEN');
100 $depth-- if ($evt->{type} eq 'CLOSE');
104 push(@$into, $evt) if $into;
105 return $evt if $passthrough;
108 push(@$into, $evt) if $into;
109 $stream->next if $content;
110 return $evt if $passthrough;
112 die "Never saw closing </${name}> before end of source";
114 return ($passthrough||$content) ? [ $evt, $collector ] : $collector;
118 sub collect_content {
119 my ($self, $options) = @_;
120 $self->collect({ %{$options||{}}, content => 1 })
124 my ($self, $events) = @_;
125 sub { return $self->_stream_from_array(@$events, $_[0]) };
129 my ($self, $events) = @_;
130 my $coll_proto = $self->collect({ passthrough => 1 });
133 my $emit = $self->_stream_from_array(@$events);
134 my $coll = &$coll_proto;
135 return ref($coll) eq 'HASH' # single event, no collect
137 : [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
141 sub prepend_content {
142 my ($self, $events) = @_;
145 if ($evt->{is_in_place_close}) {
146 $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
147 return [ $evt, $self->_stream_from_array(
148 @$events, { type => 'CLOSE', name => $evt->{name} }
151 return $self->_stream_from_array($evt, @$events);
156 my ($self, $events) = @_;
157 my $coll_proto = $self->collect({ passthrough => 1, content => 1 });
160 if ($evt->{is_in_place_close}) {
161 $evt = { %$evt }; delete @{$evt}{qw(raw is_in_place_close)};
162 return [ $evt, $self->_stream_from_array(
163 @$events, { type => 'CLOSE', name => $evt->{name} }
166 my $coll = &$coll_proto;
167 my $emit = $self->_stream_from_array(@$events);
168 return [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ];
173 my ($self, $replace_with, $options) = @_;
174 my $coll_proto = $self->collect($options);
176 my ($evt, $stream) = @_;
177 my $emit = $self->_stream_from_proto($replace_with);
178 my $coll = &$coll_proto;
179 # For a straightforward replace operation we can, in fact, do the emit
180 # -before- the collect, and my first cut did so. However in order to
181 # use the captured content in generating the new content, we need
182 # the collect stage to happen first - and it seems highly unlikely
183 # that in normal operation the collect phase will take long enough
184 # for the difference to be noticeable
187 ? (ref $coll eq 'ARRAY'
188 ? [ $coll->[0], $self->_stream_concat($coll->[1], $emit) ]
189 : $self->_stream_concat($coll, $emit)
196 sub replace_content {
197 my ($self, $replace_with, $options) = @_;
198 $self->replace($replace_with, { %{$options||{}}, content => 1 })
202 my ($self, $repeat_for, $options) = @_;
203 $options->{into} = \my @into;
205 my $repeat_between = delete $options->{repeat_between};
206 if ($repeat_between) {
207 $options->{filter} = sub {
208 $_->select($repeat_between)->collect({ into => \@between })
212 my $s = $self->_stream_from_proto($repeat_for);
213 # We have to test $repeat_between not @between here because
214 # at the point we're constructing our return stream @between
215 # hasn't been populated yet - but we can test @between in the
216 # map routine because it has been by then and that saves us doing
217 # the extra stream construction if we don't need it.
218 $self->_flatten_stream_of_streams(do {
219 if ($repeat_between) {
221 local $_ = $self->_stream_from_array(@into);
222 (@between && $s->peek)
223 ? $self->_stream_concat(
224 $_[0]->($_), $self->_stream_from_array(@between)
230 local $_ = $self->_stream_from_array(@into);
236 $self->replace($repeater, $options);
240 my ($self, $repeat_for, $options) = @_;
241 $self->repeat($repeat_for, { %{$options||{}}, content => 1 })