package RTx::Shredder::Plugin;
use strict;
use warnings FATAL => 'all';
use File::Spec ();
=head1 NAME
RTx::Shredder::Plugin - interface to access shredder plugins
=head1 SYNOPSIS
use RTx::Shredder::Plugin;
# get list of the plugins
my %plugins = RTx::Shredder::Plugin->List;
# load plugin by name
my $plugin = new RTx::Shredder::Plugin;
my( $status, $msg ) = $plugin->LoadByString( 'Tickets' );
unless( $status ) {
print STDERR "Couldn't load plugin 'Tickets': $msg\n";
exit(1);
}
# load plugin by preformatted string
my $plugin = new RTx::Shredder::Plugin;
my( $status, $msg ) = $plugin->LoadByString( 'Tickets=status,deleted' );
unless( $status ) {
print STDERR "Couldn't load plugin: $msg\n";
exit(1);
}
=head1 METHODS
=head2 new
Object constructor, returns new object. Takes optional hash
as arguments, it's not required and this class doesn't use it,
but plugins could define some arguments and can handle them
after your've load it.
=cut
sub new
{
my $proto = shift;
my $self = bless( {}, ref $proto || $proto );
$self->_Init( @_ );
return $self;
}
sub _Init
{
my $self = shift;
my %args = ( @_ );
$self->{'opt'} = \%args;
}
=head2 List
Returns hash with names of the available plugins as keys and path to
library files as values. Method has no arguments. Can be used as class
method too.
=cut
sub List
{
my $self = shift;
my @files;
foreach my $root( @INC ) {
my $mask = File::Spec->catdir( $root, qw(RTx Shredder Plugin *.pm) );
push @files, glob $mask;
}
my %res = map { $_ =~ m/([^\\\/]+)\.pm$/; $1 => $_ } reverse @files;
return %res;
}
=head2 LoadByName
Takes name of the plugin as first argument, loads plugin,
creates new plugin object and reblesses self into plugin
if all steps were successfuly finished, then you don't need to
create new object for the plugin.
Other arguments are sent to the constructor of the plugin
(method new.)
Returns C<$status> and C<$message>. On errors status
is C<false> value.
=cut
sub LoadByName
{
my $self = shift;
my $name = shift or return (0, "Name not specified");
local $@;
my $plugin = "RTx::Shredder::Plugin::$name";
eval "require $plugin";
return( 0, $@ ) if $@;
my $obj = eval { $plugin->new( @_ ) };
return( 0, $@ ) if $@;
return( 0, 'constructor returned empty object' ) unless $obj;
$self->Rebless( $obj );
return( 1, "successfuly load plugin" );
}
=head2 LoadByString
Takes formatted string as first argument and which is used to
load plugin. The format of the string is
<plugin name>[=<arg>,<val>[;<arg>,<val>]...]
exactly like in the L<rtx-shredder> script. All other
arguments are sent to the plugins constructor.
Method does the same things as C<LoadByName>, but also
checks if the plugin supports arguments and values are correct,
so you can C<Run> specified plugin immediatly.
Returns list with C<$status> and C<$message>. On errors status
is C<false>.
=cut
sub LoadByString
{
my $self = shift;
my ($plugin, $args) = split /=/, ( shift || '' ), 2;
my ($status, $msg) = $self->LoadByName( $plugin, @_ );
return( $status, $msg ) unless $status;
my %args;
foreach( split /\s*;\s*/, ( $args || '' ) ) {
my( $k,$v ) = split /\s*,\s*/, ( $_ || '' ), 2;
unless( $args{$k} ) {
$args{$k} = $v;
next;
}
$args{$k} = [ $args{$k} ] unless UNIVERSAL::isa( $args{ $k }, 'ARRAY');
push @{ $args{$k} }, $v;
}
($status, $msg) = $self->HasSupportForArgs( keys %args );
return( $status, $msg ) unless $status;
($status, $msg) = $self->TestArgs( %args );
return( $status, $msg ) unless $status;
return( 1, "successfuly load plugin" );
}
=head2 Rebless
Instance method that takes one object as argument and rebless
the current object into into class of the argument and copy data
of the former. Returns nothing.
Method is used by C<Load*> methods to automaticaly rebless
C<RTx::Shredder::Plugin> object into class of the loaded
plugin.
=cut
sub Rebless
{
my( $self, $obj ) = @_;
bless( $self, ref $obj );
%{$self} = %{$obj};
return;
}
1;