[推荐+转载]HTML::Template文档翻译:)

By tojeff

全文如下:


package Template;
$Template::VERSION = '2.6';
=head1 NAME
Template - 在CGI中使用HTML模板的模块
=head1 SYNOPSIS
首先你需要创建一个模板 - 仅仅是带有扩展的标志的 HTML 文件,
最常见的扩展标志就是 <TMPL_VAR>
例如, test.tmpl:
<html>
<head><title>Test Template</title>
<body>
My Home Directory is <TMPL_VAR NAME=HOME>
<p>
My Path is set to <TMPL_VAR NAME=PATH>
</body>
</html>
现在创建一个小 CGI 程序:
#!/usr/bin/perl -w
use Template;
# 打开HTML模板
my $template = Template->new(filename => 'test.tmpl');
# 填充部分参数
$template->param(HOME => $ENV{HOME});
$template->param(PATH => $ENV{PATH});
#发送必须的 Content-Type,并且打印模板输出
print "Content-Type: text/html\n\n", $template->output;
如果设置正确的话,运行CGI程序以后,将在浏览器中显示如下的内容:
My Home Directory is /home/some/directory
My Path is set to /bin;/usr/bin
=head1 DESCRIPTION
本模块试图简单并且自然的使用 HTML 模板.她继承了 HTML 并且扩展了部分新的HTML标签
-<TMPL_VAR>,<TMPL_LOOP>,<TMPL_INCLUDE>,<TMPL_IF>,<TMPL_ELSE>和<TMPL_UNLESS>.
使用HTML和上述的标签编写的模板将会被调用,也就是说你的模板可以和你的脚本分离,
甚至可以由其他人来创建,修改,然后使用本模块来填充模板中的变量,循环和分支申明.
这将帮助你将脚本使用的 数据结构设计 和 HTML 分开.
=head1 THE TAGS
=head2 TMPL_VAR
<TMPL_VAR NAME="PARAMETER_NAME">
<TMPL_VAR> 标签非常的简单.
模板中的每个 <TMPL_VAR> 都要调用$template->param(PARAMETER_NAME => "VALUE").
当页面输出的时候,<TMPL_VAR> 将会被你赋的变量值取代.
如果你没有设置模板中的一些变量值,在输出时仅仅跳过.
一个可选的属性:你可以在你的标签里面使用 "ESCAPE=HTML" ,以在输出前编码部
分HTML字符.也就是说", <, >, 和 & 字符将转换为 ", <, >和 &.
这个属性在你的变量中如果包含HTML代码可能会带来麻烦的时候才非常有用.
例:
<input name=param type=text value="<TMPL_VAR NAME="PARAM">">
如果你给 param() 传递类似与 sam"my ,那么你将会在双引号部分引来麻烦.
在另外一个方面, 如果你使用ESCAPE=HTML, 例如:
<input name=param type=text value="<TMPL_VAR ESCAPE=HTML NAME="PARAM">">
无论提交者提交的参数怎么变化,你将会得到任何你想得到的值.
你可以使用的格式: ESCAPE="HTML", ESCAPE='HTML' 和 ESCAPE='1'.
如果传递给 ESCAPE 的参数0,将关闭过滤,而且默认的设置是关闭的.
同样你也可以使用 "ESCAPE=URL" 来处理URL.
她将做 URL 过滤, 比如,替换 ' ' 为 '+'和替换 '/' 为 '%2F'.
你也可以使用一个 DEFAULT 来设置缺省的默认值.
例如, 你要输出 "the devil gave me a taco",如果 "who" 变量没有被设置.
The <TMPL_VAR NAME=WHO DEFAULT=devil> gave me a taco.
=head2 TMPL_LOOP
<TMPL_LOOP NAME="LOOP_NAME"> ... </TMPL_LOOP>
<TMPL_LOOP>标签比<TMPL_VAR>稍微复杂一点. <TMPL_LOOP> 允许你划定一块文本区块,
并且给她一个名字. 在区块内部,你可以放置<TMPL_VAR>标签. 为了循环,需要传递给
param()的参数分配(散列引用(hash refs))一个表 (一个数组(array ref)).
循环将重述列表,并且给每个参数产生文本块. 未设置的参数将会被跳过. 举例如下:
模板文件:
<TMPL_LOOP NAME=EMPLOYEE_INFO>
Name: <TMPL_VAR NAME=NAME> <br>
Job: <TMPL_VAR NAME=JOB> <p>
</TMPL_LOOP>
脚本:
$template->param(EMPLOYEE_INFO => [
{ name => 'Sam', job => 'programmer' },
{ name => 'Steve', job => 'soda jerk' },
]
);
print $template->output();
浏览器中的输出:
Name: Sam
Job: programmer
Name: Steve
Job: soda jerk
如上面你所见<TMPL_LOOP>进行了参数的分配并且重述了循环输出
一般情况下,如果你想用程序产生一个<TMPL_LOOP>的循环,下面是一个详细的例子
(可能有很多种其他方法可以实现!):
# 需要放入循环中的数组:
my @words = qw(I Am Cool);
my @numbers = qw(1 2 3);
my @loop_data = (); # 初始化循环数组
while (@words and @numbers) {
my %row_data; # 使用新的散列
# fill in this row
$row_data{WORD} = shift @words;
$row_data{NUMBER} = shift @numbers;
# 先将数据保存在散列中,然后在压入数组
push(@loop_data, \%row_data);
}
# 为 param()传递参数(引用)
$template->param(THIS_LOOP => \@loop_data);
上面的例子可以与下面的模板一起工作:
<TMPL_LOOP NAME="THIS_LOOP">
Word: <TMPL_VAR NAME="WORD"> <br>
Number: <TMPL_VAR NAME="NUMBER"> <p>
</TMPL_LOOP>
她将产生如下的输出:
Word: I
Number: 1
Word: Am
Number: 2
Word: Cool
Number: 3
嵌套的 <TMPL_LOOP>也可以很好按照你的期望的情况正确的工作.
如果传递给 param() 的参数有冗余, 下面是使用嵌套的一个例子:
$template->param(LOOP => [
{ name => 'Bobby',
nicknames => [
{ name => 'the big bad wolf' },
{ name => 'He-Man' },
],
},
],
);
基本上, 每个<TMPL_LOOP>将获取一个数组引用.数组内部是任意数量的散列引用.
这些散列包含'name=>value'对来给模板中的循环传递单个的参数.
在<TMPL_LOOP>中, 变量仅仅能够在 <TMPL_LOOP> 以后才可用.模板中的<TMPL_LOOP>
的区块外的变量将不可见.由于Perl语言的面向对象的特殊性,<TMPL_LOOP> 引入了新的类
似于Perl子程序的调用.如果你想变量是全局可用的,你可以在new()使用'global_vars'选项描述.
=head2 TMPL_INCLUDE
<TMPL_INCLUDE NAME="filename.tmpl">
该标签在当前模板点包含一个模板进来. 被包含的模板内容与直接放置在主模板中的效果一样.
文件路径可以是绝对路径(在UNIX中以 '/'开头).如果不是绝对路径,模块将在文件的当前路径搜索.
如果没有找到,并且环境变量中的'HTML_TEMPLATE_ROOT'变量如果存在,该路径将会被搜索.
最后, 'path' 选项将要考虑;
总之,首先是当前,其次是'HTML_TEMPLATE_ROOT',最后文件名将传递给 open().
查看下面的关于'HTML_TEMPLATE_ROOT'和 new()的'path'选项获得更多的信息.
作为'HTML_INCLADE'的多重递归调用的保护措施, 默认'HTML_INCLADE'只在10层以内才起作用.
你可以使用 "max_includes" 选项转换限制条件.查看下面的 "max_includes" 选项获得更多的细节.
=head2 TMPL_IF
<TMPL_IF NAME="PARAMETER_NAME"> ... </TMPL_IF>
<TMPL_IF>标签可以由传递的参数决定是不是要在输出中包含一段文字块.
如果参数是Perl中的真值的话(例如 '1'),然后文字块将会被包含.
如果是未定义或者是否(例如'0'),然后文字块将会被跳过.参数传递方法类似于TMPL_VAR.
例:
<TMPL_IF NAME="BOOL">
Some text that only gets displayed if BOOL is true!
</TMPL_IF>
如果你调用$template->param(BOOL => 1),然后上面的文字块将会被包含在输出中.
<TMPL_IF>...</TMPL_IF>块可以包含在任意的有效模板中,比如VARs和LOOPs以及其他的IF/ELSE结构.
注意,交叉的<TMPL_IF>和<TMPL_LOOP>是无效的.
下面的将不能够正常的工作:
<TMPL_IF BOOL>
<TMPL_LOOP SOME_LOOP>
</TMPL_IF>
</TMPL_LOOP>
如果TMPL_LOOP的名字与TMPL_IF相同,并且LOOP至少含有一行,IF块将会输出.
例:
<TMPL_IF LOOP_ONE>
This will output if the loop is not empty.
</TMPL_IF>
<TMPL_LOOP LOOP_ONE>
....
</TMPL_LOOP>
警告: 模块的最大的优点就是协调了HTML和Perl的相互关系.
如果你使用TMPL_IF和Perl if()交叉使用很多的话,那么你会给维护带来很多的困难.
所以我建议你仅仅使用TMPL_IF,只要你可以不使用Perl代码中的 if()的情况下.
=head2 TMPL_ELSE
<TMPL_IF NAME="PARAMETER_NAME">...<TMPL_ELSE>...</TMPL_IF>
你可以使用TMPL_ELSE在你的TMPL_IF中包含一个选择.
注意:你仍然要用</TMPL_IF>来结束,而不是</TMPL_ELSE>!
例:
<TMPL_IF BOOL>
Some text that is included only if BOOL is true
<TMPL_ELSE>
Some text that is included only if BOOL is false
</TMPL_IF>
=head2 TMPL_UNLESS
<TMPL_UNLESS NAME="PARAMETER_NAME">...</TMPL_UNLESS>
这是<TMPL_IF>对立的标签.如果控制参数为假,或者未定义,文字块将会输出.
你可以使用<TMPL_ELSE>来搭配<TMPL_UNLESS>,使用方法类似与<TMPL_IF>.
例:
<TMPL_UNLESS BOOL>
Some text that is output only if BOOL is FALSE.
<TMPL_ELSE>
Some text that is output only if BOOL is TRUE.
</TMPL_UNLESS>
如果TMPL_LOOP的名字被使用在TMPL_UNLESS中, 那么并且LOOP没有内容,UNLESS块将会输出.
例:
<TMPL_UNLESS LOOP_ONE>
This will output if the loop is empty.
</TMPL_UNLESS>
<TMPL_LOOP LOOP_ONE>
....
</TMPL_LOOP>
=cut
=head2 NOTES
Template的标签试图模仿标准的HTML的语法.然而,它们被允许打破惯例.类似于:
<img src="<TMPL_VAR IMAGE_SRC>">
这并不是真正有效的HTML, 但是却是非常有效的代码,可以按照希望的要求工作.
选项 "NAME=" 是可选的, 虽然为了更好的展开,我强烈建议使用她.
例如"<TMPL_LOOP LOOP_NAME>" 是接受的.
如果你是标准HTML的追随者,并且希望你的模板也遵循标准的HTML语法,
你可以按照HTML的形式随意的定义模板的标签.这可能对使用HTML的编辑器或者那些使用DTD格式的工具
来检查模板的HTML语法的人员.
<!-- TMPL_VAR NAME=PARAM1 -->
为了方便说明, 标准的标签将在本文档中使用.
=head1 METHODS
=head2 new()
调用 new() 创建一个新的模板对象:
my $template = Template->new( filename => 'file.tmpl',
option => 'value'
);
调用 new() 的时候,你必须至少含有一对name => value对来指定访问模板文件的方法.
你可以使用"filename => 'file.tmpl'" 来指定一个文件名来打开她作为一个模板.
类似的,你也可以
使用:
my $t = Template->new( scalarref => $ref_to_template_text,
option => 'value'
);

my $t = Template->new( arrayref => $ref_to_array_of_lines ,
option => 'value'
);
这些都是初始化模板进入内存资源.在大多数的情况下,你可以想使用文件名参数.
如果你担心使用mod_perl以后,所有的模板的访问权限,那么缓冲选项的细节部分如下.
你可以从已经打开的文件句柄中读取模板,类似与传统的typeglob以及FileHandle:
my $t = Template->new( filehandle => *FH, option => 'value');
如果你喜欢,四个新的 new() 调用方法样式也可以使用.
my $t = Template->new_file('file.tmpl', option => 'value');
my $t = Template->new_scalar_ref($ref_to_template_text,
option => 'value');
my $t = Template->new_array_ref($ref_to_array_of_lines,
option => 'value');
my $t = Template->new_filehandle($fh,
option => 'value');
作为最后一个选项, 可能会有人需要, 你可以这样调用new()方法:
my $t = Template->new( type => 'filename',
source => 'file.tmpl'
);
她将可以与三种源一起工作.
如果环境变量HTML_TEMPLATE_ROOT被设置,并且文件名是以'/'开始(UNIX),
那么文件的路径将关联到"$HTML_TEMPLATE_ROOT" 的值.
例如,环境变量HTML_TEMPLATE_ROOT被设置为"/home/sam"并且我使用文件名"sam.tmpl"调用,
那么Template将会打开"/home/sam/sam.tmpl"访问模板.
你仍然可以使用new()的"path"选项来影响路径(查看下面获得更多的信息).
你可以使用new来修改Template对象的行为.这些选项都是有效的:
=over 4
=item Error Detection Options
=over 4
=item *
die_on_bad_params - 如果设置为0,那么,模块允许在'param_name'不存在的情况下,
调用$template->param(param_name => 'value'),而不退出. 默认设置为1.
=item *
strict - 如果设置为0,那么,模块允许在TMPL_*被使用而不退出.
例:
<TMPL_HUH NAME=ZUH>
通常情况下将是一个错误, 但是你在调用new的时候使用'strict => 0',标签将会忽略.默认设置为 1.
=item *
vanguard_compatibility_mode - 如果设置为1,那么模块将愿意看到<TMPL_VAR>
标签看起来类似于 %NAME% 作为传统方式(早期)的补充.
同时也要设置 die_on_bad_params => 0.默认为 0.
=back
=item Caching Options
=over 4
=item *
cache - 如果设置为1,模块将要在内存中缓冲,然后按参数分析模板并且修正文件中的数据.
这仅仅作用适用于使用指定文件名的方式打开模板, 而不是标量引用(scalarref)和数组引用模块(arraryref).
缓冲同样也查看任何文件的修正时间,包含使用的<TMPL_INCLUDE>标签, 但是,再一次说明:
仅仅适用于指定文件名的方式打开模板的.
这主要是服务于类似于Apache/mod_perl等持久稳固的环境中使用.
这对使用普通的CGI环境是绝对没有任何益处的,因为程序在每次请求以后都要从内存中清除的.
为了能够与通常的CGI程序缓冲,查看下面的'shared_cache'选项.
注意:不同的new()参数设置不会导致缓冲的刷新, 仅仅修正模板的时间更改将会引发缓冲的刷新.
对大多数的使用,这种方法是很好的.在mod_perl下,我简单测试了一下,使用cache使90%
的执行过程提高了速度.Cache 默认为0.
=item *
shared_cache - 如果设置为 1 模块将使用IPC::SharedCache(可以从 CPAN 站点获得)模块,
保存缓冲在共享的内存中.这样做的的好处就是为使用每个分析模板的一个共享进程,
这将在多用户的服务器环境中大幅度的减少内存的使用.举例,在一个系统上,我们使用 4MB 模板高速
缓冲并且维持 25 个httpd进程shared_cache可以节省大约 100MB!当然, 相对与使用传统的高速缓
冲来言,一些速度损失是不可以避免的.另外一个在cache和shared_cache就是shared_cache可以工
作在CGI环境中,而cache仅仅在Apache/mod_perl等持久稳定的系统中有效.
默认的,模板使用IPC键 'TMPL' 作为共享的根段(0x4c504d54 in hex),
但是,这将可以通过在new()中对四种另外的方式和整数关键字设置'ipc_key'来修改.
另外的相应与IPC::SharedCache可选项可以影响共享的内存
-ipc_mode, ipc_segment_size 和ipc_max_size. 查看L<IPC::SharedCache>了解这些是怎么
工作的(在大多数情况下,我们不需要改变默认值).
查看L<IPC::SharedCache>获得更多关于共享内存的系统信息.
=item *
double_cache - 如果设置为1模块将使用
shared_cache和cache模式的联合体来获取更优的缓冲方式.当然,她仍然是消耗两种的模式中其中一种
的内存.同样的 ipc_* 选项,也可以以shared_cache方式工作应用.默认,double_cache是关闭的.
=item *
blind_cache - 如果设置为1,模块将以通常的cache方式工作,只是每次请求时不检查文件是不是已经
更新. 该选项的使用请无比小心, 但是切可以用与高负载的服务器上.
我的测试显示,在mod_perl下,使用blind_cache仅仅使提高了速度1-2%.
注意: 综合该选项与shared_cache,会导致陈旧的模板长贮内存!
=item *
file_cache - 如果设置为1,模块将使用Storable模块,将缓冲保存在文件中.
她将不再使用额外的内存, 我的简单测试显示她收到了50% 的执行效益.
类似与shared_cache, 她也可以适应CGI环境. 默认设置为0.
如果你设置改属性,你还必须设置"file_cache_dir"选项.查看获得更多细节问题.
注意: Storable模块使用flock()来保证缓冲文件的安全访问.
在一个不支持flock()的系统(Win95等)或者文件系统(NFS等)使用将会带来危害.
=item *
file_cache_dir - 如果使用file_cache,设置文件高速缓冲的高速缓冲文件目录.
你的脚本必须获得此目录的写权限. 你又必须确保有足够的可用空间来保存缓冲文件.
=item *
file_cache_dir_mode - 设置新建的缓冲文件的目录和子目录模式.
为了服务器的安全,默认为0700,但是在你使用你的服务器帐号登陆时,可能会给您带来不便.
=item *
double_file_cache - 如果设置为1,模块将综合使用file_cache和cache来获得多可能的缓冲.
与file_cache协同工作的file_cache_* 选项使用于double_file_cache.
默认情况下,double_file_cache设置为0.
=back
=item Filesystem Options
=over 4
=item *
path - 在new()中,你可以向该变量传递一个列表来设置'filename'和<TMPL_INCLUDE>标签指定的
文件和来设置搜索的目录. 在文件名为相对路径,该列表仅仅是用来参考的.如果HTML_TEMPLATE_ROOT
环境变量存在的话,她将会首先被尝试的.同样, 如果设置了HTML_TEMPLATE_ROOT,系统将会尝试把优先
把HTML_TEMPLATE_ROOT路径添加到path数组. 在<TMPL_INCLUDE>文件中, 当HTML_TEMPLATE_ROOT
路径被参考之前,被包含的文件的路径将会被优先考虑.
例:
my $template = Template->new( filename => 'file.tmpl',
path => [ '/path/to/templates',
'/alternate/path'
]
);
注意: 路径信息中的路径必须是unix的路径表达形式,使用斜杠('/')来分割的.
=item *
search_path_on_include - 如果设置为真值的话,对每个<TMPL_INCLUDE>标签,模块将中path
指定的路径数组的顶端开始搜索,并且使用找到第一个匹配的模板.
通常情况下,仅仅在当前的目录中查找模板. 默认设置为0.
=back
=item Debugging Options
=over 4
=item *
debug - 如果设置为1,模块将会把任意的调试信息写到STDERR.默认为0.
=item *
stack_debug - 如果设置为1,模块将使用 Data::Dumper 打印分析栈的内容到STDERR.默认设置为 0.
=item *
cache_debug - 如果设置为1,模块将发送关于缓冲加载,采样和错误信息到STDERR.默认设置0.
=item *
shared_cache_debug - 如果设置为1,模块将打开IPC::SharedCache中的调试选项(查看 L<IPC::SharedCache>获得更多信息). 默认设置0.
=item *
memory_debug - 如果设置为1,模块将发送关于缓冲内存的使用情况到STDERR,该功能依赖于GTop模块.默认设置0.
=back
=item Miscellaneous Options
=over 4
=item *
associate - 该选项允许你继承其他对象的参数.
仅仅的要求就是所继承的对象要有一个类似与Template的param()的param()方法.
一个比较优秀的就是CGI.pm的查询对象.
例:
my $query = new CGI;
my $template = Template->new(filename => 'template.tmpl',
associate => $query);
然后, $template->output()将会安照
$template->param('FormField', $cgi->param('FormField'))方式运行;
每个指定的 key/value 对将由$cgi->param()方法提供.
你所设置的参数将优先于关联的参数.你可以通过传递匿名的数组指定多重的对象来关联.
他们按照他们出现的顺序来查找参数:
my $template = Template->new(filename => 'template.tmpl',
associate => [$query, $other_obj]);
老版本的 associateCGI() 调用仍然支持, 但是现在考虑荒废她.
注意: 参数名是不区分大小写的.
如果你在CGI对象中有两个参数名,'NAME' 和 'Name',他们其中之一将会被随机的使用.
该行为可能被下面的选项控制.
=item *
case_sensitive - 设置该选项为真,将导致Template处理模板变量名时区分大小写.
如果不使用"case_sensitive",下面的例子将仅仅设置一个参数:
my $template = Template->new(filename => 'template.tmpl',
case_sensitive => 1);
$template->param(
FieldA => 'foo',
fIELDa => 'bar',
);
该选项默认是关闭的.
注意: 使用case_sensitive和loop_context_vars,那么特殊的循环变量将仅仅小写有效.
=item *
loop_context_vars - 当该参数设置为真时(默认为非) 四个循环的上下文变量将在循环中生效:
__first__, __last__, __inner__, __odd__. 他们可以与
<TMPL_IF>, <TMPL_UNLESS> 和 <TMPL_ELSE> 一起使用来控制循环的输出.
做为以上的补充, 当循环的上下文变量打开以后,一个 __counter__ 变量也将生效.
例:
<TMPL_LOOP NAME="FOO">
<TMPL_IF NAME="__first__">
This only outputs on the first pass.
</TMPL_IF>
<TMPL_IF NAME="__odd__">
This outputs every other pass, on the odd passes.
</TMPL_IF>
<TMPL_UNLESS NAME="__odd__">
This outputs every other pass, on the even passes.
</TMPL_IF>
<TMPL_IF NAME="__inner__">
This outputs on passes that are neither first nor last.
</TMPL_IF>
This is pass number <TMPL_VAR NAME="__counter__">.
<TMPL_IF NAME="__last__">
This only outputs on the last pass.
<TMPL_IF>
</TMPL_LOOP>
该功能的一个典型用法就是提供一个离析器,类似于perl的函数join().
例:
<TMPL_LOOP FRUIT>
<TMPL_IF __last__> and </TMPL_IF>
<TMPL_VAR KIND><TMPL_UNLESS __last__>, <TMPL_ELSE>.</TMPL_UNLESS>
</TMPL_LOOP>
将输出 (在浏览器中) :
Apples, Oranges, Brains, Toes, and Kiwi.
当然,必须提供一个适当的param()调用.
注意: 一个只有一个参数的循环,__first__ 和 __last__将全部设置为真, 但是却没有__inner__.
=item *
no_includes - 该选项设置为1,将在模板中禁止使用 <TMPL_INCLUDE> 标签.
这样可以可以给开放的模板减少危险. 默认设置为 0.
=item *
max_includes - 设置包含功能能够达到的最大的深度. 默认设置为 10.
包含超过深度的文件将会显示一个错误. 设置为 0,可以关闭该保护功能.
=item *
global_vars - 通常的,在循环外面定义的变量将在循环中无效.
该选项使 <TMPL_VAR> 类似与全局变量- 她们将变的没有现在.该选项也会影响<TMPL_IF>和<TMPL_UNLESS>.
例:
This is a normal variable: <TMPL_VAR NORMAL>.<P>
<TMPL_LOOP NAME=FROOT_LOOP>
Here it is inside the loop: <TMPL_VAR NORMAL><P>
</TMPL_LOOP>
通常她不能够按照期望来工作, 因为在循环以外的 <TMPL_VAR NORMAL>值在循环内是无效的.
global_vars 允许你访问装入循环的值.例如, 在本循环在中,内部循环将可以存取循环外部的值OUTER_VAR:
<TMPL_LOOP OUTER_LOOP>
OUTER: <TMPL_VAR OUTER_VAR>
<TMPL_LOOP INNER_LOOP>
INNER: <TMPL_VAR INNER_VAR>
INSIDE OUT: <TMPL_VAR OUTER_VAR>
</TMPL_LOOP>
</TMPL_LOOP>
=item *
filter - 该选项允许你指定一个你的模板文件的过滤方法.
一个过滤其实是一个在模板阅读以后,但是在解析模板标签之前的子程序.
在大多数的简单运用中, 你简单的给过滤参数分配一个代码引用.
该子程度将接受一个参数 - 一个指向模板中的字符串引用. 下面是一个接受类似于
"!!!ZAP_VARFOO!!!"的标签的例子,然后将他转换为模板的标签:
my $filter = sub {
my $text_ref = shift;
$$text_ref =~ s/!!!ZAP_(.*?)!!!/<TMPL_$1>/g;
};
# open zap.tmpl using the above filter
my $template = Template->new(filename => 'zap.tmpl',
filter => $filter);
更多可能的使用方法都是可能的. 您可以要求您的过滤接受一个模板文件
作为一个行数组而不是单独的一个标量.要做的就是,你指点你的一个使用散列的过滤.
在这样的形式,你使用"sub"关键字指定一个过滤和使用"format"关键字指定要求的参数形式.
有效的格式就是"scalar"和"array".
使用"array"格式将招致执行错误,但是在很多情况下可以带来方便.
my $template = Template->new(filename => 'zap.tmpl',
filter => { sub => $filter,
format => 'array' });
你可能使用多重的过滤. 为可过多的具体的功能,她可以允许简单的过滤的组合.
仅仅要做的就是指定一个过滤数组. 过滤将按照他们被指定的顺序来过滤.
my $template = Template->new(filename => 'zap.tmpl',
filter => [
{ sub => \&decompress,
format => 'scalar' },
{ sub => \&remove_spaces,
format => 'array' }
]);
类似于主模板中,指定的过滤将会在任何TMPL_INCLUDE包含的文件中起作用.
=back
=back 4
=cut

use integer; # no floating point math so far!
use strict; # and no funny business, either.
use Carp; # generate better errors with more context
use File::Spec; # generate paths that work on all platforms

# define accessor constants used to improve readability of array
# accesses into "objects". I used to use 'use constant' but that
# seems to cause occasional irritating warnings in older Perls.
package Template::LOOP;
sub TEMPLATE_HASH () { 0; }
sub PARAM_SET () { 1 };

package Template::COND;
sub VARIABLE () { 0 };
sub VARIABLE_TYPE () { 1 };
sub VARIABLE_TYPE_VAR () { 0 };
sub VARIABLE_TYPE_LOOP () { 1 };
sub JUMP_IF_TRUE () { 2 };
sub JUMP_ADDRESS () { 3 };
sub WHICH () { 4 };
sub WHICH_IF () { 0 };
sub WHICH_UNLESS () { 1 };

# back to the main package scope.
package Template;

# open a new template and return an object handle
sub new {
my $pkg = shift;
my $self; { my %hash; $self = bless(\%hash, $pkg); }

# the options hash
my $options = {};
$self->{options} = $options;

# set default parameters in options hash
%$options = (
debug => 0,
stack_debug => 0,
timing => 0,
search_path_on_include => 0,
cache => 0,
blind_cache => 0,
file_cache => 0,
file_cache_dir => '',
file_cache_dir_mode => 0700,
cache_debug => 0,
shared_cache_debug => 0,
memory_debug => 0,
die_on_bad_params => 1,
vanguard_compatibility_mode => 0,
associate => [],
path => [],
strict => 1,
loop_context_vars => 0,
max_includes => 10,
shared_cache => 0,
double_cache => 0,
double_file_cache => 0,
ipc_key => 'TMPL',
ipc_mode => 0666,
ipc_segment_size => 65536,
ipc_max_size => 0,
global_vars => 0,
no_includes => 0,
case_sensitive => 0,
filter => [],
);

# load in options supplied to new()
for (my $x = 0; $x <= $#_; $x += 2) {
defined($_[($x + 1)]) or croak("Template->new() called with odd number of option parameters - should be of the form option => value");
$options->{lc($_[$x])} = $_[($x + 1)];
}

# blind_cache = 1 implies cache = 1
$options->{blind_cache} and $options->{cache} = 1;

# shared_cache = 1 implies cache = 1
$options->{shared_cache} and $options->{cache} = 1;

# file_cache = 1 implies cache = 1
$options->{file_cache} and $options->{cache} = 1;

# double_cache is a combination of shared_cache and cache.
$options->{double_cache} and $options->{cache} = 1;
$options->{double_cache} and $options->{shared_cache} = 1;

# double_file_cache is a combination of file_cache and cache.
$options->{double_file_cache} and $options->{cache} = 1;
$options->{double_file_cache} and $options->{file_cache} = 1;

# vanguard_compatibility_mode implies die_on_bad_params = 0
$options->{vanguard_compatibility_mode} and
$options->{die_on_bad_params} = 0;

# handle the "type", "source" parameter format (does anyone use it?)
if (exists($options->{type})) {
exists($options->{source}) or croak("Template->new() called with 'type' parameter set, but no 'source'!");
($options->{type} eq 'filename' or $options->{type} eq 'scalarref' or
$options->{type} eq 'arrayref' or $options->{type} eq 'filehandle') or
croak("Template->new() : type parameter must be set to 'filename', 'arrayref', 'scalarref' or 'filehandle'!");

$options->{$options->{type}} = $options->{source};
delete $options->{type};
delete $options->{source};
}

# associate should be an array of one element if it's not
# already an array.
if (ref($options->{associate}) ne 'ARRAY') {
$options->{associate} = [ $options->{associate} ];
}

# path should be an array if it's not already
if (ref($options->{path}) ne 'ARRAY') {
$options->{path} = [ $options->{path} ];
}

# filter should be an array if it's not already
if (ref($options->{filter}) ne 'ARRAY') {
$options->{filter} = [ $options->{filter} ];
}

# make sure objects in associate area support param()
foreach my $object (@{$options->{associate}}) {
defined($object->can('param')) or
croak("Template->new called with associate option, containing object of type " . ref($object) . " which lacks a param() method!");
}

# check for syntax errors:
my $source_count = 0;
exists($options->{filename}) and $source_count++;
exists($options->{filehandle}) and $source_count++;
exists($options->{arrayref}) and $source_count++;
exists($options->{scalarref}) and $source_count++;
if ($source_count != 1) {
croak("Template->new called with multiple (or no) template sources specified! A valid call to new() has exactly one filename => 'file' OR exactly one scalarref => \\\$scalar OR exactly one arrayref => \\\@array OR exactly one filehandle => \*FH");
}

# do some memory debugging - this is best started as early as possible
if ($options->{memory_debug}) {
# memory_debug needs GTop
eval { require GTop; };
croak("Could not load GTop. You must have GTop installed to use Template in memory_debug mode. The error was: $@")
if ($@);
$self->{gtop} = GTop->new();
$self->{proc_mem} = $self->{gtop}->proc_mem($$);
print STDERR "\n### Template Memory Debug ### START ", $self->{proc_mem}->size(), "\n";
}

if ($options->{file_cache}) {
# make sure we have a file_cache_dir option
croak("You must specify the file_cache_dir option if you want to use file_cache.")
unless defined $options->{file_cache_dir} and
length $options->{file_cache_dir};

# file_cache needs some extra modules loaded
eval { require Storable; };
croak("Could not load Storable. You must have Storable installed to use Template in file_cache mode. The error was: $@")
if ($@);
eval { require Digest::MD5; };
croak("Could not load Digest::MD5. You must have Digest::MD5 installed to use Template in file_cache mode. The error was: $@")
if ($@);
}

if ($options->{shared_cache}) {
# shared_cache needs some extra modules loaded
eval { require IPC::SharedCache; };
croak("Could not load IPC::SharedCache. You must have IPC::SharedCache installed to use Template in shared_cache mode. The error was: $@")
if ($@);

# initialize the shared cache
my %cache;
tie %cache, 'IPC::SharedCache',
ipc_key => $options->{ipc_key},
load_callback => [\&_load_shared_cache, $self],
validate_callback => [\&_validate_shared_cache, $self],
debug => $options->{shared_cache_debug},
ipc_mode => $options->{ipc_mode},
max_size => $options->{ipc_max_size},
ipc_segment_size => $options->{ipc_segment_size};
$self->{cache} = \%cache;
}

print STDERR "### Template Memory Debug ### POST CACHE INIT ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

# initialize data structures
$self->_init;

print STDERR "### Template Memory Debug ### POST _INIT CALL ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

# drop the shared cache - leaving out this step results in the
# template object evading garbage collection since the callbacks in
# the shared cache tie hold references to $self! This was not easy
# to find, by the way.
delete $self->{cache} if $options->{shared_cache};

return $self;
}

# an internally used new that receives its parse_stack and param_map as input
sub _new_from_loop {
my $pkg = shift;
my $self; { my %hash; $self = bless(\%hash, $pkg); }

# the options hash
my $options = {};
$self->{options} = $options;

# set default parameters in options hash - a subset of the options
# valid in a normal new(). Since _new_from_loop never calls _init,
# many options have no relevance.
%$options = (
debug => 0,
stack_debug => 0,
die_on_bad_params => 1,
associate => [],
loop_context_vars => 0,
);

# load in options supplied to new()
for (my $x = 0; $x <= $#_; $x += 2) {
defined($_[($x + 1)]) or croak("Template->new() called with odd number of option parameters - should be of the form option => value");
$options->{lc($_[$x])} = $_[($x + 1)];
}

$self->{param_map} = $options->{param_map};
$self->{parse_stack} = $options->{parse_stack};
delete($options->{param_map});
delete($options->{parse_stack});

return $self;
}

# a few shortcuts to new(), of possible use...
sub new_file {
my $pkg = shift; return $pkg->new('filename', @_);
}
sub new_filehandle {
my $pkg = shift; return $pkg->new('filehandle', @_);
}
sub new_array_ref {
my $pkg = shift; return $pkg->new('arrayref', @_);
}
sub new_scalar_ref {
my $pkg = shift; return $pkg->new('scalarref', @_);
}

# initializes all the object data structures, either from cache or by
# calling the appropriate routines.
sub _init {
my $self = shift;
my $options = $self->{options};

if ($options->{double_cache}) {
# try the normal cache, return if we have it.
$self->_fetch_from_cache();
return if (defined $self->{param_map} and defined $self->{parse_stack});

# try the shared cache
$self->_fetch_from_shared_cache();

# put it in the local cache if we got it.
$self->_commit_to_cache()
if (defined $self->{param_map} and defined $self->{parse_stack});
} elsif ($options->{double_file_cache}) {
# try the normal cache, return if we have it.
$self->_fetch_from_cache();
return if (defined $self->{param_map} and defined $self->{parse_stack});

# try the file cache
$self->_fetch_from_file_cache();

# put it in the local cache if we got it.
$self->_commit_to_cache()
if (defined $self->{param_map} and defined $self->{parse_stack});
} elsif ($options->{shared_cache}) {
# try the shared cache
$self->_fetch_from_shared_cache();
} elsif ($options->{file_cache}) {
# try the file cache
$self->_fetch_from_file_cache();
} elsif ($options->{cache}) {
# try the normal cache
$self->_fetch_from_cache();
}

# if we got a cache hit, return
return if (defined $self->{param_map} and defined $self->{parse_stack});

# if we're here, then we didn't get a cached copy, so do a full
# init.
$self->_init_template();
$self->_parse();

# now that we have a full init, cache the structures if cacheing is
# on. shared cache is already cool.
if($options->{file_cache}){
$self->_commit_to_file_cache();
}
$self->_commit_to_cache() if (($options->{cache}
and not $options->{shared_cache}
and not $options->{file_cache}) or
($options->{double_cache}) or
($options->{double_file_cache}));
}

# Caching subroutines - they handle getting and validating cache
# records from either the in-memory or shared caches.

# handles the normal in memory cache
use vars qw( %CACHE );
sub _fetch_from_cache {
my $self = shift;
my $options = $self->{options};

# return if there's no cache entry for this filename
return unless exists($options->{filename});
my $filepath = $self->_find_file($options->{filename});
return unless (defined($filepath) and
exists $CACHE{$filepath});

$options->{filepath} = $filepath;

# validate the cache
my $mtime = $self->_mtime($filepath);
if (defined $mtime) {
# return if the mtime doesn't match the cache
if (defined($CACHE{$filepath}{mtime}) and
($mtime != $CACHE{$filepath}{mtime})) {
$options->{cache_debug} and
print STDERR "CACHE MISS : $filepath : $mtime\n";
return;
}

# if the template has includes, check each included file's mtime
# and return if different
if (exists($CACHE{$filepath}{included_mtimes})) {
foreach my $filename (keys %{$CACHE{$filepath}{included_mtimes}}) {
next unless
defined($CACHE{$filepath}{included_mtimes}{$filename});

my $included_mtime = (stat($filename))Η];
if ($included_mtime != $CACHE{$filepath}{included_mtimes}{$filename}) {
$options->{cache_debug} and
print STDERR "### Template Cache Debug ### CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";

return;
}
}
}
}

# got a cache hit!

$options->{cache_debug} and print STDERR "### Template Cache Debug ### CACHE HIT : $filepath\n";

$self->{param_map} = $CACHE{$filepath}{param_map};
$self->{parse_stack} = $CACHE{$filepath}{parse_stack};
exists($CACHE{$filepath}{included_mtimes}) and
$self->{included_mtimes} = $CACHE{$filepath}{included_mtimes};

# clear out values from param_map from last run
$self->_normalize_options();
$self->clear_params();
}

sub _commit_to_cache {
my $self = shift;
my $options = $self->{options};

my $filepath = $options->{filepath};
if (not defined $filepath) {
$filepath = $self->_find_file($options->{filename});
confess("Template->new() : Cannot open included file $options->{filename} : file not found.")
unless defined($filepath);
$options->{filepath} = $filepath;
}

$options->{cache_debug} and print STDERR "### Template Cache Debug ### CACHE LOAD : $filepath\n";

$options->{blind_cache} or
$CACHE{$filepath}{mtime} = $self->_mtime($filepath);
$CACHE{$filepath}{param_map} = $self->{param_map};
$CACHE{$filepath}{parse_stack} = $self->{parse_stack};
exists($self->{included_mtimes}) and
$CACHE{$filepath}{included_mtimes} = $self->{included_mtimes};
}

# generates MD5 from filepath to determine filename for cache file
sub _get_cache_filename {
my ($self, $filepath) = @_;

# hash the filename ...
my $hash = Digest::MD5::md5_hex($filepath);

# ... and build a path out of it. Using the first two charcters
# gives us 255 buckets. This means you can have 255,000 templates
# in the cache before any one directory gets over a few thousand
# files in it. That's probably pretty good for this planet. If not
# then it should be configurable.
if (wantarray) {
return (substr($hash,0,2), substr($hash,2))
} else {
return File::Spec->join($self->{options}{file_cache_dir},
substr($hash,0,2), substr($hash,2));
}
}

# handles the file cache
sub _fetch_from_file_cache {
my $self = shift;
my $options = $self->{options};
return unless exists($options->{filename});

# return if there's no cache entry for this filename
my $filepath = $self->_find_file($options->{filename});
return unless defined $filepath;
my $cache_filename = $self->_get_cache_filename($filepath);
return unless -e $cache_filename;

eval {
$self->{record} = Storable::lock_retrieve($cache_filename);
};
croak("Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $@")
if $@;
croak("Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $!")
unless defined $self->{record};

($self->{mtime},
$self->{included_mtimes},
$self->{param_map},
$self->{parse_stack}) = @{$self->{record}};

$options->{filepath} = $filepath;

# validate the cache
my $mtime = $self->_mtime($filepath);
if (defined $mtime) {
# return if the mtime doesn't match the cache
if (defined($self->{mtime}) and
($mtime != $self->{mtime})) {
$options->{cache_debug} and
print STDERR "### Template Cache Debug ### FILE CACHE MISS : $filepath : $mtime\n";
($self->{mtime},
$self->{included_mtimes},
$self->{param_map},
$self->{parse_stack}) = (undef, undef, undef, undef);
return;
}

# if the template has includes, check each included file's mtime
# and return if different
if (exists($self->{included_mtimes})) {
foreach my $filename (keys %{$self->{included_mtimes}}) {
next unless
defined($self->{included_mtimes}{$filename});

my $included_mtime = (stat($filename))Η];
if ($included_mtime != $self->{included_mtimes}{$filename}) {
$options->{cache_debug} and
print STDERR "### Template Cache Debug ### FILE CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
($self->{mtime},
$self->{included_mtimes},
$self->{param_map},
$self->{parse_stack}) = (undef, undef, undef, undef);
return;
}
}
}
}

# got a cache hit!
$options->{cache_debug} and print STDERR "### Template Cache Debug ### FILE CACHE HIT : $filepath\n";

# clear out values from param_map from last run
$self->_normalize_options();
$self->clear_params();
}

sub _commit_to_file_cache {
my $self = shift;
my $options = $self->{options};

my $filepath = $options->{filepath};
if (not defined $filepath) {
$filepath = $self->_find_file($options->{filename});
confess("Template->new() : Cannot open included file $options->{filename} : file not found.")
unless defined($filepath);
$options->{filepath} = $filepath;
}

my ($cache_dir, $cache_file) = $self->_get_cache_filename($filepath);
$cache_dir = File::Spec->join($options->{file_cache_dir}, $cache_dir);
if (not -d $cache_dir) {
if (not -d $options->{file_cache_dir}) {
mkdir($options->{file_cache_dir},$options->{file_cache_dir_mode})
or croak("Template->new() : can't mkdir $options->{file_cache_dir} (file_cache => 1): $!");
}
mkdir($cache_dir,$options->{file_cache_dir_mode})
or croak("Template->new() : can't mkdir $cache_dir (file_cache => 1): $!");
}

$options->{cache_debug} and print STDERR "### Template Cache Debug ### FILE CACHE LOAD : $options->{filepath}\n";

my $result;
eval {
$result = Storable::lock_store([ $self->{mtime},
$self->{included_mtimes},
$self->{param_map},
$self->{parse_stack} ],
scalar File::Spec->join($cache_dir, $cache_file)
);
};
croak("Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $@")
if $@;
croak("Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $!")
unless defined $result;
}

# Shared cache routines.
sub _fetch_from_shared_cache {
my $self = shift;
my $options = $self->{options};

my $filepath = $self->_find_file($options->{filename});
return unless defined $filepath;

# fetch from the shared cache.
$self->{record} = $self->{cache}{$filepath};

($self->{mtime},
$self->{included_mtimes},
$self->{param_map},
$self->{parse_stack}) = @{$self->{record}}
if defined($self->{record});

$options->{cache_debug} and defined($self->{record}) and print STDERR "### Template Cache Debug ### CACHE HIT : $filepath\n";
# clear out values from param_map from last run
$self->_normalize_options(), $self->clear_params()
if (defined($self->{record}));
delete($self->{record});

return $self;
}

sub _validate_shared_cache {
my ($self, $filename, $record) = @_;
my $options = $self->{options};

$options->{shared_cache_debug} and print STDERR "### Template Cache Debug ### SHARED CACHE VALIDATE : $filename\n";

return 1 if $options->{blind_cache};

my ($c_mtime, $included_mtimes, $param_map, $parse_stack) = @$record;

# if the modification time has changed return false
my $mtime = $self->_mtime($filename);
if (defined $mtime and defined $c_mtime
and $mtime != $c_mtime) {
$options->{cache_debug} and
print STDERR "### Template Cache Debug ### SHARED CACHE MISS : $filename : $mtime\n";
return 0;
}

# if the template has includes, check each included file's mtime
# and return false if different
if (defined $mtime and defined $included_mtimes) {
foreach my $fname (keys %$included_mtimes) {
next unless defined($included_mtimes->{$fname});
if ($included_mtimes->{$fname} != (stat($fname))Η]) {
$options->{cache_debug} and
print STDERR "### Template Cache Debug ### SHARED CACHE MISS : $filename : INCLUDE $fname\n";
return 0;
}
}
}

# all done - return true
return 1;
}

sub _load_shared_cache {
my ($self, $filename) = @_;
my $options = $self->{options};
my $cache = $self->{cache};

$self->_init_template();
$self->_parse();

$options->{cache_debug} and print STDERR "### Template Cache Debug ### SHARED CACHE LOAD : $options->{filepath}\n";

print STDERR "### Template Memory Debug ### END CACHE LOAD ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

return [ $self->{mtime},
$self->{included_mtimes},
$self->{param_map},
$self->{parse_stack} ];
}

# utility function - given a filename performs documented search and
# returns a full path of undef if the file cannot be found.
sub _find_file {
my ($self, $filename, $extra_path) = @_;
my $options = $self->{options};
my $filepath;

# first check for a full path
return File::Spec->canonpath($filename)
if (File::Spec->file_name_is_absolute($filename) and (-e $filename));

# try the extra_path if one was specified
if (defined($extra_path)) {
$extra_path->[$#{$extra_path}] = $filename;
$filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path));
return File::Spec->canonpath($filepath) if -e $filepath;
}

# try pre-prending HTML_Template_Root
if (exists($ENV{HTML_TEMPLATE_ROOT})) {
$filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename);
return File::Spec->canonpath($filepath) if -e $filepath;
}

# try "path" option list..
foreach my $path (@{$options->{path}}) {
$filepath = File::Spec->catfile($path, $filename);
return File::Spec->canonpath($filepath) if -e $filepath;
}

# try even a relative path from the current directory...
return File::Spec->canonpath($filename) if -e $filename;

# try "path" option list with HTML_TEMPLATE_ROOT prepended...
if (exists($ENV{HTML_TEMPLATE_ROOT})) {
foreach my $path (@{$options->{path}}) {
$filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename);
return File::Spec->canonpath($filepath) if -e $filepath;
}
}

return undef;
}

# utility function - computes the mtime for $filename
sub _mtime {
my ($self, $filepath) = @_;
my $options = $self->{options};

return(undef) if ($options->{blind_cache});

# make sure it still exists in the filesystem
(-r $filepath) or Carp::confess("Template : template file $filepath does not exist or is unreadable.");

# get the modification time
return (stat(_))Η];
}

# utility function - enforces new() options across LOOPs that have
# come from a cache. Otherwise they would have stale options hashes.
sub _normalize_options {
my $self = shift;
my $options = $self->{options};

my @pstacks = ($self->{parse_stack});
while(@pstacks) {
my $pstack = pop(@pstacks);
foreach my $item (@$pstack) {
next unless (ref($item) eq 'Template::LOOP');
foreach my $template (values %{$item->[Template::LOOP::TEMPLATE_HASH]}) {
# must be the same list as the call to _new_from_loop...
$template->{options}{debug} = $options->{debug};
$template->{options}{stack_debug} = $options->{stack_debug};
$template->{options}{die_on_bad_params} = $options->{die_on_bad_params};
$template->{options}{case_sensitive} = $options->{case_sensitive};

push(@pstacks, $template->{parse_stack});
}
}
}
}

# initialize the template buffer
sub _init_template {
my $self = shift;
my $options = $self->{options};

print STDERR "### Template Memory Debug ### START INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

if (exists($options->{filename})) {
my $filepath = $options->{filepath};
if (not defined $filepath) {
$filepath = $self->_find_file($options->{filename});
confess("Template->new() : Cannot open included file $options->{filename} : file not found.")
unless defined($filepath);
# we'll need this for future reference - to call stat() for example.
$options->{filepath} = $filepath;
}

confess("Template->new() : Cannot open included file $options->{filename} : $!")
unless defined(open(TEMPLATE, $filepath));
$self->{mtime} = $self->_mtime($filepath);

# read into scalar, note the mtime for the record
$self->{template} = "";
while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) {}
close(TEMPLATE);

} elsif (exists($options->{scalarref})) {
# copy in the template text
$self->{template} = ${$options->{scalarref}};

delete($options->{scalarref});
} elsif (exists($options->{arrayref})) {
# if we have an array ref, join and store the template text
$self->{template} = join("", @{$options->{arrayref}});

delete($options->{arrayref});
} elsif (exists($options->{filehandle})) {
# just read everything in in one go
local $/ = undef;
$self->{template} = readline($options->{filehandle});

delete($options->{filehandle});
} else {
confess("Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified.");
}

print STDERR "### Template Memory Debug ### END INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

# handle filters if necessary
$self->_call_filters(\$self->{template}) if @{$options->{filter}};

return $self;
}

# handle calling user defined filters
sub _call_filters {
my $self = shift;
my $template_ref = shift;
my $options = $self->{options};

my ($format, $sub);
foreach my $filter (@{$options->{filter}}) {
croak("Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.")
unless ref $filter;

# translate into CODE->HASH
$filter = { 'format' => 'scalar', 'sub' => $filter }
if (ref $filter eq 'CODE');

if (ref $filter eq 'HASH') {
$format = $filter->{'format'};
$sub = $filter->{'sub'};

# check types and values
croak("Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.")
unless defined $format and defined $sub;
croak("Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'")
unless $format eq 'array' or $format eq 'scalar';
croak("Template->new() : bad value set for filter parameter - \"sub\" must be a code ref")
unless ref $sub and ref $sub eq 'CODE';

# catch errors
eval {
if ($format eq 'scalar') {
# call
$sub->($template_ref);
} else {
# modulate
my @array = map { $_."\n" } split("\n", $$template_ref);
# call
$sub->(\@array);
# demodulate
$$template_ref = join("", @array);
}
};
croak("Template->new() : fatal error occured during filter call: $@") if $@;
} else {
croak("Template->new() : bad value set for filter parameter - must be code ref or hash ref");
}
}
# all done
return $template_ref;
}

# _parse sifts through a template building up the param_map and
# parse_stack structures.
#
# The end result is a Template object that is fully ready for
# output().
sub _parse {
my $self = shift;
my $options = $self->{options};

$options->{debug} and print STDERR "### Template Debug ### In _parse:\n";

# setup the stacks and maps - they're accessed by typeglobs that
# reference the top of the stack. They are masked so that a loop
# can transparently have its own versions.
use vars qw(@pstack %pmap @ifstack @ucstack %top_pmap);
local (*pstack, *ifstack, *pmap, *ucstack, *top_pmap);

# the pstack is the array of scalar refs (plain text from the
# template file), VARs, LOOPs, IFs and ELSEs that output() works on
# to produce output. Looking at output() should make it clear what
# _parse is trying to accomplish.
my @pstacks = ([]);
*pstack = $pstacksΎ];
$self->{parse_stack} = $pstacksΎ];

# the pmap binds names to VARs, LOOPs and IFs. It allows param() to
# access the right variable. NOTE: output() does not look at the
# pmap at all!
my @pmaps = ({});
*pmap = $pmapsΎ];
*top_pmap = $pmapsΎ];
$self->{param_map} = $pmapsΎ];

# the ifstack is a temporary stack containing pending ifs and elses
# waiting for a /if.
my @ifstacks = ([]);
*ifstack = $ifstacksΎ];

# the ucstack is a temporary stack containing conditions that need
# to be bound to param_map entries when their block is finished.
# This happens when a conditional is encountered before any other
# reference to its NAME. Since a conditional can reference VARs and
# LOOPs it isn't possible to make the link right away.
my @ucstacks = ([]);
*ucstack = $ucstacksΎ];

# the loopstack is another temp stack for closing loops. unlike
# those above it doesn't get scoped inside loops, therefore it
# doesn't need the typeglob magic.
my @loopstack = ();

# the fstack is a stack of filenames and counters that keeps track
# of which file we're in and where we are in it. This allows
# accurate error messages even inside included files!
# fcounter, fmax and fname are aliases for the current file's info
use vars qw($fcounter $fname $fmax);
local (*fcounter, *fname, *fmax);

my @fstack = ([$options->{filepath} || "/fake/path/for/non/file/template",
1,
scalar @{[$self->{template} =~ m/(\n)/g]} + 1
]);
(*fname, *fcounter, *fmax) = \ ( @{$fstackΎ]} );

my $NOOP = Template::NOOP->new();
my $ESCAPE = Template::ESCAPE->new();
my $URLESCAPE = Template::URLESCAPE->new();

# all the tags that need NAMEs:
my %need_names = map { $_ => 1 }
qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS TMPL_INCLUDE);

# variables used below that don't need to be my'd in the loop
my ($name, $which, $escape, $default);

# handle the old vanguard format
$options->{vanguard_compatibility_mode} and
$self->{template} =~ s/%([-\w\/\.+]+)%/<TMPL_VAR NAME=$1>/g;

# now split up template on '<', leaving them in
my @chunks = split(m/(?=<)/, $self->{template});

# all done with template
delete $self->{template};

# loop through chunks, filling up pstack
my $last_chunk = $#chunks;
CHUNK: for (my $chunk_number = 0;
$chunk_number <= $last_chunk;
$chunk_number++) {
next unless defined $chunks[$chunk_number];
my $chunk = $chunks[$chunk_number];

# a general regex to match any and all TMPL_* tags
if ($chunk =~ /^<
(?:!--\s*)?
(
\/?[Tt][Mm][Pp][Ll]_
(?:
(?:[Vv][Aa][Rr])
|
(?:[Ll][Oo][Oo][Pp])
|
(?:[Ii][Ff])
|
(?:[Ee][Ll][Ss][Ee])
|
(?:[Uu][Nn][Ll][Ee][Ss][Ss])
|
(?:[Ii][Nn][Cc][Ll][Uu][Dd][Ee])
)
) # $1 => $which - start of the tag

\s*

# DEFAULT attribute
(?:
[Dd][Ee][Ff][Aa][Uu][Ll][Tt]
\s*=\s*
(?:
"([^">]*)" # $2 => double-quoted DEFAULT value "
|
'([^'>]*)' # $3 => single-quoted DEFAULT value
|
([^\s=>]*) # $4 => unquoted DEFAULT value
)
)?

\s*

# ESCAPE attribute
(?:
[Ee][Ss][Cc][Aa][Pp][Ee]
\s*=\s*
(?:
(?: 0 | (?:"0") | (?:'0') )
|
( 1 | (?:"1") | (?:'1') |
(?:[Hh][Tt][Mm][Ll]) |
(?:"[Hh][Tt][Mm][Ll]") |
(?:'[Hh][Tt][Mm][Ll]') |
(?:[Uu][Rr][Ll]) |
(?:"[Uu][Rr][Ll]") |
(?:'[Uu][Rr][Ll]') |
) # $5 => ESCAPE on
)
)* # allow multiple ESCAPEs

\s*

# DEFAULT attribute
(?:
[Dd][Ee][Ff][Aa][Uu][Ll][Tt]
\s*=\s*
(?:
"([^">]*)" # $6 => double-quoted DEFAULT value "
|
'([^'>]*)' # $7 => single-quoted DEFAULT value
|
([^\s=>]*) # $8 => unquoted DEFAULT value
)
)?

\s*

# NAME attribute
(?:
(?:
[Nn][Aa][Mm][Ee]
\s*=\s*
)?
(?:
"([^">]*)" # $9 => double-quoted NAME value "
|
'([^'>]*)' # $10 => single-quoted NAME value
|
([^\s=>]*) # $11 => unquoted NAME value
)
)?

\s*

# DEFAULT attribute
(?:
[Dd][Ee][Ff][Aa][Uu][Ll][Tt]
\s*=\s*
(?:
"([^">]*)" # $12 => double-quoted DEFAULT value "
|
'([^'>]*)' # $13 => single-quoted DEFAULT value
|
([^\s=>]*) # $14 => unquoted DEFAULT value
)
)?

\s*

# ESCAPE attribute
(?:
[Ee][Ss][Cc][Aa][Pp][Ee]
\s*=\s*
(?:
(?: 0 | (?:"0") | (?:'0') )
|
( 1 | (?:"1") | (?:'1') |
(?:[Hh][Tt][Mm][Ll]) |
(?:"[Hh][Tt][Mm][Ll]") |
(?:'[Hh][Tt][Mm][Ll]') |
(?:[Uu][Rr][Ll]) |
(?:"[Uu][Rr][Ll]") |
(?:'[Uu][Rr][Ll]') |
) # $15 => ESCAPE on
)
)* # allow multiple ESCAPEs

\s*

# DEFAULT attribute
(?:
[Dd][Ee][Ff][Aa][Uu][Ll][Tt]
\s*=\s*
(?:
"([^">]*)" # $16 => double-quoted DEFAULT value "
|
'([^'>]*)' # $17 => single-quoted DEFAULT value
|
([^\s=>]*) # $18 => unquoted DEFAULT value
)
)?

\s*

(?:--)?>
(.*) # $19 => $post - text that comes after the tag
$/sx) {

$which = uc($1); # which tag is it

$escape = defined $5 ? $5 : defined $15 ? $15 : 0; # escape set?

# what name for the tag? undef for a /tag at most, one of the
# following three will be defined
$name = defined $9 ? $9 : defined $10 ? $10 : defined $11 ? $11 : undef;

# is there a default?
$default = defined $2 ? $2 : defined $3 ? $3 : defined $4 ? $4 :
defined $6 ? $6 : defined $7 ? $7 : defined $8 ? $8 :
defined $12 ? $12 : defined $13 ? $13 : defined $14 ? $14 :
defined $16 ? $16 : defined $17 ? $17 : defined $18 ? $18 :
undef;

my $post = $19; # what comes after on the line

# allow mixed case in filenames, otherwise flatten
$name = lc($name) unless (not defined $name or $which eq 'TMPL_INCLUDE' or $options->{case_sensitive});

# die if we need a name and didn't get one
die "Template->new() : No NAME given to a $which tag at $fname : line $fcounter."
if ($need_names{$which} and (not defined $name or not length $name));

# die if we got an escape but can't use one
die "Template->new() : ESCAPE option invalid in a $which tag at $fname : line $fcounter." if ( $escape and ($which ne 'TMPL_VAR'));

# die if we got a default but can't use one
die "Template->new() : DEFAULT option invalid in a $which tag at $fname : line $fcounter." if ( defined $default and ($which ne 'TMPL_VAR'));

# take actions depending on which tag found
if ($which eq 'TMPL_VAR') {
$options->{debug} and print STDERR "### Template Debug ### $fname : line $fcounter : parsed VAR $name\n";

# if we already have this var, then simply link to the existing
# Template::VAR, else create a new one.
my $var;
if (exists $pmap{$name}) {
$var = $pmap{$name};
(ref($var) eq 'Template::VAR') or
die "Template->new() : Already used param name $name as a TMPL_LOOP, found in a TMPL_VAR at $fname : line $fcounter.";
} else {
$var = Template::VAR->new();
$pmap{$name} = $var;
$top_pmap{$name} = Template::VAR->new()
if $options->{global_vars} and not exists $top_pmap{$name};
}

# if a DEFAULT was provided, push a DEFAULT object on the
# stack before the variable.
if (defined $default) {
push(@pstack, Template::DEFAULT->new($default));
}

# if ESCAPE was set, push an ESCAPE op on the stack before
# the variable. output will handle the actual work.
if ($escape) {
if ($escape =~ /^"?[Uu][Rr][Ll]"?$/) {
push(@pstack, $URLESCAPE);
} else {
push(@pstack, $ESCAPE);
}
}

push(@pstack, $var);

} elsif ($which eq 'TMPL_LOOP') {
# we've got a loop start
$options->{debug} and print STDERR "### Template Debug ### $fname : line $fcounter : LOOP $name start\n";

# if we already have this loop, then simply link to the existing
# Template::LOOP, else create a new one.
my $loop;
if (exists $pmap{$name}) {
$loop = $pmap{$name};
(ref($loop) eq 'Template::LOOP') or
die "Template->new() : Already used param name $name as a TMPL_VAR, TMPL_IF or TMPL_UNLESS, found in a TMP_LOOP at $fname : line $fcounter!";

} else {
# store the results in a LOOP object - actually just a
# thin wrapper around another Template object.
$loop = Template::LOOP->new();
$pmap{$name} = $loop;
}

# get it on the loopstack, pstack of the enclosing block
push(@pstack, $loop);
push(@loopstack, [$loop, $#pstack]);

# magic time - push on a fresh pmap and pstack, adjust the typeglobs.
# this gives the loop a separate namespace (i.e. pmap and pstack).
push(@pstacks, []);
*pstack = $pstacks[$#pstacks];
push(@pmaps, {});
*pmap = $pmaps[$#pmaps];
push(@ifstacks, []);
*ifstack = $ifstacks[$#ifstacks];
push(@ucstacks, []);
*ucstack = $ucstacks[$#ucstacks];

# auto-vivify __FIRST__, __LAST__ and __INNER__ if
# loop_context_vars is set. Otherwise, with
# die_on_bad_params set output() will might cause errors
# when it tries to set them.
if ($options->{loop_context_vars}) {
$pmap{__first__} = Template::VAR->new();
$pmap{__inner__} = Template::VAR->new();
$pmap{__last__} = Template::VAR->new();
$pmap{__odd__} = Template::VAR->new();
$pmap{__counter__} = Template::VAR->new();
}

} elsif ($which eq '/TMPL_LOOP') {
$options->{debug} and print STDERR "### Template Debug ### $fname : line $fcounter : LOOP end\n";

my $loopdata = pop(@loopstack);
die "Template->new() : found </TMPL_LOOP> with no matching <TMPL_LOOP> at $fname : line $fcounter!" unless defined $loopdata;

my ($loop, $starts_at) = @$loopdata;

# resolve pending conditionals
foreach my $uc (@ucstack) {
my $var = $uc->[Template::COND::VARIABLE];
if (exists($pmap{$var})) {
$uc->[Template::COND::VARIABLE] = $pmap{$var};
} else {
$pmap{$var} = Template::VAR->new();
$top_pmap{$var} = Template::VAR->new()
if $options->{global_vars} and not exists $top_pmap{$var};
$uc->[Template::COND::VARIABLE] = $pmap{$var};
}
if (ref($pmap{$var}) eq 'Template::VAR') {
$uc->[Template::COND::VARIABLE_TYPE] = Template::COND::VARIABLE_TYPE_VAR;
} else {
$uc->[Template::COND::VARIABLE_TYPE] = Template::COND::VARIABLE_TYPE_LOOP;
}
}

# get pmap and pstack for the loop, adjust the typeglobs to
# the enclosing block.
my $param_map = pop(@pmaps);
*pmap = $pmaps[$#pmaps];
my $parse_stack = pop(@pstacks);
*pstack = $pstacks[$#pstacks];

scalar(@ifstack) and die "Template->new() : Dangling <TMPL_IF> or <TMPL_UNLESS> in loop ending at $fname : line $fcounter.";
pop(@ifstacks);
*ifstack = $ifstacks[$#ifstacks];
pop(@ucstacks);
*ucstack = $ucstacks[$#ucstacks];

# instantiate the sub-Template, feeding it parse_stack and
# param_map. This means that only the enclosing template
# does _parse() - sub-templates get their parse_stack and
# param_map fed to them already filled in.
$loop->[Template::LOOP::TEMPLATE_HASH]{$starts_at}
= Template->_new_from_loop(
parse_stack => $parse_stack,
param_map => $param_map,
debug => $options->{debug},
die_on_bad_params => $options->{die_on_bad_params},
loop_context_vars => $options->{loop_context_vars},
case_sensitive => $options->{case_sensitive},
);

} elsif ($which eq 'TMPL_IF' or $which eq 'TMPL_UNLESS' ) {
$options->{debug} and print STDERR "### Template Debug ### $fname : line $fcounter : $which $name start\n";

# if we already have this var, then simply link to the existing
# Template::VAR/LOOP, else defer the mapping
my $var;
if (exists $pmap{$name}) {
$var = $pmap{$name};
} else {
$var = $name;
}

# connect the var to a conditional
my $cond = Template::COND->new($var);
if ($which eq 'TMPL_IF') {
$cond->[Template::COND::WHICH] = Template::COND::WHICH_IF;
$cond->[Template::COND::JUMP_IF_TRUE] = 0;
} else {
$cond->[Template::COND::WHICH] = Template::COND::WHICH_UNLESS;
$cond->[Template::COND::JUMP_IF_TRUE] = 1;
}

# push unconnected conditionals onto the ucstack for
# resolution later. Otherwise, save type information now.
if ($var eq $name) {
push(@ucstack, $cond);
} else {
if (ref($var) eq 'Template::VAR') {
$cond->[Template::COND::VARIABLE_TYPE] = Template::COND::VARIABLE_TYPE_VAR;
} else {
$cond->[Template::COND::VARIABLE_TYPE] = Template::COND::VARIABLE_TYPE_LOOP;
}
}

# push what we've got onto the stacks
push(@pstack, $cond);
push(@ifstack, $cond);

} elsif ($which eq '/TMPL_IF' or $which eq '/TMPL_UNLESS') {
$options->{debug} and print STDERR "### Template Debug ###$fname : line $fcounter : $which end\n";

my $cond = pop(@ifstack);
die "Template->new() : found </${which}> with no matching <TMPL_IF> at $fname : line $fcounter." unless defined $cond;
if ($which eq '/TMPL_IF') {
die "Template->new() : found </TMPL_IF> incorrectly terminating a <TMPL_UNLESS> (use </TMPL_UNLESS>) at $fname : line $fcounter.\n"
if ($cond->[Template::COND::WHICH] == Template::COND::WHICH_UNLESS);
} else {
die "Template->new() : found </TMPL_UNLESS> incorrectly terminating a <TMPL_IF> (use </TMPL_IF>) at $fname : line $fcounter.\n"
if ($cond->[Template::COND::WHICH] == Template::COND::WHICH_IF);
}

# connect the matching to this "address" - place a NOOP to
# hold the spot. This allows output() to treat an IF in the
# assembler-esque "Conditional Jump" mode.
push(@pstack, $NOOP);
$cond->[Template::COND::JUMP_ADDRESS] = $#pstack;

} elsif ($which eq 'TMPL_ELSE') {
$options->{debug} and print STDERR "### Template Debug ### $fname : line $fcounter : ELSE\n";

my $cond = pop(@ifstack);
die "Template->new() : found <TMPL_ELSE> with no matching <TMPL_IF> or <TMPL_UNLESS> at $fname : line $fcounter." unless defined $cond;


my $else = Template::COND->new($cond->[Template::COND::VARIABLE]);
$else->[Template::COND::WHICH] = $cond->[Template::COND::WHICH];
$else->[Template::COND::JUMP_IF_TRUE] = not $cond->[Template::COND::JUMP_IF_TRUE];

# need end-block resolution?
if (defined($cond->[Template::COND::VARIABLE_TYPE])) {
$else->[Template::COND::VARIABLE_TYPE] = $cond->[Template::COND::VARIABLE_TYPE];
} else {
push(@ucstack, $else);
}

push(@pstack, $else);
push(@ifstack, $else);

# connect the matching to this "address" - thus the if,
# failing jumps to the ELSE address. The else then gets
# elaborated, and of course succeeds. On the other hand, if
# the IF fails and falls though, output will reach the else
# and jump to the /if address.
$cond->[Template::COND::JUMP_ADDRESS] = $#pstack;

} elsif ($which eq 'TMPL_INCLUDE') {
# handle TMPL_INCLUDEs
$options->{debug} and print STDERR "### Template Debug ### $fname : line $fcounter : INCLUDE $name \n";

# no includes here, bub
$options->{no_includes} and croak("Template : Illegal attempt to use TMPL_INCLUDE in template file : (no_includes => 1)");

my $filename = $name;

# look for the included file...
my $filepath;
if ($options->{search_path_on_include}) {
$filepath = $self->_find_file($filename);
} else {
$filepath = $self->_find_file($filename,
[File::Spec->splitdir($fstack[-1]Ύ])]
);
}
die "Template->new() : Cannot open included file $filename : file not found."
unless defined($filepath);
die "Template->new() : Cannot open included file $filename : $!"
unless defined(open(TEMPLATE, $filepath));

# read into the array
my $included_template = "";
while(read(TEMPLATE, $included_template, 10240, length($included_template))) {}
close(TEMPLATE);

# call filters if necessary
$self->_call_filters(\$included_template) if @{$options->{filter}};

if ($included_template) { # not empty
# handle the old vanguard format - this needs to happen here
# since we're not about to do a next CHUNKS.
$options->{vanguard_compatibility_mode} and
$included_template =~ s/%([-\w\/\.+]+)%/<TMPL_VAR NAME=$1>/g;

# collect mtimes for included files
if ($options->{cache} and !$options->{blind_cache}) {
$self->{included_mtimes}{$filepath} = (stat($filepath))Η];
}

# adjust the fstack to point to the included file info
push(@fstack, [$filepath, 1,
scalar @{[$included_template =~ m/(\n)/g]} + 1]);
(*fname, *fcounter, *fmax) = \ ( @{$fstack[$#fstack]} );

# make sure we aren't infinitely recursing
die "Template->new() : likely recursive includes - parsed $options->{max_includes} files deep and giving up (set max_includes higher to allow deeper recursion)." if ($options->{max_includes} and (scalar(@fstack) > $options->{max_includes}));

# stick the remains of this chunk onto the bottom of the
# included text.
$included_template .= $post;
$post = undef;

# move the new chunks into place.
splice(@chunks, $chunk_number, 1,
split(m/(?=<)/, $included_template));

# recalculate stopping point
$last_chunk = $#chunks;

# start in on the first line of the included text - nothing
# else to do on this line.
$chunk = $chunks[$chunk_number];

redo CHUNK;
}
} else {
# zuh!?
die "Template->new() : Unknown or unmatched TMPL construct at $fname : line $fcounter.";
}
# push the rest after the tag
if (defined($post)) {
if (ref($pstack[$#pstack]) eq 'SCALAR') {
${$pstack[$#pstack]} .= $post;
} else {
push(@pstack, \$post);
}
}
} else { # just your ordinary markup
# make sure we didn't reject something TMPL_* but badly formed
if ($options->{strict}) {
die "Template->new() : Syntax error in <TMPL_*> tag at $fname : $fcounter." if ($chunk =~ /<(?:!--\s*)?\/?[Tt][Mm][Pp][Ll]_/);
}

# push the rest and get next chunk
if (defined($chunk)) {
if (ref($pstack[$#pstack]) eq 'SCALAR') {
${$pstack[$#pstack]} .= $chunk;
} else {
push(@pstack, \$chunk);
}
}
}
# count newlines in chunk and advance line count
$fcounter += scalar(@{[$chunk =~ m/(\n)/g]});
# if we just crossed the end of an included file
# pop off the record and re-alias to the enclosing file's info
pop(@fstack), (*fname, *fcounter, *fmax) = \ ( @{$fstack[$#fstack]} )
if ($fcounter > $fmax);

} # next CHUNK

# make sure we don't have dangling IF or LOOP blocks
scalar(@ifstack) and die "Template->new() : At least one <TMPL_IF> or <TMPL_UNLESS> not terminated at end of file!";
scalar(@loopstack) and die "Template->new() : At least one <TMPL_LOOP> not terminated at end of file!";

# resolve pending conditionals
foreach my $uc (@ucstack) {
my $var = $uc->[Template::COND::VARIABLE];
if (exists($pmap{$var})) {
$uc->[Template::COND::VARIABLE] = $pmap{$var};
} else {
$pmap{$var} = Template::VAR->new();
$top_pmap{$var} = Template::VAR->new()
if $options->{global_vars} and not exists $top_pmap{$var};
$uc->[Template::COND::VARIABLE] = $pmap{$var};
}
if (ref($pmap{$var}) eq 'Template::VAR') {
$uc->[Template::COND::VARIABLE_TYPE] = Template::COND::VARIABLE_TYPE_VAR;
} else {
$uc->[Template::COND::VARIABLE_TYPE] = Template::COND::VARIABLE_TYPE_LOOP;
}
}

# want a stack dump?
if ($options->{stack_debug}) {
require 'Data/Dumper.pm';
print STDERR "### Template _param Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n";
}

# get rid of filters - they cause runtime errors if Storable tries
# to store them. This can happen under global_vars.
delete $options->{filter};
}

# a recursive sub that associates each loop with the loops above
# (treating the top-level as a loop)
sub _globalize_vars {
my $self = shift;

# associate with the loop (and top-level templates) above in the tree.
push(@{$self->{options}{associate}}, @_);

# recurse down into the template tree, adding ourself to the end of
# list.
push(@_, $self);
map { $_->_globalize_vars(@_) }
map {values %{$_->[Template::LOOP::TEMPLATE_HASH]}}
grep { ref($_) eq 'Template::LOOP'} @{$self->{parse_stack}};
}

# method used to recursively un-hook associate
sub _unglobalize_vars {
my $self = shift;

# disassociate
$self->{options}{associate} = undef;

# recurse down into the template tree disassociating
map { $_->_unglobalize_vars() }
map {values %{$_->[Template::LOOP::TEMPLATE_HASH]}}
grep { ref($_) eq 'Template::LOOP'} @{$self->{parse_stack}};
}

=head2 param()

param() can be called in a number of ways

1) To return a list of parameters in the template :

my @parameter_names = $self->param();


2) To return the value set to a param :

my $value = $self->param('PARAM');

3) To set the value of a parameter :

# For simple TMPL_VARs:
$self->param(PARAM => 'value');

# with a subroutine reference that gets called to get the value
# of the scalar. The sub will recieve the template object as a
# parameter.
$self->param(PARAM => sub { return 'value' });

# And TMPL_LOOPs:
$self->param(LOOP_PARAM =>
[
{ PARAM => VALUE_FOR_FIRST_PASS, ... },
{ PARAM => VALUE_FOR_SECOND_PASS, ... }
...
]
);

4) To set the value of a a number of parameters :

# For simple TMPL_VARs:
$self->param(PARAM => 'value',
PARAM2 => 'value'
);

# And with some TMPL_LOOPs:
$self->param(PARAM => 'value',
PARAM2 => 'value',
LOOP_PARAM =>
[
{ PARAM => VALUE_FOR_FIRST_PASS, ... },
{ PARAM => VALUE_FOR_SECOND_PASS, ... }
...
],
ANOTHER_LOOP_PARAM =>
[
{ PARAM => VALUE_FOR_FIRST_PASS, ... },
{ PARAM => VALUE_FOR_SECOND_PASS, ... }
...
]
);

5) To set the value of a a number of parameters using a hash-ref :

$self->param(
{
PARAM => 'value',
PARAM2 => 'value',
LOOP_PARAM =>
[
{ PARAM => VALUE_FOR_FIRST_PASS, ... },
{ PARAM => VALUE_FOR_SECOND_PASS, ... }
...
],
ANOTHER_LOOP_PARAM =>
[
{ PARAM => VALUE_FOR_FIRST_PASS, ... },
{ PARAM => VALUE_FOR_SECOND_PASS, ... }
...
]
}
);

=cut


sub param {
my $self = shift;
my $options = $self->{options};
my $param_map = $self->{param_map};

# the no-parameter case - return list of parameters in the template.
return keys(%$param_map) unless scalar(@_);

my $first = shift;
my $type = ref $first;

# the one-parameter case - could be a parameter value request or a
# hash-ref.
if (!scalar(@_) and !length($type)) {
my $param = $options->{case_sensitive} ? $first : lc $first;

# check for parameter existence
$options->{die_on_bad_params} and !exists($param_map->{$param}) and
croak("Template : Attempt to get nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params set => 1)");

return undef unless (exists($param_map->{$param}) and
defined($param_map->{$param}));

return ${$param_map->{$param}} if
(ref($param_map->{$param}) eq 'Template::VAR');
return $param_map->{$param}[Template::LOOP::PARAM_SET];
}

if (!scalar(@_)) {
croak("Template->param() : Single reference arg to param() must be a hash-ref! You gave me a $type.")
unless $type eq 'HASH' or
(ref($first) and UNIVERSAL::isa($first, 'HASH'));
push(@_, %$first);
} else {
unshift(@_, $first);
}

croak("Template->param() : You gave me an odd number of parameters to param()!")
unless ((@_ % 2) == 0);

# strangely, changing this to a "while(@_) { shift, shift }" type
# loop causes perl 5.004_04 to die with some nonsense about a
# read-only value.
for (my $x = 0; $x <= $#_; $x += 2) {
my $param = $options->{case_sensitive} ? $_[$x] : lc $_[$x];
my $value = $_[($x + 1)];

# check that this param exists in the template
$options->{die_on_bad_params} and !exists($param_map->{$param}) and
croak("Template : Attempt to set nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params => 1)");

# if we're not going to die from bad param names, we need to ignore
# them...
next unless (exists($param_map->{$param}));

# figure out what we've got, taking special care to allow for
# objects that are compatible underneath.
my $value_type = ref($value);
if (defined($value_type) and length($value_type) and ($value_type eq 'ARRAY' or ((ref($value) !~ /^(CODE)|(HASH)|(SCALAR)$/) and $value->isa('ARRAY')))) {
(ref($param_map->{$param}) eq 'Template::LOOP') or
croak("Template::param() : attempt to set parameter '$param' with an array ref - parameter is not a TMPL_LOOP!");
$param_map->{$param}[Template::LOOP::PARAM_SET] = [@{$value}];
} else {
(ref($param_map->{$param}) eq 'Template::VAR') or
croak("Template::param() : attempt to set parameter '$param' with a scalar - parameter is not a TMPL_VAR!");
${$param_map->{$param}} = $value;
}
}
}

=pod

=head2 clear_params()

Sets all the parameters to undef. Useful internally, if nowhere else!

=cut

sub clear_params {
my $self = shift;
my $type;
foreach my $name (keys %{$self->{param_map}}) {
$type = ref($self->{param_map}{$name});
undef(${$self->{param_map}{$name}})
if ($type eq 'Template::VAR');
undef($self->{param_map}{$name}[Template::LOOP::PARAM_SET])
if ($type eq 'Template::LOOP');
}
}


# obsolete implementation of associate
sub associateCGI {
my $self = shift;
my $cgi = shift;
(ref($cgi) eq 'CGI') or
croak("Warning! non-CGI object was passed to Template::associateCGI()!\n");
push(@{$self->{options}{associate}}, $cgi);
return 1;
}


=head2 output()

output() returns the final result of the template. In most situations
you'll want to print this, like:

print $template->output();

When output is called each occurrence of <TMPL_VAR NAME=name> is
replaced with the value assigned to "name" via param(). If a named
parameter is unset it is simply replaced with ''. <TMPL_LOOPS> are
evaluated once per parameter set, accumlating output on each pass.

Calling output() is guaranteed not to change the state of the
Template object, in case you were wondering. This property is mostly
important for the internal implementation of loops.

You may optionally supply a filehandle to print to automatically as
the template is generated. This may improve performance and lower
memory consumption. Example:

$template->output(print_to => *STDOUT);

The return value is undefined when using the "print_to" option.

=cut

use vars qw(%URLESCAPE_MAP);
sub output {
my $self = shift;
my $options = $self->{options};
local $_;

croak("Template->output() : You gave me an odd number of parameters to output()!")
unless ((@_ % 2) == 0);
my %args = @_;

print STDERR "### Template Memory Debug ### START OUTPUT ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

$options->{debug} and print STDERR "### Template Debug ### In output\n";

# want a stack dump?
if ($options->{stack_debug}) {
require 'Data/Dumper.pm';
print STDERR "### Template output Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n";
}

# globalize vars - this happens here to localize the circular
# references created by global_vars.
$self->_globalize_vars() if ($options->{global_vars});

# support the associate magic, searching for undefined params and
# attempting to fill them from the associated objects.
if (scalar(@{$options->{associate}})) {
# prepare case-mapping hashes to do case-insensitive matching
# against associated objects. This allows CGI.pm to be
# case-sensitive and still work with asssociate.
my (%case_map, $lparam);
foreach my $associated_object (@{$options->{associate}}) {
# what a hack! This should really be optimized out for case_sensitive.
if ($options->{case_sensitive}) {
map {
$case_map{$associated_object}{$_} = $_
} $associated_object->param();
} else {
map {
$case_map{$associated_object}{lc($_)} = $_
} $associated_object->param();
}
}

foreach my $param (keys %{$self->{param_map}}) {
unless (defined($self->param($param))) {
OBJ: foreach my $associated_object (reverse @{$options->{associate}}) {
$self->param($param, scalar $associated_object->param($case_map{$associated_object}{$param})), last OBJ
if (exists($case_map{$associated_object}{$param}));
}
}
}
}

use vars qw($line @parse_stack); local(*line, *parse_stack);

# walk the parse stack, accumulating output in $result
*parse_stack = $self->{parse_stack};
my $result = '';

tie $result, 'Template::PRINTSCALAR', $args{print_to}
if defined $args{print_to} and not tied $args{print_to};

my $type;
my $parse_stack_length = $#parse_stack;
for (my $x = 0; $x <= $parse_stack_length; $x++) {
*line = \$parse_stack[$x];
$type = ref($line);

if ($type eq 'SCALAR') {
$result .= $$line;
} elsif ($type eq 'Template::VAR' and ref($$line) eq 'CODE') {
defined($$line) and $result .= $$line->($self);
} elsif ($type eq 'Template::VAR') {
defined($$line) and $result .= $$line;
} elsif ($type eq 'Template::LOOP') {
if (defined($line->[Template::LOOP::PARAM_SET])) {
eval { $result .= $line->output($x, $options->{loop_context_vars}); };
croak("Template->output() : fatal error in loop output : $@")
if $@;
}
} elsif ($type eq 'Template::COND') {
if ($line->[Template::COND::JUMP_IF_TRUE]) {
if ($line->[Template::COND::VARIABLE_TYPE] == Template::COND::VARIABLE_TYPE_VAR) {
if (defined ${$line->[Template::COND::VARIABLE]}) {
if (ref(${$line->[Template::COND::VARIABLE]}) eq 'CODE') {
$x = $line->[Template::COND::JUMP_ADDRESS] if ${$line->[Template::COND::VARIABLE]}->($self);
} else {
$x = $line->[Template::COND::JUMP_ADDRESS] if ${$line->[Template::COND::VARIABLE]};
}
}
} else {
$x = $line->[Template::COND::JUMP_ADDRESS] if
(defined $line->[Template::COND::VARIABLE][Template::LOOP::PARAM_SET] and
scalar @{$line->[Template::COND::VARIABLE][Template::LOOP::PARAM_SET]});
}
} else {
if ($line->[Template::COND::VARIABLE_TYPE] == Template::COND::VARIABLE_TYPE_VAR) {
if (defined ${$line->[Template::COND::VARIABLE]}) {
if (ref(${$line->[Template::COND::VARIABLE]}) eq 'CODE') {
$x = $line->[Template::COND::JUMP_ADDRESS] unless ${$line->[Template::COND::VARIABLE]}->($self);
} else {
$x = $line->[Template::COND::JUMP_ADDRESS] unless ${$line->[Template::COND::VARIABLE]};
}
} else {
$x = $line->[Template::COND::JUMP_ADDRESS];
}
} else {
$x = $line->[Template::COND::JUMP_ADDRESS] if
(not defined $line->[Template::COND::VARIABLE][Template::LOOP::PARAM_SET] or
not scalar @{$line->[Template::COND::VARIABLE][Template::LOOP::PARAM_SET]});
}
}
} elsif ($type eq 'Template::NOOP') {
next;
} elsif ($type eq 'Template::DEFAULT') {
$_ = $x; # remember default place in stack

# find next VAR, there might be an ESCAPE in the way
*line = \$parse_stack[++$x];
*line = \$parse_stack[++$x] if ref $line eq 'Template::ESCAPE';

# either output the default or go back
if (defined $$line) {
$x = $_;
} else {
$result .= ${$parse_stack[$_]};
}
next;
} elsif ($type eq 'Template::ESCAPE') {
*line = \$parse_stack[++$x];
if (defined($$line)) {
$_ = $$line;

# straight from the CGI.pm bible.
s/&/&/g;
s/\"/"/g; #"
s/>/>/g;
s/</</g;
s/'/'/g; #'

$result .= $_;
}
next;
} elsif ($type eq 'Template::URLESCAPE') {
$x++;
*line = \$parse_stack[$x];
if (defined($$line)) {
$_ = $$line;
# Build a char->hex map if one isn't already available
unless (exists($URLESCAPE_MAP{chr(1)})) {
for (0..255) { $URLESCAPE_MAP{chr($_)} = sprintf('%%%02X', $_); }
}
# do the translation (RFC 2396 ^uric)
s!([^a-zA-Z0-9_.\-])!$URLESCAPE_MAP{$1}!g;
$result .= $_;
}
} else {
confess("Template::output() : Unknown item in parse_stack : " . $type);
}
}

# undo the globalization circular refs
$self->_unglobalize_vars() if ($options->{global_vars});

print STDERR "### Template Memory Debug ### END OUTPUT ", $self->{proc_mem}->size(), "\n"
if $options->{memory_debug};

return undef if defined $args{print_to};
return $result;
}

=pod

=head2 query()

This method allow you to get information about the template structure.
It can be called in a number of ways. The simplest usage of query is
simply to check whether a parameter name exists in the template, using
the C<name> option:

if ($template->query(name => 'foo')) {
# do something if a varaible of any type
# named FOO is in the template
}

This same usage returns the type of the parameter. The type is the
same as the tag minus the leading 'TMPL_'. So, for example, a
TMPL_VAR parameter returns 'VAR' from query().

if ($template->query(name => 'foo') eq 'VAR') {
# do something if FOO exists and is a TMPL_VAR
}

Note that the variables associated with TMPL_IFs and TMPL_UNLESSs will
be identified as 'VAR' unless they are also used in a TMPL_LOOP, in
which case they will return 'LOOP'.

C<query()> also allows you to get a list of parameters inside a loop
(and inside loops inside loops). Example loop:

<TMPL_LOOP NAME="EXAMPLE_LOOP">
<TMPL_VAR NAME="BEE">
<TMPL_VAR NAME="BOP">
<TMPL_LOOP NAME="EXAMPLE_INNER_LOOP">
<TMPL_VAR NAME="INNER_BEE">
<TMPL_VAR NAME="INNER_BOP">
</TMPL_LOOP>
</TMPL_LOOP>

And some query calls:

# returns 'LOOP'
$type = $template->query(name => 'EXAMPLE_LOOP');

# returns ('bop', 'bee', 'example_inner_loop')
@param_names = $template->query(loop => 'EXAMPLE_LOOP');

# both return 'VAR'
$type = $template->query(name => ['EXAMPLE_LOOP', 'BEE']);
$type = $template->query(name => ['EXAMPLE_LOOP', 'BOP']);

# and this one returns 'LOOP'
$type = $template->query(name => ['EXAMPLE_LOOP',
'EXAMPLE_INNER_LOOP']);

# and finally, this returns ('inner_bee', 'inner_bop')
@inner_param_names = $template->query(loop => ['EXAMPLE_LOOP',
'EXAMPLE_INNER_LOOP']);

# for non existent parameter names you get undef
# this returns undef.
$type = $template->query(name => 'DWEAZLE_ZAPPA');

# calling loop on a non-loop parameter name will cause an error.
# this dies:
$type = $template->query(loop => 'DWEAZLE_ZAPPA');

As you can see above the C<loop> option returns a list of parameter
names and both C<name> and C<loop> take array refs in order to refer
to parameters inside loops. It is an error to use C<loop> with a
parameter that is not a loop.

Note that all the names are returned in lowercase and the types are
uppercase.

Just like C<param()>, C<query()> with no arguements returns all the
parameter names in the template at the top level.

=cut

sub query {
my $self = shift;
$self->{options}{debug} and print STDERR "### Template Debug ### query(", join(', ', @_), ")\n";

# the no-parameter case - return $self->param()
return $self->param() unless scalar(@_);

croak("Template::query() : Odd number of parameters passed to query!")
if (scalar(@_) % 2);
croak("Template::query() : Wrong number of parameters passed to query - should be 2.")
if (scalar(@_) != 2);

my ($opt, $path) = (lc shift, shift);
croak("Template::query() : invalid parameter ($opt)")
unless ($opt eq 'name' or $opt eq 'loop');

# make path an array unless it already is
$path = [$path] unless (ref $path);

# find the param in question.
my @objs = $self->_find_param(@$path);
return undef unless scalar(@objs);
my ($obj, $type);

# do what the user asked with the object
if ($opt eq 'name') {
# we only look at the first one. new() should make sure they're
# all the same.
($obj, $type) = (shift(@objs), shift(@objs));
return undef unless defined $obj;
return 'VAR' if $type eq 'Template::VAR';
return 'LOOP' if $type eq 'Template::LOOP';
croak("Template::query() : unknown object ($type) in param_map!");

} elsif ($opt eq 'loop') {
my %results;
while(@objs) {
($obj, $type) = (shift(@objs), shift(@objs));
croak("Template::query() : Search path [", join(', ', @$path), "] doesn't end in a TMPL_LOOP - it is an error to use the 'loop' option on a non-loop parameter. To avoid this problem you can use the 'name' option to query() to check the type first.")
unless ((defined $obj) and ($type eq 'Template::LOOP'));

# SHAZAM! This bit extracts all the parameter names from all the
# loop objects for this name.
map {$results{$_} = 1} map { keys(%{$_->{'param_map'}}) }
values(%{$obj->[Template::LOOP::TEMPLATE_HASH]});
}
# this is our loop list, return it.
return keys(%results);
}
}

# a function that returns the object(s) corresponding to a given path and
# its (their) ref()(s). Used by query() in the obvious way.
sub _find_param {
my $self = shift;
my $spot = $self->{options}{case_sensitive} ? shift : lc shift;

# get the obj and type for this spot
my $obj = $self->{'param_map'}{$spot};
return unless defined $obj;
my $type = ref $obj;

# return if we're here or if we're not but this isn't a loop
return ($obj, $type) unless @_;
return unless ($type eq 'Template::LOOP');

# recurse. this is a depth first seach on the template tree, for
# the algorithm geeks in the audience.
return map { $_->_find_param(@_) }
values(%{$obj->[Template::LOOP::TEMPLATE_HASH]});
}

# Template::VAR, LOOP, etc are *light* objects - their internal
# spec is used above. No encapsulation or information hiding is to be
# assumed.

package Template::VAR;

sub new {
my $value;
return bless(\$value, $_Ύ]);
}

package Template::DEFAULT;

sub new {
my $value = $_Ώ];
return bless(\$value, $_Ύ]);
}

package Template::LOOP;

sub new {
return bless([], $_Ύ]);
}

sub output {
my $self = shift;
my $index = shift;
my $loop_context_vars = shift;
my $template = $self->[TEMPLATE_HASH]{$index};
my $value_sets_array = $self->[PARAM_SET];
return unless defined($value_sets_array);

my $result = '';
my $count = 0;
my $odd = 0;
foreach my $value_set (@$value_sets_array) {
if ($loop_context_vars) {
if ($count == 0) {
@{$value_set}{qw(__first__ __inner__ __last__)} = (1,0,$#{$value_sets_array} == 0);
} elsif ($count == $#{$value_sets_array}) {
@{$value_set}{qw(__first__ __inner__ __last__)} = (0,0,1);
} else {
@{$value_set}{qw(__first__ __inner__ __last__)} = (0,1,0);
}
$odd = $value_set->{__odd__} = not $odd;
$value_set->{__counter__} = $count + 1;
}
$template->param($value_set);
$result .= $template->output;
$template->clear_params;
@{$value_set}{qw(__first__ __last__ __inner__ __odd__ __counter__)} =
(0,0,0,0)
if ($loop_context_vars);
$count++;
}

return $result;
}

package Template::COND;

sub new {
my $pkg = shift;
my $var = shift;
my $self = [];
$self->[VARIABLE] = $var;

bless($self, $pkg);
return $self;
}

package Template::NOOP;
sub new {
my $unused;
my $self = \$unused;
bless($self, $_Ύ]);
return $self;
}

package Template::ESCAPE;
sub new {
my $unused;
my $self = \$unused;
bless($self, $_Ύ]);
return $self;
}

package Template::URLESCAPE;
sub new {
my $unused;
my $self = \$unused;
bless($self, $_Ύ]);
return $self;
}

# scalar-tying package for output(print_to => *HANDLE) implementation
package Template::PRINTSCALAR;
use strict;

sub TIESCALAR { bless \$_Ώ], $_Ύ]; }
sub FETCH { }
sub STORE {
my $self = shift;
local *FH = $$self;
print FH @_;
}
1;
__END__

=head1 FREQUENTLY ASKED QUESTIONS

In the interest of greater understanding I've started a FAQ section of
the perldocs. Please look in here before you send me email.

=over 4

=item 1

Q: Is there a place to go to discuss Template and/or get help?

A: There's a mailing-list for discussing Template at
html-template-users@lists.sourceforge.net. To join:

http://lists.sourceforge.net/.../html-template-users

If you just want to get email when new releases are available you can
join the announcements mailing-list here:

http://lists.sourceforge.net/...ml-template-announce

=item 2

Q: Is there a searchable archive for the mailing-list?

A: Yes, you can find an archive of the SourceForge list here:

http://www.geocrawler.com/...SourceForge/23294/0/

For an archive of the old vm.com list, setup by Sean P. Scanlon, see:

http://bluedot.net/mail/archive/

=item 3

Q: I want support for <TMPL_XXX>! How about it?

A: Maybe. I definitely encourage people to discuss their ideas for
Template on the mailing list. Please be ready to explain to me
how the new tag fits in with Template's mission to provide a
fast, lightweight system for using HTML templates.

NOTE: Offering to program said addition and provide it in the form of
a patch to the most recent version of Template will definitely
have a softening effect on potential opponents!

=item 4

Q: I found a bug, can you fix it?

A: That depends. Did you send me the VERSION of Template, a test
script and a test template? If so, then almost certainly.

If you're feeling really adventurous, Template has a publically
available CVS server. See below for more information in the PUBLIC
CVS SERVER section.

=item 5

Q: <TMPL_VAR>s from the main template aren't working inside a
<TMPL_LOOP>! Why?

A: This is the intended behavior. <TMPL_LOOP> introduces a separate
scope for <TMPL_VAR>s much like a subroutine call in Perl introduces a
separate scope for "my" variables.

If you want your <TMPL_VAR>s to be global you can set the
'global_vars' option when you call new(). See above for documentation
of the 'global_vars' new() option.

=item 6

Q: Why do you use /[Tt]/ instead of /t/i? It's so ugly!

A: Simple - the case-insensitive match switch is very inefficient.
According to _Mastering_Regular_Expressions_ from O'Reilly Press,
/[Tt]/ is faster and more space efficient than /t/i - by as much as
double against long strings. //i essentially does a lc() on the
string and keeps a temporary copy in memory.

When this changes, and it is in the 5.6 development series, I will
gladly use //i. Believe me, I realize [Tt] is hideously ugly.

=item 7

Q: How can I pre-load my templates using cache-mode and mod_perl?

A: Add something like this to your startup.pl:

use Template;
use File::Find;

print STDERR "Pre-loading HTML Templates...\n";
find(
sub {
return unless /\.tmpl$/;
Template->new(
filename => "$File::Find::dir/$_",
cache => 1,
);
},
'/path/to/templates',
'/another/path/to/templates/'
);

Note that you'll need to modify the "return unless" line to specify
the extension you use for your template files - I use .tmpl, as you
can see. You'll also need to specify the path to your template files.

One potential problem: the "/path/to/templates/" must be EXACTLY the
same path you use when you call Template->new(). Otherwise the
cache won't know they're the same file and will load a new copy -
instead getting a speed increase, you'll double your memory usage. To
find out if this is happening set cache_debug => 1 in your application
code and look for "CACHE MISS" messages in the logs.

=item 8

Q: What characters are allowed in TMPL_* NAMEs?

A: Numbers, letters, '.', '/', '+', '-' and '_'.

=item 9

Q: How can I execute a program from inside my template?

A: Short answer: you can't. Longer answer: you shouldn't since this
violates the fundamental concept behind Template - that design
and code should be seperate.

But, inevitably some people still want to do it. If that describes
you then you should take a look at
L<Template::Expr|Template::Expr>. Using
Template::Expr it should be easy to write a run_program()
function. Then you can do awful stuff like:

<tmpl_var expr="run_program('foo.pl')">

Just, please, don't tell me about it. I'm feeling guilty enough just
for writing Template::Expr in the first place.

=item 10

Q: Can I get a copy of these docs in Japanese?

A: Yes you can. See Kawai Takanori's translation at:

http://member.nifty.ne.jp/...ps/html/template.htm

=item 11

Q: What's the best way to create a <select> form element using
Template?

A: There is much disagreement on this issue. My personal preference
is to use CGI.pm's excellent popup_menu() and scrolling_list()
functions to fill in a single <tmpl_var select_foo> variable.

To some people this smacks of mixing HTML and code in a way that they
hoped Template would help them avoid. To them I'd say that HTML
is a violation of the principle of separating design from programming.
There's no clear separation between the programmatic elements of the
<form> tags and the layout of the <form> tags. You'll have to draw
the line somewhere - clearly the designer can't be entirely in charge
of form creation.

It's a balancing act and you have to weigh the pros and cons on each side.
It is certainly possible to produce a <select> element entirely inside the
template. What you end up with is a rat's nest of loops and conditionals.
Alternately you can give up a certain amount of flexibility in return for
vastly simplifying your templates. I generally choose the latter.

Another option is to investigate FillInForm which some have
reported success using to solve this problem.

=back

=head1 BUGS

I am aware of no bugs - if you find one, join the mailing list and
tell us about it. You can join the Template mailing-list by
visiting:

http://lists.sourceforge.net/.../html-template-users

Of course, you can still email me directly (sam@tregar.com) with bugs,
but I reserve the right to forward bug reports to the mailing list.

When submitting bug reports, be sure to include full details,
including the VERSION of the module, a test script and a test template
demonstrating the problem!

If you're feeling really adventurous, Template has a publically
available CVS server. See below for more information in the PUBLIC
CVS SERVER section.

=head1 CREDITS

This module was the brain child of my boss, Jesse Erlbaum
( jesse@vm.com ) at Vanguard Media ( http://vm.com ) . The most original
idea in this module - the <TMPL_LOOP> - was entirely his.

Fixes, Bug Reports, Optimizations and Ideas have been generously
provided by:

Richard Chen
Mike Blazer
Adriano Nagelschmidt Rodrigues
Andrej Mikus
Ilya Obshadko
Kevin Puetz
Steve Reppucci
Richard Dice
Tom Hukins
Eric Zylberstejn
David Glasser
Peter Marelas
James William Carlson
Frank D. Cringle
Winfried Koenig
Matthew Wickline
Doug Steinwand
Drew Taylor
Tobias Brox
Michael Lloyd
Simran Gambhir
Chris Houser <chouser@bluweb.com>
Larry Moore
Todd Larason
Jody Biggs
T.J. Mather
Martin Schroth
Dave Wolfe
uchum
Kawai Takanori
Peter Guelich
Chris Nokleberg
Ralph Corderoy
William Ward
Ade Olonoh
Mark Stosberg
Lance Thomas
Roland Giersig
Jere Julian
Peter Leonard
Kenny Smith
Sean P. Scanlon
Martin Pfeffer
David Ferrance
Gyepi Sam
Darren Chamberlain

Thanks!

=head1 WEBSITE

You can find information about Template and other related modules at:

http://html-template.sourceforge.net

=head1 PUBLIC CVS SERVER

Template now has a publicly accessible CVS server provided by
SourceForge (www.sourceforge.net). You can access it by going to
http://sourceforge.net/cvs/?group_id=1075. Give it a try!

=head1 AUTHOR

Sam Tregar, sam@tregar.com

=head1 LICENSE

Template : A module for using HTML Templates with Perl
Copyright (C) 2000-2002 Sam Tregar (sam@tregar.com)

This module is free software; you can redistribute it and/or modify it
under the terms of either:

a) the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version,

or

b) the "Artistic License" which comes with this module.

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 either
the GNU General Public License or the Artistic License for more details.

You should have received a copy of the Artistic License with this
module, in the file ARTISTIC. If not, I'll be glad to provide one.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA

=cut