1package String::BufferStack; 2 3use strict; 4use warnings; 5use Carp; 6 7our $VERSION; $VERSION = "1.16"; 8 9=head1 NAME 10 11String::BufferStack - Nested buffers for templating systems 12 13=head1 SYNOPSIS 14 15 my $stack = String::BufferStack->new; 16 $stack->push( filter => sub {return uc shift} ); 17 $stack->append("content"); 18 $stack->flush_output; 19 20=head1 DESCRIPTION 21 22C<String::BufferStack> provides a framework for storing nested 23buffers. By default, all of the buffers flow directly to the output 24method, but individual levels of the stack can apply filters, or store 25their output in a scalar reference. 26 27=head1 METHODS 28 29=head2 new PARAMHASH 30 31Creates a new buffer stack and returns it. Possible arguments include: 32 33=over 34 35=item prealoc 36 37Preallocate this many bytes in the output buffer. This can reduce 38reallocations, and thus speed up appends. 39 40=item out_method 41 42The method to call when output trickles down to the bottom-most buffer 43and is flushed via L<flush_output>. The default C<out_method> prints 44the content to C<STDOUT>. This method will always be called with 45non-undef, non-zero length content. 46 47=item use_length 48 49Calculate length of each buffer as it is built. This imposes a 50significant runtime cost, so should be avoided if at all possible. 51Defaults to off. 52 53=back 54 55=cut 56 57sub new { 58 my $class = shift; 59 my %args = @_; 60 my $output = " "x($args{prealloc} || 0); 61 $output = ''; 62 return bless { 63 stack => [], 64 top => undef, 65 output => \$output, 66 out_method => $args{out_method} || sub { print STDOUT @_ }, 67 pre_appends => {}, 68 use_length => $args{use_length}, 69 }, $class; 70} 71 72=head2 push PARAMHASH 73 74Pushes a new frame onto the buffer stack. By default, the output from 75this new frame connects to the input of the previous frame. There are 76a number of possible options: 77 78=over 79 80=item buffer 81 82A string reference, into which the output from this stack frame will 83appear. By default, this is the input buffer of the previous frame. 84 85=item private 86 87If a true value is passed for C<private>, it creates a private string 88reference, and uses that as the buffer -- this is purely for 89convenience. That is, the following blocks are equivilent: 90 91 my $buffer = ""; 92 $stack->push( buffer => \$buffer ); 93 # ... 94 $stack->pop; 95 print $buffer; 96 97 $stack->push( private => 1 ); 98 # ... 99 print $stack->pop; 100 101=item pre_append 102 103A callback, which will be called with a reference to the 104C<String::BufferStack> object, and the arguments to append, whenever 105this stack frame has anything appended to the input buffer, directly 106or indirectly. 107 108Within the context of the pre-append callback, L</append>, 109L</direct_append>, and L</set_pre_append> function on the frame the 110pre-append is attached to, not the topmost trame. Using L</append> 111within the pre-append callback is not suggested; use 112L</direct_append> instead. L</set_pre_append> can be used to alter or 113remove the pre-append callback itself -- this is not uncommon, in 114the case where the first append is the only one which needs be watched 115for, for instance. 116 117=item filter 118 119A callback, used to process data which is appended to the stack frame. 120By default, filters are lazy, being called only when a frame is 121popped. They can be forced at any time by calling L</flush_filters>, 122however. 123 124=back 125 126=cut 127 128sub push { 129 my $self = shift; 130 my $frame = { 131 buffer => $self->{top} ? $self->{top}{pre_filter} : $self->{output}, 132 @_ 133 }; 134 my $filter = ""; 135 my $buffer = ""; 136 $frame->{buffer} = \$buffer if delete $frame->{private}; 137 $frame->{length} = (defined ${$frame->{buffer}}) ? CORE::length(${$frame->{buffer}}) : 0 138 if $self->{use_length} or $frame->{use_length}; 139 $frame->{pre_filter} = $frame->{filter} ? \$filter : $frame->{buffer}; 140 $self->{top} = $frame; 141 local $self->{local_frame} = $frame; 142 $self->set_pre_append(delete $frame->{pre_append}) if defined $frame->{pre_append}; 143 CORE::push(@{$self->{stack}}, $frame); 144} 145 146=head2 depth 147 148Returns the current depth of the stack. This starts at 0, when no 149frames have been pushed, and increases by one for each frame pushed. 150 151=cut 152 153sub depth { 154 my $self = shift; 155 return scalar @{$self->{stack}}; 156} 157 158=head2 append STRING [, STRING, ...] 159 160Appends the given strings to the input side of the topmost buffer. 161This will call all pre-append hooks attached to it, as well. Note 162that if the frame has a filter, the filter will not immediately run, 163but will be delayed until the frame is L</pop>'d, or L</flush_filters> 164is called. 165 166When called with no frames on the stack, appends the stringins 167directly to the L</output_buffer>. 168 169=cut 170 171sub append { 172 my $self = shift; 173 my $frame = $self->{local_frame} || $self->{top}; 174 if ($frame) { 175 my $ref = $frame->{pre_filter}; 176 if (exists $self->{pre_appends}{$frame->{buffer}} and not $frame->{filter}) { 177 # This is an append to the output buffer, signal all pre_append hooks for it 178 for my $frame (@{$self->{pre_appends}{$frame->{buffer}}}) { 179 die unless $frame->{pre_append}; 180 local $self->{local_frame} = $frame; 181 $frame->{pre_append}->($self, @_); 182 } 183 } 184 for (@_) { 185 $$ref .= $_ if defined; 186 } 187 } else { 188 my $ref = $self->{output}; 189 for (@_) { 190 $$ref .= $_ if defined; 191 } 192 } 193} 194 195=head2 direct_append STRING [, STRING, ...] 196 197Similar to L</append>, but appends the strings to the output side of 198the frame, skipping pre-append callbacks and filters. 199 200When called with no frames on the stack, appends the strings 201directly to the L</output_buffer>. 202 203=cut 204 205sub direct_append { 206 my $self = shift; 207 my $frame = $self->{local_frame} || $self->{top}; 208 my $ref = $frame ? $frame->{buffer} : $self->{output}; 209 for (@_) { 210 $$ref .= $_ if defined; 211 } 212} 213 214=head2 pop 215 216Removes the topmost frame on the stack, flushing the topmost filters 217in the process. Returns the output buffer of the frame -- note that 218this may not contain only strings appended in the current frame, but 219also those from before, as a speed optimization. That is: 220 221 $stack->append("one"); 222 $stack->push; 223 $stack->append(" two"); 224 $stack->pop; # returns "one two" 225 226This operation is a no-op if there are no frames on the stack. 227 228=cut 229 230sub pop { 231 my $self = shift; 232 return unless $self->{top}; 233 $self->filter; 234 my $frame = CORE::pop(@{$self->{stack}}); 235 local $self->{local_frame} = $frame; 236 $self->set_pre_append(undef); 237 $self->{top} = @{$self->{stack}} ? $self->{stack}[-1] : undef; 238 return ${$frame->{buffer}}; 239} 240 241=head2 set_pre_append CALLBACK 242 243Alters the pre-append callback on the topmost frame. The callback 244will be called before text is appended to the input buffer of the 245frame, and will be passed the C<String::BufferStack> and the arguments 246to L</append>. 247 248=cut 249 250sub set_pre_append { 251 my $self = shift; 252 my $hook = shift; 253 my $frame = $self->{local_frame} || $self->{top}; 254 return unless $frame; 255 if ($hook and not $frame->{pre_append}) { 256 CORE::push(@{$self->{pre_appends}{$frame->{buffer}}}, $frame); 257 } elsif (not $hook and $frame->{pre_append}) { 258 $self->{pre_appends}{ $frame->{buffer} } 259 = [ grep { $_ ne $frame } @{ $self->{pre_appends}{ $frame->{buffer} } } ]; 260 delete $self->{pre_appends}{ $frame->{buffer} } 261 unless @{ $self->{pre_appends}{ $frame->{buffer} } }; 262 } 263 $frame->{pre_append} = $hook; 264} 265 266=head2 set_filter FILTER 267 268Alters the filter on the topmost frame. Doing this flushes the 269filters on the topmost frame. 270 271=cut 272 273sub set_filter { 274 my $self = shift; 275 my $filter = shift; 276 return unless $self->{top}; 277 $self->filter; 278 if (defined $self->{top}{filter} and not defined $filter) { 279 # Removing a filter, flush, then in = out 280 $self->{top}{pre_filter} = $self->{top}{buffer}; 281 } elsif (not defined $self->{top}{filter} and defined $filter) { 282 # Adding a filter, add a pre_filter stage 283 my $pre_filter = ""; 284 $self->{top}{pre_filter} = \$pre_filter; 285 } 286 $self->{top}{filter} = $filter; 287} 288 289=head2 filter 290 291Filters the topmost stack frame, if it has outstanding unfiltered 292data. This will propagate content to lower frames, possibly calling 293their pre-append hooks. 294 295=cut 296 297sub filter { 298 my $self = shift; 299 my $frame = shift || $self->{top}; 300 return unless $frame and $frame->{filter} and CORE::length(${$frame->{pre_filter}}); 301 302 # We remove the input before we shell out to the filter, so we 303 # don't get into infinite loops. 304 my $input = ${$frame->{pre_filter}}; 305 ${$frame->{pre_filter}} = ''; 306 my $output = $frame->{filter}->($input); 307 if (exists $self->{pre_appends}{$frame->{buffer}}) { 308 for my $frame (@{$self->{pre_appends}{$frame->{buffer}}}) { 309 local $self->{local_frame} = $frame; 310 $frame->{pre_append}->($self, $output); 311 } 312 } 313 ${$frame->{buffer}} .= $output; 314} 315 316=head2 flush 317 318If there are no frames on the stack, calls L</flush_output>. 319Otherwise, calls L</flush_filters>. 320 321=cut 322 323sub flush { 324 my $self = shift; 325 # Flushing with no stack flushes the output 326 return $self->flush_output unless $self->depth; 327 # Otherwise it just flushes the filters 328 $self->flush_filters; 329} 330 331=head2 flush_filters 332 333Flushes all filters. This does not flush output from the output 334buffer; see L</flush_output>. 335 336=cut 337 338sub flush_filters { 339 my $self = shift; 340 # Push content through filters -- reverse so the top one is first 341 for my $frame (reverse @{$self->{stack}}) { 342 $self->filter($frame); 343 } 344} 345 346=head2 buffer 347 348Returns the contents of the output buffer of the topmost frame; if 349there are no frames, returns the output buffer. 350 351=cut 352 353sub buffer { 354 my $self = shift; 355 return $self->{top} ? ${$self->{top}{buffer}} : ${$self->{output}}; 356} 357 358=head2 buffer_ref 359 360Returns a reference to the output buffer of the topmost frame; if 361there are no frames, returns a reference to the output buffer. Note 362that adjusting this skips pre-append and filter hooks. 363 364=cut 365 366sub buffer_ref { 367 my $self = shift; 368 return $self->{top} ? $self->{top}{buffer} : $self->{output}; 369} 370 371=head2 length 372 373If C<use_length> was enabled in the buffer stack's constructor, 374returns the number of characters appended to the current frame; if 375there are no frames, returns the length of the output buffer. 376 377If C<use_length> was not enabled, warns and returns 0. 378 379=cut 380 381sub length { 382 my $self = shift; 383 carp("String::BufferStack object didn't enable use_length") and return 0 384 unless $self->{use_length} or ($self->{top} and $self->{top}{use_length}); 385 return $self->{top} ? CORE::length(${$self->{top}{buffer}}) - $self->{top}{length} : CORE::length(${$self->{output}}); 386} 387 388 389=head2 flush_output 390 391Flushes all filters using L</flush_filters>, then flushes output from 392the output buffer, using the configured L</out_method>. 393 394=cut 395 396sub flush_output { 397 my $self = shift; 398 $self->flush_filters; 399 400 # Look at what we have at the end 401 return unless CORE::length(${$self->{output}}); 402 $self->{out_method}->(${$self->{output}}); 403 ${$self->{output}} = ""; 404 return ""; 405} 406 407=head2 output_buffer 408 409Returns the pending output buffer, which sits below all existing 410frames. 411 412=cut 413 414sub output_buffer { 415 my $self = shift; 416 return ${$self->{output}}; 417} 418 419=head2 output_buffer_ref 420 421Returns a reference to the pending output buffer, allowing you to 422modify it. 423 424=cut 425 426sub output_buffer_ref { 427 my $self = shift; 428 return $self->{output}; 429} 430 431=head2 clear 432 433Clears I<all> buffers in the stack, including the output buffer. 434 435=cut 436 437sub clear { 438 my $self = shift; 439 ${$self->{output}} = ""; 440 ${$_->{pre_filter}} = ${$_->{buffer}} = "" for @{$self->{stack}}; 441 return ""; 442} 443 444=head2 clear_top 445 446Clears the topmost buffer in the stack; if there are no frames on the 447stack, clears the output buffer. 448 449=cut 450 451sub clear_top { 452 my $self = shift; 453 if ($self->{top}) { 454 ${$self->{top}{pre_filter}} = ${$self->{top}{buffer}} = ""; 455 } else { 456 ${$self->{output}} = ""; 457 } 458 return ""; 459} 460 461=head2 out_method [CALLBACK] 462 463Gets or sets the output method callback, which is given content from 464the pending output buffer, which sits below all frames. 465 466=cut 467 468sub out_method { 469 my $self = shift; 470 $self->{out_method} = shift if @_; 471 return $self->{out_method}; 472} 473 474=head1 SEE ALSO 475 476Many concepts were originally taken from L<HTML::Mason>'s internal 477buffer stack. 478 479=head1 AUTHORS 480 481Alex Vandiver C<< alexmv@bestpractical.com >> 482 483=head1 LICENSE 484 485Copyright 2008-2009, Best Practical Solutions. 486 487This package is distributed under the same terms as Perl itself. 488 489=cut 490 491 4921; 493