File Coverage

blib/lib/Inline/TT.pm

Criterion	Covered	Total	%
statement	59	81	72.8
branch	6	12	50.0
condition			n/a
subroutine	13	17	76.4
pod	1	6	16.6
total	79	116	68.1

package Inline::TT;
use strict; use warnings;

use Carp;

use Storable qw( store retrieve );
# Storable is used to store/retrieve the compiled template on disk

use Template::Parser;
use Template::Document;
use Template::Context;
use Template::Stash;

our $TRIM_LEADING_SPACE  = 'TRIM_LEADING_SPACE';
our $TRIM_TRAILING_SPACE = 'TRIM_TRAILING_SPACE';

our $VERSION    = '0.07';
our @ISA        = qw( Inline );
our %default_inline_tt_option_for = (
        $TRIM_LEADING_SPACE  => 1,
        $TRIM_TRAILING_SPACE => 1,
);

# To understand the methods here it helps to read the Inline API docs:
# http://search.cpan.org/~ingy/Inline-0.44/Inline-API.pod

sub register {
    return {
        language        => 'TT',
        aliases	        => [ qw( tt template ) ],
        type	        => 'interpreted',
        suffix	        => 'tt2',
    };
}

# TRIM_LEADING_SPACES and TRIM_TRAILING_SPACES are valid options.  They
# both default to 1.  All other options are passed directly to TT.
sub validate {
    my $o          = shift;
    my %option_for = @_;

    foreach my $option ( keys %default_inline_tt_option_for ) {
        if ( defined $option_for{$option} ) {

            $o->{ILSM}{Inline_TT_options}{$option} = $option_for{$option};

            delete $option_for{$option};

        }
        else {
            $o->{ILSM}{Inline_TT_options}{$option}
            = $default_inline_tt_option_for{$option};
        }
    }

    $o->{ILSM}{TT_options} = {};

    foreach my $option ( keys %option_for ) {
        $o->{ILSM}{TT_options}{$option} = $option_for{$option};
    }
}

# To provide any useful information, we must rehydrate the stored object.
# This is not really a problem, since this method is not likely called in
# production.
#
# XXX This does not work for the first invocation.  That's bad, since
# that's the most likely one to request info.
sub info {
    my $o       = shift;
    my $obj     = $o->{API}{location};
    my $retval;

    eval {
        # retrieve is exported from Storable
        my $tt_code     = retrieve( $obj );
        my $document    = Template::Document->new( $tt_code );
        my $blocks      = join( "\n  ", sort keys %{$document->{_DEFBLOCKS}} );

        $retval	        = "The following tt2 blocks have been bound as subs:"
            . "\n  $blocks\n";
    };

    # If the _Inline directory is not yet built, this error will occur.
    if ( $@ ) {
        $retval = "Rerun, without deleting _Inline, to see INFO.\n";
    }

    return $retval;
}

sub working_info { return "no useful info, sorry\n"; }

# This build receives $code from the template object $o, parses it,
# makes a path for it and stores it.  This handles all the BLOCKS at once.
# Inline will only call this if the md5sum of the input template does not
# match one that is available in the _Inline directory (or its moral
# equivalent).  Otherwise, it will only call load below.
sub build {
    my $o       = shift;
    my $code    = $o->{API}{code};

    my $parser  = Template::Parser->new( $o->{ILSM}{TT_options} );
    my $content = $parser->parse( $code );

    my $path    = "$o->{API}{install_lib}/auto/$o->{API}{modpname}";
    my $obj     = $o->{API}{location};

    $o->mkpath( $path ) unless -d $path;

    store( $content, $obj );  # from Storable
}

# This routine rehydrates the parsed Template object which was originally
# generated by build.  This happens each time the program runs.  After the
# the parsed object it reconstituted, load turns it into a document.
# Each key in that document's _DEFBLOCKS list is made a sub in the caller's
# package.  No, we really shouldn't be peeking inside to the _DEFBLOCKS
# level, but I couldn't find the relavent API.
sub load {
    my $o        = shift;
    my $obj      = $o->{API}{location};

    my $tt_code  = retrieve( $obj );  # from Storable
    my $document = Template::Document->new( $tt_code );

    foreach my $sub ( keys %{$document->{_DEFBLOCKS}} ) {

        no strict 'refs';

        *{"$o->{API}{pkg}\::$sub"} = _make_block_sub( $sub, $document, $o );
    }

    croak "Unable to load TT module $obj:\n$@" if $@;
}

# _make_block_sub takes the name of a block and the document containing it
# and returns a closure for the block.  The closure expects a hash of values
# for template interpolation.  It always processes its block and only its
# block.  A lot of trimming happens.  Typically, no space is left for
# template directives.  Further, no leading or trailing spaces survive.
sub _make_block_sub {
    my $name    = shift;
    my $doc     = shift;
    my $o       = shift;

    return sub {
        my $args    = shift;

        my $stash   = Template::Stash->new( $args );
        my $context = Template::Context->new(
            {
                STASH  => $stash,
                TRIM   => 1,
                BLOCKS => $doc->{_DEFBLOCKS},
            }
        );

        my $retval  = $doc->{_DEFBLOCKS}{$name}( $context );

        if ( $o->{ILSM}{Inline_TT_options}{$TRIM_LEADING_SPACE} ) {
            $retval =~ s/^\s+//;
        }
        if ( $o->{ILSM}{Inline_TT_options}{$TRIM_TRAILING_SPACE} ) {
            $retval =~ s/\s+$//;
        }

        return $retval;
    }
}

1;
__END__