[Templates-cvs] cvs commit: TT3/lib/Template Context.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Fri, 10 Dec 2004 14:53:34 +0000
cvs 04/12/10 14:53:34
Modified: lib/Template Context.pm
Log:
* Template::Context is now subclassed from Template::Scope
Revision Changes Path
1.7 +36 -298 TT3/lib/Template/Context.pm
Index: Context.pm
===================================================================
RCS file: /template-toolkit/TT3/lib/Template/Context.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- Context.pm 2004/12/01 17:58:48 1.6
+++ Context.pm 2004/12/10 14:53:34 1.7
@@ -16,7 +16,7 @@
# modify it under the same terms as Perl itself.
#
# REVISION
-# $Id: Context.pm,v 1.6 2004/12/01 17:58:48 abw Exp $
+# $Id: Context.pm,v 1.7 2004/12/10 14:53:34 abw Exp $
#
#========================================================================
@@ -24,9 +24,10 @@
use strict;
use warnings;
-use Template::Exception;
-use Template::Base;
-use base qw( Template::Base );
+use Template::Resources;
+use Template::Resource::Template;
+use Template::Scope;
+use base qw( Template::Scope );
# providers can define a fetch($context, $item) method which expects a
# component reference passed as the first argument, or a get($item)
@@ -35,41 +36,31 @@
use constant FETCH => 'fetch';
use constant GET => 'get';
-our $VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
our $DEBUG = 0 unless defined $DEBUG;
our $ERROR = '';
our $THROW = 'context';
-our $EXCEPTION = 'Template::Exception';
-our $MAX_DEPTH = 64;
+our $RESOURCES = 'Template::Resources' unless defined $RESOURCES;
+our $EXCEPTION = 'Template::Exception' unless defined $EXCEPTION;
-#========================================================================
-# constructor, initialisation, accessors and other housekeeping methods.
-#========================================================================
-
#------------------------------------------------------------------------
# init()
#
# Initialisation method called by base class new() constructor method.
-# Takes some, or others of the following options, all of which is still
-# subject to minor change.
-# id / name / path / time # general purpose identifiers
-# depth # internal depth counter
#------------------------------------------------------------------------
sub init {
my ($self, $config) = @_;
+
+ # copy all keys in
@$self{ keys %$config } = values %$config;
- $self->{ depth } ||= 0;
- # 'visited' flag should be upgraded to array ref
- $self->{ visited } = [ ]
- if $self->{ visited }
- && ! UNIVERSAL::isa($self->{ visited }, 'ARRAY');
+ $self->{ resources } = $config->{ resources }
+ || $self->pkgvar( RESOURCES => $RESOURCES );
- # TMP HACK
- $self->{ name } = '[anon]' unless defined $self->{ name };
+ $self->debug("created resource: $self->{ resources }\n") if $DEBUG;
return $self;
}
@@ -77,227 +68,13 @@
# not sure if we need all these... how about an AUTOLOAD that walks
# the right chains?
+
sub id { $_[0]->{ id } }
sub name { $_[0]->{ name } }
sub path { $_[0]->{ path } }
sub time { $_[0]->{ time } }
-#------------------------------------------------------------------------
-# locate($resource)
-#
-# Walk up the component/parent/caller chains looking for any $type items.
-#------------------------------------------------------------------------
-
-sub locate {
- my ($self, $resource) = @_;
- my $debug = $self->{ DEBUG };
- my $locations;
-
- $self->debug("locate($resource)\n") if $debug;
-
- if ($locations = $self->{ locations }->{ $resource }) {
- $self->debug(" - using cached locations\n") if $debug;
- }
- else {
- my @contexts = ($self);
- my ($name, $context, $items, @many_items, $next);
- my $depth = 1;
-
- $self->debug(" - locating... \n") if $debug;
-
- local $self->{ THROW } = "context.locate.$resource";
-
- $locations = $self->{ locations }->{ $resource } = [ ];
-
- # walk the context 'parent' chain upwards
-
- # TODO: should we keep track of those contexts we've seen?
- # Would prevent runaway from loops in parent chain.
-
- CONTEXT: while ($context = shift @contexts) {
- if ($items = $context->{ $resource }) {
- $self->debug(" - located context $resource: $items\n")
- if $debug;
-
- @many_items = ($items);
-
- ITEMS: while (@many_items) {
- $items = shift @many_items;
-
- # TODO: undef might indicate error, hard decline,
- # something else, but for now we ignore it like a
- # coward (same also goes for '0')
- next ITEMS unless defined $items;
-
- if (UNIVERSAL::isa($items, 'ARRAY')) {
- # expand the contents of a reference to a list
- unshift(@many_items, @$items);
- }
- else {
- # otherwise push whatever it is onto the locations
- push(@$locations, $items);
- }
- }
- }
-
- # unshift parent onto pending context list
- # TODO: we may want to search other chains, e.g. caller, etc.
- unshift(@contexts, $context->{ parent })
- if $context->{ parent };
-
- # in theory we should never allow the context tree to
- # grow beyond $MAX_DEPTH, but you can't be too careful
- # TODO: this should probably throw the error
- return $self->error("maximum search depth ($MAX_DEPTH) reached")
- if $depth++ > $MAX_DEPTH;
- }
- }
-
- return $locations;
-}
-
-
-#------------------------------------------------------------------------
-# unlocate($resource)
-#
-# Remove any cached locations for a particular resource.
-#------------------------------------------------------------------------
-
-sub unlocate {
- my ($self, $resource) = @_;
- delete $self->{ locations }->{ $resource };
-}
-
-
-#------------------------------------------------------------------------
-# find($resource, $name)
-#
-# Search the locations of the specified resource for an item named $name.
-#------------------------------------------------------------------------
-
-sub find {
- my ($self, $resource, $name, @opts) = @_;
- my $debug = $self->{ DEBUG };
- my $item;
-
- $self->debug("find($resource, $name)\n") if $debug;
-
- # We first fetch a collection of all possible locations of
- # the resource type in question. Each of these locations
- # can be a hash ref, a provider object or subroutine. We
- # "Do The Right Thing" to see if the location contains the
- # named resource and return it if it does.
-
- my $locations = $self->{ locations }->{ $resource }
- || $self->locate($resource) || return;
-
- my ($items, $method);
- $self->{ DECLINED } = 0;
-
- # provide a useful exception type for errors thrown
- local $self->{ THROW } = "context.find.$resource.$name";
-
- foreach $items (@$locations) {
- $self->debug(" - location: $items\n") if $debug;
-
- if (ref($items) eq 'HASH') {
- # look for the item in the hash. A value can be
- # explicitly set to undef to indicated that the variable
- # is undefined, masking any previously set value for the
- # variable in a parent content. This only works in hash
- # references because it's the only one we can test
- # exists() on, for all others, we expect a defined value
- if (exists $items->{ $name }) {
- $item = $items->{ $name };
- last;
- }
- }
- elsif ($method = UNIVERSAL::can($items, FETCH)) {
- # call fetch() method on provider, passing $self
- last if defined ($item = &$method($items, $self, $name, @opts));
- }
- elsif ($method = UNIVERSAL::can($items, GET)) {
- # call get() method, without passing $self
- last if defined ($item = &$method($items, $name, @opts));
- }
- elsif (UNIVERSAL::isa($items, 'CODE')) {
- # call subroutine to fetch it, passing $self as first
- # argument so that subroutine can behave like a method
- last if defined ($item = &$items($self, $name, @opts));
- }
- else {
- return $self->error("invalid $resource collection: $items");
- }
- }
-
- return defined $item
- ? $item
- : $self->decline("not found in $resource: $name");
-}
-
-
-#------------------------------------------------------------------------
-# resource($name)
-#------------------------------------------------------------------------
-
-sub resource {
- my ($self, $name) = @_;
-
- $self->debug("resource($name)\n") if $DEBUG;
-
- return $self->{ resource }->{ $name }
- ||= $self->find( resources => $name )
- || $self->decline("resource not found: $name");
-}
-
-
-#------------------------------------------------------------------------
-# fetch( $resource, $name, @args)
-#------------------------------------------------------------------------
-
-sub fetch {
- my ($self, $type, $name, @args) = @_;
-
- $self->debug("fetch($type, $name)\n") if $DEBUG;
-
- # get the manager for the resource $type
- my $resource = $self->{ resource }->{ $type }
- || $self->resource( $type ) || return;
-
- # call the resource's fetch() method, passing $self as first argument
- my $result = $resource->fetch($self, $name, @args);
-
- return defined $result
- ? $result
- : $self->decline($resource->error());
-}
-
-
-
-#------------------------------------------------------------------------
-# store( $resource, $name, @args)
-#------------------------------------------------------------------------
-
-sub store {
- my ($self, $type, $name, @args) = @_;
-
- # get the manager for the resource $type
- my $resource = $self->{ resource }->{ $type }
- || $self->resource( $type ) || return;
-
- # call the resource's store() method, passing $self as first argument
- my $result = $resource->store($self, $name, @args);
-
- return defined $result
- ? $result
- : $self->decline($resource->error());
-
-}
-
-
-
-
sub catch {
my ($self, $error, $output) = @_;
@@ -312,77 +89,38 @@
}
-#------------------------------------------------------------------------
-# attach($parent)
-#
-# Attach the current context to the parent context passed as an argument.
-#------------------------------------------------------------------------
-
-sub attach {
- my ($self, $parent) = @_;
-
- return $self->error('context is already attached to a parent')
- if $self->{ parent };
-
- $self->{ parent } = $parent;
-
- # delete any cache of previously discovered resource locations
- delete $self->{ locations };
-
- return $self;
-}
+#========================================================================
+# compiler() method previously defined in Template::Component
+# needs to be properly integrated in here, or defined in
+# Template::Resource::Compiler
+#========================================================================
#------------------------------------------------------------------------
-# detach()
+# compiler($name)
#
-# Detach the current context from its parent.
+# Search the compilers for one matching the name provided as an argument.
+# If $name is undefined then instead search for a 'default' compiler
+# which may return a compiler object or reference another by name
+# (e.g. default => 'tt3').
#------------------------------------------------------------------------
-sub detach {
+sub compiler {
my $self = shift;
-
- # delete cache of previously discovered resource locations
- delete $self->{ locations };
-
- # delete parent and return reference to it
- return delete $self->{ parent }
- || $self->error('context is not attached to a parent')
-}
-
-
-#------------------------------------------------------------------------
-# child($config)
-#
-# Create a new context object and attach it to the current context.
-#------------------------------------------------------------------------
+ my $name = shift || 'default';
+
+ # check to see if $name is already a compiler
+ if (ref $name) {
+ return UNIVERSAL::can($name, 'compile')
+ ? $name
+ : $self->error("invalid compiler reference: $name");
+ }
-sub child {
- my $self = shift;
- my $child = $self->new(@_) || return;
-
- # attach child to $self if $self is an object, but don't bother
- # if it's a class name
- return ref $self ? $child->attach($self) : $child;
+ return $self->{ compiler }->{ $name } ||= $self->find( compilers => $name )
+ || $self->decline("compiler not found: $name");
}
-#------------------------------------------------------------------------
-# parent()
-#
-# Return the parent context.
-#------------------------------------------------------------------------
-
-sub parent {
- my $self = shift;
-
- return $self->{ parent }
- || $self->error('context does not have a parent');
-}
-
-
-
-
1;
__END__
@@ -467,7 +205,7 @@
=head1 VERSION
-$Revision: 1.6 $
+$Revision: 1.7 $
=head1 COPYRIGHT