Simple Perl Plugins

Even with quite some searching and reading about Perl I could not find a small, but complete example for how to create a plugin system for a perl project.

I found Module::Pluggable, but not being a perl expert the documented example was not enough to get a working proof of concept. I was also pointed to Moose's roles and traits. With a minimal example with a minimal number of dependencies as goal, Module::Pluggable was preferred.

My minimal example, based on Email::Send, has three parts:

Main script (./plugin-test.pl):

#!/usr/bin/perl 

use FindBin; # find the name and path of the current file
use lib $FindBin::Bin; # add as lib path, to find modules
# (hack; better put modules in correct path)

# This module provides a simple, clean interface to multiple plugins.
# It can be easily extended by plugins. For example see PluginA, PluginB.
# The idea is taken from the Email::Send modules by Casey West.
use PMT::Test;

my $tester = PMT::Test->new; # create new object
$tester->work(); # do work

my @available = $tester->get_all_plugins(); # get all plugins
print( "LIST={@available}\n");

my $res = $tester->is_plugin_available( 'PluginA'); # check plugin availibility
printf( "PluginA available=%s!\n", $res ? "Yes" : "No");
$res = $tester->is_plugin_available( 'PluginC');
printf( "PluginC available=%s!\n", $res ? "Yes" : "No");

# _plugin_selected is the plugin that should be used; not defined by default
PMT::Test->new( { _plugin_selected => 'PluginA'})->work( "test-data");
PMT::Test->new()->work( "test-data2");

Plugin-managing package (./PMT/Test.pm):

package PMT::Test;
use strict;

use Module::Pluggable search_path => 'PMT::Test';

# create a new object of type $class
sub new {
  my( $class, $args) = @_; # args can contain any field, see BEGIN below

  my %plugins = map {
    my( $short_name) = /^${class}::(.+)/; # remove class name to get short name
    ( $short_name, $_);
  } $class->plugins; # loop through Module::Pluggable->plugins
  $args->{ _plugin_list} = \%plugins; # store plugin list in args

  return bless( $args => $class);
}

# this is run after reading the file, before compiling everything else
BEGIN {
  for my $field( qw( _plugin_selected _plugin_list)) {
    my $code = sub { # create a sub for each field
      return $_[0]->{ $field} unless @_ > 1; # return field for an object of this class
      my $self = shift;
      $self->{ $field} = ( @_ == 1 ? $_[ 0] : [ @_]); # or storing the field if @_ > 1
    };

    no strict 'refs';
    *$field = $code;
  }
}

# returns a list of all plugins
sub get_all_plugins {
  my $self = shift();
  return keys %{ $self->_plugin_list}; # return all keys from the _plugin_list hash
}

# return of the given plugin is in the plugin list
sub is_plugin_available {
  my( $self, $plugin) = @_;
  return grep( $_ eq $plugin, $self->get_all_plugins()); # grep for $plugin in plugin list
}

# make plugin(s) work on data
sub work {
  my( $self, $data) = @_;

  if( $self->_plugin_selected ) { # if a plugin is already selected, use it
    return $self->_try_plugin( $self->_plugin_selected, $data);
  }

  return $self->_try_all_plugins( $data); # try all if no plugin is selected
}

# loop over all plugins and make them work on $data
sub _try_all_plugins {
  my( $self, $data) = @_;

  foreach( $self->get_all_plugins) {
    my $success = $self->_try_plugin( $_, $data);
    #return 1 if $success; # if plugins should only be run until the first success
  }
  #return 0; # no success if no plugin was successful
}

# make $plugin work on $data
sub _try_plugin {
  my( $self, $plugin, $data) = @_;
  my $invocant = $self->_get_plugin_invocant( $plugin); # get the plugin
  return $invocant->work( $data);
}

# get the plugin
sub _get_plugin_invocant {
  my( $self, $plugin) = @_;

  return $plugin if Scalar::Util::blessed( $plugin); # if blessed, return package name

  # is the mailer a plugin given by short name?
  my $package = exists $self->_plugin_list->{$plugin} 
    ? $self->_plugin_list->{$plugin} 
    : $plugin;
  eval "require $package" or return;
  return $package;
}

1;

__END__

Plugin package (./PMT/Test/PluginA.pm):

package PMT::Test::PluginA;

use strict;

sub work {
  my ($class, $message) = @_;
  printf( "PluginA.work( '%s', '%s')\n", $class, $message);
  return 1; # success
}

1;

__END__

It's better than no example, but likely not perfect. So please comment about errors or improvements.