File Coverage

blib/lib/POE/Component/PluginManager.pm

Criterion	Covered	Total	%
statement	18	205	8.7
branch	0	58	0.0
condition	0	12	0.0
subroutine	6	28	21.4
pod	0	17	0.0
total	24	320	7.5

package POE::Component::PluginManager::PluginAPI;

# this is the plugin API.
# i decided to put it in its own class
# so that nobody can mess up with calling
# the wrong methods.
# it also made the design somewhat clearer.
sub new {
    my ( $class, $kernel, $alias ) = @_;
    my $self = {};
    $self->{kernel} = $kernel;
    $self->{alias}  = $alias;
    bless $self, $class;
}

sub warning {
    my $self   = shift;
    my $string = shift;
    $self->{kernel}->post( $self->{alias}, 'plugin_warning', $string );

    # maybe i should rather use poe callbacks here?
}

sub error {
    my $self = shift;
    my $ex   = shift;
    $self->{kernel}->post( $self->{alias}, 'plugin_error', $ex );
}

package POE::Component::PluginManager;
our $VERSION = "0.67";

use strict;
use warnings;
use POE;
use Carp;
use Data::Dumper;
use Class::Unload;

# we need this to unload classes, otherwise
# plugins can't be "reloaded". Maybe in the
# future there should be an option to disable
# this feature, so that PluginManager doesn't
# necesarily depend on this module.
# However, its just working fine for me, so far.

my $pluginmanager_shutdown = 0;
my $DEBUG                  = 0;
my $alias;

sub debug {
    print @_ if $DEBUG;
}

sub new {
    my $type = shift;
    if ( @_ & 1 ) {
        carp('PluginManager->new needs even number of options');
    }
    my %options = @_;

    if ( exists $options{'Alias'} ) {    # the alias
        $alias = $options{'Alias'};
        delete $options{'Alias'};
    }
    else {
        carp '[pluginmanager] Using default Alias \'pluginmanager\'';
        $alias = 'pluginmanager';
    }
    if ( exists $options{'Debug'} ) {    # debugging on/off
        $DEBUG = $options{'Debug'};
        delete $options{'Debug'};
    }
    if ( keys %options > 0 ) {
        carp '[$alias]: Unrecognized options in new(): ' . join( ', ', keys %options );
    }

    # Create a new session for ourself
    POE::Session->create(

        # Our subroutines
        'inline_states' => {

            # Maintenance events
            '_start'            => \&start,                 # initial startup
            '_stop'             => \&stop,                  # cleanup, if needed
            '_dump'             => \&_dump,                 # for debugging purposes
            '_generate_event'   => \&_generate_event,       # for broadcasting events
            '_child'            => \&child,                 # to catch _child events
            'shutdown'          => \&component_shutdown,    # shuts down the component
            'unload'            => \&unload_plugin,         # unload a plugin
            'load'              => \&load_plugin,           # load a plugin.
            'show_plugin_table' => \&show_plugin_table,     # sends a hash
            'register'          => \®ister,              # registers your session
            'unregister'        => \&unregister,            # unregisters your session
            'unregister_all'    => \&unregister_all,        # unregisters all sessions.

            'add_plugin'     => \&add_plugin,               # internally used
            'remove_plugin'  => \&remove_plugin,            # internally used
            'plugin_error'   => \&plugin_error,             # internally used
            'plugin_warning' => \&plugin_warning,           # internally used
            'relayed_warning'=> \&relayed_warning,          # to delay warnings.
        },
    ) or die 'Unable to create a new session!';

    # Return success
    return 1;
}

sub child {
    my ( $reason, $child, $return ) = @_[ ARG0 .. ARG2 ];
    my $plugin_id = $child->ID();

    if ( $reason eq 'create' ) {

        # a new plugin session has been started.
        POE::Kernel->yield( 'add_plugin', $plugin_id, $return );
    }
    elsif ( $reason eq 'lose' ) {

        # a plugin session has stopped
        POE::Kernel->yield( 'remove_plugin', $plugin_id, $return );
    }
}

sub start {
    debug( "[$alias] Plugin manager session has started. Alias: " . $alias . "\n" );
    POE::Kernel->alias_set($alias);

    # make an alias, so that this session won't go away.
    # maybe a feature for later versions: if no alias is specified, increase
    # refcount and return session object.
    my $plugin_api = POE::Component::PluginManager::PluginAPI->new( $_[KERNEL], $alias );

    # create the plugin API (seperate class)
    $_[HEAP]->{plugin_api} = $plugin_api;

}

sub stop {
    debug "[$alias] plugin manager session stopped.\n";
}

sub add_plugin {
    my $plugin_id = $_[ARG0];
    my $arguments = $_[ARG1];

    # a new plugin has come to life. register it to the plugin table.
    my ( $name, $longname, $license, $version, $author ) = @{$arguments} unless ref($arguments) ne 'ARRAY';
    unless ( $name && $longname && $license && $version && $author ) {
        warn "[$alias] $name did not correctly set all values (name, longname, license and version)";
        POE::Kernel->yield( '_generate_event', 'plugin_invalid_values', $name );

        # if a plugin didn't specify at least the name correctly, we will not be able
        # to unload it.
    }
    $_[HEAP]->{plugins}->{$name}->{id}       = $plugin_id;
    $_[HEAP]->{plugins}->{$name}->{longname} = $longname;
    $_[HEAP]->{plugins}->{$name}->{license}  = $license;
    $_[HEAP]->{plugins}->{$name}->{version}  = $version;
    $_[HEAP]->{plugins}->{$name}->{author}   = $author;
    $_[HEAP]->{lookup}->{$plugin_id}         = $name;

    # $_[HEAP]->{lookup} is a reverse lookup table for looking up plugin names by their ID
    POE::Kernel->yield( '_generate_event', 'plugin_started', $name );
}

sub remove_plugin {
    my $plugin_id    = $_[ARG0];
    my $quit_message = $_[ARG1];
    my $name         = $_[HEAP]->{lookup}->{$plugin_id};

    # a plugin has died away.
    # $quit_message is the returned value, if any.
    $quit_message = "quit" unless $quit_message;
    unless ($name) {
        warn "[$alias] WARNING: plugin $plugin_id unregistered, but the pluginmanager didn't knew about it.";
        warn "[$alias] WARNING: this might have been caused by a plugin not registering correctly.";
    }
    delete $_[HEAP]->{plugins}->{$name};
    delete $_[HEAP]->{lookup}->{$plugin_id};
    Class::Unload->unload($name);

    # all of this pretty printing is a bit superfluous.
    # remove it.
    my $spaces = 34 - length($name);
    my $spacer = " " x $spaces;
    debug "[$alias] Plugin unloaded: $name$spacer Quitmsg: $quit_message\n";
    POE::Kernel->yield( '_generate_event', 'plugin_unloaded', $name, $quit_message );

    #check if we want to shutdown
    my $plugin_count = 0;
    if ($pluginmanager_shutdown) {
        foreach ( keys %{ $_[HEAP]->{plugins} } ) {
            $plugin_count++;
        }
        if ( $plugin_count == 0 ) {

            # there are no plugins left, shutdown
            # shut down component here: remove alias
            POE::Kernel->alias_remove($alias);
            POE::Kernel->yield( '_generate_event', 'plugin_manager_shutdown', $plugin_count );
            POE::Kernel->yield("unregister_all");
        }
        else {
            debug "[$alias] waiting for plugins to shut down. Remaining: $plugin_count\n";
            POE::Kernel->yield( '_generate_event', 'plugin_waiting', $plugin_count );
        }
    }
}

sub load_plugin {

    # loads a plugin, parameter: Classname (f.ex YourProgram::Plugins::Foobarplugin)
    my $plugin = $_[ARG0];
    my $data   = $_[ARG1];
    warn "[$alias] warning: no plugin name specified" unless $plugin;
    my $classname = $plugin;      # the classname equals the plugin name supplied
    my $filename  = $classname;
    $filename =~ s#::#/#g;
    $filename .= ".pm";
    if ( $_[HEAP]->{plugins}->{$classname} ) {
        warn "[$alias] warning: plugin $classname already loaded!\n";
        POE::Kernel->yield( '_generate_event', 'plugin_compile_failed', $classname, "plugin already loaded" );
        return;
    }

    #my $classname = ( split( /\./, $filename ) )[0];

    my $spaces = 40 - length($classname);
    my $spacer = " " x $spaces;
    my ( $name, $longname, $license, $version );    #name, longname, license, version (all strings)
    debug "[$alias] loading $classname...$spacer compile: ";
    # this makes the load_plugin signal re-entrant. Thanks to Tim Esselens for the patch.
    if ($INC{$filename}) { delete $INC{$filename};
                          debug "[$alias] class was still in \@INC, removing...\n";
                          };
    eval { require $filename; };
    if ($@) {
        debug "FAIL\n";
        debug "[$alias] Error: $@\n";
        POE::Kernel->yield( '_generate_event', 'plugin_compile_failed', $classname, $@ );
        Class::Unload->unload($classname); # fixes the "attempt to reload $plugin" warnings
    }
    else {
        debug "OK ";
        debug "run: ";
        eval { $classname->new( $_[HEAP]->{plugin_api}, $data ); };
        if ($@) {
            debug "FAIL\n";
            debug "[$alias] Error: $@\n";
            POE::Kernel->yield( '_generate_event', 'plugin_init_failed', $classname, $@ );
            Class::Unload->unload($classname);
        }
        else {
            debug "OK\n";
        }
    }
}

sub unload_plugin {
    my $plugin = $_[ARG0];
    my $mode   = $_[ARG1];
    my $reason = $_[ARG2];

    # checking
    warn "[$alias] warning: no plugin name specified" unless $plugin;
    $mode = 'smart' unless $mode;    # fallback to "smart" if no mode is specified
    if ( exists $_[HEAP]->{plugins}->{$plugin} ) {
        my $sid = $_[HEAP]->{plugins}->{$plugin}->{id};
        POE::Kernel->post( $sid, 'shutdown', $mode, $reason );
    }
    else {
        warn "[$alias] the plugin $plugin wasn't registered to the pluginmanager";
        POE::Kernel->yield( '_generate_event', 'plugin_unload_failed', $plugin, "no such plugin" );
    }
}

sub plugin_error {

    # a plugin reported an error.
    my $id   = $_[SENDER]->ID();
    my $name = $_[HEAP]->{lookup}->{$id};
    $name = $id unless $name;

    # $name may be unspecified, if a plugin reports an error
    # in _start, because the pluginmanager didn't have a chance
    # to register the plugin yet. In this case, we simply return
    # the session ID. Anyone interested could look up the corresponding
    # plugin name in the plugin list later on.
    my $error_hashref = $_[ARG0];
    POE::Kernel->yield( '_generate_event', 'plugin_error', $name, $error_hashref );
}

sub plugin_warning {
    my $id   = $_[SENDER]->ID();
    my $name = $_[HEAP]->{lookup}->{$id};
    if(!$name){ # were delaying a bit
        print "unresolved warning!\n";
        $_[KERNEL]->yield('relayed_warning', $id, $_[ARG0]);
        return 1;
    }

    # see above, the same goes for warnings.
    my $string = $_[ARG0];
    POE::Kernel->yield( '_generate_event', 'plugin_warning', $name, $string );
}

sub relayed_warning {  # a little helper function, that delays warnings until the _child
    my $id = $_[ARG0]; # event had time to be dispatched
    my $string = $_[ARG1];
    my $name = $_[HEAP]->{lookup}->{$id};
    $name = 'unresolved' unless $name;
    POE::Kernel->yield( '_generate_event', 'plugin_warning', $name, $string );
}

sub _dump {

    # for debugging purposes, outputting the plugin and the lookup table.
    debug "[$alias] Dumping plugin table to STDOUT...\n";
    debug Dumper $_[HEAP]->{plugins};
    debug "[$alias] Dumping lookup table to STDOUT...\n";
    debug Dumper $_[HEAP]->{lookup};
}

sub component_shutdown {
    debug "[$alias] received shutdown signal, shutting down all plugins...\n";
    my $mode = $_[ARG0];
    $mode = 'smart' unless $mode;    # fallback
    my $plugins_pending = 0;
    $pluginmanager_shutdown = 1;     # setting the global shutdown flag
                                     # sending the shutdown signal to all plugins.
                                     # then, when all plugins are shut down, the plugin manager will go away.
    foreach my $plugin ( keys %{ $_[HEAP]->{plugins} } ) {
        debug "shutting down $plugin, id: " . $_[HEAP]->{plugins}->{$plugin}->{id} . "\n";
        POE::Kernel->post( $_[HEAP]->{plugins}->{$plugin}->{id}, 'shutdown', $mode, 'pluginmanager shutdown' );
        $plugins_pending++;
    }
    if ( $plugins_pending == 0 ) {

        # no plugins pending, shut down immediately
        POE::Kernel->alias_remove($alias);
        POE::Kernel->yield( '_generate_event', 'plugin_manager_shutdown', 0 );
        #POE::Kernel->delay("unregister_all", 1);
        POE::Kernel->yield("unregister_all");
    }
    #$_[KERNEL]->delay("unregister_all", 1);
}

sub show_plugin_table {

    # renamed from "show_plugin_list" to "show_plugin_table", since
    # "list" implies we would send back a list, or an arrayref.
    my $plugins = {};
    foreach my $plugin ( keys %{ $_[HEAP]->{plugins} } ) {
        $plugins->{$plugin}->{id}       = $_[HEAP]->{plugins}->{$plugin}->{id};
        $plugins->{$plugin}->{longname} = $_[HEAP]->{plugins}->{$plugin}->{longname};
        $plugins->{$plugin}->{license}  = $_[HEAP]->{plugins}->{$plugin}->{license};
        $plugins->{$plugin}->{version}  = $_[HEAP]->{plugins}->{$plugin}->{version};
        $plugins->{$plugin}->{author}   = $_[HEAP]->{plugins}->{$plugin}->{author};
    }
    POE::Kernel->yield( '_generate_event', 'plugin_table', $plugins );
    return $plugins;
}

sub register {
    my $session = $_[ARG0];
    if ( !$session ) {
        $session = $_[SENDER]->ID();
    }
    $_[HEAP]->{RecvSessions}->{$session} = 1;
    POE::Kernel->refcount_increment($session);

    # incrementing the refcount, so that the session can't go away
    # as long as we are sending events.

}

sub unregister {
    my $session = $_[ARG0];
    if ( !$session ) {
        $session = $_[SENDER]->ID();
    }
    delete $_[HEAP]->{RecvSessions}->{$session};
    POE::Kernel->refcount_decrement($session);

    # now you can go away.
}
sub unregister_all {
        foreach(keys %{$_[HEAP]->{RecvSessions}}){
        $_[KERNEL]->refcount_decrement($_);
    }
    delete $_[HEAP]->{RecvSessions};
}

sub _generate_event {

    #function to generate events. this events receives the event that is to be broad
    #casted via ARG0 and ARG1 - $#_ are the arguments. then it iterates through
    #the hash of registered sessions and sends the event to all sessions.
    my $event     = $_[ARG0];
    my @arguments = @_[ ARG1 .. $#_ ];
    while ( my ( $key, $value ) = each %{ $_[HEAP]->{RecvSessions} } ) {
        POE::Kernel->post( $key, $event, @arguments );
    }

}
return 1;

__END__