Apache-SimpleTemplate
view release on metacpan or search on metacpan
SimpleTemplate.pm view on Meta::CPAN
sub compile {
my $s = shift;
my $template = $_[1] ? $_[0] : &load($_[0]);
if (!defined $template) { $s->{_error} .= "Not Found: $_[0]\n"; return 404; }
my $block_begin = $s->{block_begin} || $DEFAULT_BLOCK_BEGIN;
my $block_end = $s->{block_end} || $DEFAULT_BLOCK_END;
print STDERR "-- DELIM: $block_begin $block_end\n" if $s->{debug} > 2;
$block_begin =~ s/([^\w])/\\$1/g;
$block_end =~ s/([^\w])/\\$1/g;
my $eval = '';
my $precode = '';
my $package = 'Apache::SimpleTemplate::Template'.$_[0];
$package =~ s/\//\:\:/g;
$package =~ s/[^\w\:]/_/g;
my $usepackage = 0;
$template =~ s/($block_begin)\#(.*?)\#($block_end)/$1.'-'.&blank_lines($2).$3/gse;
#$template =~ s/$block_begin\-(.*?)$block_end/&blank_lines($1)/gse;
if ($template =~ s/$block_begin\!(.*?)$block_end/
$precode .= $1 . '; ';
'';
/gse) {
$usepackage = 1;
if ($s->{debug} > 3) {
print STDERR "============================INITIAL BLOCK\n";
print STDERR $precode . "\n";
print STDERR "============================/INITIAL BLOCK\n";
}
}
if ($usepackage) {
$eval .= "package $package; use Apache::SimpleTemplate; " . $precode;
}
$eval .= 'sub ' . ($usepackage?'____st_go_ ':''). '{ my ($s) = @_; ';
$eval .= 'my $r = $s->{r}; my $____st_out_ = $s->{out}; my $inref=$s->{inref}; ';
my @pieces = split (/$block_end/, $template);
# fix parsing problem if code block at very end of template.
if (($template =~ m/$block_end$/s) && !($template =~ m/$block_end\n$/s)) { push (@pieces, ''); }
# for (my $i=0; $i<=$#pieces; $i++) {
# print STDERR "==================================PIECE $i:\n";
# print STDERR $pieces[$i];
# print STDERR "\n==================================\n";
# }
my $i = 0;
for (; $i<$#pieces; $i++) {
if ($pieces[$i] =~
m/(.*?)$block_begin([\^\+\\\-\=\:]?)(.*?)\;?(\s*)$/gs) {
my $text = "e_escape($1);
my $encode = $2;
my $block = $3.$4;
if ($s->{debug} > 3) {
print STDERR "==================================TEXT $i:\n";
print STDERR "$1\n";
print STDERR "==================================CODE ($encode) $i:\n";
print STDERR "$block\n";
}
$eval .= '$$____st_out_ .= \''.$text."'; ";
if (!$encode) {
$eval .= $block .'; ';
}
elsif ($encode eq ':') {
print STDERR "** Apache::SimpleTemplate: DEPRECATED ':' OPERATOR." if ($s->{debug} > 1);
$eval .= '{ my $out = undef; my $____st_tmp_=eval {'.$block.'}; ';
$eval .= '$$____st_out_ .= (defined $out) ? $out : $____st_tmp_;'.'}; ';
}
elsif ($encode eq '=') {
$eval .= '$$____st_out_ .= ('.$block.'); ';
}
elsif ($encode eq '+') {
$eval .= '$$____st_out_ .= &Apache::SimpleTemplate::encode('.$block.'); ';
}
elsif ($encode eq '^') {
$eval .= '$$____st_out_ .= &Apache::SimpleTemplate::escape('.$block.'); ';
}
elsif ($encode eq '\\') {
$eval .= '$$____st_out_ .= &Apache::SimpleTemplate::js_escape('.$block.'); ';
}
elsif ($encode eq '-') {
$eval .= &blank_lines($block);
}
}
else {
print STDERR "** Apache::SimpleTemplate $_[0]: Invalid Block in:\n";
print STDERR $pieces[$i].$s->{block_end}."\n";
$s->{_error} .= "Invalid Block: ".$pieces[$i].$s->{block_end}."\n";
return 500;
}
}
if ($s->{debug} > 3) {
print STDERR "==================================TEXT $i:\n";
print STDERR "$pieces[$i]\n";
print STDERR "==================================\n";
}
$eval .= '$$____st_out_.=\''."e_escape($pieces[$i]).'\'; ';
$eval .= "return (\$____st_out_);\n}";
#if ($usepackage) { $eval .= "1;\n"; }
if ($s->{debug} > 2) {
print STDERR "===================================================EVAL\n";
print STDERR "$eval\n";
print STDERR "===================================================/EVAL\n";
}
my $fun = eval($eval);
if ($@) { print STDERR "** Apache::SimpleTemplate $_[0]: $@\n"; $s->{_error} .= $@; return 500; }
if ($usepackage) { return 200; }
return $fun;
}
sub blank_lines {
my ($string) = @_;
$string =~ s/[^\n]//g;
return $string;
}
#
# include
#
# for use in templates, so they can include other templates/files.
# takes a path relative to the document root.
# $s->include('/path/relative/to/docroot.stml');
#
sub include {
my $s = shift;
print STDERR "---- Apache::SimpleTemplate::include FROM $s->{file} FOR $_[0]\n" if ($s->{debug} > 1);
my $tmp = $s->{status};
$s->render($ENV{DOCUMENT_ROOT}.$_[0]);
$s->status($tmp) if ($s->{cascade_status} == 0);
}
#
# preload a template into memory
# takes a full path
#
sub preload {
my $s = shift;
$_cache{$_[0]} = $s->compile($_[0]);
}
#########################################################
# OTHER FUNCTIONS (callable as methods, too.)
#
# url-encode a string
sub encode {
my $s = shift;
if (ref $s) { $s = shift; }
return undef unless defined($s);
$s =~ s/([^a-zA-Z0-9_\.\-\ ])/uc sprintf("%%%02x",ord($1))/eg;
$s =~ s/\ /\+/g;
return $s;
}
# url-decode a string
sub decode {
my $s = shift;
if (ref $s) { $s = shift; }
return undef unless defined($s);
$s =~ s/\+/ /g;
$s =~ s/\%([0-9a-fA-F]{2})/chr(hex($1))/eg;
return $s;
}
# html-escape a string ('<tag> & " ' becomes '<tag> & "')
sub escape {
my $s = shift;
if (ref $s) { $s = shift; }
return undef unless defined($s);
$s =~ s/\&/&/g;
$s =~ s/\</</g;
$s =~ s/\>/>/g;
$s =~ s/\"/"/g;
return $s;
}
# escape single quotes (') and backslashes (\) with \' and \\
sub quote_escape {
my $s = shift;
if (ref $s) { $s = shift; }
return undef unless defined($s);
$s =~ s/([\'\\])/\\$1/gs;
return $s;
}
# escape single quotes (') and backslashes (\) with \' and \\, newlines and cr's with \n \r
sub js_escape {
my $s = shift;
if (ref $s) { $s = shift; }
return undef unless defined($s);
$s =~ s/([\'\\])/\\$1/gs;
$s =~ s/\n/\\n/g;
$s =~ s/\r/\\r/g;
return $s;
}
#
# parse_form
#
# try to get the form data every which way..
# %form = $r->args; loses multiple checkboxes....
# and doesn't parse a QUERY STRING in a POST. :(
#
sub parse_form {
my $s = shift;
my ($r) = @_;
#print STDERR "PARSE FORM! $r\n";
my (%form, @form);
if ($r && $r->args && ref($r->args)) {
@form = $r->args;
}
# elsif ($ENV{QUERY_STRING}) {
# foreach my $pair (split('&', $ENV{QUERY_STRING})) {
elsif (($r && $r->args) || $ENV{QUERY_STRING}) {
foreach my $pair (split('&', (($r && $r->args) ? $r->args : $ENV{QUERY_STRING}))) {
my ($k, $v) = split('=', $pair);
push (@form, &decode($k), &decode($v));
}
}
if (($r) && ($r->method() eq 'POST') && ($r->header_in('Content-Length') > 0)) {
# handle upload posts
if ($r->header_in('Content-Type') =~ m/multipart\/form-data/i) {
use CGI;
$CGI::DISABLE_UPLOADS = 0;
my $cgi = CGI->new();
foreach my $k (keys %{$cgi->Vars}) { $form{$k} = $cgi->param($k); }
use CGI::Upload;
my $upload = CGI::Upload->new({ query => $cgi });
$s->{upload} = $upload;
}
# handle other posts
else {
push @form, $r->content();
}
SimpleTemplate.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Apache::SimpleTemplate
=head1 SYNOPSIS
=head2 in httpd.conf:
<Files *.stml>
SetHandler perl-script
PerlHandler +Apache::SimpleTemplate
### options (w/ defaults):
#PerlSetVar SimpleTemplateCache 1
#PerlSetVar SimpleTemplateReload 1
#PerlSetVar SimpleTemplateDebug 0
#PerlSetVar SimpleTemplateCascadeStatus 1
#PerlSetVar SimpleTemplateBlockBegin "<%"
#PerlSetVar SimpleTemplateBlockEnd "%>"
#PerlSetVar SimpleTemplateContentType "text/html"
</Files>
### have index.stml files handle a request for a directory name.
#DirectoryIndex index.html index.stml
<Location /example>
SetHandler perl-script
PerlHandler +Apache::SimpleTemplate
PerlSetVar SimpleTemplateFile "/templates/example.stml"
</Location>
=head2 in a template:
=head3 <%! _perl_definitions_or_declarations_ %>
compiles the code once. (the code block is replaced by nothing.)
can be used for defining subroutines, 'use' calls, declaring and
populating variables/hashes/etc.
=head3 <% _perl_code_ %>
executes the perl code. (this block is replaced by nothing.)
can also declare variables for use within the template.
=head3 <%= _a_perl_expression_ %>
evaluates the perl expression, and the block gets replaced by
the expression's value.
'<%+ %>' is the same as '<%= %>', but the output gets url-encoded.
(mnemonic: '+' is a space in a url-encoded string.)
'<%^ %>'is the same as '<%= %>', but the output gets html-escaped.
(mnemonic: '^' looks like the '<' and '>' that get replaced.)
'<%\ %>'is the same as '<%= %>', except the string gets escaped for
use as a single-quoted javascript var. ("'", "\", NL, CR get escaped.)
=head3 <%- _a_comment_ %>
is ignored and replace by nothing.
(mnemonic: "-" as in "<!-- html comments -->".)
=head3 <%# _comment_out_text_and/or_template_blocks_ #%>
comment out larger areas of templates, including code blocks.
NB: the '#' on the closing tag, as this is the only tag which can
wrap other tags.
=head3 <% $s->include('/dir/file.stml') %>
includes another file or parsed-template in place of this.
=head3 <%= $$inref{foo}; %>
prints the value of the CGI/form input variable 'foo'.
=head3 <% $s->header('Location','/'); $s->status(302); return; %>
ends execution of the template and redirects browser to '/'.
=head3 <% $s->content_type('text/xml'); %>
sets our content-type to 'text/xml' instead of default 'text/html';
=head3 <%: _perl_code_ %> DEPRECATED
evaluates the perl code, and the block gets replaced by the last
value returned in the perl code, or $out if defined. (included
mostly for backward compatability-- it's better to use a mixture
of <% %> and <%= %> blocks.)
(mnemonic: '<%: %>' is like a combination of '<% %>' and '<%= %>'.)
=head1 DESCRIPTION
Apache::SimpleTemplate is *another* Template-with-embedded-Perl package
for mod_perl. It allows you to embed blocks of Perl code into text
documents, such as HTML files, and have this code executed upon HTTP
request. It should take moments to set-up and learn; very little knowledge
of mod_perl is necessary, though some knowledge of Apache and perl is
assumed.
This module is meant to be a slim and basic alternative to more fully
featured packages like Apache::Embperl, Apache::ASP, or TemplateToolkit,
and more of a mod_perl counterpart to JSP or PHP. You may wish to compare
approaches and features of the other perl templating schemes, and consider
trade-offs in funcionality, implementation time, speed, memory
consumption, etc. This module's relative lack of "features" is meant to
improve both its performance and its flexibility.
Apache::SimpleTemplate has no added programming syntax, relying simply
on perl itself for all programming logic in the templates. It should
run with a very small memory footprint and little processing over-head.
Templates get compiled into perl packages (or subroutines), and the
caching and preloading options can help you increace speed and reduce
SimpleTemplate.pm view on Meta::CPAN
#### or non-CGI use, just get the rendered page:
# $s->render('/full/path/to/file.stml');
# print ${ $s->{out} };
=head1 VARIABLES & FUNCTIONS
=head2 variables in templates:
$r - this instance of 'Apache', i.e. the request object.
$s - this instance of 'Apache::SimpleTemplate' (or your subclass)
$inref - a reference to a hash containing the CGI/form input args
$____st_* - these names are reserved for use inside the parsing function.
=head2 constructor and getters/setters:
$s = new Apache::SimpleTemplate($r) -- pass the Apache request object, $r.
parses CGI params.
$s = new Apache::SimpleTemplate($in) -- pass me a hash of CGI params.
$s = new Apache::SimpleTemplate() -- parses params from $ENV{QUERY_STRING}
$s->block_begin() -- get or set the beginning delimiter
$s->block_begin('<%')
$s->block_end() -- get or set the ending delimiter
$s->block_end('%>')
$s->file() -- get or set a file for rendering
$s->file('/foo.stml')
$s->debug() -- get or set the debug level (0=quiet - 3=verbose)
$s->debug(1)
$s->reload() -- get or set the reload flag (0 or 1)
$s->reload(1)
$s->cache() -- get or set the caching flag (0 or 1)
$s->cache(1)
$s->cascade_status() -- get or set flag for cascading status codes
$s->cascade_status(0) from included templates
=head2 other methods/functions (mostly useful in templates):
$s->content_type('text/xml') -- set our content-type to something
(must be done before any call to flush().)
$s->status(302) -- set our status to something other than 200
(must be done before any call to flush().)
$s->header($name,$value) -- add an outgoing header. (can add multiple
of the same name.)
(must be done before any call to flush().)
return -- stop running this template (within <% %>)
$s->encode($string) -- url-encode the $string.
&Apache::SimpleTemplate::encode($string)
$s->decode($string) -- url-decode the $string.
&Apache::SimpleTemplate::decode($string)
$s->escape($string) -- html-escape the $string.
&Apache::SimpleTemplate::escape($string)
$s->quote_escape($string) -- single-quote-escape the $string.
&Apache::SimpleTemplate::quote_escape($string)
$s->js_escape($string) -- single-quote and newline escape (for javascript)
&Apache::SimpleTemplate::quote_escape($string)
$s->preload($file) -- preload the template in $file, a full
path which must match the DOCUMENT_ROOT.
(for use in a startup.pl file.)
$s->include('/dir/file') -- include another document/template.
the path is relative to the DOCUMENT_ROOT
$s->print(...) -- print out something from within <% %>.
$s->flush() -- flush the print buffer (within <% %>).
(sends HTTP headers on the first call.)
=head2 deprecated and removed vars and functions.
$out - deprecated template variable.
a <%: %> block of code could use this for the output,
instead of the last value returned by the block.
use <% %> or <%= %> blocks as needed instead.
$headerref - removed, use $s->header() instead.
$status - removed, use $s->status() instead.
$content_type - removed, use $s->content_type() instead.
Apache::SimpleTemplate::include() -- static calls no longer work.
instantiate if necessary, and use $s->include() instead.
(shouldn't have been included in the first place, as they
would not follow any settings other than defaults.)
=head2 PerlSetVar options
SimpleTemplateBlockBegin -- the delim for a code block's end ['<%']
SimpleTemplateBlockEnd -- the delim for a code block's start ['%>']
SimpleTemplateCache -- keep templates in memory? [1]
SimpleTemplateReload -- check templates for changes? [1]
SimpleTemplateDebug -- level of debug msgs in error_log (0-3) [0]
(if >= 1, compile errors go to the browser.)
SimpleTemplateContentType -- the default content_type ['text/html']
SimpleTemplateCascadeStatus -- set to 0 if you do not want included
templates to affect the response status.
SimpleTemplateFile -- template file location (w/in doc_root)
probably useful only within a <Location>.
[the incoming request path]
=head1 OTHER TIDBITS
=head2 template processing
Any errors in evaluating a code block should get logged to the error_log.
The compilation process tries to keep the line numbers consistent with
the template, but <%! %> declarations/definitions that are not at the
top of the template may throw line numbers off.
Any additional variables you wish to use must be declared (with 'my').
If you declare them in <%! %> or <% %> blocks, they will be accessible
in later blocks.
( run in 1.758 second using v1.01-cache-2.11-cpan-39bf76dae61 )