################################################## ## ## Name: CGI::FastTemplate ## ## Copyright (c) 1998-99 Jason Moore . All rights ## reserved. ## ## This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## Artistic License for more details. ## ## ## Credits: ## - fancy regexp taken from article by Brian Slesinsky ## http://www.hotwired.com/webmonkey/code/97/21/index2a_page4.html?tw=perl ## ## - modified regexp to support ${VAR} and $VAR styles suggested by Eric L. Brine ## ## ## Documentation: ## See ## 'perldoc CGI::FastTemplate' ## or ## 'perldoc ./FastTemplate' ## ## History: ## See 'README' ## ## $Id: FastTemplate.pm,v 1.2 1999/06/27 02:12:23 jmoore Exp $ ## ################################################## package CGI::FastTemplate; use strict; $CGI::FastTemplate::VERSION = '1.09'; $CGI::FastTemplate::ROOT = undef; $CGI::FastTemplate::VAR_ID = '$'; $CGI::FastTemplate::DELIM_LEFT = '{'; $CGI::FastTemplate::DELIM_RIGHT = '}'; ## ## define indexes for object attributes ## sub STRICT () {0}; sub namespace () {1}; sub namespaces () {2}; sub last_parse () {3}; sub template_name () {4}; sub template_data () {5}; sub ROOT () {6}; ################################################## ## sub new ## ## - instantiates FastTemplate ## { my($class,$root) = @_; my $self = []; bless $self, $class; $self->init; $self->[STRICT] = 1; if (defined($root)) { $self->set_root($root); } return($self); } ################################################## ## sub strict ## { my($self) = shift; $self->[STRICT] = 1; } ################################################## ## sub no_strict ## { my($self) = shift; $self->[STRICT] = undef; } ################################################## ## sub clear_all ## ## - initializes (or clears!) variables ## { my($self) = shift; if (!ref($self)) { print STDERR "FastTemplate: Unable to call init without instance.\n"; return(); } $self->[namespace] = {}; ## main hash where we resolve variables $self->[namespaces] = []; ## array of hash refs $self->[last_parse] = undef; ## remember where we stored the last parse so print() ## will have a default $self->[template_name] = {}; ## template name: template file $self->[template_data] = {}; ## template name: template content/data } *init = \&clear_all; ## alias to 'clear' : 'init' ################################################## ## sub clear_define ## ## - clears values entered with define() ## { my($self) = shift; $self->[template_name] = {}; } ################################################## ## sub clear_tpl ## ## - clears hash that holds loaded templates. ## - if passed an array of names, clears only those loaded templates ## { my($self) = shift; my @args = @_; if (@args == 0) ## clear entire cache { $self->[template_data] = {}; return(1); } ## clear just a selection of entries for (@args) { delete( ${$self->[template_data]}{$_} ); } return(1); } ################################################## ## sub clear_href ## ## - removes from the end, a given number of hash references ## from the namespace list. ## ## - 1: number of hash references to erase ## { my($self, $number) = @_; if (!defined($number)) { $self->[namespaces] = []; return(1); } for (1..$number) { pop(@{$self->[namespaces]}); ## toss it away } return(1); } ################################################# ## sub clear_parse ## ## - clears hash which holds parsed variables ## - if called with a scalar only clears that key/element in the namespace. ## so, $tpl->clear("ROWS") which is almost the same as, ## $tpl->assign(ROWS => ""); ## ## - if called with an array, all keys in the array are deleted ## e.g. $tpl->clear("ROWS", "COLS"); has the same effect as ## $tpl->assign(ROWS => "", ## COLS => ""); ## ## { my $self = shift; if (@_ == 0) ## clear everything { $self->[namespace] = {}; ## main hash where we resolve variables $self->[last_parse] = undef; ## remember where we stored the last parse so print() return(1); } for (@_) { delete(${$self->[namespace]}{$_}); } return(1); } *clear = \&clear_parse; ## alias clear -> clear_parse ################################################## ## sub set_root ## ## - sets template root directory. { my($self, $root) = @_; ## set object default root directory $CGI::FastTemplate::ROOT = $root; ## set instance template dir ## ## - no needed ## if (ref($self)) { $self->[ROOT] = $root; } return(1); } ################################################## ## sub define ## ## - sets alias/name to associate with template filenames ## - note: names are relative to ROOT directory (set with set_root) ## - e.g. the following works ## $tpl->set_root("/tmp/docs"); ## $tpl->define( main => "../dev_docs"); ## (assuming you have templates in /tmp/dev_docs) ## ## - files are not loaded until used, so go nuts when defining. each line ## only costs a wee bit of memory and compile time. ## ## - note: define is cumulative ## { my($self, %define) = @_; for (keys(%define)) { $self->[template_name]->{$_} = $define{$_}; } return(1); } ################################################## ## sub assign ## ## - assigns values of a HASH directly to internal namespace ## HASH ## ## Args: ## - 1: hash reference (to add to array of namespaces) ## - 1: hash (to merge with main namespace hash) ## ## - returns: 1 on success ## { my $self = shift; if (ref($_[0]) eq "HASH") { push(@{$self->[namespaces]}, $_[0]); return(1); } my %assign = @_; my($name,$value); while ( ($name,$value) = each(%assign) ) { $self->[namespace]->{$name} = $value; } return(1); } ################################################## ## sub parse ## ## - parses a scalar to resolve/interpolate any variables ## it finds. ## ## - 1: hash of what we are parse in TARGET:SOURCE form ## NOTE: SOURCE with a "." as the first character get appended ## to existing TARGET ## { my($self, %parse) = @_; my $target; for $target (keys(%parse)) { ## ## make all sources an array... ## if (ref($parse{$target}) ne "ARRAY") { $parse{$target} = [$parse{$target}]; } my($p, $append); for $p (@{$parse{$target}}) { if (substr($p,0,1) eq ".") ## detect append { $append = 1; $p = substr($p, 1); } if (!exists($self->[template_name]{$p})) { print STDERR "FastTemplate: Template alias: $p does not exist.\n"; next; } ## load template if we need to if (!exists($self->[template_data]{$p})) { $self->slurp($self->[template_name]->{$p}, \$self->[template_data]->{$p} ); } ## copy SOURCE (template_data) to temp variable ## (can't use namespace, since we might be appending to it.) my $temp_parse = $self->[template_data]->{$p}; ######### ## parse ######### $temp_parse =~ s/\$(?:([A-Z][A-Z0-9_]+)|\{([A-Z][A-Z0-9_]+)\})/ my $v = $self->[namespace]->{$+}; if (!defined($v)) { ## look in array of hash refs for value of variable my $r; for $r (@{$self->[namespaces]}) { if (exists($$r{$+})) ## found it { $v = $$r{$+}; last; } } } if (!defined($v)) ## $v should be empty not undef, to prevent { ## warnings under -w if ($self->[STRICT]) { print STDERR "[CGI::FastTemplate] Warning: no value found for variable: $+\n"; $v = '$' . $+; ## keep original variable name in output } else { $v = ""; ## remove variable name } } $v; /ge; $self->[last_parse] = $target; ## assign temp to final TARGET if ($append) { $self->[namespace]->{$target} .= $temp_parse; } else { $self->[namespace]->{$target} = $temp_parse; } } } } ################################################## ## sub slurp ## ## - slurps (loads) in file into a scalar. ## - cool trick to undef the end of line character ## grabbed from some usenet posting. (don't remember) ## ## - i think the maximum file size is (2**32-1) approx. 2 megs. ## ## - 1: filename (minus path) ## - 2: reference to put result in [optional] ## returns: scalar ## ## { my($self, $filename, $ref) = @_; my $temp; if (ref($self) && defined($self->[ROOT])) ## use instance ROOT { $filename = $self->[ROOT] . "/" . $filename; } elsif (defined($CGI::FastTemplate::ROOT)) ## use object ROOT { $filename = $CGI::FastTemplate::ROOT . "/" . $filename; } if (!open(TEMPLATE, $filename)) { print STDERR "FastTemplate: slurp: cannot open: $filename ($!)"; return(); } ## cool trick! local($/) = undef; $temp =