The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::Amazon::MechanicalTurk::Template::PerlTemplate;
use strict;
use warnings;
use Carp;
use IO::File;
use IO::String;
use Net::Amazon::MechanicalTurk::Template;

our $VERSION = '1.01_01';

our @ISA = qw{ Net::Amazon::MechanicalTurk::Template };

Net::Amazon::MechanicalTurk::Template::PerlTemplate->attributes(qw{
    compiledSub
});

sub compileSource {
    my ($self, $text) = @_;
    
    # Wrap the code in an anonymouse sub, so it only has to be eval'd once.
    my $perlSource =
        "return sub {\n" .
        "    my \$out = shift;\n" .
        "    my \%params = \%{\$_[0]};\n" .
        $text . "\n" .
        "}\n";

    $self->compiledSub(Net::Amazon::MechanicalTurk::Template::PerlTemplate::CompiledNameSpace::__compileSub__(
        $perlSource,
        $self->templateFile
    ));
    $self->compiled(1);
}

sub merge {
    my ($self, $params) = @_;
    my $out = IO::String->new;
    my $oldFh = select($out);
    eval {
        $self->compiledSub->($out, $params);
    };
    if ($@) {
        my $error = $@;
        select($oldFh);
        Carp::croak("Error executing perl template " . $self->templateFile . " - $error.");
    }
    select($oldFh);
    return ${$out->string_ref};
}

package Net::Amazon::MechanicalTurk::Template::PerlTemplate::CompiledNameSpace;

our $VERSION = '1.01_01';

# provides a package to be used for evaluating code.
# A perl template may declare subs.  If they are not qualified they will end up 
# in here.
# 
# WARNING:
#   If a user compiles more than 1 template where more than 1 template has
#   has a common subroutine name, then the last compiled template will be the
#   one providing the implementation of the sub, for all templates.
#

sub __compileSub__ {
    # Use funky variable names to avoid clashing with template variables.
    my $__perlSource__ = shift;
    my $__perlSourceFile__ = shift;
    no warnings;
    my $__perlSub__ = eval $__perlSource__;
    if ($@) {
        Carp::croak("Couldn't compile perl source from $__perlSourceFile__ - $@.");
    }
    if (!UNIVERSAL::isa($__perlSub__, "CODE")) {
        Carp::croak("Couldn't find compiled code in perl source $__perlSourceFile__.");
    }
    return $__perlSub__;
}

return 1;