package HTML::Template::Ex; # # Copyright (C) 2007 Bee Flag, Corp, All Rights Reserved. # Masatoshi Mizuno EmizunoE<64>bomcity.comE # # $Id: 297 2007-03-25 14:34:59Z lushe $ # use strict; use warnings; use base qw/HTML::Template/; use Carp qw/croak/; use Digest::MD5 qw/md5_hex/; our $VERSION = '0.08'; my $ErrstrStyle= <}; sub new { my $class= shift; my $base = shift || HTML::Template::Ex::DummyObject->new; my %opt = $_[0] ? ($_[1] ? @_: %{$_[0]}) : croak __PACKAGE__.'::new: I want argument.'; for ( [qw{ strict 0 }], [qw{ file_cache 0 }], [qw{ global_vars 1 }], [qw{ shared_cache 0 }], [qw{ die_on_bad_params 0 }], ) { $opt{$_->[0]}= $_->[1] if exists($opt{$_->[0]}); } my(%param, %mark, %order, %temp); $opt{_ex_base_object}= $base; $opt{_ex_params} = \%param; $opt{_ex_orders} = \%order; $opt{_ex_mark} = \%mark; if (exists($opt{filter})) { if (ref($opt{filter}) eq 'CODE') { $opt{filter}= [{ format=> 'scalar', sub=> $opt{filter} }]; } elsif (ref($opt{filter}) eq 'HASH') { $opt{filter}= [$opt{filter}]; } elsif (ref($opt{filter}) ne 'ARRAY') { croak __PACKAGE__.q{::new: Bad format for 'filter'}; } } if ($opt{setup_env}) { $param{"env_$_"}= sub { $ENV{$_} || "" } for keys %ENV; } my $filter= $opt{exec_off} ? sub { &_offFilter(\%param, @_) } : sub { &_exFilter($base, \%opt, \%temp, @_) }; push @{$opt{filter}}, { format=> 'scalar', sub=> $filter }; my $self= HTML::Template::new($class, %opt); $opt{cache} and $self->{_ex_charset}= pop @{$self->{parse_stack}} || ""; $self; } sub output { my($self)= @_; my $parse_stack= $self->{parse_stack}; my $options = $self->{options}; my($ex_mark, $ex_param, $ex_order); if ($options->{cache}) { $ex_mark = pop @$parse_stack; $ex_param= pop @$parse_stack; $ex_order= pop @$parse_stack; } else { $ex_mark = $options->{_ex_mark} || {}; $ex_param= $options->{_ex_params} || {}; $ex_order= $options->{_ex_orders} || {}; } HTML::Template::param($self, $ex_mark); my $base = $options->{_ex_base_object}; my %param= %$ex_param; $options->{no_strict_exec} and do { no strict }; ## no critic my $cnt; for my $v (@$parse_stack) { next if (ref($v) ne 'HTML::Template::VAR' || ! $$v); my $hash= $ex_order->{$$v} || next; ++$cnt; my $result; eval{ $result= $hash->{function}->($base, \%param) }; if (my $err= $@) { require HTML::Entities; require Devel::StackTrace; my $st= Devel::StackTrace->new( no_refs=> 1 ); my $error; $error.= $_->filename. ': ' . $_->line. "\n" for $st->frames; $error = HTML::Entities::encode_entities( " - error:\n $err \n stack trace:\n $error", q{\\\<>&\"\'}, ); $error=~s{\r?\n} [
\n]sg; $param{$$v}= qq{
}; } else { $param{$$v}= ref($result) eq 'ARRAY' ? "" : $hash->{hidden} ? "": ($result || ""); $param{$hash->{key_name}}= $result if $hash->{key_name}; } } HTML::Template::param($self, \%param); my $result= HTML::Template::output(@_); if ($options->{cache}) { push @$parse_stack, $ex_order; push @$parse_stack, $ex_param; push @$parse_stack, $ex_mark; push @$parse_stack, ($self->{_ex_charset} || ""); } $result; } sub charset { $_[0]->{_ex_charset} || "" } sub _call_filters { my($self, $html)= @_; $self->{_ex_charset}= $1 if $$html=~m{$GetCharSetRegix}i; if ($self->{options}{auto_encoder}) { $self->{options}{auto_encoder}->($html) if $self->{_ex_charset}; } elsif ($self->{options}{encoder}) { $self->{options}{encoder}->($html); } HTML::Template::_call_filters(@_); } sub _exFilter { my($base, $opt, $temp, $text)= @_; $$text=~s{]+\s*)?>(.+?)]*>} [ &_replaceEx($1, $2, $base, $opt, $temp) ]isge; $$text=~m{(?:]*>|]*>)} and croak q{At least one not terminated at end of file!}; $$text=~s{]+)>} [ &_replaceSet($1, $opt->{_ex_params}) ]isge; } sub _offFilter { my($param, $text)= @_; $$text=~s{]+\s*?>.+?]*>} []isg; $$text=~s{(?:]*>|]*>)} []isg; $$text=~s{]+)>} [ &_replaceSet($1, $param) ]isge; } sub _replaceSet { my $opt = shift || return "[ tmpl_set Error!! ]"; my $param= shift || return "[ tmpl_set Error!! ]"; my $name = ($opt=~/name=\s*[\'\"]?([^\s\'\"]+)/)[0] || return "[ tmpl_set Error!! ]"; my $value= ($opt=~/value=\s*[\'\"](.+?)[\'\"]/)[0] || ($opt=~/value=\s*([^\s]+)/)[0] || return "[ tmpl_set Error!! ('$name') ]"; $param->{$name}= $value if $value; ""; } sub _replaceEx { my($tag, $code, $base, $opt, $temp)= @_; my $escape= my $default= ""; my($exec, %attr); if ($tag) { $attr{key_name}= lc($1) if $tag=~/name=[\"\']?([^\s\"\']+)/; $attr{hidden}= 1 if $tag=~/hidden=[\"\']?([^\s\"\']+)/; $escape = qq{ escape="$1"} if $tag=~/escape=[\"\']?([^\s\"\']+)/; $default= qq{ default="$1"} if $tag=~/default=[\"\']?([^\s\"\']+)/; } my $ident= '__$ex_'. &_get_ident_id($opt) .'$'. (++$temp->{count}). '$__'; $code= "no strict;\n". $code if $opt->{no_strict_exec}; eval"\$exec= sub { $code }"; ## no critic $attr{function}= sub { $exec->(@_) || "" }; $opt->{_ex_orders}{$ident}= \%attr; $opt->{_ex_mark}{$ident} = $ident; qq{}; } sub _commit_to_cache { my($self)= @_; push @{$self->{parse_stack}}, $self->{options}{_ex_orders}; push @{$self->{parse_stack}}, $self->{options}{_ex_params}; push @{$self->{parse_stack}}, $self->{options}{_ex_mark}; push @{$self->{parse_stack}}, ($self->{_ex_charset} || ""); HTML::Template::_commit_to_cache(@_); } sub _get_ident_id { $_[0]->{___ident_id} ||= substr(md5_hex(time(). {}. rand()), 0, 32); } package HTML::Template::Ex::DummyObject; use strict; sub new { bless {}, shift } 1; __END__ =head1 NAME HTML::Template::Ex - The Perl code is operated in the template for HTML::Template. =head1 SYNOPSIS package MyProject; use CGI; use Jcode; use HTML::Template::Ex; my $cgi = CGI->new; my $self= bless { cgi=> cgi }, __PACKAGE__; my $template= < <tmpl_var name="title">

my($self, $param)= @_; $param->{page_title}= 'My Page Title'; return $self->{cgi}->param('name') || 'It doesn't receive it.';
return [ { u_name=> 'foo', email=> 'foo@mydomain' }, { u_name=> 'boo', email=> 'boo@localdomain' }, ]; END_OF_TEMPLATE my $tmpl= HTML::Template::Ex->new($self, { setup_env=> 1, scalarref=> \$template, encoder => sub { Jcode->new($_[0])->euc }, # ... other 'HTML::Template' options. }); print STDOUT $cgi->header, $tmpl->output; =head1 DESCRIPTION This module offers the function to evaluate the Perl code to the template that HTML::Template uses. The character string enclosed with ' ... ' is evaluated as Perl code. my($self, $param)= @_; my $hoge= $self->to_method; $param->{hoge}= $hoge; return ""; The object passed to the constructor is passed to the first argument to the tmpl_ex tag. The second argument is HASH reference for the parameter that HTML::Template uses. When the ending value of each tmpl_ex block is returned, the value is buried under the position. Therefore, it is necessary to return the dead blank character to bury anything. When HTML::Template::Ex evaluates a little code, there is a little habit when a complex thing is done though it is convenient. One is the priority level when two or more tmpl_ex blocks are described. There is no problem for one template. It is sequentially evaluated on. And, please pay attention to the point done earlier than HTML::Template evaluates tag about this evaluation. The problem reads other templates from the template. It is time when it exists also in the read template the tmpl_ex block. HTML::Template::Ex is not intervened for the include of the template. Therefore, after HTML::Template evaluates tag, the tmpl_ex block include ahead will be evaluated. This sometimes causes confusion. ... [3] .... [ 1 ] ... [4] .... [ 2 ] ... [5] And, the error message is a very difficult secondarily thing. As for each tmpl_ex block, the code is individually evaluated with eval. Therefore, it is not a translation processed while looking about the entire template. Therefore, only the error where eval originates is obtained. As for this, specific in the error generation part becomes very difficult. The thing of this problem solved only by HTML::Template::Ex is difficult. Therefore, the improvement is not scheduled in the future. Using HTML::Template::Ex on the assumption of the thing to write a complex code doesn't come recommended though it is regrettable. Intuition is compelled every time the error occurs and debugging is compelled to reliance. Perhaps, this will be annoyed by the stress. Still, I think that it can do the template that works more high-speed than HTML::Mason and Template ToolKit if the code can be completed. Please try and look at interesting one. Therefore, HTML::Template::Ex selects it by the rental server etc. of the template driver. We will recommend the usage not to expect many of the template driver in the situation in which the leg is limited. And, '' doesn't have the meaning because it is evaluated earlier than HTML::Template though it is a thing misunderstood easily at the end. .... .... This is smoothly evaluated to diverge to both of the tmpl_ex block. Please solve 'IF' related to tmpl_ex block in tmpl_ex block. my($self, $param)= @_; if ($apram->{hoge}) { ... } else { ... } ""; =head1 TAGS It is enhancing tag that introduces here added by using HTML::Template::Ex. Please see the document of HTML::Template about standard tag of L. =head2 [PERL_CODE] The Perl code is evaluated in the template. Please see DESCRIPTION for details concerning basic operation. When the NAME attribute is given, the value that the tmpl_ex block returned to the parameter of the name is substituted. Please give the HIDDEN attribute at the same time to prevent the value being buried under the position of the tmpl_ex block.

The ESCAPE attribute can be used. ..... ban, bo, bon. return "Zooooo"; * After it is escaped of html, this is buried. =head2 The value is set in the parameter in the template. =head2 When the setup_env option is given to the constructor, the environment variable is set up. It can be referred to by ''. Please specify the environment variable name putting up 'env_' to the head of the name. =head1 METHODS =head2 new ([OBJECT], [OPTION]) It is a constructor. An arbitrary object is given to the first argument. The given object is passed as the first argument of each tmpl_ex block. [OPTION] is an option to pass to HTML::Template. Please include the option of HTML::Template::Ex here. Options. =over 4 =item * setup_env It is set up to refer to the environment variable. =item * exec_off All the tag that HTML::Template::Ex evaluates is invalidated and it puts it out. =item * no_strict_exec This is turned off though the code of the tmpl_ex block is evaluated under the strict environment usually. For person who is not accustomed to making strict code. =item * encoder The CODE reference to process the character-code can be defined. =item * auto_encoder When charset was able to be acquired from the template, encoder is processed. =back =head2 charset When charset was able to be acquired from the template, the value is returned. =head2 initStyle ([STYLE]) The output style etc. when the error occurs are defined. =head2 output Contents are output. =head2 other Please refer to the document of L for other methods. =head1 NOTES There is causing the defective operation according to the kind of the cash used by HTML::Template option. * If it is 'cache' option to specify at mod_perl, it operates normally usually. =head1 SEE ALSO L, =head1 AUTHOR Masatoshi Mizuno EmizunoE<64>bomcity.comE =head1 COPYRIGHT Copyright (C) 2007 by Bee Flag, Corp. ELE, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.6 or, at your option, any later version of Perl 5 you may have available. =cut