|
...
|
...
|
@@ -1,481 +1,35 @@
|
|
1
|
1
|
#!/usr/bin/env perl
|
|
2
|
2
|
#
|
|
3
|
|
-# You want to install cpanminus? Run the following command and it will
|
|
4
|
|
-# install itself for you. You might want to run it as a root with sudo
|
|
5
|
|
-# if you want to install to places like /usr/local/bin.
|
|
|
3
|
+# This is a pre-compiled source code for the cpanm (cpanminus) program.
|
|
|
4
|
+# For more details about how to install cpanm, go to the following URL:
|
|
6
|
5
|
#
|
|
7
|
|
-# % curl -L http://cpanmin.us | perl - --self-upgrade
|
|
|
6
|
+# https://github.com/miyagawa/cpanminus
|
|
8
|
7
|
#
|
|
9
|
|
-# If you don't have curl but wget, replace `curl -L` with `wget -O -`.
|
|
|
8
|
+# Quickstart: Run the following command and it will install itself for
|
|
|
9
|
+# you. You might want to run it as a root with sudo if you want to install
|
|
|
10
|
+# to places like /usr/local/bin.
|
|
10
|
11
|
#
|
|
11
|
|
-# For more details about this program, visit http://search.cpan.org/dist/App-cpanminus
|
|
|
12
|
+# % curl -L https://cpanmin.us | perl - App::cpanminus
|
|
12
|
13
|
#
|
|
|
14
|
+# If you don't have curl but wget, replace `curl -L` with `wget -O -`.
|
|
|
15
|
+
|
|
13
|
16
|
# DO NOT EDIT -- this is an auto generated file
|
|
|
17
|
+
|
|
14
|
18
|
# This chunk of stuff was generated by App::FatPacker. To find the original
|
|
15
|
19
|
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
|
|
16
|
20
|
BEGIN {
|
|
17
|
21
|
my %fatpacked;
|
|
18
|
22
|
|
|
19
|
|
-$fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
|
|
20
|
|
- package App::cpanminus;
|
|
21
|
|
- our $VERSION = "1.6005";
|
|
22
|
|
-
|
|
23
|
|
- =head1 NAME
|
|
24
|
|
-
|
|
25
|
|
- App::cpanminus - get, unpack, build and install modules from CPAN
|
|
26
|
|
-
|
|
27
|
|
- =head1 SYNOPSIS
|
|
28
|
|
-
|
|
29
|
|
- cpanm Module
|
|
30
|
|
-
|
|
31
|
|
- Run C<cpanm -h> or C<perldoc cpanm> for more options.
|
|
32
|
|
-
|
|
33
|
|
- =head1 DESCRIPTION
|
|
34
|
|
-
|
|
35
|
|
- cpanminus is a script to get, unpack, build and install modules from
|
|
36
|
|
- CPAN and does nothing else.
|
|
37
|
|
-
|
|
38
|
|
- It's dependency free (can bootstrap itself), requires zero
|
|
39
|
|
- configuration, and stands alone. When running, it requires only 10MB
|
|
40
|
|
- of RAM.
|
|
41
|
|
-
|
|
42
|
|
- =head1 INSTALLATION
|
|
43
|
|
-
|
|
44
|
|
- There are several ways to install cpanminus to your system.
|
|
45
|
|
-
|
|
46
|
|
- =head2 Package management system
|
|
47
|
|
-
|
|
48
|
|
- There are Debian packages, RPMs, FreeBSD ports, and packages for other
|
|
49
|
|
- operation systems available. If you want to use the package management system,
|
|
50
|
|
- search for cpanminus and use the appropriate command to install. This makes it
|
|
51
|
|
- easy to install C<cpanm> to your system without thinking about where to
|
|
52
|
|
- install, and later upgrade.
|
|
53
|
|
-
|
|
54
|
|
- =head2 Installing to system perl
|
|
55
|
|
-
|
|
56
|
|
- You can also use the latest cpanminus to install cpanminus itself:
|
|
57
|
|
-
|
|
58
|
|
- curl -L http://cpanmin.us | perl - --sudo App::cpanminus
|
|
59
|
|
-
|
|
60
|
|
- This will install C<cpanm> to your bin directory like
|
|
61
|
|
- C</usr/local/bin> (unless you configured C<INSTALL_BASE> with
|
|
62
|
|
- L<local::lib>), so you probably need the C<--sudo> option.
|
|
63
|
|
-
|
|
64
|
|
- =head2 Installing to local perl (perlbrew)
|
|
65
|
|
-
|
|
66
|
|
- If you have perl in your home directory, which is the case if you use
|
|
67
|
|
- tools like L<perlbrew>, you don't need the C<--sudo> option, since
|
|
68
|
|
- you're most likely to have a write permission to the perl's library
|
|
69
|
|
- path. You can just do:
|
|
70
|
|
-
|
|
71
|
|
- curl -L http://cpanmin.us | perl - App::cpanminus
|
|
72
|
|
-
|
|
73
|
|
- to install the C<cpanm> executable to the perl's bin path, like
|
|
74
|
|
- C<~/perl5/perlbrew/bin/cpanm>.
|
|
75
|
|
-
|
|
76
|
|
- =head2 Downloading the standalone executable
|
|
77
|
|
-
|
|
78
|
|
- You can also copy the standalone executable to whatever location you'd like.
|
|
79
|
|
-
|
|
80
|
|
- cd ~/bin
|
|
81
|
|
- curl -LO http://xrl.us/cpanm
|
|
82
|
|
- chmod +x cpanm
|
|
83
|
|
- # edit shebang if you don't have /usr/bin/env
|
|
84
|
|
-
|
|
85
|
|
- This just works, but be sure to grab the new version manually when you
|
|
86
|
|
- upgrade because C<--self-upgrade> might not work for this.
|
|
87
|
|
-
|
|
88
|
|
- =head1 DEPENDENCIES
|
|
89
|
|
-
|
|
90
|
|
- perl 5.8 or later.
|
|
91
|
|
-
|
|
92
|
|
- =over 4
|
|
93
|
|
-
|
|
94
|
|
- =item *
|
|
95
|
|
-
|
|
96
|
|
- 'tar' executable (bsdtar or GNU tar version 1.22 are rcommended) or Archive::Tar to unpack files.
|
|
97
|
|
-
|
|
98
|
|
- =item *
|
|
99
|
|
-
|
|
100
|
|
- C compiler, if you want to build XS modules.
|
|
101
|
|
-
|
|
102
|
|
- =item *
|
|
103
|
|
-
|
|
104
|
|
- make
|
|
105
|
|
-
|
|
106
|
|
- =item *
|
|
107
|
|
-
|
|
108
|
|
- Module::Build (core in 5.10)
|
|
109
|
|
-
|
|
110
|
|
- =back
|
|
111
|
|
-
|
|
112
|
|
- =head1 QUESTIONS
|
|
113
|
|
-
|
|
114
|
|
- =head2 Another CPAN installer?
|
|
115
|
|
-
|
|
116
|
|
- OK, the first motivation was this: the CPAN shell runs out of memory (or swaps
|
|
117
|
|
- heavily and gets really slow) on Slicehost/linode's most affordable plan with
|
|
118
|
|
- only 256MB RAM. Should I pay more to install perl modules from CPAN? I don't
|
|
119
|
|
- think so.
|
|
120
|
|
-
|
|
121
|
|
- =head2 But why a new client?
|
|
122
|
|
-
|
|
123
|
|
- First of all, let me be clear that CPAN and CPANPLUS are great tools
|
|
124
|
|
- I've used for I<literally> years (you know how many modules I have on
|
|
125
|
|
- CPAN, right?). I really respect their efforts of maintaining the most
|
|
126
|
|
- important tools in the CPAN toolchain ecosystem.
|
|
127
|
|
-
|
|
128
|
|
- However, for less experienced users (mostly from outside the Perl community),
|
|
129
|
|
- or even really experienced Perl developers who know how to shoot themselves in
|
|
130
|
|
- their feet, setting up the CPAN toolchain often feels like yak shaving,
|
|
131
|
|
- especially when all they want to do is just install some modules and start
|
|
132
|
|
- writing code.
|
|
133
|
|
-
|
|
134
|
|
- =head2 Zero-conf? How does this module get/parse/update the CPAN index?
|
|
135
|
|
-
|
|
136
|
|
- It queries the CPAN Meta DB site at L<http://cpanmetadb.plackperl.org/>.
|
|
137
|
|
- The site is updated at least every hour to reflect the latest changes
|
|
138
|
|
- from fast syncing mirrors. The script then also falls back to query the
|
|
139
|
|
- module at L<http://metacpan.org/> using its wonderful API.
|
|
140
|
|
-
|
|
141
|
|
- Fetched files are unpacked in C<~/.cpanm> and automatically cleaned up
|
|
142
|
|
- periodically. You can configure the location of this with the
|
|
143
|
|
- C<PERL_CPANM_HOME> environment variable.
|
|
144
|
|
-
|
|
145
|
|
- =head2 Where does this install modules to? Do I need root access?
|
|
146
|
|
-
|
|
147
|
|
- It installs to wherever ExtUtils::MakeMaker and Module::Build are
|
|
148
|
|
- configured to (via C<PERL_MM_OPT> and C<PERL_MB_OPT>). So if you're
|
|
149
|
|
- using local::lib, then it installs to your local perl5
|
|
150
|
|
- directory. Otherwise it installs to the site_perl directory that
|
|
151
|
|
- belongs to your perl.
|
|
152
|
|
-
|
|
153
|
|
- cpanminus at a boot time checks whether you have configured
|
|
154
|
|
- local::lib, or have the permission to install modules to the site_perl
|
|
155
|
|
- directory. If neither, it automatically sets up local::lib compatible
|
|
156
|
|
- installation path in a C<perl5> directory under your home
|
|
157
|
|
- directory. To avoid this, run the script as the root user, with
|
|
158
|
|
- C<--sudo> option or with C<--local-lib> option.
|
|
159
|
|
-
|
|
160
|
|
- =head2 cpanminus can't install the module XYZ. Is it a bug?
|
|
161
|
|
-
|
|
162
|
|
- It is more likely a problem with the distribution itself. cpanminus
|
|
163
|
|
- doesn't support or is known to have issues with distributions like as
|
|
164
|
|
- follows:
|
|
165
|
|
-
|
|
166
|
|
- =over 4
|
|
167
|
|
-
|
|
168
|
|
- =item *
|
|
169
|
|
-
|
|
170
|
|
- Tests that require input from STDIN.
|
|
171
|
|
-
|
|
172
|
|
- =item *
|
|
173
|
|
-
|
|
174
|
|
- Tests that might fail when C<AUTOMATED_TESTING> is enabled.
|
|
175
|
|
-
|
|
176
|
|
- =item *
|
|
177
|
|
-
|
|
178
|
|
- Modules that have invalid numeric values as VERSION (such as C<1.1a>)
|
|
179
|
|
-
|
|
180
|
|
- =back
|
|
181
|
|
-
|
|
182
|
|
- These failures can be reported back to the author of the module so
|
|
183
|
|
- that they can fix it accordingly, rather than me.
|
|
184
|
|
-
|
|
185
|
|
- =head2 Does cpanm support the feature XYZ of L<CPAN> and L<CPANPLUS>?
|
|
186
|
|
-
|
|
187
|
|
- Most likely not. Here are the things that cpanm doesn't do by
|
|
188
|
|
- itself. And it's a feature - you got that from the name I<minus>,
|
|
189
|
|
- right?
|
|
190
|
|
-
|
|
191
|
|
- If you need these features, use L<CPAN>, L<CPANPLUS> or the standalone
|
|
192
|
|
- tools that are mentioned.
|
|
193
|
|
-
|
|
194
|
|
- =over 4
|
|
195
|
|
-
|
|
196
|
|
- =item *
|
|
197
|
|
-
|
|
198
|
|
- Bundle:: module dependencies
|
|
199
|
|
-
|
|
200
|
|
- =item *
|
|
201
|
|
-
|
|
202
|
|
- CPAN testers reporting
|
|
203
|
|
-
|
|
204
|
|
- =item *
|
|
205
|
|
-
|
|
206
|
|
- Building RPM packages from CPAN modules
|
|
207
|
|
-
|
|
208
|
|
- =item *
|
|
209
|
|
-
|
|
210
|
|
- Listing the outdated modules that needs upgrading. See L<App::cpanoutdated>
|
|
211
|
|
-
|
|
212
|
|
- =item *
|
|
213
|
|
-
|
|
214
|
|
- Uninstalling modules. See L<pm-uninstall>.
|
|
215
|
|
-
|
|
216
|
|
- =item *
|
|
217
|
|
-
|
|
218
|
|
- Showing the changes of the modules you're about to upgrade. See L<cpan-listchanges>
|
|
219
|
|
-
|
|
220
|
|
- =item *
|
|
221
|
|
-
|
|
222
|
|
- Patching CPAN modules with distroprefs.
|
|
223
|
|
-
|
|
224
|
|
- =back
|
|
225
|
|
-
|
|
226
|
|
- See L<cpanm> or C<cpanm -h> to see what cpanminus I<can> do :)
|
|
227
|
|
-
|
|
228
|
|
- =head1 COPYRIGHT
|
|
229
|
|
-
|
|
230
|
|
- Copyright 2010- Tatsuhiko Miyagawa
|
|
231
|
|
-
|
|
232
|
|
- The standalone executable contains the following modules embedded.
|
|
233
|
|
-
|
|
234
|
|
- =over 4
|
|
235
|
|
-
|
|
236
|
|
- =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
|
|
237
|
|
-
|
|
238
|
|
- =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
|
|
239
|
|
-
|
|
240
|
|
- =item L<local::lib> Copyright 2007-2009 Matt S Trout
|
|
241
|
|
-
|
|
242
|
|
- =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
|
|
243
|
|
-
|
|
244
|
|
- =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
|
|
245
|
|
-
|
|
246
|
|
- =item L<version> Copyright 2004-2010 John Peacock
|
|
247
|
|
-
|
|
248
|
|
- =item L<JSON::PP> Copyright 2007−2011 by Makamaka Hannyaharamitu
|
|
249
|
|
-
|
|
250
|
|
- =item L<CPAN::Meta>, L<CPAN::Meta::Requirements> Copyright (c) 2010 by David Golden and Ricardo Signes
|
|
251
|
|
-
|
|
252
|
|
- =item L<CPAN::Meta::YAML> Copyright 2010 Adam Kennedy
|
|
253
|
|
-
|
|
254
|
|
- =item L<File::pushd> Copyright 2012 David Golden
|
|
255
|
|
-
|
|
256
|
|
- =back
|
|
257
|
|
-
|
|
258
|
|
- =head1 LICENSE
|
|
259
|
|
-
|
|
260
|
|
- Same as Perl.
|
|
261
|
|
-
|
|
262
|
|
- =head1 CREDITS
|
|
263
|
|
-
|
|
264
|
|
- =head2 CONTRIBUTORS
|
|
265
|
|
-
|
|
266
|
|
- Patches and code improvements were contributed by:
|
|
267
|
|
-
|
|
268
|
|
- Goro Fuji, Kazuhiro Osawa, Tokuhiro Matsuno, Kenichi Ishigaki, Ian
|
|
269
|
|
- Wells, Pedro Melo, Masayoshi Sekimura, Matt S Trout (mst), squeeky,
|
|
270
|
|
- horus and Ingy dot Net.
|
|
271
|
|
-
|
|
272
|
|
- =head2 ACKNOWLEDGEMENTS
|
|
273
|
|
-
|
|
274
|
|
- Bug reports, suggestions and feedbacks were sent by, or general
|
|
275
|
|
- acknowledgement goes to:
|
|
276
|
|
-
|
|
277
|
|
- Jesse Vincent, David Golden, Andreas Koenig, Jos Boumans, Chris
|
|
278
|
|
- Williams, Adam Kennedy, Audrey Tang, J. Shirley, Chris Prather, Jesse
|
|
279
|
|
- Luehrs, Marcus Ramberg, Shawn M Moore, chocolateboy, Chirs Nehren,
|
|
280
|
|
- Jonathan Rockway, Leon Brocard, Simon Elliott, Ricardo Signes, AEvar
|
|
281
|
|
- Arnfjord Bjarmason, Eric Wilhelm, Florian Ragwitz and xaicron.
|
|
282
|
|
-
|
|
283
|
|
- =head1 COMMUNITY
|
|
284
|
|
-
|
|
285
|
|
- =over 4
|
|
286
|
|
-
|
|
287
|
|
- =item L<http://github.com/miyagawa/cpanminus> - source code repository, issue tracker
|
|
288
|
|
-
|
|
289
|
|
- =item L<irc://irc.perl.org/#toolchain> - discussions about Perl toolchain. I'm there.
|
|
290
|
|
-
|
|
291
|
|
- =back
|
|
292
|
|
-
|
|
293
|
|
- =head1 NO WARRANTY
|
|
294
|
|
-
|
|
295
|
|
- This software is provided "as-is," without any express or implied
|
|
296
|
|
- warranty. In no event shall the author be held liable for any damages
|
|
297
|
|
- arising from the use of the software.
|
|
298
|
|
-
|
|
299
|
|
- =head1 SEE ALSO
|
|
300
|
|
-
|
|
301
|
|
- L<CPAN> L<CPANPLUS> L<pip>
|
|
302
|
|
-
|
|
303
|
|
- =cut
|
|
304
|
|
-
|
|
305
|
|
- 1;
|
|
|
23
|
+$fatpacked{"App/cpanminus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS';
|
|
|
24
|
+ package App::cpanminus;our$VERSION="1.7040";1;
|
|
306
|
25
|
APP_CPANMINUS
|
|
307
|
26
|
|
|
308
|
|
-$fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
|
|
309
|
|
- package App::cpanminus::script;
|
|
310
|
|
- use strict;
|
|
311
|
|
- use Config;
|
|
312
|
|
- use Cwd ();
|
|
313
|
|
- use App::cpanminus;
|
|
314
|
|
- use File::Basename ();
|
|
315
|
|
- use File::Find ();
|
|
316
|
|
- use File::Path ();
|
|
317
|
|
- use File::Spec ();
|
|
318
|
|
- use File::Copy ();
|
|
319
|
|
- use File::Temp ();
|
|
320
|
|
- use Getopt::Long ();
|
|
321
|
|
- use Parse::CPAN::Meta;
|
|
322
|
|
- use Symbol ();
|
|
323
|
|
-
|
|
324
|
|
- use constant WIN32 => $^O eq 'MSWin32';
|
|
325
|
|
- use constant SUNOS => $^O eq 'solaris';
|
|
326
|
|
-
|
|
327
|
|
- our $VERSION = $App::cpanminus::VERSION;
|
|
328
|
|
-
|
|
329
|
|
- if ($INC{"App/FatPacker/Trace.pm"}) {
|
|
330
|
|
- require JSON::PP;
|
|
331
|
|
- require CPAN::Meta::YAML;
|
|
332
|
|
- require CPAN::Meta::Prereqs;
|
|
333
|
|
- require version::vpp;
|
|
334
|
|
- require File::pushd;
|
|
335
|
|
- }
|
|
336
|
|
-
|
|
337
|
|
- my $quote = WIN32 ? q/"/ : q/'/;
|
|
338
|
|
-
|
|
339
|
|
- sub agent {
|
|
340
|
|
- my $self = shift;
|
|
341
|
|
- "cpanminus/$VERSION perl/$]";
|
|
342
|
|
- }
|
|
343
|
|
-
|
|
344
|
|
- sub determine_home {
|
|
345
|
|
- my $class = shift;
|
|
346
|
|
-
|
|
347
|
|
- my $homedir = $ENV{HOME}
|
|
348
|
|
- || eval { require File::HomeDir; File::HomeDir->my_home }
|
|
349
|
|
- || join('', @ENV{qw(HOMEDRIVE HOMEPATH)}); # Win32
|
|
350
|
|
-
|
|
351
|
|
- if (WIN32) {
|
|
352
|
|
- require Win32; # no fatpack
|
|
353
|
|
- $homedir = Win32::GetShortPathName($homedir);
|
|
354
|
|
- }
|
|
355
|
|
-
|
|
356
|
|
- return "$homedir/.cpanm";
|
|
357
|
|
- }
|
|
358
|
|
-
|
|
359
|
|
- sub new {
|
|
360
|
|
- my $class = shift;
|
|
361
|
|
-
|
|
362
|
|
- bless {
|
|
363
|
|
- home => $class->determine_home,
|
|
364
|
|
- cmd => 'install',
|
|
365
|
|
- seen => {},
|
|
366
|
|
- notest => undef,
|
|
367
|
|
- test_only => undef,
|
|
368
|
|
- installdeps => undef,
|
|
369
|
|
- force => undef,
|
|
370
|
|
- sudo => undef,
|
|
371
|
|
- make => undef,
|
|
372
|
|
- verbose => undef,
|
|
373
|
|
- quiet => undef,
|
|
374
|
|
- interactive => undef,
|
|
375
|
|
- log => undef,
|
|
376
|
|
- mirrors => [],
|
|
377
|
|
- mirror_only => undef,
|
|
378
|
|
- mirror_index => undef,
|
|
379
|
|
- perl => $^X,
|
|
380
|
|
- argv => [],
|
|
381
|
|
- local_lib => undef,
|
|
382
|
|
- self_contained => undef,
|
|
383
|
|
- prompt_timeout => 0,
|
|
384
|
|
- prompt => undef,
|
|
385
|
|
- configure_timeout => 60,
|
|
386
|
|
- try_lwp => 1,
|
|
387
|
|
- try_wget => 1,
|
|
388
|
|
- try_curl => 1,
|
|
389
|
|
- uninstall_shadows => ($] < 5.012),
|
|
390
|
|
- skip_installed => 1,
|
|
391
|
|
- skip_satisfied => 0,
|
|
392
|
|
- auto_cleanup => 7, # days
|
|
393
|
|
- pod2man => 1,
|
|
394
|
|
- installed_dists => 0,
|
|
395
|
|
- showdeps => 0,
|
|
396
|
|
- scandeps => 0,
|
|
397
|
|
- scandeps_tree => [],
|
|
398
|
|
- format => 'tree',
|
|
399
|
|
- save_dists => undef,
|
|
400
|
|
- skip_configure => 0,
|
|
401
|
|
- verify => 0,
|
|
402
|
|
- @_,
|
|
403
|
|
- }, $class;
|
|
404
|
|
- }
|
|
405
|
|
-
|
|
406
|
|
- sub env {
|
|
407
|
|
- my($self, $key) = @_;
|
|
408
|
|
- $ENV{"PERL_CPANM_" . $key};
|
|
409
|
|
- }
|
|
410
|
|
-
|
|
411
|
|
- sub parse_options {
|
|
412
|
|
- my $self = shift;
|
|
413
|
|
-
|
|
414
|
|
- local @ARGV = @{$self->{argv}};
|
|
415
|
|
- push @ARGV, split /\s+/, $self->env('OPT');
|
|
416
|
|
- push @ARGV, @_;
|
|
417
|
|
-
|
|
418
|
|
- Getopt::Long::Configure("bundling");
|
|
419
|
|
- Getopt::Long::GetOptions(
|
|
420
|
|
- 'f|force' => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
|
|
421
|
|
- 'n|notest!' => \$self->{notest},
|
|
422
|
|
- 'test-only' => sub { $self->{notest} = 0; $self->{skip_installed} = 0; $self->{test_only} = 1 },
|
|
423
|
|
- 'S|sudo!' => \$self->{sudo},
|
|
424
|
|
- 'v|verbose' => sub { $self->{verbose} = $self->{interactive} = 1 },
|
|
425
|
|
- 'verify!' => \$self->{verify},
|
|
426
|
|
- 'q|quiet!' => \$self->{quiet},
|
|
427
|
|
- 'h|help' => sub { $self->{action} = 'show_help' },
|
|
428
|
|
- 'V|version' => sub { $self->{action} = 'show_version' },
|
|
429
|
|
- 'perl=s' => \$self->{perl},
|
|
430
|
|
- 'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
|
|
431
|
|
- 'L|local-lib-contained=s' => sub {
|
|
432
|
|
- $self->{local_lib} = $self->maybe_abs($_[1]);
|
|
433
|
|
- $self->{self_contained} = 1;
|
|
434
|
|
- $self->{pod2man} = undef;
|
|
435
|
|
- },
|
|
436
|
|
- 'mirror=s@' => $self->{mirrors},
|
|
437
|
|
- 'mirror-only!' => \$self->{mirror_only},
|
|
438
|
|
- 'mirror-index=s' => \$self->{mirror_index},
|
|
439
|
|
- 'cascade-search!' => \$self->{cascade_search},
|
|
440
|
|
- 'prompt!' => \$self->{prompt},
|
|
441
|
|
- 'installdeps' => \$self->{installdeps},
|
|
442
|
|
- 'skip-installed!' => \$self->{skip_installed},
|
|
443
|
|
- 'skip-satisfied!' => \$self->{skip_satisfied},
|
|
444
|
|
- 'reinstall' => sub { $self->{skip_installed} = 0 },
|
|
445
|
|
- 'interactive!' => \$self->{interactive},
|
|
446
|
|
- 'i|install' => sub { $self->{cmd} = 'install' },
|
|
447
|
|
- 'info' => sub { $self->{cmd} = 'info' },
|
|
448
|
|
- 'look' => sub { $self->{cmd} = 'look'; $self->{skip_installed} = 0 },
|
|
449
|
|
- 'self-upgrade' => sub { $self->check_upgrade; $self->{cmd} = 'install'; $self->{skip_installed} = 1; push @ARGV, 'App::cpanminus' },
|
|
450
|
|
- 'uninst-shadows!' => \$self->{uninstall_shadows},
|
|
451
|
|
- 'lwp!' => \$self->{try_lwp},
|
|
452
|
|
- 'wget!' => \$self->{try_wget},
|
|
453
|
|
- 'curl!' => \$self->{try_curl},
|
|
454
|
|
- 'auto-cleanup=s' => \$self->{auto_cleanup},
|
|
455
|
|
- 'man-pages!' => \$self->{pod2man},
|
|
456
|
|
- 'scandeps' => \$self->{scandeps},
|
|
457
|
|
- 'showdeps' => sub { $self->{showdeps} = 1; $self->{skip_installed} = 0 },
|
|
458
|
|
- 'format=s' => \$self->{format},
|
|
459
|
|
- 'save-dists=s' => sub {
|
|
460
|
|
- $self->{save_dists} = $self->maybe_abs($_[1]);
|
|
461
|
|
- },
|
|
462
|
|
- 'skip-configure!' => \$self->{skip_configure},
|
|
463
|
|
- 'dev!' => \$self->{dev_release},
|
|
464
|
|
- 'metacpan!' => \$self->{metacpan},
|
|
465
|
|
- );
|
|
466
|
|
-
|
|
467
|
|
- if (!@ARGV && $0 ne '-' && !-t STDIN){ # e.g. # cpanm < author/requires.cpanm
|
|
468
|
|
- push @ARGV, $self->load_argv_from_fh(\*STDIN);
|
|
469
|
|
- $self->{load_from_stdin} = 1;
|
|
470
|
|
- }
|
|
471
|
|
-
|
|
472
|
|
- $self->{argv} = \@ARGV;
|
|
473
|
|
- }
|
|
474
|
|
-
|
|
475
|
|
- sub check_upgrade {
|
|
476
|
|
- if ($0 !~ /^$Config{installsitebin}/) {
|
|
477
|
|
- if ($0 =~ m!perlbrew/bin!) {
|
|
478
|
|
- warn <<WARN;
|
|
|
27
|
+$fatpacked{"App/cpanminus/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_DEPENDENCY';
|
|
|
28
|
+ package App::cpanminus::Dependency;use strict;use CPAN::Meta::Requirements;sub from_prereqs {my($class,$prereqs,$phases,$types)=@_;my@deps;for my$type (@$types){push@deps,$class->from_versions($prereqs->merged_requirements($phases,[$type])->as_string_hash,$type,)}return@deps}sub from_versions {my($class,$versions,$type)=@_;my@deps;while (my($module,$version)=each %$versions){push@deps,$class->new($module,$version,$type)}@deps}sub merge_with {my($self,$requirements)=@_;$self->{original_version}=$self->version;eval {$requirements->add_string_requirement($self->module,$self->version)};if ($@ =~ /illegal requirements/){warn sprintf("Can't merge requirements for %s: '%s' and '%s'",$self->module,$self->version,$requirements->requirements_for_module($self->module))}$self->{version}=$requirements->requirements_for_module($self->module)}sub new {my($class,$module,$version,$type)=@_;bless {module=>$module,version=>$version,type=>$type || 'requires',},$class}sub module {$_[0]->{module}}sub version {$_[0]->{version}}sub type {$_[0]->{type}}sub requires_version {my$self=shift;if (defined$self->{original_version}){return$self->{original_version}}$self->version}sub is_requirement {$_[0]->{type}eq 'requires'}1;
|
|
|
29
|
+APP_CPANMINUS_DEPENDENCY
|
|
|
30
|
+
|
|
|
31
|
+$fatpacked{"App/cpanminus/script.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_SCRIPT';
|
|
|
32
|
+ package App::cpanminus::script;use strict;use Config;use Cwd ();use App::cpanminus;use App::cpanminus::Dependency;use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use Getopt::Long ();use Symbol ();use String::ShellQuote ();use version ();use constant WIN32=>$^O eq 'MSWin32';use constant BAD_TAR=>($^O eq 'solaris' || $^O eq 'hpux');use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION=$App::cpanminus::VERSION;if ($INC{"App/FatPacker/Trace.pm"}){require version::vpp}my$quote=WIN32 ? q/"/ : q/'/;sub agent {my$self=shift;my$agent="cpanminus/$VERSION";$agent .= " perl/$]" if$self->{report_perl_version};$agent}sub determine_home {my$class=shift;my$homedir=$ENV{HOME}|| eval {require File::HomeDir;File::HomeDir->my_home}|| join('',@ENV{qw(HOMEDRIVE HOMEPATH)});if (WIN32){require Win32;$homedir=Win32::GetShortPathName($homedir)}return "$homedir/.cpanm"}sub new {my$class=shift;bless {home=>$class->determine_home,cmd=>'install',seen=>{},notest=>undef,test_only=>undef,installdeps=>undef,force=>undef,sudo=>undef,make=>undef,verbose=>undef,quiet=>undef,interactive=>undef,log=>undef,mirrors=>[],mirror_only=>undef,mirror_index=>undef,cpanmetadb=>"http://cpanmetadb.plackperl.org/v1.0/",perl=>$^X,argv=>[],local_lib=>undef,self_contained=>undef,exclude_vendor=>undef,prompt_timeout=>0,prompt=>undef,configure_timeout=>60,build_timeout=>3600,test_timeout=>1800,try_lwp=>1,try_wget=>1,try_curl=>1,uninstall_shadows=>($] < 5.012),skip_installed=>1,skip_satisfied=>0,auto_cleanup=>7,pod2man=>1,installed_dists=>0,install_types=>['requires'],with_develop=>0,showdeps=>0,scandeps=>0,scandeps_tree=>[],format=>'tree',save_dists=>undef,skip_configure=>0,verify=>0,report_perl_version=>!$class->maybe_ci,build_args=>{},features=>{},pure_perl=>0,cpanfile_path=>'cpanfile',@_,},$class}sub env {my($self,$key)=@_;$ENV{"PERL_CPANM_" .$key}}sub maybe_ci {my$class=shift;grep$ENV{$_},qw(TRAVIS CI AUTOMATED_TESTING AUTHOR_TESTING)}sub install_type_handlers {my$self=shift;my@handlers;for my$type (qw(recommends suggests)){push@handlers,"with-$type"=>sub {my%uniq;$self->{install_types}=[grep!$uniq{$_}++,@{$self->{install_types}},$type ]};push@handlers,"without-$type"=>sub {$self->{install_types}=[grep $_ ne $type,@{$self->{install_types}}]}}@handlers}sub build_args_handlers {my$self=shift;my@handlers;for my$phase (qw(configure build test install)){push@handlers,"$phase-args=s"=>\($self->{build_args}{$phase})}@handlers}sub parse_options {my$self=shift;local@ARGV=@{$self->{argv}};push@ARGV,grep length,split /\s+/,$self->env('OPT');push@ARGV,@_;Getopt::Long::Configure("bundling");Getopt::Long::GetOptions('f|force'=>sub {$self->{skip_installed}=0;$self->{force}=1},'n|notest!'=>\$self->{notest},'test-only'=>sub {$self->{notest}=0;$self->{skip_installed}=0;$self->{test_only}=1},'S|sudo!'=>\$self->{sudo},'v|verbose'=>\$self->{verbose},'verify!'=>\$self->{verify},'q|quiet!'=>\$self->{quiet},'h|help'=>sub {$self->{action}='show_help'},'V|version'=>sub {$self->{action}='show_version'},'perl=s'=>sub {$self->diag("--perl is deprecated since it's known to be fragile in figuring out dependencies. Run `$_[1] -S cpanm` instead.\n",1);$self->{perl}=$_[1]},'l|local-lib=s'=>sub {$self->{local_lib}=$self->maybe_abs($_[1])},'L|local-lib-contained=s'=>sub {$self->{local_lib}=$self->maybe_abs($_[1]);$self->{self_contained}=1;$self->{pod2man}=undef},'self-contained!'=>\$self->{self_contained},'exclude-vendor!'=>\$self->{exclude_vendor},'mirror=s@'=>$self->{mirrors},'mirror-only!'=>\$self->{mirror_only},'mirror-index=s'=>sub {$self->{mirror_index}=$self->maybe_abs($_[1])},'M|from=s'=>sub {$self->{mirrors}=[$_[1]];$self->{mirror_only}=1},'cpanmetadb=s'=>\$self->{cpanmetadb},'cascade-search!'=>\$self->{cascade_search},'prompt!'=>\$self->{prompt},'installdeps'=>\$self->{installdeps},'skip-installed!'=>\$self->{skip_installed},'skip-satisfied!'=>\$self->{skip_satisfied},'reinstall'=>sub {$self->{skip_installed}=0},'interactive!'=>\$self->{interactive},'i|install'=>sub {$self->{cmd}='install'},'info'=>sub {$self->{cmd}='info'},'look'=>sub {$self->{cmd}='look';$self->{skip_installed}=0},'U|uninstall'=>sub {$self->{cmd}='uninstall'},'self-upgrade'=>sub {$self->{action}='self_upgrade'},'uninst-shadows!'=>\$self->{uninstall_shadows},'lwp!'=>\$self->{try_lwp},'wget!'=>\$self->{try_wget},'curl!'=>\$self->{try_curl},'auto-cleanup=s'=>\$self->{auto_cleanup},'man-pages!'=>\$self->{pod2man},'scandeps'=>\$self->{scandeps},'showdeps'=>sub {$self->{showdeps}=1;$self->{skip_installed}=0},'format=s'=>\$self->{format},'save-dists=s'=>sub {$self->{save_dists}=$self->maybe_abs($_[1])},'skip-configure!'=>\$self->{skip_configure},'dev!'=>\$self->{dev_release},'metacpan!'=>\$self->{metacpan},'report-perl-version!'=>\$self->{report_perl_version},'configure-timeout=i'=>\$self->{configure_timeout},'build-timeout=i'=>\$self->{build_timeout},'test-timeout=i'=>\$self->{test_timeout},'with-develop'=>\$self->{with_develop},'without-develop'=>sub {$self->{with_develop}=0},'with-feature=s'=>sub {$self->{features}{$_[1]}=1},'without-feature=s'=>sub {$self->{features}{$_[1]}=0},'with-all-features'=>sub {$self->{features}{__all}=1},'pp|pureperl!'=>\$self->{pure_perl},"cpanfile=s"=>\$self->{cpanfile_path},$self->install_type_handlers,$self->build_args_handlers,);if (!@ARGV && $0 ne '-' &&!-t STDIN){push@ARGV,$self->load_argv_from_fh(\*STDIN);$self->{load_from_stdin}=1}$self->{argv}=\@ARGV}sub check_upgrade {my$self=shift;my$install_base=$ENV{PERL_LOCAL_LIB_ROOT}? $self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}): $Config{installsitebin};if ($0 eq '-'){return}elsif ($0 !~ /^$install_base/){if ($0 =~ m!perlbrew/bin!){die <<DIE}else {die <<DIE}}}sub check_libs {my$self=shift;return if$self->{_checked}++;$self->bootstrap_local_lib}sub setup_verify {my$self=shift;my$has_modules=eval {require Module::Signature;require Digest::SHA;1};$self->{cpansign}=$self->which('cpansign');unless ($has_modules && $self->{cpansign}){warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";$self->{verify}=0}}sub parse_module_args {my($self,$module)=@_;$module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;if ($module =~ /\~[v\d\._,\!<>= ]+$/){return split /\~/,$module,2}else {return$module,undef}}sub doit {my$self=shift;my$code;eval {$code=($self->_doit==0)};if (my$e=$@){warn$e;$code=1}return$code}sub _doit {my$self=shift;$self->setup_home;$self->init_tools;$self->setup_verify if$self->{verify};if (my$action=$self->{action}){$self->$action()and return 1}return$self->show_help(1)unless @{$self->{argv}}or $self->{load_from_stdin};$self->configure_mirrors;my$cwd=Cwd::cwd;my@fail;for my$module (@{$self->{argv}}){if ($module =~ s/\.pm$//i){my ($volume,$dirs,$file)=File::Spec->splitpath($module);$module=join '::',grep {$_}File::Spec->splitdir($dirs),$file}($module,my$version)=$self->parse_module_args($module);$self->chdir($cwd);if ($self->{cmd}eq 'uninstall'){$self->uninstall_module($module)or push@fail,$module}else {$self->install_module($module,0,$version)or push@fail,$module}}if ($self->{base}&& $self->{auto_cleanup}){$self->cleanup_workdirs}if ($self->{installed_dists}){my$dists=$self->{installed_dists}> 1 ? "distributions" : "distribution";$self->diag("$self->{installed_dists} $dists installed\n",1)}if ($self->{scandeps}){$self->dump_scandeps()}$self->chdir($cwd);return!@fail}sub setup_home {my$self=shift;$self->{home}=$self->env('HOME')if$self->env('HOME');unless (_writable($self->{home})){die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n"}$self->{base}="$self->{home}/work/" .time .".$$";File::Path::mkpath([$self->{base}],0,0777);$self->{log}=File::Spec->catfile($self->{base},"build.log");my$final_log="$self->{home}/build.log";{open my$out,">$self->{log}" or die "$self->{log}: $!"}if (CAN_SYMLINK){my$build_link="$self->{home}/latest-build";unlink$build_link;symlink$self->{base},$build_link;unlink$final_log;symlink$self->{log},$final_log}else {my$log=$self->{log};my$home=$self->{home};$self->{at_exit}=sub {my$self=shift;my$temp_log="$home/build.log." .time .".$$";File::Copy::copy($log,$temp_log)&& unlink($final_log);rename($temp_log,$final_log)}}$self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" ."Work directory is $self->{base}\n")}sub package_index_for {my ($self,$mirror)=@_;return$self->source_for($mirror)."/02packages.details.txt"}sub generate_mirror_index {my ($self,$mirror)=@_;my$file=$self->package_index_for($mirror);my$gz_file=$file .'.gz';my$index_mtime=(stat$gz_file)[9];unless (-e $file && (stat$file)[9]>= $index_mtime){$self->chat("Uncompressing index file...\n");if (eval {require Compress::Zlib}){my$gz=Compress::Zlib::gzopen($gz_file,"rb")or do {$self->diag_fail("$Compress::Zlib::gzerrno opening compressed index");return};open my$fh,'>',$file or do {$self->diag_fail("$! opening uncompressed index for write");return};my$buffer;while (my$status=$gz->gzread($buffer)){if ($status < 0){$self->diag_fail($gz->gzerror ." reading compressed index");return}print$fh $buffer}}else {if (system("gunzip -c $gz_file > $file")){$self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");return}}utime$index_mtime,$index_mtime,$file}return 1}sub search_mirror_index {my ($self,$mirror,$module,$version)=@_;$self->search_mirror_index_file($self->package_index_for($mirror),$module,$version)}sub search_mirror_index_file {my($self,$file,$module,$version)=@_;open my$fh,'<',$file or return;my$found;while (<$fh>){if (m!^\Q$module\E\s+([\w\.]+)\s+(\S*)!m){$found=$self->cpan_module($module,$2,$1);last}}return$found unless$self->{cascade_search};if ($found){if ($self->satisfy_version($module,$found->{module_version},$version)){return$found}else {$self->chat("Found $module $found->{module_version} which doesn't satisfy $version.\n")}}return}sub with_version_range {my($self,$version)=@_;defined($version)&& $version =~ /(?:<|!=|==)/}sub encode_json {my($self,$data)=@_;require JSON::PP;my$json=JSON::PP::encode_json($data);$json =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;$json}sub version_to_query {my($self,$module,$version)=@_;require CPAN::Meta::Requirements;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement($module,$version || '0');my$req=$requirements->requirements_for_module($module);if ($req =~ s/^==\s*//){return {term=>{'module.version'=>$req },}}elsif ($req !~ /\s/){return {range=>{'module.version_numified'=>{'gte'=>$self->numify_ver_metacpan($req)}},}}else {my%ops=qw(< lt <= lte > gt >= gte);my(%range,@exclusion);my@requirements=split /,\s*/,$req;for my$r (@requirements){if ($r =~ s/^([<>]=?)\s*//){$range{$ops{$1}}=$self->numify_ver_metacpan($r)}elsif ($r =~ s/\!=\s*//){push@exclusion,$self->numify_ver_metacpan($r)}}my@filters=({range=>{'module.version_numified'=>\%range }},);if (@exclusion){push@filters,{not=>{or=>[map {+{term=>{'module.version_numified'=>$self->numify_ver_metacpan($_)}}}@exclusion ]},}}return@filters}}sub numify_ver_metacpan {my($self,$ver)=@_;$ver =~ s/_//g;version->new($ver)->numify}sub numify_ver {my($self,$ver)=@_;eval version->new($ver)->numify}sub maturity_filter {my($self,$module,$version)=@_;if ($version =~ /==/){return}elsif ($self->{dev_release}){return +{not=>{term=>{status=>'backpan' }}}}else {return ({not=>{term=>{status=>'backpan' }}},{term=>{maturity=>'released' }},)}}sub by_version {my%s=qw(latest 3 cpan 2 backpan 1);$b->{_score}<=> $a->{_score}|| $s{$b->{fields}{status}}<=> $s{$a->{fields}{status}}}sub by_first_come {$a->{fields}{date}cmp $b->{fields}{date}}sub by_date {$b->{fields}{date}cmp $a->{fields}{date}}sub find_best_match {my($self,$match,$version)=@_;return unless$match && @{$match->{hits}{hits}|| []};my@hits=$self->{dev_release}? sort {by_version || by_date}@{$match->{hits}{hits}}: sort {by_version || by_first_come}@{$match->{hits}{hits}};$hits[0]->{fields}}sub search_metacpan {my($self,$module,$version)=@_;require JSON::PP;$self->chat("Searching $module ($version) on metacpan ...\n");my$metacpan_uri='http://api.metacpan.org/v0';my@filter=$self->maturity_filter($module,$version);my$query={filtered=>{(@filter ? (filter=>{and=>\@filter }): ()),query=>{nested=>{score_mode=>'max',path=>'module',query=>{custom_score=>{metacpan_script=>"score_version_numified",query=>{constant_score=>{filter=>{and=>[{term=>{'module.authorized'=>JSON::PP::true()}},{term=>{'module.indexed'=>JSON::PP::true()}},{term=>{'module.name'=>$module }},$self->version_to_query($module,$version),]}}},}},}},}};my$module_uri="$metacpan_uri/file/_search?source=";$module_uri .= $self->encode_json({query=>$query,fields=>['date','release','author','module','status' ],});my($release,$author,$module_version);my$module_json=$self->get($module_uri);my$module_meta=eval {JSON::PP::decode_json($module_json)};my$match=$self->find_best_match($module_meta);if ($match){$release=$match->{release};$author=$match->{author};my$module_matched=(grep {$_->{name}eq $module}@{$match->{module}})[0];$module_version=$module_matched->{version}}unless ($release){$self->chat("! Could not find a release matching $module ($version) on MetaCPAN.\n");return}my$dist_uri="$metacpan_uri/release/_search?source=";$dist_uri .= $self->encode_json({filter=>{and=>[{term=>{'release.name'=>$release }},{term=>{'release.author'=>$author }},]},fields=>['download_url','stat','status' ],});my$dist_json=$self->get($dist_uri);my$dist_meta=eval {JSON::PP::decode_json($dist_json)};if ($dist_meta){$dist_meta=$dist_meta->{hits}{hits}[0]{fields}}if ($dist_meta && $dist_meta->{download_url}){(my$distfile=$dist_meta->{download_url})=~ s!.+/authors/id/!!;local$self->{mirrors}=$self->{mirrors};if ($dist_meta->{status}eq 'backpan'){$self->{mirrors}=['http://backpan.perl.org' ]}elsif ($dist_meta->{stat}{mtime}> time()-24*60*60){$self->{mirrors}=['http://cpan.metacpan.org' ]}return$self->cpan_module($module,$distfile,$module_version)}$self->diag_fail("Finding $module on metacpan failed.");return}sub search_database {my($self,$module,$version)=@_;my$found;if ($self->{dev_release}or $self->{metacpan}){$found=$self->search_metacpan($module,$version)and return$found;$found=$self->search_cpanmetadb($module,$version)and return$found}else {$found=$self->search_cpanmetadb($module,$version)and return$found;$found=$self->search_metacpan($module,$version)and return$found}}sub search_cpanmetadb {my($self,$module,$version)=@_;$self->chat("Searching $module ($version) on cpanmetadb ...\n");if ($self->with_version_range($version)){return$self->search_cpanmetadb_history($module,$version)}else {return$self->search_cpanmetadb_package($module,$version)}}sub search_cpanmetadb_package {my($self,$module,$version)=@_;require CPAN::Meta::YAML;(my$uri=$self->{cpanmetadb})=~ s{/?$}{/package/$module};my$yaml=$self->get($uri);my$meta=eval {CPAN::Meta::YAML::Load($yaml)};if ($meta && $meta->{distfile}){return$self->cpan_module($module,$meta->{distfile},$meta->{version})}$self->diag_fail("Finding $module on cpanmetadb failed.");return}sub search_cpanmetadb_history {my($self,$module,$version)=@_;(my$uri=$self->{cpanmetadb})=~ s{/?$}{/history/$module};my$content=$self->get($uri)or return;my@found;for my$line (split /\r?\n/,$content){if ($line =~ /^$module\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_obj=>version::->parse($1),distfile=>$2,}}}return unless@found;$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_obj}cmp $a->{version_obj}}@found){if ($self->satisfy_version($module,$try->{version_obj},$version)){local$self->{mirrors}=$self->{mirrors};unshift @{$self->{mirrors}},'http://backpan.perl.org' unless$try->{latest};return$self->cpan_module($module,$try->{distfile},$try->{version})}}$self->diag_fail("Finding $module ($version) on cpanmetadb failed.");return}sub search_module {my($self,$module,$version)=@_;if ($self->{mirror_index}){$self->mask_output(chat=>"Searching $module on mirror index $self->{mirror_index} ...\n");my$pkg=$self->search_mirror_index_file($self->{mirror_index},$module,$version);return$pkg if$pkg;unless ($self->{cascade_search}){$self->mask_output(diag_fail=>"Finding $module ($version) on mirror index $self->{mirror_index} failed.");return}}unless ($self->{mirror_only}){my$found=$self->search_database($module,$version);return$found if$found}MIRROR: for my$mirror (@{$self->{mirrors}}){$self->mask_output(chat=>"Searching $module on mirror $mirror ...\n");my$name='02packages.details.txt.gz';my$uri="$mirror/modules/$name";my$gz_file=$self->package_index_for($mirror).'.gz';unless ($self->{pkgs}{$uri}){$self->mask_output(chat=>"Downloading index file $uri ...\n");$self->mirror($uri,$gz_file);$self->generate_mirror_index($mirror)or next MIRROR;$self->{pkgs}{$uri}="!!retrieved!!"}my$pkg=$self->search_mirror_index($mirror,$module,$version);return$pkg if$pkg;$self->mask_output(diag_fail=>"Finding $module ($version) on mirror $mirror failed.")}return}sub source_for {my($self,$mirror)=@_;$mirror =~ s/[^\w\.\-]+/%/g;my$dir="$self->{home}/sources/$mirror";File::Path::mkpath([$dir ],0,0777);return$dir}sub load_argv_from_fh {my($self,$fh)=@_;my@argv;while(defined(my$line=<$fh>)){chomp$line;$line =~ s/#.+$//;$line =~ s/^\s+//;$line =~ s/\s+$//;push@argv,split ' ',$line if$line}return@argv}sub show_version {my$self=shift;print "cpanm (App::cpanminus) version $VERSION ($0)\n";print "perl version $] ($^X)\n\n";print " \%Config:\n";for my$key (qw(archname installsitelib installsitebin installman1dir installman3dir sitearchexp sitelibexp vendorarch vendorlibexp archlibexp privlibexp)){print " $key=$Config{$key}\n" if$Config{$key}}print " \%ENV:\n";for my$key (grep /^PERL/,sort keys%ENV){print " $key=$ENV{$key}\n"}print " \@INC:\n";for my$inc (@INC){print " $inc\n" unless ref($inc)eq 'CODE'}return 1}sub show_help {my$self=shift;if ($_[0]){print <<USAGE;return}print <<HELP;return 1}sub _writable {my$dir=shift;my@dir=File::Spec->splitdir($dir);while (@dir){$dir=File::Spec->catdir(@dir);if (-e $dir){return -w _}pop@dir}return}sub maybe_abs {my($self,$lib)=@_;if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)){return$lib}else {return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(),$lib))}}sub local_lib_target {my($self,$root)=@_;(grep {$_ ne ''}split /\Q$Config{path_sep}/,$root)[0]}sub bootstrap_local_lib {my$self=shift;if ($self->{local_lib}){return$self->setup_local_lib($self->{local_lib})}if ($ENV{PERL_LOCAL_LIB_ROOT}&& $ENV{PERL_MM_OPT}){return$self->setup_local_lib($self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}),1)}return if$self->{sudo}or (_writable($Config{installsitelib})and _writable($Config{installsitebin}));if ($ENV{PERL_MM_OPT}and ($ENV{MODULEBUILDRC}or $ENV{PERL_MB_OPT})){return}$self->setup_local_lib;$self->diag(<<DIAG,1);sleep 2}sub upgrade_toolchain {my($self,$config_deps)=@_;my%deps=map {$_->module=>$_}@$config_deps;my$reqs=CPAN::Meta::Requirements->from_string_hash({'Module::Build'=>'0.38','ExtUtils::MakeMaker'=>'6.58','ExtUtils::Install'=>'1.46',});if ($deps{"ExtUtils::MakeMaker"}){$deps{"ExtUtils::MakeMaker"}->merge_with($reqs)}elsif ($deps{"Module::Build"}){$deps{"Module::Build"}->merge_with($reqs);$deps{"ExtUtils::Install"}||= App::cpanminus::Dependency->new("ExtUtils::Install",0,'configure');$deps{"ExtUtils::Install"}->merge_with($reqs)}@$config_deps=values%deps}sub _core_only_inc {my($self,$base)=@_;require local::lib;(local::lib->resolve_path(local::lib->install_base_arch_path($base)),local::lib->resolve_path(local::lib->install_base_perl_path($base)),(!$self->{exclude_vendor}? grep {$_}@Config{qw(vendorarch vendorlibexp)}: ()),@Config{qw(archlibexp privlibexp)},)}sub _diff {my($self,$old,$new)=@_;my@diff;my%old=map {$_=>1}@$old;for my$n (@$new){push@diff,$n unless exists$old{$n}}@diff}sub _setup_local_lib_env {my($self,$base)=@_;$self->diag(<<WARN,1)if$base =~ /\s/;local$SIG{__WARN__}=sub {};local::lib->setup_env_hash_for($base,0)}sub setup_local_lib {my($self,$base,$no_env)=@_;$base=undef if$base eq '_';require local::lib;{local $0='cpanm';$base ||= "~/perl5";$base=local::lib->resolve_path($base);if ($self->{self_contained}){my@inc=$self->_core_only_inc($base);$self->{search_inc}=[@inc ]}else {$self->{search_inc}=[local::lib->install_base_arch_path($base),local::lib->install_base_perl_path($base),@INC,]}$self->_setup_local_lib_env($base)unless$no_env;$self->{local_lib}=$base}}sub prompt_bool {my($self,$mess,$def)=@_;my$val=$self->prompt($mess,$def);return lc$val eq 'y'}sub prompt {my($self,$mess,$def)=@_;my$isa_tty=-t STDIN && (-t STDOUT ||!(-f STDOUT || -c STDOUT));my$dispdef=defined$def ? "[$def] " : " ";$def=defined$def ? $def : "";if (!$self->{prompt}|| (!$isa_tty && eof STDIN)){return$def}local $|=1;local $\;my$ans;eval {local$SIG{ALRM}=sub {undef$ans;die "alarm\n"};print STDOUT "$mess $dispdef";alarm$self->{prompt_timeout}if$self->{prompt_timeout};$ans=<STDIN>;alarm 0};if (defined$ans){chomp$ans}else {print STDOUT "\n"}return (!defined$ans || $ans eq '')? $def : $ans}sub diag_ok {my($self,$msg)=@_;chomp$msg;$msg ||= "OK";if ($self->{in_progress}){$self->_diag("$msg\n");$self->{in_progress}=0}$self->log("-> $msg\n")}sub diag_fail {my($self,$msg,$always)=@_;chomp$msg;if ($self->{in_progress}){$self->_diag("FAIL\n");$self->{in_progress}=0}if ($msg){$self->_diag("! $msg\n",$always,1);$self->log("-> FAIL $msg\n")}}sub diag_progress {my($self,$msg)=@_;chomp$msg;$self->{in_progress}=1;$self->_diag("$msg ... ");$self->log("$msg\n")}sub _diag {my($self,$msg,$always,$error)=@_;my$fh=$error ? *STDERR : *STDOUT;print {$fh}$msg if$always or $self->{verbose}or!$self->{quiet}}sub diag {my($self,$msg,$always)=@_;$self->_diag($msg,$always);$self->log($msg)}sub chat {my$self=shift;print STDERR @_ if$self->{verbose};$self->log(@_)}sub mask_output {my$self=shift;my$method=shift;$self->$method($self->mask_uri_passwords(@_))}sub log {my$self=shift;open my$out,">>$self->{log}";print$out @_}sub run {my($self,$cmd)=@_;if (WIN32){$cmd=$self->shell_quote(@$cmd)if ref$cmd eq 'ARRAY';unless ($self->{verbose}){$cmd .= " >> " .$self->shell_quote($self->{log})." 2>&1"}!system$cmd}else {my$pid=fork;if ($pid){waitpid$pid,0;return!$?}else {$self->run_exec($cmd)}}}sub run_exec {my($self,$cmd)=@_;if (ref$cmd eq 'ARRAY'){unless ($self->{verbose}){open my$logfh,">>",$self->{log};open STDERR,'>&',$logfh;open STDOUT,'>&',$logfh;close$logfh}exec @$cmd}else {unless ($self->{verbose}){$cmd .= " >> " .$self->shell_quote($self->{log})." 2>&1"}exec$cmd}}sub run_timeout {my($self,$cmd,$timeout)=@_;return$self->run($cmd)if WIN32 || $self->{verbose}||!$timeout;my$pid=fork;if ($pid){eval {local$SIG{ALRM}=sub {die "alarm\n"};alarm$timeout;waitpid$pid,0;alarm 0};if ($@ && $@ eq "alarm\n"){$self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");local$SIG{TERM}='IGNORE';kill TERM=>0;waitpid$pid,0;return}return!$?}elsif ($pid==0){$self->run_exec($cmd)}else {$self->chat("! fork failed: falling back to system()\n");$self->run($cmd)}}sub append_args {my($self,$cmd,$phase)=@_;if (my$args=$self->{build_args}{$phase}){$cmd=join ' ',$self->shell_quote(@$cmd),$args}$cmd}sub configure {my($self,$cmd,$depth)=@_;local$ENV{PERL5_CPAN_IS_RUNNING}=local$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$;local$ENV{PERL5_CPANM_IS_RUNNING}=$$;my$use_default=!$self->{interactive};local$ENV{PERL_MM_USE_DEFAULT}=$use_default;local$ENV{PERL_MM_OPT}=$ENV{PERL_MM_OPT};local$ENV{PERL_MB_OPT}=$ENV{PERL_MB_OPT};unless ($self->{pod2man}){$ENV{PERL_MM_OPT}.= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";$ENV{PERL_MB_OPT}.= " --config installman1dir= --config installsiteman1dir= --config installman3dir= --config installsiteman3dir="}if ($self->{pure_perl}){$ENV{PERL_MM_OPT}.= " PUREPERL_ONLY=1";$ENV{PERL_MB_OPT}.= " --pureperl-only"}$cmd=$self->append_args($cmd,'configure')if$depth==0;local$self->{verbose}=$self->{verbose}|| $self->{interactive};$self->run_timeout($cmd,$self->{configure_timeout})}sub build {my($self,$cmd,$distname,$depth)=@_;local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};$cmd=$self->append_args($cmd,'build')if$depth==0;return 1 if$self->run_timeout($cmd,$self->{build_timeout});while (1){my$ans=lc$self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?","s");return if$ans eq 's';return$self->build($cmd,$distname,$depth)if$ans eq 'r';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}sub test {my($self,$cmd,$distname,$depth)=@_;return 1 if$self->{notest};local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{NONINTERACTIVE_TESTING}=!$self->{interactive};$cmd=$self->append_args($cmd,'test')if$depth==0;return 1 if$self->run_timeout($cmd,$self->{test_timeout});if ($self->{force}){$self->diag_fail("Testing $distname failed but installing it anyway.");return 1}else {$self->diag_fail;while (1){my$ans=lc$self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?","s");return if$ans eq 's';return$self->test($cmd,$distname,$depth)if$ans eq 'r';return 1 if$ans eq 'f';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}}sub install {my($self,$cmd,$uninst_opts,$depth)=@_;if ($depth==0 && $self->{test_only}){return 1}if ($self->{sudo}){unshift @$cmd,"sudo"}if ($self->{uninstall_shadows}&&!$ENV{PERL_MM_OPT}){push @$cmd,@$uninst_opts}$cmd=$self->append_args($cmd,'install')if$depth==0;$self->run($cmd)}sub look {my$self=shift;my$shell=$ENV{SHELL};$shell ||= $ENV{COMSPEC}if WIN32;if ($shell){my$cwd=Cwd::cwd;$self->diag("Entering $cwd with $shell\n");system$shell}else {$self->diag_fail("You don't seem to have a SHELL :/")}}sub show_build_log {my$self=shift;my@pagers=($ENV{PAGER},(WIN32 ? (): ('less')),'more');my$pager;while (@pagers){$pager=shift@pagers;next unless$pager;$pager=$self->which($pager);next unless$pager;last}if ($pager){system("$pager < $self->{log}")}else {$self->diag_fail("You don't seem to have a PAGER :/")}}sub chdir {my$self=shift;Cwd::chdir(File::Spec->canonpath($_[0]))or die "$_[0]: $!"}sub configure_mirrors {my$self=shift;unless (@{$self->{mirrors}}){$self->{mirrors}=['http://www.cpan.org' ]}for (@{$self->{mirrors}}){s!^/!file:///!;s!/$!!}}sub self_upgrade {my$self=shift;$self->check_upgrade;$self->{argv}=['App::cpanminus' ];return}sub install_module {my($self,$module,$depth,$version)=@_;$self->check_libs;if ($self->{seen}{$module}++){$self->chat("Already tried $module. Skipping.\n");return 1}if ($self->{skip_satisfied}){my($ok,$local)=$self->check_module($module,$version || 0);if ($ok){$self->diag("You have $module ($local)\n",1);return 1}}my$dist=$self->resolve_name($module,$version);unless ($dist){my$what=$module .($version ? " ($version)" : "");$self->diag_fail("Couldn't find module or a distribution $what",1);return}if ($dist->{distvname}&& $self->{seen}{$dist->{distvname}}++){$self->chat("Already tried $dist->{distvname}. Skipping.\n");return 1}if ($self->{cmd}eq 'info'){print$self->format_dist($dist),"\n";return 1}$dist->{depth}=$depth;if ($dist->{module}){unless ($self->satisfy_version($dist->{module},$dist->{module_version},$version)){$self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n",1);return}my$cmp=$version ? "==" : "";my$requirement=$dist->{module_version}? "$cmp$dist->{module_version}" : 0;my($ok,$local)=$self->check_module($dist->{module},$requirement);if ($self->{skip_installed}&& $ok){$self->diag("$dist->{module} is up to date. ($local)\n",1);return 1}}if ($dist->{dist}eq 'perl'){$self->diag("skipping $dist->{pathname}\n");return 1}$self->diag("--> Working on $module\n");$dist->{dir}||= $self->fetch_module($dist);unless ($dist->{dir}){$self->diag_fail("Failed to fetch distribution $dist->{distvname}",1);return}$self->chat("Entering $dist->{dir}\n");$self->chdir($self->{base});$self->chdir($dist->{dir});if ($self->{cmd}eq 'look'){$self->look;return 1}return$self->build_stuff($module,$dist,$depth)}sub uninstall_search_path {my$self=shift;$self->{local_lib}? (local::lib->install_base_arch_path($self->{local_lib}),local::lib->install_base_perl_path($self->{local_lib})): @Config{qw(installsitearch installsitelib)}}sub uninstall_module {my ($self,$module)=@_;$self->check_libs;my@inc=$self->uninstall_search_path;my($metadata,$packlist)=$self->packlists_containing($module,\@inc);unless ($packlist){$self->diag_fail(<<DIAG,1);return}my@uninst_files=$self->uninstall_target($metadata,$packlist);$self->ask_permission($module,\@uninst_files)or return;$self->uninstall_files(@uninst_files,$packlist);$self->diag("Successfully uninstalled $module\n",1);return 1}sub packlists_containing {my($self,$module,$inc)=@_;require Module::Metadata;my$metadata=Module::Metadata->new_from_module($module,inc=>$inc)or return;my$packlist;my$wanted=sub {return unless $_ eq '.packlist' && -f $_;for my$file ($self->unpack_packlist($File::Find::name)){$packlist ||= $File::Find::name if$file eq $metadata->filename}};{require File::pushd;my$pushd=File::pushd::pushd();my@search=grep -d $_,map File::Spec->catdir($_,'auto'),@$inc;File::Find::find($wanted,@search)}return$metadata,$packlist}sub uninstall_target {my($self,$metadata,$packlist)=@_;if ($self->has_shadow_install($metadata)or $self->{local_lib}){grep$self->should_unlink($_),$self->unpack_packlist($packlist)}else {$self->unpack_packlist($packlist)}}sub has_shadow_install {my($self,$metadata)=@_;my@shadow=grep defined,map Module::Metadata->new_from_module($metadata->name,inc=>[$_]),@INC;@shadow >= 2}sub should_unlink {my($self,$file)=@_;if ($self->{local_lib}){$file =~ /^\Q$self->{local_lib}\E/}else {!(grep$file =~ /^\Q$_\E/,@Config{qw(installbin installscript installman1dir installman3dir)})}}sub ask_permission {my ($self,$module,$files)=@_;$self->diag("$module contains the following files:\n\n");for my$file (@$files){$self->diag(" $file\n")}$self->diag("\n");return 'force uninstall' if$self->{force};local$self->{prompt}=1;return$self->prompt_bool("Are you sure you want to uninstall $module?",'y')}sub unpack_packlist {my ($self,$packlist)=@_;open my$fh,'<',$packlist or die "$packlist: $!";map {chomp;$_}<$fh>}sub uninstall_files {my ($self,@files)=@_;$self->diag("\n");for my$file (@files){$self->diag("Unlink: $file\n");unlink$file or $self->diag_fail("$!: $file")}$self->diag("\n");return 1}sub format_dist {my($self,$dist)=@_;return "$dist->{cpanid}/$dist->{filename}"}sub trim {local $_=shift;tr/\n/ /d;s/^\s*|\s*$//g;$_}sub fetch_module {my($self,$dist)=@_;$self->chdir($self->{base});for my$uri (@{$dist->{uris}}){$self->mask_output(diag_progress=>"Fetching $uri");my$filename=$dist->{filename}|| $uri;my$name=File::Basename::basename($filename);my$cancelled;my$fetch=sub {my$file;eval {local$SIG{INT}=sub {$cancelled=1;die "SIGINT\n"};$self->mirror($uri,$name);$file=$name if -e $name};$self->diag("ERROR: " .trim("$@")."\n",1)if $@ && $@ ne "SIGINT\n";return$file};my($try,$file);while ($try++ < 3){$file=$fetch->();last if$cancelled or $file;$self->mask_output(diag_fail=>"Download $uri failed. Retrying ... ")}if ($cancelled){$self->diag_fail("Download cancelled.");return}unless ($file){$self->mask_output(diag_fail=>"Failed to download $uri");next}$self->diag_ok;$dist->{local_path}=File::Spec->rel2abs($name);my$dir=$self->unpack($file,$uri,$dist);next unless$dir;if (my$save=$self->{save_dists}){my$path=$dist->{pathname}? "$save/authors/id/$dist->{pathname}" : "$save/vendor/$file";$self->chat("Copying $name to $path\n");File::Path::mkpath([File::Basename::dirname($path)],0,0777);File::Copy::copy($file,$path)or warn $!}return$dist,$dir}}sub unpack {my($self,$file,$uri,$dist)=@_;if ($self->{verify}){$self->verify_archive($file,$uri,$dist)or return}$self->chat("Unpacking $file\n");my$dir=$file =~ /\.zip/i ? $self->unzip($file): $self->untar($file);unless ($dir){$self->diag_fail("Failed to unpack $file: no directory")}return$dir}sub verify_checksums_signature {my($self,$chk_file)=@_;require Module::Signature;$self->chat("Verifying the signature of CHECKSUMS\n");my$rv=eval {local$SIG{__WARN__}=sub {};my$v=Module::Signature::_verify($chk_file);$v==Module::Signature::SIGNATURE_OK()};if ($rv){$self->chat("Verified OK!\n")}else {$self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");return}return 1}sub verify_archive {my($self,$file,$uri,$dist)=@_;unless ($dist->{cpanid}){$self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");return 1}(my$mirror=$uri)=~ s!/authors/id.*$!!;(my$chksum_uri=$uri)=~ s!/[^/]*$!/CHECKSUMS!;my$chk_file=$self->source_for($mirror)."/$dist->{cpanid}.CHECKSUMS";$self->mask_output(diag_progress=>"Fetching $chksum_uri");$self->mirror($chksum_uri,$chk_file);unless (-e $chk_file){$self->diag_fail("Fetching $chksum_uri failed.\n");return}$self->diag_ok;$self->verify_checksums_signature($chk_file)or return;$self->verify_checksum($file,$chk_file)}sub verify_checksum {my($self,$file,$chk_file)=@_;$self->chat("Verifying the SHA1 for $file\n");open my$fh,"<$chk_file" or die "$chk_file: $!";my$data=join '',<$fh>;$data =~ s/\015?\012/\n/g;require Safe;my$chksum=Safe->new->reval($data);if (!ref$chksum or ref$chksum ne 'HASH'){$self->diag_fail("! Checksum file downloaded from $chk_file is broken.\n");return}if (my$sha=$chksum->{$file}{sha256}){my$hex=$self->sha1_for($file);if ($hex eq $sha){$self->chat("Checksum for $file: Verified!\n")}else {$self->diag_fail("Checksum mismatch for $file\n");return}}else {$self->chat("Checksum for $file not found in CHECKSUMS.\n");return}}sub sha1_for {my($self,$file)=@_;require Digest::SHA;open my$fh,"<",$file or die "$file: $!";my$dg=Digest::SHA->new(256);my($data);while (read($fh,$data,4096)){$dg->add($data)}return$dg->hexdigest}sub verify_signature {my($self,$dist)=@_;$self->diag_progress("Verifying the SIGNATURE file");my$out=`$self->{cpansign} -v --skip 2>&1`;$self->log($out);if ($out =~ /Signature verified OK/){$self->diag_ok("Verified OK");return 1}else {$self->diag_fail("SIGNATURE verificaion for $dist->{filename} failed\n");return}}sub resolve_name {my($self,$module,$version)=@_;if ($module =~ /(?:^git:|\.git(?:@.+)?$)/){return$self->git_uri($module)}if ($module =~ /^(ftp|https?|file):/){if ($module =~ m!authors/id/(.*)!){return$self->cpan_dist($1,$module)}else {return {uris=>[$module ]}}}if ($module =~ m!^[\./]! && -d $module){return {source=>'local',dir=>Cwd::abs_path($module),}}if (-f $module){return {source=>'local',uris=>["file://" .Cwd::abs_path($module)],}}if ($module =~ s!^cpan:///distfile/!!){return$self->cpan_dist($module)}if ($module =~ m!^(?:[A-Z]/[A-Z]{2}/)?([A-Z]{2}[\-A-Z0-9]*/.*)$!){return$self->cpan_dist($1)}return$self->search_module($module,$version)}sub cpan_module {my($self,$module,$dist,$version)=@_;my$dist=$self->cpan_dist($dist);$dist->{module}=$module;$dist->{module_version}=$version if$version && $version ne 'undef';return$dist}sub cpan_dist {my($self,$dist,$url)=@_;$dist =~ s!^([A-Z]{2})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;require CPAN::DistnameInfo;my$d=CPAN::DistnameInfo->new($dist);if ($url){$url=[$url ]unless ref$url eq 'ARRAY'}else {my$id=$d->cpanid;my$fn=substr($id,0,1)."/" .substr($id,0,2)."/" .$id ."/" .$d->filename;my@mirrors=@{$self->{mirrors}};my@urls=map "$_/authors/id/$fn",@mirrors;$url=\@urls,}return {$d->properties,source=>'cpan',uris=>$url,}}sub git_uri {my ($self,$uri)=@_;($uri,my$commitish)=split /(?<=\.git)@/i,$uri,2;my$dir=File::Temp::tempdir(CLEANUP=>1);$self->mask_output(diag_progress=>"Cloning $uri");$self->run(['git','clone',$uri,$dir ]);unless (-e "$dir/.git"){$self->diag_fail("Failed cloning git repository $uri",1);return}if ($commitish){require File::pushd;my$dir=File::pushd::pushd($dir);unless ($self->run(['git','checkout',$commitish ])){$self->diag_fail("Failed to checkout '$commitish' in git repository $uri\n");return}}$self->diag_ok;return {source=>'local',dir=>$dir,}}sub setup_module_build_patch {my$self=shift;open my$out,">$self->{base}/ModuleBuildSkipMan.pm" or die $!;print$out <<EOF}sub core_version_for {my($self,$module)=@_;require Module::CoreList;unless (exists$Module::CoreList::version{$]+0}){die sprintf("Module::CoreList %s (loaded from %s) doesn't seem to have entries for perl $]. " ."You're strongly recommended to upgrade Module::CoreList from CPAN.\n",$Module::CoreList::VERSION,$INC{"Module/CoreList.pm"})}unless (exists$Module::CoreList::version{$]+0}{$module}){return -1}return$Module::CoreList::version{$]+0}{$module}}sub search_inc {my$self=shift;$self->{search_inc}||= do {if (defined$::Bin){[grep!/^\Q$::Bin\E\/..\/(?:fat)?lib$/,@INC]}else {[@INC]}}}sub check_module {my($self,$mod,$want_ver)=@_;require Module::Metadata;my$meta=Module::Metadata->new_from_module($mod,inc=>$self->search_inc)or return 0,undef;my$version=$meta->version;if ($self->{self_contained}&& $self->loaded_from_perl_lib($meta)){$version=$self->core_version_for($mod);return 0,undef if$version && $version==-1}$self->{local_versions}{$mod}=$version;if ($self->is_deprecated($meta)){return 0,$version}elsif ($self->satisfy_version($mod,$version,$want_ver)){return 1,($version || 'undef')}else {return 0,$version}}sub satisfy_version {my($self,$mod,$version,$want_ver)=@_;$want_ver='0' unless defined($want_ver)&& length($want_ver);require CPAN::Meta::Requirements;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement($mod,$want_ver);$requirements->accepts_module($mod,$version)}sub unsatisfy_how {my($self,$ver,$want_ver)=@_;if ($want_ver =~ /^[v0-9\.\_]+$/){return "$ver < $want_ver"}else {return "$ver doesn't satisfy $want_ver"}}sub is_deprecated {my($self,$meta)=@_;my$deprecated=eval {require Module::CoreList;Module::CoreList::is_deprecated($meta->{module})};return$deprecated && $self->loaded_from_perl_lib($meta)}sub loaded_from_perl_lib {my($self,$meta)=@_;require Config;my@dirs=qw(archlibexp privlibexp);if ($self->{self_contained}&&!$self->{exclude_vendor}&& $Config{vendorarch}){unshift@dirs,qw(vendorarch vendorlibexp)}for my$dir (@dirs){my$confdir=$Config{$dir};if ($confdir eq substr($meta->filename,0,length($confdir))){return 1}}return}sub should_install {my($self,$mod,$ver)=@_;$self->chat("Checking if you have $mod $ver ... ");my($ok,$local)=$self->check_module($mod,$ver);if ($ok){$self->chat("Yes ($local)\n")}elsif ($local){$self->chat("No (" .$self->unsatisfy_how($local,$ver).")\n")}else {$self->chat("No\n")}return$mod unless$ok;return}sub check_perl_version {my($self,$version)=@_;require CPAN::Meta::Requirements;my$req=CPAN::Meta::Requirements->from_string_hash({perl=>$version });$req->accepts_module(perl=>$])}sub install_deps {my($self,$dir,$depth,@deps)=@_;my(@install,%seen,@fail);for my$dep (@deps){next if$seen{$dep->module};if ($dep->module eq 'perl'){if ($dep->is_requirement &&!$self->check_perl_version($dep->version)){$self->diag("Needs perl @{[$dep->version]}, you have $]\n");push@fail,'perl'}}elsif ($self->should_install($dep->module,$dep->version)){push@install,$dep;$seen{$dep->module}=1}}if (@install){$self->diag("==> Found dependencies: " .join(", ",map $_->module,@install)."\n")}for my$dep (@install){$self->install_module($dep->module,$depth + 1,$dep->version)}$self->chdir($self->{base});$self->chdir($dir)if$dir;if ($self->{scandeps}){return 1}my@not_ok=$self->unsatisfied_deps(@deps);if (@not_ok){return 0,\@not_ok}else {return 1}}sub unsatisfied_deps {my($self,@deps)=@_;require CPAN::Meta::Check;require CPAN::Meta::Requirements;my$reqs=CPAN::Meta::Requirements->new;for my$dep (grep $_->is_requirement,@deps){$reqs->add_string_requirement($dep->module=>$dep->requires_version || '0')}my$ret=CPAN::Meta::Check::check_requirements($reqs,'requires',$self->{search_inc});grep defined,values %$ret}sub install_deps_bailout {my($self,$target,$dir,$depth,@deps)=@_;my($ok,$fail)=$self->install_deps($dir,$depth,@deps);if (!$ok){$self->diag_fail("Installing the dependencies failed: " .join(", ",@$fail),1);unless ($self->prompt_bool("Do you want to continue building $target anyway?","n")){$self->diag_fail("Bailing out the installation for $target.",1);return}}return 1}sub build_stuff {my($self,$stuff,$dist,$depth)=@_;if ($self->{verify}&& -e 'SIGNATURE'){$self->verify_signature($dist)or return}require CPAN::Meta;my($meta_file)=grep -f,qw(META.json META.yml);if ($meta_file){$self->chat("Checking configure dependencies from $meta_file\n");$dist->{cpanmeta}=eval {CPAN::Meta->load_file($meta_file)}}elsif ($dist->{dist}&& $dist->{version}){$self->chat("META.yml/json not found. Creating skeleton for it.\n");$dist->{cpanmeta}=CPAN::Meta->new({name=>$dist->{dist},version=>$dist->{version}})}$dist->{meta}=$dist->{cpanmeta}? $dist->{cpanmeta}->as_struct : {};my@config_deps;if ($dist->{cpanmeta}){push@config_deps,App::cpanminus::Dependency->from_prereqs($dist->{cpanmeta}->effective_prereqs,['configure'],$self->{install_types},)}if (-e 'Build.PL' &&!$self->should_use_mm($dist->{dist})&&!@config_deps){push@config_deps,App::cpanminus::Dependency->from_versions({'Module::Build'=>'0.38' },'configure',)}$self->upgrade_toolchain(\@config_deps);my$target=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};{$self->install_deps_bailout($target,$dist->{dir},$depth,@config_deps)or return}$self->diag_progress("Configuring $target");my$configure_state=$self->configure_this($dist,$depth);$self->diag_ok($configure_state->{configured_ok}? "OK" : "N/A");if ($dist->{cpanmeta}&& $dist->{source}eq 'cpan'){$dist->{provides}=$dist->{cpanmeta}{provides}|| $self->extract_packages($dist->{cpanmeta},".")}my$root_target=(($self->{installdeps}or $self->{showdeps})and $depth==0);$dist->{want_phases}=$self->{notest}&&!$root_target ? [qw(build runtime)]: [qw(build test runtime)];push @{$dist->{want_phases}},'develop' if$self->{with_develop}&& $depth==0;my@deps=$self->find_prereqs($dist);my$module_name=$self->find_module_name($configure_state)|| $dist->{meta}{name};$module_name =~ s/-/::/g;if ($self->{showdeps}){for my$dep (@config_deps,@deps){print$dep->module,($dep->version ? ("~".$dep->version): ""),"\n"}return 1}my$distname=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;my$walkup;if ($self->{scandeps}){$walkup=$self->scandeps_append_child($dist)}$self->install_deps_bailout($distname,$dist->{dir},$depth,@deps)or return;if ($self->{scandeps}){unless ($configure_state->{configured_ok}){my$diag=<<DIAG;if (@config_deps){my@tree=@{$self->{scandeps_tree}};$diag .= "!\n" .join("",map "! * $_->[0]{module}\n",@tree[0..$#tree-1])if@tree}$self->diag("!\n$diag!\n",1)}$walkup->();return 1}if ($self->{installdeps}&& $depth==0){if ($configure_state->{configured_ok}){$self->diag("<== Installed dependencies for $stuff. Finishing.\n");return 1}else {$self->diag("! Configuring $distname failed. See $self->{log} for details.\n",1);return}}my$installed;if ($configure_state->{use_module_build}&& -e 'Build' && -f _){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{perl},"./Build" ],$distname,$depth)&& $self->test([$self->{perl},"./Build","test" ],$distname,$depth)&& $self->install([$self->{perl},"./Build","install" ],["--uninst",1 ],$depth)&& $installed++}elsif ($self->{make}&& -e 'Makefile'){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{make}],$distname,$depth)&& $self->test([$self->{make},"test" ],$distname,$depth)&& $self->install([$self->{make},"install" ],["UNINST=1" ],$depth)&& $installed++}else {my$why;my$configure_failed=$configure_state->{configured}&&!$configure_state->{configured_ok};if ($configure_failed){$why="Configure failed for $distname."}elsif ($self->{make}){$why="The distribution doesn't have a proper Makefile.PL/Build.PL"}else {$why="Can't configure the distribution. You probably need to have 'make'."}$self->diag_fail("$why See $self->{log} for details.",1);return}if ($installed && $self->{test_only}){$self->diag_ok;$self->diag("Successfully tested $distname\n",1)}elsif ($installed){my$local=$self->{local_versions}{$dist->{module}|| ''};my$version=$dist->{module_version}|| $dist->{meta}{version}|| $dist->{version};my$reinstall=$local && ($local eq $version);my$action=$local &&!$reinstall ? $self->numify_ver($version)< $self->numify_ver($local)? "downgraded" : "upgraded" : undef;my$how=$reinstall ? "reinstalled $distname" : $local ? "installed $distname ($action from $local)" : "installed $distname" ;my$msg="Successfully $how";$self->diag_ok;$self->diag("$msg\n",1);$self->{installed_dists}++;$self->save_meta($stuff,$dist,$module_name,\@config_deps,\@deps);return 1}else {my$what=$self->{test_only}? "Testing" : "Installing";$self->diag_fail("$what $stuff failed. See $self->{log} for details. Retry with --force to force install it.",1);return}}sub perl_requirements {my($self,@requires)=@_;my@perl;for my$requires (grep defined,@requires){if (exists$requires->{perl}){push@perl,App::cpanminus::Dependency->new(perl=>$requires->{perl})}}return@perl}sub should_use_mm {my($self,$dist)=@_;my%should_use_mm=map {$_=>1}qw(version ExtUtils-ParseXS ExtUtils-Install ExtUtils-Manifest);$should_use_mm{$dist}}sub configure_this {my($self,$dist,$depth)=@_;if (-e $self->{cpanfile_path}&& $self->{installdeps}&& $depth==0){require Module::CPANfile;$dist->{cpanfile}=eval {Module::CPANfile->load($self->{cpanfile_path})};$self->diag_fail($@,1)if $@;return {configured=>1,configured_ok=>!!$dist->{cpanfile},use_module_build=>0,}}if ($self->{skip_configure}){my$eumm=-e 'Makefile';my$mb=-e 'Build' && -f _;return {configured=>1,configured_ok=>$eumm || $mb,use_module_build=>$mb,}}my$state={};my$try_eumm=sub {if (-e 'Makefile.PL'){$self->chat("Running Makefile.PL\n");if ($self->configure([$self->{perl},"Makefile.PL" ],$depth)){$state->{configured_ok}=-e 'Makefile'}$state->{configured}++}};my$try_mb=sub {if (-e 'Build.PL'){$self->chat("Running Build.PL\n");if ($self->configure([$self->{perl},"Build.PL" ],$depth)){$state->{configured_ok}=-e 'Build' && -f _}$state->{use_module_build}++;$state->{configured}++}};my@try;if ($dist->{dist}&& $self->should_use_mm($dist->{dist})){@try=($try_eumm,$try_mb)}else {@try=($try_mb,$try_eumm)}for my$try (@try){$try->();last if$state->{configured_ok}}unless ($state->{configured_ok}){while (1){my$ans=lc$self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?","s");last if$ans eq 's';return$self->configure_this($dist,$depth)if$ans eq 'r';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}return$state}sub find_module_name {my($self,$state)=@_;return unless$state->{configured_ok};if ($state->{use_module_build}&& -e "_build/build_params"){my$params=do {open my$in,"_build/build_params";$self->safe_eval(join "",<$in>)};return eval {$params->[2]{module_name}}|| undef}elsif (-e "Makefile"){open my$mf,"Makefile";while (<$mf>){if (/^\#\s+NAME\s+=>\s+(.*)/){return$self->safe_eval($1)}}}return}sub list_files {my$self=shift;if (-e 'MANIFEST'){require ExtUtils::Manifest;my$manifest=eval {ExtUtils::Manifest::manifind()}|| {};return sort {lc$a cmp lc$b}keys %$manifest}else {require File::Find;my@files;my$finder=sub {my$name=$File::Find::name;$name =~ s!\.[/\\]!!;push@files,$name};File::Find::find($finder,".");return sort {lc$a cmp lc$b}@files}}sub extract_packages {my($self,$meta,$dir)=@_;my$try=sub {my$file=shift;return 0 if$file =~ m!^(?:x?t|inc|local|perl5|fatlib|_build)/!;return 1 unless$meta->{no_index};return 0 if grep {$file =~ m!^$_/!}@{$meta->{no_index}{directory}|| []};return 0 if grep {$file eq $_}@{$meta->{no_index}{file}|| []};return 1};require Parse::PMFile;my@files=grep {/\.pm(?:\.PL)?$/ && $try->($_)}$self->list_files;my$provides={};for my$file (@files){my$parser=Parse::PMFile->new($meta,{UNSAFE=>1,ALLOW_DEV_VERSION=>1 });my$packages=$parser->parse($file);while (my($package,$meta)=each %$packages){$provides->{$package}||= {file=>$meta->{infile},($meta->{version}eq 'undef')? (): (version=>$meta->{version}),}}}return$provides}sub save_meta {my($self,$module,$dist,$module_name,$config_deps,$build_deps)=@_;return unless$dist->{distvname}&& $dist->{source}eq 'cpan';my$base=($ENV{PERL_MM_OPT}|| '')=~ /INSTALL_BASE=/ ? ($self->install_base($ENV{PERL_MM_OPT})."/lib/perl5"): $Config{sitelibexp};my$provides=$dist->{provides};File::Path::mkpath("blib/meta",0,0777);my$local={name=>$module_name,target=>$module,version=>exists$provides->{$module_name}? ($provides->{$module_name}{version}|| $dist->{version}): $dist->{version},dist=>$dist->{distvname},pathname=>$dist->{pathname},provides=>$provides,};require JSON::PP;open my$fh,">","blib/meta/install.json" or die $!;print$fh JSON::PP::encode_json($local);if (-e "MYMETA.json"){File::Copy::copy("MYMETA.json","blib/meta/MYMETA.json")}my@cmd=(($self->{sudo}? 'sudo' : ()),$^X,'-MExtUtils::Install=install','-e',qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],);$self->run(\@cmd)}sub _merge_hashref {my($self,@hashrefs)=@_;my%hash;for my$h (@hashrefs){%hash=(%hash,%$h)}return \%hash}sub install_base {my($self,$mm_opt)=@_;$mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;die "Your PERL_MM_OPT doesn't contain INSTALL_BASE"}sub safe_eval {my($self,$code)=@_;eval$code}sub configure_features {my($self,$dist,@features)=@_;map $_->identifier,grep {$self->effective_feature($dist,$_)}@features}sub effective_feature {my($self,$dist,$feature)=@_;if ($dist->{depth}==0){my$value=$self->{features}{$feature->identifier};return$value if defined$value;return 1 if$self->{features}{__all}}if ($self->{interactive}){require CPAN::Meta::Requirements;$self->diag("[@{[ $feature->description ]}]\n",1);my$req=CPAN::Meta::Requirements->new;for my$phase (@{$dist->{want_phases}}){for my$type (@{$self->{install_types}}){$req->add_requirements($feature->prereqs->requirements_for($phase,$type))}}my$reqs=$req->as_string_hash;my@missing;for my$module (keys %$reqs){if ($self->should_install($module,$req->{$module})){push@missing,$module}}if (@missing){my$howmany=@missing;$self->diag("==> Found missing dependencies: " .join(", ",@missing)."\n",1);local$self->{prompt}=1;return$self->prompt_bool("Install the $howmany optional module(s)?","y")}}return}sub find_prereqs {my($self,$dist)=@_;my@deps=$self->extract_meta_prereqs($dist);if ($dist->{module}=~ /^Bundle::/i){push@deps,$self->bundle_deps($dist)}if ($self->{cpanfile_requirements}&&!$dist->{cpanfile}){for my$dep (@deps){$dep->merge_with($self->{cpanfile_requirements})}}return@deps}sub extract_meta_prereqs {my($self,$dist)=@_;if ($dist->{cpanfile}){my@features=$self->configure_features($dist,$dist->{cpanfile}->features);my$prereqs=$dist->{cpanfile}->prereqs_with(@features);$self->{cpanfile_requirements}=$prereqs->merged_requirements($dist->{want_phases},['requires']);return App::cpanminus::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}require CPAN::Meta;my@deps;my($meta_file)=grep -f,qw(MYMETA.json MYMETA.yml);if ($meta_file){$self->chat("Checking dependencies from $meta_file ...\n");my$mymeta=eval {CPAN::Meta->load_file($meta_file,{lazy_validation=>1 })};if ($mymeta){$dist->{meta}{name}=$mymeta->name;$dist->{meta}{version}=$mymeta->version;return$self->extract_prereqs($mymeta,$dist)}}if (-e '_build/prereqs'){$self->chat("Checking dependencies from _build/prereqs ...\n");my$prereqs=do {open my$in,"_build/prereqs";$self->safe_eval(join "",<$in>)};my$meta=CPAN::Meta->new({name=>$dist->{meta}{name},version=>$dist->{meta}{version},%$prereqs },{lazy_validation=>1 },);@deps=$self->extract_prereqs($meta,$dist)}elsif (-e 'Makefile'){$self->chat("Finding PREREQ from Makefile ...\n");open my$mf,"Makefile";while (<$mf>){if (/^\#\s+PREREQ_PM => \{\s*(.*?)\s*\}/){my@all;my@pairs=split ', ',$1;for (@pairs){my ($pkg,$v)=split '=>',$_;push@all,[$pkg,$v ]}my$list=join ", ",map {"'$_->[0]' => $_->[1]"}@all;my$prereq=$self->safe_eval("no strict; +{ $list }");push@deps,App::cpanminus::Dependency->from_versions($prereq)if$prereq;last}}}return@deps}sub bundle_deps {my($self,$dist)=@_;my@files;File::Find::find({wanted=>sub {push@files,File::Spec->rel2abs($_)if /\.pm/i},no_chdir=>1,},'.');my@deps;for my$file (@files){open my$pod,"<",$file or next;my$in_contents;while (<$pod>){if (/^=head\d\s+CONTENTS/){$in_contents=1}elsif (/^=/){$in_contents=0}elsif ($in_contents){/^(\S+)\s*(\S+)?/ and push@deps,App::cpanminus::Dependency->new($1,$self->maybe_version($2))}}}return@deps}sub maybe_version {my($self,$string)=@_;return$string && $string =~ /^\.?\d/ ? $string : undef}sub extract_prereqs {my($self,$meta,$dist)=@_;my@features=$self->configure_features($dist,$meta->features);my$prereqs=$self->soften_makemaker_prereqs($meta->effective_prereqs(\@features)->clone);return App::cpanminus::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}sub soften_makemaker_prereqs {my($self,$prereqs)=@_;return$prereqs unless -e "inc/Module/Install.pm";for my$phase (qw(build test runtime)){my$reqs=$prereqs->requirements_for($phase,'requires');if ($reqs->requirements_for_module('ExtUtils::MakeMaker')){$reqs->clear_requirement('ExtUtils::MakeMaker');$reqs->add_minimum('ExtUtils::MakeMaker'=>0)}}$prereqs}sub cleanup_workdirs {my$self=shift;my$expire=time - 24 * 60 * 60 * $self->{auto_cleanup};my@targets;opendir my$dh,"$self->{home}/work";while (my$e=readdir$dh){next if$e !~ /^(\d+)\.\d+$/;my$time=$1;if ($time < $expire){push@targets,"$self->{home}/work/$e"}}if (@targets){if (@targets >= 64){$self->diag("Expiring " .scalar(@targets)." work directories. This might take a while...\n")}else {$self->chat("Expiring " .scalar(@targets)." work directories.\n")}File::Path::rmtree(\@targets,0,0)}}sub scandeps_append_child {my($self,$dist)=@_;my$new_node=[$dist,[]];my$curr_node=$self->{scandeps_current}|| [undef,$self->{scandeps_tree}];push @{$curr_node->[1]},$new_node;$self->{scandeps_current}=$new_node;return sub {$self->{scandeps_current}=$curr_node}}sub dump_scandeps {my$self=shift;if ($self->{format}eq 'tree'){$self->walk_down(sub {my($dist,$depth)=@_;if ($depth==0){print "$dist->{distvname}\n"}else {print " " x ($depth - 1);print "\\_ $dist->{distvname}\n"}},1)}elsif ($self->{format}=~ /^dists?$/){$self->walk_down(sub {my($dist,$depth)=@_;print$self->format_dist($dist),"\n"},0)}elsif ($self->{format}eq 'json'){require JSON::PP;print JSON::PP::encode_json($self->{scandeps_tree})}elsif ($self->{format}eq 'yaml'){require YAML;print YAML::Dump($self->{scandeps_tree})}else {$self->diag("Unknown format: $self->{format}\n")}}sub walk_down {my($self,$cb,$pre)=@_;$self->_do_walk_down($self->{scandeps_tree},$cb,0,$pre)}sub _do_walk_down {my($self,$children,$cb,$depth,$pre)=@_;for my$node (@$children){$cb->($node->[0],$depth)if$pre;$self->_do_walk_down($node->[1],$cb,$depth + 1,$pre);$cb->($node->[0],$depth)unless$pre}}sub DESTROY {my$self=shift;$self->{at_exit}->($self)if$self->{at_exit}}sub shell_quote {my($self,@stuff)=@_;if (WIN32){join ' ',map {/^${quote}.+${quote}$/ ? $_ : ($quote .$_ .$quote)}@stuff}else {String::ShellQuote::shell_quote_best_effort(@stuff)}}sub which {my($self,$name)=@_;if (File::Spec->file_name_is_absolute($name)){if (-x $name &&!-d _){return$name}}my$exe_ext=$Config{_exe};for my$dir (File::Spec->path){my$fullpath=File::Spec->catfile($dir,$name);if ((-x $fullpath || -x ($fullpath .= $exe_ext))&&!-d _){if ($fullpath =~ /\s/){$fullpath=$self->shell_quote($fullpath)}return$fullpath}}return}sub get {my($self,$uri)=@_;if ($uri =~ /^file:/){$self->file_get($uri)}else {$self->{_backends}{get}->(@_)}}sub mirror {my($self,$uri,$local)=@_;if ($uri =~ /^file:/){$self->file_mirror($uri,$local)}else {$self->{_backends}{mirror}->(@_)}}sub untar {$_[0]->{_backends}{untar}->(@_)};sub unzip {$_[0]->{_backends}{unzip}->(@_)};sub uri_to_file {my($self,$uri)=@_;if ($uri =~ s!file:/+!!){$uri="/$uri" unless$uri =~ m![a-zA-Z]:!}return$uri}sub file_get {my($self,$uri)=@_;my$file=$self->uri_to_file($uri);open my$fh,"<$file" or return;join '',<$fh>}sub file_mirror {my($self,$uri,$path)=@_;my$file=$self->uri_to_file($uri);File::Copy::copy($file,$path)}sub has_working_lwp {my($self,$mirrors)=@_;my$https=grep /^https:/,@$mirrors;eval {require LWP::UserAgent;LWP::UserAgent->VERSION(5.802);require LWP::Protocol::https if$https;1}}sub init_tools {my$self=shift;return if$self->{initialized}++;if ($self->{make}=$self->which($Config{make})){$self->chat("You have make $self->{make}\n")}if ($self->{try_lwp}&& $self->has_working_lwp($self->{mirrors})){$self->chat("You have LWP $LWP::VERSION\n");my$ua=sub {LWP::UserAgent->new(parse_head=>0,env_proxy=>1,agent=>$self->agent,timeout=>30,@_,)};$self->{_backends}{get}=sub {my$self=shift;my$res=$ua->()->request(HTTP::Request->new(GET=>$_[0]));return unless$res->is_success;return$res->decoded_content};$self->{_backends}{mirror}=sub {my$self=shift;my$res=$ua->()->mirror(@_);die$res->content if$res->code==501;$res->code}}elsif ($self->{try_wget}and my$wget=$self->which('wget')){$self->chat("You have $wget\n");my@common=('--user-agent',$self->agent,'--retry-connrefused',($self->{verbose}? (): ('-q')),);$self->{_backends}{get}=sub {my($self,$uri)=@_;$self->safeexec(my$fh,$wget,$uri,@common,'-O','-')or die "wget $uri: $!";local $/;<$fh>};$self->{_backends}{mirror}=sub {my($self,$uri,$path)=@_;$self->safeexec(my$fh,$wget,$uri,@common,'-O',$path)or die "wget $uri: $!";local $/;<$fh>}}elsif ($self->{try_curl}and my$curl=$self->which('curl')){$self->chat("You have $curl\n");my@common=('--location','--user-agent',$self->agent,($self->{verbose}? (): '-s'),);$self->{_backends}{get}=sub {my($self,$uri)=@_;$self->safeexec(my$fh,$curl,@common,$uri)or die "curl $uri: $!";local $/;<$fh>};$self->{_backends}{mirror}=sub {my($self,$uri,$path)=@_;$self->safeexec(my$fh,$curl,@common,$uri,'-#','-o',$path)or die "curl $uri: $!";local $/;<$fh>}}else {require HTTP::Tiny;$self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");my%common=(agent=>$self->agent,);$self->{_backends}{get}=sub {my$self=shift;my$res=HTTP::Tiny->new(%common)->get($_[0]);return unless$res->{success};return$res->{content}};$self->{_backends}{mirror}=sub {my$self=shift;my$res=HTTP::Tiny->new(%common)->mirror(@_);return$res->{status}}}my$tar=$self->which('tar');my$tar_ver;my$maybe_bad_tar=sub {WIN32 || BAD_TAR || (($tar_ver=`$tar --version 2>/dev/null`)=~ /GNU.*1\.13/i)};if ($tar &&!$maybe_bad_tar->()){chomp$tar_ver;$self->chat("You have $tar: $tar_ver\n");$self->{_backends}{untar}=sub {my($self,$tarfile)=@_;my$xf=($self->{verbose}? 'v' : '')."xf";my$ar=$tarfile =~ /bz2$/ ? 'j' : 'z';my($root,@others)=`$tar ${ar}tf $tarfile` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "$tar $ar$xf $tarfile";return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif ($tar and my$gzip=$self->which('gzip')and my$bzip2=$self->which('bzip2')){$self->chat("You have $tar, $gzip and $bzip2\n");$self->{_backends}{untar}=sub {my($self,$tarfile)=@_;my$x="x" .($self->{verbose}? 'v' : '')."f -";my$ar=$tarfile =~ /bz2$/ ? $bzip2 : $gzip;my($root,@others)=`$ar -dc $tarfile | $tar tf -` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "$ar -dc $tarfile | $tar $x";return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif (eval {require Archive::Tar}){$self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");$self->{_backends}{untar}=sub {my$self=shift;my$t=Archive::Tar->new($_[0]);my($root,@others)=$t->list_files;FILE: {$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}$t->extract;return -d $root ? $root : undef}}else {$self->{_backends}{untar}=sub {die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n"}}if (my$unzip=$self->which('unzip')){$self->chat("You have $unzip\n");$self->{_backends}{unzip}=sub {my($self,$zipfile)=@_;my$opt=$self->{verbose}? '' : '-q';my(undef,$root,@others)=`$unzip -t $zipfile` or return undef;chomp$root;$root =~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1};system "$unzip $opt $zipfile";return$root if -d $root;$self->diag_fail("Bad archive: [$root] $zipfile");return undef}}else {$self->{_backends}{unzip}=sub {eval {require Archive::Zip}or die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";my($self,$file)=@_;my$zip=Archive::Zip->new();my$status;$status=$zip->read($file);$self->diag_fail("Read of file[$file] failed")if$status!=Archive::Zip::AZ_OK();my@members=$zip->members();for my$member (@members){my$af=$member->fileName();next if ($af =~ m!^(/|\.\./)!);$status=$member->extractToFileNamed($af);$self->diag_fail("Extracting of file[$af] from zipfile[$file failed")if$status!=Archive::Zip::AZ_OK()}my ($root)=$zip->membersMatching(qr<^[^/]+/$>);$root &&= $root->fileName;return -d $root ? $root : undef}}}sub safeexec {my$self=shift;my$rdr=$_[0]||= Symbol::gensym();if (WIN32){my$cmd=$self->shell_quote(@_[1..$#_]);return open($rdr,"$cmd |")}if (my$pid=open($rdr,'-|')){return$pid}elsif (defined$pid){exec(@_[1 .. $#_ ]);exit 1}else {return}}sub mask_uri_passwords {my($self,@strings)=@_;s{ (https?://) ([^:/]+) : [^@/]+ @ }{$1$2:********@}gx for@strings;return@strings}1;
|
|
479
|
33
|
It appears your cpanm executable was installed via `perlbrew install-cpanm`.
|
|
480
|
34
|
cpanm --self-upgrade won't upgrade the version of cpanm you're running.
|
|
481
|
35
|
|
|
...
|
...
|
@@ -483,9 +37,7 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
|
|
483
|
37
|
|
|
484
|
38
|
perlbrew install-cpanm
|
|
485
|
39
|
|
|
486
|
|
- WARN
|
|
487
|
|
- } else {
|
|
488
|
|
- warn <<WARN;
|
|
|
40
|
+ DIE
|
|
489
|
41
|
You are running cpanm from the path where your current perl won't install executables to.
|
|
490
|
42
|
Because of that, cpanm --self-upgrade won't upgrade the version of cpanm you're running.
|
|
491
|
43
|
|
|
...
|
...
|
@@ -494,11698 +46,463 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
|
|
494
|
46
|
|
|
495
|
47
|
It means you either installed cpanm globally with system perl, or use distro packages such
|
|
496
|
48
|
as rpm or apt-get, and you have to use them again to upgrade cpanm.
|
|
497
|
|
- WARN
|
|
498
|
|
- }
|
|
499
|
|
- }
|
|
500
|
|
- }
|
|
501
|
|
-
|
|
502
|
|
- sub check_libs {
|
|
503
|
|
- my $self = shift;
|
|
504
|
|
- return if $self->{_checked}++;
|
|
505
|
|
-
|
|
506
|
|
- $self->bootstrap_local_lib;
|
|
507
|
|
- if (@{$self->{bootstrap_deps} || []}) {
|
|
508
|
|
- local $self->{notest} = 1; # test failure in bootstrap should be tolerated
|
|
509
|
|
- local $self->{scandeps} = 0;
|
|
510
|
|
- $self->install_deps(Cwd::cwd, 0, @{$self->{bootstrap_deps}});
|
|
511
|
|
- }
|
|
512
|
|
- }
|
|
513
|
|
-
|
|
514
|
|
- sub setup_verify {
|
|
515
|
|
- my $self = shift;
|
|
516
|
|
-
|
|
517
|
|
- my $has_modules = eval { require Module::Signature; require Digest::SHA; 1 };
|
|
518
|
|
- $self->{cpansign} = $self->which('cpansign');
|
|
519
|
|
-
|
|
520
|
|
- unless ($has_modules && $self->{cpansign}) {
|
|
521
|
|
- warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";
|
|
522
|
|
- $self->{verify} = 0;
|
|
523
|
|
- }
|
|
524
|
|
- }
|
|
525
|
|
-
|
|
526
|
|
- sub parse_module_args {
|
|
527
|
|
- my($self, $module) = @_;
|
|
528
|
|
-
|
|
529
|
|
- # Plack@1.2 -> Plack~"==1.2"
|
|
530
|
|
- # BUT don't expand @ in git URLs
|
|
531
|
|
- $module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;
|
|
532
|
|
-
|
|
533
|
|
- # Plack~1.20, DBI~"> 1.0, <= 2.0"
|
|
534
|
|
- if ($module =~ /\~[v\d\._,\!<>= ]+$/) {
|
|
535
|
|
- return split /\~/, $module, 2;
|
|
536
|
|
- } else {
|
|
537
|
|
- return $module, undef;
|
|
538
|
|
- }
|
|
539
|
|
- }
|
|
540
|
|
-
|
|
541
|
|
- sub doit {
|
|
542
|
|
- my $self = shift;
|
|
543
|
|
-
|
|
544
|
|
- $self->setup_home;
|
|
545
|
|
- $self->init_tools;
|
|
546
|
|
- $self->setup_verify if $self->{verify};
|
|
547
|
|
-
|
|
548
|
|
- if (my $action = $self->{action}) {
|
|
549
|
|
- $self->$action() and return 1;
|
|
550
|
|
- }
|
|
551
|
|
-
|
|
552
|
|
- $self->show_help(1)
|
|
553
|
|
- unless @{$self->{argv}} or $self->{load_from_stdin};
|
|
554
|
|
-
|
|
555
|
|
- $self->configure_mirrors;
|
|
556
|
|
-
|
|
557
|
|
- my $cwd = Cwd::cwd;
|
|
558
|
|
-
|
|
559
|
|
- my @fail;
|
|
560
|
|
- for my $module (@{$self->{argv}}) {
|
|
561
|
|
- if ($module =~ s/\.pm$//i) {
|
|
562
|
|
- my ($volume, $dirs, $file) = File::Spec->splitpath($module);
|
|
563
|
|
- $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
|
|
564
|
|
- }
|
|
565
|
|
-
|
|
566
|
|
- ($module, my $version) = $self->parse_module_args($module);
|
|
567
|
|
- if ($self->{skip_satisfied}) {
|
|
568
|
|
- $self->check_libs;
|
|
569
|
|
- my($ok, $local) = $self->check_module($module, $version || 0);
|
|
570
|
|
- if ($ok) {
|
|
571
|
|
- $self->diag("You have $module ($local)\n", 1);
|
|
572
|
|
- next;
|
|
573
|
|
- }
|
|
574
|
|
- }
|
|
575
|
|
-
|
|
576
|
|
- $self->chdir($cwd);
|
|
577
|
|
- $self->install_module($module, 0, $version)
|
|
578
|
|
- or push @fail, $module;
|
|
579
|
|
- }
|
|
580
|
|
-
|
|
581
|
|
- if ($self->{base} && $self->{auto_cleanup}) {
|
|
582
|
|
- $self->cleanup_workdirs;
|
|
583
|
|
- }
|
|
584
|
|
-
|
|
585
|
|
- if ($self->{installed_dists}) {
|
|
586
|
|
- my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
|
|
587
|
|
- $self->diag("$self->{installed_dists} $dists installed\n", 1);
|
|
588
|
|
- }
|
|
589
|
|
-
|
|
590
|
|
- if ($self->{scandeps}) {
|
|
591
|
|
- $self->dump_scandeps();
|
|
592
|
|
- }
|
|
593
|
|
- # Workaround for older File::Temp's
|
|
594
|
|
- # where creating a tempdir with an implicit $PWD
|
|
595
|
|
- # causes tempdir non-cleanup if $PWD changes
|
|
596
|
|
- # as paths are stored internally without being resolved
|
|
597
|
|
- # absolutely.
|
|
598
|
|
- # https://rt.cpan.org/Public/Bug/Display.html?id=44924
|
|
599
|
|
- $self->chdir($cwd);
|
|
600
|
|
-
|
|
601
|
|
- return !@fail;
|
|
602
|
|
- }
|
|
603
|
|
-
|
|
604
|
|
- sub setup_home {
|
|
605
|
|
- my $self = shift;
|
|
606
|
|
-
|
|
607
|
|
- $self->{home} = $self->env('HOME') if $self->env('HOME');
|
|
608
|
|
-
|
|
609
|
|
- unless (_writable($self->{home})) {
|
|
610
|
|
- die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
|
|
611
|
|
- }
|
|
612
|
|
-
|
|
613
|
|
- $self->{base} = "$self->{home}/work/" . time . ".$$";
|
|
614
|
|
- File::Path::mkpath([ $self->{base} ], 0, 0777);
|
|
615
|
|
-
|
|
616
|
|
- my $link = "$self->{home}/latest-build";
|
|
617
|
|
- eval { unlink $link; symlink $self->{base}, $link };
|
|
618
|
|
-
|
|
619
|
|
- $self->{log} = File::Spec->catfile($self->{home}, "build.log"); # because we use shell redirect
|
|
620
|
|
-
|
|
621
|
|
- {
|
|
622
|
|
- my $log = $self->{log}; my $base = $self->{base};
|
|
623
|
|
- $self->{at_exit} = sub {
|
|
624
|
|
- my $self = shift;
|
|
625
|
|
- File::Copy::copy($self->{log}, "$self->{base}/build.log");
|
|
626
|
|
- };
|
|
627
|
|
- }
|
|
628
|
|
-
|
|
629
|
|
- { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
|
|
630
|
|
-
|
|
631
|
|
- $self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" .
|
|
632
|
|
- "Work directory is $self->{base}\n");
|
|
633
|
|
- }
|
|
634
|
|
-
|
|
635
|
|
- sub fetch_meta_sco {
|
|
636
|
|
- my($self, $dist) = @_;
|
|
637
|
|
- return if $self->{mirror_only};
|
|
638
|
|
-
|
|
639
|
|
- my $meta_yml = $self->get("http://search.cpan.org/meta/$dist->{distvname}/META.yml");
|
|
640
|
|
- return $self->parse_meta_string($meta_yml);
|
|
641
|
|
- }
|
|
642
|
|
-
|
|
643
|
|
- sub package_index_for {
|
|
644
|
|
- my ($self, $mirror) = @_;
|
|
645
|
|
- return $self->source_for($mirror) . "/02packages.details.txt";
|
|
646
|
|
- }
|
|
647
|
|
-
|
|
648
|
|
- sub generate_mirror_index {
|
|
649
|
|
- my ($self, $mirror) = @_;
|
|
650
|
|
- my $file = $self->package_index_for($mirror);
|
|
651
|
|
- my $gz_file = $file . '.gz';
|
|
652
|
|
- my $index_mtime = (stat $gz_file)[9];
|
|
653
|
|
-
|
|
654
|
|
- unless (-e $file && (stat $file)[9] >= $index_mtime) {
|
|
655
|
|
- $self->chat("Uncompressing index file...\n");
|
|
656
|
|
- if (eval {require Compress::Zlib}) {
|
|
657
|
|
- my $gz = Compress::Zlib::gzopen($gz_file, "rb")
|
|
658
|
|
- or do { $self->diag_fail("$Compress::Zlib::gzerrno opening compressed index"); return};
|
|
659
|
|
- open my $fh, '>', $file
|
|
660
|
|
- or do { $self->diag_fail("$! opening uncompressed index for write"); return };
|
|
661
|
|
- my $buffer;
|
|
662
|
|
- while (my $status = $gz->gzread($buffer)) {
|
|
663
|
|
- if ($status < 0) {
|
|
664
|
|
- $self->diag_fail($gz->gzerror . " reading compressed index");
|
|
665
|
|
- return;
|
|
666
|
|
- }
|
|
667
|
|
- print $fh $buffer;
|
|
668
|
|
- }
|
|
669
|
|
- } else {
|
|
670
|
|
- if (system("gunzip -c $gz_file > $file")) {
|
|
671
|
|
- $self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");
|
|
672
|
|
- return;
|
|
673
|
|
- }
|
|
674
|
|
- }
|
|
675
|
|
- utime $index_mtime, $index_mtime, $file;
|
|
676
|
|
- }
|
|
677
|
|
- return 1;
|
|
678
|
|
- }
|
|
679
|
|
-
|
|
680
|
|
- sub search_mirror_index {
|
|
681
|
|
- my ($self, $mirror, $module, $version) = @_;
|
|
682
|
|
- $self->search_mirror_index_file($self->package_index_for($mirror), $module, $version);
|
|
683
|
|
- }
|
|
684
|
|
-
|
|
685
|
|
- sub search_mirror_index_file {
|
|
686
|
|
- my($self, $file, $module, $version) = @_;
|
|
687
|
|
-
|
|
688
|
|
- open my $fh, '<', $file or return;
|
|
689
|
|
- my $found;
|
|
690
|
|
- while (<$fh>) {
|
|
691
|
|
- if (m!^\Q$module\E\s+([\w\.]+)\s+(\S*)!m) {
|
|
692
|
|
- $found = $self->cpan_module($module, $2, $1);
|
|
693
|
|
- last;
|
|
694
|
|
- }
|
|
695
|
|
- }
|
|
696
|
|
-
|
|
697
|
|
- return $found unless $self->{cascade_search};
|
|
698
|
|
-
|
|
699
|
|
- if ($found) {
|
|
700
|
|
- if ($self->satisfy_version($module, $found->{module_version}, $version)) {
|
|
701
|
|
- return $found;
|
|
702
|
|
- } else {
|
|
703
|
|
- $self->chat("Found $module $found->{module_version} which doesn't satisfy $version.\n");
|
|
704
|
|
- }
|
|
705
|
|
- }
|
|
706
|
|
-
|
|
707
|
|
- return;
|
|
708
|
|
- }
|
|
709
|
|
-
|
|
710
|
|
- sub with_version_range {
|
|
711
|
|
- my($self, $version) = @_;
|
|
712
|
|
- defined($version) && $version =~ /[<>=]/;
|
|
713
|
|
- }
|
|
714
|
|
-
|
|
715
|
|
- sub encode_json {
|
|
716
|
|
- my($self, $data) = @_;
|
|
717
|
|
- require JSON::PP;
|
|
718
|
|
-
|
|
719
|
|
- my $json = JSON::PP::encode_json($data);
|
|
720
|
|
- $json =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
|
|
721
|
|
- $json;
|
|
722
|
|
- }
|
|
723
|
|
-
|
|
724
|
|
- # TODO extract this as a module?
|
|
725
|
|
- sub version_to_query {
|
|
726
|
|
- my($self, $module, $version) = @_;
|
|
727
|
|
-
|
|
728
|
|
- require CPAN::Meta::Requirements;
|
|
|
49
|
+ DIE
|
|
|
50
|
+ Usage: cpanm [options] Module [...]
|
|
729
|
51
|
|
|
730
|
|
- my $requirements = CPAN::Meta::Requirements->new;
|
|
731
|
|
- $requirements->add_string_requirement($module, $version || '0');
|
|
|
52
|
+ Try `cpanm --help` or `man cpanm` for more options.
|
|
|
53
|
+ USAGE
|
|
|
54
|
+ Usage: cpanm [options] Module [...]
|
|
732
|
55
|
|
|
733
|
|
- my $req = $requirements->requirements_for_module($module);
|
|
734
|
|
-
|
|
735
|
|
- if ($req =~ s/^==\s*//) {
|
|
736
|
|
- return {
|
|
737
|
|
- term => { 'module.version' => $req },
|
|
738
|
|
- };
|
|
739
|
|
- } elsif ($req !~ /\s/) {
|
|
740
|
|
- return {
|
|
741
|
|
- range => { 'module.version_numified' => { 'gte' => $self->numify_ver($req) } },
|
|
742
|
|
- };
|
|
743
|
|
- } else {
|
|
744
|
|
- my %ops = qw(< lt <= lte > gt >= gte);
|
|
745
|
|
- my(%range, @exclusion);
|
|
746
|
|
- my @requirements = split /,\s*/, $req;
|
|
747
|
|
- for my $r (@requirements) {
|
|
748
|
|
- if ($r =~ s/^([<>]=?)\s*//) {
|
|
749
|
|
- $range{$ops{$1}} = $self->numify_ver($r);
|
|
750
|
|
- } elsif ($r =~ s/\!=\s*//) {
|
|
751
|
|
- push @exclusion, $self->numify_ver($r);
|
|
752
|
|
- }
|
|
753
|
|
- }
|
|
754
|
|
-
|
|
755
|
|
- my @filters= (
|
|
756
|
|
- { range => { 'module.version_numified' => \%range } },
|
|
757
|
|
- );
|
|
758
|
|
-
|
|
759
|
|
- if (@exclusion) {
|
|
760
|
|
- push @filters, {
|
|
761
|
|
- not => { or => [ map { +{ term => { 'module.version_numified' => $self->numify_ver($_) } } } @exclusion ] },
|
|
762
|
|
- };
|
|
763
|
|
- }
|
|
764
|
|
-
|
|
765
|
|
- return @filters;
|
|
766
|
|
- }
|
|
767
|
|
- }
|
|
768
|
|
-
|
|
769
|
|
- sub numify_ver {
|
|
770
|
|
- my($self, $ver) = @_;
|
|
771
|
|
- version->new($ver)->numify;
|
|
772
|
|
- }
|
|
773
|
|
-
|
|
774
|
|
- sub maturity_filter {
|
|
775
|
|
- my($self, $module, $version) = @_;
|
|
776
|
|
-
|
|
777
|
|
- my @filters;
|
|
778
|
|
-
|
|
779
|
|
- # TODO: dev release should be enabled per dist
|
|
780
|
|
- if (!$self->with_version_range($version) or $self->{dev_release}) {
|
|
781
|
|
- # backpan'ed dev release are considered "cancelled"
|
|
782
|
|
- push @filters, { not => { term => { status => 'backpan' } } };
|
|
783
|
|
- }
|
|
784
|
|
-
|
|
785
|
|
- unless ($self->{dev_release} or $version =~ /==/) {
|
|
786
|
|
- push @filters, { term => { maturity => 'released' } };
|
|
787
|
|
- }
|
|
788
|
|
-
|
|
789
|
|
- return @filters;
|
|
790
|
|
- }
|
|
791
|
|
-
|
|
792
|
|
- sub search_metacpan {
|
|
793
|
|
- my($self, $module, $version) = @_;
|
|
794
|
|
-
|
|
795
|
|
- require JSON::PP;
|
|
796
|
|
-
|
|
797
|
|
- $self->chat("Searching $module ($version) on metacpan ...\n");
|
|
798
|
|
-
|
|
799
|
|
- my $metacpan_uri = 'http://api.metacpan.org/v0';
|
|
800
|
|
-
|
|
801
|
|
- my @filter = $self->maturity_filter($module, $version);
|
|
802
|
|
-
|
|
803
|
|
- my $query = { filtered => {
|
|
804
|
|
- (@filter ? (filter => { and => \@filter }) : ()),
|
|
805
|
|
- query => { nested => {
|
|
806
|
|
- score_mode => 'max',
|
|
807
|
|
- path => 'module',
|
|
808
|
|
- query => { custom_score => {
|
|
809
|
|
- metacpan_script => "score_version_numified",
|
|
810
|
|
- query => { constant_score => {
|
|
811
|
|
- filter => { and => [
|
|
812
|
|
- { term => { 'module.authorized' => JSON::PP::true() } },
|
|
813
|
|
- { term => { 'module.indexed' => JSON::PP::true() } },
|
|
814
|
|
- { term => { 'module.name' => $module } },
|
|
815
|
|
- $self->version_to_query($module, $version),
|
|
816
|
|
- ] }
|
|
817
|
|
- } },
|
|
818
|
|
- } },
|
|
819
|
|
- } },
|
|
820
|
|
- } };
|
|
821
|
|
-
|
|
822
|
|
- my $module_uri = "$metacpan_uri/file/_search?source=";
|
|
823
|
|
- $module_uri .= $self->encode_json({
|
|
824
|
|
- query => $query,
|
|
825
|
|
- fields => [ 'release', 'module' ],
|
|
826
|
|
- });
|
|
827
|
|
-
|
|
828
|
|
- my($release, $module_version);
|
|
829
|
|
-
|
|
830
|
|
- my $module_json = $self->get($module_uri);
|
|
831
|
|
- my $module_meta = eval { JSON::PP::decode_json($module_json) };
|
|
832
|
|
- my $match = $module_meta ? $module_meta->{hits}{hits}[0]{fields} : undef;
|
|
833
|
|
- if ($match) {
|
|
834
|
|
- $release = $match->{release};
|
|
835
|
|
- my $module_matched = (grep { $_->{name} eq $module } @{$match->{module}})[0];
|
|
836
|
|
- $module_version = $module_matched->{version};
|
|
837
|
|
- }
|
|
838
|
|
-
|
|
839
|
|
- unless ($release) {
|
|
840
|
|
- $self->chat("! Could not find a release matching $module ($version) on MetaCPAN.\n");
|
|
841
|
|
- return;
|
|
842
|
|
- }
|
|
843
|
|
-
|
|
844
|
|
- my $dist_uri = "$metacpan_uri/release/_search?source=";
|
|
845
|
|
- $dist_uri .= $self->encode_json({
|
|
846
|
|
- filter => {
|
|
847
|
|
- term => { 'release.name' => $release },
|
|
848
|
|
- },
|
|
849
|
|
- fields => [ 'download_url', 'stat', 'status' ],
|
|
850
|
|
- });
|
|
851
|
|
-
|
|
852
|
|
- my $dist_json = $self->get($dist_uri);
|
|
853
|
|
- my $dist_meta = eval { JSON::PP::decode_json($dist_json) };
|
|
854
|
|
-
|
|
855
|
|
- if ($dist_meta) {
|
|
856
|
|
- $dist_meta = $dist_meta->{hits}{hits}[0]{fields};
|
|
857
|
|
- }
|
|
858
|
|
- if ($dist_meta && $dist_meta->{download_url}) {
|
|
859
|
|
- (my $distfile = $dist_meta->{download_url}) =~ s!.+/authors/id/!!;
|
|
860
|
|
- local $self->{mirrors} = $self->{mirrors};
|
|
861
|
|
- if ($dist_meta->{status} eq 'backpan') {
|
|
862
|
|
- $self->{mirrors} = [ 'http://backpan.perl.org' ];
|
|
863
|
|
- } elsif ($dist_meta->{stat}{mtime} > time()-24*60*60) {
|
|
864
|
|
- $self->{mirrors} = [ 'http://cpan.metacpan.org' ];
|
|
865
|
|
- }
|
|
866
|
|
- return $self->cpan_module($module, $distfile, $module_version);
|
|
867
|
|
- }
|
|
868
|
|
-
|
|
869
|
|
- $self->diag_fail("Finding $module on metacpan failed.");
|
|
870
|
|
- return;
|
|
871
|
|
- }
|
|
872
|
|
-
|
|
873
|
|
- sub search_database {
|
|
874
|
|
- my($self, $module, $version) = @_;
|
|
875
|
|
-
|
|
876
|
|
- my $found;
|
|
877
|
|
- my $range = ($self->with_version_range($version) || $self->{dev_release});
|
|
878
|
|
-
|
|
879
|
|
- if ($range or $self->{metacpan}) {
|
|
880
|
|
- $found = $self->search_metacpan($module, $version) and return $found;
|
|
881
|
|
- $found = $self->search_cpanmetadb($module, $version) and return $found;
|
|
882
|
|
- } else {
|
|
883
|
|
- $found = $self->search_cpanmetadb($module, $version) and return $found;
|
|
884
|
|
- $found = $self->search_metacpan($module, $version) and return $found;
|
|
885
|
|
- }
|
|
886
|
|
- }
|
|
887
|
|
-
|
|
888
|
|
- sub search_cpanmetadb {
|
|
889
|
|
- my($self, $module, $version) = @_;
|
|
890
|
|
-
|
|
891
|
|
- $self->chat("Searching $module on cpanmetadb ...\n");
|
|
892
|
|
-
|
|
893
|
|
- my $uri = "http://cpanmetadb.plackperl.org/v1.0/package/$module";
|
|
894
|
|
- my $yaml = $self->get($uri);
|
|
895
|
|
- my $meta = $self->parse_meta_string($yaml);
|
|
896
|
|
- if ($meta && $meta->{distfile}) {
|
|
897
|
|
- return $self->cpan_module($module, $meta->{distfile}, $meta->{version});
|
|
898
|
|
- }
|
|
899
|
|
-
|
|
900
|
|
- $self->diag_fail("Finding $module on cpanmetadb failed.");
|
|
901
|
|
- return;
|
|
902
|
|
- }
|
|
903
|
|
-
|
|
904
|
|
- sub search_module {
|
|
905
|
|
- my($self, $module, $version) = @_;
|
|
906
|
|
-
|
|
907
|
|
- if ($self->{mirror_index}) {
|
|
908
|
|
- $self->chat("Searching $module on mirror index $self->{mirror_index} ...\n");
|
|
909
|
|
- my $pkg = $self->search_mirror_index_file($self->{mirror_index}, $module, $version);
|
|
910
|
|
- return $pkg if $pkg;
|
|
911
|
|
-
|
|
912
|
|
- unless ($self->{cascade_search}) {
|
|
913
|
|
- $self->diag_fail("Finding $module ($version) on mirror index $self->{mirror_index} failed.");
|
|
914
|
|
- return;
|
|
915
|
|
- }
|
|
916
|
|
- }
|
|
917
|
|
-
|
|
918
|
|
- unless ($self->{mirror_only}) {
|
|
919
|
|
- my $found = $self->search_database($module, $version);
|
|
920
|
|
- return $found if $found;
|
|
921
|
|
- }
|
|
922
|
|
-
|
|
923
|
|
- MIRROR: for my $mirror (@{ $self->{mirrors} }) {
|
|
924
|
|
- $self->chat("Searching $module on mirror $mirror ...\n");
|
|
925
|
|
- my $name = '02packages.details.txt.gz';
|
|
926
|
|
- my $uri = "$mirror/modules/$name";
|
|
927
|
|
- my $gz_file = $self->package_index_for($mirror) . '.gz';
|
|
928
|
|
-
|
|
929
|
|
- unless ($self->{pkgs}{$uri}) {
|
|
930
|
|
- $self->chat("Downloading index file $uri ...\n");
|
|
931
|
|
- $self->mirror($uri, $gz_file);
|
|
932
|
|
- $self->generate_mirror_index($mirror) or next MIRROR;
|
|
933
|
|
- $self->{pkgs}{$uri} = "!!retrieved!!";
|
|
934
|
|
- }
|
|
935
|
|
-
|
|
936
|
|
- my $pkg = $self->search_mirror_index($mirror, $module, $version);
|
|
937
|
|
- return $pkg if $pkg;
|
|
938
|
|
-
|
|
939
|
|
- $self->diag_fail("Finding $module ($version) on mirror $mirror failed.");
|
|
940
|
|
- }
|
|
941
|
|
-
|
|
942
|
|
- return;
|
|
943
|
|
- }
|
|
944
|
|
-
|
|
945
|
|
- sub source_for {
|
|
946
|
|
- my($self, $mirror) = @_;
|
|
947
|
|
- $mirror =~ s/[^\w\.\-]+/%/g;
|
|
948
|
|
-
|
|
949
|
|
- my $dir = "$self->{home}/sources/$mirror";
|
|
950
|
|
- File::Path::mkpath([ $dir ], 0, 0777);
|
|
951
|
|
-
|
|
952
|
|
- return $dir;
|
|
953
|
|
- }
|
|
954
|
|
-
|
|
955
|
|
- sub load_argv_from_fh {
|
|
956
|
|
- my($self, $fh) = @_;
|
|
957
|
|
-
|
|
958
|
|
- my @argv;
|
|
959
|
|
- while(defined(my $line = <$fh>)){
|
|
960
|
|
- chomp $line;
|
|
961
|
|
- $line =~ s/#.+$//; # comment
|
|
962
|
|
- $line =~ s/^\s+//; # trim spaces
|
|
963
|
|
- $line =~ s/\s+$//; # trim spaces
|
|
964
|
|
-
|
|
965
|
|
- push @argv, split ' ', $line if $line;
|
|
966
|
|
- }
|
|
967
|
|
- return @argv;
|
|
968
|
|
- }
|
|
969
|
|
-
|
|
970
|
|
- sub show_version {
|
|
971
|
|
- print "cpanm (App::cpanminus) version $VERSION\n";
|
|
972
|
|
- return 1;
|
|
973
|
|
- }
|
|
974
|
|
-
|
|
975
|
|
- sub show_help {
|
|
976
|
|
- my $self = shift;
|
|
977
|
|
-
|
|
978
|
|
- if ($_[0]) {
|
|
979
|
|
- die <<USAGE;
|
|
980
|
|
- Usage: cpanm [options] Module [...]
|
|
981
|
|
-
|
|
982
|
|
- Try `cpanm --help` or `man cpanm` for more options.
|
|
983
|
|
- USAGE
|
|
984
|
|
- }
|
|
985
|
|
-
|
|
986
|
|
- print <<HELP;
|
|
987
|
|
- Usage: cpanm [options] Module [...]
|
|
988
|
|
-
|
|
989
|
|
- Options:
|
|
990
|
|
- -v,--verbose Turns on chatty output
|
|
991
|
|
- -q,--quiet Turns off the most output
|
|
992
|
|
- --interactive Turns on interactive configure (required for Task:: modules)
|
|
993
|
|
- -f,--force force install
|
|
994
|
|
- -n,--notest Do not run unit tests
|
|
995
|
|
- --test-only Run tests only, do not install
|
|
996
|
|
- -S,--sudo sudo to run install commands
|
|
997
|
|
- --installdeps Only install dependencies
|
|
998
|
|
- --showdeps Only display direct dependencies
|
|
999
|
|
- --reinstall Reinstall the distribution even if you already have the latest version installed
|
|
1000
|
|
- --mirror Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
|
|
1001
|
|
- --mirror-only Use the mirror's index file instead of the CPAN Meta DB
|
|
1002
|
|
- --prompt Prompt when configure/build/test fails
|
|
1003
|
|
- -l,--local-lib Specify the install base to install modules
|
|
1004
|
|
- -L,--local-lib-contained Specify the install base to install all non-core modules
|
|
1005
|
|
- --auto-cleanup Number of days that cpanm's work directories expire in. Defaults to 7
|
|
|
56
|
+ Options:
|
|
|
57
|
+ -v,--verbose Turns on chatty output
|
|
|
58
|
+ -q,--quiet Turns off the most output
|
|
|
59
|
+ --interactive Turns on interactive configure (required for Task:: modules)
|
|
|
60
|
+ -f,--force force install
|
|
|
61
|
+ -n,--notest Do not run unit tests
|
|
|
62
|
+ --test-only Run tests only, do not install
|
|
|
63
|
+ -S,--sudo sudo to run install commands
|
|
|
64
|
+ --installdeps Only install dependencies
|
|
|
65
|
+ --showdeps Only display direct dependencies
|
|
|
66
|
+ --reinstall Reinstall the distribution even if you already have the latest version installed
|
|
|
67
|
+ --mirror Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
|
|
|
68
|
+ --mirror-only Use the mirror's index file instead of the CPAN Meta DB
|
|
|
69
|
+ -M,--from Use only this mirror base URL and its index file
|
|
|
70
|
+ --prompt Prompt when configure/build/test fails
|
|
|
71
|
+ -l,--local-lib Specify the install base to install modules
|
|
|
72
|
+ -L,--local-lib-contained Specify the install base to install all non-core modules
|
|
|
73
|
+ --self-contained Install all non-core modules, even if they're already installed.
|
|
|
74
|
+ --auto-cleanup Number of days that cpanm's work directories expire in. Defaults to 7
|
|
1006
|
75
|
|
|
1007
|
76
|
Commands:
|
|
1008
|
77
|
--self-upgrade upgrades itself
|
|
1009
|
|
- --info Displays distribution info on CPAN
|
|
1010
|
|
- --look Opens the distribution with your SHELL
|
|
1011
|
|
- -V,--version Displays software version
|
|
1012
|
|
-
|
|
1013
|
|
- Examples:
|
|
1014
|
|
-
|
|
1015
|
|
- cpanm Test::More # install Test::More
|
|
1016
|
|
- cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path
|
|
1017
|
|
- cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL
|
|
1018
|
|
- cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file
|
|
1019
|
|
- cpanm --interactive Task::Kensho # Configure interactively
|
|
1020
|
|
- cpanm . # install from local directory
|
|
1021
|
|
- cpanm --installdeps . # install all the deps for the current directory
|
|
1022
|
|
- cpanm -L extlib Plack # install Plack and all non-core deps into extlib
|
|
1023
|
|
- cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror
|
|
1024
|
|
-
|
|
1025
|
|
- You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
|
|
1026
|
|
-
|
|
1027
|
|
- export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
|
|
1028
|
|
-
|
|
1029
|
|
- Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
|
|
1030
|
|
-
|
|
1031
|
|
- HELP
|
|
1032
|
|
-
|
|
1033
|
|
- return 1;
|
|
1034
|
|
- }
|
|
1035
|
|
-
|
|
1036
|
|
- sub _writable {
|
|
1037
|
|
- my $dir = shift;
|
|
1038
|
|
- my @dir = File::Spec->splitdir($dir);
|
|
1039
|
|
- while (@dir) {
|
|
1040
|
|
- $dir = File::Spec->catdir(@dir);
|
|
1041
|
|
- if (-e $dir) {
|
|
1042
|
|
- return -w _;
|
|
1043
|
|
- }
|
|
1044
|
|
- pop @dir;
|
|
1045
|
|
- }
|
|
1046
|
|
-
|
|
1047
|
|
- return;
|
|
1048
|
|
- }
|
|
1049
|
|
-
|
|
1050
|
|
- sub maybe_abs {
|
|
1051
|
|
- my($self, $lib) = @_;
|
|
1052
|
|
- if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)) {
|
|
1053
|
|
- return $lib;
|
|
1054
|
|
- } else {
|
|
1055
|
|
- return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(), $lib));
|
|
1056
|
|
- }
|
|
1057
|
|
- }
|
|
1058
|
|
-
|
|
1059
|
|
- sub bootstrap_local_lib {
|
|
1060
|
|
- my $self = shift;
|
|
1061
|
|
-
|
|
1062
|
|
- # If -l is specified, use that.
|
|
1063
|
|
- if ($self->{local_lib}) {
|
|
1064
|
|
- return $self->setup_local_lib($self->{local_lib});
|
|
1065
|
|
- }
|
|
1066
|
|
-
|
|
1067
|
|
- # root, locally-installed perl or --sudo: don't care about install_base
|
|
1068
|
|
- return if $self->{sudo} or (_writable($Config{installsitelib}) and _writable($Config{installsitebin}));
|
|
1069
|
|
-
|
|
1070
|
|
- # local::lib is configured in the shell -- yay
|
|
1071
|
|
- if ($ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT})) {
|
|
1072
|
|
- $self->bootstrap_local_lib_deps;
|
|
1073
|
|
- return;
|
|
1074
|
|
- }
|
|
1075
|
|
-
|
|
1076
|
|
- $self->setup_local_lib;
|
|
1077
|
|
-
|
|
1078
|
|
- $self->diag(<<DIAG);
|
|
1079
|
|
- !
|
|
1080
|
|
- ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
|
|
1081
|
|
- ! To turn off this warning, you have to do one of the following:
|
|
1082
|
|
- ! - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
|
|
1083
|
|
- ! - Configure local::lib your existing local::lib in this shell to set PERL_MM_OPT etc.
|
|
1084
|
|
- ! - Install local::lib by running the following commands
|
|
1085
|
|
- !
|
|
1086
|
|
- ! cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
|
|
1087
|
|
- !
|
|
1088
|
|
- DIAG
|
|
1089
|
|
- sleep 2;
|
|
1090
|
|
- }
|
|
1091
|
|
-
|
|
1092
|
|
- sub _core_only_inc {
|
|
1093
|
|
- my($self, $base) = @_;
|
|
1094
|
|
- require local::lib;
|
|
1095
|
|
- (
|
|
1096
|
|
- local::lib->resolve_path(local::lib->install_base_perl_path($base)),
|
|
1097
|
|
- local::lib->resolve_path(local::lib->install_base_arch_path($base)),
|
|
1098
|
|
- @Config{qw(privlibexp archlibexp)},
|
|
1099
|
|
- );
|
|
1100
|
|
- }
|
|
1101
|
|
-
|
|
1102
|
|
- sub _diff {
|
|
1103
|
|
- my($self, $old, $new) = @_;
|
|
1104
|
|
-
|
|
1105
|
|
- my @diff;
|
|
1106
|
|
- my %old = map { $_ => 1 } @$old;
|
|
1107
|
|
- for my $n (@$new) {
|
|
1108
|
|
- push @diff, $n unless exists $old{$n};
|
|
1109
|
|
- }
|
|
1110
|
|
-
|
|
1111
|
|
- @diff;
|
|
1112
|
|
- }
|
|
1113
|
|
-
|
|
1114
|
|
- sub _setup_local_lib_env {
|
|
1115
|
|
- my($self, $base) = @_;
|
|
1116
|
|
- local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
|
|
1117
|
|
- local::lib->setup_env_hash_for($base);
|
|
1118
|
|
- }
|
|
1119
|
|
-
|
|
1120
|
|
- sub setup_local_lib {
|
|
1121
|
|
- my($self, $base) = @_;
|
|
1122
|
|
- $base = undef if $base eq '_';
|
|
1123
|
|
-
|
|
1124
|
|
- require local::lib;
|
|
1125
|
|
- {
|
|
1126
|
|
- local $0 = 'cpanm'; # so curl/wget | perl works
|
|
1127
|
|
- $base ||= "~/perl5";
|
|
1128
|
|
- if ($self->{self_contained}) {
|
|
1129
|
|
- my @inc = $self->_core_only_inc($base);
|
|
1130
|
|
- $self->{search_inc} = [ @inc ];
|
|
1131
|
|
- } else {
|
|
1132
|
|
- $self->{search_inc} = [
|
|
1133
|
|
- local::lib->resolve_path(local::lib->install_base_arch_path($base)),
|
|
1134
|
|
- local::lib->resolve_path(local::lib->install_base_perl_path($base)),
|
|
1135
|
|
- @INC,
|
|
1136
|
|
- ];
|
|
1137
|
|
- }
|
|
1138
|
|
- $self->_setup_local_lib_env($base);
|
|
1139
|
|
- }
|
|
1140
|
|
-
|
|
1141
|
|
- $self->bootstrap_local_lib_deps;
|
|
1142
|
|
- }
|
|
1143
|
|
-
|
|
1144
|
|
- sub bootstrap_local_lib_deps {
|
|
1145
|
|
- my $self = shift;
|
|
1146
|
|
- push @{$self->{bootstrap_deps}},
|
|
1147
|
|
- 'ExtUtils::MakeMaker' => 6.31,
|
|
1148
|
|
- 'ExtUtils::Install' => 1.46;
|
|
1149
|
|
- }
|
|
1150
|
|
-
|
|
1151
|
|
- sub prompt_bool {
|
|
1152
|
|
- my($self, $mess, $def) = @_;
|
|
1153
|
|
-
|
|
1154
|
|
- my $val = $self->prompt($mess, $def);
|
|
1155
|
|
- return lc $val eq 'y';
|
|
1156
|
|
- }
|
|
1157
|
|
-
|
|
1158
|
|
- sub prompt {
|
|
1159
|
|
- my($self, $mess, $def) = @_;
|
|
1160
|
|
-
|
|
1161
|
|
- my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
|
|
1162
|
|
- my $dispdef = defined $def ? "[$def] " : " ";
|
|
1163
|
|
- $def = defined $def ? $def : "";
|
|
1164
|
|
-
|
|
1165
|
|
- if (!$self->{prompt} || (!$isa_tty && eof STDIN)) {
|
|
1166
|
|
- return $def;
|
|
1167
|
|
- }
|
|
1168
|
|
-
|
|
1169
|
|
- local $|=1;
|
|
1170
|
|
- local $\;
|
|
1171
|
|
- my $ans;
|
|
1172
|
|
- eval {
|
|
1173
|
|
- local $SIG{ALRM} = sub { undef $ans; die "alarm\n" };
|
|
1174
|
|
- print STDOUT "$mess $dispdef";
|
|
1175
|
|
- alarm $self->{prompt_timeout} if $self->{prompt_timeout};
|
|
1176
|
|
- $ans = <STDIN>;
|
|
1177
|
|
- alarm 0;
|
|
1178
|
|
- };
|
|
1179
|
|
- if ( defined $ans ) {
|
|
1180
|
|
- chomp $ans;
|
|
1181
|
|
- } else { # user hit ctrl-D or alarm timeout
|
|
1182
|
|
- print STDOUT "\n";
|
|
1183
|
|
- }
|
|
1184
|
|
-
|
|
1185
|
|
- return (!defined $ans || $ans eq '') ? $def : $ans;
|
|
1186
|
|
- }
|
|
1187
|
|
-
|
|
1188
|
|
- sub diag_ok {
|
|
1189
|
|
- my($self, $msg) = @_;
|
|
1190
|
|
- chomp $msg;
|
|
1191
|
|
- $msg ||= "OK";
|
|
1192
|
|
- if ($self->{in_progress}) {
|
|
1193
|
|
- $self->_diag("$msg\n");
|
|
1194
|
|
- $self->{in_progress} = 0;
|
|
1195
|
|
- }
|
|
1196
|
|
- $self->log("-> $msg\n");
|
|
1197
|
|
- }
|
|
1198
|
|
-
|
|
1199
|
|
- sub diag_fail {
|
|
1200
|
|
- my($self, $msg, $always) = @_;
|
|
1201
|
|
- chomp $msg;
|
|
1202
|
|
- if ($self->{in_progress}) {
|
|
1203
|
|
- $self->_diag("FAIL\n");
|
|
1204
|
|
- $self->{in_progress} = 0;
|
|
1205
|
|
- }
|
|
1206
|
|
-
|
|
1207
|
|
- if ($msg) {
|
|
1208
|
|
- $self->_diag("! $msg\n", $always);
|
|
1209
|
|
- $self->log("-> FAIL $msg\n");
|
|
1210
|
|
- }
|
|
1211
|
|
- }
|
|
1212
|
|
-
|
|
1213
|
|
- sub diag_progress {
|
|
1214
|
|
- my($self, $msg) = @_;
|
|
1215
|
|
- chomp $msg;
|
|
1216
|
|
- $self->{in_progress} = 1;
|
|
1217
|
|
- $self->_diag("$msg ... ");
|
|
1218
|
|
- $self->log("$msg\n");
|
|
1219
|
|
- }
|
|
1220
|
|
-
|
|
1221
|
|
- sub _diag {
|
|
1222
|
|
- my($self, $msg, $always) = @_;
|
|
1223
|
|
- print STDERR $msg if $always or $self->{verbose} or !$self->{quiet};
|
|
1224
|
|
- }
|
|
1225
|
|
-
|
|
1226
|
|
- sub diag {
|
|
1227
|
|
- my($self, $msg, $always) = @_;
|
|
1228
|
|
- $self->_diag($msg, $always);
|
|
1229
|
|
- $self->log($msg);
|
|
1230
|
|
- }
|
|
1231
|
|
-
|
|
1232
|
|
- sub chat {
|
|
1233
|
|
- my $self = shift;
|
|
1234
|
|
- print STDERR @_ if $self->{verbose};
|
|
1235
|
|
- $self->log(@_);
|
|
1236
|
|
- }
|
|
1237
|
|
-
|
|
1238
|
|
- sub log {
|
|
1239
|
|
- my $self = shift;
|
|
1240
|
|
- open my $out, ">>$self->{log}";
|
|
1241
|
|
- print $out @_;
|
|
1242
|
|
- }
|
|
1243
|
|
-
|
|
1244
|
|
- sub run {
|
|
1245
|
|
- my($self, $cmd) = @_;
|
|
1246
|
|
-
|
|
1247
|
|
- if (WIN32 && ref $cmd eq 'ARRAY') {
|
|
1248
|
|
- $cmd = join q{ }, map { $self->shell_quote($_) } @$cmd;
|
|
1249
|
|
- }
|
|
1250
|
|
-
|
|
1251
|
|
- if (ref $cmd eq 'ARRAY') {
|
|
1252
|
|
- my $pid = fork;
|
|
1253
|
|
- if ($pid) {
|
|
1254
|
|
- waitpid $pid, 0;
|
|
1255
|
|
- return !$?;
|
|
1256
|
|
- } else {
|
|
1257
|
|
- $self->run_exec($cmd);
|
|
1258
|
|
- }
|
|
1259
|
|
- } else {
|
|
1260
|
|
- unless ($self->{verbose}) {
|
|
1261
|
|
- $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
|
|
1262
|
|
- }
|
|
1263
|
|
- !system $cmd;
|
|
1264
|
|
- }
|
|
1265
|
|
- }
|
|
1266
|
|
-
|
|
1267
|
|
- sub run_exec {
|
|
1268
|
|
- my($self, $cmd) = @_;
|
|
1269
|
|
-
|
|
1270
|
|
- if (ref $cmd eq 'ARRAY') {
|
|
1271
|
|
- unless ($self->{verbose}) {
|
|
1272
|
|
- open my $logfh, ">>", $self->{log};
|
|
1273
|
|
- open STDERR, '>&', $logfh;
|
|
1274
|
|
- open STDOUT, '>&', $logfh;
|
|
1275
|
|
- close $logfh;
|
|
1276
|
|
- }
|
|
1277
|
|
- exec @$cmd;
|
|
1278
|
|
- } else {
|
|
1279
|
|
- unless ($self->{verbose}) {
|
|
1280
|
|
- $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
|
|
1281
|
|
- }
|
|
1282
|
|
- exec $cmd;
|
|
1283
|
|
- }
|
|
1284
|
|
- }
|
|
1285
|
|
-
|
|
1286
|
|
- sub run_timeout {
|
|
1287
|
|
- my($self, $cmd, $timeout) = @_;
|
|
1288
|
|
- return $self->run($cmd) if WIN32 || $self->{verbose} || !$timeout;
|
|
1289
|
|
-
|
|
1290
|
|
- my $pid = fork;
|
|
1291
|
|
- if ($pid) {
|
|
1292
|
|
- eval {
|
|
1293
|
|
- local $SIG{ALRM} = sub { die "alarm\n" };
|
|
1294
|
|
- alarm $timeout;
|
|
1295
|
|
- waitpid $pid, 0;
|
|
1296
|
|
- alarm 0;
|
|
1297
|
|
- };
|
|
1298
|
|
- if ($@ && $@ eq "alarm\n") {
|
|
1299
|
|
- $self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");
|
|
1300
|
|
- local $SIG{TERM} = 'IGNORE';
|
|
1301
|
|
- kill TERM => 0;
|
|
1302
|
|
- waitpid $pid, 0;
|
|
1303
|
|
- return;
|
|
1304
|
|
- }
|
|
1305
|
|
- return !$?;
|
|
1306
|
|
- } elsif ($pid == 0) {
|
|
1307
|
|
- $self->run_exec($cmd);
|
|
1308
|
|
- } else {
|
|
1309
|
|
- $self->chat("! fork failed: falling back to system()\n");
|
|
1310
|
|
- $self->run($cmd);
|
|
1311
|
|
- }
|
|
1312
|
|
- }
|
|
1313
|
|
-
|
|
1314
|
|
- sub configure {
|
|
1315
|
|
- my($self, $cmd) = @_;
|
|
1316
|
|
-
|
|
1317
|
|
- # trick AutoInstall
|
|
1318
|
|
- local $ENV{PERL5_CPAN_IS_RUNNING} = local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;
|
|
1319
|
|
-
|
|
1320
|
|
- # e.g. skip CPAN configuration on local::lib
|
|
1321
|
|
- local $ENV{PERL5_CPANM_IS_RUNNING} = $$;
|
|
1322
|
|
-
|
|
1323
|
|
- my $use_default = !$self->{interactive};
|
|
1324
|
|
- local $ENV{PERL_MM_USE_DEFAULT} = $use_default;
|
|
1325
|
|
-
|
|
1326
|
|
- # skip man page generation
|
|
1327
|
|
- local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
|
|
1328
|
|
- unless ($self->{pod2man}) {
|
|
1329
|
|
- $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
|
|
1330
|
|
- }
|
|
1331
|
|
-
|
|
1332
|
|
- local $self->{verbose} = $self->{verbose} || $self->{interactive};
|
|
1333
|
|
- $self->run_timeout($cmd, $self->{configure_timeout});
|
|
1334
|
|
- }
|
|
1335
|
|
-
|
|
1336
|
|
- sub build {
|
|
1337
|
|
- my($self, $cmd, $distname) = @_;
|
|
1338
|
|
-
|
|
1339
|
|
- return 1 if $self->run_timeout($cmd, $self->{build_timeout});
|
|
1340
|
|
- while (1) {
|
|
1341
|
|
- my $ans = lc $self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
|
|
1342
|
|
- return if $ans eq 's';
|
|
1343
|
|
- return $self->build($cmd, $distname) if $ans eq 'r';
|
|
1344
|
|
- $self->show_build_log if $ans eq 'e';
|
|
1345
|
|
- $self->look if $ans eq 'l';
|
|
1346
|
|
- }
|
|
1347
|
|
- }
|
|
1348
|
|
-
|
|
1349
|
|
- sub test {
|
|
1350
|
|
- my($self, $cmd, $distname) = @_;
|
|
1351
|
|
- return 1 if $self->{notest};
|
|
1352
|
|
-
|
|
1353
|
|
- # https://rt.cpan.org/Ticket/Display.html?id=48965#txn-1013385
|
|
1354
|
|
- local $ENV{PERL_MM_USE_DEFAULT} = 1;
|
|
1355
|
|
-
|
|
1356
|
|
- return 1 if $self->run_timeout($cmd, $self->{test_timeout});
|
|
1357
|
|
- if ($self->{force}) {
|
|
1358
|
|
- $self->diag_fail("Testing $distname failed but installing it anyway.");
|
|
1359
|
|
- return 1;
|
|
1360
|
|
- } else {
|
|
1361
|
|
- $self->diag_fail;
|
|
1362
|
|
- while (1) {
|
|
1363
|
|
- my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?", "s");
|
|
1364
|
|
- return if $ans eq 's';
|
|
1365
|
|
- return $self->test($cmd, $distname) if $ans eq 'r';
|
|
1366
|
|
- return 1 if $ans eq 'f';
|
|
1367
|
|
- $self->show_build_log if $ans eq 'e';
|
|
1368
|
|
- $self->look if $ans eq 'l';
|
|
1369
|
|
- }
|
|
1370
|
|
- }
|
|
1371
|
|
- }
|
|
1372
|
|
-
|
|
1373
|
|
- sub install {
|
|
1374
|
|
- my($self, $cmd, $uninst_opts, $depth) = @_;
|
|
1375
|
|
-
|
|
1376
|
|
- if ($depth == 0 && $self->{test_only}) {
|
|
1377
|
|
- return 1;
|
|
1378
|
|
- }
|
|
1379
|
|
-
|
|
1380
|
|
- if ($self->{sudo}) {
|
|
1381
|
|
- unshift @$cmd, "sudo";
|
|
1382
|
|
- }
|
|
1383
|
|
-
|
|
1384
|
|
- if ($self->{uninstall_shadows} && !$ENV{PERL_MM_OPT}) {
|
|
1385
|
|
- push @$cmd, @$uninst_opts;
|
|
1386
|
|
- }
|
|
1387
|
|
-
|
|
1388
|
|
- $self->run($cmd);
|
|
1389
|
|
- }
|
|
1390
|
|
-
|
|
1391
|
|
- sub look {
|
|
1392
|
|
- my $self = shift;
|
|
1393
|
|
-
|
|
1394
|
|
- my $shell = $ENV{SHELL};
|
|
1395
|
|
- $shell ||= $ENV{COMSPEC} if WIN32;
|
|
1396
|
|
- if ($shell) {
|
|
1397
|
|
- my $cwd = Cwd::cwd;
|
|
1398
|
|
- $self->diag("Entering $cwd with $shell\n");
|
|
1399
|
|
- system $shell;
|
|
1400
|
|
- } else {
|
|
1401
|
|
- $self->diag_fail("You don't seem to have a SHELL :/");
|
|
1402
|
|
- }
|
|
1403
|
|
- }
|
|
1404
|
|
-
|
|
1405
|
|
- sub show_build_log {
|
|
1406
|
|
- my $self = shift;
|
|
1407
|
|
-
|
|
1408
|
|
- my @pagers = (
|
|
1409
|
|
- $ENV{PAGER},
|
|
1410
|
|
- (WIN32 ? () : ('less')),
|
|
1411
|
|
- 'more'
|
|
1412
|
|
- );
|
|
1413
|
|
- my $pager;
|
|
1414
|
|
- while (@pagers) {
|
|
1415
|
|
- $pager = shift @pagers;
|
|
1416
|
|
- next unless $pager;
|
|
1417
|
|
- $pager = $self->which($pager);
|
|
1418
|
|
- next unless $pager;
|
|
1419
|
|
- last;
|
|
1420
|
|
- }
|
|
1421
|
|
-
|
|
1422
|
|
- if ($pager) {
|
|
1423
|
|
- # win32 'more' doesn't allow "more build.log", the < is required
|
|
1424
|
|
- system("$pager < $self->{log}");
|
|
1425
|
|
- }
|
|
1426
|
|
- else {
|
|
1427
|
|
- $self->diag_fail("You don't seem to have a PAGER :/");
|
|
1428
|
|
- }
|
|
1429
|
|
- }
|
|
1430
|
|
-
|
|
1431
|
|
- sub chdir {
|
|
1432
|
|
- my $self = shift;
|
|
1433
|
|
- Cwd::chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
|
|
1434
|
|
- }
|
|
1435
|
|
-
|
|
1436
|
|
- sub configure_mirrors {
|
|
1437
|
|
- my $self = shift;
|
|
1438
|
|
- unless (@{$self->{mirrors}}) {
|
|
1439
|
|
- $self->{mirrors} = [ 'http://www.cpan.org' ];
|
|
1440
|
|
- }
|
|
1441
|
|
- for (@{$self->{mirrors}}) {
|
|
1442
|
|
- s!^/!file:///!;
|
|
1443
|
|
- s!/$!!;
|
|
1444
|
|
- }
|
|
1445
|
|
- }
|
|
1446
|
|
-
|
|
1447
|
|
- sub self_upgrade {
|
|
1448
|
|
- my $self = shift;
|
|
1449
|
|
- $self->{argv} = [ 'App::cpanminus' ];
|
|
1450
|
|
- return; # continue
|
|
1451
|
|
- }
|
|
1452
|
|
-
|
|
1453
|
|
- sub install_module {
|
|
1454
|
|
- my($self, $module, $depth, $version) = @_;
|
|
1455
|
|
-
|
|
1456
|
|
- if ($self->{seen}{$module}++) {
|
|
1457
|
|
- $self->chat("Already tried $module. Skipping.\n");
|
|
1458
|
|
- return 1;
|
|
1459
|
|
- }
|
|
1460
|
|
-
|
|
1461
|
|
- my $dist = $self->resolve_name($module, $version);
|
|
1462
|
|
- unless ($dist) {
|
|
1463
|
|
- $self->diag_fail("Couldn't find module or a distribution $module ($version)", 1);
|
|
1464
|
|
- return;
|
|
1465
|
|
- }
|
|
1466
|
|
-
|
|
1467
|
|
- if ($dist->{distvname} && $self->{seen}{$dist->{distvname}}++) {
|
|
1468
|
|
- $self->chat("Already tried $dist->{distvname}. Skipping.\n");
|
|
1469
|
|
- return 1;
|
|
1470
|
|
- }
|
|
1471
|
|
-
|
|
1472
|
|
- if ($self->{cmd} eq 'info') {
|
|
1473
|
|
- print $self->format_dist($dist), "\n";
|
|
1474
|
|
- return 1;
|
|
1475
|
|
- }
|
|
1476
|
|
-
|
|
1477
|
|
- $self->check_libs;
|
|
1478
|
|
- $self->setup_module_build_patch unless $self->{pod2man};
|
|
1479
|
|
-
|
|
1480
|
|
- if ($dist->{module}) {
|
|
1481
|
|
- unless ($self->with_version_range($version)) {
|
|
1482
|
|
- my($ok, $local) = $self->check_module($dist->{module}, $dist->{module_version} || 0);
|
|
1483
|
|
- if ($self->{skip_installed} && $ok) {
|
|
1484
|
|
- $self->diag("$dist->{module} is up to date. ($local)\n", 1);
|
|
1485
|
|
- return 1;
|
|
1486
|
|
- }
|
|
1487
|
|
- }
|
|
1488
|
|
-
|
|
1489
|
|
- unless ($self->satisfy_version($dist->{module}, $dist->{module_version}, $version)) {
|
|
1490
|
|
- $self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n");
|
|
1491
|
|
- return;
|
|
1492
|
|
- }
|
|
1493
|
|
- }
|
|
1494
|
|
-
|
|
1495
|
|
- if ($dist->{dist} eq 'perl'){
|
|
1496
|
|
- $self->diag("skipping $dist->{pathname}\n");
|
|
1497
|
|
- return 1;
|
|
1498
|
|
- }
|
|
1499
|
|
-
|
|
1500
|
|
- $self->diag("--> Working on $module\n");
|
|
1501
|
|
-
|
|
1502
|
|
- $dist->{dir} ||= $self->fetch_module($dist);
|
|
1503
|
|
-
|
|
1504
|
|
- unless ($dist->{dir}) {
|
|
1505
|
|
- $self->diag_fail("Failed to fetch distribution $dist->{distvname}", 1);
|
|
1506
|
|
- return;
|
|
1507
|
|
- }
|
|
1508
|
|
-
|
|
1509
|
|
- $self->chat("Entering $dist->{dir}\n");
|
|
1510
|
|
- $self->chdir($self->{base});
|
|
1511
|
|
- $self->chdir($dist->{dir});
|
|
1512
|
|
-
|
|
1513
|
|
- if ($self->{cmd} eq 'look') {
|
|
1514
|
|
- $self->look;
|
|
1515
|
|
- return 1;
|
|
1516
|
|
- }
|
|
1517
|
|
-
|
|
1518
|
|
- return $self->build_stuff($module, $dist, $depth);
|
|
1519
|
|
- }
|
|
1520
|
|
-
|
|
1521
|
|
- sub format_dist {
|
|
1522
|
|
- my($self, $dist) = @_;
|
|
1523
|
|
-
|
|
1524
|
|
- # TODO support --dist-format?
|
|
1525
|
|
- return "$dist->{cpanid}/$dist->{filename}";
|
|
1526
|
|
- }
|
|
1527
|
|
|