line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Module::Install; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
2496366
|
|
|
0
|
|
|
|
|
0
|
|
20
|
1
|
|
|
1
|
|
5
|
use 5.006; |
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
21
|
|
21
|
1
|
|
|
1
|
|
4
|
use strict 'vars'; |
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
22
|
|
22
|
1
|
|
|
1
|
|
4
|
use Cwd (); |
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
14
|
|
23
|
1
|
|
|
1
|
|
6
|
use File::Find (); |
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
24
|
|
24
|
|
|
|
|
|
|
use File::Path (); |
25
|
1
|
|
|
1
|
|
6
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
94
|
|
26
|
|
|
|
|
|
|
use vars qw{$VERSION $MAIN}; |
27
|
|
|
|
|
|
|
BEGIN { |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
1
|
|
|
1
|
|
3
|
|
34
|
|
|
|
|
|
|
$VERSION = '1.19'; |
35
|
|
|
|
|
|
|
|
36
|
1
|
|
|
|
|
2
|
|
37
|
|
|
|
|
|
|
$MAIN = undef; |
38
|
1
|
|
|
|
|
2
|
|
39
|
1
|
|
|
|
|
2783
|
*inc::Module::Install::VERSION = *VERSION; |
40
|
|
|
|
|
|
|
@inc::Module::Install::ISA = __PACKAGE__; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
0
|
|
|
sub import { |
45
|
0
|
|
|
|
|
|
my $class = shift; |
46
|
0
|
|
|
|
|
|
my $self = $class->new(@_); |
47
|
|
|
|
|
|
|
my $who = $self->_caller; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
|
61
|
0
|
0
|
|
|
|
|
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; |
|
0
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
unless ( $INC{$file} ) { die <<"END_DIE" } |
63
|
0
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Please invoke ${\__PACKAGE__} with: |
65
|
0
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
use inc::${\__PACKAGE__}; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
not: |
69
|
0
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
use ${\__PACKAGE__}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
END_DIE |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
0
|
0
|
0
|
|
|
|
|
78
|
|
|
|
|
|
|
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
0
|
0
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
if ( -f $0 ) { |
86
|
|
|
|
|
|
|
my $s = (stat($0))[9]; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
|
90
|
0
|
0
|
0
|
|
|
|
my $a = $s - time; |
|
0
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
if ( $a > 0 and $a < 5 ) { sleep 5 } |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
|
94
|
0
|
0
|
|
|
|
|
my $t = time; |
|
0
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
if ( $s > $t ) { die <<"END_DIE" } |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Your installer $0 has a modification time in the future ($s > $t). |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
This is known to create infinite loops in make. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Please correct this, then run $0 again. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
END_DIE |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Module::Install no longer supports Build.PL. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
It was impossible to maintain duel backends, and has been deprecated. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Please remove all Build.PL files and only use the Makefile.PL installer. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
END_DIE |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
$^H |= strict::bits(qw(refs subs vars)); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
0
|
0
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
unless ( -f $self->{file} ) { |
129
|
0
|
0
|
|
|
|
|
foreach my $key (keys %INC) { |
130
|
|
|
|
|
|
|
delete $INC{$key} if $key =~ /Module\/Install/; |
131
|
|
|
|
|
|
|
} |
132
|
0
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
local $^W; |
134
|
0
|
|
|
|
|
|
require "$self->{path}/$self->{dispatch}.pm"; |
135
|
0
|
|
|
|
|
|
File::Path::mkpath("$self->{prefix}/$self->{author}"); |
136
|
0
|
|
|
|
|
|
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); |
137
|
0
|
|
|
|
|
|
$self->{admin}->init; |
138
|
0
|
|
|
|
|
|
@_ = ($class, _self => $self); |
|
0
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
goto &{"$self->{name}::import"}; |
140
|
|
|
|
|
|
|
} |
141
|
0
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
local $^W; |
|
0
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
*{"${who}::AUTOLOAD"} = $self->autoload; |
144
|
|
|
|
|
|
|
$self->preload; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
delete $INC{'inc/Module/Install.pm'}; |
148
|
|
|
|
|
|
|
delete $INC{'Module/Install.pm'}; |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$MAIN = $self; |
152
|
0
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
return 1; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
0
|
0
|
|
sub autoload { |
157
|
0
|
|
|
|
|
|
my $self = shift; |
158
|
0
|
|
|
|
|
|
my $who = $self->_caller; |
159
|
0
|
|
|
|
|
|
my $cwd = Cwd::getcwd(); |
160
|
|
|
|
|
|
|
my $sym = "${who}::AUTOLOAD"; |
161
|
0
|
|
|
0
|
|
|
$sym->{$cwd} = sub { |
162
|
0
|
0
|
|
|
|
|
my $pwd = Cwd::getcwd(); |
163
|
|
|
|
|
|
|
if ( my $code = $sym->{$pwd} ) { |
164
|
0
|
0
|
|
|
|
|
|
165
|
|
|
|
|
|
|
goto &$code unless $cwd eq $pwd; |
166
|
0
|
0
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
unless ($$sym =~ s/([^:]+)$//) { |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
my ($package, $file, $line) = caller; |
173
|
|
|
|
|
|
|
die <<"EOT"; |
174
|
|
|
|
|
|
|
Unknown function is found at $file line $line. |
175
|
|
|
|
|
|
|
Execution of $file aborted due to runtime errors. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
If you're a contributor to a project, you may need to install |
178
|
|
|
|
|
|
|
some Module::Install extensions from CPAN (or other repository). |
179
|
|
|
|
|
|
|
If you're a user of a module, please contact the author. |
180
|
|
|
|
|
|
|
EOT |
181
|
0
|
|
|
|
|
|
} |
182
|
0
|
0
|
0
|
|
|
|
my $method = $1; |
|
|
0
|
|
|
|
|
|
183
|
|
|
|
|
|
|
if ( uc($method) eq $method ) { |
184
|
0
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
return; |
186
|
|
|
|
|
|
|
} elsif ( $method =~ /^_/ and $self->can($method) ) { |
187
|
0
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
return $self->$method(@_); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
0
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
unshift @_, ( $self, $1 ); |
|
0
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
goto &{$self->can('call')}; |
194
|
|
|
|
|
|
|
}; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
0
|
0
|
|
sub preload { |
198
|
0
|
0
|
|
|
|
|
my $self = shift; |
199
|
0
|
|
|
|
|
|
unless ( $self->{extensions} ) { |
200
|
|
|
|
|
|
|
$self->load_extensions( |
201
|
|
|
|
|
|
|
"$self->{prefix}/$self->{path}", $self |
202
|
|
|
|
|
|
|
); |
203
|
|
|
|
|
|
|
} |
204
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
205
|
0
|
0
|
|
|
|
|
my @exts = @{$self->{extensions}}; |
206
|
0
|
|
|
|
|
|
unless ( @exts ) { |
207
|
|
|
|
|
|
|
@exts = $self->{admin}->load_all_extensions; |
208
|
|
|
|
|
|
|
} |
209
|
0
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
|
my %seen; |
211
|
0
|
|
|
|
|
|
foreach my $obj ( @exts ) { |
|
0
|
|
|
|
|
|
|
212
|
0
|
0
|
|
|
|
|
while (my ($method, $glob) = each %{ref($obj) . '::'}) { |
213
|
0
|
0
|
|
|
|
|
next unless $obj->can($method); |
214
|
0
|
0
|
|
|
|
|
next if $method =~ /^_/; |
215
|
0
|
|
|
|
|
|
next if $method eq uc($method); |
216
|
|
|
|
|
|
|
$seen{$method}++; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
0
|
|
|
|
|
|
|
220
|
0
|
|
|
|
|
|
my $who = $self->_caller; |
221
|
0
|
|
|
|
|
|
foreach my $name ( sort keys %seen ) { |
222
|
0
|
|
|
|
|
|
local $^W; |
223
|
0
|
|
|
0
|
|
|
*{"${who}::$name"} = sub { |
|
0
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
|
${"${who}::AUTOLOAD"} = "${who}::$name"; |
|
0
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
goto &{"${who}::AUTOLOAD"}; |
226
|
|
|
|
|
|
|
}; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
0
|
0
|
|
sub new { |
231
|
|
|
|
|
|
|
my ($class, %args) = @_; |
232
|
0
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
delete $INC{'FindBin.pm'}; |
234
|
|
|
|
|
|
|
{ |
235
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
local $SIG{__WARN__} = sub {}; |
237
|
|
|
|
|
|
|
require FindBin; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
|
241
|
0
|
0
|
|
|
|
|
my $base_path = Cwd::abs_path($FindBin::Bin); |
242
|
0
|
|
|
|
|
|
unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { |
243
|
|
|
|
|
|
|
delete $args{prefix}; |
244
|
0
|
0
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
return $args{_self} if $args{_self}; |
246
|
0
|
0
|
|
|
|
|
|
247
|
|
|
|
|
|
|
$base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS'; |
248
|
0
|
|
0
|
|
|
|
|
249
|
0
|
|
0
|
|
|
|
$args{dispatch} ||= 'Admin'; |
250
|
0
|
0
|
0
|
|
|
|
$args{prefix} ||= 'inc'; |
251
|
0
|
|
0
|
|
|
|
$args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); |
252
|
0
|
|
0
|
|
|
|
$args{bundle} ||= 'inc/BUNDLES'; |
253
|
0
|
|
|
|
|
|
$args{base} ||= $base_path; |
254
|
0
|
|
0
|
|
|
|
$class =~ s/^\Q$args{prefix}\E:://; |
255
|
0
|
|
0
|
|
|
|
$args{name} ||= $class; |
256
|
0
|
0
|
|
|
|
|
$args{version} ||= $class->VERSION; |
257
|
0
|
|
|
|
|
|
unless ( $args{path} ) { |
258
|
0
|
|
|
|
|
|
$args{path} = $args{name}; |
259
|
|
|
|
|
|
|
$args{path} =~ s!::!/!g; |
260
|
0
|
|
0
|
|
|
|
} |
261
|
0
|
|
|
|
|
|
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; |
262
|
|
|
|
|
|
|
$args{wrote} = 0; |
263
|
0
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
bless( \%args, $class ); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
0
|
|
|
0
|
0
|
|
sub call { |
268
|
0
|
0
|
|
|
|
|
my ($self, $method) = @_; |
269
|
0
|
|
|
|
|
|
my $obj = $self->load($method) or return; |
270
|
0
|
|
|
|
|
|
splice(@_, 0, 2, $obj); |
|
0
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
goto &{$obj->can($method)}; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
0
|
0
|
|
sub load { |
275
|
|
|
|
|
|
|
my ($self, $method) = @_; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
$self->load_extensions( |
278
|
0
|
0
|
|
|
|
|
"$self->{prefix}/$self->{path}", $self |
279
|
|
|
|
|
|
|
) unless $self->{extensions}; |
280
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
281
|
0
|
0
|
|
|
|
|
foreach my $obj (@{$self->{extensions}}) { |
282
|
|
|
|
|
|
|
return $obj if $obj->can($method); |
283
|
|
|
|
|
|
|
} |
284
|
0
|
0
|
|
|
|
|
|
285
|
|
|
|
|
|
|
my $admin = $self->{admin} or die <<"END_DIE"; |
286
|
|
|
|
|
|
|
The '$method' method does not exist in the '$self->{prefix}' path! |
287
|
|
|
|
|
|
|
Please remove the '$self->{prefix}' directory and run $0 again to load it. |
288
|
|
|
|
|
|
|
END_DIE |
289
|
0
|
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
my $obj = $admin->load($method, 1); |
|
0
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
push @{$self->{extensions}}, $obj; |
292
|
0
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
$obj; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
0
|
0
|
|
sub load_extensions { |
297
|
|
|
|
|
|
|
my ($self, $path, $top) = @_; |
298
|
0
|
|
|
|
|
|
|
299
|
0
|
0
|
|
|
|
|
my $should_reload = 0; |
|
0
|
0
|
|
|
|
|
|
300
|
0
|
|
|
|
|
|
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { |
301
|
0
|
|
|
|
|
|
unshift @INC, $self->{prefix}; |
302
|
|
|
|
|
|
|
$should_reload = 1; |
303
|
|
|
|
|
|
|
} |
304
|
0
|
|
|
|
|
|
|
305
|
0
|
|
|
|
|
|
foreach my $rv ( $self->find_extensions($path) ) { |
|
0
|
|
|
|
|
|
|
306
|
0
|
0
|
|
|
|
|
my ($file, $pkg) = @{$rv}; |
307
|
|
|
|
|
|
|
next if $self->{pathnames}{$pkg}; |
308
|
0
|
|
|
|
|
|
|
309
|
0
|
|
|
|
|
|
local $@; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
310
|
0
|
0
|
|
|
|
|
my $new = eval { local $^W; require $file; $pkg->can('new') }; |
311
|
0
|
0
|
|
|
|
|
unless ( $new ) { |
312
|
0
|
|
|
|
|
|
warn $@ if $@; |
313
|
|
|
|
|
|
|
next; |
314
|
|
|
|
|
|
|
} |
315
|
0
|
0
|
|
|
|
|
$self->{pathnames}{$pkg} = |
316
|
0
|
|
|
|
|
|
$should_reload ? delete $INC{$file} : $INC{$file}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); |
318
|
|
|
|
|
|
|
} |
319
|
0
|
|
0
|
|
|
|
|
320
|
|
|
|
|
|
|
$self->{extensions} ||= []; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
0
|
0
|
|
sub find_extensions { |
324
|
|
|
|
|
|
|
my ($self, $path) = @_; |
325
|
0
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
my @found; |
327
|
0
|
|
|
0
|
|
|
File::Find::find( {no_chdir => 1, wanted => sub { |
328
|
0
|
0
|
|
|
|
|
my $file = $File::Find::name; |
329
|
0
|
|
|
|
|
|
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; |
330
|
0
|
0
|
|
|
|
|
my $subpath = $1; |
331
|
|
|
|
|
|
|
return if lc($subpath) eq lc($self->{dispatch}); |
332
|
0
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
$file = "$self->{path}/$subpath.pm"; |
334
|
0
|
|
|
|
|
|
my $pkg = "$self->{name}::$subpath"; |
335
|
|
|
|
|
|
|
$pkg =~ s!/!::!g; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
|
339
|
0
|
0
|
0
|
|
|
|
|
340
|
0
|
|
|
|
|
|
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { |
341
|
0
|
|
|
|
|
|
my $content = Module::Install::_read($File::Find::name); |
342
|
0
|
|
|
|
|
|
my $in_pod = 0; |
343
|
0
|
0
|
|
|
|
|
foreach ( split /\n/, $content ) { |
344
|
0
|
0
|
|
|
|
|
$in_pod = 1 if /^=\w/; |
345
|
0
|
0
|
0
|
|
|
|
$in_pod = 0 if /^=cut/; |
346
|
0
|
0
|
|
|
|
|
next if ($in_pod || /^=cut/); |
347
|
0
|
0
|
|
|
|
|
next if /^\s*#/; |
348
|
0
|
|
|
|
|
|
if ( m/^\s*package\s+($pkg)\s*;/i ) { |
349
|
0
|
|
|
|
|
|
$pkg = $1; |
350
|
|
|
|
|
|
|
last; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
0
|
|
|
|
|
|
|
355
|
0
|
0
|
|
|
|
|
push @found, [ $file, $pkg ]; |
356
|
|
|
|
|
|
|
}}, $path ) if -d $path; |
357
|
0
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
@found; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
|
368
|
0
|
|
|
0
|
|
|
sub _caller { |
369
|
0
|
|
|
|
|
|
my $depth = 0; |
370
|
0
|
|
|
|
|
|
my $call = caller($depth); |
371
|
0
|
|
|
|
|
|
while ( $call eq __PACKAGE__ ) { |
372
|
0
|
|
|
|
|
|
$depth++; |
373
|
|
|
|
|
|
|
$call = caller($depth); |
374
|
0
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
return $call; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
0
|
|
|
0
|
|
|
sub _read { |
379
|
0
|
0
|
|
|
|
|
local *FH; |
380
|
0
|
|
|
|
|
|
open( FH, '<', $_[0] ) or die "open($_[0]): $!"; |
381
|
0
|
|
|
|
|
|
binmode FH; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
382
|
0
|
0
|
|
|
|
|
my $string = do { local $/; <FH> }; |
383
|
0
|
|
|
|
|
|
close FH or die "close($_[0]): $!"; |
384
|
|
|
|
|
|
|
return $string; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
0
|
|
|
0
|
|
|
sub _readperl { |
388
|
0
|
|
|
|
|
|
my $string = Module::Install::_read($_[0]); |
389
|
0
|
|
|
|
|
|
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; |
390
|
0
|
|
|
|
|
|
$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; |
391
|
0
|
|
|
|
|
|
$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; |
392
|
|
|
|
|
|
|
return $string; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
0
|
|
|
sub _readpod { |
396
|
0
|
|
|
|
|
|
my $string = Module::Install::_read($_[0]); |
397
|
0
|
0
|
|
|
|
|
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; |
398
|
0
|
|
|
|
|
|
return $string if $_[0] =~ /\.pod\z/; |
399
|
0
|
|
|
|
|
|
$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; |
400
|
0
|
|
|
|
|
|
$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; |
401
|
0
|
|
|
|
|
|
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; |
402
|
0
|
|
|
|
|
|
$string =~ s/^\n+//s; |
403
|
|
|
|
|
|
|
return $string; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
0
|
|
|
0
|
|
|
sub _write { |
407
|
0
|
0
|
|
|
|
|
local *FH; |
408
|
0
|
|
|
|
|
|
open( FH, '>', $_[0] ) or die "open($_[0]): $!"; |
409
|
0
|
|
|
|
|
|
binmode FH; |
410
|
0
|
0
|
|
|
|
|
foreach ( 1 .. $#_ ) { |
411
|
|
|
|
|
|
|
print FH $_[$_] or die "print($_[0]): $!"; |
412
|
0
|
0
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
close FH or die "close($_[0]): $!"; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
0
|
|
0
|
0
|
|
|
sub _version { |
419
|
0
|
|
|
|
|
|
my $s = shift || 0; |
420
|
0
|
0
|
|
|
|
|
my $d =()= $s =~ /(\.)/g; |
421
|
|
|
|
|
|
|
if ( $d >= 2 ) { |
422
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; |
424
|
0
|
|
|
|
|
|
} |
425
|
0
|
|
0
|
|
|
|
$s =~ s/^(\d+)\.?//; |
426
|
|
|
|
|
|
|
my $l = $1 || 0; |
427
|
0
|
|
|
|
|
|
my @v = map { |
|
0
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
$_ . '0' x (3 - length $_) |
429
|
0
|
0
|
|
|
|
|
} $s =~ /(\d{1,3})\D?/g; |
430
|
0
|
|
|
|
|
|
$l = $l . '.' . join '', @v if @v; |
431
|
|
|
|
|
|
|
return $l + 0; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
0
|
|
|
0
|
|
|
sub _cmp { |
435
|
|
|
|
|
|
|
_version($_[1]) <=> _version($_[2]); |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub _CLASS { |
440
|
0
|
0
|
0
|
0
|
|
|
( |
441
|
|
|
|
|
|
|
defined $_[0] |
442
|
|
|
|
|
|
|
and |
443
|
|
|
|
|
|
|
! ref $_[0] |
444
|
|
|
|
|
|
|
and |
445
|
|
|
|
|
|
|
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s |
446
|
|
|
|
|
|
|
) ? $_[0] : undef; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
1; |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
|