2 use vars qw{$Try_autoload
3 $META $Signal $Cwd $End $Suppress_readline %Dontload};
7 # $Id: CPAN.pm,v 1.160 1997/07/28 12:21:56 k Exp $
9 # my $version = substr q$Revision: 1.160 $, 10; # only used during development
16 use ExtUtils::MakeMaker ();
17 use File::Basename ();
23 use Text::ParseWords ();
26 END { $End++; &cleanup; }
48 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
51 @CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
56 autobundle bundle expand force get
57 install make readme recompile shell test clean
60 #-> sub CPAN::AUTOLOAD ;
65 @EXPORT{@EXPORT} = '';
66 if (exists $EXPORT{$l}){
69 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
75 warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
85 $Suppress_readline ||= ! -t STDIN;
87 my $prompt = "cpan> ";
89 unless ($Suppress_readline) {
90 require Term::ReadLine;
91 # import Term::ReadLine;
92 $term = Term::ReadLine->new('CPAN Monitor');
93 $readline::rl_completion_function =
94 $readline::rl_completion_function = 'CPAN::Complete::cpl';
100 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
101 my $cwd = CPAN->$getcwd();
102 my $rl_avail = $Suppress_readline ? "suppressed" :
103 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
104 "available (try ``install Bundle::CPAN'')";
107 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
108 Readline support $rl_avail
110 } unless $CPAN::Config->{'inhibit_startup_message'} ;
112 if ($Suppress_readline) {
114 last unless defined ($_ = <> );
117 last unless defined ($_ = $term->readline($prompt));
121 $_ = 'h' if $_ eq '?';
126 use vars qw($import_done);
127 CPAN->import(':DEFAULT') unless $import_done++;
128 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
131 } elsif (/^q(?:uit)?$/i) {
135 if ($] < 5.00322) { # parsewords had a bug until recently
138 eval { @line = Text::ParseWords::shellwords($_) };
139 warn($@), next if $@;
141 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
142 my $command = shift @line;
143 eval { CPAN::Shell->$command(@line) };
147 &cleanup, die "Goodbye\n" if $Signal;
153 package CPAN::CacheMgr;
155 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
158 package CPAN::Config;
159 import ExtUtils::MakeMaker 'neatvalue';
160 use vars qw(%can $dot_cpan);
163 'commit' => "Commit changes to disk",
164 'defaults' => "Reload defaults from disk",
165 'init' => "Interactive setting of all options",
170 @CPAN::FTP::ISA = qw(CPAN::Debug);
172 package CPAN::Complete;
173 @CPAN::Complete::ISA = qw(CPAN::Debug);
176 use vars qw($last_time $date_of_03);
177 @CPAN::Index::ISA = qw(CPAN::Debug);
181 package CPAN::InfoObj;
182 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
184 package CPAN::Author;
185 @CPAN::Author::ISA = qw(CPAN::InfoObj);
187 package CPAN::Distribution;
188 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
190 package CPAN::Bundle;
191 @CPAN::Bundle::ISA = qw(CPAN::Module);
193 package CPAN::Module;
194 @CPAN::Module::ISA = qw(CPAN::InfoObj);
197 use vars qw($AUTOLOAD $redef @ISA);
198 @CPAN::Shell::ISA = qw(CPAN::Debug);
200 #-> sub CPAN::Shell::AUTOLOAD ;
202 my($autoload) = $AUTOLOAD;
203 $autoload =~ s/.*:://;
204 if ($autoload =~ /^w/) {
205 if ($CPAN::META->has_inst('CPAN::WAIT')) {
209 Commands starting with "w" require CPAN::WAIT to be installed.
210 Please consider installing CPAN::WAIT to use the fulltext index.
211 For this you just need to type
216 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
222 warn "CPAN::Shell doesn't know how to autoload $autoload :-(
230 #-> CPAN::Shell::try_dot_al
232 my($class,$autoload) = @_;
233 return unless $CPAN::Try_autoload;
234 # I don't see how to re-use that from the AutoLoader...
236 # Braces used to preserve $1 et al.
238 my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/;
240 if (defined($name=$INC{"$pkg.pm"}))
242 $name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
243 $name = undef unless (-r $name);
245 unless (defined $name)
247 $name = "auto/$autoload.al";
252 eval {local $SIG{__DIE__};require $name};
254 if (substr($autoload,-9) eq '::DESTROY') {
258 if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
259 eval {local $SIG{__DIE__};require $name};
272 my $lm = Carp::longmess();
273 # warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
277 # This should be left to a runtime evaluation
278 eval {require CPAN::WAIT;};
280 unshift @ISA, "CPAN::WAIT";
283 #### autoloader is experimental
284 #### to try it we have to set $Try_autoload and uncomment
285 #### the use statement and uncomment the __END__ below
286 #### You also need AutoSplit 1.01 available. MakeMaker will
287 #### then build CPAN with all the AutoLoad stuff.
291 if ($CPAN::Try_autoload) {
293 CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
294 CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
295 CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
297 *{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD;
304 $META ||= CPAN->new; # In case we reeval ourselves we
307 # Do this after you have set up the whole inheritance
308 CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
312 # __END__ # uncomment this and AutoSplit version 1.01 will split it
314 #-> sub CPAN::autobundle ;
316 #-> sub CPAN::bundle ;
318 #-> sub CPAN::expand ;
320 #-> sub CPAN::force ;
322 #-> sub CPAN::install ;
326 #-> sub CPAN::clean ;
333 my($mgr,$class) = @_;
334 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
336 values %{ $META->{$class} };
339 # Called by shell, not in batch mode. Not clean XXX
340 #-> sub CPAN::checklock ;
343 my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
344 if (-f $lockfile && -M _ > 0) {
345 my $fh = FileHandle->new($lockfile);
348 if (defined $other && $other) {
350 return if $$==$other; # should never happen
351 print qq{There seems to be running another CPAN process }.
352 qq{($other). Trying to contact...\n};
353 if (kill 0, $other) {
354 Carp::croak qq{Other job is running.\n}.
355 qq{You may want to kill it and delete the lockfile, }.
356 qq{maybe. On UNIX try:\n}.
359 } elsif (-w $lockfile) {
361 ExtUtils::MakeMaker::prompt
362 (qq{Other job not responding. Shall I overwrite }.
363 qq{the lockfile? (Y/N)},"y");
364 print("Ok, bye\n"), exit unless $ans =~ /^y/i;
367 qq{Lockfile $lockfile not writeable by you. }.
368 qq{Cannot proceed.\n}.
371 qq{ and then rerun us.\n}
376 File::Path::mkpath($CPAN::Config->{cpan_home});
378 unless ($fh = FileHandle->new(">$lockfile")) {
379 if ($! =~ /Permission/) {
380 my $incc = $INC{'CPAN/Config.pm'};
381 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
384 Your configuration suggests that CPAN.pm should use a working
386 $CPAN::Config->{cpan_home}
387 Unfortunately we could not create the lock file
389 due to permission problems.
391 Please make sure that the configuration variable
392 \$CPAN::Config->{cpan_home}
393 points to a directory where you can write a .lock file. You can set
394 this variable in either
401 Carp::croak "Could not open >$lockfile: $!";
404 $self->{LOCK} = $lockfile;
406 $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
408 my $s = $Signal == 2 ? "a second" : "another";
409 &cleanup, die "Got $s SIGINT" if $Signal;
412 $SIG{'__DIE__'} = \&cleanup;
413 $self->debug("Signal handler set.") if $CPAN::DEBUG;
416 #-> sub CPAN::DESTROY ;
418 &cleanup; # need an eval?
422 sub cwd {Cwd::cwd();}
424 #-> sub CPAN::getcwd ;
425 sub getcwd {Cwd::getcwd();}
427 #-> sub CPAN::exists ;
429 my($mgr,$class,$id) = @_;
431 ### Carp::croak "exists called without class argument" unless $class;
433 exists $META->{$class}{$id};
436 #-> sub CPAN::has_inst
438 my($self,$mod,$message) = @_;
439 Carp::croak("CPAN->has_inst() called without an argument")
441 if (defined $message && $message eq "no") {
444 } elsif (exists $Dontload{$mod}) {
449 $file =~ s|/|\\|g if $^O eq 'MSWin32';
451 if (exists $INC{$file} && $INC{$file}) {
452 # warn "$file in %INC"; #debug
454 } elsif ( my($obj) = CPAN::Shell->expand('Module',$mod) ) {
455 if ($obj->inst_file) {
457 print "CPAN: $mod successfully required\n";
459 if ($mod eq "CPAN::WAIT") {
460 push @CPAN::Shell::ISA, CPAN::WAIT unless $@;
464 } elsif ($mod eq "MD5"){
466 CPAN: MD5 security checks disabled because MD5 not installed.
467 Please consider installing the MD5 module
472 } elsif (eval { require $file }) {
473 # we can still have luck, if the program is fed with a bogus
476 } elsif ($mod eq "Net::FTP") {
478 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
480 install Bundle::libnet
489 #-> sub CPAN::instance ;
491 my($mgr,$class,$id) = @_;
494 $META->{$class}{$id} ||= $class->new(ID => $id );
502 #-> sub CPAN::cleanup ;
504 local $SIG{__DIE__} = '';
505 my $i = 0; my $ineval = 0; my $sub;
506 while ((undef,undef,undef,$sub) = caller(++$i)) {
507 $ineval = 1, last if $sub eq '(eval)';
509 return if $ineval && !$End;
510 return unless defined $META->{'LOCK'};
511 return unless -f $META->{'LOCK'};
512 unlink $META->{'LOCK'};
513 print STDERR "Lockfile removed.\n";
516 package CPAN::CacheMgr;
518 #-> sub CPAN::CacheMgr::as_string ;
520 eval { require Data::Dumper };
522 return shift->SUPER::as_string;
524 return Data::Dumper::Dumper(shift);
528 #-> sub CPAN::CacheMgr::cachesize ;
534 # my($self,@dirs) = @_;
535 # return unless -d $self->{ID};
537 # @dirs = $self->dirs unless @dirs;
539 # $self->disk_usage($dir);
543 #-> sub CPAN::CacheMgr::clean_cache ;
544 #=# sub clean_cache {
545 #=# my $self = shift;
547 #=# while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
548 #=# $self->force_clean_cache($dir);
550 #=# $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
553 #-> sub CPAN::CacheMgr::dir ;
558 #-> sub CPAN::CacheMgr::entries ;
561 return unless defined $dir;
562 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
563 $dir ||= $self->{ID};
565 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
566 my($cwd) = CPAN->$getcwd();
567 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
568 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
571 next if $_ eq "." || $_ eq "..";
573 push @entries, $CPAN::META->catfile($dir,$_);
575 push @entries, $CPAN::META->catdir($dir,$_);
577 print STDERR "Warning: weird direntry in $dir: $_\n";
580 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
581 sort { -M $b <=> -M $a} @entries;
584 #-> sub CPAN::CacheMgr::disk_usage ;
587 # if (! defined $dir or $dir eq "") {
588 # $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
591 return if $self->{SIZE}{$dir};
600 $self->{SIZE}{$dir} = $Du/1024/1024;
601 push @{$self->{FIFO}}, $dir;
602 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
603 $self->{DU} += $Du/1024/1024;
604 if ($self->{DU} > $self->{'MAX'} ) {
605 my($toremove) = shift @{$self->{FIFO}};
606 printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
607 $self->{DU}, $self->{'MAX'};
608 $self->force_clean_cache($toremove);
613 #-> sub CPAN::CacheMgr::force_clean_cache ;
614 sub force_clean_cache {
616 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
618 File::Path::rmtree($dir);
619 $self->{DU} -= $self->{SIZE}{$dir};
620 delete $self->{SIZE}{$dir};
623 #-> sub CPAN::CacheMgr::new ;
630 ID => $CPAN::Config->{'build_dir'},
631 MAX => $CPAN::Config->{'build_cache'},
634 File::Path::mkpath($self->{ID});
635 my $dh = DirHandle->new($self->{ID});
637 $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
639 for $e ($self->entries) {
640 next if $e eq ".." || $e eq ".";
641 $self->disk_usage($e);
644 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
646 CPAN->debug($debug) if $CPAN::DEBUG;
652 #-> sub CPAN::Debug::debug ;
655 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
656 # Complete, caller(1)
658 ($caller) = caller(0);
660 $arg = "" unless defined $arg;
661 my $rest = join ":", map { defined $_ ? $_ : "UNDEF" } @rest;
662 # print "caller[$caller]\n";
663 # print "func[$func]\n";
664 # print "line[$line]\n";
665 # print "rest[@rest]\n";
666 # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]\n";
667 # print "CPAN::DEBUG[$CPAN::DEBUG]\n";
668 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
669 if ($arg and ref $arg) {
670 eval { require Data::Dumper };
672 print $arg->as_string;
674 print Data::Dumper::Dumper($arg);
677 print "Debug($caller:$func,$line,[$rest]): $arg\n"
682 package CPAN::Config;
684 #-> sub CPAN::Config::edit ;
686 my($class,@args) = @_;
688 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
689 my($o,$str,$func,$args,$key_exists);
695 if (ref($CPAN::Config->{$o}) eq ARRAY) {
698 # Let's avoid eval, it's easier to comprehend without.
699 if ($func eq "push") {
700 push @{$CPAN::Config->{$o}}, @args;
701 } elsif ($func eq "pop") {
702 pop @{$CPAN::Config->{$o}};
703 } elsif ($func eq "shift") {
704 shift @{$CPAN::Config->{$o}};
705 } elsif ($func eq "unshift") {
706 unshift @{$CPAN::Config->{$o}}, @args;
707 } elsif ($func eq "splice") {
708 splice @{$CPAN::Config->{$o}}, @args;
710 $CPAN::Config->{$o} = [@args];
714 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
719 $CPAN::Config->{$o} = $args[0] if defined $args[0];
721 print defined $CPAN::Config->{$o} ?
722 $CPAN::Config->{$o} : "UNDEFINED";
727 #-> sub CPAN::Config::commit ;
729 my($self,$configpm) = @_;
730 unless (defined $configpm){
731 $configpm ||= $INC{"CPAN/MyConfig.pm"};
732 $configpm ||= $INC{"CPAN/Config.pm"};
733 $configpm || Carp::confess(qq{
734 CPAN::Config::commit called without an argument.
735 Please specify a filename where to save the configuration or try
736 "o conf init" to have an interactive course through configing.
741 $mode = (stat $configpm)[2];
742 if ($mode && ! -w _) {
743 Carp::confess("$configpm is not writable");
747 my $msg = <<EOF unless $configpm =~ /MyConfig/;
749 # This is CPAN.pm's systemwide configuration file. This file provides
750 # defaults for users, and the values can be changed in a per-user
751 # configuration file. The user-config file is being looked for as
752 # ~/.cpan/CPAN/MyConfig.pm.
756 my($fh) = FileHandle->new;
757 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
758 print $fh qq[$msg\$CPAN::Config = \{\n];
759 foreach (sort keys %$CPAN::Config) {
762 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
767 print $fh "};\n1;\n__END__\n";
770 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
771 #chmod $mode, $configpm;
772 ###why was that so? $self->defaults;
773 print "commit: wrote $configpm\n";
777 *default = \&defaults;
778 #-> sub CPAN::Config::defaults ;
788 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
797 #-> sub CPAN::Config::load ;
801 eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems
802 unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
803 eval {require CPAN::MyConfig;}; # where you can override system wide settings
804 return unless @miss = $self->not_loaded;
805 require CPAN::FirstTime;
806 my($configpm,$fh,$redo,$theycalled);
808 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
809 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
810 $configpm = $INC{"CPAN/Config.pm"};
812 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
813 $configpm = $INC{"CPAN/MyConfig.pm"};
816 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
817 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
818 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
819 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
820 if (-w $configpmtest) {
821 $configpm = $configpmtest;
822 } elsif (-w $configpmdir) {
823 #_#_# following code dumped core on me with 5.003_11, a.k.
824 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
825 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
826 my $fh = FileHandle->new;
827 if ($fh->open(">$configpmtest")) {
829 $configpm = $configpmtest;
831 # Should never happen
832 Carp::confess("Cannot open >$configpmtest");
837 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
838 File::Path::mkpath($configpmdir);
839 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
840 if (-w $configpmtest) {
841 $configpm = $configpmtest;
842 } elsif (-w $configpmdir) {
843 #_#_# following code dumped core on me with 5.003_11, a.k.
844 my $fh = FileHandle->new;
845 if ($fh->open(">$configpmtest")) {
847 $configpm = $configpmtest;
849 # Should never happen
850 Carp::confess("Cannot open >$configpmtest");
853 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
854 qq{create a configuration file.});
860 We have to reconfigure CPAN.pm due to following uninitialized parameters:
863 } if $redo && ! $theycalled;
865 $configpm initialized.
868 CPAN::FirstTime::init($configpm);
871 #-> sub CPAN::Config::not_loaded ;
875 cpan_home keep_source_where build_dir build_cache index_expire
876 gzip tar unzip make pager makepl_arg make_arg make_install_arg
877 urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
879 push @miss, $_ unless defined $CPAN::Config->{$_};
884 #-> sub CPAN::Config::unload ;
886 delete $INC{'CPAN/MyConfig.pm'};
887 delete $INC{'CPAN/Config.pm'};
891 #-> sub CPAN::Config::help ;
895 defaults reload default config values from disk
896 commit commit session changes to disk
897 init go through a dialog to set all parameters
899 You may edit key values in the follow fashion:
901 o conf build_cache 15
903 o conf build_dir "/foo/bar"
907 o conf urllist unshift ftp://ftp.foo.bar/
910 undef; #don't reprint CPAN::Config
913 #-> sub CPAN::Config::cpl ;
915 my($word,$line,$pos) = @_;
917 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
918 return grep /^\Q$word\E/, @o_conf;
923 #-> sub CPAN::Shell::h ;
925 my($class,$about) = @_;
926 if (defined $about) {
927 print "Detailed help not yet implemented\n";
930 command arguments description
933 d /regex/ info distributions
935 i none anything of above
937 r as reinstall recommendations
938 u above uninstalled distributions
939 See manpage for autobundle, recompile, force, look, etc.
942 test modules, make test (implies make)
943 install dists, bundles, make install (implies test)
944 clean "r" or "u" make clean
945 readme display the README file
947 reload index|cpan load most recent indices/CPAN.pm
948 h or ? display this menu
949 o various set and query options
950 ! perl-code eval a perl command
951 q quit the shell subroutine
956 #-> sub CPAN::Shell::a ;
957 sub a { print shift->format_result('Author',@_);}
958 #-> sub CPAN::Shell::b ;
960 my($self,@which) = @_;
961 CPAN->debug("which[@which]") if $CPAN::DEBUG;
962 my($incdir,$bdir,$dh);
963 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
964 $bdir = $CPAN::META->catdir($incdir,"Bundle");
965 if ($dh = DirHandle->new($bdir)) { # may fail
967 for $entry ($dh->read) {
968 next if -d $CPAN::META->catdir($bdir,$entry);
969 next unless $entry =~ s/\.pm$//;
970 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
974 print $self->format_result('Bundle',@which);
976 #-> sub CPAN::Shell::d ;
977 sub d { print shift->format_result('Distribution',@_);}
978 #-> sub CPAN::Shell::m ;
979 sub m { print shift->format_result('Module',@_);}
981 #-> sub CPAN::Shell::i ;
986 @type = qw/Author Bundle Distribution Module/;
987 @args = '/./' unless @args;
990 push @result, $self->expand($type,@args);
992 my $result = @result == 1 ?
993 $result[0]->as_string :
994 join "", map {$_->as_glimpse} @result;
995 $result ||= "No objects found of any type for argument @args\n";
999 #-> sub CPAN::Shell::o ;
1001 my($self,$o_type,@o_what) = @_;
1003 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1004 if ($o_type eq 'conf') {
1005 shift @o_what if @o_what && $o_what[0] eq 'help';
1008 print "CPAN::Config options:\n";
1009 for $k (sort keys %CPAN::Config::can) {
1010 $v = $CPAN::Config::can{$k};
1011 printf " %-18s %s\n", $k, $v;
1014 for $k (sort keys %$CPAN::Config) {
1015 $v = $CPAN::Config->{$k};
1017 printf " %-18s\n", $k;
1018 print map {"\t$_\n"} @{$v};
1020 printf " %-18s %s\n", $k, $v;
1024 } elsif (!CPAN::Config->edit(@o_what)) {
1025 print qq[Type 'o conf' to view configuration edit options\n\n];
1027 } elsif ($o_type eq 'debug') {
1029 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1032 my($what) = shift @o_what;
1033 if ( exists $CPAN::DEBUG{$what} ) {
1034 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1035 } elsif ($what =~ /^\d/) {
1036 $CPAN::DEBUG = $what;
1037 } elsif (lc $what eq 'all') {
1039 for (values %CPAN::DEBUG) {
1042 $CPAN::DEBUG = $max;
1045 for (keys %CPAN::DEBUG) {
1046 next unless lc($_) eq lc($what);
1047 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1050 print "unknown argument [$what]\n" unless $known;
1054 print "Valid options for debug are ".
1055 join(", ",sort(keys %CPAN::DEBUG), 'all').
1056 qq{ or a number. Completion works on the options. }.
1057 qq{Case is ignored.\n\n};
1060 print "Options set for debugging:\n";
1062 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1063 $v = $CPAN::DEBUG{$k};
1064 printf " %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
1067 print "Debugging turned off completely.\n";
1072 conf set or get configuration variables
1073 debug set or get debugging options
1078 #-> sub CPAN::Shell::reload ;
1080 my($self,$command,@arg) = @_;
1082 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1083 if ($command =~ /cpan/i) {
1084 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
1085 my $fh = FileHandle->new($INC{'CPAN.pm'});
1089 local($SIG{__WARN__})
1091 if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
1101 print "\n$redef subroutines redefined\n";
1102 } elsif ($command =~ /index/) {
1103 CPAN::Index->force_reload;
1105 print qq{cpan re-evals the CPAN.pm file\n};
1106 print qq{index re-reads the index files\n};
1110 #-> sub CPAN::Shell::_binary_extensions ;
1111 sub _binary_extensions {
1112 my($self) = shift @_;
1113 my(@result,$module,%seen,%need,$headerdone);
1114 for $module ($self->expand('Module','/./')) {
1115 my $file = $module->cpan_file;
1116 next if $file eq "N/A";
1117 next if $file =~ /^Contact Author/;
1118 next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
1119 next unless $module->xs_file;
1122 push @result, $module;
1124 # print join " | ", @result;
1129 #-> sub CPAN::Shell::recompile ;
1131 my($self) = shift @_;
1132 my($module,@module,$cpan_file,%dist);
1133 @module = $self->_binary_extensions();
1134 for $module (@module){ # we force now and compile later, so we don't do it twice
1135 $cpan_file = $module->cpan_file;
1136 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1138 $dist{$cpan_file}++;
1140 for $cpan_file (sort keys %dist) {
1141 print " CPAN: Recompiling $cpan_file\n\n";
1142 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1144 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1145 # stop a package from recompiling,
1146 # e.g. IO-1.12 when we have perl5.003_10
1150 #-> sub CPAN::Shell::_u_r_common ;
1152 my($self) = shift @_;
1153 my($what) = shift @_;
1154 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1155 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1156 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1158 @args = '/./' unless @args;
1159 my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
1160 $version_zeroes = 0;
1161 my $sprintf = "%-25s %9s %9s %s\n";
1162 for $module ($self->expand('Module',@args)) {
1163 my $file = $module->cpan_file;
1164 next unless defined $file; # ??
1165 my($latest) = $module->cpan_version || 0;
1166 my($inst_file) = $module->inst_file;
1170 $have = $module->inst_version;
1171 } elsif ($what eq "r") {
1172 $have = $module->inst_version;
1174 $version_zeroes++ unless $have;
1175 next if $have >= $latest;
1176 } elsif ($what eq "u") {
1182 } elsif ($what eq "r") {
1184 } elsif ($what eq "u") {
1188 return if $CPAN::Signal; # this is sometimes lengthy
1191 push @result, sprintf "%s %s\n", $module->id, $have;
1192 } elsif ($what eq "r") {
1193 push @result, $module->id;
1194 next if $seen{$file}++;
1195 } elsif ($what eq "u") {
1196 push @result, $module->id;
1197 next if $seen{$file}++;
1198 next if $file =~ /^Contact/;
1200 unless ($headerdone++){
1204 "Package namespace",
1210 $latest = substr($latest,0,8) if length($latest) > 8;
1211 $have = substr($have,0,8) if length($have) > 8;
1212 printf $sprintf, $module->id, $have, $latest, $file;
1213 $need{$module->id}++;
1217 print "No modules found for @args\n";
1218 } elsif ($what eq "r") {
1219 print "All modules are up to date for @args\n";
1222 if ($what eq "r" && $version_zeroes) {
1223 my $s = $version_zeroes > 1 ? "s have" : " has";
1224 print qq{$version_zeroes installed module$s no version number to compare\n};
1229 #-> sub CPAN::Shell::r ;
1231 shift->_u_r_common("r",@_);
1234 #-> sub CPAN::Shell::u ;
1236 shift->_u_r_common("u",@_);
1239 #-> sub CPAN::Shell::autobundle ;
1242 my(@bundle) = $self->_u_r_common("a",@_);
1243 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1244 File::Path::mkpath($todir);
1245 unless (-d $todir) {
1246 print "Couldn't mkdir $todir for some reason\n";
1249 my($y,$m,$d) = (localtime)[5,4,3];
1253 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1254 my($to) = $CPAN::META->catfile($todir,"$me.pm");
1256 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1257 $to = $CPAN::META->catfile($todir,"$me.pm");
1259 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1261 "package Bundle::$me;\n\n",
1262 "\$VERSION = '0.01';\n\n",
1266 "Bundle::$me - Snapshot of installation on ",
1267 $Config::Config{'myhostname'},
1270 "\n\n=head1 SYNOPSIS\n\n",
1271 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1272 "=head1 CONTENTS\n\n",
1273 join("\n", @bundle),
1274 "\n\n=head1 CONFIGURATION\n\n",
1276 "\n\n=head1 AUTHOR\n\n",
1277 "This Bundle has been generated automatically ",
1278 "by the autobundle routine in CPAN.pm.\n",
1281 print "\nWrote bundle file
1285 #-> sub CPAN::Shell::expand ;
1288 my($type,@args) = @_;
1292 if ($arg =~ m|^/(.*)/$|) {
1295 my $class = "CPAN::$type";
1297 if (defined $regex) {
1298 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
1301 $obj->id =~ /$regex/i
1305 $] < 5.00303 ### provide sort of compatibility with 5.003
1310 $obj->name =~ /$regex/i
1315 if ( $type eq 'Bundle' ) {
1316 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1318 if ($CPAN::META->exists($class,$xarg)) {
1319 $obj = $CPAN::META->instance($class,$xarg);
1320 } elsif ($CPAN::META->exists($class,$arg)) {
1321 $obj = $CPAN::META->instance($class,$arg);
1328 return wantarray ? @m : $m[0];
1331 #-> sub CPAN::Shell::format_result ;
1334 my($type,@args) = @_;
1335 @args = '/./' unless @args;
1336 my(@result) = $self->expand($type,@args);
1337 my $result = @result == 1 ?
1338 $result[0]->as_string :
1339 join "", map {$_->as_glimpse} @result;
1340 $result ||= "No objects of type $type found for argument @args\n";
1344 #-> sub CPAN::Shell::rematein ;
1347 my($meth,@some) = @_;
1349 if ($meth eq 'force') {
1351 $meth = shift @some;
1353 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1355 foreach $s (@some) {
1359 } elsif ($s =~ m|/|) { # looks like a file
1360 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1361 } elsif ($s =~ m|^Bundle::|) {
1362 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1364 $obj = $CPAN::META->instance('CPAN::Module',$s)
1365 if $CPAN::META->exists('CPAN::Module',$s);
1369 qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
1377 ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
1379 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1380 $obj = $CPAN::META->instance('CPAN::Author',$s);
1381 print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
1383 print qq{Warning: Cannot $meth $s, don\'t know what it is.
1388 to find objects with similar identifiers.
1394 #-> sub CPAN::Shell::force ;
1395 sub force { shift->rematein('force',@_); }
1396 #-> sub CPAN::Shell::get ;
1397 sub get { shift->rematein('get',@_); }
1398 #-> sub CPAN::Shell::readme ;
1399 sub readme { shift->rematein('readme',@_); }
1400 #-> sub CPAN::Shell::make ;
1401 sub make { shift->rematein('make',@_); }
1402 #-> sub CPAN::Shell::test ;
1403 sub test { shift->rematein('test',@_); }
1404 #-> sub CPAN::Shell::install ;
1405 sub install { shift->rematein('install',@_); }
1406 #-> sub CPAN::Shell::clean ;
1407 sub clean { shift->rematein('clean',@_); }
1408 #-> sub CPAN::Shell::look ;
1409 sub look { shift->rematein('look',@_); }
1413 #-> sub CPAN::FTP::ftp_get ;
1415 my($class,$host,$dir,$file,$target) = @_;
1417 qq[Going to fetch file [$file] from dir [$dir]
1418 on host [$host] as local [$target]\n]
1420 my $ftp = Net::FTP->new($host);
1421 return 0 unless defined $ftp;
1422 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1423 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1424 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1425 warn "Couldn't login on $host";
1428 # print qq[Going to ->cwd("$dir")\n];
1429 unless ( $ftp->cwd($dir) ){
1430 warn "Couldn't cwd $dir";
1434 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1435 unless ( $ftp->get($file,$target) ){
1436 warn "Couldn't fetch $file from $host\n";
1439 $ftp->quit; # it's ok if this fails
1443 #-> sub CPAN::FTP::localize ;
1444 # sorry for the ugly code here, I'll clean it up as soon as Net::FTP
1447 my($self,$file,$aslocal,$force) = @_;
1449 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1450 unless defined $aslocal;
1451 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
1454 return $aslocal if -f $aslocal && -r _ && ! $force;
1457 rename $aslocal, "$aslocal.bak";
1461 my($aslocal_dir) = File::Basename::dirname($aslocal);
1462 File::Path::mkpath($aslocal_dir);
1463 print STDERR qq{Warning: You are not allowed to write into }.
1464 qq{directory "$aslocal_dir".
1465 I\'ll continue, but if you face any problems, they may be due
1466 to insufficient permissions.\n} unless -w $aslocal_dir;
1468 # Inheritance is not easier to manage than a few if/else branches
1469 if ($CPAN::META->has_inst('LWP')) {
1470 require LWP::UserAgent;
1472 $Ua = LWP::UserAgent->new;
1474 $Ua->proxy('ftp', $var)
1475 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1476 $Ua->proxy('http', $var)
1477 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1479 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1483 # Try the list of urls for each single object. We keep a record
1484 # where we did get a file from
1486 for $i (0..$#{$CPAN::Config->{urllist}}) {
1487 my $url = $CPAN::Config->{urllist}[$i];
1488 $url .= "/" unless substr($url,-1) eq "/";
1490 $self->debug("localizing[$url]") if $CPAN::DEBUG;
1491 if ($url =~ /^file:/) {
1493 if ($CPAN::META->has_inst('LWP')) {
1495 my $u = URI::URL->new($url);
1497 } else { # works only on Unix, is poorly constructed, but
1498 # hopefully better than nothing.
1499 # RFC 1738 says fileurl BNF is
1500 # fileurl = "file://" [ host | "localhost" ] "/" fpath
1501 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
1502 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
1503 $l =~ s/^file://; # assume they meant file://localhost
1505 return $l if -f $l && -r _;
1506 # Maybe mirror has compressed it?
1508 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
1509 system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
1510 return $aslocal if -f $aslocal;
1514 if ($CPAN::META->has_inst('LWP')) {
1515 print "Fetching $url with LWP\n";
1516 my $res = $Ua->mirror($url, $aslocal);
1517 if ($res->is_success) {
1521 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1522 # that's the nice and easy way thanks to Graham
1523 my($host,$dir,$getfile) = ($1,$2,$3);
1524 if ($CPAN::META->has_inst('Net::FTP')) {
1526 $self->debug("Going to fetch file [$getfile]
1529 as local [$aslocal]") if $CPAN::DEBUG;
1530 CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
1531 warn "Net::FTP failed for some reason\n";
1535 # Came back if Net::FTP couldn't establish connection (or failed otherwise)
1536 # Maybe they are behind a firewall, but they gave us
1537 # a socksified (or other) ftp program...
1540 # does ncftp handle http?
1541 for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
1542 next unless defined $funkyftp;
1543 next if $funkyftp =~ /^\s*$/;
1544 my($want_compressed);
1547 Trying with $funkyftp to get
1550 $want_compressed = $aslocal =~ s/\.gz//;
1551 my($source_switch) = "";
1552 $source_switch = "-source" if $funkyftp =~ /\blynx$/;
1553 $source_switch = "-c" if $funkyftp =~ /\bncftp$/;
1554 my($system) = "$funkyftp $source_switch '$url' > $aslocal";
1555 $self->debug("system[$system]") if $CPAN::DEBUG;
1557 if (($wstatus = system($system)) == 0
1559 -s $aslocal # lynx returns 0 on my system even if it fails
1561 if ($want_compressed) {
1562 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1563 if (system($system) == 0) {
1564 rename $aslocal, "$aslocal.gz";
1566 $system = "$CPAN::Config->{'gzip'} $aslocal";
1569 return "$aslocal.gz";
1571 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1572 if (system($system) == 0) {
1573 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
1576 # should be fine, eh?
1581 my $estatus = $wstatus >> 8;
1582 my $size = -s $aslocal;
1584 System call "$system"
1585 returned status $estatus (wstat $wstatus), left
1586 $aslocal with size $size
1591 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1592 my($host,$dir,$getfile) = ($1,$2,$3);
1594 if (-x $CPAN::Config->{'ftp'}) {
1596 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
1597 $ctime,$blksize,$blocks) = stat($aslocal);
1598 $timestamp = $mtime ||= 0;
1600 my($netrc) = CPAN::FTP::netrc->new;
1601 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
1603 my $targetfile = File::Basename::basename($aslocal);
1609 map("cd $_", split "/", $dir), # RFC 1738
1611 "get $getfile $targetfile",
1614 if (! $netrc->netrc) {
1615 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
1616 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
1619 "hasdef[%d]cont($host)[%d]",
1621 $netrc->contains($host)
1624 if ($netrc->protected) {
1627 Trying with external ftp to get
1629 As this requires some features that are not thoroughly tested, we\'re
1630 not sure, that we get it right....
1634 my $fh = FileHandle->new;
1635 $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
1636 or die "Couldn't open ftp: $!";
1637 # pilot is blind now
1638 CPAN->debug("dialog [".(join "|",@dialog)."]")
1640 foreach (@dialog) { $fh->print("$_\n") }
1641 $fh->close; # Wait for process to complete
1643 my $estatus = $wstatus >> 8;
1645 Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
1646 returned status $estatus (wstat $wstatus)
1648 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1649 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1651 if ($mtime > $timestamp) {
1652 print "GOT $aslocal\n";
1655 print "Hmm... Still failed!\n";
1658 warn "Your $netrcfile is not correctly protected.\n";
1661 warn "Your ~/.netrc neither contains $host
1662 nor does it have a default entry\n";
1665 # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
1666 # login manually to host, using e-mail as password.
1667 print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
1671 "user anonymous $Config::Config{'cf_email'}"
1673 CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
1674 $fh = FileHandle->new;
1675 $fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
1676 die "Cannot fork: $!\n";
1677 foreach (@dialog) { $fh->print("$_\n") }
1680 my $estatus = $wstatus >> 8;
1682 Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
1683 returned status $estatus (wstat $wstatus)
1685 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1686 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1688 if ($mtime > $timestamp) {
1689 print "GOT $aslocal\n";
1692 print "Bad luck... Still failed!\n";
1698 print "Can't access URL $url.\n\n";
1700 push @mess, "LWP" unless CPAN->has_inst('LWP');
1701 push @mess, "Net::FTP" unless CPAN->has_inst('Net::FTP');
1703 for $ext (qw/lynx ncftp ftp/) {
1704 $CPAN::Config->{$ext} ||= "";
1705 push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
1707 $mess = qq{Either get }.
1709 qq{ or check, if the URL found in your configuration file, }.
1710 $CPAN::Config->{urllist}[$i].
1712 print Text::Wrap::wrap("","",$mess), "\n";
1714 print "Cannot fetch $file\n";
1716 rename "$aslocal.bak", $aslocal;
1717 print "Trying to get away with old file:\n";
1718 print $self->ls($aslocal);
1724 # find2perl needs modularization, too, all the following is stolen
1727 my($self,$name) = @_;
1728 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
1729 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
1731 my($perms,%user,%group);
1735 $blocks = int(($blocks + 1) / 2);
1738 $blocks = int(($sizemm + 1023) / 1024);
1741 if (-f _) { $perms = '-'; }
1742 elsif (-d _) { $perms = 'd'; }
1743 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
1744 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
1745 elsif (-p _) { $perms = 'p'; }
1746 elsif (-S _) { $perms = 's'; }
1747 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
1749 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
1750 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
1751 my $tmpmode = $mode;
1752 my $tmp = $rwx[$tmpmode & 7];
1754 $tmp = $rwx[$tmpmode & 7] . $tmp;
1756 $tmp = $rwx[$tmpmode & 7] . $tmp;
1757 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
1758 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
1759 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
1762 my $user = $user{$uid} || $uid; # too lazy to implement lookup
1763 my $group = $group{$gid} || $gid;
1765 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
1767 my($moname) = $moname[$mon];
1768 if (-M _ > 365.25 / 2) {
1769 $timeyear = $year + 1900;
1772 $timeyear = sprintf("%02d:%02d", $hour, $min);
1775 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
1789 package CPAN::FTP::netrc;
1793 my $file = MM->catfile($ENV{HOME},".netrc");
1795 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1796 $atime,$mtime,$ctime,$blksize,$blocks)
1801 my($fh,@machines,$hasdefault);
1803 $fh = FileHandle->new or die "Could not create a filehandle";
1805 if($fh->open($file)){
1806 $protected = ($mode & 077) == 0;
1808 NETRC: while (<$fh>) {
1809 my(@tokens) = split " ", $_;
1810 TOKEN: while (@tokens) {
1811 my($t) = shift @tokens;
1812 if ($t eq "default"){
1814 # warn "saw a default entry before tokens[@tokens]";
1817 last TOKEN if $t eq "macdef";
1818 if ($t eq "machine") {
1819 push @machines, shift @tokens;
1824 $file = $hasdefault = $protected = "";
1828 'mach' => [@machines],
1830 'hasdefault' => $hasdefault,
1831 'protected' => $protected,
1835 sub hasdefault { shift->{'hasdefault'} }
1836 sub netrc { shift->{'netrc'} }
1837 sub protected { shift->{'protected'} }
1839 my($self,$mach) = @_;
1840 for ( @{$self->{'mach'}} ) {
1841 return 1 if $_ eq $mach;
1846 package CPAN::Complete;
1848 #-> sub CPAN::Complete::cpl ;
1850 my($word,$line,$pos) = @_;
1854 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1856 if ($line =~ s/^(force\s*)//) {
1864 ! a b d h i m o q r u autobundle clean
1865 make test install force reload look
1868 } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
1870 } elsif ($line =~ /^a\s/) {
1871 @return = cplx('CPAN::Author',$word);
1872 } elsif ($line =~ /^b\s/) {
1873 @return = cplx('CPAN::Bundle',$word);
1874 } elsif ($line =~ /^d\s/) {
1875 @return = cplx('CPAN::Distribution',$word);
1876 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
1877 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
1878 } elsif ($line =~ /^i\s/) {
1879 @return = cpl_any($word);
1880 } elsif ($line =~ /^reload\s/) {
1881 @return = cpl_reload($word,$line,$pos);
1882 } elsif ($line =~ /^o\s/) {
1883 @return = cpl_option($word,$line,$pos);
1890 #-> sub CPAN::Complete::cplx ;
1892 my($class, $word) = @_;
1893 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1896 #-> sub CPAN::Complete::cpl_any ;
1900 cplx('CPAN::Author',$word),
1901 cplx('CPAN::Bundle',$word),
1902 cplx('CPAN::Distribution',$word),
1903 cplx('CPAN::Module',$word),
1907 #-> sub CPAN::Complete::cpl_reload ;
1909 my($word,$line,$pos) = @_;
1911 my(@words) = split " ", $line;
1912 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1913 my(@ok) = qw(cpan index);
1914 return @ok if @words == 1;
1915 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
1918 #-> sub CPAN::Complete::cpl_option ;
1920 my($word,$line,$pos) = @_;
1922 my(@words) = split " ", $line;
1923 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1924 my(@ok) = qw(conf debug);
1925 return @ok if @words == 1;
1926 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
1928 } elsif ($words[1] eq 'index') {
1930 } elsif ($words[1] eq 'conf') {
1931 return CPAN::Config::cpl(@_);
1932 } elsif ($words[1] eq 'debug') {
1933 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1937 package CPAN::Index;
1939 #-> sub CPAN::Index::force_reload ;
1942 $CPAN::Index::last_time = 0;
1946 #-> sub CPAN::Index::reload ;
1948 my($cl,$force) = @_;
1951 # XXX check if a newer one is available. (We currently read it from time to time)
1952 for ($CPAN::Config->{index_expire}) {
1953 $_ = 0.001 unless $_ > 0.001;
1955 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1959 $cl->rd_authindex($cl->reload_x(
1960 "authors/01mailrc.txt.gz",
1964 $debug = "timing reading 01[".($t2 - $time)."]";
1966 return if $CPAN::Signal; # this is sometimes lengthy
1967 $cl->rd_modpacks($cl->reload_x(
1968 "modules/02packages.details.txt.gz",
1972 $debug .= "02[".($t2 - $time)."]";
1974 return if $CPAN::Signal; # this is sometimes lengthy
1975 $cl->rd_modlist($cl->reload_x(
1976 "modules/03modlist.data.gz",
1980 $debug .= "03[".($t2 - $time)."]";
1982 CPAN->debug($debug) if $CPAN::DEBUG;
1985 #-> sub CPAN::Index::reload_x ;
1987 my($cl,$wanted,$localname,$force) = @_;
1989 CPAN::Config->load; # we should guarantee loading wherever we rely
1991 my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},
1995 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
1998 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
1999 # use Devel::Symdump;
2000 # print Devel::Symdump->isa_tree, "\n";
2001 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
2002 qq{day$s. I\'ll use that.});
2007 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
2010 #-> sub CPAN::Index::rd_authindex ;
2012 my($cl,$index_target) = @_;
2013 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
2014 print "Going to read $index_target\n";
2015 my $fh = FileHandle->new("$pipe|");
2018 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
2019 next unless $userid && $fullname && $email;
2021 # instantiate an author object
2022 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
2023 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
2024 return if $CPAN::Signal;
2027 $? and Carp::croak "FAILED $pipe: exit status [$?]";
2030 #-> sub CPAN::Index::rd_modpacks ;
2032 my($cl,$index_target) = @_;
2033 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
2034 print "Going to read $index_target\n";
2035 my $fh = FileHandle->new("$pipe|");
2041 my($mod,$version,$dist) = split;
2042 $dist = '' unless defined $dist;
2043 ### $version =~ s/^\+//;
2045 # if it as a bundle, instatiate a bundle object
2046 my($bundle,$id,$userid);
2048 if ($mod eq 'CPAN') {
2050 if ($version > $CPAN::VERSION){
2052 There\'s a new CPAN.pm version (v$version) available!
2053 You might want to try
2056 without quitting the current session. It should be a seemless upgrade
2057 while we are running...
2062 last if $CPAN::Signal;
2063 } elsif ($mod =~ /^Bundle::(.*)/) {
2068 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
2069 ### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
2070 # This "next" makes us faster but if the job is running long, we ignore
2071 # rereads which is bad. So we have to be a bit slower again.
2072 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
2075 # instantiate a module object
2076 $id = $CPAN::META->instance('CPAN::Module',$mod);
2077 ### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
2078 ### if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
2081 if ($id->cpan_file ne $dist){
2082 # determine the author
2083 ($userid) = $dist =~ /([^\/]+)/;
2085 'CPAN_USERID' => $userid,
2086 'CPAN_VERSION' => $version,
2087 'CPAN_FILE' => $dist
2091 # instantiate a distribution object
2092 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
2093 $CPAN::META->instance(
2094 'CPAN::Distribution' => $dist
2096 'CPAN_USERID' => $userid
2100 return if $CPAN::Signal;
2103 $? and Carp::croak "FAILED $pipe: exit status [$?]";
2106 #-> sub CPAN::Index::rd_modlist ;
2108 my($cl,$index_target) = @_;
2109 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
2110 print "Going to read $index_target\n";
2111 my $fh = FileHandle->new("$pipe|");
2114 if (/^Date:\s+(.*)/){
2115 return if $date_of_03 eq $1;
2123 $eval .= q{CPAN::Modulelist->data;};
2125 my($comp) = Safe->new("CPAN::Safe1");
2126 my $ret = $comp->reval($eval);
2127 Carp::confess($@) if $@;
2128 return if $CPAN::Signal;
2130 my $obj = $CPAN::META->instance(CPAN::Module,$_);
2131 $obj->set(%{$ret->{$_}});
2132 return if $CPAN::Signal;
2136 package CPAN::InfoObj;
2138 #-> sub CPAN::InfoObj::new ;
2139 sub new { my $this = bless {}, shift; %$this = @_; $this }
2141 #-> sub CPAN::InfoObj::set ;
2143 my($self,%att) = @_;
2144 my(%oldatt) = %$self;
2145 %$self = (%oldatt, %att);
2148 #-> sub CPAN::InfoObj::id ;
2149 sub id { shift->{'ID'} }
2151 #-> sub CPAN::InfoObj::as_glimpse ;
2155 my $class = ref($self);
2156 $class =~ s/^CPAN:://;
2157 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2161 #-> sub CPAN::InfoObj::as_string ;
2165 my $class = ref($self);
2166 $class =~ s/^CPAN:://;
2167 push @m, $class, " id = $self->{ID}\n";
2168 for (sort keys %$self) {
2171 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
2172 if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
2173 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2175 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
2181 #-> sub CPAN::InfoObj::author ;
2184 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2187 package CPAN::Author;
2189 #-> sub CPAN::Author::as_glimpse ;
2193 my $class = ref($self);
2194 $class =~ s/^CPAN:://;
2195 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2199 # Dead code, I would have liked to have,,, but it was never reached,,,
2202 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
2205 #-> sub CPAN::Author::fullname ;
2206 sub fullname { shift->{'FULLNAME'} }
2208 #-> sub CPAN::Author::email ;
2209 sub email { shift->{'EMAIL'} }
2211 package CPAN::Distribution;
2213 #-> sub CPAN::Distribution::called_for ;
2216 $self->{'CALLED_FOR'} = $id if defined $id;
2217 return $self->{'CALLED_FOR'};
2220 #-> sub CPAN::Distribution::get ;
2225 exists $self->{'build_dir'} and push @e,
2226 "Unwrapped into directory $self->{'build_dir'}";
2227 print join "", map {" $_\n"} @e and return if @e;
2232 $CPAN::Config->{keep_source_where},
2235 split("/",$self->{ID})
2238 $self->debug("Doing localize") if $CPAN::DEBUG;
2239 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
2240 $self->{localfile} = $local_file;
2241 my $builddir = $CPAN::META->{cachemgr}->dir;
2242 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2243 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2246 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2247 if ($CPAN::META->has_inst('MD5')) {
2248 $self->debug("MD5 is installed, verifying");
2251 $self->debug("MD5 is NOT installed");
2253 $self->debug("Removing tmp") if $CPAN::DEBUG;
2254 File::Path::rmtree("tmp");
2255 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
2257 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2258 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
2259 $self->untar_me($local_file);
2260 } elsif ( $local_file =~ /\.zip$/i ) {
2261 $self->unzip_me($local_file);
2262 } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
2263 $self->pm2dir_me($local_file);
2265 $self->{archived} = "NO";
2268 if ($self->{archived} ne 'NO') {
2270 # Let's check if the package has its own directory.
2271 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!");
2272 my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
2274 my ($distdir,$packagedir);
2275 if (@readdir == 1 && -d $readdir[0]) {
2276 $distdir = $readdir[0];
2277 $packagedir = $CPAN::META->catdir($builddir,$distdir);
2278 -d $packagedir and print "Removing previously used $packagedir\n";
2279 File::Path::rmtree($packagedir);
2280 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2282 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2283 $pragmatic_dir =~ s/\W_//g;
2284 $pragmatic_dir++ while -d "../$pragmatic_dir";
2285 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
2286 File::Path::mkpath($packagedir);
2288 for $f (@readdir) { # is already without "." and ".."
2289 my $to = $CPAN::META->catdir($packagedir,$f);
2290 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2293 $self->{'build_dir'} = $packagedir;
2296 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
2298 File::Path::rmtree("tmp");
2299 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
2300 print "Going to unlink $local_file\n";
2301 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
2303 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
2304 unless (-f $makefilepl) {
2305 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
2306 if (-f $configure) {
2307 # do we have anything to do?
2308 $self->{'configure'} = $configure;
2310 my $fh = FileHandle->new(">$makefilepl")
2311 or Carp::croak("Could not open >$makefilepl");
2312 my $cf = $self->called_for || "unknown";
2314 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
2315 # because there was no Makefile.PL supplied.
2316 # Autogenerated on: }.scalar localtime().qq{
2318 use ExtUtils::MakeMaker;
2319 WriteMakefile(NAME => q[$cf]);
2322 print qq{Package comes without Makefile.PL.\n}.
2323 qq{ Writing one on our own (calling it $cf)\n};
2331 my($self,$local_file) = @_;
2332 $self->{archived} = "tar";
2333 my $system = "$CPAN::Config->{gzip} --decompress --stdout " .
2334 "$local_file | $CPAN::Config->{tar} xvf -";
2335 if (system($system)== 0) {
2336 $self->{unwrapped} = "YES";
2338 $self->{unwrapped} = "NO";
2343 my($self,$local_file) = @_;
2344 $self->{archived} = "zip";
2345 my $system = "$CPAN::Config->{unzip} $local_file";
2346 if (system($system) == 0) {
2347 $self->{unwrapped} = "YES";
2349 $self->{unwrapped} = "NO";
2354 my($self,$local_file) = @_;
2355 $self->{archived} = "pm";
2356 my $to = File::Basename::basename($local_file);
2357 $to =~ s/\.(gz|Z)$//;
2358 my $system = "$CPAN::Config->{gzip} --decompress --stdout $local_file > $to";
2359 if (system($system) == 0) {
2360 $self->{unwrapped} = "YES";
2362 $self->{unwrapped} = "NO";
2366 #-> sub CPAN::Distribution::new ;
2368 my($class,%att) = @_;
2370 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
2372 my $this = { %att };
2373 return bless $this, $class;
2376 #-> sub CPAN::Distribution::look ;
2379 if ( $CPAN::Config->{'shell'} ) {
2381 Trying to open a subshell in the build directory...
2385 Your configuration does not define a value for subshells.
2386 Please define it with "o conf shell <your shell>"
2390 my $dist = $self->id;
2391 my $dir = $self->dir or $self->get;
2394 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2395 my $pwd = CPAN->$getcwd();
2397 print qq{Working directory is $dir.\n};
2398 system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
2402 #-> sub CPAN::Distribution::readme ;
2405 my($dist) = $self->id;
2406 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
2407 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
2411 $CPAN::Config->{keep_source_where},
2414 split("/","$sans.readme"),
2416 $self->debug("Doing localize") if $CPAN::DEBUG;
2417 $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
2418 my $fh_pager = FileHandle->new;
2419 $fh_pager->open("|$CPAN::Config->{'pager'}")
2420 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
2421 my $fh_readme = FileHandle->new;
2422 $fh_readme->open($local_file) or die "Could not open $local_file: $!";
2423 $fh_pager->print(<$fh_readme>);
2426 #-> sub CPAN::Distribution::verifyMD5 ;
2431 $self->{MD5_STATUS} ||= "";
2432 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
2433 print join "", map {" $_\n"} @e and return if @e;
2435 my($lc_want,$lc_file,@local,$basename);
2436 @local = split("/",$self->{ID});
2438 push @local, "CHECKSUMS";
2440 CPAN->catfile($CPAN::Config->{keep_source_where},
2441 "authors", "id", @local);
2446 $self->MD5_check_file($lc_want)
2448 return $self->{MD5_STATUS} = "OK";
2450 $lc_file = CPAN::FTP->localize("authors/id/@local",
2451 $lc_want,'force>:-{');
2453 $local[-1] .= ".gz";
2454 $lc_file = CPAN::FTP->localize("authors/id/@local",
2455 "$lc_want.gz",'force>:-{');
2456 my @system = ($CPAN::Config->{gzip}, '--decompress', $lc_file);
2457 system(@system) == 0 or die "Could not uncompress $lc_file";
2458 $lc_file =~ s/\.gz$//;
2460 $self->MD5_check_file($lc_file);
2463 #-> sub CPAN::Distribution::MD5_check_file ;
2464 sub MD5_check_file {
2465 my($self,$chk_file) = @_;
2466 my($cksum,$file,$basename);
2467 $file = $self->{localfile};
2468 $basename = File::Basename::basename($file);
2469 my $fh = FileHandle->new;
2471 if (open $fh, $chk_file){
2474 my($comp) = Safe->new();
2475 $cksum = $comp->reval($eval);
2477 rename $chk_file, "$chk_file.bad";
2478 Carp::confess($@) if $@;
2481 Carp::carp "Could not open $chk_file for reading";
2483 if ($cksum->{$basename}->{md5}) {
2484 $self->debug("Found checksum for $basename:" .
2485 "$cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
2486 my $pipe = "$CPAN::Config->{gzip} --decompress ".
2491 $self->eq_MD5($fh,$cksum->{$basename}->{md5})
2495 $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
2497 print "Checksum for $file ok\n";
2498 return $self->{MD5_STATUS} = "OK";
2500 print qq{Checksum mismatch for distribution file. }.
2501 qq{Please investigate.\n\n};
2502 print $self->as_string;
2503 print $CPAN::META->instance(
2505 $self->{CPAN_USERID}
2507 my $wrap = qq{I\'d recommend removing $file. It seems to
2508 be a bogus file. Maybe you have configured your \`urllist\' with a
2509 bad URL. Please check this array with \`o conf urllist\', and
2511 print Text::Wrap::wrap("","",$wrap);
2516 close $fh if fileno($fh);
2518 $self->{MD5_STATUS} ||= "";
2519 if ($self->{MD5_STATUS} eq "NIL") {
2520 print "\nNo md5 checksum for $basename in local $chk_file.";
2521 print "Removing $chk_file\n";
2522 unlink $chk_file or print "Could not unlink: $!";
2525 $self->{MD5_STATUS} = "NIL";
2530 #-> sub CPAN::Distribution::eq_MD5 ;
2532 my($self,$fh,$expectMD5) = @_;
2535 my $hexdigest = $md5->hexdigest;
2536 $hexdigest eq $expectMD5;
2539 #-> sub CPAN::Distribution::force ;
2542 $self->{'force_update'}++;
2543 delete $self->{'MD5_STATUS'};
2544 delete $self->{'archived'};
2545 delete $self->{'build_dir'};
2546 delete $self->{'localfile'};
2547 delete $self->{'make'};
2548 delete $self->{'install'};
2549 delete $self->{'unwrapped'};
2550 delete $self->{'writemakefile'};
2553 #-> sub CPAN::Distribution::perl ;
2556 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
2557 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2558 my $pwd = CPAN->$getcwd();
2559 my $candidate = $CPAN::META->catfile($pwd,$^X);
2560 $perl ||= $candidate if MM->maybe_command($candidate);
2562 my ($component,$perl_name);
2563 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
2564 PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
2565 next unless defined($component) && $component;
2566 my($abs) = MM->catfile($component,$perl_name);
2567 if (MM->maybe_command($abs)) {
2577 #-> sub CPAN::Distribution::make ;
2580 $self->debug($self->id) if $CPAN::DEBUG;
2581 print "Running make\n";
2585 $self->{archived} eq "NO" and push @e,
2586 "Is neither a tar nor a zip archive.";
2588 $self->{unwrapped} eq "NO" and push @e,
2589 "had problems unarchiving. Please build manually";
2591 exists $self->{writemakefile} &&
2592 $self->{writemakefile} eq "NO" and push @e,
2593 "Had some problem writing Makefile";
2595 defined $self->{'make'} and push @e,
2596 "Has already been processed within this session";
2598 print join "", map {" $_\n"} @e and return if @e;
2600 print "\n CPAN.pm: Going to build ".$self->id."\n\n";
2601 my $builddir = $self->dir;
2602 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2603 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
2606 if ($self->{'configure'}) {
2607 $system = $self->{'configure'};
2609 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
2611 # This needs a handler that can be turned on or off:
2612 # $switch = "-MExtUtils::MakeMaker ".
2613 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
2615 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
2618 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
2621 if ($CPAN::Config->{inactivity_timeout}) {
2623 alarm $CPAN::Config->{inactivity_timeout};
2624 local $SIG{CHLD} = sub { wait };
2625 if (defined($pid = fork)) {
2632 print "Cannot fork: $!";
2641 $self->{writemakefile} = "NO - $@";
2646 $ret = system($system);
2648 $self->{writemakefile} = "NO";
2653 $self->{writemakefile} = "YES";
2654 return if $CPAN::Signal;
2655 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
2656 if (system($system) == 0) {
2657 print " $system -- OK\n";
2658 $self->{'make'} = "YES";
2660 $self->{writemakefile} = "YES";
2661 $self->{'make'} = "NO";
2662 print " $system -- NOT OK\n";
2666 #-> sub CPAN::Distribution::test ;
2670 return if $CPAN::Signal;
2671 print "Running make test\n";
2674 exists $self->{'make'} or push @e,
2675 "Make had some problems, maybe interrupted? Won't test";
2677 exists $self->{'make'} and
2678 $self->{'make'} eq 'NO' and
2679 push @e, "Oops, make had returned bad status";
2681 exists $self->{'build_dir'} or push @e, "Has no own directory";
2682 print join "", map {" $_\n"} @e and return if @e;
2684 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2685 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2686 my $system = join " ", $CPAN::Config->{'make'}, "test";
2687 if (system($system) == 0) {
2688 print " $system -- OK\n";
2689 $self->{'make_test'} = "YES";
2691 $self->{'make_test'} = "NO";
2692 print " $system -- NOT OK\n";
2696 #-> sub CPAN::Distribution::clean ;
2699 print "Running make clean\n";
2702 exists $self->{'build_dir'} or push @e, "Has no own directory";
2703 print join "", map {" $_\n"} @e and return if @e;
2705 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2706 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2707 my $system = join " ", $CPAN::Config->{'make'}, "clean";
2708 if (system($system) == 0) {
2709 print " $system -- OK\n";
2712 # Hmmm, what to do if make clean failed?
2716 #-> sub CPAN::Distribution::install ;
2720 return if $CPAN::Signal;
2721 print "Running make install\n";
2724 exists $self->{'build_dir'} or push @e, "Has no own directory";
2726 exists $self->{'make'} or push @e,
2727 "Make had some problems, maybe interrupted? Won't install";
2729 exists $self->{'make'} and
2730 $self->{'make'} eq 'NO' and
2731 push @e, "Oops, make had returned bad status";
2733 push @e, "make test had returned bad status, won't install without force"
2734 if exists $self->{'make_test'} and
2735 $self->{'make_test'} eq 'NO' and
2736 ! $self->{'force_update'};
2738 exists $self->{'install'} and push @e,
2739 $self->{'install'} eq "YES" ?
2740 "Already done" : "Already tried without success";
2742 print join "", map {" $_\n"} @e and return if @e;
2744 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2745 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2746 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
2747 my($pipe) = FileHandle->new("$system 2>&1 |");
2755 print " $system -- OK\n";
2756 $self->{'install'} = "YES";
2758 $self->{'install'} = "NO";
2759 print " $system -- NOT OK\n";
2760 if ($makeout =~ /permission/s && $> > 0) {
2761 print " You may have to su to root to install the package\n";
2766 #-> sub CPAN::Distribution::dir ;
2768 shift->{'build_dir'};
2771 package CPAN::Bundle;
2773 #-> sub CPAN::Bundle::as_string ;
2777 $self->{INST_VERSION} = $self->inst_version;
2778 return $self->SUPER::as_string;
2781 #-> sub CPAN::Bundle::contains ;
2784 my($parsefile) = $self->inst_file;
2785 unless ($parsefile) {
2786 # Try to get at it in the cpan directory
2787 $self->debug("no parsefile") if $CPAN::DEBUG;
2788 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
2790 $self->debug($dist->as_string) if $CPAN::DEBUG;
2791 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2792 File::Path::mkpath($todir);
2794 ($me = $self->id) =~ s/.*://;
2795 $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
2796 $to = $CPAN::META->catfile($todir,"$me.pm");
2797 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
2801 my $fh = FileHandle->new;
2803 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
2805 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
2807 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
2812 push @result, (split " ", $_, 2)[0];
2815 delete $self->{STATUS};
2816 $self->{CONTAINS} = join ", ", @result;
2817 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
2821 #-> sub CPAN::Bundle::find_bundle_file
2822 sub find_bundle_file {
2823 my($self,$where,$what) = @_;
2824 my $bu = $CPAN::META->catfile($where,$what);
2825 return $bu if -f $bu;
2826 my $manifest = $CPAN::META->catfile($where,"MANIFEST");
2827 unless (-f $manifest) {
2828 require ExtUtils::Manifest;
2829 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2830 my $cwd = CPAN->$getcwd();
2832 ExtUtils::Manifest::mkmanifest();
2835 my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
2839 my($file) = /(\S+)/;
2840 if ($file =~ m|Bundle/$what$|) {
2842 return $CPAN::META->catfile($where,$bu);
2845 Carp::croak("Could't find a Bundle file in $where");
2848 #-> sub CPAN::Bundle::inst_file ;
2852 ($me = $self->id) =~ s/.*://;
2853 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
2854 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2856 $self->SUPER::inst_file;
2857 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2858 # return $self->{'INST_FILE'}; # even if undefined?
2861 #-> sub CPAN::Bundle::rematein ;
2863 my($self,$meth) = @_;
2864 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
2866 for $s ($self->contains) {
2867 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
2868 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
2869 if ($type eq 'CPAN::Distribution') {
2871 The Bundle }.$self->id.qq{ contains
2872 explicitly a file $s.
2876 $CPAN::META->instance($type,$s)->$meth();
2880 #sub CPAN::Bundle::xs_file
2882 # If a bundle contains another that contains an xs_file we have
2883 # here, we just don't bother I suppose
2887 #-> sub CPAN::Bundle::force ;
2888 sub force { shift->rematein('force',@_); }
2889 #-> sub CPAN::Bundle::get ;
2890 sub get { shift->rematein('get',@_); }
2891 #-> sub CPAN::Bundle::make ;
2892 sub make { shift->rematein('make',@_); }
2893 #-> sub CPAN::Bundle::test ;
2894 sub test { shift->rematein('test',@_); }
2895 #-> sub CPAN::Bundle::install ;
2896 sub install { shift->rematein('install',@_); }
2897 #-> sub CPAN::Bundle::clean ;
2898 sub clean { shift->rematein('clean',@_); }
2900 #-> sub CPAN::Bundle::readme ;
2903 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
2904 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
2905 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
2908 package CPAN::Module;
2910 #-> sub CPAN::Module::as_glimpse ;
2914 my $class = ref($self);
2915 $class =~ s/^CPAN:://;
2916 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
2920 #-> sub CPAN::Module::as_string ;
2924 CPAN->debug($self) if $CPAN::DEBUG;
2925 my $class = ref($self);
2926 $class =~ s/^CPAN:://;
2928 push @m, $class, " id = $self->{ID}\n";
2929 my $sprintf = " %-12s %s\n";
2930 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
2931 my $sprintf2 = " %-12s %s (%s)\n";
2933 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
2938 CPAN::Shell->expand('Author',$userid)->fullname
2941 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
2942 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
2943 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
2944 my(%statd,%stats,%statl,%stati);
2945 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
2946 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
2947 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
2948 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
2949 $statd{' '} = 'unknown';
2950 $stats{' '} = 'unknown';
2951 $statl{' '} = 'unknown';
2952 $stati{' '} = 'unknown';
2960 $statd{$self->{statd}},
2961 $stats{$self->{stats}},
2962 $statl{$self->{statl}},
2963 $stati{$self->{stati}}
2964 ) if $self->{statd};
2965 my $local_file = $self->inst_file;
2966 if ($local_file && ! exists $self->{MANPAGE}) {
2967 my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
2972 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
2980 $self->{MANPAGE} = join " ", @result;
2983 for $item (qw/MANPAGE CONTAINS/) {
2984 push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
2986 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
2987 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
2991 #-> sub CPAN::Module::cpan_file ;
2994 CPAN->debug($self->id) if $CPAN::DEBUG;
2995 unless (defined $self->{'CPAN_FILE'}) {
2996 CPAN::Index->reload;
2998 if (defined $self->{'CPAN_FILE'}){
2999 return $self->{'CPAN_FILE'};
3000 } elsif (defined $self->{'userid'}) {
3001 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
3007 *name = \&cpan_file;
3009 #-> sub CPAN::Module::cpan_version ;
3010 sub cpan_version { shift->{'CPAN_VERSION'} }
3012 #-> sub CPAN::Module::force ;
3015 $self->{'force_update'}++;
3018 #-> sub CPAN::Module::rematein ;
3020 my($self,$meth) = @_;
3021 $self->debug($self->id) if $CPAN::DEBUG;
3022 my $cpan_file = $self->cpan_file;
3023 return if $cpan_file eq "N/A";
3024 return if $cpan_file =~ /^Contact Author/;
3025 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
3026 $pack->called_for($self->id);
3027 $pack->force if exists $self->{'force_update'};
3029 delete $self->{'force_update'};
3032 #-> sub CPAN::Module::readme ;
3033 sub readme { shift->rematein('readme') }
3034 #-> sub CPAN::Module::look ;
3035 sub look { shift->rematein('look') }
3036 #-> sub CPAN::Module::get ;
3037 sub get { shift->rematein('get',@_); }
3038 #-> sub CPAN::Module::make ;
3039 sub make { shift->rematein('make') }
3040 #-> sub CPAN::Module::test ;
3041 sub test { shift->rematein('test') }
3042 #-> sub CPAN::Module::install ;
3046 my($latest) = $self->cpan_version;
3048 my($inst_file) = $self->inst_file;
3050 if (defined $inst_file) {
3051 $have = $self->inst_version;
3053 if (1){ # A block for scoping $^W, the if is just for the visual
3056 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
3057 print $self->id, " is up to date.\n";
3062 $self->rematein('install') if $doit;
3064 #-> sub CPAN::Module::clean ;
3065 sub clean { shift->rematein('clean') }
3067 #-> sub CPAN::Module::inst_file ;
3071 @packpath = split /::/, $self->{ID};
3072 $packpath[-1] .= ".pm";
3073 foreach $dir (@INC) {
3074 my $pmfile = CPAN->catfile($dir,@packpath);
3082 #-> sub CPAN::Module::xs_file ;
3086 @packpath = split /::/, $self->{ID};
3087 push @packpath, $packpath[-1];
3088 $packpath[-1] .= "." . $Config::Config{'dlext'};
3089 foreach $dir (@INC) {
3090 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
3098 #-> sub CPAN::Module::inst_version ;
3101 my $parsefile = $self->inst_file or return 0;
3102 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
3103 my $have = MM->parse_version($parsefile);
3118 CPAN - query, download and build perl modules from CPAN sites
3124 perl -MCPAN -e shell;
3130 autobundle, clean, install, make, recompile, test
3134 The CPAN module is designed to automate the make and install of perl
3135 modules and extensions. It includes some searching capabilities and
3136 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
3137 to fetch the raw data from the net.
3139 Modules are fetched from one or more of the mirrored CPAN
3140 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
3143 The CPAN module also supports the concept of named and versioned
3144 'bundles' of modules. Bundles simplify the handling of sets of
3145 related modules. See BUNDLES below.
3147 The package contains a session manager and a cache manager. There is
3148 no status retained between sessions. The session manager keeps track
3149 of what has been fetched, built and installed in the current
3150 session. The cache manager keeps track of the disk space occupied by
3151 the make processes and deletes excess space according to a simple FIFO
3154 All methods provided are accessible in a programmer style and in an
3155 interactive shell style.
3157 =head2 Interactive Mode
3159 The interactive mode is entered by running
3161 perl -MCPAN -e shell
3163 which puts you into a readline interface. You will have most fun if
3164 you install Term::ReadKey and Term::ReadLine to enjoy both history and
3167 Once you are on the command line, type 'h' and the rest should be
3170 The most common uses of the interactive modes are
3174 =item Searching for authors, bundles, distribution files and modules
3176 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
3177 for each of the four categories and another, C<i> for any of the
3178 mentioned four. Each of the four entities is implemented as a class
3179 with slightly differing methods for displaying an object.
3181 Arguments you pass to these commands are either strings matching exact
3182 the identification string of an object or regular expressions that are
3183 then matched case-insensitively against various attributes of the
3184 objects. The parser recognizes a regualar expression only if you
3185 enclose it between two slashes.
3187 The principle is that the number of found objects influences how an
3188 item is displayed. If the search finds one item, we display the result
3189 of object-E<gt>as_string, but if we find more than one, we display
3190 each as object-E<gt>as_glimpse. E.g.
3194 EMAIL a.koenig@franz.ww.TU-Berlin.DE
3195 FULLNAME Andreas König
3200 EMAIL a.koenig@franz.ww.TU-Berlin.DE
3201 FULLNAME Andreas König
3205 Author ANDYD (Andy Dougherty)
3206 Author MERLYN (Randal L. Schwartz)
3208 =item make, test, install, clean modules or distributions
3210 These commands do indeed exist just as written above. Each of them
3211 takes any number of arguments and investigates for each what it might
3212 be. Is it a distribution file (recognized by embedded slashes), this
3213 file is being processed. Is it a module, CPAN determines the
3214 distribution file where this module is included and processes that.
3216 Any C<make>, C<test>, and C<readme> are run unconditionally. A
3218 install <distribution_file>
3220 also is run unconditionally. But for
3224 CPAN checks if an install is actually needed for it and prints
3225 I<Foo up to date> in case the module doesnE<39>t need to be updated.
3227 CPAN also keeps track of what it has done within the current session
3228 and doesnE<39>t try to build a package a second time regardless if it
3229 succeeded or not. The C<force > command takes as first argument the
3230 method to invoke (currently: make, test, or install) and executes the
3231 command from scratch.
3235 cpan> install OpenGL
3236 OpenGL is up to date.
3237 cpan> force install OpenGL
3240 OpenGL-0.4/COPYRIGHT
3243 =item readme, look module or distribution
3245 These two commands take only one argument, be it a module or a
3246 distribution file. C<readme> displays the README of the associated
3247 distribution file. C<Look> gets and untars (if not yet done) the
3248 distribution file, changes to the appropriate directory and opens a
3249 subshell process in that directory.
3255 The commands that are available in the shell interface are methods in
3256 the package CPAN::Shell. If you enter the shell command, all your
3257 input is split by the Text::ParseWords::shellwords() routine which
3258 acts like most shells do. The first word is being interpreted as the
3259 method to be called and the rest of the words are treated as arguments
3264 C<autobundle> writes a bundle file into the
3265 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
3266 a list of all modules that are both available from CPAN and currently
3267 installed within @INC. The name of the bundle file is based on the
3268 current date and a counter.
3272 recompile() is a very special command in that it takes no argument and
3273 runs the make/test/install cycle with brute force over all installed
3274 dynamically loadable extensions (aka XS modules) with 'force' in
3275 effect. Primary purpose of this command is to finish a network
3276 installation. Imagine, you have a common source tree for two different
3277 architectures. You decide to do a completely independent fresh
3278 installation. You start on one architecture with the help of a Bundle
3279 file produced earlier. CPAN installs the whole Bundle for you, but
3280 when you try to repeat the job on the second architecture, CPAN
3281 responds with a C<"Foo up to date"> message for all modules. So you
3282 will be glad to run recompile in the second architecture and
3285 Another popular use for C<recompile> is to act as a rescue in case your
3286 perl breaks binary compatibility. If one of the modules that CPAN uses
3287 is in turn depending on binary compatibility (so you cannot run CPAN
3288 commands), then you should try the CPAN::Nox module for recovery.
3290 =head2 The 4 C<CPAN::*> Classes: Author, Bundle, Module, Distribution
3292 Although it may be considered internal, the class hierarchie does
3293 matter for both users and programmer. CPAN.pm deals with above
3294 mentioned four classes, and all those classes share a set of
3295 methods. It is a classical single polymorphism that is in effect. A
3296 metaclass object registers all objects of all kinds and indexes them
3297 with a string. The strings referencing objects have a separated
3298 namespace (well, not completely separated):
3302 words containing a "/" (slash) Distribution
3303 words starting with Bundle:: Bundle
3304 everything else Module or Author
3306 Modules know their associated Distribution objects. They always refer
3307 to the most recent official release. Developers may mark their
3308 releases as unstable development versions (by inserting an underbar
3309 into the visible version number), so not always is the default
3310 distribution for a given module the really hottest and newest. If a
3311 module Foo circulates on CPAN in both version 1.23 and 1.23_90,
3312 CPAN.pm offers a convenient way to install version 1.23 by saying
3316 This would install the complete distribution file (say
3317 BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
3318 you would like to install version 1.23_90, you need to know where the
3319 distribution file resides on CPAN relative to the authors/id/
3320 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
3321 so he would have to say
3323 install BAR/Foo-1.23_90.tar.gz
3325 The first example will be driven by an object of the class
3326 CPAN::Module, the second by an object of class Distribution.
3328 =head2 ProgrammerE<39>s interface
3330 If you do not enter the shell, the available shell commands are both
3331 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
3332 functions in the calling package (C<install(...)>).
3334 There's currently only one class that has a stable interface,
3335 CPAN::Shell. All commands that are available in the CPAN shell are
3336 methods of the class CPAN::Shell. Each of the commands that produce
3337 listings of modules (C<r>, C<autobundle>, C<u>) returns a list of the
3338 IDs of all modules within the list.
3342 =item expand($type,@things)
3344 The IDs of all objects available within a program are strings that can
3345 be expanded to the corresponding real objects with the
3346 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
3347 list of CPAN::Module objects according to the C<@things> arguments
3348 given. In scalar context it only returns the first element of the
3351 =item Programming Examples
3353 This enables the programmer to do operations that combine
3354 functionalities that are available in the shell.
3356 # install everything that is outdated on my disk:
3357 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
3359 # install my favorite programs if necessary:
3360 for $mod (qw(Net::FTP MD5 Data::Dumper)){
3361 my $obj = CPAN::Shell->expand('Module',$mod);
3365 # list all modules on my disk that have no VERSION number
3366 for $mod (CPAN::Shell->expand("Module","/./")){
3367 next unless $mod->inst_file;
3368 next if $mod->inst_version;
3369 print "No VERSION in ", $mod->id, "\n";
3374 =head2 Methods in the four
3376 =head2 Cache Manager
3378 Currently the cache manager only keeps track of the build directory
3379 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
3380 deletes complete directories below C<build_dir> as soon as the size of
3381 all directories there gets bigger than $CPAN::Config->{build_cache}
3382 (in MB). The contents of this cache may be used for later
3383 re-installations that you intend to do manually, but will never be
3384 trusted by CPAN itself. This is due to the fact that the user might
3385 use these directories for building modules on different architectures.
3387 There is another directory ($CPAN::Config->{keep_source_where}) where
3388 the original distribution files are kept. This directory is not
3389 covered by the cache manager and must be controlled by the user. If
3390 you choose to have the same directory as build_dir and as
3391 keep_source_where directory, then your sources will be deleted with
3392 the same fifo mechanism.
3396 A bundle is just a perl module in the namespace Bundle:: that does not
3397 define any functions or methods. It usually only contains documentation.
3399 It starts like a perl module with a package declaration and a $VERSION
3400 variable. After that the pod section looks like any other pod with the
3401 only difference, that I<one special pod section> exists starting with
3406 In this pod section each line obeys the format
3408 Module_Name [Version_String] [- optional text]
3410 The only required part is the first field, the name of a module
3411 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
3412 of the line is optional. The comment part is delimited by a dash just
3413 as in the man page header.
3415 The distribution of a bundle should follow the same convention as
3416 other distributions.
3418 Bundles are treated specially in the CPAN package. If you say 'install
3419 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
3420 the modules in the CONTENTS section of the pod. You can install your
3421 own Bundles locally by placing a conformant Bundle file somewhere into
3422 your @INC path. The autobundle() command which is available in the
3423 shell interface does that for you by including all currently installed
3424 modules in a snapshot bundle file.
3426 There is a meaningless Bundle::Demo available on CPAN. Try to install
3427 it, it usually does no harm, just demonstrates what the Bundle
3428 interface looks like.
3430 =head2 Prerequisites
3432 If you have a local mirror of CPAN and can access all files with
3433 "file:" URLs, then you only need a perl better than perl5.003 to run
3434 this module. Otherwise Net::FTP is strongly recommended. LWP may be
3435 required for non-UNIX systems or if your nearest CPAN site is
3436 associated with an URL that is not C<ftp:>.
3438 If you have neither Net::FTP nor LWP, there is a fallback mechanism
3439 implemented for an external ftp command or for an external lynx
3442 This module presumes that all packages on CPAN
3448 declare their $VERSION variable in an easy to parse manner. This
3449 prerequisite can hardly be relaxed because it consumes by far too much
3450 memory to load all packages into the running program just to determine
3451 the $VERSION variable . Currently all programs that are dealing with
3452 version use something like this
3454 perl -MExtUtils::MakeMaker -le \
3455 'print MM->parse_version($ARGV[0])' filename
3457 If you are author of a package and wonder if your $VERSION can be
3458 parsed, please try the above method.
3462 come as compressed or gzipped tarfiles or as zip files and contain a
3463 Makefile.PL (well we try to handle a bit more, but without much
3470 The debugging of this module is pretty difficult, because we have
3471 interferences of the software producing the indices on CPAN, of the
3472 mirroring process on CPAN, of packaging, of configuration, of
3473 synchronicity, and of bugs within CPAN.pm.
3475 In interactive mode you can try "o debug" which will list options for
3476 debugging the various parts of the package. The output may not be very
3477 useful for you as it's just a byproduct of my own testing, but if you
3478 have an idea which part of the package may have a bug, it's sometimes
3479 worth to give it a try and send me more specific output. You should
3480 know that "o debug" has built-in completion support.
3482 =head2 Floppy, Zip, and all that Jazz
3484 CPAN.pm works nicely without network too. If you maintain machines
3485 that are not networked at all, you should consider working with file:
3486 URLs. Of course, you have to collect your modules somewhere first. So
3487 you might use CPAN.pm to put together all you need on a networked
3488 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
3489 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
3490 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
3493 =head1 CONFIGURATION
3495 When the CPAN module is installed a site wide configuration file is
3496 created as CPAN/Config.pm. The default values defined there can be
3497 overridden in another configuration file: CPAN/MyConfig.pm. You can
3498 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
3499 $HOME/.cpan is added to the search path of the CPAN module before the
3500 use() or require() statements.
3502 Currently the following keys in the hash reference $CPAN::Config are
3505 build_cache size of cache for directories to build modules
3506 build_dir locally accessible directory to build modules
3507 index_expire after how many days refetch index files
3508 cpan_home local directory reserved for this package
3509 gzip location of external program gzip
3510 inactivity_timeout breaks interactive Makefile.PLs after that
3511 many seconds inactivity. Set to 0 to never break.
3512 inhibit_startup_message
3513 if true, does not print the startup message
3514 keep_source keep the source in a local directory?
3515 keep_source_where where keep the source (if we do)
3516 make location of external program make
3517 make_arg arguments that should always be passed to 'make'
3518 make_install_arg same as make_arg for 'make install'
3519 makepl_arg arguments passed to 'perl Makefile.PL'
3520 pager location of external program more (or any pager)
3521 tar location of external program tar
3522 unzip location of external program unzip
3523 urllist arrayref to nearby CPAN sites (or equivalent locations)
3525 You can set and query each of these options interactively in the cpan
3526 shell with the command set defined within the C<o conf> command:
3530 =item o conf E<lt>scalar optionE<gt>
3532 prints the current value of the I<scalar option>
3534 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
3536 Sets the value of the I<scalar option> to I<value>
3538 =item o conf E<lt>list optionE<gt>
3540 prints the current value of the I<list option> in MakeMaker's
3543 =item o conf E<lt>list optionE<gt> [shift|pop]
3545 shifts or pops the array in the I<list option> variable
3547 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
3549 works like the corresponding perl commands.
3555 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
3556 install foreign, unmasked, unsigned code on your machine. We compare
3557 to a checksum that comes from the net just as the distribution file
3558 itself. If somebody has managed to tamper with the distribution file,
3559 they may have as well tampered with the CHECKSUMS file. Future
3560 development will go towards strong authentification.
3564 Most functions in package CPAN are exported per default. The reason
3565 for this is that the primary use is intended for the cpan shell or for
3570 we should give coverage for _all_ of the CPAN and not just the
3571 __PAUSE__ part, right? In this discussion CPAN and PAUSE have become
3572 equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
3573 PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
3575 Future development should be directed towards a better intergration of
3580 Andreas König E<lt>a.koenig@mind.deE<gt>
3584 perl(1), CPAN::Nox(3)