| 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 | |
|---|
| 7 | package MT::Builder; |
|---|
| 8 | |
|---|
| 9 | use strict; |
|---|
| 10 | use base qw( MT::ErrorHandler ); |
|---|
| 11 | use MT::Util qw( weaken ); |
|---|
| 12 | |
|---|
| 13 | sub NODE () { 'MT::Template::Node' } |
|---|
| 14 | |
|---|
| 15 | sub new { bless { }, $_[0] } |
|---|
| 16 | |
|---|
| 17 | sub 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 | |
|---|
| 228 | sub 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 | |
|---|
| 234 | sub _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 | |
|---|
| 256 | sub _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 | |
|---|
| 267 | sub 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 | |
|---|
| 284 | sub 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 | my $vars = $ctx->{__stash}{vars}; |
|---|
| 401 | local $vars->{__value__} = delete $vars->{__cond_value__}; |
|---|
| 402 | local $vars->{__name__} = delete $vars->{__cond_name__}; |
|---|
| 403 | $out = $out ? $ctx->slurp(\%args, $cond) : $ctx->else(\%args, $cond); |
|---|
| 404 | delete $vars->{__cond_tag__}; |
|---|
| 405 | return $build->error(MT->translate("Error in <mt[_1]> tag: [_2]", $t->[0], $ctx->errstr)) |
|---|
| 406 | unless defined $out; |
|---|
| 407 | } |
|---|
| 408 | |
|---|
| 409 | $out = $ph->($ctx, \%args, $out, \@args) |
|---|
| 410 | if %args && $ph; |
|---|
| 411 | $res .= $out |
|---|
| 412 | if defined $out; |
|---|
| 413 | |
|---|
| 414 | if ($timer) { |
|---|
| 415 | $timer->mark("tag_" |
|---|
| 416 | . lc($t->[0]) . args_to_string(\%args)); |
|---|
| 417 | } |
|---|
| 418 | } else { |
|---|
| 419 | if ($t->[0] !~ m/^_/) { # placeholder tag. just ignore |
|---|
| 420 | return $build->error(MT->translate("Unknown tag found: [_1]", $t->[0])); |
|---|
| 421 | } |
|---|
| 422 | } |
|---|
| 423 | } |
|---|
| 424 | } |
|---|
| 425 | |
|---|
| 426 | return $res; |
|---|
| 427 | } |
|---|
| 428 | |
|---|
| 429 | sub args_to_string { |
|---|
| 430 | my ($args) = @_; |
|---|
| 431 | my $str = ''; |
|---|
| 432 | foreach my $a (keys %$args) { |
|---|
| 433 | next if $a eq '@'; |
|---|
| 434 | next unless defined $args->{$a}; |
|---|
| 435 | next if $args->{$a} eq ''; |
|---|
| 436 | $str .= ';' . $a . ':'; |
|---|
| 437 | if (ref $args->{$a} eq 'ARRAY') { |
|---|
| 438 | foreach my $aa (@{ $args->{$a} }) { |
|---|
| 439 | $aa = '...' if $aa =~ m/ /; |
|---|
| 440 | $str .= $aa . ';'; |
|---|
| 441 | } |
|---|
| 442 | chop($str); |
|---|
| 443 | } else { |
|---|
| 444 | $str .= $args->{$a} =~ m/ / ? '...' : $args->{$a}; |
|---|
| 445 | } |
|---|
| 446 | } |
|---|
| 447 | my $more_args = $args->{'@'}; |
|---|
| 448 | if ($more_args && @$more_args) { |
|---|
| 449 | foreach my $a (@$more_args) { |
|---|
| 450 | if (ref $a->[1] eq 'ARRAY') { |
|---|
| 451 | $str .= ' ' . $a->[0] . '='; |
|---|
| 452 | foreach my $aa (@{ $a->[1] }) { |
|---|
| 453 | $aa = '...' if $aa =~ m/ /; |
|---|
| 454 | $str .= $aa . ';'; |
|---|
| 455 | } |
|---|
| 456 | chop($str); |
|---|
| 457 | } else { |
|---|
| 458 | next if exists $args->{$a->[0]} |
|---|
| 459 | && ($args->{$a->[0]} eq $a->[1]); |
|---|
| 460 | next unless defined $args->[1]; |
|---|
| 461 | next if $args->[1] eq ''; |
|---|
| 462 | $str .= ';' . $a->[0] . ':'; |
|---|
| 463 | $str .= $a->[1]; |
|---|
| 464 | } |
|---|
| 465 | } |
|---|
| 466 | } |
|---|
| 467 | return $str ne '' ? '[' . substr($str,1) . ']' : ''; |
|---|
| 468 | } |
|---|
| 469 | 1; |
|---|
| 470 | __END__ |
|---|
| 471 | |
|---|
| 472 | =head1 NAME |
|---|
| 473 | |
|---|
| 474 | MT::Builder - Parser and interpreter for MT templates |
|---|
| 475 | |
|---|
| 476 | =head1 SYNOPSIS |
|---|
| 477 | |
|---|
| 478 | use MT::Builder; |
|---|
| 479 | use MT::Template::Context; |
|---|
| 480 | |
|---|
| 481 | my $build = MT::Builder->new; |
|---|
| 482 | my $ctx = MT::Template::Context->new; |
|---|
| 483 | |
|---|
| 484 | my $tokens = $build->compile($ctx, '<$MTVersion$>') |
|---|
| 485 | or die $build->errstr; |
|---|
| 486 | defined(my $out = $build->build($ctx, $tokens)) |
|---|
| 487 | or die $build->errstr; |
|---|
| 488 | |
|---|
| 489 | =head1 DESCRIPTION |
|---|
| 490 | |
|---|
| 491 | I<MT::Builder> provides the parser and interpreter for taking a template |
|---|
| 492 | body and turning it into a generated output page. An I<MT::Builder> object |
|---|
| 493 | knows how to parse a string of text into tokens, then take those tokens and |
|---|
| 494 | build a scalar string representing the output of the page. It does not, |
|---|
| 495 | however, know anything about the types of tags that it encounters; it hands |
|---|
| 496 | off this work to the I<MT::Template::Context> object, which can look up a |
|---|
| 497 | tag and determine whether it's valid, whether it's a container or substitution |
|---|
| 498 | tag, etc. |
|---|
| 499 | |
|---|
| 500 | All I<MT::Builder> knows is the basic structure of a Movable Type tag, and |
|---|
| 501 | how to break up a string into pieces: plain text pieces interspersed with |
|---|
| 502 | tag callouts. It then knows how to take a list of these tokens/pieces and |
|---|
| 503 | build a completed page, using the same I<MT::Template::Context> object to |
|---|
| 504 | actually fill in the values for the Movable Type tags. |
|---|
| 505 | |
|---|
| 506 | =head1 USAGE |
|---|
| 507 | |
|---|
| 508 | =head2 MT::Builder->new |
|---|
| 509 | |
|---|
| 510 | Constructs and returns a new parser/interpreter object. |
|---|
| 511 | |
|---|
| 512 | =head2 $build->compile($ctx, $string) |
|---|
| 513 | |
|---|
| 514 | Given an I<MT::Template::Context> object I<$ctx>, breaks up the scalar string |
|---|
| 515 | I<$string> into tokens and returns the list of tokens as a reference to an |
|---|
| 516 | array. Returns C<undef> on compilation failure. |
|---|
| 517 | |
|---|
| 518 | =head2 $build->build($ctx, \@tokens [, \%cond ]) |
|---|
| 519 | |
|---|
| 520 | Given an I<MT::Template::Context> object I<$ctx>, turns a list of tokens |
|---|
| 521 | I<\@tokens> and generates an output page. Returns the output page on success, |
|---|
| 522 | C<undef> on failure. Note that the empty string (C<''>) and the number zero |
|---|
| 523 | (C<0>) are both valid return values for this method, so you should check |
|---|
| 524 | specifically for an undefined value when checking for errors. |
|---|
| 525 | |
|---|
| 526 | The optional argument I<\%cond> specifies a list of conditions under which |
|---|
| 527 | the tokens will be interpreted. If provided, I<\%cond> should be a reference |
|---|
| 528 | to a hash, where the keys are MT tag names (without the leading C<MT>), and |
|---|
| 529 | the values are boolean flags specifying whether to include the tag; a true |
|---|
| 530 | value means that the tag should be included in the final output, a false value |
|---|
| 531 | that it should not. This is useful when a template includes conditional |
|---|
| 532 | container tags (eg C<E<lt>MTEntryIfExtendedE<gt>>), and you wish to influence |
|---|
| 533 | the inclusion of these container tags. For example, if a template contains |
|---|
| 534 | the container |
|---|
| 535 | |
|---|
| 536 | <MTEntryIfExtended> |
|---|
| 537 | <$MTEntryMore$> |
|---|
| 538 | </MTEntryIfExtended> |
|---|
| 539 | |
|---|
| 540 | and you wish to exclude this conditional, you could call I<build> like this: |
|---|
| 541 | |
|---|
| 542 | my $out = $build->build($ctx, $tokens, { EntryIfExtended => 0 }); |
|---|
| 543 | |
|---|
| 544 | =head2 $build->syntree2str(\@tokens) |
|---|
| 545 | |
|---|
| 546 | Internal debugging routine to dump a set of template tokens. Returns a |
|---|
| 547 | readable string of contents of the C<$tokens> parameter. |
|---|
| 548 | |
|---|
| 549 | =head1 ERROR HANDLING |
|---|
| 550 | |
|---|
| 551 | On an error, the above methods return C<undef>, and the error message can |
|---|
| 552 | be obtained by calling the method I<errstr> on the object. For example: |
|---|
| 553 | |
|---|
| 554 | defined(my $out = $build->build($ctx, $tokens)) |
|---|
| 555 | or die $build->errstr; |
|---|
| 556 | |
|---|
| 557 | =head1 AUTHOR & COPYRIGHTS |
|---|
| 558 | |
|---|
| 559 | Please see the I<MT> manpage for author, copyright, and license information. |
|---|
| 560 | |
|---|
| 561 | =cut |
|---|
