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>(.*?)$nl?}s; $perl_sect = qr{<%perl>(.*?)$nl?}s; $perl_line = qr{(?:(?<=\n)|^)%(.*?)(\n|\Z)}s; $comp_def = qr{<%def\s+([.\w+]+)>$nl(.*?)$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> ... >> 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; 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> ... >> 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 %> 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