2 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
6 # $Id: CPAN.pm,v 1.106 1997/01/24 12:26:36 k Exp $
8 # my $version = substr q$Revision: 1.106 $, 10; # only used during development
15 use ExtUtils::MakeMaker ();
16 use File::Basename ();
22 use Text::ParseWords ();
26 END { $End++; &cleanup; }
48 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META);
51 @CPAN::ISA = qw(CPAN::Debug Exporter MY); # the MY class from
55 $META ||= new CPAN; # In case we reeval ourselves we
58 CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
61 autobundle bundle expand force get
62 install make readme recompile shell test clean
67 #-> sub CPAN::autobundle ;
69 #-> sub CPAN::bundle ;
71 #-> sub CPAN::expand ;
75 #-> sub CPAN::install ;
86 #-> sub CPAN::AUTOLOAD ;
91 @EXPORT{@EXPORT} = '';
92 if (exists $EXPORT{$l}){
95 warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
104 my($mgr,$class) = @_;
105 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
107 values %{ $META->{$class} };
110 # Called by shell, not in batch mode. Not clean XXX
111 #-> sub CPAN::checklock ;
114 my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
115 if (-f $lockfile && -M _ > 0) {
116 my $fh = FileHandle->new($lockfile);
119 if (defined $other && $other) {
121 return if $$==$other; # should never happen
122 print qq{There seems to be running another CPAN process ($other). Trying to contact...\n};
123 if (kill 0, $other) {
124 Carp::croak qq{Other job is running.\n}.
125 qq{You may want to kill it and delete the lockfile, maybe. On UNIX try:\n}.
128 } elsif (-w $lockfile) {
130 ExtUtils::MakeMaker::prompt
131 (qq{Other job not responding. Shall I overwrite the lockfile? (Y/N)},"y");
132 print("Ok, bye\n"), exit unless $ans =~ /^y/i;
135 qq{Lockfile $lockfile not writeable by you. Cannot proceed.\n}.
138 qq{ and then rerun us.\n}
143 File::Path::mkpath($CPAN::Config->{cpan_home});
145 unless ($fh = FileHandle->new(">$lockfile")) {
146 if ($! =~ /Permission/) {
147 my $incc = $INC{'CPAN/Config.pm'};
148 my $myincc = MY->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
151 Your configuration suggests that CPAN.pm should use a working
153 $CPAN::Config->{cpan_home}
154 Unfortunately we could not create the lock file
156 due to permission problems.
158 Please make sure that the configuration variable
159 \$CPAN::Config->{cpan_home}
160 points to a directory where you can write a .lock file. You can set
161 this variable in either
168 Carp::croak "Could not open >$lockfile: $!";
171 $self->{LOCK} = $lockfile;
173 $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
175 my $s = $Signal == 2 ? "a second" : "another";
176 &cleanup, die "Got $s SIGINT" if $Signal;
179 $SIG{'__DIE__'} = \&cleanup;
180 print STDERR "Signal handler set.\n" unless $CPAN::Config->{'inhibit_startup_message'};
183 #-> sub CPAN::DESTROY ;
185 &cleanup; # need an eval?
188 #-> sub CPAN::exists ;
190 my($mgr,$class,$id) = @_;
192 Carp::croak "exists called without class argument" unless $class;
194 exists $META->{$class}{$id};
197 #-> sub CPAN::hasFTP ;
201 return $self->{'hasFTP'} = $arg;
202 } elsif (not defined $self->{'hasFTP'}) {
203 eval {require Net::FTP;};
204 $self->{'hasFTP'} = $@ ? 0 : 1;
206 return $self->{'hasFTP'};
209 #-> sub CPAN::hasLWP ;
213 return $self->{'hasLWP'} = $arg;
214 } elsif (not defined $self->{'hasLWP'}) {
217 $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
219 return $self->{'hasLWP'};
222 #-> sub CPAN::hasMD5 ;
226 $self->{'hasMD5'} = $arg;
227 } elsif (not defined $self->{'hasMD5'}) {
230 print "MD5 security checks disabled because MD5 not installed.
231 Please consider installing MD5\n";
232 $self->{'hasMD5'} = 0;
237 return $self->{'hasMD5'};
240 #-> sub CPAN::instance ;
242 my($mgr,$class,$id) = @_;
244 Carp::croak "instance called without class argument" unless $class;
246 $META->{$class}{$id} ||= $class->new(ID => $id );
254 #-> sub CPAN::cleanup ;
256 local $SIG{__DIE__} = '';
257 my $i = 0; my $ineval = 0; my $sub;
258 while ((undef,undef,undef,$sub) = caller(++$i)) {
259 $ineval = 1, last if $sub eq '(eval)';
261 return if $ineval && !$End;
262 return unless defined $META->{'LOCK'};
263 return unless -f $META->{'LOCK'};
264 unlink $META->{'LOCK'};
265 print STDERR "Lockfile removed.\n";
266 # my $mess = Carp::longmess(@_);
270 #-> sub CPAN::shell ;
272 $Suppress_readline ||= ! -t STDIN;
274 my $prompt = "cpan> ";
277 unless ($Suppress_readline) {
278 require Term::ReadLine;
279 import Term::ReadLine;
280 $term = new Term::ReadLine 'CPAN Monitor';
281 $readline::rl_completion_function =
282 $readline::rl_completion_function = 'CPAN::Complete::complete';
287 my $cwd = Cwd::cwd();
288 # How should we determine if we have more than stub ReadLine enabled?
289 my $rl_avail = $Suppress_readline ? "suppressed" :
290 defined &Term::ReadLine::Perl::readline ? "enabled" :
291 "available (get Term::ReadKey and Term::ReadLine)";
294 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
295 Readline support $rl_avail
297 } unless $CPAN::Config->{'inhibit_startup_message'} ;
299 if ($Suppress_readline) {
301 last unless defined (chomp($_ = <>));
303 last unless defined ($_ = $term->readline($prompt));
307 $_ = 'h' if $_ eq '?';
312 use vars qw($import_done);
313 CPAN->import(':DEFAULT') unless $import_done++;
314 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
317 } elsif (/^q(?:uit)?$/i) {
321 if ($] < 5.00322) { # parsewords had a bug at until recently
324 eval { @line = Text::ParseWords::shellwords($_) };
325 warn($@), next if $@;
327 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
328 my $command = shift @line;
329 eval { CPAN::Shell->$command(@line) };
333 &cleanup, die if $Signal;
340 use vars qw($AUTOLOAD $redef);
341 @CPAN::Shell::ISA = qw(CPAN::Debug);
343 # private function ro re-eval this module (handy during development)
344 #-> sub CPAN::Shell::AUTOLOAD ;
346 warn "CPAN::Shell doesn't know how to autoload $AUTOLOAD :-(
352 #-> sub CPAN::Shell::h ;
354 my($class,$about) = @_;
355 if (defined $about) {
356 print "Detailed help not yet implemented\n";
359 command arguments description
362 d /regex/ info distributions
364 i none anything of above
366 r as reinstall recommendations
367 u above uninstalled distributions
368 See manpage for autobundle, recompile, force, look, etc.
371 test modules, make test (implies make)
372 install dists, bundles, make install (implies test)
373 clean "r" or "u" make clean
374 readme display the README file
376 reload index|cpan load most recent indices/CPAN.pm
377 h or ? display this menu
378 o various set and query options
379 ! perl-code eval a perl command
380 q quit the shell subroutine
385 #-> sub CPAN::Shell::a ;
386 sub a { print shift->format_result('Author',@_);}
387 #-> sub CPAN::Shell::b ;
389 my($self,@which) = @_;
390 CPAN->debug("which[@which]") if $CPAN::DEBUG;
391 my($incdir,$bdir,$dh);
392 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
393 $bdir = $CPAN::META->catdir($incdir,"Bundle");
394 if ($dh = DirHandle->new($bdir)) { # may fail
396 for $entry ($dh->read) {
397 next if -d $CPAN::META->catdir($bdir,$entry);
398 next unless $entry =~ s/\.pm$//;
399 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
403 print $self->format_result('Bundle',@which);
405 #-> sub CPAN::Shell::d ;
406 sub d { print shift->format_result('Distribution',@_);}
407 #-> sub CPAN::Shell::m ;
408 sub m { print shift->format_result('Module',@_);}
410 #-> sub CPAN::Shell::i ;
415 @type = qw/Author Bundle Distribution Module/;
416 @args = '/./' unless @args;
419 push @result, $self->expand($type,@args);
421 my $result = @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result;
422 $result ||= "No objects found of any type for argument @args\n";
426 #-> sub CPAN::Shell::o ;
428 my($self,$o_type,@o_what) = @_;
430 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
431 if ($o_type eq 'conf') {
432 shift @o_what if @o_what && $o_what[0] eq 'help';
435 print "CPAN::Config options:\n";
436 for $k (sort keys %CPAN::Config::can) {
437 $v = $CPAN::Config::can{$k};
438 printf " %-18s %s\n", $k, $v;
441 for $k (sort keys %$CPAN::Config) {
442 $v = $CPAN::Config->{$k};
444 printf " %-18s\n", $k;
445 print map {"\t$_\n"} @{$v};
447 printf " %-18s %s\n", $k, $v;
451 } elsif (!CPAN::Config->edit(@o_what)) {
452 print qq[Type 'o conf' to view configuration edit options\n\n];
454 } elsif ($o_type eq 'debug') {
456 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
459 my($what) = shift @o_what;
460 if ( exists $CPAN::DEBUG{$what} ) {
461 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
462 } elsif ($what =~ /^\d/) {
463 $CPAN::DEBUG = $what;
464 } elsif (lc $what eq 'all') {
466 for (values %CPAN::DEBUG) {
471 for (keys %CPAN::DEBUG) {
472 next unless lc($_) eq lc($what);
473 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
475 print "unknown argument [$what]\n";
479 print "Valid options for debug are ".join(", ",sort(keys %CPAN::DEBUG), 'all').
480 " or a number. Completion works on the options. Case is ignored.\n\n";
483 print "Options set for debugging:\n";
485 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
486 $v = $CPAN::DEBUG{$k};
487 printf " %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
490 print "Debugging turned off completely.\n";
495 conf set or get configuration variables
496 debug set or get debugging options
501 #-> sub CPAN::Shell::reload ;
503 if ($_[1] =~ /cpan/i) {
504 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
505 my $fh = FileHandle->new($INC{'CPAN.pm'});
509 local($SIG{__WARN__})
511 if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
521 print "\n$redef subroutines redefined\n";
522 } elsif ($_[1] =~ /index/) {
523 CPAN::Index->force_reload;
527 #-> sub CPAN::Shell::_binary_extensions ;
528 sub _binary_extensions {
529 my($self) = shift @_;
530 my(@result,$module,%seen,%need,$headerdone);
531 for $module ($self->expand('Module','/./')) {
532 my $file = $module->cpan_file;
533 next if $file eq "N/A";
534 next if $file =~ /^Contact Author/;
535 next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
536 next unless $module->xs_file;
539 push @result, $module;
541 # print join " | ", @result;
546 #-> sub CPAN::Shell::recompile ;
548 my($self) = shift @_;
549 my($module,@module,$cpan_file,%dist);
550 @module = $self->_binary_extensions();
551 for $module (@module){ # we force now and compile later, so we don't do it twice
552 $cpan_file = $module->cpan_file;
553 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
557 for $cpan_file (sort keys %dist) {
558 print " CPAN: Recompiling $cpan_file\n\n";
559 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
561 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
562 # stop a package from recompiling,
563 # e.g. IO-1.12 when we have perl5.003_10
567 #-> sub CPAN::Shell::_u_r_common ;
569 my($self) = shift @_;
570 my($what) = shift @_;
571 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
572 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
573 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
575 @args = '/./' unless @args;
576 my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
578 my $sprintf = "%-25s %9s %9s %s\n";
579 for $module ($self->expand('Module',@args)) {
580 my $file = $module->cpan_file;
581 next unless defined $file; # ??
582 my($latest) = $module->cpan_version || 0;
583 my($inst_file) = $module->inst_file;
587 $have = $module->inst_version;
588 } elsif ($what eq "r") {
589 $have = $module->inst_version;
591 $version_zeroes++ unless $have;
592 next if $have >= $latest;
593 } elsif ($what eq "u") {
599 } elsif ($what eq "r") {
601 } elsif ($what eq "u") {
605 return if $CPAN::Signal; # this is sometimes lengthy
608 push @result, sprintf "%s %s\n", $module->id, $have;
609 } elsif ($what eq "r") {
610 push @result, $module->id;
611 next if $seen{$file}++;
612 } elsif ($what eq "u") {
613 push @result, $module->id;
614 next if $seen{$file}++;
615 next if $file =~ /^Contact/;
617 unless ($headerdone++){
619 printf $sprintf, "Package namespace", "installed", "latest", "in CPAN file";
621 $latest = substr($latest,0,8) if length($latest) > 8;
622 $have = substr($have,0,8) if length($have) > 8;
623 printf $sprintf, $module->id, $have, $latest, $file;
624 $need{$module->id}++;
628 print "No modules found for @args\n";
629 } elsif ($what eq "r") {
630 print "All modules are up to date for @args\n";
633 if ($what eq "r" && $version_zeroes) {
634 my $s = $version_zeroes>1 ? "s have" : " has";
635 print qq{$version_zeroes installed module$s no version number to compare\n};
640 #-> sub CPAN::Shell::r ;
642 shift->_u_r_common("r",@_);
645 #-> sub CPAN::Shell::u ;
647 shift->_u_r_common("u",@_);
650 #-> sub CPAN::Shell::autobundle ;
653 my(@bundle) = $self->_u_r_common("a",@_);
654 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
655 File::Path::mkpath($todir);
657 print "Couldn't mkdir $todir for some reason\n";
660 my($y,$m,$d) = (localtime)[5,4,3];
664 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
665 my($to) = $CPAN::META->catfile($todir,"$me.pm");
667 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
668 $to = $CPAN::META->catfile($todir,"$me.pm");
670 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
672 "package Bundle::$me;\n\n",
673 "\$VERSION = '0.01';\n\n",
677 "Bundle::$me - Snapshot of installation on ",
678 $Config::Config{'myhostname'},
681 "\n\n=head1 SYNOPSIS\n\n",
682 "perl -MCPAN -e 'install Bundle::$me'\n\n",
683 "=head1 CONTENTS\n\n",
685 "\n\n=head1 CONFIGURATION\n\n",
687 "\n\n=head1 AUTHOR\n\n",
688 "This Bundle has been generated automatically by the autobundle routine in CPAN.pm.\n",
691 print "\nWrote bundle file
695 #-> sub CPAN::Shell::expand ;
698 my($type,@args) = @_;
702 if ($arg =~ m|^/(.*)/$|) {
705 my $class = "CPAN::$type";
707 if (defined $regex) {
708 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
711 $obj->id =~ /$regex/i
715 $] < 5.00303 ### provide sort of compatibility with 5.003
720 $obj->name =~ /$regex/i
725 if ( $type eq 'Bundle' ) {
726 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
728 if ($CPAN::META->exists($class,$xarg)) {
729 $obj = $CPAN::META->instance($class,$xarg);
730 } elsif ($CPAN::META->exists($class,$arg)) {
731 $obj = $CPAN::META->instance($class,$arg);
741 #-> sub CPAN::Shell::format_result ;
744 my($type,@args) = @_;
745 @args = '/./' unless @args;
746 my(@result) = $self->expand($type,@args);
747 my $result = @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result;
748 $result ||= "No objects of type $type found for argument @args\n";
752 #-> sub CPAN::Shell::rematein ;
755 my($meth,@some) = @_;
757 if ($meth eq 'force') {
761 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
767 } elsif ($s =~ m|/|) { # looks like a file
768 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
769 } elsif ($s =~ m|^Bundle::|) {
770 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
772 $obj = $CPAN::META->instance('CPAN::Module',$s) if $CPAN::META->exists('CPAN::Module',$s);
775 CPAN->debug(qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.$obj->as_string.qq{\]}) if $CPAN::DEBUG;
780 ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
782 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
783 $obj = $CPAN::META->instance('CPAN::Author',$s);
784 print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
786 print "Warning: Cannot $meth $s, don't know what it is\n";
791 #-> sub CPAN::Shell::force ;
792 sub force { shift->rematein('force',@_); }
793 #-> sub CPAN::Shell::get ;
794 sub get { shift->rematein('get',@_); }
795 #-> sub CPAN::Shell::readme ;
796 sub readme { shift->rematein('readme',@_); }
797 #-> sub CPAN::Shell::make ;
798 sub make { shift->rematein('make',@_); }
799 #-> sub CPAN::Shell::test ;
800 sub test { shift->rematein('test',@_); }
801 #-> sub CPAN::Shell::install ;
802 sub install { shift->rematein('install',@_); }
803 #-> sub CPAN::Shell::clean ;
804 sub clean { shift->rematein('clean',@_); }
805 #-> sub CPAN::Shell::look ;
806 sub look { shift->rematein('look',@_); }
810 @CPAN::FTP::ISA = qw(CPAN::Debug);
812 #-> sub CPAN::FTP::ftp_get ;
814 my($class,$host,$dir,$file,$target) = @_;
816 qq[Going to fetch file [$file] from dir [$dir]
817 on host [$host] as local [$target]\n]
819 my $ftp = Net::FTP->new($host);
820 return 0 unless defined $ftp;
821 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
822 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
823 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
824 warn "Couldn't login on $host";
827 # print qq[Going to ->cwd("$dir")\n];
828 unless ( $ftp->cwd($dir) ){
829 warn "Couldn't cwd $dir";
833 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
834 unless ( $ftp->get($file,$target) ){
835 warn "Couldn't fetch $file from $host";
838 $ftp->quit; # it's ok if this fails
842 #-> sub CPAN::FTP::localize ;
844 my($self,$file,$aslocal,$force) = @_;
846 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])" unless defined $aslocal;
847 $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
849 return $aslocal if -f $aslocal && -r _ && ! $force;
851 my($aslocal_dir) = File::Basename::dirname($aslocal);
852 File::Path::mkpath($aslocal_dir);
853 print STDERR qq{Warning: You are not allowed to write into directory "$aslocal_dir".
854 I\'ll continue, but if you face any problems, they may be due
855 to insufficient permissions.\n} unless -w $aslocal_dir;
857 # Inheritance is not easier to manage than a few if/else branches
858 if ($CPAN::META->hasLWP) {
859 require LWP::UserAgent;
861 $Ua = new LWP::UserAgent;
863 $Ua->proxy('ftp', $var)
864 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
865 $Ua->proxy('http', $var)
866 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
868 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
872 # Try the list of urls for each single object. We keep a record
873 # where we did get a file from
874 for (0..$#{$CPAN::Config->{urllist}}) {
875 my $url = $CPAN::Config->{urllist}[$_];
876 $url .= "/" unless substr($url,-1) eq "/";
878 $self->debug("localizing[$url]") if $CPAN::DEBUG;
879 if ($url =~ /^file:/) {
881 if ($CPAN::META->hasLWP) {
883 my $u = new URI::URL $url;
885 } else { # works only on Unix, is poorly constructed, but
886 # hopefully better than nothing.
887 # RFC 1738 says fileurl BNF is
888 # fileurl = "file://" [ host | "localhost" ] "/" fpath
889 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
890 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
891 $l =~ s/^file://; # assume they meant file://localhost
893 return $l if -f $l && -r _;
896 if ($CPAN::META->hasLWP) {
897 print "Fetching $url with LWP\n";
898 my $res = $Ua->mirror($url, $aslocal);
899 if ($res->is_success) {
903 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
904 # that's the nice and easy way thanks to Graham
905 my($host,$dir,$getfile) = ($1,$2,$3);
906 if ($CPAN::META->hasFTP) {
908 $self->debug("Going to fetch file [$getfile]
911 as local [$aslocal]") if $CPAN::DEBUG;
912 CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
913 warn "Net::FTP failed for some reason\n";
916 Please, install Net::FTP as soon as possible. Just type
923 # Came back if Net::FTP couldn't establish connection (or failed otherwise)
924 # Maybe they are behind a firewall, but they gave us
925 # a socksified (or other) ftp program...
927 if (-x $CPAN::Config->{'ftp'}) {
929 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
930 $ctime,$blksize,$blocks) = stat($aslocal);
931 $timestamp = $mtime if defined $mtime;
933 my($netrc) = CPAN::FTP::netrc->new;
934 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
936 my $targetfile = File::Basename::basename($aslocal);
942 map("cd $_", split "/", $dir), # RFC 1738
944 "get $getfile $targetfile",
947 if (! $netrc->netrc) {
948 warn "No ~/.netrc file found";
949 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
952 "hasdef[%d]cont($host)[%d]",
954 $netrc->contains($host)
957 if ($netrc->protected) {
960 Trying with external ftp to get
962 As this requires some features that are not thoroughly tested, we\'re
963 not sure, that we get it right....
967 my $fh = FileHandle->new;
968 $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
969 or die "Couldn't open ftp: $!";
971 CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
972 foreach (@dialog) { $fh->print("$_\n") }
973 $fh->close; # Wait for process to complete
974 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
975 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
976 if ($mtime > $timestamp) {
977 print "GOT $aslocal\n";
980 print "Hmm... Still failed!\n";
983 warn "Your $netrcfile is not correctly protected.\n";
986 warn "Your ~/.netrc neither contains $host
987 nor does it have a default entry\n";
990 # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
991 # login manually to host, using e-mail as password.
992 print qq{Issuing "ftp$verbose -n"\n};
993 unshift @dialog, "open $host", "user anonymous $Config::Config{'cf_email'}";
994 CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
995 $fh = FileHandle->new;
996 $fh->open("|$CPAN::Config->{'ftp'} -n") or
997 die "Cannot fork: $!\n";
998 foreach (@dialog) { $fh->print("$_\n") }
1000 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1001 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1002 if ($mtime > $timestamp) {
1003 print "GOT $aslocal\n";
1006 print "Bad luck... Still failed!\n";
1012 # what, still not succeeded?
1013 if (-x $CPAN::Config->{'lynx'}) {
1014 my($want_compressed);
1017 Trying with lynx to get $url
1020 $want_compressed = $aslocal =~ s/\.gz//;
1021 my($system) = "$CPAN::Config->{'lynx'} -source '$url' > $aslocal";
1022 if (system($system)==0) {
1023 if ($want_compressed) {
1024 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1025 if (system($system)==0) {
1026 rename $aslocal, "$aslocal.gz";
1028 $system = "$CPAN::Config->{'gzip'} $aslocal";
1031 return "$aslocal.gz";
1033 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1034 if (system($system)==0) {
1035 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
1038 # should be fine, eh?
1044 warn "Can't access URL $url.
1045 Either get LWP or Net::FTP
1046 or an external lynx or ftp";
1048 Carp::croak("Cannot fetch $file from anywhere");
1051 package CPAN::FTP::netrc;
1055 my $file = MY->catfile($ENV{HOME},".netrc");
1057 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1058 $atime,$mtime,$ctime,$blksize,$blocks)
1062 my($fh,@machines,$hasdefault);
1064 $fh = FileHandle->new or die "Could not create a filehandle";
1066 if($fh->open($file)){
1067 $protected = ($mode & 077) == 0;
1069 NETRC: while (<$fh>) {
1070 my(@tokens) = split " ", $_;
1071 TOKEN: while (@tokens) {
1072 my($t) = shift @tokens;
1073 if ($t eq "default"){
1075 warn "saw a default entry before tokens[@tokens]";
1078 last TOKEN if $t eq "macdef";
1079 if ($t eq "machine") {
1080 push @machines, shift @tokens;
1085 $file = $hasdefault = $protected = "";
1089 'mach' => [@machines],
1091 'hasdefault' => $hasdefault,
1092 'protected' => $protected,
1096 sub hasdefault { shift->{'hasdefault'} }
1097 sub netrc { shift->{'netrc'} }
1098 sub protected { shift->{'protected'} }
1100 my($self,$mach) = @_;
1101 for ( @{$self->{'mach'}} ) {
1102 return 1 if $_ eq $mach;
1107 package CPAN::Complete;
1108 @CPAN::Complete::ISA = qw(CPAN::Debug);
1110 #-> sub CPAN::Complete::complete ;
1112 my($word,$line,$pos) = @_;
1116 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1118 if ($line =~ s/^(force\s*)//) {
1126 ! a b d h i m o q r u autobundle clean
1127 make test install force reload look
1130 } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
1132 } elsif ($line =~ /^a\s/) {
1133 @return = completex('CPAN::Author',$word);
1134 } elsif ($line =~ /^b\s/) {
1135 @return = completex('CPAN::Bundle',$word);
1136 } elsif ($line =~ /^d\s/) {
1137 @return = completex('CPAN::Distribution',$word);
1138 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
1139 @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
1140 } elsif ($line =~ /^i\s/) {
1141 @return = complete_any($word);
1142 } elsif ($line =~ /^reload\s/) {
1143 @return = complete_reload($word,$line,$pos);
1144 } elsif ($line =~ /^o\s/) {
1145 @return = complete_option($word,$line,$pos);
1152 #-> sub CPAN::Complete::completex ;
1154 my($class, $word) = @_;
1155 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1158 #-> sub CPAN::Complete::complete_any ;
1162 completex('CPAN::Author',$word),
1163 completex('CPAN::Bundle',$word),
1164 completex('CPAN::Distribution',$word),
1165 completex('CPAN::Module',$word),
1169 #-> sub CPAN::Complete::complete_reload ;
1170 sub complete_reload {
1171 my($word,$line,$pos) = @_;
1173 my(@words) = split " ", $line;
1174 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1175 my(@ok) = qw(cpan index);
1176 return @ok if @words==1;
1177 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1180 #-> sub CPAN::Complete::complete_option ;
1181 sub complete_option {
1182 my($word,$line,$pos) = @_;
1184 my(@words) = split " ", $line;
1185 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1186 my(@ok) = qw(conf debug);
1187 return @ok if @words==1;
1188 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1190 } elsif ($words[1] eq 'index') {
1192 } elsif ($words[1] eq 'conf') {
1193 return CPAN::Config::complete(@_);
1194 } elsif ($words[1] eq 'debug') {
1195 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1199 package CPAN::Index;
1200 use vars qw($last_time);
1201 @CPAN::Index::ISA = qw(CPAN::Debug);
1204 #-> sub CPAN::Index::force_reload ;
1207 $CPAN::Index::last_time = 0;
1211 #-> sub CPAN::Index::reload ;
1213 my($cl,$force) = @_;
1216 # XXX check if a newer one is available. (We currently read it from time to time)
1217 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1220 $cl->read_authindex($cl->reload_x("authors/01mailrc.txt.gz","01mailrc.gz",$force));
1221 return if $CPAN::Signal; # this is sometimes lengthy
1222 $cl->read_modpacks($cl->reload_x("modules/02packages.details.txt.gz","02packag.gz",$force));
1223 return if $CPAN::Signal; # this is sometimes lengthy
1224 $cl->read_modlist($cl->reload_x("modules/03modlist.data.gz","03mlist.gz",$force));
1227 #-> sub CPAN::Index::reload_x ;
1229 my($cl,$wanted,$localname,$force) = @_;
1231 my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
1232 if (-f $abs_wanted && -M $abs_wanted < $CPAN::Config->{'index_expire'} && !$force) {
1233 my($s) = $CPAN::Config->{'index_expire'} != 1;
1234 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} day$s. I\'ll use that.\n});
1239 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1242 #-> sub CPAN::Index::read_authindex ;
1243 sub read_authindex {
1244 my($cl,$index_target) = @_;
1245 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1246 warn "Going to read $index_target\n";
1247 my $fh = FileHandle->new("$pipe|");
1250 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1251 next unless $userid && $fullname && $email;
1253 # instantiate an author object
1254 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
1255 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
1256 return if $CPAN::Signal;
1259 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1262 #-> sub CPAN::Index::read_modpacks ;
1264 my($cl,$index_target) = @_;
1265 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1266 warn "Going to read $index_target\n";
1267 my $fh = FileHandle->new("$pipe|");
1271 my($mod,$version,$dist) = split;
1272 $version =~ s/^\+//;
1274 # if it as a bundle, instatiate a bundle object
1276 if ($mod =~ /^Bundle::(.*)/) {
1280 if ($mod eq 'CPAN') {
1282 if ($version > $CPAN::VERSION){
1284 Hey, you know what? There\'s a new CPAN.pm version (v$version)
1285 available! I\'d suggest--provided you have time--you try
1288 without quitting the current session. It should be a seemless upgrade
1289 while we are running...
1298 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
1299 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1300 # This "next" makes us faster but if the job is running long, we ignore
1301 # rereads which is bad. So we have to be a bit slower again.
1302 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
1305 # instantiate a module object
1306 $id = $CPAN::META->instance('CPAN::Module',$mod);
1307 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1310 # determine the author
1311 my($userid) = $dist =~ /([^\/]+)/;
1312 $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
1314 # instantiate a distribution object
1315 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1316 $CPAN::META->instance(
1317 'CPAN::Distribution' => $dist
1319 'CPAN_USERID' => $userid
1324 return if $CPAN::Signal;
1327 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1330 #-> sub CPAN::Index::read_modlist ;
1332 my($cl,$index_target) = @_;
1333 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1334 warn "Going to read $index_target\n";
1335 my $fh = FileHandle->new("$pipe|");
1339 next if /use vars/; # will go away in 03...
1341 return if $CPAN::Signal;
1343 $eval .= q{CPAN::Modulelist->data;};
1345 my($comp) = Safe->new("CPAN::Safe1");
1346 my $ret = $comp->reval($eval);
1347 Carp::confess($@) if $@;
1348 return if $CPAN::Signal;
1350 my $obj = $CPAN::META->instance(CPAN::Module,$_);
1351 $obj->set(%{$ret->{$_}});
1352 return if $CPAN::Signal;
1356 package CPAN::InfoObj;
1357 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
1359 #-> sub CPAN::InfoObj::new ;
1360 sub new { my $this = bless {}, shift; %$this = @_; $this }
1362 #-> sub CPAN::InfoObj::set ;
1364 my($self,%att) = @_;
1365 my(%oldatt) = %$self;
1366 %$self = (%oldatt, %att);
1369 #-> sub CPAN::InfoObj::id ;
1370 sub id { shift->{'ID'} }
1372 #-> sub CPAN::InfoObj::as_glimpse ;
1376 my $class = ref($self);
1377 $class =~ s/^CPAN:://;
1378 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
1382 #-> sub CPAN::InfoObj::as_string ;
1386 my $class = ref($self);
1387 $class =~ s/^CPAN:://;
1388 push @m, $class, " id = $self->{ID}\n";
1389 for (sort keys %$self) {
1392 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
1393 if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
1394 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
1396 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
1402 #-> sub CPAN::InfoObj::author ;
1405 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
1408 package CPAN::Author;
1409 @CPAN::Author::ISA = qw(CPAN::Debug CPAN::InfoObj);
1411 #-> sub CPAN::Author::as_glimpse ;
1415 my $class = ref($self);
1416 $class =~ s/^CPAN:://;
1417 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
1421 # Dead code, I would have liked to have,,, but it was never reached,,,
1424 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
1427 #-> sub CPAN::Author::fullname ;
1428 sub fullname { shift->{'FULLNAME'} }
1430 #-> sub CPAN::Author::email ;
1431 sub email { shift->{'EMAIL'} }
1433 package CPAN::Distribution;
1434 @CPAN::Distribution::ISA = qw(CPAN::Debug CPAN::InfoObj);
1436 #-> sub CPAN::Distribution::called_for ;
1439 $self->{'CALLED_FOR'} = $id if defined $id;
1440 return $self->{'CALLED_FOR'};
1443 #-> sub CPAN::Distribution::get ;
1448 exists $self->{'build_dir'} and push @e, "Unwrapped into directory $self->{'build_dir'}";
1449 print join "", map {" $_\n"} @e and return if @e;
1454 $CPAN::Config->{keep_source_where},
1457 split("/",$self->{ID})
1460 $self->debug("Doing localize") if $CPAN::DEBUG;
1461 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
1462 $self->{localfile} = $local_file;
1463 my $builddir = $CPAN::META->{cachemgr}->dir;
1464 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
1465 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
1468 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
1469 if ($CPAN::META->hasMD5) {
1472 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
1473 $self->debug("Removing tmp") if $CPAN::DEBUG;
1474 File::Path::rmtree("tmp");
1475 mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
1477 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
1478 if ($local_file =~ /z$/i){
1479 $self->{archived} = "tar";
1480 if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
1481 $self->{unwrapped} = "YES";
1483 $self->{unwrapped} = "NO";
1485 } elsif ($local_file =~ /zip$/i) {
1486 $self->{archived} = "zip";
1487 if (system("$CPAN::Config->{unzip} $local_file")==0) {
1488 $self->{unwrapped} = "YES";
1490 $self->{unwrapped} = "NO";
1493 # Let's check if the package has its own directory.
1494 opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
1495 my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
1497 my ($distdir,$packagedir);
1498 if (@readdir == 1 && -d $readdir[0]) {
1499 $distdir = $readdir[0];
1500 $packagedir = $CPAN::META->catdir($builddir,$distdir);
1501 -d $packagedir and print "Removing previously used $packagedir\n";
1502 File::Path::rmtree($packagedir);
1503 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
1505 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
1506 $pragmatic_dir =~ s/\W_//g;
1507 $pragmatic_dir++ while -d "../$pragmatic_dir";
1508 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
1509 File::Path::mkpath($packagedir);
1511 for $f (@readdir) { # is already without "." and ".."
1512 my $to = $CPAN::META->catdir($packagedir,$f);
1513 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
1516 $self->{'build_dir'} = $packagedir;
1519 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") if $CPAN::DEBUG;
1520 File::Path::rmtree("tmp");
1521 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
1522 print "Going to unlink $local_file\n";
1523 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
1525 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
1526 unless (-f $makefilepl) {
1527 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
1528 if (-f $configure) {
1529 # do we have anything to do?
1530 $self->{'configure'} = $configure;
1532 my $fh = FileHandle->new(">$makefilepl") or Carp::croak("Could not open >$makefilepl");
1533 my $cf = $self->called_for || "unknown";
1535 # This Makefile.PL has been autogenerated by the module CPAN.pm
1536 # Autogenerated on: }.scalar localtime().qq{
1537 use ExtUtils::MakeMaker;
1538 WriteMakefile(NAME => q[$cf]);
1540 print qq{Package comes without Makefile.PL.\n}.
1541 qq{ Writing one on our own (calling it $cf)\n};
1545 $self->{archived} = "NO";
1550 #-> sub CPAN::Distribution::new ;
1552 my($class,%att) = @_;
1554 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
1556 my $this = { %att };
1557 return bless $this, $class;
1560 #-> sub CPAN::Distribution::look ;
1563 if ( $CPAN::Config->{'shell'} ) {
1565 Trying to open a subshell in the build directory...
1569 Your configuration does not define a value for subshells.
1570 Please define it with "o conf shell <your shell>"
1574 my $dist = $self->id;
1575 my $dir = $self->dir or $self->get;
1577 my $pwd = Cwd::cwd();
1579 print qq{Working directory is $dir.\n};
1580 system($CPAN::Config->{'shell'})==0 or die "Subprocess shell error";
1584 #-> sub CPAN::Distribution::readme ;
1587 my($dist) = $self->id;
1588 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
1589 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
1593 $CPAN::Config->{keep_source_where},
1596 split("/","$sans.readme"),
1598 $self->debug("Doing localize") if $CPAN::DEBUG;
1599 $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
1600 my $fh_pager = FileHandle->new;
1601 $fh_pager->open("|$CPAN::Config->{'pager'}") or die "Could not open pager $CPAN::Config->{'pager'}: $!";
1602 my $fh_readme = FileHandle->new;
1603 $fh_readme->open($local_file) or die "Could not open $local_file: $!";
1604 $fh_pager->print(<$fh_readme>);
1607 #-> sub CPAN::Distribution::verifyMD5 ;
1612 $self->{MD5_STATUS} and push @e, "MD5 Checksum was ok";
1613 print join "", map {" $_\n"} @e and return if @e;
1616 my(@local) = split("/",$self->{ID});
1617 my($basename) = pop @local;
1618 push @local, "CHECKSUMS";
1621 $CPAN::Config->{keep_source_where},
1630 $self->MD5_check_file($local_wanted,$basename)
1632 return $self->{MD5_STATUS}="OK";
1634 $local_file = CPAN::FTP->localize("authors/id/@local", $local_wanted, 'force>:-{');
1639 $local[-1] .= ".gz";
1640 $local_file = CPAN::FTP->localize(
1641 "authors/id/@local",
1645 my $system = "$CPAN::Config->{gzip} --decompress $local_file";
1646 system($system)==0 or die "Could not uncompress $local_file";
1647 $local_file =~ s/\.gz$//;
1649 $self->MD5_check_file($local_file,$basename);
1652 #-> sub CPAN::Distribution::MD5_check_file ;
1653 sub MD5_check_file {
1654 my($self,$lfile,$basename) = @_;
1656 my $fh = new FileHandle;
1658 if (open $fh, $lfile){
1661 my($comp) = Safe->new();
1662 $cksum = $comp->reval($eval);
1663 Carp::confess($@) if $@;
1664 if ($cksum->{$basename}->{md5}) {
1665 $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
1666 my $file = $self->{localfile};
1667 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
1669 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
1671 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
1673 print "Checksum for $file ok\n";
1674 return $self->{MD5_STATUS}="OK";
1678 "\nChecksum mismatch for distribution file. Please investigate.\n\n",
1680 $CPAN::META->instance('CPAN::Author',$self->{CPAN_USERID})->as_string,
1681 "Please contact the author or your CPAN site admin"
1684 close $fh if fileno($fh);
1686 print "No md5 checksum for $basename in local $lfile\n";
1690 Carp::carp "Could not open $lfile for reading";
1694 #-> sub CPAN::Distribution::eq_MD5 ;
1696 my($self,$fh,$expectMD5) = @_;
1699 my $hexdigest = $md5->hexdigest;
1700 $hexdigest eq $expectMD5;
1703 #-> sub CPAN::Distribution::force ;
1706 $self->{'force_update'}++;
1707 delete $self->{'MD5_STATUS'};
1708 delete $self->{'archived'};
1709 delete $self->{'build_dir'};
1710 delete $self->{'localfile'};
1711 delete $self->{'make'};
1712 delete $self->{'install'};
1713 delete $self->{'unwrapped'};
1714 delete $self->{'writemakefile'};
1717 #-> sub CPAN::Distribution::make ;
1720 $self->debug($self->id) if $CPAN::DEBUG;
1721 print "Running make\n";
1725 $self->{archived} eq "NO" and push @e, "Is neither a tar nor a zip archive.";
1726 $self->{unwrapped} eq "NO" and push @e, "had problems unarchiving. Please build manually";
1727 exists $self->{writemakefile} && $self->{writemakefile} eq "NO" and push @e, "Had some problem writing Makefile";
1728 defined $self->{'make'} and push @e, "Has already been processed within this session";
1729 print join "", map {" $_\n"} @e and return if @e;
1731 print "\n CPAN.pm: Going to build ".$self->id."\n\n";
1732 my $builddir = $self->dir;
1733 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
1734 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
1737 if ($self->{'configure'}) {
1738 $system = $self->{'configure'};
1740 my($perl) = $^X =~ /^\.\// ? "$CPAN::Cwd/$^X" : $^X; # XXX subclassing folks, forgive me!
1741 $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
1743 $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
1746 if ($CPAN::Config->{inactivity_timeout}) {
1748 alarm $CPAN::Config->{inactivity_timeout};
1749 #$SIG{CHLD} = \&REAPER;
1750 if (defined($pid=fork)) {
1757 print "Cannot fork: $!";
1760 $ret = system($system);
1764 $ret = system($system);
1770 $self->{writemakefile} = "NO - $@";
1773 } elsif ($ret != 0) {
1774 $self->{writemakefile} = "NO";
1777 $self->{writemakefile} = "YES";
1778 return if $CPAN::Signal;
1779 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
1780 if (system($system)==0) {
1781 print " $system -- OK\n";
1782 $self->{'make'} = "YES";
1784 $self->{writemakefile} = "YES";
1785 $self->{'make'} = "NO";
1786 print " $system -- NOT OK\n";
1790 #-> sub CPAN::Distribution::test ;
1794 return if $CPAN::Signal;
1795 print "Running make test\n";
1798 exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't test";
1799 exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
1800 exists $self->{'build_dir'} or push @e, "Has no own directory";
1801 print join "", map {" $_\n"} @e and return if @e;
1803 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1804 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1805 my $system = join " ", $CPAN::Config->{'make'}, "test";
1806 if (system($system)==0) {
1807 print " $system -- OK\n";
1808 $self->{'make_test'} = "YES";
1810 $self->{'make_test'} = "NO";
1811 print " $system -- NOT OK\n";
1815 #-> sub CPAN::Distribution::clean ;
1818 print "Running make clean\n";
1821 exists $self->{'build_dir'} or push @e, "Has no own directory";
1822 print join "", map {" $_\n"} @e and return if @e;
1824 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1825 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1826 my $system = join " ", $CPAN::Config->{'make'}, "clean";
1827 if (system($system)==0) {
1828 print " $system -- OK\n";
1831 # Hmmm, what to do if make clean failed?
1835 #-> sub CPAN::Distribution::install ;
1839 return if $CPAN::Signal;
1840 print "Running make install\n";
1843 exists $self->{'build_dir'} or push @e, "Has no own directory";
1844 exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't install";
1845 exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
1846 exists $self->{'install'} and push @e, $self->{'install'} eq "YES" ? "Already done" : "Already tried without success";
1847 print join "", map {" $_\n"} @e and return if @e;
1849 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1850 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1851 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
1852 my($pipe) = FileHandle->new("$system 2>&1 |");
1860 print " $system -- OK\n";
1861 $self->{'install'} = "YES";
1863 $self->{'install'} = "NO";
1864 print " $system -- NOT OK\n";
1865 if ($makeout =~ /permission/s && $> > 0) {
1866 print " You may have to su to root to install the package\n";
1871 #-> sub CPAN::Distribution::dir ;
1873 shift->{'build_dir'};
1876 package CPAN::Bundle;
1877 @CPAN::Bundle::ISA = qw(CPAN::Debug CPAN::InfoObj CPAN::Module);
1879 #-> sub CPAN::Bundle::as_string ;
1883 return $self->SUPER::as_string;
1886 #-> sub CPAN::Bundle::contains ;
1889 my($parsefile) = $self->inst_file;
1890 unless ($parsefile) {
1891 # Try to get at it in the cpan directory
1892 $self->debug("no parsefile") if $CPAN::DEBUG;
1893 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
1894 $self->debug($dist->as_string) if $CPAN::DEBUG;
1896 $self->debug($dist->as_string) if $CPAN::DEBUG;
1897 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1898 File::Path::mkpath($todir);
1900 ($me = $self->id) =~ s/.*://;
1901 $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
1902 $to = $CPAN::META->catfile($todir,"$me.pm");
1903 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
1907 my $fh = new FileHandle;
1909 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
1912 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
1917 push @result, (split " ", $_, 2)[0];
1920 delete $self->{STATUS};
1921 $self->{CONTAINS} = [@result];
1925 #-> sub CPAN::Bundle::inst_file ;
1929 ($me = $self->id) =~ s/.*://;
1930 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
1931 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
1932 $inst_file = $self->SUPER::inst_file;
1933 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
1934 return $self->{'INST_FILE'}; # even if undefined?
1937 #-> sub CPAN::Bundle::rematein ;
1939 my($self,$meth) = @_;
1940 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
1942 for $s ($self->contains) {
1943 $CPAN::META->instance('CPAN::Module',$s)->$meth();
1947 #-> sub CPAN::Bundle::force ;
1948 sub force { shift->rematein('force',@_); }
1949 #-> sub CPAN::Bundle::get ;
1950 sub get { shift->rematein('get',@_); }
1951 #-> sub CPAN::Bundle::make ;
1952 sub make { shift->rematein('make',@_); }
1953 #-> sub CPAN::Bundle::test ;
1954 sub test { shift->rematein('test',@_); }
1955 #-> sub CPAN::Bundle::install ;
1956 sub install { shift->rematein('install',@_); }
1957 #-> sub CPAN::Bundle::clean ;
1958 sub clean { shift->rematein('clean',@_); }
1960 #-> sub CPAN::Bundle::readme ;
1963 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
1964 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
1965 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
1968 package CPAN::Module;
1969 @CPAN::Module::ISA = qw(CPAN::Debug CPAN::InfoObj);
1971 #-> sub CPAN::Module::as_glimpse ;
1975 my $class = ref($self);
1976 $class =~ s/^CPAN:://;
1977 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
1981 #-> sub CPAN::Module::as_string ;
1985 CPAN->debug($self) if $CPAN::DEBUG;
1986 my $class = ref($self);
1987 $class =~ s/^CPAN:://;
1989 push @m, $class, " id = $self->{ID}\n";
1990 my $sprintf = " %-12s %s\n";
1991 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
1992 my $sprintf2 = " %-12s %s (%s)\n";
1994 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
1999 $CPAN::META->instance(CPAN::Author,$userid)->fullname
2002 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
2003 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
2004 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
2005 my(%statd,%stats,%statl,%stati);
2006 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
2007 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
2008 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
2009 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
2010 $statd{' '} = 'unknown';
2011 $stats{' '} = 'unknown';
2012 $statl{' '} = 'unknown';
2013 $stati{' '} = 'unknown';
2021 $statd{$self->{statd}},
2022 $stats{$self->{stats}},
2023 $statl{$self->{statl}},
2024 $stati{$self->{stati}}
2025 ) if $self->{statd};
2026 my $local_file = $self->inst_file;
2027 if ($local_file && ! exists $self->{MANPAGE}) {
2028 my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
2033 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
2041 $self->{MANPAGE} = join " ", @result;
2043 push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE};
2044 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
2045 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
2049 #-> sub CPAN::Module::cpan_file ;
2052 CPAN->debug($self->id) if $CPAN::DEBUG;
2053 unless (defined $self->{'CPAN_FILE'}) {
2054 CPAN::Index->reload;
2056 if (defined $self->{'CPAN_FILE'}){
2057 return $self->{'CPAN_FILE'};
2058 } elsif (defined $self->{'userid'}) {
2059 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
2065 *name = \&cpan_file;
2067 #-> sub CPAN::Module::cpan_version ;
2068 sub cpan_version { shift->{'CPAN_VERSION'} }
2070 #-> sub CPAN::Module::force ;
2073 $self->{'force_update'}++;
2076 #-> sub CPAN::Module::rematein ;
2078 my($self,$meth) = @_;
2079 $self->debug($self->id) if $CPAN::DEBUG;
2080 my $cpan_file = $self->cpan_file;
2081 return if $cpan_file eq "N/A";
2082 return if $cpan_file =~ /^Contact Author/;
2083 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2084 $pack->called_for($self->id);
2085 $pack->force if exists $self->{'force_update'};
2087 delete $self->{'force_update'};
2090 #-> sub CPAN::Module::readme ;
2091 sub readme { shift->rematein('readme') }
2092 #-> sub CPAN::Module::look ;
2093 sub look { shift->rematein('look') }
2094 #-> sub CPAN::Module::get ;
2095 sub get { shift->rematein('get',@_); }
2096 #-> sub CPAN::Module::make ;
2097 sub make { shift->rematein('make') }
2098 #-> sub CPAN::Module::test ;
2099 sub test { shift->rematein('test') }
2100 #-> sub CPAN::Module::install ;
2104 my($latest) = $self->cpan_version;
2106 my($inst_file) = $self->inst_file;
2108 if (defined $inst_file) {
2109 $have = $self->inst_version;
2111 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
2112 print $self->id, " is up to date.\n";
2116 $self->rematein('install') if $doit;
2118 #-> sub CPAN::Module::clean ;
2119 sub clean { shift->rematein('clean') }
2121 #-> sub CPAN::Module::inst_file ;
2125 @packpath = split /::/, $self->{ID};
2126 $packpath[-1] .= ".pm";
2127 foreach $dir (@INC) {
2128 my $pmfile = CPAN->catfile($dir,@packpath);
2135 #-> sub CPAN::Module::xs_file ;
2139 @packpath = split /::/, $self->{ID};
2140 push @packpath, $packpath[-1];
2141 $packpath[-1] .= "." . $Config::Config{'dlext'};
2142 foreach $dir (@INC) {
2143 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
2150 #-> sub CPAN::Module::inst_version ;
2153 my $parsefile = $self->inst_file or return 0;
2154 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
2155 my $have = MY->parse_version($parsefile);
2162 package CPAN::CacheMgr;
2164 @CPAN::CacheMgr::ISA = qw(CPAN::Debug CPAN::InfoObj);
2167 #-> sub CPAN::CacheMgr::as_string ;
2169 eval { require Data::Dumper };
2171 return shift->SUPER::as_string;
2173 return Data::Dumper::Dumper(shift);
2177 #-> sub CPAN::CacheMgr::cachesize ;
2183 # my($self,@dirs) = @_;
2184 # return unless -d $self->{ID};
2186 # @dirs = $self->dirs unless @dirs;
2187 # for $dir (@dirs) {
2188 # $self->disk_usage($dir);
2192 #-> sub CPAN::CacheMgr::clean_cache ;
2196 while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
2197 $self->force_clean_cache($dir);
2199 $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
2202 #-> sub CPAN::CacheMgr::dir ;
2207 #-> sub CPAN::CacheMgr::entries ;
2209 my($self,$dir) = @_;
2210 $dir ||= $self->{ID};
2211 my($cwd) = Cwd::cwd();
2212 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
2213 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
2216 next if $_ eq "." || $_ eq "..";
2218 push @entries, $CPAN::META->catfile($dir,$_);
2220 push @entries, $CPAN::META->catdir($dir,$_);
2222 print STDERR "Warning: weird direntry in $dir: $_\n";
2225 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
2226 sort {-M $b <=> -M $a} @entries;
2229 #-> sub CPAN::CacheMgr::disk_usage ;
2231 my($self,$dir) = @_;
2232 if (! defined $dir or $dir eq "") {
2233 $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
2236 return if defined $self->{SIZE}{$dir};
2245 $self->{SIZE}{$dir} = $Du/1024/1024;
2246 push @{$self->{FIFO}}, $dir;
2247 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
2248 $self->{DU} += $Du/1024/1024;
2249 if ($self->{DU} > $self->{'MAX'} ) {
2250 printf "...Hold on a sec... CPAN's cleaning the cache: %.2f MB > %.2f MB\n",
2251 $self->{DU}, $self->{'MAX'};
2254 $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}") if $CPAN::DEBUG;
2255 $self->debug($self->as_string) if $CPAN::DEBUG;
2260 #-> sub CPAN::CacheMgr::force_clean_cache ;
2261 sub force_clean_cache {
2262 my($self,$dir) = @_;
2263 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}") if $CPAN::DEBUG;
2264 File::Path::rmtree($dir);
2265 $self->{DU} -= $self->{SIZE}{$dir};
2266 delete $self->{SIZE}{$dir};
2269 #-> sub CPAN::CacheMgr::new ;
2272 my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, DU => 0 };
2273 File::Path::mkpath($self->{ID});
2274 my $dh = DirHandle->new($self->{ID});
2275 bless $self, $class;
2276 $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
2278 for $e ($self->entries) {
2279 next if $e eq ".." || $e eq ".";
2280 $self->debug("Have to check size $e") if $CPAN::DEBUG;
2281 $self->disk_usage($e);
2286 package CPAN::Debug;
2288 #-> sub CPAN::Debug::debug ;
2290 my($self,$arg) = @_;
2291 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg Complete, caller(1) eg readline
2292 ($caller) = caller(0);
2293 $caller =~ s/.*:://;
2294 # print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
2295 # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
2296 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
2298 eval { require Data::Dumper };
2300 print $arg->as_string;
2302 print Data::Dumper::Dumper($arg);
2305 print "Debug($caller:$func,$line,@rest): $arg\n"
2310 package CPAN::Config;
2311 import ExtUtils::MakeMaker 'neatvalue';
2315 'commit' => "Commit changes to disk",
2316 'defaults' => "Reload defaults from disk",
2319 #-> sub CPAN::Config::edit ;
2321 my($class,@args) = @_;
2322 return unless @args;
2323 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
2324 my($o,$str,$func,$args,$key_exists);
2330 if (ref($CPAN::Config->{$o}) eq ARRAY) {
2331 $func = shift @args;
2332 # Let's avoid eval, it's easier to comprehend without.
2333 if ($func eq "push") {
2334 push @{$CPAN::Config->{$o}}, @args;
2335 } elsif ($func eq "pop") {
2336 pop @{$CPAN::Config->{$o}};
2337 } elsif ($func eq "shift") {
2338 shift @{$CPAN::Config->{$o}};
2339 } elsif ($func eq "unshift") {
2340 unshift @{$CPAN::Config->{$o}}, @args;
2341 } elsif ($func eq "splice") {
2342 splice @{$CPAN::Config->{$o}}, @args;
2344 $CPAN::Config->{$o} = [@args];
2347 $CPAN::Config->{$o} = $args[0] if defined $args[0];
2349 print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
2354 #-> sub CPAN::Config::commit ;
2356 my($self, $configpm) = @_;
2360 my($fh) = FileHandle->new;
2361 $configpm ||= cfile();
2363 $mode = (stat $configpm)[2];
2364 if ($mode && ! -w _) {
2365 print "$configpm is not writable\n" and return;
2367 #chmod 0644, $configpm; #?
2370 my $msg = <<EOF unless $configpm =~ /MyConfig/;
2372 # This is CPAN.pm's systemwide configuration file. This file provides
2373 # defaults for users, and the values can be changed in a per-user configuration
2374 # file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
2378 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
2379 print $fh qq[$msg\$CPAN::Config = \{\n];
2380 foreach (sort keys %$CPAN::Config) {
2381 print $fh " '$_' => ", ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}), ",\n";
2384 print $fh "};\n1;\n__END__\n";
2387 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
2388 #chmod $mode, $configpm;
2390 print "commit: wrote $configpm\n";
2394 *default = \&defaults;
2395 #-> sub CPAN::Config::defaults ;
2404 #-> sub CPAN::Config::load ;
2407 eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems
2408 unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
2409 eval {require CPAN::MyConfig;}; # where you can override system wide settings
2410 unless ( $self->load_succeeded ) {
2411 require CPAN::FirstTime;
2413 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
2414 $configpm = $INC{"CPAN/Config.pm"};
2415 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
2416 $configpm = $INC{"CPAN/MyConfig.pm"};
2418 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
2419 my($configpmdir) = MY->catdir($path_to_cpan,"CPAN");
2420 my($configpmtest) = MY->catfile($configpmdir,"Config.pm");
2421 if (-d $configpmdir || File::Path::mkpath($configpmdir)) {
2422 if (-w $configpmtest or -w $configpmdir) {
2423 $configpm = $configpmtest;
2426 unless ($configpm) {
2427 $configpmdir = MY->catdir($ENV{HOME},".cpan","CPAN");
2428 File::Path::mkpath($configpmdir);
2429 $configpmtest = MY->catfile($configpmdir,"MyConfig.pm");
2430 if (-w $configpmtest or -w $configpmdir) {
2431 $configpm = $configpmtest;
2433 warn "WARNING: CPAN.pm is unable to create a configuration file.\n";
2437 warn "Calling CPAN::FirstTime::init($configpm)";
2438 CPAN::FirstTime::init($configpm);
2442 #-> sub CPAN::Config::load_succeeded ;
2443 sub load_succeeded {
2446 cpan_home keep_source_where build_dir build_cache index_expire
2447 gzip tar unzip make pager makepl_arg make_arg make_install_arg
2448 urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
2450 unless (defined $CPAN::Config->{$_}){
2452 CPAN->debug("undefined configuration parameter $_") if $CPAN::DEBUG;
2458 #-> sub CPAN::Config::unload ;
2460 delete $INC{'CPAN/MyConfig.pm'};
2461 delete $INC{'CPAN/Config.pm'};
2464 #-> sub CPAN::Config::cfile ;
2466 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'};
2470 #-> sub CPAN::Config::help ;
2474 defaults reload default config values from disk
2475 commit commit session changes to disk
2477 You may edit key values in the follow fashion:
2479 o conf build_cache 15
2481 o conf build_dir "/foo/bar"
2483 o conf urllist shift
2485 o conf urllist unshift ftp://ftp.foo.bar/
2488 undef; #don't reprint CPAN::Config
2491 #-> sub CPAN::Config::complete ;
2493 my($word,$line,$pos) = @_;
2495 my(@words) = split " ", $line;
2496 my(@o_conf) = (sort keys %CPAN::Config::can, sort keys %$CPAN::Config);
2497 return (@o_conf) unless @words>2;
2498 if($words[2] =~ /->(.*)/) {
2500 my(@methods) = qw(shift unshift push pop splice);
2501 return @methods unless $meth;
2502 return sort grep /^\Q$meth\E/, @methods;
2504 return sort grep /^\Q$word\E/, @o_conf;
2511 CPAN - query, download and build perl modules from CPAN sites
2517 perl -MCPAN -e shell;
2523 autobundle, clean, install, make, recompile, test
2527 The CPAN module is designed to automate the make and install of perl
2528 modules and extensions. It includes some searching capabilities and
2529 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
2530 to fetch the raw data from the net.
2532 Modules are fetched from one or more of the mirrored CPAN
2533 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
2536 The CPAN module also supports the concept of named and versioned
2537 'bundles' of modules. Bundles simplify the handling of sets of
2538 related modules. See BUNDLES below.
2540 The package contains a session manager and a cache manager. There is
2541 no status retained between sessions. The session manager keeps track
2542 of what has been fetched, built and installed in the current
2543 session. The cache manager keeps track of the disk space occupied by
2544 the make processes and deletes excess space according to a simple FIFO
2547 All methods provided are accessible in a programmer style and in an
2548 interactive shell style.
2550 =head2 Interactive Mode
2552 The interactive mode is entered by running
2554 perl -MCPAN -e shell
2556 which puts you into a readline interface. You will have most fun if
2557 you install Term::ReadKey and Term::ReadLine to enjoy both history and
2560 Once you are on the command line, type 'h' and the rest should be
2563 The most common uses of the interactive modes are
2567 =item Searching for authors, bundles, distribution files and modules
2569 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
2570 for each of the four categories and another, C<i> for any of the
2571 mentioned four. Each of the four entities is implemented as a class
2572 with slightly differing methods for displaying an object.
2574 Arguments you pass to these commands are either strings matching exact
2575 the identification string of an object or regular expressions that are
2576 then matched case-insensitively against various attributes of the
2577 objects. The parser recognizes a regualar expression only if you
2578 enclose it between two slashes.
2580 The principle is that the number of found objects influences how an
2581 item is displayed. If the search finds one item, we display the result
2582 of object-E<gt>as_string, but if we find more than one, we display
2583 each as object-E<gt>as_glimpse. E.g.
2587 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2588 FULLNAME Andreas König
2593 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2594 FULLNAME Andreas König
2598 Author ANDYD (Andy Dougherty)
2599 Author MERLYN (Randal L. Schwartz)
2601 =item make, test, install, clean modules or distributions
2603 These commands do indeed exist just as written above. Each of them
2604 takes any number of arguments and investigates for each what it might
2605 be. Is it a distribution file (recognized by embedded slashes), this
2606 file is being processed. Is it a module, CPAN determines the
2607 distribution file where this module is included and processes that.
2609 Any C<make>, C<test>, and C<readme> are run unconditionally. A
2611 C<install E<lt>distribution_fileE<gt>>
2613 also is run unconditionally. But for
2615 C<install E<lt>moduleE<gt>>
2617 CPAN checks if an install is actually needed for it and prints
2618 I<Foo up to date> in case the module doesnE<39>t need to be updated.
2620 CPAN also keeps track of what it has done within the current session
2621 and doesnE<39>t try to build a package a second time regardless if it
2622 succeeded or not. The C<force > command takes as first argument the
2623 method to invoke (currently: make, test, or install) and executes the
2624 command from scratch.
2628 cpan> install OpenGL
2629 OpenGL is up to date.
2630 cpan> force install OpenGL
2633 OpenGL-0.4/COPYRIGHT
2636 =item readme, look module or distribution
2638 These two commands take only one argument, be it a module or a
2639 distribution file. C<readme> displays the README of the associated
2640 distribution file. C<Look> gets and untars (if not yet done) the
2641 distribution file, changes to the appropriate directory and opens a
2642 subshell process in that directory.
2648 The commands that are available in the shell interface are methods in
2649 the package CPAN::Shell. If you enter the shell command, all your
2650 input is split by the Text::ParseWords::shellwords() routine which
2651 acts like most shells do. The first word is being interpreted as the
2652 method to be called and the rest of the words are treated as arguments
2657 C<autobundle> writes a bundle file into the
2658 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
2659 a list of all modules that are both available from CPAN and currently
2660 installed within @INC. The name of the bundle file is based on the
2661 current date and a counter.
2665 recompile() is a very special command in that it takes no argument and
2666 runs the make/test/install cycle with brute force over all installed
2667 dynamically loadable extensions (aka XS modules) with 'force' in
2668 effect. Primary purpose of this command is to finish a network
2669 installation. Imagine, you have a common source tree for two different
2670 architectures. You decide to do a completely independent fresh
2671 installation. You start on one architecture with the help of a Bundle
2672 file produced earlier. CPAN installs the whole Bundle for you, but
2673 when you try to repeat the job on the second architecture, CPAN
2674 responds with a C<"Foo up to date"> message for all modules. So you
2675 will be glad to run recompile in the second architecture and
2678 Another popular use for C<recompile> is to act as a rescue in case your
2679 perl breaks binary compatibility. If one of the modules that CPAN uses
2680 is in turn depending on binary compatibility (so you cannot run CPAN
2681 commands), then you should try the CPAN::Nox module for recovery.
2683 =head2 ProgrammerE<39>s interface
2685 If you do not enter the shell, the available shell commands are both
2686 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
2687 functions in the calling package (C<install(...)>). The
2688 programmerE<39>s interface has beta status. Do not heavily rely on it,
2689 changes may still be necessary.
2691 =head2 Cache Manager
2693 Currently the cache manager only keeps track of the build directory
2694 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
2695 deletes complete directories below C<build_dir> as soon as the size of
2696 all directories there gets bigger than $CPAN::Config->{build_cache}
2697 (in MB). The contents of this cache may be used for later
2698 re-installations that you intend to do manually, but will never be
2699 trusted by CPAN itself. This is due to the fact that the user might
2700 use these directories for building modules on different architectures.
2702 There is another directory ($CPAN::Config->{keep_source_where}) where
2703 the original distribution files are kept. This directory is not
2704 covered by the cache manager and must be controlled by the user. If
2705 you choose to have the same directory as build_dir and as
2706 keep_source_where directory, then your sources will be deleted with
2707 the same fifo mechanism.
2711 A bundle is just a perl module in the namespace Bundle:: that does not
2712 define any functions or methods. It usually only contains documentation.
2714 It starts like a perl module with a package declaration and a $VERSION
2715 variable. After that the pod section looks like any other pod with the
2716 only difference, that I<one special pod section> exists starting with
2721 In this pod section each line obeys the format
2723 Module_Name [Version_String] [- optional text]
2725 The only required part is the first field, the name of a module
2726 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
2727 of the line is optional. The comment part is delimited by a dash just
2728 as in the man page header.
2730 The distribution of a bundle should follow the same convention as
2731 other distributions.
2733 Bundles are treated specially in the CPAN package. If you say 'install
2734 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
2735 the modules in the CONTENTS section of the pod. You can install your
2736 own Bundles locally by placing a conformant Bundle file somewhere into
2737 your @INC path. The autobundle() command which is available in the
2738 shell interface does that for you by including all currently installed
2739 modules in a snapshot bundle file.
2741 There is a meaningless Bundle::Demo available on CPAN. Try to install
2742 it, it usually does no harm, just demonstrates what the Bundle
2743 interface looks like.
2745 =head2 Prerequisites
2747 If you have a local mirror of CPAN and can access all files with
2748 "file:" URLs, then you only need a perl better than perl5.003 to run
2749 this module. Otherwise Net::FTP is strongly recommended. LWP may be
2750 required for non-UNIX systems or if your nearest CPAN site is
2751 associated with an URL that is not C<ftp:>.
2753 If you have neither Net::FTP nor LWP, there is a fallback mechanism
2754 implemented for an external ftp command or for an external lynx
2757 This module presumes that all packages on CPAN
2763 declare their $VERSION variable in an easy to parse manner. This
2764 prerequisite can hardly be relaxed because it consumes by far too much
2765 memory to load all packages into the running program just to determine
2766 the $VERSION variable . Currently all programs that are dealing with
2767 version use something like this
2769 perl -MExtUtils::MakeMaker -le \
2770 'print MM->parse_version($ARGV[0])' filename
2772 If you are author of a package and wonder if your $VERSION can be
2773 parsed, please try the above method.
2777 come as compressed or gzipped tarfiles or as zip files and contain a
2778 Makefile.PL (well we try to handle a bit more, but without much
2785 The debugging of this module is pretty difficult, because we have
2786 interferences of the software producing the indices on CPAN, of the
2787 mirroring process on CPAN, of packaging, of configuration, of
2788 synchronicity, and of bugs within CPAN.pm.
2790 In interactive mode you can try "o debug" which will list options for
2791 debugging the various parts of the package. The output may not be very
2792 useful for you as it's just a byproduct of my own testing, but if you
2793 have an idea which part of the package may have a bug, it's sometimes
2794 worth to give it a try and send me more specific output. You should
2795 know that "o debug" has built-in completion support.
2797 =head2 Floppy, Zip, and all that Jazz
2799 CPAN.pm works nicely without network too. If you maintain machines
2800 that are not networked at all, you should consider working with file:
2801 URLs. Of course, you have to collect your modules somewhere first. So
2802 you might use CPAN.pm to put together all you need on a networked
2803 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
2804 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
2805 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
2808 =head1 CONFIGURATION
2810 When the CPAN module is installed a site wide configuration file is
2811 created as CPAN/Config.pm. The default values defined there can be
2812 overridden in another configuration file: CPAN/MyConfig.pm. You can
2813 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
2814 $HOME/.cpan is added to the search path of the CPAN module before the
2815 use() or require() statements.
2817 Currently the following keys in the hash reference $CPAN::Config are
2820 build_cache size of cache for directories to build modules
2821 build_dir locally accessible directory to build modules
2822 index_expire after how many days refetch index files
2823 cpan_home local directory reserved for this package
2824 gzip location of external program gzip
2825 inactivity_timeout breaks interactive Makefile.PLs after that
2826 many seconds inactivity. Set to 0 to never break.
2827 inhibit_startup_message
2828 if true, does not print the startup message
2829 keep_source keep the source in a local directory?
2830 keep_source_where where keep the source (if we do)
2831 make location of external program make
2832 make_arg arguments that should always be passed to 'make'
2833 make_install_arg same as make_arg for 'make install'
2834 makepl_arg arguments passed to 'perl Makefile.PL'
2835 pager location of external program more (or any pager)
2836 tar location of external program tar
2837 unzip location of external program unzip
2838 urllist arrayref to nearby CPAN sites (or equivalent locations)
2840 You can set and query each of these options interactively in the cpan
2841 shell with the command set defined within the C<o conf> command:
2845 =item o conf E<lt>scalar optionE<gt>
2847 prints the current value of the I<scalar option>
2849 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
2851 Sets the value of the I<scalar option> to I<value>
2853 =item o conf E<lt>list optionE<gt>
2855 prints the current value of the I<list option> in MakeMaker's
2858 =item o conf E<lt>list optionE<gt> [shift|pop]
2860 shifts or pops the array in the I<list option> variable
2862 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
2864 works like the corresponding perl commands.
2870 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
2871 install foreign, unmasked, unsigned code on your machine. We compare
2872 to a checksum that comes from the net just as the distribution file
2873 itself. If somebody has managed to tamper with the distribution file,
2874 they may have as well tampered with the CHECKSUMS file. Future
2875 development will go towards strong authentification.
2879 Most functions in package CPAN are exported per default. The reason
2880 for this is that the primary use is intended for the cpan shell or for
2885 we should give coverage for _all_ of the CPAN and not just the
2886 __PAUSE__ part, right? In this discussion CPAN and PAUSE have become
2887 equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
2888 PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
2890 Future development should be directed towards a better intergration of
2895 Andreas König E<lt>a.koenig@mind.deE<gt>
2899 perl(1), CPAN::Nox(3)