Re: extending <% | %>

diff --git a/lib/HTML/Mason/Compiler.pm b/lib/HTML/Mason/Compiler.pm
index f2c598e..38e6839 100644
--- a/lib/HTML/Mason/Compiler.pm
+++ b/lib/HTML/Mason/Compiler.pm
@@ -1,3 +1,6 @@
+# -*- cperl-indent-level: 4; cperl-continued-brace-offset: -4; cperl-continued-statement-offset: 4 -*-
+# vim: tabstop=4 shiftwidth=4 softtabstop=4:
+
 # Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
 # This program is free software; you can redistribute it and/or modify it
 # under the same terms as Perl itself.
@@ -7,6 +10,7 @@ package HTML::Mason::Compiler;
 use strict;
 use warnings;
 use Data::Dumper;
+use Scalar::Util ();
 use HTML::Mason::Component::FileBased;
 use HTML::Mason::Component::Subcomponent;
 use HTML::Mason::Exceptions( abbr => [qw(param_error compiler_error syntax_error)] );
@@ -439,6 +443,7 @@ sub end_named_block
     $self->{current_compile}{in_main}++;
 }
 
+my $code_num = 0;
 sub substitution
 {
     my $self = shift;
@@ -460,39 +465,90 @@ sub substitution
         return;
     }
 
-    if ( ( exists $p{escape} && defined $p{escape} ) ||
-         @{ $self->{default_escape_flags} }
-       )
+    if ( ( exists $p{filters} && defined $p{filters} ) ||
+        @{ $self->{default_escape_flags} } ||
+        @{ $self->{default_filters} }
+        )
     {
+        my @filters = (
+            defined $p{filters} ? @{ $p{filters} } : (),
+        );
+
         my @flags;
-        if ( defined $p{escape} )
+        # the lexer creates a one-element array for escapes; do we want to
+        # depend on that knowledge?  I'm iffy.
+        if ( @filters and @{ $filters[-1] } == 1 )
         {
-            $p{escape} =~ s/\s+$//;
-
-            if ( $p{escape} =~ /$old_escape_re/ )
+            my $flags = (pop @filters)->[0];
+            if ( $flags =~ /$old_escape_re/ )
             {
-                @flags = split //, $p{escape};
+                @flags = split //, $flags;
             }
             else
             {
-                @flags = split /\s*,\s*/, $p{escape};
+                @flags = split /\s*,\s*/, $flags;
             }
         }
 
         # is there any way to check the flags for validity and still
         # allow them to be dynamically set from components?
+        if ( ! grep { $_ eq 'n' } @flags )
+        {
+            push @filters,
+                @{ $self->{default_filters}      || [] };
 
-        unshift @flags, @{ $self->default_escape_flags }
-            unless grep { $_ eq 'n' } @flags;
+            push @flags,
+                @{ $self->{default_escape_flags} || [] };
+        }
+        else
+        {
+            @flags = grep { $_ ne 'n' } @flags;
+        }
+            
+        {
+            my %seen;
+            @flags = grep { ! $seen{$_}++ } @flags;
+        }
+        
+        # @flags had gotten popped off earlier -- it's easier to have one kind
+        # of data structure turning into code, rather than two
+        #push @filters, map { [ $_ ] } @flags;
+
+        #$text = "(join '', grep { defined } ($text))";
+        #$text = "(join '', ($text))";
+        if ( @filters and $filters[0][0] eq 'perl')
+        {
+            # special case -- not a real filter
+            $text = "do { my \@_args = \@_; HTML::Mason::Filters::Result->new(sub { sub { ($text) }->(\@_args) }) }";
+            #$text = "HTML::Mason::Filters::Result->new(sub { ($text) } )";
+            shift @filters;
+        }
+        else
+        {
+            # XXX untested, if anything breaks, assume this is wrong
+            $text = "HTML::Mason::Filters::Result->new(sub { \"\Q$text\E\" })";
+        }
 
-        my %seen;
-        my $flags =
-            ( join ', ',
-              map { $seen{$_}++ ? () : "'$_'" }
-              grep { $_ ne 'n' } @flags
-            );
+        if ( @filters )
+        {
+            $text = sprintf 
+                "\$m->interp->apply_filters(%s, %s, %s)",
+                '{ request => $m }', # context
+                $text,               # input
+                join(', ', map {
+                    sprintf "[ '%s', [ %s ] ]", $_->[0], $_->[1] || '()'
+                } reverse @filters)
+            ;
+        }
 
-        $text = "\$m->interp->apply_escapes( (join '', ($text)), $flags )" if $flags;
+        if ( @flags )
+        {
+            $text = sprintf
+                "\$m->interp->apply_escapes(%s, %s)",
+                $text,
+                join ',', map { "'$_'" } reverse @flags
+            ;
+        }
     }
 
     my $code;
@@ -506,12 +562,25 @@ sub substitution
         # output defined bits, which is what $m->print does internally
         # as well. use 'if defined' for maximum efficiency; grep
         # creates a list.
-        $code = "for ( $text ) { \$\$_outbuf .= \$_ if defined }\n";
+        $code = sprintf "for my \$_text ( %s ) { %s }\n",
+            $text,
+            join('; ',
+                '$_text = $_text->as_string if Scalar::Util::blessed($_text)'
+                    . ' && $_text->isa("HTML::Mason::Filters::Result")',
+                '$$_outbuf .= $_text if defined($_text)',
+            )
+        ;
     }
 
     eval { $self->postprocess_perl->(\$code) } if $self->postprocess_perl;
     compiler_error $@ if $@;
 
+#    open my $fh, ">out." . sprintf("%03d", ++$code_num);
+#    use Data::Dumper;
+#    print $fh Dumper(\%p);
+#    print $fh $code;
+#    close $fh;
+
     $self->_add_body_code($code);
 
     $self->{current_compile}{last_body_code_type} = 'substitution';
diff --git a/lib/HTML/Mason/Filters.pm b/lib/HTML/Mason/Filters.pm
new file mode 100644
index 0000000..26c27ca
--- /dev/null
+++ b/lib/HTML/Mason/Filters.pm
@@ -0,0 +1,90 @@
+# -*- cperl-indent-level: 4; cperl-continued-brace-offset: -4; cperl-continued-statement-offset: 4 -*-
+# vim: tabstop=4 shiftwidth=4 softtabstop=4:
+
+use strict;
+use warnings;
+
+package HTML::Mason::Filters;
+
+# input = code
+sub cache
+{
+    my ( $m, $input, $args ) = @_;
+
+    my ($get, $set) = $m->_cache_access(@$args);
+
+    my $cached = $get->();
+
+    if ( $cached )
+    {
+        return HTML::Mason::Filters::Result->new(sub { $cached });
+    }
+    else
+    {
+        return HTML::Mason::Filters::Result->new(sub {
+            my $output = $input->();
+            $set->($output);
+            return $output;
+        });
+    }
+}
+
+# this would be input = code
+#sub format
+#{
+#    my ( $m, $input, $args ) = @_;
+#
+#    my ( $format ) = @$args;
+#
+#    return HTML::Mason::Filters::Result->new(sub {
+#        sprintf $format, $input->()
+#    });
+#}
+
+# input = text
+sub format
+{
+    my ( $input, $args ) = @_;
+    return sprintf $args->[0], $$input;
+}
+
+package HTML::Mason::Filters::Result;
+
+use Scalar::Util ();
+
+sub new {
+    my $class = shift;
+    my $arg   = shift;
+    my $code  = (
+        ref $arg eq 'CODE' or (
+            Scalar::Util::blessed($arg) &&
+            $arg->isa($class)
+        )
+    )
+    ? $arg
+    : sub { $arg };
+    return bless $code => $class;
+}
+
+sub as_string {
+    my ($self) = @_;
+    my @rv = $self->();
+    $_[0] = HTML::Mason::Filters::Result::Static->new(sub { @rv });
+    return join '', grep { defined } @rv;
+}
+
+use overload (
+    fallback => 1,
+    q{""} => 'as_string',
+);
+
+package HTML::Mason::Filters::Result::Static;
+
+our @ISA = 'HTML::Mason::Filters::Result';
+
+sub as_string {
+    my ($self) = @_;
+    return join '', grep { defined } $self->();
+}
+
+1;
diff --git a/lib/HTML/Mason/Interp.pm b/lib/HTML/Mason/Interp.pm
index 82525b3..01de0d1 100644
--- a/lib/HTML/Mason/Interp.pm
+++ b/lib/HTML/Mason/Interp.pm
@@ -1,4 +1,5 @@
 # -*- cperl-indent-level: 4; cperl-continued-brace-offset: -4; cperl-continued-statement-offset: 4 -*-
+# vim: tabstop=4 shiftwidth=4 softtabstop=4:
 
 # Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
 # This program is free software; you can redistribute it and/or modify it
@@ -15,6 +16,7 @@ use File::Spec;
 use File::Temp;
 use HTML::Mason;
 use HTML::Mason::Escapes;
+use HTML::Mason::Filters;
 use HTML::Mason::Request;
 use HTML::Mason::Resolver::File;
 use HTML::Mason::Tools qw(read_file taint_is_on load_pkg);
@@ -168,6 +170,7 @@ sub _initialize
     $self->_check_data_dir();
     $self->_create_data_subdirs();
     $self->_initialize_escapes();
+    $self->_initialize_filters();
 
     #
     # Create preallocated buffer for requests.
@@ -249,6 +252,28 @@ sub _initialize_escapes
     }
 }
 
+sub _initialize_filters
+{
+    my $self = shift;
+
+    # Add filters (including defaults)
+    $self->set_filter(
+        cache => {
+            code => \&HTML::Mason::Filters::cache,
+            input => 'code',
+        },
+        format => {
+            code => \&HTML::Mason::Filters::format,
+            input => 'text',
+        },
+    );
+
+    if ( my $f = delete $self->{filter_flags} )
+    {
+        $self->set_filter(%$f);
+    }
+}
+
 sub _set_code_cache_attributes
 {
     my $self = shift;
@@ -987,7 +1012,12 @@ sub set_escape
             }
         }
 
-        $self->{escapes}{$name} = $coderef;
+        $self->set_filter(
+            $name => {
+                code  => $coderef,
+                input => 'text',
+            },
+        );
     }
 }
 
@@ -995,23 +1025,99 @@ sub remove_escape
 {
     my $self = shift;
 
-    delete $self->{escapes}{ shift() };
+    delete $self->{filters}{ shift() };
 }
 
-sub apply_escapes
+sub apply_escapes 
 {
     my $self = shift;
     my $text = shift;
+    # keep the original error message in case anyone is depending on it
+    return $self->apply_filters( {}, $text, map {
+        exists $self->{filters}{$_} &&
+        $self->{filters}{$_}{input} eq 'text' # reasonable guess
+        ? [ $_ ]
+        : param_error "Invalid escape flag: $_"
+    } @_ );
+}
+
+sub set_filter
+{
+    my $self = shift;
+    my %p = @_;
 
-    foreach my $flag (@_)
+    while ( my ($name, $arg) = each %p )
     {
-        param_error "Invalid escape flag: $flag"
-            unless exists $self->{escapes}{$flag};
+        if ( ref $arg eq 'CODE' )
+        {
+            $arg = { code => $arg };
+        }
 
-        $self->{escapes}{$flag}->(\$text);
+        unless ( $arg->{input} and
+            ( $arg->{input} eq 'code' or $arg->{input} eq 'text' ) )
+        {
+            param_error "Invalid filter input style: $arg->{input}";
+        }
+
+        if ( $arg->{input} eq 'text' ) 
+        {
+            my $code = $arg->{code};
+            $arg->{code} = sub {
+                my ( $m, $input, $args ) = @_;
+                return HTML::Mason::Filters::Result->new(sub {
+                    # force passing in a string, just in case some user-defined
+                    # escape becomes confused otherwise, though I think this is
+                    # unlikely
+                    $input = join('', $input);
+                    $code->(\$input, $args);
+                    return $input;
+                });
+            };
+        }
+
+        $self->{filters}{$name} = $arg;
+    }
+}
+
+sub remove_filter
+{
+    my $self = shift;
+    delete $self->{filters}{ shift() };
+}
+
+sub apply_filters
+{
+    my $self = shift;
+
+    my $context = shift;
+    my $m = delete $context->{request};
+
+    #my $result = HTML::Mason::Filters::Result->new(shift);
+    my $result = shift;
+
+    my @filter_args = @_;
+
+    if ( my ($not_found) =
+        grep { ! exists $self->{filters}{$_->[0]} } @filter_args)
+    {
+        param_error "Invalid filter: $not_found";
+    }
+
+    for my $filter_arg (@filter_args)
+    {
+        my ( $name, $args ) = @$filter_arg;
+
+        my $input = $result;
+        $result = HTML::Mason::Filters::Result->new(sub {
+            $self->{filters}{$name}{code}->(
+                $m,
+                $input,
+                $args,
+            )
+        });
     }
 
-    return $text;
+    return $result;
 }
 
 1;
diff --git a/lib/HTML/Mason/Lexer.pm b/lib/HTML/Mason/Lexer.pm
index 0d88b71..eed10b0 100644
--- a/lib/HTML/Mason/Lexer.pm
+++ b/lib/HTML/Mason/Lexer.pm
@@ -1,3 +1,6 @@
+# -*- cperl-indent-level: 4; cperl-continued-brace-offset: -4; cperl-continued-statement-offset: 4 -*-
+# vim: tabstop=4 shiftwidth=4 softtabstop=4:
+
 # Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
 # This program is free software; you can redistribute it and/or modify it
 # under the same terms as Perl itself.
@@ -364,6 +367,18 @@ sub match_named_block
 my $flag = qr/[[:alpha:]_]\w*/;
 sub escape_flag_regex { $flag }
 
+my $pipe_re = qr/
+    \s*
+    (?<!\|)
+    \|
+    \s*
+/x;
+
+my $old_flag_re = qr/
+   $flag
+   (?:\s*,\s*$flag)*
+/x;
+
 sub match_substitute
 {
     # This routine relies on there *not* to be an opening <%foo> tag
@@ -374,27 +389,45 @@ sub match_substitute
     return 0 unless $self->{current}{comp_source} =~ /\G<%/gcs;
 
     if ( $self->{current}{comp_source} =~
-         m{
-           \G
-           (.+?)                # Substitution body ($1)
-           (
-            \s*
-            (?<!\|)             # Not preceded by a '|'
-            \|                  # A '|'
-            \s*
-            (                   # (Start $3)
-             $flag              # A flag
-             (?:\s*,\s*$flag)*  # More flags, with comma separators
-            )
-            \s*
-           )?
-           %>                   # Closing tag
-          }xcigs )
+        m{ \G \s* (.+?) \s* %> }xcigs )
     {
-        $self->{current}{lines} += tr/\n// foreach grep defined, ($1, $2);
+        my $body = $1;
+        $self->{current}{lines} += $body =~ tr/\n//;
+
+        my @filters;
+           
+        if ( $body =~
+            s{
+                $pipe_re
+                ( $old_flag_re )
+                \s* $
+            }{}xis )
+        {
+            push @filters, [ $1 ];
+        }
+                
+        while ( $body =~
+            s{
+                $pipe_re
+                ( $flag )       # filter name
+                (               # (optional) filter args
+                    \( .* \)
+                )?
+                \s* $
+            }{}xis )
+        {
+            unshift @filters, [ $1 => $2 ];
+        }
+
+        # special case -- inline substiutions are always interpreted as Perl
+        # code; later, substitution-with-content may be either Perl or text
+        unshift @filters, [ 'perl', '' ];
+
+        $self->{current}{compiler}->substitution(
+            substitution => $body,
+            filters      => \@filters,
+        );
 
-        $self->{current}{compiler}->substitution( substitution => $1,
-                                                  escape => $3 );
         return 1;
     }
     else
diff --git a/lib/HTML/Mason/Request.pm b/lib/HTML/Mason/Request.pm
index 1af1e7e..ad6754b 100644
--- a/lib/HTML/Mason/Request.pm
+++ b/lib/HTML/Mason/Request.pm
@@ -1,4 +1,5 @@
 # -*- cperl-indent-level: 4; cperl-continued-brace-offset: -4; cperl-continued-statement-offset: 4 -*-
+# vim: tabstop=4 shiftwidth=4 softtabstop=4:
 
 # Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
 # This program is free software; you can redistribute it and/or modify it
@@ -771,13 +772,15 @@ sub _cache_1_x
     }
 }
 
-sub cache_self {
+# abstract out the details of data_cache_api so that the client code doesn't
+# need to care; return a coderef for getting from the cache with the given
+# params and a coderef for setting.
+sub _cache_access {
     my ($self, %options) = @_;
-
-    return if $self->{top_stack}->[STACK_IN_CALL_SELF]->{'CACHE_SELF'};
-
+  
     my (%store_options, %retrieve_options);
     my ($expires_in, $key, $cache);
+
     if ($self->data_cache_api eq '1.0') {
         foreach (qw(key expire_if busy_lock)) {
             $retrieve_options{$_} = $options{$_} if (exists($options{$_}));
@@ -795,17 +798,46 @@ sub cache_self {
             $retrieve_options{$_} = delete($options{$_}) if (exists($options{$_}));
         }
         $expires_in = delete $options{expires_in} || delete $options{expire_in} || 'never';
-        $key = delete $options{key} || '__mason_cache_self__';
+        $key = delete $options{key} || delete $options{default_key}
+            || '__mason_cache_default__';
         $cache = $self->cache(%options);
     }
 
+    return ( $self->data_cache_api eq '1.0'
+        ? (
+            # 1.0 getter
+            sub {
+                $self->cache(%retrieve_options)
+            },
+            # 1.0 setter
+            sub {
+                $self->cache(
+                  action => 'store',
+                  key    => $key,
+                  value  => shift,
+                  %store_options
+                );
+            },
+        )
+        : (
+            # modern getter
+            sub { $cache->get($key, %retrieve_options) },
+            # modern setter
+            sub { $cache->set($key, shift, $expires_in) },
+        )
+    );
+}
+
+sub cache_self {
+    my ($self, %options) = @_;
+
+    return if $self->{top_stack}->[STACK_IN_CALL_SELF]->{'CACHE_SELF'};
+
+    my ( $get, $set ) = $self->_cache_access(%options);
+
     my ($output, @retval, $error);
 
-    my $cached =
-        ( $self->data_cache_api eq '1.0' ?
-          $self->cache(%retrieve_options) :
-          $cache->get($key, %retrieve_options)
-        );
+    my $cached = $get->();
 
     if ($cached) {
         ($output, my $retval) = @$cached;
@@ -820,11 +852,7 @@ sub cache_self {
             unless ($self->_aborted_or_declined($error));
 
         my $value = [$output, \@retval];
-        if ($self->data_cache_api eq '1.0') {
-            $self->cache(action=>'store', key=>$key, value=>$value, %store_options);
-        } else {
-            $cache->set($key, $value, $expires_in);
-        }
+        $set->($value);
     }
 
     #
@@ -1171,8 +1199,10 @@ sub print
         );
 
     # use 'if defined' for maximum efficiency; grep creates a list.
-    for ( @_ ) {
-        $$bufref .= $_ if defined;
+    for my $_text ( @_ ) {
+        $_text = $_text->as_string if Scalar::Util::blessed($_text)
+            && $_text->isa("HTML::Mason::Filters::Result");
+        $$bufref .= $_text if defined($_text);
     }
 
     $self->flush_buffer if $self->{autoflush};
diff --git a/lib/HTML/Mason/Tests.pm b/lib/HTML/Mason/Tests.pm
index e69ab8d..ab68da1 100644
--- a/lib/HTML/Mason/Tests.pm
+++ b/lib/HTML/Mason/Tests.pm
@@ -503,10 +503,13 @@ sub _run_test
 
     $self->{buffer} = '';
     my $interp = $self->_make_main_interp;
-    $interp->out_method( sub { for (@_) { $self->{buffer} .= $_ if defined $_ } } );
+    $interp->out_method( sub {
+      for my $text (@_) { $self->{buffer} .= $text if defined $text } 
+    } );
 
     my $warnings = '';
-    local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
+    local $SIG{__WARN__} = sub { for my $text (@_) { $warnings .= $text } };
+
     eval {
         # Run pre_code if test has it - pass in interp
         if ($test->{pre_code}) {
diff --git a/t/10-cache.t b/t/10-cache.t
index c8b9bd5..420809d 100644
--- a/t/10-cache.t
+++ b/t/10-cache.t
@@ -581,6 +581,35 @@ EOF
 
 #------------------------------------------------------------
 
+    $group->add_support(
+        path => 'support/cache_substitution',
+        component => <<'EOF',
+<% ($m->print("hello\n"), "world") | cache(expires_in => "5s") %>
+EOF
+    );
+
+    $group->add_test(
+        name => 'cache_substition',
+        description => 'test | cache in substitution',
+        component => <<'EOF',
+<& support/cache_substitution &>
+<& support/cache_substitution &>
+% sleep 5;
+<& support/cache_substitution &>
+EOF
+        expect => <<'EOF',
+hello
+world
+
+world
+
+hello
+world
+EOF
+    );
+
+#------------------------------------------------------------
+
     return $group;
 }