root/lang/perl/Text-MicroTemplate/trunk/lib/Text/MicroTemplate.pm @ 26876

Revision 26876, 13.5 kB (checked in by kazuho, 5 years ago)

doc

Line 
1# modified for NanoA by kazuho, some modified by tokuhirom
2# based on Mojo::Template. Copyright (C) 2008, Sebastian Riedel.
3
4package Text::MicroTemplate;
5
6require Exporter;
7
8use strict;
9use warnings;
10use constant DEBUG => $ENV{MICRO_TEMPLATE_DEBUG} || 0;
11
12use Carp 'croak';
13
14our $VERSION = '0.03';
15our @ISA = qw(Exporter);
16our @EXPORT_OK = qw(encoded_string build_mt render_mt);
17our %EXPORT_TAGS = (
18    all => [ @EXPORT_OK ],
19);
20
21sub new {
22    my $class = shift;
23    my $self = bless {
24        code                => undef,
25        comment_mark        => '#',
26        expression_mark     => '=',
27        raw_expression_mark => '=r',
28        line_start          => '?',
29        template            => undef,
30        tree                => [],
31        tag_start           => '<?',
32        tag_end             => '?>',
33        escape_func         => 'Text::MicroTemplate::escape_html',
34        package_name        => undef, # defaults to caller
35        @_ == 1 ? ref($_[0]) ? %{$_[0]} : (template => $_[0]) : @_,
36    }, $class;
37    if (defined $self->{template}) {
38        $self->parse($self->{template});
39    }
40    unless (defined $self->{package_name}) {
41        $self->{package_name} = 'main';
42        my $i = 0;
43        while (my $c = caller(++$i)) {
44            if ($c !~ /^Text::MicroTemplate($|::)/) {
45                $self->{package_name} = $c;
46                last;
47            }
48        }
49    }
50    $self;
51}
52
53sub escape_func {
54    my $self = shift;
55    if (@_) {
56        $self->{escape_func} = shift;
57    }
58    $self->{escape_func};
59}
60
61sub package_name {
62    my $self = shift;
63    if (@_) {
64        $self->{package_name} = shift;
65    }
66    $self->{package_name};
67}
68
69sub template { shift->{template} }
70
71sub code {
72    my $self = shift;
73    unless (defined $self->{code}) {
74        $self->_build();
75    }
76    $self->{code};
77}
78
79sub _build {
80    my $self = shift;
81   
82    my $escape_func = $self->{escape_func} || '';
83   
84    # Compile
85    my @lines;
86    my $last_was_code;
87    for my $line (@{$self->{tree}}) {
88
89        # New line
90        push @lines, '';
91        for (my $j = 0; $j < @{$line}; $j += 2) {
92            my $type  = $line->[$j];
93            my $value = $line->[$j + 1];
94
95            # Need to fix line ending?
96            my $newline = chomp $value;
97
98            # add semicolon to last line of code
99            if ($last_was_code && $type ne 'code') {
100                $lines[-1] .= ';';
101                undef $last_was_code;
102            }
103
104            # Text
105            if ($type eq 'text') {
106
107                # Quote and fix line ending
108                $value = quotemeta($value);
109                $value .= '\n' if $newline;
110
111                $lines[-1] .= "\$_MT .= \"" . $value . "\";";
112            }
113
114            # Code
115            if ($type eq 'code') {
116                $lines[-1] .= $value;
117                $last_was_code = 1;
118            }
119
120            # Expression
121            if ($type eq 'expr') {
122                $lines[-1] .= "\$_MT_T = scalar $value; \$_MT .= ref \$_MT_T eq 'Text::MicroTemplate::EncodedString' ? \$\$_MT_T : $escape_func(\$_MT_T);";
123            }
124
125            # Raw Expression
126            if ($type eq 'raw_expr') {
127               
128                $lines[-1] .= "\$_MT_T = $value; \$_MT .= ref \$_MT_T eq q(Text::MicroTemplate::EncodedString) ? \$\$_MT_T : \$_MT_T;";
129            }
130        }
131    }
132
133    # add semicolon to last line of code
134    if ($last_was_code) {
135        $lines[-1] .= ';';
136    }
137   
138    # Wrap
139    $lines[0] ||= '';
140    $lines[0]   = q/sub { my $_MT = ''; my $_MT_T = '';/ . $lines[0];
141    $lines[-1] .= q/return $_MT; }/;
142
143    $self->{code} = join "\n", @lines;
144    return $self;
145}
146
147# I am so smart! I am so smart! S-M-R-T! I mean S-M-A-R-T...
148sub parse {
149    my ($self, $tmpl) = @_;
150    $self->{template} = $tmpl;
151
152    # Clean start
153    delete $self->{tree};
154    delete $self->{code};
155
156    # Tags
157    my $line_start    = quotemeta $self->{line_start};
158    my $tag_start     = quotemeta $self->{tag_start};
159    my $tag_end       = quotemeta $self->{tag_end};
160    my $cmnt_mark     = quotemeta $self->{comment_mark};
161    my $expr_mark     = quotemeta $self->{expression_mark};
162    my $raw_expr_mark = quotemeta $self->{raw_expression_mark};
163
164    # Tokenize
165    my $state = 'text';
166    my $multiline_expression = 0;
167    my @lines = split /(\n)/, $tmpl;
168    while (@lines) {
169        my $line = shift @lines;
170        my $newline = undef;
171        if (@lines) {
172            shift @lines;
173            $newline = 1;
174        }
175       
176        # Perl line without return value
177        if ($line =~ /^$line_start\s+(.*)$/) {
178            push @{$self->{tree}}, ['code', $1];
179            $multiline_expression = 0;
180            next;
181        }
182
183        # Perl line with return value
184        if ($line =~ /^$line_start$expr_mark\s+(.+)$/) {
185            push @{$self->{tree}}, [
186                'expr', $1,
187                $newline ? ('text', "\n") : (),
188            ];
189            $multiline_expression = 0;
190            next;
191        }
192
193        # Perl line with raw return value
194        if ($line =~ /^$line_start$raw_expr_mark\s+(.+)$/) {
195            push @{$self->{tree}}, [
196                'raw_expr', $1,
197                $newline ? ('text', "\n") : (),
198            ];
199            $multiline_expression = 0;
200            next;
201        }
202
203        # Comment line, dummy token needed for line count
204        if ($line =~ /^$line_start$cmnt_mark\s+$/) {
205            push @{$self->{tree}}, [];
206            $multiline_expression = 0;
207            next;
208        }
209
210        # Escaped line ending?
211        if ($line =~ /(\\+)$/) {
212            my $length = length $1;
213
214            # Newline escaped
215            if ($length == 1) {
216                $line =~ s/\\$//;
217            }
218
219            # Backslash escaped
220            if ($length >= 2) {
221                $line =~ s/\\\\$/\\/;
222                $line .= "\n";
223            }
224        }
225
226        # Normal line ending
227        else { $line .= "\n" if $newline }
228
229        # Mixed line
230        my @token;
231        for my $token (split /
232            (
233                $tag_start$raw_expr_mark # Raw Expression
234            |
235                $tag_start$expr_mark     # Expression
236            |
237                $tag_start$cmnt_mark     # Comment
238            |
239                $tag_start               # Code
240            |
241                $tag_end                 # End
242            )
243        /x, $line) {
244
245            # Garbage
246            next unless $token;
247
248            # End
249            if ($token =~ /^$tag_end$/) {
250                $state = 'text';
251                $multiline_expression = 0;
252            }
253
254            # Code
255            elsif ($token =~ /^$tag_start$/) { $state = 'code' }
256
257            # Comment
258            elsif ($token =~ /^$tag_start$cmnt_mark$/) { $state = 'cmnt' }
259
260            # Raw Expression
261            elsif ($token =~ /^$tag_start$raw_expr_mark$/) {
262                $state = 'raw_expr';
263            }
264
265            # Expression
266            elsif ($token =~ /^$tag_start$expr_mark$/) {
267                $state = 'expr';
268            }
269
270            # Value
271            else {
272
273                # Comments are ignored
274                next if $state eq 'cmnt';
275
276                # Multiline expressions are a bit complicated,
277                # only the first line can be compiled as 'expr'
278                $state = 'code' if $multiline_expression;
279                $multiline_expression = 1
280                    if $state eq 'expr' || $state eq 'raw_expr';
281
282                # Store value
283                push @token, $state, $token;
284            }
285        }
286        push @{$self->{tree}}, \@token;
287    }
288   
289    return $self;
290}
291
292sub _context {
293    my ($self, $text, $line) = @_;
294    my @lines  = split /\n/, $text;
295   
296    join '', map {
297        0 < $_ && $_ <= @lines ? sprintf("%4d: %s\n", $_, $lines[$_ - 1]) : ''
298    } ($line - 2) .. ($line + 2);
299}
300
301# Debug goodness
302sub _error {
303    my ($self, $error, $line_offset, $from) = @_;
304   
305    # Line
306    if ($error =~ /^(.*)\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)/) {
307        my $reason = $1;
308        my $line   = $2 - $line_offset;
309        my $delim  = '-' x 76;
310       
311        my $report = "$reason at line $line in template passed from $from.\n";
312        my $template = $self->_context($self->{template}, $line);
313        $report .= "$delim\n$template$delim\n";
314
315        # Advanced debugging
316        if (DEBUG) {
317            my $code = $self->_context($self->code, $line);
318            $report .= "$code$delim\n";
319            $report .= $error;
320        }
321
322        return $report;
323    }
324
325    # No line found
326    return "Template error: $error";
327}
328
329# create raw string (that does not need to be escaped)
330sub encoded_string {
331    Text::MicroTemplate::EncodedString->new($_[0]);
332}
333
334sub escape_html {
335    my $str = shift;
336    return $str->as_string
337        if ref $str eq 'Text::MicroTemplate::EncodedString';
338    $str =~ s/&/&amp;/g;
339    $str =~ s/>/&gt;/g;
340    $str =~ s/</&lt;/g;
341    $str =~ s/"/&quot;/g;
342    $str =~ s/'/&#39;/g;
343    return $str;
344}
345
346sub build_mt {
347    my $mt = Text::MicroTemplate->new(@_);
348    $mt->build();
349}
350
351sub build {
352    my $_mt = shift;
353    my $_code = $_mt->code;
354    my $_from = sub {
355        my $i = 0;
356        while (my @c = caller(++$i)) {
357            return "$c[1] at line $c[2]"
358                if $c[0] ne __PACKAGE__;
359        }
360        '';
361    }->();
362    my $expr = << "...";
363package $_mt->{package_name};
364sub {
365    local \$SIG{__WARN__} = sub { print STDERR \$_mt->_error(shift, 4, \$_from) };
366    Text::MicroTemplate::encoded_string((
367        $_code
368    )->(\@_));
369}
370...
371    my $die_msg;
372    {
373        local $@;
374        if (my $_builder = eval($expr)) {
375            return $_builder;
376        }
377        $die_msg = $_mt->_error($@, 4, $_from);
378    }
379    die $die_msg;
380}
381
382sub render_mt {
383    my $builder = build_mt(shift);
384    $builder->(@_);
385}
386
387package Text::MicroTemplate::EncodedString;
388
389use strict;
390use warnings;
391
392sub new {
393    my ($klass, $str) = @_;
394    bless \$str, $klass;
395}
396
397sub as_string {
398    my $self = shift;
399    $$self;
400}
401
4021;
403__END__
404
405=head1 NAME
406
407Text::MicroTemplate
408
409=head1 SYNOPSIS
410
411    use Text::MicroTemplate qw(:all);
412
413    # compile template, and render
414    $renderer = build_mt('hello, <?= $_[0] ?>');
415    $html = $renderer->('John')->as_string;
416
417    # or in one line
418    $html = render_mt('hello, <?= $_[0] ?>', 'John')->as_string;
419
420    # complex form
421    $mt = Text::MicroTemplate->new(
422        template => 'hello, <?= $query->param('user') ?>,
423    );
424    $code = $mt->code;
425    $renderer = eval << "..." or die $@;
426    sub {
427        my \$query = shift;
428        $code->();
429    }
430    ...
431    $html = $renderer->(CGI->new)->as_string;
432
433=head1 DESCRIPTION
434
435Text::MicroTemplate is a standalone, fast, intelligent, extensible template engine with following features.
436
437=head2 standalone
438
439Text::MicroTemplate does not rely on other CPAN modules.
440
441=head2 fast
442
443Based on L<Mojo::Template>, expressions in the template is perl code.
444
445=head2 intelligent
446
447Text::MicroTemplate automatically escapes variables when and only when necessary.
448
449=head2 extensible
450
451Text::MicroTemplate does not provide features like template cache or including other files by itself.  However, it is easy to add you own (that suites the most to your application), by wrapping the result of the module (which is a perl expression).
452
453The module only provides basic building blocks for a template engine.  Refer to L<Text::MicroTemplate::File> for higher-level interface.
454
455=head1 TEMPLATE SYNTAX
456
457    # output the result of expression with automatic escape
458    <?= $expr ?>             (tag style)
459    ?= $expr                 (per-line)
460
461    # output the result expression without escape (tag style)
462    <?=r $raw_str ?>
463    ?=r $raw_str
464
465    # execute perl code (tag style)
466    <? foo() ?>
467    ? foo()
468
469    # comment (tag style)
470    <?# comment ?>
471    ?# comment
472
473    # loops
474    <ul>
475    ? for my $item (@list) {
476    <li><?= $item ?></li>
477    ? }
478    </ul>
479
480=head1 EXPORTABLE FUNCTIONS
481
482=head2 build_mt($template)
483
484Returns a subref that renders given template.  Parameters are equivalent to Text::MicroTemplate->new.
485
486    # build template renderer at startup time and use it multiple times
487    my $renderer = build_mt('hello, <?= $_[0] ?>!');
488
489    sub run {
490        ...
491        my $hello = $renderer->($query->param('user'));
492        ...
493    }
494
495=head2 render_mt($template, @args)
496
497Utility function that combines build_mt and call to the generated template builder.
498
499    # render
500    $hello = render_mt('hello, <?= $_[0] ?>!', 'John');
501
502    # print as HTML
503    print $hello->as_string;
504
505    # use the result in another template (no double-escapes)
506    $enc = render_mt('<h1><?= $_[0] ?></h1>', $hello);
507
508Intertally, the function is equivalent to:
509
510    build_mt($template)->(@_);
511
512=head2 encoded_string($str)
513
514wraps given string to an object that will not be escaped by the template engine
515
516=head1 OO-STYLE INTERFACE
517
518Text::MicroTemplate provides OO-style interface to handle more complex cases.
519
520=head2 new($template)
521
522=head2 new(%args)
523
524=head2 new(\%args)
525
526Constructs template renderer.  In the second or third form, parameters below are recognized.
527
528=head3 template
529
530template string (mandatory)
531
532=head3 escape_func
533
534escape function (defaults to L<Text::MicroTemplate::escape_html>), no escape when set to undef
535
536=head3 package_name
537
538package under where the renderer is compiled (defaults to caller package)
539
540=head2 code()
541
542returns perl code that renders the template when evaluated
543
544=head1 SEE ALSO
545
546L<Text::MicroTemplate::File>
547
548=head1 AUTHOR
549
550Kazuho Oku E<lt>kazuhooku gmail.comE<gt>
551
552Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF GMAIL COME<gt>
553
554The module is based on L<Mojo::Template> by Sebastian Riedel.
555
556=head1 LICENSE
557
558This program is free software, you can redistribute it and/or modify it under the same terms as Perl 5.10.
559
560=cut
Note: See TracBrowser for help on using the browser.