This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
[inseparable changes from match from perl-5.003_96 to perl-5.003_97]
[perl5.git] / lib / CPAN.pm
... / ...
CommitLineData
1package CPAN;
2use vars qw{$META $Signal $Cwd $End $Suppress_readline};
3
4$VERSION = '1.24';
5
6# $Id: CPAN.pm,v 1.139 1997/03/31 22:43:23 k Exp $
7
8# my $version = substr q$Revision: 1.139 $, 10; # only used during development
9
10use Carp ();
11use Config ();
12use Cwd ();
13use DirHandle;
14use Exporter ();
15use ExtUtils::MakeMaker ();
16use File::Basename ();
17use File::Copy ();
18use File::Find;
19use File::Path ();
20use FileHandle ();
21use Safe ();
22use Text::ParseWords ();
23use Text::Wrap;
24
25my $getcwd;
26$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
27$Cwd = Cwd->$getcwd();
28
29END { $End++; &cleanup; }
30
31%CPAN::DEBUG = qw(
32 CPAN 1
33 Index 2
34 InfoObj 4
35 Author 8
36 Distribution 16
37 Bundle 32
38 Module 64
39 CacheMgr 128
40 Complete 256
41 FTP 512
42 Shell 1024
43 Eval 2048
44 Config 4096
45 );
46
47$CPAN::DEBUG ||= 0;
48$CPAN::Signal ||= 0;
49
50package CPAN;
51use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
52use strict qw(vars);
53
54@CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
55 # MakeMaker, gives us
56 # catfile and catdir
57
58$META ||= new CPAN; # In case we reeval ourselves we
59 # need a ||
60
61@EXPORT = qw(
62 autobundle bundle expand force get
63 install make readme recompile shell test clean
64 );
65
66
67
68#-> sub CPAN::autobundle ;
69sub autobundle;
70#-> sub CPAN::bundle ;
71sub bundle;
72#-> sub CPAN::expand ;
73sub expand;
74#-> sub CPAN::force ;
75sub force;
76#-> sub CPAN::install ;
77sub install;
78#-> sub CPAN::make ;
79sub make;
80#-> sub CPAN::shell ;
81sub shell;
82#-> sub CPAN::clean ;
83sub clean;
84#-> sub CPAN::test ;
85sub test;
86
87#-> sub CPAN::AUTOLOAD ;
88sub AUTOLOAD {
89 my($l) = $AUTOLOAD;
90 $l =~ s/.*:://;
91 my(%EXPORT);
92 @EXPORT{@EXPORT} = '';
93 if (exists $EXPORT{$l}){
94 CPAN::Shell->$l(@_);
95 } else {
96 warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
97Nothing Done.
98";
99 CPAN::Shell->h;
100 }
101}
102
103#-> sub CPAN::all ;
104sub all {
105 my($mgr,$class) = @_;
106 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
107 CPAN::Index->reload;
108 values %{ $META->{$class} };
109}
110
111# Called by shell, not in batch mode. Not clean XXX
112#-> sub CPAN::checklock ;
113sub checklock {
114 my($self) = @_;
115 my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
116 if (-f $lockfile && -M _ > 0) {
117 my $fh = FileHandle->new($lockfile);
118 my $other = <$fh>;
119 $fh->close;
120 if (defined $other && $other) {
121 chomp $other;
122 return if $$==$other; # should never happen
123 print qq{There seems to be running another CPAN process }.
124 qq{($other). Trying to contact...\n};
125 if (kill 0, $other) {
126 Carp::croak qq{Other job is running.\n}.
127 qq{You may want to kill it and delete the lockfile, }.
128 qq{maybe. On UNIX try:\n}.
129 qq{ kill $other\n}.
130 qq{ rm $lockfile\n};
131 } elsif (-w $lockfile) {
132 my($ans) =
133 ExtUtils::MakeMaker::prompt
134 (qq{Other job not responding. Shall I overwrite }.
135 qq{the lockfile? (Y/N)},"y");
136 print("Ok, bye\n"), exit unless $ans =~ /^y/i;
137 } else {
138 Carp::croak(
139 qq{Lockfile $lockfile not writeable by you. }.
140 qq{Cannot proceed.\n}.
141 qq{ On UNIX try:\n}.
142 qq{ rm $lockfile\n}.
143 qq{ and then rerun us.\n}
144 );
145 }
146 }
147 }
148 File::Path::mkpath($CPAN::Config->{cpan_home});
149 my $fh;
150 unless ($fh = FileHandle->new(">$lockfile")) {
151 if ($! =~ /Permission/) {
152 my $incc = $INC{'CPAN/Config.pm'};
153 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
154 print qq{
155
156Your configuration suggests that CPAN.pm should use a working
157directory of
158 $CPAN::Config->{cpan_home}
159Unfortunately we could not create the lock file
160 $lockfile
161due to permission problems.
162
163Please make sure that the configuration variable
164 \$CPAN::Config->{cpan_home}
165points to a directory where you can write a .lock file. You can set
166this variable in either
167 $incc
168or
169 $myincc
170
171};
172 }
173 Carp::croak "Could not open >$lockfile: $!";
174 }
175 print $fh $$, "\n";
176 $self->{LOCK} = $lockfile;
177 $fh->close;
178 $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
179 $SIG{'INT'} = sub {
180 my $s = $Signal == 2 ? "a second" : "another";
181 &cleanup, die "Got $s SIGINT" if $Signal;
182 $Signal = 1;
183 };
184 $SIG{'__DIE__'} = \&cleanup;
185 $self->debug("Signal handler set.") if $CPAN::DEBUG;
186}
187
188#-> sub CPAN::DESTROY ;
189sub DESTROY {
190 &cleanup; # need an eval?
191}
192
193#-> sub CPAN::exists ;
194sub exists {
195 my($mgr,$class,$id) = @_;
196 CPAN::Index->reload;
197 ### Carp::croak "exists called without class argument" unless $class;
198 $id ||= "";
199 exists $META->{$class}{$id};
200}
201
202#-> sub CPAN::hasFTP ;
203sub hasFTP {
204 my($self,$arg) = @_;
205 if (defined $arg) {
206 return $self->{'hasFTP'} = $arg;
207 } elsif (not defined $self->{'hasFTP'}) {
208 eval {require Net::FTP;};
209 $self->{'hasFTP'} = $@ ? 0 : 1;
210 }
211 return $self->{'hasFTP'};
212}
213
214#-> sub CPAN::hasLWP ;
215sub hasLWP {
216 my($self,$arg) = @_;
217 if (defined $arg) {
218 return $self->{'hasLWP'} = $arg;
219 } elsif (not defined $self->{'hasLWP'}) {
220 eval {require LWP;};
221 $LWP::VERSION ||= 0;
222 $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
223 }
224 return $self->{'hasLWP'};
225}
226
227#-> sub CPAN::hasMD5 ;
228sub hasMD5 {
229 my($self,$arg) = @_;
230 if (defined $arg) {
231 $self->{'hasMD5'} = $arg;
232 } elsif (not defined $self->{'hasMD5'}) {
233 eval {require MD5;};
234 if ($@) {
235 print "MD5 security checks disabled because MD5 not installed.
236 Please consider installing the MD5 module\n";
237 $self->{'hasMD5'} = 0;
238 } else {
239 $self->{'hasMD5'}++;
240 }
241 }
242 return $self->{'hasMD5'};
243}
244
245#-> sub CPAN::hasWAIT ;
246sub hasWAIT {
247 my($self,$arg) = @_;
248 if (defined $arg) {
249 $self->{'hasWAIT'} = $arg;
250 } elsif (not defined $self->{'hasWAIT'}) {
251 eval {require CPAN::WAIT;};
252 if ($@) {
253 $self->{'hasWAIT'} = 0;
254 } else {
255 $self->{'hasWAIT'} = 1;
256 }
257 }
258 return $self->{'hasWAIT'};
259}
260
261#-> sub CPAN::instance ;
262sub instance {
263 my($mgr,$class,$id) = @_;
264 ### CPAN::Index->reload; ### not faster: unless time - $CPAN::Index::last_time > 60;
265 CPAN::Index->reload;
266 ### Carp::croak "instance called without class argument" unless $class;
267 $id ||= "";
268 $META->{$class}{$id} ||= $class->new(ID => $id );
269}
270
271#-> sub CPAN::new ;
272sub new {
273 bless {}, shift;
274}
275
276#-> sub CPAN::cleanup ;
277sub cleanup {
278 local $SIG{__DIE__} = '';
279 my $i = 0; my $ineval = 0; my $sub;
280 while ((undef,undef,undef,$sub) = caller(++$i)) {
281 $ineval = 1, last if $sub eq '(eval)';
282 }
283 return if $ineval && !$End;
284 return unless defined $META->{'LOCK'};
285 return unless -f $META->{'LOCK'};
286 unlink $META->{'LOCK'};
287 print STDERR "Lockfile removed.\n";
288# my $mess = Carp::longmess(@_);
289# die @_;
290}
291
292#-> sub CPAN::shell ;
293sub shell {
294 $Suppress_readline ||= ! -t STDIN;
295
296 my $prompt = "cpan> ";
297 local($^W) = 1;
298 unless ($Suppress_readline) {
299 require Term::ReadLine;
300# import Term::ReadLine;
301 $term = new Term::ReadLine 'CPAN Monitor';
302 $readline::rl_completion_function =
303 $readline::rl_completion_function = 'CPAN::Complete::complete';
304 }
305
306 no strict;
307 $META->checklock();
308 my $getcwd;
309 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
310 my $cwd = Cwd->$getcwd();
311 # How should we determine if we have more than stub ReadLine enabled?
312 my $rl_avail = $Suppress_readline ? "suppressed" :
313 defined &Term::ReadLine::Perl::readline ? "enabled" :
314 "available (get Term::ReadKey and Term::ReadLine::Perl)";
315
316 print qq{
317cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
318Readline support $rl_avail
319
320} unless $CPAN::Config->{'inhibit_startup_message'} ;
321 while () {
322 if ($Suppress_readline) {
323 print $prompt;
324 last unless defined ($_ = <> );
325 chomp;
326 } else {
327# if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024
328# my($report,$item);
329# $report = "";
330# for $item (qw/ReadLine IN OUT MinLine findConsole Features/) {
331# $report .= sprintf "%-15s", $item;
332# $report .= $term->$item() || "";
333# $report .= "\n";
334# }
335# print $report;
336# CPAN->debug($report);
337# }
338 last unless defined ($_ = $term->readline($prompt));
339 }
340 s/^\s//;
341 next if /^$/;
342 $_ = 'h' if $_ eq '?';
343 if (/^\!/) {
344 s/^\!//;
345 my($eval) = $_;
346 package CPAN::Eval;
347 use vars qw($import_done);
348 CPAN->import(':DEFAULT') unless $import_done++;
349 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
350 eval($eval);
351 warn $@ if $@;
352 } elsif (/^q(?:uit)?$/i) {
353 last;
354 } elsif (/./) {
355 my(@line);
356 if ($] < 5.00322) { # parsewords had a bug until recently
357 @line = split;
358 } else {
359 eval { @line = Text::ParseWords::shellwords($_) };
360 warn($@), next if $@;
361 }
362 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
363 my $command = shift @line;
364 eval { CPAN::Shell->$command(@line) };
365 warn $@ if $@;
366 }
367 } continue {
368 &cleanup, die if $Signal;
369 chdir $cwd;
370 print "\n";
371 }
372}
373
374package CPAN::CacheMgr;
375use vars qw($Du);
376@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
377use File::Find;
378
379#-> sub CPAN::CacheMgr::as_string ;
380sub as_string {
381 eval { require Data::Dumper };
382 if ($@) {
383 return shift->SUPER::as_string;
384 } else {
385 return Data::Dumper::Dumper(shift);
386 }
387}
388
389#-> sub CPAN::CacheMgr::cachesize ;
390sub cachesize {
391 shift->{DU};
392}
393
394# sub check {
395# my($self,@dirs) = @_;
396# return unless -d $self->{ID};
397# my $dir;
398# @dirs = $self->dirs unless @dirs;
399# for $dir (@dirs) {
400# $self->disk_usage($dir);
401# }
402# }
403
404#-> sub CPAN::CacheMgr::clean_cache ;
405#=# sub clean_cache {
406#=# my $self = shift;
407#=# my $dir;
408#=# while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
409#=# $self->force_clean_cache($dir);
410#=# }
411#=# $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
412#=# }
413
414#-> sub CPAN::CacheMgr::dir ;
415sub dir {
416 shift->{ID};
417}
418
419#-> sub CPAN::CacheMgr::entries ;
420sub entries {
421 my($self,$dir) = @_;
422 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
423 $dir ||= $self->{ID};
424 my $getcwd;
425 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
426 my($cwd) = Cwd->$getcwd();
427 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
428 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
429 my(@entries);
430 for ($dh->read) {
431 next if $_ eq "." || $_ eq "..";
432 if (-f $_) {
433 push @entries, $CPAN::META->catfile($dir,$_);
434 } elsif (-d _) {
435 push @entries, $CPAN::META->catdir($dir,$_);
436 } else {
437 print STDERR "Warning: weird direntry in $dir: $_\n";
438 }
439 }
440 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
441 sort { -M $b <=> -M $a} @entries;
442}
443
444#-> sub CPAN::CacheMgr::disk_usage ;
445sub disk_usage {
446 my($self,$dir) = @_;
447# if (! defined $dir or $dir eq "") {
448# $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
449# return;
450# }
451 return if $self->{SIZE}{$dir};
452 local($Du) = 0;
453 find(
454 sub {
455 return if -l $_;
456 $Du += -s _;
457 },
458 $dir
459 );
460 $self->{SIZE}{$dir} = $Du/1024/1024;
461 push @{$self->{FIFO}}, $dir;
462 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
463 $self->{DU} += $Du/1024/1024;
464 if ($self->{DU} > $self->{'MAX'} ) {
465 my($toremove) = shift @{$self->{FIFO}};
466 printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
467 $self->{DU}, $self->{'MAX'};
468 $self->force_clean_cache($toremove);
469 }
470 $self->{DU};
471}
472
473#-> sub CPAN::CacheMgr::force_clean_cache ;
474sub force_clean_cache {
475 my($self,$dir) = @_;
476 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
477 if $CPAN::DEBUG;
478 File::Path::rmtree($dir);
479 $self->{DU} -= $self->{SIZE}{$dir};
480 delete $self->{SIZE}{$dir};
481}
482
483#-> sub CPAN::CacheMgr::new ;
484sub new {
485 my $class = shift;
486 my $time = time;
487 my($debug,$t2);
488 $debug = "";
489 my $self = {
490 ID => $CPAN::Config->{'build_dir'},
491 MAX => $CPAN::Config->{'build_cache'},
492 DU => 0
493 };
494 File::Path::mkpath($self->{ID});
495 my $dh = DirHandle->new($self->{ID});
496 bless $self, $class;
497 $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
498 my $e;
499 for $e ($self->entries) {
500 next if $e eq ".." || $e eq ".";
501 $self->disk_usage($e);
502 }
503 $t2 = time;
504 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
505 $time = $t2;
506 CPAN->debug($debug) if $CPAN::DEBUG;
507 $self;
508}
509
510package CPAN::Debug;
511
512#-> sub CPAN::Debug::debug ;
513sub debug {
514 my($self,$arg) = @_;
515 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
516 # Complete, caller(1)
517 # eg readline
518 ($caller) = caller(0);
519 $caller =~ s/.*:://;
520# print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
521# print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
522 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
523 if (ref $arg) {
524 eval { require Data::Dumper };
525 if ($@) {
526 print $arg->as_string;
527 } else {
528 print Data::Dumper::Dumper($arg);
529 }
530 } else {
531 print "Debug($caller:$func,$line,@rest): $arg\n"
532 }
533 }
534}
535
536package CPAN::Config;
537import ExtUtils::MakeMaker 'neatvalue';
538use vars qw(%can);
539
540%can = (
541 'commit' => "Commit changes to disk",
542 'defaults' => "Reload defaults from disk",
543 'init' => "Interactive setting of all options",
544);
545
546#-> sub CPAN::Config::edit ;
547sub edit {
548 my($class,@args) = @_;
549 return unless @args;
550 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
551 my($o,$str,$func,$args,$key_exists);
552 $o = shift @args;
553 if($can{$o}) {
554 $class->$o(@args);
555 return 1;
556 } else {
557 if (ref($CPAN::Config->{$o}) eq ARRAY) {
558 $func = shift @args;
559 $func ||= "";
560 # Let's avoid eval, it's easier to comprehend without.
561 if ($func eq "push") {
562 push @{$CPAN::Config->{$o}}, @args;
563 } elsif ($func eq "pop") {
564 pop @{$CPAN::Config->{$o}};
565 } elsif ($func eq "shift") {
566 shift @{$CPAN::Config->{$o}};
567 } elsif ($func eq "unshift") {
568 unshift @{$CPAN::Config->{$o}}, @args;
569 } elsif ($func eq "splice") {
570 splice @{$CPAN::Config->{$o}}, @args;
571 } elsif (@args) {
572 $CPAN::Config->{$o} = [@args];
573 } else {
574 print(
575 " $o ",
576 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
577 "\n"
578 );
579 }
580 } else {
581 $CPAN::Config->{$o} = $args[0] if defined $args[0];
582 print " $o ";
583 print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
584 }
585 }
586}
587
588#-> sub CPAN::Config::commit ;
589sub commit {
590 my($self,$configpm) = @_;
591 unless (defined $configpm){
592 $configpm ||= $INC{"CPAN/MyConfig.pm"};
593 $configpm ||= $INC{"CPAN/Config.pm"};
594 $configpm || Carp::confess(qq{
595CPAN::Config::commit called without an argument.
596Please specify a filename where to save the configuration or try
597"o conf init" to have an interactive course through configing.
598});
599 }
600 my($mode);
601 if (-f $configpm) {
602 $mode = (stat $configpm)[2];
603 if ($mode && ! -w _) {
604 Carp::confess("$configpm is not writable");
605 }
606 }
607
608 my $msg = <<EOF unless $configpm =~ /MyConfig/;
609
610# This is CPAN.pm's systemwide configuration file. This file provides
611# defaults for users, and the values can be changed in a per-user configuration
612# file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
613
614EOF
615 $msg ||= "\n";
616 my($fh) = FileHandle->new;
617 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
618 print $fh qq[$msg\$CPAN::Config = \{\n];
619 foreach (sort keys %$CPAN::Config) {
620 $fh->print(
621 " '$_' => ",
622 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
623 ",\n"
624 );
625 }
626
627 print $fh "};\n1;\n__END__\n";
628 close $fh;
629
630 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
631 #chmod $mode, $configpm;
632###why was that so? $self->defaults;
633 print "commit: wrote $configpm\n";
634 1;
635}
636
637*default = \&defaults;
638#-> sub CPAN::Config::defaults ;
639sub defaults {
640 my($self) = @_;
641 $self->unload;
642 $self->load;
643 1;
644}
645
646sub init {
647 my($self) = @_;
648 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
649 # have the least
650 # important
651 # variable
652 # undefined
653 $self->load;
654 1;
655}
656
657my $dot_cpan;
658#-> sub CPAN::Config::load ;
659sub load {
660 my($self) = shift;
661 my(@miss);
662 eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems
663 unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
664 eval {require CPAN::MyConfig;}; # where you can override system wide settings
665 return unless @miss = $self->not_loaded;
666 require CPAN::FirstTime;
667 my($configpm,$fh,$redo);
668 $redo ||= "";
669 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
670 $configpm = $INC{"CPAN/Config.pm"};
671 $redo++;
672 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
673 $configpm = $INC{"CPAN/MyConfig.pm"};
674 $redo++;
675 } else {
676 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
677 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
678 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
679 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
680 if (-w $configpmtest) {
681 $configpm = $configpmtest;
682 } elsif (-w $configpmdir) {
683 #_#_# following code dumped core on me with 5.003_11, a.k.
684 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
685 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
686 my $fh = FileHandle->new;
687 if ($fh->open(">$configpmtest")) {
688 $fh->print("1;\n");
689 $configpm = $configpmtest;
690 } else {
691 # Should never happen
692 Carp::confess("Cannot open >$configpmtest");
693 }
694 }
695 }
696 unless ($configpm) {
697 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
698 File::Path::mkpath($configpmdir);
699 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
700 if (-w $configpmtest) {
701 $configpm = $configpmtest;
702 } elsif (-w $configpmdir) {
703 #_#_# following code dumped core on me with 5.003_11, a.k.
704 my $fh = FileHandle->new;
705 if ($fh->open(">$configpmtest")) {
706 $fh->print("1;\n");
707 $configpm = $configpmtest;
708 } else {
709 # Should never happen
710 Carp::confess("Cannot open >$configpmtest");
711 }
712 } else {
713 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
714 qq{create a configuration file.});
715 }
716 }
717 }
718 local($") = ", ";
719 print qq{
720We have to reconfigure CPAN.pm due to following uninitialized parameters:
721
722@miss
723} if $redo ;
724 print qq{
725$configpm initialized.
726};
727 sleep 2;
728 CPAN::FirstTime::init($configpm);
729}
730
731#-> sub CPAN::Config::not_loaded ;
732sub not_loaded {
733 my(@miss);
734 for (qw(
735 cpan_home keep_source_where build_dir build_cache index_expire
736 gzip tar unzip make pager makepl_arg make_arg make_install_arg
737 urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
738 )) {
739 push @miss, $_ unless defined $CPAN::Config->{$_};
740 }
741 return @miss;
742}
743
744#-> sub CPAN::Config::unload ;
745sub unload {
746 delete $INC{'CPAN/MyConfig.pm'};
747 delete $INC{'CPAN/Config.pm'};
748}
749
750*h = \&help;
751#-> sub CPAN::Config::help ;
752sub help {
753 print <<EOF;
754Known options:
755 defaults reload default config values from disk
756 commit commit session changes to disk
757 init go through a dialog to set all parameters
758
759You may edit key values in the follow fashion:
760
761 o conf build_cache 15
762
763 o conf build_dir "/foo/bar"
764
765 o conf urllist shift
766
767 o conf urllist unshift ftp://ftp.foo.bar/
768
769EOF
770 undef; #don't reprint CPAN::Config
771}
772
773#-> sub CPAN::Config::complete ;
774sub complete {
775 my($word,$line,$pos) = @_;
776 $word ||= "";
777 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
778 return grep /^\Q$word\E/, @o_conf;
779}
780
781package CPAN::Shell;
782use vars qw($AUTOLOAD $redef @ISA);
783@CPAN::Shell::ISA = qw(CPAN::Debug);
784if ($CPAN::META->hasWAIT) {
785 unshift @ISA, "CPAN::WAIT";
786}
787# private function ro re-eval this module (handy during development)
788#-> sub CPAN::Shell::AUTOLOAD ;
789sub AUTOLOAD {
790 my($autoload) = $AUTOLOAD;
791 $autoload =~ s/.*:://;
792 if ($autoload =~ /^w/) {
793 if ($CPAN::META->hasWAIT) {
794 CPAN::WAIT->wh;
795 return;
796 } else {
797 print STDERR qq{
798Commands starting with "w" require CPAN::WAIT to be installed.
799Please consider installing CPAN::WAIT to use the fulltext index.
800Type "install CPAN::WAIT" and restart CPAN.pm.
801}
802 }
803 } else {
804 warn "CPAN::Shell doesn't know how to autoload $autoload :-(
805Nothing Done.
806";
807 }
808 CPAN::Shell->h;
809}
810
811#-> sub CPAN::Shell::h ;
812sub h {
813 my($class,$about) = @_;
814 if (defined $about) {
815 print "Detailed help not yet implemented\n";
816 } else {
817 print q{
818command arguments description
819a string authors
820b or display bundles
821d /regex/ info distributions
822m or about modules
823i none anything of above
824
825r as reinstall recommendations
826u above uninstalled distributions
827See manpage for autobundle, recompile, force, look, etc.
828
829make make
830test modules, make test (implies make)
831install dists, bundles, make install (implies test)
832clean "r" or "u" make clean
833readme display the README file
834
835reload index|cpan load most recent indices/CPAN.pm
836h or ? display this menu
837o various set and query options
838! perl-code eval a perl command
839q quit the shell subroutine
840};
841 }
842}
843
844#-> sub CPAN::Shell::a ;
845sub a { print shift->format_result('Author',@_);}
846#-> sub CPAN::Shell::b ;
847sub b {
848 my($self,@which) = @_;
849 CPAN->debug("which[@which]") if $CPAN::DEBUG;
850 my($incdir,$bdir,$dh);
851 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
852 $bdir = $CPAN::META->catdir($incdir,"Bundle");
853 if ($dh = DirHandle->new($bdir)) { # may fail
854 my($entry);
855 for $entry ($dh->read) {
856 next if -d $CPAN::META->catdir($bdir,$entry);
857 next unless $entry =~ s/\.pm$//;
858 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
859 }
860 }
861 }
862 print $self->format_result('Bundle',@which);
863}
864#-> sub CPAN::Shell::d ;
865sub d { print shift->format_result('Distribution',@_);}
866#-> sub CPAN::Shell::m ;
867sub m { print shift->format_result('Module',@_);}
868
869#-> sub CPAN::Shell::i ;
870sub i {
871 my($self) = shift;
872 my(@args) = @_;
873 my(@type,$type,@m);
874 @type = qw/Author Bundle Distribution Module/;
875 @args = '/./' unless @args;
876 my(@result);
877 for $type (@type) {
878 push @result, $self->expand($type,@args);
879 }
880 my $result = @result == 1 ?
881 $result[0]->as_string :
882 join "", map {$_->as_glimpse} @result;
883 $result ||= "No objects found of any type for argument @args\n";
884 print $result;
885}
886
887#-> sub CPAN::Shell::o ;
888sub o {
889 my($self,$o_type,@o_what) = @_;
890 $o_type ||= "";
891 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
892 if ($o_type eq 'conf') {
893 shift @o_what if @o_what && $o_what[0] eq 'help';
894 if (!@o_what) {
895 my($k,$v);
896 print "CPAN::Config options:\n";
897 for $k (sort keys %CPAN::Config::can) {
898 $v = $CPAN::Config::can{$k};
899 printf " %-18s %s\n", $k, $v;
900 }
901 print "\n";
902 for $k (sort keys %$CPAN::Config) {
903 $v = $CPAN::Config->{$k};
904 if (ref $v) {
905 printf " %-18s\n", $k;
906 print map {"\t$_\n"} @{$v};
907 } else {
908 printf " %-18s %s\n", $k, $v;
909 }
910 }
911 print "\n";
912 } elsif (!CPAN::Config->edit(@o_what)) {
913 print qq[Type 'o conf' to view configuration edit options\n\n];
914 }
915 } elsif ($o_type eq 'debug') {
916 my(%valid);
917 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
918 if (@o_what) {
919 while (@o_what) {
920 my($what) = shift @o_what;
921 if ( exists $CPAN::DEBUG{$what} ) {
922 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
923 } elsif ($what =~ /^\d/) {
924 $CPAN::DEBUG = $what;
925 } elsif (lc $what eq 'all') {
926 my($max) = 0;
927 for (values %CPAN::DEBUG) {
928 $max += $_;
929 }
930 $CPAN::DEBUG = $max;
931 } else {
932 my($known) = 0;
933 for (keys %CPAN::DEBUG) {
934 next unless lc($_) eq lc($what);
935 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
936 $known = 1;
937 }
938 print "unknown argument [$what]\n" unless $known;
939 }
940 }
941 } else {
942 print "Valid options for debug are ".
943 join(", ",sort(keys %CPAN::DEBUG), 'all').
944 qq{ or a number. Completion works on the options. }.
945 qq{Case is ignored.\n\n};
946 }
947 if ($CPAN::DEBUG) {
948 print "Options set for debugging:\n";
949 my($k,$v);
950 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
951 $v = $CPAN::DEBUG{$k};
952 printf " %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
953 }
954 } else {
955 print "Debugging turned off completely.\n";
956 }
957 } else {
958 print qq{
959Known options:
960 conf set or get configuration variables
961 debug set or get debugging options
962};
963 }
964}
965
966#-> sub CPAN::Shell::reload ;
967sub reload {
968 my($self,$command,@arg) = @_;
969 $command ||= "";
970 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
971 if ($command =~ /cpan/i) {
972 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
973 my $fh = FileHandle->new($INC{'CPAN.pm'});
974 local($/);
975 undef $/;
976 $redef = 0;
977 local($SIG{__WARN__})
978 = sub {
979 if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
980 ++$redef;
981 local($|) = 1;
982 print ".";
983 return;
984 }
985 warn @_;
986 };
987 eval <$fh>;
988 warn $@ if $@;
989 print "\n$redef subroutines redefined\n";
990 } elsif ($command =~ /index/) {
991 CPAN::Index->force_reload;
992 } else {
993 print qq{cpan re-evals the CPAN.pm file\n};
994 print qq{index re-reads the index files\n};
995 }
996}
997
998#-> sub CPAN::Shell::_binary_extensions ;
999sub _binary_extensions {
1000 my($self) = shift @_;
1001 my(@result,$module,%seen,%need,$headerdone);
1002 for $module ($self->expand('Module','/./')) {
1003 my $file = $module->cpan_file;
1004 next if $file eq "N/A";
1005 next if $file =~ /^Contact Author/;
1006 next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
1007 next unless $module->xs_file;
1008 local($|) = 1;
1009 print ".";
1010 push @result, $module;
1011 }
1012# print join " | ", @result;
1013 print "\n";
1014 return @result;
1015}
1016
1017#-> sub CPAN::Shell::recompile ;
1018sub recompile {
1019 my($self) = shift @_;
1020 my($module,@module,$cpan_file,%dist);
1021 @module = $self->_binary_extensions();
1022 for $module (@module){ # we force now and compile later, so we don't do it twice
1023 $cpan_file = $module->cpan_file;
1024 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1025 $pack->force;
1026 $dist{$cpan_file}++;
1027 }
1028 for $cpan_file (sort keys %dist) {
1029 print " CPAN: Recompiling $cpan_file\n\n";
1030 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1031 $pack->install;
1032 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1033 # stop a package from recompiling,
1034 # e.g. IO-1.12 when we have perl5.003_10
1035 }
1036}
1037
1038#-> sub CPAN::Shell::_u_r_common ;
1039sub _u_r_common {
1040 my($self) = shift @_;
1041 my($what) = shift @_;
1042 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1043 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1044 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1045 my(@args) = @_;
1046 @args = '/./' unless @args;
1047 my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
1048 $version_zeroes = 0;
1049 my $sprintf = "%-25s %9s %9s %s\n";
1050 for $module ($self->expand('Module',@args)) {
1051 my $file = $module->cpan_file;
1052 next unless defined $file; # ??
1053 my($latest) = $module->cpan_version || 0;
1054 my($inst_file) = $module->inst_file;
1055 my($have);
1056 if ($inst_file){
1057 if ($what eq "a") {
1058 $have = $module->inst_version;
1059 } elsif ($what eq "r") {
1060 $have = $module->inst_version;
1061 local($^W) = 0;
1062 $version_zeroes++ unless $have;
1063 next if $have >= $latest;
1064 } elsif ($what eq "u") {
1065 next;
1066 }
1067 } else {
1068 if ($what eq "a") {
1069 next;
1070 } elsif ($what eq "r") {
1071 next;
1072 } elsif ($what eq "u") {
1073 $have = "-";
1074 }
1075 }
1076 return if $CPAN::Signal; # this is sometimes lengthy
1077 $seen{$file} ||= 0;
1078 if ($what eq "a") {
1079 push @result, sprintf "%s %s\n", $module->id, $have;
1080 } elsif ($what eq "r") {
1081 push @result, $module->id;
1082 next if $seen{$file}++;
1083 } elsif ($what eq "u") {
1084 push @result, $module->id;
1085 next if $seen{$file}++;
1086 next if $file =~ /^Contact/;
1087 }
1088 unless ($headerdone++){
1089 print "\n";
1090 printf(
1091 $sprintf,
1092 "Package namespace",
1093 "installed",
1094 "latest",
1095 "in CPAN file"
1096 );
1097 }
1098 $latest = substr($latest,0,8) if length($latest) > 8;
1099 $have = substr($have,0,8) if length($have) > 8;
1100 printf $sprintf, $module->id, $have, $latest, $file;
1101 $need{$module->id}++;
1102 }
1103 unless (%need) {
1104 if ($what eq "u") {
1105 print "No modules found for @args\n";
1106 } elsif ($what eq "r") {
1107 print "All modules are up to date for @args\n";
1108 }
1109 }
1110 if ($what eq "r" && $version_zeroes) {
1111 my $s = $version_zeroes > 1 ? "s have" : " has";
1112 print qq{$version_zeroes installed module$s no version number to compare\n};
1113 }
1114 @result;
1115}
1116
1117#-> sub CPAN::Shell::r ;
1118sub r {
1119 shift->_u_r_common("r",@_);
1120}
1121
1122#-> sub CPAN::Shell::u ;
1123sub u {
1124 shift->_u_r_common("u",@_);
1125}
1126
1127#-> sub CPAN::Shell::autobundle ;
1128sub autobundle {
1129 my($self) = shift;
1130 my(@bundle) = $self->_u_r_common("a",@_);
1131 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1132 File::Path::mkpath($todir);
1133 unless (-d $todir) {
1134 print "Couldn't mkdir $todir for some reason\n";
1135 return;
1136 }
1137 my($y,$m,$d) = (localtime)[5,4,3];
1138 $y+=1900;
1139 $m++;
1140 my($c) = 0;
1141 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1142 my($to) = $CPAN::META->catfile($todir,"$me.pm");
1143 while (-f $to) {
1144 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1145 $to = $CPAN::META->catfile($todir,"$me.pm");
1146 }
1147 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1148 $fh->print(
1149 "package Bundle::$me;\n\n",
1150 "\$VERSION = '0.01';\n\n",
1151 "1;\n\n",
1152 "__END__\n\n",
1153 "=head1 NAME\n\n",
1154 "Bundle::$me - Snapshot of installation on ",
1155 $Config::Config{'myhostname'},
1156 " on ",
1157 scalar(localtime),
1158 "\n\n=head1 SYNOPSIS\n\n",
1159 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1160 "=head1 CONTENTS\n\n",
1161 join("\n", @bundle),
1162 "\n\n=head1 CONFIGURATION\n\n",
1163 Config->myconfig,
1164 "\n\n=head1 AUTHOR\n\n",
1165 "This Bundle has been generated automatically ",
1166 "by the autobundle routine in CPAN.pm.\n",
1167 );
1168 $fh->close;
1169 print "\nWrote bundle file
1170 $to\n\n";
1171}
1172
1173#-> sub CPAN::Shell::expand ;
1174sub expand {
1175 shift;
1176 my($type,@args) = @_;
1177 my($arg,@m);
1178 for $arg (@args) {
1179 my $regex;
1180 if ($arg =~ m|^/(.*)/$|) {
1181 $regex = $1;
1182 }
1183 my $class = "CPAN::$type";
1184 my $obj;
1185 if (defined $regex) {
1186 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
1187 push @m, $obj
1188 if
1189 $obj->id =~ /$regex/i
1190 or
1191 (
1192 (
1193 $] < 5.00303 ### provide sort of compatibility with 5.003
1194 ||
1195 $obj->can('name')
1196 )
1197 &&
1198 $obj->name =~ /$regex/i
1199 );
1200 }
1201 } else {
1202 my($xarg) = $arg;
1203 if ( $type eq 'Bundle' ) {
1204 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1205 }
1206 if ($CPAN::META->exists($class,$xarg)) {
1207 $obj = $CPAN::META->instance($class,$xarg);
1208 } elsif ($CPAN::META->exists($class,$arg)) {
1209 $obj = $CPAN::META->instance($class,$arg);
1210 } else {
1211 next;
1212 }
1213 push @m, $obj;
1214 }
1215 }
1216 return wantarray ? @m : $m[0];
1217}
1218
1219#-> sub CPAN::Shell::format_result ;
1220sub format_result {
1221 my($self) = shift;
1222 my($type,@args) = @_;
1223 @args = '/./' unless @args;
1224 my(@result) = $self->expand($type,@args);
1225 my $result = @result == 1 ?
1226 $result[0]->as_string :
1227 join "", map {$_->as_glimpse} @result;
1228 $result ||= "No objects of type $type found for argument @args\n";
1229 $result;
1230}
1231
1232#-> sub CPAN::Shell::rematein ;
1233sub rematein {
1234 shift;
1235 my($meth,@some) = @_;
1236 my $pragma = "";
1237 if ($meth eq 'force') {
1238 $pragma = $meth;
1239 $meth = shift @some;
1240 }
1241 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1242 my($s,@s);
1243 foreach $s (@some) {
1244 my $obj;
1245 if (ref $s) {
1246 $obj = $s;
1247 } elsif ($s =~ m|/|) { # looks like a file
1248 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1249 } elsif ($s =~ m|^Bundle::|) {
1250 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1251 } else {
1252 $obj = $CPAN::META->instance('CPAN::Module',$s)
1253 if $CPAN::META->exists('CPAN::Module',$s);
1254 }
1255 if (ref $obj) {
1256 CPAN->debug(
1257 qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
1258 $obj->as_string.
1259 qq{\]}
1260 ) if $CPAN::DEBUG;
1261 $obj->$pragma()
1262 if
1263 $pragma
1264 &&
1265 ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
1266 $obj->$meth();
1267 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1268 $obj = $CPAN::META->instance('CPAN::Author',$s);
1269 print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
1270 } else {
1271 print qq{Warning: Cannot $meth $s, don\'t know what it is.
1272Try the command
1273
1274 i /$s/
1275
1276to find objects with similar identifiers.
1277};
1278 }
1279 }
1280}
1281
1282#-> sub CPAN::Shell::force ;
1283sub force { shift->rematein('force',@_); }
1284#-> sub CPAN::Shell::get ;
1285sub get { shift->rematein('get',@_); }
1286#-> sub CPAN::Shell::readme ;
1287sub readme { shift->rematein('readme',@_); }
1288#-> sub CPAN::Shell::make ;
1289sub make { shift->rematein('make',@_); }
1290#-> sub CPAN::Shell::test ;
1291sub test { shift->rematein('test',@_); }
1292#-> sub CPAN::Shell::install ;
1293sub install { shift->rematein('install',@_); }
1294#-> sub CPAN::Shell::clean ;
1295sub clean { shift->rematein('clean',@_); }
1296#-> sub CPAN::Shell::look ;
1297sub look { shift->rematein('look',@_); }
1298
1299package CPAN::FTP;
1300use vars qw($Ua);
1301@CPAN::FTP::ISA = qw(CPAN::Debug);
1302
1303#-> sub CPAN::FTP::ftp_get ;
1304sub ftp_get {
1305 my($class,$host,$dir,$file,$target) = @_;
1306 $class->debug(
1307 qq[Going to fetch file [$file] from dir [$dir]
1308 on host [$host] as local [$target]\n]
1309 ) if $CPAN::DEBUG;
1310 my $ftp = Net::FTP->new($host);
1311 return 0 unless defined $ftp;
1312 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1313 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1314 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1315 warn "Couldn't login on $host";
1316 return;
1317 }
1318 # print qq[Going to ->cwd("$dir")\n];
1319 unless ( $ftp->cwd($dir) ){
1320 warn "Couldn't cwd $dir";
1321 return;
1322 }
1323 $ftp->binary;
1324 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1325 unless ( $ftp->get($file,$target) ){
1326 warn "Couldn't fetch $file from $host\n";
1327 return;
1328 }
1329 $ftp->quit; # it's ok if this fails
1330 return 1;
1331}
1332
1333#-> sub CPAN::FTP::localize ;
1334sub localize {
1335 my($self,$file,$aslocal,$force) = @_;
1336 $force ||= 0;
1337 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1338 unless defined $aslocal;
1339 $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
1340
1341 return $aslocal if -f $aslocal && -r _ && ! $force;
1342 rename $aslocal, "$aslocal.bak" if -f $aslocal;
1343
1344 my($aslocal_dir) = File::Basename::dirname($aslocal);
1345 File::Path::mkpath($aslocal_dir);
1346 print STDERR qq{Warning: You are not allowed to write into }.
1347 qq{directory "$aslocal_dir".
1348 I\'ll continue, but if you face any problems, they may be due
1349 to insufficient permissions.\n} unless -w $aslocal_dir;
1350
1351 # Inheritance is not easier to manage than a few if/else branches
1352 if ($CPAN::META->hasLWP) {
1353 require LWP::UserAgent;
1354 unless ($Ua) {
1355 $Ua = new LWP::UserAgent;
1356 my($var);
1357 $Ua->proxy('ftp', $var)
1358 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1359 $Ua->proxy('http', $var)
1360 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1361 $Ua->no_proxy($var)
1362 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1363 }
1364 }
1365
1366 # Try the list of urls for each single object. We keep a record
1367 # where we did get a file from
1368 my($i);
1369 for $i (0..$#{$CPAN::Config->{urllist}}) {
1370 my $url = $CPAN::Config->{urllist}[$i];
1371 $url .= "/" unless substr($url,-1) eq "/";
1372 $url .= $file;
1373 $self->debug("localizing[$url]") if $CPAN::DEBUG;
1374 if ($url =~ /^file:/) {
1375 my $l;
1376 if ($CPAN::META->hasLWP) {
1377 require URI::URL;
1378 my $u = new URI::URL $url;
1379 $l = $u->path;
1380 } else { # works only on Unix, is poorly constructed, but
1381 # hopefully better than nothing.
1382 # RFC 1738 says fileurl BNF is
1383 # fileurl = "file://" [ host | "localhost" ] "/" fpath
1384 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
1385 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
1386 $l =~ s/^file://; # assume they meant file://localhost
1387 }
1388 return $l if -f $l && -r _;
1389 # Maybe mirror has compressed it?
1390 if (-f "$l.gz") {
1391 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
1392 system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
1393 return $aslocal if -f $aslocal;
1394 }
1395 }
1396
1397 if ($CPAN::META->hasLWP) {
1398 print "Fetching $url with LWP\n";
1399 my $res = $Ua->mirror($url, $aslocal);
1400 if ($res->is_success) {
1401 return $aslocal;
1402 }
1403 }
1404 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1405 # that's the nice and easy way thanks to Graham
1406 my($host,$dir,$getfile) = ($1,$2,$3);
1407 if ($CPAN::META->hasFTP) {
1408 $dir =~ s|/+|/|g;
1409 $self->debug("Going to fetch file [$getfile]
1410 from dir [$dir]
1411 on host [$host]
1412 as local [$aslocal]") if $CPAN::DEBUG;
1413 CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
1414 warn "Net::FTP failed for some reason\n";
1415 } else {
1416 warn qq{
1417 Please, install Net::FTP as soon as possible. Just type
1418 install Net::FTP
1419 Thank you.
1420
1421}
1422 }
1423 }
1424
1425 # Came back if Net::FTP couldn't establish connection (or failed otherwise)
1426 # Maybe they are behind a firewall, but they gave us
1427 # a socksified (or other) ftp program...
1428
1429 my($funkyftp);
1430 # does ncftp handle http?
1431 for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
1432 next unless defined $funkyftp;
1433 next unless -x $funkyftp;
1434 my($want_compressed);
1435 print(
1436 qq{
1437Trying with $funkyftp to get
1438 $url
1439});
1440 $want_compressed = $aslocal =~ s/\.gz//;
1441 my($source_switch) = "";
1442 $source_switch = "-source" if $funkyftp =~ /\blynx$/;
1443 my($system) = "$funkyftp $source_switch '$url' > $aslocal";
1444 my($wstatus);
1445 if (($wstatus = system($system)) == 0) {
1446 if ($want_compressed) {
1447 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1448 if (system($system) == 0) {
1449 rename $aslocal, "$aslocal.gz";
1450 } else {
1451 $system = "$CPAN::Config->{'gzip'} $aslocal";
1452 system($system);
1453 }
1454 return "$aslocal.gz";
1455 } else {
1456 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1457 if (system($system) == 0) {
1458 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
1459 system($system);
1460 } else {
1461 # should be fine, eh?
1462 }
1463 return $aslocal;
1464 }
1465 } else {
1466 my $estatus = $wstatus >> 8;
1467 print qq{
1468System call "$system"
1469returned status $estatus (wstat $wstatus)
1470};
1471 }
1472 }
1473
1474 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1475 my($host,$dir,$getfile) = ($1,$2,$3);
1476 my($netrcfile,$fh);
1477 if (-x $CPAN::Config->{'ftp'}) {
1478 my $timestamp = 0;
1479 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
1480 $ctime,$blksize,$blocks) = stat($aslocal);
1481 $timestamp = $mtime ||= 0;
1482
1483 my($netrc) = CPAN::FTP::netrc->new;
1484 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
1485
1486 my $targetfile = File::Basename::basename($aslocal);
1487 my(@dialog);
1488 push(
1489 @dialog,
1490 "lcd $aslocal_dir",
1491 "cd /",
1492 map("cd $_", split "/", $dir), # RFC 1738
1493 "bin",
1494 "get $getfile $targetfile",
1495 "quit"
1496 );
1497 if (! $netrc->netrc) {
1498 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
1499 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
1500 CPAN->debug(
1501 sprint(
1502 "hasdef[%d]cont($host)[%d]",
1503 $netrc->hasdefault,
1504 $netrc->contains($host)
1505 )
1506 ) if $CPAN::DEBUG;
1507 if ($netrc->protected) {
1508 print(
1509 qq{
1510 Trying with external ftp to get
1511 $url
1512 As this requires some features that are not thoroughly tested, we\'re
1513 not sure, that we get it right....
1514
1515}
1516 );
1517 my $fh = FileHandle->new;
1518 $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
1519 or die "Couldn't open ftp: $!";
1520 # pilot is blind now
1521 CPAN->debug("dialog [".(join "|",@dialog)."]")
1522 if $CPAN::DEBUG;
1523 foreach (@dialog) { $fh->print("$_\n") }
1524 $fh->close; # Wait for process to complete
1525 my $wstatus = $?;
1526 my $estatus = $wstatus >> 8;
1527 print qq{
1528Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
1529 returned status $estatus (wstat $wstatus)
1530} if $wstatus;
1531 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1532 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1533 $mtime ||= 0;
1534 if ($mtime > $timestamp) {
1535 print "GOT $aslocal\n";
1536 return $aslocal;
1537 } else {
1538 print "Hmm... Still failed!\n";
1539 }
1540 } else {
1541 warn "Your $netrcfile is not correctly protected.\n";
1542 }
1543 } else {
1544 warn "Your ~/.netrc neither contains $host
1545 nor does it have a default entry\n";
1546 }
1547
1548 # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
1549 # login manually to host, using e-mail as password.
1550 print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
1551 unshift(
1552 @dialog,
1553 "open $host",
1554 "user anonymous $Config::Config{'cf_email'}"
1555 );
1556 CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
1557 $fh = FileHandle->new;
1558 $fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
1559 die "Cannot fork: $!\n";
1560 foreach (@dialog) { $fh->print("$_\n") }
1561 $fh->close;
1562 my $wstatus = $?;
1563 my $estatus = $wstatus >> 8;
1564 print qq{
1565Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
1566 returned status $estatus (wstat $wstatus)
1567} if $wstatus;
1568 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1569 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1570 $mtime ||= 0;
1571 if ($mtime > $timestamp) {
1572 print "GOT $aslocal\n";
1573 return $aslocal;
1574 } else {
1575 print "Bad luck... Still failed!\n";
1576 }
1577 }
1578 sleep 2;
1579 }
1580
1581 print "Can't access URL $url.\n\n";
1582 my(@mess,$mess);
1583 push @mess, "LWP" unless CPAN->hasLWP;
1584 push @mess, "Net::FTP" unless CPAN->hasFTP;
1585 my($ext);
1586 for $ext (qw/lynx ncftp ftp/) {
1587 $CPAN::Config->{$ext} ||= "";
1588 push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
1589 }
1590 $mess = qq{Either get }.
1591 join(" or ",@mess).
1592 qq{ or check, if the URL found in your configuration file, }.
1593 $CPAN::Config->{urllist}[$i].
1594 qq{, is valid.};
1595 print Text::Wrap::wrap("","",$mess), "\n";
1596 }
1597 print "Cannot fetch $file\n";
1598 if (-f "$aslocal.bak") {
1599 rename "$aslocal.bak", $aslocal;
1600 print "Trying to get away with old file:\n";
1601 print $self->ls($aslocal);
1602 return $aslocal;
1603 }
1604 return;
1605}
1606
1607# find2perl needs modularization, too, all the following is stolen
1608# from there
1609sub ls {
1610 my($self,$name) = @_;
1611 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
1612 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
1613
1614 my($perms,%user,%group);
1615 my $pname = $name;
1616
1617 if (defined $blocks) {
1618 $blocks = int(($blocks + 1) / 2);
1619 }
1620 else {
1621 $blocks = int(($sizemm + 1023) / 1024);
1622 }
1623
1624 if (-f _) { $perms = '-'; }
1625 elsif (-d _) { $perms = 'd'; }
1626 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
1627 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
1628 elsif (-p _) { $perms = 'p'; }
1629 elsif (-S _) { $perms = 's'; }
1630 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
1631
1632 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
1633 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
1634 my $tmpmode = $mode;
1635 my $tmp = $rwx[$tmpmode & 7];
1636 $tmpmode >>= 3;
1637 $tmp = $rwx[$tmpmode & 7] . $tmp;
1638 $tmpmode >>= 3;
1639 $tmp = $rwx[$tmpmode & 7] . $tmp;
1640 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
1641 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
1642 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
1643 $perms .= $tmp;
1644
1645 my $user = $user{$uid} || $uid; # too lazy to implement lookup
1646 my $group = $group{$gid} || $gid;
1647
1648 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
1649 my($timeyear);
1650 my($moname) = $moname[$mon];
1651 if (-M _ > 365.25 / 2) {
1652 $timeyear = $year + 1900;
1653 }
1654 else {
1655 $timeyear = sprintf("%02d:%02d", $hour, $min);
1656 }
1657
1658 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
1659 $ino,
1660 $blocks,
1661 $perms,
1662 $nlink,
1663 $user,
1664 $group,
1665 $sizemm,
1666 $moname,
1667 $mday,
1668 $timeyear,
1669 $pname;
1670}
1671
1672package CPAN::FTP::netrc;
1673
1674sub new {
1675 my($class) = @_;
1676 my $file = MM->catfile($ENV{HOME},".netrc");
1677
1678 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1679 $atime,$mtime,$ctime,$blksize,$blocks)
1680 = stat($file);
1681 $mode ||= 0;
1682 my $protected = 0;
1683
1684 my($fh,@machines,$hasdefault);
1685 $hasdefault = 0;
1686 $fh = FileHandle->new or die "Could not create a filehandle";
1687
1688 if($fh->open($file)){
1689 $protected = ($mode & 077) == 0;
1690 local($/) = "";
1691 NETRC: while (<$fh>) {
1692 my(@tokens) = split " ", $_;
1693 TOKEN: while (@tokens) {
1694 my($t) = shift @tokens;
1695 if ($t eq "default"){
1696 $hasdefault++;
1697 # warn "saw a default entry before tokens[@tokens]";
1698 last NETRC;
1699 }
1700 last TOKEN if $t eq "macdef";
1701 if ($t eq "machine") {
1702 push @machines, shift @tokens;
1703 }
1704 }
1705 }
1706 } else {
1707 $file = $hasdefault = $protected = "";
1708 }
1709
1710 bless {
1711 'mach' => [@machines],
1712 'netrc' => $file,
1713 'hasdefault' => $hasdefault,
1714 'protected' => $protected,
1715 }, $class;
1716}
1717
1718sub hasdefault { shift->{'hasdefault'} }
1719sub netrc { shift->{'netrc'} }
1720sub protected { shift->{'protected'} }
1721sub contains {
1722 my($self,$mach) = @_;
1723 for ( @{$self->{'mach'}} ) {
1724 return 1 if $_ eq $mach;
1725 }
1726 return 0;
1727}
1728
1729package CPAN::Complete;
1730@CPAN::Complete::ISA = qw(CPAN::Debug);
1731
1732#-> sub CPAN::Complete::complete ;
1733sub complete {
1734 my($word,$line,$pos) = @_;
1735 $word ||= "";
1736 $line ||= "";
1737 $pos ||= 0;
1738 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1739 $line =~ s/^\s*//;
1740 if ($line =~ s/^(force\s*)//) {
1741 $pos -= length($1);
1742 }
1743 my @return;
1744 if ($pos == 0) {
1745 @return = grep(
1746 /^$word/,
1747 sort qw(
1748 ! a b d h i m o q r u autobundle clean
1749 make test install force reload look
1750 )
1751 );
1752 } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
1753 @return = ();
1754 } elsif ($line =~ /^a\s/) {
1755 @return = completex('CPAN::Author',$word);
1756 } elsif ($line =~ /^b\s/) {
1757 @return = completex('CPAN::Bundle',$word);
1758 } elsif ($line =~ /^d\s/) {
1759 @return = completex('CPAN::Distribution',$word);
1760 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
1761 @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
1762 } elsif ($line =~ /^i\s/) {
1763 @return = complete_any($word);
1764 } elsif ($line =~ /^reload\s/) {
1765 @return = complete_reload($word,$line,$pos);
1766 } elsif ($line =~ /^o\s/) {
1767 @return = complete_option($word,$line,$pos);
1768 } else {
1769 @return = ();
1770 }
1771 return @return;
1772}
1773
1774#-> sub CPAN::Complete::completex ;
1775sub completex {
1776 my($class, $word) = @_;
1777 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1778}
1779
1780#-> sub CPAN::Complete::complete_any ;
1781sub complete_any {
1782 my($word) = shift;
1783 return (
1784 completex('CPAN::Author',$word),
1785 completex('CPAN::Bundle',$word),
1786 completex('CPAN::Distribution',$word),
1787 completex('CPAN::Module',$word),
1788 );
1789}
1790
1791#-> sub CPAN::Complete::complete_reload ;
1792sub complete_reload {
1793 my($word,$line,$pos) = @_;
1794 $word ||= "";
1795 my(@words) = split " ", $line;
1796 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1797 my(@ok) = qw(cpan index);
1798 return @ok if @words == 1;
1799 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
1800}
1801
1802#-> sub CPAN::Complete::complete_option ;
1803sub complete_option {
1804 my($word,$line,$pos) = @_;
1805 $word ||= "";
1806 my(@words) = split " ", $line;
1807 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1808 my(@ok) = qw(conf debug);
1809 return @ok if @words == 1;
1810 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
1811 if (0) {
1812 } elsif ($words[1] eq 'index') {
1813 return ();
1814 } elsif ($words[1] eq 'conf') {
1815 return CPAN::Config::complete(@_);
1816 } elsif ($words[1] eq 'debug') {
1817 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1818 }
1819}
1820
1821package CPAN::Index;
1822use vars qw($last_time $date_of_03);
1823@CPAN::Index::ISA = qw(CPAN::Debug);
1824$last_time ||= 0;
1825$date_of_03 ||= 0;
1826
1827#-> sub CPAN::Index::force_reload ;
1828sub force_reload {
1829 my($class) = @_;
1830 $CPAN::Index::last_time = 0;
1831 $class->reload(1);
1832}
1833
1834#-> sub CPAN::Index::reload ;
1835sub reload {
1836 my($cl,$force) = @_;
1837 my $time = time;
1838
1839 # XXX check if a newer one is available. (We currently read it from time to time)
1840 for ($CPAN::Config->{index_expire}) {
1841 $_ = 0.001 unless $_ > 0.001;
1842 }
1843 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1844 my($debug,$t2);
1845 $last_time = $time;
1846
1847 $cl->read_authindex($cl->reload_x(
1848 "authors/01mailrc.txt.gz",
1849 "01mailrc.gz",
1850 $force));
1851 $t2 = time;
1852 $debug = "timing reading 01[".($t2 - $time)."]";
1853 $time = $t2;
1854 return if $CPAN::Signal; # this is sometimes lengthy
1855 $cl->read_modpacks($cl->reload_x(
1856 "modules/02packages.details.txt.gz",
1857 "02packag.gz",
1858 $force));
1859 $t2 = time;
1860 $debug .= "02[".($t2 - $time)."]";
1861 $time = $t2;
1862 return if $CPAN::Signal; # this is sometimes lengthy
1863 $cl->read_modlist($cl->reload_x(
1864 "modules/03modlist.data.gz",
1865 "03mlist.gz",
1866 $force));
1867 $t2 = time;
1868 $debug .= "03[".($t2 - $time)."]";
1869 $time = $t2;
1870 CPAN->debug($debug) if $CPAN::DEBUG;
1871}
1872
1873#-> sub CPAN::Index::reload_x ;
1874sub reload_x {
1875 my($cl,$wanted,$localname,$force) = @_;
1876 $force ||= 0;
1877 CPAN::Config->load; # we should guarantee loading wherever we rely on Config XXX
1878 my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
1879 if (
1880 -f $abs_wanted &&
1881 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
1882 !$force
1883 ) {
1884 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
1885 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
1886 qq{day$s. I\'ll use that.});
1887 return $abs_wanted;
1888 } else {
1889 $force ||= 1;
1890 }
1891 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1892}
1893
1894#-> sub CPAN::Index::read_authindex ;
1895sub read_authindex {
1896 my($cl,$index_target) = @_;
1897 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1898 print "Going to read $index_target\n";
1899 my $fh = FileHandle->new("$pipe|");
1900 while (<$fh>) {
1901 chomp;
1902 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1903 next unless $userid && $fullname && $email;
1904
1905 # instantiate an author object
1906 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
1907 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
1908 return if $CPAN::Signal;
1909 }
1910 $fh->close;
1911 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1912}
1913
1914#-> sub CPAN::Index::read_modpacks ;
1915sub read_modpacks {
1916 my($cl,$index_target) = @_;
1917 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1918 print "Going to read $index_target\n";
1919 my $fh = FileHandle->new("$pipe|");
1920 while (<$fh>) {
1921 last if /^\s*$/;
1922 }
1923 while (<$fh>) {
1924 chomp;
1925 my($mod,$version,$dist) = split;
1926### $version =~ s/^\+//;
1927
1928 # if it as a bundle, instatiate a bundle object
1929 my($bundle,$id,$userid);
1930
1931 if ($mod eq 'CPAN') {
1932 local($^W)= 0;
1933 if ($version > $CPAN::VERSION){
1934 print qq{
1935 There\'s a new CPAN.pm version (v$version) available!
1936 You might want to try
1937 install CPAN
1938 reload cpan
1939 without quitting the current session. It should be a seemless upgrade
1940 while we are running...
1941};
1942 sleep 2;
1943 print qq{\n};
1944 }
1945 last if $CPAN::Signal;
1946 } elsif ($mod =~ /^Bundle::(.*)/) {
1947 $bundle = $1;
1948 }
1949
1950 if ($bundle){
1951 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
1952### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1953# This "next" makes us faster but if the job is running long, we ignore
1954# rereads which is bad. So we have to be a bit slower again.
1955# } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
1956# next;
1957 } else {
1958 # instantiate a module object
1959 $id = $CPAN::META->instance('CPAN::Module',$mod);
1960### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
1961### if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
1962 }
1963
1964 if ($id->cpan_file ne $dist){
1965 # determine the author
1966 ($userid) = $dist =~ /([^\/]+)/;
1967 $id->set(
1968 'CPAN_USERID' => $userid,
1969 'CPAN_VERSION' => $version,
1970 'CPAN_FILE' => $dist
1971 );
1972 }
1973
1974 # instantiate a distribution object
1975 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1976 $CPAN::META->instance(
1977 'CPAN::Distribution' => $dist
1978 )->set(
1979 'CPAN_USERID' => $userid
1980 );
1981 }
1982
1983 return if $CPAN::Signal;
1984 }
1985 $fh->close;
1986 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1987}
1988
1989#-> sub CPAN::Index::read_modlist ;
1990sub read_modlist {
1991 my($cl,$index_target) = @_;
1992 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1993 print "Going to read $index_target\n";
1994 my $fh = FileHandle->new("$pipe|");
1995 my $eval;
1996 while (<$fh>) {
1997 if (/^Date:\s+(.*)/){
1998 return if $date_of_03 eq $1;
1999 ($date_of_03) = $1;
2000 }
2001 last if /^\s*$/;
2002 }
2003 local($/) = undef;
2004 $eval = <$fh>;
2005 $fh->close;
2006 $eval .= q{CPAN::Modulelist->data;};
2007 local($^W) = 0;
2008 my($comp) = Safe->new("CPAN::Safe1");
2009 my $ret = $comp->reval($eval);
2010 Carp::confess($@) if $@;
2011 return if $CPAN::Signal;
2012 for (keys %$ret) {
2013 my $obj = $CPAN::META->instance(CPAN::Module,$_);
2014 $obj->set(%{$ret->{$_}});
2015 return if $CPAN::Signal;
2016 }
2017}
2018
2019package CPAN::InfoObj;
2020@CPAN::InfoObj::ISA = qw(CPAN::Debug);
2021
2022#-> sub CPAN::InfoObj::new ;
2023sub new { my $this = bless {}, shift; %$this = @_; $this }
2024
2025#-> sub CPAN::InfoObj::set ;
2026sub set {
2027 my($self,%att) = @_;
2028 my(%oldatt) = %$self;
2029 %$self = (%oldatt, %att);
2030}
2031
2032#-> sub CPAN::InfoObj::id ;
2033sub id { shift->{'ID'} }
2034
2035#-> sub CPAN::InfoObj::as_glimpse ;
2036sub as_glimpse {
2037 my($self) = @_;
2038 my(@m);
2039 my $class = ref($self);
2040 $class =~ s/^CPAN:://;
2041 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2042 join "", @m;
2043}
2044
2045#-> sub CPAN::InfoObj::as_string ;
2046sub as_string {
2047 my($self) = @_;
2048 my(@m);
2049 my $class = ref($self);
2050 $class =~ s/^CPAN:://;
2051 push @m, $class, " id = $self->{ID}\n";
2052 for (sort keys %$self) {
2053 next if $_ eq 'ID';
2054 my $extra = "";
2055 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
2056 if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
2057 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2058 } else {
2059 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
2060 }
2061 }
2062 join "", @m, "\n";
2063}
2064
2065#-> sub CPAN::InfoObj::author ;
2066sub author {
2067 my($self) = @_;
2068 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2069}
2070
2071package CPAN::Author;
2072@CPAN::Author::ISA = qw(CPAN::InfoObj);
2073
2074#-> sub CPAN::Author::as_glimpse ;
2075sub as_glimpse {
2076 my($self) = @_;
2077 my(@m);
2078 my $class = ref($self);
2079 $class =~ s/^CPAN:://;
2080 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2081 join "", @m;
2082}
2083
2084# Dead code, I would have liked to have,,, but it was never reached,,,
2085#sub make {
2086# my($self) = @_;
2087# return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
2088#}
2089
2090#-> sub CPAN::Author::fullname ;
2091sub fullname { shift->{'FULLNAME'} }
2092*name = \&fullname;
2093#-> sub CPAN::Author::email ;
2094sub email { shift->{'EMAIL'} }
2095
2096package CPAN::Distribution;
2097@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
2098
2099#-> sub CPAN::Distribution::called_for ;
2100sub called_for {
2101 my($self,$id) = @_;
2102 $self->{'CALLED_FOR'} = $id if defined $id;
2103 return $self->{'CALLED_FOR'};
2104}
2105
2106#-> sub CPAN::Distribution::get ;
2107sub get {
2108 my($self) = @_;
2109 EXCUSE: {
2110 my @e;
2111 exists $self->{'build_dir'} and push @e,
2112 "Unwrapped into directory $self->{'build_dir'}";
2113 print join "", map {" $_\n"} @e and return if @e;
2114 }
2115 my($local_file);
2116 my($local_wanted) =
2117 CPAN->catfile(
2118 $CPAN::Config->{keep_source_where},
2119 "authors",
2120 "id",
2121 split("/",$self->{ID})
2122 );
2123
2124 $self->debug("Doing localize") if $CPAN::DEBUG;
2125 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
2126 $self->{localfile} = $local_file;
2127 my $builddir = $CPAN::META->{cachemgr}->dir;
2128 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2129 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2130 my $packagedir;
2131
2132 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2133 if ($CPAN::META->hasMD5) {
2134 $self->verifyMD5;
2135 }
2136 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
2137 $self->debug("Removing tmp") if $CPAN::DEBUG;
2138 File::Path::rmtree("tmp");
2139 mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
2140 chdir "tmp";
2141 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2142 if ($local_file =~ /z$/i){
2143 $self->{archived} = "tar";
2144 if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")== 0) {
2145 $self->{unwrapped} = "YES";
2146 } else {
2147 $self->{unwrapped} = "NO";
2148 }
2149 } elsif ($local_file =~ /zip$/i) {
2150 $self->{archived} = "zip";
2151 if (system("$CPAN::Config->{unzip} $local_file") == 0) {
2152 $self->{unwrapped} = "YES";
2153 } else {
2154 $self->{unwrapped} = "NO";
2155 }
2156 }
2157 # Let's check if the package has its own directory.
2158 opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
2159 my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
2160 closedir DIR;
2161 my ($distdir,$packagedir);
2162 if (@readdir == 1 && -d $readdir[0]) {
2163 $distdir = $readdir[0];
2164 $packagedir = $CPAN::META->catdir($builddir,$distdir);
2165 -d $packagedir and print "Removing previously used $packagedir\n";
2166 File::Path::rmtree($packagedir);
2167 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2168 } else {
2169 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2170 $pragmatic_dir =~ s/\W_//g;
2171 $pragmatic_dir++ while -d "../$pragmatic_dir";
2172 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
2173 File::Path::mkpath($packagedir);
2174 my($f);
2175 for $f (@readdir) { # is already without "." and ".."
2176 my $to = $CPAN::META->catdir($packagedir,$f);
2177 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2178 }
2179 }
2180 $self->{'build_dir'} = $packagedir;
2181
2182 chdir "..";
2183 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
2184 if $CPAN::DEBUG;
2185 File::Path::rmtree("tmp");
2186 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
2187 print "Going to unlink $local_file\n";
2188 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
2189 }
2190 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
2191 unless (-f $makefilepl) {
2192 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
2193 if (-f $configure) {
2194 # do we have anything to do?
2195 $self->{'configure'} = $configure;
2196 } else {
2197 my $fh = FileHandle->new(">$makefilepl")
2198 or Carp::croak("Could not open >$makefilepl");
2199 my $cf = $self->called_for || "unknown";
2200 $fh->print(qq{
2201# This Makefile.PL has been autogenerated by the module CPAN.pm
2202# Autogenerated on: }.scalar localtime().qq{
2203 use ExtUtils::MakeMaker;
2204 WriteMakefile(NAME => q[$cf]);
2205});
2206 print qq{Package comes without Makefile.PL.\n}.
2207 qq{ Writing one on our own (calling it $cf)\n};
2208 }
2209 }
2210 } else {
2211 $self->{archived} = "NO";
2212 }
2213 return $self;
2214}
2215
2216#-> sub CPAN::Distribution::new ;
2217sub new {
2218 my($class,%att) = @_;
2219
2220 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
2221
2222 my $this = { %att };
2223 return bless $this, $class;
2224}
2225
2226#-> sub CPAN::Distribution::look ;
2227sub look {
2228 my($self) = @_;
2229 if ( $CPAN::Config->{'shell'} ) {
2230 print qq{
2231Trying to open a subshell in the build directory...
2232};
2233 } else {
2234 print qq{
2235Your configuration does not define a value for subshells.
2236Please define it with "o conf shell <your shell>"
2237};
2238 return;
2239 }
2240 my $dist = $self->id;
2241 my $dir = $self->dir or $self->get;
2242 $dir = $self->dir;
2243 my $getcwd;
2244 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2245 my $pwd = Cwd->$getcwd();
2246 chdir($dir);
2247 print qq{Working directory is $dir.\n};
2248 system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
2249 chdir($pwd);
2250}
2251
2252#-> sub CPAN::Distribution::readme ;
2253sub readme {
2254 my($self) = @_;
2255 my($dist) = $self->id;
2256 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
2257 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
2258 my($local_file);
2259 my($local_wanted) =
2260 CPAN->catfile(
2261 $CPAN::Config->{keep_source_where},
2262 "authors",
2263 "id",
2264 split("/","$sans.readme"),
2265 );
2266 $self->debug("Doing localize") if $CPAN::DEBUG;
2267 $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
2268 my $fh_pager = FileHandle->new;
2269 $fh_pager->open("|$CPAN::Config->{'pager'}")
2270 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
2271 my $fh_readme = FileHandle->new;
2272 $fh_readme->open($local_file) or die "Could not open $local_file: $!";
2273 $fh_pager->print(<$fh_readme>);
2274}
2275
2276#-> sub CPAN::Distribution::verifyMD5 ;
2277sub verifyMD5 {
2278 my($self) = @_;
2279 EXCUSE: {
2280 my @e;
2281 $self->{MD5_STATUS} ||= "";
2282 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
2283 print join "", map {" $_\n"} @e and return if @e;
2284 }
2285 my($local_file);
2286 my(@local) = split("/",$self->{ID});
2287 my($basename) = pop @local;
2288 push @local, "CHECKSUMS";
2289 my($local_wanted) =
2290 CPAN->catfile(
2291 $CPAN::Config->{keep_source_where},
2292 "authors",
2293 "id",
2294 @local
2295 );
2296 local($") = "/";
2297 if (
2298 -f $local_wanted
2299 &&
2300 $self->MD5_check_file($local_wanted,$basename)
2301 ) {
2302 return $self->{MD5_STATUS} = "OK";
2303 }
2304 $local_file = CPAN::FTP->localize(
2305 "authors/id/@local",
2306 $local_wanted,
2307 'force>:-{');
2308 my($checksum_pipe);
2309 if ($local_file) {
2310 # fine
2311 } else {
2312 $local[-1] .= ".gz";
2313 $local_file = CPAN::FTP->localize(
2314 "authors/id/@local",
2315 "$local_wanted.gz",
2316 'force>:-{'
2317 );
2318 my $system = "$CPAN::Config->{gzip} --decompress $local_file";
2319 system($system) == 0 or die "Could not uncompress $local_file";
2320 $local_file =~ s/\.gz$//;
2321 }
2322 $self->MD5_check_file($local_file,$basename);
2323}
2324
2325#-> sub CPAN::Distribution::MD5_check_file ;
2326sub MD5_check_file {
2327 my($self,$lfile,$basename) = @_;
2328 my($cksum);
2329 my $fh = new FileHandle;
2330 local($/) = undef;
2331 if (open $fh, $lfile){
2332 my $eval = <$fh>;
2333 close $fh;
2334 my($comp) = Safe->new();
2335 $cksum = $comp->reval($eval);
2336 Carp::confess($@) if $@;
2337 if ($cksum->{$basename}->{md5}) {
2338 $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n")
2339 if $CPAN::DEBUG;
2340 my $file = $self->{localfile};
2341 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
2342 if (
2343 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
2344 or
2345 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
2346 ){
2347 print "Checksum for $file ok\n";
2348 return $self->{MD5_STATUS} = "OK";
2349 } else {
2350 print join(
2351 "",
2352 qq{Checksum mismatch for distribution file. },
2353 qq{Please investigate.\n\n}
2354 );
2355 print $self->as_string;
2356 print $CPAN::META->instance(
2357 'CPAN::Author',
2358 $self->{CPAN_USERID}
2359 )->as_string;
2360 my $wrap = qq{I\'d recommend removing $self->{'localfile'}}.
2361 qq{, put another URL at the top of the list of URLs to }.
2362 qq{visit, and restart CPAN.pm. If all this doesn\'t help, }.
2363 qq{please contact the author or your CPAN site admin};
2364 print Text::Wrap::wrap("","",$wrap);
2365 print "\n\n";
2366 sleep 3;
2367 return;
2368 }
2369 close $fh if fileno($fh);
2370 } else {
2371 $self->{MD5_STATUS} ||= "";
2372 if ($self->{MD5_STATUS} eq "NIL") {
2373 print "\nNo md5 checksum for $basename in local $lfile.";
2374 print "Removing $lfile\n";
2375 unlink $lfile or print "Could not unlink: $!";
2376 sleep 1;
2377 }
2378 $self->{MD5_STATUS} = "NIL";
2379 return;
2380 }
2381 } else {
2382 Carp::carp "Could not open $lfile for reading";
2383 }
2384}
2385
2386#-> sub CPAN::Distribution::eq_MD5 ;
2387sub eq_MD5 {
2388 my($self,$fh,$expectMD5) = @_;
2389 my $md5 = new MD5;
2390 $md5->addfile($fh);
2391 my $hexdigest = $md5->hexdigest;
2392 $hexdigest eq $expectMD5;
2393}
2394
2395#-> sub CPAN::Distribution::force ;
2396sub force {
2397 my($self) = @_;
2398 $self->{'force_update'}++;
2399 delete $self->{'MD5_STATUS'};
2400 delete $self->{'archived'};
2401 delete $self->{'build_dir'};
2402 delete $self->{'localfile'};
2403 delete $self->{'make'};
2404 delete $self->{'install'};
2405 delete $self->{'unwrapped'};
2406 delete $self->{'writemakefile'};
2407}
2408
2409#-> sub CPAN::Distribution::perl ;
2410sub perl {
2411 my($self) = @_;
2412 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
2413 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2414 my $pwd = Cwd->$getcwd();
2415 my $candidate = $CPAN::META->catfile($pwd,$^X);
2416 $perl ||= $candidate if MM->maybe_command($candidate);
2417 unless ($perl) {
2418 my ($component,$perl_name);
2419 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
2420 PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
2421 next unless defined($component) && $component;
2422 my($abs) = MM->catfile($component,$perl_name);
2423 if (MM->maybe_command($abs)) {
2424 $perl = $abs;
2425 last DIST_PERLNAME;
2426 }
2427 }
2428 }
2429 }
2430 $perl;
2431}
2432
2433#-> sub CPAN::Distribution::make ;
2434sub make {
2435 my($self) = @_;
2436 $self->debug($self->id) if $CPAN::DEBUG;
2437 print "Running make\n";
2438 $self->get;
2439 EXCUSE: {
2440 my @e;
2441 $self->{archived} eq "NO" and push @e,
2442 "Is neither a tar nor a zip archive.";
2443
2444 $self->{unwrapped} eq "NO" and push @e,
2445 "had problems unarchiving. Please build manually";
2446
2447 exists $self->{writemakefile} &&
2448 $self->{writemakefile} eq "NO" and push @e,
2449 "Had some problem writing Makefile";
2450
2451 defined $self->{'make'} and push @e,
2452 "Has already been processed within this session";
2453
2454 print join "", map {" $_\n"} @e and return if @e;
2455 }
2456 print "\n CPAN.pm: Going to build ".$self->id."\n\n";
2457 my $builddir = $self->dir;
2458 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2459 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
2460
2461 my $system;
2462 if ($self->{'configure'}) {
2463 $system = $self->{'configure'};
2464 } else {
2465 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
2466 my $switch = "";
2467# This needs a handler that can be turned on or off:
2468# $switch = "-MExtUtils::MakeMaker ".
2469# "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
2470# if $] > 5.00310;
2471 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
2472 }
2473 {
2474 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
2475 my($ret,$pid);
2476 $@ = "";
2477 if ($CPAN::Config->{inactivity_timeout}) {
2478 eval {
2479 alarm $CPAN::Config->{inactivity_timeout};
2480 local $SIG{CHLD} = sub { wait };
2481 if (defined($pid = fork)) {
2482 if ($pid) { #parent
2483 wait;
2484 } else { #child
2485 exec $system;
2486 }
2487 } else {
2488 print "Cannot fork: $!";
2489 return;
2490 }
2491 };
2492 alarm 0;
2493 if ($@){
2494 kill 9, $pid;
2495 waitpid $pid, 0;
2496 print $@;
2497 $self->{writemakefile} = "NO - $@";
2498 $@ = "";
2499 return;
2500 }
2501 } else {
2502 $ret = system($system);
2503 if ($ret != 0) {
2504 $self->{writemakefile} = "NO";
2505 return;
2506 }
2507 }
2508 }
2509 $self->{writemakefile} = "YES";
2510 return if $CPAN::Signal;
2511 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
2512 if (system($system) == 0) {
2513 print " $system -- OK\n";
2514 $self->{'make'} = "YES";
2515 } else {
2516 $self->{writemakefile} = "YES";
2517 $self->{'make'} = "NO";
2518 print " $system -- NOT OK\n";
2519 }
2520}
2521
2522#-> sub CPAN::Distribution::test ;
2523sub test {
2524 my($self) = @_;
2525 $self->make;
2526 return if $CPAN::Signal;
2527 print "Running make test\n";
2528 EXCUSE: {
2529 my @e;
2530 exists $self->{'make'} or push @e,
2531 "Make had some problems, maybe interrupted? Won't test";
2532
2533 exists $self->{'make'} and
2534 $self->{'make'} eq 'NO' and
2535 push @e, "Oops, make had returned bad status";
2536
2537 exists $self->{'build_dir'} or push @e, "Has no own directory";
2538 print join "", map {" $_\n"} @e and return if @e;
2539 }
2540 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2541 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2542 my $system = join " ", $CPAN::Config->{'make'}, "test";
2543 if (system($system) == 0) {
2544 print " $system -- OK\n";
2545 $self->{'make_test'} = "YES";
2546 } else {
2547 $self->{'make_test'} = "NO";
2548 print " $system -- NOT OK\n";
2549 }
2550}
2551
2552#-> sub CPAN::Distribution::clean ;
2553sub clean {
2554 my($self) = @_;
2555 print "Running make clean\n";
2556 EXCUSE: {
2557 my @e;
2558 exists $self->{'build_dir'} or push @e, "Has no own directory";
2559 print join "", map {" $_\n"} @e and return if @e;
2560 }
2561 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2562 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2563 my $system = join " ", $CPAN::Config->{'make'}, "clean";
2564 if (system($system) == 0) {
2565 print " $system -- OK\n";
2566 $self->force;
2567 } else {
2568 # Hmmm, what to do if make clean failed?
2569 }
2570}
2571
2572#-> sub CPAN::Distribution::install ;
2573sub install {
2574 my($self) = @_;
2575 $self->test;
2576 return if $CPAN::Signal;
2577 print "Running make install\n";
2578 EXCUSE: {
2579 my @e;
2580 exists $self->{'build_dir'} or push @e, "Has no own directory";
2581
2582 exists $self->{'make'} or push @e,
2583 "Make had some problems, maybe interrupted? Won't install";
2584
2585 exists $self->{'make'} and
2586 $self->{'make'} eq 'NO' and
2587 push @e, "Oops, make had returned bad status";
2588
2589 push @e, "make test had returned bad status, won't install without force"
2590 if exists $self->{'make_test'} and
2591 $self->{'make_test'} eq 'NO' and
2592 ! $self->{'force_update'};
2593
2594 exists $self->{'install'} and push @e,
2595 $self->{'install'} eq "YES" ?
2596 "Already done" : "Already tried without success";
2597
2598 print join "", map {" $_\n"} @e and return if @e;
2599 }
2600 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2601 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2602 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
2603 my($pipe) = FileHandle->new("$system 2>&1 |");
2604 my($makeout) = "";
2605 while (<$pipe>){
2606 print;
2607 $makeout .= $_;
2608 }
2609 $pipe->close;
2610 if ($?==0) {
2611 print " $system -- OK\n";
2612 $self->{'install'} = "YES";
2613 } else {
2614 $self->{'install'} = "NO";
2615 print " $system -- NOT OK\n";
2616 if ($makeout =~ /permission/s && $> > 0) {
2617 print " You may have to su to root to install the package\n";
2618 }
2619 }
2620}
2621
2622#-> sub CPAN::Distribution::dir ;
2623sub dir {
2624 shift->{'build_dir'};
2625}
2626
2627package CPAN::Bundle;
2628@CPAN::Bundle::ISA = qw(CPAN::Module);
2629
2630#-> sub CPAN::Bundle::as_string ;
2631sub as_string {
2632 my($self) = @_;
2633 $self->contains;
2634 $self->{INST_VERSION} = $self->inst_version;
2635 return $self->SUPER::as_string;
2636}
2637
2638#-> sub CPAN::Bundle::contains ;
2639sub contains {
2640 my($self) = @_;
2641 my($parsefile) = $self->inst_file;
2642 unless ($parsefile) {
2643 # Try to get at it in the cpan directory
2644 $self->debug("no parsefile") if $CPAN::DEBUG;
2645 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
2646 $dist->get;
2647 $self->debug($dist->as_string) if $CPAN::DEBUG;
2648 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2649 File::Path::mkpath($todir);
2650 my($me,$from,$to);
2651 ($me = $self->id) =~ s/.*://;
2652 $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
2653 $to = $CPAN::META->catfile($todir,"$me.pm");
2654 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
2655 $parsefile = $to;
2656 }
2657 my @result;
2658 my $fh = new FileHandle;
2659 local $/ = "\n";
2660 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
2661 my $inpod = 0;
2662 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
2663 while (<$fh>) {
2664 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
2665 next unless $inpod;
2666 next if /^=/;
2667 next if /^\s+$/;
2668 chomp;
2669 push @result, (split " ", $_, 2)[0];
2670 }
2671 close $fh;
2672 delete $self->{STATUS};
2673 $self->{CONTAINS} = join ", ", @result;
2674 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
2675 @result;
2676}
2677
2678#-> sub CPAN::Bundle::find_bundle_file
2679sub find_bundle_file {
2680 my($self,$where,$what) = @_;
2681 my $bu = $CPAN::META->catfile($where,$what);
2682 return $bu if -f $bu;
2683 my $manifest = $CPAN::META->catfile($where,"MANIFEST");
2684 unless (-f $manifest) {
2685 require ExtUtils::Manifest;
2686 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2687 my $cwd = Cwd->$getcwd();
2688 chdir $where;
2689 ExtUtils::Manifest::mkmanifest();
2690 chdir $cwd;
2691 }
2692 my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
2693 local($/) = "\n";
2694 while (<$fh>) {
2695 next if /^\s*\#/;
2696 my($file) = /(\S+)/;
2697 if ($file =~ m|Bundle/$what$|) {
2698 $bu = $file;
2699 return $CPAN::META->catfile($where,$bu);
2700 }
2701 }
2702 Carp::croak("Could't find a Bundle file in $where");
2703}
2704
2705#-> sub CPAN::Bundle::inst_file ;
2706sub inst_file {
2707 my($self) = @_;
2708 my($me,$inst_file);
2709 ($me = $self->id) =~ s/.*://;
2710 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
2711 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2712# $inst_file =
2713 $self->SUPER::inst_file;
2714# return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2715# return $self->{'INST_FILE'}; # even if undefined?
2716}
2717
2718#-> sub CPAN::Bundle::rematein ;
2719sub rematein {
2720 my($self,$meth) = @_;
2721 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
2722 my($s);
2723 for $s ($self->contains) {
2724 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
2725 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
2726 if ($type eq 'CPAN::Distribution') {
2727 warn qq{
2728The Bundle }.$self->id.qq{ contains
2729explicitly a file $s.
2730};
2731 sleep 3;
2732 }
2733 $CPAN::META->instance($type,$s)->$meth();
2734 }
2735}
2736
2737#sub CPAN::Bundle::xs_file
2738sub xs_file {
2739 # If a bundle contains another that contains an xs_file we have
2740 # here, we just don't bother I suppose
2741 return 0;
2742}
2743
2744#-> sub CPAN::Bundle::force ;
2745sub force { shift->rematein('force',@_); }
2746#-> sub CPAN::Bundle::get ;
2747sub get { shift->rematein('get',@_); }
2748#-> sub CPAN::Bundle::make ;
2749sub make { shift->rematein('make',@_); }
2750#-> sub CPAN::Bundle::test ;
2751sub test { shift->rematein('test',@_); }
2752#-> sub CPAN::Bundle::install ;
2753sub install { shift->rematein('install',@_); }
2754#-> sub CPAN::Bundle::clean ;
2755sub clean { shift->rematein('clean',@_); }
2756
2757#-> sub CPAN::Bundle::readme ;
2758sub readme {
2759 my($self) = @_;
2760 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
2761 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
2762 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
2763}
2764
2765package CPAN::Module;
2766@CPAN::Module::ISA = qw(CPAN::InfoObj);
2767
2768#-> sub CPAN::Module::as_glimpse ;
2769sub as_glimpse {
2770 my($self) = @_;
2771 my(@m);
2772 my $class = ref($self);
2773 $class =~ s/^CPAN:://;
2774 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
2775 join "", @m;
2776}
2777
2778#-> sub CPAN::Module::as_string ;
2779sub as_string {
2780 my($self) = @_;
2781 my(@m);
2782 CPAN->debug($self) if $CPAN::DEBUG;
2783 my $class = ref($self);
2784 $class =~ s/^CPAN:://;
2785 local($^W) = 0;
2786 push @m, $class, " id = $self->{ID}\n";
2787 my $sprintf = " %-12s %s\n";
2788 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
2789 my $sprintf2 = " %-12s %s (%s)\n";
2790 my($userid);
2791 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
2792 push @m, sprintf(
2793 $sprintf2,
2794 'CPAN_USERID',
2795 $userid,
2796 CPAN::Shell->expand('Author',$userid)->fullname
2797 )
2798 }
2799 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
2800 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
2801 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
2802 my(%statd,%stats,%statl,%stati);
2803 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
2804 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
2805 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
2806 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
2807 $statd{' '} = 'unknown';
2808 $stats{' '} = 'unknown';
2809 $statl{' '} = 'unknown';
2810 $stati{' '} = 'unknown';
2811 push @m, sprintf(
2812 $sprintf3,
2813 'DSLI_STATUS',
2814 $self->{statd},
2815 $self->{stats},
2816 $self->{statl},
2817 $self->{stati},
2818 $statd{$self->{statd}},
2819 $stats{$self->{stats}},
2820 $statl{$self->{statl}},
2821 $stati{$self->{stati}}
2822 ) if $self->{statd};
2823 my $local_file = $self->inst_file;
2824 if ($local_file && ! exists $self->{MANPAGE}) {
2825 my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
2826 my $inpod = 0;
2827 my(@result);
2828 local $/ = "\n";
2829 while (<$fh>) {
2830 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
2831 next unless $inpod;
2832 next if /^=/;
2833 next if /^\s+$/;
2834 chomp;
2835 push @result, $_;
2836 }
2837 close $fh;
2838 $self->{MANPAGE} = join " ", @result;
2839 }
2840 my($item);
2841 for $item (qw/MANPAGE CONTAINS/) {
2842 push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
2843 }
2844 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
2845 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
2846 join "", @m, "\n";
2847}
2848
2849#-> sub CPAN::Module::cpan_file ;
2850sub cpan_file {
2851 my $self = shift;
2852 CPAN->debug($self->id) if $CPAN::DEBUG;
2853 unless (defined $self->{'CPAN_FILE'}) {
2854 CPAN::Index->reload;
2855 }
2856 if (defined $self->{'CPAN_FILE'}){
2857 return $self->{'CPAN_FILE'};
2858 } elsif (defined $self->{'userid'}) {
2859 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
2860 } else {
2861 return "N/A";
2862 }
2863}
2864
2865*name = \&cpan_file;
2866
2867#-> sub CPAN::Module::cpan_version ;
2868sub cpan_version { shift->{'CPAN_VERSION'} }
2869
2870#-> sub CPAN::Module::force ;
2871sub force {
2872 my($self) = @_;
2873 $self->{'force_update'}++;
2874}
2875
2876#-> sub CPAN::Module::rematein ;
2877sub rematein {
2878 my($self,$meth) = @_;
2879 $self->debug($self->id) if $CPAN::DEBUG;
2880 my $cpan_file = $self->cpan_file;
2881 return if $cpan_file eq "N/A";
2882 return if $cpan_file =~ /^Contact Author/;
2883 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2884 $pack->called_for($self->id);
2885 $pack->force if exists $self->{'force_update'};
2886 $pack->$meth();
2887 delete $self->{'force_update'};
2888}
2889
2890#-> sub CPAN::Module::readme ;
2891sub readme { shift->rematein('readme') }
2892#-> sub CPAN::Module::look ;
2893sub look { shift->rematein('look') }
2894#-> sub CPAN::Module::get ;
2895sub get { shift->rematein('get',@_); }
2896#-> sub CPAN::Module::make ;
2897sub make { shift->rematein('make') }
2898#-> sub CPAN::Module::test ;
2899sub test { shift->rematein('test') }
2900#-> sub CPAN::Module::install ;
2901sub install {
2902 my($self) = @_;
2903 my($doit) = 0;
2904 my($latest) = $self->cpan_version;
2905 $latest ||= 0;
2906 my($inst_file) = $self->inst_file;
2907 my($have) = 0;
2908 if (defined $inst_file) {
2909 $have = $self->inst_version;
2910 }
2911 if (1){ # A block for scoping $^W, the if is just for the visual
2912 # appeal
2913 local($^W)=0;
2914 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
2915 print $self->id, " is up to date.\n";
2916 } else {
2917 $doit = 1;
2918 }
2919 }
2920 $self->rematein('install') if $doit;
2921}
2922#-> sub CPAN::Module::clean ;
2923sub clean { shift->rematein('clean') }
2924
2925#-> sub CPAN::Module::inst_file ;
2926sub inst_file {
2927 my($self) = @_;
2928 my($dir,@packpath);
2929 @packpath = split /::/, $self->{ID};
2930 $packpath[-1] .= ".pm";
2931 foreach $dir (@INC) {
2932 my $pmfile = CPAN->catfile($dir,@packpath);
2933 if (-f $pmfile){
2934 return $pmfile;
2935 }
2936 }
2937 return;
2938}
2939
2940#-> sub CPAN::Module::xs_file ;
2941sub xs_file {
2942 my($self) = @_;
2943 my($dir,@packpath);
2944 @packpath = split /::/, $self->{ID};
2945 push @packpath, $packpath[-1];
2946 $packpath[-1] .= "." . $Config::Config{'dlext'};
2947 foreach $dir (@INC) {
2948 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
2949 if (-f $xsfile){
2950 return $xsfile;
2951 }
2952 }
2953 return;
2954}
2955
2956#-> sub CPAN::Module::inst_version ;
2957sub inst_version {
2958 my($self) = @_;
2959 my $parsefile = $self->inst_file or return 0;
2960 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
2961 my $have = MM->parse_version($parsefile);
2962 $have ||= 0;
2963 $have =~ s/\s+//g;
2964 $have ||= 0;
2965 $have;
2966}
2967
2968# Do this after you have set up the whole inheritance
2969CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
2970
29711;
2972__END__
2973
2974=head1 NAME
2975
2976CPAN - query, download and build perl modules from CPAN sites
2977
2978=head1 SYNOPSIS
2979
2980Interactive mode:
2981
2982 perl -MCPAN -e shell;
2983
2984Batch mode:
2985
2986 use CPAN;
2987
2988 autobundle, clean, install, make, recompile, test
2989
2990=head1 DESCRIPTION
2991
2992The CPAN module is designed to automate the make and install of perl
2993modules and extensions. It includes some searching capabilities and
2994knows how to use Net::FTP or LWP (or lynx or an external ftp client)
2995to fetch the raw data from the net.
2996
2997Modules are fetched from one or more of the mirrored CPAN
2998(Comprehensive Perl Archive Network) sites and unpacked in a dedicated
2999directory.
3000
3001The CPAN module also supports the concept of named and versioned
3002'bundles' of modules. Bundles simplify the handling of sets of
3003related modules. See BUNDLES below.
3004
3005The package contains a session manager and a cache manager. There is
3006no status retained between sessions. The session manager keeps track
3007of what has been fetched, built and installed in the current
3008session. The cache manager keeps track of the disk space occupied by
3009the make processes and deletes excess space according to a simple FIFO
3010mechanism.
3011
3012All methods provided are accessible in a programmer style and in an
3013interactive shell style.
3014
3015=head2 Interactive Mode
3016
3017The interactive mode is entered by running
3018
3019 perl -MCPAN -e shell
3020
3021which puts you into a readline interface. You will have most fun if
3022you install Term::ReadKey and Term::ReadLine to enjoy both history and
3023completion.
3024
3025Once you are on the command line, type 'h' and the rest should be
3026self-explanatory.
3027
3028The most common uses of the interactive modes are
3029
3030=over 2
3031
3032=item Searching for authors, bundles, distribution files and modules
3033
3034There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
3035for each of the four categories and another, C<i> for any of the
3036mentioned four. Each of the four entities is implemented as a class
3037with slightly differing methods for displaying an object.
3038
3039Arguments you pass to these commands are either strings matching exact
3040the identification string of an object or regular expressions that are
3041then matched case-insensitively against various attributes of the
3042objects. The parser recognizes a regualar expression only if you
3043enclose it between two slashes.
3044
3045The principle is that the number of found objects influences how an
3046item is displayed. If the search finds one item, we display the result
3047of object-E<gt>as_string, but if we find more than one, we display
3048each as object-E<gt>as_glimpse. E.g.
3049
3050 cpan> a ANDK
3051 Author id = ANDK
3052 EMAIL a.koenig@franz.ww.TU-Berlin.DE
3053 FULLNAME Andreas König
3054
3055
3056 cpan> a /andk/
3057 Author id = ANDK
3058 EMAIL a.koenig@franz.ww.TU-Berlin.DE
3059 FULLNAME Andreas König
3060
3061
3062 cpan> a /and.*rt/
3063 Author ANDYD (Andy Dougherty)
3064 Author MERLYN (Randal L. Schwartz)
3065
3066=item make, test, install, clean modules or distributions
3067
3068These commands do indeed exist just as written above. Each of them
3069takes any number of arguments and investigates for each what it might
3070be. Is it a distribution file (recognized by embedded slashes), this
3071file is being processed. Is it a module, CPAN determines the
3072distribution file where this module is included and processes that.
3073
3074Any C<make>, C<test>, and C<readme> are run unconditionally. A
3075
3076 install <distribution_file>
3077
3078also is run unconditionally. But for
3079
3080 install <module>
3081
3082CPAN checks if an install is actually needed for it and prints
3083I<Foo up to date> in case the module doesnE<39>t need to be updated.
3084
3085CPAN also keeps track of what it has done within the current session
3086and doesnE<39>t try to build a package a second time regardless if it
3087succeeded or not. The C<force > command takes as first argument the
3088method to invoke (currently: make, test, or install) and executes the
3089command from scratch.
3090
3091Example:
3092
3093 cpan> install OpenGL
3094 OpenGL is up to date.
3095 cpan> force install OpenGL
3096 Running make
3097 OpenGL-0.4/
3098 OpenGL-0.4/COPYRIGHT
3099 [...]
3100
3101=item readme, look module or distribution
3102
3103These two commands take only one argument, be it a module or a
3104distribution file. C<readme> displays the README of the associated
3105distribution file. C<Look> gets and untars (if not yet done) the
3106distribution file, changes to the appropriate directory and opens a
3107subshell process in that directory.
3108
3109=back
3110
3111=head2 CPAN::Shell
3112
3113The commands that are available in the shell interface are methods in
3114the package CPAN::Shell. If you enter the shell command, all your
3115input is split by the Text::ParseWords::shellwords() routine which
3116acts like most shells do. The first word is being interpreted as the
3117method to be called and the rest of the words are treated as arguments
3118to this method.
3119
3120=head2 autobundle
3121
3122C<autobundle> writes a bundle file into the
3123C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
3124a list of all modules that are both available from CPAN and currently
3125installed within @INC. The name of the bundle file is based on the
3126current date and a counter.
3127
3128=head2 recompile
3129
3130recompile() is a very special command in that it takes no argument and
3131runs the make/test/install cycle with brute force over all installed
3132dynamically loadable extensions (aka XS modules) with 'force' in
3133effect. Primary purpose of this command is to finish a network
3134installation. Imagine, you have a common source tree for two different
3135architectures. You decide to do a completely independent fresh
3136installation. You start on one architecture with the help of a Bundle
3137file produced earlier. CPAN installs the whole Bundle for you, but
3138when you try to repeat the job on the second architecture, CPAN
3139responds with a C<"Foo up to date"> message for all modules. So you
3140will be glad to run recompile in the second architecture and
3141youE<39>re done.
3142
3143Another popular use for C<recompile> is to act as a rescue in case your
3144perl breaks binary compatibility. If one of the modules that CPAN uses
3145is in turn depending on binary compatibility (so you cannot run CPAN
3146commands), then you should try the CPAN::Nox module for recovery.
3147
3148=head2 The 4 Classes: Authors, Bundles, Modules, Distributions
3149
3150Although it may be considered internal, the class hierarchie does
3151matter for both users and programmer. CPAN.pm deals with above
3152mentioned four classes, and all those classes share a set of
3153methods. It is a classical single polymorphism that is in effect. A
3154metaclass object registers all objects of all kinds and indexes them
3155with a string. The strings referencing objects have a separated
3156namespace (well, not completely separated):
3157
3158 Namespace Class
3159
3160 words containing a "/" (slash) Distribution
3161 words starting with Bundle:: Bundle
3162 everything else Module or Author
3163
3164Modules know their associated Distribution objects. They always refer
3165to the most recent official release. Developers may mark their
3166releases as unstable development versions (by inserting an underbar
3167into the visible version number), so not always is the default
3168distribution for a given module the really hottest and newest. If a
3169module Foo circulates on CPAN in both version 1.23 and 1.23_90,
3170CPAN.pm offers a convenient way to install version 1.23 by saying
3171
3172 install Foo
3173
3174This would install the complete distribution file (say
3175BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
3176you would like to install version 1.23_90, you need to know where the
3177distribution file resides on CPAN relative to the authors/id/
3178directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
3179so he would have say
3180
3181 install BAR/Foo-1.23_90.tar.gz
3182
3183The first example will be driven by an object of the class
3184CPAN::Module, the second by an object of class Distribution.
3185
3186=head2 ProgrammerE<39>s interface
3187
3188If you do not enter the shell, the available shell commands are both
3189available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
3190functions in the calling package (C<install(...)>).
3191
3192There's currently only one class that has a stable interface,
3193CPAN::Shell. All commands that are available in the CPAN shell are
3194methods of the class CPAN::Shell. The commands that produce listings
3195of modules (C<r>, C<autobundle>, C<u>) return a list of the IDs of all
3196modules within the list.
3197
3198=over 2
3199
3200=item expand($type,@things)
3201
3202The IDs of all objects available within a program are strings that can
3203be expanded to the corresponding real objects with the
3204C<CPAN::Shell-E<gt>expand()> method. Expand returns a list of
3205CPAN::Module objects according to the C<@things> arguments given. In
3206scalar context it only returns the first element of the list.
3207
3208=item Programming Examples
3209
3210This enables the programmer to do operations like these:
3211
3212 # install everything that is outdated on my disk:
3213 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
3214
3215 # install my favorite programs if necessary:
3216 for $mod (qw(Net::FTP MD5 Data::Dumper)){
3217 my $obj = CPAN::Shell->expand('Module',$mod);
3218 $obj->install;
3219 }
3220
3221=back
3222
3223=head2 Cache Manager
3224
3225Currently the cache manager only keeps track of the build directory
3226($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
3227deletes complete directories below C<build_dir> as soon as the size of
3228all directories there gets bigger than $CPAN::Config->{build_cache}
3229(in MB). The contents of this cache may be used for later
3230re-installations that you intend to do manually, but will never be
3231trusted by CPAN itself. This is due to the fact that the user might
3232use these directories for building modules on different architectures.
3233
3234There is another directory ($CPAN::Config->{keep_source_where}) where
3235the original distribution files are kept. This directory is not
3236covered by the cache manager and must be controlled by the user. If
3237you choose to have the same directory as build_dir and as
3238keep_source_where directory, then your sources will be deleted with
3239the same fifo mechanism.
3240
3241=head2 Bundles
3242
3243A bundle is just a perl module in the namespace Bundle:: that does not
3244define any functions or methods. It usually only contains documentation.
3245
3246It starts like a perl module with a package declaration and a $VERSION
3247variable. After that the pod section looks like any other pod with the
3248only difference, that I<one special pod section> exists starting with
3249(verbatim):
3250
3251 =head1 CONTENTS
3252
3253In this pod section each line obeys the format
3254
3255 Module_Name [Version_String] [- optional text]
3256
3257The only required part is the first field, the name of a module
3258(eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
3259of the line is optional. The comment part is delimited by a dash just
3260as in the man page header.
3261
3262The distribution of a bundle should follow the same convention as
3263other distributions.
3264
3265Bundles are treated specially in the CPAN package. If you say 'install
3266Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
3267the modules in the CONTENTS section of the pod. You can install your
3268own Bundles locally by placing a conformant Bundle file somewhere into
3269your @INC path. The autobundle() command which is available in the
3270shell interface does that for you by including all currently installed
3271modules in a snapshot bundle file.
3272
3273There is a meaningless Bundle::Demo available on CPAN. Try to install
3274it, it usually does no harm, just demonstrates what the Bundle
3275interface looks like.
3276
3277=head2 Prerequisites
3278
3279If you have a local mirror of CPAN and can access all files with
3280"file:" URLs, then you only need a perl better than perl5.003 to run
3281this module. Otherwise Net::FTP is strongly recommended. LWP may be
3282required for non-UNIX systems or if your nearest CPAN site is
3283associated with an URL that is not C<ftp:>.
3284
3285If you have neither Net::FTP nor LWP, there is a fallback mechanism
3286implemented for an external ftp command or for an external lynx
3287command.
3288
3289This module presumes that all packages on CPAN
3290
3291=over 2
3292
3293=item *
3294
3295declare their $VERSION variable in an easy to parse manner. This
3296prerequisite can hardly be relaxed because it consumes by far too much
3297memory to load all packages into the running program just to determine
3298the $VERSION variable . Currently all programs that are dealing with
3299version use something like this
3300
3301 perl -MExtUtils::MakeMaker -le \
3302 'print MM->parse_version($ARGV[0])' filename
3303
3304If you are author of a package and wonder if your $VERSION can be
3305parsed, please try the above method.
3306
3307=item *
3308
3309come as compressed or gzipped tarfiles or as zip files and contain a
3310Makefile.PL (well we try to handle a bit more, but without much
3311enthusiasm).
3312
3313=back
3314
3315=head2 Debugging
3316
3317The debugging of this module is pretty difficult, because we have
3318interferences of the software producing the indices on CPAN, of the
3319mirroring process on CPAN, of packaging, of configuration, of
3320synchronicity, and of bugs within CPAN.pm.
3321
3322In interactive mode you can try "o debug" which will list options for
3323debugging the various parts of the package. The output may not be very
3324useful for you as it's just a byproduct of my own testing, but if you
3325have an idea which part of the package may have a bug, it's sometimes
3326worth to give it a try and send me more specific output. You should
3327know that "o debug" has built-in completion support.
3328
3329=head2 Floppy, Zip, and all that Jazz
3330
3331CPAN.pm works nicely without network too. If you maintain machines
3332that are not networked at all, you should consider working with file:
3333URLs. Of course, you have to collect your modules somewhere first. So
3334you might use CPAN.pm to put together all you need on a networked
3335machine. Then copy the $CPAN::Config->{keep_source_where} (but not
3336$CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
3337of a personal CPAN. CPAN.pm on the non-networked machines works nicely
3338with this floppy.
3339
3340=head1 CONFIGURATION
3341
3342When the CPAN module is installed a site wide configuration file is
3343created as CPAN/Config.pm. The default values defined there can be
3344overridden in another configuration file: CPAN/MyConfig.pm. You can
3345store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
3346$HOME/.cpan is added to the search path of the CPAN module before the
3347use() or require() statements.
3348
3349Currently the following keys in the hash reference $CPAN::Config are
3350defined:
3351
3352 build_cache size of cache for directories to build modules
3353 build_dir locally accessible directory to build modules
3354 index_expire after how many days refetch index files
3355 cpan_home local directory reserved for this package
3356 gzip location of external program gzip
3357 inactivity_timeout breaks interactive Makefile.PLs after that
3358 many seconds inactivity. Set to 0 to never break.
3359 inhibit_startup_message
3360 if true, does not print the startup message
3361 keep_source keep the source in a local directory?
3362 keep_source_where where keep the source (if we do)
3363 make location of external program make
3364 make_arg arguments that should always be passed to 'make'
3365 make_install_arg same as make_arg for 'make install'
3366 makepl_arg arguments passed to 'perl Makefile.PL'
3367 pager location of external program more (or any pager)
3368 tar location of external program tar
3369 unzip location of external program unzip
3370 urllist arrayref to nearby CPAN sites (or equivalent locations)
3371
3372You can set and query each of these options interactively in the cpan
3373shell with the command set defined within the C<o conf> command:
3374
3375=over 2
3376
3377=item o conf E<lt>scalar optionE<gt>
3378
3379prints the current value of the I<scalar option>
3380
3381=item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
3382
3383Sets the value of the I<scalar option> to I<value>
3384
3385=item o conf E<lt>list optionE<gt>
3386
3387prints the current value of the I<list option> in MakeMaker's
3388neatvalue format.
3389
3390=item o conf E<lt>list optionE<gt> [shift|pop]
3391
3392shifts or pops the array in the I<list option> variable
3393
3394=item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
3395
3396works like the corresponding perl commands.
3397
3398=back
3399
3400=head1 SECURITY
3401
3402There's no strong security layer in CPAN.pm. CPAN.pm helps you to
3403install foreign, unmasked, unsigned code on your machine. We compare
3404to a checksum that comes from the net just as the distribution file
3405itself. If somebody has managed to tamper with the distribution file,
3406they may have as well tampered with the CHECKSUMS file. Future
3407development will go towards strong authentification.
3408
3409=head1 EXPORT
3410
3411Most functions in package CPAN are exported per default. The reason
3412for this is that the primary use is intended for the cpan shell or for
3413oneliners.
3414
3415=head1 BUGS
3416
3417we should give coverage for _all_ of the CPAN and not just the
3418__PAUSE__ part, right? In this discussion CPAN and PAUSE have become
3419equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
3420PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
3421
3422Future development should be directed towards a better intergration of
3423the other parts.
3424
3425=head1 AUTHOR
3426
3427Andreas König E<lt>a.koenig@mind.deE<gt>
3428
3429=head1 SEE ALSO
3430
3431perl(1), CPAN::Nox(3)
3432
3433=cut
3434
Unnamed repository; edit this file 'description' to name the repository.