root/branches/release-26/lib/MT/Builder.pm @ 1174

Revision 1174, 19.5 kB (checked in by bchoate, 23 months ago)

Updated copyright year for source.

  • Property svn:keywords set to Author Date Id Revision
Line 
1# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
2# This program is distributed under the terms of the
3# GNU General Public License, version 2.
4#
5# $Id$
6
7package MT::Builder;
8
9use strict;
10use base qw( MT::ErrorHandler );
11
12use constant NODE => 'MT::Template::Node';
13
14sub new { bless { }, $_[0] }
15
16sub compile {
17    my $build = shift;
18    my($ctx, $text, $opt) = @_;
19    my $tmpl;
20
21    $opt ||= { uncompiled => 1 };
22    my $depth = $opt->{depth} ||= 0;
23
24    my $ids;
25    my $classes;
26    my $errors;
27
28    # handle $builder->compile($template) signature
29    if (UNIVERSAL::isa($ctx, 'MT::Template')) {
30        $tmpl = $ctx;
31        $ctx = $tmpl->context;
32        $text = $tmpl->text;
33        $tmpl->reset_tokens();
34        $ids = $build->{__state}{ids} = {};
35        $classes = $build->{__state}{classes} = {};
36        $errors = $build->{__state}{errors} = [];
37        $build->{__state}{tmpl} = $tmpl;
38    } else {
39        $ids = $build->{__state}{ids} || {};
40        $classes = $build->{__state}{classes} || {};
41        $tmpl = $build->{__state}{tmpl};
42        $errors = $build->{__state}{errors} ||= [];
43    }
44
45    return [ ] unless defined $text;
46
47    my $mods;
48
49    # Translate any HTML::Template markup into native MT syntax.
50    if ($text =~ m/<(?:MT_TRANS\b|MT_ACTION\b|(?:tmpl_(?:if|loop|unless|else|var|include)))/i) {
51        translate_html_tmpl($text);
52    }
53
54    my $state = $build->{__state};
55    local $state->{tokens} = [];
56    local $state->{classes} = $classes;
57    local $state->{tmpl} = $tmpl;
58    local $state->{ids} = $ids;
59    local $state->{text} = \$text;
60
61    my $pos = 0;
62    my $len = length $text;
63    # MT tag syntax: <MTFoo>, <$MTFoo$>, <$MTFoo>
64    #                <MT:Foo>, <$MT:Foo>, <$MT:Foo$>
65    #                <MTFoo:Bar>, <$MTFoo:Bar>, <$MTFoo:Bar$>
66    # For 'function' tags, the '$' characters are optional
67    # For namespace, the ':' is optional for the default 'MT' namespace.
68    # Other namespaces (like 'Foo') would require the colon.
69    # Tag and attributes are case-insensitive. So you can write:
70    #   <mtfoo>...</MTFOO>
71    while ($text =~ m!(<\$?(MT:?)((?:<[^>]+?>|"[^"]*?"|'[^']*?'|.)+?)[\$/]?>)!gis) {
72        my($whole_tag, $prefix, $tag) = ($1, $2, $3);
73        ($tag, my($args)) = split /\s+/, $tag, 2;
74        my $sec_start = pos $text;
75        my $tag_start = $sec_start - length $whole_tag;
76        _text_block($state, $pos, $tag_start) if $pos < $tag_start;
77        $args ||= '';
78        # Structure of a node:
79        #   tag name, attribute hashref, contained tokens, template text,
80        #       attributes arrayref, parent array reference
81        my $rec = bless [ $tag, \my %args, undef, undef, \my @args ], NODE;
82        while ($args =~ /
83            (?:
84                (?:
85                    (\w+)                           #1
86                    \s*=\s*
87                    (?:(?:
88                        (["'])                      #2
89                        ((?:<[^>]+?>|.)*?)          #3
90                        \2
91                        (                           #4
92                            (?:
93                                [,:]
94                                (["'])              #5
95                                (?:(?:<[^>]+?>|.)*?)
96                                \5
97                            )+
98                        )?
99                    ) |
100                    (\S+))                          #6
101                )
102            ) |
103            (\w+)                                   #7
104            /gsx) {
105            if (defined $7) {
106                # An unnamed attribute gets stored in the 'name' argument.
107                $args{'name'} = $7;
108            } else {
109                my $attr = lc $1;
110                my $value = defined $6 ? $6 : $3;
111                my $extra = $4;
112                if (defined $extra) {
113                    my @extra;
114                    push @extra, $2 while $extra =~ m/[,:](["'])((?:<[^>]+?>|.)*?)\1/gs;
115                    $value = [ $value, @extra ];
116                }
117                # We need a reference to the filters to check
118                # attributes and whether they need to be in the array of
119                # attributes for post-processing.
120                $mods ||= $ctx->{__filters};
121                push @args, [$attr, $value] if exists $mods->{$attr};
122                $args{$attr} = $value;
123                if ($attr eq 'id') {
124                    # store a reference to this token based on the 'id' for it
125                    $ids->{$3} = $rec;
126                } 
127                elsif ($attr eq 'class') {
128                    # store a reference to this token based on the 'id' for it
129                    $classes->{lc $3} ||= [];
130                    push @{ $classes->{lc $3} }, $rec;
131                }
132            }
133        }
134        my($h, $is_container) = $ctx->handler_for($tag);
135        if (!$h) {
136            # determine line #
137            my $pre_error = substr($text, 0, $tag_start);
138            my @m = $pre_error =~ m/\r?\n/g;
139            my $line = scalar @m;
140            if ($depth) {
141                $opt->{error_line} = $line;
142                push @$errors, { message => MT->translate("<[_1]> at line [_2] is unrecognized.", $prefix . $tag, "#"), line => $line };
143            } else {
144                push @$errors, { message => MT->translate("<[_1]> at line [_2] is unrecognized.", $prefix . $tag, $line + 1), line => $line };
145            }
146        }
147        if ($is_container) {
148            if ($whole_tag !~ m|/>$|) {
149                my ($sec_end, $tag_end) = _consume_up_to(\$text,$sec_start,$tag);
150                if ($sec_end) {
151                    my $sec = $tag =~ m/ignore/i ? '' # ignore MTIgnore blocks
152                            : substr $text, $sec_start, $sec_end - $sec_start;
153                    if ($sec !~ m/<\$?MT/i) {
154                        $rec->[2] = [ ($sec ne '' ? ['TEXT', $sec ] : ()) ];
155                    }
156                    else {
157                        local $opt->{depth} = $opt->{depth} + 1;
158                        local $opt->{parent} = $rec;
159                        $rec->[2] = $build->compile($ctx, $sec, $opt);
160                        if ( @$errors ) {
161                            my $pre_error = substr($text, 0, $sec_start);
162                            my @m = $pre_error =~ m/\r?\n/g;
163                            my $line = scalar @m;
164                            foreach (@$errors) {
165                                $line += $_->{line};
166                                $_->{line} = $line;
167                                $_->{message} =~ s/#/$line/;
168                            }
169                        }
170                        # unless (defined $rec->[2]) {
171                        #     my $pre_error = substr($text, 0, $sec_start);
172                        #     my @m = $pre_error =~ m/\r?\n/g;
173                        #     my $line = scalar @m;
174                        #     if ($depth) {
175                        #         $opt->{error_line} = $line + ($opt->{error_line} || 0);
176                        #         return;
177                        #     }
178                        #     else {
179                        #         $line += ($opt->{error_line} || 0) + 1;
180                        #         my $err = $build->errstr;
181                        #         $err =~ s/#/$line/;
182                        #         return $build->error($err);
183                        #     }
184                        # }
185                    }
186                    $rec->[3] = $sec if $opt->{uncompiled};
187                }
188                else {
189                    my $pre_error = substr($text, 0, $tag_start);
190                    my @m = $pre_error =~ m/\r?\n/g;
191                    my $line = scalar @m;
192                    if ($depth) {
193                        # $opt->{error_line} = $line;
194                        # return $build->error(MT->translate("<[_1]> with no </[_1]> on line #", $prefix . $tag));
195                        push @$errors, { message => MT->translate("<[_1]> with no </[_1]> on line [_2].", $prefix . $tag, "#" ), line => $line };
196                    }
197                    else {
198                        push @$errors, { message => MT->translate("<[_1]> with no </[_1]> on line [_2].", $prefix . $tag, $line +1 ), line => $line + 1 };
199                        # return $build->error(MT->translate("<[_1]> with no </[_1]> on line [_2]", $prefix . $tag, $line + 1));
200                    }
201                    last; # return undef;
202                }
203                $pos = $tag_end + 1;
204                (pos $text) = $tag_end;
205            }
206            else {
207                $rec->[3] = '';
208            }
209        }
210        $rec->[5] = $opt->{parent} || $tmpl;
211        $rec->[6] = $tmpl;
212        push @{ $state->{tokens} }, $rec;
213        $pos = pos $text;
214    }
215    _text_block($state, $pos, $len) if $pos < $len;
216    if (defined $tmpl) {
217        # assign token and id references to template
218        $tmpl->tokens($state->{tokens});
219        $tmpl->token_ids($state->{ids});
220        $tmpl->token_classes($state->{classes});
221        $tmpl->errors($state->{errors})
222            if $state->{errors} && (@{$state->{errors}});
223    }
224    return $state->{tokens};
225}
226
227sub translate_html_tmpl {
228    $_[0] =~ s!<(/?)tmpl_(if|loop|unless|else|var|include)\b!<$1mt:$2!ig;
229    $_[0] =~ s!<MT_TRANS\b!<__trans!ig;
230    $_[0] =~ s!<MT_ACTION\b!<__action!ig;
231}
232
233sub _consume_up_to {
234    my($text, $start, $stoptag) = @_;
235    my $pos;
236    (pos $$text) = $start;
237    while ($$text =~ m!(<([\$/]?)MT:?($stoptag)\b(?:[^>]*?)[\$/]?>)!gi) {
238        my($whole_tag, $prefix, $tag) = ($1, $2, $3);
239        my $end = pos $$text;
240        if ($prefix && ($prefix eq '/')) {
241            return ($end - length($whole_tag), $end);
242        } elsif ($whole_tag !~ m|/>|) {
243            my ($sec_end, $end_tag) = _consume_up_to($text, $end, $tag);
244            last if !$sec_end;
245            (pos $$text) = $end_tag;
246        }
247    }
248    # special case for unclosed 'else' tag:
249    if (lc($stoptag) eq 'else' || lc($stoptag) eq 'elseif') {
250        return ($start + length($$text), $start + length($$text));
251    }
252    return (0, 0);
253}
254
255sub _text_block {
256    my $text = substr ${ $_[0]->{text} }, $_[1], $_[2] - $_[1];
257    push @{ $_[0]->{tokens} }, bless [ 'TEXT', $text, undef, undef, undef, $_[0]->{tokens}, $_[0]->{tmpl} ], NODE
258        if (defined $text) && ($text ne '');
259}
260
261sub syntree2str {
262    my ($tokens, $depth) = @_;
263    my $string = '';
264    foreach my $t (@$tokens) {
265        my ($name, $args, $tokens, $uncompiled) = @$t;
266        $string .= (" " x $depth) .  $name;
267        if (ref $args eq 'HASH') {
268            $string .= join(", ", (map { " $_ => " . $args->{$_} }
269                                   (keys %$args)));
270        }
271
272        $string.= "\n";
273        $string .= syntree2str($tokens, $depth + 2);
274    }
275    return $string;
276}
277
278my $count=0;
279sub build {
280    my $build = shift;
281    my($ctx, $tokens, $cond) = @_;
282
283    #print STDERR syntree2str($tokens,0) unless $count++ == 1;
284
285    if ($cond) {
286        my %lcond;
287        # lowercase condtional keys since we're storing tags in lowercase now
288        %lcond = map { lc $_ => $cond->{$_} } keys %$cond;
289        $cond = \%lcond;
290    } else {
291        $cond = {};
292    }
293    $ctx->stash('builder', $build);
294    my $res = '';
295    my $ph = $ctx->post_process_handler;
296
297    for my $t (@$tokens) {
298        if ($t->[0] eq 'TEXT') {
299            $res .= $t->[1];
300        } else {
301            my($tokens, $tokens_else, $uncompiled);
302            my $tag = lc $t->[0];
303            if ($cond && (exists $cond->{ $tag } && !$cond->{ $tag })) {
304                # if there's a cond for this tag and it's false,
305                # walk the children and look for an MTElse.
306                # the children of the MTElse will become $tokens
307                for my $tok (@{ $t->[2] }) {
308                    if (lc $tok->[0] eq 'else' || lc $tok->[0] eq 'elseif') {
309                        $tokens = $tok->[2];
310                        $uncompiled = $tok->[3];
311                        last;
312                    }
313                }
314                next unless $tokens;
315            } else {
316                if ($t->[2] && ref($t->[2])) {
317                    # either there is no cond for this tag, or it's true,
318                    # so we want to partition the children into
319                    # those which are inside an else and those which are not.
320                    ($tokens, $tokens_else) = ([], []);
321                    for my $sub (@{ $t->[2] }) {
322                        if (lc $sub->[0] eq 'else' || lc $sub->[0] eq 'elseif') {
323                            push @$tokens_else, $sub;
324                        } else {
325                            push @$tokens, $sub;
326                        }
327                    }
328                }
329                $uncompiled = $t->[3];
330            }
331            my($h, $type) = $ctx->handler_for($t->[0]);
332            if ($h) {
333                my $start;
334                if ($MT::DebugMode & 8) {
335                    require Time::HiRes;
336                    $start = [ Time::HiRes::gettimeofday() ];
337                }
338                local($ctx->{__stash}{tag}) = $t->[0];
339                local($ctx->{__stash}{tokens}) = ref($tokens) ? bless $tokens, 'MT::Template::Tokens' : undef;
340                local($ctx->{__stash}{tokens_else}) = ref($tokens_else) ? bless $tokens_else, 'MT::Template::Tokens' : undef;
341                local($ctx->{__stash}{uncompiled}) = $uncompiled;
342                my %args = %{$t->[1]} if defined $t->[1];
343                my @args = @{$t->[4]} if defined $t->[4];
344
345                # process variables
346                foreach my $v (keys %args) {
347                    if (ref $args{$v} eq 'ARRAY') {
348                        foreach (@{$args{$v}}) {
349                            if (m/^\$([A-Za-z_](\w|\.)*)$/) {
350                                $_ = $ctx->var($1);
351                            }
352                        }
353                    } else {
354                        if ($args{$v} =~ m/^\$([A-Za-z_](\w|\.)*)$/) {
355                            $args{$v} = $ctx->var($1);
356                        }
357                    }
358                }
359                foreach (@args) {
360                    $_ = [ $_->[0], $_->[1] ];
361                    my $arg = $_;
362                    if (ref $arg->[1] eq 'ARRAY') {
363                        $arg->[1] = [ @{$arg->[1]} ];
364                        foreach (@{$arg->[1]}) {
365                            if (m/^\$([A-Za-z_](\w|\.)*)$/) {
366                                $_ = $ctx->var($1);
367                            }
368                        }
369                    } else {
370                        if ($arg->[1] =~ m/^\$([A-Za-z_](\w|\.)*)$/) {
371                            $arg->[1] = $ctx->var($1);
372                        }
373                    }
374                }
375
376                # Stores a reference to the ordered list of arguments,
377                # just in case the handler wants them
378                local $args{'@'} = \@args;
379                my $out = $h->($ctx, \%args, $cond);
380
381                unless (defined $out) {
382                    my $err = $ctx->errstr;
383                    if (defined $err) {
384                        return $build->error(MT->translate("Error in <mt:[_1]> tag: [_2]", $t->[0], $ctx->errstr));
385                    }
386                    else {
387                        # no error was given, so undef will mean '' in
388                        # such a scenario
389                        $out = '';
390                    }
391                }
392
393                if ((defined $type) && ($type == 2)) {
394                    # conditional; process result
395                    $out = $out ? $ctx->slurp(\%args, $cond) : $ctx->else(\%args, $cond);
396                    delete $ctx->{__stash}{vars}->{__value__};
397                    delete $ctx->{__stash}{vars}->{__name__};
398                }
399
400                $out = $ph->($ctx, \%args, $out, \@args)
401                    if %args && $ph;
402                $res .= $out
403                    if defined $out;
404                if ($MT::DebugMode & 8) {
405                    my $elapsed = Time::HiRes::tv_interval($start);
406                    print STDERR "Builder: Tag [" . $t->[0] . "] - $elapsed seconds\n" if $elapsed > 0.25;
407                }
408            } else {
409                if ($t->[0] !~ m/^_/) { # placeholder tag. just ignore
410                    return $build->error(MT->translate("Unknown tag found: [_1]", $t->[0]));
411                }
412            }
413        }
414    }
415
416    return $res;
417}
418
4191;
420__END__
421
422=head1 NAME
423
424MT::Builder - Parser and interpreter for MT templates
425
426=head1 SYNOPSIS
427
428    use MT::Builder;
429    use MT::Template::Context;
430
431    my $build = MT::Builder->new;
432    my $ctx = MT::Template::Context->new;
433
434    my $tokens = $build->compile($ctx, '<$MTVersion$>')
435        or die $build->errstr;
436    defined(my $out = $build->build($ctx, $tokens))
437        or die $build->errstr;
438
439=head1 DESCRIPTION
440
441I<MT::Builder> provides the parser and interpreter for taking a template
442body and turning it into a generated output page. An I<MT::Builder> object
443knows how to parse a string of text into tokens, then take those tokens and
444build a scalar string representing the output of the page. It does not,
445however, know anything about the types of tags that it encounters; it hands
446off this work to the I<MT::Template::Context> object, which can look up a
447tag and determine whether it's valid, whether it's a container or substitution
448tag, etc.
449
450All I<MT::Builder> knows is the basic structure of a Movable Type tag, and
451how to break up a string into pieces: plain text pieces interspersed with
452tag callouts. It then knows how to take a list of these tokens/pieces and
453build a completed page, using the same I<MT::Template::Context> object to
454actually fill in the values for the Movable Type tags.
455
456=head1 USAGE
457
458=head2 MT::Builder->new
459
460Constructs and returns a new parser/interpreter object.
461
462=head2 $build->compile($ctx, $string)
463
464Given an I<MT::Template::Context> object I<$ctx>, breaks up the scalar string
465I<$string> into tokens and returns the list of tokens as a reference to an
466array. Returns C<undef> on compilation failure.
467
468=head2 $build->build($ctx, \@tokens [, \%cond ])
469
470Given an I<MT::Template::Context> object I<$ctx>, turns a list of tokens
471I<\@tokens> and generates an output page. Returns the output page on success,
472C<undef> on failure. Note that the empty string (C<''>) and the number zero
473(C<0>) are both valid return values for this method, so you should check
474specifically for an undefined value when checking for errors.
475
476The optional argument I<\%cond> specifies a list of conditions under which
477the tokens will be interpreted. If provided, I<\%cond> should be a reference
478to a hash, where the keys are MT tag names (without the leading C<MT>), and
479the values are boolean flags specifying whether to include the tag; a true
480value means that the tag should be included in the final output, a false value
481that it should not. This is useful when a template includes conditional
482container tags (eg C<E<lt>MTEntryIfExtendedE<gt>>), and you wish to influence
483the inclusion of these container tags. For example, if a template contains
484the container
485
486    <MTEntryIfExtended>
487    <$MTEntryMore$>
488    </MTEntryIfExtended>
489
490and you wish to exclude this conditional, you could call I<build> like this:
491
492    my $out = $build->build($ctx, $tokens, { EntryIfExtended => 0 });
493
494=head2 $build->syntree2str(\@tokens)
495
496Internal debugging routine to dump a set of template tokens. Returns a
497readable string of contents of the C<$tokens> parameter.
498
499=head1 ERROR HANDLING
500
501On an error, the above methods return C<undef>, and the error message can
502be obtained by calling the method I<errstr> on the object. For example:
503
504    defined(my $out = $build->build($ctx, $tokens))
505        or die $build->errstr;
506
507=head1 AUTHOR & COPYRIGHTS
508
509Please see the I<MT> manpage for author, copyright, and license information.
510
511=cut
Note: See TracBrowser for help on using the browser.