1: Fun thing, or module for (by) nut.<P>
   2: 
   3: Inline::TT allows you to define your Perl code with Template Toolkit's BLOCK syntax. You can get the tarball <A href="http://bulknews.net/lib/archives/">here</A>.<P>
   4: 
   5: <CODE>
   6: package Inline::TT;
   7: 
   8: use strict;
   9: use vars qw($VERSION);
  10: $VERSION = 0.01;
  11: 
  12: use base qw(Inline);
  13: use IO::File;
  14: use Template::Parser;
  15: 
  16: sub croak { require Carp; Carp::croak(@_) }
  17: 
  18: #--------------------------------------------------
  19: # Inline APIs
  20: #--------------------------------------------------
  21: 
  22: sub register {
  23:     return {
  24: 	language => 'TT',
  25: 	aliases  => [ qw(tt) ],
  26: 	type     => 'interpreted',
  27: 	suffix   => 'tt',
  28:     };
  29: }
  30: 
  31: sub validate { }
  32: 
  33: 
  34: 
  35: sub build {
  36:     my $self = shift;
  37:     my $code = $self->__compile($self->{API}->{code});
  38:     my $path = "$self->{API}->{install_lib}/auto/$self->{API}->{modpname}";
  39:     $self->mkpath($path) unless -d $path;
  40: 
  41:     my $obj = $self->{API}->{location};
  42:     my $out = IO::File->new("> $obj") or die "$obj: $!";
  43:     $out->print($code);
  44:     $out->close;
  45: }
  46: 
  47: 
  48: sub load {
  49:     my $self = shift;
  50:     my $obj  = $self->{API}->{location};
  51:     my $in   = IO::File->new($obj) or die "$obj: $!";
  52:     my $code = do { local $/; <$in> };
  53:     $in->close;
  54: 
  55:     eval "package $self->{API}->{pkg};$code;";
  56:     croak $@ if $@;
  57: }
  58: 
  59: sub info { }
  60: 
  61: #--------------------------------------------------
  62: # private methods
  63: #--------------------------------------------------
  64: 
  65: sub __compile {
  66:     my($self, $text) = @_;
  67:     my $parser   = Template::Parser->new({ PRE_CHOMP => 1, POST_CHOMP => 1 });
  68:     my $content  = $parser->parse($text) or croak $parser->error;
  69:     my $document = $self->__document($content);
  70: 
  71:     my $subs;
  72:     for my $block (keys %{$content->{DEFBLOCKS}}) {
  73: 	$subs .= <<BLOCK;
  74: sub $block {
  75:     my(\%args) = \@_;
  76:      \$Context->include(\$Context->template('$block'), \\\%args);
  77: }
  78: 
  79: BLOCK
  80:     }
  81: 
  82:     return <<CODE;
  83: #------------------------------------------------------------------------
  84: # Compiled template generated by the Inline::TT version $VERSION
  85: #------------------------------------------------------------------------
  86: 
  87: use Template::Context;
  88: use Template::Document;
  89: 
  90: my \$Doc = $document
  91: my \$Context = Template::Context->new;
  92: \$Context->visit(\$Doc->{_DEFBLOCKS});
  93: 
  94: $subs
  95: CODE
  96:     ;
  97: }
  98: 
  99: sub __document {
 100:     my($self, $content) = @_;
 101: 
 102:     # just pasted from Template::Document::write_perl_file
 103:     my ($block, $defblocks, $metadata) =
 104:         @$content{ qw( BLOCK DEFBLOCKS METADATA ) };
 105:     my $pkg = "'Template::Document'";
 106: 
 107:     $defblocks = join('',
 108:                       map { "'$_' => $defblocks->{ $_ },\n" }
 109:                       keys %$defblocks);
 110: 
 111:     $metadata = join('',
 112: 		     map {
 113: 			 my $x = $metadata->{ $_ };
 114: 			 $x =~ s/(['\\])/\\$1/g;
 115: 			 "'$_' => '$x',\n";
 116: 		     } keys %$metadata);
 117: 
 118:     return  <<EOF;
 119: bless {
 120: $metadata
 121: _HOT       => 0,
 122: _BLOCK     => $block,
 123: _DEFBLOCKS => {
 124: $defblocks
 125: },
 126: }, $pkg;
 127: EOF
 128:     ;
 129: }
 130: 
 131: 1;
 132: __END__
 133: 
 134: =head1 NAME
 135: 
 136: Inline::TT - use TT BLOCK as your Perl sub
 137: 
 138: =head1 SYNOPSIS
 139: 
 140:   use Inline 'TT';
 141: 
 142:   print add(args => [ 0, 1 ]);                      # 1
 143:   print rubyish(str => "Just another Perl Hacker"); # "Just/another/Ruby/hacker"
 144: 
 145:   __END__
 146:   __TT__
 147:   [% BLOCK add %]
 148:   [% result = 0 %]
 149:   [% FOREACH arg = args %]
 150:     [% result = result + arg %]
 151:   [% END %]
 152:   [% result %]
 153:   [% END %]
 154: 
 155:   [% BLOCK rubyish %]
 156:   [% strings = str.split(' ')
 157:      strings.2 = "Ruby"
 158:   %]
 159:   [% strings.join('/') %]
 160:   [% END %]
 161: 
 162: =head1 DESCRIPTION
 163: 
 164: Template-Toolkit is not just a Templating Engine. It's a
 165: B<language>. Yep, Inline::TT is a Inline plugin to aloow you to code
 166: your Perl subs in TT.
 167: 
 168: =head1 AUTHOR
 169: 
 170: Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
 171: 
 172: This library is free software; you can redistribute it and/or modify
 173: it under the same terms as Perl itself.
 174: 
 175: =head1 SEE ALSO
 176: 
 177: L<Template>, L<Inline>
 178: 
 179: =cut
 180: </CODE>
 181: <PRE>--
 182: Tatsuhiko Miyagawa
 183: <A href="mailto:miyagawa@cpan.org">miyagawa@cpan.org</A></PRE>