1 |
dpavlin |
34 |
#line 1 |
2 |
|
|
package Module::AutoInstall; |
3 |
|
|
|
4 |
|
|
use strict; |
5 |
|
|
use Cwd (); |
6 |
|
|
use ExtUtils::MakeMaker (); |
7 |
|
|
|
8 |
|
|
use vars qw{$VERSION}; |
9 |
|
|
BEGIN { |
10 |
|
|
$VERSION = '1.03'; |
11 |
|
|
} |
12 |
|
|
|
13 |
|
|
# special map on pre-defined feature sets |
14 |
|
|
my %FeatureMap = ( |
15 |
|
|
'' => 'Core Features', # XXX: deprecated |
16 |
|
|
'-core' => 'Core Features', |
17 |
|
|
); |
18 |
|
|
|
19 |
|
|
# various lexical flags |
20 |
|
|
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); |
21 |
|
|
my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); |
22 |
|
|
my ( $PostambleActions, $PostambleUsed ); |
23 |
|
|
|
24 |
|
|
# See if it's a testing or non-interactive session |
25 |
|
|
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); |
26 |
|
|
_init(); |
27 |
|
|
|
28 |
|
|
sub _accept_default { |
29 |
|
|
$AcceptDefault = shift; |
30 |
|
|
} |
31 |
|
|
|
32 |
|
|
sub missing_modules { |
33 |
|
|
return @Missing; |
34 |
|
|
} |
35 |
|
|
|
36 |
|
|
sub do_install { |
37 |
|
|
__PACKAGE__->install( |
38 |
|
|
[ |
39 |
|
|
$Config |
40 |
|
|
? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) |
41 |
|
|
: () |
42 |
|
|
], |
43 |
|
|
@Missing, |
44 |
|
|
); |
45 |
|
|
} |
46 |
|
|
|
47 |
|
|
# initialize various flags, and/or perform install |
48 |
|
|
sub _init { |
49 |
|
|
foreach my $arg ( |
50 |
|
|
@ARGV, |
51 |
|
|
split( |
52 |
|
|
/[\s\t]+/, |
53 |
|
|
$ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' |
54 |
|
|
) |
55 |
|
|
) |
56 |
|
|
{ |
57 |
|
|
if ( $arg =~ /^--config=(.*)$/ ) { |
58 |
|
|
$Config = [ split( ',', $1 ) ]; |
59 |
|
|
} |
60 |
|
|
elsif ( $arg =~ /^--installdeps=(.*)$/ ) { |
61 |
|
|
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); |
62 |
|
|
exit 0; |
63 |
|
|
} |
64 |
|
|
elsif ( $arg =~ /^--default(?:deps)?$/ ) { |
65 |
|
|
$AcceptDefault = 1; |
66 |
|
|
} |
67 |
|
|
elsif ( $arg =~ /^--check(?:deps)?$/ ) { |
68 |
|
|
$CheckOnly = 1; |
69 |
|
|
} |
70 |
|
|
elsif ( $arg =~ /^--skip(?:deps)?$/ ) { |
71 |
|
|
$SkipInstall = 1; |
72 |
|
|
} |
73 |
|
|
elsif ( $arg =~ /^--test(?:only)?$/ ) { |
74 |
|
|
$TestOnly = 1; |
75 |
|
|
} |
76 |
|
|
} |
77 |
|
|
} |
78 |
|
|
|
79 |
|
|
# overrides MakeMaker's prompt() to automatically accept the default choice |
80 |
|
|
sub _prompt { |
81 |
|
|
goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; |
82 |
|
|
|
83 |
|
|
my ( $prompt, $default ) = @_; |
84 |
|
|
my $y = ( $default =~ /^[Yy]/ ); |
85 |
|
|
|
86 |
|
|
print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; |
87 |
|
|
print "$default\n"; |
88 |
|
|
return $default; |
89 |
|
|
} |
90 |
|
|
|
91 |
|
|
# the workhorse |
92 |
|
|
sub import { |
93 |
|
|
my $class = shift; |
94 |
|
|
my @args = @_ or return; |
95 |
|
|
my $core_all; |
96 |
|
|
|
97 |
|
|
print "*** $class version " . $class->VERSION . "\n"; |
98 |
|
|
print "*** Checking for Perl dependencies...\n"; |
99 |
|
|
|
100 |
|
|
my $cwd = Cwd::cwd(); |
101 |
|
|
|
102 |
|
|
$Config = []; |
103 |
|
|
|
104 |
|
|
my $maxlen = length( |
105 |
|
|
( |
106 |
|
|
sort { length($b) <=> length($a) } |
107 |
|
|
grep { /^[^\-]/ } |
108 |
|
|
map { |
109 |
|
|
ref($_) |
110 |
|
|
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) |
111 |
|
|
: '' |
112 |
|
|
} |
113 |
|
|
map { +{@args}->{$_} } |
114 |
|
|
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } |
115 |
|
|
)[0] |
116 |
|
|
); |
117 |
|
|
|
118 |
|
|
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { |
119 |
|
|
my ( @required, @tests, @skiptests ); |
120 |
|
|
my $default = 1; |
121 |
|
|
my $conflict = 0; |
122 |
|
|
|
123 |
|
|
if ( $feature =~ m/^-(\w+)$/ ) { |
124 |
|
|
my $option = lc($1); |
125 |
|
|
|
126 |
|
|
# check for a newer version of myself |
127 |
|
|
_update_to( $modules, @_ ) and return if $option eq 'version'; |
128 |
|
|
|
129 |
|
|
# sets CPAN configuration options |
130 |
|
|
$Config = $modules if $option eq 'config'; |
131 |
|
|
|
132 |
|
|
# promote every features to core status |
133 |
|
|
$core_all = ( $modules =~ /^all$/i ) and next |
134 |
|
|
if $option eq 'core'; |
135 |
|
|
|
136 |
|
|
next unless $option eq 'core'; |
137 |
|
|
} |
138 |
|
|
|
139 |
|
|
print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; |
140 |
|
|
|
141 |
|
|
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); |
142 |
|
|
|
143 |
|
|
unshift @$modules, -default => &{ shift(@$modules) } |
144 |
|
|
if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability |
145 |
|
|
|
146 |
|
|
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { |
147 |
|
|
if ( $mod =~ m/^-(\w+)$/ ) { |
148 |
|
|
my $option = lc($1); |
149 |
|
|
|
150 |
|
|
$default = $arg if ( $option eq 'default' ); |
151 |
|
|
$conflict = $arg if ( $option eq 'conflict' ); |
152 |
|
|
@tests = @{$arg} if ( $option eq 'tests' ); |
153 |
|
|
@skiptests = @{$arg} if ( $option eq 'skiptests' ); |
154 |
|
|
|
155 |
|
|
next; |
156 |
|
|
} |
157 |
|
|
|
158 |
|
|
printf( "- %-${maxlen}s ...", $mod ); |
159 |
|
|
|
160 |
|
|
if ( $arg and $arg =~ /^\D/ ) { |
161 |
|
|
unshift @$modules, $arg; |
162 |
|
|
$arg = 0; |
163 |
|
|
} |
164 |
|
|
|
165 |
|
|
# XXX: check for conflicts and uninstalls(!) them. |
166 |
|
|
if ( |
167 |
|
|
defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) |
168 |
|
|
{ |
169 |
|
|
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; |
170 |
|
|
push @Existing, $mod => $arg; |
171 |
|
|
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests; |
172 |
|
|
} |
173 |
|
|
else { |
174 |
|
|
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; |
175 |
|
|
push @required, $mod => $arg; |
176 |
|
|
} |
177 |
|
|
} |
178 |
|
|
|
179 |
|
|
next unless @required; |
180 |
|
|
|
181 |
|
|
my $mandatory = ( $feature eq '-core' or $core_all ); |
182 |
|
|
|
183 |
|
|
if ( |
184 |
|
|
!$SkipInstall |
185 |
|
|
and ( |
186 |
|
|
$CheckOnly |
187 |
|
|
or _prompt( |
188 |
|
|
qq{==> Auto-install the } |
189 |
|
|
. ( @required / 2 ) |
190 |
|
|
. ( $mandatory ? ' mandatory' : ' optional' ) |
191 |
|
|
. qq{ module(s) from CPAN?}, |
192 |
|
|
$default ? 'y' : 'n', |
193 |
|
|
) =~ /^[Yy]/ |
194 |
|
|
) |
195 |
|
|
) |
196 |
|
|
{ |
197 |
|
|
push( @Missing, @required ); |
198 |
|
|
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests; |
199 |
|
|
} |
200 |
|
|
|
201 |
|
|
elsif ( !$SkipInstall |
202 |
|
|
and $default |
203 |
|
|
and $mandatory |
204 |
|
|
and |
205 |
|
|
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) |
206 |
|
|
=~ /^[Nn]/ ) |
207 |
|
|
{ |
208 |
|
|
push( @Missing, @required ); |
209 |
|
|
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests; |
210 |
|
|
} |
211 |
|
|
|
212 |
|
|
else { |
213 |
|
|
$DisabledTests{$_} = 1 for map { glob($_) } @tests; |
214 |
|
|
} |
215 |
|
|
} |
216 |
|
|
|
217 |
|
|
$UnderCPAN = _check_lock(); # check for $UnderCPAN |
218 |
|
|
|
219 |
|
|
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { |
220 |
|
|
require Config; |
221 |
|
|
print |
222 |
|
|
"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; |
223 |
|
|
|
224 |
|
|
# make an educated guess of whether we'll need root permission. |
225 |
|
|
print " (You may need to do that as the 'root' user.)\n" |
226 |
|
|
if eval '$>'; |
227 |
|
|
} |
228 |
|
|
print "*** $class configuration finished.\n"; |
229 |
|
|
|
230 |
|
|
chdir $cwd; |
231 |
|
|
|
232 |
|
|
# import to main:: |
233 |
|
|
no strict 'refs'; |
234 |
|
|
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; |
235 |
|
|
} |
236 |
|
|
|
237 |
|
|
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS; |
238 |
|
|
# if we are, then we simply let it taking care of our dependencies |
239 |
|
|
sub _check_lock { |
240 |
|
|
return unless @Missing; |
241 |
|
|
|
242 |
|
|
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { |
243 |
|
|
print <<'END_MESSAGE'; |
244 |
|
|
|
245 |
|
|
*** Since we're running under CPANPLUS, I'll just let it take care |
246 |
|
|
of the dependency's installation later. |
247 |
|
|
END_MESSAGE |
248 |
|
|
return 1; |
249 |
|
|
} |
250 |
|
|
|
251 |
|
|
_load_cpan(); |
252 |
|
|
|
253 |
|
|
# Find the CPAN lock-file |
254 |
|
|
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); |
255 |
|
|
return unless -f $lock; |
256 |
|
|
|
257 |
|
|
# Check the lock |
258 |
|
|
local *LOCK; |
259 |
|
|
return unless open(LOCK, $lock); |
260 |
|
|
|
261 |
|
|
if ( |
262 |
|
|
( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() ) |
263 |
|
|
and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' |
264 |
|
|
) { |
265 |
|
|
print <<'END_MESSAGE'; |
266 |
|
|
|
267 |
|
|
*** Since we're running under CPAN, I'll just let it take care |
268 |
|
|
of the dependency's installation later. |
269 |
|
|
END_MESSAGE |
270 |
|
|
return 1; |
271 |
|
|
} |
272 |
|
|
|
273 |
|
|
close LOCK; |
274 |
|
|
return; |
275 |
|
|
} |
276 |
|
|
|
277 |
|
|
sub install { |
278 |
|
|
my $class = shift; |
279 |
|
|
|
280 |
|
|
my $i; # used below to strip leading '-' from config keys |
281 |
|
|
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); |
282 |
|
|
|
283 |
|
|
my ( @modules, @installed ); |
284 |
|
|
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { |
285 |
|
|
|
286 |
|
|
# grep out those already installed |
287 |
|
|
if ( defined( _version_check( _load($pkg), $ver ) ) ) { |
288 |
|
|
push @installed, $pkg; |
289 |
|
|
} |
290 |
|
|
else { |
291 |
|
|
push @modules, $pkg, $ver; |
292 |
|
|
} |
293 |
|
|
} |
294 |
|
|
|
295 |
|
|
return @installed unless @modules; # nothing to do |
296 |
|
|
return @installed if _check_lock(); # defer to the CPAN shell |
297 |
|
|
|
298 |
|
|
print "*** Installing dependencies...\n"; |
299 |
|
|
|
300 |
|
|
return unless _connected_to('cpan.org'); |
301 |
|
|
|
302 |
|
|
my %args = @config; |
303 |
|
|
my %failed; |
304 |
|
|
local *FAILED; |
305 |
|
|
if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { |
306 |
|
|
while (<FAILED>) { chomp; $failed{$_}++ } |
307 |
|
|
close FAILED; |
308 |
|
|
|
309 |
|
|
my @newmod; |
310 |
|
|
while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { |
311 |
|
|
push @newmod, ( $k => $v ) unless $failed{$k}; |
312 |
|
|
} |
313 |
|
|
@modules = @newmod; |
314 |
|
|
} |
315 |
|
|
|
316 |
|
|
if ( _has_cpanplus() ) { |
317 |
|
|
_install_cpanplus( \@modules, \@config ); |
318 |
|
|
} else { |
319 |
|
|
_install_cpan( \@modules, \@config ); |
320 |
|
|
} |
321 |
|
|
|
322 |
|
|
print "*** $class installation finished.\n"; |
323 |
|
|
|
324 |
|
|
# see if we have successfully installed them |
325 |
|
|
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { |
326 |
|
|
if ( defined( _version_check( _load($pkg), $ver ) ) ) { |
327 |
|
|
push @installed, $pkg; |
328 |
|
|
} |
329 |
|
|
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { |
330 |
|
|
print FAILED "$pkg\n"; |
331 |
|
|
} |
332 |
|
|
} |
333 |
|
|
|
334 |
|
|
close FAILED if $args{do_once}; |
335 |
|
|
|
336 |
|
|
return @installed; |
337 |
|
|
} |
338 |
|
|
|
339 |
|
|
sub _install_cpanplus { |
340 |
|
|
my @modules = @{ +shift }; |
341 |
|
|
my @config = _cpanplus_config( @{ +shift } ); |
342 |
|
|
my $installed = 0; |
343 |
|
|
|
344 |
|
|
require CPANPLUS::Backend; |
345 |
|
|
my $cp = CPANPLUS::Backend->new; |
346 |
|
|
my $conf = $cp->configure_object; |
347 |
|
|
|
348 |
|
|
return unless $conf->can('conf') # 0.05x+ with "sudo" support |
349 |
|
|
or _can_write($conf->_get_build('base')); # 0.04x |
350 |
|
|
|
351 |
|
|
# if we're root, set UNINST=1 to avoid trouble unless user asked for it. |
352 |
|
|
my $makeflags = $conf->get_conf('makeflags') || ''; |
353 |
|
|
if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { |
354 |
|
|
# 0.03+ uses a hashref here |
355 |
|
|
$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; |
356 |
|
|
|
357 |
|
|
} else { |
358 |
|
|
# 0.02 and below uses a scalar |
359 |
|
|
$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) |
360 |
|
|
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); |
361 |
|
|
|
362 |
|
|
} |
363 |
|
|
$conf->set_conf( makeflags => $makeflags ); |
364 |
|
|
$conf->set_conf( prereqs => 1 ); |
365 |
|
|
|
366 |
|
|
|
367 |
|
|
|
368 |
|
|
while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { |
369 |
|
|
$conf->set_conf( $key, $val ); |
370 |
|
|
} |
371 |
|
|
|
372 |
|
|
my $modtree = $cp->module_tree; |
373 |
|
|
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { |
374 |
|
|
print "*** Installing $pkg...\n"; |
375 |
|
|
|
376 |
|
|
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; |
377 |
|
|
|
378 |
|
|
my $success; |
379 |
|
|
my $obj = $modtree->{$pkg}; |
380 |
|
|
|
381 |
|
|
if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { |
382 |
|
|
my $pathname = $pkg; |
383 |
|
|
$pathname =~ s/::/\\W/; |
384 |
|
|
|
385 |
|
|
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { |
386 |
|
|
delete $INC{$inc}; |
387 |
|
|
} |
388 |
|
|
|
389 |
|
|
my $rv = $cp->install( modules => [ $obj->{module} ] ); |
390 |
|
|
|
391 |
|
|
if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { |
392 |
|
|
print "*** $pkg successfully installed.\n"; |
393 |
|
|
$success = 1; |
394 |
|
|
} else { |
395 |
|
|
print "*** $pkg installation cancelled.\n"; |
396 |
|
|
$success = 0; |
397 |
|
|
} |
398 |
|
|
|
399 |
|
|
$installed += $success; |
400 |
|
|
} else { |
401 |
|
|
print << "."; |
402 |
|
|
*** Could not find a version $ver or above for $pkg; skipping. |
403 |
|
|
. |
404 |
|
|
} |
405 |
|
|
|
406 |
|
|
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; |
407 |
|
|
} |
408 |
|
|
|
409 |
|
|
return $installed; |
410 |
|
|
} |
411 |
|
|
|
412 |
|
|
sub _cpanplus_config { |
413 |
|
|
my @config = (); |
414 |
|
|
while ( @_ ) { |
415 |
|
|
my ($key, $value) = (shift(), shift()); |
416 |
|
|
if ( $key eq 'prerequisites_policy' ) { |
417 |
|
|
if ( $value eq 'follow' ) { |
418 |
|
|
$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); |
419 |
|
|
} elsif ( $value eq 'ask' ) { |
420 |
|
|
$value = CPANPLUS::Internals::Constants::PREREQ_ASK(); |
421 |
|
|
} elsif ( $value eq 'ignore' ) { |
422 |
|
|
$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); |
423 |
|
|
} else { |
424 |
|
|
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; |
425 |
|
|
} |
426 |
|
|
} else { |
427 |
|
|
die "*** Cannot convert option $key to CPANPLUS version.\n"; |
428 |
|
|
} |
429 |
|
|
} |
430 |
|
|
return @config; |
431 |
|
|
} |
432 |
|
|
|
433 |
|
|
sub _install_cpan { |
434 |
|
|
my @modules = @{ +shift }; |
435 |
|
|
my @config = @{ +shift }; |
436 |
|
|
my $installed = 0; |
437 |
|
|
my %args; |
438 |
|
|
|
439 |
|
|
_load_cpan(); |
440 |
|
|
require Config; |
441 |
|
|
|
442 |
|
|
if (CPAN->VERSION < 1.80) { |
443 |
|
|
# no "sudo" support, probe for writableness |
444 |
|
|
return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) |
445 |
|
|
and _can_write( $Config::Config{sitelib} ); |
446 |
|
|
} |
447 |
|
|
|
448 |
|
|
# if we're root, set UNINST=1 to avoid trouble unless user asked for it. |
449 |
|
|
my $makeflags = $CPAN::Config->{make_install_arg} || ''; |
450 |
|
|
$CPAN::Config->{make_install_arg} = |
451 |
|
|
join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) |
452 |
|
|
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); |
453 |
|
|
|
454 |
|
|
# don't show start-up info |
455 |
|
|
$CPAN::Config->{inhibit_startup_message} = 1; |
456 |
|
|
|
457 |
|
|
# set additional options |
458 |
|
|
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { |
459 |
|
|
( $args{$opt} = $arg, next ) |
460 |
|
|
if $opt =~ /^force$/; # pseudo-option |
461 |
|
|
$CPAN::Config->{$opt} = $arg; |
462 |
|
|
} |
463 |
|
|
|
464 |
|
|
local $CPAN::Config->{prerequisites_policy} = 'follow'; |
465 |
|
|
|
466 |
|
|
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { |
467 |
|
|
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; |
468 |
|
|
|
469 |
|
|
print "*** Installing $pkg...\n"; |
470 |
|
|
|
471 |
|
|
my $obj = CPAN::Shell->expand( Module => $pkg ); |
472 |
|
|
my $success = 0; |
473 |
|
|
|
474 |
|
|
if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { |
475 |
|
|
my $pathname = $pkg; |
476 |
|
|
$pathname =~ s/::/\\W/; |
477 |
|
|
|
478 |
|
|
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { |
479 |
|
|
delete $INC{$inc}; |
480 |
|
|
} |
481 |
|
|
|
482 |
|
|
my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) |
483 |
|
|
: CPAN::Shell->install($pkg); |
484 |
|
|
$rv ||= eval { |
485 |
|
|
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) |
486 |
|
|
->{install} |
487 |
|
|
if $CPAN::META; |
488 |
|
|
}; |
489 |
|
|
|
490 |
|
|
if ( $rv eq 'YES' ) { |
491 |
|
|
print "*** $pkg successfully installed.\n"; |
492 |
|
|
$success = 1; |
493 |
|
|
} |
494 |
|
|
else { |
495 |
|
|
print "*** $pkg installation failed.\n"; |
496 |
|
|
$success = 0; |
497 |
|
|
} |
498 |
|
|
|
499 |
|
|
$installed += $success; |
500 |
|
|
} |
501 |
|
|
else { |
502 |
|
|
print << "."; |
503 |
|
|
*** Could not find a version $ver or above for $pkg; skipping. |
504 |
|
|
. |
505 |
|
|
} |
506 |
|
|
|
507 |
|
|
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; |
508 |
|
|
} |
509 |
|
|
|
510 |
|
|
return $installed; |
511 |
|
|
} |
512 |
|
|
|
513 |
|
|
sub _has_cpanplus { |
514 |
|
|
return ( |
515 |
|
|
$HasCPANPLUS = ( |
516 |
|
|
$INC{'CPANPLUS/Config.pm'} |
517 |
|
|
or _load('CPANPLUS::Shell::Default') |
518 |
|
|
) |
519 |
|
|
); |
520 |
|
|
} |
521 |
|
|
|
522 |
|
|
# make guesses on whether we're under the CPAN installation directory |
523 |
|
|
sub _under_cpan { |
524 |
|
|
require Cwd; |
525 |
|
|
require File::Spec; |
526 |
|
|
|
527 |
|
|
my $cwd = File::Spec->canonpath( Cwd::cwd() ); |
528 |
|
|
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); |
529 |
|
|
|
530 |
|
|
return ( index( $cwd, $cpan ) > -1 ); |
531 |
|
|
} |
532 |
|
|
|
533 |
|
|
sub _update_to { |
534 |
|
|
my $class = __PACKAGE__; |
535 |
|
|
my $ver = shift; |
536 |
|
|
|
537 |
|
|
return |
538 |
|
|
if defined( _version_check( _load($class), $ver ) ); # no need to upgrade |
539 |
|
|
|
540 |
|
|
if ( |
541 |
|
|
_prompt( "==> A newer version of $class ($ver) is required. Install?", |
542 |
|
|
'y' ) =~ /^[Nn]/ |
543 |
|
|
) |
544 |
|
|
{ |
545 |
|
|
die "*** Please install $class $ver manually.\n"; |
546 |
|
|
} |
547 |
|
|
|
548 |
|
|
print << "."; |
549 |
|
|
*** Trying to fetch it from CPAN... |
550 |
|
|
. |
551 |
|
|
|
552 |
|
|
# install ourselves |
553 |
|
|
_load($class) and return $class->import(@_) |
554 |
|
|
if $class->install( [], $class, $ver ); |
555 |
|
|
|
556 |
|
|
print << '.'; exit 1; |
557 |
|
|
|
558 |
|
|
*** Cannot bootstrap myself. :-( Installation terminated. |
559 |
|
|
. |
560 |
|
|
} |
561 |
|
|
|
562 |
|
|
# check if we're connected to some host, using inet_aton |
563 |
|
|
sub _connected_to { |
564 |
|
|
my $site = shift; |
565 |
|
|
|
566 |
|
|
return ( |
567 |
|
|
( _load('Socket') and Socket::inet_aton($site) ) or _prompt( |
568 |
|
|
qq( |
569 |
|
|
*** Your host cannot resolve the domain name '$site', which |
570 |
|
|
probably means the Internet connections are unavailable. |
571 |
|
|
==> Should we try to install the required module(s) anyway?), 'n' |
572 |
|
|
) =~ /^[Yy]/ |
573 |
|
|
); |
574 |
|
|
} |
575 |
|
|
|
576 |
|
|
# check if a directory is writable; may create it on demand |
577 |
|
|
sub _can_write { |
578 |
|
|
my $path = shift; |
579 |
|
|
mkdir( $path, 0755 ) unless -e $path; |
580 |
|
|
|
581 |
|
|
return 1 if -w $path; |
582 |
|
|
|
583 |
|
|
print << "."; |
584 |
|
|
*** You are not allowed to write to the directory '$path'; |
585 |
|
|
the installation may fail due to insufficient permissions. |
586 |
|
|
. |
587 |
|
|
|
588 |
|
|
if ( |
589 |
|
|
eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( |
590 |
|
|
qq( |
591 |
|
|
==> Should we try to re-execute the autoinstall process with 'sudo'?), |
592 |
|
|
((-t STDIN) ? 'y' : 'n') |
593 |
|
|
) =~ /^[Yy]/ |
594 |
|
|
) |
595 |
|
|
{ |
596 |
|
|
|
597 |
|
|
# try to bootstrap ourselves from sudo |
598 |
|
|
print << "."; |
599 |
|
|
*** Trying to re-execute the autoinstall process with 'sudo'... |
600 |
|
|
. |
601 |
|
|
my $missing = join( ',', @Missing ); |
602 |
|
|
my $config = join( ',', |
603 |
|
|
UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) |
604 |
|
|
if $Config; |
605 |
|
|
|
606 |
|
|
return |
607 |
|
|
unless system( 'sudo', $^X, $0, "--config=$config", |
608 |
|
|
"--installdeps=$missing" ); |
609 |
|
|
|
610 |
|
|
print << "."; |
611 |
|
|
*** The 'sudo' command exited with error! Resuming... |
612 |
|
|
. |
613 |
|
|
} |
614 |
|
|
|
615 |
|
|
return _prompt( |
616 |
|
|
qq( |
617 |
|
|
==> Should we try to install the required module(s) anyway?), 'n' |
618 |
|
|
) =~ /^[Yy]/; |
619 |
|
|
} |
620 |
|
|
|
621 |
|
|
# load a module and return the version it reports |
622 |
|
|
sub _load { |
623 |
|
|
my $mod = pop; # class/instance doesn't matter |
624 |
|
|
my $file = $mod; |
625 |
|
|
|
626 |
|
|
$file =~ s|::|/|g; |
627 |
|
|
$file .= '.pm'; |
628 |
|
|
|
629 |
|
|
local $@; |
630 |
|
|
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); |
631 |
|
|
} |
632 |
|
|
|
633 |
|
|
# Load CPAN.pm and it's configuration |
634 |
|
|
sub _load_cpan { |
635 |
|
|
return if $CPAN::VERSION; |
636 |
|
|
require CPAN; |
637 |
|
|
if ( $CPAN::HandleConfig::VERSION ) { |
638 |
|
|
# Newer versions of CPAN have a HandleConfig module |
639 |
|
|
CPAN::HandleConfig->load; |
640 |
|
|
} else { |
641 |
|
|
# Older versions had the load method in Config directly |
642 |
|
|
CPAN::Config->load; |
643 |
|
|
} |
644 |
|
|
} |
645 |
|
|
|
646 |
|
|
# compare two versions, either use Sort::Versions or plain comparison |
647 |
|
|
sub _version_check { |
648 |
|
|
my ( $cur, $min ) = @_; |
649 |
|
|
return unless defined $cur; |
650 |
|
|
|
651 |
|
|
$cur =~ s/\s+$//; |
652 |
|
|
|
653 |
|
|
# check for version numbers that are not in decimal format |
654 |
|
|
if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { |
655 |
|
|
if ( ( $version::VERSION or defined( _load('version') )) and |
656 |
|
|
version->can('new') |
657 |
|
|
) { |
658 |
|
|
|
659 |
|
|
# use version.pm if it is installed. |
660 |
|
|
return ( |
661 |
|
|
( version->new($cur) >= version->new($min) ) ? $cur : undef ); |
662 |
|
|
} |
663 |
|
|
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) |
664 |
|
|
{ |
665 |
|
|
|
666 |
|
|
# use Sort::Versions as the sorting algorithm for a.b.c versions |
667 |
|
|
return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) |
668 |
|
|
? $cur |
669 |
|
|
: undef ); |
670 |
|
|
} |
671 |
|
|
|
672 |
|
|
warn "Cannot reliably compare non-decimal formatted versions.\n" |
673 |
|
|
. "Please install version.pm or Sort::Versions.\n"; |
674 |
|
|
} |
675 |
|
|
|
676 |
|
|
# plain comparison |
677 |
|
|
local $^W = 0; # shuts off 'not numeric' bugs |
678 |
|
|
return ( $cur >= $min ? $cur : undef ); |
679 |
|
|
} |
680 |
|
|
|
681 |
|
|
# nothing; this usage is deprecated. |
682 |
|
|
sub main::PREREQ_PM { return {}; } |
683 |
|
|
|
684 |
|
|
sub _make_args { |
685 |
|
|
my %args = @_; |
686 |
|
|
|
687 |
|
|
$args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } |
688 |
|
|
if $UnderCPAN or $TestOnly; |
689 |
|
|
|
690 |
|
|
if ( $args{EXE_FILES} and -e 'MANIFEST' ) { |
691 |
|
|
require ExtUtils::Manifest; |
692 |
|
|
my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); |
693 |
|
|
|
694 |
|
|
$args{EXE_FILES} = |
695 |
|
|
[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; |
696 |
|
|
} |
697 |
|
|
|
698 |
|
|
$args{test}{TESTS} ||= 't/*.t'; |
699 |
|
|
$args{test}{TESTS} = join( ' ', |
700 |
|
|
grep { !exists( $DisabledTests{$_} ) } |
701 |
|
|
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); |
702 |
|
|
|
703 |
|
|
my $missing = join( ',', @Missing ); |
704 |
|
|
my $config = |
705 |
|
|
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) |
706 |
|
|
if $Config; |
707 |
|
|
|
708 |
|
|
$PostambleActions = ( |
709 |
|
|
$missing |
710 |
|
|
? "\$(PERL) $0 --config=$config --installdeps=$missing" |
711 |
|
|
: "\$(NOECHO) \$(NOOP)" |
712 |
|
|
); |
713 |
|
|
|
714 |
|
|
return %args; |
715 |
|
|
} |
716 |
|
|
|
717 |
|
|
# a wrapper to ExtUtils::MakeMaker::WriteMakefile |
718 |
|
|
sub Write { |
719 |
|
|
require Carp; |
720 |
|
|
Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; |
721 |
|
|
|
722 |
|
|
if ($CheckOnly) { |
723 |
|
|
print << "."; |
724 |
|
|
*** Makefile not written in check-only mode. |
725 |
|
|
. |
726 |
|
|
return; |
727 |
|
|
} |
728 |
|
|
|
729 |
|
|
my %args = _make_args(@_); |
730 |
|
|
|
731 |
|
|
no strict 'refs'; |
732 |
|
|
|
733 |
|
|
$PostambleUsed = 0; |
734 |
|
|
local *MY::postamble = \&postamble unless defined &MY::postamble; |
735 |
|
|
ExtUtils::MakeMaker::WriteMakefile(%args); |
736 |
|
|
|
737 |
|
|
print << "." unless $PostambleUsed; |
738 |
|
|
*** WARNING: Makefile written with customized MY::postamble() without |
739 |
|
|
including contents from Module::AutoInstall::postamble() -- |
740 |
|
|
auto installation features disabled. Please contact the author. |
741 |
|
|
. |
742 |
|
|
|
743 |
|
|
return 1; |
744 |
|
|
} |
745 |
|
|
|
746 |
|
|
sub postamble { |
747 |
|
|
$PostambleUsed = 1; |
748 |
|
|
|
749 |
|
|
return << "."; |
750 |
|
|
|
751 |
|
|
config :: installdeps |
752 |
|
|
\t\$(NOECHO) \$(NOOP) |
753 |
|
|
|
754 |
|
|
checkdeps :: |
755 |
|
|
\t\$(PERL) $0 --checkdeps |
756 |
|
|
|
757 |
|
|
installdeps :: |
758 |
|
|
\t$PostambleActions |
759 |
|
|
|
760 |
|
|
. |
761 |
|
|
|
762 |
|
|
} |
763 |
|
|
|
764 |
|
|
1; |
765 |
|
|
|
766 |
|
|
__END__ |
767 |
|
|
|
768 |
|
|
#line 1003 |