File Coverage

lib/Template/Plugin.pm

Criterion	Covered	Total	%
statement	10	36	27.7
branch	0	10	0.0
condition	0	4	0.0
subroutine	4	8	50.0
pod	2	5	40.0
total	16	63	25.4

#============================================================= -*-Perl-*-
#
# Template::Plugin
#
# DESCRIPTION
#
#   Module defining a base class for a plugin object which can be loaded
#   and instantiated via the USE directive.
#
# AUTHOR
#   Andy Wardley
#
# COPYRIGHT
#   Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it an/or
#   modify it under the same terms as Perl itself.
#
#============================================================================

package Template::Plugin;

use strict;
use warnings;
use base 'Template::Base';

our $VERSION = 2.70;
our $DEBUG   = 0 unless defined $DEBUG;
our $ERROR   = '';
our $AUTOLOAD;


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

#------------------------------------------------------------------------
# load()
#
# Class method called when the plugin module is first loaded.  It
# returns the name of a class (by default, its own class) or a prototype
# object which will be used to instantiate new objects.  The new()
# method is then called against the class name (class method) or
# prototype object (object method) to create a new instances of the
# object.
#------------------------------------------------------------------------

sub load {
    return $_[0];
}


#------------------------------------------------------------------------
# new($context, $delegate, @params)
#
# Object constructor which is called by the Template::Context to
# instantiate a new Plugin object.  This base class constructor is
# used as a general mechanism to load and delegate to other Perl
# modules.  The context is passed as the first parameter, followed by
# a reference to a delegate object or the name of the module which
# should be loaded and instantiated.  Any additional parameters passed
# to the USE directive are forwarded to the new() constructor.
#
# A plugin object is returned which has an AUTOLOAD method to delegate
# requests to the underlying object.
#------------------------------------------------------------------------

sub new {
    my $class = shift;
    bless {
    }, $class;
}

sub old_new {
    my ($class, $context, $delclass, @params) = @_;
    my ($delegate, $delmod);

    return $class->error("no context passed to $class constructor\n")
        unless defined $context;

    if (ref $delclass) {
        # $delclass contains a reference to a delegate object
        $delegate = $delclass;
    }
    else {
        # delclass is the name of a module to load and instantiate
        ($delmod = $delclass) =~ s|::|/|g;

        eval {
            require "$delmod.pm";
            $delegate = $delclass->new(@params)
                || die "failed to instantiate $delclass object\n";
        };
        return $class->error($@) if $@;
    }

    bless {
        _CONTEXT  => $context,
        _DELEGATE => $delegate,
        _PARAMS   => \@params,
    }, $class;
}


#------------------------------------------------------------------------
# fail($error)
#
# Version 1 error reporting function, now replaced by error() inherited
# from Template::Base.  Raises a "deprecated function" warning and then
# calls error().
#------------------------------------------------------------------------

sub fail {
    my $class = shift;
    my ($pkg, $file, $line) = caller();
    warn "Template::Plugin::fail() is deprecated at $file line $line.  Please use error()\n";
    $class->error(@_);
}


#========================================================================
#                      -----  OBJECT METHODS -----
#========================================================================

#------------------------------------------------------------------------
# AUTOLOAD
#
# General catch-all method which delegates all calls to the _DELEGATE
# object.
#------------------------------------------------------------------------

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

    $method =~ s/.*:://;
    return if $method eq 'DESTROY';

    if (ref $self eq 'HASH') {
        my $delegate = $self->{ _DELEGATE } || return;
        return $delegate->$method(@_);
    }
    my ($pkg, $file, $line) = caller();
#    warn "no such '$method' method called on $self at $file line $line\n";
    return undef;
}


1;

__END__