File Coverage

blib/lib/Template/Plugin/Perl.pm

Criterion	Covered	Total	%
statement	42	47	89.3
branch	6	10	60.0
condition			n/a
subroutine	9	10	90.0
pod	3	3	100.0
total	60	70	85.7

package Template::Plugin::Perl;

use strict;
use warnings;

use Data::Dumper;
use Template::Plugin;
use base qw( Template::Plugin );
use vars qw( $AUTOLOAD $VERSION );

$VERSION = '0.06';

$Data::Dumper::Indent = 0;
*throw = \&Template::Plugin::Perl::throw;

sub new {
    my ($class, $context, $params) = @_;
    bless {
	    _context => $context,
    }, $class;
}

my $entered = 0;

sub AUTOLOAD {
    my $self = shift;
    my $method = $AUTOLOAD;
    #warn "$method";

    $method =~ s/.*:://;
    return if $method eq 'DESTROY';

    #warn "\@_ = @_\n";
    if ($entered == 1) {
        die("$method not found\n");
    }
    my @args;
    foreach my $arg (@_) {
        my $code = Data::Dumper->Dump([$arg], ['args']);
        $code =~ s/^\s*\$args\s*=\s*(.*);\s*$/$1/s;
        $code =~ s/^\[(.*)\]\s*$/$1/s;
        push @args, $code;
    }
    my $code = "$method(".join(',', @args).")";
    #warn "code: $code\n";
    $entered = 1;
    my @retval = eval $code;
    $entered = 0;
    if ($@) {
        $self->throw("Perl built-in function error: $@");
    }
    if (!@retval) { return (); }
    if (@retval == 1) { $retval[0] }
    else { \@retval };
}

sub throw {
    my $self = shift;
    die (Template::Exception->new('Plugin Perl', join(', ', @_)));
}

sub pow {
    shift;
    return $_[0] ** $_[1];
}

1;
__END__