1# Template::Mustache is an implementation of the fabulous Mustache templating 2# language for Perl 5.8 and later. 3# 4# @author Pieter van de Bruggen 5# @see http://mustache.github.com 6package Template::Mustache; 7use strict; 8use warnings; 9 10use CGI (); 11use File::Spec; 12 13use version 0.77; our $VERSION = qv("v0.5.1"); 14 15my %TemplateCache; 16 17# Constructs a new regular expression, to be used in the parsing of Mustache 18# templates. 19# @param [String] $otag The tag opening delimiter. 20# @param [String] $ctag The tag closing delimiter. 21# @return [Regex] A regular expression that will match tags with the specified 22# delimiters. 23# @api private 24sub build_pattern { 25 my ($otag, $ctag) = @_; 26 return qr/ 27 (.*?) # Capture the pre-tag content 28 ([ \t]*) # Capture the pre-tag whitespace 29 (?:\Q$otag\E \s*) # Match the opening of the tag 30 (?: 31 (=) \s* (.+?) \s* = | # Capture Set Delimiters 32 ({) \s* (.+?) \s* } | # Capture Triple Mustaches 33 (\W?) \s* (.+?) # Capture everything else 34 ) 35 (?:\s* \Q$ctag\E) # Match the closing of the tag 36 /xsm; 37} 38 39# Reads a file into a string, returning the empty string if the file does not 40# exist. 41# @param [String] $filename The name of the file to read. 42# @return [String] The contents of the given filename, or the empty string. 43# @api private 44sub read_file { 45 my ($filename) = @_; 46 return '' unless -f $filename; 47 48 local *FILE; 49 open FILE, $filename or die "Cannot read from file $filename!"; 50 sysread(FILE, my $data, -s FILE); 51 close FILE; 52 53 return $data; 54} 55 56# @overload parse($tmpl) 57# Creates an AST from the given template. 58# @param [String] $tmpl The template to parse. 59# @return [Array] The AST represented by the given template. 60# @api private 61# @overload parse($tmpl, $delims) 62# Creates an AST from the given template, with non-standard delimiters. 63# @param [String] $tmpl The template to parse. 64# @param [Array<String>[2]] $delims The delimiter pair to begin parsing with. 65# @return [Array] The AST represented by the given template. 66# @api private 67# @overload parse($tmpl, $delims, $section, $start) 68# Parses out a section tag from the given template. 69# @param [String] $tmpl The template to parse. 70# @param [Array<String>[2]] $delims The delimiter pair to begin parsing with. 71# @param [String] $section The name of the section we're parsing. 72# @param [Int] $start The index of the first character of the section. 73# @return [(String, Int)] The raw text of the section, and the index of the 74# character immediately following the close section tag. 75# @api internal 76sub parse { 77 my ($tmpl, $delims, $section, $start) = @_; 78 my @buffer; 79 80 # Pull the parse tree out of the cache, if we can... 81 $delims ||= [qw'{{ }}']; 82 my $cache = $TemplateCache{join ' ', @$delims} ||= {}; 83 return $cache->{$tmpl} if exists $cache->{$tmpl}; 84 85 my $error = sub { 86 my ($message, $errorPos) = @_; 87 my @lineCount = split("\n", substr($tmpl, 0, $errorPos)); 88 89 die $message . "\nLine " . length(@lineCount); 90 }; 91 92 # Build the pattern, and instruct the regex engine to begin at `$start`. 93 my $pattern = build_pattern(@$delims); 94 my $pos = pos($tmpl) = $start ||= 0; 95 96 # Begin parsing out tags 97 while ($tmpl =~ m/\G$pattern/gc) { 98 my ($content, $whitespace) = ($1, $2); 99 my $type = $3 || $5 || $7; 100 my $tag = $4 || $6 || $8; 101 102 # Buffer any non-tag content we have. 103 push @buffer, $content if $content; 104 105 # Grab the index for the end of the content, and update our pointer. 106 my $eoc = $pos + length($content) - 1; 107 $pos = pos($tmpl); 108 109 # A tag is considered standalone if it is the only non-whitespace 110 # content on a line. 111 my $is_standalone = (substr($tmpl, $eoc, 1) || "\n") eq "\n" && 112 (substr($tmpl, $pos, 1) || "\n") eq "\n"; 113 114 # Standalone tags should consume the newline that follows them, unless 115 # the tag is of an interpolation type. 116 # Otherwise, any whitespace we've captured should be added to the 117 # buffer, and the end of content index should be advanced. 118 if ($is_standalone && ($type ne '{' && $type ne '&' && $type ne '')) { 119 $pos += 1; 120 } elsif ($whitespace) { 121 $eoc += length($whitespace); 122 push @buffer, $whitespace; 123 $whitespace = ''; 124 } 125 126 if ($type eq '!') { 127 # Comment Tag - No-op. 128 } elsif ($type eq '{' || $type eq '&' || $type eq '') { 129 # Interpolation Tag - Buffers the tag type and name. 130 push @buffer, [ $type, $tag ]; 131 } elsif ($type eq '>') { 132 # Partial Tag - Buffers the tag type, name, and any indentation 133 push @buffer, [ $type, $tag, $whitespace ]; 134 } elsif ($type eq '=') { 135 # Set Delimiter Tag - Changes the delimiter pair and updates the 136 # tag pattern. 137 $delims = [ split(/\s+/, $tag) ]; 138 139 $error->("Set Delimiters tags must have exactly two values!", $pos) 140 if @$delims != 2; 141 142 $pattern = build_pattern(@$delims); 143 } elsif ($type eq '#' || $type eq '^') { 144 # Section Tag - Recursively calls #parse (starting from the current 145 # index), and receives the raw section string and a new index. 146 # Buffers the tag type, name, the section string and delimiters. 147 (my $raw, $pos) = parse($tmpl, $delims, $tag, $pos); 148 push @buffer, [ $type, $tag, [$raw, $delims] ]; 149 } elsif ($type eq '/') { 150 # End Section Tag - Short circuits a recursive call to #parse, 151 # caches the buffer for the raw section template, and returns the 152 # raw section template and the index immediately following the tag. 153 my $msg; 154 if (!$section) { 155 $msg = "End Section tag '$tag' found, but not in a section!"; 156 } elsif ($tag ne $section) { 157 $msg = "End Section tag closes '$tag'; expected '$section'!"; 158 } 159 $error->($msg, $pos) if $msg; 160 161 my $raw_section = substr($tmpl, $start, $eoc + 1 - $start); 162 $cache->{$raw_section} = [@buffer]; 163 return ($raw_section, $pos); 164 } else { 165 $error->("Unknown tag type -- $type", $pos); 166 } 167 168 # Update our match pointer to coincide with any changes we've made. 169 pos($tmpl) = $pos 170 } 171 172 # Buffer any remaining template, cache the template for later, and return 173 # a reference to the buffer. 174 push @buffer, substr($tmpl, $pos); 175 $cache->{$tmpl} = [@buffer]; 176 return \@buffer; 177} 178 179# Produces an expanded version of the template represented by the given parse 180# tree. 181# @param [Array<String,Array>] $parse_tree The AST of a Mustache template. 182# @param [Code] $partials A subroutine that looks up partials by name. 183# @param [(Any)] @context The context stack to perform key lookups against. 184# @return [String] The fully rendered template. 185# @api private 186sub generate { 187 my ($parse_tree, $partials, @context) = @_; 188 189 # Build a helper function to abstract away subtemplate expansion. 190 # Recursively calls generate after parsing the given template. This allows 191 # us to use the call stack as our context stack. 192 my $build = sub { generate(parse(@_[0,1]), $partials, $_[2], @context) }; 193 194 # Walk through the parse tree, handling each element in turn. 195 join '', map { 196 # If the given element is a string, treat it literally. 197 my @result = ref $_ ? () : $_; 198 199 # Otherwise, it's a three element array, containing a tag's type, name, 200 # and accessory data. As a precautionary step, we can prefetch any 201 # data value from the context stack (which will be useful in every case 202 # except partial tags). 203 unless (@result) { 204 my ($type, $tag, $data) = @$_; 205 my $render = sub { $build->(shift, $data->[1]) }; 206 207 my ($ctx, $value) = lookup($tag, @context) unless $type eq '>'; 208 209 if ($type eq '{' || $type eq '&' || $type eq '') { 210 # Interpolation Tags 211 # If the value is a code reference, we should treat it 212 # according to Mustache's lambda rules. Specifically, we 213 # should call the sub (passing a "render" function as a 214 # convenience), render its contents against the current 215 # context, and cache the value (if possible). 216 if (ref $value eq 'CODE') { 217 $value = $build->($value->($render)); 218 $ctx->{$tag} = $value if ref $ctx eq 'HASH'; 219 } 220 # An empty `$type` represents an HTML escaped tag. 221 $value = CGI::escapeHTML($value) unless $type; 222 @result = $value; 223 } elsif ($type eq '#') { 224 # Section Tags 225 # `$data` will contain an array reference with the raw template 226 # string, and the delimiter pair being used when the section 227 # tag was encountered. 228 # There are four special cases for section tags. 229 # * If the value is falsey, the section is skipped over. 230 # * If the value is an array reference, the section is 231 # rendered once using each element of the array. 232 # * If the value is a code reference, the raw section string 233 # and a rendering function are passed to the sub; the return 234 # value is then automatically rendered. 235 # * Otherwise, the section is rendered using given value. 236 if (ref $value eq 'ARRAY') { 237 @result = map { $build->(@$data, $_) } @$value; 238 } elsif ($value) { 239 my @x = @$data; 240 $x[0] = $value->($x[0], $render) if ref $value eq 'CODE'; 241 @result = $build->(@x, $value); 242 } 243 } elsif ($type eq '^') { 244 # Inverse Section Tags 245 # These should only be rendered if the value is falsey or an 246 # empty array reference. `$data` is as for Section Tags. 247 $value = @$value if ref $value eq 'ARRAY'; 248 @result = $build->(@$data) unless $value; 249 } elsif ($type eq '>') { 250 # Partial Tags 251 # `$data` contains indentation to be applied to the partial. 252 # The partial template is looked up thanks to the `$partials` 253 # code reference, rendered, and non-empty lines are indented. 254 my $partial = scalar $partials->($tag); 255 $partial =~ s/^(?=.)/${data}/gm if $data; 256 @result = $build->($partial); 257 } 258 } 259 @result; # Collect the results... 260 } @$parse_tree; 261} 262 263# Performs a lookup of a `$field` in a context stack. 264# @param [String] $field The field to lookup. 265# @param [(Any)] @context The context stack. 266# @return [(Any, Any)] The context element and value for the given `$field`. 267# @api private 268sub lookup { 269 my ($field, @context) = @_; 270 my ($value, $ctx) = ''; 271 272 for my $index (0..$#{[@context]}) { 273 $ctx = $context[$index]; 274 if (ref $ctx eq 'HASH') { 275 next unless exists $ctx->{$field}; 276 $value = $ctx->{$field}; 277 last; 278 } else { 279 next unless UNIVERSAL::can($ctx, $field); 280 $value = $ctx->$field(); 281 last; 282 } 283 } 284 285 return ($ctx, $value); 286} 287 288use namespace::clean; 289 290# Standard hash constructor. 291# @param %args Initialization data. 292# @return [Template::Mustache] A new instance. 293sub new { 294 my ($class, %args) = @_; 295 return bless({ %args }, $class); 296} 297 298our $template_path = '.'; 299 300# Filesystem path for template and partial lookups. 301# @return [String] +$Template::Mustache::template_path+ (defaults to '.'). 302# @scope dual 303sub template_path { $Template::Mustache::template_path } 304 305our $template_extension = 'mustache'; 306 307# File extension for templates and partials. 308# @return [String] +$Template::Mustache::template_extension+ (defaults to 309# 'mustache'). 310# @scope dual 311sub template_extension { $Template::Mustache::template_extension } 312 313# Package namespace to ignore during template lookups. 314# 315# As an example, if you subclass +Template::Mustache+ as the class 316# +My::Heavily::Namepaced::Views::SomeView+, calls to {render} will 317# automatically try to load the template 318# +./My/Heavily/Namespaced/Views/SomeView.mustache+ under the {template_path}. 319# Since views will very frequently all live in a common namespace, you can 320# override this method in your subclass, and save yourself some headaches. 321# 322# Setting template_namespace to: yields template name: 323# My::Heavily::Namespaced::Views => SomeView.mustache 324# My::Heavily::Namespaced => Views/SomeView.mustache 325# Heavily::Namespaced => My/Heavily/Namespaced/Views/SomeView.mustache 326# 327# As noted by the last example, namespaces will only be removed from the 328# beginning of the package name. 329# @return [String] The empty string. 330# @scope dual 331sub template_namespace { '' } 332 333our $template_file; 334 335# The template filename to read. The filename follows standard Perl module 336# lookup practices (e.g. My::Module becomes My/Module.pm) with the following 337# differences: 338# * Templates have the extension given by {template_extension} ('mustache' by 339# default). 340# * Templates will have {template_namespace} removed, if it appears at the 341# beginning of the package name. 342# * Template filename resolution will short circuit if 343# +$Template::Mustache::template_file+ is set. 344# * Template filename resolution may be overriden in subclasses. 345# * Template files will be resolved against {template_path}, not +$PERL5LIB+. 346# @return [String] The path to the template file, relative to {template_path}. 347# @see template 348sub template_file { 349 my ($receiver) = @_; 350 return $Template::Mustache::template_file 351 if $Template::Mustache::template_file; 352 353 my $class = ref $receiver || $receiver; 354 $class =~ s/^@{[$receiver->template_namespace()]}:://; 355 my $ext = $receiver->template_extension(); 356 return File::Spec->catfile(split(/::/, "${class}.${ext}")); 357}; 358 359# Reads the template off disk. 360# @return [String] The contents of the {template_file} under {template_path}. 361sub template { 362 my ($receiver) = @_; 363 my $path = $receiver->template_path(); 364 my $template_file = $receiver->template_file(); 365 return read_file(File::Spec->catfile($path, $template_file)); 366} 367 368# Reads a named partial off disk. 369# @param [String] $name The name of the partial to lookup. 370# @return [String] The contents of the partial (in {template_path}, of type 371# {template_extension}), or the empty string, if the partial does not exist. 372sub partial { 373 my ($receiver, $name) = @_; 374 my $path = $receiver->template_path(); 375 my $ext = $receiver->template_extension(); 376 return read_file(File::Spec->catfile($path, "${name}.${ext}")); 377} 378 379# @overload render() 380# Renders a class or instance's template with data from the receiver. The 381# template will be retrieved by calling the {template} method. Partials 382# will be fetched by {partial}. 383# @return [String] The fully rendered template. 384# @overload render($tmpl) 385# Renders the given template with data from the receiver. Partials will be 386# fetched by {partial}. 387# @param [String] $tmpl The template to render. 388# @return [String] The fully rendered template. 389# @overload render($data) 390# Renders a class or instance's template with data from the receiver. The 391# template will be retrieved by calling the {template} method. Partials 392# will be fetched by {partial}. 393# @param [Hash,Object] $data Data to be interpolated into the template. 394# @return [String] The fully rendered template. 395# @overload render($tmpl, $data) 396# Renders the given template with the given data. Partials will be fetched 397# by {partial}. 398# @param [String] $tmpl The template to render. 399# @param [Hash,Class,Object] $data Data to be interpolated into the template. 400# @return [String] The fully rendered template. 401# @overload render($tmpl, $data, $partials) 402# Renders the given template with the given data. Partials will be looked up 403# by calling the given code reference with the partial's name. 404# @param [String] $tmpl The template to render. 405# @param [Hash,Class,Object] $data Data to be interpolated into the template. 406# @param [Code] $partials A function used to lookup partials. 407# @return [String] The fully rendered template. 408# @overload render($tmpl, $data, $partials) 409# Renders the given template with the given data. Partials will be looked up 410# by calling the partial's name as a method on the given class or object. 411# @param [String] $tmpl The template to render. 412# @param [Hash,Class,Object] $data Data to be interpolated into the template. 413# @param [Class,Object] $partials A thing that responds to partial names. 414# @return [String] The fully rendered template. 415# @overload render($tmpl, $data, $partials) 416# Renders the given template with the given data. Partials will be looked up 417# in the given hash. 418# @param [String] $tmpl The template to render. 419# @param [Hash,Class,Object] $data Data to be interpolated into the template. 420# @param [Hash] $partials A hash containing partials. 421# @return [String] The fully rendered template. 422sub render { 423 my ($receiver, $tmpl, $data, $partials) = @_; 424 ($data, $tmpl) = ($tmpl, $data) if !(ref $data) && (ref $tmpl); 425 426 $tmpl = $receiver->template() unless defined $tmpl; 427 $data ||= $receiver; 428 $partials ||= sub { 429 unshift @_, $receiver; 430 goto &{$receiver->can('partial')}; 431 }; 432 433 my $part = $partials; 434 $part = sub { lookup(shift, $partials) } unless ref $partials eq 'CODE'; 435 436 my $parsed = parse($tmpl); 437 return generate($parsed, $part, $data); 438} 439 4401; 441