259 lines
7.1 KiB
Perl
259 lines
7.1 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Plugins
|
|
# Author : Alex Krohn
|
|
# CVS Info :
|
|
# $Id: Installer.pm,v 1.13 2004/08/23 19:54:27 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: A web based admin to install/uninstall plugins.
|
|
#
|
|
|
|
package GT::Plugins::Installer;
|
|
# ==================================================================
|
|
use strict;
|
|
|
|
use vars qw/@ISA $ATTRIBS $ERROR_MESSAGE $VERSION $DEBUG/;
|
|
use GT::Base;
|
|
use GT::Plugins;
|
|
use GT::Tar;
|
|
|
|
$ERROR_MESSAGE = 'GT::Plugins';
|
|
$DEBUG = 0;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/;
|
|
$ATTRIBS = {
|
|
plugin_dir => undef,
|
|
prog_ver => undef,
|
|
prog_user_cgi => undef,
|
|
prog_admin_cgi => undef,
|
|
prog_images => undef,
|
|
prog_libs => undef
|
|
};
|
|
@ISA = qw/GT::Base/;
|
|
|
|
sub init {
|
|
# ----------------------------------------------------------------
|
|
# Load the plugin config file on init() called from GT::Base.
|
|
#
|
|
my $self = shift;
|
|
my $param = $self->common_param(@_);
|
|
$self->set($param);
|
|
if (! $self->{plugin_dir} or ! -d $self->{plugin_dir}) {
|
|
return $self->error('BADARGS', 'FATAL', "missing/invalid plugin dir passed to manager.");
|
|
}
|
|
$self->{cfg} = GT::Plugins->load_cfg($self->{plugin_dir});
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------------------- #
|
|
# Utilities used in Install/Uninstall by Plugins #
|
|
# ----------------------------------------------------------------------------------------- #
|
|
|
|
sub install_hooks {
|
|
# -----------------------------------------------------------------
|
|
# Register a list of plugin hooks.
|
|
#
|
|
my ($self, $plugin, $hooks) = @_;
|
|
if (ref $hooks ne 'ARRAY') {
|
|
return $self->error('BADARGS', 'FATAL', "Usage: $self->install_menu('PLUGINNAME', [['hookname', 'PRE/POST', 'action'], ...])");
|
|
}
|
|
if (ref $hooks->[0] ne 'ARRAY') {
|
|
$hooks = [ $hooks ];
|
|
}
|
|
foreach my $hook (@$hooks) {
|
|
my ($hookname, $prepost, $action) = @$hook;
|
|
if (! ((uc $prepost eq 'PRE') or (uc $prepost eq 'POST'))) {
|
|
die "Invalid hook argument. Must be pre/post, not: $prepost";
|
|
}
|
|
push @{$self->{cfg}->{$plugin}->{hooks}}, [lc $hookname, uc $prepost, $action, 1];
|
|
}
|
|
GT::Plugins->save_cfg($self->{plugin_dir}, $self->{cfg});
|
|
}
|
|
|
|
sub install_menu {
|
|
# -----------------------------------------------------------------
|
|
# Register a list of menu options for a plugin.
|
|
#
|
|
my ($self, $plugin, $menus) = @_;
|
|
if (ref $menus ne 'ARRAY') {
|
|
return $self->error('BADARGS', 'FATAL', "Usage: $self->install_menu('PLUGINNAME', [['title', 'url'], ...])");
|
|
}
|
|
if (ref $menus->[0] ne 'ARRAY') {
|
|
$menus = [ $menus ];
|
|
}
|
|
foreach my $menu (@$menus) {
|
|
push @{$self->{cfg}->{$plugin}->{menu}}, $menu;
|
|
}
|
|
GT::Plugins->save_cfg($self->{plugin_dir}, $self->{cfg});
|
|
}
|
|
|
|
sub install_options {
|
|
# -----------------------------------------------------------------
|
|
# Register a list of options for a plugin.
|
|
#
|
|
my ($self, $plugin, $opts, ) = @_;
|
|
if (ref $opts ne 'ARRAY') {
|
|
return $self->error('BADARGS', 'FATAL', "Usage: $self->install_options('PLUGINNAME', [['name', 'val', 'instructions'] ...])");
|
|
}
|
|
if (ref $opts->[0] ne 'ARRAY') {
|
|
$opts = [ $opts ];
|
|
}
|
|
foreach my $opt (@$opts) {
|
|
exists $self->{cfg}->{$plugin}->{user} or ($self->{cfg}->{$plugin}->{user} = []);
|
|
push @{$self->{cfg}->{$plugin}->{user}}, $opt;
|
|
}
|
|
GT::Plugins->save_cfg($self->{plugin_dir}, $self->{cfg});
|
|
}
|
|
|
|
sub install_registry {
|
|
# -----------------------------------------------------------------
|
|
# Register a registry item for a plugin.
|
|
#
|
|
my ($self, $plugin, $opts) = @_;
|
|
if (ref $opts ne 'HASH') {
|
|
return $self->error('BADARGS', 'FATAL', "Usage: $self->install_options('PLUGINNAME', { key => value, ... })");
|
|
}
|
|
my $registry = ($self->{cfg}->{$plugin}->{registry} ||= {});
|
|
foreach my $key (keys %$registry) {
|
|
$registry->{$key} = $registry->{$key};
|
|
}
|
|
|
|
GT::Plugins->save_cfg($self->{plugin_dir}, $self->{cfg});
|
|
}
|
|
|
|
sub uninstall_hooks {
|
|
# -----------------------------------------------------------------
|
|
# Remove plugins, just a no-op as the config gets deleted.
|
|
#
|
|
my ($self, $plugin, $hooks) = @_;
|
|
return 1;
|
|
}
|
|
|
|
sub uninstall_menu {
|
|
# -----------------------------------------------------------------
|
|
# Remove menus, no-op as config gets deleted.
|
|
#
|
|
my ($self, $plugin, $menus) = @_;
|
|
return 1;
|
|
}
|
|
|
|
sub uninstall_options {
|
|
# -----------------------------------------------------------------
|
|
# Remove options, just a no-op as config gets deleted.
|
|
#
|
|
my ($self, $plugin, $opts) = @_;
|
|
return 1;
|
|
}
|
|
|
|
sub uninstall_registry {
|
|
# -----------------------------------------------------------------
|
|
# Remove registry, just a no-op as config gets deleted.
|
|
#
|
|
return 1;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Plugins::Installer
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
$mgr->install_hooks('PluginName', ['hook_name', 'PRE|POST', 'code']);
|
|
$mgr->install_menu('PluginName', ['menu_name', 'menu_url', 'enabled']);
|
|
$mgr->install_options('PluginName', ['option_key', 'option_val', 'instructions']);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The installer is an object that is passed into plugins during installation.
|
|
It provides methods to add hooks, menu options, admin options or copy files
|
|
into the users application.
|
|
|
|
=head2 install_hooks
|
|
|
|
C<install_hooks> takes as arguments the plugin name and an array of:
|
|
|
|
=over 4
|
|
|
|
=item hook_name
|
|
|
|
The hook you want to override.
|
|
|
|
=item PRE/POST
|
|
|
|
Either the string PRE or POST depending on whether the hook should be run
|
|
before the main code, or after.
|
|
|
|
=item code
|
|
|
|
The name of the code to run. It should be Plugins::PACKAGE::YourPluginName::function.
|
|
Where PACKAGE is the name of the Gossamer Product the plugin is for. For example
|
|
Plugins::GMail::Wap::header
|
|
|
|
=back
|
|
|
|
C<install_hooks> returns 1 on success, undef on failure with the error
|
|
message in $GT::Plugins::error.
|
|
|
|
=head2 install_menu
|
|
|
|
C<install_menu> takes as arguments the plugin name and an array of:
|
|
|
|
=over 4
|
|
|
|
=item menu_name
|
|
|
|
The name that will show up in the admin menu.
|
|
|
|
=item menu_url
|
|
|
|
The URL for the menu option.
|
|
|
|
=item enabled
|
|
|
|
Either true or false depending on whether the menu option should be shown.
|
|
|
|
=back
|
|
|
|
C<install_menu> returns 1 on success, undef on failure with the error
|
|
message in $GT::Plugins::error.
|
|
|
|
=head2 install_options
|
|
|
|
C<install_options> takes as arguments the plugin name and an array of:
|
|
|
|
=over 4
|
|
|
|
=item option_key
|
|
|
|
This is the key, and is used when accessing the options hash.
|
|
|
|
=item option_value
|
|
|
|
This is the default value.
|
|
|
|
=item instructions
|
|
|
|
A string instruction users on what the plugin does.
|
|
|
|
=back
|
|
|
|
C<install_options> returns 1 on success, undef on failure with the error
|
|
message in $GT::Plugins::error.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Installer.pm,v 1.13 2004/08/23 19:54:27 jagerman Exp $
|
|
|
|
=cut
|