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 ### $version =~ s/^\+//;
2044 # if it as a bundle, instatiate a bundle object
2045 my($bundle,$id,$userid);
2047 if ($mod eq 'CPAN') {
2049 if ($version > $CPAN::VERSION){
2051 There\'s a new CPAN.pm version (v$version) available!
2052 You might want to try
2055 without quitting the current session. It should be a seemless upgrade
2056 while we are running...
2061 last if $CPAN::Signal;
2062 } elsif ($mod =~ /^Bundle::(.*)/) {
2067 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
2068 ### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
2069 # This "next" makes us faster but if the job is running long, we ignore
2070 # rereads which is bad. So we have to be a bit slower again.
2071 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
2074 # instantiate a module object
2075 $id = $CPAN::META->instance('CPAN::Module',$mod);
2076 ### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
2077 ### if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
2080 if ($id->cpan_file ne $dist){
2081 # determine the author
2082 ($userid) = $dist =~ /([^\/]+)/;
2084 'CPAN_USERID' => $userid,
2085 'CPAN_VERSION' => $version,
2086 'CPAN_FILE' => $dist
2090 # instantiate a distribution object
2091 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
2092 $CPAN::META->instance(
2093 'CPAN::Distribution' => $dist
2095 'CPAN_USERID' => $userid
2099 return if $CPAN::Signal;
2102 $? and Carp::croak "FAILED $pipe: exit status [$?]";
2105 #-> sub CPAN::Index::rd_modlist ;
2107 my($cl,$index_target) = @_;
2108 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
2109 print "Going to read $index_target\n";
2110 my $fh = FileHandle->new("$pipe|");
2113 if (/^Date:\s+(.*)/){
2114 return if $date_of_03 eq $1;
2122 $eval .= q{CPAN::Modulelist->data;};
2124 my($comp) = Safe->new("CPAN::Safe1");
2125 my $ret = $comp->reval($eval);
2126 Carp::confess($@) if $@;
2127 return if $CPAN::Signal;
2129 my $obj = $CPAN::META->instance(CPAN::Module,$_);
2130 $obj->set(%{$ret->{$_}});
2131 return if $CPAN::Signal;
2135 package CPAN::InfoObj;
2137 #-> sub CPAN::InfoObj::new ;
2138 sub new { my $this = bless {}, shift; %$this = @_; $this }
2140 #-> sub CPAN::InfoObj::set ;
2142 my($self,%att) = @_;
2143 my(%oldatt) = %$self;
2144 %$self = (%oldatt, %att);
2147 #-> sub CPAN::InfoObj::id ;
2148 sub id { shift->{'ID'} }
2150 #-> sub CPAN::InfoObj::as_glimpse ;
2154 my $class = ref($self);
2155 $class =~ s/^CPAN:://;
2156 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2160 #-> sub CPAN::InfoObj::as_string ;
2164 my $class = ref($self);
2165 $class =~ s/^CPAN:://;
2166 push @m, $class, " id = $self->{ID}\n";
2167 for (sort keys %$self) {
2170 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
2171 if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
2172 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2174 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
2180 #-> sub CPAN::InfoObj::author ;
2183 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2186 package CPAN::Author;
2188 #-> sub CPAN::Author::as_glimpse ;
2192 my $class = ref($self);
2193 $class =~ s/^CPAN:://;
2194 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2198 # Dead code, I would have liked to have,,, but it was never reached,,,
2201 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
2204 #-> sub CPAN::Author::fullname ;
2205 sub fullname { shift->{'FULLNAME'} }
2207 #-> sub CPAN::Author::email ;
2208 sub email { shift->{'EMAIL'} }
2210 package CPAN::Distribution;
2212 #-> sub CPAN::Distribution::called_for ;
2215 $self->{'CALLED_FOR'} = $id if defined $id;
2216 return $self->{'CALLED_FOR'};
2219 #-> sub CPAN::Distribution::get ;
2224 exists $self->{'build_dir'} and push @e,
2225 "Unwrapped into directory $self->{'build_dir'}";
2226 print join "", map {" $_\n"} @e and return if @e;
2231 $CPAN::Config->{keep_source_where},
2234 split("/",$self->{ID})
2237 $self->debug("Doing localize") if $CPAN::DEBUG;
2238 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
2239 $self->{localfile} = $local_file;
2240 my $builddir = $CPAN::META->{cachemgr}->dir;
2241 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2242 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2245 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2246 if ($CPAN::META->has_inst('MD5')) {
2247 $self->debug("MD5 is installed, verifying");
2250 $self->debug("MD5 is NOT installed");
2252 $self->debug("Removing tmp") if $CPAN::DEBUG;
2253 File::Path::rmtree("tmp");
2254 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
2256 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2257 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
2258 $self->untar_me($local_file);
2259 } elsif ( $local_file =~ /\.zip$/i ) {
2260 $self->unzip_me($local_file);
2261 } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
2262 $self->pm2dir_me($local_file);
2264 $self->{archived} = "NO";
2267 if ($self->{archived} ne 'NO') {
2269 # Let's check if the package has its own directory.
2270 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!");
2271 my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
2273 my ($distdir,$packagedir);
2274 if (@readdir == 1 && -d $readdir[0]) {
2275 $distdir = $readdir[0];
2276 $packagedir = $CPAN::META->catdir($builddir,$distdir);
2277 -d $packagedir and print "Removing previously used $packagedir\n";
2278 File::Path::rmtree($packagedir);
2279 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2281 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2282 $pragmatic_dir =~ s/\W_//g;
2283 $pragmatic_dir++ while -d "../$pragmatic_dir";
2284 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
2285 File::Path::mkpath($packagedir);
2287 for $f (@readdir) { # is already without "." and ".."
2288 my $to = $CPAN::META->catdir($packagedir,$f);
2289 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2292 $self->{'build_dir'} = $packagedir;
2295 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
2297 File::Path::rmtree("tmp");
2298 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
2299 print "Going to unlink $local_file\n";
2300 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
2302 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
2303 unless (-f $makefilepl) {
2304 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
2305 if (-f $configure) {
2306 # do we have anything to do?
2307 $self->{'configure'} = $configure;
2309 my $fh = FileHandle->new(">$makefilepl")
2310 or Carp::croak("Could not open >$makefilepl");
2311 my $cf = $self->called_for || "unknown";
2313 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
2314 # because there was no Makefile.PL supplied.
2315 # Autogenerated on: }.scalar localtime().qq{
2317 use ExtUtils::MakeMaker;
2318 WriteMakefile(NAME => q[$cf]);
2321 print qq{Package comes without Makefile.PL.\n}.
2322 qq{ Writing one on our own (calling it $cf)\n};
2330 my($self,$local_file) = @_;
2331 $self->{archived} = "tar";
2332 my $system = "$CPAN::Config->{gzip} --decompress --stdout " .
2333 "$local_file | $CPAN::Config->{tar} xvf -";
2334 if (system($system)== 0) {
2335 $self->{unwrapped} = "YES";
2337 $self->{unwrapped} = "NO";
2342 my($self,$local_file) = @_;
2343 $self->{archived} = "zip";
2344 my $system = "$CPAN::Config->{unzip} $local_file";
2345 if (system($system) == 0) {
2346 $self->{unwrapped} = "YES";
2348 $self->{unwrapped} = "NO";
2353 my($self,$local_file) = @_;
2354 $self->{archived} = "pm";
2355 my $to = File::Basename::basename($local_file);
2356 $to =~ s/\.(gz|Z)$//;
2357 my $system = "$CPAN::Config->{gzip} --decompress --stdout $local_file > $to";
2358 if (system($system) == 0) {
2359 $self->{unwrapped} = "YES";
2361 $self->{unwrapped} = "NO";
2365 #-> sub CPAN::Distribution::new ;
2367 my($class,%att) = @_;
2369 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
2371 my $this = { %att };
2372 return bless $this, $class;
2375 #-> sub CPAN::Distribution::look ;
2378 if ( $CPAN::Config->{'shell'} ) {
2380 Trying to open a subshell in the build directory...
2384 Your configuration does not define a value for subshells.
2385 Please define it with "o conf shell <your shell>"
2389 my $dist = $self->id;
2390 my $dir = $self->dir or $self->get;
2393 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2394 my $pwd = CPAN->$getcwd();
2396 print qq{Working directory is $dir.\n};
2397 system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
2401 #-> sub CPAN::Distribution::readme ;
2404 my($dist) = $self->id;
2405 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
2406 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
2410 $CPAN::Config->{keep_source_where},
2413 split("/","$sans.readme"),
2415 $self->debug("Doing localize") if $CPAN::DEBUG;
2416 $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
2417 my $fh_pager = FileHandle->new;
2418 $fh_pager->open("|$CPAN::Config->{'pager'}")
2419 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
2420 my $fh_readme = FileHandle->new;
2421 $fh_readme->open($local_file) or die "Could not open $local_file: $!";
2422 $fh_pager->print(<$fh_readme>);
2425 #-> sub CPAN::Distribution::verifyMD5 ;
2430 $self->{MD5_STATUS} ||= "";
2431 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
2432 print join "", map {" $_\n"} @e and return if @e;
2434 my($lc_want,$lc_file,@local,$basename);
2435 @local = split("/",$self->{ID});
2437 push @local, "CHECKSUMS";
2439 CPAN->catfile($CPAN::Config->{keep_source_where},
2440 "authors", "id", @local);
2445 $self->MD5_check_file($lc_want)
2447 return $self->{MD5_STATUS} = "OK";
2449 $lc_file = CPAN::FTP->localize("authors/id/@local",
2450 $lc_want,'force>:-{');
2452 $local[-1] .= ".gz";
2453 $lc_file = CPAN::FTP->localize("authors/id/@local",
2454 "$lc_want.gz",'force>:-{');
2455 my @system = ($CPAN::Config->{gzip}, '--decompress', $lc_file);
2456 system(@system) == 0 or die "Could not uncompress $lc_file";
2457 $lc_file =~ s/\.gz$//;
2459 $self->MD5_check_file($lc_file);
2462 #-> sub CPAN::Distribution::MD5_check_file ;
2463 sub MD5_check_file {
2464 my($self,$chk_file) = @_;
2465 my($cksum,$file,$basename);
2466 $file = $self->{localfile};
2467 $basename = File::Basename::basename($file);
2468 my $fh = FileHandle->new;
2470 if (open $fh, $chk_file){
2473 my($comp) = Safe->new();
2474 $cksum = $comp->reval($eval);
2476 rename $chk_file, "$chk_file.bad";
2477 Carp::confess($@) if $@;
2480 Carp::carp "Could not open $chk_file for reading";
2482 if ($cksum->{$basename}->{md5}) {
2483 $self->debug("Found checksum for $basename:" .
2484 "$cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
2485 my $pipe = "$CPAN::Config->{gzip} --decompress ".
2490 $self->eq_MD5($fh,$cksum->{$basename}->{md5})
2494 $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
2496 print "Checksum for $file ok\n";
2497 return $self->{MD5_STATUS} = "OK";
2499 print qq{Checksum mismatch for distribution file. }.
2500 qq{Please investigate.\n\n};
2501 print $self->as_string;
2502 print $CPAN::META->instance(
2504 $self->{CPAN_USERID}
2506 my $wrap = qq{I\'d recommend removing $file. It seems to
2507 be a bogus file. Maybe you have configured your \`urllist\' with a
2508 bad URL. Please check this array with \`o conf urllist\', and
2510 print Text::Wrap::wrap("","",$wrap);
2515 close $fh if fileno($fh);
2517 $self->{MD5_STATUS} ||= "";
2518 if ($self->{MD5_STATUS} eq "NIL") {
2519 print "\nNo md5 checksum for $basename in local $chk_file.";
2520 print "Removing $chk_file\n";
2521 unlink $chk_file or print "Could not unlink: $!";
2524 $self->{MD5_STATUS} = "NIL";
2529 #-> sub CPAN::Distribution::eq_MD5 ;
2531 my($self,$fh,$expectMD5) = @_;
2534 my $hexdigest = $md5->hexdigest;
2535 $hexdigest eq $expectMD5;
2538 #-> sub CPAN::Distribution::force ;
2541 $self->{'force_update'}++;
2542 delete $self->{'MD5_STATUS'};
2543 delete $self->{'archived'};
2544 delete $self->{'build_dir'};
2545 delete $self->{'localfile'};
2546 delete $self->{'make'};
2547 delete $self->{'install'};
2548 delete $self->{'unwrapped'};
2549 delete $self->{'writemakefile'};
2552 #-> sub CPAN::Distribution::perl ;
2555 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
2556 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2557 my $pwd = CPAN->$getcwd();
2558 my $candidate = $CPAN::META->catfile($pwd,$^X);
2559 $perl ||= $candidate if MM->maybe_command($candidate);
2561 my ($component,$perl_name);
2562 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
2563 PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
2564 next unless defined($component) && $component;
2565 my($abs) = MM->catfile($component,$perl_name);
2566 if (MM->maybe_command($abs)) {
2576 #-> sub CPAN::Distribution::make ;
2579 $self->debug($self->id) if $CPAN::DEBUG;
2580 print "Running make\n";
2584 $self->{archived} eq "NO" and push @e,
2585 "Is neither a tar nor a zip archive.";
2587 $self->{unwrapped} eq "NO" and push @e,
2588 "had problems unarchiving. Please build manually";
2590 exists $self->{writemakefile} &&
2591 $self->{writemakefile} eq "NO" and push @e,
2592 "Had some problem writing Makefile";
2594 defined $self->{'make'} and push @e,
2595 "Has already been processed within this session";
2597 print join "", map {" $_\n"} @e and return if @e;
2599 print "\n CPAN.pm: Going to build ".$self->id."\n\n";
2600 my $builddir = $self->dir;
2601 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2602 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
2605 if ($self->{'configure'}) {
2606 $system = $self->{'configure'};
2608 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
2610 # This needs a handler that can be turned on or off:
2611 # $switch = "-MExtUtils::MakeMaker ".
2612 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
2614 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
2617 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
2620 if ($CPAN::Config->{inactivity_timeout}) {
2622 alarm $CPAN::Config->{inactivity_timeout};
2623 local $SIG{CHLD} = sub { wait };
2624 if (defined($pid = fork)) {
2631 print "Cannot fork: $!";
2640 $self->{writemakefile} = "NO - $@";
2645 $ret = system($system);
2647 $self->{writemakefile} = "NO";
2652 $self->{writemakefile} = "YES";
2653 return if $CPAN::Signal;
2654 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
2655 if (system($system) == 0) {
2656 print " $system -- OK\n";
2657 $self->{'make'} = "YES";
2659 $self->{writemakefile} = "YES";
2660 $self->{'make'} = "NO";
2661 print " $system -- NOT OK\n";
2665 #-> sub CPAN::Distribution::test ;
2669 return if $CPAN::Signal;
2670 print "Running make test\n";
2673 exists $self->{'make'} or push @e,
2674 "Make had some problems, maybe interrupted? Won't test";
2676 exists $self->{'make'} and
2677 $self->{'make'} eq 'NO' and
2678 push @e, "Oops, make had returned bad status";
2680 exists $self->{'build_dir'} or push @e, "Has no own directory";
2681 print join "", map {" $_\n"} @e and return if @e;
2683 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2684 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2685 my $system = join " ", $CPAN::Config->{'make'}, "test";
2686 if (system($system) == 0) {
2687 print " $system -- OK\n";
2688 $self->{'make_test'} = "YES";
2690 $self->{'make_test'} = "NO";
2691 print " $system -- NOT OK\n";
2695 #-> sub CPAN::Distribution::clean ;
2698 print "Running make clean\n";
2701 exists $self->{'build_dir'} or push @e, "Has no own directory";
2702 print join "", map {" $_\n"} @e and return if @e;
2704 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2705 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2706 my $system = join " ", $CPAN::Config->{'make'}, "clean";
2707 if (system($system) == 0) {
2708 print " $system -- OK\n";
2711 # Hmmm, what to do if make clean failed?
2715 #-> sub CPAN::Distribution::install ;
2719 return if $CPAN::Signal;
2720 print "Running make install\n";
2723 exists $self->{'build_dir'} or push @e, "Has no own directory";
2725 exists $self->{'make'} or push @e,
2726 "Make had some problems, maybe interrupted? Won't install";
2728 exists $self->{'make'} and
2729 $self->{'make'} eq 'NO' and
2730 push @e, "Oops, make had returned bad status";
2732 push @e, "make test had returned bad status, won't install without force"
2733 if exists $self->{'make_test'} and
2734 $self->{'make_test'} eq 'NO' and
2735 ! $self->{'force_update'};
2737 exists $self->{'install'} and push @e,
2738 $self->{'install'} eq "YES" ?
2739 "Already done" : "Already tried without success";
2741 print join "", map {" $_\n"} @e and return if @e;
2743 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2744 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2745 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
2746 my($pipe) = FileHandle->new("$system 2>&1 |");
2754 print " $system -- OK\n";
2755 $self->{'install'} = "YES";
2757 $self->{'install'} = "NO";
2758 print " $system -- NOT OK\n";
2759 if ($makeout =~ /permission/s && $> > 0) {
2760 print " You may have to su to root to install the package\n";
2765 #-> sub CPAN::Distribution::dir ;
2767 shift->{'build_dir'};
2770 package CPAN::Bundle;
2772 #-> sub CPAN::Bundle::as_string ;
2776 $self->{INST_VERSION} = $self->inst_version;
2777 return $self->SUPER::as_string;
2780 #-> sub CPAN::Bundle::contains ;
2783 my($parsefile) = $self->inst_file;
2784 unless ($parsefile) {
2785 # Try to get at it in the cpan directory
2786 $self->debug("no parsefile") if $CPAN::DEBUG;
2787 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
2789 $self->debug($dist->as_string) if $CPAN::DEBUG;
2790 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2791 File::Path::mkpath($todir);
2793 ($me = $self->id) =~ s/.*://;
2794 $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
2795 $to = $CPAN::META->catfile($todir,"$me.pm");
2796 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
2800 my $fh = FileHandle->new;
2802 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
2804 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
2806 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
2811 push @result, (split " ", $_, 2)[0];
2814 delete $self->{STATUS};
2815 $self->{CONTAINS} = join ", ", @result;
2816 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
2820 #-> sub CPAN::Bundle::find_bundle_file
2821 sub find_bundle_file {
2822 my($self,$where,$what) = @_;
2823 my $bu = $CPAN::META->catfile($where,$what);
2824 return $bu if -f $bu;
2825 my $manifest = $CPAN::META->catfile($where,"MANIFEST");
2826 unless (-f $manifest) {
2827 require ExtUtils::Manifest;
2828 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2829 my $cwd = CPAN->$getcwd();
2831 ExtUtils::Manifest::mkmanifest();
2834 my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
2838 my($file) = /(\S+)/;
2839 if ($file =~ m|Bundle/$what$|) {
2841 return $CPAN::META->catfile($where,$bu);
2844 Carp::croak("Could't find a Bundle file in $where");
2847 #-> sub CPAN::Bundle::inst_file ;
2851 ($me = $self->id) =~ s/.*://;
2852 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
2853 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2855 $self->SUPER::inst_file;
2856 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2857 # return $self->{'INST_FILE'}; # even if undefined?
2860 #-> sub CPAN::Bundle::rematein ;
2862 my($self,$meth) = @_;
2863 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
2865 for $s ($self->contains) {
2866 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
2867 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
2868 if ($type eq 'CPAN::Distribution') {
2870 The Bundle }.$self->id.qq{ contains
2871 explicitly a file $s.
2875 $CPAN::META->instance($type,$s)->$meth();
2879 #sub CPAN::Bundle::xs_file
2881 # If a bundle contains another that contains an xs_file we have
2882 # here, we just don't bother I suppose
2886 #-> sub CPAN::Bundle::force ;
2887 sub force { shift->rematein('force',@_); }
2888 #-> sub CPAN::Bundle::get ;
2889 sub get { shift->rematein('get',@_); }
2890 #-> sub CPAN::Bundle::make ;
2891 sub make { shift->rematein('make',@_); }
2892 #-> sub CPAN::Bundle::test ;
2893 sub test { shift->rematein('test',@_); }
2894 #-> sub CPAN::Bundle::install ;
2895 sub install { shift->rematein('install',@_); }
2896 #-> sub CPAN::Bundle::clean ;
2897 sub clean { shift->rematein('clean',@_); }
2899 #-> sub CPAN::Bundle::readme ;
2902 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
2903 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
2904 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
2907 package CPAN::Module;
2909 #-> sub CPAN::Module::as_glimpse ;
2913 my $class = ref($self);
2914 $class =~ s/^CPAN:://;
2915 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
2919 #-> sub CPAN::Module::as_string ;
2923 CPAN->debug($self) if $CPAN::DEBUG;
2924 my $class = ref($self);
2925 $class =~ s/^CPAN:://;
2927 push @m, $class, " id = $self->{ID}\n";
2928 my $sprintf = " %-12s %s\n";
2929 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
2930 my $sprintf2 = " %-12s %s (%s)\n";
2932 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
2937 CPAN::Shell->expand('Author',$userid)->fullname
2940 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
2941 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
2942 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
2943 my(%statd,%stats,%statl,%stati);
2944 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
2945 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
2946 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
2947 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
2948 $statd{' '} = 'unknown';
2949 $stats{' '} = 'unknown';
2950 $statl{' '} = 'unknown';
2951 $stati{' '} = 'unknown';
2959 $statd{$self->{statd}},
2960 $stats{$self->{stats}},
2961 $statl{$self->{statl}},
2962 $stati{$self->{stati}}
2963 ) if $self->{statd};
2964 my $local_file = $self->inst_file;
2965 if ($local_file && ! exists $self->{MANPAGE}) {
2966 my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
2971 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
2979 $self->{MANPAGE} = join " ", @result;
2982 for $item (qw/MANPAGE CONTAINS/) {
2983 push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
2985 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
2986 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
2990 #-> sub CPAN::Module::cpan_file ;
2993 CPAN->debug($self->id) if $CPAN::DEBUG;
2994 unless (defined $self->{'CPAN_FILE'}) {
2995 CPAN::Index->reload;
2997 if (defined $self->{'CPAN_FILE'}){
2998 return $self->{'CPAN_FILE'};
2999 } elsif (defined $self->{'userid'}) {
3000 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
3006 *name = \&cpan_file;
3008 #-> sub CPAN::Module::cpan_version ;
3009 sub cpan_version { shift->{'CPAN_VERSION'} }
3011 #-> sub CPAN::Module::force ;
3014 $self->{'force_update'}++;
3017 #-> sub CPAN::Module::rematein ;
3019 my($self,$meth) = @_;
3020 $self->debug($self->id) if $CPAN::DEBUG;
3021 my $cpan_file = $self->cpan_file;
3022 return if $cpan_file eq "N/A";
3023 return if $cpan_file =~ /^Contact Author/;
3024 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
3025 $pack->called_for($self->id);
3026 $pack->force if exists $self->{'force_update'};
3028 delete $self->{'force_update'};
3031 #-> sub CPAN::Module::readme ;
3032 sub readme { shift->rematein('readme') }
3033 #-> sub CPAN::Module::look ;
3034 sub look { shift->rematein('look') }
3035 #-> sub CPAN::Module::get ;
3036 sub get { shift->rematein('get',@_); }
3037 #-> sub CPAN::Module::make ;
3038 sub make { shift->rematein('make') }
3039 #-> sub CPAN::Module::test ;
3040 sub test { shift->rematein('test') }
3041 #-> sub CPAN::Module::install ;
3045 my($latest) = $self->cpan_version;
3047 my($inst_file) = $self->inst_file;
3049 if (defined $inst_file) {
3050 $have = $self->inst_version;
3052 if (1){ # A block for scoping $^W, the if is just for the visual
3055 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
3056 print $self->id, " is up to date.\n";
3061 $self->rematein('install') if $doit;
3063 #-> sub CPAN::Module::clean ;
3064 sub clean { shift->rematein('clean') }
3066 #-> sub CPAN::Module::inst_file ;
3070 @packpath = split /::/, $self->{ID};
3071 $packpath[-1] .= ".pm";
3072 foreach $dir (@INC) {
3073 my $pmfile = CPAN->catfile($dir,@packpath);
3081 #-> sub CPAN::Module::xs_file ;
3085 @packpath = split /::/, $self->{ID};
3086 push @packpath, $packpath[-1];
3087 $packpath[-1] .= "." . $Config::Config{'dlext'};
3088 foreach $dir (@INC) {
3089 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
3097 #-> sub CPAN::Module::inst_version ;
3100 my $parsefile = $self->inst_file or return 0;
3101 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
3102 my $have = MM->parse_version($parsefile);
3117 CPAN - query, download and build perl modules from CPAN sites
3123 perl -MCPAN -e shell;
3129 autobundle, clean, install, make, recompile, test
3133 The CPAN module is designed to automate the make and install of perl
3134 modules and extensions. It includes some searching capabilities and
3135 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
3136 to fetch the raw data from the net.
3138 Modules are fetched from one or more of the mirrored CPAN
3139 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
3142 The CPAN module also supports the concept of named and versioned
3143 'bundles' of modules. Bundles simplify the handling of sets of
3144 related modules. See BUNDLES below.
3146 The package contains a session manager and a cache manager. There is
3147 no status retained between sessions. The session manager keeps track
3148 of what has been fetched, built and installed in the current
3149 session. The cache manager keeps track of the disk space occupied by
3150 the make processes and deletes excess space according to a simple FIFO
3153 All methods provided are accessible in a programmer style and in an
3154 interactive shell style.
3156 =head2 Interactive Mode
3158 The interactive mode is entered by running
3160 perl -MCPAN -e shell
3162 which puts you into a readline interface. You will have most fun if
3163 you install Term::ReadKey and Term::ReadLine to enjoy both history and
3166 Once you are on the command line, type 'h' and the rest should be
3169 The most common uses of the interactive modes are
3173 =item Searching for authors, bundles, distribution files and modules
3175 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
3176 for each of the four categories and another, C<i> for any of the
3177 mentioned four. Each of the four entities is implemented as a class
3178 with slightly differing methods for displaying an object.
3180 Arguments you pass to these commands are either strings matching exact
3181 the identification string of an object or regular expressions that are
3182 then matched case-insensitively against various attributes of the
3183 objects. The parser recognizes a regualar expression only if you
3184 enclose it between two slashes.
3186 The principle is that the number of found objects influences how an
3187 item is displayed. If the search finds one item, we display the result
3188 of object-E<gt>as_string, but if we find more than one, we display
3189 each as object-E<gt>as_glimpse. E.g.
3193 EMAIL a.koenig@franz.ww.TU-Berlin.DE
3194 FULLNAME Andreas König
3199 EMAIL a.koenig@franz.ww.TU-Berlin.DE
3200 FULLNAME Andreas König
3204 Author ANDYD (Andy Dougherty)
3205 Author MERLYN (Randal L. Schwartz)
3207 =item make, test, install, clean modules or distributions
3209 These commands do indeed exist just as written above. Each of them
3210 takes any number of arguments and investigates for each what it might
3211 be. Is it a distribution file (recognized by embedded slashes), this
3212 file is being processed. Is it a module, CPAN determines the
3213 distribution file where this module is included and processes that.
3215 Any C<make>, C<test>, and C<readme> are run unconditionally. A
3217 install <distribution_file>
3219 also is run unconditionally. But for
3223 CPAN checks if an install is actually needed for it and prints
3224 I<Foo up to date> in case the module doesnE<39>t need to be updated.
3226 CPAN also keeps track of what it has done within the current session
3227 and doesnE<39>t try to build a package a second time regardless if it
3228 succeeded or not. The C<force > command takes as first argument the
3229 method to invoke (currently: make, test, or install) and executes the
3230 command from scratch.
3234 cpan> install OpenGL
3235 OpenGL is up to date.
3236 cpan> force install OpenGL
3239 OpenGL-0.4/COPYRIGHT
3242 =item readme, look module or distribution
3244 These two commands take only one argument, be it a module or a
3245 distribution file. C<readme> displays the README of the associated
3246 distribution file. C<Look> gets and untars (if not yet done) the
3247 distribution file, changes to the appropriate directory and opens a
3248 subshell process in that directory.
3254 The commands that are available in the shell interface are methods in
3255 the package CPAN::Shell. If you enter the shell command, all your
3256 input is split by the Text::ParseWords::shellwords() routine which
3257 acts like most shells do. The first word is being interpreted as the
3258 method to be called and the rest of the words are treated as arguments
3263 C<autobundle> writes a bundle file into the
3264 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
3265 a list of all modules that are both available from CPAN and currently
3266 installed within @INC. The name of the bundle file is based on the
3267 current date and a counter.
3271 recompile() is a very special command in that it takes no argument and
3272 runs the make/test/install cycle with brute force over all installed
3273 dynamically loadable extensions (aka XS modules) with 'force' in
3274 effect. Primary purpose of this command is to finish a network
3275 installation. Imagine, you have a common source tree for two different
3276 architectures. You decide to do a completely independent fresh
3277 installation. You start on one architecture with the help of a Bundle
3278 file produced earlier. CPAN installs the whole Bundle for you, but
3279 when you try to repeat the job on the second architecture, CPAN
3280 responds with a C<"Foo up to date"> message for all modules. So you
3281 will be glad to run recompile in the second architecture and
3284 Another popular use for C<recompile> is to act as a rescue in case your
3285 perl breaks binary compatibility. If one of the modules that CPAN uses
3286 is in turn depending on binary compatibility (so you cannot run CPAN
3287 commands), then you should try the CPAN::Nox module for recovery.
3289 =head2 The 4 C<CPAN::*> Classes: Author, Bundle, Module, Distribution
3291 Although it may be considered internal, the class hierarchie does
3292 matter for both users and programmer. CPAN.pm deals with above
3293 mentioned four classes, and all those classes share a set of
3294 methods. It is a classical single polymorphism that is in effect. A
3295 metaclass object registers all objects of all kinds and indexes them
3296 with a string. The strings referencing objects have a separated
3297 namespace (well, not completely separated):
3301 words containing a "/" (slash) Distribution
3302 words starting with Bundle:: Bundle
3303 everything else Module or Author
3305 Modules know their associated Distribution objects. They always refer
3306 to the most recent official release. Developers may mark their
3307 releases as unstable development versions (by inserting an underbar
3308 into the visible version number), so not always is the default
3309 distribution for a given module the really hottest and newest. If a
3310 module Foo circulates on CPAN in both version 1.23 and 1.23_90,
3311 CPAN.pm offers a convenient way to install version 1.23 by saying
3315 This would install the complete distribution file (say
3316 BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
3317 you would like to install version 1.23_90, you need to know where the
3318 distribution file resides on CPAN relative to the authors/id/
3319 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
3320 so he would have to say
3322 install BAR/Foo-1.23_90.tar.gz
3324 The first example will be driven by an object of the class
3325 CPAN::Module, the second by an object of class Distribution.
3327 =head2 ProgrammerE<39>s interface
3329 If you do not enter the shell, the available shell commands are both
3330 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
3331 functions in the calling package (C<install(...)>).
3333 There's currently only one class that has a stable interface,
3334 CPAN::Shell. All commands that are available in the CPAN shell are
3335 methods of the class CPAN::Shell. Each of the commands that produce
3336 listings of modules (C<r>, C<autobundle>, C<u>) returns a list of the
3337 IDs of all modules within the list.
3341 =item expand($type,@things)
3343 The IDs of all objects available within a program are strings that can
3344 be expanded to the corresponding real objects with the
3345 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
3346 list of CPAN::Module objects according to the C<@things> arguments
3347 given. In scalar context it only returns the first element of the
3350 =item Programming Examples
3352 This enables the programmer to do operations that combine
3353 functionalities that are available in the shell.
3355 # install everything that is outdated on my disk:
3356 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
3358 # install my favorite programs if necessary:
3359 for $mod (qw(Net::FTP MD5 Data::Dumper)){
3360 my $obj = CPAN::Shell->expand('Module',$mod);
3364 # list all modules on my disk that have no VERSION number
3365 for $mod (CPAN::Shell->expand("Module","/./")){
3366 next unless $mod->inst_file;
3367 next if $mod->inst_version;
3368 print "No VERSION in ", $mod->id, "\n";
3373 =head2 Methods in the four
3375 =head2 Cache Manager
3377 Currently the cache manager only keeps track of the build directory
3378 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
3379 deletes complete directories below C<build_dir> as soon as the size of
3380 all directories there gets bigger than $CPAN::Config->{build_cache}
3381 (in MB). The contents of this cache may be used for later
3382 re-installations that you intend to do manually, but will never be
3383 trusted by CPAN itself. This is due to the fact that the user might
3384 use these directories for building modules on different architectures.
3386 There is another directory ($CPAN::Config->{keep_source_where}) where
3387 the original distribution files are kept. This directory is not
3388 covered by the cache manager and must be controlled by the user. If
3389 you choose to have the same directory as build_dir and as
3390 keep_source_where directory, then your sources will be deleted with
3391 the same fifo mechanism.
3395 A bundle is just a perl module in the namespace Bundle:: that does not
3396 define any functions or methods. It usually only contains documentation.
3398 It starts like a perl module with a package declaration and a $VERSION
3399 variable. After that the pod section looks like any other pod with the
3400 only difference, that I<one special pod section> exists starting with
3405 In this pod section each line obeys the format
3407 Module_Name [Version_String] [- optional text]
3409 The only required part is the first field, the name of a module
3410 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
3411 of the line is optional. The comment part is delimited by a dash just
3412 as in the man page header.
3414 The distribution of a bundle should follow the same convention as
3415 other distributions.
3417 Bundles are treated specially in the CPAN package. If you say 'install
3418 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
3419 the modules in the CONTENTS section of the pod. You can install your
3420 own Bundles locally by placing a conformant Bundle file somewhere into
3421 your @INC path. The autobundle() command which is available in the
3422 shell interface does that for you by including all currently installed
3423 modules in a snapshot bundle file.
3425 There is a meaningless Bundle::Demo available on CPAN. Try to install
3426 it, it usually does no harm, just demonstrates what the Bundle
3427 interface looks like.
3429 =head2 Prerequisites
3431 If you have a local mirror of CPAN and can access all files with
3432 "file:" URLs, then you only need a perl better than perl5.003 to run
3433 this module. Otherwise Net::FTP is strongly recommended. LWP may be
3434 required for non-UNIX systems or if your nearest CPAN site is
3435 associated with an URL that is not C<ftp:>.
3437 If you have neither Net::FTP nor LWP, there is a fallback mechanism
3438 implemented for an external ftp command or for an external lynx
3441 This module presumes that all packages on CPAN
3447 declare their $VERSION variable in an easy to parse manner. This
3448 prerequisite can hardly be relaxed because it consumes by far too much
3449 memory to load all packages into the running program just to determine
3450 the $VERSION variable . Currently all programs that are dealing with
3451 version use something like this
3453 perl -MExtUtils::MakeMaker -le \
3454 'print MM->parse_version($ARGV[0])' filename
3456 If you are author of a package and wonder if your $VERSION can be
3457 parsed, please try the above method.
3461 come as compressed or gzipped tarfiles or as zip files and contain a
3462 Makefile.PL (well we try to handle a bit more, but without much
3469 The debugging of this module is pretty difficult, because we have
3470 interferences of the software producing the indices on CPAN, of the
3471 mirroring process on CPAN, of packaging, of configuration, of
3472 synchronicity, and of bugs within CPAN.pm.
3474 In interactive mode you can try "o debug" which will list options for
3475 debugging the various parts of the package. The output may not be very
3476 useful for you as it's just a byproduct of my own testing, but if you
3477 have an idea which part of the package may have a bug, it's sometimes
3478 worth to give it a try and send me more specific output. You should
3479 know that "o debug" has built-in completion support.
3481 =head2 Floppy, Zip, and all that Jazz
3483 CPAN.pm works nicely without network too. If you maintain machines
3484 that are not networked at all, you should consider working with file:
3485 URLs. Of course, you have to collect your modules somewhere first. So
3486 you might use CPAN.pm to put together all you need on a networked
3487 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
3488 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
3489 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
3492 =head1 CONFIGURATION
3494 When the CPAN module is installed a site wide configuration file is
3495 created as CPAN/Config.pm. The default values defined there can be
3496 overridden in another configuration file: CPAN/MyConfig.pm. You can
3497 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
3498 $HOME/.cpan is added to the search path of the CPAN module before the
3499 use() or require() statements.
3501 Currently the following keys in the hash reference $CPAN::Config are
3504 build_cache size of cache for directories to build modules
3505 build_dir locally accessible directory to build modules
3506 index_expire after how many days refetch index files
3507 cpan_home local directory reserved for this package
3508 gzip location of external program gzip
3509 inactivity_timeout breaks interactive Makefile.PLs after that
3510 many seconds inactivity. Set to 0 to never break.
3511 inhibit_startup_message
3512 if true, does not print the startup message
3513 keep_source keep the source in a local directory?
3514 keep_source_where where keep the source (if we do)
3515 make location of external program make
3516 make_arg arguments that should always be passed to 'make'
3517 make_install_arg same as make_arg for 'make install'
3518 makepl_arg arguments passed to 'perl Makefile.PL'
3519 pager location of external program more (or any pager)
3520 tar location of external program tar
3521 unzip location of external program unzip
3522 urllist arrayref to nearby CPAN sites (or equivalent locations)
3524 You can set and query each of these options interactively in the cpan
3525 shell with the command set defined within the C<o conf> command:
3529 =item o conf E<lt>scalar optionE<gt>
3531 prints the current value of the I<scalar option>
3533 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
3535 Sets the value of the I<scalar option> to I<value>
3537 =item o conf E<lt>list optionE<gt>
3539 prints the current value of the I<list option> in MakeMaker's
3542 =item o conf E<lt>list optionE<gt> [shift|pop]
3544 shifts or pops the array in the I<list option> variable
3546 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
3548 works like the corresponding perl commands.
3554 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
3555 install foreign, unmasked, unsigned code on your machine. We compare
3556 to a checksum that comes from the net just as the distribution file
3557 itself. If somebody has managed to tamper with the distribution file,
3558 they may have as well tampered with the CHECKSUMS file. Future
3559 development will go towards strong authentification.
3563 Most functions in package CPAN are exported per default. The reason
3564 for this is that the primary use is intended for the cpan shell or for
3569 we should give coverage for _all_ of the CPAN and not just the
3570 __PAUSE__ part, right? In this discussion CPAN and PAUSE have become
3571 equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
3572 PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
3574 Future development should be directed towards a better intergration of
3579 Andreas König E<lt>a.koenig@mind.deE<gt>
3583 perl(1), CPAN::Nox(3)