package Template::MasonLite;
use strict;
use warnings;
use Carp;
our $VERSION = '0.9';
my(
$nl, $init_sect, $perl_sect, $perl_line, $comp_def, $comp_call,
$expression, $literal
);
BEGIN {
$nl = qr{(?:[ \r]*\n)};
$init_sect = qr{<%init>(.*?)%init>$nl?}s;
$perl_sect = qr{<%perl>(.*?)%perl>$nl?}s;
$perl_line = qr{(?:(?<=\n)|^)%(.*?)(\n|\Z)}s;
$comp_def = qr{<%def\s+([.\w+]+)>$nl(.*?)%def>$nl?}s;
$comp_call = qr{<&\s*([\w._-]+)(?:\s*,)?(.*?)&>}s;
$expression = qr{<%\s*(.*?)%>}s;
$literal = qr{(.*?(\n|(?=<%|<&|\Z)))};
}
sub new { return bless $_[0]->_parse($_[1]), $_[0]; }
sub new_from_file { return bless $_[0]->_parse_file($_[1]), $_[0]; }
sub apply { my $self = shift; return $self->(@_) };
sub _parse_file {
my($class, $template) = @_;
open my $fh, '<', $template or croak "$!: $template";
sysread $fh, $_, -s $template;
return $class->_parse($_);
}
sub _parse {
my($class, $template) = @_;
die "No template!\n" unless defined($template);
$_ = $template;
my(@head, @body, %comp);
while(!/\G\Z/sgc) {
if (/\G$init_sect/sgc ) { push @head, $1; }
elsif(/\G$perl_sect/sgc ) { push @body, $1; }
elsif(/\G$perl_line/sgc ) { push @body, $1; }
elsif(/\G$comp_def/sgc ) { $comp{$1} = $2; }
elsif(/\G$comp_call/sgc ) { push @body,
[ 0, "\$comp{'$1'}->apply($2)" ];
}
elsif(/\G$expression/sgc) { push @body, [ 0, $1 ]; }
elsif(/\G$literal/sgc ) { push @body, [ 1, $1 ]; }
else {/(.*)/sgc && croak "could not parse: '$1'"; }
};
while(my($name, $source) = each %comp) {
$comp{$name} = $class->new($source);
}
unshift @head, 'my @r; my %ARGS; %ARGS = @_ unless(@_ % 2);';
push @body, 'return join "", @r';
my $code = join("\n", map {
ref($_)
? ( $_->[0] ? _literal($_->[1]) : _expr($_->[1]) )
: $_;
} @head, @body);
$_ = '';
my $sub = eval "sub { $code }";
croak $@ if $@;
return $sub;
}
sub _expr { "push \@r, $_[0];"; }
sub _literal { $_ = shift; s/'/\\'/g; s/\\\n//s; _expr("'$_'"); }
# End of Template::MasonLite
sub install {
my $target = (@_, @ARGV)[0] or die "target filename required";
local($/);
my $tm_code = qr{package.*?# End of Template::MasonLite\s*}s;
open my $fh, '<', __FILE__ or die "$! - open(" . __FILE__ . ")";
$_ = <$fh>;
my($code) = m{^.*?($tm_code)}s;
open $fh, '<', $target or die "$! - open($target)";
$_ = <$fh>;
s{$tm_code|(?=^__END__$|^__DATA__$|\Z)}{$code}m;
open $fh, '>', $target or die "$! - open(>$target)";
print $fh $_;
close($fh);
}
1;
__END__
=head1 NAME
Template::MasonLite - add a small templating system to your script
=head1 SYNOPSIS
To install the template engine (about 80 lines of code) directly into your
script:
perl -MTemplate::MasonLite -e Template::MasonLite::install scriptname
Then you can define a template in your script:
my $template = <<'EOF';
>
ServerName <% $ARGS{domain_name} %>
DocumentRoot /var/www/<% $ARGS{domain_name} %>
% if($ARGS{want_cgi}) {
ScriptAlias /bin/ /usr/lib/cgi-bin/<% $ARGS{domain_name} %>
% }
Options Indexes MultiViews\
% if($ARGS{want_ssi}) {
Includes\
% }
EOF
And turn it into a template object:
my $t = Template::MasonLite->new($template);
Finally, call the template's C method and pass it some data.
print $t->apply(
ip_addr => '10.5.9.230',
domain_name => 'www.example.com',
want_cgi => 0,
want_ssi => 1,
);
=head1 DESCRIPTION
Template::MasonLite is a templating system that's so small, you can include it
directly in your script. This allows you to deploy your script without having
to install a templating module first. This is especially useful for generating
config files.
=head1 INSTALLATION
If you have this module installed on your development host, you can copy the
relevant code into your script using this command:
perl -MTemplate::MasonLite -e Template::MasonLite::install scriptname
You can rerun that command to update the code or to replace it if you've
somehow managed to break it.
=head1 METHODS
=head2 new (string)
Constructs a template object from a string.
=head2 new_from_file (filename)
Constructs a template object from the contents of a file.
=head2 apply (arguments ...)
Combines supplied arguments with template and returns resulting string.
=head1 TEMPLATE SYNTAX
Template::MasonLite implements a small subset of the HTML::Mason templating
syntax. Essentially it allows you to embed Perl in your template.
=head2 Template Arguments
Any arguments passed to the C method will be available to your
template in C<@_> and if an even number of arguments were provided, they will
also be available as key=>value pairs in %ARGS.
=head2 Expressions
You can insert the value of Perl variables or expressions into your template
by enclosing them in C<< <% ... %> >>, eg:
ServerName <% $ARGS{domain_name} %>
Options <% join ' ', @options %>
=head2 Perl Lines
Any line which starts with a '%' character will be treated as Perl code.
This is especially useful for conditional sections or loops, eg:
% if($ARGS{want_cgi}) {
ScriptAlias /bin/ /usr/lib/cgi-bin/<% $ARGS{domain_name} %>
% }
=head2 Perl Sections
A number of lines of Perl code can be wrapped in C<< <%perl> ... %perl> >>
tags. Both opening and closing tags must occur at the start of a line, eg:
<%perl>
my $domain_name = $ARGS{domain_name}
or die "Template requires a 'domain_name' parameter\n";
my $timestamp = localtime;
%perl>
You can also use C<< <%init> ... <%/init> >> tags to bracket a block of
Perl code that is run before all other code - regardless of where it appears in
the template.
=head2 Embedded Components
You can define named subcomponents - templates within your template, using the
C<< <%def name> ... %def> >> tags. The name consists of characters in the
set [\w._-].
<%def .allow_from>
% my $allowed = shift;
order deny,allow
deny from all
allow from <% $allow %>
%def>
You can call a subcomponent using its name and any arguments in
C<< <& ... &> >>, eg:
<& .allow_from, '127.0.0.1' &>
Note the comma after the component name. Subcomponents have a separate lexical
scope from the main template. Any variables which a component needs to see
should be passed as arguments.
=head2 Suppressing newlines
If you end a line with a backslash ('\'), neither the backslash nor the
following newline will not appear in the output.
=head1 HTML::Mason (in)compatibility
The syntax elements listed above are the complete syntax supported by this
module. A non-exhaustive list of cool stuff that L can do that
this module can't includes: C<< <%attr> >>, C<< <%flags> >>,
C<< <%cleanup> >>, C<< <%once> >>, C<< <%shared> >>, C<< <%filter> >>,
C<< <%doc> >> and C<< <%text> >> sections; escaping; filtering components;
inheritance and other OO things; autohandlers and dhandlers; caching; $m and $r
objects; Apache/mod_perl integration.
=head1 BUGS
Errors in templates do not always lead to useful error messages.
=head1 SEE ALSO
If you're looking for a templating tool to build web pages, L
would be a much better choice than this module.
=head1 COPYRIGHT
Copyright 2004 Grant McLean Egrantm@cpan.orgE
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut