OK, a few things, one a bug fix, and two are extra patches that
modify how Apache::Template works.
First, the bug fix.
DIR_MERGE and SERVER_MERGE were calling the _merge function which
was merging config directives, but _merge wasn't checking for
duplicates, so each file in, for example, PRE_ and POST_PROCESS
was being processed 2 times. I added a small utility function
called _uniq which returns the unique elements of a list.
Here's the sub, with an example:
sub _uniq {
my %uniq;
UNIVERSAL::isa($_[0], 'ARRAY') &&
return grep { ++$uniq{$_} == 1 } @{$_[0]};
}
my $f = [ qw(a b a c a d a e a f) ];
print map "$_\n", _uniq($f);
a
b
c
d
e
f
This change only affects _mergs(), so DIR_MERGE and SERVER_MERGE
benefit immediately.
Secondly, I posted a few patches two weeks ago or so that made
Template::Service::Apache behave pretty differently from how it
does by default:
1) walk the directory tree to look for included files, rather
than rely on a set INCLUDE_PATH.
2) Modify the return from Template::Service::Apache::params
to return sub references rather than data structures.
I've re-examined these patches and redone them.
I realized that the ROOT_PROVIDER object stored within $SERVICE
and created during Template::Service::Apache::_init() was there
only so that ABSOLUTE would not have to be set for all templates
(security risk, and all that). With the tree walking, however,
ABSOLUTE does not need to be set. In this patch, the
ROOT_PROVIDER object is eliminated, along with
Template::Service::Apache::template() (it wasn't needed anymore).
I modified what params() returns. In my previous patch, I was Doing
Funny Things with @_ before calling the appropriate
Apache::Request methods, but this is a lot of work. Compare:
my $p = {
params => sub {
my $p = shift;
if (@_) {
$r->param($p, shift);
}
return $r->param($p);
},
};
and
my $p = {
params => sub { $r->param(@_) },
};
The functionality of the second one isn't subject to my
introduction of bugs. :)
Well, the diffs are attached. They should be patched against the
distributed Apache::Template and Template::Service::Apache, not
versions thereof which had my previous diffs patched in (sorry
about that for anyone who actually used my other patches).
I've looked over these new files, and they look OK to me, but
the resulting (patched) modules need to be examined by someone
who wasn't involved in writing them. I am confident that the
functionality of Apache::Template will remain unchanged with
these patches applied, but it's nice to have confirmation...
(darren)
--
It seemed the world was divided into good and bad people. The good
ones slept better... while the bad ones seemed to enjoy the waking
hours much more.
-- Woody Allen
--- Template.pm.orig Fri Jun 15 09:36:25 2001
+++ Template.pm Tue Jul 3 15:49:15 2001
@@ -78,13 +78,14 @@
};
};
- my $template = $SERVICE->template($r);
- return $template unless ref $template;
+ $SERVICE->include_path($r->filename);
+ (my $template = $r->filename) =~ s:.*/::;
my $params = $SERVICE->params($r);
return $params unless ref $params;
my $content = $SERVICE->process($template, $params);
+ $r->warn(" *** Processed \$template ", $r->filename);
unless (defined $content) {
$r->log_reason($SERVICE->error(), $r->filename());
return SERVER_ERROR;
@@ -422,7 +423,7 @@
if(!ref $parent->{$key}) {
$merged->{$key} = $parent->{$key};
} elsif (ref $parent->{$key} eq 'ARRAY') {
- $merged->{$key} = [ @{$parent->{$key}} ];
+ $merged->{$key} = [ _uniq($parent->{$key}) ];
} elsif (ref $parent->{$key} eq 'HASH') {
$merged->{$key} = { %{$parent->{$key}} };
} elsif (ref $parent->{$key} eq 'SCALAR') {
@@ -434,7 +435,7 @@
if(!ref $config->{$key}) {
$merged->{$key} = $config->{$key};
} elsif (ref $config->{$key} eq 'ARRAY') {
- push @{$merged->{$key} ||= []}, @{$config->{$key}};
+ $merged->{$key} = [ _uniq([ @{$config->{$key}}, @{$parent->{$key}} ]) ];
} elsif (ref $config->{$key} eq 'HASH') {
$merged->{$key} = { %{$merged->{$key}}, %{$config->{$key}} };
} elsif (ref $config->{$key} eq 'SCALAR') {
@@ -444,6 +445,12 @@
return $merged;
}
+sub _uniq {
+ my %uniq;
+ UNIVERSAL::isa($_[0], 'ARRAY') &&
+ return grep { ++$uniq{$_} == 1 } @{$_[0]};
+}
+
# debug methods for testing problems with DIR_MERGE, etc.
sub dump_hash {
--- Apache.pm.orig Fri Jun 15 09:36:25 2001
+++ Apache.pm Tue Jul 3 15:50:24 2001
@@ -39,7 +39,6 @@
$DEBUG = 0 unless defined $DEBUG;
use Apache::Util qw(escape_uri ht_time);
-use Apache::Constants qw( :common );
use Apache::Request;
#========================================================================
@@ -47,54 +46,6 @@
#========================================================================
#------------------------------------------------------------------------
-# template($request)
-#
-# Fetch root template document from the ROOT_PROVIDER using the
-# request filename. Returns a reference to a Template::Document
-# object on success or a DECLINED status code if not found. On error,
-# the relevant error message is logged and SERVER_ERROR is returned.
-#------------------------------------------------------------------------
-
-sub template {
- my ($self, $r) = @_;
- my $filename = $r->filename();
-
- return DECLINED unless -f $filename;
- $self->{ TEMPLATE_ERROR } = undef;
-
- my ($template, $error) = $self->{ ROOT_PROVIDER }->fetch($filename);
- if ($error == &Template::Constants::STATUS_DECLINED) {
- return DECLINED;
- }
- elsif ($error) {
- # save error as exception for params() to add to template vars
- $self->{ TEMPLATE_ERROR } = Template::Exception->new(
- Template::Constants::ERROR_FILE, $template);
-
- # if there is an ERROR template defined then we attempt to
- # fetch it as a substitute for the original template. Note
- # that we must fetch it from the regular template providers
- # in the Template::Context because they honour the INCLUDE_PATH
- # parameters whereas the ROOT_PROVIDER expects an absolute file
-
- if ($template = $self->{ ERROR }) {
- eval { $template = $self->{ CONTEXT }->template($template) };
- if ($@) {
- $r->log_reason($self->{ TEMPLATE_ERROR } . " / $@", $filename);
- return SERVER_ERROR;
- }
- }
- else {
- $r->log_reason($template, $filename);
- return SERVER_ERROR;
- }
- }
-
- return $template;
-}
-
-
-#------------------------------------------------------------------------
# params($request, $params)
#
# Create a set of processing parameters (i.e. template variables) for
@@ -111,17 +62,21 @@
return $params unless keys %$plist;
$r = Apache::Request->new($r);
- $params->{ env } = apache_table_to_hash( $r->subprocess_env() )
- if $all or $plist->{ env };
+ $params->{ env } = sub { $r->subprocess_env(@_) }
+ if ($all or $plist->{ env });
+
$params->{ uri } = $r->subprocess_env('REDIRECT_URL') || $r->uri()
if $all or $plist->{ uri };
- $params->{ pnotes } = $r->pnotes()
- if $all or $plist->{ pnotes };
- $params->{ params } = apache_table_to_hash( $r->parms() )
- if $all or $plist->{ params };
+
+ $params->{ pnotes } = sub { return $r->pnotes(@_) }
+ if ($all or $plist->{ pnotes });
+
+ $params->{ params } = sub { $r->param(@_) }
+ if ($all or $plist->{ params });
+
$params->{ cookies } = {
- map { $1 => escape_uri($2) if (/([^=]+)=(.*)/) }
- grep(!/^$/, split(/;\s*/, $r->header_in('cookie'))),
+ map { escape_uri($1) => escape_uri($2) if (/([^=]+)=(.*)/) }
+ grep !/^$/, split /;\s*/, $r->header_in('cookie')
} if $all or $plist->{ cookies };
# add any error raised by main template failure
@@ -152,24 +107,6 @@
$r->send_http_header;
}
-
-#------------------------------------------------------------------------
-# apache_table_to_hash($table)
-#
-# Converts an Apache::Table (tied hash) to a regular hash array. This
-# is necessary because calling for a non-existent element of the table
-# causes Perl to generate a "method not found" error.
-#
-# Needs to be more robust to handle multi-value fields.
-#------------------------------------------------------------------------
-
-sub apache_table_to_hash {
- my $table = shift || return { };
- return { %{ $table } };
-}
-
-
-
#------------------------------------------------------------------------
# _init()
#
@@ -191,22 +128,13 @@
$config->{ PARSER } ||= Template::Config->parser($config)
|| return $self->error(Template::Config->error());
- # create a provider for the root document
- my $rootcfg = {
- ABSOLUTE => 1,
- map { exists $config->{ $_ } ? ($_, $config->{ $_ }) : () }
- qw( COMPILE_DIR COMPILE_EXT CACHE_SIZE PARSER ),
- };
-
- my $rootprov = Template::Config->provider($rootcfg)
+ my $provider = Template::Config->provider($config)
|| return $self->error(Template::Config->error());
- # now let the Template::Service superclass initialiser continue
- $self->SUPER::_init($config)
- || return undef;
+ $config->{ LOAD_TEMPLATES } = $provider;
- # save reference to root document provider
- $self->{ ROOT_PROVIDER } = $rootprov;
+ # now let the Template::Service superclass initialiser continue
+ $self->SUPER::_init($config) || return;
# extract other relevant SERVICE_* config items
foreach (qw( SERVICE_HEADERS SERVICE_PARAMS )) {
@@ -214,7 +142,46 @@
$self->{ $_ } = { map { $_ => 1 } @$item };
}
+ # Create an accessor method to update $normprov's include path
+ unless (defined &include_path) {
+ *include_path = sub {
+ my ($self, $filename) = @_;
+ my $paths = $self->_inc_path($filename);
+ $provider->include_path($paths);
+ }
+ }
+
return $self;
}
+#------------------------------------------------------------------------
+# _inc_path($filename)
+#
+# This creates a list of directories to be returned to the provider,
+# and specifies how provider searches for included files. This hack
+# makes the provider walk up the directory hierarchy to find the
+# closest occurance of a file to include. This facilitates, for
+# example, putting different headers and footers at various places
+# along the tree.
+#------------------------------------------------------------------------
+sub _inc_path ($) {
+ my $class = shift;
+ my $f = shift;
+ my %uniq;
+ my @dir;
+ local $" = '/';
+
+ #
+ # This bit of code returns a reference to a list of directories,
+ # sorted in reverse order by length, starting from the directory
+ # in which the translated filename lives, and ending with /.
+ #
+ return [
+ sort { length $b <=> length $a } # reverse sorted by length
+ grep { ++$uniq{$_} == 1 } # (unique directories only)
+ map { push @dir, $_; "/@dir"; } # a growing list of dirs
+ ($f =~ m:([^/]+)/:og) # gathered from the current
+ ]; # translated filename
+}
+
1;
