/usr/share/perl5/Module/Pluggable/Fast.pm is in libmodule-pluggable-fast-perl 0.19-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | package Module::Pluggable::Fast;
use strict;
use vars '$VERSION';
use UNIVERSAL::require;
use Carp qw/croak carp/;
use File::Find ();
use File::Basename;
use File::Spec::Functions qw/splitdir catdir abs2rel/;
$VERSION = '0.19';
=head1 NAME
Module::Pluggable::Fast - Fast plugins with instantiation
=head1 SYNOPSIS
package MyClass;
use Module::Pluggable::Fast
name => 'components',
search => [ qw/MyClass::Model MyClass::View MyClass::Controller/ ];
package MyOtherClass;
use MyClass;
my @components = MyClass->components;
=head1 DESCRIPTION
Similar to C<Module::Pluggable> but instantiates plugins as soon as they're
found, useful for code generators like C<Class::DBI::Loader>.
=head2 OPTIONS
=head3 name
Name for the exported method.
Defaults to plugins.
=head3 require
If true, only require plugins.
=head3 callback
Codref to be called instead of the default instantiate callback.
=head3 search
Arrayref containing a list of namespaces to search for plugins.
Defaults to the ::Plugin:: namespace of the calling class.
=cut
sub import {
my ( $class, %args ) = @_;
my $caller = caller;
no strict 'refs';
*{ "$caller\::" . ( $args{name} || 'plugins' ) } = sub {
my $self = shift;
$args{search} ||= ["$caller\::Plugin"];
$args{require} ||= 0;
$args{callback} ||= sub {
my $plugin = shift;
my $obj = $plugin;
eval { $obj = $plugin->new(@_) };
carp qq/Couldn't instantiate "$plugin", "$@"/ if $@;
return $obj;
};
my %plugins;
foreach my $dir ( exists $INC{'blib.pm'} ? grep { /blib/ } @INC : @INC )
{
foreach my $searchpath ( @{ $args{search} } ) {
my $sp = catdir( $dir, ( split /::/, $searchpath ) );
next unless ( -e $sp && -d $sp );
foreach my $file ( _find_packages($sp) ) {
my ( $name, $directory ) = fileparse $file, qr/\.pm/;
$directory = abs2rel $directory, $sp;
my $plugin = join '::', splitdir catdir $searchpath,
$directory, $name;
$plugin->require;
my $error = $UNIVERSAL::require::ERROR;
die qq/Couldn't load "$plugin", "$error"/ if $error;
unless ( $plugins{$plugin} ) {
$plugins{$plugin} =
$args{require}
? $plugin
: $args{callback}->( $plugin, @_ );
}
for my $class ( _list_packages($plugin) ) {
next if $plugins{$class};
$plugins{$class} =
$args{require}
? $class
: $args{callback}->( $class, @_ );
}
}
}
}
return values %plugins;
};
}
sub _find_packages {
my $search = shift;
my @files = ();
my $wanted = sub {
my $path = $File::Find::name;
return unless $path =~ /\w+\.pm$/;
return unless $path =~ /\A(.+)\z/;
$path = $1; # untaint
# don't include symbolig links pointing into nowhere
# (e.g. emacs lock-files)
return if -l $path && !-e $path;
$path =~ s#^\\./##;
push @files, $path;
};
File::Find::find( { no_chdir => 1, wanted => $wanted }, $search );
return @files;
}
sub _list_packages {
my $class = shift;
$class .= '::' unless $class =~ m!::$!;
no strict 'refs';
my @classes;
for my $subclass ( grep !/^main::$/, grep /::$/, keys %$class ) {
$subclass =~ s!::$!!;
next if $subclass =~ /^::/;
push @classes, "$class$subclass";
push @classes, _list_packages("$class$subclass");
}
return @classes;
}
=head1 AUTHOR
Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 SEE ALSO
L<Module::Pluggable>
=cut
1;
|