File Coverage

blib/lib/Text/MicroMason/Filters.pm

Criterion	Covered	Total	%
statement	46	52	88.4
branch	15	22	68.1
condition	6	6	100.0
subroutine	10	10	100.0
pod	5	6	83.3
total	82	96	85.4

package Text::MicroMason::Filters;

use strict;
use Carp;

use Safe;

######################################################################

# Output filtering
use vars qw( %Filters );
$Filters{p} = \&Text::MicroMason::Base::_printable;

$Filters{h} = eval {
      require HTML::Entities; sub { HTML::Entities::encode( $_[0], q[<>&'"] ) }
    } || eval { require CGI; \&CGI::escapeHTML };

$Filters{u} = eval { require URI::Escape; \&URI::Escape::uri_escape };

sub defaults {
  (shift)->NEXT('defaults'), filters => \%Filters, default_filters => '', default_policy => 'combine'
}

######################################################################

# $perl_code = $mason->assemble( @tokens );
sub assemble {
    my $self = shift;
    my @tokens = @_;
    # warn "Filter assemble";
    foreach my $position ( 0 .. int( $#tokens / 2 ) ) {
        if ( $tokens[$position * 2] eq 'expr' ) {
            my $token = $tokens[$position * 2 + 1];
            my $filt_flags = ($token =~ s/(?
                                          \s*       # optional white space
                                          (\w+(?:[\s\,]+\w+)*) # \w+ optionally delimited by spaces andor commas
                                          \s*\z     # optional whitespace and the end of string
                                         //x) ? $1 : '';

	    my @unparsed;
	    push @unparsed, $self->{default_filters} unless $filt_flags and $self->{default_policy} eq 'override';
	    push @unparsed, $filt_flags;
            if (my @filters = $self->parse_filters(@unparsed)) {
                $token = '$m->filter( ' . join(', ', map "'$_'", @filters ) . ', ' .
                    'join "", do { ' . $token . '} )';
            }
            $tokens[$position * 2 + 1] = $token;
        }
    }
    $self->NEXT('assemble', @tokens );
}

# @flags = $mason->parse_filters( @filter_strings );
sub parse_filters {
  my $self = shift;

  my $no_ns;
  my $short = join '', 'n', grep { length($_) == 1 } keys %{ $self->{filters} };
  reverse grep { not $no_ns ||= /^n$/ } reverse
    map { /^[$short]{2,5}$/ ? split('') : split(/[\s\,]+/) } @_;
}

######################################################################

# %functions = $mason->filter_functions();
# $function  = $mason->filter_functions( $flag );
# @functions = $mason->filter_functions( \@flags );
# $mason->filter_functions( $flag => $function, ... );
sub filter_functions {
  my $self = shift;
  my $filters = ( ref $self ) ? $self->{filters} : \%Filters;
  if ( scalar @_ == 0 ) {
    %$filters
  } elsif ( scalar @_ == 1 ) {
    my $key = shift;
    if ( ! ref $key ) {
      $filters->{ $key }
    } else {
      @{ $filters }{ @$key }
    }
  } else {
    %$filters = ( %$filters, @_ );
  }
}

# @functions = $mason->get_filter_functions( @flags_or_functions );
sub get_filter_functions {
  my $self = shift;

  map {
    ( ref $_ eq 'CODE' ) ? $_ : $self->{filters}{ $_ }
	or $self->croak_msg("No definition for a filter named '$_'" );
  } @_
}

# $result = $mason->filter( @filters, $content );
sub filter {
  my $self = shift;
  local $_ = pop;

  foreach my $function ( $self->get_filter_functions( @_ ) ) {
    $_ = &$function($_)
  }
  $_
}

######################################################################

1;

__END__