File Coverage

blib/lib/Data/Template.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	12	14	85.7
condition			n/a
subroutine	10	10	100.0
pod	5	5	100.0
total	82	85	96.4

package Data::Template;

=encoding utf8
=cut

use strict;
use warnings;

our $VERSION = '0.02';

use base qw(Class::Accessor);
Data::Template->mk_accessors(qw(engine prefix));

use Template;

sub new {
    my $self = shift;
    my $TT = Template->new(INTERPOLATE => 1);
#    return $self->SUPER::new({engine => $TT, prefix => '=', @_});
    return $self->SUPER::new({engine => $TT, @_});
}

sub process {
    my $self = shift;
    my $tt = shift;
    my $vars = shift;

    if (!ref $tt) {
        return $self->process_s($tt, $vars);
    } elsif (ref $tt eq 'ARRAY') {
        return $self->process_a($tt, $vars);
    } elsif (ref $tt eq 'HASH') {
        return $self->process_h($tt, $vars);
    } else {
        die 'burp'
    }
}

sub process_h {
    my $self = shift;
    my $h = shift;
    my $vars = shift;

    my %ph = ();
    while (my ($k, $v) = each %$h) {
        $k = $self->process_s($k, $vars);
        $v = $self->process($v, $vars);
        $ph{$k} = $v;
    }
    return \%ph;
}

sub process_a {
    my $self = shift;
    my $a = shift;
    my $vars = shift;

    my @pa;
    foreach (@$a) {
        push @pa, $self->process($_, $vars);
    }
    return \@pa;
}

=begin private

    ($p, $t) = $self->_split_scalar($s)

Determines if C<$s> is a plain scalar or
a text template. If it is a plain scalar,
C<$p> gets its content and C<$t> gets C.
Otherwise, C<$p> is C and C<$t>
gets the contents of the template.

There is difference between C<$s> and
the content of C<$s> only if there is a
C. In this case, a plain scalar
is (1) one which does not begin with the prefix
(the content is C<$s> itself) or (2)
one which begins with C<"\\"> followed
by the prefix (the content is C<$s> without
the leading escape). When there is
a prefix, C<$s> is a template if it begins
with the prefix and its content is C<$s>
without the prefix.

    # say prefix is '='
    ($p, $t) = $tt->_split_scalar('foo')
    # ($p, $t) = ('foo', undef)
    ($p, $t) = $tt->_split_scalar('=foo')
    # ($p, $t) = (undef, 'foo')
    ($p, $t) = $tt->_split_scalar('\\=foo')
    # ($p, $t) = ('=foo', undef)

=end private

=cut

sub _split_scalar {
    my $self = shift;
    my $s = shift;
    my $prefix = $self->prefix;
    if ($prefix) {
        if ($s =~ s/^\Q$prefix\E//) { # it is a template
            return (undef, $s);
        } else {
            $s =~ s/^\\(\Q$prefix\E)/$1/; # chomp the leading escape
            return ($s, undef);
        }
    }
    # by now everything else looks like a template
    return (undef, $s);
}

sub process_s {
    my $self = shift;
    my $s = shift;
    my $vars = shift;

    my ($p, $t) = $self->_split_scalar($s);
    return $p if defined $p;

    my $ps;
    $self->engine->process(\$t, $vars, \$ps)
        or die $self->engine->error();
    return $ps;


}

1;

__END__