2 use vars qw{$Try_autoload
4 $META $Signal $Cwd $End
5 $Suppress_readline %Dontload
11 # $Id: CPAN.pm,v 1.276 2000/01/08 15:29:46 k Exp $
13 # only used during development:
15 # $Revision = "[".substr(q$Revision: 1.276 $, 10)."]";
22 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
23 use File::Basename ();
29 use Text::ParseWords ();
33 END { $End++; &cleanup; }
54 $CPAN::Frontend ||= "CPAN::Shell";
55 $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
58 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
61 @CPAN::ISA = qw(CPAN::Debug Exporter);
64 autobundle bundle expand force get cvs_import
65 install make readme recompile shell test clean
68 #-> sub CPAN::AUTOLOAD ;
73 @EXPORT{@EXPORT} = '';
74 CPAN::Config->load unless $CPAN::Config_loaded++;
75 if (exists $EXPORT{$l}){
78 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
82 # $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD");
84 $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
93 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
94 CPAN::Config->load unless $CPAN::Config_loaded++;
96 my $prompt = "cpan> ";
98 unless ($Suppress_readline) {
99 require Term::ReadLine;
100 # import Term::ReadLine;
101 $term = Term::ReadLine->new('CPAN Monitor');
102 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
103 my $attribs = $term->Attribs;
104 # $attribs->{completion_entry_function} =
105 # $attribs->{'list_completion_function'};
106 $attribs->{attempted_completion_function} = sub {
107 &CPAN::Complete::gnu_cpl;
109 # $attribs->{completion_word} =
110 # [qw(help me somebody to find out how
111 # to use completion with GNU)];
113 $readline::rl_completion_function =
114 $readline::rl_completion_function = 'CPAN::Complete::cpl';
116 # $term->OUT is autoflushed anyway
117 my $odef = select STDERR;
127 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
128 my $cwd = CPAN->$getcwd();
129 my $try_detect_readline;
130 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
131 my $rl_avail = $Suppress_readline ? "suppressed" :
132 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
133 "available (try ``install Bundle::CPAN'')";
135 $CPAN::Frontend->myprint(
137 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision)
138 ReadLine support $rl_avail
140 }) unless $CPAN::Config->{'inhibit_startup_message'} ;
141 my($continuation) = "";
143 if ($Suppress_readline) {
145 last unless defined ($_ = <> );
148 last unless defined ($_ = $term->readline($prompt));
150 $_ = "$continuation$_" if $continuation;
153 $_ = 'h' if /^\s*\?/;
154 if (/^(?:q(?:uit)?|bye|exit)$/i) {
164 use vars qw($import_done);
165 CPAN->import(':DEFAULT') unless $import_done++;
166 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
173 if ($] < 5.00322) { # parsewords had a bug until recently
176 eval { @line = Text::ParseWords::shellwords($_) };
177 warn($@), next if $@;
179 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
180 my $command = shift @line;
181 eval { CPAN::Shell->$command(@line) };
184 $CPAN::Frontend->myprint("\n");
190 CPAN::Queue->nullify_queue;
191 if ($try_detect_readline) {
192 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
194 $CPAN::META->has_inst("Term::ReadLine::Perl")
196 delete $INC{"Term/ReadLine.pm"};
198 local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef);
199 require Term::ReadLine;
200 $CPAN::Frontend->myprint("\n$redef subroutines in ".
201 "Term::ReadLine redefined\n");
208 package CPAN::CacheMgr;
209 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
212 package CPAN::Config;
213 import ExtUtils::MakeMaker 'neatvalue';
214 use vars qw(%can $dot_cpan);
217 'commit' => "Commit changes to disk",
218 'defaults' => "Reload defaults from disk",
219 'init' => "Interactive setting of all options",
223 use vars qw($Ua $Thesite $Themethod);
224 @CPAN::FTP::ISA = qw(CPAN::Debug);
226 package CPAN::Complete;
227 @CPAN::Complete::ISA = qw(CPAN::Debug);
230 use vars qw($last_time $date_of_03);
231 @CPAN::Index::ISA = qw(CPAN::Debug);
235 package CPAN::InfoObj;
236 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
238 package CPAN::Author;
239 @CPAN::Author::ISA = qw(CPAN::InfoObj);
241 package CPAN::Distribution;
242 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
244 package CPAN::Bundle;
245 @CPAN::Bundle::ISA = qw(CPAN::Module);
247 package CPAN::Module;
248 @CPAN::Module::ISA = qw(CPAN::InfoObj);
251 use vars qw($AUTOLOAD $redef @ISA);
252 @CPAN::Shell::ISA = qw(CPAN::Debug);
254 #-> sub CPAN::Shell::AUTOLOAD ;
256 my($autoload) = $AUTOLOAD;
257 my $class = shift(@_);
258 # warn "autoload[$autoload] class[$class]";
259 $autoload =~ s/.*:://;
260 if ($autoload =~ /^w/) {
261 if ($CPAN::META->has_inst('CPAN::WAIT')) {
262 CPAN::WAIT->$autoload(@_);
264 $CPAN::Frontend->mywarn(qq{
265 Commands starting with "w" require CPAN::WAIT to be installed.
266 Please consider installing CPAN::WAIT to use the fulltext index.
267 For this you just need to type
272 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
276 # $CPAN::Frontend->mywarn("Could not autoload $autoload");
278 $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
284 #-> CPAN::Shell::try_dot_al
286 my($class,$autoload) = @_;
287 return unless $CPAN::Try_autoload;
288 # I don't see how to re-use that from the AutoLoader...
290 # Braces used to preserve $1 et al.
292 my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/;
294 if (defined($name=$INC{"$pkg.pm"}))
296 $name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
297 $name = undef unless (-r $name);
299 unless (defined $name)
301 $name = "auto/$autoload.al";
306 eval {local $SIG{__DIE__};require $name};
308 if (substr($autoload,-9) eq '::DESTROY') {
312 if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
313 eval {local $SIG{__DIE__};require $name};
328 # my $lm = Carp::longmess();
329 # warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
333 #### autoloader is experimental
334 #### to try it we have to set $Try_autoload and uncomment
335 #### the use statement and uncomment the __END__ below
336 #### You also need AutoSplit 1.01 available. MakeMaker will
337 #### then build CPAN with all the AutoLoad stuff.
341 if ($CPAN::Try_autoload) {
344 CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
345 CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
346 CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
348 *{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD;
352 package CPAN::Tarzip;
353 use vars qw($AUTOLOAD @ISA);
354 @CPAN::Tarzip::ISA = qw(CPAN::Debug);
358 # One use of the queue is to determine if we should or shouldn't
359 # announce the availability of a new CPAN module
361 # Now we try to use it for dependency tracking. For that to happen
362 # we need to draw a dependency tree and do the leaves first. This can
363 # easily be reached by running CPAN.pm recursively, but we don't want
364 # to waste memory and run into deep recursion. So what we can do is
367 # CPAN::Queue is the package where the queue is maintained. Dependencies
368 # often have high priority and must be brought to the head of the queue,
369 # possibly by jumping the queue if they are already there. My first code
370 # attempt tried to be extremely correct. Whenever a module needed
371 # immediate treatment, I either unshifted it to the front of the queue,
372 # or, if it was already in the queue, I spliced and let it bypass the
373 # others. This became a too correct model that made it impossible to put
374 # an item more than once into the queue. Why would you need that? Well,
375 # you need temporary duplicates as the manager of the queue is a loop
378 # (1) looks at the first item in the queue without shifting it off
380 # (2) cares for the item
382 # (3) removes the item from the queue, *even if its agenda failed and
383 # even if the item isn't the first in the queue anymore* (that way
384 # protecting against never ending queues)
386 # So if an item has prerequisites, the installation fails now, but we
387 # want to retry later. That's easy if we have it twice in the queue.
389 # I also expect insane dependency situations where an item gets more
390 # than two lives in the queue. Simplest example is triggered by 'install
391 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
392 # get in the way. I wanted the queue manager to be a dumb servant, not
393 # one that knows everything.
395 # Who would I tell in this model that the user wants to be asked before
396 # processing? I can't attach that information to the module object,
397 # because not modules are installed but distributions. So I'd have to
398 # tell the distribution object that it should ask the user before
399 # processing. Where would the question be triggered then? Most probably
400 # in CPAN::Distribution::rematein.
401 # Hope that makes sense, my head is a bit off:-) -- AK
406 my($class,$mod) = @_;
407 my $self = bless {mod => $mod}, $class;
409 # my @all = map { $_->{mod} } @All;
410 # warn "Adding Queue object for mod[$mod] all[@all]";
420 my($class,$what) = @_;
422 for my $i (0..$#All) {
423 if ( $All[$i]->{mod} eq $what ) {
434 WHAT: for my $what (reverse @what) {
436 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
437 if ($All[$i]->{mod} eq $what){
439 if ($jumped > 100) { # one's OK if e.g. just processing now;
440 # more are OK if user typed it several
442 $CPAN::Frontend->mywarn(
443 qq{Object [$what] queued more than 100 times, ignoring}
449 my $obj = bless { mod => $what }, $class;
455 my($self,$what) = @_;
456 my @all = map { $_->{mod} } @All;
457 my $exists = grep { $_->{mod} eq $what } @All;
458 # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]";
464 @All = grep { $_->{mod} ne $mod } @All;
465 # my @all = map { $_->{mod} } @All;
466 # warn "Deleting Queue object for mod[$mod] all[@all]";
477 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
481 # __END__ # uncomment this and AutoSplit version 1.01 will split it
483 #-> sub CPAN::autobundle ;
485 #-> sub CPAN::bundle ;
487 #-> sub CPAN::expand ;
489 #-> sub CPAN::force ;
491 #-> sub CPAN::install ;
495 #-> sub CPAN::clean ;
502 my($mgr,$class) = @_;
503 CPAN::Config->load unless $CPAN::Config_loaded++;
504 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
506 values %{ $META->{$class} };
508 *all = \&all_objects;
510 # Called by shell, not in batch mode. Not clean XXX
511 #-> sub CPAN::checklock ;
514 my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
515 if (-f $lockfile && -M _ > 0) {
516 my $fh = FileHandle->new($lockfile);
519 if (defined $other && $other) {
521 return if $$==$other; # should never happen
522 $CPAN::Frontend->mywarn(
524 There seems to be running another CPAN process ($other). Contacting...
526 if (kill 0, $other) {
527 $CPAN::Frontend->mydie(qq{Other job is running.
528 You may want to kill it and delete the lockfile, maybe. On UNIX try:
532 } elsif (-w $lockfile) {
534 ExtUtils::MakeMaker::prompt
535 (qq{Other job not responding. Shall I overwrite }.
536 qq{the lockfile? (Y/N)},"y");
537 $CPAN::Frontend->myexit("Ok, bye\n")
538 unless $ans =~ /^y/i;
541 qq{Lockfile $lockfile not writeable by you. }.
542 qq{Cannot proceed.\n}.
545 qq{ and then rerun us.\n}
550 my $dotcpan = $CPAN::Config->{cpan_home};
551 eval { File::Path::mkpath($dotcpan);};
553 # A special case at least for Jarkko.
558 $symlinkcpan = readlink $dotcpan;
559 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
560 eval { File::Path::mkpath($symlinkcpan); };
564 $CPAN::Frontend->mywarn(qq{
565 Working directory $symlinkcpan created.
569 unless (-d $dotcpan) {
571 Your configuration suggests "$dotcpan" as your
572 CPAN.pm working directory. I could not create this directory due
573 to this error: $firsterror\n};
575 As "$dotcpan" is a symlink to "$symlinkcpan",
576 I tried to create that, but I failed with this error: $seconderror
579 Please make sure the directory exists and is writable.
581 $CPAN::Frontend->mydie($diemess);
585 unless ($fh = FileHandle->new(">$lockfile")) {
586 if ($! =~ /Permission/) {
587 my $incc = $INC{'CPAN/Config.pm'};
588 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
589 $CPAN::Frontend->myprint(qq{
591 Your configuration suggests that CPAN.pm should use a working
593 $CPAN::Config->{cpan_home}
594 Unfortunately we could not create the lock file
596 due to permission problems.
598 Please make sure that the configuration variable
599 \$CPAN::Config->{cpan_home}
600 points to a directory where you can write a .lock file. You can set
601 this variable in either
608 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
610 $fh->print($$, "\n");
611 $self->{LOCK} = $lockfile;
615 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
620 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
621 print "Caught SIGINT\n";
625 # From: Larry Wall <larry@wall.org>
626 # Subject: Re: deprecating SIGDIE
627 # To: perl5-porters@perl.org
628 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
630 # The original intent of __DIE__ was only to allow you to substitute one
631 # kind of death for another on an application-wide basis without respect
632 # to whether you were in an eval or not. As a global backstop, it should
633 # not be used any more lightly (or any more heavily :-) than class
634 # UNIVERSAL. Any attempt to build a general exception model on it should
635 # be politely squashed. Any bug that causes every eval {} to have to be
636 # modified should be not so politely squashed.
638 # Those are my current opinions. It is also my optinion that polite
639 # arguments degenerate to personal arguments far too frequently, and that
640 # when they do, it's because both people wanted it to, or at least didn't
641 # sufficiently want it not to.
645 $SIG{'__DIE__'} = \&cleanup;
646 $self->debug("Signal handler set.") if $CPAN::DEBUG;
649 #-> sub CPAN::DESTROY ;
651 &cleanup; # need an eval?
655 sub cwd {Cwd::cwd();}
657 #-> sub CPAN::getcwd ;
658 sub getcwd {Cwd::getcwd();}
660 #-> sub CPAN::exists ;
662 my($mgr,$class,$id) = @_;
664 ### Carp::croak "exists called without class argument" unless $class;
666 exists $META->{$class}{$id};
669 #-> sub CPAN::delete ;
671 my($mgr,$class,$id) = @_;
672 delete $META->{$class}{$id};
675 #-> sub CPAN::has_inst
677 my($self,$mod,$message) = @_;
678 Carp::croak("CPAN->has_inst() called without an argument")
680 if (defined $message && $message eq "no") {
683 } elsif (exists $Dontload{$mod}) {
689 $file =~ s|/|\\|g if $^O eq 'MSWin32';
692 # checking %INC is wrong, because $INC{LWP} may be true
693 # although $INC{"URI/URL.pm"} may have failed. But as
694 # I really want to say "bla loaded OK", I have to somehow
696 ### warn "$file in %INC"; #debug
698 } elsif (eval { require $file }) {
699 # eval is good: if we haven't yet read the database it's
700 # perfect and if we have installed the module in the meantime,
701 # it tries again. The second require is only a NOOP returning
702 # 1 if we had success, otherwise it's retrying
704 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
705 if ($mod eq "CPAN::WAIT") {
706 push @CPAN::Shell::ISA, CPAN::WAIT;
709 } elsif ($mod eq "Net::FTP") {
711 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
713 install Bundle::libnet
717 } elsif ($mod eq "MD5"){
718 $CPAN::Frontend->myprint(qq{
719 CPAN: MD5 security checks disabled because MD5 not installed.
720 Please consider installing the MD5 module.
725 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
730 #-> sub CPAN::instance ;
732 my($mgr,$class,$id) = @_;
735 $META->{$class}{$id} ||= $class->new(ID => $id );
743 #-> sub CPAN::cleanup ;
745 # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
746 local $SIG{__DIE__} = '';
751 0 && # disabled, try reload cpan with it
752 $] > 5.004_60 # thereabouts
757 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
759 $subroutine eq '(eval)';
762 return if $ineval && !$End;
763 return unless defined $META->{'LOCK'};
764 return unless -f $META->{'LOCK'};
765 unlink $META->{'LOCK'};
767 # Carp::cluck("DEBUGGING");
768 $CPAN::Frontend->mywarn("Lockfile removed.\n");
771 package CPAN::CacheMgr;
773 #-> sub CPAN::CacheMgr::as_string ;
775 eval { require Data::Dumper };
777 return shift->SUPER::as_string;
779 return Data::Dumper::Dumper(shift);
783 #-> sub CPAN::CacheMgr::cachesize ;
790 return unless -d $self->{ID};
791 while ($self->{DU} > $self->{'MAX'} ) {
792 my($toremove) = shift @{$self->{FIFO}};
793 $CPAN::Frontend->myprint(sprintf(
794 "Deleting from cache".
795 ": $toremove (%.1f>%.1f MB)\n",
796 $self->{DU}, $self->{'MAX'})
798 return if $CPAN::Signal;
799 $self->force_clean_cache($toremove);
800 return if $CPAN::Signal;
804 #-> sub CPAN::CacheMgr::dir ;
809 #-> sub CPAN::CacheMgr::entries ;
812 return unless defined $dir;
813 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
814 $dir ||= $self->{ID};
816 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
817 my($cwd) = CPAN->$getcwd();
818 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
819 my $dh = DirHandle->new(File::Spec->curdir)
820 or Carp::croak("Couldn't opendir $dir: $!");
823 next if $_ eq "." || $_ eq "..";
825 push @entries, MM->catfile($dir,$_);
827 push @entries, MM->catdir($dir,$_);
829 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
832 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
833 sort { -M $b <=> -M $a} @entries;
836 #-> sub CPAN::CacheMgr::disk_usage ;
839 return if exists $self->{SIZE}{$dir};
840 return if $CPAN::Signal;
844 $File::Find::prune++ if $CPAN::Signal;
846 if ($^O eq 'MacOS') {
848 my $cat = Mac::Files::FSpGetCatInfo($_);
849 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
856 return if $CPAN::Signal;
857 $self->{SIZE}{$dir} = $Du/1024/1024;
858 push @{$self->{FIFO}}, $dir;
859 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
860 $self->{DU} += $Du/1024/1024;
864 #-> sub CPAN::CacheMgr::force_clean_cache ;
865 sub force_clean_cache {
867 return unless -e $dir;
868 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
870 File::Path::rmtree($dir);
871 $self->{DU} -= $self->{SIZE}{$dir};
872 delete $self->{SIZE}{$dir};
875 #-> sub CPAN::CacheMgr::new ;
882 ID => $CPAN::Config->{'build_dir'},
883 MAX => $CPAN::Config->{'build_cache'},
884 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
887 File::Path::mkpath($self->{ID});
888 my $dh = DirHandle->new($self->{ID});
892 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
894 CPAN->debug($debug) if $CPAN::DEBUG;
898 #-> sub CPAN::CacheMgr::scan_cache ;
901 return if $self->{SCAN} eq 'never';
902 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
903 unless $self->{SCAN} eq 'atstart';
904 $CPAN::Frontend->myprint(
905 sprintf("Scanning cache %s for sizes\n",
908 for $e ($self->entries($self->{ID})) {
909 next if $e eq ".." || $e eq ".";
910 $self->disk_usage($e);
911 return if $CPAN::Signal;
918 #-> sub CPAN::Debug::debug ;
921 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
922 # Complete, caller(1)
924 ($caller) = caller(0);
926 $arg = "" unless defined $arg;
927 my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
928 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
929 if ($arg and ref $arg) {
930 eval { require Data::Dumper };
932 $CPAN::Frontend->myprint($arg->as_string);
934 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
937 $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
942 package CPAN::Config;
944 #-> sub CPAN::Config::edit ;
946 my($class,@args) = @_;
948 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
949 my($o,$str,$func,$args,$key_exists);
955 if (ref($CPAN::Config->{$o}) eq ARRAY) {
958 # Let's avoid eval, it's easier to comprehend without.
959 if ($func eq "push") {
960 push @{$CPAN::Config->{$o}}, @args;
961 } elsif ($func eq "pop") {
962 pop @{$CPAN::Config->{$o}};
963 } elsif ($func eq "shift") {
964 shift @{$CPAN::Config->{$o}};
965 } elsif ($func eq "unshift") {
966 unshift @{$CPAN::Config->{$o}}, @args;
967 } elsif ($func eq "splice") {
968 splice @{$CPAN::Config->{$o}}, @args;
970 $CPAN::Config->{$o} = [@args];
972 $CPAN::Frontend->myprint(
975 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
980 $CPAN::Config->{$o} = $args[0] if defined $args[0];
981 $CPAN::Frontend->myprint(" $o " .
982 (defined $CPAN::Config->{$o} ?
983 $CPAN::Config->{$o} : "UNDEFINED"));
988 #-> sub CPAN::Config::commit ;
990 my($self,$configpm) = @_;
991 unless (defined $configpm){
992 $configpm ||= $INC{"CPAN/MyConfig.pm"};
993 $configpm ||= $INC{"CPAN/Config.pm"};
994 $configpm || Carp::confess(q{
995 CPAN::Config::commit called without an argument.
996 Please specify a filename where to save the configuration or try
997 "o conf init" to have an interactive course through configing.
1002 $mode = (stat $configpm)[2];
1003 if ($mode && ! -w _) {
1004 Carp::confess("$configpm is not writable");
1008 my $msg = <<EOF unless $configpm =~ /MyConfig/;
1010 # This is CPAN.pm's systemwide configuration file. This file provides
1011 # defaults for users, and the values can be changed in a per-user
1012 # configuration file. The user-config file is being looked for as
1013 # ~/.cpan/CPAN/MyConfig.pm.
1017 my($fh) = FileHandle->new;
1018 rename $configpm, "$configpm~" if -f $configpm;
1019 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
1020 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
1021 foreach (sort keys %$CPAN::Config) {
1024 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
1029 $fh->print("};\n1;\n__END__\n");
1032 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
1033 #chmod $mode, $configpm;
1034 ###why was that so? $self->defaults;
1035 $CPAN::Frontend->myprint("commit: wrote $configpm\n");
1039 *default = \&defaults;
1040 #-> sub CPAN::Config::defaults ;
1050 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
1059 #-> sub CPAN::Config::load ;
1064 eval {require CPAN::Config;}; # We eval because of some
1065 # MakeMaker problems
1066 unless ($dot_cpan++){
1067 unshift @INC, MM->catdir($ENV{HOME},".cpan");
1068 eval {require CPAN::MyConfig;}; # where you can override
1069 # system wide settings
1072 return unless @miss = $self->not_loaded;
1073 # XXX better check for arrayrefs too
1074 require CPAN::FirstTime;
1075 my($configpm,$fh,$redo,$theycalled);
1077 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
1078 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
1079 $configpm = $INC{"CPAN/Config.pm"};
1081 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
1082 $configpm = $INC{"CPAN/MyConfig.pm"};
1085 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
1086 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
1087 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
1088 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
1089 if (-w $configpmtest) {
1090 $configpm = $configpmtest;
1091 } elsif (-w $configpmdir) {
1092 #_#_# following code dumped core on me with 5.003_11, a.k.
1093 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
1094 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
1095 my $fh = FileHandle->new;
1096 if ($fh->open(">$configpmtest")) {
1098 $configpm = $configpmtest;
1100 # Should never happen
1101 Carp::confess("Cannot open >$configpmtest");
1105 unless ($configpm) {
1106 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
1107 File::Path::mkpath($configpmdir);
1108 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
1109 if (-w $configpmtest) {
1110 $configpm = $configpmtest;
1111 } elsif (-w $configpmdir) {
1112 #_#_# following code dumped core on me with 5.003_11, a.k.
1113 my $fh = FileHandle->new;
1114 if ($fh->open(">$configpmtest")) {
1116 $configpm = $configpmtest;
1118 # Should never happen
1119 Carp::confess("Cannot open >$configpmtest");
1122 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
1123 qq{create a configuration file.});
1128 $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
1129 We have to reconfigure CPAN.pm due to following uninitialized parameters:
1133 $CPAN::Frontend->myprint(qq{
1134 $configpm initialized.
1137 CPAN::FirstTime::init($configpm);
1140 #-> sub CPAN::Config::not_loaded ;
1144 cpan_home keep_source_where build_dir build_cache scan_cache
1145 index_expire gzip tar unzip make pager makepl_arg make_arg
1146 make_install_arg urllist inhibit_startup_message
1147 ftp_proxy http_proxy no_proxy prerequisites_policy
1149 push @miss, $_ unless defined $CPAN::Config->{$_};
1154 #-> sub CPAN::Config::unload ;
1156 delete $INC{'CPAN/MyConfig.pm'};
1157 delete $INC{'CPAN/Config.pm'};
1160 #-> sub CPAN::Config::help ;
1162 $CPAN::Frontend->myprint(q[
1164 defaults reload default config values from disk
1165 commit commit session changes to disk
1166 init go through a dialog to set all parameters
1168 You may edit key values in the follow fashion (the "o" is a literal
1171 o conf build_cache 15
1173 o conf build_dir "/foo/bar"
1175 o conf urllist shift
1177 o conf urllist unshift ftp://ftp.foo.bar/
1180 undef; #don't reprint CPAN::Config
1183 #-> sub CPAN::Config::cpl ;
1185 my($word,$line,$pos) = @_;
1187 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1188 my(@words) = split " ", substr($line,0,$pos+1);
1193 $words[2] =~ /list$/ && @words == 3
1195 $words[2] =~ /list$/ && @words == 4 && length($word)
1198 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
1199 } elsif (@words >= 4) {
1202 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
1203 return grep /^\Q$word\E/, @o_conf;
1206 package CPAN::Shell;
1208 #-> sub CPAN::Shell::h ;
1210 my($class,$about) = @_;
1211 if (defined $about) {
1212 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1214 $CPAN::Frontend->myprint(q{
1217 b string display bundles
1218 d or info distributions
1219 m /regex/ about modules
1220 i or anything of above
1221 r none reinstall recommendations
1222 u uninstalled distributions
1224 Download, Test, Make, Install...
1226 make make (implies get)
1227 test modules, make test (implies make)
1228 install dists, bundles make install (implies test)
1230 look open subshell in these dists' directories
1231 readme display these dists' README files
1234 h,? display this menu ! perl-code eval a perl command
1235 o conf [opt] set and query options q quit the cpan shell
1236 reload cpan load CPAN.pm again reload index load newer indices
1237 autobundle Snapshot force cmd unconditionally do cmd});
1243 #-> sub CPAN::Shell::a ;
1244 sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
1245 #-> sub CPAN::Shell::b ;
1247 my($self,@which) = @_;
1248 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1249 my($incdir,$bdir,$dh);
1250 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1251 $bdir = MM->catdir($incdir,"Bundle");
1252 if ($dh = DirHandle->new($bdir)) { # may fail
1254 for $entry ($dh->read) {
1255 next if -d MM->catdir($bdir,$entry);
1256 next unless $entry =~ s/\.pm$//;
1257 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
1261 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1263 #-> sub CPAN::Shell::d ;
1264 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1265 #-> sub CPAN::Shell::m ;
1266 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1267 $CPAN::Frontend->myprint(shift->format_result('Module',@_));
1270 #-> sub CPAN::Shell::i ;
1275 @type = qw/Author Bundle Distribution Module/;
1276 @args = '/./' unless @args;
1279 push @result, $self->expand($type,@args);
1281 my $result = @result == 1 ?
1282 $result[0]->as_string :
1283 join "", map {$_->as_glimpse} @result;
1284 $result ||= "No objects found of any type for argument @args\n";
1285 $CPAN::Frontend->myprint($result);
1288 #-> sub CPAN::Shell::o ;
1290 my($self,$o_type,@o_what) = @_;
1292 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1293 if ($o_type eq 'conf') {
1294 shift @o_what if @o_what && $o_what[0] eq 'help';
1297 $CPAN::Frontend->myprint("CPAN::Config options");
1298 if (exists $INC{'CPAN/Config.pm'}) {
1299 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1301 if (exists $INC{'CPAN/MyConfig.pm'}) {
1302 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1304 $CPAN::Frontend->myprint(":\n");
1305 for $k (sort keys %CPAN::Config::can) {
1306 $v = $CPAN::Config::can{$k};
1307 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1309 $CPAN::Frontend->myprint("\n");
1310 for $k (sort keys %$CPAN::Config) {
1311 $v = $CPAN::Config->{$k};
1313 $CPAN::Frontend->myprint(
1320 map {"\t$_\n"} @{$v}
1324 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1327 $CPAN::Frontend->myprint("\n");
1328 } elsif (!CPAN::Config->edit(@o_what)) {
1329 $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]);
1331 } elsif ($o_type eq 'debug') {
1333 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1336 my($what) = shift @o_what;
1337 if ( exists $CPAN::DEBUG{$what} ) {
1338 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1339 } elsif ($what =~ /^\d/) {
1340 $CPAN::DEBUG = $what;
1341 } elsif (lc $what eq 'all') {
1343 for (values %CPAN::DEBUG) {
1346 $CPAN::DEBUG = $max;
1349 for (keys %CPAN::DEBUG) {
1350 next unless lc($_) eq lc($what);
1351 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1354 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1359 my $raw = "Valid options for debug are ".
1360 join(", ",sort(keys %CPAN::DEBUG), 'all').
1361 qq{ or a number. Completion works on the options. }.
1362 qq{Case is ignored.};
1364 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1365 $CPAN::Frontend->myprint("\n\n");
1368 $CPAN::Frontend->myprint("Options set for debugging:\n");
1370 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1371 $v = $CPAN::DEBUG{$k};
1372 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
1375 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1378 $CPAN::Frontend->myprint(qq{
1380 conf set or get configuration variables
1381 debug set or get debugging options
1386 sub dotdot_onreload {
1389 if ( $_[0] =~ /Subroutine (\w+) redefined/ ) {
1393 # $CPAN::Frontend->myprint(".($subr)");
1394 $CPAN::Frontend->myprint(".");
1401 #-> sub CPAN::Shell::reload ;
1403 my($self,$command,@arg) = @_;
1405 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1406 if ($command =~ /cpan/i) {
1407 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
1408 my $fh = FileHandle->new($INC{'CPAN.pm'});
1411 local($SIG{__WARN__}) = dotdot_onreload(\$redef);
1414 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1415 } elsif ($command =~ /index/) {
1416 CPAN::Index->force_reload;
1418 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1419 index re-reads the index files\n});
1423 #-> sub CPAN::Shell::_binary_extensions ;
1424 sub _binary_extensions {
1425 my($self) = shift @_;
1426 my(@result,$module,%seen,%need,$headerdone);
1427 my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz$};
1428 for $module ($self->expand('Module','/./')) {
1429 my $file = $module->cpan_file;
1430 next if $file eq "N/A";
1431 next if $file =~ /^Contact Author/;
1432 next if $file =~ / $isaperl /xo;
1433 next unless $module->xs_file;
1435 $CPAN::Frontend->myprint(".");
1436 push @result, $module;
1438 # print join " | ", @result;
1439 $CPAN::Frontend->myprint("\n");
1443 #-> sub CPAN::Shell::recompile ;
1445 my($self) = shift @_;
1446 my($module,@module,$cpan_file,%dist);
1447 @module = $self->_binary_extensions();
1448 for $module (@module){ # we force now and compile later, so we
1450 $cpan_file = $module->cpan_file;
1451 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1453 $dist{$cpan_file}++;
1455 for $cpan_file (sort keys %dist) {
1456 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1457 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1459 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1460 # stop a package from recompiling,
1461 # e.g. IO-1.12 when we have perl5.003_10
1465 #-> sub CPAN::Shell::_u_r_common ;
1467 my($self) = shift @_;
1468 my($what) = shift @_;
1469 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1470 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1471 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1473 @args = '/./' unless @args;
1474 my(@result,$module,%seen,%need,$headerdone,
1475 $version_undefs,$version_zeroes);
1476 $version_undefs = $version_zeroes = 0;
1477 my $sprintf = "%-25s %9s %9s %s\n";
1478 for $module ($self->expand('Module',@args)) {
1479 my $file = $module->cpan_file;
1480 next unless defined $file; # ??
1481 my($latest) = $module->cpan_version;
1482 my($inst_file) = $module->inst_file;
1484 return if $CPAN::Signal;
1487 $have = $module->inst_version;
1488 } elsif ($what eq "r") {
1489 $have = $module->inst_version;
1491 if ($have eq "undef"){
1493 } elsif ($have == 0){
1496 next if $have >= $latest;
1497 # to be pedantic we should probably say:
1498 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1499 # to catch the case where CPAN has a version 0 and we have a version undef
1500 } elsif ($what eq "u") {
1506 } elsif ($what eq "r") {
1508 } elsif ($what eq "u") {
1512 return if $CPAN::Signal; # this is sometimes lengthy
1515 push @result, sprintf "%s %s\n", $module->id, $have;
1516 } elsif ($what eq "r") {
1517 push @result, $module->id;
1518 next if $seen{$file}++;
1519 } elsif ($what eq "u") {
1520 push @result, $module->id;
1521 next if $seen{$file}++;
1522 next if $file =~ /^Contact/;
1524 unless ($headerdone++){
1525 $CPAN::Frontend->myprint("\n");
1526 $CPAN::Frontend->myprint(sprintf(
1528 "Package namespace",
1534 $latest = substr($latest,0,8) if length($latest) > 8;
1535 $have = substr($have,0,8) if length($have) > 8;
1536 $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
1537 $need{$module->id}++;
1541 $CPAN::Frontend->myprint("No modules found for @args\n");
1542 } elsif ($what eq "r") {
1543 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1547 if ($version_zeroes) {
1548 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1549 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1550 qq{a version number of 0\n});
1552 if ($version_undefs) {
1553 my $s_has = $version_undefs > 1 ? "s have" : " has";
1554 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1555 qq{parseable version number\n});
1561 #-> sub CPAN::Shell::r ;
1563 shift->_u_r_common("r",@_);
1566 #-> sub CPAN::Shell::u ;
1568 shift->_u_r_common("u",@_);
1571 #-> sub CPAN::Shell::autobundle ;
1574 CPAN::Config->load unless $CPAN::Config_loaded++;
1575 my(@bundle) = $self->_u_r_common("a",@_);
1576 my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1577 File::Path::mkpath($todir);
1578 unless (-d $todir) {
1579 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1582 my($y,$m,$d) = (localtime)[5,4,3];
1586 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1587 my($to) = MM->catfile($todir,"$me.pm");
1589 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1590 $to = MM->catfile($todir,"$me.pm");
1592 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1594 "package Bundle::$me;\n\n",
1595 "\$VERSION = '0.01';\n\n",
1599 "Bundle::$me - Snapshot of installation on ",
1600 $Config::Config{'myhostname'},
1603 "\n\n=head1 SYNOPSIS\n\n",
1604 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1605 "=head1 CONTENTS\n\n",
1606 join("\n", @bundle),
1607 "\n\n=head1 CONFIGURATION\n\n",
1609 "\n\n=head1 AUTHOR\n\n",
1610 "This Bundle has been generated automatically ",
1611 "by the autobundle routine in CPAN.pm.\n",
1614 $CPAN::Frontend->myprint("\nWrote bundle file
1618 #-> sub CPAN::Shell::expand ;
1621 my($type,@args) = @_;
1625 if ($arg =~ m|^/(.*)/$|) {
1628 my $class = "CPAN::$type";
1630 if (defined $regex) {
1634 $CPAN::META->all_objects($class)
1637 # BUG, we got an empty object somewhere
1638 CPAN->debug(sprintf(
1639 "Empty id on obj[%s]%%[%s]",
1646 if $obj->id =~ /$regex/i
1650 $] < 5.00303 ### provide sort of
1651 ### compatibility with 5.003
1656 $obj->name =~ /$regex/i
1661 if ( $type eq 'Bundle' ) {
1662 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1664 if ($CPAN::META->exists($class,$xarg)) {
1665 $obj = $CPAN::META->instance($class,$xarg);
1666 } elsif ($CPAN::META->exists($class,$arg)) {
1667 $obj = $CPAN::META->instance($class,$arg);
1674 return wantarray ? @m : $m[0];
1677 #-> sub CPAN::Shell::format_result ;
1680 my($type,@args) = @_;
1681 @args = '/./' unless @args;
1682 my(@result) = $self->expand($type,@args);
1683 my $result = @result == 1 ?
1684 $result[0]->as_string :
1685 join "", map {$_->as_glimpse} @result;
1686 $result ||= "No objects of type $type found for argument @args\n";
1690 # The only reason for this method is currently to have a reliable
1691 # debugging utility that reveals which output is going through which
1692 # channel. No, I don't like the colors ;-)
1693 sub print_ornamented {
1694 my($self,$what,$ornament) = @_;
1696 my $ornamenting = 0; # turn the colors on
1699 unless (defined &color) {
1700 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1701 import Term::ANSIColor "color";
1703 *color = sub { return "" };
1707 for $line (split /\n/, $what) {
1708 $longest = length($line) if length($line) > $longest;
1710 my $sprintf = "%-" . $longest . "s";
1712 $what =~ s/(.*\n?)//m;
1715 my($nl) = chomp $line ? "\n" : "";
1716 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
1717 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
1725 my($self,$what) = @_;
1726 $self->print_ornamented($what, 'bold blue on_yellow');
1730 my($self,$what) = @_;
1731 $self->myprint($what);
1736 my($self,$what) = @_;
1737 $self->print_ornamented($what, 'bold red on_yellow');
1741 my($self,$what) = @_;
1742 $self->print_ornamented($what, 'bold red on_white');
1743 Carp::confess "died";
1747 my($self,$what) = @_;
1748 $self->print_ornamented($what, 'bold red on_white');
1753 return if -t STDOUT;
1754 my $odef = select STDERR;
1761 #-> sub CPAN::Shell::rematein ;
1762 # RE-adme||MA-ke||TE-st||IN-stall
1765 my($meth,@some) = @_;
1767 if ($meth eq 'force') {
1769 $meth = shift @some;
1772 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1774 foreach $s (@some) {
1775 CPAN::Queue->new($s);
1777 while ($s = CPAN::Queue->first) {
1781 } elsif ($s =~ m|/|) { # looks like a file
1782 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1783 } elsif ($s =~ m|^Bundle::|) {
1784 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1786 $obj = $CPAN::META->instance('CPAN::Module',$s)
1787 if $CPAN::META->exists('CPAN::Module',$s);
1791 qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
1799 ($] < 5.00303 || $obj->can($pragma)); ###
1803 if ($]>=5.00303 && $obj->can('called_for')) {
1804 $obj->called_for($s);
1806 CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
1809 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1810 $obj = $CPAN::META->instance('CPAN::Author',$s);
1811 $CPAN::Frontend->myprint(
1813 "Don't be silly, you can't $meth ",
1819 ->myprint(qq{Warning: Cannot $meth $s, }.
1820 qq{don\'t know what it is.
1825 to find objects with similar identifiers.
1828 CPAN::Queue->delete_first($s);
1832 #-> sub CPAN::Shell::force ;
1833 sub force { shift->rematein('force',@_); }
1834 #-> sub CPAN::Shell::get ;
1835 sub get { shift->rematein('get',@_); }
1836 #-> sub CPAN::Shell::readme ;
1837 sub readme { shift->rematein('readme',@_); }
1838 #-> sub CPAN::Shell::make ;
1839 sub make { shift->rematein('make',@_); }
1840 #-> sub CPAN::Shell::test ;
1841 sub test { shift->rematein('test',@_); }
1842 #-> sub CPAN::Shell::install ;
1843 sub install { shift->rematein('install',@_); }
1844 #-> sub CPAN::Shell::clean ;
1845 sub clean { shift->rematein('clean',@_); }
1846 #-> sub CPAN::Shell::look ;
1847 sub look { shift->rematein('look',@_); }
1848 #-> sub CPAN::Shell::cvs_import ;
1849 sub cvs_import { shift->rematein('cvs_import',@_); }
1853 #-> sub CPAN::FTP::ftp_get ;
1855 my($class,$host,$dir,$file,$target) = @_;
1857 qq[Going to fetch file [$file] from dir [$dir]
1858 on host [$host] as local [$target]\n]
1860 my $ftp = Net::FTP->new($host);
1861 return 0 unless defined $ftp;
1862 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1863 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1864 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1865 warn "Couldn't login on $host";
1868 unless ( $ftp->cwd($dir) ){
1869 warn "Couldn't cwd $dir";
1873 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1874 unless ( $ftp->get($file,$target) ){
1875 warn "Couldn't fetch $file from $host\n";
1878 $ftp->quit; # it's ok if this fails
1882 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
1884 # leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
1885 # leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997
1886 # leach,> ***************
1887 # leach,> *** 1562,1567 ****
1888 # leach,> --- 1562,1580 ----
1889 # leach,> return 1 if substr($url,0,4) eq "file";
1890 # leach,> return 1 unless $url =~ m|://([^/]+)|;
1891 # leach,> my $host = $1;
1892 # leach,> + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1893 # leach,> + if ($proxy) {
1894 # leach,> + $proxy =~ m|://([^/:]+)|;
1895 # leach,> + $proxy = $1;
1896 # leach,> + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1897 # leach,> + if ($noproxy) {
1898 # leach,> + if ($host !~ /$noproxy$/) {
1899 # leach,> + $host = $proxy;
1901 # leach,> + } else {
1902 # leach,> + $host = $proxy;
1905 # leach,> require Net::Ping;
1906 # leach,> return 1 unless $Net::Ping::VERSION >= 2;
1910 # this is quite optimistic and returns one on several occasions where
1911 # inappropriate. But this does no harm. It would do harm if we were
1912 # too pessimistic (as I was before the http_proxy
1914 my($self,$url) = @_;
1915 return 1; # we can't simply roll our own, firewalls may break ping
1916 return 0 unless $url;
1917 return 1 if substr($url,0,4) eq "file";
1918 return 1 unless $url =~ m|^(\w+)://([^/]+)|;
1919 my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy
1921 return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype};
1923 return 1 unless $Net::Ping::VERSION >= 2;
1925 # 1.3101 had it different: only if the first eval raised an
1926 # exception we tried it with TCP. Now we are happy if icmp wins
1927 # the order and return, we don't even check for $@. Thanks to
1928 # thayer@uis.edu for the suggestion.
1929 eval {$p = Net::Ping->new("icmp");};
1930 return 1 if $p && ref($p) && $p->ping($host, 10);
1931 eval {$p = Net::Ping->new("tcp");};
1932 $CPAN::Frontend->mydie($@) if $@;
1933 return $p->ping($host, 10);
1936 #-> sub CPAN::FTP::localize ;
1937 # sorry for the ugly code here, I'll clean it up as soon as Net::FTP
1940 my($self,$file,$aslocal,$force) = @_;
1942 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1943 unless defined $aslocal;
1944 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
1947 if ($^O eq 'MacOS') {
1948 my($name, $path) = File::Basename::fileparse($aslocal, '');
1949 if (length($name) > 31) {
1950 $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//;
1952 my $size = 31 - length($suf);
1953 while (length($name) > $size) {
1957 $aslocal = File::Spec->catfile($path, $name);
1961 return $aslocal if -f $aslocal && -r _ && !($force & 1);
1964 rename $aslocal, "$aslocal.bak";
1968 my($aslocal_dir) = File::Basename::dirname($aslocal);
1969 File::Path::mkpath($aslocal_dir);
1970 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
1971 qq{directory "$aslocal_dir".
1972 I\'ll continue, but if you encounter problems, they may be due
1973 to insufficient permissions.\n}) unless -w $aslocal_dir;
1975 # Inheritance is not easier to manage than a few if/else branches
1976 if ($CPAN::META->has_inst('LWP::UserAgent')) {
1977 require LWP::UserAgent;
1979 $Ua = LWP::UserAgent->new;
1981 $Ua->proxy('ftp', $var)
1982 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1983 $Ua->proxy('http', $var)
1984 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1986 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1990 # Try the list of urls for each single object. We keep a record
1991 # where we did get a file from
1992 my(@reordered,$last);
1993 $CPAN::Config->{urllist} ||= [];
1994 $last = $#{$CPAN::Config->{urllist}};
1995 if ($force & 2) { # local cpans probably out of date, don't reorder
1996 @reordered = (0..$last);
2000 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2002 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2013 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2015 @levels = qw/easy hard hardest/;
2017 @levels = qw/easy/ if $^O eq 'MacOS';
2018 for $level (@levels) {
2019 my $method = "host$level";
2020 my @host_seq = $level eq "easy" ?
2021 @reordered : 0..$last; # reordered has CDROM up front
2022 @host_seq = (0) unless @host_seq;
2023 my $ret = $self->$method(\@host_seq,$file,$aslocal);
2025 $Themethod = $level;
2027 # utime $now, $now, $aslocal; # too bad, if we do that, we
2028 # might alter a local mirror
2029 $self->debug("level[$level]") if $CPAN::DEBUG;
2037 qq{Please check, if the URLs I found in your configuration file \(}.
2038 join(", ", @{$CPAN::Config->{urllist}}).
2039 qq{\) are valid. The urllist can be edited.},
2040 qq{E.g. with ``o conf urllist push ftp://myurl/''};
2041 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2043 $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
2045 rename "$aslocal.bak", $aslocal;
2046 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2047 $self->ls($aslocal));
2054 my($self,$host_seq,$file,$aslocal) = @_;
2056 HOSTEASY: for $i (@$host_seq) {
2057 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2058 unless ($self->is_reachable($url)) {
2059 $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
2063 $url .= "/" unless substr($url,-1) eq "/";
2065 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2066 if ($url =~ /^file:/) {
2068 if ($CPAN::META->has_inst('LWP')) {
2070 my $u = URI::URL->new($url);
2072 } else { # works only on Unix, is poorly constructed, but
2073 # hopefully better than nothing.
2074 # RFC 1738 says fileurl BNF is
2075 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2076 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2078 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2079 $l =~ s|^file:||; # assume they
2082 $l =~ s|^/|| unless -f $l; # e.g. /P:
2084 if ( -f $l && -r _) {
2088 # Maybe mirror has compressed it?
2090 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2091 CPAN::Tarzip->gunzip("$l.gz", $aslocal);
2098 if ($CPAN::META->has_inst('LWP')) {
2099 $CPAN::Frontend->myprint("Fetching with LWP:
2103 require LWP::UserAgent;
2104 $Ua = LWP::UserAgent->new;
2106 my $res = $Ua->mirror($url, $aslocal);
2107 if ($res->is_success) {
2110 utime $now, $now, $aslocal; # download time is more
2111 # important than upload time
2113 } elsif ($url !~ /\.gz$/) {
2114 my $gzurl = "$url.gz";
2115 $CPAN::Frontend->myprint("Fetching with LWP:
2118 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2119 if ($res->is_success &&
2120 CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
2128 # Alan Burlison informed me that in firewall envs Net::FTP
2129 # can still succeed where LWP fails. So we do not skip
2130 # Net::FTP anymore when LWP is available.
2134 $self->debug("LWP not installed") if $CPAN::DEBUG;
2136 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2137 # that's the nice and easy way thanks to Graham
2138 my($host,$dir,$getfile) = ($1,$2,$3);
2139 if ($CPAN::META->has_inst('Net::FTP')) {
2141 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2144 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2145 "aslocal[$aslocal]") if $CPAN::DEBUG;
2146 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2150 if ($aslocal !~ /\.gz$/) {
2151 my $gz = "$aslocal.gz";
2152 $CPAN::Frontend->myprint("Fetching with Net::FTP
2155 if (CPAN::FTP->ftp_get($host,
2159 CPAN::Tarzip->gunzip($gz,$aslocal)
2172 my($self,$host_seq,$file,$aslocal) = @_;
2174 # Came back if Net::FTP couldn't establish connection (or
2175 # failed otherwise) Maybe they are behind a firewall, but they
2176 # gave us a socksified (or other) ftp program...
2179 my($devnull) = $CPAN::Config->{devnull} || "";
2181 my($aslocal_dir) = File::Basename::dirname($aslocal);
2182 File::Path::mkpath($aslocal_dir);
2183 HOSTHARD: for $i (@$host_seq) {
2184 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2185 unless ($self->is_reachable($url)) {
2186 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2189 $url .= "/" unless substr($url,-1) eq "/";
2191 my($proto,$host,$dir,$getfile);
2193 # Courtesy Mark Conty mark_conty@cargill.com change from
2194 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2196 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2197 # proto not yet used
2198 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2200 next HOSTHARD; # who said, we could ftp anything except ftp?
2203 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2205 for $f ('lynx','ncftpget','ncftp') {
2206 next unless exists $CPAN::Config->{$f};
2207 $funkyftp = $CPAN::Config->{$f};
2208 next unless defined $funkyftp;
2209 next if $funkyftp =~ /^\s*$/;
2210 my($want_compressed);
2211 my $aslocal_uncompressed;
2212 ($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
2213 my($source_switch) = "";
2215 $source_switch = " -source";
2216 } elsif ($f eq "ncftp"){
2217 $source_switch = " -c";
2220 my($stdout_redir) = " > $aslocal_uncompressed";
2221 if ($f eq "ncftpget"){
2222 $chdir = "cd $aslocal_dir && ";
2225 $CPAN::Frontend->myprint(
2227 Trying with "$funkyftp$source_switch" to get
2231 "$chdir$funkyftp$source_switch '$url' $devnull$stdout_redir";
2232 $self->debug("system[$system]") if $CPAN::DEBUG;
2234 if (($wstatus = system($system)) == 0
2237 -s $aslocal_uncompressed # lynx returns 0 on my
2238 # system even if it fails
2244 } elsif ($aslocal_uncompressed ne $aslocal) {
2245 # test gzip integrity
2247 CPAN::Tarzip->gtest($aslocal_uncompressed)
2249 rename $aslocal_uncompressed, $aslocal;
2251 CPAN::Tarzip->gzip($aslocal_uncompressed,
2252 "$aslocal_uncompressed.gz");
2257 } elsif ($url !~ /\.gz$/) {
2258 unlink $aslocal_uncompressed if
2259 -f $aslocal_uncompressed && -s _ == 0;
2260 my $gz = "$aslocal.gz";
2261 my $gzurl = "$url.gz";
2262 $CPAN::Frontend->myprint(
2264 Trying with "$funkyftp$source_switch" to get
2267 my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ".
2268 "$aslocal_uncompressed.gz";
2269 $self->debug("system[$system]") if $CPAN::DEBUG;
2271 if (($wstatus = system($system)) == 0
2273 -s "$aslocal_uncompressed.gz"
2275 # test gzip integrity
2276 if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
2277 CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
2280 rename $aslocal_uncompressed, $aslocal;
2285 unlink "$aslocal_uncompressed.gz" if
2286 -f "$aslocal_uncompressed.gz";
2289 my $estatus = $wstatus >> 8;
2290 my $size = -f $aslocal ?
2291 ", left\n$aslocal with size ".-s _ :
2292 "\nWarning: expected file [$aslocal] doesn't exist";
2293 $CPAN::Frontend->myprint(qq{
2294 System call "$system"
2295 returned status $estatus (wstat $wstatus)$size
2303 my($self,$host_seq,$file,$aslocal) = @_;
2306 my($aslocal_dir) = File::Basename::dirname($aslocal);
2307 File::Path::mkpath($aslocal_dir);
2308 HOSTHARDEST: for $i (@$host_seq) {
2309 unless (length $CPAN::Config->{'ftp'}) {
2310 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2313 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2314 unless ($self->is_reachable($url)) {
2315 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2318 $url .= "/" unless substr($url,-1) eq "/";
2320 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2321 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2324 my($host,$dir,$getfile) = ($1,$2,$3);
2326 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2327 $ctime,$blksize,$blocks) = stat($aslocal);
2328 $timestamp = $mtime ||= 0;
2329 my($netrc) = CPAN::FTP::netrc->new;
2330 my($netrcfile) = $netrc->netrc;
2331 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2332 my $targetfile = File::Basename::basename($aslocal);
2338 map("cd $_", split "/", $dir), # RFC 1738
2340 "get $getfile $targetfile",
2344 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2345 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2346 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2348 $netrc->contains($host))) if $CPAN::DEBUG;
2349 if ($netrc->protected) {
2350 $CPAN::Frontend->myprint(qq{
2351 Trying with external ftp to get
2353 As this requires some features that are not thoroughly tested, we\'re
2354 not sure, that we get it right....
2358 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
2360 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2361 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2363 if ($mtime > $timestamp) {
2364 $CPAN::Frontend->myprint("GOT $aslocal\n");
2368 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2371 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2372 qq{correctly protected.\n});
2375 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2376 nor does it have a default entry\n");
2379 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2380 # then and login manually to host, using e-mail as
2382 $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
2386 "user anonymous $Config::Config{'cf_email'}"
2388 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
2389 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2390 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2392 if ($mtime > $timestamp) {
2393 $CPAN::Frontend->myprint("GOT $aslocal\n");
2397 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2399 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2405 my($self,$command,@dialog) = @_;
2406 my $fh = FileHandle->new;
2407 $fh->open("|$command") or die "Couldn't open ftp: $!";
2408 foreach (@dialog) { $fh->print("$_\n") }
2409 $fh->close; # Wait for process to complete
2411 my $estatus = $wstatus >> 8;
2412 $CPAN::Frontend->myprint(qq{
2413 Subprocess "|$command"
2414 returned status $estatus (wstat $wstatus)
2418 # find2perl needs modularization, too, all the following is stolen
2422 my($self,$name) = @_;
2423 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2424 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2426 my($perms,%user,%group);
2430 $blocks = int(($blocks + 1) / 2);
2433 $blocks = int(($sizemm + 1023) / 1024);
2436 if (-f _) { $perms = '-'; }
2437 elsif (-d _) { $perms = 'd'; }
2438 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2439 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2440 elsif (-p _) { $perms = 'p'; }
2441 elsif (-S _) { $perms = 's'; }
2442 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2444 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2445 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2446 my $tmpmode = $mode;
2447 my $tmp = $rwx[$tmpmode & 7];
2449 $tmp = $rwx[$tmpmode & 7] . $tmp;
2451 $tmp = $rwx[$tmpmode & 7] . $tmp;
2452 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
2453 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
2454 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
2457 my $user = $user{$uid} || $uid; # too lazy to implement lookup
2458 my $group = $group{$gid} || $gid;
2460 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
2462 my($moname) = $moname[$mon];
2463 if (-M _ > 365.25 / 2) {
2464 $timeyear = $year + 1900;
2467 $timeyear = sprintf("%02d:%02d", $hour, $min);
2470 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
2484 package CPAN::FTP::netrc;
2488 my $file = MM->catfile($ENV{HOME},".netrc");
2490 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2491 $atime,$mtime,$ctime,$blksize,$blocks)
2496 my($fh,@machines,$hasdefault);
2498 $fh = FileHandle->new or die "Could not create a filehandle";
2500 if($fh->open($file)){
2501 $protected = ($mode & 077) == 0;
2503 NETRC: while (<$fh>) {
2504 my(@tokens) = split " ", $_;
2505 TOKEN: while (@tokens) {
2506 my($t) = shift @tokens;
2507 if ($t eq "default"){
2511 last TOKEN if $t eq "macdef";
2512 if ($t eq "machine") {
2513 push @machines, shift @tokens;
2518 $file = $hasdefault = $protected = "";
2522 'mach' => [@machines],
2524 'hasdefault' => $hasdefault,
2525 'protected' => $protected,
2529 sub hasdefault { shift->{'hasdefault'} }
2530 sub netrc { shift->{'netrc'} }
2531 sub protected { shift->{'protected'} }
2533 my($self,$mach) = @_;
2534 for ( @{$self->{'mach'}} ) {
2535 return 1 if $_ eq $mach;
2540 package CPAN::Complete;
2543 my($text, $line, $start, $end) = @_;
2544 my(@perlret) = cpl($text, $line, $start);
2545 # find longest common match. Can anybody show me how to peruse
2546 # T::R::Gnu to have this done automatically? Seems expensive.
2547 return () unless @perlret;
2548 my($newtext) = $text;
2549 for (my $i = length($text)+1;;$i++) {
2550 last unless length($perlret[0]) && length($perlret[0]) >= $i;
2551 my $try = substr($perlret[0],0,$i);
2552 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
2553 # warn "try[$try]tries[@tries]";
2554 if (@tries == @perlret) {
2560 ($newtext,@perlret);
2563 #-> sub CPAN::Complete::cpl ;
2565 my($word,$line,$pos) = @_;
2569 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2571 if ($line =~ s/^(force\s*)//) {
2579 ! a b d h i m o q r u autobundle clean
2580 make test install force reload look cvs_import
2583 } elsif ( $line !~ /^[\!abcdhimorutl]/ ) {
2585 } elsif ($line =~ /^a\s/) {
2586 @return = cplx('CPAN::Author',$word);
2587 } elsif ($line =~ /^b\s/) {
2588 @return = cplx('CPAN::Bundle',$word);
2589 } elsif ($line =~ /^d\s/) {
2590 @return = cplx('CPAN::Distribution',$word);
2591 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look|cvs_import)\s/ ) {
2592 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
2593 } elsif ($line =~ /^i\s/) {
2594 @return = cpl_any($word);
2595 } elsif ($line =~ /^reload\s/) {
2596 @return = cpl_reload($word,$line,$pos);
2597 } elsif ($line =~ /^o\s/) {
2598 @return = cpl_option($word,$line,$pos);
2605 #-> sub CPAN::Complete::cplx ;
2607 my($class, $word) = @_;
2608 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
2611 #-> sub CPAN::Complete::cpl_any ;
2615 cplx('CPAN::Author',$word),
2616 cplx('CPAN::Bundle',$word),
2617 cplx('CPAN::Distribution',$word),
2618 cplx('CPAN::Module',$word),
2622 #-> sub CPAN::Complete::cpl_reload ;
2624 my($word,$line,$pos) = @_;
2626 my(@words) = split " ", $line;
2627 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2628 my(@ok) = qw(cpan index);
2629 return @ok if @words == 1;
2630 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
2633 #-> sub CPAN::Complete::cpl_option ;
2635 my($word,$line,$pos) = @_;
2637 my(@words) = split " ", $line;
2638 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2639 my(@ok) = qw(conf debug);
2640 return @ok if @words == 1;
2641 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
2643 } elsif ($words[1] eq 'index') {
2645 } elsif ($words[1] eq 'conf') {
2646 return CPAN::Config::cpl(@_);
2647 } elsif ($words[1] eq 'debug') {
2648 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
2652 package CPAN::Index;
2654 #-> sub CPAN::Index::force_reload ;
2657 $CPAN::Index::last_time = 0;
2661 #-> sub CPAN::Index::reload ;
2663 my($cl,$force) = @_;
2666 # XXX check if a newer one is available. (We currently read it
2667 # from time to time)
2668 for ($CPAN::Config->{index_expire}) {
2669 $_ = 0.001 unless $_ && $_ > 0.001;
2671 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
2673 ## IFF we are developing, it helps to wipe out the memory between
2674 ## reloads, otherwise it is not what a user expects.
2676 ## undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
2677 ## $CPAN::META = CPAN->new;
2681 my $needshort = $^O eq "dos";
2683 $cl->rd_authindex($cl
2685 "authors/01mailrc.txt.gz",
2687 File::Spec->catfile('authors', '01mailrc.gz') :
2688 File::Spec->catfile('authors', '01mailrc.txt.gz'),
2691 $debug = "timing reading 01[".($t2 - $time)."]";
2693 return if $CPAN::Signal; # this is sometimes lengthy
2694 $cl->rd_modpacks($cl
2696 "modules/02packages.details.txt.gz",
2698 File::Spec->catfile('modules', '02packag.gz') :
2699 File::Spec->catfile('modules', '02packages.details.txt.gz'),
2702 $debug .= "02[".($t2 - $time)."]";
2704 return if $CPAN::Signal; # this is sometimes lengthy
2707 "modules/03modlist.data.gz",
2709 File::Spec->catfile('modules', '03mlist.gz') :
2710 File::Spec->catfile('modules', '03modlist.data.gz'),
2713 $debug .= "03[".($t2 - $time)."]";
2715 CPAN->debug($debug) if $CPAN::DEBUG;
2718 #-> sub CPAN::Index::reload_x ;
2720 my($cl,$wanted,$localname,$force) = @_;
2721 $force |= 2; # means we're dealing with an index here
2722 CPAN::Config->load; # we should guarantee loading wherever we rely
2724 $localname ||= $wanted;
2725 my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
2729 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
2732 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
2733 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
2734 qq{day$s. I\'ll use that.});
2737 $force |= 1; # means we're quite serious about it.
2739 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
2742 #-> sub CPAN::Index::rd_authindex ;
2744 my($cl, $index_target) = @_;
2746 return unless defined $index_target;
2747 $CPAN::Frontend->myprint("Going to read $index_target\n");
2748 # my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2749 # while ($_ = $fh->READLINE) {
2752 tie *FH, CPAN::Tarzip, $index_target;
2754 push @lines, split /\012/ while <FH>;
2756 my($userid,$fullname,$email) =
2757 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
2758 next unless $userid && $fullname && $email;
2760 # instantiate an author object
2761 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
2762 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
2763 return if $CPAN::Signal;
2768 my($self,$dist) = @_;
2769 $dist = $self->{'id'} unless defined $dist;
2770 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
2774 #-> sub CPAN::Index::rd_modpacks ;
2776 my($cl, $index_target) = @_;
2778 return unless defined $index_target;
2779 $CPAN::Frontend->myprint("Going to read $index_target\n");
2780 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2782 while ($_ = $fh->READLINE) {
2784 my @ls = map {"$_\n"} split /\n/, $_;
2785 unshift @ls, "\n" x length($1) if /^(\n+)/;
2789 my $shift = shift(@lines);
2790 last if $shift =~ /^\s*$/;
2794 my($mod,$version,$dist) = split;
2795 ### $version =~ s/^\+//;
2797 # if it is a bundle, instantiate a bundle object
2798 my($bundle,$id,$userid);
2800 if ($mod eq 'CPAN' &&
2802 CPAN::Queue->exists('Bundle::CPAN') ||
2803 CPAN::Queue->exists('CPAN')
2807 if ($version > $CPAN::VERSION){
2808 $CPAN::Frontend->myprint(qq{
2809 There\'s a new CPAN.pm version (v$version) available!
2810 [Current version is v$CPAN::VERSION]
2811 You might want to try
2812 install Bundle::CPAN
2814 without quitting the current session. It should be a seamless upgrade
2815 while we are running...
2818 $CPAN::Frontend->myprint(qq{\n});
2820 last if $CPAN::Signal;
2821 } elsif ($mod =~ /^Bundle::(.*)/) {
2826 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
2827 # warn "made mod[$mod]a bundle";
2828 # Let's make it a module too, because bundles have so much
2829 # in common with modules
2830 $CPAN::META->instance('CPAN::Module',$mod);
2831 # warn "made mod[$mod]a module";
2833 # This "next" makes us faster but if the job is running long, we ignore
2834 # rereads which is bad. So we have to be a bit slower again.
2835 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
2840 # instantiate a module object
2841 $id = $CPAN::META->instance('CPAN::Module',$mod);
2844 if ($id->cpan_file ne $dist){
2845 $userid = $cl->userid($dist);
2847 'CPAN_USERID' => $userid,
2848 'CPAN_VERSION' => $version,
2849 'CPAN_FILE' => $dist
2853 # instantiate a distribution object
2854 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
2855 # we do not need CONTAINSMODS unless we do something with
2856 # this dist, so we better produce it on demand.
2858 ## my $obj = $CPAN::META->instance(
2859 ## 'CPAN::Distribution' => $dist
2861 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
2863 $CPAN::META->instance(
2864 'CPAN::Distribution' => $dist
2866 'CPAN_USERID' => $userid
2870 return if $CPAN::Signal;
2875 #-> sub CPAN::Index::rd_modlist ;
2877 my($cl,$index_target) = @_;
2878 return unless defined $index_target;
2879 $CPAN::Frontend->myprint("Going to read $index_target\n");
2880 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2883 while ($_ = $fh->READLINE) {
2885 my @ls = map {"$_\n"} split /\n/, $_;
2886 unshift @ls, "\n" x length($1) if /^(\n+)/;
2890 my $shift = shift(@eval);
2891 if ($shift =~ /^Date:\s+(.*)/){
2892 return if $date_of_03 eq $1;
2895 last if $shift =~ /^\s*$/;
2898 push @eval, q{CPAN::Modulelist->data;};
2900 my($comp) = Safe->new("CPAN::Safe1");
2901 my($eval) = join("", @eval);
2902 my $ret = $comp->reval($eval);
2903 Carp::confess($@) if $@;
2904 return if $CPAN::Signal;
2906 my $obj = $CPAN::META->instance(CPAN::Module,$_);
2907 $obj->set(%{$ret->{$_}});
2908 return if $CPAN::Signal;
2912 package CPAN::InfoObj;
2914 #-> sub CPAN::InfoObj::new ;
2915 sub new { my $this = bless {}, shift; %$this = @_; $this }
2917 #-> sub CPAN::InfoObj::set ;
2919 my($self,%att) = @_;
2920 my(%oldatt) = %$self;
2921 %$self = (%oldatt, %att);
2924 #-> sub CPAN::InfoObj::id ;
2925 sub id { shift->{'ID'} }
2927 #-> sub CPAN::InfoObj::as_glimpse ;
2931 my $class = ref($self);
2932 $class =~ s/^CPAN:://;
2933 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2937 #-> sub CPAN::InfoObj::as_string ;
2941 my $class = ref($self);
2942 $class =~ s/^CPAN:://;
2943 push @m, $class, " id = $self->{ID}\n";
2944 for (sort keys %$self) {
2947 if ($_ eq "CPAN_USERID") {
2948 $extra .= " (".$self->author;
2949 my $email; # old perls!
2950 if ($email = $CPAN::META->instance(CPAN::Author,
2953 $extra .= " <$email>";
2955 $extra .= " <no email>";
2959 if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX
2960 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2961 } elsif (ref($self->{$_}) eq "HASH") {
2965 join(" ",keys %{$self->{$_}}),
2968 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
2974 #-> sub CPAN::InfoObj::author ;
2977 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2982 require Data::Dumper;
2983 Data::Dumper::Dumper($self);
2986 package CPAN::Author;
2988 #-> sub CPAN::Author::as_glimpse ;
2992 my $class = ref($self);
2993 $class =~ s/^CPAN:://;
2994 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2998 # Dead code, I would have liked to have,,, but it was never reached,,,
3001 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
3004 #-> sub CPAN::Author::fullname ;
3005 sub fullname { shift->{'FULLNAME'} }
3008 #-> sub CPAN::Author::email ;
3009 sub email { shift->{'EMAIL'} }
3011 package CPAN::Distribution;
3013 #-> sub CPAN::Distribution::as_string ;
3016 $self->containsmods;
3017 $self->SUPER::as_string(@_);
3020 #-> sub CPAN::Distribution::containsmods ;
3023 return if exists $self->{CONTAINSMODS};
3024 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
3025 my $mod_file = $mod->{CPAN_FILE} or next;
3026 my $dist_id = $self->{ID} or next;
3027 my $mod_id = $mod->{ID} or next;
3028 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
3032 #-> sub CPAN::Distribution::called_for ;
3035 $self->{'CALLED_FOR'} = $id if defined $id;
3036 return $self->{'CALLED_FOR'};
3039 #-> sub CPAN::Distribution::get ;
3044 exists $self->{'build_dir'} and push @e,
3045 "Unwrapped into directory $self->{'build_dir'}";
3046 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3051 $CPAN::Config->{keep_source_where},
3054 split("/",$self->{ID})
3057 $self->debug("Doing localize") if $CPAN::DEBUG;
3059 CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
3060 or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
3061 $self->{localfile} = $local_file;
3062 my $builddir = $CPAN::META->{cachemgr}->dir;
3063 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
3064 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
3067 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
3068 if ($CPAN::META->has_inst('MD5')) {
3069 $self->debug("MD5 is installed, verifying");
3072 $self->debug("MD5 is NOT installed");
3074 $self->debug("Removing tmp") if $CPAN::DEBUG;
3075 File::Path::rmtree("tmp");
3076 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
3078 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
3079 if (! $local_file) {
3080 Carp::croak "bad download, can't do anything :-(\n";
3081 } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
3082 $self->untar_me($local_file);
3083 } elsif ( $local_file =~ /\.zip$/i ) {
3084 $self->unzip_me($local_file);
3085 } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
3086 $self->pm2dir_me($local_file);
3088 $self->{archived} = "NO";
3090 chdir File::Spec->updir;
3091 if ($self->{archived} ne 'NO') {
3092 chdir File::Spec->catdir(File::Spec->curdir, "tmp");
3093 # Let's check if the package has its own directory.
3094 my $dh = DirHandle->new(File::Spec->curdir)
3095 or Carp::croak("Couldn't opendir .: $!");
3096 my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
3098 my ($distdir,$packagedir);
3099 if (@readdir == 1 && -d $readdir[0]) {
3100 $distdir = $readdir[0];
3101 $packagedir = MM->catdir($builddir,$distdir);
3102 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
3103 File::Path::rmtree($packagedir);
3104 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
3106 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
3107 $pragmatic_dir =~ s/\W_//g;
3108 $pragmatic_dir++ while -d "../$pragmatic_dir";
3109 $packagedir = MM->catdir($builddir,$pragmatic_dir);
3110 File::Path::mkpath($packagedir);
3112 for $f (@readdir) { # is already without "." and ".."
3113 my $to = MM->catdir($packagedir,$f);
3114 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
3117 $self->{'build_dir'} = $packagedir;
3118 chdir File::Spec->updir;
3120 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
3122 File::Path::rmtree("tmp");
3123 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
3124 $CPAN::Frontend->myprint("Going to unlink $local_file\n");
3125 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
3127 my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
3128 unless (-f $makefilepl) {
3129 my($configure) = MM->catfile($packagedir,"Configure");
3130 if (-f $configure) {
3131 # do we have anything to do?
3132 $self->{'configure'} = $configure;
3133 } elsif (-f MM->catfile($packagedir,"Makefile")) {
3134 $CPAN::Frontend->myprint(qq{
3135 Package comes with a Makefile and without a Makefile.PL.
3136 We\'ll try to build it with that Makefile then.
3138 $self->{writemakefile} = "YES";
3141 my $fh = FileHandle->new(">$makefilepl")
3142 or Carp::croak("Could not open >$makefilepl");
3143 my $cf = $self->called_for || "unknown";
3145 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
3146 # because there was no Makefile.PL supplied.
3147 # Autogenerated on: }.scalar localtime().qq{
3149 use ExtUtils::MakeMaker;
3150 WriteMakefile(NAME => q[$cf]);
3153 $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
3154 Writing one on our own (calling it $cf)\n});
3162 my($self,$local_file) = @_;
3163 $self->{archived} = "tar";
3164 if (CPAN::Tarzip->untar($local_file)) {
3165 $self->{unwrapped} = "YES";
3167 $self->{unwrapped} = "NO";
3172 my($self,$local_file) = @_;
3173 $self->{archived} = "zip";
3174 my $system = "$CPAN::Config->{unzip} $local_file";
3175 if (system($system) == 0) {
3176 $self->{unwrapped} = "YES";
3178 $self->{unwrapped} = "NO";
3183 my($self,$local_file) = @_;
3184 $self->{archived} = "pm";
3185 my $to = File::Basename::basename($local_file);
3186 $to =~ s/\.(gz|Z)$//;
3187 if (CPAN::Tarzip->gunzip($local_file,$to)) {
3188 $self->{unwrapped} = "YES";
3190 $self->{unwrapped} = "NO";
3194 #-> sub CPAN::Distribution::new ;
3196 my($class,%att) = @_;
3198 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
3200 my $this = { %att };
3201 return bless $this, $class;
3204 #-> sub CPAN::Distribution::look ;
3208 if ($^O eq 'MacOS') {
3209 $self->ExtUtils::MM_MacOS::look;
3213 if ( $CPAN::Config->{'shell'} ) {
3214 $CPAN::Frontend->myprint(qq{
3215 Trying to open a subshell in the build directory...
3218 $CPAN::Frontend->myprint(qq{
3219 Your configuration does not define a value for subshells.
3220 Please define it with "o conf shell <your shell>"
3224 my $dist = $self->id;
3225 my $dir = $self->dir or $self->get;
3228 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3229 my $pwd = CPAN->$getcwd();
3231 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3232 system($CPAN::Config->{'shell'}) == 0
3233 or $CPAN::Frontend->mydie("Subprocess shell error");
3240 my $dir = $self->dir;
3242 my $package = $self->called_for;
3243 my $module = $CPAN::META->instance('CPAN::Module', $package);
3244 my $version = $module->cpan_version;
3246 my $userid = $self->{CPAN_USERID};
3248 my $cvs_dir = (split '/', $dir)[-1];
3249 $cvs_dir =~ s/-\d+[^-]+$//;
3251 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
3253 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
3254 if ($cvs_site_perl) {
3255 $cvs_dir = "$cvs_site_perl/$cvs_dir";
3257 my $cvs_log = qq{"imported $package $version sources"};
3258 $version =~ s/\./_/g;
3259 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
3260 "$cvs_dir", $userid, "v$version");
3263 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3264 my $pwd = CPAN->$getcwd();
3267 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3269 $CPAN::Frontend->myprint(qq{@cmd\n});
3270 system(@cmd) == 0 or
3271 $CPAN::Frontend->mydie("cvs import failed");
3275 #-> sub CPAN::Distribution::readme ;
3278 my($dist) = $self->id;
3279 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
3280 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
3284 $CPAN::Config->{keep_source_where},
3287 split("/","$sans.readme"),
3289 $self->debug("Doing localize") if $CPAN::DEBUG;
3290 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
3292 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
3294 if ($^O eq 'MacOS') {
3295 ExtUtils::MM_MacOS::launch_file($local_file);
3299 my $fh_pager = FileHandle->new;
3300 local($SIG{PIPE}) = "IGNORE";
3301 $fh_pager->open("|$CPAN::Config->{'pager'}")
3302 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
3303 my $fh_readme = FileHandle->new;
3304 $fh_readme->open($local_file)
3305 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
3306 $CPAN::Frontend->myprint(qq{
3309 with pager "$CPAN::Config->{'pager'}"
3312 $fh_pager->print(<$fh_readme>);
3315 #-> sub CPAN::Distribution::verifyMD5 ;
3320 $self->{MD5_STATUS} ||= "";
3321 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
3322 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3324 my($lc_want,$lc_file,@local,$basename);
3325 @local = split("/",$self->{ID});
3327 push @local, "CHECKSUMS";
3329 MM->catfile($CPAN::Config->{keep_source_where},
3330 "authors", "id", @local);
3335 $self->MD5_check_file($lc_want)
3337 return $self->{MD5_STATUS} = "OK";
3339 $lc_file = CPAN::FTP->localize("authors/id/@local",
3342 $local[-1] .= ".gz";
3343 $lc_file = CPAN::FTP->localize("authors/id/@local",
3346 $lc_file =~ s/\.gz$//;
3347 CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
3352 $self->MD5_check_file($lc_file);
3355 #-> sub CPAN::Distribution::MD5_check_file ;
3356 sub MD5_check_file {
3357 my($self,$chk_file) = @_;
3358 my($cksum,$file,$basename);
3359 $file = $self->{localfile};
3360 $basename = File::Basename::basename($file);
3361 my $fh = FileHandle->new;
3362 if (open $fh, $chk_file){
3365 $eval =~ s/\015?\012/\n/g;
3367 my($comp) = Safe->new();
3368 $cksum = $comp->reval($eval);
3370 rename $chk_file, "$chk_file.bad";
3371 Carp::confess($@) if $@;
3374 Carp::carp "Could not open $chk_file for reading";
3377 if (exists $cksum->{$basename}{md5}) {
3378 $self->debug("Found checksum for $basename:" .
3379 "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
3383 my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
3385 $fh = CPAN::Tarzip->TIEHANDLE($file);
3388 # had to inline it, when I tied it, the tiedness got lost on
3389 # the call to eq_MD5. (Jan 1998)
3393 while ($fh->READ($ref, 4096) > 0){
3396 my $hexdigest = $md5->hexdigest;
3397 $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
3401 $CPAN::Frontend->myprint("Checksum for $file ok\n");
3402 return $self->{MD5_STATUS} = "OK";
3404 $CPAN::Frontend->myprint(qq{Checksum mismatch for }.
3405 qq{distribution file. }.
3406 qq{Please investigate.\n\n}.
3408 $CPAN::META->instance(
3410 $self->{CPAN_USERID}
3412 my $wrap = qq{I\'d recommend removing $file. It seems to
3413 be a bogus file. Maybe you have configured your \`urllist\' with a
3414 bad URL. Please check this array with \`o conf urllist\', and
3416 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
3417 $CPAN::Frontend->myprint("\n\n");
3421 # close $fh if fileno($fh);
3423 $self->{MD5_STATUS} ||= "";
3424 if ($self->{MD5_STATUS} eq "NIL") {
3425 $CPAN::Frontend->myprint(qq{
3426 No md5 checksum for $basename in local $chk_file.
3429 unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
3432 $self->{MD5_STATUS} = "NIL";
3437 #-> sub CPAN::Distribution::eq_MD5 ;
3439 my($self,$fh,$expectMD5) = @_;
3442 while (read($fh, $data, 4096)){
3445 # $md5->addfile($fh);
3446 my $hexdigest = $md5->hexdigest;
3447 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
3448 $hexdigest eq $expectMD5;
3451 #-> sub CPAN::Distribution::force ;
3454 $self->{'force_update'}++;
3456 MD5_STATUS archived build_dir localfile make install unwrapped
3459 delete $self->{$att};
3465 my $file = File::Basename::basename($self->id);
3466 return unless $file =~ m{ ^ perl
3469 (\d{3}(_[0-4][0-9])?)
3476 #-> sub CPAN::Distribution::perl ;
3479 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
3480 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3481 my $pwd = CPAN->$getcwd();
3482 my $candidate = MM->catfile($pwd,$^X);
3483 $perl ||= $candidate if MM->maybe_command($candidate);
3485 my ($component,$perl_name);
3486 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
3487 PATH_COMPONENT: foreach $component (MM->path(),
3488 $Config::Config{'binexp'}) {
3489 next unless defined($component) && $component;
3490 my($abs) = MM->catfile($component,$perl_name);
3491 if (MM->maybe_command($abs)) {
3501 #-> sub CPAN::Distribution::make ;
3504 $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
3505 # Emergency brake if they said install Pippi and get newest perl
3506 if ($self->isa_perl) {
3508 $self->called_for ne $self->id && ! $self->{'force_update'}
3510 $CPAN::Frontend->mydie(sprintf qq{
3511 The most recent version "%s" of the module "%s"
3512 comes with the current version of perl (%s).
3513 I\'ll build that only if you ask for something like
3518 $CPAN::META->instance(
3531 $self->{archived} eq "NO" and push @e,
3532 "Is neither a tar nor a zip archive.";
3534 $self->{unwrapped} eq "NO" and push @e,
3535 "had problems unarchiving. Please build manually";
3537 exists $self->{writemakefile} &&
3538 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
3539 $1 || "Had some problem writing Makefile";
3541 defined $self->{'make'} and push @e,
3542 "Has already been processed within this session";
3544 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3546 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
3547 my $builddir = $self->dir;
3548 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
3549 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
3551 if ($^O eq 'MacOS') {
3552 ExtUtils::MM_MacOS::make($self);
3557 if ($self->{'configure'}) {
3558 $system = $self->{'configure'};
3560 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
3562 # This needs a handler that can be turned on or off:
3563 # $switch = "-MExtUtils::MakeMaker ".
3564 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
3566 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
3568 unless (exists $self->{writemakefile}) {
3569 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
3572 if ($CPAN::Config->{inactivity_timeout}) {
3574 alarm $CPAN::Config->{inactivity_timeout};
3575 local $SIG{CHLD}; # = sub { wait };
3576 if (defined($pid = fork)) {
3581 # note, this exec isn't necessary if
3582 # inactivity_timeout is 0. On the Mac I'd
3583 # suggest, we set it always to 0.
3587 $CPAN::Frontend->myprint("Cannot fork: $!");
3595 $CPAN::Frontend->myprint($@);
3596 $self->{writemakefile} = "NO $@";
3601 $ret = system($system);
3603 $self->{writemakefile} = "NO Makefile.PL returned status $ret";
3607 if (-f "Makefile") {
3608 $self->{writemakefile} = "YES";
3610 $self->{writemakefile} =
3611 qq{NO Makefile.PL refused to write a Makefile.};
3612 # It's probably worth to record the reason, so let's retry
3614 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
3615 # $self->{writemakefile} .= <$fh>;
3618 return if $CPAN::Signal;
3619 if (my @prereq = $self->needs_prereq){
3621 $CPAN::Frontend->myprint("---- Dependencies detected ".
3622 "during [$id] -----\n");
3624 for my $p (@prereq) {
3625 $CPAN::Frontend->myprint(" $p\n");
3628 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
3630 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
3631 require ExtUtils::MakeMaker;
3632 my $answer = ExtUtils::MakeMaker::prompt(
3633 "Shall I follow them and prepend them to the queue
3634 of modules we are processing right now?", "yes");
3635 $follow = $answer =~ /^\s*y/i;
3638 $CPAN::Frontend->myprint(" Ignoring dependencies on modules @prereq\n");
3641 CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
3645 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
3646 if (system($system) == 0) {
3647 $CPAN::Frontend->myprint(" $system -- OK\n");
3648 $self->{'make'} = "YES";
3650 $self->{writemakefile} ||= "YES";
3651 $self->{'make'} = "NO";
3652 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3656 #-> sub CPAN::Distribution::needs_prereq ;
3659 return unless -f "Makefile"; # we cannot say much
3660 my $fh = FileHandle->new("<Makefile") or
3661 $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
3666 last if /MakeMaker post_initialize section/;
3668 \s+PREREQ_PM\s+=>\s+(.+)
3671 # warn "Found prereq expr[$p]";
3673 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
3679 my $mo = $CPAN::META->instance("CPAN::Module",$p);
3680 next if $mo->uptodate;
3681 # it's not needed, so don't push it. We cannot omit this step, because
3682 # if 'force' is in effect, nobody else will check.
3683 if ($self->{have_sponsored}{$p}++){
3684 # We have already sponsored it and for some reason it's still
3685 # not available. So we do nothing. Or what should we do?
3686 # if we push it again, we have a potential infinite loop
3694 #-> sub CPAN::Distribution::test ;
3698 return if $CPAN::Signal;
3699 $CPAN::Frontend->myprint("Running make test\n");
3702 exists $self->{'make'} or push @e,
3703 "Make had some problems, maybe interrupted? Won't test";
3705 exists $self->{'make'} and
3706 $self->{'make'} eq 'NO' and
3707 push @e, "Oops, make had returned bad status";
3709 exists $self->{'build_dir'} or push @e, "Has no own directory";
3710 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3712 chdir $self->{'build_dir'} or
3713 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3714 $self->debug("Changed directory to $self->{'build_dir'}")
3717 if ($^O eq 'MacOS') {
3718 ExtUtils::MM_MacOS::make_test($self);
3722 my $system = join " ", $CPAN::Config->{'make'}, "test";
3723 if (system($system) == 0) {
3724 $CPAN::Frontend->myprint(" $system -- OK\n");
3725 $self->{'make_test'} = "YES";
3727 $self->{'make_test'} = "NO";
3728 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3732 #-> sub CPAN::Distribution::clean ;
3735 $CPAN::Frontend->myprint("Running make clean\n");
3738 exists $self->{'build_dir'} or push @e, "Has no own directory";
3739 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3741 chdir $self->{'build_dir'} or
3742 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3743 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
3745 if ($^O eq 'MacOS') {
3746 ExtUtils::MM_MacOS::make_clean($self);
3750 my $system = join " ", $CPAN::Config->{'make'}, "clean";
3751 if (system($system) == 0) {
3752 $CPAN::Frontend->myprint(" $system -- OK\n");
3755 # Hmmm, what to do if make clean failed?
3759 #-> sub CPAN::Distribution::install ;
3763 return if $CPAN::Signal;
3764 $CPAN::Frontend->myprint("Running make install\n");
3767 exists $self->{'build_dir'} or push @e, "Has no own directory";
3769 exists $self->{'make'} or push @e,
3770 "Make had some problems, maybe interrupted? Won't install";
3772 exists $self->{'make'} and
3773 $self->{'make'} eq 'NO' and
3774 push @e, "Oops, make had returned bad status";
3776 push @e, "make test had returned bad status, ".
3777 "won't install without force"
3778 if exists $self->{'make_test'} and
3779 $self->{'make_test'} eq 'NO' and
3780 ! $self->{'force_update'};
3782 exists $self->{'install'} and push @e,
3783 $self->{'install'} eq "YES" ?
3784 "Already done" : "Already tried without success";
3786 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3788 chdir $self->{'build_dir'} or
3789 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3790 $self->debug("Changed directory to $self->{'build_dir'}")
3793 if ($^O eq 'MacOS') {
3794 ExtUtils::MM_MacOS::make_install($self);
3798 my $system = join(" ", $CPAN::Config->{'make'},
3799 "install", $CPAN::Config->{make_install_arg});
3800 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
3801 my($pipe) = FileHandle->new("$system $stderr |");
3804 $CPAN::Frontend->myprint($_);
3809 $CPAN::Frontend->myprint(" $system -- OK\n");
3810 return $self->{'install'} = "YES";
3812 $self->{'install'} = "NO";
3813 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3814 if ($makeout =~ /permission/s && $> > 0) {
3815 $CPAN::Frontend->myprint(qq{ You may have to su }.
3816 qq{to root to install the package\n});
3821 #-> sub CPAN::Distribution::dir ;
3823 shift->{'build_dir'};
3826 package CPAN::Bundle;
3828 #-> sub CPAN::Bundle::as_string ;
3832 $self->{INST_VERSION} = $self->inst_version;
3833 return $self->SUPER::as_string;
3836 #-> sub CPAN::Bundle::contains ;
3839 my($parsefile) = $self->inst_file;
3840 my($id) = $self->id;
3841 $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
3842 unless ($parsefile) {
3843 # Try to get at it in the cpan directory
3844 $self->debug("no parsefile") if $CPAN::DEBUG;
3845 Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
3846 my $dist = $CPAN::META->instance('CPAN::Distribution',
3847 $self->{CPAN_FILE});
3849 $self->debug($dist->as_string) if $CPAN::DEBUG;
3850 my($todir) = $CPAN::Config->{'cpan_home'};
3851 my(@me,$from,$to,$me);
3852 @me = split /::/, $self->id;
3854 $me = MM->catfile(@me);
3855 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
3856 $to = MM->catfile($todir,$me);
3857 File::Path::mkpath(File::Basename::dirname($to));
3858 File::Copy::copy($from, $to)
3859 or Carp::confess("Couldn't copy $from to $to: $!");
3863 my $fh = FileHandle->new;
3865 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
3867 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
3869 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
3870 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
3871 next unless $in_cont;
3876 push @result, (split " ", $_, 2)[0];
3879 delete $self->{STATUS};
3880 $self->{CONTAINS} = join ", ", @result;
3881 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
3883 $CPAN::Frontend->mywarn(qq{
3884 The bundle file "$parsefile" may be a broken
3885 bundlefile. It seems not to contain any bundle definition.
3886 Please check the file and if it is bogus, please delete it.
3887 Sorry for the inconvenience.
3893 #-> sub CPAN::Bundle::find_bundle_file
3894 sub find_bundle_file {
3895 my($self,$where,$what) = @_;
3896 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
3897 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
3898 ### my $bu = MM->catfile($where,$what);
3899 ### return $bu if -f $bu;
3900 my $manifest = MM->catfile($where,"MANIFEST");
3901 unless (-f $manifest) {
3902 require ExtUtils::Manifest;
3903 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3904 my $cwd = CPAN->$getcwd();
3906 ExtUtils::Manifest::mkmanifest();
3909 my $fh = FileHandle->new($manifest)
3910 or Carp::croak("Couldn't open $manifest: $!");
3913 if ($^O eq 'MacOS') {
3916 $what2 =~ s/:Bundle://;
3919 $what2 =~ s|Bundle[/\\]||;
3924 my($file) = /(\S+)/;
3925 if ($file =~ m|\Q$what\E$|) {
3927 # return MM->catfile($where,$bu); # bad
3930 # retry if she managed to
3931 # have no Bundle directory
3932 $bu = $file if $file =~ m|\Q$what2\E$|;
3934 $bu =~ tr|/|:| if $^O eq 'MacOS';
3935 return MM->catfile($where, $bu) if $bu;
3936 Carp::croak("Couldn't find a Bundle file in $where");
3939 #-> sub CPAN::Bundle::inst_file ;
3943 ($me = $self->id) =~ s/.*://;
3944 ## my(@me,$inst_file);
3945 ## @me = split /::/, $self->id;
3946 ## $me[-1] .= ".pm";
3947 $inst_file = MM->catfile($CPAN::Config->{'cpan_home'},
3948 "Bundle", "$me.pm");
3950 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
3952 $self->SUPER::inst_file;
3953 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
3954 # return $self->{'INST_FILE'}; # even if undefined?
3957 #-> sub CPAN::Bundle::rematein ;
3959 my($self,$meth) = @_;
3960 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
3961 my($id) = $self->id;
3962 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
3963 unless $self->inst_file || $self->{CPAN_FILE};
3965 for $s ($self->contains) {
3966 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
3967 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
3968 if ($type eq 'CPAN::Distribution') {
3969 $CPAN::Frontend->mywarn(qq{
3970 The Bundle }.$self->id.qq{ contains
3971 explicitly a file $s.
3975 # possibly noisy action:
3976 my $obj = $CPAN::META->instance($type,$s);
3978 my $success = $obj->can("uptodate") ? $obj->uptodate : 0;
3979 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
3980 $fail{$s} = 1 unless $success;
3982 # recap with less noise
3983 if ( $meth eq "install") {
3986 my $raw = sprintf(qq{Bundle summary:
3987 The following items in bundle %s had installation problems:},
3990 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
3991 $CPAN::Frontend->myprint("\n");
3993 for $s ($self->contains) {
3994 $paragraph .= "$s " if $fail{$s};
3996 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
3997 $CPAN::Frontend->myprint("\n");
3999 $self->{'install'} = 'YES';
4004 #sub CPAN::Bundle::xs_file
4006 # If a bundle contains another that contains an xs_file we have
4007 # here, we just don't bother I suppose
4011 #-> sub CPAN::Bundle::force ;
4012 sub force { shift->rematein('force',@_); }
4013 #-> sub CPAN::Bundle::get ;
4014 sub get { shift->rematein('get',@_); }
4015 #-> sub CPAN::Bundle::make ;
4016 sub make { shift->rematein('make',@_); }
4017 #-> sub CPAN::Bundle::test ;
4018 sub test { shift->rematein('test',@_); }
4019 #-> sub CPAN::Bundle::install ;
4022 $self->rematein('install',@_);
4024 #-> sub CPAN::Bundle::clean ;
4025 sub clean { shift->rematein('clean',@_); }
4027 #-> sub CPAN::Bundle::readme ;
4030 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
4031 No File found for bundle } . $self->id . qq{\n}), return;
4032 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
4033 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
4036 package CPAN::Module;
4038 #-> sub CPAN::Module::as_glimpse ;
4042 my $class = ref($self);
4043 $class =~ s/^CPAN:://;
4044 push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
4049 #-> sub CPAN::Module::as_string ;
4053 CPAN->debug($self) if $CPAN::DEBUG;
4054 my $class = ref($self);
4055 $class =~ s/^CPAN:://;
4057 push @m, $class, " id = $self->{ID}\n";
4058 my $sprintf = " %-12s %s\n";
4059 push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description})
4060 if $self->{description};
4061 my $sprintf2 = " %-12s %s (%s)\n";
4063 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
4065 if ($author = CPAN::Shell->expand('Author',$userid)) {
4068 if ($m = $author->email) {
4075 $author->fullname . $email
4079 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
4080 if $self->{CPAN_VERSION};
4081 push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
4082 if $self->{CPAN_FILE};
4083 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
4084 my(%statd,%stats,%statl,%stati);
4085 @statd{qw,? i c a b R M S,} = qw,unknown idea
4086 pre-alpha alpha beta released mature standard,;
4087 @stats{qw,? m d u n,} = qw,unknown mailing-list
4088 developer comp.lang.perl.* none,;
4089 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
4090 @stati{qw,? f r O h,} = qw,unknown functions
4091 references+ties object-oriented hybrid,;
4092 $statd{' '} = 'unknown';
4093 $stats{' '} = 'unknown';
4094 $statl{' '} = 'unknown';
4095 $stati{' '} = 'unknown';
4103 $statd{$self->{statd}},
4104 $stats{$self->{stats}},
4105 $statl{$self->{statl}},
4106 $stati{$self->{stati}}
4107 ) if $self->{statd};
4108 my $local_file = $self->inst_file;
4110 $self->{MANPAGE} ||= $self->manpage_headline($local_file);
4113 for $item (qw/MANPAGE CONTAINS/) {
4114 push @m, sprintf($sprintf, $item, $self->{$item})
4115 if exists $self->{$item};
4117 push @m, sprintf($sprintf, 'INST_FILE',
4118 $local_file || "(not installed)");
4119 push @m, sprintf($sprintf, 'INST_VERSION',
4120 $self->inst_version) if $local_file;
4124 sub manpage_headline {
4125 my($self,$local_file) = @_;
4126 my(@local_file) = $local_file;
4127 $local_file =~ s/\.pm$/.pod/;
4128 push @local_file, $local_file;
4130 for $locf (@local_file) {
4131 next unless -f $locf;
4132 my $fh = FileHandle->new($locf)
4133 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
4137 $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
4138 m/^=head1\s+NAME/ ? 1 : $inpod;
4151 #-> sub CPAN::Module::cpan_file ;
4154 CPAN->debug($self->id) if $CPAN::DEBUG;
4155 unless (defined $self->{'CPAN_FILE'}) {
4156 CPAN::Index->reload;
4158 if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){
4159 return $self->{'CPAN_FILE'};
4160 } elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
4161 my $fullname = $CPAN::META->instance(CPAN::Author,
4162 $self->{'userid'})->fullname;
4163 my $email = $CPAN::META->instance(CPAN::Author,
4164 $self->{'userid'})->email;
4165 unless (defined $fullname && defined $email) {
4166 return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
4168 return "Contact Author $fullname <$email>";
4174 *name = \&cpan_file;
4176 #-> sub CPAN::Module::cpan_version ;
4179 $self->{'CPAN_VERSION'} = 'undef'
4180 unless defined $self->{'CPAN_VERSION'}; # I believe this is
4181 # always a bug in the
4182 # index and should be
4184 # but usually I find
4186 # and do not want to
4189 $self->{'CPAN_VERSION'};
4192 #-> sub CPAN::Module::force ;
4195 $self->{'force_update'}++;
4198 #-> sub CPAN::Module::rematein ;
4200 my($self,$meth) = @_;
4201 $self->debug($self->id) if $CPAN::DEBUG;
4202 my $cpan_file = $self->cpan_file;
4203 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
4204 $CPAN::Frontend->mywarn(sprintf qq{
4205 The module %s isn\'t available on CPAN.
4207 Either the module has not yet been uploaded to CPAN, or it is
4208 temporary unavailable. Please contact the author to find out
4209 more about the status. Try ``i %s''.
4216 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
4217 $pack->called_for($self->id);
4218 $pack->force if exists $self->{'force_update'};
4220 delete $self->{'force_update'};
4223 #-> sub CPAN::Module::readme ;
4224 sub readme { shift->rematein('readme') }
4225 #-> sub CPAN::Module::look ;
4226 sub look { shift->rematein('look') }
4227 #-> sub CPAN::Module::cvs_import ;
4228 sub cvs_import { shift->rematein('cvs_import') }
4229 #-> sub CPAN::Module::get ;
4230 sub get { shift->rematein('get',@_); }
4231 #-> sub CPAN::Module::make ;
4232 sub make { shift->rematein('make') }
4233 #-> sub CPAN::Module::test ;
4234 sub test { shift->rematein('test') }
4235 #-> sub CPAN::Module::uptodate ;
4238 my($latest) = $self->cpan_version;
4240 my($inst_file) = $self->inst_file;
4242 if (defined $inst_file) {
4243 $have = $self->inst_version;
4254 #-> sub CPAN::Module::install ;
4260 not exists $self->{'force_update'}
4262 $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
4266 $self->rematein('install') if $doit;
4268 #-> sub CPAN::Module::clean ;
4269 sub clean { shift->rematein('clean') }
4271 #-> sub CPAN::Module::inst_file ;
4275 @packpath = split /::/, $self->{ID};
4276 $packpath[-1] .= ".pm";
4277 foreach $dir (@INC) {
4278 my $pmfile = MM->catfile($dir,@packpath);
4286 #-> sub CPAN::Module::xs_file ;
4290 @packpath = split /::/, $self->{ID};
4291 push @packpath, $packpath[-1];
4292 $packpath[-1] .= "." . $Config::Config{'dlext'};
4293 foreach $dir (@INC) {
4294 my $xsfile = MM->catfile($dir,'auto',@packpath);
4302 #-> sub CPAN::Module::inst_version ;
4305 my $parsefile = $self->inst_file or return;
4306 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
4308 my $have = MM->parse_version($parsefile) || "undef";
4309 $have =~ s/\s*//g; # stringify to float around floating point issues
4313 package CPAN::Tarzip;
4316 my($class,$read,$write) = @_;
4317 if ($CPAN::META->has_inst("Compress::Zlib")) {
4319 $fhw = FileHandle->new($read)
4320 or $CPAN::Frontend->mydie("Could not open $read: $!");
4321 my $gz = Compress::Zlib::gzopen($write, "wb")
4322 or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
4323 $gz->gzwrite($buffer)
4324 while read($fhw,$buffer,4096) > 0 ;
4329 system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
4334 my($class,$read,$write) = @_;
4335 if ($CPAN::META->has_inst("Compress::Zlib")) {
4337 $fhw = FileHandle->new(">$write")
4338 or $CPAN::Frontend->mydie("Could not open >$write: $!");
4339 my $gz = Compress::Zlib::gzopen($read, "rb")
4340 or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
4341 $fhw->print($buffer)
4342 while $gz->gzread($buffer) > 0 ;
4343 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
4344 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
4349 system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
4354 my($class,$read) = @_;
4355 if ($CPAN::META->has_inst("Compress::Zlib")) {
4357 my $gz = Compress::Zlib::gzopen($read, "rb")
4358 or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
4359 1 while $gz->gzread($buffer) > 0 ;
4360 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
4361 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
4365 return system("$CPAN::Config->{'gzip'} -dt $read")==0;
4370 my($class,$file) = @_;
4372 $class->debug("file[$file]");
4373 if ($CPAN::META->has_inst("Compress::Zlib")) {
4374 my $gz = Compress::Zlib::gzopen($file,"rb") or
4375 die "Could not gzopen $file";
4376 $ret = bless {GZ => $gz}, $class;
4378 my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |";
4379 my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
4381 $ret = bless {FH => $fh}, $class;
4388 if (exists $self->{GZ}) {
4389 my $gz = $self->{GZ};
4390 my($line,$bytesread);
4391 $bytesread = $gz->gzreadline($line);
4392 return undef if $bytesread <= 0;
4395 my $fh = $self->{FH};
4396 return scalar <$fh>;
4401 my($self,$ref,$length,$offset) = @_;
4402 die "read with offset not implemented" if defined $offset;
4403 if (exists $self->{GZ}) {
4404 my $gz = $self->{GZ};
4405 my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
4408 my $fh = $self->{FH};
4409 return read($fh,$$ref,$length);
4415 if (exists $self->{GZ}) {
4416 my $gz = $self->{GZ};
4419 my $fh = $self->{FH};
4420 $fh->close if defined $fh;
4426 my($class,$file) = @_;
4427 # had to disable, because version 0.07 seems to be buggy
4428 if (MM->maybe_command($CPAN::Config->{'gzip'})
4430 MM->maybe_command($CPAN::Config->{'tar'})) {
4431 my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
4432 "< $file | $CPAN::Config->{tar} xvf -";
4433 if (system($system) != 0) {
4434 # people find the most curious tar binaries that cannot handle
4436 my $system = "$CPAN::Config->{'gzip'} --decompress $file";
4437 if (system($system)==0) {
4438 $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
4440 $CPAN::Frontend->mydie(
4441 qq{Couldn\'t uncompress $file\n}
4445 $system = "$CPAN::Config->{tar} xvf $file";
4446 $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
4447 if (system($system)==0) {
4448 $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
4450 $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
4456 } elsif ($CPAN::META->has_inst("Archive::Tar")
4458 $CPAN::META->has_inst("Compress::Zlib") ) {
4459 my $tar = Archive::Tar->new($file,1);
4460 $tar->extract($tar->list_files); # I'm pretty sure we have nothing
4461 # that isn't compressed
4463 ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
4464 if ($^O eq 'MacOS');
4468 $CPAN::Frontend->mydie(qq{
4469 CPAN.pm needs either both external programs tar and gzip installed or
4470 both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
4471 is available. Can\'t continue.
4484 CPAN - query, download and build perl modules from CPAN sites
4490 perl -MCPAN -e shell;
4496 autobundle, clean, install, make, recompile, test
4500 The CPAN module is designed to automate the make and install of perl
4501 modules and extensions. It includes some searching capabilities and
4502 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
4503 to fetch the raw data from the net.
4505 Modules are fetched from one or more of the mirrored CPAN
4506 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
4509 The CPAN module also supports the concept of named and versioned
4510 I<bundles> of modules. Bundles simplify the handling of sets of
4511 related modules. See Bundles below.
4513 The package contains a session manager and a cache manager. There is
4514 no status retained between sessions. The session manager keeps track
4515 of what has been fetched, built and installed in the current
4516 session. The cache manager keeps track of the disk space occupied by
4517 the make processes and deletes excess space according to a simple FIFO
4520 For extended searching capabilities there's a plugin for CPAN available,
4521 L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
4522 all documents available in CPAN authors directories. If C<CPAN::WAIT>
4523 is installed on your system, the interactive shell of <CPAN.pm> will
4524 enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands which send
4525 queries to the WAIT server that has been configured for your
4528 All other methods provided are accessible in a programmer style and in an
4529 interactive shell style.
4531 =head2 Interactive Mode
4533 The interactive mode is entered by running
4535 perl -MCPAN -e shell
4537 which puts you into a readline interface. You will have the most fun if
4538 you install Term::ReadKey and Term::ReadLine to enjoy both history and
4541 Once you are on the command line, type 'h' and the rest should be
4544 The most common uses of the interactive modes are
4548 =item Searching for authors, bundles, distribution files and modules
4550 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
4551 for each of the four categories and another, C<i> for any of the
4552 mentioned four. Each of the four entities is implemented as a class
4553 with slightly differing methods for displaying an object.
4555 Arguments you pass to these commands are either strings exactly matching
4556 the identification string of an object or regular expressions that are
4557 then matched case-insensitively against various attributes of the
4558 objects. The parser recognizes a regular expression only if you
4559 enclose it between two slashes.
4561 The principle is that the number of found objects influences how an
4562 item is displayed. If the search finds one item, the result is
4563 displayed with the rather verbose method C<as_string>, but if we find
4564 more than one, we display each object with the terse method
4567 =item make, test, install, clean modules or distributions
4569 These commands take any number of arguments and investigate what is
4570 necessary to perform the action. If the argument is a distribution
4571 file name (recognized by embedded slashes), it is processed. If it is
4572 a module, CPAN determines the distribution file in which this module
4573 is included and processes that, following any dependencies named in
4574 the module's Makefile.PL (this behavior is controlled by
4575 I<prerequisites_policy>.)
4577 Any C<make> or C<test> are run unconditionally. An
4579 install <distribution_file>
4581 also is run unconditionally. But for
4585 CPAN checks if an install is actually needed for it and prints
4586 I<module up to date> in the case that the distribution file containing
4587 the module doesnE<39>t need to be updated.
4589 CPAN also keeps track of what it has done within the current session
4590 and doesnE<39>t try to build a package a second time regardless if it
4591 succeeded or not. The C<force> command takes as a first argument the
4592 method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
4593 command from scratch.
4597 cpan> install OpenGL
4598 OpenGL is up to date.
4599 cpan> force install OpenGL
4602 OpenGL-0.4/COPYRIGHT
4605 A C<clean> command results in a
4609 being executed within the distribution file's working directory.
4611 =item get, readme, look module or distribution
4613 C<get> downloads a distribution file without further action. C<readme>
4614 displays the README file of the associated distribution. C<Look> gets
4615 and untars (if not yet done) the distribution file, changes to the
4616 appropriate directory and opens a subshell process in that directory.
4620 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
4621 in the cpan-shell it is intended that you can press C<^C> anytime and
4622 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
4623 to clean up and leave the shell loop. You can emulate the effect of a
4624 SIGTERM by sending two consecutive SIGINTs, which usually means by
4625 pressing C<^C> twice.
4627 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
4628 SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
4634 The commands that are available in the shell interface are methods in
4635 the package CPAN::Shell. If you enter the shell command, all your
4636 input is split by the Text::ParseWords::shellwords() routine which
4637 acts like most shells do. The first word is being interpreted as the
4638 method to be called and the rest of the words are treated as arguments
4639 to this method. Continuation lines are supported if a line ends with a
4644 C<autobundle> writes a bundle file into the
4645 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
4646 a list of all modules that are both available from CPAN and currently
4647 installed within @INC. The name of the bundle file is based on the
4648 current date and a counter.
4652 recompile() is a very special command in that it takes no argument and
4653 runs the make/test/install cycle with brute force over all installed
4654 dynamically loadable extensions (aka XS modules) with 'force' in
4655 effect. The primary purpose of this command is to finish a network
4656 installation. Imagine, you have a common source tree for two different
4657 architectures. You decide to do a completely independent fresh
4658 installation. You start on one architecture with the help of a Bundle
4659 file produced earlier. CPAN installs the whole Bundle for you, but
4660 when you try to repeat the job on the second architecture, CPAN
4661 responds with a C<"Foo up to date"> message for all modules. So you
4662 invoke CPAN's recompile on the second architecture and youE<39>re done.
4664 Another popular use for C<recompile> is to act as a rescue in case your
4665 perl breaks binary compatibility. If one of the modules that CPAN uses
4666 is in turn depending on binary compatibility (so you cannot run CPAN
4667 commands), then you should try the CPAN::Nox module for recovery.
4669 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
4671 Although it may be considered internal, the class hierarchy does matter
4672 for both users and programmer. CPAN.pm deals with above mentioned four
4673 classes, and all those classes share a set of methods. A classical
4674 single polymorphism is in effect. A metaclass object registers all
4675 objects of all kinds and indexes them with a string. The strings
4676 referencing objects have a separated namespace (well, not completely
4681 words containing a "/" (slash) Distribution
4682 words starting with Bundle:: Bundle
4683 everything else Module or Author
4685 Modules know their associated Distribution objects. They always refer
4686 to the most recent official release. Developers may mark their releases
4687 as unstable development versions (by inserting an underbar into the
4688 visible version number), so the really hottest and newest distribution
4689 file is not always the default. If a module Foo circulates on CPAN in
4690 both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
4691 install version 1.23 by saying
4695 This would install the complete distribution file (say
4696 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
4697 like to install version 1.23_90, you need to know where the
4698 distribution file resides on CPAN relative to the authors/id/
4699 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
4700 so you would have to say
4702 install BAR/Foo-1.23_90.tar.gz
4704 The first example will be driven by an object of the class
4705 CPAN::Module, the second by an object of class CPAN::Distribution.
4707 =head2 ProgrammerE<39>s interface
4709 If you do not enter the shell, the available shell commands are both
4710 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
4711 functions in the calling package (C<install(...)>).
4713 There's currently only one class that has a stable interface -
4714 CPAN::Shell. All commands that are available in the CPAN shell are
4715 methods of the class CPAN::Shell. Each of the commands that produce
4716 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
4717 the IDs of all modules within the list.
4721 =item expand($type,@things)
4723 The IDs of all objects available within a program are strings that can
4724 be expanded to the corresponding real objects with the
4725 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
4726 list of CPAN::Module objects according to the C<@things> arguments
4727 given. In scalar context it only returns the first element of the
4730 =item Programming Examples
4732 This enables the programmer to do operations that combine
4733 functionalities that are available in the shell.
4735 # install everything that is outdated on my disk:
4736 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
4738 # install my favorite programs if necessary:
4739 for $mod (qw(Net::FTP MD5 Data::Dumper)){
4740 my $obj = CPAN::Shell->expand('Module',$mod);
4744 # list all modules on my disk that have no VERSION number
4745 for $mod (CPAN::Shell->expand("Module","/./")){
4746 next unless $mod->inst_file;
4747 # MakeMaker convention for undefined $VERSION:
4748 next unless $mod->inst_version eq "undef";
4749 print "No VERSION in ", $mod->id, "\n";
4752 Or if you want to write a cronjob to watch The CPAN, you could list
4753 all modules that need updating:
4755 perl -e 'use CPAN; CPAN::Shell->r;'
4757 If you don't want to get any output if all modules are up to date, you
4758 can parse the output of above command for the regular expression
4759 //modules are up to date// and decide to mail the output only if it
4762 If you prefer to do it more in a programmer style in one single
4763 process, maybe something like this suites you better:
4765 # list all modules on my disk that have newer versions on CPAN
4766 for $mod (CPAN::Shell->expand("Module","/./")){
4767 next unless $mod->inst_file;
4768 next if $mod->uptodate;
4769 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
4770 $mod->id, $mod->inst_version, $mod->cpan_version;
4773 If that gives you too much output every day, you maybe only want to
4774 watch for three modules. You can write
4776 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
4778 as the first line instead. Or you can combine some of the above
4781 # watch only for a new mod_perl module
4782 $mod = CPAN::Shell->expand("Module","mod_perl");
4783 exit if $mod->uptodate;
4784 # new mod_perl arrived, let me know all update recommendations
4789 =head2 Methods in the four Classes
4791 =head2 Cache Manager
4793 Currently the cache manager only keeps track of the build directory
4794 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
4795 deletes complete directories below C<build_dir> as soon as the size of
4796 all directories there gets bigger than $CPAN::Config->{build_cache}
4797 (in MB). The contents of this cache may be used for later
4798 re-installations that you intend to do manually, but will never be
4799 trusted by CPAN itself. This is due to the fact that the user might
4800 use these directories for building modules on different architectures.
4802 There is another directory ($CPAN::Config->{keep_source_where}) where
4803 the original distribution files are kept. This directory is not
4804 covered by the cache manager and must be controlled by the user. If
4805 you choose to have the same directory as build_dir and as
4806 keep_source_where directory, then your sources will be deleted with
4807 the same fifo mechanism.
4811 A bundle is just a perl module in the namespace Bundle:: that does not
4812 define any functions or methods. It usually only contains documentation.
4814 It starts like a perl module with a package declaration and a $VERSION
4815 variable. After that the pod section looks like any other pod with the
4816 only difference being that I<one special pod section> exists starting with
4821 In this pod section each line obeys the format
4823 Module_Name [Version_String] [- optional text]
4825 The only required part is the first field, the name of a module
4826 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
4827 of the line is optional. The comment part is delimited by a dash just
4828 as in the man page header.
4830 The distribution of a bundle should follow the same convention as
4831 other distributions.
4833 Bundles are treated specially in the CPAN package. If you say 'install
4834 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
4835 the modules in the CONTENTS section of the pod. You can install your
4836 own Bundles locally by placing a conformant Bundle file somewhere into
4837 your @INC path. The autobundle() command which is available in the
4838 shell interface does that for you by including all currently installed
4839 modules in a snapshot bundle file.
4841 =head2 Prerequisites
4843 If you have a local mirror of CPAN and can access all files with
4844 "file:" URLs, then you only need a perl better than perl5.003 to run
4845 this module. Otherwise Net::FTP is strongly recommended. LWP may be
4846 required for non-UNIX systems or if your nearest CPAN site is
4847 associated with an URL that is not C<ftp:>.
4849 If you have neither Net::FTP nor LWP, there is a fallback mechanism
4850 implemented for an external ftp command or for an external lynx
4853 =head2 Finding packages and VERSION
4855 This module presumes that all packages on CPAN
4861 declare their $VERSION variable in an easy to parse manner. This
4862 prerequisite can hardly be relaxed because it consumes far too much
4863 memory to load all packages into the running program just to determine
4864 the $VERSION variable. Currently all programs that are dealing with
4865 version use something like this
4867 perl -MExtUtils::MakeMaker -le \
4868 'print MM->parse_version(shift)' filename
4870 If you are author of a package and wonder if your $VERSION can be
4871 parsed, please try the above method.
4875 come as compressed or gzipped tarfiles or as zip files and contain a
4876 Makefile.PL (well, we try to handle a bit more, but without much
4883 The debugging of this module is pretty difficult, because we have
4884 interferences of the software producing the indices on CPAN, of the
4885 mirroring process on CPAN, of packaging, of configuration, of
4886 synchronicity, and of bugs within CPAN.pm.
4888 In interactive mode you can try "o debug" which will list options for
4889 debugging the various parts of the package. The output may not be very
4890 useful for you as it's just a by-product of my own testing, but if you
4891 have an idea which part of the package may have a bug, it's sometimes
4892 worth to give it a try and send me more specific output. You should
4893 know that "o debug" has built-in completion support.
4895 =head2 Floppy, Zip, Offline Mode
4897 CPAN.pm works nicely without network too. If you maintain machines
4898 that are not networked at all, you should consider working with file:
4899 URLs. Of course, you have to collect your modules somewhere first. So
4900 you might use CPAN.pm to put together all you need on a networked
4901 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
4902 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
4903 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
4904 with this floppy. See also below the paragraph about CD-ROM support.
4906 =head1 CONFIGURATION
4908 When the CPAN module is installed, a site wide configuration file is
4909 created as CPAN/Config.pm. The default values defined there can be
4910 overridden in another configuration file: CPAN/MyConfig.pm. You can
4911 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
4912 $HOME/.cpan is added to the search path of the CPAN module before the
4913 use() or require() statements.
4915 Currently the following keys in the hash reference $CPAN::Config are
4918 build_cache size of cache for directories to build modules
4919 build_dir locally accessible directory to build modules
4920 index_expire after this many days refetch index files
4921 cpan_home local directory reserved for this package
4922 gzip location of external program gzip
4923 inactivity_timeout breaks interactive Makefile.PLs after this
4924 many seconds inactivity. Set to 0 to never break.
4925 inhibit_startup_message
4926 if true, does not print the startup message
4927 keep_source_where directory in which to keep the source (if we do)
4928 make location of external make program
4929 make_arg arguments that should always be passed to 'make'
4930 make_install_arg same as make_arg for 'make install'
4931 makepl_arg arguments passed to 'perl Makefile.PL'
4932 pager location of external program more (or any pager)
4933 prerequisites_policy
4934 what to do if you are missing module prerequisites
4935 ('follow' automatically, 'ask' me, or 'ignore')
4936 scan_cache controls scanning of cache ('atstart' or 'never')
4937 tar location of external program tar
4938 unzip location of external program unzip
4939 urllist arrayref to nearby CPAN sites (or equivalent locations)
4940 wait_list arrayref to a wait server to try (See CPAN::WAIT)
4941 ftp_proxy, } the three usual variables for configuring
4942 http_proxy, } proxy requests. Both as CPAN::Config variables
4943 no_proxy } and as environment variables configurable.
4945 You can set and query each of these options interactively in the cpan
4946 shell with the command set defined within the C<o conf> command:
4950 =item C<o conf E<lt>scalar optionE<gt>>
4952 prints the current value of the I<scalar option>
4954 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
4956 Sets the value of the I<scalar option> to I<value>
4958 =item C<o conf E<lt>list optionE<gt>>
4960 prints the current value of the I<list option> in MakeMaker's
4963 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
4965 shifts or pops the array in the I<list option> variable
4967 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
4969 works like the corresponding perl commands.
4973 =head2 Note on urllist parameter's format
4975 urllist parameters are URLs according to RFC 1738. We do a little
4976 guessing if your URL is not compliant, but if you have problems with file URLs, please try the correct format. Either:
4978 file://localhost/whatever/ftp/pub/CPAN/
4982 file:///home/ftp/pub/CPAN/
4984 =head2 urllist parameter has CD-ROM support
4986 The C<urllist> parameter of the configuration table contains a list of
4987 URLs that are to be used for downloading. If the list contains any
4988 C<file> URLs, CPAN always tries to get files from there first. This
4989 feature is disabled for index files. So the recommendation for the
4990 owner of a CD-ROM with CPAN contents is: include your local, possibly
4991 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
4993 o conf urllist push file://localhost/CDROM/CPAN
4995 CPAN.pm will then fetch the index files from one of the CPAN sites
4996 that come at the beginning of urllist. It will later check for each
4997 module if there is a local copy of the most recent version.
4999 Another peculiarity of urllist is that the site that we could
5000 successfully fetch the last file from automatically gets a preference
5001 token and is tried as the first site for the next request. So if you
5002 add a new site at runtime it may happen that the previously preferred
5003 site will be tried another time. This means that if you want to disallow
5004 a site for the next transfer, it must be explicitly removed from
5009 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
5010 install foreign, unmasked, unsigned code on your machine. We compare
5011 to a checksum that comes from the net just as the distribution file
5012 itself. If somebody has managed to tamper with the distribution file,
5013 they may have as well tampered with the CHECKSUMS file. Future
5014 development will go towards strong authentication.
5018 Most functions in package CPAN are exported per default. The reason
5019 for this is that the primary use is intended for the cpan shell or for
5022 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
5024 To populate a freshly installed perl with my favorite modules is pretty
5025 easiest by maintaining a private bundle definition file. To get a useful
5026 blueprint of a bundle definition file, the command autobundle can be used
5027 on the CPAN shell command line. This command writes a bundle definition
5028 file for all modules that are installed for the currently running perl
5029 interpreter. It's recommended to run this command only once and from then
5030 on maintain the file manually under a private name, say
5031 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
5033 cpan> install Bundle::my_bundle
5035 then answer a few questions and then go out for a coffee.
5037 Maintaining a bundle definition file means to keep track of two
5038 things: dependencies and interactivity. CPAN.pm sometimes fails on
5039 calculating dependencies because not all modules define all MakeMaker
5040 attributes correctly, so a bundle definition file should specify
5041 prerequisites as early as possible. On the other hand, it's a bit
5042 annoying that many distributions need some interactive configuring. So
5043 what I try to accomplish in my private bundle file is to have the
5044 packages that need to be configured early in the file and the gentle
5045 ones later, so I can go out after a few minutes and leave CPAN.pm
5048 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
5050 Thanks to Graham Barr for contributing the following paragraphs about
5051 the interaction between perl, and various firewall configurations.
5053 Firewalls can be categorized into three basic types.
5059 This is where the firewall machine runs a web server and to access the
5060 outside world you must do it via the web server. If you set environment
5061 variables like http_proxy or ftp_proxy to a values beginning with http://
5062 or in your web browser you have to set proxy information then you know
5063 you are running a http firewall.
5065 To access servers outside these types of firewalls with perl (even for
5066 ftp) you will need to use LWP.
5070 This where the firewall machine runs a ftp server. This kind of
5071 firewall will only let you access ftp servers outside the firewall.
5072 This is usually done by connecting to the firewall with ftp, then
5073 entering a username like "user@outside.host.com"
5075 To access servers outside these type of firewalls with perl you
5076 will need to use Net::FTP.
5078 =item One way visibility
5080 I say one way visibility as these firewalls try to make themselve look
5081 invisible to the users inside the firewall. An FTP data connection is
5082 normally created by sending the remote server your IP address and then
5083 listening for the connection. But the remote server will not be able to
5084 connect to you because of the firewall. So for these types of firewall
5085 FTP connections need to be done in a passive mode.
5087 There are two that I can think off.
5093 If you are using a SOCKS firewall you will need to compile perl and link
5094 it with the SOCKS library, this is what is normally called a ``socksified''
5095 perl. With this executable you will be able to connect to servers outside
5096 the firewall as if it is not there.
5100 This is the firewall implemented in the Linux kernel, it allows you to
5101 hide a complete network behind one IP address. With this firewall no
5102 special compiling is need as you can access hosts directly.
5110 We should give coverage for B<all> of the CPAN and not just the PAUSE
5111 part, right? In this discussion CPAN and PAUSE have become equal --
5112 but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus
5113 the clpa/, doc/, misc/, ports/, src/, scripts/.
5115 Future development should be directed towards a better integration of
5118 If a Makefile.PL requires special customization of libraries, prompts
5119 the user for special input, etc. then you may find CPAN is not able to
5120 build the distribution. In that case, you should attempt the
5121 traditional method of building a Perl module package from a shell.
5125 Andreas Koenig E<lt>andreas.koenig@anima.deE<gt>
5129 perl(1), CPAN::Nox(3)