view release on metacpan or  search on metacpan

lib/Plugin/Simple.pm  view on Meta::CPAN

package Plugin::Simple;
use 5.006;
use strict;
use warnings;

use Carp qw(croak);
use Cwd qw (abs_path);
use Module::List qw(list_modules);
use Module::Load;

our $VERSION = '1.01';

my $self;

sub import {
    my ($class, %opts) = @_;

    $self = __PACKAGE__->_new(%opts);

    my $sub_name = $opts{sub_name} ? $opts{sub_name} : 'plugins';

    {
        no warnings 'redefine';
        no strict 'refs';

        my $pkg = (caller)[0];
        *{"$pkg\::$sub_name"} = \&_plugins;
    }
}
sub _new {
    my ($class, %args) = @_;
    my $self = bless \%args, $class;

    return $self;
}
sub _search {
    my ($self, $pkg, $item) = @_;

    my @plugins;

    if ($item){
        if ($item !~ /::$/){
            push @plugins, $item;
        }
        else {
            my $candidates;
            eval { $candidates = list_modules(
                    $item,
                    {list_modules => 1, recurse => 1}
                );
            };
            push @plugins, keys %$candidates;
        }
    }
    else {
        my $path = $pkg;
        $path .= '::Plugin::';
        my $candidates = {};
        eval { $candidates = list_modules(
                $path,
                {
                    list_modules => 1,
                    recurse => 1
                }
            );
        };
        push @plugins, keys %$candidates;
    }

    my @loaded;

    for (@plugins){
        my $ok = $self->_load($_);
        push @loaded, $ok;
    }

    return @loaded;
}
sub _load {
    my ($self, $plugin) = @_;

    if ($plugin =~ /(.*)\W(\w+)\.pm/){
        unshift @INC, $1;
        $plugin = $2;
    }
    elsif ($plugin =~ /^(\w+)\.pm$/){
        unshift @INC, '.';
        $plugin = $1;
    }

    my $loaded = eval { load $plugin; 1; };

    if ($loaded) {
        return $plugin;
    }
}
sub _plugins {
    shift if ref $_[0]; # dump the calling object if present

    my ($item, $can);

    if ($_[0] && $_[0] eq 'can'){
        shift;
        $can = shift;
    }
    else {
        $item = shift;
        shift;
        $can = shift;
    }

    if (@_){
        croak "usage: plugins(['Load::From'], [can => 'sub']), " .
              "in that order\n";
    }

    my $pkg = (caller)[0];
    my @plugins;

    if ($item){
        if ($item =~ /(?:\.pm|\.pl)/){
            my $abs_path;
            my $ok_file = eval { $abs_path = abs_path($item); 1 };

            if (! $ok_file){
                croak
                "\npackage $item can't be found, and no default plugin set\n";
            }

            if (-e $abs_path){
                @plugins = $self->_load($abs_path);
            }
        }
        else{
            @plugins = $self->_search($pkg, $item);
        }
    }
    if (! @plugins){
        @plugins = _search($pkg);
    }
    if (! $plugins[0] && $self->{default}){
        push @plugins, $self->_load($self->{default});
    }
    if (! $plugins[0]){
        if ($item){
            croak
            "\npackage $item can't be found, and no default plugin set\n";
        }
        else {
            croak "\npackage can't be found, and no default plugin set\n";
        }
    }
    my @wanted_plugins;

    if ($can) {
        for my $mod (@plugins){
            my $can_count = 0;
            for my $sub (@$can){
                if ($mod->can($sub)){
                    $can_count++;
                }
            }
            push @wanted_plugins, $mod if $can_count == @$can;
        }
        return wantarray ? @wanted_plugins : $wanted_plugins[0];
    }

    return wantarray ? @plugins : $plugins[0];
}

1;

=head1 NAME

Plugin::Simple - Load plugins from files or modules.

=for html