File Coverage

blib/lib/Plack/Middleware/TemplateToolkit.pm

Criterion	Covered	Total	%
statement	194	199	97.4
branch	83	94	88.3
condition	31	43	72.0
subroutine	27	27	100.0
pod	5	5	100.0
total	340	368	92.3

package Plack::Middleware::TemplateToolkit;
# ABSTRACT: Serve files with Template Toolkit and Plack
$Plack::Middleware::TemplateToolkit::VERSION = '0.27';
use strict;
use warnings;
use 5.008_001;

use parent 'Exporter'; # for 'use Plack::Middleware::TemplateToolkit $version;'
use parent 'Plack::Middleware';
use Plack::Request 0.994;
use Plack::MIME;
use Template 2;
use Scalar::Util qw(blessed);
use HTTP::Status qw(status_message);
use Time::HiRes;
use Plack::Middleware::Debug::Timer;
use Encode;
use Carp;

# Configuration options as described in Template::Manual::Config
our @TT_CONFIG;
our @DEPRECATED;

BEGIN {
    @TT_CONFIG = qw(START_TAG END_TAG TAG_STYLE PRE_CHOMP POST_CHOMP TRIM
        INTERPOLATE ANYCASE INCLUDE_PATH DELIMITER ABSOLUTE RELATIVE DEFAULT
        BLOCKS VIEWS AUTO_RESET RECURSION VARIABLES CONSTANTS
        CONSTANT_NAMESPACE NAMESPACE PRE_PROCESS POST_PROCESS PROCESS WRAPPER
        ERROR EVAL_PERL OUTPUT OUTPUT_PATH STRICT DEBUG DEBUG_FORMAT
        CACHE_SIZE STAT_TTL COMPILE_EXT COMPILE_DIR PLUGINS PLUGIN_BASE
        LOAD_PERL FILTERS LOAD_TEMPLATES LOAD_PLUGINS LOAD_FILTERS
        TOLERANT SERVICE CONTEXT STASH PARSER GRAMMAR
    );

    # the following ugly code is only needed to catch deprecated accessors
    @DEPRECATED = qw(pre_process process eval_perl interpolate post_chomp);
    no strict 'refs';
    my $module = "Plack::Middleware::TemplateToolkit";
    foreach my $name (@DEPRECATED) {
        *{ $module . "::$name" } = sub {
            my $correct = uc($name);
            carp $module. "$name is deprecated, use ::$correct";
            my $method = $module . "::$correct";
            &$method(@_);
            }
    }

    sub new {
        my $self = Plack::Component::new(@_);

        # Support 'root' config (matches MW::Static etc)
        # if INCLUDE_PATH hasn't been defined
        $self->INCLUDE_PATH( $self->root )
            if !$self->INCLUDE_PATH() && $self->root;

        foreach ( grep { defined $self->{$_} } @DEPRECATED ) {
            $self->$_;
        }
        $self;
    }
}

use Plack::Util::Accessor (
    qw(dir_index path extension content_type default_type tt root timer
        pass_through decode_request encode_response vars request_vars),
    @TT_CONFIG
);

sub prepare_app {
    my ($self) = @_;

    $self->dir_index('index.html')   unless $self->dir_index;
    $self->pass_through(0)           unless defined $self->pass_through;
    $self->default_type('text/html') unless $self->default_type;
    $self->decode_request('utf8')    unless defined $self->decode_request;
    $self->encode_response('utf8')   unless defined $self->encode_response;
    $self->request_vars( [] ) unless defined $self->request_vars;

    if ( not $self->vars ) {
        $self->vars( sub { return { params => shift->query_parameters } } );
    } elsif ( ref $self->vars eq 'HASH' ) {
        my $vars = $self->vars;
        $self->vars( sub { return $vars; } );
    } elsif ( ref $self->vars ne 'CODE' ) {
        die 'vars must be a code or hash reference, if defined';
    }

    my $config = {};
    foreach (@TT_CONFIG) {
        next unless $self->$_;
        $config->{$_} = $self->$_;
        $self->$_(undef);    # don't initialize twice
    }

    if ( $self->tt ) {
        die 'tt must be a Template instance'
            unless UNIVERSAL::isa( $self->tt, 'Template' );
        die 'Either specify a template with tt or Template options, not both'
            if %$config;
    } else {
        die 'No INCLUDE_PATH supplied' unless $config->{INCLUDE_PATH};
        $self->tt( Template->new($config) );
    }
}

sub call {    # adapted from Plack::Middleware::Static
    my ( $self, $env ) = @_;

    my $start = [ Time::HiRes::gettimeofday ] if $self->timer;
    my $res = $self->_handle_template($env);

    if ( !$res or ( $self->pass_through and $res->[0] == 404 ) ) {
        if ( $self->app ) {
            # pass to the next middleware/app
            $res = $self->app->($env);
            # if ( $self->catch_errors and $res->[0] =~ /^[45]/ ) {
            # TODO: process error message (but better use callback)
            # }
        } else {
            my $req = Plack::Request->new($env);
            $res = $self->process_error( 404, 'Not found', 'text/plain', $req );
        }
    }

    if ($self->timer) {
        my $end = [ Time::HiRes::gettimeofday ];
        $env->{'tt.start'} = Plack::Middleware::Debug::Timer->format_time($start);
        $env->{'tt.end'}   = Plack::Middleware::Debug::Timer->format_time($end);
        $env->{'tt.elapsed'}
            = sprintf '%.6f s', Time::HiRes::tv_interval $start, $end;
    }

    $res;
}

sub process_template {
    my ( $self, $template, $code, $vars ) = @_;

    my ( $content, $res );
    if ( $self->tt->process( $template, $vars, \$content ) ) {
        my $type = $self->content_type || do {
            Plack::MIME->mime_type($1) if $template =~ /(\.\w{1,6})$/;
            }
            || $self->default_type;
        if ( $self->encode_response ) {
            $content = encode( $self->encode_response, $content );
        }
        $res = [ $code, [ 'Content-Type' => $type ], [$content] ];
    } else {
        $res = $self->tt->error->as_string;
    }

    return $res;
}

sub process_error {
    my ( $self, $code, $error, $type, $req ) = @_;

    $code = 500 unless $code && $code =~ /^\d\d\d$/;
    $error = status_message($code) unless $error;
    $type = ( $self->content_type || $self->default_type || 'text/plain' )
        unless $type;

    # plain error without template
    return [ $code, [ 'Content-Type' => $type ], [$error] ]
        unless $self->{$code} and $self->tt;

    $req = Plack::Request->new( { 'tt.vars' => {} } )
        unless blessed $req && $req->isa('Plack::Request');
    eval { $self->_set_vars($req); };

    $req->env->{'tt.vars'}->{'error'}   = $error;
    $req->env->{'tt.vars'}->{'path'}    = $req->path_info;
    $req->env->{'tt.vars'}->{'request'} = $req;

    my $tpl = $self->{$code};
    my $res = $self->process_template( $tpl, $code, $req->env->{'tt.vars'} );

    unless ( ref $res ) {

        # processing error document failed: result in a 500 error
        if ( $code eq 500 ) {
            $res = [ 500, [ 'Content-Type' => $type ], [$res] ];
            $tpl = undef;
        } else {
            if ( ref $req->logger ) {
                $req->logger->( { level => 'warn', message => $res } );
            }
            ( $res, $tpl ) = $self->process_error( 500, $res, $type, $req );
        }
    }

    return wantarray ? ( $res, $tpl ) : $res;
}

sub _set_vars {
    my ( $self, $req ) = @_;
    my $env = $req->env;

    # we must not copy the vars by reference because
    # otherwise we might modify the same object
    my (%vars) = %{ $self->vars->($req) } if defined $self->vars;

    my $rv = $self->request_vars;
    unless ( exists $vars{request} ) {
        if ( $rv eq 'all' ) {
            $vars{request} = $req;
        } elsif ( ref $rv and @$rv ) {
            $vars{request} = {};
            foreach ( @{ $self->request_vars } ) {
                next unless $req->can($_);
                my $value = $req->$_;

              # request vars should also be byte strings, so we must decode it
                if ( $self->decode_request ) {
                    my $encoding = $self->decode_request;

                    if ( blessed($value) and $value->isa('Hash::MultiValue') )
                    {
                        my @values = $value->values;
                        @values = map { decode( $encoding, $_ ) } @values;
                        my $hash = Hash::MultiValue->new;
                        foreach my $key ( $value->keys ) {
                            $key = decode( $encoding, $key );
                            $hash->add( $key, shift @values );
                        }
                        $value = $hash;
                    } else {
                        $value = decode( $encoding, $value );
                    }
                }

                $vars{request}->{$_} = $value;
            }
        }
    }

    if ( $env->{'tt.vars'} ) {
        # add to existing vars
        foreach ( keys %vars ) {
            $env->{'tt.vars'}->{$_} = $vars{$_};
        }
    } else {
        $env->{'tt.vars'} = \%vars;
    }
}

# core function called once in 'call'
sub _handle_template {
    my ( $self, $env ) = @_;

    if ( not $env->{'tt.template'} ) {
        my $path = $env->{'tt.path'} || do {
           $env->{'tt.path'} = $env->{PATH_INFO} || '/';
        };

        my $path_match = $self->path || '/';
        for ($path) {
            my $matched
                = 'CODE' eq ref $path_match
                ? $path_match->($_)
                : $_ =~ $path_match;
            if (not $matched) {
                delete $env->{'tt.path'};
                return;
            }
        }

        $path .= $self->dir_index if $path =~ /\/$/;
        $path =~ s{^/}{};    # Do not want to enable absolute paths

        my $extension = $self->extension;
        if ( $extension and $path !~ /${extension}$/ ) {
            # This 404 will be catched in method call if pass_through is set
            my ($res, $tpl) = $self->process_error(
                404, 'Not found', 'text/plain', Plack::Request->new($env) );
            $env->{'tt.template'} = $tpl;
            return $res;
        }

        $env->{'tt.template'} = $path;
    } else {
        delete $env->{'tt.path'};
    }

    my ($res, $tpl);
    my $req = Plack::Request->new($env);
    eval { $self->_set_vars($req); };
    if ( $@ ) {
        my $error = "error setting template variables: $@";
        my $type = $self->content_type || $self->default_type;
        ( $res, $tpl ) = $self->process_error( 500, $error, $type, $req );
        $env->{'tt.template'} = $tpl;
    } else {
        $res = $self->process_template(
            $env->{'tt.template'}, 200, $env->{'tt.vars'} );
    }

    unless ( ref $res ) {
        my $type = $self->content_type || $self->default_type;
        if ( $res =~ /file error .+ not found/ ) {
            ( $res, $tpl ) = $self->process_error( 404, $res, $type, $req );
        } else {
            if ( ref $req->logger ) {
                $req->logger->( { level => 'warn', message => $res } );
            }
            ( $res, $tpl ) = $self->process_error( 500, $res, $type, $req );
        }
        $env->{'tt.template'} = $tpl;
    }

    return $res;
}

1;

__END__