1 |
#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 |