~ubuntu-branches/ubuntu/maverick/libclass-accessor-grouped-perl/maverick

« back to all changes in this revision

Viewing changes to inc/Module/AutoInstall.pm

  • Committer: Bazaar Package Importer
  • Author(s): gregor herrmann
  • Date: 2007-07-14 21:51:56 UTC
  • Revision ID: james.westby@ubuntu.com-20070714215156-l0iazyikbi21rpu8
Tags: upstream-0.07000
ImportĀ upstreamĀ versionĀ 0.07000

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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