Файловый менеджер - Редактировать - /home/lakoyani/lakoyani.com.fj/Context.pm.tar
Назад
usr/local/lib64/perl5/Template/Context.pm 0000444 00000147116 14711271405 0014165 0 ustar 00 #============================================================= -*-Perl-*- # # Template::Context # # DESCRIPTION # Module defining a context in which a template document is processed. # This is the runtime processing interface through which templates # can access the functionality of the Template Toolkit. # # AUTHOR # Andy Wardley <abw@wardley.org> # # COPYRIGHT # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # #============================================================================ package Template::Context; use strict; use warnings; use base 'Template::Base'; use Template::Base; use Template::Config; use Template::Constants; use Template::Exception; use Scalar::Util 'blessed'; use constant DOCUMENT => 'Template::Document'; use constant EXCEPTION => 'Template::Exception'; use constant BADGER_EXCEPTION => 'Badger::Exception'; use constant MSWin32 => $^O eq 'MSWin32'; our $VERSION = '3.100'; our $DEBUG = 0 unless defined $DEBUG; our $DEBUG_FORMAT = "\n## \$file line \$line : [% \$text %] ##\n"; our $VIEW_CLASS = 'Template::View'; our $AUTOLOAD; #======================================================================== # ----- PUBLIC METHODS ----- #======================================================================== #------------------------------------------------------------------------ # template($name) # # General purpose method to fetch a template and return it in compiled # form. In the usual case, the $name parameter will be a simple string # containing the name of a template (e.g. 'header'). It may also be # a reference to Template::Document object (or sub-class) or a Perl # sub-routine. These are considered to be compiled templates and are # returned intact. Finally, it may be a reference to any other kind # of valid input source accepted by Template::Provider (e.g. scalar # ref, glob, IO handle, etc). # # Templates may be cached at one of 3 different levels. The internal # BLOCKS member is a local cache which holds references to all # template blocks used or imported via PROCESS since the context's # reset() method was last called. This is checked first and if the # template is not found, the method then walks down the BLOCKSTACK # list. This contains references to the block definition tables in # any enclosing Template::Documents that we're visiting (e.g. we've # been called via an INCLUDE and we want to access a BLOCK defined in # the template that INCLUDE'd us). If nothing is defined, then we # iterate through the LOAD_TEMPLATES providers list as a 'chain of # responsibility' (see Design Patterns) asking each object to fetch() # the template if it can. # # Returns the compiled template. On error, undef is returned and # the internal ERROR value (read via error()) is set to contain an # error message of the form "$name: $error". #------------------------------------------------------------------------ sub template { my ($self, $name) = @_; my ($prefix, $blocks, $defblocks, $provider, $template, $error); my ($shortname, $blockname, $providers); $self->debug("template($name)") if $self->{ DEBUG }; # references to Template::Document (or sub-class) objects, or # CODE references are assumed to be pre-compiled templates and are # returned intact return $name if (blessed($name) && $name->isa(DOCUMENT)) || ref($name) eq 'CODE'; $shortname = $name; unless (ref $name) { $self->debug("looking for block [$name]") if $self->{ DEBUG }; # we first look in the BLOCKS hash for a BLOCK that may have # been imported from a template (via PROCESS) return $template if ($template = $self->{ BLOCKS }->{ $name }); # then we iterate through the BLKSTACK list to see if any of the # Template::Documents we're visiting define this BLOCK foreach $blocks (@{ $self->{ BLKSTACK } }) { return $template if $blocks && ($template = $blocks->{ $name }); } # now it's time to ask the providers, so we look to see if any # prefix is specified to indicate the desired provider set. if (MSWin32) { # let C:/foo through $prefix = $1 if $shortname =~ s/^(\w{2,})://o; } else { $prefix = $1 if $shortname =~ s/^(\w+)://; } if (defined $prefix) { $providers = $self->{ PREFIX_MAP }->{ $prefix } || return $self->throw( Template::Constants::ERROR_FILE, "no providers for template prefix '$prefix'"); } } $providers = $self->{ PREFIX_MAP }->{ default } || $self->{ LOAD_TEMPLATES } unless $providers; # Finally we try the regular template providers which will # handle references to files, text, etc., as well as templates # reference by name. If $blockname = ''; while ($shortname) { $self->debug("asking providers for [$shortname] [$blockname]") if $self->{ DEBUG }; foreach my $provider (@$providers) { ($template, $error) = $provider->fetch($shortname, $prefix); if ($error) { if ($error == Template::Constants::STATUS_ERROR) { # $template contains exception object if (blessed($template) && $template->isa(EXCEPTION) && $template->type eq Template::Constants::ERROR_FILE) { $self->throw($template); } else { $self->throw( Template::Constants::ERROR_FILE, $template ); } } # DECLINE is ok, carry on } elsif (length $blockname) { return $template if $template = $template->blocks->{ $blockname }; } else { return $template; } } last if ref $shortname || ! $self->{ EXPOSE_BLOCKS }; $shortname =~ s{/([^/]+)$}{} || last; $blockname = length $blockname ? "$1/$blockname" : $1; } $self->throw(Template::Constants::ERROR_FILE, "$name: not found"); } #------------------------------------------------------------------------ # plugin($name, \@args) # # Calls on each of the LOAD_PLUGINS providers in turn to fetch() (i.e. load # and instantiate) a plugin of the specified name. Additional parameters # passed are propagated to the new() constructor for the plugin. # Returns a reference to a new plugin object or other reference. On # error, undef is returned and the appropriate error message is set for # subsequent retrieval via error(). #------------------------------------------------------------------------ sub plugin { my ($self, $name, $args) = @_; my ($provider, $plugin, $error); $self->debug("plugin($name, ", defined $args ? @$args : '[ ]', ')') if $self->{ DEBUG }; # request the named plugin from each of the LOAD_PLUGINS providers in turn foreach my $provider (@{ $self->{ LOAD_PLUGINS } }) { ($plugin, $error) = $provider->fetch($name, $args, $self); return $plugin unless $error; if ($error == Template::Constants::STATUS_ERROR) { $self->throw($plugin) if ref $plugin; $self->throw(Template::Constants::ERROR_PLUGIN, $plugin); } } $self->throw(Template::Constants::ERROR_PLUGIN, "$name: plugin not found"); } #------------------------------------------------------------------------ # filter($name, \@args, $alias) # # Similar to plugin() above, but querying the LOAD_FILTERS providers to # return filter instances. An alias may be provided which is used to # save the returned filter in a local cache. #------------------------------------------------------------------------ sub filter { my ($self, $name, $args, $alias) = @_; my ($provider, $filter, $error); $self->debug("filter($name, ", defined $args ? @$args : '[ ]', defined $alias ? $alias : '<no alias>', ')') if $self->{ DEBUG }; # use any cached version of the filter if no params provided return $filter if ! $args && ! ref $name && ($filter = $self->{ FILTER_CACHE }->{ $name }); # request the named filter from each of the FILTERS providers in turn foreach my $provider (@{ $self->{ LOAD_FILTERS } }) { ($filter, $error) = $provider->fetch($name, $args, $self); last unless $error; if ($error == Template::Constants::STATUS_ERROR) { $self->throw($filter) if ref $filter; $self->throw(Template::Constants::ERROR_FILTER, $filter); } # return $self->error($filter) # if $error == &Template::Constants::STATUS_ERROR; } return $self->error("$name: filter not found") unless $filter; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # commented out by abw on 19 Nov 2001 to fix problem with xmlstyle # plugin which may re-define a filter by calling define_filter() # multiple times. With the automatic aliasing/caching below, any # new filter definition isn't seen. Don't think this will cause # any problems as filters explicitly supplied with aliases will # still work as expected. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # alias defaults to name if undefined # $alias = $name # unless defined($alias) or ref($name) or $args; # cache FILTER if alias is valid $self->{ FILTER_CACHE }->{ $alias } = $filter if $alias; return $filter; } #------------------------------------------------------------------------ # view(\%config) # # Create a new Template::View bound to this context. #------------------------------------------------------------------------ sub view { my $self = shift; require Template::View; return $VIEW_CLASS->new($self, @_) || $self->throw(&Template::Constants::ERROR_VIEW, $VIEW_CLASS->error); } #------------------------------------------------------------------------ # process($template, \%params) [% PROCESS template var=val ... %] # process($template, \%params, $local) [% INCLUDE template var=val ... %] # # Processes the template named or referenced by the first parameter. # The optional second parameter may reference a hash array of variable # definitions. These are set before the template is processed by # calling update() on the stash. Note that, unless the third parameter # is true, the context is not localised and these, and any other # variables set in the template will retain their new values after this # method returns. The third parameter is in place so that this method # can handle INCLUDE calls: the stash will be localized. # # Returns the output of processing the template. Errors are thrown # as Template::Exception objects via die(). #------------------------------------------------------------------------ sub process { my ($self, $template, $params, $localize) = @_; my ($trim, $blocks) = @$self{ qw( TRIM BLOCKS ) }; my (@compiled, $name, $compiled); my ($stash, $component, $tblocks, $error, $tmpout); my $output = ''; $template = [ $template ] unless ref $template eq 'ARRAY'; $self->debug("process([ ", join(', '), @$template, ' ], ', defined $params ? $params : '<no params>', ', ', $localize ? '<localized>' : '<unlocalized>', ')') if $self->{ DEBUG }; # fetch compiled template for each name specified foreach $name (@$template) { push(@compiled, $self->template($name)); } if ($localize) { # localise the variable stash with any parameters passed $stash = $self->{ STASH } = $self->{ STASH }->clone($params); } else { # update stash with any new parameters passed $self->{ STASH }->update($params); $stash = $self->{ STASH }; } eval { # save current component eval { $component = $stash->get('component') }; foreach $name (@$template) { $compiled = shift @compiled; my $element = ref $compiled eq 'CODE' ? { (name => (ref $name ? '' : $name), modtime => time()) } : $compiled; if (blessed($component) && $component->isa(DOCUMENT)) { $element->{ caller } = $component->{ name }; $element->{ callers } = $component->{ callers } || []; push(@{$element->{ callers }}, $element->{ caller }); } $stash->set('component', $element); unless ($localize) { # merge any local blocks defined in the Template::Document # into our local BLOCKS cache @$blocks{ keys %$tblocks } = values %$tblocks if (blessed($compiled) && $compiled->isa(DOCUMENT)) && ($tblocks = $compiled->blocks); } if (ref $compiled eq 'CODE') { $tmpout = &$compiled($self); } elsif (ref $compiled) { $tmpout = $compiled->process($self); } else { $self->throw('file', "invalid template reference: $compiled"); } if ($trim) { for ($tmpout) { s/^\s+//; s/\s+$//; } } $output .= $tmpout; # pop last item from callers. # NOTE - this will not be called if template throws an # error. The whole issue of caller and callers should be # revisited to try and avoid putting this info directly into # the component data structure. Perhaps use a local element # instead? pop(@{$element->{ callers }}) if (blessed($component) && $component->isa(DOCUMENT)); } $stash->set('component', $component); }; $error = $@; if ($localize) { # ensure stash is delocalised before dying $self->{ STASH } = $self->{ STASH }->declone(); } $self->throw(ref $error ? $error : (Template::Constants::ERROR_FILE, $error)) if $error; return $output; } #------------------------------------------------------------------------ # include($template, \%params) [% INCLUDE template var = val, ... %] # # Similar to process() above but processing the template in a local # context. Any variables passed by reference to a hash as the second # parameter will be set before the template is processed and then # revert to their original values before the method returns. Similarly, # any changes made to non-global variables within the template will # persist only until the template is processed. # # Returns the output of processing the template. Errors are thrown # as Template::Exception objects via die(). #------------------------------------------------------------------------ sub include { my ($self, $template, $params) = @_; return $self->process($template, $params, 'localize me!'); } #------------------------------------------------------------------------ # insert($file) # # Insert the contents of a file without parsing. #------------------------------------------------------------------------ sub insert { my ($self, $file) = @_; my ($prefix, $providers, $text, $error); my $output = ''; my $files = ref $file eq 'ARRAY' ? $file : [ $file ]; $self->debug("insert([ ", join(', '), @$files, " ])") if $self->{ DEBUG }; FILE: foreach $file (@$files) { my $name = $file; if (MSWin32) { # let C:/foo through $prefix = $1 if $name =~ s/^(\w{2,})://o; } else { $prefix = $1 if $name =~ s/^(\w+)://; } if (defined $prefix) { $providers = $self->{ PREFIX_MAP }->{ $prefix } || return $self->throw(Template::Constants::ERROR_FILE, "no providers for file prefix '$prefix'"); } else { $providers = $self->{ PREFIX_MAP }->{ default } || $self->{ LOAD_TEMPLATES }; } foreach my $provider (@$providers) { ($text, $error) = $provider->load($name, $prefix); next FILE unless $error; if ($error == Template::Constants::STATUS_ERROR) { $self->throw($text) if ref $text; $self->throw(Template::Constants::ERROR_FILE, $text); } } $self->throw(Template::Constants::ERROR_FILE, "$file: not found"); } continue { $output .= $text; } return $output; } #------------------------------------------------------------------------ # throw($type, $info, \$output) [% THROW errtype "Error info" %] # # Throws a Template::Exception object by calling die(). This method # may be passed a reference to an existing Template::Exception object; # a single value containing an error message which is used to # instantiate a Template::Exception of type 'undef'; or a pair of # values representing the exception type and info from which a # Template::Exception object is instantiated. e.g. # # $context->throw($exception); # $context->throw("I'm sorry Dave, I can't do that"); # $context->throw('denied', "I'm sorry Dave, I can't do that"); # # An optional third parameter can be supplied in the last case which # is a reference to the current output buffer containing the results # of processing the template up to the point at which the exception # was thrown. The RETURN and STOP directives, for example, use this # to propagate output back to the user, but it can safely be ignored # in most cases. # # This method rides on a one-way ticket to die() oblivion. It does not # return in any real sense of the word, but should get caught by a # surrounding eval { } block (e.g. a BLOCK or TRY) and handled # accordingly, or returned to the caller as an uncaught exception. #------------------------------------------------------------------------ sub throw { my ($self, $error, $info, $output) = @_; local $" = ', '; # die! die! die! if (blessed($error) && $error->isa(EXCEPTION)) { die $error; } elsif (blessed($error) && $error->isa(BADGER_EXCEPTION)) { # convert a Badger::Exception to a Template::Exception so that # things continue to work during the transition to Badger die EXCEPTION->new($error->type, $error->info); } elsif (defined $info) { die (EXCEPTION->new($error, $info, $output)); } else { $error ||= ''; die (EXCEPTION->new('undef', $error, $output)); } # not reached } #------------------------------------------------------------------------ # catch($error, \$output) # # Called by various directives after catching an error thrown via die() # from within an eval { } block. The first parameter contains the error # which may be a sanitized reference to a Template::Exception object # (such as that raised by the throw() method above, a plugin object, # and so on) or an error message thrown via die from somewhere in user # code. The latter are coerced into 'undef' Template::Exception objects. # Like throw() above, a reference to a scalar may be passed as an # additional parameter to represent the current output buffer # localised within the eval block. As exceptions are thrown upwards # and outwards from nested blocks, the catch() method reconstructs the # correct output buffer from these fragments, storing it in the # exception object for passing further onwards and upwards. # # Returns a reference to a Template::Exception object.. #------------------------------------------------------------------------ sub catch { my ($self, $error, $output) = @_; if ( blessed($error) && ( $error->isa(EXCEPTION) || $error->isa(BADGER_EXCEPTION) ) ) { $error->text($output) if $output; return $error; } else { return EXCEPTION->new('undef', $error, $output); } } #------------------------------------------------------------------------ # localise(\%params) # delocalise() # # The localise() method creates a local copy of the current stash, # allowing the existing state of variables to be saved and later # restored via delocalise(). # # A reference to a hash array may be passed containing local variable # definitions which should be added to the cloned namespace. These # values persist until delocalisation. #------------------------------------------------------------------------ sub localise { my $self = shift; $self->{ STASH } = $self->{ STASH }->clone(@_); } sub delocalise { my $self = shift; $self->{ STASH } = $self->{ STASH }->declone(); } #------------------------------------------------------------------------ # visit($document, $blocks) # # Each Template::Document calls the visit() method on the context # before processing itself. It passes a reference to the hash array # of named BLOCKs defined within the document, allowing them to be # added to the internal BLKSTACK list which is subsequently used by # template() to resolve templates. # from a provider. #------------------------------------------------------------------------ sub visit { my ($self, $document, $blocks) = @_; unshift(@{ $self->{ BLKSTACK } }, $blocks) } #------------------------------------------------------------------------ # leave() # # The leave() method is called when the document has finished # processing itself. This removes the entry from the BLKSTACK list # that was added visit() above. For persistence of BLOCK definitions, # the process() method (i.e. the PROCESS directive) does some extra # magic to copy BLOCKs into a shared hash. #------------------------------------------------------------------------ sub leave { my $self = shift; shift(@{ $self->{ BLKSTACK } }); } #------------------------------------------------------------------------ # define_block($name, $block) # # Adds a new BLOCK definition to the local BLOCKS cache. $block may # be specified as a reference to a sub-routine or Template::Document # object or as text which is compiled into a template. Returns a true # value (the $block reference or compiled block reference) if # successful or undef on failure. Call error() to retrieve the # relevant error message (i.e. compilation failure). #------------------------------------------------------------------------ sub define_block { my ($self, $name, $block) = @_; $block = $self->template(\$block) || return undef unless ref $block; $self->{ BLOCKS }->{ $name } = $block; } #------------------------------------------------------------------------ # define_filter($name, $filter, $is_dynamic) # # Adds a new FILTER definition to the local FILTER_CACHE. #------------------------------------------------------------------------ sub define_filter { my ($self, $name, $filter, $is_dynamic) = @_; my ($result, $error); $filter = [ $filter, 1 ] if $is_dynamic; foreach my $provider (@{ $self->{ LOAD_FILTERS } }) { ($result, $error) = $provider->store($name, $filter); return 1 unless $error; $self->throw(&Template::Constants::ERROR_FILTER, $result) if $error == &Template::Constants::STATUS_ERROR; } $self->throw(&Template::Constants::ERROR_FILTER, "FILTER providers declined to store filter $name"); } #------------------------------------------------------------------------ # define_vmethod($type, $name, \&sub) # # Passes $type, $name, and &sub on to stash->define_vmethod(). #------------------------------------------------------------------------ sub define_vmethod { my $self = shift; $self->stash->define_vmethod(@_); } #------------------------------------------------------------------------ # define_view($name, $params) # # Defines a new view. #------------------------------------------------------------------------ sub define_view { my ($self, $name, $params) = @_; my $base; if (defined $params->{ base }) { my $base = $self->{ STASH }->get($params->{ base }); return $self->throw( &Template::Constants::ERROR_VIEW, "view base is not defined: $params->{ base }" ) unless $base; return $self->throw( &Template::Constants::ERROR_VIEW, "view base is not a $VIEW_CLASS object: $params->{ base } => $base" ) unless blessed($base) && $base->isa($VIEW_CLASS); $params->{ base } = $base; } my $view = $self->view($params); $view->seal(); $self->{ STASH }->set($name, $view); } #------------------------------------------------------------------------ # define_views($views) # # Defines multiple new views. #------------------------------------------------------------------------ sub define_views { my ($self, $views) = @_; # a list reference is better because the order is deterministic (and so # allows an earlier VIEW to be the base for a later VIEW), but we'll # accept a hash reference and assume that the user knows the order of # processing is undefined $views = [ %$views ] if ref $views eq 'HASH'; # make of copy so we don't destroy the original list reference my @items = @$views; my ($name, $view); while (@items) { $self->define_view(splice(@items, 0, 2)); } } #------------------------------------------------------------------------ # reset() # # Reset the state of the internal BLOCKS hash to clear any BLOCK # definitions imported via the PROCESS directive. Any original # BLOCKS definitions passed to the constructor will be restored. #------------------------------------------------------------------------ sub reset { my ($self, $blocks) = @_; $self->{ BLKSTACK } = [ ]; $self->{ BLOCKS } = { %{ $self->{ INIT_BLOCKS } } }; } #------------------------------------------------------------------------ # stash() # # Simple accessor methods to return the STASH values. This is likely # to be called quite often so we provide a direct method rather than # relying on the slower AUTOLOAD. #------------------------------------------------------------------------ sub stash { return $_[0]->{ STASH }; } #------------------------------------------------------------------------ # debugging($command, @args, \%params) # # Method for controlling the debugging status of the context. The first # argument can be 'on' or 'off' to enable/disable debugging, 'format' # to define the format of the debug message, or 'msg' to generate a # debugging message reporting the file, line, message text, etc., # according to the current debug format. #------------------------------------------------------------------------ sub debugging { my $self = shift; my $hash = ref $_[-1] eq 'HASH' ? pop : { }; my @args = @_; if (@args) { if ($args[0] eq '1' || lc($args[0]) eq 'on' ) { $self->{ DEBUG_DIRS } = 1; shift(@args); } elsif ($args[0] eq '0' || lc($args[0]) eq 'off') { $self->{ DEBUG_DIRS } = 0; shift(@args); } } if (@args) { if (lc($args[0]) eq 'msg') { return unless $self->{ DEBUG_DIRS }; my $format = $self->{ DEBUG_FORMAT }; $format = $DEBUG_FORMAT unless defined $format; $format =~ s/\$(\w+)/$hash->{ $1 }/ge; return $format; } elsif ( lc($args[0]) eq 'format' ) { $self->{ DEBUG_FORMAT } = $args[1]; } # else ignore } return ''; } #------------------------------------------------------------------------ # AUTOLOAD # # Provides pseudo-methods for read-only access to various internal # members. For example, templates(), plugins(), filters(), # eval_perl(), load_perl(), etc. These aren't called very often, or # may never be called at all. #------------------------------------------------------------------------ sub AUTOLOAD { my $self = shift; my $method = $AUTOLOAD; my $result; $method =~ s/.*:://; return if $method eq 'DESTROY'; warn "no such context method/member: $method\n" unless defined ($result = $self->{ uc $method }); return $result; } #------------------------------------------------------------------------ # DESTROY # # Stash may contain references back to the Context via macro closures, # etc. This breaks the circular references. #------------------------------------------------------------------------ sub DESTROY { my $self = shift; undef $self->{ STASH }; } #======================================================================== # -- PRIVATE METHODS -- #======================================================================== #------------------------------------------------------------------------ # _init(\%config) # # Initialisation method called by Template::Base::new() #------------------------------------------------------------------------ sub _init { my ($self, $config) = @_; my ($name, $item, $method, $block, $blocks); my @itemlut = ( LOAD_TEMPLATES => 'provider', LOAD_PLUGINS => 'plugins', LOAD_FILTERS => 'filters' ); # LOAD_TEMPLATE, LOAD_PLUGINS, LOAD_FILTERS - lists of providers while (($name, $method) = splice(@itemlut, 0, 2)) { $item = $config->{ $name } || Template::Config->$method($config) || return $self->error($Template::Config::ERROR); $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ]; } my $providers = $self->{ LOAD_TEMPLATES }; my $prefix_map = $self->{ PREFIX_MAP } = $config->{ PREFIX_MAP } || { }; while (my ($key, $val) = each %$prefix_map) { $prefix_map->{ $key } = [ ref $val ? $val : map { $providers->[$_] } split(/\D+/, $val) ] unless ref $val eq 'ARRAY'; } # STASH $self->{ STASH } = $config->{ STASH } || do { my $predefs = $config->{ VARIABLES } || $config->{ PRE_DEFINE } || { }; # hack to get stash to know about debug mode $predefs->{ _DEBUG } = ( ($config->{ DEBUG } || 0) & &Template::Constants::DEBUG_UNDEF ) ? 1 : 0 unless defined $predefs->{ _DEBUG }; $predefs->{ _STRICT } = $config->{ STRICT }; Template::Config->stash($predefs) || return $self->error($Template::Config::ERROR); }; # compile any template BLOCKS specified as text $blocks = $config->{ BLOCKS } || { }; $self->{ INIT_BLOCKS } = $self->{ BLOCKS } = { map { $block = $blocks->{ $_ }; $block = $self->template(\$block) || return undef unless ref $block; ($_ => $block); } keys %$blocks }; # define any VIEWS $self->define_views( $config->{ VIEWS } ) if $config->{ VIEWS }; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # RECURSION - flag indicating is recursion into templates is supported # EVAL_PERL - flag indicating if PERL blocks should be processed # TRIM - flag to remove leading and trailing whitespace from output # BLKSTACK - list of hashes of BLOCKs defined in current template(s) # CONFIG - original configuration hash # EXPOSE_BLOCKS - make blocks visible as pseudo-files # DEBUG_FORMAT - format for generating template runtime debugging messages # DEBUG - format for generating template runtime debugging messages $self->{ RECURSION } = $config->{ RECURSION } || 0; $self->{ EVAL_PERL } = $config->{ EVAL_PERL } || 0; $self->{ TRIM } = $config->{ TRIM } || 0; $self->{ BLKSTACK } = [ ]; $self->{ CONFIG } = $config; $self->{ EXPOSE_BLOCKS } = defined $config->{ EXPOSE_BLOCKS } ? $config->{ EXPOSE_BLOCKS } : 0; $self->{ DEBUG_FORMAT } = $config->{ DEBUG_FORMAT }; $self->{ DEBUG_DIRS } = ($config->{ DEBUG } || 0) & Template::Constants::DEBUG_DIRS; $self->{ DEBUG } = defined $config->{ DEBUG } ? $config->{ DEBUG } & ( Template::Constants::DEBUG_CONTEXT | Template::Constants::DEBUG_FLAGS ) : $DEBUG; return $self; } 1; __END__ =head1 NAME Template::Context - Runtime context in which templates are processed =head1 SYNOPSIS use Template::Context; # constructor $context = Template::Context->new(\%config) || die $Template::Context::ERROR; # fetch (load and compile) a template $template = $context->template($template_name); # fetch (load and instantiate) a plugin object $plugin = $context->plugin($name, \@args); # fetch (return or create) a filter subroutine $filter = $context->filter($name, \@args, $alias); # process/include a template, errors are thrown via die() $output = $context->process($template, \%vars); $output = $context->include($template, \%vars); # raise an exception via die() $context->throw($error_type, $error_message, \$output_buffer); # catch an exception, clean it up and fix output buffer $exception = $context->catch($exception, \$output_buffer); # save/restore the stash to effect variable localisation $new_stash = $context->localise(\%vars); $old_stash = $context->delocalise(); # add new BLOCK or FILTER definitions $context->define_block($name, $block); $context->define_filter($name, \&filtersub, $is_dynamic); # reset context, clearing any imported BLOCK definitions $context->reset(); # methods for accessing internal items $stash = $context->stash(); $tflag = $context->trim(); $epflag = $context->eval_perl(); $providers = $context->templates(); $providers = $context->plugins(); $providers = $context->filters(); ... =head1 DESCRIPTION The C<Template::Context> module defines an object class for representing a runtime context in which templates are processed. It provides an interface to the fundamental operations of the Template Toolkit processing engine through which compiled templates (i.e. Perl code constructed from the template source) can process templates, load plugins and filters, raise exceptions and so on. A default C<Template::Context> object is created by the L<Template> module. Any C<Template::Context> options may be passed to the L<Template> L<new()|Template#new()> constructor method and will be forwarded to the C<Template::Context> constructor. use Template; my $template = Template->new({ TRIM => 1, EVAL_PERL => 1, BLOCKS => { header => 'This is the header', footer => 'This is the footer', }, }); Similarly, the C<Template::Context> constructor will forward all configuration parameters onto other default objects (e.g. L<Template::Provider>, L<Template::Plugins>, L<Template::Filters>, etc.) that it may need to instantiate. $context = Template::Context->new({ INCLUDE_PATH => '/home/abw/templates', # provider option TAG_STYLE => 'html', # parser option }); A C<Template::Context> object (or subclass) can be explicitly instantiated and passed to the L<Template> L<new()|Template#new()> constructor method as the C<CONTEXT> configuration item. use Template; use Template::Context; my $context = Template::Context->new({ TRIM => 1 }); my $template = Template->new({ CONTEXT => $context }); The L<Template> module uses the L<Template::Config> L<context()|Template::Config#context()> factory method to create a default context object when required. The C<$Template::Config::CONTEXT> package variable may be set to specify an alternate context module. This will be loaded automatically and its L<new()> constructor method called by the L<context()|Template::Config#context()> factory method when a default context object is required. use Template; $Template::Config::CONTEXT = 'MyOrg::Template::Context'; my $template = Template->new({ EVAL_PERL => 1, EXTRA_MAGIC => 'red hot', # your extra config items ... }); =head1 METHODS =head2 new(\%params) The C<new()> constructor method is called to instantiate a C<Template::Context> object. Configuration parameters may be specified as a HASH reference or as a list of C<name =E<gt> value> pairs. my $context = Template::Context->new({ INCLUDE_PATH => 'header', POST_PROCESS => 'footer', }); my $context = Template::Context->new( EVAL_PERL => 1 ); The C<new()> method returns a C<Template::Context> object or C<undef> on error. In the latter case, a relevant error message can be retrieved by the L<error()|Template::Base#error()> class method or directly from the C<$Template::Context::ERROR> package variable. my $context = Template::Context->new(\%config) || die Template::Context->error(); my $context = Template::Context->new(\%config) || die $Template::Context::ERROR; The following configuration items may be specified. Please see L<Template::Manual::Config> for further details. =head3 VARIABLES The L<VARIABLES|Template::Manual::Config#VARIABLES> option can be used to specify a hash array of template variables. my $context = Template::Context->new({ VARIABLES => { title => 'A Demo Page', author => 'Joe Random Hacker', version => 3.14, }, }; =head3 BLOCKS The L<BLOCKS|Template::Manual::Config#BLOCKS> option can be used to pre-define a default set of template blocks. my $context = Template::Context->new({ BLOCKS => { header => 'The Header. [% title %]', footer => sub { return $some_output_text }, another => Template::Document->new({ ... }), }, }); =head3 VIEWS The L<VIEWS|Template::Manual::Config#VIEWS> option can be used to pre-define one or more L<Template::View> objects. my $context = Template::Context->new({ VIEWS => [ bottom => { prefix => 'bottom/' }, middle => { prefix => 'middle/', base => 'bottom' }, top => { prefix => 'top/', base => 'middle' }, ], }); =head3 TRIM The L<TRIM|Template::Manual::Config#TRIM> option can be set to have any leading and trailing whitespace automatically removed from the output of all template files and C<BLOCK>s. example: [% BLOCK foo %] Line 1 of foo [% END %] before [% INCLUDE foo %] after output: before Line 1 of foo after =head3 EVAL_PERL The L<EVAL_PERL|Template::Manual::Config#EVAL_PERL> is used to indicate if C<PERL> and/or C<RAWPERL> blocks should be evaluated. It is disabled by default. =head3 RECURSION The L<RECURSION|Template::Manual::Config#RECURSION> can be set to allow templates to recursively process themselves, either directly (e.g. template C<foo> calls C<INCLUDE foo>) or indirectly (e.g. C<foo> calls C<INCLUDE bar> which calls C<INCLUDE foo>). =head3 LOAD_TEMPLATES The L<LOAD_TEMPLATES|Template::Manual::Config#LOAD_TEMPLATES> option can be used to provide a reference to a list of L<Template::Provider> objects or sub-classes thereof which will take responsibility for loading and compiling templates. my $context = Template::Context->new({ LOAD_TEMPLATES => [ MyOrg::Template::Provider->new({ ... }), Template::Provider->new({ ... }), ], }); =head3 LOAD_PLUGINS The L<LOAD_PLUGINS|Template::Manual::Config#LOAD_PLUGINS> options can be used to specify a list of provider objects responsible for loading and instantiating template plugin objects. my $context = Template::Context->new({ LOAD_PLUGINS => [ MyOrg::Template::Plugins->new({ ... }), Template::Plugins->new({ ... }), ], }); =head3 LOAD_FILTERS The L<LOAD_FILTERS|Template::Manual::Config#LOAD_FILTERS> option can be used to specify a list of provider objects for returning and/or creating filter subroutines. my $context = Template::Context->new({ LOAD_FILTERS => [ MyTemplate::Filters->new(), Template::Filters->new(), ], }); =head3 STASH The L<STASH|Template::Manual::Config#STASH> option can be used to specify a L<Template::Stash> object or sub-class which will take responsibility for managing template variables. my $stash = MyOrg::Template::Stash->new({ ... }); my $context = Template::Context->new({ STASH => $stash, }); =head3 DEBUG The L<DEBUG|Template::Manual::Config#DEBUG> option can be used to enable various debugging features of the L<Template::Context> module. use Template::Constants qw( :debug ); my $template = Template->new({ DEBUG => DEBUG_CONTEXT | DEBUG_DIRS, }); =head2 template($name) Returns a compiled template by querying each of the L<LOAD_TEMPLATES> providers (instances of L<Template::Provider>, or sub-class) in turn. $template = $context->template('header'); On error, a L<Template::Exception> object of type 'C<file>' is thrown via C<die()>. This can be caught by enclosing the call to C<template()> in an C<eval> block and examining C<$@>. eval { $template = $context->template('header') }; if ($@) { print "failed to fetch template: $@\n"; } =head2 plugin($name, \@args) Instantiates a plugin object by querying each of the L<LOAD_PLUGINS> providers. The default L<LOAD_PLUGINS> provider is a L<Template::Plugins> object which attempts to load plugin modules, according the various configuration items such as L<PLUGIN_BASE|Template::Plugins#PLUGIN_BASE>, L<LOAD_PERL|Template::Plugins#LOAD_PERL>, etc., and then instantiate an object via L<new()|Template::Plugin#new()>. A reference to a list of constructor arguments may be passed as the second parameter. These are forwarded to the plugin constructor. Returns a reference to a plugin (which is generally an object, but doesn't have to be). Errors are thrown as L<Template::Exception> objects with the type set to 'C<plugin>'. $plugin = $context->plugin('DBI', 'dbi:msql:mydbname'); =head2 filter($name, \@args, $alias) Instantiates a filter subroutine by querying the L<LOAD_FILTERS> providers. The default L<LOAD_FILTERS> provider is a L<Template::Filters> object. Additional arguments may be passed by list reference along with an optional alias under which the filter will be cached for subsequent use. The filter is cached under its own C<$name> if C<$alias> is undefined. Subsequent calls to C<filter($name)> will return the cached entry, if defined. Specifying arguments bypasses the caching mechanism and always creates a new filter. Errors are thrown as L<Template::Exception> objects with the type set to 'C<filter>'. # static filter (no args) $filter = $context->filter('html'); # dynamic filter (args) aliased to 'padright' $filter = $context->filter('format', '%60s', 'padright'); # retrieve previous filter via 'padright' alias $filter = $context->filter('padright'); =head2 process($template, \%vars) Processes a template named or referenced by the first parameter and returns the output generated. An optional reference to a hash array may be passed as the second parameter, containing variable definitions which will be set before the template is processed. The template is processed in the current context, with no localisation of variables performed. Errors are thrown as L<Template::Exception> objects via C<die()>. $output = $context->process('header', { title => 'Hello World' }); =head2 include($template, \%vars) Similar to L<process()>, but using localised variables. Changes made to any variables will only persist until the C<include()> method completes. $output = $context->include('header', { title => 'Hello World' }); =head2 insert($template) This method returns the source content of a template file without performing any evaluation. It is used to implement the C<INSERT> directive. =head2 throw($error_type, $error_message, \$output) Raises an exception in the form of a L<Template::Exception> object by calling C<die()>. This method may be passed a reference to an existing L<Template::Exception> object; a single value containing an error message which is used to instantiate a L<Template::Exception> of type 'C<undef>'; or a pair of values representing the exception C<type> and C<info> from which a L<Template::Exception> object is instantiated. e.g. $context->throw($exception); $context->throw("I'm sorry Dave, I can't do that"); $context->throw('denied', "I'm sorry Dave, I can't do that"); The optional third parameter may be a reference to the current output buffer. This is then stored in the exception object when created, allowing the catcher to examine and use the output up to the point at which the exception was raised. $output .= 'blah blah blah'; $output .= 'more rhubarb'; $context->throw('yack', 'Too much yacking', \$output); =head2 catch($exception, \$output) Catches an exception thrown, either as a reference to a L<Template::Exception> object or some other value. In the latter case, the error string is promoted to a L<Template::Exception> object of 'C<undef>' type. This method also accepts a reference to the current output buffer which is passed to the L<Template::Exception> constructor, or is appended to the output buffer stored in an existing L<Template::Exception> object, if unique (i.e. not the same reference). By this process, the correct state of the output buffer can be reconstructed for simple or nested throws. =head2 define_block($name, $block) Adds a new block definition to the internal L<BLOCKS> cache. The first argument should contain the name of the block and the second a reference to a L<Template::Document> object or template sub-routine, or template text which is automatically compiled into a template sub-routine. Returns a true value (the sub-routine or L<Template::Document> reference) on success or undef on failure. The relevant error message can be retrieved by calling the L<error()|Template::Base#error()> method. =head2 define_filter($name, \&filter, $is_dynamic) Adds a new filter definition by calling the L<store()|Template::Filters#store()> method on each of the L<LOAD_FILTERS> providers until accepted (in the usual case, this is accepted straight away by the one and only L<Template::Filters> provider). The first argument should contain the name of the filter and the second a reference to a filter subroutine. The optional third argument can be set to any true value to indicate that the subroutine is a dynamic filter factory. Returns a true value or throws a 'C<filter>' exception on error. =head2 define_vmethod($type, $name, $code) This method is a wrapper around the L<Template::Stash> L<define_vmethod()|Template::Stash#define_vmethod()> method. It can be used to define new virtual methods. # define a new scalar (item) virtual method $context->define_vmethod( item => ucfirst => sub { my $text = shift; return ucfirst $text; } ) =head2 define_view($name, \%params) This method allows you to define a named L<view|Template::View>. $context->define_view( my_view => { prefix => 'my_templates/' } ); The view is then accessible as a template variable. [% my_view.print(some_data) %] =head2 define_views($views) This method allows you to define multiple named L<views|Template::View>. A reference to a hash array or list reference should be passed as an argument. $context->define_view({ # hash reference my_view_one => { prefix => 'my_templates_one/' }, my_view_two => { prefix => 'my_templates_two/' } }); If you're defining multiple views of which one or more are based on other views in the same definition then you should pass them as a list reference. This ensures that they get created in the right order (Perl does not preserve the order of items defined in a hash reference so you can't guarantee that your base class view will be defined before your subclass view). $context->define_view([ # list referenence my_view_one => { prefix => 'my_templates_one/' }, my_view_two => { prefix => 'my_templates_two/' , base => 'my_view_one', } ]); The views are then accessible as template variables. [% my_view_one.print(some_data) %] [% my_view_two.print(some_data) %] See also the L<VIEWS> option. =head2 stash() This method returns the L<Template::Stash> object used internally to manage template variables. =head2 localise(\%vars) Clones the stash to create a context with localised variables. Returns a reference to the newly cloned stash object which is also stored internally. $stash = $context->localise(); =head2 delocalise() Restore the stash to its state prior to localisation. $stash = $context->delocalise(); =head2 visit(\%blocks) This method is called by L<Template::Document> objects immediately before they process their content. It is called to register any local C<BLOCK> definitions with the context object so that they may be subsequently delivered on request. =head2 leave() Compliment to the L<visit()> method. Called by L<Template::Document> objects immediately after they process their content. =head2 view() This method creates a L<Template::View> object bound to the context. =head2 reset() Clears the local L<BLOCKS> cache of any C<BLOCK> definitions. Any initial set of L<BLOCKS> specified as a configuration item to the constructor will be reinstated. =head2 debugging($flag, @args) This method is used to control debugging output. It is used to implement the L<DEBUG|Template::Manual::Directives#DEBUG> directive. The first argument can be C<on> or C<off> to enable or disable debugging respectively. The numerical values C<0> and C<1> can also be used if you prefer. $context->debugging('on'); Alternately, the first argument can be C<format> to define a new debug message format. The second argument should be the format string which can contain any of the C<$file>, C<$line> or C<$text> symbols to indicate where the relevant values should be inserted. # note single quotes to prevent interpolated of variables $context->debugging( format => '## $file line $line: $text' ); The final use of this method is to generate debugging messages themselves. The first argument should be C<msg>, followed by a reference to a hash array of value to insert into the debugging format string. $context->debugging( msg => { line => 20, file => 'example.tt', text => 'Trampoline! Trampoline!', } ); =head2 AUTOLOAD An C<AUTOLOAD> method provides access to context configuration items. $stash = $context->stash(); $tflag = $context->trim(); $epflag = $context->eval_perl(); ... =head1 AUTHOR Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> =head1 COPYRIGHT Copyright (C) 1996-2013 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Template>, L<Template::Document>, L<Template::Exception>, L<Template::Filters>, L<Template::Plugins>, L<Template::Provider>, L<Template::Service>, L<Template::Stash> =cut # Local Variables: # mode: perl # perl-indent-level: 4 # indent-tabs-mode: nil # End: # # vim: expandtab shiftwidth=4: usr/local/lib64/perl5/Template/Stash/Context.pm 0000444 00000063423 14711306412 0015242 0 ustar 00 #============================================================= -*-Perl-*- # # Template::Stash::Context # # DESCRIPTION # This is an alternate stash object which includes a patch from # Craig Barratt to implement various new virtual methods to allow # dotted template variable to denote if object methods and subroutines # should be called in scalar or list context. It adds a little overhead # to each stash call and I'm a little wary of doing that. So for now, # it's implemented as a separate stash module which will allow us to # test it out, benchmark it and switch it in or out as we require. # # This is what Craig has to say about it: # # Here's a better set of features for the core. Attached is a new version # of Stash.pm (based on TT2.02) that: # # - supports the special op "scalar" that forces scalar context on # function calls, eg: # # cgi.param("foo").scalar # # calls cgi.param("foo") in scalar context (unlike my wimpy # scalar op from last night). Array context is the default. # # With non-function operands, scalar behaves like the perl # version (eg: no-op for scalar, size for arrays, etc). # # - supports the special op "ref" that behaves like the perl ref. # If applied to a function the function is not called. Eg: # # cgi.param("foo").ref # # does *not* call cgi.param and evaluates to "CODE". Similarly, # HASH.ref, ARRAY.ref return what you expect. # # - adds a new scalar and list op called "array" that is a no-op for # arrays and promotes scalars to one-element arrays. # # - allows scalar ops to be applied to arrays and hashes in place, # eg: ARRAY.repeat(3) repeats each element in place. # # - allows list ops to be applied to scalars by promoting the scalars # to one-element arrays (like an implicit "array"). So you can # do things like SCALAR.size, SCALAR.join and get a useful result. # # This also means you can now use x.0 to safely get the first element # whether x is an array or scalar. # # The new Stash.pm passes the TT2.02 test suite. But I haven't tested the # new features very much. One nagging implementation problem is that the # "scalar" and "ref" ops have higher precedence than user variable names. # # AUTHORS # Andy Wardley <abw@kfs.org> # Craig Barratt <craig@arraycomm.com> # # COPYRIGHT # Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved. # Copyright (C) 1998-2001 Canon Research Centre Europe Ltd. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # #============================================================================ package Template::Stash::Context; use strict; use warnings; use base 'Template::Stash'; our $VERSION = '3.100'; our $DEBUG = 0 unless defined $DEBUG; #======================================================================== # -- PACKAGE VARIABLES AND SUBS -- #======================================================================== #------------------------------------------------------------------------ # copy virtual methods from those in the regular Template::Stash #------------------------------------------------------------------------ our $ROOT_OPS = { %$Template::Stash::ROOT_OPS, defined $ROOT_OPS ? %$ROOT_OPS : (), }; our $SCALAR_OPS = { %$Template::Stash::SCALAR_OPS, 'array' => sub { return [$_[0]] }, defined $SCALAR_OPS ? %$SCALAR_OPS : (), }; our $LIST_OPS = { %$Template::Stash::LIST_OPS, 'array' => sub { return $_[0] }, defined $LIST_OPS ? %$LIST_OPS : (), }; our $HASH_OPS = { %$Template::Stash::HASH_OPS, defined $HASH_OPS ? %$HASH_OPS : (), }; #======================================================================== # ----- CLASS METHODS ----- #======================================================================== #------------------------------------------------------------------------ # new(\%params) # # Constructor method which creates a new Template::Stash object. # An optional hash reference may be passed containing variable # definitions that will be used to initialise the stash. # # Returns a reference to a newly created Template::Stash. #------------------------------------------------------------------------ sub new { my $class = shift; my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ }; my $self = { global => { }, %$params, %$ROOT_OPS, '_PARENT' => undef, '_CLASS' => $class, }; bless $self, $class; } #======================================================================== # ----- PUBLIC OBJECT METHODS ----- #======================================================================== #------------------------------------------------------------------------ # clone(\%params) # # Creates a copy of the current stash object to effect localisation # of variables. The new stash is blessed into the same class as the # parent (which may be a derived class) and has a '_PARENT' member added # which contains a reference to the parent stash that created it # ($self). This member is used in a successive declone() method call to # return the reference to the parent. # # A parameter may be provided which should reference a hash of # variable/values which should be defined in the new stash. The # update() method is called to define these new variables in the cloned # stash. # # Returns a reference to a cloned Template::Stash. #------------------------------------------------------------------------ sub clone { my ($self, $params) = @_; $params ||= { }; # look out for magical 'import' argument which imports another hash my $import = $params->{ import }; if (defined $import && UNIVERSAL::isa($import, 'HASH')) { delete $params->{ import }; } else { undef $import; } my $clone = bless { %$self, # copy all parent members %$params, # copy all new data '_PARENT' => $self, # link to parent }, ref $self; # perform hash import if defined &{ $HASH_OPS->{ import }}($clone, $import) if defined $import; return $clone; } #------------------------------------------------------------------------ # declone($export) # # Returns a reference to the PARENT stash. When called in the following # manner: # $stash = $stash->declone(); # the reference count on the current stash will drop to 0 and be "freed" # and the caller will be left with a reference to the parent. This # contains the state of the stash before it was cloned. #------------------------------------------------------------------------ sub declone { my $self = shift; $self->{ _PARENT } || $self; } #------------------------------------------------------------------------ # get($ident) # # Returns the value for an variable stored in the stash. The variable # may be specified as a simple string, e.g. 'foo', or as an array # reference representing compound variables. In the latter case, each # pair of successive elements in the list represent a node in the # compound variable. The first is the variable name, the second a # list reference of arguments or 0 if undefined. So, the compound # variable [% foo.bar('foo').baz %] would be represented as the list # [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ]. Returns the value of the # identifier or an empty string if undefined. Errors are thrown via # die(). #------------------------------------------------------------------------ sub get { my ($self, $ident, $args) = @_; my ($root, $result); $root = $self; if (ref $ident eq 'ARRAY' || ($ident =~ /\./) && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) { my $size = $#$ident; # if $ident is a list reference, then we evaluate each item in the # identifier against the previous result, using the root stash # ($self) as the first implicit 'result'... foreach (my $i = 0; $i <= $size; $i += 2) { if ( $i + 2 <= $size && ($ident->[$i+2] eq "scalar" || $ident->[$i+2] eq "ref") ) { $result = $self->_dotop($root, @$ident[$i, $i+1], 0, $ident->[$i+2]); $i += 2; } else { $result = $self->_dotop($root, @$ident[$i, $i+1]); } last unless defined $result; $root = $result; } } else { $result = $self->_dotop($root, $ident, $args); } return defined $result ? $result : $self->undefined($ident, $args); } #------------------------------------------------------------------------ # set($ident, $value, $default) # # Updates the value for a variable in the stash. The first parameter # should be the variable name or array, as per get(). The second # parameter should be the intended value for the variable. The third, # optional parameter is a flag which may be set to indicate 'default' # mode. When set true, the variable will only be updated if it is # currently undefined or has a false value. The magical 'IMPORT' # variable identifier may be used to indicate that $value is a hash # reference whose values should be imported. Returns the value set, # or an empty string if not set (e.g. default mode). In the case of # IMPORT, returns the number of items imported from the hash. #------------------------------------------------------------------------ sub set { my ($self, $ident, $value, $default) = @_; my ($root, $result, $error); $root = $self; ELEMENT: { if (ref $ident eq 'ARRAY' || ($ident =~ /\./) && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) { # a compound identifier may contain multiple elements (e.g. # foo.bar.baz) and we must first resolve all but the last, # using _dotop() with the $lvalue flag set which will create # intermediate hashes if necessary... my $size = $#$ident; foreach (my $i = 0; $i < $size - 2; $i += 2) { $result = $self->_dotop($root, @$ident[$i, $i+1], 1); last ELEMENT unless defined $result; $root = $result; } # then we call _assign() to assign the value to the last element $result = $self->_assign($root, @$ident[$size-1, $size], $value, $default); } else { $result = $self->_assign($root, $ident, 0, $value, $default); } } return defined $result ? $result : ''; } #------------------------------------------------------------------------ # getref($ident) # # Returns a "reference" to a particular item. This is represented as a # closure which will return the actual stash item when called. # WARNING: still experimental! #------------------------------------------------------------------------ sub getref { my ($self, $ident, $args) = @_; my ($root, $item, $result); $root = $self; if (ref $ident eq 'ARRAY') { my $size = $#$ident; foreach (my $i = 0; $i <= $size; $i += 2) { ($item, $args) = @$ident[$i, $i + 1]; last if $i >= $size - 2; # don't evaluate last node last unless defined ($root = $self->_dotop($root, $item, $args)); } } else { $item = $ident; } if (defined $root) { return sub { my @args = (@{$args||[]}, @_); $self->_dotop($root, $item, \@args); } } else { return sub { '' }; } } #------------------------------------------------------------------------ # update(\%params) # # Update multiple variables en masse. No magic is performed. Simple # variable names only. #------------------------------------------------------------------------ sub update { my ($self, $params) = @_; # look out for magical 'import' argument to import another hash my $import = $params->{ import }; if (defined $import && UNIVERSAL::isa($import, 'HASH')) { @$self{ keys %$import } = values %$import; delete $params->{ import }; } @$self{ keys %$params } = values %$params; } #======================================================================== # ----- PRIVATE OBJECT METHODS ----- #======================================================================== #------------------------------------------------------------------------ # _dotop($root, $item, \@args, $lvalue, $nextItem) # # This is the core 'dot' operation method which evaluates elements of # variables against their root. All variables have an implicit root # which is the stash object itself (a hash). Thus, a non-compound # variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is # '(stash.)foo.bar'. The first parameter is a reference to the current # root, initially the stash itself. The second parameter contains the # name of the variable element, e.g. 'foo'. The third optional # parameter is a reference to a list of any parenthesised arguments # specified for the variable, which are passed to sub-routines, object # methods, etc. The final parameter is an optional flag to indicate # if this variable is being evaluated on the left side of an assignment # (e.g. foo.bar.baz = 10). When set true, intermediated hashes will # be created (e.g. bar) if necessary. # # Returns the result of evaluating the item against the root, having # performed any variable "magic". The value returned can then be used # as the root of the next _dotop() in a compound sequence. Returns # undef if the variable is undefined. #------------------------------------------------------------------------ sub _dotop { my ($self, $root, $item, $args, $lvalue, $nextItem) = @_; my $rootref = ref $root; my ($value, @result, $ret, $retVal); $nextItem ||= ""; my $scalarContext = 1 if ( $nextItem eq "scalar" ); my $returnRef = 1 if ( $nextItem eq "ref" ); $args ||= [ ]; $lvalue ||= 0; # print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n" # if $DEBUG; # return undef without an error if either side of the dot is unviable # or if an attempt is made to access a private member, starting _ or . return undef unless defined($root) and defined($item) and $item !~ /^[\._]/; if (ref(\$root) eq "SCALAR" && !$lvalue && (($value = $LIST_OPS->{ $item }) || $item =~ /^-?\d+$/) ) { # # Promote scalar to one element list, to be processed below. # $rootref = 'ARRAY'; $root = [$root]; } if ($rootref eq $self->{_CLASS} || $rootref eq 'HASH') { # if $root is a regular HASH or a Template::Stash kinda HASH (the # *real* root of everything). We first lookup the named key # in the hash, or create an empty hash in its place if undefined # and the $lvalue flag is set. Otherwise, we check the HASH_OPS # pseudo-methods table, calling the code if found, or return undef. if (defined($value = $root->{ $item })) { ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, $scalarContext); return $retVal if ( $ret ); ## RETURN } elsif ($lvalue) { # we create an intermediate hash if this is an lvalue return $root->{ $item } = { }; ## RETURN } elsif ($value = $HASH_OPS->{ $item }) { @result = &$value($root, @$args); ## @result } elsif (ref $item eq 'ARRAY') { # hash slice return [@$root{@$item}]; ## RETURN } elsif ($value = $SCALAR_OPS->{ $item }) { # # Apply scalar ops to every hash element, in place. # foreach my $key ( keys %$root ) { $root->{$key} = &$value($root->{$key}, @$args); } } } elsif ($rootref eq 'ARRAY') { # if root is an ARRAY then we check for a LIST_OPS pseudo-method # (except for l-values for which it doesn't make any sense) # or return the numerical index into the array, or undef if (($value = $LIST_OPS->{ $item }) && ! $lvalue) { @result = &$value($root, @$args); ## @result } elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) { # # Apply scalar ops to every array element, in place. # for ( my $i = 0 ; $i < @$root ; $i++ ) { $root->[$i] = &$value($root->[$i], @$args); ## @result } } elsif ($item =~ /^-?\d+$/) { $value = $root->[$item]; ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, $scalarContext); return $retVal if ( $ret ); ## RETURN } elsif (ref $item eq 'ARRAY' ) { # array slice return [@$root[@$item]]; ## RETURN } } # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL') # doesn't appear to work with CGI, returning true for the first call # and false for all subsequent calls. elsif (ref($root) && UNIVERSAL::can($root, 'can')) { # if $root is a blessed reference (i.e. inherits from the # UNIVERSAL object base class) then we call the item as a method. # If that fails then we try to fallback on HASH behaviour if # possible. return ref $root->can($item) if ( $returnRef ); ## RETURN eval { @result = $scalarContext ? scalar $root->$item(@$args) : $root->$item(@$args); ## @result }; if ($@) { # failed to call object method, so try some fallbacks if (UNIVERSAL::isa($root, 'HASH') && defined($value = $root->{ $item })) { ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, $scalarContext); return $retVal if ( $ret ); ## RETURN } elsif (UNIVERSAL::isa($root, 'ARRAY') && ($value = $LIST_OPS->{ $item })) { @result = &$value($root, @$args); } else { @result = (undef, $@); } } } elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) { # at this point, it doesn't look like we've got a reference to # anything we know about, so we try the SCALAR_OPS pseudo-methods # table (but not for l-values) @result = &$value($root, @$args); ## @result } elsif ($self->{ _DEBUG }) { die "don't know how to access [ $root ].$item\n"; ## DIE } else { @result = (); } # fold multiple return items into a list unless first item is undef if (defined $result[0]) { return ref(@result > 1 ? [ @result ] : $result[0]) if ( $returnRef ); ## RETURN if ( $scalarContext ) { return scalar @result if ( @result > 1 ); ## RETURN return scalar(@{$result[0]}) if ( ref $result[0] eq "ARRAY" ); return scalar(%{$result[0]}) if ( ref $result[0] eq "HASH" ); return $result[0]; ## RETURN } else { return @result > 1 ? [ @result ] : $result[0]; ## RETURN } } elsif (defined $result[1]) { die $result[1]; ## DIE } elsif ($self->{ _DEBUG }) { die "$item is undefined\n"; ## DIE } return undef; } #------------------------------------------------------------------------ # ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, # $scalarContext); # # Handle the various return processing for _dotop #------------------------------------------------------------------------ sub _dotop_return { my($value, $args, $returnRef, $scalarContext) = @_; my(@result); return (1, ref $value) if ( $returnRef ); ## RETURN if ( $scalarContext ) { return (1, scalar(@$value)) if ref $value eq 'ARRAY'; ## RETURN return (1, scalar(%$value)) if ref $value eq 'HASH'; ## RETURN return (1, scalar($value)) unless ref $value eq 'CODE'; ## RETURN; @result = scalar &$value(@$args) ## @result; } else { return (1, $value) unless ref $value eq 'CODE'; ## RETURN @result = &$value(@$args); ## @result } return (0, undef, @result); } #------------------------------------------------------------------------ # _assign($root, $item, \@args, $value, $default) # # Similar to _dotop() above, but assigns a value to the given variable # instead of simply returning it. The first three parameters are the # root item, the item and arguments, as per _dotop(), followed by the # value to which the variable should be set and an optional $default # flag. If set true, the variable will only be set if currently false # (undefined/zero) #------------------------------------------------------------------------ sub _assign { my ($self, $root, $item, $args, $value, $default) = @_; my $rootref = ref $root; my $result; $args ||= [ ]; $default ||= 0; # print(STDERR "_assign(root=$root, item=$item, args=[@$args], \n", # "value=$value, default=$default)\n") # if $DEBUG; # return undef without an error if either side of the dot is unviable # or if an attempt is made to update a private member, starting _ or . return undef ## RETURN unless $root and defined $item and $item !~ /^[\._]/; if ($rootref eq 'HASH' || $rootref eq $self->{_CLASS}) { # if the root is a hash we set the named key return ($root->{ $item } = $value) ## RETURN unless $default && $root->{ $item }; } elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) { # or set a list item by index number return ($root->[$item] = $value) ## RETURN unless $default && $root->{ $item }; } elsif (UNIVERSAL::isa($root, 'UNIVERSAL')) { # try to call the item as a method of an object return $root->$item(@$args, $value); ## RETURN } else { die "don't know how to assign to [$root].[$item]\n"; ## DIE } return undef; } 1; __END__ =head1 NAME Template::Stash::Context - Experimetal stash allowing list/scalar context definition =head1 SYNOPSIS use Template; use Template::Stash::Context; my $stash = Template::Stash::Context->new(\%vars); my $tt2 = Template->new({ STASH => $stash }); =head1 DESCRIPTION This is an alternate stash object which includes a patch from Craig Barratt to implement various new virtual methods to allow dotted template variable to denote if object methods and subroutines should be called in scalar or list context. It adds a little overhead to each stash call and I'm a little wary of applying that to the core default stash without investigating the effects first. So for now, it's implemented as a separate stash module which will allow us to test it out, benchmark it and switch it in or out as we require. This is what Craig has to say about it: Here's a better set of features for the core. Attached is a new version of Stash.pm (based on TT2.02) that: * supports the special op "scalar" that forces scalar context on function calls, eg: cgi.param("foo").scalar calls cgi.param("foo") in scalar context (unlike my wimpy scalar op from last night). Array context is the default. With non-function operands, scalar behaves like the perl version (eg: no-op for scalar, size for arrays, etc). * supports the special op "ref" that behaves like the perl ref. If applied to a function the function is not called. Eg: cgi.param("foo").ref does *not* call cgi.param and evaluates to "CODE". Similarly, HASH.ref, ARRAY.ref return what you expect. * adds a new scalar and list op called "array" that is a no-op for arrays and promotes scalars to one-element arrays. * allows scalar ops to be applied to arrays and hashes in place, eg: ARRAY.repeat(3) repeats each element in place. * allows list ops to be applied to scalars by promoting the scalars to one-element arrays (like an implicit "array"). So you can do things like SCALAR.size, SCALAR.join and get a useful result. This also means you can now use x.0 to safely get the first element whether x is an array or scalar. The new Stash.pm passes the TT2.02 test suite. But I haven't tested the new features very much. One nagging implementation problem is that the "scalar" and "ref" ops have higher precedence than user variable names. =head1 AUTHOR Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/|http://wardley.org/> =head1 VERSION 1.63, distributed as part of the Template Toolkit version 3.100, released on 30 March 2020. =head1 COPYRIGHT Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Template::Stash|Template::Stash> =cut # Local Variables: # mode: perl # perl-indent-level: 4 # indent-tabs-mode: nil # End: # # vim: expandtab shiftwidth=4:
| ver. 1.4 |
Github
|
.
| PHP 7.4.33 | Генерация страницы: 0 |
proxy
|
phpinfo
|
Настройка