■

my $tt = Template->new();

Template

  use base (Template::Base);

Template::Base

sub new(){
   $class(='Template')->_init();
...

Template

sub _init(){
  Template::Constants 登録
  $self->{SERVICE} = Template::Config->service( $config );
}

Template::Config

sub service( $params ){
  $class(='Template::Config')->load( $SERVICE(='Template::Service') );
  return $SERVICE->new( $params );
}

sub load ( $module ) {
  $module =~ s[::][/]g;
  $module .= '.pm';
  eval{ require $module; };

ServiceモジュールとしてTemplate::Configに登録されている
Template::Serviceをrequireしてnew.

• • -

Template::Service

  use base (Template::Base);

Template::Base

sub new(){
   $class(='Template::Service')->_init();
...

と、Templateと同じようなnewの流れとなる。

Template::Service

sub _init( $config ){
    my $delim = $config->{ DELIMITER } || ':';
    foreach $item (qw( PRE_PROCESS PROCESS POST_PROCESS WRAPPER )) {
       $data = $config->{ $item };
       $self->{ $item } = [ ], next unless (defined $data);
       $data = [ split($delim, $data || '') ]
         unless ref $data eq 'ARRAY';
       $self->{ $item } = $data;
    }
...

$selfの、PRE_PROCESS, PROCESS, POST_PROCESS, WRAPPERを初期化して、
$configで設定されているものを代入。
PRE_PROCESS = 'global_header:private_header'
POST_PROCESS = 'global_footer:private_footer'
とか書ける感じ。

sub _init( $config ){
...続き
    $self->{ PROCESS } = $config->{ PROCESS } || undef;
    $self->{ ERROR      } = $config->{ ERROR } || $config->{ ERRORS };
    $self->{ AUTO_RESET } = $config->{ AUTO_RESET } || 1;
    $self->{ DEBUG      } = ( $config->{ DEBUG } || 0 )
                            & Template::Constants::DEBUG_SERVICE;
    $context = $self->{ CONTEXT } = $config->{ CONTEXT }
        || Template::Config->context($config);
    return $self;
}

Template::Config

sub context( $params ){
    return undef unless $class->load($CONTEXT(='Template::Context'));
    return $CONTEXT->new($params) 
}

Template,Template::Serviceと同じく、Template::Contextに対してload, new → _init().

Template::Context

sub _init( $config ) {
    my @itemlut = ( 
        LOAD_TEMPLATES => 'provider',
        LOAD_PLUGINS   => 'plugins',
        LOAD_FILTERS   => 'filters' 
    );
    while ( ($name, $method) = splice(@itemlut, 0, 2) ) {
        $item = $config->{ $name } || Template::Config->$method($config)
        $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ];
    }
...

Template::Config

sub provider( $config ){
    $class->load($PROVIDER(='Template::Provider');
    return $PROVIDER->new($params) 
}

sub plugins( $config ){
    $class->load($PLUGINS(='Template::Plugins');
    return $PLUGINS->new($params) 
}

sub filters( $config ){
    $class->load($Filters(='Template::Filters');
    return $Filters->new($params) 
}

Template::Provider

sub _init( $params ){
    my $size = $params->{ CACHE_SIZE   };
    my $path = $params->{ INCLUDE_PATH } || '.';
    my $cdir = $params->{ COMPILE_DIR  } || '';
    my $dlim = $params->{ DELIMITER    };

    $self->{ DELIMITER    } = $dlim;
    $self->{ DEFAULT      } = $params->{ DEFAULT  };
    $self->{ ENCODING     } = $params->{ ENCODING };
#   $self->{ PREFIX       } = $params->{ PREFIX   };
...
    return $self
}

tt2ファイル読み込み、コンパイル等に関する様々な値を設定している。

Template::Plugins

our $PLUGIN_BASE = 'Template::Plugin';
our $STD_PLUGINS = {
    'autoformat' => 'Template::Plugin::Autoformat',
    'cgi'        => 'Template::Plugin::CGI',
    'datafile'   => 'Template::Plugin::Datafile',
    'date'       => 'Template::Plugin::Date',
    'debug'      => 'Template::Plugin::Debug',
    'directory'  => 'Template::Plugin::Directory',
    'dbi'        => 'Template::Plugin::DBI',
    'dumper'     => 'Template::Plugin::Dumper',
    'file'       => 'Template::Plugin::File',
    'format'     => 'Template::Plugin::Format',
    'html'       => 'Template::Plugin::HTML',
    'image'      => 'Template::Plugin::Image',
    'iterator'   => 'Template::Plugin::Iterator',
    'pod'        => 'Template::Plugin::Pod',
    'table'      => 'Template::Plugin::Table',
    'url'        => 'Template::Plugin::URL',
    'view'       => 'Template::Plugin::View',
    'wrap'       => 'Template::Plugin::Wrap',
    'xmlstyle'   => 'Template::Plugin::XML::Style',
};

sub _init( $params ){
    my ($pbase, $plugins, $factory) = 
    @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) };
...
    # add default plugin base (Template::Plugin) if set
    push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE;

    $self->{ PLUGIN_BASE } = $pbase;
    $self->{ PLUGINS     } = { %$STD_PLUGINS, %$plugins };
    $self->{ TOLERANT    } = $params->{ TOLERANT }  || 0;
    $self->{ LOAD_PERL   } = $params->{ LOAD_PERL } || 0;
    $self->{ FACTORY     } = $factory || { };

    return $self;
}

デフォルトのプラグインと、指定したプラグインを設定。
独自のプラグイン基底クラスも追加可能。

Template::Filters

$FILTERS = {
    # static filters 
    'html'            => \&html_filter,
    'html_para'       => \&html_paragraph,
    'html_break'      => \&html_para_break,
    'html_para_break' => \&html_para_break,
    'html_line_break' => \&html_line_break,
    'uri'             => \&uri_filter,
    'upper'           => sub { uc $_[0] },
    'lower'           => sub { lc $_[0] },
    'ucfirst'         => sub { ucfirst $_[0] },
    'lcfirst'         => sub { lcfirst $_[0] },
    'stderr'          => sub { print STDERR @_; return '' },
    'trim'            => sub { for ($_[0]) { s/^\s+//; s/\s+$// }; $_[0] },
    'null'            => sub { return '' },
    'collapse'        => sub { for ($_[0]) { s/^\s+//; s/\s+$//; s/\s+/ /g };
                               $_[0] },

    # dynamic filters
    'html_entity' => [ \&html_entity_filter_factory, 1 ],
    'indent'      => [ \&indent_filter_factory,      1 ],
    'format'      => [ \&format_filter_factory,      1 ],
    'truncate'    => [ \&truncate_filter_factory,    1 ],
    'repeat'      => [ \&repeat_filter_factory,      1 ],
    'replace'     => [ \&replace_filter_factory,     1 ],
    'remove'      => [ \&remove_filter_factory,      1 ],
    'eval'        => [ \&eval_filter_factory,        1 ],
    'evaltt'      => [ \&eval_filter_factory,        1 ],  # alias
    'perl'        => [ \&perl_filter_factory,        1 ],
    'evalperl'    => [ \&perl_filter_factory,        1 ],  # alias
    'redirect'    => [ \&redirect_filter_factory,    1 ],
    'file'        => [ \&redirect_filter_factory,    1 ],  # alias
    'stdout'      => [ \&stdout_filter_factory,      1 ],
    'latex'       => [ \&latex_filter_factory,       1 ],
};

# name of module implementing plugin filters
$PLUGIN_FILTER = 'Template::Plugin::Filter';

sub _init( $params ){
    $self->{ FILTERS  } = $params->{ FILTERS } || { };
    $self->{ TOLERANT } = $params->{ TOLERANT }  || 0;
...
    return $self;

Template::Context

sub _init( $params ){
...続き
    my $providers = $self->{LOAD_TEMPLATES(='Template::Config->provider($params)')};
    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';
    }
...

...続き
    $self->{ STASH } = $config->{ STASH } || do {
      my $predefs = $config->{VARIABLES} || $config->{PRE_DEFINE} || {};

    Template::Config->stash( $predefs );
...

Template::Config

sub stash( $params ){
    $class->load( $STASH(='Template::Stash::XS') );
    return $STASH->new( $params );
}

Template::Stash::XS

BEGIN {
    @Template::Stash::XS::ISA = qw/DynaLoader Template::Stash/;
    bootstrap Template::Stash::XS $Template::VERSION;
}

Template::Stash

sub new {
    my $self = {
      global => {},
      %$params, 
      %$ROOT_OPS,
      '_PARENT' => undef,
    };
    bless $self, $class;
}

Template::Context

sub _init {
...続き
    #compile any template BLOCKS specified as text
    $blocks = $config->{BLOCKS} || {};
    $self->{ INIT_BLOCKS } = $self->{BLOCKS} = {
        map {
            $block = $blocks->{ $_ };
            $block = $self->template(\$block) unless ref $block;
            ( $_ => $block );
        }
        keys %$blocks
    };

    ...other setting ( RECURSION, EVAL_PERL, TRIM, BLKSTACK, CONFIG, DEBUG... )

    return $self;
}

ようやく終了。

appendix

@PRELOAD   = ( $CONTEXT, $FILTERS, $ITERATOR, $PARSER,
               $PLUGINS, $PROVIDER, $SERVICE, $STASH );
sub preload {
    $class->load($module) foreach my $module (@PRELOAD, @_);
}

Template::Stash

our $ROOT_OPS = {
    'inc'  => sub { local $^W = 0; my $item = shift; ++$item }, 
    'dec'  => sub { local $^W = 0; my $item = shift; --$item }, 
#    import => \&hash_import,
    defined $ROOT_OPS ? %$ROOT_OPS : (),
};

our $SCALAR_OPS = {
    'item'    => sub {   $_[0] },
    'list'    => sub { [ $_[0] ] },
    'hash'    => sub { { value => $_[0] } },
    'length'  => sub { length $_[0] },
    'size'    => sub { return 1 },
    'defined' => sub { return 1 },
    'match' => sub {
        my ($str, $search, $global) = @_;
        return $str unless defined $str and defined $search;
        my @matches = $global ? ($str =~ /$search/g)
                              : ($str =~ /$search/);
        return @matches ? \@matches : '';
    },
    'search'  => sub { 
        my ($str, $pattern) = @_;
        return $str unless defined $str and defined $pattern;
        return $str =~ /$pattern/;
    },
    'repeat'  => sub { 
        my ($str, $count) = @_;
        $str = '' unless defined $str;  
        return '' unless $count;
        $count ||= 1;
        return $str x $count;
    },
    'replace' => sub {
        my ($text, $pattern, $replace, $global) = @_;
        $text    = '' unless defined $text;
        $pattern = '' unless defined $pattern;
        $replace = '' unless defined $replace;
        $global  = 1  unless defined $global;

        if ($replace =~ /\$\d+/) {
            # replacement string may contain backrefs
            my $expand = sub {
                my ($chunk, $start, $end) = @_;
                $chunk =~ s{ \\(\\|\$) | \$ (\d+) }{
                    $1 ? $1
                        : ($2 > $#$start || $2 == 0) ? '' 
                        : substr($text, $start->[$2], $end->[$2] - $start->[$2]);
                }exg;
                $chunk;
            };
            if ($global) {
                $text =~ s{$pattern}{ &$expand($replace, [@-], [@+]) }eg;
            } 
            else {
                $text =~ s{$pattern}{ &$expand($replace, [@-], [@+]) }e;
            }
        }
        else {
            if ($global) {
                $text =~ s/$pattern/$replace/g;
            } 
            else {
                $text =~ s/$pattern/$replace/;
            }
        }
        return $text;
    },
    'remove'  => sub { 
        my ($str, $search) = @_;
        return $str unless defined $str and defined $search;
        $str =~ s/$search//g;
        return $str;
    },
    'split' => sub {
        my ($str, $split, $limit) = @_;
        $str = '' unless defined $str;

        # we have to be very careful about spelling out each possible 
        # combination of arguments because split() is very sensitive
        # to them, for example C behaves differently 
        # to C<$space=' '; split($space, ...)>

        if (defined $limit) {
            return [ defined $split 
                     ? split($split, $str, $limit)
                     : split(' ', $str, $limit) ];
        }
        else {
            return [ defined $split 
                     ? split($split, $str)
                     : split(' ', $str) ];
        }
    },
    'chunk' => sub {
        my ($string, $size) = @_;
        my @list;
        $size ||= 1;
        if ($size < 0) {
            # sexeger!  It's faster to reverse the string, search
            # it from the front and then reverse the output than to 
            # search it from the end, believe it nor not!
            $string = reverse $string;
            $size = -$size;
            unshift(@list, scalar reverse $1) 
                while ($string =~ /*1/g);
        }
        else {
            push(@list, $1) while ($string =~ /*2/g);
        }
        return \@list;
    },
    'substr' => sub {
        my ($text, $offset, $length, $replacement) = @_;
        $offset ||= 0;

        if(defined $length) {
            if (defined $replacement) {
                substr( $text, $offset, $length, $replacement );
                return $text;
            }
            else {
                return substr( $text, $offset, $length );
            }
        }
        else {
            return substr( $text, $offset );
        }
    },

    defined $SCALAR_OPS ? %$SCALAR_OPS : (),
};

our $HASH_OPS = {
    'item'   => sub { 
        my ($hash, $item) = @_; 
        $item = '' unless defined $item;
        return if $PRIVATE && $item =~ /$PRIVATE/;
        $hash->{ $item };
    },
    'hash'   => sub { $_[0] },
    'size'   => sub { scalar keys %{$_[0]} },
    'each'   => sub { # this will be changed in TT3 to do what pairs does
                      [        %{ $_[0] } ] },
    'keys'   => sub { [ keys   %{ $_[0] } ] },
    'values' => sub { [ values %{ $_[0] } ] },
    'items'  => sub { [        %{ $_[0] } ] },
    'pairs'  => sub { [ map   { { key => $_ , value => $_[0]->{ $_ } } }
                        sort keys %{ $_[0] } ] },
    'list'   => sub { 
        my ($hash, $what) = @_;  
        $what ||= '';
        return ($what eq 'keys')   ? [   keys %$hash ]
            :  ($what eq 'values') ? [ values %$hash ]
            :  ($what eq 'each')   ? [        %$hash ]
            :  # for now we do what pairs does but this will be changed 
               # in TT3 to return [ $hash ] by default
               [ map { { key => $_ , value => $hash->{ $_ } } }
                 sort keys %$hash 
               ];
    },
    'exists'  => sub { exists $_[0]->{ $_[1] } },
    'defined' => sub { 
        # return the item requested, or 1 if no argument 
        # to indicate that the hash itself is defined
        my $hash = shift;
        return @_ ? defined $hash->{ $_[0] } : 1;
    },
    'delete'  => sub { 
        my $hash = shift; 
        delete $hash->{ $_ } for @_;
    },
    'import'  => \&hash_import,
    'sort'    => sub {
        my ($hash) = @_;
        [ sort { lc $hash->{$a} cmp lc $hash->{$b} } (keys %$hash) ];
    },
    'nsort'    => sub {
        my ($hash) = @_;
        [ sort { $hash->{$a} <=> $hash->{$b} } (keys %$hash) ];
    },
    defined $HASH_OPS ? %$HASH_OPS : (),
};

our $LIST_OPS = {
    'item'    => sub { $_[0]->[ $_[1] || 0 ] },
    'list'    => sub { $_[0] },
    'hash'    => sub { 
        my $list = shift;
        if (@_) {
            my $n = shift || 0;
            return { map { ($n++, $_) } @$list }; 
        }
        no warnings;
        return { @$list };
    },
    'push'    => sub { my $list = shift; push(@$list, @_); return '' },
    'pop'     => sub { my $list = shift; pop(@$list) },
    'unshift' => sub { my $list = shift; unshift(@$list, @_); return '' },
    'shift'   => sub { my $list = shift; shift(@$list) },
    'max'     => sub { local $^W = 0; my $list = shift; $#$list; },
    'size'    => sub { local $^W = 0; my $list = shift; $#$list + 1; },
    'defined' => sub { 
        # return the item requested, or 1 if no argument to 
        # indicate that the hash itself is defined
        my $list = shift;
        return @_ ? defined $list->[$_[0]] : 1;
    },
    'first'   => sub {
        my $list = shift;
        return $list->[0] unless @_;
        return [ @$list[0..$_[0]-1] ];
    },
    'last'    => sub {
        my $list = shift;
        return $list->[-1] unless @_;
        return [ @$list[-$_[0]..-1] ];
    },
    'reverse' => sub { my $list = shift; [ reverse @$list ] },
    'grep'    => sub { 
        my ($list, $pattern) = @_;
        $pattern ||= '';
        return [ grep /$pattern/, @$list ];
    },
    'join'    => sub { 
        my ($list, $joint) = @_; 
        join(defined $joint ? $joint : ' ', 
             map { defined $_ ? $_ : '' } @$list) 
        },
    'sort'    => sub {
        $^W = 0;
        my ($list, $field) = @_;
        return $list unless @$list > 1;     # no need to sort 1 item lists
        return [
            $field                          # Schwartzian Transform 
            ?  map  { $_->[0] }             # for case insensitivity
               sort { $a->[1] cmp $b->[1] }
               map  { [ $_, lc(ref($_) eq 'HASH' 
                   ? $_->{ $field } : 
                   UNIVERSAL::can($_, $field)
                   ? $_->$field() : $_) ] } 
               @$list 
            :  map  { $_->[0] }
               sort { $a->[1] cmp $b->[1] }
               map  { [ $_, lc $_ ] } 
               @$list,
       ];
   },
   'nsort'    => sub {
        my ($list, $field) = @_;
        return $list unless @$list > 1;     # no need to sort 1 item lists
        return [ 
            $field                          # Schwartzian Transform 
            ?  map  { $_->[0] }             # for case insensitivity
               sort { $a->[1] <=> $b->[1] }
               map  { [ $_, lc(ref($_) eq 'HASH' 
                   ? $_->{ $field } : 
                   UNIVERSAL::can($_, $field)
                   ? $_->$field() : $_) ] } 
               @$list 
            :  map  { $_->[0] }
               sort { $a->[1] <=> $b->[1] }
               map  { [ $_, lc $_ ] } 
               @$list,
        ];
    },
    'unique'  => sub { my %u; [ grep { ++$u{$_} == 1 } @{$_[0]} ] },
    'import'  => sub {
        my $list = shift;
        push(@$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_);
        return $list;
    },
    'merge'   => sub {
        my $list = shift;
        return [ @$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_ ];
    },
    'slice' => sub {
        my ($list, $from, $to) = @_;
        $from ||= 0;
        $to = $#$list unless defined $to;
        return [ @$list[$from..$to] ];
    },
    'splice'  => sub {
        my ($list, $offset, $length, @replace) = @_;
        if (@replace) {
            # @replace can contain a list of multiple replace items, or 
            # be a single reference to a list
            @replace = @{ $replace[0] }
            if @replace == 1 && ref $replace[0] eq 'ARRAY';
            return [ splice @$list, $offset, $length, @replace ];
        }
        elsif (defined $length) {
            return [ splice @$list, $offset, $length ];
        }
        elsif (defined $offset) {
            return [ splice @$list, $offset ];
        }
        else {
            return [ splice(@$list) ];
        }
    },

    defined $LIST_OPS ? %$LIST_OPS : (),
};

Template::Service :
                 'DEBUG' => 0,
                 '' => undef,
                 'PRE_PROCESS' => ,
                 'AUTO_RESET' => 1,
                 'POST_PROCESS' => ,
                 'ERROR' => undef,
                 'PROCESS' => undef,
                 '0' => undef,
                 'CONTEXT' => => Template::Context
                 'ERROR' =>undef
                 'WRAPPER' => 

Template::Context :
                 'PREFIX_MAP' => {},
                 '' => undef,
                 'BLOCKS' => {},
                 'TRIM' => 0,
                 'CONFIG' => {},
                 'LOAD_PLUGINS' =>  IN Template::Plugin
                 'LOAD_TEMPLATES' =>  IN Template::Provider
                 'BLKSTACK' => ,
                 '0' => undef,
                 'STASH' => Template::Stash::XS
                 'DEBUG_FORMAT' => undef,
                 '_ERROR' => undef,
                 'DEBUG' => undef,
                 'EVAL_PERL' => 0,
                 'EXPOSE_BLOCKS' => 0,
                 'DEBUG_DIRS' => 0,
                 'RECURSION' => 0,
                 'INIT_BLOCKS' => $VAR1->{'SERVICE'}{'CONTEXT'}{'BLOCKS'},
                 'LOAD_FILTERS' =>  Template::Filters

Template::Plugin :
                'DEBUG' => 0,
                '' => undef,
                'FACTORY' => {},
                'PLUGIN_BASE' => [
                              'Template::Plugin'
                 ],
                'LOAD_PERL' => 0,
                'TOLERANT' => 0,
                '0' => undef,
                'PLUGINS' => {
                         'pod' => 'Template::Plugin::Pod',
                         'date' => 'Template::Plugin::Date',
                         'file' => 'Template::Plugin::File',
                         'table' => 'Template::Plugin::Table',
                         'dumper' => 'Template::Plugin::Dumper',
                         'directory' => 'Template::Plugin::Directory',
                         'html' => 'Template::Plugin::HTML',
                         'dbi' => 'Template::Plugin::DBI',
                         'autoformat' => 'Template::Plugin::Autoformat',
                         'view' => 'Template::Plugin::View',
                         'debug' => 'Template::Plugin::Debug',
                         'iterator' => 'Template::Plugin::Iterator',
                         'url' => 'Template::Plugin::URL',
                         'wrap' => 'Template::Plugin::Wrap',
                         'datafile' => 'Template::Plugin::Datafile',
                         'cgi' => 'Template::Plugin::CGI',
                         'image' => 'Template::Plugin::Image',
                         'format' => 'Template::Plugin::Format',
                         'xmlstyle' => 'Template::Plugin::XML::Style'
               },
              '_ERROR' => undef

Template::Provider :
              'SIZE' => undef,
              '' => undef,
              'COMPILE_DIR' => '',
              'DELIMITER' => ':',
              'UNICODE' => 1,
              'TOLERANT' => 0,
              'DOCUMENT' => 'Template::Document',
              '0' => undef,
              'RELATIVE' => 0,
              '_ERROR' => undef,
              'INCLUDE_PATH' => [
                                '.'
                ],
              'DEBUG' => 0,
              'ABSOLUTE' => 0,
              'LOOKUP' => {},
              'DEFAULT' => undef,
              'PARSER' => undef,
              'ENCODING' => undef,
              'SLOTS' => 0,
              'PARAMS' => $VAR1->{'SERVICE'}{'CONTEXT'}{'CONFIG'},
              'COMPILE_EXT' => ''

Template::Stash::XS :
              'global' => {},
              'inc' => sub { "DUMMY" },
              '_DEBUG' => 0,
              'dec' => sub { "DUMMY" },
              '_PARENT' => undef

Template::Filters :
              'DEBUG' => 0,
              '' => undef,
              'TOLERANT' => 0,
              '0' => undef,
              'FILTERS' => {},
              '_ERROR' => undef

*1:.{$size})|(.+

*2:.{$size})|(.+