File Coverage

lib/CPAN.pm
Criterion Covered Total %
statement 1928 3691 52.2
branch 787 2106 37.4
condition 213 647 32.9
subroutine 238 318 74.8
pod n/a
total 3166 6762 46.8


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 6     6   178 use strict;
  6         96  
  6         177  
3             package CPAN;
4             $CPAN::VERSION = '1.8802';
5             $CPAN::VERSION = eval $CPAN::VERSION;
6              
7 6     6   258 use CPAN::HandleConfig;
  6         61  
  6         169  
8 6     6   295 use CPAN::Version;
  6         67  
  6         140  
9 6     6   232 use CPAN::Debug;
  6         85  
  6         146  
10 6     6   220 use CPAN::Tarzip;
  6         62  
  6         355  
11 6     6   129 use Carp ();
  6         123  
  6         188  
12 6     6   91 use Config ();
  6         90  
  6         143  
13 6     6   96 use Cwd ();
  6         86  
  6         57  
14 6     6   298 use DirHandle ();
  6         61  
  6         64  
15 6     6   105 use Exporter ();
  6         89  
  6         60  
16 6     6   208 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
  6         63  
  6         302  
17             # 5.005_04 does not work without
18             # this
19 6     6   219 use File::Basename ();
  6         53  
  6         57  
20 6     6   186 use File::Copy ();
  6         60  
  6         62  
21 6     6   105 use File::Find;
  6         53  
  6         129  
22 6     6   103 use File::Path ();
  6         55  
  6         54  
23 6     6   1580 use File::Spec ();
  6         84  
  6         61  
24 6     6   211 use FileHandle ();
  6         59  
  6         59  
25 6     6   200 use Safe ();
  6         127  
  6         66  
26 6     6   294 use Sys::Hostname qw(hostname);
  6         64  
  6         149  
27 6     6   228 use Text::ParseWords ();
  6         62  
  6         64  
28 6     6   247 use Text::Wrap ();
  6         63  
  6         66  
29              
30             # we need to run chdir all over and we would get at wrong libraries
31             # there
32             BEGIN {
33 6 50   6   224     if (File::Spec->can("rel2abs")) {
34 6         69         for my $inc (@INC) {
35 111         6069             $inc = File::Spec->rel2abs($inc);
36                     }
37                 }
38             }
39 6     6   598 no lib ".";
  6         88  
  6         364  
40              
41             require Mac::BuildTools if $^O eq 'MacOS';
42              
43             END { $CPAN::End++; &cleanup; }
44              
45             $CPAN::Signal ||= 0;
46             $CPAN::Frontend ||= "CPAN::Shell";
47             unless (@CPAN::Defaultsites){
48                 @CPAN::Defaultsites = map {
49                     CPAN::URL->new(TEXT => $_, FROM => "DEF")
50                 }
51                     "http://www.perl.org/CPAN/",
52                         "ftp://ftp.perl.org/pub/CPAN/";
53             }
54             # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
55             $CPAN::Perl ||= CPAN::find_perl();
56             $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
57             $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
58              
59              
60 6         455 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
61             $Signal $Suppress_readline $Frontend
62             @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
63 6     6   185 $Be_Silent );
  6         59  
64              
65             @CPAN::ISA = qw(CPAN::Debug Exporter);
66              
67             # note that these functions live in CPAN::Shell and get executed via
68             # AUTOLOAD when called directly
69             @EXPORT = qw(
70             autobundle
71             bundle
72             clean
73             cvs_import
74             expand
75             force
76             get
77             install
78             make
79             mkmyconfig
80             notest
81             perldoc
82             readme
83             recent
84             recompile
85             shell
86             test
87             upgrade
88             );
89              
90             sub soft_chdir_with_alternatives ($);
91              
92             #-> sub CPAN::AUTOLOAD ;
93             sub AUTOLOAD {
94 1     1   66     my($l) = $AUTOLOAD;
95 1         36     $l =~ s/.*:://;
96 1         10     my(%EXPORT);
97 1         128     @EXPORT{@EXPORT} = '';
98 1 50       92     CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
99 1 50       13     if (exists $EXPORT{$l}){
100 0         0 CPAN::Shell->$l(@_);
101                 } else {
102 1         34 die(qq{Unknown CPAN command "$AUTOLOAD". }.
103                         qq{Type ? for help.\n});
104                 }
105             }
106              
107             #-> sub CPAN::shell ;
108             sub shell {
109 1     1   11     my($self) = @_;
110 1 50       27     $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
111 1 50       65     CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
112              
113 1   33     25     my $oprompt = shift || CPAN::Prompt->new;
114 1         14     my $prompt = $oprompt;
115 1   50     19     my $commandline = shift || "";
116 1   50     12     $CPAN::CurrentCommandId ||= 1;
117              
118 1         14     local($^W) = 1;
119 1 50       12     unless ($Suppress_readline) {
120 1         46 require Term::ReadLine;
121 1 50 33     18         if (! $term
122                         or
123                         $term->ReadLine eq "Term::ReadLine::Stub"
124                        ) {
125 1         22             $term = Term::ReadLine->new('CPAN Monitor');
126                     }
127 1 50       14 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
128 0         0 my $attribs = $term->Attribs;
129             $attribs->{attempted_completion_function} = sub {
130 0     0   0 &CPAN::Complete::gnu_cpl;
131             }
132 0         0 } else {
133 1         34 $readline::rl_completion_function =
134             $readline::rl_completion_function = 'CPAN::Complete::cpl';
135             }
136 1 50       17         if (my $histfile = $CPAN::Config->{'histfile'}) {{
137 1 50       9             unless ($term->can("AddHistory")) {
  1         43  
138 0         0                 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
139 0         0                 last;
140                         }
141 1         45             my($fh) = FileHandle->new;
142 1 50       14             open $fh, "<$histfile" or last;
143 0         0             local $/ = "\n";
144 0         0             while (<$fh>) {
145 0         0                 chomp;
146 0         0                 $term->AddHistory($_);
147                         }
148 0         0             close $fh;
149                     }}
150 1         21         for ($CPAN::Config->{term_ornaments}) { # alias
151 1         10             local $Term::ReadLine::termcap_nowarn = 1;
152 1 50       22             $term->ornaments($_) if defined;
153                     }
154             # $term->OUT is autoflushed anyway
155 1         16 my $odef = select STDERR;
156 1         13 $| = 1;
157 1         11 select STDOUT;
158 1         9 $| = 1;
159 1         14 select $odef;
160                 }
161              
162             # no strict; # I do not recall why no strict was here (2000-09-03)
163 1         31     $META->checklock();
164 1 50       20     my @cwd = (
165                            CPAN::anycwd(),
166                            File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
167                            File::Spec->rootdir(),
168                           );
169 1         11010     my $try_detect_readline;
170 1 50       81     $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
171 1 50       35     my $rl_avail = $Suppress_readline ? "suppressed" :
    50          
172             ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
173             "available (try 'install Bundle::CPAN')";
174              
175 1 50       15     unless ($CPAN::Config->{'inhibit_startup_message'}){
176 1         265         $CPAN::Frontend->myprint(
177                                              sprintf qq{
178             cpan shell -- CPAN exploration and modules installation (v%s)
179             ReadLine support %s
180            
181             },
182                                              $CPAN::VERSION,
183                                              $rl_avail
184                                             )
185                 }
186 1         12     my($continuation) = "";
187 1         9     my $last_term_ornaments;
188 1         9   SHELLCOMMAND: while () {
189 125 50       1416 if ($Suppress_readline) {
190 0         0 print $prompt;
191 0 0       0 last SHELLCOMMAND unless defined ($_ = <> );
192 0         0 chomp;
193             } else {
194             last SHELLCOMMAND unless
195 125 50       2286                 defined ($_ = $term->readline($prompt, $commandline));
196             }
197 125 50       1341 $_ = "$continuation$_" if $continuation;
198 125         1903 s/^\s+//;
199 125 100       2114 next SHELLCOMMAND if /^$/;
200 124 50       1859 $_ = 'h' if /^\s*\?/;
201 124 100       6009 if (/^(?:q(?:uit)?|bye|exit)$/i) {
    50          
    100          
    50          
202 1         12 last SHELLCOMMAND;
203             } elsif (s/\\$//s) {
204 0         0 chomp;
205 0         0 $continuation = $_;
206 0         0 $prompt = " > ";
207             } elsif (/^\!/) {
208 5         51 s/^\!//;
209 5         63 my($eval) = $_;
210             package CPAN::Eval;
211 6     6   166             use strict;
  6         72  
  6         2925  
212 6     6   944 use vars qw($import_done);
  6         57  
  6         141  
213 5 100       143 CPAN->import(':DEFAULT') unless $import_done++;
214 5 50       1937 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
215 5         531 eval($eval);
216 5 50       106 warn $@ if $@;
217 5         48 $continuation = "";
218 5         55 $prompt = $oprompt;
219             } elsif (/./) {
220 118         1377 my(@line);
221 118 50       1238 if ($] < 5.00322) { # parsewords had a bug until recently
222 0         0 @line = split;
223             } else {
224 118         1138 eval { @line = Text::ParseWords::shellwords($_) };
  118         2436  
225 118 50       35034 warn($@), next SHELLCOMMAND if $@;
226 118 50       1687                 warn("Text::Parsewords could not parse the line [$_]"),
227                                 next SHELLCOMMAND unless @line;
228             }
229 118 50       1403 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
230 118         1331 my $command = shift @line;
231 118         1625 eval { CPAN::Shell->$command(@line) };
  118         2886  
232 118 100       5003 warn $@ if $@;
233 118 100       3380             if ($command =~ /^(make|test|install|force|notest|clean|upgrade)$/) {
234 17         547                 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
235                         }
236 118         2537             soft_chdir_with_alternatives(\@cwd);
237 118         1580 $CPAN::Frontend->myprint("\n");
238 118         1515 $continuation = "";
239 118         5729             $CPAN::CurrentCommandId++;
240 118         4350 $prompt = $oprompt;
241             }
242                 } continue {
243 124         1895       $commandline = ""; # I do want to be able to pass a default to
244             # shell, but on the second command I see no
245             # use in that
246 124         2064       $Signal=0;
247 124         2418       CPAN::Queue->nullify_queue;
248 124 50       1498       if ($try_detect_readline) {
249 0 0 0     0 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
250             ||
251             $CPAN::META->has_inst("Term::ReadLine::Perl")
252             ) {
253 0         0 delete $INC{"Term/ReadLine.pm"};
254 0         0 my $redef = 0;
255 0         0 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
256 0         0 require Term::ReadLine;
257 0         0 $CPAN::Frontend->myprint("\n$redef subroutines in ".
258             "Term::ReadLine redefined\n");
259 0         0             @_ = ($oprompt,"");
260 0         0 goto &shell;
261             }
262                   }
263 124 50 33     7263       if ($term and $term->can("ornaments")) {
264 124         1676           for ($CPAN::Config->{term_ornaments}) { # alias
265 124 50       1726               if (defined $_) {
266 124 100 100     2677                   if (not defined $last_term_ornaments
267                                   or $_ != $last_term_ornaments
268                                  ) {
269 3         77                       local $Term::ReadLine::termcap_nowarn = 1;
270 3         128                       $term->ornaments($_);
271 3         68                       $last_term_ornaments = $_;
272                               }
273                           } else {
274 0         0                   undef $last_term_ornaments;
275                           }
276                       }
277                   }
278                 }
279 1         14     soft_chdir_with_alternatives(\@cwd);
280             }
281              
282             sub soft_chdir_with_alternatives ($) {
283 119     119   1399     my($cwd) = @_;
284 119         6328     while (not chdir $cwd->[0]) {
285 0 0       0         if (@$cwd>1) {
286 0         0             $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
287             Trying to chdir to "$cwd->[1]" instead.
288             });
289 0         0             shift @$cwd;
290                     } else {
291 0         0             $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
292                     }
293                 }
294             }
295              
296             # CPAN::_yaml_loadfile
297             sub _yaml_loadfile {
298 0     0   0     my($self,$local_file) = @_;
299 0   0     0     my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
300 0 0       0