# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Plugins
#   Author  : Alex Krohn
#   CVS Info :                          
#   $Id: Plugins.pm,v 1.55 2005/04/01 00:16:51 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description: A plugin system for CGI scripts.
#

package GT::Plugins;
# ==================================================================
use strict;
# TODO: Eventually we want to get rid of the $ACTION global, but it would break
# rather a lot to do so.
use vars qw/$VERSION $DEBUG $ERRORS $ATTRIBS $ACTION $error @ISA $AUTOLOAD @EXPORT/;
use GT::Base;
use GT::Config;
use GT::AutoLoader;

@ISA    = qw/GT::Base/;
$ERRORS = {
    BADARGS      => "Invalid arguments. Usage: %s",
    CANTLOAD     => "Unable to load plugin '%s': %s",
    CANTOPEN     => "Unable to open '%s': %s",
    CANTDELETE   => "Unable to remove plugin file '%s': %s",
    CANTMOVE     => "Unable to move plugin %s from '%s' to '%s': %s",
    CANTREMOVE   => "Unable to remove plugin file '%s': %s",
    PLUGEXISTS   => "The plugin '%s' already exists, unable to overwrite without confirmation",
    NOINSTALL    => "Unable to load install code in plugin '%s'. Missing Install.pm file.",
    NOCODE       => "Unable to load main code for plugin '%s' from tar file. Missing '%s.pm' file.",
    NOPLUGINNAME => "Please name your plugin before calling save()",
    NOPLUGIN     => "There is no plugin named '%s' in the config file.",
    CORRUPTCFG   => "Syntax error in config file: %s",
    PLUGINERR    => "Error running plugin '%s' hook '%s': %s"
};
$ATTRIBS = { directory => undef, prefix => '' };
$DEBUG   = 0;
$VERSION = sprintf "%d.%03d", q$Revision: 1.55 $ =~ /(\d+)\.(\d+)/;

# Actions that plugins can handle.
use constants
    STOP     => 1,
    CONTINUE => 2,

    NAME    => 0,
    TYPE    => 1,
    HOOK    => 2,
    ENABLED => 3;

@EXPORT = qw/STOP CONTINUE/;

sub init {
# -----------------------------------------------------------------
# Set our debug level and any extra options.
#
    my $self = shift;
    my @args = @_;
    if (@args == 1 and not ref $args[0]) {
        @args = (directory => @args);
    }

    $self->set(@args);

    if ($self->{debug}) {
        $self->{_debug} = delete $self->{debug};
    }

    $self->{directory} or $self->fatal(BADARGS => 'No directory passed to GT::Plugins->new()');

    $self->load_cfg;

    return $self;
}

sub active_plugins {
# -----------------------------------------------------------------------------
# Class/object method that returns a boolean value indicating whether or not
# the given argument (a plugin hook name) has any registered plugin hooks.
# Primarily designed for optimizations where a section of code isn't needed
# except for plugins.
#
    my $self = shift;
    my $config = ref $self ? $self->{config} : $self->load_cfg(shift);

    my $hook_name = lc shift;

    return (
        exists $config->{_pre_hooks}->{$hook_name}  and @{$config->{_pre_hooks}->{$hook_name}} or
        exists $config->{_post_hooks}->{$hook_name} and @{$config->{_post_hooks}->{$hook_name}}
    ) ? 1 : undef;
}

sub dispatch {
# -----------------------------------------------------------------
# Class Method to Run plugins.
#
    my $self = shift;
    my $directory;
    my $config = ref $self ? $self->{config} : $self->load_cfg($directory = shift);
    my ($hook_name, $code, @args) = @_;

    $hook_name = lc $hook_name;

# Run any pre hooks.
    my @results;
    my $debug = ref $self ? $self->{_debug} : $DEBUG;

    if (exists $config->{_pre_hooks}->{$hook_name}) {
        local $^W; no strict 'refs';
# Save our action in case plugins is called twice.
        my $orig_action = $ACTION;
        foreach my $hook (@{$config->{_pre_hooks}->{$hook_name}}) {
            $self->debug("Plugin: pre $hook_name running => $hook") if $debug;
            defined &{$hook} or $self->_load_hook($hook, 'PRE') or next;
            $ACTION = CONTINUE;
            @results = $hook->(@args);
            if ($ACTION == STOP) {
                $self->debug("Plugin pre hook $hook_name stopped further plugins.") if $debug;
                last;
            }
        }
        unless ($ACTION == STOP) {
            @results = $code->(@args);
        }
        $ACTION = $orig_action;
    }
    else {
        @results = $code->(@args);
    }

# Run any post hooks.
    if (exists $config->{_post_hooks}->{$hook_name}) {
        local ($^W); no strict 'refs';
        my $orig_action = $ACTION;
        foreach my $hook (@{$config->{_post_hooks}->{$hook_name}}) {
            $self->debug("Plugin: post $hook_name running => $hook") if $debug;
            defined &{$hook} or $self->_load_hook($hook, 'POST') or next;
            $ACTION = CONTINUE;
            @results = $hook->(@results);
            if ($ACTION == STOP) {
                $self->debug("Plugin post hook $hook_name stopped further plugins.") if $debug;
                last;
            }
        }
        $ACTION = $orig_action;
    }

# Must return as a list
    return @results ? (@results)[0 .. $#results] : ();
}

sub dispatch_method {
# -----------------------------------------------------------------
# Class Method to Run plugins.
#
    my $self = shift;
    my $directory;
    my $config = ref $self ? $self->{config} : $self->load_cfg($directory = shift);
    my ($hook_name, $object, $method, @args) = @_;
    $hook_name = lc $hook_name;

    my $debug = ref $self ? $self->{_debug} : $DEBUG;

# Run any pre hooks.
    my @results;
    if (exists $config->{_pre_hooks}->{$hook_name}) {
        local ($^W); no strict 'refs';
# Save our action in case plugins is called twice.
        my $orig_action = $ACTION;
        foreach my $hook (@{$config->{_pre_hooks}->{$hook_name}}) {
            $self->debug("Plugin: pre $hook_name running => $hook") if $debug;
            defined &{$hook} or $self->_load_hook($hook, 'PRE') or next;
            $ACTION = CONTINUE;
            @results = $hook->($object, @args);
            $ACTION == STOP and last;
        }
        unless ($ACTION == STOP) {
            @results = $object->$method(@args);
        }
        $ACTION = $orig_action;
    }
    else {
        @results = $object->$method(@args);
    }

# Run any post hooks.
    if (exists $config->{_post_hooks}->{$hook_name}) {
        local ($^W); no strict 'refs';
        my $orig_action = $ACTION;
        foreach my $hook (@{$config->{_post_hooks}->{$hook_name}}) {
            $self->debug("Plugin: post $hook_name running => $hook") if $debug;
            defined &{$hook} or $self->_load_hook($hook, 'POST') or next;
            $ACTION = CONTINUE;
            @results = $hook->($object, @results);
            # If the post hook returned the object as the first return value
            # that probably means it returned @_ unaltered, in which case we
            # want to remove it so that @results doesn't end up with any number
            # of objects stuck to the beginning of arguments/return values.
            shift @results if ref $object and ref $results[0] and $object == $results[0];

            $ACTION == STOP and last;
        }
        $ACTION = $orig_action;
    }

# Must return as a list
    return @results ? (@results)[0 .. $#results] : ();
}

sub load_cfg {
# -----------------------------------------------------------------
# Load the plugin config file.
#
    my ($self, $directory) = @_;
    $directory ||= ref $self ? $self->{directory} : '.';

    my $cfg = GT::Config->load("$directory/plugin.cfg", { local => 0, inheritance => 0, create_ok => 1 });

    if (!$cfg and ref $self ? $self->{_debug} : $DEBUG) {
        $self->debug("Unable to load plugin config file '$directory/plugin.cfg': $GT::Config::error");
    }

    # Take care to delete _pre_hooks just in case the file was somehow saved
    # with _pre_hooks in it.
    delete $cfg->{_pre_hooks} if not $cfg->cache_hit;

    # If _pre_hooks exists, the config was loaded from the cache, and the below
    # has already been calculated.
    unless ($cfg->{_pre_hooks}) {
        $cfg->{_pre_hooks}  = {};
        $cfg->{_post_hooks} = {};
        while (my ($plugin, $config) = each %$cfg) {
            next if substr($plugin, 0, 1) eq '_' or ref $config->{hooks} ne 'ARRAY';
            for my $hook (@{$config->{hooks}}) {
                next unless $hook->[ENABLED] and ($hook->[TYPE] eq 'PRE' or $hook->[TYPE] eq 'POST');
                push @{$cfg->{$hook->[TYPE] eq 'PRE' ? '_pre_hooks' : '_post_hooks'}->{lc $hook->[NAME]}}, $hook->[HOOK];
            }
        }
    }

    $self->{config} = $cfg if ref $self;
    return $cfg;
}

$COMPILE{save_cfg} = __LINE__ . <<'END_OF_SUB';
sub save_cfg {
# -----------------------------------------------------------------
# Save the plugin cfg file.  OO usage: $plugin_obj->save;  Deprecated, non-OO
# usage: GT::Plugins->save_cfg($plugin_config_object);  Also supported is:
# GT::Plugins->save_cfg($ignored_value, $plugin_config_object); for
# compatibility reasons.  These are almost equivelant to
# $plugin_config_object->save, except that they remove the internal _pre_hooks
# and _post_hooks keys first, then restore them after saving.
#
    my $self = shift;
    my $config = ref $self ? $self->{config} : @_ > 1 ? $_[1] : $_[0];

    my ($pre, $post) = delete @$config{qw/_pre_hooks _post_hooks/};

    $config->save();

    @$config{qw/_pre_hooks _post_hooks/} = ($pre, $post);

    return 1;
}
END_OF_SUB

sub action {
# -------------------------------------------------------------------
# Sets the action the plugin wants.
#
    $ACTION = $_[1];
}

$COMPILE{_load_hook} = __LINE__ . <<'END_OF_SUB';
sub _load_hook {
# -------------------------------------------------------------------
# Loads a module and checks for the hook.
#
    my ($self, $hook, $stage) = @_;
    my ($pkg) = $hook =~ /^(.*)::[^:]+$/ or return;
    $pkg =~ s,::,/,g;
    {
        local $SIG{__DIE__};
        eval { require "$pkg.pm" };
    }
    if ($@) {
        return $self->error('PLUGINERR', 'FATAL', $stage, $hook, "$@");
    }
    if (! defined &{$hook}) {
        return $self->error('PLUGINERR', 'FATAL', $stage, $hook, "$hook does not exist in $pkg");
    }
    return 1;
}
END_OF_SUB

$COMPILE{reset_env} = __LINE__ . <<'END_OF_SUB';
sub reset_env { }
END_OF_SUB

1;

__END__

=head1 NAME

GT::Plugins - a plugin interface for Gossamer Threads products.

=head1 SYNOPSIS

    use GT::Plugins;
    $PLUGIN = GT::Plugins->new('/path/to/plugin/dir');

    $PLUGIN->dispatch(hook_name => \&code_ref => @args);
    $PLUGIN->dispatch_method(hook_name => $self => method => @args);

Old style, now deprecated in favour of the object approach above:

    use GT::Plugins;

    GT::Plugins->dispatch('/path/to/plugin/dir', hook_name => \&code_ref => @args);
    GT::Plugins->dispatch_method('/path/to/plugin/dir', hook_name => $self => method => @args);

=head1 DESCRIPTION

The plugin module supports two modes of use.  The first mode involves creating
and using a GT::Plugins object upon which plugin dispatch methods may be called
to provide hooks.  The second does not use the object, but instead uses class
methods with an extra argument of the plugin path preceding the other
->dispatch() arguments.

Of the two approaches, the object approach is recommended as it is a) faster,
and b) requires much less value duplication as the plugin directory needs to be
specified only once.  The old, class-method-based plugin interface should be
considered deprecated, and all new code should attempt to use the object-based
system.

A dispatch with each of the two interfaces work as follows, with differences in
interfaces as noted:

=over 4

=item 1.

Loads the plugin config file.  The actual file access and evaluation will be
cached, but a small amount of extra overhead is required on each dispatch.
This only applies to the deprecated class-method dispatch interface - the
preferred object interface loads the configuration file only once.

=item 2.

Runs any 'PRE' hooks registered in the config file.  When using ->dispatch(),
each hook is passed the C<@args> arguments passed into ->dispatch.  When using
->dispatch_method(), both the object ($self) and arguments (@args) are passed
to the hook.

Each plugin hook then has the ability to abort further plugins if desired by
calling C<$PLUGIN-E<gt>action(STOP)> (or C<GT::Plugins-E<gt>action(STOP)> for
the non-OO interface).  STOP is exported by default from the GT::Plugins
module.  Performing a STOP will skip both any further 'PRE' hooks and the
original function/method, and will use the hook's return value instead of the
real code's return value.

The current behaviour of 'PRE' hooks ignores the return value of any 'PRE' hook
that does not perform a STOP, however this behaviour B<may> change to use the
return value as the arguments to the next PRE hook or actual code called.  As
such, it is strongly recommended to return @_ from any 'PRE' hooks.

=item 3.

Assuming C<-E<gt>action(STOP)> has not been called, the method
(->dispatch_method) or code reference (->dispatch) will be called, and its
return value stored.

=item 4.

Any registered 'POST' hooks registered in the config file will be run.  When
using ->dispatch(), the list-context return value of the main code run (or, if
a 'PRE' hook called STOP, the return value of that 'PRE' hook) will be passed
in.  When using ->dispatch_method(), the object is additionally passed in as
the first argument.

The list returned by the 'POST' hook will be used as arguments for any
subsequent 'POST' hooks and as the final result returned by the ->dispatch() or
->dispatch_method() call.  There is one exception to this - for
->dispatch_method() 'POST' hooks, if the first argument of the return value is
the object, it will be removed; this is done to prevent a build-up of excess
objects at the beginning of the 'POST' hook arguments/return values due to
'POST' hooks simply returning @_ unaltered.

=item 5.

The return value of the final 'POST' hook, or, when no post hooks are
configured, of the actual code, is returned as the result of the ->dispatch()
call.

=back

=head1 SEE ALSO

Also included as part of the plugin system are some modules for web based tools
to manage plugins:

L<GT::Plugins::Manager> - Add, remove and edit plugin files.

L<GT::Plugins::Wizard> - Create shell plugins.

L<GT::Plugins::Installer> - Used in installing plugins.

=head1 COPYRIGHT

Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: Plugins.pm,v 1.55 2005/04/01 00:16:51 brewt Exp $

=cut