■
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 Cbehaves 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
■
ファイルの内容を読み出す、LOAD_FILE()関数を使うと、
mysql> select load_file('/home/homepage/text.txt');
ERROR 13 (HY000): Can't get stat of '/home/homepage/text.txt' (Errcode: 13)
というエラーがでて思うように動かない。。
/home/homepage/test.txtは存在してて、consoleからは読めるのに。
- rwxrwxrwx 1 root root 1 11月 22 12:04 text.txt
色々調べてみると、このファイルが置かれているルートディレクトリの権限に依存するらすぃ。
というのも、/home/homepageの権限を700から777に変えたらうまくいく。
も少し詳しく調べてみたい。。
■
最近、仮想化技術の一つ、xen(-3.0.3)に触っていることもあってか、
linuxを支えている基本技術をきちんと学ぼうと思っている。
(つまりはトラブってるってこと...orz )
今回は、その基本技術の1つの『ファイルシステム(FS)』について。
Data::Visitor
なんじゃこのモジュールは。。