PC Professionell 2004 December/PCpro_2004_12.ISO/files/webserver/tsw/TSW_3.4.0.exe/Apache2/perl/Document.pm

Perl POD Document | 2004-01-30 | 14.8 KB | 493 lines

##============================================================= -*-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   <[e-mail]>
#
# COPYRIGHT
#   Copyright (C) 1996-2000 Andy Wardley.  All Rights Reserved.
#   Copyright (C) 1998-2000 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.
#
#----------------------------------------------------------------------------
#
# $Id: Document.pm,v 2.71 2004/01/13 16:19:10 abw Exp $
#
#============================================================================

package Template::Document;

require 5.004;

use strict;
use vars qw( $VERSION $ERROR $COMPERR $DEBUG $AUTOLOAD );
use base qw( Template::Base );
use Template::Constants;

$VERSION = sprintf("%d.%02d", q$Revision: 2.71 $ =~ /(\d+)\.(\d+)/);


#========================================================================
#                     -----  PUBLIC METHODS -----
#========================================================================

#------------------------------------------------------------------------
# new(\%document)
#
# Creates a new self-contained Template::Document object which
# encapsulates a compiled Perl sub-routine, $block, any additional
# BLOCKs defined within the document ($defblocks, also Perl sub-routines)
# and additional $metadata about the document.
#------------------------------------------------------------------------

sub new {
    my ($class, $doc) = @_;
    my ($block, $defblocks, $metadata) = @$doc{ qw( BLOCK DEFBLOCKS METADATA ) };
    $defblocks ||= { };
    $metadata  ||= { };

    # evaluate Perl code in $block to create sub-routine reference if necessary
    unless (ref $block) {
        local $SIG{__WARN__} = \&catch_warnings;
        $COMPERR = '';

        # DON'T LOOK NOW! - blindly untainting can make you go blind!
        $block =~ /(.*)/s;
        $block = $1;

        $block = eval $block;
        return $class->error($@)
            unless defined $block;
    }

    # same for any additional BLOCK definitions
    @$defblocks{ keys %$defblocks } =
        # MORE BLIND UNTAINTING - turn away if you're squeamish
        map {
            ref($_)
                ? $_
                : ( /(.*)/s && eval($1) or return $class->error($@) )
            } values %$defblocks;

    bless {
        %$metadata,
        _BLOCK     => $block,
        _DEFBLOCKS => $defblocks,
        _HOT       => 0,
    }, $class;
}


#------------------------------------------------------------------------
# block()
#
# Returns a reference to the internal sub-routine reference, _BLOCK,
# that constitutes the main document template.
#------------------------------------------------------------------------

sub block {
    return $_[0]->{ _BLOCK };
}


#------------------------------------------------------------------------
# blocks()
#
# Returns a reference to a hash array containing any BLOCK definitions
# from the template.  The hash keys are the BLOCK nameand the values
# are references to Template::Document objects.  Returns 0 (# an empty hash)
# if no blocks are defined.
#------------------------------------------------------------------------

sub blocks {
    return $_[0]->{ _DEFBLOCKS };
}


#------------------------------------------------------------------------
# process($context)
#
# Process the document in a particular context.  Checks for recursion,
# registers the document with the context via visit(), processes itself,
# and then unwinds with a large gin and tonic.
#------------------------------------------------------------------------

sub process {
    my ($self, $context) = @_;
    my $defblocks = $self->{ _DEFBLOCKS };
    my $output;


    # check we're not already visiting this template
    return $context->throw(Template::Constants::ERROR_FILE,
                           "recursion into '$self->{ name }'")
        if $self->{ _HOT } && ! $context->{ RECURSION };   ## RETURN ##

    $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;
}


#------------------------------------------------------------------------
# AUTOLOAD
#
# Provides pseudo-methods for read-only access to various internal
# members.
#------------------------------------------------------------------------

sub AUTOLOAD {
    my $self   = shift;
    my $method = $AUTOLOAD;

    $method =~ s/.*:://;
    return if $method eq 'DESTROY';
#    my ($pkg, $file, $line) = caller();
#    print STDERR "called $self->AUTOLOAD($method) from $file line $line\n";
    return $self->{ $method };
}


#========================================================================
#                     -----  PRIVATE METHODS -----
#========================================================================


#------------------------------------------------------------------------
# _dump()
#
# Debug method which returns a string representing the internal state
# of the object.
#------------------------------------------------------------------------

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;
}


#========================================================================
#                      ----- CLASS METHODS -----
#========================================================================

#------------------------------------------------------------------------
# as_perl($content)
#
# This method expects a reference to a hash passed as the first argument
# containing 3 items:
#     METADATA   # a hash of template metadata
#     BLOCK      # string containing Perl sub definition for main block
#     DEFBLOCKS  # hash containing further subs for addional BLOCK defs
# It returns a string containing Perl code which, when evaluated and
# executed, will instantiate a new Template::Document object with the
# above data.  On error, it returns undef with an appropriate error
# message set in $ERROR.
#------------------------------------------------------------------------

sub as_perl {
    my ($class, $content) = @_;
    my ($block, $defblocks, $metadata) = @$content{ qw( BLOCK DEFBLOCKS METADATA ) };

    $block =~ s/\n/\n    /g;
    $block =~ s/\s+$//;

    $defblocks = join('', map {
    my $code = $defblocks->{ $_ };
    $code =~ s/\n/\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
#------------------------------------------------------------------------
# Compiled template generated by the Template Toolkit version $Template::VERSION
#------------------------------------------------------------------------

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


#------------------------------------------------------------------------
# write_perl_file($filename, \%content)
#
# This method calls as_perl() to generate the Perl code to represent a
# compiled template with the content passed as the second argument.
# It then writes this to the file denoted by the first argument.
#
# Returns 1 on success.  On error, sets the $ERROR package variable
# to contain an error message and returns undef.
#------------------------------------------------------------------------

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)
        );
    print $fh $class->as_perl($content) || die $!;
    close($fh);
    };
    return $class->error($@) if $@;
    return rename($tmpfile, $file)
    || $class->error($!);
}


#------------------------------------------------------------------------
# catch_warnings($msg)
#
# Installed as
#------------------------------------------------------------------------

sub catch_warnings {
    $COMPERR .= join('', @_);
}


1;

__END__


#------------------------------------------------------------------------
# IMPORTANT NOTE
#   This documentation is generated automatically from source
#   templates.  Any changes you make here may be lost.
#
#   The 'docsrc' documentation source bundle is available for download
#   from http://www.template-toolkit.org/docs.html and contains all
#   the source templates, XML files, scripts, etc., from which the
#   documentation for the Template Toolkit is built.
#------------------------------------------------------------------------

=head1 NAME

Template::Document - Compiled template document object

=head1 SYNOPSIS

    use Template::Document;

    $doc = Template::Document->new({
    BLOCK => sub { # some perl code; return $some_text },
    DEFBLOCKS => {
        header => sub { # more perl code; return $some_text },
        footer => sub { # blah blah blah; return $some_text },
    },
    METADATA => {
        author  => 'Andy Wardley',
        version => 3.14,
    }
    }) || die $Template::Document::ERROR;

    print $doc->process($context);

=head1 DESCRIPTION

This module defines an object class whose instances represent compiled
template documents.  The Template::Parser module creates a
Template::Document instance to encapsulate a template as it is compiled
into Perl code.

The constructor method, new(), expects a reference to a hash array
containing the BLOCK, DEFBLOCKS and METADATA items.  The BLOCK item
should contain a reference to a Perl subroutine or a textual
representation of Perl code, as generated by the Template::Parser
module, which is then evaluated into a subroutine reference using
eval().  The DEFLOCKS item should reference a hash array containing
further named BLOCKs which may be defined in the template.  The keys
represent BLOCK names and the values should be subroutine references
or text strings of Perl code as per the main BLOCK item.  The METADATA
item should reference a hash array of metadata items relevant to the
document.

The process() method can then be called on the instantiated
Template::Document object, passing a reference to a Template::Content
object as the first parameter.  This will install any locally defined
blocks (DEFBLOCKS) in the the contexts() BLOCKS cache (via a call to
visit()) so that they may be subsequently resolved by the context.  The
main BLOCK subroutine is then executed, passing the context reference
on as a parameter.  The text returned from the template subroutine is
then returned by the process() method, after calling the context leave()
method to permit cleanup and de-registration of named BLOCKS previously
installed.

An AUTOLOAD method provides access to the METADATA items for the document.
The Template::Service module installs a reference to the main
Template::Document object in the stash as the 'template' variable.
This allows metadata items to be accessed from within templates,
including PRE_PROCESS templates.

header:

    <html>
    <head>
    <title>[% template.title %]
    </head>
    ...

Template::Document objects are usually created by the Template::Parser
but can be manually instantiated or sub-classed to provide custom
template components.

=head1 METHODS

=head2 new(\%config)

Constructor method which accept a reference to a hash array containing the
structure as shown in this example:

    $doc = Template::Document->new({
    BLOCK => sub { # some perl code; return $some_text },
    DEFBLOCKS => {
        header => sub { # more perl code; return $some_text },
        footer => sub { # blah blah blah; return $some_text },
    },
    METADATA => {
        author  => 'Andy Wardley',
        version => 3.14,
    }
    }) || die $Template::Document::ERROR;

BLOCK and DEFBLOCKS items may be expressed as references to Perl subroutines
or as text strings containing Perl subroutine definitions, as is generated
by the Template::Parser module.  These are evaluated into subroutine references
using eval().

Returns a new Template::Document object or undef on error.  The error() class
method can be called, or the $ERROR package variable inspected to retrieve
the relevant error message.

=head2 process($context)

Main processing routine for the compiled template document.  A reference to
a Template::Context object should be passed as the first parameter.  The
method installs any locally defined blocks via a call to the context
visit() method, processes it's own template, passing the context reference
by parameter and then calls leave() in the context to allow cleanup.

    print $doc->process($context);

Returns a text string representing the generated output for the template.
Errors are thrown via die().

=head2 block()

Returns a reference to the main BLOCK subroutine.

=head2 blocks()

Returns a reference to the hash array of named DEFBLOCKS subroutines.

=head2 AUTOLOAD

An autoload method returns METADATA items.

    print $doc->author();

=head1 PACKAGE SUB-ROUTINES

=head2 write_perl_file(\%config)

This package subroutine is provided to effect persistance of compiled
templates.  If the COMPILE_EXT option (to indicate a file extension
for saving compiled templates) then the Template::Parser module calls
this subroutine before calling the new() constructor.  At this stage,
the parser has a representation of the template as text strings
containing Perl code.  We can write that to a file, enclosed in a
small wrapper which will allow us to susequently require() the file
and have Perl parse and compile it into a Template::Document.  Thus we
have persistance of compiled templates.

=head1 AUTHOR

Andy Wardley E<lt>[e-mail]<gt>

L<http://www.andywardley.com/|http://www.andywardley.com/>




=head1 VERSION

2.71, distributed as part of the
Template Toolkit version 2.13, released on 30 January 2004.

=head1 COPYRIGHT

  Copyright (C) 1996-2004 Andy Wardley.  All Rights Reserved.
  Copyright (C) 1998-2002 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.

=head1 SEE ALSO

L<Template|Template>, L<Template::Parser|Template::Parser>

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: