root/branches/release-30/lib/MT/Builder.pm @ 1427

Revision 1427, 20.8 kB (checked in by mpaschal, 21 months ago)

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