—package
Mojo::Template;
use
Mojo::Base -base;
use
IO::File;
use
Mojo::ByteStream;
use
Mojo::Exception;
# "If for any reason you're not completely satisfied, I hate you."
has
[
qw/auto_escape compiled/
];
has
[
qw/append code prepend/
] =>
''
;
has
capture_end
=>
'end'
;
has
capture_start
=>
'begin'
;
has
comment_mark
=>
'#'
;
has
encoding
=>
'UTF-8'
;
has
escape_mark
=>
'='
;
has
expression_mark
=>
'='
;
has
line_start
=>
'%'
;
has
name
=>
'template'
;
has
namespace
=>
'Mojo::Template::SandBox'
;
has
replace_mark
=>
'%'
;
has
tag_start
=>
'<%'
;
has
tag_end
=>
'%>'
;
has
template
=>
''
;
has
tree
=>
sub
{ [] };
has
trim_mark
=>
'='
;
# Helpers
my
$HELPERS
=
<<'EOF';
use Mojo::ByteStream 'b';
use Mojo::Util;
no strict 'refs';
no warnings 'redefine';
sub capture;
*capture = sub { shift->(@_) };
sub escape;
*escape = sub {
return "$_[0]" if ref $_[0] && ref $_[0] eq 'Mojo::ByteStream';
my $v;
{
no warnings 'uninitialized';
$v = "$_[0]";
}
Mojo::Util::xml_escape $v;
$v;
};
use Mojo::Base -strict;
EOF
$HELPERS
=~ s/\n//g;
sub
build {
my
$self
=
shift
;
# Compile
my
(
@lines
,
$cpst
);
my
$multi
= 0;
for
my
$line
(@{
$self
->tree}) {
# New line
push
@lines
,
''
;
for
(
my
$j
= 0;
$j
< @{
$line
};
$j
+= 2) {
my
$type
=
$line
->[
$j
];
my
$value
=
$line
->[
$j
+ 1] ||
''
;
my
$newline
=
chomp
$value
;
# Capture end
if
(
$type
eq
'cpen'
) {
# End block
$lines
[-1] .=
'return b($_M) }'
;
# No following code
my
$next
=
$line
->[
$j
+ 3];
$lines
[-1] .=
';'
if
!
defined
$next
||
$next
=~ /^\s*$/;
}
# Text
if
(
$type
eq
'text'
) {
# Quote and fix line ending
$value
=
quotemeta
(
$value
);
$value
.=
'\n'
if
$newline
;
$lines
[-1] .=
"\$_M .= \""
.
$value
.
"\";"
if
length
$value
;
}
# Code or multiline expression
if
(
$type
eq
'code'
||
$multi
) {
$lines
[-1] .=
"$value"
}
# Expression
if
(
$type
~~ [
qw/expr escp/
]) {
# Start
unless
(
$multi
) {
# Escaped
my
$a
=
$self
->auto_escape;
if
((
$type
eq
'escp'
&& !
$a
) || (
$type
eq
'expr'
&&
$a
)) {
$lines
[-1] .=
"\$_M .= escape"
;
$lines
[-1] .=
" +$value"
if
length
$value
;
}
# Raw
else
{
$lines
[-1] .=
"\$_M .= $value"
}
}
# Multiline
$multi
= (
$line
->[
$j
+ 2] ||
''
) eq
'text'
&& (
$line
->[
$j
+ 3] ||
''
) eq
''
? 0 : 1;
# Append semicolon
$lines
[-1] .=
';'
if
!
$multi
&& !
$cpst
;
}
# Capture started
if
(
$cpst
) {
$lines
[-1] .=
$cpst
;
$cpst
=
undef
;
}
# Capture start
if
(
$type
eq
'cpst'
) {
$cpst
=
" sub { my \$_M = ''; "
}
}
}
# Wrap
my
$prepend
=
$self
->prepend;
my
$append
=
$self
->append;
my
$namespace
=
$self
->namespace;
$lines
[0] ||=
''
;
$lines
[0] =
"package $namespace; $HELPERS sub { my \$_M = ''; $prepend; do {"
.
$lines
[0];
$lines
[-1] .=
"$append; \$_M; } };"
;
# Final code
$self
->code(
join
"\n"
,
@lines
);
$self
->tree([]);
return
$self
;
}
sub
compile {
my
$self
=
shift
;
# Compile
return
unless
my
$code
=
$self
->code;
my
$compiled
=
eval
$code
;
# Use local stacktrace for compile exceptions
return
Mojo::Exception->new($@, [
$self
->template,
$code
],
$self
->name)
->trace->verbose(1)
if
$@;
$self
->compiled(
$compiled
);
return
;
}
sub
interpret {
my
$self
=
shift
;
# Compile
unless
(
$self
->compiled) {
my
$e
=
$self
->compile;
return
$e
if
ref
$e
;
}
my
$compiled
=
$self
->compiled;
return
unless
$compiled
;
# Stacktrace
local
$SIG
{__DIE__} =
sub
{
CORE::
die
(
$_
[0])
if
ref
$_
[0];
Mojo::Exception->throw(
shift
, [
$self
->template,
$self
->code],
$self
->name);
};
# Interpret
my
$output
=
eval
{
$compiled
->(
@_
) };
$output
=
Mojo::Exception->new($@, [
$self
->template],
$self
->name)->verbose(1)
if
$@;
return
$output
;
}
# "I am so smart! I am so smart! S-M-R-T! I mean S-M-A-R-T..."
sub
parse {
my
(
$self
,
$tmpl
) =
@_
;
# Clean start
$self
->template(
$tmpl
);
delete
$self
->{tree};
# Token
my
$raw_start
=
$self
->line_start;
my
$raw_tag_start
=
$self
->tag_start;
my
$raw_tag_end
=
$self
->tag_end;
my
$raw_expr
=
$self
->expression_mark;
my
$raw_trim
=
$self
->trim_mark;
my
$raw_replace
=
$self
->replace_mark;
my
$start
=
quotemeta
$raw_start
;
my
$tag_start
=
quotemeta
$raw_tag_start
;
my
$tag_end
=
quotemeta
$raw_tag_end
;
my
$cmnt
=
quotemeta
$self
->comment_mark;
my
$escp
=
quotemeta
$self
->escape_mark;
my
$expr
=
quotemeta
$raw_expr
;
my
$trim
=
quotemeta
$raw_trim
;
my
$cpst
=
quotemeta
$self
->capture_start;
my
$cpen
=
quotemeta
$self
->capture_end;
my
$replace
=
quotemeta
$raw_replace
;
# Token regex
my
$token_re
=
qr/
(
$tag_start$replace # Replace
|
$tag_start$expr$escp\s*$cpen # Escaped expression (end)
|
$tag_start$expr$escp # Escaped expression
|
$tag_start$expr\s*$cpen # Expression (end)
|
$tag_start$expr # Expression
|
$tag_start$cmnt\s*$cpen # Comment (end)
|
$tag_start$cmnt # Comment
|
$tag_start\s*$cpen # Code (end)
|
$tag_start # Code
|
$cpst\s*$trim$tag_end # Trim end (start)
|
$trim$tag_end # Trim end
|
$cpst\s*$tag_end # End (start)
|
$tag_end # End
)
/
x;
# Split lines
my
$state
=
'text'
;
my
@capture_token
;
my
$trimming
= 0;
for
my
$line
(
split
/\n/,
$tmpl
) {
$trimming
= 0
if
$state
eq
'text'
;
# Perl line
if
(
$state
eq
'text'
&&
$line
!~ s/^(\s*)
$start
$replace
/$1
$raw_start
/) {
$line
=~ s/^(\s*)
$start
(
$expr
)?// and
$line
=
$2
?
"$1$raw_tag_start$2$line $raw_tag_end"
:
"$raw_tag_start$line $raw_trim$raw_tag_end"
;
}
# Escaped line ending
if
(
$line
=~ /(\\+)$/) {
my
$len
=
length
$1;
# Newline
if
(
$len
== 1) {
$line
=~ s/\\$// }
# Backslash
if
(
$len
>= 2) {
$line
=~ s/\\\\$/\\/;
$line
.=
"\n"
;
}
}
# Normal line ending
else
{
$line
.=
"\n"
}
# Tokenize
my
@token
;
for
my
$token
(
split
/
$token_re
/,
$line
) {
# Capture end
@capture_token
= (
'cpen'
,
undef
)
if
$token
=~ s/^(
$tag_start
)(?:
$expr
)?(?:
$escp
)?\s
*$cpen
/$1/;
# End
if
(
$state
ne
'text'
&&
$token
=~ /^(?:(
$cpst
)\s*)?(
$trim
)?
$tag_end
$/) {
$state
=
'text'
;
# Capture start
splice
@token
, -2, 0,
'cpst'
,
undef
if
$1;
# Trim previous text
if
($2) {
$trimming
= 1;
$self
->_trim(\
@token
);
}
# Hint at end
push
@token
,
'text'
,
''
;
}
# Code
elsif
(
$token
=~ /^
$tag_start
$/) {
$state
=
'code'
}
# Expression
elsif
(
$token
=~ /^
$tag_start
$expr
$/) {
$state
=
'expr'
}
# Expression that needs to be escaped
elsif
(
$token
=~ /^
$tag_start
$expr
$escp
$/) {
$state
=
'escp'
}
# Comment
elsif
(
$token
=~ /^
$tag_start
$cmnt
$/) {
$state
=
'cmnt'
}
# Value
else
{
# Replace
$token
=
$raw_tag_start
if
$token
eq
"$raw_tag_start$raw_replace"
;
# Convert whitespace text to line noise
if
(
$trimming
&&
$token
=~ s/^(\s+)//) {
push
@token
,
'code'
, $1;
$trimming
= 0;
}
# Comments are ignored
next
if
$state
eq
'cmnt'
;
push
@token
,
@capture_token
,
$state
,
$token
;
@capture_token
= ();
}
}
push
@{
$self
->tree}, \
@token
;
}
return
$self
;
}
sub
render {
my
$self
=
shift
;
my
$tmpl
=
shift
;
# Parse
$self
->parse(
$tmpl
);
# Build
$self
->build;
# Compile
my
$e
=
$self
->compile;
return
$e
if
$e
;
# Interpret
return
$self
->interpret(
@_
);
}
sub
render_file {
my
$self
=
shift
;
my
$path
=
shift
;
# Slurp file
$self
->name(
$path
)
unless
defined
$self
->{name};
croak
"Can't open template '$path': $!"
unless
my
$file
= IO::File->new(
"< $path"
);
my
$tmpl
=
''
;
while
(
$file
->
sysread
(
my
$buffer
, CHUNK_SIZE, 0)) {
$tmpl
.=
$buffer
;
}
# Decode and render
$tmpl
= decode(
$self
->encoding,
$tmpl
)
if
$self
->encoding;
return
$self
->render(
$tmpl
,
@_
);
}
sub
render_file_to_file {
my
$self
=
shift
;
my
$spath
=
shift
;
my
$tpath
=
shift
;
# Render
my
$output
=
$self
->render_file(
$spath
,
@_
);
return
$output
if
ref
$output
;
# Write to file
return
$self
->_write_file(
$tpath
,
$output
);
}
sub
render_to_file {
my
$self
=
shift
;
my
$tmpl
=
shift
;
my
$path
=
shift
;
# Render
my
$output
=
$self
->render(
$tmpl
,
@_
);
return
$output
if
ref
$output
;
# Write to file
return
$self
->_write_file(
$path
,
$output
);
}
sub
_trim {
my
(
$self
,
$line
) =
@_
;
# Walk line backwards
for
(
my
$j
=
@$line
- 4;
$j
>= 0;
$j
-= 2) {
# Skip capture
next
if
$line
->[
$j
] eq
'cpst'
||
$line
->[
$j
] eq
'cpen'
;
# Only trim text
return
unless
$line
->[
$j
] eq
'text'
;
# Convert whitespace text to line noise
my
$value
=
$line
->[
$j
+ 1];
if
(
$line
->[
$j
+ 1] =~ s/(\s+)$//) {
$value
=
$line
->[
$j
+ 1];
splice
@$line
,
$j
, 0,
'code'
, $1;
}
# Text left
return
if
length
$value
;
}
}
sub
_write_file {
my
(
$self
,
$path
,
$output
) =
@_
;
# Encode and write to file
croak
"Can't open file '$path': $!"
unless
my
$file
= IO::File->new(
"> $path"
);
$output
= encode(
$self
->encoding,
$output
)
if
$self
->encoding;
$file
->
syswrite
(
$output
) or croak
"Can't write to file '$path': $!"
;
return
;
}
1;
__END__
=head1 NAME
Mojo::Template - Perl-ish templates!
=head1 SYNOPSIS
use Mojo::Template;
my $mt = Mojo::Template->new;
# Simple
my $output = $mt->render(<<'EOF');
<!doctype html><html>
<head><title>Simple</title></head>
<body>Time: <%= localtime(time) %></body>
</html>
EOF
say $output;
# More complicated
my $output = $mt->render(<<'EOF', 23, 'foo bar');
%= 5 * 5
% my ($number, $text) = @_;
test 123
foo <% my $i = $number + 2; %>
% for (1 .. 23) {
* some text <%= $i++ %>
% }
EOF
say $output;
=head1 DESCRIPTION
L<Mojo::Template> is a minimalistic and very Perl-ish template engine,
designed specifically for all those small tasks that come up during big
projects.
Like preprocessing a config file, generating text from heredocs and stuff
like that.
<% Perl code %>
<%= Perl expression, replaced with result %>
<%== Perl expression, replaced with XML escaped result %>
<%# Comment, useful for debugging %>
<%% Replaced with "<%", useful for generating templates %>
% Perl code line, treated as "<% line =%>"
%= Perl expression line, treated as "<%= line %>"
%== Perl expression line, treated as "<%== line %>"
%# Comment line, treated as "<%# line =%>"
%% Replaced with "%", useful for generating templates
=head2 Automatic escaping
Escaping behavior can be reversed with the C<auto_escape> attribute, this is
the default in L<Mojolicious> C<.ep> templates for example.
<%= Perl expression, replaced with XML escaped result %>
<%== Perl expression, replaced with result %>
L<Mojo::ByteStream> objects are always excluded from automatic escaping.
<%= b('<div>excluded!</div>') %>
=head2 Trimming
Whitespace characters around tags can be trimmed with a special tag ending.
<%= All whitespace characters around this expression will be trimmed =%>
=head2 Blocks
You can capture whole template blocks for reuse later with the C<begin> and
C<end> keywords.
<% my $block = begin %>
<% my $name = shift; =%>
Hello <%= $name %>.
<% end %>
<%= $block->('Baerbel') %>
<%= $block->('Wolfgang') %>
=head2 Indentation
Perl lines can also be indented freely.
% my $block = begin
% my $name = shift;
Hello <%= $name %>.
% end
%= $block->('Baerbel')
%= $block->('Wolfgang')
=head2 Arguments
L<Mojo::Template> templates work just like Perl subs (actually they get
compiled to a Perl sub internally).
That means you can access arguments simply via C<@_>.
% my ($foo, $bar) = @_;
% my $x = shift;
test 123 <%= $foo %>
=head2 More escaping
You can use escaped tags and lines to generate templates.
%% my $number = <%= 20 + 3 %>;
The number is <%%= $number %>
A newline can be escaped with a backslash.
This is <%= 23 * 3 %> a\
single line
And a backslash in front of a newline can be escaped with another backslash.
% use Data::Dumper;
This will\\
result <%= Dumper {foo => 'bar'} %>\\
in multiple lines
=head2 Exceptions
Templates get compiled to Perl code internally, this can make debugging a bit
tricky.
But L<Mojo::Template> will return L<Mojo::Exception> objects that stringify
to error messages with context.
Bareword "xx" not allowed while "strict subs" in use at template line 4.
2: </head>
3: <body>
4: % my $i = 2; xx
5: %= $i * 2
6: </body>
=head2 Caching
L<Mojo::Template> does not support caching by itself, but you can easily
build a wrapper around it.
# Compile and store code somewhere
my $mt = Mojo::Template->new;
$mt->parse($template);
$mt->build;
my $code = $mt->code;
# Load code and template (template for debug trace only)
$mt->template($template);
$mt->code($code);
$mt->compile;
my $output = $mt->interpret(@arguments);
=head1 ATTRIBUTES
L<Mojo::Template> implements the following attributes.
=head2 C<auto_escape>
my $auto_escape = $mt->auto_escape;
$mt = $mt->auto_escape(1);
Activate automatic XML escaping.
=head2 C<append>
my $code = $mt->append;
$mt = $mt->append('warn "Processed template"');
Append Perl code to compiled template.
=head2 C<capture_end>
my $capture_end = $mt->capture_end;
$mt = $mt->capture_end('end');
Keyword indicating the end of a capture block, defaults to C<end>.
<% my $block = begin %>
Some data!
<% end %>
=head2 C<capture_start>
my $capture_start = $mt->capture_start;
$mt = $mt->capture_start('begin');
Keyword indicating the start of a capture block, defaults to C<begin>.
<% my $block = begin %>
Some data!
<% end %>
=head2 C<code>
my $code = $mt->code;
$mt = $mt->code($code);
Compiled template code.
=head2 C<comment_mark>
my $comment_mark = $mt->comment_mark;
$mt = $mt->comment_mark('#');
Character indicating the start of a comment, defaults to C<#>.
<%# This is a comment %>
=head2 C<encoding>
my $encoding = $mt->encoding;
$mt = $mt->encoding('UTF-8');
Encoding used for template files.
=head2 C<escape_mark>
my $escape_mark = $mt->escape_mark;
$mt = $mt->escape_mark('=');
Character indicating the start of an escaped expression, defaults to C<=>.
<%== $foo %>
=head2 C<expression_mark>
my $expression_mark = $mt->expression_mark;
$mt = $mt->expression_mark('=');
Character indicating the start of an expression, defaults to C<=>.
<%= $foo %>
=head2 C<line_start>
my $line_start = $mt->line_start;
$mt = $mt->line_start('%');
Character indicating the start of a code line, defaults to C<%>.
% $foo = 23;
=head2 C<name>
my $name = $mt->name;
$mt = $mt->name('foo.mt');
Name of template currently being processed, defaults to C<template>.
Note that this method is attribute and might change without warning!
=head2 C<namespace>
my $namespace = $mt->namespace;
$mt = $mt->namespace('main');
Namespace used to compile templates, defaults to C<Mojo::Template::SandBox>.
=head2 C<prepend>
my $code = $mt->prepend;
$mt = $mt->prepend('my $self = shift;');
Prepend Perl code to compiled template.
=head2 C<replace_mark>
my $replace_mark = $mt->replace_mark;
$mt = $mt->replace_mark('%');
Character used for escaping the start of a tag or line, defaults to C<%>.
<%% my $foo = 23; %>
=head2 C<tag_start>
my $tag_start = $mt->tag_start;
$mt = $mt->tag_start('<%');
Characters indicating the start of a tag, defaults to C<E<lt>%>.
<% $foo = 23; %>
=head2 C<tag_end>
my $tag_end = $mt->tag_end;
$mt = $mt->tag_end('%>');
Characters indicating the end of a tag, defaults to C<%E<gt>>.
<%= $foo %>
=head2 C<template>
my $template = $mt->template;
$mt = $mt->template($template);
Raw template.
=head2 C<tree>
my $tree = $mt->tree;
$mt = $mt->tree($tree);
Parsed tree.
=head2 C<trim_mark>
my $trim_mark = $mt->trim_mark;
$mt = $mt->trim_mark('-');
Character activating automatic whitespace trimming, defaults to C<=>.
<%= $foo =%>
=head1 METHODS
L<Mojo::Template> inherits all methods from L<Mojo::Base> and implements the
following new ones.
=head2 C<new>
my $mt = Mojo::Template->new;
Construct a new L<Mojo::Template> object.
=head2 C<build>
$mt = $mt->build;
Build template.
=head2 C<compile>
my $exception = $mt->compile;
Compile template.
=head2 C<interpret>
my $output = $mt->interpret;
my $output = $mt->interpret(@arguments);
Interpret template.
=head2 C<parse>
$mt = $mt->parse($template);
Parse template.
=head2 C<render>
my $output = $mt->render($template);
my $output = $mt->render($template, @arguments);
Render template.
=head2 C<render_file>
my $output = $mt->render_file($template_file);
my $output = $mt->render_file($template_file, @arguments);
Render template file.
=head2 C<render_file_to_file>
my $exception = $mt->render_file_to_file($template_file, $output_file);
my $exception = $mt->render_file_to_file(
$template_file, $output_file, @arguments
);
Render template file to a specific file.
=head2 C<render_to_file>
my $exception = $mt->render_to_file($template, $output_file);
my $exception = $mt->render_to_file(
$template, $output_file, @arguments
);
Render template to a specific file.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
=cut