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