File Coverage

blib/lib/String/TT.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	14	16	87.5
condition	4	6	66.6
subroutine	10	10	100.0
pod	2	2	100.0
total	88	92	95.6

package String::TT;
use strict;
use warnings;
use PadWalker qw(peek_my);
use Carp qw(confess croak);
use Template;
use List::Util qw(min);
use Sub::Exporter -setup => {
    exports => [qw/tt strip/],
};

our $VERSION   = '0.03';
our $AUTHORITY = 'CPAN:JROCKWAY';

my %SIGIL_MAP = (
    '$' => 's',
    '@' => 'a',
    '%' => 'h',
    '&' => 'c', # probably do not need
    '*' => 'g', # probably do not need
);

{
    my $engine;
    sub _build_tt_engine {
        return $engine ||= Template->new;
    }
}

sub tt($) {
    my $template = shift;
    confess 'Whoa there, I need a template' if !defined $template;

    my %vars = %{peek_my(1)||{}};
    my %transformed_vars;
    for my $v (keys %vars){
        my ($sigil, $varname) = ($v =~ /^(.)(.+)$/);
        my $suffix = $SIGIL_MAP{$sigil};
        my $name = join '_', $varname, $suffix;
        $transformed_vars{$name} = $vars{$v};
        if($sigil eq '$'){
            $transformed_vars{$name} = ${$transformed_vars{$name}};
        }
    }

    # add the plain scalar variables (without overwriting anything)
    for my $v (grep { /_s$/ } keys %transformed_vars) {
        my ($varname) = ($v =~ /^(.+)_s$/);
        if(!exists $transformed_vars{$varname}){
            $transformed_vars{$varname} = $transformed_vars{$v};
        }
    }

    my $t = _build_tt_engine;
    my $output;
    $t->process(\$template, \%transformed_vars, \$output)
        || croak $t->error;
    return $output;
}

sub strip($){
    my $lines = shift;

    my $trailing_newline = ($lines =~ /\n$/s);# perl silently throws away data
    my @lines = split "\n", $lines;
    shift @lines if $lines[0] eq ''; # strip empty leading line

    # determine indentation level
    my @spaces = map { /^(\040+)/ and length $1 or 0 } grep { !/^\s*$/ } @lines;

    my $indentation_level = min(@spaces);

    # strip off $indentation_level spaces
    my $stripped = join "\n", map {
        my $copy = $_;
        substr($copy,0,$indentation_level) = "";
        $copy;
    } @lines;

    $stripped .= "\n" if $trailing_newline;
    return $stripped;
}

1;
__END__