2 use vars qw{$Try_autoload
4 $META $Signal $Cwd $End
11 # $Id: CPAN.pm,v 1.303 2000/08/01 15:57:15 k Exp $
13 # only used during development:
15 # $Revision = "[".substr(q$Revision: 1.303 $, 10)."]";
22 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
23 use File::Basename ();
29 use Text::ParseWords ();
32 no lib "."; # we need to run chdir all over and we would get at wrong
35 END { $End++; &cleanup; }
56 $CPAN::Frontend ||= "CPAN::Shell";
57 $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
60 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term);
63 @CPAN::ISA = qw(CPAN::Debug Exporter);
66 autobundle bundle expand force get cvs_import
67 install make readme recompile shell test clean
70 #-> sub CPAN::AUTOLOAD ;
75 @EXPORT{@EXPORT} = '';
76 CPAN::Config->load unless $CPAN::Config_loaded++;
77 if (exists $EXPORT{$l}){
80 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
84 # $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD");
86 $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
95 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
96 CPAN::Config->load unless $CPAN::Config_loaded++;
98 my $prompt = "cpan> ";
100 unless ($Suppress_readline) {
101 require Term::ReadLine;
102 # import Term::ReadLine;
103 $term = Term::ReadLine->new('CPAN Monitor');
104 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
105 my $attribs = $term->Attribs;
106 # $attribs->{completion_entry_function} =
107 # $attribs->{'list_completion_function'};
108 $attribs->{attempted_completion_function} = sub {
109 &CPAN::Complete::gnu_cpl;
111 # $attribs->{completion_word} =
112 # [qw(help me somebody to find out how
113 # to use completion with GNU)];
115 $readline::rl_completion_function =
116 $readline::rl_completion_function = 'CPAN::Complete::cpl';
118 # $term->OUT is autoflushed anyway
119 my $odef = select STDERR;
129 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
130 my $cwd = CPAN->$getcwd();
131 my $try_detect_readline;
132 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
133 my $rl_avail = $Suppress_readline ? "suppressed" :
134 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
135 "available (try ``install Bundle::CPAN'')";
137 $CPAN::Frontend->myprint(
139 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision)
140 ReadLine support $rl_avail
142 }) unless $CPAN::Config->{'inhibit_startup_message'} ;
143 my($continuation) = "";
145 if ($Suppress_readline) {
147 last unless defined ($_ = <> );
150 last unless defined ($_ = $term->readline($prompt));
152 $_ = "$continuation$_" if $continuation;
155 $_ = 'h' if /^\s*\?/;
156 if (/^(?:q(?:uit)?|bye|exit)$/i) {
166 use vars qw($import_done);
167 CPAN->import(':DEFAULT') unless $import_done++;
168 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
175 if ($] < 5.00322) { # parsewords had a bug until recently
178 eval { @line = Text::ParseWords::shellwords($_) };
179 warn($@), next if $@;
181 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
182 my $command = shift @line;
183 eval { CPAN::Shell->$command(@line) };
186 $CPAN::Frontend->myprint("\n");
192 CPAN::Queue->nullify_queue;
193 if ($try_detect_readline) {
194 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
196 $CPAN::META->has_inst("Term::ReadLine::Perl")
198 delete $INC{"Term/ReadLine.pm"};
200 local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef);
201 require Term::ReadLine;
202 $CPAN::Frontend->myprint("\n$redef subroutines in ".
203 "Term::ReadLine redefined\n");
210 package CPAN::CacheMgr;
211 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
214 package CPAN::Config;
215 import ExtUtils::MakeMaker 'neatvalue';
216 use vars qw(%can $dot_cpan);
219 'commit' => "Commit changes to disk",
220 'defaults' => "Reload defaults from disk",
221 'init' => "Interactive setting of all options",
225 use vars qw($Ua $Thesite $Themethod);
226 @CPAN::FTP::ISA = qw(CPAN::Debug);
228 package CPAN::Complete;
229 @CPAN::Complete::ISA = qw(CPAN::Debug);
232 use vars qw($last_time $date_of_03);
233 @CPAN::Index::ISA = qw(CPAN::Debug);
237 package CPAN::InfoObj;
238 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
240 package CPAN::Author;
241 @CPAN::Author::ISA = qw(CPAN::InfoObj);
243 package CPAN::Distribution;
244 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
246 package CPAN::Bundle;
247 @CPAN::Bundle::ISA = qw(CPAN::Module);
249 package CPAN::Module;
250 @CPAN::Module::ISA = qw(CPAN::InfoObj);
253 use vars qw($AUTOLOAD $redef @ISA);
254 @CPAN::Shell::ISA = qw(CPAN::Debug);
256 #-> sub CPAN::Shell::AUTOLOAD ;
258 my($autoload) = $AUTOLOAD;
259 my $class = shift(@_);
260 # warn "autoload[$autoload] class[$class]";
261 $autoload =~ s/.*:://;
262 if ($autoload =~ /^w/) {
263 if ($CPAN::META->has_inst('CPAN::WAIT')) {
264 CPAN::WAIT->$autoload(@_);
266 $CPAN::Frontend->mywarn(qq{
267 Commands starting with "w" require CPAN::WAIT to be installed.
268 Please consider installing CPAN::WAIT to use the fulltext index.
269 For this you just need to type
274 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
278 # $CPAN::Frontend->mywarn("Could not autoload $autoload");
280 $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
286 #-> CPAN::Shell::try_dot_al
288 my($class,$autoload) = @_;
289 return unless $CPAN::Try_autoload;
290 # I don't see how to re-use that from the AutoLoader...
292 # Braces used to preserve $1 et al.
294 my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/;
296 if (defined($name=$INC{"$pkg.pm"}))
298 $name =~ s|^(.*)$pkg\.pm\z|$1auto/$pkg/$func.al|s;
299 $name = undef unless (-r $name);
301 unless (defined $name)
303 $name = "auto/$autoload.al";
308 eval {local $SIG{__DIE__};require $name};
310 if (substr($autoload,-9) eq '::DESTROY') {
314 if ($name =~ s{(\w{12,})\.al\z}{substr($1,0,11).".al"}e){
315 eval {local $SIG{__DIE__};require $name};
330 # my $lm = Carp::longmess();
331 # warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
335 #### autoloader is experimental
336 #### to try it we have to set $Try_autoload and uncomment
337 #### the use statement and uncomment the __END__ below
338 #### You also need AutoSplit 1.01 available. MakeMaker will
339 #### then build CPAN with all the AutoLoad stuff.
343 if ($CPAN::Try_autoload) {
346 CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
347 CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
348 CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
350 *{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD;
354 package CPAN::Tarzip;
355 use vars qw($AUTOLOAD @ISA);
356 @CPAN::Tarzip::ISA = qw(CPAN::Debug);
360 # One use of the queue is to determine if we should or shouldn't
361 # announce the availability of a new CPAN module
363 # Now we try to use it for dependency tracking. For that to happen
364 # we need to draw a dependency tree and do the leaves first. This can
365 # easily be reached by running CPAN.pm recursively, but we don't want
366 # to waste memory and run into deep recursion. So what we can do is
369 # CPAN::Queue is the package where the queue is maintained. Dependencies
370 # often have high priority and must be brought to the head of the queue,
371 # possibly by jumping the queue if they are already there. My first code
372 # attempt tried to be extremely correct. Whenever a module needed
373 # immediate treatment, I either unshifted it to the front of the queue,
374 # or, if it was already in the queue, I spliced and let it bypass the
375 # others. This became a too correct model that made it impossible to put
376 # an item more than once into the queue. Why would you need that? Well,
377 # you need temporary duplicates as the manager of the queue is a loop
380 # (1) looks at the first item in the queue without shifting it off
382 # (2) cares for the item
384 # (3) removes the item from the queue, *even if its agenda failed and
385 # even if the item isn't the first in the queue anymore* (that way
386 # protecting against never ending queues)
388 # So if an item has prerequisites, the installation fails now, but we
389 # want to retry later. That's easy if we have it twice in the queue.
391 # I also expect insane dependency situations where an item gets more
392 # than two lives in the queue. Simplest example is triggered by 'install
393 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
394 # get in the way. I wanted the queue manager to be a dumb servant, not
395 # one that knows everything.
397 # Who would I tell in this model that the user wants to be asked before
398 # processing? I can't attach that information to the module object,
399 # because not modules are installed but distributions. So I'd have to
400 # tell the distribution object that it should ask the user before
401 # processing. Where would the question be triggered then? Most probably
402 # in CPAN::Distribution::rematein.
403 # Hope that makes sense, my head is a bit off:-) -- AK
408 my($class,$mod) = @_;
409 my $self = bless {mod => $mod}, $class;
411 # my @all = map { $_->{mod} } @All;
412 # warn "Adding Queue object for mod[$mod] all[@all]";
422 my($class,$what) = @_;
424 for my $i (0..$#All) {
425 if ( $All[$i]->{mod} eq $what ) {
436 WHAT: for my $what (reverse @what) {
438 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
439 if ($All[$i]->{mod} eq $what){
441 if ($jumped > 100) { # one's OK if e.g. just processing now;
442 # more are OK if user typed it several
444 $CPAN::Frontend->mywarn(
445 qq{Object [$what] queued more than 100 times, ignoring}
451 my $obj = bless { mod => $what }, $class;
457 my($self,$what) = @_;
458 my @all = map { $_->{mod} } @All;
459 my $exists = grep { $_->{mod} eq $what } @All;
460 # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]";
466 @All = grep { $_->{mod} ne $mod } @All;
467 # my @all = map { $_->{mod} } @All;
468 # warn "Deleting Queue object for mod[$mod] all[@all]";
479 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
483 # __END__ # uncomment this and AutoSplit version 1.01 will split it
485 #-> sub CPAN::autobundle ;
487 #-> sub CPAN::bundle ;
489 #-> sub CPAN::expand ;
491 #-> sub CPAN::force ;
493 #-> sub CPAN::install ;
497 #-> sub CPAN::clean ;
504 my($mgr,$class) = @_;
505 CPAN::Config->load unless $CPAN::Config_loaded++;
506 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
508 values %{ $META->{$class} };
510 *all = \&all_objects;
512 # Called by shell, not in batch mode. Not clean XXX
513 #-> sub CPAN::checklock ;
516 my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
517 if (-f $lockfile && -M _ > 0) {
518 my $fh = FileHandle->new($lockfile);
521 if (defined $other && $other) {
523 return if $$==$other; # should never happen
524 $CPAN::Frontend->mywarn(
526 There seems to be running another CPAN process ($other). Contacting...
528 if (kill 0, $other) {
529 $CPAN::Frontend->mydie(qq{Other job is running.
530 You may want to kill it and delete the lockfile, maybe. On UNIX try:
534 } elsif (-w $lockfile) {
536 ExtUtils::MakeMaker::prompt
537 (qq{Other job not responding. Shall I overwrite }.
538 qq{the lockfile? (Y/N)},"y");
539 $CPAN::Frontend->myexit("Ok, bye\n")
540 unless $ans =~ /^y/i;
543 qq{Lockfile $lockfile not writeable by you. }.
544 qq{Cannot proceed.\n}.
547 qq{ and then rerun us.\n}
552 my $dotcpan = $CPAN::Config->{cpan_home};
553 eval { File::Path::mkpath($dotcpan);};
555 # A special case at least for Jarkko.
560 $symlinkcpan = readlink $dotcpan;
561 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
562 eval { File::Path::mkpath($symlinkcpan); };
566 $CPAN::Frontend->mywarn(qq{
567 Working directory $symlinkcpan created.
571 unless (-d $dotcpan) {
573 Your configuration suggests "$dotcpan" as your
574 CPAN.pm working directory. I could not create this directory due
575 to this error: $firsterror\n};
577 As "$dotcpan" is a symlink to "$symlinkcpan",
578 I tried to create that, but I failed with this error: $seconderror
581 Please make sure the directory exists and is writable.
583 $CPAN::Frontend->mydie($diemess);
587 unless ($fh = FileHandle->new(">$lockfile")) {
588 if ($! =~ /Permission/) {
589 my $incc = $INC{'CPAN/Config.pm'};
590 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
591 $CPAN::Frontend->myprint(qq{
593 Your configuration suggests that CPAN.pm should use a working
595 $CPAN::Config->{cpan_home}
596 Unfortunately we could not create the lock file
598 due to permission problems.
600 Please make sure that the configuration variable
601 \$CPAN::Config->{cpan_home}
602 points to a directory where you can write a .lock file. You can set
603 this variable in either
610 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
612 $fh->print($$, "\n");
613 $self->{LOCK} = $lockfile;
617 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
622 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
623 print "Caught SIGINT\n";
627 # From: Larry Wall <larry@wall.org>
628 # Subject: Re: deprecating SIGDIE
629 # To: perl5-porters@perl.org
630 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
632 # The original intent of __DIE__ was only to allow you to substitute one
633 # kind of death for another on an application-wide basis without respect
634 # to whether you were in an eval or not. As a global backstop, it should
635 # not be used any more lightly (or any more heavily :-) than class
636 # UNIVERSAL. Any attempt to build a general exception model on it should
637 # be politely squashed. Any bug that causes every eval {} to have to be
638 # modified should be not so politely squashed.
640 # Those are my current opinions. It is also my optinion that polite
641 # arguments degenerate to personal arguments far too frequently, and that
642 # when they do, it's because both people wanted it to, or at least didn't
643 # sufficiently want it not to.
647 $SIG{'__DIE__'} = \&cleanup;
648 $self->debug("Signal handler set.") if $CPAN::DEBUG;
651 #-> sub CPAN::DESTROY ;
653 &cleanup; # need an eval?
657 sub cwd {Cwd::cwd();}
659 #-> sub CPAN::getcwd ;
660 sub getcwd {Cwd::getcwd();}
662 #-> sub CPAN::exists ;
664 my($mgr,$class,$id) = @_;
666 ### Carp::croak "exists called without class argument" unless $class;
668 exists $META->{$class}{$id};
671 #-> sub CPAN::delete ;
673 my($mgr,$class,$id) = @_;
674 delete $META->{$class}{$id};
677 #-> sub CPAN::has_usable
678 # has_inst is sometimes too optimistic, we should replace it with this
679 # has_usable whenever a case is given
681 my($self,$mod,$message) = @_;
682 return 1 if $HAS_USABLE->{$mod};
683 my $has_inst = $self->has_inst($mod,$message);
684 return unless $has_inst;
687 LWP => [ # we frequently had "Can't locate object
688 # method "new" via package
689 # "LWP::UserAgent" at (eval 69) line
692 sub {require LWP::UserAgent},
693 sub {require HTTP::Request},
694 sub {require URI::URL},
697 sub {require Net::FTP},
698 sub {require Net::Config},
701 if ($capabilities->{$mod}) {
702 for my $c (0..$#{$capabilities->{$mod}}) {
703 my $code = $capabilities->{$mod}[$c];
704 my $ret = eval { &$code() };
706 warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
711 return $HAS_USABLE->{$mod} = 1;
714 #-> sub CPAN::has_inst
716 my($self,$mod,$message) = @_;
717 Carp::croak("CPAN->has_inst() called without an argument")
719 if (defined $message && $message eq "no"
721 exists $CPAN::META->{dontload_hash}{$mod}
723 exists $CPAN::Config->{dontload_hash}{$mod}
725 $CPAN::META->{dontload_hash}{$mod}||=1;
731 $file =~ s|/|\\|g if $^O eq 'MSWin32';
734 # checking %INC is wrong, because $INC{LWP} may be true
735 # although $INC{"URI/URL.pm"} may have failed. But as
736 # I really want to say "bla loaded OK", I have to somehow
738 ### warn "$file in %INC"; #debug
740 } elsif (eval { require $file }) {
741 # eval is good: if we haven't yet read the database it's
742 # perfect and if we have installed the module in the meantime,
743 # it tries again. The second require is only a NOOP returning
744 # 1 if we had success, otherwise it's retrying
746 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
747 if ($mod eq "CPAN::WAIT") {
748 push @CPAN::Shell::ISA, CPAN::WAIT;
751 } elsif ($mod eq "Net::FTP") {
753 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
755 install Bundle::libnet
759 } elsif ($mod eq "MD5"){
760 $CPAN::Frontend->myprint(qq{
761 CPAN: MD5 security checks disabled because MD5 not installed.
762 Please consider installing the MD5 module.
767 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
772 #-> sub CPAN::instance ;
774 my($mgr,$class,$id) = @_;
777 $META->{$class}{$id} ||= $class->new(ID => $id );
785 #-> sub CPAN::cleanup ;
787 # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
788 local $SIG{__DIE__} = '';
793 0 && # disabled, try reload cpan with it
794 $] > 5.004_60 # thereabouts
799 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
801 $subroutine eq '(eval)';
804 return if $ineval && !$End;
805 return unless defined $META->{'LOCK'};
806 return unless -f $META->{'LOCK'};
807 unlink $META->{'LOCK'};
809 # Carp::cluck("DEBUGGING");
810 $CPAN::Frontend->mywarn("Lockfile removed.\n");
813 package CPAN::CacheMgr;
815 #-> sub CPAN::CacheMgr::as_string ;
817 eval { require Data::Dumper };
819 return shift->SUPER::as_string;
821 return Data::Dumper::Dumper(shift);
825 #-> sub CPAN::CacheMgr::cachesize ;
832 return unless -d $self->{ID};
833 while ($self->{DU} > $self->{'MAX'} ) {
834 my($toremove) = shift @{$self->{FIFO}};
835 $CPAN::Frontend->myprint(sprintf(
836 "Deleting from cache".
837 ": $toremove (%.1f>%.1f MB)\n",
838 $self->{DU}, $self->{'MAX'})
840 return if $CPAN::Signal;
841 $self->force_clean_cache($toremove);
842 return if $CPAN::Signal;
846 #-> sub CPAN::CacheMgr::dir ;
851 #-> sub CPAN::CacheMgr::entries ;
854 return unless defined $dir;
855 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
856 $dir ||= $self->{ID};
858 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
859 my($cwd) = CPAN->$getcwd();
860 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
861 my $dh = DirHandle->new(File::Spec->curdir)
862 or Carp::croak("Couldn't opendir $dir: $!");
865 next if $_ eq "." || $_ eq "..";
867 push @entries, MM->catfile($dir,$_);
869 push @entries, MM->catdir($dir,$_);
871 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
874 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
875 sort { -M $b <=> -M $a} @entries;
878 #-> sub CPAN::CacheMgr::disk_usage ;
881 return if exists $self->{SIZE}{$dir};
882 return if $CPAN::Signal;
886 $File::Find::prune++ if $CPAN::Signal;
888 if ($^O eq 'MacOS') {
890 my $cat = Mac::Files::FSpGetCatInfo($_);
891 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
898 return if $CPAN::Signal;
899 $self->{SIZE}{$dir} = $Du/1024/1024;
900 push @{$self->{FIFO}}, $dir;
901 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
902 $self->{DU} += $Du/1024/1024;
906 #-> sub CPAN::CacheMgr::force_clean_cache ;
907 sub force_clean_cache {
909 return unless -e $dir;
910 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
912 File::Path::rmtree($dir);
913 $self->{DU} -= $self->{SIZE}{$dir};
914 delete $self->{SIZE}{$dir};
917 #-> sub CPAN::CacheMgr::new ;
924 ID => $CPAN::Config->{'build_dir'},
925 MAX => $CPAN::Config->{'build_cache'},
926 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
929 File::Path::mkpath($self->{ID});
930 my $dh = DirHandle->new($self->{ID});
934 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
936 CPAN->debug($debug) if $CPAN::DEBUG;
940 #-> sub CPAN::CacheMgr::scan_cache ;
943 return if $self->{SCAN} eq 'never';
944 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
945 unless $self->{SCAN} eq 'atstart';
946 $CPAN::Frontend->myprint(
947 sprintf("Scanning cache %s for sizes\n",
950 for $e ($self->entries($self->{ID})) {
951 next if $e eq ".." || $e eq ".";
952 $self->disk_usage($e);
953 return if $CPAN::Signal;
960 #-> sub CPAN::Debug::debug ;
963 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
964 # Complete, caller(1)
966 ($caller) = caller(0);
968 $arg = "" unless defined $arg;
969 my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
970 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
971 if ($arg and ref $arg) {
972 eval { require Data::Dumper };
974 $CPAN::Frontend->myprint($arg->as_string);
976 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
979 $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
984 package CPAN::Config;
986 #-> sub CPAN::Config::edit ;
987 # returns true on successful action
989 my($class,@args) = @_;
991 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
992 my($o,$str,$func,$args,$key_exists);
998 CPAN->debug("o[$o]");
1000 $func = shift @args;
1002 CPAN->debug("func[$func]");
1004 # Let's avoid eval, it's easier to comprehend without.
1005 if ($func eq "push") {
1006 push @{$CPAN::Config->{$o}}, @args;
1008 } elsif ($func eq "pop") {
1009 pop @{$CPAN::Config->{$o}};
1011 } elsif ($func eq "shift") {
1012 shift @{$CPAN::Config->{$o}};
1014 } elsif ($func eq "unshift") {
1015 unshift @{$CPAN::Config->{$o}}, @args;
1017 } elsif ($func eq "splice") {
1018 splice @{$CPAN::Config->{$o}}, @args;
1021 $CPAN::Config->{$o} = [@args];
1024 $CPAN::Frontend->myprint(
1027 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
1031 if ($o eq "urllist" && $changed) {
1032 # reset the cached values
1033 undef $CPAN::FTP::Thesite;
1034 undef $CPAN::FTP::Themethod;
1038 $CPAN::Config->{$o} = $args[0] if defined $args[0];
1039 $CPAN::Frontend->myprint(" $o " .
1040 (defined $CPAN::Config->{$o} ?
1041 $CPAN::Config->{$o} : "UNDEFINED"));
1046 #-> sub CPAN::Config::commit ;
1048 my($self,$configpm) = @_;
1049 unless (defined $configpm){
1050 $configpm ||= $INC{"CPAN/MyConfig.pm"};
1051 $configpm ||= $INC{"CPAN/Config.pm"};
1052 $configpm || Carp::confess(q{
1053 CPAN::Config::commit called without an argument.
1054 Please specify a filename where to save the configuration or try
1055 "o conf init" to have an interactive course through configing.
1060 $mode = (stat $configpm)[2];
1061 if ($mode && ! -w _) {
1062 Carp::confess("$configpm is not writable");
1067 $msg = <<EOF unless $configpm =~ /MyConfig/;
1069 # This is CPAN.pm's systemwide configuration file. This file provides
1070 # defaults for users, and the values can be changed in a per-user
1071 # configuration file. The user-config file is being looked for as
1072 # ~/.cpan/CPAN/MyConfig.pm.
1076 my($fh) = FileHandle->new;
1077 rename $configpm, "$configpm~" if -f $configpm;
1078 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
1079 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
1080 foreach (sort keys %$CPAN::Config) {
1083 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
1088 $fh->print("};\n1;\n__END__\n");
1091 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
1092 #chmod $mode, $configpm;
1093 ###why was that so? $self->defaults;
1094 $CPAN::Frontend->myprint("commit: wrote $configpm\n");
1098 *default = \&defaults;
1099 #-> sub CPAN::Config::defaults ;
1109 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
1118 #-> sub CPAN::Config::load ;
1123 eval {require CPAN::Config;}; # We eval because of some
1124 # MakeMaker problems
1125 unless ($dot_cpan++){
1126 unshift @INC, MM->catdir($ENV{HOME},".cpan");
1127 eval {require CPAN::MyConfig;}; # where you can override
1128 # system wide settings
1131 return unless @miss = $self->not_loaded;
1132 # XXX better check for arrayrefs too
1133 require CPAN::FirstTime;
1134 my($configpm,$fh,$redo,$theycalled);
1136 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
1137 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
1138 $configpm = $INC{"CPAN/Config.pm"};
1140 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
1141 $configpm = $INC{"CPAN/MyConfig.pm"};
1144 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
1145 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
1146 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
1147 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
1148 if (-w $configpmtest) {
1149 $configpm = $configpmtest;
1150 } elsif (-w $configpmdir) {
1151 #_#_# following code dumped core on me with 5.003_11, a.k.
1152 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
1153 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
1154 my $fh = FileHandle->new;
1155 if ($fh->open(">$configpmtest")) {
1157 $configpm = $configpmtest;
1159 # Should never happen
1160 Carp::confess("Cannot open >$configpmtest");
1164 unless ($configpm) {
1165 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
1166 File::Path::mkpath($configpmdir);
1167 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
1168 if (-w $configpmtest) {
1169 $configpm = $configpmtest;
1170 } elsif (-w $configpmdir) {
1171 #_#_# following code dumped core on me with 5.003_11, a.k.
1172 my $fh = FileHandle->new;
1173 if ($fh->open(">$configpmtest")) {
1175 $configpm = $configpmtest;
1177 # Should never happen
1178 Carp::confess("Cannot open >$configpmtest");
1181 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
1182 qq{create a configuration file.});
1187 $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
1188 We have to reconfigure CPAN.pm due to following uninitialized parameters:
1192 $CPAN::Frontend->myprint(qq{
1193 $configpm initialized.
1196 CPAN::FirstTime::init($configpm);
1199 #-> sub CPAN::Config::not_loaded ;
1203 cpan_home keep_source_where build_dir build_cache scan_cache
1204 index_expire gzip tar unzip make pager makepl_arg make_arg
1205 make_install_arg urllist inhibit_startup_message
1206 ftp_proxy http_proxy no_proxy prerequisites_policy
1208 push @miss, $_ unless defined $CPAN::Config->{$_};
1213 #-> sub CPAN::Config::unload ;
1215 delete $INC{'CPAN/MyConfig.pm'};
1216 delete $INC{'CPAN/Config.pm'};
1219 #-> sub CPAN::Config::help ;
1221 $CPAN::Frontend->myprint(q[
1223 defaults reload default config values from disk
1224 commit commit session changes to disk
1225 init go through a dialog to set all parameters
1227 You may edit key values in the follow fashion (the "o" is a literal
1230 o conf build_cache 15
1232 o conf build_dir "/foo/bar"
1234 o conf urllist shift
1236 o conf urllist unshift ftp://ftp.foo.bar/
1239 undef; #don't reprint CPAN::Config
1242 #-> sub CPAN::Config::cpl ;
1244 my($word,$line,$pos) = @_;
1246 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1247 my(@words) = split " ", substr($line,0,$pos+1);
1252 $words[2] =~ /list$/ && @words == 3
1254 $words[2] =~ /list$/ && @words == 4 && length($word)
1257 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
1258 } elsif (@words >= 4) {
1261 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
1262 return grep /^\Q$word\E/, @o_conf;
1265 package CPAN::Shell;
1267 #-> sub CPAN::Shell::h ;
1269 my($class,$about) = @_;
1270 if (defined $about) {
1271 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1273 $CPAN::Frontend->myprint(q{
1276 b string display bundles
1277 d or info distributions
1278 m /regex/ about modules
1279 i or anything of above
1280 r none reinstall recommendations
1281 u uninstalled distributions
1283 Download, Test, Make, Install...
1285 make make (implies get)
1286 test modules, make test (implies make)
1287 install dists, bundles make install (implies test)
1289 look open subshell in these dists' directories
1290 readme display these dists' README files
1293 h,? display this menu ! perl-code eval a perl command
1294 o conf [opt] set and query options q quit the cpan shell
1295 reload cpan load CPAN.pm again reload index load newer indices
1296 autobundle Snapshot force cmd unconditionally do cmd});
1302 #-> sub CPAN::Shell::a ;
1304 my($self,@arg) = @_;
1305 # authors are always UPPERCASE
1309 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1311 #-> sub CPAN::Shell::b ;
1313 my($self,@which) = @_;
1314 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1315 my($incdir,$bdir,$dh);
1316 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1317 $bdir = MM->catdir($incdir,"Bundle");
1318 if ($dh = DirHandle->new($bdir)) { # may fail
1320 for $entry ($dh->read) {
1321 next if -d MM->catdir($bdir,$entry);
1322 next unless $entry =~ s/\.pm\z//;
1323 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
1327 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1329 #-> sub CPAN::Shell::d ;
1330 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1331 #-> sub CPAN::Shell::m ;
1332 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1333 $CPAN::Frontend->myprint(shift->format_result('Module',@_));
1336 #-> sub CPAN::Shell::i ;
1341 @type = qw/Author Bundle Distribution Module/;
1342 @args = '/./' unless @args;
1345 push @result, $self->expand($type,@args);
1347 my $result = @result == 1 ?
1348 $result[0]->as_string :
1349 join "", map {$_->as_glimpse} @result;
1350 $result ||= "No objects found of any type for argument @args\n";
1351 $CPAN::Frontend->myprint($result);
1354 #-> sub CPAN::Shell::o ;
1356 my($self,$o_type,@o_what) = @_;
1358 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1359 if ($o_type eq 'conf') {
1360 shift @o_what if @o_what && $o_what[0] eq 'help';
1363 $CPAN::Frontend->myprint("CPAN::Config options");
1364 if (exists $INC{'CPAN/Config.pm'}) {
1365 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1367 if (exists $INC{'CPAN/MyConfig.pm'}) {
1368 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1370 $CPAN::Frontend->myprint(":\n");
1371 for $k (sort keys %CPAN::Config::can) {
1372 $v = $CPAN::Config::can{$k};
1373 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1375 $CPAN::Frontend->myprint("\n");
1376 for $k (sort keys %$CPAN::Config) {
1377 $v = $CPAN::Config->{$k};
1379 my(@report) = ref $v eq "ARRAY" ? @$v : %$v;
1380 $CPAN::Frontend->myprint(
1387 map {"\t$_\n"} @report
1391 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1394 $CPAN::Frontend->myprint("\n");
1395 } elsif (!CPAN::Config->edit(@o_what)) {
1396 $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]);
1398 } elsif ($o_type eq 'debug') {
1400 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1403 my($what) = shift @o_what;
1404 if ( exists $CPAN::DEBUG{$what} ) {
1405 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1406 } elsif ($what =~ /^\d/) {
1407 $CPAN::DEBUG = $what;
1408 } elsif (lc $what eq 'all') {
1410 for (values %CPAN::DEBUG) {
1413 $CPAN::DEBUG = $max;
1416 for (keys %CPAN::DEBUG) {
1417 next unless lc($_) eq lc($what);
1418 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1421 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1426 my $raw = "Valid options for debug are ".
1427 join(", ",sort(keys %CPAN::DEBUG), 'all').
1428 qq{ or a number. Completion works on the options. }.
1429 qq{Case is ignored.};
1431 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1432 $CPAN::Frontend->myprint("\n\n");
1435 $CPAN::Frontend->myprint("Options set for debugging:\n");
1437 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1438 $v = $CPAN::DEBUG{$k};
1439 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
1442 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1445 $CPAN::Frontend->myprint(qq{
1447 conf set or get configuration variables
1448 debug set or get debugging options
1453 sub dotdot_onreload {
1456 if ( $_[0] =~ /Subroutine (\w+) redefined/ ) {
1460 # $CPAN::Frontend->myprint(".($subr)");
1461 $CPAN::Frontend->myprint(".");
1468 #-> sub CPAN::Shell::reload ;
1470 my($self,$command,@arg) = @_;
1472 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1473 if ($command =~ /cpan/i) {
1474 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
1475 my $fh = FileHandle->new($INC{'CPAN.pm'});
1478 local($SIG{__WARN__}) = dotdot_onreload(\$redef);
1481 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1482 } elsif ($command =~ /index/) {
1483 CPAN::Index->force_reload;
1485 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1486 index re-reads the index files\n});
1490 #-> sub CPAN::Shell::_binary_extensions ;
1491 sub _binary_extensions {
1492 my($self) = shift @_;
1493 my(@result,$module,%seen,%need,$headerdone);
1494 my $isaperl = q{ perl
1498 \\d{3}(_[0-4][0-9])?
1504 for $module ($self->expand('Module','/./')) {
1505 my $file = $module->cpan_file;
1506 next if $file eq "N/A";
1507 next if $file =~ /^Contact Author/;
1508 next if $file =~ / $isaperl /x;
1509 next unless $module->xs_file;
1511 $CPAN::Frontend->myprint(".");
1512 push @result, $module;
1514 # print join " | ", @result;
1515 $CPAN::Frontend->myprint("\n");
1519 #-> sub CPAN::Shell::recompile ;
1521 my($self) = shift @_;
1522 my($module,@module,$cpan_file,%dist);
1523 @module = $self->_binary_extensions();
1524 for $module (@module){ # we force now and compile later, so we
1526 $cpan_file = $module->cpan_file;
1527 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1529 $dist{$cpan_file}++;
1531 for $cpan_file (sort keys %dist) {
1532 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1533 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1535 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1536 # stop a package from recompiling,
1537 # e.g. IO-1.12 when we have perl5.003_10
1541 #-> sub CPAN::Shell::_u_r_common ;
1543 my($self) = shift @_;
1544 my($what) = shift @_;
1545 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1546 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1547 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1549 @args = '/./' unless @args;
1550 my(@result,$module,%seen,%need,$headerdone,
1551 $version_undefs,$version_zeroes);
1552 $version_undefs = $version_zeroes = 0;
1553 my $sprintf = "%-25s %9s %9s %s\n";
1554 for $module ($self->expand('Module',@args)) {
1555 my $file = $module->cpan_file;
1556 next unless defined $file; # ??
1557 my($latest) = $module->cpan_version;
1558 my($inst_file) = $module->inst_file;
1560 return if $CPAN::Signal;
1563 $have = $module->inst_version;
1564 } elsif ($what eq "r") {
1565 $have = $module->inst_version;
1567 if ($have eq "undef"){
1569 } elsif ($have == 0){
1572 next if $have >= $latest;
1573 # to be pedantic we should probably say:
1574 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1575 # to catch the case where CPAN has a version 0 and we have a version undef
1576 } elsif ($what eq "u") {
1582 } elsif ($what eq "r") {
1584 } elsif ($what eq "u") {
1588 return if $CPAN::Signal; # this is sometimes lengthy
1591 push @result, sprintf "%s %s\n", $module->id, $have;
1592 } elsif ($what eq "r") {
1593 push @result, $module->id;
1594 next if $seen{$file}++;
1595 } elsif ($what eq "u") {
1596 push @result, $module->id;
1597 next if $seen{$file}++;
1598 next if $file =~ /^Contact/;
1600 unless ($headerdone++){
1601 $CPAN::Frontend->myprint("\n");
1602 $CPAN::Frontend->myprint(sprintf(
1604 "Package namespace",
1610 $latest = substr($latest,0,8) if length($latest) > 8;
1611 $have = substr($have,0,8) if length($have) > 8;
1612 $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
1613 $need{$module->id}++;
1617 $CPAN::Frontend->myprint("No modules found for @args\n");
1618 } elsif ($what eq "r") {
1619 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1623 if ($version_zeroes) {
1624 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1625 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1626 qq{a version number of 0\n});
1628 if ($version_undefs) {
1629 my $s_has = $version_undefs > 1 ? "s have" : " has";
1630 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1631 qq{parseable version number\n});
1637 #-> sub CPAN::Shell::r ;
1639 shift->_u_r_common("r",@_);
1642 #-> sub CPAN::Shell::u ;
1644 shift->_u_r_common("u",@_);
1647 #-> sub CPAN::Shell::autobundle ;
1650 CPAN::Config->load unless $CPAN::Config_loaded++;
1651 my(@bundle) = $self->_u_r_common("a",@_);
1652 my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1653 File::Path::mkpath($todir);
1654 unless (-d $todir) {
1655 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1658 my($y,$m,$d) = (localtime)[5,4,3];
1662 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1663 my($to) = MM->catfile($todir,"$me.pm");
1665 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1666 $to = MM->catfile($todir,"$me.pm");
1668 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1670 "package Bundle::$me;\n\n",
1671 "\$VERSION = '0.01';\n\n",
1675 "Bundle::$me - Snapshot of installation on ",
1676 $Config::Config{'myhostname'},
1679 "\n\n=head1 SYNOPSIS\n\n",
1680 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1681 "=head1 CONTENTS\n\n",
1682 join("\n", @bundle),
1683 "\n\n=head1 CONFIGURATION\n\n",
1685 "\n\n=head1 AUTHOR\n\n",
1686 "This Bundle has been generated automatically ",
1687 "by the autobundle routine in CPAN.pm.\n",
1690 $CPAN::Frontend->myprint("\nWrote bundle file
1694 #-> sub CPAN::Shell::expand ;
1697 my($type,@args) = @_;
1701 if ($arg =~ m|^/(.*)/$|) {
1704 my $class = "CPAN::$type";
1706 if (defined $regex) {
1710 $CPAN::META->all_objects($class)
1713 # BUG, we got an empty object somewhere
1714 CPAN->debug(sprintf(
1715 "Empty id on obj[%s]%%[%s]",
1722 if $obj->id =~ /$regex/i
1726 $] < 5.00303 ### provide sort of
1727 ### compatibility with 5.003
1732 $obj->name =~ /$regex/i
1737 if ( $type eq 'Bundle' ) {
1738 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1740 if ($CPAN::META->exists($class,$xarg)) {
1741 $obj = $CPAN::META->instance($class,$xarg);
1742 } elsif ($CPAN::META->exists($class,$arg)) {
1743 $obj = $CPAN::META->instance($class,$arg);
1750 return wantarray ? @m : $m[0];
1753 #-> sub CPAN::Shell::format_result ;
1756 my($type,@args) = @_;
1757 @args = '/./' unless @args;
1758 my(@result) = $self->expand($type,@args);
1759 my $result = @result == 1 ?
1760 $result[0]->as_string :
1761 join "", map {$_->as_glimpse} @result;
1762 $result ||= "No objects of type $type found for argument @args\n";
1766 # The only reason for this method is currently to have a reliable
1767 # debugging utility that reveals which output is going through which
1768 # channel. No, I don't like the colors ;-)
1769 sub print_ornamented {
1770 my($self,$what,$ornament) = @_;
1772 my $ornamenting = 0; # turn the colors on
1775 unless (defined &color) {
1776 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1777 import Term::ANSIColor "color";
1779 *color = sub { return "" };
1783 for $line (split /\n/, $what) {
1784 $longest = length($line) if length($line) > $longest;
1786 my $sprintf = "%-" . $longest . "s";
1788 $what =~ s/(.*\n?)//m;
1791 my($nl) = chomp $line ? "\n" : "";
1792 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
1793 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
1801 my($self,$what) = @_;
1802 $self->print_ornamented($what, 'bold blue on_yellow');
1806 my($self,$what) = @_;
1807 $self->myprint($what);
1812 my($self,$what) = @_;
1813 $self->print_ornamented($what, 'bold red on_yellow');
1817 my($self,$what) = @_;
1818 $self->print_ornamented($what, 'bold red on_white');
1819 Carp::confess "died";
1823 my($self,$what) = @_;
1824 $self->print_ornamented($what, 'bold red on_white');
1829 return if -t STDOUT;
1830 my $odef = select STDERR;
1837 #-> sub CPAN::Shell::rematein ;
1838 # RE-adme||MA-ke||TE-st||IN-stall
1841 my($meth,@some) = @_;
1843 if ($meth eq 'force') {
1845 $meth = shift @some;
1848 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1850 foreach $s (@some) {
1851 CPAN::Queue->new($s);
1853 while ($s = CPAN::Queue->first) {
1857 } elsif ($s =~ m|/|) { # looks like a file
1858 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1859 } elsif ($s =~ m|^Bundle::|) {
1860 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1862 $obj = $CPAN::META->instance('CPAN::Module',$s)
1863 if $CPAN::META->exists('CPAN::Module',$s);
1867 qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
1875 ($] < 5.00303 || $obj->can($pragma)); ###
1879 if ($]>=5.00303 && $obj->can('called_for')) {
1880 $obj->called_for($s);
1882 CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
1885 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1886 $obj = $CPAN::META->instance('CPAN::Author',$s);
1887 $CPAN::Frontend->myprint(
1889 "Don't be silly, you can't $meth ",
1895 ->myprint(qq{Warning: Cannot $meth $s, }.
1896 qq{don\'t know what it is.
1901 to find objects with similar identifiers.
1904 CPAN::Queue->delete_first($s);
1908 #-> sub CPAN::Shell::force ;
1909 sub force { shift->rematein('force',@_); }
1910 #-> sub CPAN::Shell::get ;
1911 sub get { shift->rematein('get',@_); }
1912 #-> sub CPAN::Shell::readme ;
1913 sub readme { shift->rematein('readme',@_); }
1914 #-> sub CPAN::Shell::make ;
1915 sub make { shift->rematein('make',@_); }
1916 #-> sub CPAN::Shell::test ;
1917 sub test { shift->rematein('test',@_); }
1918 #-> sub CPAN::Shell::install ;
1919 sub install { shift->rematein('install',@_); }
1920 #-> sub CPAN::Shell::clean ;
1921 sub clean { shift->rematein('clean',@_); }
1922 #-> sub CPAN::Shell::look ;
1923 sub look { shift->rematein('look',@_); }
1924 #-> sub CPAN::Shell::cvs_import ;
1925 sub cvs_import { shift->rematein('cvs_import',@_); }
1929 #-> sub CPAN::FTP::ftp_get ;
1931 my($class,$host,$dir,$file,$target) = @_;
1933 qq[Going to fetch file [$file] from dir [$dir]
1934 on host [$host] as local [$target]\n]
1936 my $ftp = Net::FTP->new($host);
1937 return 0 unless defined $ftp;
1938 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1939 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1940 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1941 warn "Couldn't login on $host";
1944 unless ( $ftp->cwd($dir) ){
1945 warn "Couldn't cwd $dir";
1949 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1950 unless ( $ftp->get($file,$target) ){
1951 warn "Couldn't fetch $file from $host\n";
1954 $ftp->quit; # it's ok if this fails
1958 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
1960 # leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
1961 # leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997
1962 # leach,> ***************
1963 # leach,> *** 1562,1567 ****
1964 # leach,> --- 1562,1580 ----
1965 # leach,> return 1 if substr($url,0,4) eq "file";
1966 # leach,> return 1 unless $url =~ m|://([^/]+)|;
1967 # leach,> my $host = $1;
1968 # leach,> + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1969 # leach,> + if ($proxy) {
1970 # leach,> + $proxy =~ m|://([^/:]+)|;
1971 # leach,> + $proxy = $1;
1972 # leach,> + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1973 # leach,> + if ($noproxy) {
1974 # leach,> + if ($host !~ /$noproxy$/) {
1975 # leach,> + $host = $proxy;
1977 # leach,> + } else {
1978 # leach,> + $host = $proxy;
1981 # leach,> require Net::Ping;
1982 # leach,> return 1 unless $Net::Ping::VERSION >= 2;
1986 # this is quite optimistic and returns one on several occasions where
1987 # inappropriate. But this does no harm. It would do harm if we were
1988 # too pessimistic (as I was before the http_proxy
1990 my($self,$url) = @_;
1991 return 1; # we can't simply roll our own, firewalls may break ping
1992 return 0 unless $url;
1993 return 1 if substr($url,0,4) eq "file";
1994 return 1 unless $url =~ m|^(\w+)://([^/]+)|;
1995 my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy
1997 return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype};
1999 return 1 unless $Net::Ping::VERSION >= 2;
2001 # 1.3101 had it different: only if the first eval raised an
2002 # exception we tried it with TCP. Now we are happy if icmp wins
2003 # the order and return, we don't even check for $@. Thanks to
2004 # thayer@uis.edu for the suggestion.
2005 eval {$p = Net::Ping->new("icmp");};
2006 return 1 if $p && ref($p) && $p->ping($host, 10);
2007 eval {$p = Net::Ping->new("tcp");};
2008 $CPAN::Frontend->mydie($@) if $@;
2009 return $p->ping($host, 10);
2012 #-> sub CPAN::FTP::localize ;
2013 # sorry for the ugly code here, I'll clean it up as soon as Net::FTP
2016 my($self,$file,$aslocal,$force) = @_;
2018 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2019 unless defined $aslocal;
2020 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2023 if ($^O eq 'MacOS') {
2024 my($name, $path) = File::Basename::fileparse($aslocal, '');
2025 if (length($name) > 31) {
2026 $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//;
2028 my $size = 31 - length($suf);
2029 while (length($name) > $size) {
2033 $aslocal = File::Spec->catfile($path, $name);
2037 return $aslocal if -f $aslocal && -r _ && !($force & 1);
2040 rename $aslocal, "$aslocal.bak";
2044 my($aslocal_dir) = File::Basename::dirname($aslocal);
2045 File::Path::mkpath($aslocal_dir);
2046 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2047 qq{directory "$aslocal_dir".
2048 I\'ll continue, but if you encounter problems, they may be due
2049 to insufficient permissions.\n}) unless -w $aslocal_dir;
2051 # Inheritance is not easier to manage than a few if/else branches
2052 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2054 $Ua = LWP::UserAgent->new;
2056 $Ua->proxy('ftp', $var)
2057 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
2058 $Ua->proxy('http', $var)
2059 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2061 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2065 # Try the list of urls for each single object. We keep a record
2066 # where we did get a file from
2067 my(@reordered,$last);
2068 $CPAN::Config->{urllist} ||= [];
2069 $last = $#{$CPAN::Config->{urllist}};
2070 if ($force & 2) { # local cpans probably out of date, don't reorder
2071 @reordered = (0..$last);
2075 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2077 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2088 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2090 @levels = qw/easy hard hardest/;
2092 @levels = qw/easy/ if $^O eq 'MacOS';
2093 for $level (@levels) {
2094 my $method = "host$level";
2095 my @host_seq = $level eq "easy" ?
2096 @reordered : 0..$last; # reordered has CDROM up front
2097 @host_seq = (0) unless @host_seq;
2098 my $ret = $self->$method(\@host_seq,$file,$aslocal);
2100 $Themethod = $level;
2102 # utime $now, $now, $aslocal; # too bad, if we do that, we
2103 # might alter a local mirror
2104 $self->debug("level[$level]") if $CPAN::DEBUG;
2112 qq{Please check, if the URLs I found in your configuration file \(}.
2113 join(", ", @{$CPAN::Config->{urllist}}).
2114 qq{\) are valid. The urllist can be edited.},
2115 qq{E.g. with ``o conf urllist push ftp://myurl/''};
2116 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2118 $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
2120 rename "$aslocal.bak", $aslocal;
2121 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2122 $self->ls($aslocal));
2129 my($self,$host_seq,$file,$aslocal) = @_;
2131 HOSTEASY: for $i (@$host_seq) {
2132 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2133 unless ($self->is_reachable($url)) {
2134 $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
2138 $url .= "/" unless substr($url,-1) eq "/";
2140 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2141 if ($url =~ /^file:/) {
2143 if ($CPAN::META->has_inst('URI::URL')) {
2144 my $u = URI::URL->new($url);
2146 } else { # works only on Unix, is poorly constructed, but
2147 # hopefully better than nothing.
2148 # RFC 1738 says fileurl BNF is
2149 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2150 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2152 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2153 $l =~ s|^file:||; # assume they
2156 $l =~ s|^/||s unless -f $l; # e.g. /P:
2158 if ( -f $l && -r _) {
2162 # Maybe mirror has compressed it?
2164 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2165 CPAN::Tarzip->gunzip("$l.gz", $aslocal);
2172 if ($CPAN::META->has_usable('LWP')) {
2173 $CPAN::Frontend->myprint("Fetching with LWP:
2177 require LWP::UserAgent;
2178 $Ua = LWP::UserAgent->new;
2180 my $res = $Ua->mirror($url, $aslocal);
2181 if ($res->is_success) {
2184 utime $now, $now, $aslocal; # download time is more
2185 # important than upload time
2187 } elsif ($url !~ /\.gz\z/) {
2188 my $gzurl = "$url.gz";
2189 $CPAN::Frontend->myprint("Fetching with LWP:
2192 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2193 if ($res->is_success &&
2194 CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
2202 # Alan Burlison informed me that in firewall envs Net::FTP
2203 # can still succeed where LWP fails. So we do not skip
2204 # Net::FTP anymore when LWP is available.
2208 $self->debug("LWP not installed") if $CPAN::DEBUG;
2210 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2211 # that's the nice and easy way thanks to Graham
2212 my($host,$dir,$getfile) = ($1,$2,$3);
2213 if ($CPAN::META->has_usable('Net::FTP')) {
2215 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2218 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2219 "aslocal[$aslocal]") if $CPAN::DEBUG;
2220 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2224 if ($aslocal !~ /\.gz\z/) {
2225 my $gz = "$aslocal.gz";
2226 $CPAN::Frontend->myprint("Fetching with Net::FTP
2229 if (CPAN::FTP->ftp_get($host,
2233 CPAN::Tarzip->gunzip($gz,$aslocal)
2246 my($self,$host_seq,$file,$aslocal) = @_;
2248 # Came back if Net::FTP couldn't establish connection (or
2249 # failed otherwise) Maybe they are behind a firewall, but they
2250 # gave us a socksified (or other) ftp program...
2253 my($devnull) = $CPAN::Config->{devnull} || "";
2255 my($aslocal_dir) = File::Basename::dirname($aslocal);
2256 File::Path::mkpath($aslocal_dir);
2257 HOSTHARD: for $i (@$host_seq) {
2258 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2259 unless ($self->is_reachable($url)) {
2260 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2263 $url .= "/" unless substr($url,-1) eq "/";
2265 my($proto,$host,$dir,$getfile);
2267 # Courtesy Mark Conty mark_conty@cargill.com change from
2268 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2270 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2271 # proto not yet used
2272 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2274 next HOSTHARD; # who said, we could ftp anything except ftp?
2277 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2279 for $f ('lynx','ncftpget','ncftp') {
2280 next unless exists $CPAN::Config->{$f};
2281 $funkyftp = $CPAN::Config->{$f};
2282 next unless defined $funkyftp;
2283 next if $funkyftp =~ /^\s*$/;
2284 my($asl_ungz, $asl_gz);
2285 ($asl_ungz = $aslocal) =~ s/\.gz//;
2286 $asl_gz = "$asl_ungz.gz";
2287 my($src_switch) = "";
2289 $src_switch = " -source";
2290 } elsif ($f eq "ncftp"){
2291 $src_switch = " -c";
2294 my($stdout_redir) = " > $asl_ungz";
2295 if ($f eq "ncftpget"){
2296 $chdir = "cd $aslocal_dir && ";
2299 $CPAN::Frontend->myprint(
2301 Trying with "$funkyftp$src_switch" to get
2305 "$chdir$funkyftp$src_switch '$url' $devnull$stdout_redir";
2306 $self->debug("system[$system]") if $CPAN::DEBUG;
2308 if (($wstatus = system($system)) == 0
2311 -s $asl_ungz # lynx returns 0 on my
2312 # system even if it fails
2318 } elsif ($asl_ungz ne $aslocal) {
2319 # test gzip integrity
2321 CPAN::Tarzip->gtest($asl_ungz)
2323 rename $asl_ungz, $aslocal;
2325 CPAN::Tarzip->gzip($asl_ungz,$asl_gz);
2330 } elsif ($url !~ /\.gz\z/) {
2332 -f $asl_ungz && -s _ == 0;
2333 my $gz = "$aslocal.gz";
2334 my $gzurl = "$url.gz";
2335 $CPAN::Frontend->myprint(
2337 Trying with "$funkyftp$src_switch" to get
2340 my($system) = "$funkyftp$src_switch '$url.gz' $devnull > $asl_gz";
2341 $self->debug("system[$system]") if $CPAN::DEBUG;
2343 if (($wstatus = system($system)) == 0
2347 # test gzip integrity
2348 if (CPAN::Tarzip->gtest($asl_gz)) {
2349 CPAN::Tarzip->gunzip($asl_gz,$aslocal);
2351 rename $asl_ungz, $aslocal;
2356 unlink $asl_gz if -f $asl_gz;
2359 my $estatus = $wstatus >> 8;
2360 my $size = -f $aslocal ?
2361 ", left\n$aslocal with size ".-s _ :
2362 "\nWarning: expected file [$aslocal] doesn't exist";
2363 $CPAN::Frontend->myprint(qq{
2364 System call "$system"
2365 returned status $estatus (wstat $wstatus)$size
2373 my($self,$host_seq,$file,$aslocal) = @_;
2376 my($aslocal_dir) = File::Basename::dirname($aslocal);
2377 File::Path::mkpath($aslocal_dir);
2378 HOSTHARDEST: for $i (@$host_seq) {
2379 unless (length $CPAN::Config->{'ftp'}) {
2380 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2383 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2384 unless ($self->is_reachable($url)) {
2385 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2388 $url .= "/" unless substr($url,-1) eq "/";
2390 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2391 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2394 my($host,$dir,$getfile) = ($1,$2,$3);
2396 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2397 $ctime,$blksize,$blocks) = stat($aslocal);
2398 $timestamp = $mtime ||= 0;
2399 my($netrc) = CPAN::FTP::netrc->new;
2400 my($netrcfile) = $netrc->netrc;
2401 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2402 my $targetfile = File::Basename::basename($aslocal);
2408 map("cd $_", split "/", $dir), # RFC 1738
2410 "get $getfile $targetfile",
2414 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2415 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2416 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2418 $netrc->contains($host))) if $CPAN::DEBUG;
2419 if ($netrc->protected) {
2420 $CPAN::Frontend->myprint(qq{
2421 Trying with external ftp to get
2423 As this requires some features that are not thoroughly tested, we\'re
2424 not sure, that we get it right....
2428 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
2430 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2431 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2433 if ($mtime > $timestamp) {
2434 $CPAN::Frontend->myprint("GOT $aslocal\n");
2438 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2441 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2442 qq{correctly protected.\n});
2445 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2446 nor does it have a default entry\n");
2449 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2450 # then and login manually to host, using e-mail as
2452 $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
2456 "user anonymous $Config::Config{'cf_email'}"
2458 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
2459 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2460 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2462 if ($mtime > $timestamp) {
2463 $CPAN::Frontend->myprint("GOT $aslocal\n");
2467 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2469 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2475 my($self,$command,@dialog) = @_;
2476 my $fh = FileHandle->new;
2477 $fh->open("|$command") or die "Couldn't open ftp: $!";
2478 foreach (@dialog) { $fh->print("$_\n") }
2479 $fh->close; # Wait for process to complete
2481 my $estatus = $wstatus >> 8;
2482 $CPAN::Frontend->myprint(qq{
2483 Subprocess "|$command"
2484 returned status $estatus (wstat $wstatus)
2488 # find2perl needs modularization, too, all the following is stolen
2492 my($self,$name) = @_;
2493 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2494 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2496 my($perms,%user,%group);
2500 $blocks = int(($blocks + 1) / 2);
2503 $blocks = int(($sizemm + 1023) / 1024);
2506 if (-f _) { $perms = '-'; }
2507 elsif (-d _) { $perms = 'd'; }
2508 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2509 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2510 elsif (-p _) { $perms = 'p'; }
2511 elsif (-S _) { $perms = 's'; }
2512 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2514 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2515 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2516 my $tmpmode = $mode;
2517 my $tmp = $rwx[$tmpmode & 7];
2519 $tmp = $rwx[$tmpmode & 7] . $tmp;
2521 $tmp = $rwx[$tmpmode & 7] . $tmp;
2522 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
2523 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
2524 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
2527 my $user = $user{$uid} || $uid; # too lazy to implement lookup
2528 my $group = $group{$gid} || $gid;
2530 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
2532 my($moname) = $moname[$mon];
2533 if (-M _ > 365.25 / 2) {
2534 $timeyear = $year + 1900;
2537 $timeyear = sprintf("%02d:%02d", $hour, $min);
2540 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
2554 package CPAN::FTP::netrc;
2558 my $file = MM->catfile($ENV{HOME},".netrc");
2560 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2561 $atime,$mtime,$ctime,$blksize,$blocks)
2566 my($fh,@machines,$hasdefault);
2568 $fh = FileHandle->new or die "Could not create a filehandle";
2570 if($fh->open($file)){
2571 $protected = ($mode & 077) == 0;
2573 NETRC: while (<$fh>) {
2574 my(@tokens) = split " ", $_;
2575 TOKEN: while (@tokens) {
2576 my($t) = shift @tokens;
2577 if ($t eq "default"){
2581 last TOKEN if $t eq "macdef";
2582 if ($t eq "machine") {
2583 push @machines, shift @tokens;
2588 $file = $hasdefault = $protected = "";
2592 'mach' => [@machines],
2594 'hasdefault' => $hasdefault,
2595 'protected' => $protected,
2599 sub hasdefault { shift->{'hasdefault'} }
2600 sub netrc { shift->{'netrc'} }
2601 sub protected { shift->{'protected'} }
2603 my($self,$mach) = @_;
2604 for ( @{$self->{'mach'}} ) {
2605 return 1 if $_ eq $mach;
2610 package CPAN::Complete;
2613 my($text, $line, $start, $end) = @_;
2614 my(@perlret) = cpl($text, $line, $start);
2615 # find longest common match. Can anybody show me how to peruse
2616 # T::R::Gnu to have this done automatically? Seems expensive.
2617 return () unless @perlret;
2618 my($newtext) = $text;
2619 for (my $i = length($text)+1;;$i++) {
2620 last unless length($perlret[0]) && length($perlret[0]) >= $i;
2621 my $try = substr($perlret[0],0,$i);
2622 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
2623 # warn "try[$try]tries[@tries]";
2624 if (@tries == @perlret) {
2630 ($newtext,@perlret);
2633 #-> sub CPAN::Complete::cpl ;
2635 my($word,$line,$pos) = @_;
2639 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2641 if ($line =~ s/^(force\s*)//) {
2649 ! a b d h i m o q r u autobundle clean
2650 make test install force reload look cvs_import
2653 } elsif ( $line !~ /^[\!abcdhimorutl]/ ) {
2655 } elsif ($line =~ /^a\s/) {
2656 @return = cplx('CPAN::Author',$word);
2657 } elsif ($line =~ /^b\s/) {
2658 @return = cplx('CPAN::Bundle',$word);
2659 } elsif ($line =~ /^d\s/) {
2660 @return = cplx('CPAN::Distribution',$word);
2661 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look|cvs_import)\s/ ) {
2662 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
2663 } elsif ($line =~ /^i\s/) {
2664 @return = cpl_any($word);
2665 } elsif ($line =~ /^reload\s/) {
2666 @return = cpl_reload($word,$line,$pos);
2667 } elsif ($line =~ /^o\s/) {
2668 @return = cpl_option($word,$line,$pos);
2675 #-> sub CPAN::Complete::cplx ;
2677 my($class, $word) = @_;
2678 # I believed for many years that this was sorted, today I
2679 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
2680 # make it sorted again. Maybe sort was dropped when GNU-readline
2681 # support came in? The RCS file is difficult to read on that:-(
2682 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
2685 #-> sub CPAN::Complete::cpl_any ;
2689 cplx('CPAN::Author',$word),
2690 cplx('CPAN::Bundle',$word),
2691 cplx('CPAN::Distribution',$word),
2692 cplx('CPAN::Module',$word),
2696 #-> sub CPAN::Complete::cpl_reload ;
2698 my($word,$line,$pos) = @_;
2700 my(@words) = split " ", $line;
2701 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2702 my(@ok) = qw(cpan index);
2703 return @ok if @words == 1;
2704 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
2707 #-> sub CPAN::Complete::cpl_option ;
2709 my($word,$line,$pos) = @_;
2711 my(@words) = split " ", $line;
2712 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2713 my(@ok) = qw(conf debug);
2714 return @ok if @words == 1;
2715 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
2717 } elsif ($words[1] eq 'index') {
2719 } elsif ($words[1] eq 'conf') {
2720 return CPAN::Config::cpl(@_);
2721 } elsif ($words[1] eq 'debug') {
2722 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
2726 package CPAN::Index;
2728 #-> sub CPAN::Index::force_reload ;
2731 $CPAN::Index::last_time = 0;
2735 #-> sub CPAN::Index::reload ;
2737 my($cl,$force) = @_;
2740 # XXX check if a newer one is available. (We currently read it
2741 # from time to time)
2742 for ($CPAN::Config->{index_expire}) {
2743 $_ = 0.001 unless $_ && $_ > 0.001;
2745 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
2747 ## IFF we are developing, it helps to wipe out the memory between
2748 ## reloads, otherwise it is not what a user expects.
2750 ## undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
2751 ## $CPAN::META = CPAN->new;
2755 my $needshort = $^O eq "dos";
2757 $cl->rd_authindex($cl
2759 "authors/01mailrc.txt.gz",
2761 File::Spec->catfile('authors', '01mailrc.gz') :
2762 File::Spec->catfile('authors', '01mailrc.txt.gz'),
2765 $debug = "timing reading 01[".($t2 - $time)."]";
2767 return if $CPAN::Signal; # this is sometimes lengthy
2768 $cl->rd_modpacks($cl
2770 "modules/02packages.details.txt.gz",
2772 File::Spec->catfile('modules', '02packag.gz') :
2773 File::Spec->catfile('modules', '02packages.details.txt.gz'),
2776 $debug .= "02[".($t2 - $time)."]";
2778 return if $CPAN::Signal; # this is sometimes lengthy
2781 "modules/03modlist.data.gz",
2783 File::Spec->catfile('modules', '03mlist.gz') :
2784 File::Spec->catfile('modules', '03modlist.data.gz'),
2787 $debug .= "03[".($t2 - $time)."]";
2789 CPAN->debug($debug) if $CPAN::DEBUG;
2792 #-> sub CPAN::Index::reload_x ;
2794 my($cl,$wanted,$localname,$force) = @_;
2795 $force |= 2; # means we're dealing with an index here
2796 CPAN::Config->load; # we should guarantee loading wherever we rely
2798 $localname ||= $wanted;
2799 my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
2803 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
2806 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
2807 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
2808 qq{day$s. I\'ll use that.});
2811 $force |= 1; # means we're quite serious about it.
2813 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
2816 #-> sub CPAN::Index::rd_authindex ;
2818 my($cl, $index_target) = @_;
2820 return unless defined $index_target;
2821 $CPAN::Frontend->myprint("Going to read $index_target\n");
2822 # my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2823 # while ($_ = $fh->READLINE) {
2826 tie *FH, CPAN::Tarzip, $index_target;
2828 push @lines, split /\012/ while <FH>;
2830 my($userid,$fullname,$email) =
2831 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
2832 next unless $userid && $fullname && $email;
2834 # instantiate an author object
2835 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
2836 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
2837 return if $CPAN::Signal;
2842 my($self,$dist) = @_;
2843 $dist = $self->{'id'} unless defined $dist;
2844 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
2848 #-> sub CPAN::Index::rd_modpacks ;
2850 my($cl, $index_target) = @_;
2852 return unless defined $index_target;
2853 $CPAN::Frontend->myprint("Going to read $index_target\n");
2854 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2856 while ($_ = $fh->READLINE) {
2858 my @ls = map {"$_\n"} split /\n/, $_;
2859 unshift @ls, "\n" x length($1) if /^(\n+)/;
2865 my $shift = shift(@lines);
2866 $shift =~ /^Line-Count:\s+(\d+)/;
2867 $line_count = $1 if $1;
2868 last if $shift =~ /^\s*$/;
2870 if (not defined $line_count) {
2871 warn qq{Warning: Your $index_target does not contain a Line-Count header.
2872 Please check the validity of the index file by comparing it to more than one CPAN
2873 mirror. I'll continue but problems seem likely to happen.\a
2876 } elsif ($line_count != scalar @lines) {
2878 warn sprintf qq{Warning: Your %s
2879 contains a Line-Count header of %d but I see %d lines there. Please
2880 check the validity of the index file by comparing it to more than one
2881 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
2882 $index_target, $line_count, scalar(@lines);
2887 my($mod,$version,$dist) = split;
2888 ### $version =~ s/^\+//;
2890 # if it is a bundle, instantiate a bundle object
2891 my($bundle,$id,$userid);
2893 if ($mod eq 'CPAN' &&
2895 CPAN::Queue->exists('Bundle::CPAN') ||
2896 CPAN::Queue->exists('CPAN')
2900 if ($version > $CPAN::VERSION){
2901 $CPAN::Frontend->myprint(qq{
2902 There\'s a new CPAN.pm version (v$version) available!
2903 [Current version is v$CPAN::VERSION]
2904 You might want to try
2905 install Bundle::CPAN
2907 without quitting the current session. It should be a seamless upgrade
2908 while we are running...
2911 $CPAN::Frontend->myprint(qq{\n});
2913 last if $CPAN::Signal;
2914 } elsif ($mod =~ /^Bundle::(.*)/) {
2919 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
2920 # warn "made mod[$mod]a bundle";
2921 # Let's make it a module too, because bundles have so much
2922 # in common with modules
2923 $CPAN::META->instance('CPAN::Module',$mod);
2924 # warn "made mod[$mod]a module";
2926 # This "next" makes us faster but if the job is running long, we ignore
2927 # rereads which is bad. So we have to be a bit slower again.
2928 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
2933 # instantiate a module object
2934 $id = $CPAN::META->instance('CPAN::Module',$mod);
2937 if ($id->cpan_file ne $dist){
2938 $userid = $cl->userid($dist);
2940 'CPAN_USERID' => $userid,
2941 'CPAN_VERSION' => $version,
2942 'CPAN_FILE' => $dist
2946 # instantiate a distribution object
2947 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
2948 # we do not need CONTAINSMODS unless we do something with
2949 # this dist, so we better produce it on demand.
2951 ## my $obj = $CPAN::META->instance(
2952 ## 'CPAN::Distribution' => $dist
2954 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
2956 $CPAN::META->instance(
2957 'CPAN::Distribution' => $dist
2959 'CPAN_USERID' => $userid
2963 return if $CPAN::Signal;
2968 #-> sub CPAN::Index::rd_modlist ;
2970 my($cl,$index_target) = @_;
2971 return unless defined $index_target;
2972 $CPAN::Frontend->myprint("Going to read $index_target\n");
2973 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2976 while ($_ = $fh->READLINE) {
2978 my @ls = map {"$_\n"} split /\n/, $_;
2979 unshift @ls, "\n" x length($1) if /^(\n+)/;
2983 my $shift = shift(@eval);
2984 if ($shift =~ /^Date:\s+(.*)/){
2985 return if $date_of_03 eq $1;
2988 last if $shift =~ /^\s*$/;
2991 push @eval, q{CPAN::Modulelist->data;};
2993 my($comp) = Safe->new("CPAN::Safe1");
2994 my($eval) = join("", @eval);
2995 my $ret = $comp->reval($eval);
2996 Carp::confess($@) if $@;
2997 return if $CPAN::Signal;
2999 my $obj = $CPAN::META->instance(CPAN::Module,$_);
3000 $obj->set(%{$ret->{$_}});
3001 return if $CPAN::Signal;
3005 package CPAN::InfoObj;
3007 #-> sub CPAN::InfoObj::new ;
3008 sub new { my $this = bless {}, shift; %$this = @_; $this }
3010 #-> sub CPAN::InfoObj::set ;
3012 my($self,%att) = @_;
3013 my(%oldatt) = %$self;
3014 %$self = (%oldatt, %att);
3017 #-> sub CPAN::InfoObj::id ;
3018 sub id { shift->{'ID'} }
3020 #-> sub CPAN::InfoObj::as_glimpse ;
3024 my $class = ref($self);
3025 $class =~ s/^CPAN:://;
3026 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3030 #-> sub CPAN::InfoObj::as_string ;
3034 my $class = ref($self);
3035 $class =~ s/^CPAN:://;
3036 push @m, $class, " id = $self->{ID}\n";
3037 for (sort keys %$self) {
3040 if ($_ eq "CPAN_USERID") {
3041 $extra .= " (".$self->author;
3042 my $email; # old perls!
3043 if ($email = $CPAN::META->instance(CPAN::Author,
3046 $extra .= " <$email>";
3048 $extra .= " <no email>";
3052 if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX
3053 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
3054 } elsif (ref($self->{$_}) eq "HASH") {
3058 join(" ",keys %{$self->{$_}}),
3061 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
3067 #-> sub CPAN::InfoObj::author ;
3070 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
3075 require Data::Dumper;
3076 Data::Dumper::Dumper($self);
3079 package CPAN::Author;
3081 #-> sub CPAN::Author::as_glimpse ;
3085 my $class = ref($self);
3086 $class =~ s/^CPAN:://;
3087 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
3091 # Dead code, I would have liked to have,,, but it was never reached,,,
3094 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
3097 #-> sub CPAN::Author::fullname ;
3098 sub fullname { shift->{'FULLNAME'} }
3101 #-> sub CPAN::Author::email ;
3102 sub email { shift->{'EMAIL'} }
3104 package CPAN::Distribution;
3106 #-> sub CPAN::Distribution::as_string ;
3109 $self->containsmods;
3110 $self->SUPER::as_string(@_);
3113 #-> sub CPAN::Distribution::containsmods ;
3116 return if exists $self->{CONTAINSMODS};
3117 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
3118 my $mod_file = $mod->{CPAN_FILE} or next;
3119 my $dist_id = $self->{ID} or next;
3120 my $mod_id = $mod->{ID} or next;
3121 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
3125 #-> sub CPAN::Distribution::called_for ;
3128 $self->{'CALLED_FOR'} = $id if defined $id;
3129 return $self->{'CALLED_FOR'};
3132 #-> sub CPAN::Distribution::get ;
3137 exists $self->{'build_dir'} and push @e,
3138 "Unwrapped into directory $self->{'build_dir'}";
3139 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3144 $CPAN::Config->{keep_source_where},
3147 split("/",$self->{ID})
3150 $self->debug("Doing localize") if $CPAN::DEBUG;
3152 CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
3153 or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
3154 $self->{localfile} = $local_file;
3155 my $builddir = $CPAN::META->{cachemgr}->dir;
3156 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
3157 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
3160 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
3161 if ($CPAN::META->has_inst('MD5')) {
3162 $self->debug("MD5 is installed, verifying");
3165 $self->debug("MD5 is NOT installed");
3167 $self->debug("Removing tmp") if $CPAN::DEBUG;
3168 File::Path::rmtree("tmp");
3169 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
3171 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
3172 if (! $local_file) {
3173 Carp::croak "bad download, can't do anything :-(\n";
3174 } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)\z/i){
3175 $self->untar_me($local_file);
3176 } elsif ( $local_file =~ /\.zip\z/i ) {
3177 $self->unzip_me($local_file);
3178 } elsif ( $local_file =~ /\.pm\.(gz|Z)\z/) {
3179 $self->pm2dir_me($local_file);
3181 $self->{archived} = "NO";
3183 chdir File::Spec->updir;
3184 if ($self->{archived} ne 'NO') {
3185 chdir File::Spec->catdir(File::Spec->curdir, "tmp");
3186 # Let's check if the package has its own directory.
3187 my $dh = DirHandle->new(File::Spec->curdir)
3188 or Carp::croak("Couldn't opendir .: $!");
3189 my @readdir = grep $_ !~ /^\.\.?\z/s, $dh->read; ### MAC??
3191 my ($distdir,$packagedir);
3192 if (@readdir == 1 && -d $readdir[0]) {
3193 $distdir = $readdir[0];
3194 $packagedir = MM->catdir($builddir,$distdir);
3195 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
3196 File::Path::rmtree($packagedir);
3197 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
3199 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
3200 $pragmatic_dir =~ s/\W_//g;
3201 $pragmatic_dir++ while -d "../$pragmatic_dir";
3202 $packagedir = MM->catdir($builddir,$pragmatic_dir);
3203 File::Path::mkpath($packagedir);
3205 for $f (@readdir) { # is already without "." and ".."
3206 my $to = MM->catdir($packagedir,$f);
3207 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
3210 $self->{'build_dir'} = $packagedir;
3211 chdir File::Spec->updir;
3213 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
3215 File::Path::rmtree("tmp");
3216 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
3217 $CPAN::Frontend->myprint("Going to unlink $local_file\n");
3218 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
3220 my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
3221 unless (-f $makefilepl) {
3222 my($configure) = MM->catfile($packagedir,"Configure");
3223 if (-f $configure) {
3224 # do we have anything to do?
3225 $self->{'configure'} = $configure;
3226 } elsif (-f MM->catfile($packagedir,"Makefile")) {
3227 $CPAN::Frontend->myprint(qq{
3228 Package comes with a Makefile and without a Makefile.PL.
3229 We\'ll try to build it with that Makefile then.
3231 $self->{writemakefile} = "YES";
3234 my $fh = FileHandle->new(">$makefilepl")
3235 or Carp::croak("Could not open >$makefilepl");
3236 my $cf = $self->called_for || "unknown";
3238 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
3239 # because there was no Makefile.PL supplied.
3240 # Autogenerated on: }.scalar localtime().qq{
3242 use ExtUtils::MakeMaker;
3243 WriteMakefile(NAME => q[$cf]);
3246 $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
3247 Writing one on our own (calling it $cf)\n});
3255 my($self,$local_file) = @_;
3256 $self->{archived} = "tar";
3257 if (CPAN::Tarzip->untar($local_file)) {
3258 $self->{unwrapped} = "YES";
3260 $self->{unwrapped} = "NO";
3265 my($self,$local_file) = @_;
3266 if ($CPAN::META->has_inst("Archive::Zip")) {
3267 $CPAN::Frontend->mywarn("Archive::Zip not yet supported. ".
3268 "Will use external unzip");
3270 my $unzip = $CPAN::Config->{unzip} or
3271 $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
3272 $self->{archived} = "zip";
3273 my @system = ($unzip, $local_file);
3274 if (system(@system) == 0) {
3275 $self->{unwrapped} = "YES";
3277 $self->{unwrapped} = "NO";
3282 my($self,$local_file) = @_;
3283 $self->{archived} = "pm";
3284 my $to = File::Basename::basename($local_file);
3285 $to =~ s/\.(gz|Z)\z//;
3286 if (CPAN::Tarzip->gunzip($local_file,$to)) {
3287 $self->{unwrapped} = "YES";
3289 $self->{unwrapped} = "NO";
3293 #-> sub CPAN::Distribution::new ;
3295 my($class,%att) = @_;
3297 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
3299 my $this = { %att };
3300 return bless $this, $class;
3303 #-> sub CPAN::Distribution::look ;
3307 if ($^O eq 'MacOS') {
3308 $self->ExtUtils::MM_MacOS::look;
3312 if ( $CPAN::Config->{'shell'} ) {
3313 $CPAN::Frontend->myprint(qq{
3314 Trying to open a subshell in the build directory...
3317 $CPAN::Frontend->myprint(qq{
3318 Your configuration does not define a value for subshells.
3319 Please define it with "o conf shell <your shell>"
3323 my $dist = $self->id;
3324 my $dir = $self->dir or $self->get;
3327 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3328 my $pwd = CPAN->$getcwd();
3330 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3331 system($CPAN::Config->{'shell'}) == 0
3332 or $CPAN::Frontend->mydie("Subprocess shell error");
3339 my $dir = $self->dir;
3341 my $package = $self->called_for;
3342 my $module = $CPAN::META->instance('CPAN::Module', $package);
3343 my $version = $module->cpan_version;
3345 my $userid = $self->{CPAN_USERID};
3347 my $cvs_dir = (split '/', $dir)[-1];
3348 $cvs_dir =~ s/-\d+[^-]+\z//;
3350 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
3352 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
3353 if ($cvs_site_perl) {
3354 $cvs_dir = "$cvs_site_perl/$cvs_dir";
3356 my $cvs_log = qq{"imported $package $version sources"};
3357 $version =~ s/\./_/g;
3358 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
3359 "$cvs_dir", $userid, "v$version");
3362 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3363 my $pwd = CPAN->$getcwd();
3366 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3368 $CPAN::Frontend->myprint(qq{@cmd\n});
3369 system(@cmd) == 0 or
3370 $CPAN::Frontend->mydie("cvs import failed");
3374 #-> sub CPAN::Distribution::readme ;
3377 my($dist) = $self->id;
3378 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
3379 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
3383 $CPAN::Config->{keep_source_where},
3386 split("/","$sans.readme"),
3388 $self->debug("Doing localize") if $CPAN::DEBUG;
3389 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
3391 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
3393 if ($^O eq 'MacOS') {
3394 ExtUtils::MM_MacOS::launch_file($local_file);
3398 my $fh_pager = FileHandle->new;
3399 local($SIG{PIPE}) = "IGNORE";
3400 $fh_pager->open("|$CPAN::Config->{'pager'}")
3401 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
3402 my $fh_readme = FileHandle->new;
3403 $fh_readme->open($local_file)
3404 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
3405 $CPAN::Frontend->myprint(qq{
3408 with pager "$CPAN::Config->{'pager'}"
3411 $fh_pager->print(<$fh_readme>);
3414 #-> sub CPAN::Distribution::verifyMD5 ;
3419 $self->{MD5_STATUS} ||= "";
3420 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
3421 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3423 my($lc_want,$lc_file,@local,$basename);
3424 @local = split("/",$self->{ID});
3426 push @local, "CHECKSUMS";
3428 MM->catfile($CPAN::Config->{keep_source_where},
3429 "authors", "id", @local);
3434 $self->MD5_check_file($lc_want)
3436 return $self->{MD5_STATUS} = "OK";
3438 $lc_file = CPAN::FTP->localize("authors/id/@local",
3441 $local[-1] .= ".gz";
3442 $lc_file = CPAN::FTP->localize("authors/id/@local",
3445 $lc_file =~ s/\.gz\z//;
3446 CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
3451 $self->MD5_check_file($lc_file);
3454 #-> sub CPAN::Distribution::MD5_check_file ;
3455 sub MD5_check_file {
3456 my($self,$chk_file) = @_;
3457 my($cksum,$file,$basename);
3458 $file = $self->{localfile};
3459 $basename = File::Basename::basename($file);
3460 my $fh = FileHandle->new;
3461 if (open $fh, $chk_file){
3464 $eval =~ s/\015?\012/\n/g;
3466 my($comp) = Safe->new();
3467 $cksum = $comp->reval($eval);
3469 rename $chk_file, "$chk_file.bad";
3470 Carp::confess($@) if $@;
3473 Carp::carp "Could not open $chk_file for reading";
3476 if (exists $cksum->{$basename}{md5}) {
3477 $self->debug("Found checksum for $basename:" .
3478 "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
3482 my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
3484 $fh = CPAN::Tarzip->TIEHANDLE($file);
3487 # had to inline it, when I tied it, the tiedness got lost on
3488 # the call to eq_MD5. (Jan 1998)
3492 while ($fh->READ($ref, 4096) > 0){
3495 my $hexdigest = $md5->hexdigest;
3496 $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
3500 $CPAN::Frontend->myprint("Checksum for $file ok\n");
3501 return $self->{MD5_STATUS} = "OK";
3503 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
3504 qq{distribution file. }.
3505 qq{Please investigate.\n\n}.
3507 $CPAN::META->instance(
3509 $self->{CPAN_USERID}
3512 my $wrap = qq{I\'d recommend removing $file. Its MD5
3513 checksum is incorrect. Maybe you have configured your \`urllist\' with
3514 a bad URL. Please check this array with \`o conf urllist\', and
3517 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
3518 $CPAN::Frontend->myprint("\n\n");
3522 # close $fh if fileno($fh);
3524 $self->{MD5_STATUS} ||= "";
3525 if ($self->{MD5_STATUS} eq "NIL") {
3526 $CPAN::Frontend->myprint(qq{
3527 No md5 checksum for $basename in local $chk_file.
3530 unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
3533 $self->{MD5_STATUS} = "NIL";
3538 #-> sub CPAN::Distribution::eq_MD5 ;
3540 my($self,$fh,$expectMD5) = @_;
3543 while (read($fh, $data, 4096)){
3546 # $md5->addfile($fh);
3547 my $hexdigest = $md5->hexdigest;
3548 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
3549 $hexdigest eq $expectMD5;
3552 #-> sub CPAN::Distribution::force ;
3555 $self->{'force_update'}++;
3557 MD5_STATUS archived build_dir localfile make install unwrapped
3560 delete $self->{$att};
3564 #-> sub CPAN::Distribution::isa_perl ;
3567 my $file = File::Basename::basename($self->id);
3568 return unless $file =~ m{ ^ perl
3583 #-> sub CPAN::Distribution::perl ;
3586 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
3587 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3588 my $pwd = CPAN->$getcwd();
3589 my $candidate = MM->catfile($pwd,$^X);
3590 $perl ||= $candidate if MM->maybe_command($candidate);
3592 my ($component,$perl_name);
3593 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
3594 PATH_COMPONENT: foreach $component (MM->path(),
3595 $Config::Config{'binexp'}) {
3596 next unless defined($component) && $component;
3597 my($abs) = MM->catfile($component,$perl_name);
3598 if (MM->maybe_command($abs)) {
3608 #-> sub CPAN::Distribution::make ;
3611 $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
3612 # Emergency brake if they said install Pippi and get newest perl
3613 if ($self->isa_perl) {
3615 $self->called_for ne $self->id && ! $self->{'force_update'}
3617 # if we die here, we break bundles
3618 $CPAN::Frontend->mywarn(sprintf qq{
3619 The most recent version "%s" of the module "%s"
3620 comes with the current version of perl (%s).
3621 I\'ll build that only if you ask for something like
3626 $CPAN::META->instance(
3640 $self->{archived} eq "NO" and push @e,
3641 "Is neither a tar nor a zip archive.";
3643 $self->{unwrapped} eq "NO" and push @e,
3644 "had problems unarchiving. Please build manually";
3646 exists $self->{writemakefile} &&
3647 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
3648 $1 || "Had some problem writing Makefile";
3650 defined $self->{'make'} and push @e,
3651 "Has already been processed within this session";
3653 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3655 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
3656 my $builddir = $self->dir;
3657 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
3658 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
3660 if ($^O eq 'MacOS') {
3661 ExtUtils::MM_MacOS::make($self);
3666 if ($self->{'configure'}) {
3667 $system = $self->{'configure'};
3669 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
3671 # This needs a handler that can be turned on or off:
3672 # $switch = "-MExtUtils::MakeMaker ".
3673 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
3675 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
3677 unless (exists $self->{writemakefile}) {
3678 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
3681 if ($CPAN::Config->{inactivity_timeout}) {
3683 alarm $CPAN::Config->{inactivity_timeout};
3684 local $SIG{CHLD}; # = sub { wait };
3685 if (defined($pid = fork)) {
3690 # note, this exec isn't necessary if
3691 # inactivity_timeout is 0. On the Mac I'd
3692 # suggest, we set it always to 0.
3696 $CPAN::Frontend->myprint("Cannot fork: $!");
3704 $CPAN::Frontend->myprint($@);
3705 $self->{writemakefile} = "NO $@";
3710 $ret = system($system);
3712 $self->{writemakefile} = "NO Makefile.PL returned status $ret";
3716 if (-f "Makefile") {
3717 $self->{writemakefile} = "YES";
3719 $self->{writemakefile} =
3720 qq{NO Makefile.PL refused to write a Makefile.};
3721 # It's probably worth to record the reason, so let's retry
3723 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
3724 # $self->{writemakefile} .= <$fh>;
3727 return if $CPAN::Signal;
3728 if (my @prereq = $self->needs_prereq){
3730 $CPAN::Frontend->myprint("---- Dependencies detected ".
3731 "during [$id] -----\n");
3733 for my $p (@prereq) {
3734 $CPAN::Frontend->myprint(" $p\n");
3737 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
3739 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
3740 require ExtUtils::MakeMaker;
3741 my $answer = ExtUtils::MakeMaker::prompt(
3742 "Shall I follow them and prepend them to the queue
3743 of modules we are processing right now?", "yes");
3744 $follow = $answer =~ /^\s*y/i;
3748 myprint(" Ignoring dependencies on modules @prereq\n");
3751 CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
3755 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
3756 if (system($system) == 0) {
3757 $CPAN::Frontend->myprint(" $system -- OK\n");
3758 $self->{'make'} = "YES";
3760 $self->{writemakefile} ||= "YES";
3761 $self->{'make'} = "NO";
3762 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3766 #-> sub CPAN::Distribution::needs_prereq ;
3769 return unless -f "Makefile"; # we cannot say much
3770 my $fh = FileHandle->new("<Makefile") or
3771 $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
3774 # A.Speer @p -> %p, where %p is $p{Module::Name}=Required_Version
3778 last if /MakeMaker post_initialize section/;
3780 \s+PREREQ_PM\s+=>\s+(.+)
3783 # warn "Found prereq expr[$p]";
3785 # Regexp modified by A.Speer to remember actual version of file
3786 # PREREQ_PM hash key wants, then add to
3787 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
3788 # In case a prereq is mentioned twice, complain.
3789 if ( defined $p{$1} ) {
3790 warn "Warning: PREREQ_PM mentions $1 more than once, last mention wins";
3796 NEED: while (my($module, $need_version) = each %p) {
3797 my $mo = $CPAN::META->instance("CPAN::Module",$module);
3798 # we were too demanding:
3799 # next if $mo->uptodate;
3801 # We only want to install prereqs if either they're not installed
3802 # or if the installed version is too old. We cannot omit this
3803 # check, because if 'force' is in effect, nobody else will check.
3806 if (defined $mo->inst_file &&
3807 $mo->inst_version >= $need_version){
3808 CPAN->debug(sprintf "inst_file[%s]inst_version[%s]need_version[%s]",
3809 $mo->inst_file, $mo->inst_version, $need_version
3815 if ($self->{have_sponsored}{$module}++){
3816 # We have already sponsored it and for some reason it's still
3817 # not available. So we do nothing. Or what should we do?
3818 # if we push it again, we have a potential infinite loop
3821 push @need, $module;
3826 #-> sub CPAN::Distribution::test ;
3830 return if $CPAN::Signal;
3831 $CPAN::Frontend->myprint("Running make test\n");
3834 exists $self->{'make'} or push @e,
3835 "Make had some problems, maybe interrupted? Won't test";
3837 exists $self->{'make'} and
3838 $self->{'make'} eq 'NO' and
3839 push @e, "Oops, make had returned bad status";
3841 exists $self->{'build_dir'} or push @e, "Has no own directory";
3842 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3844 chdir $self->{'build_dir'} or
3845 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3846 $self->debug("Changed directory to $self->{'build_dir'}")
3849 if ($^O eq 'MacOS') {
3850 ExtUtils::MM_MacOS::make_test($self);
3854 my $system = join " ", $CPAN::Config->{'make'}, "test";
3855 if (system($system) == 0) {
3856 $CPAN::Frontend->myprint(" $system -- OK\n");
3857 $self->{'make_test'} = "YES";
3859 $self->{'make_test'} = "NO";
3860 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3864 #-> sub CPAN::Distribution::clean ;
3867 $CPAN::Frontend->myprint("Running make clean\n");
3870 exists $self->{'build_dir'} or push @e, "Has no own directory";
3871 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3873 chdir $self->{'build_dir'} or
3874 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3875 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
3877 if ($^O eq 'MacOS') {
3878 ExtUtils::MM_MacOS::make_clean($self);
3882 my $system = join " ", $CPAN::Config->{'make'}, "clean";
3883 if (system($system) == 0) {
3884 $CPAN::Frontend->myprint(" $system -- OK\n");
3887 # Hmmm, what to do if make clean failed?
3891 #-> sub CPAN::Distribution::install ;
3895 return if $CPAN::Signal;
3896 $CPAN::Frontend->myprint("Running make install\n");
3899 exists $self->{'build_dir'} or push @e, "Has no own directory";
3901 exists $self->{'make'} or push @e,
3902 "Make had some problems, maybe interrupted? Won't install";
3904 exists $self->{'make'} and
3905 $self->{'make'} eq 'NO' and
3906 push @e, "Oops, make had returned bad status";
3908 push @e, "make test had returned bad status, ".
3909 "won't install without force"
3910 if exists $self->{'make_test'} and
3911 $self->{'make_test'} eq 'NO' and
3912 ! $self->{'force_update'};
3914 exists $self->{'install'} and push @e,
3915 $self->{'install'} eq "YES" ?
3916 "Already done" : "Already tried without success";
3918 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3920 chdir $self->{'build_dir'} or
3921 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3922 $self->debug("Changed directory to $self->{'build_dir'}")
3925 if ($^O eq 'MacOS') {
3926 ExtUtils::MM_MacOS::make_install($self);
3930 my $system = join(" ", $CPAN::Config->{'make'},
3931 "install", $CPAN::Config->{make_install_arg});
3932 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
3933 my($pipe) = FileHandle->new("$system $stderr |");
3936 $CPAN::Frontend->myprint($_);
3941 $CPAN::Frontend->myprint(" $system -- OK\n");
3942 return $self->{'install'} = "YES";
3944 $self->{'install'} = "NO";
3945 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3946 if ($makeout =~ /permission/s && $> > 0) {
3947 $CPAN::Frontend->myprint(qq{ You may have to su }.
3948 qq{to root to install the package\n});
3953 #-> sub CPAN::Distribution::dir ;
3955 shift->{'build_dir'};
3958 package CPAN::Bundle;
3960 #-> sub CPAN::Bundle::as_string ;
3964 $self->{INST_VERSION} = $self->inst_version;
3965 return $self->SUPER::as_string;
3968 #-> sub CPAN::Bundle::contains ;
3971 my($parsefile) = $self->inst_file;
3972 my($id) = $self->id;
3973 $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
3974 unless ($parsefile) {
3975 # Try to get at it in the cpan directory
3976 $self->debug("no parsefile") if $CPAN::DEBUG;
3977 Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
3978 my $dist = $CPAN::META->instance('CPAN::Distribution',
3979 $self->{CPAN_FILE});
3981 $self->debug($dist->as_string) if $CPAN::DEBUG;
3982 my($todir) = $CPAN::Config->{'cpan_home'};
3983 my(@me,$from,$to,$me);
3984 @me = split /::/, $self->id;
3986 $me = MM->catfile(@me);
3987 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
3988 $to = MM->catfile($todir,$me);
3989 File::Path::mkpath(File::Basename::dirname($to));
3990 File::Copy::copy($from, $to)
3991 or Carp::confess("Couldn't copy $from to $to: $!");
3995 my $fh = FileHandle->new;
3997 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
3999 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
4001 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
4002 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
4003 next unless $in_cont;
4008 push @result, (split " ", $_, 2)[0];
4011 delete $self->{STATUS};
4012 $self->{CONTAINS} = join ", ", @result;
4013 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
4015 $CPAN::Frontend->mywarn(qq{
4016 The bundle file "$parsefile" may be a broken
4017 bundlefile. It seems not to contain any bundle definition.
4018 Please check the file and if it is bogus, please delete it.
4019 Sorry for the inconvenience.
4025 #-> sub CPAN::Bundle::find_bundle_file
4026 sub find_bundle_file {
4027 my($self,$where,$what) = @_;
4028 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
4029 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
4030 ### my $bu = MM->catfile($where,$what);
4031 ### return $bu if -f $bu;
4032 my $manifest = MM->catfile($where,"MANIFEST");
4033 unless (-f $manifest) {
4034 require ExtUtils::Manifest;
4035 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
4036 my $cwd = CPAN->$getcwd();
4038 ExtUtils::Manifest::mkmanifest();
4041 my $fh = FileHandle->new($manifest)
4042 or Carp::croak("Couldn't open $manifest: $!");
4045 if ($^O eq 'MacOS') {
4048 $what2 =~ s/:Bundle://;
4051 $what2 =~ s|Bundle[/\\]||;
4056 my($file) = /(\S+)/;
4057 if ($file =~ m|\Q$what\E$|) {
4059 # return MM->catfile($where,$bu); # bad
4062 # retry if she managed to
4063 # have no Bundle directory
4064 $bu = $file if $file =~ m|\Q$what2\E$|;
4066 $bu =~ tr|/|:| if $^O eq 'MacOS';
4067 return MM->catfile($where, $bu) if $bu;
4068 Carp::croak("Couldn't find a Bundle file in $where");
4071 #-> sub CPAN::Bundle::inst_file ;
4075 ($me = $self->id) =~ s/.*://;
4076 ## my(@me,$inst_file);
4077 ## @me = split /::/, $self->id;
4078 ## $me[-1] .= ".pm";
4079 $inst_file = MM->catfile($CPAN::Config->{'cpan_home'},
4080 "Bundle", "$me.pm");
4082 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
4084 $self->SUPER::inst_file;
4085 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
4086 # return $self->{'INST_FILE'}; # even if undefined?
4089 #-> sub CPAN::Bundle::rematein ;
4091 my($self,$meth) = @_;
4092 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
4093 my($id) = $self->id;
4094 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
4095 unless $self->inst_file || $self->{CPAN_FILE};
4097 for $s ($self->contains) {
4098 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
4099 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
4100 if ($type eq 'CPAN::Distribution') {
4101 $CPAN::Frontend->mywarn(qq{
4102 The Bundle }.$self->id.qq{ contains
4103 explicitly a file $s.
4107 # possibly noisy action:
4108 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
4109 my $obj = $CPAN::META->instance($type,$s);
4111 if ($obj->isa(CPAN::Bundle)
4113 exists $obj->{install_failed}
4115 ref($obj->{install_failed}) eq "HASH"
4117 for (keys %{$obj->{install_failed}}) {
4118 $self->{install_failed}{$_} = undef; # propagate faiure up
4121 $fail{$s} = 1; # the bundle itself may have succeeded but
4126 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
4127 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
4129 delete $self->{install_failed}{$s};
4136 # recap with less noise
4137 if ( $meth eq "install" ) {
4140 my $raw = sprintf(qq{Bundle summary:
4141 The following items in bundle %s had installation problems:},
4144 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
4145 $CPAN::Frontend->myprint("\n");
4148 for $s ($self->contains) {
4150 $paragraph .= "$s ";
4151 $self->{install_failed}{$s} = undef;
4152 $reported{$s} = undef;
4155 my $report_propagated;
4156 for $s (sort keys %{$self->{install_failed}}) {
4157 next if exists $reported{$s};
4158 $paragraph .= "and the following items had problems
4159 during recursive bundle calls: " unless $report_propagated++;
4160 $paragraph .= "$s ";
4162 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
4163 $CPAN::Frontend->myprint("\n");
4165 $self->{'install'} = 'YES';
4170 #sub CPAN::Bundle::xs_file
4172 # If a bundle contains another that contains an xs_file we have
4173 # here, we just don't bother I suppose
4177 #-> sub CPAN::Bundle::force ;
4178 sub force { shift->rematein('force',@_); }
4179 #-> sub CPAN::Bundle::get ;
4180 sub get { shift->rematein('get',@_); }
4181 #-> sub CPAN::Bundle::make ;
4182 sub make { shift->rematein('make',@_); }
4183 #-> sub CPAN::Bundle::test ;
4184 sub test { shift->rematein('test',@_); }
4185 #-> sub CPAN::Bundle::install ;
4188 $self->rematein('install',@_);
4190 #-> sub CPAN::Bundle::clean ;
4191 sub clean { shift->rematein('clean',@_); }
4193 #-> sub CPAN::Bundle::readme ;
4196 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
4197 No File found for bundle } . $self->id . qq{\n}), return;
4198 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
4199 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
4202 package CPAN::Module;
4204 #-> sub CPAN::Module::as_glimpse ;
4208 my $class = ref($self);
4209 $class =~ s/^CPAN:://;
4210 push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
4215 #-> sub CPAN::Module::as_string ;
4219 CPAN->debug($self) if $CPAN::DEBUG;
4220 my $class = ref($self);
4221 $class =~ s/^CPAN:://;
4223 push @m, $class, " id = $self->{ID}\n";
4224 my $sprintf = " %-12s %s\n";
4225 push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description})
4226 if $self->{description};
4227 my $sprintf2 = " %-12s %s (%s)\n";
4229 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
4231 if ($author = CPAN::Shell->expand('Author',$userid)) {
4234 if ($m = $author->email) {
4241 $author->fullname . $email
4245 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
4246 if $self->{CPAN_VERSION};
4247 push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
4248 if $self->{CPAN_FILE};
4249 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
4250 my(%statd,%stats,%statl,%stati);
4251 @statd{qw,? i c a b R M S,} = qw,unknown idea
4252 pre-alpha alpha beta released mature standard,;
4253 @stats{qw,? m d u n,} = qw,unknown mailing-list
4254 developer comp.lang.perl.* none,;
4255 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
4256 @stati{qw,? f r O h,} = qw,unknown functions
4257 references+ties object-oriented hybrid,;
4258 $statd{' '} = 'unknown';
4259 $stats{' '} = 'unknown';
4260 $statl{' '} = 'unknown';
4261 $stati{' '} = 'unknown';
4269 $statd{$self->{statd}},
4270 $stats{$self->{stats}},
4271 $statl{$self->{statl}},
4272 $stati{$self->{stati}}
4273 ) if $self->{statd};
4274 my $local_file = $self->inst_file;
4276 $self->{MANPAGE} ||= $self->manpage_headline($local_file);
4279 for $item (qw/MANPAGE CONTAINS/) {
4280 push @m, sprintf($sprintf, $item, $self->{$item})
4281 if exists $self->{$item};
4283 push @m, sprintf($sprintf, 'INST_FILE',
4284 $local_file || "(not installed)");
4285 push @m, sprintf($sprintf, 'INST_VERSION',
4286 $self->inst_version) if $local_file;
4290 sub manpage_headline {
4291 my($self,$local_file) = @_;
4292 my(@local_file) = $local_file;
4293 $local_file =~ s/\.pm\z/.pod/;
4294 push @local_file, $local_file;
4296 for $locf (@local_file) {
4297 next unless -f $locf;
4298 my $fh = FileHandle->new($locf)
4299 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
4303 $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
4304 m/^=head1\s+NAME/ ? 1 : $inpod;
4317 #-> sub CPAN::Module::cpan_file ;
4320 CPAN->debug($self->id) if $CPAN::DEBUG;
4321 unless (defined $self->{'CPAN_FILE'}) {
4322 CPAN::Index->reload;
4324 if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){
4325 return $self->{'CPAN_FILE'};
4326 } elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
4327 my $fullname = $CPAN::META->instance(CPAN::Author,
4328 $self->{'userid'})->fullname;
4329 my $email = $CPAN::META->instance(CPAN::Author,
4330 $self->{'userid'})->email;
4331 unless (defined $fullname && defined $email) {
4332 return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
4334 return "Contact Author $fullname <$email>";
4340 *name = \&cpan_file;
4342 #-> sub CPAN::Module::cpan_version ;
4345 $self->{'CPAN_VERSION'} = 'undef'
4346 unless defined $self->{'CPAN_VERSION'}; # I believe this is
4347 # always a bug in the
4348 # index and should be
4350 # but usually I find
4352 # and do not want to
4355 $self->{'CPAN_VERSION'};
4358 #-> sub CPAN::Module::force ;
4361 $self->{'force_update'}++;
4364 #-> sub CPAN::Module::rematein ;
4366 my($self,$meth) = @_;
4367 $self->debug($self->id) if $CPAN::DEBUG;
4368 my $cpan_file = $self->cpan_file;
4369 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
4370 $CPAN::Frontend->mywarn(sprintf qq{
4371 The module %s isn\'t available on CPAN.
4373 Either the module has not yet been uploaded to CPAN, or it is
4374 temporary unavailable. Please contact the author to find out
4375 more about the status. Try ``i %s''.
4382 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
4383 $pack->called_for($self->id);
4384 $pack->force if exists $self->{'force_update'};
4386 delete $self->{'force_update'};
4389 #-> sub CPAN::Module::readme ;
4390 sub readme { shift->rematein('readme') }
4391 #-> sub CPAN::Module::look ;
4392 sub look { shift->rematein('look') }
4393 #-> sub CPAN::Module::cvs_import ;
4394 sub cvs_import { shift->rematein('cvs_import') }
4395 #-> sub CPAN::Module::get ;
4396 sub get { shift->rematein('get',@_); }
4397 #-> sub CPAN::Module::make ;
4398 sub make { shift->rematein('make') }
4399 #-> sub CPAN::Module::test ;
4400 sub test { shift->rematein('test') }
4401 #-> sub CPAN::Module::uptodate ;
4404 my($latest) = $self->cpan_version;
4406 my($inst_file) = $self->inst_file;
4408 if (defined $inst_file) {
4409 $have = $self->inst_version;
4420 #-> sub CPAN::Module::install ;
4426 not exists $self->{'force_update'}
4428 $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
4432 $self->rematein('install') if $doit;
4434 #-> sub CPAN::Module::clean ;
4435 sub clean { shift->rematein('clean') }
4437 #-> sub CPAN::Module::inst_file ;
4441 @packpath = split /::/, $self->{ID};
4442 $packpath[-1] .= ".pm";
4443 foreach $dir (@INC) {
4444 my $pmfile = MM->catfile($dir,@packpath);
4452 #-> sub CPAN::Module::xs_file ;
4456 @packpath = split /::/, $self->{ID};
4457 push @packpath, $packpath[-1];
4458 $packpath[-1] .= "." . $Config::Config{'dlext'};
4459 foreach $dir (@INC) {
4460 my $xsfile = MM->catfile($dir,'auto',@packpath);
4468 #-> sub CPAN::Module::inst_version ;
4471 my $parsefile = $self->inst_file or return;
4472 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
4475 # local($SIG{__WARN__}) = sub { warn "1. have[$have]"; };
4477 # there was a bug in 5.6.0 that let lots of unini warnings out of
4478 # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
4479 # this workaround after 5.6.1 is out.
4480 local($SIG{__WARN__}) = sub { my $w = shift;
4481 return if $w =~ /uninitialized/i;
4484 $have = MM->parse_version($parsefile) || "undef";
4485 # local($SIG{__WARN__}) = sub { warn "2. have[$have]"; };
4486 $have =~ s/\s*//g; # stringify to float around floating point issues
4487 # local($SIG{__WARN__}) = sub { warn "3. have[$have]"; };
4488 $have; # no stringify needed, \s* above matches always
4491 package CPAN::Tarzip;
4493 # CPAN::Tarzip::gzip
4495 my($class,$read,$write) = @_;
4496 if ($CPAN::META->has_inst("Compress::Zlib")) {
4498 $fhw = FileHandle->new($read)
4499 or $CPAN::Frontend->mydie("Could not open $read: $!");
4500 my $gz = Compress::Zlib::gzopen($write, "wb")
4501 or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
4502 $gz->gzwrite($buffer)
4503 while read($fhw,$buffer,4096) > 0 ;
4508 system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
4513 # CPAN::Tarzip::gunzip
4515 my($class,$read,$write) = @_;
4516 if ($CPAN::META->has_inst("Compress::Zlib")) {
4518 $fhw = FileHandle->new(">$write")
4519 or $CPAN::Frontend->mydie("Could not open >$write: $!");
4520 my $gz = Compress::Zlib::gzopen($read, "rb")
4521 or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
4522 $fhw->print($buffer)
4523 while $gz->gzread($buffer) > 0 ;
4524 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
4525 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
4530 system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
4535 # CPAN::Tarzip::gtest
4537 my($class,$read) = @_;
4538 if ($CPAN::META->has_inst("Compress::Zlib")) {
4540 my $gz = Compress::Zlib::gzopen($read, "rb")
4541 or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
4542 1 while $gz->gzread($buffer) > 0 ;
4543 my $err = $gz->gzerror;
4544 my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
4546 $class->debug("err[$err]success[$success]") if $CPAN::DEBUG;
4549 return system("$CPAN::Config->{'gzip'} -dt $read")==0;
4554 # CPAN::Tarzip::TIEHANDLE
4556 my($class,$file) = @_;
4558 $class->debug("file[$file]");
4559 if ($CPAN::META->has_inst("Compress::Zlib")) {
4560 my $gz = Compress::Zlib::gzopen($file,"rb") or
4561 die "Could not gzopen $file";
4562 $ret = bless {GZ => $gz}, $class;
4564 my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |";
4565 my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
4567 $ret = bless {FH => $fh}, $class;
4573 # CPAN::Tarzip::READLINE
4576 if (exists $self->{GZ}) {
4577 my $gz = $self->{GZ};
4578 my($line,$bytesread);
4579 $bytesread = $gz->gzreadline($line);
4580 return undef if $bytesread <= 0;
4583 my $fh = $self->{FH};
4584 return scalar <$fh>;
4589 # CPAN::Tarzip::READ
4591 my($self,$ref,$length,$offset) = @_;
4592 die "read with offset not implemented" if defined $offset;
4593 if (exists $self->{GZ}) {
4594 my $gz = $self->{GZ};
4595 my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
4598 my $fh = $self->{FH};
4599 return read($fh,$$ref,$length);
4604 # CPAN::Tarzip::DESTROY
4607 if (exists $self->{GZ}) {
4608 my $gz = $self->{GZ};
4611 my $fh = $self->{FH};
4612 $fh->close if defined $fh;
4618 # CPAN::Tarzip::untar
4620 my($class,$file) = @_;
4621 # had to disable, because version 0.07 seems to be buggy
4622 if (MM->maybe_command($CPAN::Config->{'gzip'})
4624 MM->maybe_command($CPAN::Config->{'tar'})) {
4625 my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
4626 "< $file | $CPAN::Config->{tar} xvf -";
4627 if (system($system) != 0) {
4628 # people find the most curious tar binaries that cannot handle
4630 my $system = "$CPAN::Config->{'gzip'} --decompress $file";
4631 if (system($system)==0) {
4632 $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
4634 $CPAN::Frontend->mydie(
4635 qq{Couldn\'t uncompress $file\n}
4638 $file =~ s/\.gz\z//;
4639 $system = "$CPAN::Config->{tar} xvf $file";
4640 $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
4641 if (system($system)==0) {
4642 $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
4644 $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
4650 } elsif ($CPAN::META->has_inst("Archive::Tar")
4652 $CPAN::META->has_inst("Compress::Zlib") ) {
4653 my $tar = Archive::Tar->new($file,1);
4654 $tar->extract($tar->list_files); # I'm pretty sure we have nothing
4655 # that isn't compressed
4657 ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
4658 if ($^O eq 'MacOS');
4662 $CPAN::Frontend->mydie(qq{
4663 CPAN.pm needs either both external programs tar and gzip installed or
4664 both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
4665 is available. Can\'t continue.
4678 CPAN - query, download and build perl modules from CPAN sites
4684 perl -MCPAN -e shell;
4690 autobundle, clean, install, make, recompile, test
4694 The CPAN module is designed to automate the make and install of perl
4695 modules and extensions. It includes some searching capabilities and
4696 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
4697 to fetch the raw data from the net.
4699 Modules are fetched from one or more of the mirrored CPAN
4700 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
4703 The CPAN module also supports the concept of named and versioned
4704 I<bundles> of modules. Bundles simplify the handling of sets of
4705 related modules. See Bundles below.
4707 The package contains a session manager and a cache manager. There is
4708 no status retained between sessions. The session manager keeps track
4709 of what has been fetched, built and installed in the current
4710 session. The cache manager keeps track of the disk space occupied by
4711 the make processes and deletes excess space according to a simple FIFO
4714 For extended searching capabilities there's a plugin for CPAN available,
4715 L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
4716 all documents available in CPAN authors directories. If C<CPAN::WAIT>
4717 is installed on your system, the interactive shell of <CPAN.pm> will
4718 enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands which send
4719 queries to the WAIT server that has been configured for your
4722 All other methods provided are accessible in a programmer style and in an
4723 interactive shell style.
4725 =head2 Interactive Mode
4727 The interactive mode is entered by running
4729 perl -MCPAN -e shell
4731 which puts you into a readline interface. You will have the most fun if
4732 you install Term::ReadKey and Term::ReadLine to enjoy both history and
4735 Once you are on the command line, type 'h' and the rest should be
4738 The most common uses of the interactive modes are
4742 =item Searching for authors, bundles, distribution files and modules
4744 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
4745 for each of the four categories and another, C<i> for any of the
4746 mentioned four. Each of the four entities is implemented as a class
4747 with slightly differing methods for displaying an object.
4749 Arguments you pass to these commands are either strings exactly matching
4750 the identification string of an object or regular expressions that are
4751 then matched case-insensitively against various attributes of the
4752 objects. The parser recognizes a regular expression only if you
4753 enclose it between two slashes.
4755 The principle is that the number of found objects influences how an
4756 item is displayed. If the search finds one item, the result is
4757 displayed with the rather verbose method C<as_string>, but if we find
4758 more than one, we display each object with the terse method
4761 =item make, test, install, clean modules or distributions
4763 These commands take any number of arguments and investigate what is
4764 necessary to perform the action. If the argument is a distribution
4765 file name (recognized by embedded slashes), it is processed. If it is
4766 a module, CPAN determines the distribution file in which this module
4767 is included and processes that, following any dependencies named in
4768 the module's Makefile.PL (this behavior is controlled by
4769 I<prerequisites_policy>.)
4771 Any C<make> or C<test> are run unconditionally. An
4773 install <distribution_file>
4775 also is run unconditionally. But for
4779 CPAN checks if an install is actually needed for it and prints
4780 I<module up to date> in the case that the distribution file containing
4781 the module doesn't need to be updated.
4783 CPAN also keeps track of what it has done within the current session
4784 and doesn't try to build a package a second time regardless if it
4785 succeeded or not. The C<force> command takes as a first argument the
4786 method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
4787 command from scratch.
4791 cpan> install OpenGL
4792 OpenGL is up to date.
4793 cpan> force install OpenGL
4796 OpenGL-0.4/COPYRIGHT
4799 A C<clean> command results in a
4803 being executed within the distribution file's working directory.
4805 =item get, readme, look module or distribution
4807 C<get> downloads a distribution file without further action. C<readme>
4808 displays the README file of the associated distribution. C<Look> gets
4809 and untars (if not yet done) the distribution file, changes to the
4810 appropriate directory and opens a subshell process in that directory.
4814 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
4815 in the cpan-shell it is intended that you can press C<^C> anytime and
4816 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
4817 to clean up and leave the shell loop. You can emulate the effect of a
4818 SIGTERM by sending two consecutive SIGINTs, which usually means by
4819 pressing C<^C> twice.
4821 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
4822 SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
4828 The commands that are available in the shell interface are methods in
4829 the package CPAN::Shell. If you enter the shell command, all your
4830 input is split by the Text::ParseWords::shellwords() routine which
4831 acts like most shells do. The first word is being interpreted as the
4832 method to be called and the rest of the words are treated as arguments
4833 to this method. Continuation lines are supported if a line ends with a
4838 C<autobundle> writes a bundle file into the
4839 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
4840 a list of all modules that are both available from CPAN and currently
4841 installed within @INC. The name of the bundle file is based on the
4842 current date and a counter.
4846 recompile() is a very special command in that it takes no argument and
4847 runs the make/test/install cycle with brute force over all installed
4848 dynamically loadable extensions (aka XS modules) with 'force' in
4849 effect. The primary purpose of this command is to finish a network
4850 installation. Imagine, you have a common source tree for two different
4851 architectures. You decide to do a completely independent fresh
4852 installation. You start on one architecture with the help of a Bundle
4853 file produced earlier. CPAN installs the whole Bundle for you, but
4854 when you try to repeat the job on the second architecture, CPAN
4855 responds with a C<"Foo up to date"> message for all modules. So you
4856 invoke CPAN's recompile on the second architecture and you're done.
4858 Another popular use for C<recompile> is to act as a rescue in case your
4859 perl breaks binary compatibility. If one of the modules that CPAN uses
4860 is in turn depending on binary compatibility (so you cannot run CPAN
4861 commands), then you should try the CPAN::Nox module for recovery.
4863 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
4865 Although it may be considered internal, the class hierarchy does matter
4866 for both users and programmer. CPAN.pm deals with above mentioned four
4867 classes, and all those classes share a set of methods. A classical
4868 single polymorphism is in effect. A metaclass object registers all
4869 objects of all kinds and indexes them with a string. The strings
4870 referencing objects have a separated namespace (well, not completely
4875 words containing a "/" (slash) Distribution
4876 words starting with Bundle:: Bundle
4877 everything else Module or Author
4879 Modules know their associated Distribution objects. They always refer
4880 to the most recent official release. Developers may mark their releases
4881 as unstable development versions (by inserting an underbar into the
4882 visible version number), so the really hottest and newest distribution
4883 file is not always the default. If a module Foo circulates on CPAN in
4884 both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
4885 install version 1.23 by saying
4889 This would install the complete distribution file (say
4890 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
4891 like to install version 1.23_90, you need to know where the
4892 distribution file resides on CPAN relative to the authors/id/
4893 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
4894 so you would have to say
4896 install BAR/Foo-1.23_90.tar.gz
4898 The first example will be driven by an object of the class
4899 CPAN::Module, the second by an object of class CPAN::Distribution.
4901 =head2 Programmer's interface
4903 If you do not enter the shell, the available shell commands are both
4904 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
4905 functions in the calling package (C<install(...)>).
4907 There's currently only one class that has a stable interface -
4908 CPAN::Shell. All commands that are available in the CPAN shell are
4909 methods of the class CPAN::Shell. Each of the commands that produce
4910 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
4911 the IDs of all modules within the list.
4915 =item expand($type,@things)
4917 The IDs of all objects available within a program are strings that can
4918 be expanded to the corresponding real objects with the
4919 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
4920 list of CPAN::Module objects according to the C<@things> arguments
4921 given. In scalar context it only returns the first element of the
4924 =item Programming Examples
4926 This enables the programmer to do operations that combine
4927 functionalities that are available in the shell.
4929 # install everything that is outdated on my disk:
4930 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
4932 # install my favorite programs if necessary:
4933 for $mod (qw(Net::FTP MD5 Data::Dumper)){
4934 my $obj = CPAN::Shell->expand('Module',$mod);
4938 # list all modules on my disk that have no VERSION number
4939 for $mod (CPAN::Shell->expand("Module","/./")){
4940 next unless $mod->inst_file;
4941 # MakeMaker convention for undefined $VERSION:
4942 next unless $mod->inst_version eq "undef";
4943 print "No VERSION in ", $mod->id, "\n";
4946 # find out which distribution on CPAN contains a module:
4947 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
4949 Or if you want to write a cronjob to watch The CPAN, you could list
4950 all modules that need updating. First a quick and dirty way:
4952 perl -e 'use CPAN; CPAN::Shell->r;'
4954 If you don't want to get any output if all modules are up to date, you
4955 can parse the output of above command for the regular expression
4956 //modules are up to date// and decide to mail the output only if it
4959 If you prefer to do it more in a programmer style in one single
4960 process, maybe something like this suites you better:
4962 # list all modules on my disk that have newer versions on CPAN
4963 for $mod (CPAN::Shell->expand("Module","/./")){
4964 next unless $mod->inst_file;
4965 next if $mod->uptodate;
4966 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
4967 $mod->id, $mod->inst_version, $mod->cpan_version;
4970 If that gives you too much output every day, you maybe only want to
4971 watch for three modules. You can write
4973 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
4975 as the first line instead. Or you can combine some of the above
4978 # watch only for a new mod_perl module
4979 $mod = CPAN::Shell->expand("Module","mod_perl");
4980 exit if $mod->uptodate;
4981 # new mod_perl arrived, let me know all update recommendations
4986 =head2 Methods in the four Classes
4988 =head2 Cache Manager
4990 Currently the cache manager only keeps track of the build directory
4991 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
4992 deletes complete directories below C<build_dir> as soon as the size of
4993 all directories there gets bigger than $CPAN::Config->{build_cache}
4994 (in MB). The contents of this cache may be used for later
4995 re-installations that you intend to do manually, but will never be
4996 trusted by CPAN itself. This is due to the fact that the user might
4997 use these directories for building modules on different architectures.
4999 There is another directory ($CPAN::Config->{keep_source_where}) where
5000 the original distribution files are kept. This directory is not
5001 covered by the cache manager and must be controlled by the user. If
5002 you choose to have the same directory as build_dir and as
5003 keep_source_where directory, then your sources will be deleted with
5004 the same fifo mechanism.
5008 A bundle is just a perl module in the namespace Bundle:: that does not
5009 define any functions or methods. It usually only contains documentation.
5011 It starts like a perl module with a package declaration and a $VERSION
5012 variable. After that the pod section looks like any other pod with the
5013 only difference being that I<one special pod section> exists starting with
5018 In this pod section each line obeys the format
5020 Module_Name [Version_String] [- optional text]
5022 The only required part is the first field, the name of a module
5023 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
5024 of the line is optional. The comment part is delimited by a dash just
5025 as in the man page header.
5027 The distribution of a bundle should follow the same convention as
5028 other distributions.
5030 Bundles are treated specially in the CPAN package. If you say 'install
5031 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
5032 the modules in the CONTENTS section of the pod. You can install your
5033 own Bundles locally by placing a conformant Bundle file somewhere into
5034 your @INC path. The autobundle() command which is available in the
5035 shell interface does that for you by including all currently installed
5036 modules in a snapshot bundle file.
5038 =head2 Prerequisites
5040 If you have a local mirror of CPAN and can access all files with
5041 "file:" URLs, then you only need a perl better than perl5.003 to run
5042 this module. Otherwise Net::FTP is strongly recommended. LWP may be
5043 required for non-UNIX systems or if your nearest CPAN site is
5044 associated with an URL that is not C<ftp:>.
5046 If you have neither Net::FTP nor LWP, there is a fallback mechanism
5047 implemented for an external ftp command or for an external lynx
5050 =head2 Finding packages and VERSION
5052 This module presumes that all packages on CPAN
5058 declare their $VERSION variable in an easy to parse manner. This
5059 prerequisite can hardly be relaxed because it consumes far too much
5060 memory to load all packages into the running program just to determine
5061 the $VERSION variable. Currently all programs that are dealing with
5062 version use something like this
5064 perl -MExtUtils::MakeMaker -le \
5065 'print MM->parse_version(shift)' filename
5067 If you are author of a package and wonder if your $VERSION can be
5068 parsed, please try the above method.
5072 come as compressed or gzipped tarfiles or as zip files and contain a
5073 Makefile.PL (well, we try to handle a bit more, but without much
5080 The debugging of this module is pretty difficult, because we have
5081 interferences of the software producing the indices on CPAN, of the
5082 mirroring process on CPAN, of packaging, of configuration, of
5083 synchronicity, and of bugs within CPAN.pm.
5085 In interactive mode you can try "o debug" which will list options for
5086 debugging the various parts of the package. The output may not be very
5087 useful for you as it's just a by-product of my own testing, but if you
5088 have an idea which part of the package may have a bug, it's sometimes
5089 worth to give it a try and send me more specific output. You should
5090 know that "o debug" has built-in completion support.
5092 =head2 Floppy, Zip, Offline Mode
5094 CPAN.pm works nicely without network too. If you maintain machines
5095 that are not networked at all, you should consider working with file:
5096 URLs. Of course, you have to collect your modules somewhere first. So
5097 you might use CPAN.pm to put together all you need on a networked
5098 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
5099 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
5100 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
5101 with this floppy. See also below the paragraph about CD-ROM support.
5103 =head1 CONFIGURATION
5105 When the CPAN module is installed, a site wide configuration file is
5106 created as CPAN/Config.pm. The default values defined there can be
5107 overridden in another configuration file: CPAN/MyConfig.pm. You can
5108 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
5109 $HOME/.cpan is added to the search path of the CPAN module before the
5110 use() or require() statements.
5112 Currently the following keys in the hash reference $CPAN::Config are
5115 build_cache size of cache for directories to build modules
5116 build_dir locally accessible directory to build modules
5117 index_expire after this many days refetch index files
5118 cpan_home local directory reserved for this package
5119 dontload_hash anonymous hash: modules in the keys will not be
5120 loaded by the CPAN::has_inst() routine
5121 gzip location of external program gzip
5122 inactivity_timeout breaks interactive Makefile.PLs after this
5123 many seconds inactivity. Set to 0 to never break.
5124 inhibit_startup_message
5125 if true, does not print the startup message
5126 keep_source_where directory in which to keep the source (if we do)
5127 make location of external make program
5128 make_arg arguments that should always be passed to 'make'
5129 make_install_arg same as make_arg for 'make install'
5130 makepl_arg arguments passed to 'perl Makefile.PL'
5131 pager location of external program more (or any pager)
5132 prerequisites_policy
5133 what to do if you are missing module prerequisites
5134 ('follow' automatically, 'ask' me, or 'ignore')
5135 scan_cache controls scanning of cache ('atstart' or 'never')
5136 tar location of external program tar
5137 unzip location of external program unzip
5138 urllist arrayref to nearby CPAN sites (or equivalent locations)
5139 wait_list arrayref to a wait server to try (See CPAN::WAIT)
5140 ftp_proxy, } the three usual variables for configuring
5141 http_proxy, } proxy requests. Both as CPAN::Config variables
5142 no_proxy } and as environment variables configurable.
5144 You can set and query each of these options interactively in the cpan
5145 shell with the command set defined within the C<o conf> command:
5149 =item C<o conf E<lt>scalar optionE<gt>>
5151 prints the current value of the I<scalar option>
5153 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
5155 Sets the value of the I<scalar option> to I<value>
5157 =item C<o conf E<lt>list optionE<gt>>
5159 prints the current value of the I<list option> in MakeMaker's
5162 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
5164 shifts or pops the array in the I<list option> variable
5166 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
5168 works like the corresponding perl commands.
5172 =head2 Note on urllist parameter's format
5174 urllist parameters are URLs according to RFC 1738. We do a little
5175 guessing if your URL is not compliant, but if you have problems with file URLs, please try the correct format. Either:
5177 file://localhost/whatever/ftp/pub/CPAN/
5181 file:///home/ftp/pub/CPAN/
5183 =head2 urllist parameter has CD-ROM support
5185 The C<urllist> parameter of the configuration table contains a list of
5186 URLs that are to be used for downloading. If the list contains any
5187 C<file> URLs, CPAN always tries to get files from there first. This
5188 feature is disabled for index files. So the recommendation for the
5189 owner of a CD-ROM with CPAN contents is: include your local, possibly
5190 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
5192 o conf urllist push file://localhost/CDROM/CPAN
5194 CPAN.pm will then fetch the index files from one of the CPAN sites
5195 that come at the beginning of urllist. It will later check for each
5196 module if there is a local copy of the most recent version.
5198 Another peculiarity of urllist is that the site that we could
5199 successfully fetch the last file from automatically gets a preference
5200 token and is tried as the first site for the next request. So if you
5201 add a new site at runtime it may happen that the previously preferred
5202 site will be tried another time. This means that if you want to disallow
5203 a site for the next transfer, it must be explicitly removed from
5208 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
5209 install foreign, unmasked, unsigned code on your machine. We compare
5210 to a checksum that comes from the net just as the distribution file
5211 itself. If somebody has managed to tamper with the distribution file,
5212 they may have as well tampered with the CHECKSUMS file. Future
5213 development will go towards strong authentication.
5217 Most functions in package CPAN are exported per default. The reason
5218 for this is that the primary use is intended for the cpan shell or for
5221 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
5223 To populate a freshly installed perl with my favorite modules is pretty
5224 easiest by maintaining a private bundle definition file. To get a useful
5225 blueprint of a bundle definition file, the command autobundle can be used
5226 on the CPAN shell command line. This command writes a bundle definition
5227 file for all modules that are installed for the currently running perl
5228 interpreter. It's recommended to run this command only once and from then
5229 on maintain the file manually under a private name, say
5230 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
5232 cpan> install Bundle::my_bundle
5234 then answer a few questions and then go out for a coffee.
5236 Maintaining a bundle definition file means to keep track of two
5237 things: dependencies and interactivity. CPAN.pm sometimes fails on
5238 calculating dependencies because not all modules define all MakeMaker
5239 attributes correctly, so a bundle definition file should specify
5240 prerequisites as early as possible. On the other hand, it's a bit
5241 annoying that many distributions need some interactive configuring. So
5242 what I try to accomplish in my private bundle file is to have the
5243 packages that need to be configured early in the file and the gentle
5244 ones later, so I can go out after a few minutes and leave CPAN.pm
5247 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
5249 Thanks to Graham Barr for contributing the following paragraphs about
5250 the interaction between perl, and various firewall configurations. For
5251 further informations on firewalls, it is recommended to consult the
5252 documentation that comes with the ncftp program. If you are unable to
5253 go through the firewall with a simple Perl setup, it is very likely
5254 that you can configure ncftp so that it works for your firewall.
5256 =head2 Three basic types of firewalls
5258 Firewalls can be categorized into three basic types.
5264 This is where the firewall machine runs a web server and to access the
5265 outside world you must do it via the web server. If you set environment
5266 variables like http_proxy or ftp_proxy to a values beginning with http://
5267 or in your web browser you have to set proxy information then you know
5268 you are running a http firewall.
5270 To access servers outside these types of firewalls with perl (even for
5271 ftp) you will need to use LWP.
5275 This where the firewall machine runs a ftp server. This kind of
5276 firewall will only let you access ftp servers outside the firewall.
5277 This is usually done by connecting to the firewall with ftp, then
5278 entering a username like "user@outside.host.com"
5280 To access servers outside these type of firewalls with perl you
5281 will need to use Net::FTP.
5283 =item One way visibility
5285 I say one way visibility as these firewalls try to make themselve look
5286 invisible to the users inside the firewall. An FTP data connection is
5287 normally created by sending the remote server your IP address and then
5288 listening for the connection. But the remote server will not be able to
5289 connect to you because of the firewall. So for these types of firewall
5290 FTP connections need to be done in a passive mode.
5292 There are two that I can think off.
5298 If you are using a SOCKS firewall you will need to compile perl and link
5299 it with the SOCKS library, this is what is normally called a ``socksified''
5300 perl. With this executable you will be able to connect to servers outside
5301 the firewall as if it is not there.
5305 This is the firewall implemented in the Linux kernel, it allows you to
5306 hide a complete network behind one IP address. With this firewall no
5307 special compiling is need as you can access hosts directly.
5313 =head2 Configuring lynx or ncftp for going throught the firewall
5315 If you can go through your firewall with e.g. lynx, presumably with a
5318 /usr/local/bin/lynx -pscott:tiger
5320 then you would configure CPAN.pm with the command
5322 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
5324 That's all. Similarly for ncftp or ftp, you would configure something
5327 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
5329 Your milage may vary...
5335 =item I installed a new version of module X but CPAN keeps saying, I
5336 have the old version installed
5338 Most probably you B<do> have the old version installed. This can
5339 happen if a module installs itself into a different directory in the
5340 @INC path than it was previously installed. This is not really a
5341 CPAN.pm problem, you would have the same problem when installing the
5342 module manually. The easiest way to prevent this behaviour is to add
5343 the argument C<UNINST=1> to the C<make install> call, and that is why
5344 many people add this argument permanently by configuring
5346 o conf make_install_arg UNINST=1
5348 =item So why is UNINST=1 not the default?
5350 Because there are people who have their precise expectations about who
5351 may install where in the @INC path and who uses which @INC array. In
5352 fine tuned environments C<UNINST=1> can cause damage.
5354 =item When I install bundles or multiple modules with one command
5355 there is too much output to keep track of
5357 You may want to configure something like
5359 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
5360 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
5362 so that STDOUT is captured in a file for later inspection.
5368 We should give coverage for B<all> of the CPAN and not just the PAUSE
5369 part, right? In this discussion CPAN and PAUSE have become equal --
5370 but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus
5371 the clpa/, doc/, misc/, ports/, src/, scripts/.
5373 Future development should be directed towards a better integration of
5376 If a Makefile.PL requires special customization of libraries, prompts
5377 the user for special input, etc. then you may find CPAN is not able to
5378 build the distribution. In that case, you should attempt the
5379 traditional method of building a Perl module package from a shell.
5383 Andreas Koenig E<lt>andreas.koenig@anima.deE<gt>
5387 perl(1), CPAN::Nox(3)