1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
package CPANBootstrapper;
use strict;
use warnings;
sub import {
my ($class, $op) = @_;
die "no operation specified!\n"
unless $op;
my $do = $class->can("cmd_$op")
or die "invalid operation $op\n";
$do->(@ARGV);
exit 0;
}
sub cmd_init_config {
require ExtUtils::MakeMaker;
my $done;
my $orig = ExtUtils::MakeMaker->can("prompt");
no warnings 'once', 'redefine';
*ExtUtils::MakeMaker::prompt = sub ($;$) {
if (!$done && $_[0] =~ /manual configuration/) {
$done++;
return "no";
}
return $orig->(@_);
};
require CPAN;
CPAN->import;
$CPAN::Config->{urllist} = ["http://www.cpan.org/"];
CPAN::Config->load;
unless ($done || -w $CPAN::Config->{keep_source_where}) {
my $save = $CPAN::Config->{urllist};
delete @{$CPAN::Config}{keys %$CPAN::Config};
$CPAN::Config->{urllist} = $save;
CPAN::Config->init;
}
}
sub cmd_install {
my @modules = @_;
package main;
require CPAN;
CPAN->import;
CPAN::Config->load;
if ($CPAN::VERSION < 1.94_54) {
# CPAN can't download into a directory with spaces. it shells out to
# wget/curl, but doesn't quote the arguments. Change directories beforehand
# and use a relative filename so the command doesn't need quoting.
require Cwd;
require File::Basename;
require File::Path;
my $hosthard = defined &CPAN::FTP::hostdlhard ? 'hostdlhard' : 'hosthard';
no strict 'refs';
no warnings 'redefine';
my $hosthardsub = \&{"CPAN::FTP::$hosthard"};
*{"CPAN::FTP::$hosthard"} = sub {
my($self,$host_seq,$file,$aslocal,@rest) = @_;
if ($aslocal !~ m{[^a-zA-Z0-9+=_:,./-]}) {
$hosthardsub->(@_);
}
my $cwd = Cwd::cwd();
my $local_dir = File::Basename::dirname($aslocal);
my $local_file = File::Basename::basename($aslocal);
File::Path::mkpath($local_dir);
my $out;
eval {
chdir $local_dir;
$out = $hosthardsub->($self, $host_seq, $file, $local_file, @rest);
1;
} or do {
chdir $cwd;
die $@;
};
chdir $cwd;
if (defined $out && $out eq $local_file) {
return $aslocal;
}
return;
};
}
if ($CPAN::VERSION < 1.87_51) {
if (!$CPAN::META->has_inst("Compress::Zlib")) {
# gzip and tar commands shell out without quoting arguments. Wrap them in
# a quoting routine.
no warnings 'redefine';
my $quote = sub {
map +(
/^"/ ? $_
: m{[^a-zA-Z0-9+=_:,./-]} ? qq["$_"]
: $_
), @_;
};
my $gzip = \&CPAN::Tarzip::gzip;
*CPAN::Tarzip::gzip = sub {
$gzip->($_[0], $quote->(@_[1,2]));
};
my $gunzip = \&CPAN::Tarzip::gunzip;
*CPAN::Tarzip::gunzip = sub {
$gunzip->($_[0], $quote->(@_[1,2]));
};
my $gtest = \&CPAN::Tarzip::gtest;
*CPAN::Tarzip::gtest = sub {
$gtest->($_[0], $quote->($_[1]));
};
my $TIEHANDLE = \&CPAN::Tarzip::TIEHANDLE;
*CPAN::Tarzip::TIEHANDLE = sub {
$TIEHANDLE->($_[0], $quote->($_[1]));
};
}
if (MM->maybe_command($CPAN::Config->{gzip})
&&
MM->maybe_command($CPAN::Config->{tar})) {
my $untar = \&CPAN::Tarzip::untar;
*CPAN::Tarzip::untar = sub {
my ($class, $file) = @_;
# the original untar checks for .gz at the end, so quote it like
# "file.tar".gz
my $gz = $file =~ s/\.gz$//;
$file = qq["$file"] . ($gz ? '.gz' : '');
$untar->($class, $file);
};
}
}
# ExtUtils::ParseXS is a prerequisite of Module::Build. Previously,
# it included a Build.PL file. If CPAN.pm is configured to prefer
# Module::Build (the default), it would see the Build.PL file and assume
# MB was a prerequisite. This introduces a circular dependency, which would
# break installation. None of Module::Build's prerequisites include a
# Build.PL anymore, but continue to prefer EUMM as a precaution.
$CPAN::Config->{prefer_installer} = "EUMM";
if (defined ¬est) {
notest('install', @modules);
}
else {
force('install', @modules);
}
}
sub cmd_disable_manpages {
require CPAN;
CPAN->import;
CPAN::HandleConfig->load;
$CPAN::Config->{makepl_arg} = 'INSTALLMAN1DIR=none INSTALLMAN3DIR=none';
$CPAN::Config->{buildpl_arg} = '--install_path libdoc="" --install_path bindoc=""';
CPAN::Config->commit;
}
# make sure that the user doesn't have any existing CPAN config that'll
# cause us problems for the next few steps.
sub cmd_check {
my $cpan_version = shift;
# if CPAN loads this, it calls into CPAN::Shell which tries to run
# autoconfiguration. if it doesn't exist, we don't care
eval { require File::HomeDir; };
require CPAN;
# Need newish CPAN.pm for this, ergo skip it if that version of CPAN isn't
# installed yet.
# It will already be installed by the time we reach here if bootstrapping,
# otherwise, if we're running from CPAN then it will be installed soon
# enough, and we'll come back here..
if (eval { require CPAN::HandleConfig; } ) {
if (CPAN::HandleConfig->can('require_myconfig_or_config')) {
CPAN::HandleConfig->require_myconfig_or_config;
}
else {
local *CPAN::HandleConfig::missing_config_data = sub { () };
CPAN::HandleConfig->load;
}
if ( $CPAN::Config ) {
for my $setting (qw(
makepl_arg make_install_arg
mbuild_arg mbuild_install_arg mbuildpl_arg
)) {
my $value = $CPAN::Config->{$setting} or next;
if ($setting =~ /^make/
? $value =~ /(?:PREFIX|INSTALL_BASE)/
: $value =~ /(?:--prefix|--install_base)/
) {
die <<"DEATH";
WHOA THERE! It looks like you've got $CPAN::Config->{$setting} set in
your CPAN config. This is known to cause problems with local::lib. Please
either remove this setting or clear out your .cpan directory.
DEATH
}
}
}
}
else {
# Explode if it looks like requiring CPAN::HandleConfig should
# have worked, but didn't.
die $@
if $CPAN::VERSION >= $cpan_version;
}
}
1;
|
