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


line stmt bran cond sub pod time code
1             package Text::MicroMason::Filters;
2              
3 1     1   486 use strict;
  1         1  
  1         24  
4 1     1   3 use Carp;
  1         0  
  1         44  
5              
6 1     1   406 use Safe;
  1         23761  
  1         37  
7              
8             ######################################################################
9              
10             # Output filtering
11 1     1   5 use vars qw( %Filters );
  1         1  
  1         530  
12             $Filters{p} = \&Text::MicroMason::Base::_printable;
13              
14             $Filters{h} = eval {
15             require HTML::Entities; sub { HTML::Entities::encode( $_[0], q[<>&'"] ) }
16             } || eval { require CGI; \&CGI::escapeHTML };
17              
18             $Filters{u} = eval { require URI::Escape; \&URI::Escape::uri_escape };
19              
20             sub defaults {
21 1     1 0 5 (shift)->NEXT('defaults'), filters => \%Filters, default_filters => '', default_policy => 'combine'
22             }
23              
24             ######################################################################
25              
26             # $perl_code = $mason->assemble( @tokens );
27             sub assemble {
28 20     20 1 17 my $self = shift;
29 20         26 my @tokens = @_;
30             # warn "Filter assemble";
31 20         60 foreach my $position ( 0 .. int( $#tokens / 2 ) ) {
32 39 100       72 if ( $tokens[$position * 2] eq 'expr' ) {
33 20         25 my $token = $tokens[$position * 2 + 1];
34 20 100       94 my $filt_flags = ($token =~ s/(?
35             \s* # optional white space
36             (\w+(?:[\s\,]+\w+)*) # \w+ optionally delimited by spaces andor commas
37             \s*\z # optional whitespace and the end of string
38             //x) ? $1 : '';
39            
40 20         14 my @unparsed;
41 20 100 100     77 push @unparsed, $self->{default_filters} unless $filt_flags and $self->{default_policy} eq 'override';
42 20         20 push @unparsed, $filt_flags;
43 20 100       34 if (my @filters = $self->parse_filters(@unparsed)) {
44 17         52 $token = '$m->filter( ' . join(', ', map "'$_'", @filters ) . ', ' .
45             'join "", do { ' . $token . '} )';
46             }
47 20         48 $tokens[$position * 2 + 1] = $token;
48             }
49             }
50 20         52 $self->NEXT('assemble', @tokens );
51             }
52              
53             # @flags = $mason->parse_filters( @filter_strings );
54             sub parse_filters {
55 20     20 1 15 my $self = shift;
56            
57 20         14 my $no_ns;
58 20         12 my $short = join '', 'n', grep { length($_) == 1 } keys %{ $self->{filters} };
  78         93  
  20         62  
59 31   100     133 reverse grep { not $no_ns ||= /^n$/ } reverse
60 20 100       26 map { /^[$short]{2,5}$/ ? split('') : split(/[\s\,]+/) } @_;
  38         154  
61             }
62              
63             ######################################################################
64              
65             # %functions = $mason->filter_functions();
66             # $function = $mason->filter_functions( $flag );
67             # @functions = $mason->filter_functions( \@flags );
68             # $mason->filter_functions( $flag => $function, ... );
69             sub filter_functions {
70 2     2 1 292 my $self = shift;
71 2 50       4 my $filters = ( ref $self ) ? $self->{filters} : \%Filters;
72 2 50       5 if ( scalar @_ == 0 ) {
    50          
73 0         0 %$filters
74             } elsif ( scalar @_ == 1 ) {
75 0         0 my $key = shift;
76 0 0       0 if ( ! ref $key ) {
77 0         0 $filters->{ $key }
78             } else {
79 0         0 @{ $filters }{ @$key }
  0         0  
80             }
81             } else {
82 2         8 %$filters = ( %$filters, @_ );
83             }
84             }
85              
86             # @functions = $mason->get_filter_functions( @flags_or_functions );
87             sub get_filter_functions {
88 17     17 1 13 my $self = shift;
89            
90             map {
91 17 50       13 ( ref $_ eq 'CODE' ) ? $_ : $self->{filters}{ $_ }
  20 50       80  
92             or $self->croak_msg("No definition for a filter named '$_'" );
93             } @_
94             }
95              
96             # $result = $mason->filter( @filters, $content );
97             sub filter {
98 17     17 1 204 my $self = shift;
99 17         18 local $_ = pop;
100            
101 17         30 foreach my $function ( $self->get_filter_functions( @_ ) ) {
102 20         45 $_ = &$function($_)
103             }
104             $_
105 17         384 }
106              
107             ######################################################################
108              
109             1;
110              
111             __END__