##============================================================= -*-Perl-*-
#
# Template::Document
#
# DESCRIPTION
#   Module defining a class of objects which encapsulate compiled
#   templates, storing additional block definitions and metadata 
#   as well as the compiled Perl sub-routine representing the main
#   template content.
#
# 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::Document;use strict;use warnings;use base 'Template::Base';use Template::Constants;our$VERSION=2.79;our$DEBUG=0 unless defined$DEBUG;our$ERROR='';our($COMPERR,$AUTOLOAD,$UNICODE);BEGIN{if($UNICODE=$]>5.007?1:0){if($]>5.008){*is_utf8=\&utf8::is_utf8;}elsif($]==5.008){require Encode;*is_utf8=\&Encode::is_utf8;}}}sub new{my($class,$doc)=@_;my($block,$defblocks,$variables,$metadata)=@$doc{qw(BLOCK DEFBLOCKS VARIABLES METADATA)};$defblocks||={};$metadata||={};unless(ref$block){local$SIG{__WARN__}=\&catch_warnings;$COMPERR='';$block=~/(.*)/s;$block=$1;$block=eval$block;return$class->error($@)unless defined$block;}@$defblocks{keys%$defblocks}=map{ref($_)?$_:(/(.*)/s&&eval($1)or return$class->error($@))}values%$defblocks;bless{%$metadata,_BLOCK=>$block,_DEFBLOCKS=>$defblocks,_VARIABLES=>$variables,_HOT=>0,},$class;}sub block{return$_[0]->{_BLOCK};}sub blocks{return$_[0]->{_DEFBLOCKS};}sub variables{return$_[0]->{_VARIABLES};}sub process{my($self,$context)=@_;my$defblocks=$self->{_DEFBLOCKS};my$output;return$context->throw(Template::Constants::ERROR_FILE,"recursion into '$self->{ name }'")if$self->{_HOT}&&!$context->{RECURSION};$context->visit($self,$defblocks);$self->{_HOT}=1;eval{my$block=$self->{_BLOCK};$output=&$block($context);};$self->{_HOT}=0;$context->leave();die$context->catch($@)if$@;return$output;}sub AUTOLOAD{my$self=shift;my$method=$AUTOLOAD;$method=~s/.*:://;return if$method eq 'DESTROY';return$self->{$method};}sub _dump{my$self=shift;my$dblks;my$output="$self : $self->{ name }\n";$output.="BLOCK: $self->{ _BLOCK }\nDEFBLOCKS:\n";if($dblks=$self->{_DEFBLOCKS}){foreach my$b(keys%$dblks){$output.="    $b: $dblks->{ $b }\n";}}return$output;}sub as_perl{my($class,$content)=@_;my($block,$defblocks,$metadata)=@$content{qw(BLOCK DEFBLOCKS METADATA)};$block=~s/\n(?!#line)/\n    /g;$block=~s/\s+$//;$defblocks=join('',map{my$code=$defblocks->{$_};$code=~s/\n(?!#line)/\n        /g;$code=~s/\s*$//;"        '$_' => $code,\n";}keys%$defblocks);$defblocks=~s/\s+$//;$metadata=join('',map{my$x=$metadata->{$_};$x=~s/(['\\])/\\$1/g;"        '$_' => '$x',\n";}keys%$metadata);$metadata=~s/\s+$//;return<<EOF}sub write_perl_file{my($class,$file,$content)=@_;my($fh,$tmpfile);return$class->error("invalid filename: $file")unless$file=~/^(.+)$/s;eval{require File::Temp;require File::Basename;($fh,$tmpfile)=File::Temp::tempfile(DIR=>File::Basename::dirname($file));my$perlcode=$class->as_perl($content)||die$!;if($UNICODE&&is_utf8($perlcode)){$perlcode="use utf8;\n\n$perlcode";binmode$fh,":utf8";}print$fh $perlcode;close($fh);};return$class->error($@)if$@;return rename($tmpfile,$file)||$class->error($!);}sub catch_warnings{$COMPERR.=join('',@_);}1;__END__
#------------------------------------------------------------------------
# Compiled template generated by the Template Toolkit version $Template::VERSION
#------------------------------------------------------------------------

$class->new({
    METADATA => {
$metadata
    },
    BLOCK => $block,
    DEFBLOCKS => {
$defblocks
    },
});
EOF
