2 use vars qw{$Try_autoload $Revision
3 $META $Signal $Cwd $End
4 $Suppress_readline %Dontload
10 # $Id: CPAN.pm,v 1.250 1999/01/14 12:26:13 k Exp $
12 # only used during development:
14 # $Revision = "[".substr(q$Revision: 1.250 $, 10)."]";
21 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
22 use File::Basename ();
28 use Text::ParseWords ();
31 END { $End++; &cleanup; }
52 $CPAN::Frontend ||= "CPAN::Shell";
53 $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
56 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
59 @CPAN::ISA = qw(CPAN::Debug Exporter);
62 autobundle bundle expand force get
63 install make readme recompile shell test clean
66 #-> sub CPAN::AUTOLOAD ;
71 @EXPORT{@EXPORT} = '';
72 if (exists $EXPORT{$l}){
75 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
79 # $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD");
81 $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
89 $Suppress_readline ||= ! -t STDIN;
91 my $prompt = "cpan> ";
93 unless ($Suppress_readline) {
94 require Term::ReadLine;
95 # import Term::ReadLine;
96 $term = Term::ReadLine->new('CPAN Monitor');
97 $readline::rl_completion_function =
98 $readline::rl_completion_function = 'CPAN::Complete::cpl';
104 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
105 my $cwd = CPAN->$getcwd();
106 my $rl_avail = $Suppress_readline ? "suppressed" :
107 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
108 "available (try ``install Bundle::CPAN'')";
110 $CPAN::Frontend->myprint(
112 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision)
113 ReadLine support $rl_avail
115 }) unless $CPAN::Config->{'inhibit_startup_message'} ;
116 my($continuation) = "";
118 if ($Suppress_readline) {
120 last unless defined ($_ = <> );
123 last unless defined ($_ = $term->readline($prompt));
125 $_ = "$continuation$_" if $continuation;
128 $_ = 'h' if /^\s*\?/;
129 if (/^(?:q(?:uit)?|bye|exit)$/i) {
139 use vars qw($import_done);
140 CPAN->import(':DEFAULT') unless $import_done++;
141 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
148 if ($] < 5.00322) { # parsewords had a bug until recently
151 eval { @line = Text::ParseWords::shellwords($_) };
152 warn($@), next if $@;
154 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
155 my $command = shift @line;
156 eval { CPAN::Shell->$command(@line) };
159 $CPAN::Frontend->myprint("\n");
168 package CPAN::CacheMgr;
169 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
172 package CPAN::Config;
173 import ExtUtils::MakeMaker 'neatvalue';
174 use vars qw(%can $dot_cpan);
177 'commit' => "Commit changes to disk",
178 'defaults' => "Reload defaults from disk",
179 'init' => "Interactive setting of all options",
183 use vars qw($Ua $Thesite $Themethod);
184 @CPAN::FTP::ISA = qw(CPAN::Debug);
186 package CPAN::Complete;
187 @CPAN::Complete::ISA = qw(CPAN::Debug);
190 use vars qw($last_time $date_of_03);
191 @CPAN::Index::ISA = qw(CPAN::Debug);
195 package CPAN::InfoObj;
196 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
198 package CPAN::Author;
199 @CPAN::Author::ISA = qw(CPAN::InfoObj);
201 package CPAN::Distribution;
202 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
204 package CPAN::Bundle;
205 @CPAN::Bundle::ISA = qw(CPAN::Module);
207 package CPAN::Module;
208 @CPAN::Module::ISA = qw(CPAN::InfoObj);
211 use vars qw($AUTOLOAD $redef @ISA);
212 @CPAN::Shell::ISA = qw(CPAN::Debug);
214 #-> sub CPAN::Shell::AUTOLOAD ;
216 my($autoload) = $AUTOLOAD;
217 my $class = shift(@_);
218 # warn "autoload[$autoload] class[$class]";
219 $autoload =~ s/.*:://;
220 if ($autoload =~ /^w/) {
221 if ($CPAN::META->has_inst('CPAN::WAIT')) {
222 CPAN::WAIT->$autoload(@_);
224 $CPAN::Frontend->mywarn(qq{
225 Commands starting with "w" require CPAN::WAIT to be installed.
226 Please consider installing CPAN::WAIT to use the fulltext index.
227 For this you just need to type
232 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
236 # $CPAN::Frontend->mywarn("Could not autoload $autoload");
238 $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
244 #-> CPAN::Shell::try_dot_al
246 my($class,$autoload) = @_;
247 return unless $CPAN::Try_autoload;
248 # I don't see how to re-use that from the AutoLoader...
250 # Braces used to preserve $1 et al.
252 my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/;
254 if (defined($name=$INC{"$pkg.pm"}))
256 $name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
257 $name = undef unless (-r $name);
259 unless (defined $name)
261 $name = "auto/$autoload.al";
266 eval {local $SIG{__DIE__};require $name};
268 if (substr($autoload,-9) eq '::DESTROY') {
272 if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
273 eval {local $SIG{__DIE__};require $name};
288 # my $lm = Carp::longmess();
289 # warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
293 #### autoloader is experimental
294 #### to try it we have to set $Try_autoload and uncomment
295 #### the use statement and uncomment the __END__ below
296 #### You also need AutoSplit 1.01 available. MakeMaker will
297 #### then build CPAN with all the AutoLoad stuff.
301 if ($CPAN::Try_autoload) {
304 CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
305 CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
306 CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
308 *{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD;
312 package CPAN::Tarzip;
313 use vars qw($AUTOLOAD @ISA);
314 @CPAN::Tarzip::ISA = qw(CPAN::Debug);
317 # currently only used to determine if we should or shouldn't announce
318 # the availability of a new CPAN module
320 # but now we try to use it for dependency tracking. For that to happen
321 # we need to draw a dependency tree and do the leaves first. This can
322 # easily be reached by running CPAN.pm recursively, but we don't want
323 # to waste memory and run into deep recursion. So what we can do is
324 # this: run the queue as the user suggested. When a dependency is
325 # detected check if it is in the queue. If so, rearrange, otherwise
326 # unshift it on the queue.
331 my($class,$mod) = @_;
332 my $self = bless {mod => $mod}, $class;
334 # my @all = map { $_->{mod} } @All;
335 # warn "Adding Queue object for mod[$mod] all[@all]";
346 my($class,$what) = @_;
348 for my $i (0..$#All) {
349 if ( $All[$i]->{mod} eq $what ) {
360 WHAT: for my $what (reverse @what) {
362 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
363 if ($All[$i]->{mod} eq $what){
365 if ($jumped > 100) { # one's OK if e.g. just processing now;
366 # more are OK if user typed it several
368 $CPAN::Frontend->mywarn(
369 qq{Object [$what] queued more than 100 times, ignoring}
375 my $obj = bless { mod => $what }, $class;
381 my($self,$what) = @_;
382 my @all = map { $_->{mod} } @All;
383 my $exists = grep { $_->{mod} eq $what } @All;
384 # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]";
390 @All = grep { $_->{mod} ne $mod } @All;
391 # my @all = map { $_->{mod} } @All;
392 # warn "Deleting Queue object for mod[$mod] all[@all]";
397 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
399 # Do this after you have set up the whole inheritance
400 CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
404 # __END__ # uncomment this and AutoSplit version 1.01 will split it
406 #-> sub CPAN::autobundle ;
408 #-> sub CPAN::bundle ;
410 #-> sub CPAN::expand ;
412 #-> sub CPAN::force ;
414 #-> sub CPAN::install ;
418 #-> sub CPAN::clean ;
425 my($mgr,$class) = @_;
426 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
428 values %{ $META->{$class} };
431 # Called by shell, not in batch mode. Not clean XXX
432 #-> sub CPAN::checklock ;
435 my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
436 if (-f $lockfile && -M _ > 0) {
437 my $fh = FileHandle->new($lockfile);
440 if (defined $other && $other) {
442 return if $$==$other; # should never happen
443 $CPAN::Frontend->mywarn(
445 There seems to be running another CPAN process ($other). Contacting...
447 if (kill 0, $other) {
448 $CPAN::Frontend->mydie(qq{Other job is running.
449 You may want to kill it and delete the lockfile, maybe. On UNIX try:
453 } elsif (-w $lockfile) {
455 ExtUtils::MakeMaker::prompt
456 (qq{Other job not responding. Shall I overwrite }.
457 qq{the lockfile? (Y/N)},"y");
458 $CPAN::Frontend->myexit("Ok, bye\n")
459 unless $ans =~ /^y/i;
462 qq{Lockfile $lockfile not writeable by you. }.
463 qq{Cannot proceed.\n}.
466 qq{ and then rerun us.\n}
471 File::Path::mkpath($CPAN::Config->{cpan_home});
473 unless ($fh = FileHandle->new(">$lockfile")) {
474 if ($! =~ /Permission/) {
475 my $incc = $INC{'CPAN/Config.pm'};
476 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
477 $CPAN::Frontend->myprint(qq{
479 Your configuration suggests that CPAN.pm should use a working
481 $CPAN::Config->{cpan_home}
482 Unfortunately we could not create the lock file
484 due to permission problems.
486 Please make sure that the configuration variable
487 \$CPAN::Config->{cpan_home}
488 points to a directory where you can write a .lock file. You can set
489 this variable in either
496 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
498 $fh->print($$, "\n");
499 $self->{LOCK} = $lockfile;
503 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
508 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
509 print "Caught SIGINT\n";
512 $SIG{'__DIE__'} = \&cleanup;
513 $self->debug("Signal handler set.") if $CPAN::DEBUG;
516 #-> sub CPAN::DESTROY ;
518 &cleanup; # need an eval?
522 sub cwd {Cwd::cwd();}
524 #-> sub CPAN::getcwd ;
525 sub getcwd {Cwd::getcwd();}
527 #-> sub CPAN::exists ;
529 my($mgr,$class,$id) = @_;
531 ### Carp::croak "exists called without class argument" unless $class;
533 exists $META->{$class}{$id};
536 #-> sub CPAN::delete ;
538 my($mgr,$class,$id) = @_;
539 delete $META->{$class}{$id};
542 #-> sub CPAN::has_inst
544 my($self,$mod,$message) = @_;
545 Carp::croak("CPAN->has_inst() called without an argument")
547 if (defined $message && $message eq "no") {
550 } elsif (exists $Dontload{$mod}) {
556 $file =~ s|/|\\|g if $^O eq 'MSWin32';
559 # warn "$file in %INC"; #debug
561 } elsif (eval { require $file }) {
562 # eval is good: if we haven't yet read the database it's
563 # perfect and if we have installed the module in the meantime,
564 # it tries again. The second require is only a NOOP returning
565 # 1 if we had success, otherwise it's retrying
566 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
567 if ($mod eq "CPAN::WAIT") {
568 push @CPAN::Shell::ISA, CPAN::WAIT;
571 } elsif ($mod eq "Net::FTP") {
573 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
575 install Bundle::libnet
579 } elsif ($mod eq "MD5"){
580 $CPAN::Frontend->myprint(qq{
581 CPAN: MD5 security checks disabled because MD5 not installed.
582 Please consider installing the MD5 module.
590 #-> sub CPAN::instance ;
592 my($mgr,$class,$id) = @_;
595 $META->{$class}{$id} ||= $class->new(ID => $id );
603 #-> sub CPAN::cleanup ;
605 # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
606 local $SIG{__DIE__} = '';
611 0 && # disabled, try reload cpan with it
612 $] > 5.004_60 # thereabouts
617 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
619 $subroutine eq '(eval)';
622 return if $ineval && !$End;
623 return unless defined $META->{'LOCK'};
624 return unless -f $META->{'LOCK'};
625 unlink $META->{'LOCK'};
627 # Carp::cluck("DEBUGGING");
628 $CPAN::Frontend->mywarn("Lockfile removed.\n");
631 package CPAN::CacheMgr;
633 #-> sub CPAN::CacheMgr::as_string ;
635 eval { require Data::Dumper };
637 return shift->SUPER::as_string;
639 return Data::Dumper::Dumper(shift);
643 #-> sub CPAN::CacheMgr::cachesize ;
650 return unless -d $self->{ID};
651 while ($self->{DU} > $self->{'MAX'} ) {
652 my($toremove) = shift @{$self->{FIFO}};
653 $CPAN::Frontend->myprint(sprintf(
654 "Deleting from cache".
655 ": $toremove (%.1f>%.1f MB)\n",
656 $self->{DU}, $self->{'MAX'})
658 return if $CPAN::Signal;
659 $self->force_clean_cache($toremove);
660 return if $CPAN::Signal;
664 #-> sub CPAN::CacheMgr::dir ;
669 #-> sub CPAN::CacheMgr::entries ;
672 return unless defined $dir;
673 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
674 $dir ||= $self->{ID};
676 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
677 my($cwd) = CPAN->$getcwd();
678 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
679 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
682 next if $_ eq "." || $_ eq "..";
684 push @entries, MM->catfile($dir,$_);
686 push @entries, MM->catdir($dir,$_);
688 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
691 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
692 sort { -M $b <=> -M $a} @entries;
695 #-> sub CPAN::CacheMgr::disk_usage ;
698 return if exists $self->{SIZE}{$dir};
699 return if $CPAN::Signal;
703 $File::Find::prune++ if $CPAN::Signal;
705 $Du += (-s _); # parens to help cperl-mode
709 return if $CPAN::Signal;
710 $self->{SIZE}{$dir} = $Du/1024/1024;
711 push @{$self->{FIFO}}, $dir;
712 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
713 $self->{DU} += $Du/1024/1024;
717 #-> sub CPAN::CacheMgr::force_clean_cache ;
718 sub force_clean_cache {
720 return unless -e $dir;
721 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
723 File::Path::rmtree($dir);
724 $self->{DU} -= $self->{SIZE}{$dir};
725 delete $self->{SIZE}{$dir};
728 #-> sub CPAN::CacheMgr::new ;
735 ID => $CPAN::Config->{'build_dir'},
736 MAX => $CPAN::Config->{'build_cache'},
737 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
740 File::Path::mkpath($self->{ID});
741 my $dh = DirHandle->new($self->{ID});
745 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
747 CPAN->debug($debug) if $CPAN::DEBUG;
751 #-> sub CPAN::CacheMgr::scan_cache ;
754 return if $self->{SCAN} eq 'never';
755 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
756 unless $self->{SCAN} eq 'atstart';
757 $CPAN::Frontend->myprint(
758 sprintf("Scanning cache %s for sizes\n",
761 for $e ($self->entries($self->{ID})) {
762 next if $e eq ".." || $e eq ".";
763 $self->disk_usage($e);
764 return if $CPAN::Signal;
771 #-> sub CPAN::Debug::debug ;
774 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
775 # Complete, caller(1)
777 ($caller) = caller(0);
779 $arg = "" unless defined $arg;
780 my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
781 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
782 if ($arg and ref $arg) {
783 eval { require Data::Dumper };
785 $CPAN::Frontend->myprint($arg->as_string);
787 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
790 $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
795 package CPAN::Config;
797 #-> sub CPAN::Config::edit ;
799 my($class,@args) = @_;
801 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
802 my($o,$str,$func,$args,$key_exists);
808 if (ref($CPAN::Config->{$o}) eq ARRAY) {
811 # Let's avoid eval, it's easier to comprehend without.
812 if ($func eq "push") {
813 push @{$CPAN::Config->{$o}}, @args;
814 } elsif ($func eq "pop") {
815 pop @{$CPAN::Config->{$o}};
816 } elsif ($func eq "shift") {
817 shift @{$CPAN::Config->{$o}};
818 } elsif ($func eq "unshift") {
819 unshift @{$CPAN::Config->{$o}}, @args;
820 } elsif ($func eq "splice") {
821 splice @{$CPAN::Config->{$o}}, @args;
823 $CPAN::Config->{$o} = [@args];
825 $CPAN::Frontend->myprint(
828 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
833 $CPAN::Config->{$o} = $args[0] if defined $args[0];
834 $CPAN::Frontend->myprint(" $o " .
835 (defined $CPAN::Config->{$o} ?
836 $CPAN::Config->{$o} : "UNDEFINED"));
841 #-> sub CPAN::Config::commit ;
843 my($self,$configpm) = @_;
844 unless (defined $configpm){
845 $configpm ||= $INC{"CPAN/MyConfig.pm"};
846 $configpm ||= $INC{"CPAN/Config.pm"};
847 $configpm || Carp::confess(q{
848 CPAN::Config::commit called without an argument.
849 Please specify a filename where to save the configuration or try
850 "o conf init" to have an interactive course through configing.
855 $mode = (stat $configpm)[2];
856 if ($mode && ! -w _) {
857 Carp::confess("$configpm is not writable");
861 my $msg = <<EOF unless $configpm =~ /MyConfig/;
863 # This is CPAN.pm's systemwide configuration file. This file provides
864 # defaults for users, and the values can be changed in a per-user
865 # configuration file. The user-config file is being looked for as
866 # ~/.cpan/CPAN/MyConfig.pm.
870 my($fh) = FileHandle->new;
871 rename $configpm, "$configpm~" if -f $configpm;
872 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
873 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
874 foreach (sort keys %$CPAN::Config) {
877 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
882 $fh->print("};\n1;\n__END__\n");
885 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
886 #chmod $mode, $configpm;
887 ###why was that so? $self->defaults;
888 $CPAN::Frontend->myprint("commit: wrote $configpm\n");
892 *default = \&defaults;
893 #-> sub CPAN::Config::defaults ;
903 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
912 #-> sub CPAN::Config::load ;
917 eval {require CPAN::Config;}; # We eval because of some
919 unless ($dot_cpan++){
920 unshift @INC, MM->catdir($ENV{HOME},".cpan");
921 eval {require CPAN::MyConfig;}; # where you can override
922 # system wide settings
925 return unless @miss = $self->not_loaded;
926 # XXX better check for arrayrefs too
927 require CPAN::FirstTime;
928 my($configpm,$fh,$redo,$theycalled);
930 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
931 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
932 $configpm = $INC{"CPAN/Config.pm"};
934 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
935 $configpm = $INC{"CPAN/MyConfig.pm"};
938 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
939 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
940 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
941 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
942 if (-w $configpmtest) {
943 $configpm = $configpmtest;
944 } elsif (-w $configpmdir) {
945 #_#_# following code dumped core on me with 5.003_11, a.k.
946 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
947 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
948 my $fh = FileHandle->new;
949 if ($fh->open(">$configpmtest")) {
951 $configpm = $configpmtest;
953 # Should never happen
954 Carp::confess("Cannot open >$configpmtest");
959 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
960 File::Path::mkpath($configpmdir);
961 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
962 if (-w $configpmtest) {
963 $configpm = $configpmtest;
964 } elsif (-w $configpmdir) {
965 #_#_# following code dumped core on me with 5.003_11, a.k.
966 my $fh = FileHandle->new;
967 if ($fh->open(">$configpmtest")) {
969 $configpm = $configpmtest;
971 # Should never happen
972 Carp::confess("Cannot open >$configpmtest");
975 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
976 qq{create a configuration file.});
981 $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
982 We have to reconfigure CPAN.pm due to following uninitialized parameters:
986 $CPAN::Frontend->myprint(qq{
987 $configpm initialized.
990 CPAN::FirstTime::init($configpm);
993 #-> sub CPAN::Config::not_loaded ;
997 cpan_home keep_source_where build_dir build_cache scan_cache
998 index_expire gzip tar unzip make pager makepl_arg make_arg
999 make_install_arg urllist inhibit_startup_message
1000 ftp_proxy http_proxy no_proxy prerequisites_policy
1002 push @miss, $_ unless defined $CPAN::Config->{$_};
1007 #-> sub CPAN::Config::unload ;
1009 delete $INC{'CPAN/MyConfig.pm'};
1010 delete $INC{'CPAN/Config.pm'};
1013 #-> sub CPAN::Config::help ;
1015 $CPAN::Frontend->myprint(q[
1017 defaults reload default config values from disk
1018 commit commit session changes to disk
1019 init go through a dialog to set all parameters
1021 You may edit key values in the follow fashion:
1023 o conf build_cache 15
1025 o conf build_dir "/foo/bar"
1027 o conf urllist shift
1029 o conf urllist unshift ftp://ftp.foo.bar/
1032 undef; #don't reprint CPAN::Config
1035 #-> sub CPAN::Config::cpl ;
1037 my($word,$line,$pos) = @_;
1039 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1040 my(@words) = split " ", substr($line,0,$pos+1);
1045 $words[2] =~ /list$/ && @words == 3
1047 $words[2] =~ /list$/ && @words == 4 && length($word)
1050 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
1051 } elsif (@words >= 4) {
1054 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
1055 return grep /^\Q$word\E/, @o_conf;
1058 package CPAN::Shell;
1060 #-> sub CPAN::Shell::h ;
1062 my($class,$about) = @_;
1063 if (defined $about) {
1064 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1066 $CPAN::Frontend->myprint(q{
1067 command arguments description
1069 b or display bundles
1070 d /regex/ info distributions
1072 i none anything of above
1074 r as reinstall recommendations
1075 u above uninstalled distributions
1076 See manpage for autobundle, recompile, force, look, etc.
1079 test modules, make test (implies make)
1080 install dists, bundles, make install (implies test)
1081 clean "r" or "u" make clean
1082 readme display the README file
1084 reload index|cpan load most recent indices/CPAN.pm
1085 h or ? display this menu
1086 o various set and query options
1087 ! perl-code eval a perl command
1088 q quit the shell subroutine
1095 #-> sub CPAN::Shell::a ;
1096 sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
1097 #-> sub CPAN::Shell::b ;
1099 my($self,@which) = @_;
1100 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1101 my($incdir,$bdir,$dh);
1102 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1103 $bdir = MM->catdir($incdir,"Bundle");
1104 if ($dh = DirHandle->new($bdir)) { # may fail
1106 for $entry ($dh->read) {
1107 next if -d MM->catdir($bdir,$entry);
1108 next unless $entry =~ s/\.pm$//;
1109 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
1113 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1115 #-> sub CPAN::Shell::d ;
1116 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1117 #-> sub CPAN::Shell::m ;
1118 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1119 $CPAN::Frontend->myprint(shift->format_result('Module',@_));
1122 #-> sub CPAN::Shell::i ;
1127 @type = qw/Author Bundle Distribution Module/;
1128 @args = '/./' unless @args;
1131 push @result, $self->expand($type,@args);
1133 my $result = @result == 1 ?
1134 $result[0]->as_string :
1135 join "", map {$_->as_glimpse} @result;
1136 $result ||= "No objects found of any type for argument @args\n";
1137 $CPAN::Frontend->myprint($result);
1140 #-> sub CPAN::Shell::o ;
1142 my($self,$o_type,@o_what) = @_;
1144 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1145 if ($o_type eq 'conf') {
1146 shift @o_what if @o_what && $o_what[0] eq 'help';
1149 $CPAN::Frontend->myprint("CPAN::Config options");
1150 if (exists $INC{'CPAN/Config.pm'}) {
1151 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1153 if (exists $INC{'CPAN/MyConfig.pm'}) {
1154 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1156 $CPAN::Frontend->myprint(":\n");
1157 for $k (sort keys %CPAN::Config::can) {
1158 $v = $CPAN::Config::can{$k};
1159 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1161 $CPAN::Frontend->myprint("\n");
1162 for $k (sort keys %$CPAN::Config) {
1163 $v = $CPAN::Config->{$k};
1165 $CPAN::Frontend->myprint(
1172 map {"\t$_\n"} @{$v}
1176 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1179 $CPAN::Frontend->myprint("\n");
1180 } elsif (!CPAN::Config->edit(@o_what)) {
1181 $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]);
1183 } elsif ($o_type eq 'debug') {
1185 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1188 my($what) = shift @o_what;
1189 if ( exists $CPAN::DEBUG{$what} ) {
1190 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1191 } elsif ($what =~ /^\d/) {
1192 $CPAN::DEBUG = $what;
1193 } elsif (lc $what eq 'all') {
1195 for (values %CPAN::DEBUG) {
1198 $CPAN::DEBUG = $max;
1201 for (keys %CPAN::DEBUG) {
1202 next unless lc($_) eq lc($what);
1203 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1206 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1211 $CPAN::Frontend->myprint("Valid options for debug are ".
1212 join(", ",sort(keys %CPAN::DEBUG), 'all').
1213 qq{ or a number. Completion works on the options. }.
1214 qq{Case is ignored.\n\n});
1217 $CPAN::Frontend->myprint("Options set for debugging:\n");
1219 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1220 $v = $CPAN::DEBUG{$k};
1221 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
1224 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1227 $CPAN::Frontend->myprint(qq{
1229 conf set or get configuration variables
1230 debug set or get debugging options
1235 #-> sub CPAN::Shell::reload ;
1237 my($self,$command,@arg) = @_;
1239 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1240 if ($command =~ /cpan/i) {
1241 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
1242 my $fh = FileHandle->new($INC{'CPAN.pm'});
1245 local($SIG{__WARN__})
1247 if ( $_[0] =~ /Subroutine (\w+) redefined/ ) {
1251 # $CPAN::Frontend->myprint(".($subr)");
1252 $CPAN::Frontend->myprint(".");
1259 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1260 } elsif ($command =~ /index/) {
1261 CPAN::Index->force_reload;
1263 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1264 index re-reads the index files
1269 #-> sub CPAN::Shell::_binary_extensions ;
1270 sub _binary_extensions {
1271 my($self) = shift @_;
1272 my(@result,$module,%seen,%need,$headerdone);
1273 my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz$};
1274 for $module ($self->expand('Module','/./')) {
1275 my $file = $module->cpan_file;
1276 next if $file eq "N/A";
1277 next if $file =~ /^Contact Author/;
1278 next if $file =~ / $isaperl /xo;
1279 next unless $module->xs_file;
1281 $CPAN::Frontend->myprint(".");
1282 push @result, $module;
1284 # print join " | ", @result;
1285 $CPAN::Frontend->myprint("\n");
1289 #-> sub CPAN::Shell::recompile ;
1291 my($self) = shift @_;
1292 my($module,@module,$cpan_file,%dist);
1293 @module = $self->_binary_extensions();
1294 for $module (@module){ # we force now and compile later, so we
1296 $cpan_file = $module->cpan_file;
1297 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1299 $dist{$cpan_file}++;
1301 for $cpan_file (sort keys %dist) {
1302 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1303 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1305 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1306 # stop a package from recompiling,
1307 # e.g. IO-1.12 when we have perl5.003_10
1311 #-> sub CPAN::Shell::_u_r_common ;
1313 my($self) = shift @_;
1314 my($what) = shift @_;
1315 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1316 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1317 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1319 @args = '/./' unless @args;
1320 my(@result,$module,%seen,%need,$headerdone,
1321 $version_undefs,$version_zeroes);
1322 $version_undefs = $version_zeroes = 0;
1323 my $sprintf = "%-25s %9s %9s %s\n";
1324 for $module ($self->expand('Module',@args)) {
1325 my $file = $module->cpan_file;
1326 next unless defined $file; # ??
1327 my($latest) = $module->cpan_version;
1328 my($inst_file) = $module->inst_file;
1330 return if $CPAN::Signal;
1333 $have = $module->inst_version;
1334 } elsif ($what eq "r") {
1335 $have = $module->inst_version;
1337 if ($have eq "undef"){
1339 } elsif ($have == 0){
1342 next if $have >= $latest;
1343 # to be pedantic we should probably say:
1344 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1345 # to catch the case where CPAN has a version 0 and we have a version undef
1346 } elsif ($what eq "u") {
1352 } elsif ($what eq "r") {
1354 } elsif ($what eq "u") {
1358 return if $CPAN::Signal; # this is sometimes lengthy
1361 push @result, sprintf "%s %s\n", $module->id, $have;
1362 } elsif ($what eq "r") {
1363 push @result, $module->id;
1364 next if $seen{$file}++;
1365 } elsif ($what eq "u") {
1366 push @result, $module->id;
1367 next if $seen{$file}++;
1368 next if $file =~ /^Contact/;
1370 unless ($headerdone++){
1371 $CPAN::Frontend->myprint("\n");
1372 $CPAN::Frontend->myprint(sprintf(
1374 "Package namespace",
1380 $latest = substr($latest,0,8) if length($latest) > 8;
1381 $have = substr($have,0,8) if length($have) > 8;
1382 $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
1383 $need{$module->id}++;
1387 $CPAN::Frontend->myprint("No modules found for @args\n");
1388 } elsif ($what eq "r") {
1389 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1393 if ($version_zeroes) {
1394 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1395 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1396 qq{a version number of 0\n});
1398 if ($version_undefs) {
1399 my $s_has = $version_undefs > 1 ? "s have" : " has";
1400 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1401 qq{parseable version number\n});
1407 #-> sub CPAN::Shell::r ;
1409 shift->_u_r_common("r",@_);
1412 #-> sub CPAN::Shell::u ;
1414 shift->_u_r_common("u",@_);
1417 #-> sub CPAN::Shell::autobundle ;
1420 my(@bundle) = $self->_u_r_common("a",@_);
1421 my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1422 File::Path::mkpath($todir);
1423 unless (-d $todir) {
1424 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1427 my($y,$m,$d) = (localtime)[5,4,3];
1431 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1432 my($to) = MM->catfile($todir,"$me.pm");
1434 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1435 $to = MM->catfile($todir,"$me.pm");
1437 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1439 "package Bundle::$me;\n\n",
1440 "\$VERSION = '0.01';\n\n",
1444 "Bundle::$me - Snapshot of installation on ",
1445 $Config::Config{'myhostname'},
1448 "\n\n=head1 SYNOPSIS\n\n",
1449 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1450 "=head1 CONTENTS\n\n",
1451 join("\n", @bundle),
1452 "\n\n=head1 CONFIGURATION\n\n",
1454 "\n\n=head1 AUTHOR\n\n",
1455 "This Bundle has been generated automatically ",
1456 "by the autobundle routine in CPAN.pm.\n",
1459 $CPAN::Frontend->myprint("\nWrote bundle file
1463 #-> sub CPAN::Shell::expand ;
1466 my($type,@args) = @_;
1470 if ($arg =~ m|^/(.*)/$|) {
1473 my $class = "CPAN::$type";
1475 if (defined $regex) {
1476 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
1479 $obj->id =~ /$regex/i
1483 $] < 5.00303 ### provide sort of compatibility with 5.003
1488 $obj->name =~ /$regex/i
1493 if ( $type eq 'Bundle' ) {
1494 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1496 if ($CPAN::META->exists($class,$xarg)) {
1497 $obj = $CPAN::META->instance($class,$xarg);
1498 } elsif ($CPAN::META->exists($class,$arg)) {
1499 $obj = $CPAN::META->instance($class,$arg);
1506 return wantarray ? @m : $m[0];
1509 #-> sub CPAN::Shell::format_result ;
1512 my($type,@args) = @_;
1513 @args = '/./' unless @args;
1514 my(@result) = $self->expand($type,@args);
1515 my $result = @result == 1 ?
1516 $result[0]->as_string :
1517 join "", map {$_->as_glimpse} @result;
1518 $result ||= "No objects of type $type found for argument @args\n";
1522 # The only reason for this method is currently to have a reliable
1523 # debugging utility that reveals which output is going through which
1524 # channel. No, I don't like the colors ;-)
1525 sub print_ornamented {
1526 my($self,$what,$ornament) = @_;
1528 my $ornamenting = 0; # turn the colors on
1531 unless (defined &color) {
1532 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1533 import Term::ANSIColor "color";
1535 *color = sub { return "" };
1539 for $line (split /\n/, $what) {
1540 $longest = length($line) if length($line) > $longest;
1542 my $sprintf = "%-" . $longest . "s";
1544 $what =~ s/(.*\n?)//m;
1547 my($nl) = chomp $line ? "\n" : "";
1548 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
1549 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
1557 my($self,$what) = @_;
1558 $self->print_ornamented($what, 'bold blue on_yellow');
1562 my($self,$what) = @_;
1563 $self->myprint($what);
1568 my($self,$what) = @_;
1569 $self->print_ornamented($what, 'bold red on_yellow');
1573 my($self,$what) = @_;
1574 $self->print_ornamented($what, 'bold red on_white');
1575 Carp::confess "died";
1579 my($self,$what) = @_;
1580 $self->print_ornamented($what, 'bold red on_white');
1584 #-> sub CPAN::Shell::rematein ;
1585 # RE-adme||MA-ke||TE-st||IN-stall
1588 my($meth,@some) = @_;
1590 if ($meth eq 'force') {
1592 $meth = shift @some;
1594 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1596 foreach $s (@some) {
1597 CPAN::Queue->new($s);
1599 while ($s = CPAN::Queue->first) {
1603 } elsif ($s =~ m|/|) { # looks like a file
1604 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1605 } elsif ($s =~ m|^Bundle::|) {
1606 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1608 $obj = $CPAN::META->instance('CPAN::Module',$s)
1609 if $CPAN::META->exists('CPAN::Module',$s);
1613 qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
1621 ($] < 5.00303 || $obj->can($pragma)); ###
1625 if ($]>=5.00303 && $obj->can('called_for')) {
1626 $obj->called_for($s);
1628 CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
1631 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1632 $obj = $CPAN::META->instance('CPAN::Author',$s);
1633 $CPAN::Frontend->myprint(
1635 "Don't be silly, you can't $meth ",
1641 ->myprint(qq{Warning: Cannot $meth $s, }.
1642 qq{don\'t know what it is.
1647 to find objects with similar identifiers.
1650 CPAN::Queue->delete_first($s);
1654 #-> sub CPAN::Shell::force ;
1655 sub force { shift->rematein('force',@_); }
1656 #-> sub CPAN::Shell::get ;
1657 sub get { shift->rematein('get',@_); }
1658 #-> sub CPAN::Shell::readme ;
1659 sub readme { shift->rematein('readme',@_); }
1660 #-> sub CPAN::Shell::make ;
1661 sub make { shift->rematein('make',@_); }
1662 #-> sub CPAN::Shell::test ;
1663 sub test { shift->rematein('test',@_); }
1664 #-> sub CPAN::Shell::install ;
1665 sub install { shift->rematein('install',@_); }
1666 #-> sub CPAN::Shell::clean ;
1667 sub clean { shift->rematein('clean',@_); }
1668 #-> sub CPAN::Shell::look ;
1669 sub look { shift->rematein('look',@_); }
1673 #-> sub CPAN::FTP::ftp_get ;
1675 my($class,$host,$dir,$file,$target) = @_;
1677 qq[Going to fetch file [$file] from dir [$dir]
1678 on host [$host] as local [$target]\n]
1680 my $ftp = Net::FTP->new($host);
1681 return 0 unless defined $ftp;
1682 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1683 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1684 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1685 warn "Couldn't login on $host";
1688 unless ( $ftp->cwd($dir) ){
1689 warn "Couldn't cwd $dir";
1693 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1694 unless ( $ftp->get($file,$target) ){
1695 warn "Couldn't fetch $file from $host\n";
1698 $ftp->quit; # it's ok if this fails
1702 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
1704 # leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
1705 # leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997
1706 # leach,> ***************
1707 # leach,> *** 1562,1567 ****
1708 # leach,> --- 1562,1580 ----
1709 # leach,> return 1 if substr($url,0,4) eq "file";
1710 # leach,> return 1 unless $url =~ m|://([^/]+)|;
1711 # leach,> my $host = $1;
1712 # leach,> + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1713 # leach,> + if ($proxy) {
1714 # leach,> + $proxy =~ m|://([^/:]+)|;
1715 # leach,> + $proxy = $1;
1716 # leach,> + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1717 # leach,> + if ($noproxy) {
1718 # leach,> + if ($host !~ /$noproxy$/) {
1719 # leach,> + $host = $proxy;
1721 # leach,> + } else {
1722 # leach,> + $host = $proxy;
1725 # leach,> require Net::Ping;
1726 # leach,> return 1 unless $Net::Ping::VERSION >= 2;
1730 # this is quite optimistic and returns one on several occasions where
1731 # inappropriate. But this does no harm. It would do harm if we were
1732 # too pessimistic (as I was before the http_proxy
1734 my($self,$url) = @_;
1735 return 1; # we can't simply roll our own, firewalls may break ping
1736 return 0 unless $url;
1737 return 1 if substr($url,0,4) eq "file";
1738 return 1 unless $url =~ m|^(\w+)://([^/]+)|;
1739 my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy
1741 return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype};
1743 return 1 unless $Net::Ping::VERSION >= 2;
1745 # 1.3101 had it different: only if the first eval raised an
1746 # exception we tried it with TCP. Now we are happy if icmp wins
1747 # the order and return, we don't even check for $@. Thanks to
1748 # thayer@uis.edu for the suggestion.
1749 eval {$p = Net::Ping->new("icmp");};
1750 return 1 if $p && ref($p) && $p->ping($host, 10);
1751 eval {$p = Net::Ping->new("tcp");};
1752 $CPAN::Frontend->mydie($@) if $@;
1753 return $p->ping($host, 10);
1756 #-> sub CPAN::FTP::localize ;
1757 # sorry for the ugly code here, I'll clean it up as soon as Net::FTP
1760 my($self,$file,$aslocal,$force) = @_;
1762 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1763 unless defined $aslocal;
1764 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
1767 return $aslocal if -f $aslocal && -r _ && !($force & 1);
1770 rename $aslocal, "$aslocal.bak";
1774 my($aslocal_dir) = File::Basename::dirname($aslocal);
1775 File::Path::mkpath($aslocal_dir);
1776 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
1777 qq{directory "$aslocal_dir".
1778 I\'ll continue, but if you encounter problems, they may be due
1779 to insufficient permissions.\n}) unless -w $aslocal_dir;
1781 # Inheritance is not easier to manage than a few if/else branches
1782 if ($CPAN::META->has_inst('LWP')) {
1783 require LWP::UserAgent;
1785 $Ua = LWP::UserAgent->new;
1787 $Ua->proxy('ftp', $var)
1788 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1789 $Ua->proxy('http', $var)
1790 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1792 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1796 # Try the list of urls for each single object. We keep a record
1797 # where we did get a file from
1798 my(@reordered,$last);
1799 $CPAN::Config->{urllist} ||= [];
1800 $last = $#{$CPAN::Config->{urllist}};
1801 if ($force & 2) { # local cpans probably out of date, don't reorder
1802 @reordered = (0..$last);
1806 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
1808 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
1819 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
1821 @levels = qw/easy hard hardest/;
1823 for $level (@levels) {
1824 my $method = "host$level";
1825 my @host_seq = $level eq "easy" ?
1826 @reordered : 0..$last; # reordered has CDROM up front
1827 @host_seq = (0) unless @host_seq;
1828 my $ret = $self->$method(\@host_seq,$file,$aslocal);
1830 $Themethod = $level;
1831 $self->debug("level[$level]") if $CPAN::DEBUG;
1839 qq{Please check, if the URLs I found in your configuration file \(}.
1840 join(", ", @{$CPAN::Config->{urllist}}).
1841 qq{\) are valid. The urllist can be edited.},
1842 qq{E.g. with ``o conf urllist push ftp://myurl/''};
1843 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
1845 $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
1847 rename "$aslocal.bak", $aslocal;
1848 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
1849 $self->ls($aslocal));
1856 my($self,$host_seq,$file,$aslocal) = @_;
1858 HOSTEASY: for $i (@$host_seq) {
1859 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
1860 unless ($self->is_reachable($url)) {
1861 $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
1865 $url .= "/" unless substr($url,-1) eq "/";
1867 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
1868 if ($url =~ /^file:/) {
1870 if ($CPAN::META->has_inst('LWP')) {
1872 my $u = URI::URL->new($url);
1874 } else { # works only on Unix, is poorly constructed, but
1875 # hopefully better than nothing.
1876 # RFC 1738 says fileurl BNF is
1877 # fileurl = "file://" [ host | "localhost" ] "/" fpath
1878 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
1880 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
1881 $l =~ s/^file://; # assume they meant file://localhost
1883 if ( -f $l && -r _) {
1887 # Maybe mirror has compressed it?
1889 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
1890 CPAN::Tarzip->gunzip("$l.gz", $aslocal);
1897 if ($CPAN::META->has_inst('LWP')) {
1898 $CPAN::Frontend->myprint("Fetching with LWP:
1902 require LWP::UserAgent;
1903 $Ua = LWP::UserAgent->new;
1905 my $res = $Ua->mirror($url, $aslocal);
1906 if ($res->is_success) {
1909 } elsif ($url !~ /\.gz$/) {
1910 my $gzurl = "$url.gz";
1911 $CPAN::Frontend->myprint("Fetching with LWP:
1914 $res = $Ua->mirror($gzurl, "$aslocal.gz");
1915 if ($res->is_success &&
1916 CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
1924 # Alan Burlison informed me that in firewall envs Net::FTP
1925 # can still succeed where LWP fails. So we do not skip
1926 # Net::FTP anymore when LWP is available.
1930 $self->debug("LWP not installed") if $CPAN::DEBUG;
1932 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1933 # that's the nice and easy way thanks to Graham
1934 my($host,$dir,$getfile) = ($1,$2,$3);
1935 if ($CPAN::META->has_inst('Net::FTP')) {
1937 $CPAN::Frontend->myprint("Fetching with Net::FTP:
1940 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
1941 "aslocal[$aslocal]") if $CPAN::DEBUG;
1942 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
1946 if ($aslocal !~ /\.gz$/) {
1947 my $gz = "$aslocal.gz";
1948 $CPAN::Frontend->myprint("Fetching with Net::FTP
1951 if (CPAN::FTP->ftp_get($host,
1955 CPAN::Tarzip->gunzip($gz,$aslocal)
1968 my($self,$host_seq,$file,$aslocal) = @_;
1970 # Came back if Net::FTP couldn't establish connection (or
1971 # failed otherwise) Maybe they are behind a firewall, but they
1972 # gave us a socksified (or other) ftp program...
1975 my($devnull) = $CPAN::Config->{devnull} || "";
1977 my($aslocal_dir) = File::Basename::dirname($aslocal);
1978 File::Path::mkpath($aslocal_dir);
1979 HOSTHARD: for $i (@$host_seq) {
1980 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
1981 unless ($self->is_reachable($url)) {
1982 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
1985 $url .= "/" unless substr($url,-1) eq "/";
1987 my($proto,$host,$dir,$getfile);
1989 # Courtesy Mark Conty mark_conty@cargill.com change from
1990 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1992 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
1993 # proto not yet used
1994 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
1996 next HOSTHARD; # who said, we could ftp anything except ftp?
1998 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2000 for $f ('lynx','ncftpget','ncftp') {
2001 next unless exists $CPAN::Config->{$f};
2002 $funkyftp = $CPAN::Config->{$f};
2003 next unless defined $funkyftp;
2004 next if $funkyftp =~ /^\s*$/;
2005 my($want_compressed);
2006 my $aslocal_uncompressed;
2007 ($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
2008 my($source_switch) = "";
2009 $source_switch = " -source" if $funkyftp =~ /\blynx$/;
2010 $source_switch = " -c" if $funkyftp =~ /\bncftp$/;
2011 $CPAN::Frontend->myprint(
2013 Trying with "$funkyftp$source_switch" to get
2016 my($system) = "$funkyftp$source_switch '$url' $devnull > ".
2017 "$aslocal_uncompressed";
2018 $self->debug("system[$system]") if $CPAN::DEBUG;
2020 if (($wstatus = system($system)) == 0
2022 -s $aslocal_uncompressed # lynx returns 0 on my
2023 # system even if it fails
2025 if ($aslocal_uncompressed ne $aslocal) {
2026 # test gzip integrity
2028 CPAN::Tarzip->gtest($aslocal_uncompressed)
2030 rename $aslocal_uncompressed, $aslocal;
2032 CPAN::Tarzip->gzip($aslocal_uncompressed,
2033 "$aslocal_uncompressed.gz");
2038 } elsif ($url !~ /\.gz$/) {
2039 unlink $aslocal_uncompressed if
2040 -f $aslocal_uncompressed && -s _ == 0;
2041 my $gz = "$aslocal.gz";
2042 my $gzurl = "$url.gz";
2043 $CPAN::Frontend->myprint(
2045 Trying with "$funkyftp$source_switch" to get
2048 my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ".
2049 "$aslocal_uncompressed.gz";
2050 $self->debug("system[$system]") if $CPAN::DEBUG;
2052 if (($wstatus = system($system)) == 0
2054 -s "$aslocal_uncompressed.gz"
2056 # test gzip integrity
2057 if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
2058 CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
2061 rename $aslocal_uncompressed, $aslocal;
2066 unlink "$aslocal_uncompressed.gz" if
2067 -f "$aslocal_uncompressed.gz";
2070 my $estatus = $wstatus >> 8;
2071 my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
2072 $CPAN::Frontend->myprint(qq{
2073 System call "$system"
2074 returned status $estatus (wstat $wstatus)$size
2082 my($self,$host_seq,$file,$aslocal) = @_;
2085 my($aslocal_dir) = File::Basename::dirname($aslocal);
2086 File::Path::mkpath($aslocal_dir);
2087 HOSTHARDEST: for $i (@$host_seq) {
2088 unless (length $CPAN::Config->{'ftp'}) {
2089 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2092 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2093 unless ($self->is_reachable($url)) {
2094 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2097 $url .= "/" unless substr($url,-1) eq "/";
2099 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2100 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2103 my($host,$dir,$getfile) = ($1,$2,$3);
2106 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2107 $ctime,$blksize,$blocks) = stat($aslocal);
2108 $timestamp = $mtime ||= 0;
2109 my($netrc) = CPAN::FTP::netrc->new;
2110 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2111 my $targetfile = File::Basename::basename($aslocal);
2117 map("cd $_", split "/", $dir), # RFC 1738
2119 "get $getfile $targetfile",
2122 if (! $netrc->netrc) {
2123 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2124 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2125 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2127 $netrc->contains($host))) if $CPAN::DEBUG;
2128 if ($netrc->protected) {
2129 $CPAN::Frontend->myprint(qq{
2130 Trying with external ftp to get
2132 As this requires some features that are not thoroughly tested, we\'re
2133 not sure, that we get it right....
2137 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
2139 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2140 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2142 if ($mtime > $timestamp) {
2143 $CPAN::Frontend->myprint("GOT $aslocal\n");
2147 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2150 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2151 qq{correctly protected.\n});
2154 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2155 nor does it have a default entry\n");
2158 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2159 # then and login manually to host, using e-mail as
2161 $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
2165 "user anonymous $Config::Config{'cf_email'}"
2167 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
2168 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2169 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2171 if ($mtime > $timestamp) {
2172 $CPAN::Frontend->myprint("GOT $aslocal\n");
2176 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2178 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2184 my($self,$command,@dialog) = @_;
2185 my $fh = FileHandle->new;
2186 $fh->open("|$command") or die "Couldn't open ftp: $!";
2187 foreach (@dialog) { $fh->print("$_\n") }
2188 $fh->close; # Wait for process to complete
2190 my $estatus = $wstatus >> 8;
2191 $CPAN::Frontend->myprint(qq{
2192 Subprocess "|$command"
2193 returned status $estatus (wstat $wstatus)
2197 # find2perl needs modularization, too, all the following is stolen
2201 my($self,$name) = @_;
2202 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2203 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2205 my($perms,%user,%group);
2209 $blocks = int(($blocks + 1) / 2);
2212 $blocks = int(($sizemm + 1023) / 1024);
2215 if (-f _) { $perms = '-'; }
2216 elsif (-d _) { $perms = 'd'; }
2217 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2218 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2219 elsif (-p _) { $perms = 'p'; }
2220 elsif (-S _) { $perms = 's'; }
2221 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2223 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2224 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2225 my $tmpmode = $mode;
2226 my $tmp = $rwx[$tmpmode & 7];
2228 $tmp = $rwx[$tmpmode & 7] . $tmp;
2230 $tmp = $rwx[$tmpmode & 7] . $tmp;
2231 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
2232 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
2233 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
2236 my $user = $user{$uid} || $uid; # too lazy to implement lookup
2237 my $group = $group{$gid} || $gid;
2239 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
2241 my($moname) = $moname[$mon];
2242 if (-M _ > 365.25 / 2) {
2243 $timeyear = $year + 1900;
2246 $timeyear = sprintf("%02d:%02d", $hour, $min);
2249 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
2263 package CPAN::FTP::netrc;
2267 my $file = MM->catfile($ENV{HOME},".netrc");
2269 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2270 $atime,$mtime,$ctime,$blksize,$blocks)
2275 my($fh,@machines,$hasdefault);
2277 $fh = FileHandle->new or die "Could not create a filehandle";
2279 if($fh->open($file)){
2280 $protected = ($mode & 077) == 0;
2282 NETRC: while (<$fh>) {
2283 my(@tokens) = split " ", $_;
2284 TOKEN: while (@tokens) {
2285 my($t) = shift @tokens;
2286 if ($t eq "default"){
2290 last TOKEN if $t eq "macdef";
2291 if ($t eq "machine") {
2292 push @machines, shift @tokens;
2297 $file = $hasdefault = $protected = "";
2301 'mach' => [@machines],
2303 'hasdefault' => $hasdefault,
2304 'protected' => $protected,
2308 sub hasdefault { shift->{'hasdefault'} }
2309 sub netrc { shift->{'netrc'} }
2310 sub protected { shift->{'protected'} }
2312 my($self,$mach) = @_;
2313 for ( @{$self->{'mach'}} ) {
2314 return 1 if $_ eq $mach;
2319 package CPAN::Complete;
2321 #-> sub CPAN::Complete::cpl ;
2323 my($word,$line,$pos) = @_;
2327 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2329 if ($line =~ s/^(force\s*)//) {
2337 ! a b d h i m o q r u autobundle clean
2338 make test install force reload look
2341 } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
2343 } elsif ($line =~ /^a\s/) {
2344 @return = cplx('CPAN::Author',$word);
2345 } elsif ($line =~ /^b\s/) {
2346 @return = cplx('CPAN::Bundle',$word);
2347 } elsif ($line =~ /^d\s/) {
2348 @return = cplx('CPAN::Distribution',$word);
2349 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
2350 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
2351 } elsif ($line =~ /^i\s/) {
2352 @return = cpl_any($word);
2353 } elsif ($line =~ /^reload\s/) {
2354 @return = cpl_reload($word,$line,$pos);
2355 } elsif ($line =~ /^o\s/) {
2356 @return = cpl_option($word,$line,$pos);
2363 #-> sub CPAN::Complete::cplx ;
2365 my($class, $word) = @_;
2366 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
2369 #-> sub CPAN::Complete::cpl_any ;
2373 cplx('CPAN::Author',$word),
2374 cplx('CPAN::Bundle',$word),
2375 cplx('CPAN::Distribution',$word),
2376 cplx('CPAN::Module',$word),
2380 #-> sub CPAN::Complete::cpl_reload ;
2382 my($word,$line,$pos) = @_;
2384 my(@words) = split " ", $line;
2385 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2386 my(@ok) = qw(cpan index);
2387 return @ok if @words == 1;
2388 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
2391 #-> sub CPAN::Complete::cpl_option ;
2393 my($word,$line,$pos) = @_;
2395 my(@words) = split " ", $line;
2396 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2397 my(@ok) = qw(conf debug);
2398 return @ok if @words == 1;
2399 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
2401 } elsif ($words[1] eq 'index') {
2403 } elsif ($words[1] eq 'conf') {
2404 return CPAN::Config::cpl(@_);
2405 } elsif ($words[1] eq 'debug') {
2406 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
2410 package CPAN::Index;
2412 #-> sub CPAN::Index::force_reload ;
2415 $CPAN::Index::last_time = 0;
2419 #-> sub CPAN::Index::reload ;
2421 my($cl,$force) = @_;
2424 # XXX check if a newer one is available. (We currently read it
2425 # from time to time)
2426 for ($CPAN::Config->{index_expire}) {
2427 $_ = 0.001 unless $_ > 0.001;
2429 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
2434 my $needshort = $^O eq "dos";
2436 $cl->rd_authindex($cl->reload_x(
2437 "authors/01mailrc.txt.gz",
2438 $needshort ? "01mailrc.gz" : "",
2441 $debug = "timing reading 01[".($t2 - $time)."]";
2443 return if $CPAN::Signal; # this is sometimes lengthy
2444 $cl->rd_modpacks($cl->reload_x(
2445 "modules/02packages.details.txt.gz",
2446 $needshort ? "02packag.gz" : "",
2449 $debug .= "02[".($t2 - $time)."]";
2451 return if $CPAN::Signal; # this is sometimes lengthy
2452 $cl->rd_modlist($cl->reload_x(
2453 "modules/03modlist.data.gz",
2454 $needshort ? "03mlist.gz" : "",
2457 $debug .= "03[".($t2 - $time)."]";
2459 CPAN->debug($debug) if $CPAN::DEBUG;
2462 #-> sub CPAN::Index::reload_x ;
2464 my($cl,$wanted,$localname,$force) = @_;
2465 $force |= 2; # means we're dealing with an index here
2466 CPAN::Config->load; # we should guarantee loading wherever we rely
2468 $localname ||= $wanted;
2469 my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
2473 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
2476 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
2477 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
2478 qq{day$s. I\'ll use that.});
2481 $force |= 1; # means we're quite serious about it.
2483 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
2486 #-> sub CPAN::Index::rd_authindex ;
2488 my($cl,$index_target) = @_;
2489 return unless defined $index_target;
2490 $CPAN::Frontend->myprint("Going to read $index_target\n");
2491 # my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2492 # while ($_ = $fh->READLINE) {
2495 tie *FH, CPAN::Tarzip, $index_target;
2499 my($userid,$fullname,$email) =
2500 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
2501 next unless $userid && $fullname && $email;
2503 # instantiate an author object
2504 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
2505 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
2506 return if $CPAN::Signal;
2511 my($self,$dist) = @_;
2512 $dist = $self->{'id'} unless defined $dist;
2513 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
2517 #-> sub CPAN::Index::rd_modpacks ;
2519 my($cl,$index_target) = @_;
2520 return unless defined $index_target;
2521 $CPAN::Frontend->myprint("Going to read $index_target\n");
2522 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2524 while ($_ = $fh->READLINE) {
2527 while ($_ = $fh->READLINE) {
2529 my($mod,$version,$dist) = split;
2530 ### $version =~ s/^\+//;
2532 # if it is a bundle, instatiate a bundle object
2533 my($bundle,$id,$userid);
2535 if ($mod eq 'CPAN' &&
2537 CPAN::Queue->exists('Bundle::CPAN') ||
2538 CPAN::Queue->exists('CPAN')
2542 if ($version > $CPAN::VERSION){
2543 $CPAN::Frontend->myprint(qq{
2544 There\'s a new CPAN.pm version (v$version) available!
2545 You might want to try
2546 install Bundle::CPAN
2548 without quitting the current session. It should be a seamless upgrade
2549 while we are running...
2552 $CPAN::Frontend->myprint(qq{\n});
2554 last if $CPAN::Signal;
2555 } elsif ($mod =~ /^Bundle::(.*)/) {
2560 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
2561 # warn "made mod[$mod]a bundle";
2562 # Let's make it a module too, because bundles have so much
2563 # in common with modules
2564 $CPAN::META->instance('CPAN::Module',$mod);
2565 # warn "made mod[$mod]a module";
2567 # This "next" makes us faster but if the job is running long, we ignore
2568 # rereads which is bad. So we have to be a bit slower again.
2569 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
2574 # instantiate a module object
2575 $id = $CPAN::META->instance('CPAN::Module',$mod);
2578 if ($id->cpan_file ne $dist){
2579 $userid = $cl->userid($dist);
2581 'CPAN_USERID' => $userid,
2582 'CPAN_VERSION' => $version,
2583 'CPAN_FILE' => $dist
2587 # instantiate a distribution object
2588 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
2589 $CPAN::META->instance(
2590 'CPAN::Distribution' => $dist
2592 'CPAN_USERID' => $userid
2596 return if $CPAN::Signal;
2601 #-> sub CPAN::Index::rd_modlist ;
2603 my($cl,$index_target) = @_;
2604 return unless defined $index_target;
2605 $CPAN::Frontend->myprint("Going to read $index_target\n");
2606 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2609 while ($_ = $fh->READLINE) {
2610 if (/^Date:\s+(.*)/){
2611 return if $date_of_03 eq $1;
2616 push @eval, $_ while $_ = $fh->READLINE;
2618 push @eval, q{CPAN::Modulelist->data;};
2620 my($comp) = Safe->new("CPAN::Safe1");
2621 my($eval) = join("", @eval);
2622 my $ret = $comp->reval($eval);
2623 Carp::confess($@) if $@;
2624 return if $CPAN::Signal;
2626 my $obj = $CPAN::META->instance(CPAN::Module,$_);
2627 $obj->set(%{$ret->{$_}});
2628 return if $CPAN::Signal;
2632 package CPAN::InfoObj;
2634 #-> sub CPAN::InfoObj::new ;
2635 sub new { my $this = bless {}, shift; %$this = @_; $this }
2637 #-> sub CPAN::InfoObj::set ;
2639 my($self,%att) = @_;
2640 my(%oldatt) = %$self;
2641 %$self = (%oldatt, %att);
2644 #-> sub CPAN::InfoObj::id ;
2645 sub id { shift->{'ID'} }
2647 #-> sub CPAN::InfoObj::as_glimpse ;
2651 my $class = ref($self);
2652 $class =~ s/^CPAN:://;
2653 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2657 #-> sub CPAN::InfoObj::as_string ;
2661 my $class = ref($self);
2662 $class =~ s/^CPAN:://;
2663 push @m, $class, " id = $self->{ID}\n";
2664 for (sort keys %$self) {
2667 if ($_ eq "CPAN_USERID") {
2668 $extra .= " (".$self->author;
2669 my $email; # old perls!
2670 if ($email = $CPAN::META->instance(CPAN::Author,
2673 $extra .= " <$email>";
2675 $extra .= " <no email>";
2679 if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX
2680 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2682 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
2688 #-> sub CPAN::InfoObj::author ;
2691 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2694 package CPAN::Author;
2696 #-> sub CPAN::Author::as_glimpse ;
2700 my $class = ref($self);
2701 $class =~ s/^CPAN:://;
2702 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2706 # Dead code, I would have liked to have,,, but it was never reached,,,
2709 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
2712 #-> sub CPAN::Author::fullname ;
2713 sub fullname { shift->{'FULLNAME'} }
2715 #-> sub CPAN::Author::email ;
2716 sub email { shift->{'EMAIL'} }
2718 package CPAN::Distribution;
2720 #-> sub CPAN::Distribution::called_for ;
2723 $self->{'CALLED_FOR'} = $id if defined $id;
2724 return $self->{'CALLED_FOR'};
2727 #-> sub CPAN::Distribution::get ;
2732 exists $self->{'build_dir'} and push @e,
2733 "Unwrapped into directory $self->{'build_dir'}";
2734 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
2739 $CPAN::Config->{keep_source_where},
2742 split("/",$self->{ID})
2745 $self->debug("Doing localize") if $CPAN::DEBUG;
2747 CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
2748 or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
2749 $self->{localfile} = $local_file;
2750 my $builddir = $CPAN::META->{cachemgr}->dir;
2751 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2752 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2755 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2756 if ($CPAN::META->has_inst('MD5')) {
2757 $self->debug("MD5 is installed, verifying");
2760 $self->debug("MD5 is NOT installed");
2762 $self->debug("Removing tmp") if $CPAN::DEBUG;
2763 File::Path::rmtree("tmp");
2764 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
2766 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2767 if (! $local_file) {
2768 Carp::croak "bad download, can't do anything :-(\n";
2769 } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
2770 $self->untar_me($local_file);
2771 } elsif ( $local_file =~ /\.zip$/i ) {
2772 $self->unzip_me($local_file);
2773 } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
2774 $self->pm2dir_me($local_file);
2776 $self->{archived} = "NO";
2779 if ($self->{archived} ne 'NO') {
2781 # Let's check if the package has its own directory.
2782 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!");
2783 my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
2785 my ($distdir,$packagedir);
2786 if (@readdir == 1 && -d $readdir[0]) {
2787 $distdir = $readdir[0];
2788 $packagedir = MM->catdir($builddir,$distdir);
2789 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
2790 File::Path::rmtree($packagedir);
2791 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2793 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2794 $pragmatic_dir =~ s/\W_//g;
2795 $pragmatic_dir++ while -d "../$pragmatic_dir";
2796 $packagedir = MM->catdir($builddir,$pragmatic_dir);
2797 File::Path::mkpath($packagedir);
2799 for $f (@readdir) { # is already without "." and ".."
2800 my $to = MM->catdir($packagedir,$f);
2801 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2804 $self->{'build_dir'} = $packagedir;
2807 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
2809 File::Path::rmtree("tmp");
2810 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
2811 $CPAN::Frontend->myprint("Going to unlink $local_file\n");
2812 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
2814 my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
2815 unless (-f $makefilepl) {
2816 my($configure) = MM->catfile($packagedir,"Configure");
2817 if (-f $configure) {
2818 # do we have anything to do?
2819 $self->{'configure'} = $configure;
2820 } elsif (-f MM->catfile($packagedir,"Makefile")) {
2821 $CPAN::Frontend->myprint(qq{
2822 Package comes with a Makefile and without a Makefile.PL.
2823 We\'ll try to build it with that Makefile then.
2825 $self->{writemakefile} = "YES";
2828 my $fh = FileHandle->new(">$makefilepl")
2829 or Carp::croak("Could not open >$makefilepl");
2830 my $cf = $self->called_for || "unknown";
2832 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
2833 # because there was no Makefile.PL supplied.
2834 # Autogenerated on: }.scalar localtime().qq{
2836 use ExtUtils::MakeMaker;
2837 WriteMakefile(NAME => q[$cf]);
2840 $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
2841 Writing one on our own (calling it $cf)\n});
2849 my($self,$local_file) = @_;
2850 $self->{archived} = "tar";
2851 if (CPAN::Tarzip->untar($local_file)) {
2852 $self->{unwrapped} = "YES";
2854 $self->{unwrapped} = "NO";
2859 my($self,$local_file) = @_;
2860 $self->{archived} = "zip";
2861 my $system = "$CPAN::Config->{unzip} $local_file";
2862 if (system($system) == 0) {
2863 $self->{unwrapped} = "YES";
2865 $self->{unwrapped} = "NO";
2870 my($self,$local_file) = @_;
2871 $self->{archived} = "pm";
2872 my $to = File::Basename::basename($local_file);
2873 $to =~ s/\.(gz|Z)$//;
2874 if (CPAN::Tarzip->gunzip($local_file,$to)) {
2875 $self->{unwrapped} = "YES";
2877 $self->{unwrapped} = "NO";
2881 #-> sub CPAN::Distribution::new ;
2883 my($class,%att) = @_;
2885 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
2887 my $this = { %att };
2888 return bless $this, $class;
2891 #-> sub CPAN::Distribution::look ;
2894 if ( $CPAN::Config->{'shell'} ) {
2895 $CPAN::Frontend->myprint(qq{
2896 Trying to open a subshell in the build directory...
2899 $CPAN::Frontend->myprint(qq{
2900 Your configuration does not define a value for subshells.
2901 Please define it with "o conf shell <your shell>"
2905 my $dist = $self->id;
2906 my $dir = $self->dir or $self->get;
2909 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2910 my $pwd = CPAN->$getcwd();
2912 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
2913 system($CPAN::Config->{'shell'}) == 0
2914 or $CPAN::Frontend->mydie("Subprocess shell error");
2918 #-> sub CPAN::Distribution::readme ;
2921 my($dist) = $self->id;
2922 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
2923 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
2927 $CPAN::Config->{keep_source_where},
2930 split("/","$sans.readme"),
2932 $self->debug("Doing localize") if $CPAN::DEBUG;
2933 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
2935 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
2936 my $fh_pager = FileHandle->new;
2937 local($SIG{PIPE}) = "IGNORE";
2938 $fh_pager->open("|$CPAN::Config->{'pager'}")
2939 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
2940 my $fh_readme = FileHandle->new;
2941 $fh_readme->open($local_file)
2942 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
2943 $CPAN::Frontend->myprint(qq{
2946 with pager "$CPAN::Config->{'pager'}"
2949 $fh_pager->print(<$fh_readme>);
2952 #-> sub CPAN::Distribution::verifyMD5 ;
2957 $self->{MD5_STATUS} ||= "";
2958 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
2959 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
2961 my($lc_want,$lc_file,@local,$basename);
2962 @local = split("/",$self->{ID});
2964 push @local, "CHECKSUMS";
2966 MM->catfile($CPAN::Config->{keep_source_where},
2967 "authors", "id", @local);
2972 $self->MD5_check_file($lc_want)
2974 return $self->{MD5_STATUS} = "OK";
2976 $lc_file = CPAN::FTP->localize("authors/id/@local",
2979 $local[-1] .= ".gz";
2980 $lc_file = CPAN::FTP->localize("authors/id/@local",
2983 $lc_file =~ s/\.gz$//;
2984 CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
2989 $self->MD5_check_file($lc_file);
2992 #-> sub CPAN::Distribution::MD5_check_file ;
2993 sub MD5_check_file {
2994 my($self,$chk_file) = @_;
2995 my($cksum,$file,$basename);
2996 $file = $self->{localfile};
2997 $basename = File::Basename::basename($file);
2998 my $fh = FileHandle->new;
2999 if (open $fh, $chk_file){
3003 my($comp) = Safe->new();
3004 $cksum = $comp->reval($eval);
3006 rename $chk_file, "$chk_file.bad";
3007 Carp::confess($@) if $@;
3010 Carp::carp "Could not open $chk_file for reading";
3013 if (exists $cksum->{$basename}{md5}) {
3014 $self->debug("Found checksum for $basename:" .
3015 "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
3019 my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
3021 $fh = CPAN::Tarzip->TIEHANDLE($file);
3024 # had to inline it, when I tied it, the tiedness got lost on
3025 # the call to eq_MD5. (Jan 1998)
3029 while ($fh->READ($ref, 4096)){
3032 my $hexdigest = $md5->hexdigest;
3033 $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
3037 $CPAN::Frontend->myprint("Checksum for $file ok\n");
3038 return $self->{MD5_STATUS} = "OK";
3040 $CPAN::Frontend->myprint(qq{Checksum mismatch for }.
3041 qq{distribution file. }.
3042 qq{Please investigate.\n\n}.
3044 $CPAN::META->instance(
3046 $self->{CPAN_USERID}
3048 my $wrap = qq{I\'d recommend removing $file. It seems to
3049 be a bogus file. Maybe you have configured your \`urllist\' with a
3050 bad URL. Please check this array with \`o conf urllist\', and
3052 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
3053 $CPAN::Frontend->myprint("\n\n");
3057 # close $fh if fileno($fh);
3059 $self->{MD5_STATUS} ||= "";
3060 if ($self->{MD5_STATUS} eq "NIL") {
3061 $CPAN::Frontend->myprint(qq{
3062 No md5 checksum for $basename in local $chk_file.
3065 unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
3068 $self->{MD5_STATUS} = "NIL";
3073 #-> sub CPAN::Distribution::eq_MD5 ;
3075 my($self,$fh,$expectMD5) = @_;
3078 while (read($fh, $data, 4096)){
3081 # $md5->addfile($fh);
3082 my $hexdigest = $md5->hexdigest;
3083 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
3084 $hexdigest eq $expectMD5;
3087 #-> sub CPAN::Distribution::force ;
3090 $self->{'force_update'}++;
3092 MD5_STATUS archived build_dir localfile make install unwrapped
3093 writemakefile have_sponsored
3095 delete $self->{$att};
3101 my $file = File::Basename::basename($self->id);
3102 return unless $file =~ m{ ^ perl
3105 (\d{3}(_[0-4][0-9])?)
3112 #-> sub CPAN::Distribution::perl ;
3115 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
3116 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3117 my $pwd = CPAN->$getcwd();
3118 my $candidate = MM->catfile($pwd,$^X);
3119 $perl ||= $candidate if MM->maybe_command($candidate);
3121 my ($component,$perl_name);
3122 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
3123 PATH_COMPONENT: foreach $component (MM->path(),
3124 $Config::Config{'binexp'}) {
3125 next unless defined($component) && $component;
3126 my($abs) = MM->catfile($component,$perl_name);
3127 if (MM->maybe_command($abs)) {
3137 #-> sub CPAN::Distribution::make ;
3140 $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
3141 # Emergency brake if they said install Pippi and get newest perl
3142 if ($self->isa_perl) {
3144 $self->called_for ne $self->id && ! $self->{'force_update'}
3146 $CPAN::Frontend->mydie(sprintf qq{
3147 The most recent version "%s" of the module "%s"
3148 comes with the current version of perl (%s).
3149 I\'ll build that only if you ask for something like
3154 $CPAN::META->instance(
3167 $self->{archived} eq "NO" and push @e,
3168 "Is neither a tar nor a zip archive.";
3170 $self->{unwrapped} eq "NO" and push @e,
3171 "had problems unarchiving. Please build manually";
3173 exists $self->{writemakefile} &&
3174 $self->{writemakefile} eq "NO" and push @e,
3175 "Had some problem writing Makefile";
3177 defined $self->{'make'} and push @e,
3178 "Has already been processed within this session";
3180 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3182 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
3183 my $builddir = $self->dir;
3184 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
3185 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
3188 if ($self->{'configure'}) {
3189 $system = $self->{'configure'};
3191 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
3193 # This needs a handler that can be turned on or off:
3194 # $switch = "-MExtUtils::MakeMaker ".
3195 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
3197 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
3199 unless (exists $self->{writemakefile}) {
3200 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
3203 if ($CPAN::Config->{inactivity_timeout}) {
3205 alarm $CPAN::Config->{inactivity_timeout};
3206 local $SIG{CHLD} = sub { wait };
3207 if (defined($pid = fork)) {
3211 # note, this exec isn't necessary if
3212 # inactivity_timeout is 0. On the Mac I'd
3213 # suggest, we set it always to 0.
3217 $CPAN::Frontend->myprint("Cannot fork: $!");
3225 $CPAN::Frontend->myprint($@);
3226 $self->{writemakefile} = "NO - $@";
3231 $ret = system($system);
3233 $self->{writemakefile} = "NO";
3237 $self->{writemakefile} = "YES";
3239 return if $CPAN::Signal;
3240 if (my @prereq = $self->needs_prereq){
3242 $CPAN::Frontend->myprint("---- Dependencies detected ".
3243 "during [$id] -----\n");
3245 for my $p (@prereq) {
3246 $CPAN::Frontend->myprint(" $p\n");
3250 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
3252 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
3253 require ExtUtils::MakeMaker;
3254 my $answer = ExtUtils::MakeMaker::prompt(
3255 "Shall I follow them and prepend them to the queue
3256 of modules we are processing right now?", "yes");
3257 $follow = $answer =~ /^\s*y/i;
3260 CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
3264 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
3265 if (system($system) == 0) {
3266 $CPAN::Frontend->myprint(" $system -- OK\n");
3267 $self->{'make'} = "YES";
3269 $self->{writemakefile} = "YES";
3270 $self->{'make'} = "NO";
3271 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3275 #-> sub CPAN::Distribution::needs_prereq ;
3278 return unless -f "Makefile"; # we cannot say much
3279 my $fh = FileHandle->new("<Makefile") or
3280 $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
3284 last if ($v) = m| ^ \# \s+ ( \d+\.\d+ ) .* Revision: |x;
3288 if (1) { # probably all versions of MakeMaker ever so far
3290 last if /MakeMaker post_initialize section/;
3292 \s+PREREQ_PM\s+=>\s+(.+)
3295 # warn "Found prereq expr[$p]";
3297 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
3302 } else { # MakeMaker after a patch I suggested. Let's wait and see
3304 last if /MakeMaker post_initialize section/;
3305 my($p) = m|\# prerequisite (\S+).+not found|;
3311 unless ($CPAN::META->instance("CPAN::Module",$p)->inst_file){
3312 if ($self->{'have_sponsored'}{$p}++) {
3313 # We have already sponsored it and for some reason it's still
3314 # not available. So we do nothing. Or what should we do?
3316 # warn "----- Protegere $p -----";
3318 # CPAN::Queue->jumpqueue($p);
3326 #-> sub CPAN::Distribution::test ;
3330 return if $CPAN::Signal;
3331 $CPAN::Frontend->myprint("Running make test\n");
3334 exists $self->{'make'} or push @e,
3335 "Make had some problems, maybe interrupted? Won't test";
3337 exists $self->{'make'} and
3338 $self->{'make'} eq 'NO' and
3339 push @e, "Oops, make had returned bad status";
3341 exists $self->{'build_dir'} or push @e, "Has no own directory";
3342 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3344 chdir $self->{'build_dir'} or
3345 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3346 $self->debug("Changed directory to $self->{'build_dir'}")
3348 my $system = join " ", $CPAN::Config->{'make'}, "test";
3349 if (system($system) == 0) {
3350 $CPAN::Frontend->myprint(" $system -- OK\n");
3351 $self->{'make_test'} = "YES";
3353 $self->{'make_test'} = "NO";
3354 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3358 #-> sub CPAN::Distribution::clean ;
3361 $CPAN::Frontend->myprint("Running make clean\n");
3364 exists $self->{'build_dir'} or push @e, "Has no own directory";
3365 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3367 chdir $self->{'build_dir'} or
3368 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3369 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
3370 my $system = join " ", $CPAN::Config->{'make'}, "clean";
3371 if (system($system) == 0) {
3372 $CPAN::Frontend->myprint(" $system -- OK\n");
3375 # Hmmm, what to do if make clean failed?
3379 #-> sub CPAN::Distribution::install ;
3383 return if $CPAN::Signal;
3384 $CPAN::Frontend->myprint("Running make install\n");
3387 exists $self->{'build_dir'} or push @e, "Has no own directory";
3389 exists $self->{'make'} or push @e,
3390 "Make had some problems, maybe interrupted? Won't install";
3392 exists $self->{'make'} and
3393 $self->{'make'} eq 'NO' and
3394 push @e, "Oops, make had returned bad status";
3396 push @e, "make test had returned bad status, ".
3397 "won't install without force"
3398 if exists $self->{'make_test'} and
3399 $self->{'make_test'} eq 'NO' and
3400 ! $self->{'force_update'};
3402 exists $self->{'install'} and push @e,
3403 $self->{'install'} eq "YES" ?
3404 "Already done" : "Already tried without success";
3406 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3408 chdir $self->{'build_dir'} or
3409 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3410 $self->debug("Changed directory to $self->{'build_dir'}")
3412 my $system = join(" ", $CPAN::Config->{'make'},
3413 "install", $CPAN::Config->{make_install_arg});
3414 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
3415 my($pipe) = FileHandle->new("$system $stderr |");
3418 $CPAN::Frontend->myprint($_);
3423 $CPAN::Frontend->myprint(" $system -- OK\n");
3424 return $self->{'install'} = "YES";
3426 $self->{'install'} = "NO";
3427 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3428 if ($makeout =~ /permission/s && $> > 0) {
3429 $CPAN::Frontend->myprint(qq{ You may have to su }.
3430 qq{to root to install the package\n});
3435 #-> sub CPAN::Distribution::dir ;
3437 shift->{'build_dir'};
3440 package CPAN::Bundle;
3442 #-> sub CPAN::Bundle::as_string ;
3446 $self->{INST_VERSION} = $self->inst_version;
3447 return $self->SUPER::as_string;
3450 #-> sub CPAN::Bundle::contains ;
3453 my($parsefile) = $self->inst_file;
3454 my($id) = $self->id;
3455 $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
3456 unless ($parsefile) {
3457 # Try to get at it in the cpan directory
3458 $self->debug("no parsefile") if $CPAN::DEBUG;
3459 Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
3460 my $dist = $CPAN::META->instance('CPAN::Distribution',
3461 $self->{CPAN_FILE});
3463 $self->debug($dist->as_string) if $CPAN::DEBUG;
3464 my($todir) = $CPAN::Config->{'cpan_home'};
3465 my(@me,$from,$to,$me);
3466 @me = split /::/, $self->id;
3468 $me = MM->catfile(@me);
3469 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
3470 $to = MM->catfile($todir,$me);
3471 File::Path::mkpath(File::Basename::dirname($to));
3472 File::Copy::copy($from, $to)
3473 or Carp::confess("Couldn't copy $from to $to: $!");
3477 my $fh = FileHandle->new;
3479 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
3481 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
3483 $inpod = m/^=(?!head1\s+CONTENTS)/ ? 0 :
3484 m/^=head1\s+CONTENTS/ ? 1 : $inpod;
3489 push @result, (split " ", $_, 2)[0];
3492 delete $self->{STATUS};
3493 $self->{CONTAINS} = join ", ", @result;
3494 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
3496 $CPAN::Frontend->mywarn(qq{
3497 The bundle file "$parsefile" may be a broken
3498 bundlefile. It seems not to contain any bundle definition.
3499 Please check the file and if it is bogus, please delete it.
3500 Sorry for the inconvenience.
3506 #-> sub CPAN::Bundle::find_bundle_file
3507 sub find_bundle_file {
3508 my($self,$where,$what) = @_;
3509 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
3510 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
3511 ### my $bu = MM->catfile($where,$what);
3512 ### return $bu if -f $bu;
3513 my $manifest = MM->catfile($where,"MANIFEST");
3514 unless (-f $manifest) {
3515 require ExtUtils::Manifest;
3516 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3517 my $cwd = CPAN->$getcwd();
3519 ExtUtils::Manifest::mkmanifest();
3522 my $fh = FileHandle->new($manifest)
3523 or Carp::croak("Couldn't open $manifest: $!");
3526 $what2 =~ s|Bundle/||;
3530 my($file) = /(\S+)/;
3531 if ($file =~ m|\Q$what\E$|) {
3533 # return MM->catfile($where,$bu); # bad
3536 # retry if she managed to
3537 # have no Bundle directory
3538 $bu = $file if $file =~ m|\Q$what2\E$|;
3540 return MM->catfile($where, $bu) if $bu;
3541 Carp::croak("Couldn't find a Bundle file in $where");
3544 #-> sub CPAN::Bundle::inst_file ;
3548 ($me = $self->id) =~ s/.*://;
3549 ## my(@me,$inst_file);
3550 ## @me = split /::/, $self->id;
3551 ## $me[-1] .= ".pm";
3552 $inst_file = MM->catfile($CPAN::Config->{'cpan_home'},
3553 "Bundle", "$me.pm");
3555 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
3557 $self->SUPER::inst_file;
3558 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
3559 # return $self->{'INST_FILE'}; # even if undefined?
3562 #-> sub CPAN::Bundle::rematein ;
3564 my($self,$meth) = @_;
3565 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
3566 my($id) = $self->id;
3567 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
3568 unless $self->inst_file || $self->{CPAN_FILE};
3570 for $s ($self->contains) {
3571 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
3572 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
3573 if ($type eq 'CPAN::Distribution') {
3574 $CPAN::Frontend->mywarn(qq{
3575 The Bundle }.$self->id.qq{ contains
3576 explicitly a file $s.
3580 # possibly noisy action:
3581 my $obj = $CPAN::META->instance($type,$s);
3583 my $success = $obj->can("uptodate") ? $obj->uptodate : 0;
3584 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
3585 $fail{$s} = 1 unless $success;
3587 # recap with less noise
3588 if ( $meth eq "install") {
3590 $CPAN::Frontend->myprint(qq{\nBundle summary: }.
3591 qq{The following items seem to }.
3592 qq{have had installation problems:\n});
3593 for $s ($self->contains) {
3594 $CPAN::Frontend->myprint( "$s " ) if $fail{$s};
3596 $CPAN::Frontend->myprint(qq{\n});
3598 $self->{'install'} = 'YES';
3603 #sub CPAN::Bundle::xs_file
3605 # If a bundle contains another that contains an xs_file we have
3606 # here, we just don't bother I suppose
3610 #-> sub CPAN::Bundle::force ;
3611 sub force { shift->rematein('force',@_); }
3612 #-> sub CPAN::Bundle::get ;
3613 sub get { shift->rematein('get',@_); }
3614 #-> sub CPAN::Bundle::make ;
3615 sub make { shift->rematein('make',@_); }
3616 #-> sub CPAN::Bundle::test ;
3617 sub test { shift->rematein('test',@_); }
3618 #-> sub CPAN::Bundle::install ;
3621 $self->rematein('install',@_);
3623 #-> sub CPAN::Bundle::clean ;
3624 sub clean { shift->rematein('clean',@_); }
3626 #-> sub CPAN::Bundle::readme ;
3629 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
3630 No File found for bundle } . $self->id . qq{\n}), return;
3631 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
3632 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
3635 package CPAN::Module;
3637 #-> sub CPAN::Module::as_glimpse ;
3641 my $class = ref($self);
3642 $class =~ s/^CPAN:://;
3643 push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
3648 #-> sub CPAN::Module::as_string ;
3652 CPAN->debug($self) if $CPAN::DEBUG;
3653 my $class = ref($self);
3654 $class =~ s/^CPAN:://;
3656 push @m, $class, " id = $self->{ID}\n";
3657 my $sprintf = " %-12s %s\n";
3658 push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description})
3659 if $self->{description};
3660 my $sprintf2 = " %-12s %s (%s)\n";
3662 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
3664 if ($author = CPAN::Shell->expand('Author',$userid)) {
3667 if ($m = $author->email) {
3674 $author->fullname . $email
3678 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
3679 if $self->{CPAN_VERSION};
3680 push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
3681 if $self->{CPAN_FILE};
3682 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
3683 my(%statd,%stats,%statl,%stati);
3684 @statd{qw,? i c a b R M S,} = qw,unknown idea
3685 pre-alpha alpha beta released mature standard,;
3686 @stats{qw,? m d u n,} = qw,unknown mailing-list
3687 developer comp.lang.perl.* none,;
3688 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
3689 @stati{qw,? f r O h,} = qw,unknown functions
3690 references+ties object-oriented hybrid,;
3691 $statd{' '} = 'unknown';
3692 $stats{' '} = 'unknown';
3693 $statl{' '} = 'unknown';
3694 $stati{' '} = 'unknown';
3702 $statd{$self->{statd}},
3703 $stats{$self->{stats}},
3704 $statl{$self->{statl}},
3705 $stati{$self->{stati}}
3706 ) if $self->{statd};
3707 my $local_file = $self->inst_file;
3709 $self->{MANPAGE} ||= $self->manpage_headline($local_file);
3712 for $item (qw/MANPAGE CONTAINS/) {
3713 push @m, sprintf($sprintf, $item, $self->{$item})
3714 if exists $self->{$item};
3716 push @m, sprintf($sprintf, 'INST_FILE',
3717 $local_file || "(not installed)");
3718 push @m, sprintf($sprintf, 'INST_VERSION',
3719 $self->inst_version) if $local_file;
3723 sub manpage_headline {
3724 my($self,$local_file) = @_;
3725 my(@local_file) = $local_file;
3726 $local_file =~ s/\.pm$/.pod/;
3727 push @local_file, $local_file;
3729 for $locf (@local_file) {
3730 next unless -f $locf;
3731 my $fh = FileHandle->new($locf)
3732 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
3736 $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
3737 m/^=head1\s+NAME/ ? 1 : $inpod;
3750 #-> sub CPAN::Module::cpan_file ;
3753 CPAN->debug($self->id) if $CPAN::DEBUG;
3754 unless (defined $self->{'CPAN_FILE'}) {
3755 CPAN::Index->reload;
3757 if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){
3758 return $self->{'CPAN_FILE'};
3759 } elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
3760 my $fullname = $CPAN::META->instance(CPAN::Author,
3761 $self->{'userid'})->fullname;
3762 my $email = $CPAN::META->instance(CPAN::Author,
3763 $self->{'userid'})->email;
3764 unless (defined $fullname && defined $email) {
3765 return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
3767 return "Contact Author $fullname <$email>";
3773 *name = \&cpan_file;
3775 #-> sub CPAN::Module::cpan_version ;
3778 $self->{'CPAN_VERSION'} = 'undef'
3779 unless defined $self->{'CPAN_VERSION'}; # I believe this is
3780 # always a bug in the
3781 # index and should be
3783 # but usually I find
3785 # and do not want to
3788 $self->{'CPAN_VERSION'};
3791 #-> sub CPAN::Module::force ;
3794 $self->{'force_update'}++;
3797 #-> sub CPAN::Module::rematein ;
3799 my($self,$meth) = @_;
3800 $self->debug($self->id) if $CPAN::DEBUG;
3801 my $cpan_file = $self->cpan_file;
3802 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
3803 $CPAN::Frontend->mywarn(sprintf qq{
3804 The module %s isn\'t available on CPAN.
3806 Either the module has not yet been uploaded to CPAN, or it is
3807 temporary unavailable. Please contact the author to find out
3808 more about the status. Try ``i %s''.
3815 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
3816 $pack->called_for($self->id);
3817 $pack->force if exists $self->{'force_update'};
3819 delete $self->{'force_update'};
3822 #-> sub CPAN::Module::readme ;
3823 sub readme { shift->rematein('readme') }
3824 #-> sub CPAN::Module::look ;
3825 sub look { shift->rematein('look') }
3826 #-> sub CPAN::Module::get ;
3827 sub get { shift->rematein('get',@_); }
3828 #-> sub CPAN::Module::make ;
3829 sub make { shift->rematein('make') }
3830 #-> sub CPAN::Module::test ;
3831 sub test { shift->rematein('test') }
3832 #-> sub CPAN::Module::uptodate ;
3835 my($latest) = $self->cpan_version;
3837 my($inst_file) = $self->inst_file;
3839 if (defined $inst_file) {
3840 $have = $self->inst_version;
3842 if (1){ # A block for scoping $^W, the if is just for the visual
3854 #-> sub CPAN::Module::install ;
3860 not exists $self->{'force_update'}
3862 $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
3866 $self->rematein('install') if $doit;
3868 #-> sub CPAN::Module::clean ;
3869 sub clean { shift->rematein('clean') }
3871 #-> sub CPAN::Module::inst_file ;
3875 @packpath = split /::/, $self->{ID};
3876 $packpath[-1] .= ".pm";
3877 foreach $dir (@INC) {
3878 my $pmfile = MM->catfile($dir,@packpath);
3886 #-> sub CPAN::Module::xs_file ;
3890 @packpath = split /::/, $self->{ID};
3891 push @packpath, $packpath[-1];
3892 $packpath[-1] .= "." . $Config::Config{'dlext'};
3893 foreach $dir (@INC) {
3894 my $xsfile = MM->catfile($dir,'auto',@packpath);
3902 #-> sub CPAN::Module::inst_version ;
3905 my $parsefile = $self->inst_file or return;
3906 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
3908 my $have = MM->parse_version($parsefile) || "undef";
3913 package CPAN::Tarzip;
3916 my($class,$read,$write) = @_;
3917 if ($CPAN::META->has_inst("Compress::Zlib")) {
3919 $fhw = FileHandle->new($read)
3920 or $CPAN::Frontend->mydie("Could not open $read: $!");
3921 my $gz = Compress::Zlib::gzopen($write, "wb")
3922 or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
3923 $gz->gzwrite($buffer)
3924 while read($fhw,$buffer,4096) > 0 ;
3929 system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
3934 my($class,$read,$write) = @_;
3935 if ($CPAN::META->has_inst("Compress::Zlib")) {
3937 $fhw = FileHandle->new(">$write")
3938 or $CPAN::Frontend->mydie("Could not open >$write: $!");
3939 my $gz = Compress::Zlib::gzopen($read, "rb")
3940 or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
3941 $fhw->print($buffer)
3942 while $gz->gzread($buffer) > 0 ;
3943 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
3944 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
3949 system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
3954 my($class,$read) = @_;
3955 if ($CPAN::META->has_inst("Compress::Zlib")) {
3957 my $gz = Compress::Zlib::gzopen($read, "rb")
3958 or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
3959 1 while $gz->gzread($buffer) > 0 ;
3960 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
3961 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
3965 return system("$CPAN::Config->{'gzip'} -dt $read")==0;
3970 my($class,$file) = @_;
3972 $class->debug("file[$file]");
3973 if ($CPAN::META->has_inst("Compress::Zlib")) {
3974 my $gz = Compress::Zlib::gzopen($file,"rb") or
3975 die "Could not gzopen $file";
3976 $ret = bless {GZ => $gz}, $class;
3978 my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |";
3979 my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
3981 $ret = bless {FH => $fh}, $class;
3988 if (exists $self->{GZ}) {
3989 my $gz = $self->{GZ};
3990 my($line,$bytesread);
3991 $bytesread = $gz->gzreadline($line);
3992 return undef if $bytesread == 0;
3995 my $fh = $self->{FH};
3996 return scalar <$fh>;
4001 my($self,$ref,$length,$offset) = @_;
4002 die "read with offset not implemented" if defined $offset;
4003 if (exists $self->{GZ}) {
4004 my $gz = $self->{GZ};
4005 my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
4008 my $fh = $self->{FH};
4009 return read($fh,$$ref,$length);
4015 if (exists $self->{GZ}) {
4016 my $gz = $self->{GZ};
4019 my $fh = $self->{FH};
4026 my($class,$file) = @_;
4027 # had to disable, because version 0.07 seems to be buggy
4028 if (MM->maybe_command($CPAN::Config->{'gzip'})
4030 MM->maybe_command($CPAN::Config->{'tar'})) {
4031 if ($^O =~ /win/i) { # irgggh
4032 # people find the most curious tar binaries that cannot handle
4034 my $system = "$CPAN::Config->{'gzip'} --decompress $file";
4035 if (system($system)==0) {
4036 $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
4038 $CPAN::Frontend->mydie(
4039 qq{Couldn\'t uncompress $file\n}
4043 $system = "$CPAN::Config->{tar} xvf $file";
4044 if (system($system)==0) {
4045 $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
4047 $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
4051 my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
4052 "< $file | $CPAN::Config->{tar} xvf -";
4053 return system($system) == 0;
4055 } elsif ($CPAN::META->has_inst("Archive::Tar")
4057 $CPAN::META->has_inst("Compress::Zlib") ) {
4058 my $tar = Archive::Tar->new($file,1);
4059 $tar->extract($tar->list_files); # I'm pretty sure we have nothing
4060 # that isn't compressed
4063 $CPAN::Frontend->mydie(qq{
4064 CPAN.pm needs either both external programs tar and gzip installed or
4065 both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
4066 is available. Can\'t continue.
4079 CPAN - query, download and build perl modules from CPAN sites
4085 perl -MCPAN -e shell;
4091 autobundle, clean, install, make, recompile, test
4095 The CPAN module is designed to automate the make and install of perl
4096 modules and extensions. It includes some searching capabilities and
4097 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
4098 to fetch the raw data from the net.
4100 Modules are fetched from one or more of the mirrored CPAN
4101 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
4104 The CPAN module also supports the concept of named and versioned
4105 'bundles' of modules. Bundles simplify the handling of sets of
4106 related modules. See BUNDLES below.
4108 The package contains a session manager and a cache manager. There is
4109 no status retained between sessions. The session manager keeps track
4110 of what has been fetched, built and installed in the current
4111 session. The cache manager keeps track of the disk space occupied by
4112 the make processes and deletes excess space according to a simple FIFO
4115 For extended searching capabilities there's a plugin for CPAN available,
4116 L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
4117 all documents available in CPAN authors directories. If C<CPAN::WAIT>
4118 is installed on your system, the interactive shell of <CPAN.pm> will
4119 enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands which send
4120 queries to the WAIT server that has been configured for your
4123 All other methods provided are accessible in a programmer style and in an
4124 interactive shell style.
4126 =head2 Interactive Mode
4128 The interactive mode is entered by running
4130 perl -MCPAN -e shell
4132 which puts you into a readline interface. You will have the most fun if
4133 you install Term::ReadKey and Term::ReadLine to enjoy both history and
4136 Once you are on the command line, type 'h' and the rest should be
4139 The most common uses of the interactive modes are
4143 =item Searching for authors, bundles, distribution files and modules
4145 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
4146 for each of the four categories and another, C<i> for any of the
4147 mentioned four. Each of the four entities is implemented as a class
4148 with slightly differing methods for displaying an object.
4150 Arguments you pass to these commands are either strings exactly matching
4151 the identification string of an object or regular expressions that are
4152 then matched case-insensitively against various attributes of the
4153 objects. The parser recognizes a regular expression only if you
4154 enclose it between two slashes.
4156 The principle is that the number of found objects influences how an
4157 item is displayed. If the search finds one item, the result is displayed
4158 as object-E<gt>as_string, but if we find more than one, we display
4159 each as object-E<gt>as_glimpse. E.g.
4163 EMAIL a.koenig@franz.ww.TU-Berlin.DE
4164 FULLNAME Andreas König
4169 EMAIL a.koenig@franz.ww.TU-Berlin.DE
4170 FULLNAME Andreas König
4174 Author ANDYD (Andy Dougherty)
4175 Author MERLYN (Randal L. Schwartz)
4177 =item make, test, install, clean modules or distributions
4179 These commands take any number of arguments and investigate what is
4180 necessary to perform the action. If the argument is a distribution
4181 file name (recognized by embedded slashes), it is processed. If it is a
4182 module, CPAN determines the distribution file in which this module is
4183 included and processes that.
4185 Any C<make> or C<test> are run unconditionally. An
4187 install <distribution_file>
4189 also is run unconditionally. But for
4193 CPAN checks if an install is actually needed for it and prints
4194 I<module up to date> in the case that the distribution file containing
4195 the module doesnE<39>t need to be updated.
4197 CPAN also keeps track of what it has done within the current session
4198 and doesnE<39>t try to build a package a second time regardless if it
4199 succeeded or not. The C<force> command takes as a first argument the
4200 method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
4201 command from scratch.
4205 cpan> install OpenGL
4206 OpenGL is up to date.
4207 cpan> force install OpenGL
4210 OpenGL-0.4/COPYRIGHT
4213 A C<clean> command results in a
4217 being executed within the distribution file's working directory.
4219 =item readme, look module or distribution
4221 These two commands take only one argument, be it a module or a
4222 distribution file. C<readme> unconditionally runs, displaying the
4223 README of the associated distribution file. C<Look> gets and
4224 untars (if not yet done) the distribution file, changes to the
4225 appropriate directory and opens a subshell process in that directory.
4229 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
4230 in the cpan-shell it is intended that you can press C<^C> anytime and
4231 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
4232 to clean up and leave the shell loop. You can emulate the effect of a
4233 SIGTERM by sending two consecutive SIGINTs, which usually means by
4234 pressing C<^C> twice.
4236 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
4237 SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
4243 The commands that are available in the shell interface are methods in
4244 the package CPAN::Shell. If you enter the shell command, all your
4245 input is split by the Text::ParseWords::shellwords() routine which
4246 acts like most shells do. The first word is being interpreted as the
4247 method to be called and the rest of the words are treated as arguments
4248 to this method. Continuation lines are supported if a line ends with a
4253 C<autobundle> writes a bundle file into the
4254 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
4255 a list of all modules that are both available from CPAN and currently
4256 installed within @INC. The name of the bundle file is based on the
4257 current date and a counter.
4261 recompile() is a very special command in that it takes no argument and
4262 runs the make/test/install cycle with brute force over all installed
4263 dynamically loadable extensions (aka XS modules) with 'force' in
4264 effect. The primary purpose of this command is to finish a network
4265 installation. Imagine, you have a common source tree for two different
4266 architectures. You decide to do a completely independent fresh
4267 installation. You start on one architecture with the help of a Bundle
4268 file produced earlier. CPAN installs the whole Bundle for you, but
4269 when you try to repeat the job on the second architecture, CPAN
4270 responds with a C<"Foo up to date"> message for all modules. So you
4271 invoke CPAN's recompile on the second architecture and youE<39>re done.
4273 Another popular use for C<recompile> is to act as a rescue in case your
4274 perl breaks binary compatibility. If one of the modules that CPAN uses
4275 is in turn depending on binary compatibility (so you cannot run CPAN
4276 commands), then you should try the CPAN::Nox module for recovery.
4278 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
4280 Although it may be considered internal, the class hierarchy does matter
4281 for both users and programmer. CPAN.pm deals with above mentioned four
4282 classes, and all those classes share a set of methods. A classical
4283 single polymorphism is in effect. A metaclass object registers all
4284 objects of all kinds and indexes them with a string. The strings
4285 referencing objects have a separated namespace (well, not completely
4290 words containing a "/" (slash) Distribution
4291 words starting with Bundle:: Bundle
4292 everything else Module or Author
4294 Modules know their associated Distribution objects. They always refer
4295 to the most recent official release. Developers may mark their releases
4296 as unstable development versions (by inserting an underbar into the
4297 visible version number), so the really hottest and newest distribution
4298 file is not always the default. If a module Foo circulates on CPAN in
4299 both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
4300 install version 1.23 by saying
4304 This would install the complete distribution file (say
4305 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
4306 like to install version 1.23_90, you need to know where the
4307 distribution file resides on CPAN relative to the authors/id/
4308 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
4309 so you would have to say
4311 install BAR/Foo-1.23_90.tar.gz
4313 The first example will be driven by an object of the class
4314 CPAN::Module, the second by an object of class CPAN::Distribution.
4316 =head2 ProgrammerE<39>s interface
4318 If you do not enter the shell, the available shell commands are both
4319 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
4320 functions in the calling package (C<install(...)>).
4322 There's currently only one class that has a stable interface -
4323 CPAN::Shell. All commands that are available in the CPAN shell are
4324 methods of the class CPAN::Shell. Each of the commands that produce
4325 listings of modules (C<r>, C<autobundle>, C<u>) returns a list of the
4326 IDs of all modules within the list.
4330 =item expand($type,@things)
4332 The IDs of all objects available within a program are strings that can
4333 be expanded to the corresponding real objects with the
4334 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
4335 list of CPAN::Module objects according to the C<@things> arguments
4336 given. In scalar context it only returns the first element of the
4339 =item Programming Examples
4341 This enables the programmer to do operations that combine
4342 functionalities that are available in the shell.
4344 # install everything that is outdated on my disk:
4345 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
4347 # install my favorite programs if necessary:
4348 for $mod (qw(Net::FTP MD5 Data::Dumper)){
4349 my $obj = CPAN::Shell->expand('Module',$mod);
4353 # list all modules on my disk that have no VERSION number
4354 for $mod (CPAN::Shell->expand("Module","/./")){
4355 next unless $mod->inst_file;
4356 # MakeMaker convention for undefined $VERSION:
4357 next unless $mod->inst_version eq "undef";
4358 print "No VERSION in ", $mod->id, "\n";
4363 =head2 Methods in the four Classes
4365 =head2 Cache Manager
4367 Currently the cache manager only keeps track of the build directory
4368 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
4369 deletes complete directories below C<build_dir> as soon as the size of
4370 all directories there gets bigger than $CPAN::Config->{build_cache}
4371 (in MB). The contents of this cache may be used for later
4372 re-installations that you intend to do manually, but will never be
4373 trusted by CPAN itself. This is due to the fact that the user might
4374 use these directories for building modules on different architectures.
4376 There is another directory ($CPAN::Config->{keep_source_where}) where
4377 the original distribution files are kept. This directory is not
4378 covered by the cache manager and must be controlled by the user. If
4379 you choose to have the same directory as build_dir and as
4380 keep_source_where directory, then your sources will be deleted with
4381 the same fifo mechanism.
4385 A bundle is just a perl module in the namespace Bundle:: that does not
4386 define any functions or methods. It usually only contains documentation.
4388 It starts like a perl module with a package declaration and a $VERSION
4389 variable. After that the pod section looks like any other pod with the
4390 only difference being that I<one special pod section> exists starting with
4395 In this pod section each line obeys the format
4397 Module_Name [Version_String] [- optional text]
4399 The only required part is the first field, the name of a module
4400 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
4401 of the line is optional. The comment part is delimited by a dash just
4402 as in the man page header.
4404 The distribution of a bundle should follow the same convention as
4405 other distributions.
4407 Bundles are treated specially in the CPAN package. If you say 'install
4408 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
4409 the modules in the CONTENTS section of the pod. You can install your
4410 own Bundles locally by placing a conformant Bundle file somewhere into
4411 your @INC path. The autobundle() command which is available in the
4412 shell interface does that for you by including all currently installed
4413 modules in a snapshot bundle file.
4415 =head2 Prerequisites
4417 If you have a local mirror of CPAN and can access all files with
4418 "file:" URLs, then you only need a perl better than perl5.003 to run
4419 this module. Otherwise Net::FTP is strongly recommended. LWP may be
4420 required for non-UNIX systems or if your nearest CPAN site is
4421 associated with an URL that is not C<ftp:>.
4423 If you have neither Net::FTP nor LWP, there is a fallback mechanism
4424 implemented for an external ftp command or for an external lynx
4427 =head2 Finding packages and VERSION
4429 This module presumes that all packages on CPAN
4435 declare their $VERSION variable in an easy to parse manner. This
4436 prerequisite can hardly be relaxed because it consumes far too much
4437 memory to load all packages into the running program just to determine
4438 the $VERSION variable. Currently all programs that are dealing with
4439 version use something like this
4441 perl -MExtUtils::MakeMaker -le \
4442 'print MM->parse_version(shift)' filename
4444 If you are author of a package and wonder if your $VERSION can be
4445 parsed, please try the above method.
4449 come as compressed or gzipped tarfiles or as zip files and contain a
4450 Makefile.PL (well, we try to handle a bit more, but without much
4457 The debugging of this module is pretty difficult, because we have
4458 interferences of the software producing the indices on CPAN, of the
4459 mirroring process on CPAN, of packaging, of configuration, of
4460 synchronicity, and of bugs within CPAN.pm.
4462 In interactive mode you can try "o debug" which will list options for
4463 debugging the various parts of the package. The output may not be very
4464 useful for you as it's just a by-product of my own testing, but if you
4465 have an idea which part of the package may have a bug, it's sometimes
4466 worth to give it a try and send me more specific output. You should
4467 know that "o debug" has built-in completion support.
4469 =head2 Floppy, Zip, Offline Mode
4471 CPAN.pm works nicely without network too. If you maintain machines
4472 that are not networked at all, you should consider working with file:
4473 URLs. Of course, you have to collect your modules somewhere first. So
4474 you might use CPAN.pm to put together all you need on a networked
4475 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
4476 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
4477 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
4480 =head1 CONFIGURATION
4482 When the CPAN module is installed, a site wide configuration file is
4483 created as CPAN/Config.pm. The default values defined there can be
4484 overridden in another configuration file: CPAN/MyConfig.pm. You can
4485 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
4486 $HOME/.cpan is added to the search path of the CPAN module before the
4487 use() or require() statements.
4489 Currently the following keys in the hash reference $CPAN::Config are
4492 build_cache size of cache for directories to build modules
4493 build_dir locally accessible directory to build modules
4494 index_expire after this many days refetch index files
4495 cpan_home local directory reserved for this package
4496 gzip location of external program gzip
4497 inactivity_timeout breaks interactive Makefile.PLs after this
4498 many seconds inactivity. Set to 0 to never break.
4499 inhibit_startup_message
4500 if true, does not print the startup message
4501 keep_source keep the source in a local directory?
4502 keep_source_where directory in which to keep the source (if we do)
4503 make location of external make program
4504 make_arg arguments that should always be passed to 'make'
4505 make_install_arg same as make_arg for 'make install'
4506 makepl_arg arguments passed to 'perl Makefile.PL'
4507 pager location of external program more (or any pager)
4508 scan_cache controls scanning of cache ('atstart' or 'never')
4509 tar location of external program tar
4510 unzip location of external program unzip
4511 urllist arrayref to nearby CPAN sites (or equivalent locations)
4512 wait_list arrayref to a wait server to try (See CPAN::WAIT)
4513 ftp_proxy, } the three usual variables for configuring
4514 http_proxy, } proxy requests. Both as CPAN::Config variables
4515 no_proxy } and as environment variables configurable.
4517 You can set and query each of these options interactively in the cpan
4518 shell with the command set defined within the C<o conf> command:
4522 =item o conf E<lt>scalar optionE<gt>
4524 prints the current value of the I<scalar option>
4526 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
4528 Sets the value of the I<scalar option> to I<value>
4530 =item o conf E<lt>list optionE<gt>
4532 prints the current value of the I<list option> in MakeMaker's
4535 =item o conf E<lt>list optionE<gt> [shift|pop]
4537 shifts or pops the array in the I<list option> variable
4539 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
4541 works like the corresponding perl commands.
4545 =head2 urllist parameter has CD-ROM support
4547 The C<urllist> parameter of the configuration table contains a list of
4548 URLs that are to be used for downloading. If the list contains any
4549 C<file> URLs, CPAN always tries to get files from there first. This
4550 feature is disabled for index files. So the recommendation for the
4551 owner of a CD-ROM with CPAN contents is: include your local, possibly
4552 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
4554 o conf urllist push file://localhost/CDROM/CPAN
4556 CPAN.pm will then fetch the index files from one of the CPAN sites
4557 that come at the beginning of urllist. It will later check for each
4558 module if there is a local copy of the most recent version.
4560 Another peculiarity of urllist is that the site that we could
4561 successfully fetch the last file from automatically gets a preference
4562 token and is tried as the first site for the next request. So if you
4563 add a new site at runtime it may happen that the previously preferred
4564 site will be tried another time. This means that if you want to disallow
4565 a site for the next transfer, it must be explicitly removed from
4570 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
4571 install foreign, unmasked, unsigned code on your machine. We compare
4572 to a checksum that comes from the net just as the distribution file
4573 itself. If somebody has managed to tamper with the distribution file,
4574 they may have as well tampered with the CHECKSUMS file. Future
4575 development will go towards strong authentification.
4579 Most functions in package CPAN are exported per default. The reason
4580 for this is that the primary use is intended for the cpan shell or for
4583 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
4585 To populate a freshly installed perl with my favorite modules is pretty
4586 easiest by maintaining a private bundle definition file. To get a useful
4587 blueprint of a bundle definition file, the command autobundle can be used
4588 on the CPAN shell command line. This command writes a bundle definition
4589 file for all modules that re installed for the currently running perl
4590 interpreter. It's recommended to run this command only once and from then
4591 on maintain the file manually under a private name, say
4592 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
4594 cpan> install Bundle::my_bundle
4596 then answer a few questions and then go out.
4598 Maintaining a bundle definition file means to keep track of two things:
4599 dependencies and interactivity. CPAN.pm (currently) does not take into
4600 account dependencies between distributions, so a bundle definition file
4601 should specify distributions that depend on others B<after> the others.
4602 On the other hand, it's a bit annoying that many distributions need some
4603 interactive configuring. So what I try to accomplish in my private bundle
4604 file is to have the packages that need to be configured early in the file
4605 and the gentle ones later, so I can go out after a few minutes and leave
4608 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
4610 Thanks to Graham Barr for contributing the firewall following howto.
4612 Firewalls can be categorized into three basic types.
4618 This is where the firewall machine runs a web server and to access the
4619 outside world you must do it via the web server. If you set environment
4620 variables like http_proxy or ftp_proxy to a values beginning with http://
4621 or in your web browser you have to set proxy information then you know
4622 you are running a http firewall.
4624 To access servers outside these types of firewalls with perl (even for
4625 ftp) you will need to use LWP.
4629 This where the firewall machine runs a ftp server. This kind of firewall will
4630 only let you access ftp serves outside the firewall. This is usually done by
4631 connecting to the firewall with ftp, then entering a username like
4632 "user@outside.host.com"
4634 To access servers outside these type of firewalls with perl you
4635 will need to use Net::FTP.
4637 =item One way visibility
4639 I say one way visibility as these firewalls try to make themselves look
4640 invisible to the users inside the firewall. An FTP data connection is
4641 normally created by sending the remote server your IP address and then
4642 listening for the connection. But the remote server will not be able to
4643 connect to you because of the firewall. So for these types of firewall
4644 FTP connections need to be done in a passive mode.
4646 There are two that I can think off.
4652 If you are using a SOCKS firewall you will need to compile perl and link
4653 it with the SOCKS library, this is what is normally called a ``socksified''
4654 perl. With this executable you will be able to connect to servers outside
4655 the firewall as if it is not there.
4659 This is the firewall implemented in the Linux kernel, it allows you to
4660 hide a complete network behind one IP address. With this firewall no
4661 special compiling is need as you can access hosts directly.
4669 We should give coverage for _all_ of the CPAN and not just the PAUSE
4670 part, right? In this discussion CPAN and PAUSE have become equal --
4671 but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus
4672 the clpa/, doc/, misc/, ports/, src/, scripts/.
4674 Future development should be directed towards a better integration of
4677 If a Makefile.PL requires special customization of libraries, prompts
4678 the user for special input, etc. then you may find CPAN is not able to
4679 build the distribution. In that case, you should attempt the
4680 traditional method of building a Perl module package from a shell.
4684 Andreas König E<lt>a.koenig@kulturbox.deE<gt>
4688 perl(1), CPAN::Nox(3)