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