The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Inline::TT;

use strict;
use vars qw($VERSION);
$VERSION = 0.02;

use base qw(Inline);
use IO::File;
use Template::Parser;

sub croak { require Carp; Carp::croak(@_) }

#--------------------------------------------------
# Inline APIs
#--------------------------------------------------

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

sub validate { }

sub build {
    my $self = shift;
    my $code = $self->__compile($self->{API}->{code});
    my $path = "$self->{API}->{install_lib}/auto/$self->{API}->{modpname}";
    $self->mkpath($path) unless -d $path;

    my $obj = $self->{API}->{location};
    my $out = IO::File->new("> $obj") or die "$obj: $!";
    $out->print($code);
    $out->close;
}


sub load {
    my $self = shift;
    my $obj  = $self->{API}->{location};
    my $in   = IO::File->new($obj) or die "$obj: $!";
    my $code = do { local $/; <$in> };
    $in->close;

    eval "package $self->{API}->{pkg};$code;";
    croak $@ if $@;
}

sub info { }

#--------------------------------------------------
# private methods
#--------------------------------------------------

sub __compile {
    my($self, $text) = @_;
    my $parser   = Template::Parser->new({ PRE_CHOMP => 1 });
    my $content  = $parser->parse($text) or croak $parser->error;
    my $document = $self->__document($content);

    my $subs;
    for my $block (keys %{$content->{DEFBLOCKS}}) {
	$subs .= <<BLOCK;
sub $block {
    my(\%args) = \@_;
     \$Context->include(\$Context->template('$block'), \\\%args);
}

BLOCK
    }

    return <<CODE;
#------------------------------------------------------------------------
# Compiled template generated by the Inline::TT version $VERSION
#------------------------------------------------------------------------

use Template::Context;
use Template::Document;

my \$Doc = $document
my \$Context = Template::Context->new;
\$Context->visit(\$Doc->{_DEFBLOCKS});

$subs
CODE
    ;
}

sub __document {
    my($self, $content) = @_;

    # just pasted from Template::Document::write_perl_file
    my ($block, $defblocks, $metadata) =
        @$content{ qw( BLOCK DEFBLOCKS METADATA ) };
    my $pkg = "'Template::Document'";

    $defblocks = join('',
                      map { "'$_' => $defblocks->{ $_ },\n" }
                      keys %$defblocks);

    $metadata = join('',
		     map {
			 my $x = $metadata->{ $_ };
			 $x =~ s/(['\\])/\\$1/g;
			 "'$_' => '$x',\n";
		     } keys %$metadata);

    return  <<EOF;
bless {
$metadata
_HOT       => 0,
_BLOCK     => $block,
_DEFBLOCKS => {
$defblocks
},
}, $pkg;
EOF
    ;
}

1;
__END__

=head1 NAME

Inline::TT - use TT BLOCK as your Perl sub

=head1 SYNOPSIS

  use Inline 'TT';

  print add(args => [ 0, 1 ]);                      # 1
  print rubyish(str => "Just another Perl Hacker"); # "Just/another/Ruby/hacker"

  __END__
  __TT__
  [% BLOCK add %]
  [% result = 0 %]
  [% FOREACH arg = args %]
    [% result = result + arg %]
  [% END %]
  [% result %]
  [% END %]

  [% BLOCK rubyish %]
  [% strings = str.split(' ')
     strings.2 = "Ruby"
  %]
  [% strings.join('/') %]
  [% END %]

=head1 DESCRIPTION

Template-Toolkit is not just a Templating Engine. It's a
B<language>. Yep, Inline::TT is a Inline plugin to allow you to code
your Perl subs in TT.

=head1 AUTHOR

Original idea by IKEBE Tomohiro E<lt>ikechin@0xfa.comE<gt>

Code implemented by Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<Template>, L<Inline>

=cut