package Apache::PageKit::View;
# $Id: View.pm,v 1.110 2004/05/03 13:48:29 borisz Exp $
# we want to extend this module to use different templating packages -
# Template::ToolKit and HTML::Template
use integer;
use strict;
use File::Find ();
use File::Path ();
use HTML::Clean ();
use HTML::Template::XPath ();
use Storable ();
# how loading, filter and caching works on the templates.
# 1. templates are pre-filtered, to convert MODEL_*,VIEW_* and PKIT_* tags
# corresponding TMPL_ tags, and to run HTML::Clean
# 2. template objects are loaded and stored on disk or in memory, in
# a hash containing fields from the following set:
# * exclude_params - array ref of lists of params to be excluded from <PKIT_SELFURL> tags
# * html_template - HTML::Template object
# * template_toolkit - Template-Tookit object (NOT USED NOW)
# * filename - filename of template source
# * include_mtimes - a hash ref with file names as keys and mtimes as values
# (contains all of the files included by the <PKIT_COMPONENT> tags
# * component_ids - an array ref containing an array ref of component_ids and a hash ref
# with the parameters for the compoent, that may have
# code associated with them
# * has_form - 1 if contains <form> tag, 0 otherwise. used to
# determine whether to apply HTML::FillInForm module
# the objects themselves are keyed by page_id, pkit_view and lang
# 3. methods that are called externally
# * new($view_dir, $content_dir, $cache_dir, $default_lang, $reload, $html_clean_level, $can_edit, [ $associated_objects ], [ $fillinform_objects], $input_param_object, $output_param_object) (args passed as hash reference)
# * fill_in_view($page_id, $pkit_view, $lang)
# * open_view($page_id, $pkit_view, $lang)
# * param
# * preparse_templates($view_root,$html_clean_level,$view_cache_dir);
# * template_file_exists($page_id, $pkit_view)
# 4. methods that are called interally
# * _fetch_from_file_cache($page_id, $pkit_view, $lang);
# * _prepare_content($template_text_ref, $page_id)
# * _fill_in_content($template_text_ref, $page_id)
# * _fill_in_content_loop(...)
# * _load_page($page_id, $pkit_view, [$template_file])
# these global vars are initialised and then they are readonly!
# this is done here mainly for speed.
#use vars qw /%replace_start_tags %replace_end_tags $key_value_pattern/;
our (%replace_start_tags, %replace_end_tags, $key_value_pattern);
%replace_start_tags = (
MESSAGES => '<TMPL_LOOP NAME="PKIT_MESSAGES">',
IS_ERROR => '<TMPL_IF NAME="PKIT_IS_ERROR">',
NOT_ERROR => '<TMPL_UNLESS NAME="PKIT_IS_ERROR">',
HAVE_MESSAGES => '<TMPL_IF NAME="PKIT_MESSAGES">',
HAVE_NOT_MESSAGES => '<TMPL_UNLESS NAME="PKIT_MESSAGES">',
HOSTNAME => '<TMPL_VAR NAME="PKIT_HOSTNAME">',
MESSAGE => '<TMPL_VAR NAME="PKIT_MESSAGE">',
ERRORSTR => '<TMPL_VAR NAME="PKIT_ERRORSTR">',
REALURL => '<TMPL_VAR NAME="PKIT_REALURL">',
);
%replace_end_tags = (
VIEW => '</TMPL_IF>',
IS_ERROR => '</TMPL_IF>',
NOT_ERROR => '</TMPL_UNLESS>',
HAVE_MESSAGES => '</TMPL_IF>',
HAVE_NOT_MESSAGES => '</TMPL_UNLESS>',
MESSAGES => '</TMPL_LOOP>'
);
# --------------------- $1 --------------------------
# $2 $3 $4 $5
$key_value_pattern = qr!(\s+(\w+)(?:\s*=\s*(?:"([^"]*)"|\'([^\']*)\'|(\w+)))?)!; #"
$Apache::PageKit::View::cache_component = {};
# precompiled re to parse PKIT_COMMENT tags in a ballanced way.
my %re_helper;
%re_helper = (
std_parser => {
pkit_comment_re => qr%
\<PKIT_COMMENT\>
(?:
(?>[^\<]+)
| \<(?!PKIT_COMMENT\>)(?!\/PKIT_COMMENT\>) #/
| (??{$re_helper{std_parser}->{pkit_comment_re}})
)*
\<\/PKIT_COMMENT\> #/
%isx
},
relaxed_parser => {
pkit_comment_re => qr%
\<(!--)?\s*PKIT_COMMENT\s*(?(1)--)\>
(?:
(?>[^\<]+)
| \<
(?!(!--)?\s*PKIT_COMMENT\s*(?(2)--)\>)
(?!(!--)?\s*\/PKIT_COMMENT\s*(?(3)--)\>) #/
| (??{$re_helper{relaxed_parser}->{pkit_comment_re}})
)*
\<(!--)?\/PKIT_COMMENT\s*(?(4)--)\> #/
%isx
}
);
sub new {
my $class = shift;
my $self = { @_ };
bless $self, $class;
# $self->_init(@_);
return $self;
}
sub fill_in_view {
my ($view) = @_;
# load record containing HTML::Template object
my $record = $view->{record};
my $tmpl = $record->{html_template};
# Fill in (compiled) <PKIT_SELFURL> tags
my $exclude_params_set = $record->{exclude_params_set};
if($exclude_params_set && @$exclude_params_set){
my $input_param_object = $view->{input_param_object};
my $orig_uri = $input_param_object->notes('orig_uri');
foreach my $exclude_params (@$exclude_params_set){
my @exclude_params = split(" ",$exclude_params);
my $query_string = Apache::PageKit::params_as_string($input_param_object, \@exclude_params);
#remove empty parameters as arised from http://ka.zyx.de/galerie?show=abc& or <PKIT_SELFURL>
$query_string =~ s![?&]$!!;
if($query_string){
$tmpl->param("pkit_selfurl$exclude_params", ($orig_uri . '?' . $query_string) . '&');
} else {
$tmpl->param("pkit_selfurl$exclude_params", $orig_uri . '?');
}
}
}
# fill in data from associated objects (for example from the Apache request
# object if $apr is set
foreach my $object (@{$view->{associated_objects}}){
foreach my $key ($object->param){
# note that we only fill in MODEL_VARs, to avoid errors when setting
# loops in HTML::Template
my $type = $tmpl->query(name => $key);
if ( $type && $type eq 'VAR' ) {
$view->{pkit_pk}->{browser_cache} = 'no';
# we need a separate variable for value to force scalar context
# for multivalued params http://www.xx.yy/a?foo=12&foo=13
my $value = $object->param($key);
$tmpl->param($key, $value);
}
}
}
# finally, we use the $output_param_object object to fill in template
# get params from $view object
# note that in this case we allow for MODEL_LOOPs as well as MODEL_VARs
my $output_param_object = $view->{output_param_object};
foreach my $key ($output_param_object->param){
my $value = $output_param_object->param($key);
$view->{pkit_pk}->{browser_cache} = 'no';
$tmpl->param($key, $value);
}
my $output = $tmpl->output;
if($record->{has_form}){
# if fillinform_objects is set, then we use that to fill in any HTML
# forms in the template.
my $fif;
if(@{$view->{fillinform_objects}}){
$view->{pkit_pk}->{browser_cache} = 'no';
$fif = HTML::FillInForm->new();
$output = $fif->fill(scalarref => \$output,
fobject => $view->{fillinform_objects},
ignore_fields => $view->{ignore_fillinform_fields}
);
}
}
if($view->{can_edit} eq 'yes'){
$view->{pkit_pk}->{browser_cache} = 'no';
Apache::PageKit::Edit::add_edit_links($view, $record, \$output);
}
return \$output;
}
# gets static gzipped file, creating it if necessary
sub get_static_gzip {
my ($view, $filename) = @_;
my ($gzip_mtime, $gzipped_content);
(my $relative_filename = $filename) =~ s!^$view->{view_dir}/!!;
my $gzipped_filename = "$view->{cache_dir}/$relative_filename.gz";
# is the cache entry valid or changed on disc?
if(-f "$gzipped_filename"){
open FH, "<$gzipped_filename" or return undef;
binmode FH;
# read mtime from first line
chomp($gzip_mtime = <FH>);
# read rest of gzipped content
local $/ = undef;
$gzipped_content = <FH>;
close FH;
if($view->{reload} ne 'no'){
# is the cache entry valid or changed on disc?
my $mtime = ( stat($filename) )[9];
if($mtime != $gzip_mtime){
$gzipped_content = $view->_create_static_zip($filename, $gzipped_filename);
}
}
} else {
$gzipped_content = $view->_create_static_zip($filename, $gzipped_filename);
}
return $gzipped_content;
}
# opens template, each
sub open_view {
my ($view, $page_id, $pkit_view, $lang) = @_;
return if exists $view->{already_loaded}->{$page_id};
my $record = $view->_fetch_from_file_cache($page_id, $pkit_view, $lang);
unless($record){
# template not cached, load now
$view->_load_page($page_id, $pkit_view);
$record = $view->_fetch_from_file_cache($page_id, $pkit_view, $lang);
die "Error loading record for page_id $page_id and view $pkit_view"
unless $record;
}
if($view->{reload} ne 'no'){
# check for updated files on disk
unless($view->_is_record_uptodate($record, $pkit_view, $page_id)){
# one of the included files changed on disk, reload
$view->_load_page($page_id, $pkit_view);
$record = $view->_fetch_from_file_cache($page_id, $pkit_view, $lang);
}
}
$view->{record} = $record;
$view->{already_loaded}->{$page_id} = 1;
}
sub preparse_templates {
my ($view) = @_;
my $view_dir = $view->{view_dir};
my $load_template_sub = sub {
return unless /\.tmpl$/;
my $template_file = "$File::Find::dir/$_";
my ($pkit_view, $page_id) =
($template_file =~ m!$view_dir/([^/]*)/Page/(.*?)\.(tmpl|tt)$!);
return unless $page_id;
$view->open_view($page_id, $pkit_view);
};
File::Find::find({wanted => $load_template_sub},
# follow => 1},
$view_dir);
}
sub template_file_exists {
my ($view, $page_id, $pkit_view) = @_;
return 1 if $view->_find_template($pkit_view,$page_id);
}
# private methods
# creates gzipped file
sub _create_static_zip {
my ($view, $filename, $gzipped_filename) = @_;
local $/ = undef;
open FH, "<$filename" or return undef;
binmode FH;
my $content = <FH>;
close FH;
$view->_html_clean(\$content);
my $gzipped_content = Compress::Zlib::memGzip($content);
(my $gzipped_dir = $gzipped_filename) =~ s!(/)?[^/]*?$!!;
File::Path::mkpath("$gzipped_dir");
if ($gzipped_content) {
my $mtime = (stat($filename))[9];
if ( open GZIP, ">$gzipped_filename" ) {
binmode GZIP;
print GZIP "$mtime\n";
print GZIP $gzipped_content;
close GZIP;
} else {
warn "can not create gzip cache file $view->{cache_dir}/$gzipped_filename: $!";
}
return $gzipped_content;
}
return undef;
}
sub _fetch_from_file_cache {
my ($view, $page_id, $pkit_view, $lang) = @_;
my ($extra_param, $param_hash) = ("", "");
# get a list of requested params in the *.xsl file
if (my @xml_params = sort keys %{$Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id}}) {
my $param_obj = $view->{input_param_object};
for my $xml_param (@xml_params){
my $value = $param_obj->param($xml_param) || '';
$extra_param .= "&$xml_param=" . $value;
}
$param_hash = Digest::MD5::md5_hex($extra_param);
}
my $cache_filename = "$view->{cache_dir}/$page_id.$pkit_view.$lang$param_hash";
if(-f "$cache_filename"){
# cache file exists for specified language
return Storable::lock_retrieve($cache_filename);
} else {
$cache_filename = "$view->{cache_dir}/$page_id.$pkit_view.$view->{default_lang}$param_hash";
if(-f "$cache_filename"){
# cache file exists for default language
return Storable::lock_retrieve($cache_filename);
} else {
return;
}
}
}
sub _find_template {
my ($view, $pkit_view, $id) = @_;
my $template_file = "$view->{view_dir}/$pkit_view/$id.tmpl";
if(-f "$template_file"){
return $template_file;
} else {
$template_file = "$view->{view_dir}/Default/$id.tmpl";
if(-f "$template_file"){
return $template_file;
} else {
return undef;
}
}
}
# clean up html, remove white spaces, etc
sub _html_clean {
my ($view, $html_code_ref) = @_;
my $html_clean_level = $view->{html_clean_level};
return unless $html_clean_level > 0;
my $h = new HTML::Clean($html_code_ref,$html_clean_level) || die("can not open HTML::Clean object: $!");
$h->strip;
$$html_code_ref = ${$h->data()};
}
sub _include_components {
my ($view, $page_id, $html_code_ref, $pkit_view) = @_;
if ( $view->{relaxed_parser} eq 'yes' ) {
$$html_code_ref =~ s%<(!--)?\s*PKIT_COMPONENT($key_value_pattern+)\s*/?(?(1)--)?>(?:<(!--)?\s*/PKIT_COMPONENT\s*(?(1)--)>)?%get_component($page_id,$2,$view,$pkit_view)%eig;
} else {
$$html_code_ref =~ s%<\s*PKIT_COMPONENT($key_value_pattern+)\s*/?>(<\s*/PKIT_COMPONENT\s*>)?%&get_component($page_id,$1,$view,$pkit_view)%eig;
}
sub get_component {
my ($page_id, $params, $view, $pkit_view) = @_;
my %params = ();
while($params =~ m!$key_value_pattern!ig) {
$params{uc($2)} = $+;
}
my $component_id = delete $params{NAME} or die qq{component item "NAME=..." not found};
unless($component_id =~ s!^/!!){
# relative component, component relative to page_id
(my $page_id_dir = $page_id) =~ s![^/]*$!!;
$component_id = $page_id_dir . $component_id;
while ($component_id =~ s![^/]*/\.\./!!) {};
}
my $cid_key = join '', $component_id, sort %params;
unless ( $view->{component_ids_hash}->{$cid_key}++ ) {
push @{ $view->{component_ids} }, [ $component_id , \%params ];
}
# check for recursive pkit_components
if($view->{component_ids_hash}->{$cid_key} > 100){
die "Likely recursive PKIT_COMPONENTS for component_id $component_id and giving up.";
}
my $template_ref = $view->_load_component($page_id, $component_id, $pkit_view, \%params);
return $$template_ref;
}
}
sub _is_record_uptodate {
my ($view, $record, $pkit_view, $page_id) = @_;
# first check timestamps
my $include_mtimes = $record->{include_mtimes};
while (my ($filename, $cache_mtime) = each %$include_mtimes){
# check if file still exists
unless(-f "$filename"){
return 0;
}
# check if file is up to date
my $file_mtime = (stat($filename))[9];
# print "hi $filename - $cache_mtime - $file_mtime<br>";
if($file_mtime != $cache_mtime){
return 0;
}
if($filename =~ m!^$view->{view_dir}/Default/! && $pkit_view ne 'Default'){
# check to see if any new files have been uploaded to the $pkit_view dir
(my $check_filename = $filename) =~ s!^$view->{view_dir}/Default/!$view->{view_dir}/$pkit_view/!;
if (-f "$check_filename"){
return 0;
}
}
}
# record up to date!
return 1;
}
# here the usage of "component" also includes page
sub _load_component {
my ($view, $page_id, $component_id, $pkit_view, $component_params) = @_;
my $template_file = $view->_find_template($pkit_view, $component_id);
my $template_ref;
unless($template_file){
# no template file exists, attempt to generate from XML and XSL files
# currently only XML::LibXSLT is supported
$template_ref = $view->{content}->generate_template($page_id, $component_id, $pkit_view, $view->{input_param_object}, $component_params);
} else {
open TEMPLATE, "<$template_file" or die "can not read $template_file";
binmode TEMPLATE;
local($/) = undef;
my $template = <TEMPLATE>;
close TEMPLATE;
# expand PKIT_MACRO tags
$template =~ s!<\s*PKIT_MACRO$key_value_pattern\s*/?>!$component_params->{uc($+)} || ''!egi;
$template_ref = \$template;
my $mtime = (stat(_))[9];
$view->{include_mtimes}->{$template_file} = $mtime;
}
if($view->{can_edit} eq 'yes'){
Apache::PageKit::Edit::add_component_edit_stubs($view, $page_id, $template_ref, $pkit_view);
}
$view->_include_components($page_id,$template_ref,$pkit_view);
return $template_ref;
}
sub _load_page {
my ($view, $page_id, $pkit_view) = @_;
$Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id} = {};
my $content = $view->{content} ||= Apache::PageKit::Content->new(
content_dir => $view->{content_dir},
view_dir => $view->{view_dir},
default_lang => $view->{default_lang},
relaxed_parser => $view->{relaxed_parser},
template_class => $view->{template_class},
);
$view->{lang_tmpl} = $content->{lang_tmpl} = {};
$content->{include_mtimes} = {};
$view->{component_ids_hash} = {};
# we add Config.xml to the hash of files to be checked for mtimes,
# in case default_input_charset or default_output_charset changes!
(my $config_file = $view->{view_dir}) =~ s!/View$!/Config/Config.xml!;
my $config_mtime = ( stat($config_file) )[9];
$view->{include_mtimes} = {$config_file => $config_mtime};
my $template_file = $view->_find_template($pkit_view, $page_id);
my $template_ref = $view->_load_component($page_id,$page_id,$pkit_view);
# remove PKIT_COMMENT parts.
my $pkit_comment_re = $re_helper{ $view->{relaxed_parser} eq 'yes' ? 'relaxed_parser' : 'std_parser' }->{pkit_comment_re};
$$template_ref =~ s/$pkit_comment_re//sgi;
# my $template_file = $view->_find_template($pkit_view, $page_id);
my ( $lang_tmpl, $skip_xpath_content ) = $content->process_template($page_id, $template_ref);
# find the right converter for perl < 5.8.0
# if we skip the xpath content, the string is in $default_input_charset.
# otherwise it is in utf8 ( from libxml2 )
my $converter;
my $default_output_charset = $view->{default_output_charset};
if ( $skip_xpath_content ) {
my $default_input_charset = $view->{default_input_charset};
unless ( lc $default_input_charset eq lc $default_output_charset) {
eval {
$converter = Text::Iconv->new( $default_input_charset, $default_output_charset );
};
if ($@) {
(my $config_dir = $view->{content_dir}) =~ s!/Content$!/Config!;
die "The conversion from ($default_input_charset => $default_output_charset) is not supported by Text::Iconv please check file ${config_dir}/Config.xml";
}
}
else {
unless ( /^utf-?8$/i =~ $default_output_charset) {
eval {
$converter = Text::Iconv->new( 'utf8', $default_output_charset);
};
if ($@) {
(my $config_dir = $view->{content_dir}) =~ s!/Content$!/Config!;
die "The conversion from ('utf8' => $default_output_charset) is not supported by Text::Iconv please check file ${config_dir}/Config.xml";
}
}
}
}
# add used content file(s) to the mtimes hash
while( my ( $file, $mtime ) = each( %{ $content->{include_mtimes} } ) ) {
$view->{include_mtimes}->{$file} = $mtime;
}
# go through content files (which have had content filled in)
while (my ($lang, $filtered_html) = each %$lang_tmpl){
if ( $converter ) {
$$filtered_html = $converter->convert($$filtered_html) || die "Can not convert page from 'something' to $default_output_charset" if $$filtered_html;
}
my $exclude_params_set = $view->_preparse_model_tags($filtered_html);
$view->_html_clean($filtered_html);
my $has_form = ($$filtered_html =~ m!<form!i);
my $tmpl;
eval {
$tmpl = $view->{template_class}->new(scalarref => $filtered_html,
# don't die when we set a parameter that is not in the template
die_on_bad_params=>0,
# built in __FIRST__, __LAST__, etc vars
loop_context_vars=>1,
max_includes => 50,
global_vars=>1);
};
if($@){
die "Can not load template (MODEL TAGS) for $page_id: $@"
}
my $record = {
exclude_params_set => $exclude_params_set,
filename => $template_file,
html_template => $tmpl,
include_mtimes => $view->{include_mtimes},
component_ids => $view->{component_ids},
has_form => $has_form,
};
# make directories, if approriate
(my $dir = $page_id) =~ s!(/)?[^/]*?$!!;
if($dir){
File::Path::mkpath("$view->{cache_dir}/$dir");
}
my ($extra_param, $param_hash) = ("", "");
# get a list of requested params in the *.xsl file
if (my @xml_params = sort keys %{$Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id}}) {
my $param_obj = $view->{input_param_object};
for my $xml_param (@xml_params){
my $value = $param_obj->param($xml_param) || '';
$extra_param .= "&$xml_param=" . $value;
}
$param_hash = Digest::MD5::md5_hex($extra_param);
}
# Store record
Storable::lock_store($record, "$view->{cache_dir}/$page_id.$pkit_view.$lang$param_hash");
}
# include mtimes and component_ids are filled in by _include_components
# and _fill_in_content
delete $view->{include_mtimes};
delete $view->{lang_tmpl};
delete $view->{component_ids_hash};
}
sub _preparse_model_tags {
use bytes;
my ( $view, $html_code_ref ) = @_;
my $exclude_params_set = {};
# "compile" PageKit templates into HTML::Templates
if ( $view->{relaxed_parser} eq 'yes' ) {
# new parser
# the new parser is a lot more flexible over the old one. it can parse
# <MODEL_VAR NAME=abc>
# <MODEL_VAR NAME=abc/>
# <MODEL_VAR NAME=abc />
# < MODEL_VAR NAME=abc >
# <!-- MODEL_VAR NAME=abc -->
# <!--MODEL_VAR NAME=abc -->
# <!-- MODEL_VAR NAME=abc /-->
# all these are valid and expanded. it is slower than the old one but if it works relaible
if ( $$html_code_ref =~ m%<(!--)?\s*PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*\s*/?(?(1)--)>%i ) {
warn "PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated. use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
}
# remove tags
# tags generated by XSLT
$$html_code_ref =~ s%<(!--)?\s*/(?:MODEL|PKIT)_VAR\s*(?(1)--)>%%sig;
# translate end to tmpl
$$html_code_ref =~ s%<(!--)?\s*/(?:MODEL|PKIT)_(LOOP|IF|UNLESS)\s*(?(1)--)>%</TMPL_$2>%sig;
# XML-style stand-alone tags and other start tags
$$html_code_ref =~ s%<(!--)?\s*(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)\s*/?(?(1)--)>%<TMPL_$2$3>%sig;
$$html_code_ref =~
s^<(!--)?\s*PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?\s*(?(1)--)>(.*?)<(!--)?\s*/PKIT_ERROR(?:FONT|SPAN)\s*(?(8)--)>^
my $name = $4 || $5 || $6 || $3;
if ( $name ) {
qq{<TMPL_VAR NAME="PKIT_ERRORSPAN_BEGIN_$name">$7<TMPL_VAR NAME="PKIT_ERRORSPAN_END_$name">};
} else {
my $text = $7;
( my $errorspan_begin_tag = $view->{errorspan_begin_tag} ) =~ s/<(!--)?\s*PKIT_ERRORSTR\s*(?(1)--)>/$view->{default_errorstr}/gi;
$errorspan_begin_tag . $text . $view->{errorspan_end_tag}
} ^seig;
$$html_code_ref =~
s%<(!--)?\s*PKIT_SELFURL$key_value_pattern?\s*/?(?(1)--)>% &process_selfurl_tag($exclude_params_set, $4 || $5 || $6 || $3 ) %seig;
$$html_code_ref =~ s%<(!--)?\s*/PKIT_(VIEW|IS_ERROR|NOT_ERROR|MESSAGES|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>% $replace_end_tags{uc($2)} %seig;
$$html_code_ref =~ s%<(!--)?\s*PKIT_(MESSAGES|IS_ERROR|NOT_ERROR|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>% $replace_start_tags{uc($2)} %seig;
$$html_code_ref =~ s%<(!--)?\s*PKIT_(HOSTNAME|MESSAGE|ERRORSTR|REALURL)\s*/?(?(1)--)>% $replace_start_tags{uc($2)} %seig;
$$html_code_ref =~
s^<(!--)?\s*PKIT_VIEW$key_value_pattern\s*/?(?(1)--)>^ sprintf '<TMPL_IF NAME="PKIT_VIEW:%s">', $4 || $5 || $6 || $3; ^sieg; #"
}
else {
if ( $$html_code_ref =~ m%<PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*/?>%i ) {
warn "PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated. use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_HAVE_MESSAGES, PKIT_NOT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
}
# remove tags
# tags generated by XSLT
$$html_code_ref =~ s%</(?:MODEL|PKIT)_VAR>%%sig;
# translate end to tmpl
$$html_code_ref =~ s%</(?:MODEL|PKIT)_(LOOP|IF|UNLESS)>%</TMPL_$1>%sig;
# XML-style stand-alone tags and other start tags
$$html_code_ref =~ s%<(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)/?>%<TMPL_$1$2>%sig;
$$html_code_ref =~
s^<PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?>(.*?)</PKIT_ERROR(?:FONT|SPAN)>^
my $name = $3 || $4 || $5 || $2;
if ( $name ) {
qq{<TMPL_VAR NAME="PKIT_ERRORSPAN_BEGIN_$name">$6<TMPL_VAR NAME="PKIT_ERRORSPAN_END_$name">};
} else {
my $text = $6;
( my $errorspan_begin_tag = $view->{errorspan_begin_tag} ) =~ s/<PKIT_ERRORSTR>/$view->{default_errorstr}/gi;
$errorspan_begin_tag . $text . $view->{errorspan_end_tag}
} ^seig;
$$html_code_ref =~
s%<PKIT_SELFURL$key_value_pattern?/?>% &process_selfurl_tag($exclude_params_set, $3 || $4 || $5 || $2 ) %seig;
$$html_code_ref =~ s%</PKIT_(VIEW|IS_ERROR|NOT_ERROR|MESSAGES|HAVE_MESSAGES|HAVE_NOT_MESSAGES)>% $replace_end_tags{uc($1)} %seig;
$$html_code_ref =~ s%<PKIT_(MESSAGES|IS_ERROR|NOT_ERROR|HAVE_MESSAGES|HAVE_NOT_MESSAGES)>% $replace_start_tags{uc($1)}%seig;
$$html_code_ref =~ s%<PKIT_(HOSTNAME|MESSAGE|ERRORSTR|REALURL)/?>%$replace_start_tags{uc($1)}%seig;
$$html_code_ref =~
s^<PKIT_VIEW$key_value_pattern/?>^ sprintf '<TMPL_IF NAME="PKIT_VIEW:%s">', $3 || $4 || $5 || $2; ^sieg; #"
}
my @a = keys %$exclude_params_set;
return \@a;
sub process_selfurl_tag {
my ( $exclude_params_set, $exclude_params ) = @_;
$exclude_params = defined($exclude_params) ? join ( " ", sort split ( /\s+/, $exclude_params ) ) : "";
$exclude_params_set->{$exclude_params} = 1;
return qq{<TMPL_VAR NAME="pkit_selfurl$exclude_params">};
}
}
1;
package Apache::PageKit::View::TT2;
use strict;
#use vars qw /@ISA $key_value_pattern %replace_start_tags %replace_end_tags/;
our (@ISA, $key_value_pattern, %replace_start_tags, %replace_end_tags);
@ISA = 'Apache::PageKit::View';
*key_value_pattern = \$Apache::PageKit::View::key_value_pattern;
%replace_start_tags = (
MESSAGES => '[% FOREACH pkit_messages %]',
IS_ERROR => '[% IF pkit_is_error %]',
NOT_ERROR => '[% UNLESS pkit_is_error %]',
HAVE_MESSAGES => '[% IF pkit_messages %]',
HAVE_NOT_MESSAGES => '[% UNLESS pkit_messages %]',
HOSTNAME => '[% pkit_hostname %]',
MESSAGE => '[% pkit_message %]',
ERRORSTR => '[% pkit_errorstr %]',
REALURL => '[% pkit_realurl %]',
);
%replace_end_tags = (
VIEW => '[% END %]',
IS_ERROR => '[% END %]',
NOT_ERROR => '[% END %]',
HAVE_MESSAGES => '[% END %]',
HAVE_NOT_MESSAGES => '[% END %]',
MESSAGES => '[% END %]'
);
sub new {
require Template;
require Template::Parser;
require Template::Context;
return shift->SUPER::new(@_);
}
sub fill_in_view {
my ($view) = @_;
# load record containing Template Toolkit object
my $record = $view->{record};
my %tt_params;
# Fill in (compiled) <PKIT_SELFURL> tags
my $exclude_params_set = $record->{exclude_params_set};
if ( $exclude_params_set && @$exclude_params_set ) {
my $input_param_object = $view->{input_param_object};
my $orig_uri = $input_param_object->notes->get('orig_uri');
foreach my $exclude_params (@$exclude_params_set) {
my @exclude_params = split ( " ", $exclude_params );
my $query_string = Apache::PageKit::params_as_string( $input_param_object, \@exclude_params );
#remove empty parameters as arised from http://ka.zyx.de/galerie?show=abc& or <PKIT_SELFURL>
$query_string =~ s![?&]$!!;
if ($query_string) {
$tt_params{"pkit_selfurl$exclude_params"} = ( $orig_uri . '?' . $query_string ) . '&';
}
else {
$tt_params{"pkit_selfurl$exclude_params"} = $orig_uri . '?';
}
}
}
# fill in data from associated objects (for example from the Apache request
# object if $apr is set
foreach my $object ( @{ $view->{associated_objects} } ) {
foreach my $key ( $object->param ) {
$view->{pkit_pk}->{browser_cache} = 'no';
# we need a separate variable for value to force scalar context
# for multivalued params http://www.xx.yy/a?foo=12&foo=13
my $value = $object->param($key);
$tt_params{$key} = $value;
}
}
# finally, we use the $output_param_object object to fill in template
# get params from $view object
# note that in this case we allow for MODEL_LOOPs as well as MODEL_VARs
my $output_param_object = $view->{output_param_object};
foreach my $key ( $output_param_object->param ) {
my $value = $output_param_object->param($key);
$view->{pkit_pk}->{browser_cache} = 'no';
$tt_params{$key} = $value;
}
my $output = Template::Context->new->process(Template::Document->new( $record->{filtered_html} ), \%tt_params );
if ( $record->{has_form} ) {
# if fillinform_objects is set, then we use that to fill in any HTML
# forms in the template.
my $fif;
if ( @{ $view->{fillinform_objects} } ) {
$view->{pkit_pk}->{browser_cache} = 'no';
$fif = HTML::FillInForm->new();
$output = $fif->fill(
scalarref => \$output,
fobject => $view->{fillinform_objects},
ignore_fields => $view->{ignore_fillinform_fields}
);
}
}
if ( $view->{can_edit} eq 'yes' ) {
$view->{pkit_pk}->{browser_cache} = 'no';
Apache::PageKit::Edit::add_edit_links( $view, $record, \$output );
}
return \$output;
}
######################################################
sub _load_page {
my ( $view, $page_id, $pkit_view ) = @_;
# solange HTML::Template::XPath noch nichts mit Tempate Toolkit anfangen kann,
# HTML::Template verwenden.
my $content_template_class = $view->{template_class};
$content_template_class = 'HTML::Template' if $content_template_class eq 'Template';
my $content = $view->{content} ||= Apache::PageKit::Content->new(
content_dir => $view->{content_dir},
view_dir => $view->{view_dir},
default_lang => $view->{default_lang},
relaxed_parser => $view->{relaxed_parser},
template_class => $content_template_class,
);
$view->{lang_tmpl} = $content->{lang_tmpl} = {};
$content->{include_mtimes} = {};
$view->{component_ids_hash} = {};
# we add Config.xml to the hash of files to be checked for mtimes,
# in case default_input_charset or default_output_charset changes!
( my $config_file = $view->{view_dir} ) =~ s!/View$!/Config/Config.xml!;
my $config_mtime = ( stat($config_file) )[9];
$view->{include_mtimes} = { $config_file => $config_mtime };
my $template_file = $view->_find_template( $pkit_view, $page_id );
my $template_ref = $view->_load_component( $page_id, $page_id, $pkit_view );
# remove PKIT_COMMENT parts.
my $pkit_comment_re = $re_helper{ $view->{relaxed_parser} eq 'yes' ? 'relaxed_parser' : 'std_parser' }->{pkit_comment_re};
$$template_ref =~ s/$pkit_comment_re//sgi;
# my $template_file = $view->_find_template($pkit_view, $page_id);
my ( $lang_tmpl, $skip_xpath_content ) = $content->process_template($page_id, $template_ref);
# find the right converter for perl < 5.8.0
# if we skip the xpath content, the string is in $default_input_charset.
# otherwise it is in utf8 ( from libxml2 )
my $converter;
my $default_output_charset = $view->{default_output_charset};
if ( $skip_xpath_content ) {
my $default_input_charset = $view->{default_input_charset};
unless ( lc $default_input_charset eq lc $default_output_charset) {
eval {
$converter = Text::Iconv->new( $default_input_charset, $default_output_charset );
};
if ($@) {
(my $config_dir = $view->{content_dir}) =~ s!/Content$!/Config!;
die "The conversion from ($default_input_charset => $default_output_charset) is not supported by Text::Iconv please check file ${config_dir}/Config.xml";
}
}
else {
unless ( /^utf-?8$/i =~ $default_output_charset) {
eval {
$converter = Text::Iconv->new( 'utf8', $default_output_charset);
};
if ($@) {
(my $config_dir = $view->{content_dir}) =~ s!/Content$!/Config!;
die "The conversion from ('utf8' => $default_output_charset) is not supported by Text::Iconv please check file ${config_dir}/Config.xml";
}
}
}
}
# add used content file(s) to the mtimes hash
while ( my ( $file, $mtime ) = each( %{ $content->{include_mtimes} } ) ) {
$view->{include_mtimes}->{$file} = $mtime;
}
# go through content files (which have had content filled in)
while ( my ( $lang, $filtered_html ) = each %$lang_tmpl ) {
if ($converter) {
$$filtered_html = $converter->convert($$filtered_html)
|| die "Can not convert page from 'something' to $default_output_charset"
if $$filtered_html;
}
my $exclude_params_set = $view->_preparse_model_tags($filtered_html);
$view->_html_clean($filtered_html);
my $has_form = ( $$filtered_html =~ m!<form!i );
my $tt_parser = Template::Parser->new;
my $record = {
exclude_params_set => $exclude_params_set,
filename => $template_file,
include_mtimes => $view->{include_mtimes},
component_ids => $view->{component_ids},
has_form => $has_form,
filtered_html => $tt_parser->parse($$filtered_html) || die $tt_parser->error(),
};
# make directories, if approriate
( my $dir = $page_id ) =~ s!(/)?[^/]*?$!!;
if ($dir) {
File::Path::mkpath("$view->{cache_dir}/$dir");
}
my ( $extra_param, $param_hash ) = ( "", "" );
# get a list of requested params in the *.xsl file
if ( my @xml_params = sort keys %{ $Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id} } ) {
my $param_obj = $view->{input_param_object};
for my $xml_param (@xml_params) {
my $value = $param_obj->param($xml_param) || '';
$extra_param .= "&$xml_param=" . $value;
}
$param_hash = Digest::MD5::md5_hex($extra_param);
}
# Store record
Storable::lock_store( $record, "$view->{cache_dir}/$page_id.$pkit_view.$lang$param_hash" );
}
# include mtimes and component_ids are filled in by _include_components
# and _fill_in_content
delete $view->{include_mtimes};
delete $view->{lang_tmpl};
delete $view->{component_ids_hash};
}
sub _preparse_model_tags {
use bytes;
my ( $view, $html_code_ref ) = @_;
my $exclude_params_set = {};
# "compile" PageKit templates into HTML::Templates
if ( $view->{relaxed_parser} eq 'yes' ) {
# new parser
# the new parser is a lot more flexible over the old one. it can parse
# <MODEL_VAR NAME=abc>
# <MODEL_VAR NAME=abc/>
# <MODEL_VAR NAME=abc />
# < MODEL_VAR NAME=abc >
# <!-- MODEL_VAR NAME=abc -->
# <!--MODEL_VAR NAME=abc -->
# <!-- MODEL_VAR NAME=abc /-->
# all these are valid and expanded. it is slower than the old one but if it works relaible
if ( $$html_code_ref =~ m%<(!--)?\s*PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*\s*/?(?(1)--)>%i ) {
warn
"PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated. use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
}
# remove tags
# tags generated by XSLT
$$html_code_ref =~ s%<(!--)?\s*/(?:MODEL|PKIT)_VAR\s*(?(1)--)>%%sig;
# translate end to tmpl
$$html_code_ref =~ s~<(!--)?\s*/(?:MODEL|PKIT)_(LOOP|IF|UNLESS)\s*(?(1)--)>~[% END %]~sig;
# XML-style stand-alone tags and other start tags
$$html_code_ref =~ s~<(!--)?\s*(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)\s*/?(?(1)--)>~
my $type = uc($2);
if ( $type eq 'VAR' ) {
$type = '';
} elsif ( $type eq 'LOOP' ) {
$type = 'FOREACH';
}
qq{[\% $type $2 \%]};
~esig;
$$html_code_ref =~
s^<(!--)?\s*PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?\s*(?(1)--)>(.*?)<(!--)?\s*/PKIT_ERROR(?:FONT|SPAN)\s*(?(8)--)>^
my $name = $4 || $5 || $6 || $3;
if ( $name ) {
qq{[\% PKIT_ERRORSPAN_BEGIN_$name \%]${7}[\% PKIT_ERRORSPAN_END_$name \%]};
} else {
my $text = $7;
( my $errorspan_begin_tag = $view->{errorspan_begin_tag} ) =~ s/<(!--)?\s*PKIT_ERRORSTR\s*(?(1)--)>/$view->{default_errorstr}/gi;
$errorspan_begin_tag . $text . $view->{errorspan_end_tag};
} ^seig;
$$html_code_ref =~
s%<(!--)?\s*PKIT_SELFURL$key_value_pattern?\s*/?(?(1)--)>% &process_selfurl_tag($exclude_params_set, $4 || $5 || $6 || $3 ) %seig;
$$html_code_ref =~
s%<(!--)?\s*/PKIT_(VIEW|IS_ERROR|NOT_ERROR|MESSAGES|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>% $replace_end_tags{uc($2)} %seig;
$$html_code_ref =~
s%<(!--)?\s*PKIT_(MESSAGES|IS_ERROR|NOT_ERROR|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>% $replace_start_tags{uc($2)} %seig;
$$html_code_ref =~
s%<(!--)?\s*PKIT_(HOSTNAME|MESSAGE|ERRORSTR|REALURL)\s*/?(?(1)--)>% $replace_start_tags{uc($2)} %seig;
$$html_code_ref =~
s^<(!--)?\s*PKIT_VIEW$key_value_pattern\s*/?(?(1)--)>^ sprintf '[%% IF PKIT_VIEW#%s %%]', $4 || $5 || $6 || $3; ^sieg
; #"
}
else {
if ( $$html_code_ref =~ m%<PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*/?>%i ) {
warn
"PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated. use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_HAVE_MESSAGES, PKIT_NOT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
}
# remove tags
# tags generated by XSLT
$$html_code_ref =~ s%</(?:MODEL|PKIT)_VAR>%%sig;
# translate end to tmpl
$$html_code_ref =~ s~</(?:MODEL|PKIT)_(LOOP|IF|UNLESS)>~[% END %]~sig;
# XML-style stand-alone tags and other start tags
$$html_code_ref =~ s!<(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)/?>!
{
my $type = uc($1);
if ( $type eq 'VAR' ) {
$type = '';
} elsif ( $type eq 'LOOP' ) {
$type = 'FOREACH';
}
my $out = $2;
if ( $out =~ m/NAME\s*=\s*"([^"]*)"/i ) {
$out = $1;
}
qq{[\% $type $out \%]}
}!esig;
$$html_code_ref =~ s^<PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?>(.*?)</PKIT_ERROR(?:FONT|SPAN)>^
my $name = $3 || $4 || $5 || $2;
if ( $name ) {
qq{[\% PKIT_ERRORSPAN_BEGIN_$name \%]${6}[\% PKIT_ERRORSPAN_END_$name \%]};
} else {
my $text = $6;
( my $errorspan_begin_tag = $view->{errorspan_begin_tag} ) =~ s/<PKIT_ERRORSTR>/$view->{default_errorstr}/gi;
$errorspan_begin_tag . $text . $view->{errorspan_end_tag}
} ^seig;
$$html_code_ref =~
s%<PKIT_SELFURL$key_value_pattern?/?>% &process_selfurl_tag_tt($exclude_params_set, $3 || $4 || $5 || $2 ) %seig;
$$html_code_ref =~
s%</PKIT_(VIEW|IS_ERROR|NOT_ERROR|MESSAGES|HAVE_MESSAGES|HAVE_NOT_MESSAGES)>% $replace_end_tags{uc($1)} %seig;
$$html_code_ref =~
s%<PKIT_(MESSAGES|IS_ERROR|NOT_ERROR|HAVE_MESSAGES|HAVE_NOT_MESSAGES)>% $replace_start_tags{uc($1)}%seig;
$$html_code_ref =~ s%<PKIT_(HOSTNAME|MESSAGE|ERRORSTR|REALURL)/?>%$replace_start_tags{uc($1)}%seig;
$$html_code_ref =~ s^<PKIT_VIEW$key_value_pattern/?>^ sprintf '[%% IF PKIT_VIEW#%s %%]', $3 || $4 || $5 || $2; ^sieg; #"
}
my @a = keys %$exclude_params_set;
return \@a;
sub process_selfurl_tag_tt {
my ( $exclude_params_set, $exclude_params ) = @_;
$exclude_params = defined($exclude_params) ? join ( " ", sort split ( /\s+/, $exclude_params ) ) : "";
$exclude_params_set->{$exclude_params} = 1;
return qq{[\% pkit_selfurl$exclude_params \%]};
}
}
1;