line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Module::Pluggable::Object; |
2
|
|
|
|
|
|
|
|
3
|
39
|
|
|
39
|
|
78547
|
use strict; |
|
39
|
|
|
|
|
77
|
|
|
39
|
|
|
|
|
1252
|
|
4
|
39
|
|
|
39
|
|
234
|
use File::Find (); |
|
39
|
|
|
|
|
73
|
|
|
39
|
|
|
|
|
688
|
|
5
|
39
|
|
|
39
|
|
215
|
use File::Basename; |
|
39
|
|
|
|
|
73
|
|
|
39
|
|
|
|
|
3590
|
|
6
|
39
|
|
|
39
|
|
39171
|
use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel); |
|
39
|
|
|
|
|
42533
|
|
|
39
|
|
|
|
|
4397
|
|
7
|
39
|
|
|
39
|
|
288
|
use Carp qw(croak carp confess); |
|
39
|
|
|
|
|
103
|
|
|
39
|
|
|
|
|
2487
|
|
8
|
39
|
|
|
39
|
|
29016
|
use Devel::InnerPackage; |
|
39
|
|
|
|
|
120
|
|
|
39
|
|
|
|
|
2429
|
|
9
|
39
|
|
|
39
|
|
223
|
use vars qw($VERSION); |
|
39
|
|
|
|
|
76
|
|
|
39
|
|
|
|
|
1941
|
|
10
|
|
|
|
|
|
|
|
11
|
39
|
|
|
39
|
|
203
|
use if $] > 5.017, 'deprecate'; |
|
39
|
|
|
|
|
79
|
|
|
39
|
|
|
|
|
247
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
$VERSION = '5.1'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub new { |
17
|
51
|
|
|
51
|
0
|
111
|
my $class = shift; |
18
|
51
|
|
|
|
|
226
|
my %opts = @_; |
19
|
|
|
|
|
|
|
|
20
|
51
|
|
|
|
|
261
|
return bless \%opts, $class; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
### Eugggh, this code smells |
25
|
|
|
|
|
|
|
### This is what happens when you keep adding patches |
26
|
|
|
|
|
|
|
### *sigh* |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub plugins { |
30
|
72
|
|
|
72
|
0
|
154
|
my $self = shift; |
31
|
72
|
|
|
|
|
153
|
my @args = @_; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# override 'require' |
34
|
72
|
100
|
|
|
|
514
|
$self->{'require'} = 1 if $self->{'inner'}; |
35
|
|
|
|
|
|
|
|
36
|
72
|
|
|
|
|
180
|
my $filename = $self->{'filename'}; |
37
|
72
|
|
|
|
|
151
|
my $pkg = $self->{'package'}; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Get the exception params instantiated |
40
|
72
|
|
|
|
|
265
|
$self->_setup_exceptions; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# automatically turn a scalar search path or namespace into a arrayref |
43
|
72
|
|
|
|
|
179
|
for (qw(search_path search_dirs)) { |
44
|
144
|
100
|
100
|
|
|
849
|
$self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# default search path is '<Module>::<Name>::Plugin' |
48
|
72
|
|
100
|
|
|
514
|
$self->{'search_path'} ||= ["${pkg}::Plugin"]; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# default error handler |
51
|
72
|
|
100
|
0
|
|
634
|
$self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
52
|
72
|
|
100
|
0
|
|
684
|
$self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# default whether to follow symlinks |
55
|
72
|
100
|
|
|
|
378
|
$self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'}; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# check to see if we're running under test |
58
|
72
|
50
|
33
|
|
|
1524
|
my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC; |
|
0
|
|
|
|
|
0
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# add any search_dir params |
61
|
72
|
100
|
|
|
|
386
|
unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; |
|
4
|
|
|
|
|
15
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# set our @INC up to include and prefer our search_dirs if necessary |
64
|
72
|
|
|
|
|
292
|
my @tmp = @INC; |
65
|
72
|
100
|
|
|
|
126
|
unshift @tmp, @{$self->{'search_dirs'} || []}; |
|
72
|
|
|
|
|
608
|
|
66
|
72
|
100
|
|
|
|
278
|
local @INC = @tmp if defined $self->{'search_dirs'}; |
67
|
|
|
|
|
|
|
|
68
|
72
|
|
|
|
|
288
|
my @plugins = $self->search_directories(@SEARCHDIR); |
69
|
72
|
|
|
|
|
144
|
push(@plugins, $self->handle_inc_hooks($_, @SEARCHDIR)) for @{$self->{'search_path'}}; |
|
72
|
|
|
|
|
473
|
|
70
|
72
|
|
|
|
|
133
|
push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; |
|
72
|
|
|
|
|
481
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# return blank unless we've found anything |
73
|
72
|
100
|
|
|
|
301
|
return () unless @plugins; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# remove duplicates |
76
|
|
|
|
|
|
|
# probably not necessary but hey ho |
77
|
69
|
|
|
|
|
147
|
my %plugins; |
78
|
69
|
|
|
|
|
151
|
for(@plugins) { |
79
|
222
|
50
|
|
|
|
471
|
next unless $self->_is_legit($_); |
80
|
222
|
|
|
|
|
564
|
$plugins{$_} = 1; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# are we instantiating or requiring? |
84
|
69
|
100
|
|
|
|
238
|
if (defined $self->{'instantiate'}) { |
85
|
3
|
|
|
|
|
7
|
my $method = $self->{'instantiate'}; |
86
|
3
|
|
|
|
|
6
|
my @objs = (); |
87
|
3
|
|
|
|
|
15
|
foreach my $package (sort keys %plugins) { |
88
|
10
|
100
|
|
|
|
132
|
next unless $package->can($method); |
89
|
2
|
|
|
|
|
5
|
my $obj = eval { $package->$method(@_) }; |
|
2
|
|
|
|
|
9
|
|
90
|
2
|
50
|
|
|
|
19
|
$self->{'on_instantiate_error'}->($package, $@) if $@; |
91
|
2
|
50
|
|
|
|
16
|
push @objs, $obj if $obj; |
92
|
|
|
|
|
|
|
} |
93
|
3
|
|
|
|
|
39
|
return @objs; |
94
|
|
|
|
|
|
|
} else { |
95
|
|
|
|
|
|
|
# no? just return the names |
96
|
66
|
|
|
|
|
364
|
my @objs= sort keys %plugins; |
97
|
66
|
|
|
|
|
959
|
return @objs; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub _setup_exceptions { |
102
|
72
|
|
|
72
|
|
122
|
my $self = shift; |
103
|
|
|
|
|
|
|
|
104
|
72
|
|
|
|
|
133
|
my %only; |
105
|
|
|
|
|
|
|
my %except; |
106
|
0
|
|
|
|
|
0
|
my $only; |
107
|
0
|
|
|
|
|
0
|
my $except; |
108
|
|
|
|
|
|
|
|
109
|
72
|
100
|
|
|
|
358
|
if (defined $self->{'only'}) { |
110
|
13
|
100
|
|
|
|
63
|
if (ref($self->{'only'}) eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
111
|
4
|
|
|
|
|
7
|
%only = map { $_ => 1 } @{$self->{'only'}}; |
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
7
|
|
112
|
|
|
|
|
|
|
} elsif (ref($self->{'only'}) eq 'Regexp') { |
113
|
5
|
|
|
|
|
12
|
$only = $self->{'only'} |
114
|
|
|
|
|
|
|
} elsif (ref($self->{'only'}) eq '') { |
115
|
4
|
|
|
|
|
9
|
$only{$self->{'only'}} = 1; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
72
|
100
|
|
|
|
249
|
if (defined $self->{'except'}) { |
121
|
12
|
100
|
|
|
|
55
|
if (ref($self->{'except'}) eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
122
|
4
|
|
|
|
|
6
|
%except = map { $_ => 1 } @{$self->{'except'}}; |
|
4
|
|
|
|
|
20
|
|
|
4
|
|
|
|
|
10
|
|
123
|
|
|
|
|
|
|
} elsif (ref($self->{'except'}) eq 'Regexp') { |
124
|
4
|
|
|
|
|
7
|
$except = $self->{'except'} |
125
|
|
|
|
|
|
|
} elsif (ref($self->{'except'}) eq '') { |
126
|
4
|
|
|
|
|
9
|
$except{$self->{'except'}} = 1; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
} |
129
|
72
|
|
|
|
|
241
|
$self->{_exceptions}->{only_hash} = \%only; |
130
|
72
|
|
|
|
|
190
|
$self->{_exceptions}->{only} = $only; |
131
|
72
|
|
|
|
|
171
|
$self->{_exceptions}->{except_hash} = \%except; |
132
|
72
|
|
|
|
|
218
|
$self->{_exceptions}->{except} = $except; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub _is_legit { |
137
|
490
|
|
|
490
|
|
615
|
my $self = shift; |
138
|
490
|
|
|
|
|
601
|
my $plugin = shift; |
139
|
490
|
50
|
|
|
|
531
|
my %only = %{$self->{_exceptions}->{only_hash}||{}}; |
|
490
|
|
|
|
|
2017
|
|
140
|
490
|
50
|
|
|
|
1862
|
my %except = %{$self->{_exceptions}->{except_hash}||{}}; |
|
490
|
|
|
|
|
1578
|
|
141
|
490
|
|
|
|
|
800
|
my $only = $self->{_exceptions}->{only}; |
142
|
490
|
|
|
|
|
737
|
my $except = $self->{_exceptions}->{except}; |
143
|
490
|
|
|
|
|
1307
|
my $depth = () = split '::', $plugin, -1; |
144
|
|
|
|
|
|
|
|
145
|
490
|
100
|
100
|
|
|
1619
|
return 0 if (keys %only && !$only{$plugin} ); |
146
|
474
|
100
|
100
|
|
|
1393
|
return 0 unless (!defined $only || $plugin =~ m!$only! ); |
147
|
|
|
|
|
|
|
|
148
|
465
|
100
|
100
|
|
|
2434
|
return 0 if (keys %except && $except{$plugin} ); |
149
|
457
|
100
|
100
|
|
|
3786
|
return 0 if (defined $except && $plugin =~ m!$except! ); |
150
|
|
|
|
|
|
|
|
151
|
453
|
100
|
100
|
|
|
1363
|
return 0 if defined $self->{max_depth} && $depth>$self->{max_depth}; |
152
|
452
|
100
|
100
|
|
|
1843
|
return 0 if defined $self->{min_depth} && $depth<$self->{min_depth}; |
153
|
|
|
|
|
|
|
|
154
|
449
|
|
|
|
|
1654
|
return 1; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub search_directories { |
158
|
72
|
|
|
72
|
0
|
487
|
my $self = shift; |
159
|
72
|
|
|
|
|
266
|
my @SEARCHDIR = @_; |
160
|
|
|
|
|
|
|
|
161
|
72
|
|
|
|
|
227
|
my @plugins; |
162
|
|
|
|
|
|
|
# go through our @INC |
163
|
72
|
|
|
|
|
157
|
foreach my $dir (@SEARCHDIR) { |
164
|
720
|
|
|
|
|
2143
|
push @plugins, $self->search_paths($dir); |
165
|
|
|
|
|
|
|
} |
166
|
72
|
|
|
|
|
376
|
return @plugins; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub search_paths { |
171
|
720
|
|
|
720
|
0
|
962
|
my $self = shift; |
172
|
720
|
|
|
|
|
1333
|
my $dir = shift; |
173
|
720
|
|
|
|
|
1067
|
my @plugins; |
174
|
|
|
|
|
|
|
|
175
|
720
|
|
66
|
|
|
4251
|
my $file_regex = $self->{'file_regex'} || qr/\.pm$/; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# and each directory in our search path |
179
|
720
|
|
|
|
|
905
|
foreach my $searchpath (@{$self->{'search_path'}}) { |
|
720
|
|
|
|
|
1503
|
|
180
|
|
|
|
|
|
|
# create the search directory in a cross platform goodness way |
181
|
730
|
|
|
|
|
3837
|
my $sp = catdir($dir, (split /::/, $searchpath)); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# if it doesn't exist or it's not a dir then skip it |
184
|
730
|
100
|
66
|
|
|
32319
|
next unless ( -e $sp && -d _ ); # Use the cached stat the second time |
185
|
|
|
|
|
|
|
|
186
|
79
|
|
|
|
|
414
|
my @files = $self->find_files($sp); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# foreach one we've found |
189
|
79
|
|
|
|
|
215
|
foreach my $file (@files) { |
190
|
|
|
|
|
|
|
# untaint the file; accept .pm only |
191
|
182
|
50
|
|
|
|
2045
|
next unless ($file) = ($file =~ /(.*$file_regex)$/); |
192
|
|
|
|
|
|
|
# parse the file to get the name |
193
|
182
|
|
|
|
|
6525
|
my ($name, $directory, $suffix) = fileparse($file, $file_regex); |
194
|
|
|
|
|
|
|
|
195
|
182
|
100
|
100
|
|
|
948
|
next if (!$self->{include_editor_junk} && $self->_is_editor_junk($name)); |
196
|
|
|
|
|
|
|
|
197
|
181
|
|
|
|
|
818
|
$directory = abs2rel($directory, $sp); |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# If we have a mixed-case package name, assume case has been preserved |
200
|
|
|
|
|
|
|
# correctly. Otherwise, root through the file to locate the case-preserved |
201
|
|
|
|
|
|
|
# version of the package name. |
202
|
181
|
|
|
|
|
15811
|
my @pkg_dirs = (); |
203
|
181
|
100
|
66
|
|
|
1275
|
if ( $name eq lc($name) || $name eq uc($name) ) { |
204
|
2
|
|
|
|
|
12
|
my $pkg_file = catfile($sp, $directory, "$name$suffix"); |
205
|
2
|
50
|
|
|
|
86
|
open PKGFILE, "<$pkg_file" or die "search_paths: Can't open $pkg_file: $!"; |
206
|
2
|
|
|
|
|
3
|
my $in_pod = 0; |
207
|
2
|
|
|
|
|
31
|
while ( my $line = <PKGFILE> ) { |
208
|
2
|
50
|
|
|
|
7
|
$in_pod = 1 if $line =~ m/^=\w/; |
209
|
2
|
50
|
|
|
|
6
|
$in_pod = 0 if $line =~ /^=cut/; |
210
|
2
|
50
|
33
|
|
|
10
|
next if ($in_pod || $line =~ /^=cut/); # skip pod text |
211
|
2
|
50
|
|
|
|
7
|
next if $line =~ /^\s*#/; # and comments |
212
|
2
|
50
|
|
|
|
52
|
if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) { |
213
|
2
|
50
|
|
|
|
14
|
@pkg_dirs = split /::/, $1 if defined $1;; |
214
|
2
|
|
|
|
|
5
|
$name = $2; |
215
|
2
|
|
|
|
|
4
|
last; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
2
|
|
|
|
|
30
|
close PKGFILE; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# then create the class name in a cross platform way |
222
|
181
|
50
|
|
|
|
961
|
$directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/); # remove volume |
223
|
181
|
|
|
|
|
283
|
my @dirs = (); |
224
|
181
|
50
|
|
|
|
374
|
if ($directory) { |
225
|
181
|
|
|
|
|
704
|
($directory) = ($directory =~ /(.*)/); |
226
|
181
|
100
|
|
|
|
597
|
@dirs = grep(length($_), splitdir($directory)) |
227
|
|
|
|
|
|
|
unless $directory eq curdir(); |
228
|
181
|
|
|
|
|
852
|
for my $d (reverse @dirs) { |
229
|
42
|
|
|
|
|
76
|
my $pkg_dir = pop @pkg_dirs; |
230
|
42
|
50
|
|
|
|
133
|
last unless defined $pkg_dir; |
231
|
0
|
|
|
|
|
0
|
$d =~ s/\Q$pkg_dir\E/$pkg_dir/i; # Correct case |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} else { |
234
|
0
|
|
|
|
|
0
|
$directory = ""; |
235
|
|
|
|
|
|
|
} |
236
|
181
|
|
|
|
|
460
|
my $plugin = join '::', $searchpath, @dirs, $name; |
237
|
|
|
|
|
|
|
|
238
|
181
|
50
|
|
|
|
765
|
next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]*!i; |
239
|
|
|
|
|
|
|
|
240
|
181
|
|
|
|
|
551
|
$self->handle_finding_plugin($plugin, \@plugins) |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# now add stuff that may have been in package |
244
|
|
|
|
|
|
|
# NOTE we should probably use all the stuff we've been given already |
245
|
|
|
|
|
|
|
# but then we can't unload it :( |
246
|
79
|
|
|
|
|
335
|
push @plugins, $self->handle_innerpackages($searchpath); |
247
|
|
|
|
|
|
|
} # foreach $searchpath |
248
|
|
|
|
|
|
|
|
249
|
720
|
|
|
|
|
2750
|
return @plugins; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub _is_editor_junk { |
253
|
179
|
|
|
179
|
|
267
|
my $self = shift; |
254
|
179
|
|
|
|
|
271
|
my $name = shift; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Emacs (and other Unix-y editors) leave temp files ending in a |
257
|
|
|
|
|
|
|
# tilde as a backup. |
258
|
179
|
50
|
|
|
|
495
|
return 1 if $name =~ /~$/; |
259
|
|
|
|
|
|
|
# Emacs makes these files while a buffer is edited but not yet |
260
|
|
|
|
|
|
|
# saved. |
261
|
179
|
100
|
|
|
|
720
|
return 1 if $name =~ /^\.#/; |
262
|
|
|
|
|
|
|
# Vim can leave these files behind if it crashes. |
263
|
178
|
50
|
|
|
|
391
|
return 1 if $name =~ /\.sw[po]$/; |
264
|
|
|
|
|
|
|
|
265
|
178
|
|
|
|
|
709
|
return 0; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub handle_finding_plugin { |
269
|
268
|
|
|
268
|
0
|
358
|
my $self = shift; |
270
|
268
|
|
|
|
|
342
|
my $plugin = shift; |
271
|
268
|
|
|
|
|
369
|
my $plugins = shift; |
272
|
268
|
|
100
|
|
|
922
|
my $no_req = shift || 0; |
273
|
|
|
|
|
|
|
|
274
|
268
|
100
|
|
|
|
1056
|
return unless $self->_is_legit($plugin); |
275
|
227
|
100
|
100
|
|
|
1199
|
unless (defined $self->{'instantiate'} || $self->{'require'}) { |
276
|
124
|
|
|
|
|
216
|
push @$plugins, $plugin; |
277
|
124
|
|
|
|
|
523
|
return; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
103
|
100
|
100
|
|
|
263
|
$self->{before_require}->($plugin) || return if defined $self->{before_require}; |
281
|
102
|
100
|
|
|
|
255
|
unless ($no_req) { |
282
|
28
|
|
|
|
|
47
|
my $tmp = $@; |
283
|
28
|
|
|
|
|
41
|
my $res = eval { $self->_require($plugin) }; |
|
28
|
|
|
|
|
84
|
|
284
|
28
|
|
|
|
|
56
|
my $err = $@; |
285
|
28
|
|
|
|
|
50
|
$@ = $tmp; |
286
|
28
|
100
|
|
|
|
80
|
if ($err) { |
287
|
1
|
50
|
|
|
|
4
|
if (defined $self->{on_require_error}) { |
288
|
1
|
50
|
|
|
|
5
|
$self->{on_require_error}->($plugin, $err) || return; |
289
|
|
|
|
|
|
|
} else { |
290
|
0
|
|
|
|
|
0
|
return; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
} |
294
|
101
|
100
|
100
|
|
|
260
|
$self->{after_require}->($plugin) || return if defined $self->{after_require}; |
295
|
98
|
|
|
|
|
441
|
push @$plugins, $plugin; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub find_files { |
299
|
80
|
|
|
80
|
0
|
150
|
my $self = shift; |
300
|
80
|
|
|
|
|
149
|
my $search_path = shift; |
301
|
80
|
|
66
|
|
|
653
|
my $file_regex = $self->{'file_regex'} || qr/\.pm$/; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# find all the .pm files in it |
305
|
|
|
|
|
|
|
# this isn't perfect and won't find multiple plugins per file |
306
|
|
|
|
|
|
|
#my $cwd = Cwd::getcwd; |
307
|
80
|
|
|
|
|
174
|
my @files = (); |
308
|
|
|
|
|
|
|
{ # for the benefit of perl 5.6.1's Find, localize topic |
309
|
80
|
|
|
|
|
110
|
local $_; |
|
80
|
|
|
|
|
115
|
|
310
|
|
|
|
|
|
|
File::Find::find( { no_chdir => 1, |
311
|
|
|
|
|
|
|
follow => $self->{'follow_symlinks'}, |
312
|
|
|
|
|
|
|
wanted => sub { |
313
|
|
|
|
|
|
|
# Inlined from File::Find::Rule C< name => '*.pm' > |
314
|
315
|
100
|
|
315
|
|
16164
|
return unless $File::Find::name =~ /$file_regex/; |
315
|
185
|
|
|
|
|
376
|
(my $path = $File::Find::name) =~ s#^\\./##; |
316
|
185
|
|
|
|
|
7346
|
push @files, $path; |
317
|
|
|
|
|
|
|
} |
318
|
80
|
|
|
|
|
12506
|
}, $search_path ); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
#chdir $cwd; |
321
|
80
|
|
|
|
|
922
|
return @files; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub handle_inc_hooks { |
326
|
73
|
|
|
73
|
0
|
219
|
my $self = shift; |
327
|
73
|
|
|
|
|
135
|
my $path = shift; |
328
|
73
|
|
|
|
|
352
|
my @SEARCHDIR = @_; |
329
|
|
|
|
|
|
|
|
330
|
73
|
|
|
|
|
116
|
my @plugins; |
331
|
73
|
|
|
|
|
146
|
for my $dir ( @SEARCHDIR ) { |
332
|
730
|
100
|
66
|
|
|
1878
|
next unless ref $dir && eval { $dir->can( 'files' ) }; |
|
1
|
|
|
|
|
12
|
|
333
|
|
|
|
|
|
|
|
334
|
1
|
|
|
|
|
8
|
foreach my $plugin ( $dir->files ) { |
335
|
1
|
|
|
|
|
8
|
$plugin =~ s/\.pm$//; |
336
|
1
|
|
|
|
|
5
|
$plugin =~ s{/}{::}g; |
337
|
1
|
50
|
|
|
|
19
|
next unless $plugin =~ m!^${path}::!; |
338
|
1
|
|
|
|
|
6
|
$self->handle_finding_plugin( $plugin, \@plugins ); |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} |
341
|
73
|
|
|
|
|
315
|
return @plugins; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub handle_innerpackages { |
345
|
152
|
|
|
152
|
0
|
258
|
my $self = shift; |
346
|
152
|
100
|
100
|
|
|
547
|
return () if (exists $self->{inner} && !$self->{inner}); |
347
|
|
|
|
|
|
|
|
348
|
149
|
|
|
|
|
214
|
my $path = shift; |
349
|
149
|
|
|
|
|
194
|
my @plugins; |
350
|
|
|
|
|
|
|
|
351
|
149
|
|
|
|
|
580
|
foreach my $plugin (Devel::InnerPackage::list_packages($path)) { |
352
|
86
|
|
|
|
|
263
|
$self->handle_finding_plugin($plugin, \@plugins, 1); |
353
|
|
|
|
|
|
|
} |
354
|
149
|
|
|
|
|
690
|
return @plugins; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub _require { |
360
|
28
|
|
|
28
|
|
44
|
my $self = shift; |
361
|
28
|
|
|
|
|
44
|
my $pack = shift; |
362
|
28
|
|
|
|
|
2132
|
eval "CORE::require $pack"; |
363
|
28
|
100
|
|
|
|
105829
|
die ($@) if $@; |
364
|
27
|
|
|
|
|
86
|
return 1; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
1; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=pod |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=head1 NAME |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Module::Pluggable::Object - automatically give your module the ability to have plugins |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head1 SYNOPSIS |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Simple use Module::Pluggable - |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
package MyClass; |
382
|
|
|
|
|
|
|
use Module::Pluggable::Object; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
my $finder = Module::Pluggable::Object->new(%opts); |
385
|
|
|
|
|
|
|
print "My plugins are: ".join(", ", $finder->plugins)."\n"; |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=head1 DESCRIPTION |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
Provides a simple but, hopefully, extensible way of having 'plugins' for |
390
|
|
|
|
|
|
|
your module. Obviously this isn't going to be the be all and end all of |
391
|
|
|
|
|
|
|
solutions but it works for me. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Essentially all it does is export a method into your namespace that |
394
|
|
|
|
|
|
|
looks through a search path for .pm files and turn those into class names. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Optionally it instantiates those classes for you. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
This object is wrapped by C<Module::Pluggable>. If you want to do something |
399
|
|
|
|
|
|
|
odd or add non-general special features you're probably best to wrap this |
400
|
|
|
|
|
|
|
and produce your own subclass. |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=head1 OPTIONS |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
See the C<Module::Pluggable> docs. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=head1 AUTHOR |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Simon Wistow <simon@thegestalt.org> |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head1 COPYING |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
Copyright, 2006 Simon Wistow |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Distributed under the same terms as Perl itself. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head1 BUGS |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
None known. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=head1 SEE ALSO |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
L<Module::Pluggable> |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=cut |
425
|
|
|
|
|
|
|
|