disabled )Z٫{-i[DHRBc{M<0lzeq 1h _ub &=LV[(/Ppackage Module::Pluggable::Object; use strict; use File::Find (); use File::Basename; use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel); use Carp qw(croak carp confess); use Devel::InnerPackage; use vars qw($VERSION); use if $] > 5.017, 'deprecate'; $VERSION = '4.8'; sub new { my $class = shift; my %opts = @_; return bless \%opts, $class; } ### Eugggh, this code smells ### This is what happens when you keep adding patches ### *sigh* sub plugins { my $self = shift; my @args = @_; # override 'require' $self->{'require'} = 1 if $self->{'inner'}; my $filename = $self->{'filename'}; my $pkg = $self->{'package'}; # Get the exception params instantiated $self->_setup_exceptions; # automatically turn a scalar search path or namespace into a arrayref for (qw(search_path search_dirs)) { $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); } # default search path is '::::Plugin' $self->{'search_path'} ||= ["${pkg}::Plugin"]; # default error handler $self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 }; $self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 }; # default whether to follow symlinks $self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'}; # check to see if we're running under test my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC; # add any search_dir params unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; # set our @INC up to include and prefer our search_dirs if necessary my @tmp = @INC; unshift @tmp, @{$self->{'search_dirs'} || []}; local @INC = @tmp if defined $self->{'search_dirs'}; my @plugins = $self->search_directories(@SEARCHDIR); push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; # return blank unless we've found anything return () unless @plugins; # remove duplicates # probably not necessary but hey ho my %plugins; for(@plugins) { next unless $self->_is_legit($_); $plugins{$_} = 1; } # are we instantiating or requiring? if (defined $self->{'instantiate'}) { my $method = $self->{'instantiate'}; my @objs = (); foreach my $package (sort keys %plugins) { next unless $package->can($method); my $obj = eval { $package->$method(@_) }; $self->{'on_instantiate_error'}->($package, $@) if $@; push @objs, $obj if $obj; } return @objs; } else { # no? just return the names my @objs= sort keys %plugins; return @objs; } } sub _setup_exceptions { my $self = shift; my %only; my %except; my $only; my $except; if (defined $self->{'only'}) { if (ref($self->{'only'}) eq 'ARRAY') { %only = map { $_ => 1 } @{$self->{'only'}}; } elsif (ref($self->{'only'}) eq 'Regexp') { $only = $self->{'only'} } elsif (ref($self->{'only'}) eq '') { $only{$self->{'only'}} = 1; } } if (defined $self->{'except'}) { if (ref($self->{'except'}) eq 'ARRAY') { %except = map { $_ => 1 } @{$self->{'except'}}; } elsif (ref($self->{'except'}) eq 'Regexp') { $except = $self->{'except'} } elsif (ref($self->{'except'}) eq '') { $e