root/Inline-TT/trunk/lib/Inline/TT.pm

Revision 612 (checked in by miyagawa, 18 years ago)

Initial revision

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