File Coverage

blib/lib/Template/AutoFilter/Parser.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	19	20	95.0
condition	7	8	87.5
subroutine	10	10	100.0
pod	5	5	100.0
total	95	97	97.9

use strict;
use warnings;

package Template::AutoFilter::Parser;

our $VERSION = '0.143050'; # VERSION
# ABSTRACT: parses TT templates and automatically adds filters to tokens


use base 'Template::Parser';
use List::MoreUtils qw< part >;

sub new {
    my ( $class, $params ) = @_;

    my $self = $class->SUPER::new( $params );
    $self->{AUTO_FILTER} = $params->{AUTO_FILTER} || 'html';
    $self->{SKIP_DIRECTIVES} = $self->make_skip_directives( $params->{SKIP_DIRECTIVES} ) || $self->default_skip_directives;

    return $self;
}

sub split_text {
    my ( $self, @args ) = @_;
    my $tokens = $self->SUPER::split_text( @args ) or return;

    for my $token ( @{$tokens} ) {
        next if !ref $token;
        next if !ref $token->[2];   # Skip ITEXT ($bar)

        # Split a compound statement into individual directives
        my ($part, $is_directive) = (0, 1);
        my @directives = part {
            # Skip over interpolated fields; they are unpaired
            unless (ref) {
                $part++ if $is_directive and $_ eq ';';
                $is_directive = !$is_directive;
            }
            $part;
        } @{$token->[2]};

        for my $directive (@directives) {
            # Filter out interpolated values in strings; they don't matter for
            # our decision of whether to autofilter or not (e.g. an existing
            # filter).  Note, this is not the same as ITEXT.  Also ignore
            # semi-colon tokens, as they may make an empty directive look
            # non-empty.  They are also inconsequential to our decision to
            # autofilter or not.
            my %fields = grep { !ref and $_ ne ';' } @$directive;
            next if $self->has_skip_field( \%fields );
            next if ! %fields;

            push @$directive, qw( FILTER | IDENT ), $self->{AUTO_FILTER};
        }

        $token->[2] = [ map { @$_ } @directives ];
    }
    return $tokens;
}

sub has_skip_field {
    my ( $self, $fields ) = @_;

    my $skip_directives = $self->{SKIP_DIRECTIVES};

    for my $field ( keys %{$fields} ) {
        return 1 if $skip_directives->{$field};
    }

    return 0;
}

sub default_skip_directives {
    my ( $self ) = @_;
    my @skip_directives = qw(
        CALL SET DEFAULT INCLUDE PROCESS WRAPPER BLOCK IF UNLESS ELSIF ELSE
        END SWITCH CASE FOREACH FOR WHILE FILTER USE MACRO TRY CATCH FINAL
        THROW NEXT LAST RETURN STOP CLEAR META TAGS DEBUG ASSIGN PERL RAWPERL
    );
    return $self->make_skip_directives( \@skip_directives );
}

sub make_skip_directives {
    my ( $self, $skip_directives_list ) = @_;
    return if !$skip_directives_list;

    my %skip_directives = map { $_ => 1 } @{$skip_directives_list};
    return \%skip_directives;
}

1;

__END__