1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 # $Id: CPAN.pm,v 1.381 2000/12/01 08:13:05 k Exp $
6 # only used during development:
8 # $Revision = "[".substr(q$Revision: 1.381 $, 10)."]";
15 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
16 use File::Basename ();
22 use Text::ParseWords ();
25 no lib "."; # we need to run chdir all over and we would get at wrong
28 END { $End++; &cleanup; }
51 $CPAN::Frontend ||= "CPAN::Shell";
52 $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
57 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
58 $Revision $Signal $End $Suppress_readline $Frontend
59 $Defaultsite $Have_warned);
61 @CPAN::ISA = qw(CPAN::Debug Exporter);
64 autobundle bundle expand force get cvs_import
65 install make readme recompile shell test clean
68 #-> sub CPAN::AUTOLOAD ;
73 @EXPORT{@EXPORT} = '';
74 CPAN::Config->load unless $CPAN::Config_loaded++;
75 if (exists $EXPORT{$l}){
78 $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
87 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
88 CPAN::Config->load unless $CPAN::Config_loaded++;
90 my $oprompt = shift || "cpan> ";
91 my $prompt = $oprompt;
92 my $commandline = shift || "";
95 unless ($Suppress_readline) {
96 require Term::ReadLine;
99 $term->ReadLine eq "Term::ReadLine::Stub"
101 $term = Term::ReadLine->new('CPAN Monitor');
103 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
104 my $attribs = $term->Attribs;
105 $attribs->{attempted_completion_function} = sub {
106 &CPAN::Complete::gnu_cpl;
109 $readline::rl_completion_function =
110 $readline::rl_completion_function = 'CPAN::Complete::cpl';
112 # $term->OUT is autoflushed anyway
113 my $odef = select STDERR;
120 # no strict; # I do not recall why no strict was here (2000-09-03)
122 my $cwd = CPAN::anycwd();
123 my $try_detect_readline;
124 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
125 my $rl_avail = $Suppress_readline ? "suppressed" :
126 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
127 "available (try 'install Bundle::CPAN')";
129 $CPAN::Frontend->myprint(
131 cpan shell -- CPAN exploration and modules installation (v%s%s)
139 unless $CPAN::Config->{'inhibit_startup_message'} ;
140 my($continuation) = "";
141 SHELLCOMMAND: while () {
142 if ($Suppress_readline) {
144 last SHELLCOMMAND unless defined ($_ = <> );
147 last SHELLCOMMAND unless
148 defined ($_ = $term->readline($prompt, $commandline));
150 $_ = "$continuation$_" if $continuation;
152 next SHELLCOMMAND if /^$/;
153 $_ = 'h' if /^\s*\?/;
154 if (/^(?:q(?:uit)?|bye|exit)$/i) {
164 use vars qw($import_done);
165 CPAN->import(':DEFAULT') unless $import_done++;
166 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
173 if ($] < 5.00322) { # parsewords had a bug until recently
176 eval { @line = Text::ParseWords::shellwords($_) };
177 warn($@), next SHELLCOMMAND if $@;
178 warn("Text::Parsewords could not parse the line [$_]"),
179 next SHELLCOMMAND unless @line;
181 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
182 my $command = shift @line;
183 eval { CPAN::Shell->$command(@line) };
185 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
186 $CPAN::Frontend->myprint("\n");
191 $commandline = ""; # I do want to be able to pass a default to
192 # shell, but on the second command I see no
195 CPAN::Queue->nullify_queue;
196 if ($try_detect_readline) {
197 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
199 $CPAN::META->has_inst("Term::ReadLine::Perl")
201 delete $INC{"Term/ReadLine.pm"};
203 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
204 require Term::ReadLine;
205 $CPAN::Frontend->myprint("\n$redef subroutines in ".
206 "Term::ReadLine redefined\n");
212 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
215 package CPAN::CacheMgr;
216 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
219 package CPAN::Config;
220 use vars qw(%can $dot_cpan);
223 'commit' => "Commit changes to disk",
224 'defaults' => "Reload defaults from disk",
225 'init' => "Interactive setting of all options",
229 use vars qw($Ua $Thesite $Themethod);
230 @CPAN::FTP::ISA = qw(CPAN::Debug);
232 package CPAN::Complete;
233 @CPAN::Complete::ISA = qw(CPAN::Debug);
234 @CPAN::Complete::COMMANDS = sort qw(
235 ! a b d h i m o q r u autobundle clean dump
236 make test install force readme reload look
238 ) unless @CPAN::Complete::COMMANDS;
241 use vars qw($last_time $date_of_03);
242 @CPAN::Index::ISA = qw(CPAN::Debug);
245 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
248 package CPAN::InfoObj;
249 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
251 package CPAN::Author;
252 @CPAN::Author::ISA = qw(CPAN::InfoObj);
254 package CPAN::Distribution;
255 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
257 package CPAN::Bundle;
258 @CPAN::Bundle::ISA = qw(CPAN::Module);
260 package CPAN::Module;
261 @CPAN::Module::ISA = qw(CPAN::InfoObj);
264 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
265 @CPAN::Shell::ISA = qw(CPAN::Debug);
266 $COLOR_REGISTERED ||= 0;
267 $PRINT_ORNAMENTING ||= 0;
269 #-> sub CPAN::Shell::AUTOLOAD ;
271 my($autoload) = $AUTOLOAD;
272 my $class = shift(@_);
273 # warn "autoload[$autoload] class[$class]";
274 $autoload =~ s/.*:://;
275 if ($autoload =~ /^w/) {
276 if ($CPAN::META->has_inst('CPAN::WAIT')) {
277 CPAN::WAIT->$autoload(@_);
279 $CPAN::Frontend->mywarn(qq{
280 Commands starting with "w" require CPAN::WAIT to be installed.
281 Please consider installing CPAN::WAIT to use the fulltext index.
282 For this you just need to type
287 $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
293 package CPAN::Tarzip;
294 use vars qw($AUTOLOAD @ISA $BUGHUNTING);
295 @CPAN::Tarzip::ISA = qw(CPAN::Debug);
296 $BUGHUNTING = 0; # released code must have turned off
300 # One use of the queue is to determine if we should or shouldn't
301 # announce the availability of a new CPAN module
303 # Now we try to use it for dependency tracking. For that to happen
304 # we need to draw a dependency tree and do the leaves first. This can
305 # easily be reached by running CPAN.pm recursively, but we don't want
306 # to waste memory and run into deep recursion. So what we can do is
309 # CPAN::Queue is the package where the queue is maintained. Dependencies
310 # often have high priority and must be brought to the head of the queue,
311 # possibly by jumping the queue if they are already there. My first code
312 # attempt tried to be extremely correct. Whenever a module needed
313 # immediate treatment, I either unshifted it to the front of the queue,
314 # or, if it was already in the queue, I spliced and let it bypass the
315 # others. This became a too correct model that made it impossible to put
316 # an item more than once into the queue. Why would you need that? Well,
317 # you need temporary duplicates as the manager of the queue is a loop
320 # (1) looks at the first item in the queue without shifting it off
322 # (2) cares for the item
324 # (3) removes the item from the queue, *even if its agenda failed and
325 # even if the item isn't the first in the queue anymore* (that way
326 # protecting against never ending queues)
328 # So if an item has prerequisites, the installation fails now, but we
329 # want to retry later. That's easy if we have it twice in the queue.
331 # I also expect insane dependency situations where an item gets more
332 # than two lives in the queue. Simplest example is triggered by 'install
333 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
334 # get in the way. I wanted the queue manager to be a dumb servant, not
335 # one that knows everything.
337 # Who would I tell in this model that the user wants to be asked before
338 # processing? I can't attach that information to the module object,
339 # because not modules are installed but distributions. So I'd have to
340 # tell the distribution object that it should ask the user before
341 # processing. Where would the question be triggered then? Most probably
342 # in CPAN::Distribution::rematein.
343 # Hope that makes sense, my head is a bit off:-) -- AK
350 my $self = bless { qmod => $s }, $class;
355 # CPAN::Queue::first ;
361 # CPAN::Queue::delete_first ;
363 my($class,$what) = @_;
365 for my $i (0..$#All) {
366 if ( $All[$i]->{qmod} eq $what ) {
373 # CPAN::Queue::jumpqueue ;
377 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
378 join(",",map {$_->{qmod}} @All),
381 WHAT: for my $what (reverse @what) {
383 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
384 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
385 if ($All[$i]->{qmod} eq $what){
387 if ($jumped > 100) { # one's OK if e.g. just
388 # processing now; more are OK if
389 # user typed it several times
390 $CPAN::Frontend->mywarn(
391 qq{Object [$what] queued more than 100 times, ignoring}
397 my $obj = bless { qmod => $what }, $class;
400 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
401 join(",",map {$_->{qmod}} @All),
406 # CPAN::Queue::exists ;
408 my($self,$what) = @_;
409 my @all = map { $_->{qmod} } @All;
410 my $exists = grep { $_->{qmod} eq $what } @All;
411 # warn "in exists what[$what] all[@all] exists[$exists]";
415 # CPAN::Queue::delete ;
418 @All = grep { $_->{qmod} ne $mod } @All;
421 # CPAN::Queue::nullify_queue ;
430 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
432 # from here on only subs.
433 ################################################################################
435 #-> sub CPAN::all_objects ;
437 my($mgr,$class) = @_;
438 CPAN::Config->load unless $CPAN::Config_loaded++;
439 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
441 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
443 *all = \&all_objects;
445 # Called by shell, not in batch mode. In batch mode I see no risk in
446 # having many processes updating something as installations are
447 # continually checked at runtime. In shell mode I suspect it is
448 # unintentional to open more than one shell at a time
450 #-> sub CPAN::checklock ;
453 my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
454 if (-f $lockfile && -M _ > 0) {
455 my $fh = FileHandle->new($lockfile) or
456 $CPAN::Frontend->mydie("Could not open $lockfile: $!");
459 if (defined $other && $other) {
461 return if $$==$other; # should never happen
462 $CPAN::Frontend->mywarn(
464 There seems to be running another CPAN process ($other). Contacting...
466 if (kill 0, $other) {
467 $CPAN::Frontend->mydie(qq{Other job is running.
468 You may want to kill it and delete the lockfile, maybe. On UNIX try:
472 } elsif (-w $lockfile) {
474 ExtUtils::MakeMaker::prompt
475 (qq{Other job not responding. Shall I overwrite }.
476 qq{the lockfile? (Y/N)},"y");
477 $CPAN::Frontend->myexit("Ok, bye\n")
478 unless $ans =~ /^y/i;
481 qq{Lockfile $lockfile not writeable by you. }.
482 qq{Cannot proceed.\n}.
485 qq{ and then rerun us.\n}
489 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile ".
490 "reports other process with ID ".
491 "$other. Cannot proceed.\n"));
494 my $dotcpan = $CPAN::Config->{cpan_home};
495 eval { File::Path::mkpath($dotcpan);};
497 # A special case at least for Jarkko.
502 $symlinkcpan = readlink $dotcpan;
503 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
504 eval { File::Path::mkpath($symlinkcpan); };
508 $CPAN::Frontend->mywarn(qq{
509 Working directory $symlinkcpan created.
513 unless (-d $dotcpan) {
515 Your configuration suggests "$dotcpan" as your
516 CPAN.pm working directory. I could not create this directory due
517 to this error: $firsterror\n};
519 As "$dotcpan" is a symlink to "$symlinkcpan",
520 I tried to create that, but I failed with this error: $seconderror
523 Please make sure the directory exists and is writable.
525 $CPAN::Frontend->mydie($diemess);
529 unless ($fh = FileHandle->new(">$lockfile")) {
530 if ($! =~ /Permission/) {
531 my $incc = $INC{'CPAN/Config.pm'};
532 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
533 $CPAN::Frontend->myprint(qq{
535 Your configuration suggests that CPAN.pm should use a working
537 $CPAN::Config->{cpan_home}
538 Unfortunately we could not create the lock file
540 due to permission problems.
542 Please make sure that the configuration variable
543 \$CPAN::Config->{cpan_home}
544 points to a directory where you can write a .lock file. You can set
545 this variable in either
552 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
554 $fh->print($$, "\n");
555 $self->{LOCK} = $lockfile;
559 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
564 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
565 print "Caught SIGINT\n";
569 # From: Larry Wall <larry@wall.org>
570 # Subject: Re: deprecating SIGDIE
571 # To: perl5-porters@perl.org
572 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
574 # The original intent of __DIE__ was only to allow you to substitute one
575 # kind of death for another on an application-wide basis without respect
576 # to whether you were in an eval or not. As a global backstop, it should
577 # not be used any more lightly (or any more heavily :-) than class
578 # UNIVERSAL. Any attempt to build a general exception model on it should
579 # be politely squashed. Any bug that causes every eval {} to have to be
580 # modified should be not so politely squashed.
582 # Those are my current opinions. It is also my optinion that polite
583 # arguments degenerate to personal arguments far too frequently, and that
584 # when they do, it's because both people wanted it to, or at least didn't
585 # sufficiently want it not to.
589 # global backstop to cleanup if we should really die
590 $SIG{__DIE__} = \&cleanup;
591 $self->debug("Signal handler set.") if $CPAN::DEBUG;
594 #-> sub CPAN::DESTROY ;
596 &cleanup; # need an eval?
599 #-> sub CPAN::anycwd ;
602 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
607 sub cwd {Cwd::cwd();}
609 #-> sub CPAN::getcwd ;
610 sub getcwd {Cwd::getcwd();}
612 #-> sub CPAN::exists ;
614 my($mgr,$class,$id) = @_;
615 CPAN::Config->load unless $CPAN::Config_loaded++;
617 ### Carp::croak "exists called without class argument" unless $class;
619 exists $META->{readonly}{$class}{$id} or
620 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
623 #-> sub CPAN::delete ;
625 my($mgr,$class,$id) = @_;
626 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
627 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
630 #-> sub CPAN::has_usable
631 # has_inst is sometimes too optimistic, we should replace it with this
632 # has_usable whenever a case is given
634 my($self,$mod,$message) = @_;
635 return 1 if $HAS_USABLE->{$mod};
636 my $has_inst = $self->has_inst($mod,$message);
637 return unless $has_inst;
640 LWP => [ # we frequently had "Can't locate object
641 # method "new" via package "LWP::UserAgent" at
642 # (eval 69) line 2006
644 sub {require LWP::UserAgent},
645 sub {require HTTP::Request},
646 sub {require URI::URL},
649 sub {require Net::FTP},
650 sub {require Net::Config},
653 if ($usable->{$mod}) {
654 for my $c (0..$#{$usable->{$mod}}) {
655 my $code = $usable->{$mod}[$c];
656 my $ret = eval { &$code() };
658 warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
663 return $HAS_USABLE->{$mod} = 1;
666 #-> sub CPAN::has_inst
668 my($self,$mod,$message) = @_;
669 Carp::croak("CPAN->has_inst() called without an argument")
671 if (defined $message && $message eq "no"
673 exists $CPAN::META->{dontload_hash}{$mod} # unsafe meta access, ok
675 exists $CPAN::Config->{dontload_hash}{$mod}
677 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
683 $file =~ s|/|\\|g if $^O eq 'MSWin32';
686 # checking %INC is wrong, because $INC{LWP} may be true
687 # although $INC{"URI/URL.pm"} may have failed. But as
688 # I really want to say "bla loaded OK", I have to somehow
690 ### warn "$file in %INC"; #debug
692 } elsif (eval { require $file }) {
693 # eval is good: if we haven't yet read the database it's
694 # perfect and if we have installed the module in the meantime,
695 # it tries again. The second require is only a NOOP returning
696 # 1 if we had success, otherwise it's retrying
698 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
699 if ($mod eq "CPAN::WAIT") {
700 push @CPAN::Shell::ISA, CPAN::WAIT;
703 } elsif ($mod eq "Net::FTP") {
704 $CPAN::Frontend->mywarn(qq{
705 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
707 install Bundle::libnet
709 }) unless $Have_warned->{"Net::FTP"}++;
711 } elsif ($mod eq "MD5"){
712 $CPAN::Frontend->myprint(qq{
713 CPAN: MD5 security checks disabled because MD5 not installed.
714 Please consider installing the MD5 module.
719 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
724 #-> sub CPAN::instance ;
726 my($mgr,$class,$id) = @_;
729 # unsafe meta access, ok?
730 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
731 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
739 #-> sub CPAN::cleanup ;
741 # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
742 local $SIG{__DIE__} = '';
747 0 && # disabled, try reload cpan with it
748 $] > 5.004_60 # thereabouts
753 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
755 $subroutine eq '(eval)';
758 return if $ineval && !$End;
759 return unless defined $META->{LOCK}; # unsafe meta access, ok
760 return unless -f $META->{LOCK}; # unsafe meta access, ok
761 unlink $META->{LOCK}; # unsafe meta access, ok
763 # Carp::cluck("DEBUGGING");
764 $CPAN::Frontend->mywarn("Lockfile removed.\n");
767 package CPAN::CacheMgr;
769 #-> sub CPAN::CacheMgr::as_string ;
771 eval { require Data::Dumper };
773 return shift->SUPER::as_string;
775 return Data::Dumper::Dumper(shift);
779 #-> sub CPAN::CacheMgr::cachesize ;
784 #-> sub CPAN::CacheMgr::tidyup ;
787 return unless -d $self->{ID};
788 while ($self->{DU} > $self->{'MAX'} ) {
789 my($toremove) = shift @{$self->{FIFO}};
790 $CPAN::Frontend->myprint(sprintf(
791 "Deleting from cache".
792 ": $toremove (%.1f>%.1f MB)\n",
793 $self->{DU}, $self->{'MAX'})
795 return if $CPAN::Signal;
796 $self->force_clean_cache($toremove);
797 return if $CPAN::Signal;
801 #-> sub CPAN::CacheMgr::dir ;
806 #-> sub CPAN::CacheMgr::entries ;
809 return unless defined $dir;
810 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
811 $dir ||= $self->{ID};
812 my($cwd) = CPAN::anycwd();
813 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
814 my $dh = DirHandle->new(File::Spec->curdir)
815 or Carp::croak("Couldn't opendir $dir: $!");
818 next if $_ eq "." || $_ eq "..";
820 push @entries, MM->catfile($dir,$_);
822 push @entries, MM->catdir($dir,$_);
824 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
827 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
828 sort { -M $b <=> -M $a} @entries;
831 #-> sub CPAN::CacheMgr::disk_usage ;
834 return if exists $self->{SIZE}{$dir};
835 return if $CPAN::Signal;
839 $File::Find::prune++ if $CPAN::Signal;
841 if ($^O eq 'MacOS') {
843 my $cat = Mac::Files::FSpGetCatInfo($_);
844 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
851 return if $CPAN::Signal;
852 $self->{SIZE}{$dir} = $Du/1024/1024;
853 push @{$self->{FIFO}}, $dir;
854 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
855 $self->{DU} += $Du/1024/1024;
859 #-> sub CPAN::CacheMgr::force_clean_cache ;
860 sub force_clean_cache {
862 return unless -e $dir;
863 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
865 File::Path::rmtree($dir);
866 $self->{DU} -= $self->{SIZE}{$dir};
867 delete $self->{SIZE}{$dir};
870 #-> sub CPAN::CacheMgr::new ;
877 ID => $CPAN::Config->{'build_dir'},
878 MAX => $CPAN::Config->{'build_cache'},
879 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
882 File::Path::mkpath($self->{ID});
883 my $dh = DirHandle->new($self->{ID});
887 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
889 CPAN->debug($debug) if $CPAN::DEBUG;
893 #-> sub CPAN::CacheMgr::scan_cache ;
896 return if $self->{SCAN} eq 'never';
897 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
898 unless $self->{SCAN} eq 'atstart';
899 $CPAN::Frontend->myprint(
900 sprintf("Scanning cache %s for sizes\n",
903 for $e ($self->entries($self->{ID})) {
904 next if $e eq ".." || $e eq ".";
905 $self->disk_usage($e);
906 return if $CPAN::Signal;
913 #-> sub CPAN::Debug::debug ;
916 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
917 # Complete, caller(1)
919 ($caller) = caller(0);
921 $arg = "" unless defined $arg;
922 my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
923 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
924 if ($arg and ref $arg) {
925 eval { require Data::Dumper };
927 $CPAN::Frontend->myprint($arg->as_string);
929 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
932 $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
937 package CPAN::Config;
939 #-> sub CPAN::Config::edit ;
940 # returns true on successful action
942 my($self,@args) = @_;
944 CPAN->debug("self[$self]args[".join(" | ",@args)."]");
945 my($o,$str,$func,$args,$key_exists);
951 CPAN->debug("o[$o]") if $CPAN::DEBUG;
955 CPAN->debug("func[$func]") if $CPAN::DEBUG;
957 # Let's avoid eval, it's easier to comprehend without.
958 if ($func eq "push") {
959 push @{$CPAN::Config->{$o}}, @args;
961 } elsif ($func eq "pop") {
962 pop @{$CPAN::Config->{$o}};
964 } elsif ($func eq "shift") {
965 shift @{$CPAN::Config->{$o}};
967 } elsif ($func eq "unshift") {
968 unshift @{$CPAN::Config->{$o}}, @args;
970 } elsif ($func eq "splice") {
971 splice @{$CPAN::Config->{$o}}, @args;
974 $CPAN::Config->{$o} = [@args];
977 $self->prettyprint($o);
979 if ($o eq "urllist" && $changed) {
980 # reset the cached values
981 undef $CPAN::FTP::Thesite;
982 undef $CPAN::FTP::Themethod;
986 $CPAN::Config->{$o} = $args[0] if defined $args[0];
987 $self->prettyprint($o);
994 my $v = $CPAN::Config->{$k};
996 my(@report) = ref $v eq "ARRAY" ?
998 map { sprintf(" %-18s => %s\n",
1000 defined $v->{$_} ? $v->{$_} : "UNDEFINED"
1002 $CPAN::Frontend->myprint(
1009 map {"\t$_\n"} @report
1012 } elsif (defined $v) {
1013 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1015 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, "UNDEFINED");
1019 #-> sub CPAN::Config::commit ;
1021 my($self,$configpm) = @_;
1022 unless (defined $configpm){
1023 $configpm ||= $INC{"CPAN/MyConfig.pm"};
1024 $configpm ||= $INC{"CPAN/Config.pm"};
1025 $configpm || Carp::confess(q{
1026 CPAN::Config::commit called without an argument.
1027 Please specify a filename where to save the configuration or try
1028 "o conf init" to have an interactive course through configing.
1033 $mode = (stat $configpm)[2];
1034 if ($mode && ! -w _) {
1035 Carp::confess("$configpm is not writable");
1040 $msg = <<EOF unless $configpm =~ /MyConfig/;
1042 # This is CPAN.pm's systemwide configuration file. This file provides
1043 # defaults for users, and the values can be changed in a per-user
1044 # configuration file. The user-config file is being looked for as
1045 # ~/.cpan/CPAN/MyConfig.pm.
1049 my($fh) = FileHandle->new;
1050 rename $configpm, "$configpm~" if -f $configpm;
1051 open $fh, ">$configpm" or
1052 $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
1053 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
1054 foreach (sort keys %$CPAN::Config) {
1057 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
1062 $fh->print("};\n1;\n__END__\n");
1065 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
1066 #chmod $mode, $configpm;
1067 ###why was that so? $self->defaults;
1068 $CPAN::Frontend->myprint("commit: wrote $configpm\n");
1072 *default = \&defaults;
1073 #-> sub CPAN::Config::defaults ;
1083 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
1092 #-> sub CPAN::Config::load ;
1097 eval {require CPAN::Config;}; # We eval because of some
1098 # MakeMaker problems
1099 unless ($dot_cpan++){
1100 unshift @INC, MM->catdir($ENV{HOME},".cpan");
1101 eval {require CPAN::MyConfig;}; # where you can override
1102 # system wide settings
1105 return unless @miss = $self->missing_config_data;
1107 require CPAN::FirstTime;
1108 my($configpm,$fh,$redo,$theycalled);
1110 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
1111 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
1112 $configpm = $INC{"CPAN/Config.pm"};
1114 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
1115 $configpm = $INC{"CPAN/MyConfig.pm"};
1118 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
1119 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
1120 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
1121 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
1122 if (-w $configpmtest) {
1123 $configpm = $configpmtest;
1124 } elsif (-w $configpmdir) {
1125 #_#_# following code dumped core on me with 5.003_11, a.k.
1126 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
1127 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
1128 my $fh = FileHandle->new;
1129 if ($fh->open(">$configpmtest")) {
1131 $configpm = $configpmtest;
1133 # Should never happen
1134 Carp::confess("Cannot open >$configpmtest");
1138 unless ($configpm) {
1139 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
1140 File::Path::mkpath($configpmdir);
1141 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
1142 if (-w $configpmtest) {
1143 $configpm = $configpmtest;
1144 } elsif (-w $configpmdir) {
1145 #_#_# following code dumped core on me with 5.003_11, a.k.
1146 my $fh = FileHandle->new;
1147 if ($fh->open(">$configpmtest")) {
1149 $configpm = $configpmtest;
1151 # Should never happen
1152 Carp::confess("Cannot open >$configpmtest");
1155 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
1156 qq{create a configuration file.});
1161 $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
1162 We have to reconfigure CPAN.pm due to following uninitialized parameters:
1166 $CPAN::Frontend->myprint(qq{
1167 $configpm initialized.
1170 CPAN::FirstTime::init($configpm);
1173 #-> sub CPAN::Config::missing_config_data ;
1174 sub missing_config_data {
1177 "cpan_home", "keep_source_where", "build_dir", "build_cache",
1178 "scan_cache", "index_expire", "gzip", "tar", "unzip", "make",
1180 "makepl_arg", "make_arg", "make_install_arg", "urllist",
1181 "inhibit_startup_message", "ftp_proxy", "http_proxy", "no_proxy",
1182 "prerequisites_policy",
1185 push @miss, $_ unless defined $CPAN::Config->{$_};
1190 #-> sub CPAN::Config::unload ;
1192 delete $INC{'CPAN/MyConfig.pm'};
1193 delete $INC{'CPAN/Config.pm'};
1196 #-> sub CPAN::Config::help ;
1198 $CPAN::Frontend->myprint(q[
1200 defaults reload default config values from disk
1201 commit commit session changes to disk
1202 init go through a dialog to set all parameters
1204 You may edit key values in the follow fashion (the "o" is a literal
1207 o conf build_cache 15
1209 o conf build_dir "/foo/bar"
1211 o conf urllist shift
1213 o conf urllist unshift ftp://ftp.foo.bar/
1216 undef; #don't reprint CPAN::Config
1219 #-> sub CPAN::Config::cpl ;
1221 my($word,$line,$pos) = @_;
1223 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1224 my(@words) = split " ", substr($line,0,$pos+1);
1229 $words[2] =~ /list$/ && @words == 3
1231 $words[2] =~ /list$/ && @words == 4 && length($word)
1234 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
1235 } elsif (@words >= 4) {
1238 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
1239 return grep /^\Q$word\E/, @o_conf;
1242 package CPAN::Shell;
1244 #-> sub CPAN::Shell::h ;
1246 my($class,$about) = @_;
1247 if (defined $about) {
1248 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1250 $CPAN::Frontend->myprint(q{
1253 b string display bundles
1254 d or info distributions
1255 m /regex/ about modules
1256 i or anything of above
1257 r none reinstall recommendations
1258 u uninstalled distributions
1260 Download, Test, Make, Install...
1262 make make (implies get)
1263 test modules, make test (implies make)
1264 install dists, bundles make install (implies test)
1266 look open subshell in these dists' directories
1267 readme display these dists' README files
1270 h,? display this menu ! perl-code eval a perl command
1271 o conf [opt] set and query options q quit the cpan shell
1272 reload cpan load CPAN.pm again reload index load newer indices
1273 autobundle Snapshot force cmd unconditionally do cmd});
1279 #-> sub CPAN::Shell::a ;
1281 my($self,@arg) = @_;
1282 # authors are always UPPERCASE
1286 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1289 #-> sub CPAN::Shell::ls ;
1291 my($self,@arg) = @_;
1296 my $author = $self->expand('Author',$a) or die "No author found for $a";
1301 #-> sub CPAN::Shell::local_bundles ;
1303 my($self,@which) = @_;
1304 my($incdir,$bdir,$dh);
1305 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1306 my @bbase = "Bundle";
1307 while (my $bbase = shift @bbase) {
1308 $bdir = MM->catdir($incdir,split /::/, $bbase);
1309 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1310 if ($dh = DirHandle->new($bdir)) { # may fail
1312 for $entry ($dh->read) {
1313 next if $entry =~ /^\./; #
1314 if (-d MM->catdir($bdir,$entry)){
1315 push @bbase, "$bbase\::$entry";
1317 next unless $entry =~ s/\.pm(?!\n)\Z//;
1318 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1326 #-> sub CPAN::Shell::b ;
1328 my($self,@which) = @_;
1329 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1330 $self->local_bundles;
1331 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1334 #-> sub CPAN::Shell::d ;
1335 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1337 #-> sub CPAN::Shell::m ;
1338 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1339 $CPAN::Frontend->myprint(shift->format_result('Module',@_));
1342 #-> sub CPAN::Shell::i ;
1347 @type = qw/Author Bundle Distribution Module/;
1348 @args = '/./' unless @args;
1351 push @result, $self->expand($type,@args);
1353 my $result = @result == 1 ?
1354 $result[0]->as_string :
1356 "No objects found of any type for argument @args\n" :
1358 (map {$_->as_glimpse} @result),
1359 scalar @result, " items found\n",
1361 $CPAN::Frontend->myprint($result);
1364 #-> sub CPAN::Shell::o ;
1366 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1367 # should have been called set and 'o debug' maybe 'set debug'
1369 my($self,$o_type,@o_what) = @_;
1371 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1372 if ($o_type eq 'conf') {
1373 shift @o_what if @o_what && $o_what[0] eq 'help';
1374 if (!@o_what) { # print all things, "o conf"
1376 $CPAN::Frontend->myprint("CPAN::Config options");
1377 if (exists $INC{'CPAN/Config.pm'}) {
1378 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1380 if (exists $INC{'CPAN/MyConfig.pm'}) {
1381 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1383 $CPAN::Frontend->myprint(":\n");
1384 for $k (sort keys %CPAN::Config::can) {
1385 $v = $CPAN::Config::can{$k};
1386 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1388 $CPAN::Frontend->myprint("\n");
1389 for $k (sort keys %$CPAN::Config) {
1390 CPAN::Config->prettyprint($k);
1392 $CPAN::Frontend->myprint("\n");
1393 } elsif (!CPAN::Config->edit(@o_what)) {
1394 $CPAN::Frontend->myprint(qq{Type 'o conf' to view configuration }.
1395 qq{edit options\n\n});
1397 } elsif ($o_type eq 'debug') {
1399 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1402 my($what) = shift @o_what;
1403 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1404 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1407 if ( exists $CPAN::DEBUG{$what} ) {
1408 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1409 } elsif ($what =~ /^\d/) {
1410 $CPAN::DEBUG = $what;
1411 } elsif (lc $what eq 'all') {
1413 for (values %CPAN::DEBUG) {
1416 $CPAN::DEBUG = $max;
1419 for (keys %CPAN::DEBUG) {
1420 next unless lc($_) eq lc($what);
1421 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1424 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1429 my $raw = "Valid options for debug are ".
1430 join(", ",sort(keys %CPAN::DEBUG), 'all').
1431 qq{ or a number. Completion works on the options. }.
1432 qq{Case is ignored.};
1434 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1435 $CPAN::Frontend->myprint("\n\n");
1438 $CPAN::Frontend->myprint("Options set for debugging:\n");
1440 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1441 $v = $CPAN::DEBUG{$k};
1442 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1443 if $v & $CPAN::DEBUG;
1446 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1449 $CPAN::Frontend->myprint(qq{
1451 conf set or get configuration variables
1452 debug set or get debugging options
1457 sub paintdots_onreload {
1460 if ( $_[0] =~ /[Ss]ubroutine (\w+) redefined/ ) {
1464 # $CPAN::Frontend->myprint(".($subr)");
1465 $CPAN::Frontend->myprint(".");
1472 #-> sub CPAN::Shell::reload ;
1474 my($self,$command,@arg) = @_;
1476 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1477 if ($command =~ /cpan/i) {
1478 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
1479 my $fh = FileHandle->new($INC{'CPAN.pm'});
1482 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1485 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1486 } elsif ($command =~ /index/) {
1487 CPAN::Index->force_reload;
1489 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1490 index re-reads the index files\n});
1494 #-> sub CPAN::Shell::_binary_extensions ;
1495 sub _binary_extensions {
1496 my($self) = shift @_;
1497 my(@result,$module,%seen,%need,$headerdone);
1498 for $module ($self->expand('Module','/./')) {
1499 my $file = $module->cpan_file;
1500 next if $file eq "N/A";
1501 next if $file =~ /^Contact Author/;
1502 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1503 next if $dist->isa_perl;
1504 next unless $module->xs_file;
1506 $CPAN::Frontend->myprint(".");
1507 push @result, $module;
1509 # print join " | ", @result;
1510 $CPAN::Frontend->myprint("\n");
1514 #-> sub CPAN::Shell::recompile ;
1516 my($self) = shift @_;
1517 my($module,@module,$cpan_file,%dist);
1518 @module = $self->_binary_extensions();
1519 for $module (@module){ # we force now and compile later, so we
1521 $cpan_file = $module->cpan_file;
1522 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1524 $dist{$cpan_file}++;
1526 for $cpan_file (sort keys %dist) {
1527 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1528 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1530 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1531 # stop a package from recompiling,
1532 # e.g. IO-1.12 when we have perl5.003_10
1536 #-> sub CPAN::Shell::_u_r_common ;
1538 my($self) = shift @_;
1539 my($what) = shift @_;
1540 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1541 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1542 $what && $what =~ /^[aru]$/;
1544 @args = '/./' unless @args;
1545 my(@result,$module,%seen,%need,$headerdone,
1546 $version_undefs,$version_zeroes);
1547 $version_undefs = $version_zeroes = 0;
1548 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1549 my @expand = $self->expand('Module',@args);
1550 my $expand = scalar @expand;
1551 if (0) { # Looks like noise to me, was very useful for debugging
1552 # for metadata cache
1553 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1555 for $module (@expand) {
1556 my $file = $module->cpan_file;
1557 next unless defined $file; # ??
1558 my($latest) = $module->cpan_version;
1559 my($inst_file) = $module->inst_file;
1561 return if $CPAN::Signal;
1564 $have = $module->inst_version;
1565 } elsif ($what eq "r") {
1566 $have = $module->inst_version;
1568 if ($have eq "undef"){
1570 } elsif ($have == 0){
1573 next unless CPAN::Version->vgt($latest, $have);
1574 # to be pedantic we should probably say:
1575 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1576 # to catch the case where CPAN has a version 0 and we have a version undef
1577 } elsif ($what eq "u") {
1583 } elsif ($what eq "r") {
1585 } elsif ($what eq "u") {
1589 return if $CPAN::Signal; # this is sometimes lengthy
1592 push @result, sprintf "%s %s\n", $module->id, $have;
1593 } elsif ($what eq "r") {
1594 push @result, $module->id;
1595 next if $seen{$file}++;
1596 } elsif ($what eq "u") {
1597 push @result, $module->id;
1598 next if $seen{$file}++;
1599 next if $file =~ /^Contact/;
1601 unless ($headerdone++){
1602 $CPAN::Frontend->myprint("\n");
1603 $CPAN::Frontend->myprint(sprintf(
1606 "Package namespace",
1618 $CPAN::META->has_inst("Term::ANSIColor")
1620 $module->{RO}{description}
1622 $color_on = Term::ANSIColor::color("green");
1623 $color_off = Term::ANSIColor::color("reset");
1625 $CPAN::Frontend->myprint(sprintf $sprintf,
1632 $need{$module->id}++;
1636 $CPAN::Frontend->myprint("No modules found for @args\n");
1637 } elsif ($what eq "r") {
1638 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1642 if ($version_zeroes) {
1643 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1644 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1645 qq{a version number of 0\n});
1647 if ($version_undefs) {
1648 my $s_has = $version_undefs > 1 ? "s have" : " has";
1649 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1650 qq{parseable version number\n});
1656 #-> sub CPAN::Shell::r ;
1658 shift->_u_r_common("r",@_);
1661 #-> sub CPAN::Shell::u ;
1663 shift->_u_r_common("u",@_);
1666 #-> sub CPAN::Shell::autobundle ;
1669 CPAN::Config->load unless $CPAN::Config_loaded++;
1670 my(@bundle) = $self->_u_r_common("a",@_);
1671 my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1672 File::Path::mkpath($todir);
1673 unless (-d $todir) {
1674 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1677 my($y,$m,$d) = (localtime)[5,4,3];
1681 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1682 my($to) = MM->catfile($todir,"$me.pm");
1684 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1685 $to = MM->catfile($todir,"$me.pm");
1687 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1689 "package Bundle::$me;\n\n",
1690 "\$VERSION = '0.01';\n\n",
1694 "Bundle::$me - Snapshot of installation on ",
1695 $Config::Config{'myhostname'},
1698 "\n\n=head1 SYNOPSIS\n\n",
1699 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1700 "=head1 CONTENTS\n\n",
1701 join("\n", @bundle),
1702 "\n\n=head1 CONFIGURATION\n\n",
1704 "\n\n=head1 AUTHOR\n\n",
1705 "This Bundle has been generated automatically ",
1706 "by the autobundle routine in CPAN.pm.\n",
1709 $CPAN::Frontend->myprint("\nWrote bundle file
1713 #-> sub CPAN::Shell::expandany ;
1716 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1717 if ($s =~ m|/|) { # looks like a file
1718 $s = CPAN::Distribution->normalize($s);
1719 return $CPAN::META->instance('CPAN::Distribution',$s);
1720 # Distributions spring into existence, not expand
1721 } elsif ($s =~ m|^Bundle::|) {
1722 $self->local_bundles; # scanning so late for bundles seems
1723 # both attractive and crumpy: always
1724 # current state but easy to forget
1726 return $self->expand('Bundle',$s);
1728 return $self->expand('Module',$s)
1729 if $CPAN::META->exists('CPAN::Module',$s);
1734 #-> sub CPAN::Shell::expand ;
1737 my($type,@args) = @_;
1739 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
1741 my($regex,$command);
1742 if ($arg =~ m|^/(.*)/$|) {
1744 } elsif ($arg =~ m/=/) {
1747 my $class = "CPAN::$type";
1749 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
1751 defined $regex ? $regex : "UNDEFINED",
1752 $command || "UNDEFINED",
1754 if (defined $regex) {
1758 $CPAN::META->all_objects($class)
1761 # BUG, we got an empty object somewhere
1762 require Data::Dumper;
1763 CPAN->debug(sprintf(
1764 "Bug in CPAN: Empty id on obj[%s][%s]",
1766 Data::Dumper::Dumper($obj)
1771 if $obj->id =~ /$regex/i
1775 $] < 5.00303 ### provide sort of
1776 ### compatibility with 5.003
1781 $obj->name =~ /$regex/i
1784 } elsif ($command) {
1785 die "equal sign in command disabled (immature interface), ".
1787 ! \$CPAN::Shell::ADVANCED_QUERY=1
1788 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
1789 that may go away anytime.\n"
1790 unless $ADVANCED_QUERY;
1791 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
1792 my($matchcrit) = $criterion =~ m/^~(.+)/;
1796 $CPAN::META->all_objects($class)
1798 my $lhs = $self->$method() or next; # () for 5.00503
1800 push @m, $self if $lhs =~ m/$matchcrit/;
1802 push @m, $self if $lhs eq $criterion;
1807 if ( $type eq 'Bundle' ) {
1808 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1809 } elsif ($type eq "Distribution") {
1810 $xarg = CPAN::Distribution->normalize($arg);
1812 if ($CPAN::META->exists($class,$xarg)) {
1813 $obj = $CPAN::META->instance($class,$xarg);
1814 } elsif ($CPAN::META->exists($class,$arg)) {
1815 $obj = $CPAN::META->instance($class,$arg);
1822 return wantarray ? @m : $m[0];
1825 #-> sub CPAN::Shell::format_result ;
1828 my($type,@args) = @_;
1829 @args = '/./' unless @args;
1830 my(@result) = $self->expand($type,@args);
1831 my $result = @result == 1 ?
1832 $result[0]->as_string :
1834 "No objects of type $type found for argument @args\n" :
1836 (map {$_->as_glimpse} @result),
1837 scalar @result, " items found\n",
1842 # The only reason for this method is currently to have a reliable
1843 # debugging utility that reveals which output is going through which
1844 # channel. No, I don't like the colors ;-)
1846 #-> sub CPAN::Shell::print_ornameted ;
1847 sub print_ornamented {
1848 my($self,$what,$ornament) = @_;
1850 return unless defined $what;
1852 if ($CPAN::Config->{term_is_latin}){
1855 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
1857 if ($PRINT_ORNAMENTING) {
1858 unless (defined &color) {
1859 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1860 import Term::ANSIColor "color";
1862 *color = sub { return "" };
1866 for $line (split /\n/, $what) {
1867 $longest = length($line) if length($line) > $longest;
1869 my $sprintf = "%-" . $longest . "s";
1871 $what =~ s/(.*\n?)//m;
1874 my($nl) = chomp $line ? "\n" : "";
1875 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
1876 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
1884 my($self,$what) = @_;
1886 $self->print_ornamented($what, 'bold blue on_yellow');
1890 my($self,$what) = @_;
1891 $self->myprint($what);
1896 my($self,$what) = @_;
1897 $self->print_ornamented($what, 'bold red on_yellow');
1901 my($self,$what) = @_;
1902 $self->print_ornamented($what, 'bold red on_white');
1903 Carp::confess "died";
1907 my($self,$what) = @_;
1908 $self->print_ornamented($what, 'bold red on_white');
1913 return if -t STDOUT;
1914 my $odef = select STDERR;
1921 #-> sub CPAN::Shell::rematein ;
1922 # RE-adme||MA-ke||TE-st||IN-stall
1925 my($meth,@some) = @_;
1927 if ($meth eq 'force') {
1929 $meth = shift @some;
1932 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1934 # Here is the place to set "test_count" on all involved parties to
1935 # 0. We then can pass this counter on to the involved
1936 # distributions and those can refuse to test if test_count > X. In
1937 # the first stab at it we could use a 1 for "X".
1939 # But when do I reset the distributions to start with 0 again?
1940 # Jost suggested to have a random or cycling interaction ID that
1941 # we pass through. But the ID is something that is just left lying
1942 # around in addition to the counter, so I'd prefer to set the
1943 # counter to 0 now, and repeat at the end of the loop. But what
1944 # about dependencies? They appear later and are not reset, they
1945 # enter the queue but not its copy. How do they get a sensible
1948 # construct the queue
1950 foreach $s (@some) {
1953 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
1955 } elsif ($s =~ m|^/|) { # looks like a regexp
1956 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
1961 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
1962 $obj = CPAN::Shell->expandany($s);
1965 $obj->color_cmd_tmps(0,1);
1966 CPAN::Queue->new($s);
1968 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1969 $obj = $CPAN::META->instance('CPAN::Author',$s);
1970 if ($meth eq "dump") {
1973 $CPAN::Frontend->myprint(
1975 "Don't be silly, you can't $meth ",
1983 ->myprint(qq{Warning: Cannot $meth $s, }.
1984 qq{don\'t know what it is.
1989 to find objects with matching identifiers.
1995 # queuerunner (please be warned: when I started to change the
1996 # queue to hold objects instead of names, I made one or two
1997 # mistakes and never found which. I reverted back instead)
1998 while ($s = CPAN::Queue->first) {
2001 $obj = $s; # I do not believe, we would survive if this happened
2003 $obj = CPAN::Shell->expandany($s);
2007 ($] < 5.00303 || $obj->can($pragma))){
2008 ### compatibility with 5.003
2009 $obj->$pragma($meth); # the pragma "force" in
2010 # "CPAN::Distribution" must know
2011 # what we are intending
2013 if ($]>=5.00303 && $obj->can('called_for')) {
2014 $obj->called_for($s);
2017 qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
2023 CPAN::Queue->delete($s);
2025 CPAN->debug("failed");
2029 CPAN::Queue->delete_first($s);
2031 for my $obj (@qcopy) {
2032 $obj->color_cmd_tmps(0,0);
2036 #-> sub CPAN::Shell::dump ;
2037 sub dump { shift->rematein('dump',@_); }
2038 #-> sub CPAN::Shell::force ;
2039 sub force { shift->rematein('force',@_); }
2040 #-> sub CPAN::Shell::get ;
2041 sub get { shift->rematein('get',@_); }
2042 #-> sub CPAN::Shell::readme ;
2043 sub readme { shift->rematein('readme',@_); }
2044 #-> sub CPAN::Shell::make ;
2045 sub make { shift->rematein('make',@_); }
2046 #-> sub CPAN::Shell::test ;
2047 sub test { shift->rematein('test',@_); }
2048 #-> sub CPAN::Shell::install ;
2049 sub install { shift->rematein('install',@_); }
2050 #-> sub CPAN::Shell::clean ;
2051 sub clean { shift->rematein('clean',@_); }
2052 #-> sub CPAN::Shell::look ;
2053 sub look { shift->rematein('look',@_); }
2054 #-> sub CPAN::Shell::cvs_import ;
2055 sub cvs_import { shift->rematein('cvs_import',@_); }
2059 #-> sub CPAN::FTP::ftp_get ;
2061 my($class,$host,$dir,$file,$target) = @_;
2063 qq[Going to fetch file [$file] from dir [$dir]
2064 on host [$host] as local [$target]\n]
2066 my $ftp = Net::FTP->new($host);
2067 return 0 unless defined $ftp;
2068 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2069 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2070 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2071 warn "Couldn't login on $host";
2074 unless ( $ftp->cwd($dir) ){
2075 warn "Couldn't cwd $dir";
2079 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2080 unless ( $ftp->get($file,$target) ){
2081 warn "Couldn't fetch $file from $host\n";
2084 $ftp->quit; # it's ok if this fails
2088 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2090 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2091 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2093 # > *** 1562,1567 ****
2094 # > --- 1562,1580 ----
2095 # > return 1 if substr($url,0,4) eq "file";
2096 # > return 1 unless $url =~ m|://([^/]+)|;
2098 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2100 # > + $proxy =~ m|://([^/:]+)|;
2102 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2103 # > + if ($noproxy) {
2104 # > + if ($host !~ /$noproxy$/) {
2105 # > + $host = $proxy;
2108 # > + $host = $proxy;
2111 # > require Net::Ping;
2112 # > return 1 unless $Net::Ping::VERSION >= 2;
2116 #-> sub CPAN::FTP::localize ;
2118 my($self,$file,$aslocal,$force) = @_;
2120 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2121 unless defined $aslocal;
2122 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2125 if ($^O eq 'MacOS') {
2126 # Comment by AK on 2000-09-03: Uniq short filenames would be
2127 # available in CHECKSUMS file
2128 my($name, $path) = File::Basename::fileparse($aslocal, '');
2129 if (length($name) > 31) {
2140 my $size = 31 - length($suf);
2141 while (length($name) > $size) {
2145 $aslocal = File::Spec->catfile($path, $name);
2149 return $aslocal if -f $aslocal && -r _ && !($force & 1);
2152 rename $aslocal, "$aslocal.bak";
2156 my($aslocal_dir) = File::Basename::dirname($aslocal);
2157 File::Path::mkpath($aslocal_dir);
2158 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2159 qq{directory "$aslocal_dir".
2160 I\'ll continue, but if you encounter problems, they may be due
2161 to insufficient permissions.\n}) unless -w $aslocal_dir;
2163 # Inheritance is not easier to manage than a few if/else branches
2164 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2166 eval {$Ua = LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2168 $CPAN::Frontent->mywarn("LWP::UserAgent->new dies with $@")
2172 $Ua->proxy('ftp', $var)
2173 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2174 $Ua->proxy('http', $var)
2175 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2177 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2181 $ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy};
2182 $ENV{http_proxy} = $CPAN::Config->{http_proxy}
2183 if $CPAN::Config->{http_proxy};
2184 $ENV{no_proxy} = $CPAN::Config->{no_proxy} if $CPAN::Config->{no_proxy};
2186 # Try the list of urls for each single object. We keep a record
2187 # where we did get a file from
2188 my(@reordered,$last);
2189 $CPAN::Config->{urllist} ||= [];
2190 $last = $#{$CPAN::Config->{urllist}};
2191 if ($force & 2) { # local cpans probably out of date, don't reorder
2192 @reordered = (0..$last);
2196 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2198 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2209 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2211 @levels = qw/easy hard hardest/;
2213 @levels = qw/easy/ if $^O eq 'MacOS';
2215 for $levelno (0..$#levels) {
2216 my $level = $levels[$levelno];
2217 my $method = "host$level";
2218 my @host_seq = $level eq "easy" ?
2219 @reordered : 0..$last; # reordered has CDROM up front
2220 @host_seq = (0) unless @host_seq;
2221 my $ret = $self->$method(\@host_seq,$file,$aslocal);
2223 $Themethod = $level;
2225 # utime $now, $now, $aslocal; # too bad, if we do that, we
2226 # might alter a local mirror
2227 $self->debug("level[$level]") if $CPAN::DEBUG;
2231 last if $CPAN::Signal; # need to cleanup
2234 unless ($CPAN::Signal) {
2237 qq{Please check, if the URLs I found in your configuration file \(}.
2238 join(", ", @{$CPAN::Config->{urllist}}).
2239 qq{\) are valid. The urllist can be edited.},
2240 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2241 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2243 $CPAN::Frontend->myprint("Could not fetch $file\n");
2246 rename "$aslocal.bak", $aslocal;
2247 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2248 $self->ls($aslocal));
2255 my($self,$host_seq,$file,$aslocal) = @_;
2257 HOSTEASY: for $i (@$host_seq) {
2258 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2259 $url .= "/" unless substr($url,-1) eq "/";
2261 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2262 if ($url =~ /^file:/) {
2264 if ($CPAN::META->has_inst('URI::URL')) {
2265 my $u = URI::URL->new($url);
2267 } else { # works only on Unix, is poorly constructed, but
2268 # hopefully better than nothing.
2269 # RFC 1738 says fileurl BNF is
2270 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2271 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2273 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2274 $l =~ s|^file:||; # assume they
2277 $l =~ s|^/||s unless -f $l; # e.g. /P:
2279 if ( -f $l && -r _) {
2283 # Maybe mirror has compressed it?
2285 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2286 CPAN::Tarzip->gunzip("$l.gz", $aslocal);
2293 if ($CPAN::META->has_usable('LWP')) {
2294 $CPAN::Frontend->myprint("Fetching with LWP:
2298 require LWP::UserAgent;
2299 $Ua = LWP::UserAgent->new;
2301 my $res = $Ua->mirror($url, $aslocal);
2302 if ($res->is_success) {
2305 utime $now, $now, $aslocal; # download time is more
2306 # important than upload time
2308 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2309 my $gzurl = "$url.gz";
2310 $CPAN::Frontend->myprint("Fetching with LWP:
2313 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2314 if ($res->is_success &&
2315 CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
2321 # Alan Burlison informed me that in firewall environments
2322 # Net::FTP can still succeed where LWP fails. So we do not
2323 # skip Net::FTP anymore when LWP is available.
2326 $self->debug("LWP not installed") if $CPAN::DEBUG;
2328 return if $CPAN::Signal;
2329 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2330 # that's the nice and easy way thanks to Graham
2331 my($host,$dir,$getfile) = ($1,$2,$3);
2332 if ($CPAN::META->has_usable('Net::FTP')) {
2334 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2337 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2338 "aslocal[$aslocal]") if $CPAN::DEBUG;
2339 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2343 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2344 my $gz = "$aslocal.gz";
2345 $CPAN::Frontend->myprint("Fetching with Net::FTP
2348 if (CPAN::FTP->ftp_get($host,
2352 CPAN::Tarzip->gunzip($gz,$aslocal)
2361 return if $CPAN::Signal;
2366 my($self,$host_seq,$file,$aslocal) = @_;
2368 # Came back if Net::FTP couldn't establish connection (or
2369 # failed otherwise) Maybe they are behind a firewall, but they
2370 # gave us a socksified (or other) ftp program...
2373 my($devnull) = $CPAN::Config->{devnull} || "";
2375 my($aslocal_dir) = File::Basename::dirname($aslocal);
2376 File::Path::mkpath($aslocal_dir);
2377 HOSTHARD: for $i (@$host_seq) {
2378 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2379 $url .= "/" unless substr($url,-1) eq "/";
2381 my($proto,$host,$dir,$getfile);
2383 # Courtesy Mark Conty mark_conty@cargill.com change from
2384 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2386 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2387 # proto not yet used
2388 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2390 next HOSTHARD; # who said, we could ftp anything except ftp?
2392 next HOSTHARD if $proto eq "file"; # file URLs would have had
2393 # success above. Likely a bogus URL
2395 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2397 for $f ('lynx','ncftpget','ncftp','wget') {
2398 next unless exists $CPAN::Config->{$f};
2399 $funkyftp = $CPAN::Config->{$f};
2400 next unless defined $funkyftp;
2401 next if $funkyftp =~ /^\s*$/;
2402 my($asl_ungz, $asl_gz);
2403 ($asl_ungz = $aslocal) =~ s/\.gz//;
2404 $asl_gz = "$asl_ungz.gz";
2405 my($src_switch) = "";
2407 $src_switch = " -source";
2408 } elsif ($f eq "ncftp"){
2409 $src_switch = " -c";
2410 } elsif ($f eq "wget"){
2411 $src_switch = " -O -";
2414 my($stdout_redir) = " > $asl_ungz";
2415 if ($f eq "ncftpget"){
2416 $chdir = "cd $aslocal_dir && ";
2419 $CPAN::Frontend->myprint(
2421 Trying with "$funkyftp$src_switch" to get
2425 "$chdir$funkyftp$src_switch '$url' $devnull$stdout_redir";
2426 $self->debug("system[$system]") if $CPAN::DEBUG;
2428 if (($wstatus = system($system)) == 0
2431 -s $asl_ungz # lynx returns 0 when it fails somewhere
2437 } elsif ($asl_ungz ne $aslocal) {
2438 # test gzip integrity
2439 if (CPAN::Tarzip->gtest($asl_ungz)) {
2440 # e.g. foo.tar is gzipped --> foo.tar.gz
2441 rename $asl_ungz, $aslocal;
2443 CPAN::Tarzip->gzip($asl_ungz,$asl_gz);
2448 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2450 -f $asl_ungz && -s _ == 0;
2451 my $gz = "$aslocal.gz";
2452 my $gzurl = "$url.gz";
2453 $CPAN::Frontend->myprint(
2455 Trying with "$funkyftp$src_switch" to get
2458 my($system) = "$funkyftp$src_switch '$url.gz' $devnull > $asl_gz";
2459 $self->debug("system[$system]") if $CPAN::DEBUG;
2461 if (($wstatus = system($system)) == 0
2465 # test gzip integrity
2466 if (CPAN::Tarzip->gtest($asl_gz)) {
2467 CPAN::Tarzip->gunzip($asl_gz,$aslocal);
2469 # somebody uncompressed file for us?
2470 rename $asl_ungz, $aslocal;
2475 unlink $asl_gz if -f $asl_gz;
2478 my $estatus = $wstatus >> 8;
2479 my $size = -f $aslocal ?
2480 ", left\n$aslocal with size ".-s _ :
2481 "\nWarning: expected file [$aslocal] doesn't exist";
2482 $CPAN::Frontend->myprint(qq{
2483 System call "$system"
2484 returned status $estatus (wstat $wstatus)$size
2487 return if $CPAN::Signal;
2488 } # lynx,ncftpget,ncftp
2493 my($self,$host_seq,$file,$aslocal) = @_;
2496 my($aslocal_dir) = File::Basename::dirname($aslocal);
2497 File::Path::mkpath($aslocal_dir);
2498 HOSTHARDEST: for $i (@$host_seq) {
2499 unless (length $CPAN::Config->{'ftp'}) {
2500 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2503 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2504 $url .= "/" unless substr($url,-1) eq "/";
2506 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2507 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2510 my($host,$dir,$getfile) = ($1,$2,$3);
2512 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2513 $ctime,$blksize,$blocks) = stat($aslocal);
2514 $timestamp = $mtime ||= 0;
2515 my($netrc) = CPAN::FTP::netrc->new;
2516 my($netrcfile) = $netrc->netrc;
2517 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2518 my $targetfile = File::Basename::basename($aslocal);
2524 map("cd $_", split "/", $dir), # RFC 1738
2526 "get $getfile $targetfile",
2530 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2531 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2532 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2534 $netrc->contains($host))) if $CPAN::DEBUG;
2535 if ($netrc->protected) {
2536 $CPAN::Frontend->myprint(qq{
2537 Trying with external ftp to get
2539 As this requires some features that are not thoroughly tested, we\'re
2540 not sure, that we get it right....
2544 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
2546 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2547 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2549 if ($mtime > $timestamp) {
2550 $CPAN::Frontend->myprint("GOT $aslocal\n");
2554 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2556 return if $CPAN::Signal;
2558 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2559 qq{correctly protected.\n});
2562 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2563 nor does it have a default entry\n");
2566 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2567 # then and login manually to host, using e-mail as
2569 $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
2573 "user anonymous $Config::Config{'cf_email'}"
2575 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
2576 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2577 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2579 if ($mtime > $timestamp) {
2580 $CPAN::Frontend->myprint("GOT $aslocal\n");
2584 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2586 return if $CPAN::Signal;
2587 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2593 my($self,$command,@dialog) = @_;
2594 my $fh = FileHandle->new;
2595 $fh->open("|$command") or die "Couldn't open ftp: $!";
2596 foreach (@dialog) { $fh->print("$_\n") }
2597 $fh->close; # Wait for process to complete
2599 my $estatus = $wstatus >> 8;
2600 $CPAN::Frontend->myprint(qq{
2601 Subprocess "|$command"
2602 returned status $estatus (wstat $wstatus)
2606 # find2perl needs modularization, too, all the following is stolen
2610 my($self,$name) = @_;
2611 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2612 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2614 my($perms,%user,%group);
2618 $blocks = int(($blocks + 1) / 2);
2621 $blocks = int(($sizemm + 1023) / 1024);
2624 if (-f _) { $perms = '-'; }
2625 elsif (-d _) { $perms = 'd'; }
2626 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2627 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2628 elsif (-p _) { $perms = 'p'; }
2629 elsif (-S _) { $perms = 's'; }
2630 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2632 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2633 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2634 my $tmpmode = $mode;
2635 my $tmp = $rwx[$tmpmode & 7];
2637 $tmp = $rwx[$tmpmode & 7] . $tmp;
2639 $tmp = $rwx[$tmpmode & 7] . $tmp;
2640 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
2641 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
2642 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
2645 my $user = $user{$uid} || $uid; # too lazy to implement lookup
2646 my $group = $group{$gid} || $gid;
2648 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
2650 my($moname) = $moname[$mon];
2651 if (-M _ > 365.25 / 2) {
2652 $timeyear = $year + 1900;
2655 $timeyear = sprintf("%02d:%02d", $hour, $min);
2658 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
2672 package CPAN::FTP::netrc;
2676 my $file = MM->catfile($ENV{HOME},".netrc");
2678 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2679 $atime,$mtime,$ctime,$blksize,$blocks)
2684 my($fh,@machines,$hasdefault);
2686 $fh = FileHandle->new or die "Could not create a filehandle";
2688 if($fh->open($file)){
2689 $protected = ($mode & 077) == 0;
2691 NETRC: while (<$fh>) {
2692 my(@tokens) = split " ", $_;
2693 TOKEN: while (@tokens) {
2694 my($t) = shift @tokens;
2695 if ($t eq "default"){
2699 last TOKEN if $t eq "macdef";
2700 if ($t eq "machine") {
2701 push @machines, shift @tokens;
2706 $file = $hasdefault = $protected = "";
2710 'mach' => [@machines],
2712 'hasdefault' => $hasdefault,
2713 'protected' => $protected,
2717 # CPAN::FTP::hasdefault;
2718 sub hasdefault { shift->{'hasdefault'} }
2719 sub netrc { shift->{'netrc'} }
2720 sub protected { shift->{'protected'} }
2722 my($self,$mach) = @_;
2723 for ( @{$self->{'mach'}} ) {
2724 return 1 if $_ eq $mach;
2729 package CPAN::Complete;
2732 my($text, $line, $start, $end) = @_;
2733 my(@perlret) = cpl($text, $line, $start);
2734 # find longest common match. Can anybody show me how to peruse
2735 # T::R::Gnu to have this done automatically? Seems expensive.
2736 return () unless @perlret;
2737 my($newtext) = $text;
2738 for (my $i = length($text)+1;;$i++) {
2739 last unless length($perlret[0]) && length($perlret[0]) >= $i;
2740 my $try = substr($perlret[0],0,$i);
2741 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
2742 # warn "try[$try]tries[@tries]";
2743 if (@tries == @perlret) {
2749 ($newtext,@perlret);
2752 #-> sub CPAN::Complete::cpl ;
2754 my($word,$line,$pos) = @_;
2758 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2760 if ($line =~ s/^(force\s*)//) {
2765 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
2766 } elsif ( $line !~ /^[\!abcdhimorutl]/ ) {
2768 } elsif ($line =~ /^(a|ls)\s/) {
2769 @return = cplx('CPAN::Author',uc($word));
2770 } elsif ($line =~ /^b\s/) {
2771 CPAN::Shell->local_bundles;
2772 @return = cplx('CPAN::Bundle',$word);
2773 } elsif ($line =~ /^d\s/) {
2774 @return = cplx('CPAN::Distribution',$word);
2775 } elsif ($line =~ m/^(
2776 [mru]|make|clean|dump|test|install|readme|look|cvs_import
2778 if ($word =~ /^Bundle::/) {
2779 CPAN::Shell->local_bundles;
2781 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
2782 } elsif ($line =~ /^i\s/) {
2783 @return = cpl_any($word);
2784 } elsif ($line =~ /^reload\s/) {
2785 @return = cpl_reload($word,$line,$pos);
2786 } elsif ($line =~ /^o\s/) {
2787 @return = cpl_option($word,$line,$pos);
2788 } elsif ($line =~ m/^\S+\s/ ) {
2789 # fallback for future commands and what we have forgotten above
2790 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
2797 #-> sub CPAN::Complete::cplx ;
2799 my($class, $word) = @_;
2800 # I believed for many years that this was sorted, today I
2801 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
2802 # make it sorted again. Maybe sort was dropped when GNU-readline
2803 # support came in? The RCS file is difficult to read on that:-(
2804 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
2807 #-> sub CPAN::Complete::cpl_any ;
2811 cplx('CPAN::Author',$word),
2812 cplx('CPAN::Bundle',$word),
2813 cplx('CPAN::Distribution',$word),
2814 cplx('CPAN::Module',$word),
2818 #-> sub CPAN::Complete::cpl_reload ;
2820 my($word,$line,$pos) = @_;
2822 my(@words) = split " ", $line;
2823 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2824 my(@ok) = qw(cpan index);
2825 return @ok if @words == 1;
2826 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
2829 #-> sub CPAN::Complete::cpl_option ;
2831 my($word,$line,$pos) = @_;
2833 my(@words) = split " ", $line;
2834 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2835 my(@ok) = qw(conf debug);
2836 return @ok if @words == 1;
2837 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
2839 } elsif ($words[1] eq 'index') {
2841 } elsif ($words[1] eq 'conf') {
2842 return CPAN::Config::cpl(@_);
2843 } elsif ($words[1] eq 'debug') {
2844 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
2848 package CPAN::Index;
2850 #-> sub CPAN::Index::force_reload ;
2853 $CPAN::Index::last_time = 0;
2857 #-> sub CPAN::Index::reload ;
2859 my($cl,$force) = @_;
2862 # XXX check if a newer one is available. (We currently read it
2863 # from time to time)
2864 for ($CPAN::Config->{index_expire}) {
2865 $_ = 0.001 unless $_ && $_ > 0.001;
2867 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
2868 # debug here when CPAN doesn't seem to read the Metadata
2870 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
2872 unless ($CPAN::META->{PROTOCOL}) {
2873 $cl->read_metadata_cache;
2874 $CPAN::META->{PROTOCOL} ||= "1.0";
2876 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
2877 # warn "Setting last_time to 0";
2878 $last_time = 0; # No warning necessary
2880 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
2883 # IFF we are developing, it helps to wipe out the memory
2884 # between reloads, otherwise it is not what a user expects.
2885 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
2886 $CPAN::META = CPAN->new;
2890 local $last_time = $time;
2891 local $CPAN::META->{PROTOCOL} = PROTOCOL;
2893 my $needshort = $^O eq "dos";
2895 $cl->rd_authindex($cl
2897 "authors/01mailrc.txt.gz",
2899 File::Spec->catfile('authors', '01mailrc.gz') :
2900 File::Spec->catfile('authors', '01mailrc.txt.gz'),
2903 $debug = "timing reading 01[".($t2 - $time)."]";
2905 return if $CPAN::Signal; # this is sometimes lengthy
2906 $cl->rd_modpacks($cl
2908 "modules/02packages.details.txt.gz",
2910 File::Spec->catfile('modules', '02packag.gz') :
2911 File::Spec->catfile('modules', '02packages.details.txt.gz'),
2914 $debug .= "02[".($t2 - $time)."]";
2916 return if $CPAN::Signal; # this is sometimes lengthy
2919 "modules/03modlist.data.gz",
2921 File::Spec->catfile('modules', '03mlist.gz') :
2922 File::Spec->catfile('modules', '03modlist.data.gz'),
2924 $cl->write_metadata_cache;
2926 $debug .= "03[".($t2 - $time)."]";
2928 CPAN->debug($debug) if $CPAN::DEBUG;
2931 $CPAN::META->{PROTOCOL} = PROTOCOL;
2934 #-> sub CPAN::Index::reload_x ;
2936 my($cl,$wanted,$localname,$force) = @_;
2937 $force |= 2; # means we're dealing with an index here
2938 CPAN::Config->load; # we should guarantee loading wherever we rely
2940 $localname ||= $wanted;
2941 my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
2945 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
2948 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
2949 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
2950 qq{day$s. I\'ll use that.});
2953 $force |= 1; # means we're quite serious about it.
2955 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
2958 #-> sub CPAN::Index::rd_authindex ;
2960 my($cl, $index_target) = @_;
2962 return unless defined $index_target;
2963 $CPAN::Frontend->myprint("Going to read $index_target\n");
2965 tie *FH, CPAN::Tarzip, $index_target;
2967 push @lines, split /\012/ while <FH>;
2969 my($userid,$fullname,$email) =
2970 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
2971 next unless $userid && $fullname && $email;
2973 # instantiate an author object
2974 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
2975 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
2976 return if $CPAN::Signal;
2981 my($self,$dist) = @_;
2982 $dist = $self->{'id'} unless defined $dist;
2983 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
2987 #-> sub CPAN::Index::rd_modpacks ;
2989 my($self, $index_target) = @_;
2991 return unless defined $index_target;
2992 $CPAN::Frontend->myprint("Going to read $index_target\n");
2993 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2995 while ($_ = $fh->READLINE) {
2997 my @ls = map {"$_\n"} split /\n/, $_;
2998 unshift @ls, "\n" x length($1) if /^(\n+)/;
3004 my $shift = shift(@lines);
3005 $shift =~ /^Line-Count:\s+(\d+)/;
3006 $line_count = $1 if $1;
3007 last if $shift =~ /^\s*$/;
3009 if (not defined $line_count) {
3011 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3012 Please check the validity of the index file by comparing it to more
3013 than one CPAN mirror. I'll continue but problems seem likely to
3018 } elsif ($line_count != scalar @lines) {
3020 warn sprintf qq{Warning: Your %s
3021 contains a Line-Count header of %d but I see %d lines there. Please
3022 check the validity of the index file by comparing it to more than one
3023 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3024 $index_target, $line_count, scalar(@lines);
3027 # A necessity since we have metadata_cache: delete what isn't
3029 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3030 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3034 # before 1.56 we split into 3 and discarded the rest. From
3035 # 1.57 we assign remaining text to $comment thus allowing to
3036 # influence isa_perl
3037 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3038 my($bundle,$id,$userid);
3040 if ($mod eq 'CPAN' &&
3042 CPAN::Queue->exists('Bundle::CPAN') ||
3043 CPAN::Queue->exists('CPAN')
3047 if ($version > $CPAN::VERSION){
3048 $CPAN::Frontend->myprint(qq{
3049 There's a new CPAN.pm version (v$version) available!
3050 [Current version is v$CPAN::VERSION]
3051 You might want to try
3052 install Bundle::CPAN
3054 without quitting the current session. It should be a seamless upgrade
3055 while we are running...
3058 $CPAN::Frontend->myprint(qq{\n});
3060 last if $CPAN::Signal;
3061 } elsif ($mod =~ /^Bundle::(.*)/) {
3066 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3067 # Let's make it a module too, because bundles have so much
3068 # in common with modules.
3070 # Changed in 1.57_63: seems like memory bloat now without
3071 # any value, so commented out
3073 # $CPAN::META->instance('CPAN::Module',$mod);
3077 # instantiate a module object
3078 $id = $CPAN::META->instance('CPAN::Module',$mod);
3082 if ($id->cpan_file ne $dist){ # update only if file is
3083 # different. CPAN prohibits same
3084 # name with different version
3085 $userid = $self->userid($dist);
3087 'CPAN_USERID' => $userid,
3088 'CPAN_VERSION' => $version,
3089 'CPAN_FILE' => $dist,
3093 # instantiate a distribution object
3094 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3095 # we do not need CONTAINSMODS unless we do something with
3096 # this dist, so we better produce it on demand.
3098 ## my $obj = $CPAN::META->instance(
3099 ## 'CPAN::Distribution' => $dist
3101 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3103 $CPAN::META->instance(
3104 'CPAN::Distribution' => $dist
3106 'CPAN_USERID' => $userid,
3107 'CPAN_COMMENT' => $comment,
3111 for my $name ($mod,$dist) {
3112 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3113 $exists{$name} = undef;
3116 return if $CPAN::Signal;
3120 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3121 for my $o ($CPAN::META->all_objects($class)) {
3122 next if exists $exists{$o->{ID}};
3123 $CPAN::META->delete($class,$o->{ID});
3124 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3131 #-> sub CPAN::Index::rd_modlist ;
3133 my($cl,$index_target) = @_;
3134 return unless defined $index_target;
3135 $CPAN::Frontend->myprint("Going to read $index_target\n");
3136 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3139 while ($_ = $fh->READLINE) {
3141 my @ls = map {"$_\n"} split /\n/, $_;
3142 unshift @ls, "\n" x length($1) if /^(\n+)/;
3146 my $shift = shift(@eval);
3147 if ($shift =~ /^Date:\s+(.*)/){
3148 return if $date_of_03 eq $1;
3151 last if $shift =~ /^\s*$/;
3154 push @eval, q{CPAN::Modulelist->data;};
3156 my($comp) = Safe->new("CPAN::Safe1");
3157 my($eval) = join("", @eval);
3158 my $ret = $comp->reval($eval);
3159 Carp::confess($@) if $@;
3160 return if $CPAN::Signal;
3162 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3163 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3164 $obj->set(%{$ret->{$_}});
3165 return if $CPAN::Signal;
3169 #-> sub CPAN::Index::write_metadata_cache ;
3170 sub write_metadata_cache {
3172 return unless $CPAN::Config->{'cache_metadata'};
3173 return unless $CPAN::META->has_usable("Storable");
3175 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3176 CPAN::Distribution)) {
3177 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3179 my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
3180 $cache->{last_time} = $last_time;
3181 $cache->{PROTOCOL} = PROTOCOL;
3182 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3183 eval { Storable::nstore($cache, $metadata_file) };
3184 $CPAN::Frontend->mywarn($@) if $@;
3187 #-> sub CPAN::Index::read_metadata_cache ;
3188 sub read_metadata_cache {
3190 return unless $CPAN::Config->{'cache_metadata'};
3191 return unless $CPAN::META->has_usable("Storable");
3192 my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
3193 return unless -r $metadata_file and -f $metadata_file;
3194 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3196 eval { $cache = Storable::retrieve($metadata_file) };
3197 $CPAN::Frontend->mywarn($@) if $@;
3198 if (!$cache || ref $cache ne 'HASH'){
3202 if (exists $cache->{PROTOCOL}) {
3203 if (PROTOCOL > $cache->{PROTOCOL}) {
3204 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3205 "with protocol v%s, requiring v%s",
3212 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3213 "with protocol v1.0");
3218 while(my($class,$v) = each %$cache) {
3219 next unless $class =~ /^CPAN::/;
3220 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3221 while (my($id,$ro) = each %$v) {
3222 $CPAN::META->{readwrite}{$class}{$id} ||=
3223 $class->new(ID=>$id, RO=>$ro);
3228 unless ($clcnt) { # sanity check
3229 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3232 if ($idcnt < 1000) {
3233 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3234 "in $metadata_file\n");
3237 $CPAN::META->{PROTOCOL} ||=
3238 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3239 # does initialize to some protocol
3240 $last_time = $cache->{last_time};
3243 package CPAN::InfoObj;
3246 sub cpan_userid { shift->{RO}{CPAN_USERID} }
3247 sub id { shift->{ID} }
3249 #-> sub CPAN::InfoObj::new ;
3251 my $this = bless {}, shift;
3256 # The set method may only be used by code that reads index data or
3257 # otherwise "objective" data from the outside world. All session
3258 # related material may do anything else with instance variables but
3259 # must not touch the hash under the RO attribute. The reason is that
3260 # the RO hash gets written to Metadata file and is thus persistent.
3262 #-> sub CPAN::InfoObj::set ;
3264 my($self,%att) = @_;
3265 my $class = ref $self;
3267 # This must be ||=, not ||, because only if we write an empty
3268 # reference, only then the set method will write into the readonly
3269 # area. But for Distributions that spring into existence, maybe
3270 # because of a typo, we do not like it that they are written into
3271 # the readonly area and made permanent (at least for a while) and
3272 # that is why we do not "allow" other places to call ->set.
3273 unless ($self->id) {
3274 CPAN->debug("Bug? Empty ID, rejecting");
3277 my $ro = $self->{RO} =
3278 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
3280 while (my($k,$v) = each %att) {
3285 #-> sub CPAN::InfoObj::as_glimpse ;
3289 my $class = ref($self);
3290 $class =~ s/^CPAN:://;
3291 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3295 #-> sub CPAN::InfoObj::as_string ;
3299 my $class = ref($self);
3300 $class =~ s/^CPAN:://;
3301 push @m, $class, " id = $self->{ID}\n";
3302 for (sort keys %{$self->{RO}}) {
3303 # next if m/^(ID|RO)$/;
3305 if ($_ eq "CPAN_USERID") {
3306 $extra .= " (".$self->author;
3307 my $email; # old perls!
3308 if ($email = $CPAN::META->instance("CPAN::Author",
3311 $extra .= " <$email>";
3313 $extra .= " <no email>";
3316 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
3317 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
3320 next unless defined $self->{RO}{$_};
3321 push @m, sprintf " %-12s %s%s\n", $_, $self->{RO}{$_}, $extra;
3323 for (sort keys %$self) {
3324 next if m/^(ID|RO)$/;
3325 if (ref($self->{$_}) eq "ARRAY") {
3326 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
3327 } elsif (ref($self->{$_}) eq "HASH") {
3331 join(" ",keys %{$self->{$_}}),
3334 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
3340 #-> sub CPAN::InfoObj::author ;
3343 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
3346 #-> sub CPAN::InfoObj::dump ;
3349 require Data::Dumper;
3350 print Data::Dumper::Dumper($self);
3353 package CPAN::Author;
3355 #-> sub CPAN::Author::as_glimpse ;
3359 my $class = ref($self);
3360 $class =~ s/^CPAN:://;
3361 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
3365 #-> sub CPAN::Author::fullname ;
3367 shift->{RO}{FULLNAME};
3371 #-> sub CPAN::Author::email ;
3372 sub email { shift->{RO}{EMAIL}; }
3374 #-> sub CPAN::Author::ls ;
3379 # adapted from CPAN::Distribution::verifyMD5 ;
3381 @chksumfile = $self->id =~ /(.)(.)(.*)/;
3382 $chksumfile[1] = join "", @chksumfile[0,1];
3383 $chksumfile[2] = join "", @chksumfile[1,2];
3384 push @chksumfile, "CHECKSUMS";
3385 print join "", map {
3386 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
3387 } sort { $a->[2] cmp $b->[2] } $self->dir_listing(\@chksumfile);
3390 #-> sub CPAN::Author::dir_listing ;
3393 my $chksumfile = shift;
3395 MM->catfile($CPAN::Config->{keep_source_where},
3396 "authors", "id", @$chksumfile);
3398 my $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
3401 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
3402 $chksumfile->[-1] .= ".gz";
3403 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
3406 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
3407 CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
3413 # adapted from CPAN::Distribution::MD5_check_file ;
3414 my $fh = FileHandle->new;
3416 if (open $fh, $lc_file){
3419 $eval =~ s/\015?\012/\n/g;
3421 my($comp) = Safe->new();
3422 $cksum = $comp->reval($eval);
3424 rename $lc_file, "$lc_file.bad";
3425 Carp::confess($@) if $@;
3428 Carp::carp "Could not open $lc_file for reading";
3431 for $f (sort keys %$cksum) {
3432 if (exists $cksum->{$f}{isdir}) {
3433 my(@dir) = @$chksumfile;
3435 push @dir, $f, "CHECKSUMS";
3437 [$_->[0], $_->[1], "$f/$_->[2]"]
3438 } $self->dir_listing(\@dir);
3441 ($cksum->{$f}{"size"}||0),
3442 $cksum->{$f}{"mtime"}||"---",
3450 package CPAN::Distribution;
3453 sub cpan_comment { shift->{RO}{CPAN_COMMENT} }
3457 delete $self->{later};
3460 # CPAN::Distribution::normalize
3463 $s = $self->id unless defined $s;
3464 if ($s =~ tr|/|| == 1) {
3465 return $s if $s =~ m|^N/A|;
3466 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
3467 $CPAN::Frontend->mywarn("Strange distribution name [$s]");
3468 CPAN->debug("s[$s]") if $CPAN::DEBUG;
3473 #-> sub CPAN::Distribution::color_cmd_tmps ;
3474 sub color_cmd_tmps {
3476 my($depth) = shift || 0;
3477 my($color) = shift || 0;
3478 # a distribution needs to recurse into its prereq_pms
3480 return if exists $self->{incommandcolor}
3481 && $self->{incommandcolor}==$color;
3482 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
3483 "color_cmd_tmps depth[%s] self[%s] id[%s]",
3488 ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
3489 my $prereq_pm = $self->prereq_pm;
3490 if (defined $prereq_pm) {
3491 for my $pre (keys %$prereq_pm) {
3492 my $premo = CPAN::Shell->expand("Module",$pre);
3493 $premo->color_cmd_tmps($depth+1,$color);
3497 delete $self->{sponsored_mods};
3498 delete $self->{badtestcnt};
3500 $self->{incommandcolor} = $color;
3503 #-> sub CPAN::Distribution::as_string ;
3506 $self->containsmods;
3507 $self->SUPER::as_string(@_);
3510 #-> sub CPAN::Distribution::containsmods ;
3513 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
3514 my $dist_id = $self->{ID};
3515 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
3516 my $mod_file = $mod->cpan_file or next;
3517 my $mod_id = $mod->{ID} or next;
3518 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
3520 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
3522 keys %{$self->{CONTAINSMODS}};
3525 #-> sub CPAN::Distribution::uptodate ;
3529 foreach $c ($self->containsmods) {
3530 my $obj = CPAN::Shell->expandany($c);
3531 return 0 unless $obj->uptodate;
3536 #-> sub CPAN::Distribution::called_for ;
3539 $self->{CALLED_FOR} = $id if defined $id;
3540 return $self->{CALLED_FOR};
3543 #-> sub CPAN::Distribution::my_chdir ;
3545 my($self,$todir) = @_;
3546 # we die if we cannot chdir and we are debuggable
3547 Carp::confess("safe_chdir called without todir argument")
3548 unless defined $todir and length $todir;
3550 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
3553 my $cwd = CPAN::anycwd();
3554 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
3555 qq{to todir[$todir]: $!});
3559 #-> sub CPAN::Distribution::get ;
3564 exists $self->{'build_dir'} and push @e,
3565 "Is already unwrapped into directory $self->{'build_dir'}";
3566 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3568 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
3571 # Get the file on local disk
3577 $CPAN::Config->{keep_source_where},
3580 split("/",$self->id)
3583 $self->debug("Doing localize") if $CPAN::DEBUG;
3585 CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
3586 or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
3587 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
3588 $self->{localfile} = $local_file;
3589 return if $CPAN::Signal;
3594 if ($CPAN::META->has_inst("MD5")) {
3595 $self->debug("MD5 is installed, verifying");
3598 $self->debug("MD5 is NOT installed");
3600 return if $CPAN::Signal;
3603 # Create a clean room and go there
3605 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
3606 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
3607 $self->safe_chdir($builddir);
3608 $self->debug("Removing tmp") if $CPAN::DEBUG;
3609 File::Path::rmtree("tmp");
3610 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
3612 $self->safe_chdir($sub_wd);
3615 $self->safe_chdir("tmp");
3620 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)(?!\n)\Z/i){
3621 $self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file);
3622 $self->untar_me($local_file);
3623 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
3624 $self->unzip_me($local_file);
3625 } elsif ( $local_file =~ /\.pm\.(gz|Z)(?!\n)\Z/) {
3626 $self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file);
3627 $self->pm2dir_me($local_file);
3629 $self->{archived} = "NO";
3630 $self->safe_chdir($sub_wd);
3634 # we are still in the tmp directory!
3635 # Let's check if the package has its own directory.
3636 my $dh = DirHandle->new(File::Spec->curdir)
3637 or Carp::croak("Couldn't opendir .: $!");
3638 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
3640 my ($distdir,$packagedir);
3641 if (@readdir == 1 && -d $readdir[0]) {
3642 $distdir = $readdir[0];
3643 $packagedir = MM->catdir($builddir,$distdir);
3644 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
3646 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
3648 File::Path::rmtree($packagedir);
3649 rename($distdir,$packagedir) or
3650 Carp::confess("Couldn't rename $distdir to $packagedir: $!");
3651 $self->debug(sprintf("renamed distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
3658 my $userid = $self->cpan_userid;
3660 CPAN->debug("no userid? self[$self]");
3663 my $pragmatic_dir = $userid . '000';
3664 $pragmatic_dir =~ s/\W_//g;
3665 $pragmatic_dir++ while -d "../$pragmatic_dir";
3666 $packagedir = MM->catdir($builddir,$pragmatic_dir);
3667 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
3668 File::Path::mkpath($packagedir);
3670 for $f (@readdir) { # is already without "." and ".."
3671 my $to = MM->catdir($packagedir,$f);
3672 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
3676 $self->safe_chdir($sub_wd);
3680 $self->{'build_dir'} = $packagedir;
3681 $self->safe_chdir(File::Spec->updir);
3682 File::Path::rmtree("tmp");
3684 my($mpl) = MM->catfile($packagedir,"Makefile.PL");
3685 my($mpl_exists) = -f $mpl;
3686 unless ($mpl_exists) {
3687 # Steffen's stupid NFS has problems to see an existing
3688 # Makefile.PL such a short time after the directory was
3689 # renamed. Maybe this trick helps
3690 $dh = DirHandle->new($packagedir)
3691 or Carp::croak("Couldn't opendir $packagedir: $!");
3692 $mpl_exists = grep /^Makefile\.PL$/, $dh->read;
3694 unless ($mpl_exists) {
3695 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
3699 my($configure) = MM->catfile($packagedir,"Configure");
3700 if (-f $configure) {
3701 # do we have anything to do?
3702 $self->{'configure'} = $configure;
3703 } elsif (-f MM->catfile($packagedir,"Makefile")) {
3704 $CPAN::Frontend->myprint(qq{
3705 Package comes with a Makefile and without a Makefile.PL.
3706 We\'ll try to build it with that Makefile then.
3708 $self->{writemakefile} = "YES";
3711 my $cf = $self->called_for || "unknown";
3716 $cf =~ s|[/\\:]||g; # risk of filesystem damage
3717 $cf = "unknown" unless length($cf);
3718 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
3719 (The test -f "$mpl" returned false.)
3720 Writing one on our own (setting NAME to $cf)\a\n});
3721 $self->{had_no_makefile_pl}++;
3724 # Writing our own Makefile.PL
3726 my $fh = FileHandle->new;
3728 or Carp::croak("Could not open >$mpl: $!");
3730 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
3731 # because there was no Makefile.PL supplied.
3732 # Autogenerated on: }.scalar localtime().qq{
3734 use ExtUtils::MakeMaker;
3735 WriteMakefile(NAME => q[$cf]);
3745 # CPAN::Distribution::untar_me ;
3747 my($self,$local_file) = @_;
3748 $self->{archived} = "tar";
3749 if (CPAN::Tarzip->untar($local_file)) {
3750 $self->{unwrapped} = "YES";
3752 $self->{unwrapped} = "NO";
3756 # CPAN::Distribution::unzip_me ;
3758 my($self,$local_file) = @_;
3759 $self->{archived} = "zip";
3760 if (CPAN::Tarzip->unzip($local_file)) {
3761 $self->{unwrapped} = "YES";
3763 $self->{unwrapped} = "NO";
3769 my($self,$local_file) = @_;
3770 $self->{archived} = "pm";
3771 my $to = File::Basename::basename($local_file);
3772 $to =~ s/\.(gz|Z)(?!\n)\Z//;
3773 if (CPAN::Tarzip->gunzip($local_file,$to)) {
3774 $self->{unwrapped} = "YES";
3776 $self->{unwrapped} = "NO";
3780 #-> sub CPAN::Distribution::new ;
3782 my($class,%att) = @_;
3784 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
3786 my $this = { %att };
3787 return bless $this, $class;
3790 #-> sub CPAN::Distribution::look ;
3794 if ($^O eq 'MacOS') {
3795 $self->ExtUtils::MM_MacOS::look;
3799 if ( $CPAN::Config->{'shell'} ) {
3800 $CPAN::Frontend->myprint(qq{
3801 Trying to open a subshell in the build directory...
3804 $CPAN::Frontend->myprint(qq{
3805 Your configuration does not define a value for subshells.
3806 Please define it with "o conf shell <your shell>"
3810 my $dist = $self->id;
3811 my $dir = $self->dir or $self->get;
3813 my $pwd = CPAN::anycwd();
3814 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
3815 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3816 system($CPAN::Config->{'shell'}) == 0
3817 or $CPAN::Frontend->mydie("Subprocess shell error");
3818 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
3821 # CPAN::Distribution::cvs_import ;
3825 my $dir = $self->dir;
3827 my $package = $self->called_for;
3828 my $module = $CPAN::META->instance('CPAN::Module', $package);
3829 my $version = $module->cpan_version;
3831 my $userid = $self->cpan_userid;
3833 my $cvs_dir = (split '/', $dir)[-1];
3834 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
3836 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
3838 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
3839 if ($cvs_site_perl) {
3840 $cvs_dir = "$cvs_site_perl/$cvs_dir";
3842 my $cvs_log = qq{"imported $package $version sources"};
3843 $version =~ s/\./_/g;
3844 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
3845 "$cvs_dir", $userid, "v$version");
3847 my $pwd = CPAN::anycwd();
3848 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
3850 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3852 $CPAN::Frontend->myprint(qq{@cmd\n});
3853 system(@cmd) == 0 or
3854 $CPAN::Frontend->mydie("cvs import failed");
3855 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
3858 #-> sub CPAN::Distribution::readme ;
3861 my($dist) = $self->id;
3862 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
3863 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
3867 $CPAN::Config->{keep_source_where},
3870 split("/","$sans.readme"),
3872 $self->debug("Doing localize") if $CPAN::DEBUG;
3873 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
3875 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
3877 if ($^O eq 'MacOS') {
3878 ExtUtils::MM_MacOS::launch_file($local_file);
3882 my $fh_pager = FileHandle->new;
3883 local($SIG{PIPE}) = "IGNORE";
3884 $fh_pager->open("|$CPAN::Config->{'pager'}")
3885 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
3886 my $fh_readme = FileHandle->new;
3887 $fh_readme->open($local_file)
3888 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
3889 $CPAN::Frontend->myprint(qq{
3892 with pager "$CPAN::Config->{'pager'}"
3895 $fh_pager->print(<$fh_readme>);
3898 #-> sub CPAN::Distribution::verifyMD5 ;
3903 $self->{MD5_STATUS} ||= "";
3904 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
3905 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3907 my($lc_want,$lc_file,@local,$basename);
3908 @local = split("/",$self->id);
3910 push @local, "CHECKSUMS";
3912 MM->catfile($CPAN::Config->{keep_source_where},
3913 "authors", "id", @local);
3918 $self->MD5_check_file($lc_want)
3920 return $self->{MD5_STATUS} = "OK";
3922 $lc_file = CPAN::FTP->localize("authors/id/@local",
3925 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
3926 $local[-1] .= ".gz";
3927 $lc_file = CPAN::FTP->localize("authors/id/@local",
3930 $lc_file =~ s/\.gz(?!\n)\Z//;
3931 CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
3936 $self->MD5_check_file($lc_file);
3939 #-> sub CPAN::Distribution::MD5_check_file ;
3940 sub MD5_check_file {
3941 my($self,$chk_file) = @_;
3942 my($cksum,$file,$basename);
3943 $file = $self->{localfile};
3944 $basename = File::Basename::basename($file);
3945 my $fh = FileHandle->new;
3946 if (open $fh, $chk_file){
3949 $eval =~ s/\015?\012/\n/g;
3951 my($comp) = Safe->new();
3952 $cksum = $comp->reval($eval);
3954 rename $chk_file, "$chk_file.bad";
3955 Carp::confess($@) if $@;
3958 Carp::carp "Could not open $chk_file for reading";
3961 if (exists $cksum->{$basename}{md5}) {
3962 $self->debug("Found checksum for $basename:" .
3963 "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
3967 my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
3969 $fh = CPAN::Tarzip->TIEHANDLE($file);
3972 # had to inline it, when I tied it, the tiedness got lost on
3973 # the call to eq_MD5. (Jan 1998)
3977 while ($fh->READ($ref, 4096) > 0){
3980 my $hexdigest = $md5->hexdigest;
3981 $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
3985 $CPAN::Frontend->myprint("Checksum for $file ok\n");
3986 return $self->{MD5_STATUS} = "OK";
3988 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
3989 qq{distribution file. }.
3990 qq{Please investigate.\n\n}.
3992 $CPAN::META->instance(
3997 my $wrap = qq{I\'d recommend removing $file. Its MD5
3998 checksum is incorrect. Maybe you have configured your 'urllist' with
3999 a bad URL. Please check this array with 'o conf urllist', and
4002 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4004 # former versions just returned here but this seems a
4005 # serious threat that deserves a die
4007 # $CPAN::Frontend->myprint("\n\n");
4011 # close $fh if fileno($fh);
4013 $self->{MD5_STATUS} ||= "";
4014 if ($self->{MD5_STATUS} eq "NIL") {
4015 $CPAN::Frontend->mywarn(qq{
4016 Warning: No md5 checksum for $basename in $chk_file.
4018 The cause for this may be that the file is very new and the checksum
4019 has not yet been calculated, but it may also be that something is
4020 going awry right now.
4022 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
4023 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4025 $self->{MD5_STATUS} = "NIL";
4030 #-> sub CPAN::Distribution::eq_MD5 ;
4032 my($self,$fh,$expectMD5) = @_;
4035 while (read($fh, $data, 4096)){
4038 # $md5->addfile($fh);
4039 my $hexdigest = $md5->hexdigest;
4040 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
4041 $hexdigest eq $expectMD5;
4044 #-> sub CPAN::Distribution::force ;
4046 # Both modules and distributions know if "force" is in effect by
4047 # autoinspection, not by inspecting a global variable. One of the
4048 # reason why this was chosen to work that way was the treatment of
4049 # dependencies. They should not autpomatically inherit the force
4050 # status. But this has the downside that ^C and die() will return to
4051 # the prompt but will not be able to reset the force_update
4052 # attributes. We try to correct for it currently in the read_metadata
4053 # routine, and immediately before we check for a Signal. I hope this
4054 # works out in one of v1.57_53ff
4057 my($self, $method) = @_;
4059 MD5_STATUS archived build_dir localfile make install unwrapped
4062 delete $self->{$att};
4064 if ($method && $method eq "install") {
4065 $self->{"force_update"}++; # name should probably have been force_install
4069 #-> sub CPAN::Distribution::unforce ;
4072 delete $self->{'force_update'};
4075 #-> sub CPAN::Distribution::isa_perl ;
4078 my $file = File::Basename::basename($self->id);
4079 if ($file =~ m{ ^ perl
4092 } elsif ($self->cpan_comment
4094 $self->cpan_comment =~ /isa_perl\(.+?\)/){
4099 #-> sub CPAN::Distribution::perl ;
4102 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
4103 my $pwd = CPAN::anycwd();
4104 my $candidate = MM->catfile($pwd,$^X);
4105 $perl ||= $candidate if MM->maybe_command($candidate);
4107 my ($component,$perl_name);
4108 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
4109 PATH_COMPONENT: foreach $component (MM->path(),
4110 $Config::Config{'binexp'}) {
4111 next unless defined($component) && $component;
4112 my($abs) = MM->catfile($component,$perl_name);
4113 if (MM->maybe_command($abs)) {
4123 #-> sub CPAN::Distribution::make ;
4126 $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
4127 # Emergency brake if they said install Pippi and get newest perl
4128 if ($self->isa_perl) {
4130 $self->called_for ne $self->id &&
4131 ! $self->{force_update}
4133 # if we die here, we break bundles
4134 $CPAN::Frontend->mywarn(sprintf qq{
4135 The most recent version "%s" of the module "%s"
4136 comes with the current version of perl (%s).
4137 I\'ll build that only if you ask for something like
4142 $CPAN::META->instance(
4156 $self->{archived} eq "NO" and push @e,
4157 "Is neither a tar nor a zip archive.";
4159 $self->{unwrapped} eq "NO" and push @e,
4160 "had problems unarchiving. Please build manually";
4162 exists $self->{writemakefile} &&
4163 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
4164 $1 || "Had some problem writing Makefile";
4166 defined $self->{'make'} and push @e,
4167 "Has already been processed within this session";
4169 exists $self->{later} and length($self->{later}) and
4170 push @e, $self->{later};
4172 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4174 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
4175 my $builddir = $self->dir;
4176 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
4177 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
4179 if ($^O eq 'MacOS') {
4180 ExtUtils::MM_MacOS::make($self);
4185 if ($self->{'configure'}) {
4186 $system = $self->{'configure'};
4188 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
4190 # This needs a handler that can be turned on or off:
4191 # $switch = "-MExtUtils::MakeMaker ".
4192 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
4194 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
4196 unless (exists $self->{writemakefile}) {
4197 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
4200 if ($CPAN::Config->{inactivity_timeout}) {
4202 alarm $CPAN::Config->{inactivity_timeout};
4203 local $SIG{CHLD}; # = sub { wait };
4204 if (defined($pid = fork)) {
4209 # note, this exec isn't necessary if
4210 # inactivity_timeout is 0. On the Mac I'd
4211 # suggest, we set it always to 0.
4215 $CPAN::Frontend->myprint("Cannot fork: $!");
4223 $CPAN::Frontend->myprint($@);
4224 $self->{writemakefile} = "NO $@";
4229 $ret = system($system);
4231 $self->{writemakefile} = "NO Makefile.PL returned status $ret";
4235 if (-f "Makefile") {
4236 $self->{writemakefile} = "YES";
4237 delete $self->{make_clean}; # if cleaned before, enable next
4239 $self->{writemakefile} =
4240 qq{NO Makefile.PL refused to write a Makefile.};
4241 # It's probably worth to record the reason, so let's retry
4243 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
4244 # $self->{writemakefile} .= <$fh>;
4248 delete $self->{force_update};
4251 if (my @prereq = $self->unsat_prereq){
4252 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
4254 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
4255 if (system($system) == 0) {
4256 $CPAN::Frontend->myprint(" $system -- OK\n");
4257 $self->{'make'} = "YES";
4259 $self->{writemakefile} ||= "YES";
4260 $self->{'make'} = "NO";
4261 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
4265 sub follow_prereqs {
4269 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
4270 "during [$id] -----\n");
4272 for my $p (@prereq) {
4273 $CPAN::Frontend->myprint(" $p\n");
4276 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
4278 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
4279 require ExtUtils::MakeMaker;
4280 my $answer = ExtUtils::MakeMaker::prompt(
4281 "Shall I follow them and prepend them to the queue
4282 of modules we are processing right now?", "yes");
4283 $follow = $answer =~ /^\s*y/i;
4287 myprint(" Ignoring dependencies on modules @prereq\n");
4290 # color them as dirty
4291 for my $p (@prereq) {
4292 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
4294 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
4295 $self->{later} = "Delayed until after prerequisites";
4296 return 1; # signal success to the queuerunner
4300 #-> sub CPAN::Distribution::unsat_prereq ;
4303 my $prereq_pm = $self->prereq_pm or return;
4305 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
4306 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
4307 # we were too demanding:
4308 next if $nmo->uptodate;
4310 # if they have not specified a version, we accept any installed one
4311 if (not defined $need_version or
4312 $need_version == 0 or
4313 $need_version eq "undef") {
4314 next if defined $nmo->inst_file;
4317 # We only want to install prereqs if either they're not installed
4318 # or if the installed version is too old. We cannot omit this
4319 # check, because if 'force' is in effect, nobody else will check.
4323 defined $nmo->inst_file &&
4324 ! CPAN::Version->vgt($need_version, $nmo->inst_version)
4326 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]need_version[%s]",
4330 CPAN::Version->readable($need_version)
4336 if ($self->{sponsored_mods}{$need_module}++){
4337 # We have already sponsored it and for some reason it's still
4338 # not available. So we do nothing. Or what should we do?
4339 # if we push it again, we have a potential infinite loop
4342 push @need, $need_module;
4347 #-> sub CPAN::Distribution::prereq_pm ;
4350 return $self->{prereq_pm} if
4351 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
4352 return unless $self->{writemakefile}; # no need to have succeeded
4353 # but we must have run it
4354 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
4355 my $makefile = File::Spec->catfile($build_dir,"Makefile");
4360 $fh = FileHandle->new("<$makefile\0")) {
4364 # A.Speer @p -> %p, where %p is $p{Module::Name}=Required_Version
4366 last if /MakeMaker post_initialize section/;
4368 \s+PREREQ_PM\s+=>\s+(.+)
4371 # warn "Found prereq expr[$p]";
4373 # Regexp modified by A.Speer to remember actual version of file
4374 # PREREQ_PM hash key wants, then add to
4375 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
4376 # In case a prereq is mentioned twice, complain.
4377 if ( defined $p{$1} ) {
4378 warn "Warning: PREREQ_PM mentions $1 more than once, last mention wins";
4385 $self->{prereq_pm_detected}++;
4386 return $self->{prereq_pm} = \%p;
4389 #-> sub CPAN::Distribution::test ;
4394 delete $self->{force_update};
4397 $CPAN::Frontend->myprint("Running make test\n");
4398 if (my @prereq = $self->unsat_prereq){
4399 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
4403 exists $self->{make} or exists $self->{later} or push @e,
4404 "Make had some problems, maybe interrupted? Won't test";
4406 exists $self->{'make'} and
4407 $self->{'make'} eq 'NO' and
4408 push @e, "Can't test without successful make";
4410 exists $self->{build_dir} or push @e, "Has no own directory";
4411 $self->{badtestcnt} ||= 0;
4412 $self->{badtestcnt} > 0 and
4413 push @e, "Won't repeat unsuccessful test during this command";
4415 exists $self->{later} and length($self->{later}) and
4416 push @e, $self->{later};
4418 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4420 chdir $self->{'build_dir'} or
4421 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
4422 $self->debug("Changed directory to $self->{'build_dir'}")
4425 if ($^O eq 'MacOS') {
4426 ExtUtils::MM_MacOS::make_test($self);
4430 my $system = join " ", $CPAN::Config->{'make'}, "test";
4431 if (system($system) == 0) {
4432 $CPAN::Frontend->myprint(" $system -- OK\n");
4433 $self->{make_test} = "YES";
4435 $self->{make_test} = "NO";
4436 $self->{badtestcnt}++;
4437 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
4441 #-> sub CPAN::Distribution::clean ;
4444 $CPAN::Frontend->myprint("Running make clean\n");
4447 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
4448 push @e, "make clean already called once";
4449 exists $self->{build_dir} or push @e, "Has no own directory";
4450 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4452 chdir $self->{'build_dir'} or
4453 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
4454 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
4456 if ($^O eq 'MacOS') {
4457 ExtUtils::MM_MacOS::make_clean($self);
4461 my $system = join " ", $CPAN::Config->{'make'}, "clean";
4462 if (system($system) == 0) {
4463 $CPAN::Frontend->myprint(" $system -- OK\n");
4467 # Jost Krieger pointed out that this "force" was wrong because
4468 # it has the effect that the next "install" on this distribution
4469 # will untar everything again. Instead we should bring the
4470 # object's state back to where it is after untarring.
4472 delete $self->{force_update};
4473 delete $self->{install};
4474 delete $self->{writemakefile};
4475 delete $self->{make};
4476 delete $self->{make_test}; # no matter if yes or no, tests must be redone
4477 $self->{make_clean} = "YES";
4480 # Hmmm, what to do if make clean failed?
4482 $CPAN::Frontend->myprint(qq{ $system -- NOT OK
4484 make clean did not succeed, marking directory as unusable for further work.
4486 $self->force("make"); # so that this directory won't be used again
4491 #-> sub CPAN::Distribution::install ;
4496 delete $self->{force_update};
4499 $CPAN::Frontend->myprint("Running make install\n");
4502 exists $self->{build_dir} or push @e, "Has no own directory";
4504 exists $self->{make} or exists $self->{later} or push @e,
4505 "Make had some problems, maybe interrupted? Won't install";
4507 exists $self->{'make'} and
4508 $self->{'make'} eq 'NO' and
4509 push @e, "make had returned bad status, install seems impossible";
4511 push @e, "make test had returned bad status, ".
4512 "won't install without force"
4513 if exists $self->{'make_test'} and
4514 $self->{'make_test'} eq 'NO' and
4515 ! $self->{'force_update'};
4517 exists $self->{'install'} and push @e,
4518 $self->{'install'} eq "YES" ?
4519 "Already done" : "Already tried without success";
4521 exists $self->{later} and length($self->{later}) and
4522 push @e, $self->{later};
4524 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4526 chdir $self->{'build_dir'} or
4527 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
4528 $self->debug("Changed directory to $self->{'build_dir'}")
4531 if ($^O eq 'MacOS') {
4532 ExtUtils::MM_MacOS::make_install($self);
4536 my $system = join(" ", $CPAN::Config->{'make'},
4537 "install", $CPAN::Config->{make_install_arg});
4538 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
4539 my($pipe) = FileHandle->new("$system $stderr |");
4542 $CPAN::Frontend->myprint($_);
4547 $CPAN::Frontend->myprint(" $system -- OK\n");
4548 return $self->{'install'} = "YES";
4550 $self->{'install'} = "NO";
4551 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
4552 if ($makeout =~ /permission/s && $> > 0) {
4553 $CPAN::Frontend->myprint(qq{ You may have to su }.
4554 qq{to root to install the package\n});
4557 delete $self->{force_update};
4560 #-> sub CPAN::Distribution::dir ;
4562 shift->{'build_dir'};
4565 package CPAN::Bundle;
4569 delete $self->{later};
4570 for my $c ( $self->contains ) {
4571 my $obj = CPAN::Shell->expandany($c) or next;
4576 #-> sub CPAN::Bundle::color_cmd_tmps ;
4577 sub color_cmd_tmps {
4579 my($depth) = shift || 0;
4580 my($color) = shift || 0;
4581 # a module needs to recurse to its cpan_file, a distribution needs
4582 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
4584 return if exists $self->{incommandcolor}
4585 && $self->{incommandcolor}==$color;
4586 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
4587 "color_cmd_tmps depth[%s] self[%s] id[%s]",
4592 ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4594 for my $c ( $self->contains ) {
4595 my $obj = CPAN::Shell->expandany($c) or next;
4596 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
4597 $obj->color_cmd_tmps($depth+1,$color);
4600 delete $self->{badtestcnt};
4602 $self->{incommandcolor} = $color;
4605 #-> sub CPAN::Bundle::as_string ;
4609 # following line must be "=", not "||=" because we have a moving target
4610 $self->{INST_VERSION} = $self->inst_version;
4611 return $self->SUPER::as_string;
4614 #-> sub CPAN::Bundle::contains ;
4617 my($parsefile) = $self->inst_file || "";
4618 my($id) = $self->id;
4619 $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
4620 unless ($parsefile) {
4621 # Try to get at it in the cpan directory
4622 $self->debug("no parsefile") if $CPAN::DEBUG;
4623 Carp::confess "I don't know a $id" unless $self->cpan_file;
4624 my $dist = $CPAN::META->instance('CPAN::Distribution',
4627 $self->debug($dist->as_string) if $CPAN::DEBUG;
4628 my($todir) = $CPAN::Config->{'cpan_home'};
4629 my(@me,$from,$to,$me);
4630 @me = split /::/, $self->id;
4632 $me = MM->catfile(@me);
4633 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
4634 $to = MM->catfile($todir,$me);
4635 File::Path::mkpath(File::Basename::dirname($to));
4636 File::Copy::copy($from, $to)
4637 or Carp::confess("Couldn't copy $from to $to: $!");
4641 my $fh = FileHandle->new;
4643 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
4645 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
4647 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
4648 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
4649 next unless $in_cont;
4654 push @result, (split " ", $_, 2)[0];
4657 delete $self->{STATUS};
4658 $self->{CONTAINS} = \@result;
4659 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
4661 $CPAN::Frontend->mywarn(qq{
4662 The bundle file "$parsefile" may be a broken
4663 bundlefile. It seems not to contain any bundle definition.
4664 Please check the file and if it is bogus, please delete it.
4665 Sorry for the inconvenience.
4671 #-> sub CPAN::Bundle::find_bundle_file
4672 sub find_bundle_file {
4673 my($self,$where,$what) = @_;
4674 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
4675 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
4676 ### my $bu = MM->catfile($where,$what);
4677 ### return $bu if -f $bu;
4678 my $manifest = MM->catfile($where,"MANIFEST");
4679 unless (-f $manifest) {
4680 require ExtUtils::Manifest;
4681 my $cwd = CPAN::anycwd();
4682 chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
4683 ExtUtils::Manifest::mkmanifest();
4684 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
4686 my $fh = FileHandle->new($manifest)
4687 or Carp::croak("Couldn't open $manifest: $!");
4690 if ($^O eq 'MacOS') {
4693 $what2 =~ s/:Bundle://;
4696 $what2 =~ s|Bundle[/\\]||;
4701 my($file) = /(\S+)/;
4702 if ($file =~ m|\Q$what\E$|) {
4704 # return MM->catfile($where,$bu); # bad
4707 # retry if she managed to
4708 # have no Bundle directory
4709 $bu = $file if $file =~ m|\Q$what2\E$|;
4711 $bu =~ tr|/|:| if $^O eq 'MacOS';
4712 return MM->catfile($where, $bu) if $bu;
4713 Carp::croak("Couldn't find a Bundle file in $where");
4716 # needs to work quite differently from Module::inst_file because of
4717 # cpan_home/Bundle/ directory and the possibility that we have
4718 # shadowing effect. As it makes no sense to take the first in @INC for
4719 # Bundles, we parse them all for $VERSION and take the newest.
4721 #-> sub CPAN::Bundle::inst_file ;
4726 @me = split /::/, $self->id;
4729 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
4730 my $bfile = MM->catfile($incdir, @me);
4731 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
4732 next unless -f $bfile;
4733 my $foundv = MM->parse_version($bfile);
4734 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
4735 $self->{INST_FILE} = $bfile;
4736 $self->{INST_VERSION} = $bestv = $foundv;
4742 #-> sub CPAN::Bundle::inst_version ;
4745 $self->inst_file; # finds INST_VERSION as side effect
4746 $self->{INST_VERSION};
4749 #-> sub CPAN::Bundle::rematein ;
4751 my($self,$meth) = @_;
4752 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
4753 my($id) = $self->id;
4754 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
4755 unless $self->inst_file || $self->cpan_file;
4757 for $s ($self->contains) {
4758 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
4759 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
4760 if ($type eq 'CPAN::Distribution') {
4761 $CPAN::Frontend->mywarn(qq{
4762 The Bundle }.$self->id.qq{ contains
4763 explicitly a file $s.
4767 # possibly noisy action:
4768 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
4769 my $obj = $CPAN::META->instance($type,$s);
4771 if ($obj->isa(CPAN::Bundle)
4773 exists $obj->{install_failed}
4775 ref($obj->{install_failed}) eq "HASH"
4777 for (keys %{$obj->{install_failed}}) {
4778 $self->{install_failed}{$_} = undef; # propagate faiure up
4781 $fail{$s} = 1; # the bundle itself may have succeeded but
4786 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
4787 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
4789 delete $self->{install_failed}{$s};
4796 # recap with less noise
4797 if ( $meth eq "install" ) {
4800 my $raw = sprintf(qq{Bundle summary:
4801 The following items in bundle %s had installation problems:},
4804 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
4805 $CPAN::Frontend->myprint("\n");
4808 for $s ($self->contains) {
4810 $paragraph .= "$s ";
4811 $self->{install_failed}{$s} = undef;
4812 $reported{$s} = undef;
4815 my $report_propagated;
4816 for $s (sort keys %{$self->{install_failed}}) {
4817 next if exists $reported{$s};
4818 $paragraph .= "and the following items had problems
4819 during recursive bundle calls: " unless $report_propagated++;
4820 $paragraph .= "$s ";
4822 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
4823 $CPAN::Frontend->myprint("\n");
4825 $self->{'install'} = 'YES';
4830 #sub CPAN::Bundle::xs_file
4832 # If a bundle contains another that contains an xs_file we have
4833 # here, we just don't bother I suppose
4837 #-> sub CPAN::Bundle::force ;
4838 sub force { shift->rematein('force',@_); }
4839 #-> sub CPAN::Bundle::get ;
4840 sub get { shift->rematein('get',@_); }
4841 #-> sub CPAN::Bundle::make ;
4842 sub make { shift->rematein('make',@_); }
4843 #-> sub CPAN::Bundle::test ;
4846 $self->{badtestcnt} ||= 0;
4847 $self->rematein('test',@_);
4849 #-> sub CPAN::Bundle::install ;
4852 $self->rematein('install',@_);
4854 #-> sub CPAN::Bundle::clean ;
4855 sub clean { shift->rematein('clean',@_); }
4857 #-> sub CPAN::Bundle::uptodate ;
4860 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
4862 foreach $c ($self->contains) {
4863 my $obj = CPAN::Shell->expandany($c);
4864 return 0 unless $obj->uptodate;
4869 #-> sub CPAN::Bundle::readme ;
4872 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
4873 No File found for bundle } . $self->id . qq{\n}), return;
4874 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
4875 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
4878 package CPAN::Module;
4881 # sub cpan_userid { shift->{RO}{CPAN_USERID} }
4884 return unless exists $self->{RO}; # should never happen
4885 return $self->{RO}{CPAN_USERID} || $self->{RO}{userid};
4887 sub description { shift->{RO}{description} }
4891 delete $self->{later};
4892 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
4897 #-> sub CPAN::Module::color_cmd_tmps ;
4898 sub color_cmd_tmps {
4900 my($depth) = shift || 0;
4901 my($color) = shift || 0;
4902 # a module needs to recurse to its cpan_file
4904 return if exists $self->{incommandcolor}
4905 && $self->{incommandcolor}==$color;
4906 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
4907 "color_cmd_tmps depth[%s] self[%s] id[%s]",
4912 ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4914 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
4915 $dist->color_cmd_tmps($depth+1,$color);
4918 delete $self->{badtestcnt};
4920 $self->{incommandcolor} = $color;
4923 #-> sub CPAN::Module::as_glimpse ;
4927 my $class = ref($self);
4928 $class =~ s/^CPAN:://;
4932 $CPAN::Shell::COLOR_REGISTERED
4934 $CPAN::META->has_inst("Term::ANSIColor")
4936 $self->{RO}{description}
4938 $color_on = Term::ANSIColor::color("green");
4939 $color_off = Term::ANSIColor::color("reset");
4941 push @m, sprintf("%-15s %s%-15s%s (%s)\n",
4950 #-> sub CPAN::Module::as_string ;
4954 CPAN->debug($self) if $CPAN::DEBUG;
4955 my $class = ref($self);
4956 $class =~ s/^CPAN:://;
4958 push @m, $class, " id = $self->{ID}\n";
4959 my $sprintf = " %-12s %s\n";
4960 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
4961 if $self->description;
4962 my $sprintf2 = " %-12s %s (%s)\n";
4964 if ($userid = $self->cpan_userid || $self->userid){
4966 if ($author = CPAN::Shell->expand('Author',$userid)) {
4969 if ($m = $author->email) {
4976 $author->fullname . $email
4980 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
4981 if $self->cpan_version;
4982 push @m, sprintf($sprintf, 'CPAN_FILE', $self->cpan_file)
4983 if $self->cpan_file;
4984 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
4985 my(%statd,%stats,%statl,%stati);
4986 @statd{qw,? i c a b R M S,} = qw,unknown idea
4987 pre-alpha alpha beta released mature standard,;
4988 @stats{qw,? m d u n,} = qw,unknown mailing-list
4989 developer comp.lang.perl.* none,;
4990 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
4991 @stati{qw,? f r O h,} = qw,unknown functions
4992 references+ties object-oriented hybrid,;
4993 $statd{' '} = 'unknown';
4994 $stats{' '} = 'unknown';
4995 $statl{' '} = 'unknown';
4996 $stati{' '} = 'unknown';
5004 $statd{$self->{RO}{statd}},
5005 $stats{$self->{RO}{stats}},
5006 $statl{$self->{RO}{statl}},
5007 $stati{$self->{RO}{stati}}
5008 ) if $self->{RO}{statd};
5009 my $local_file = $self->inst_file;
5010 unless ($self->{MANPAGE}) {
5012 $self->{MANPAGE} = $self->manpage_headline($local_file);
5014 # If we have already untarred it, we should look there
5015 my $dist = $CPAN::META->instance('CPAN::Distribution',
5017 # warn "dist[$dist]";
5018 # mff=manifest file; mfh=manifest handle
5020 if ($dist->{build_dir} and
5021 -f ($mff = MM->catfile($dist->{build_dir}, "MANIFEST")) and
5022 $mfh = FileHandle->new($mff)
5024 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
5025 my $lfre = $self->id; # local file RE
5028 my($lfl); # local file file
5030 my(@mflines) = <$mfh>;
5035 while (length($lfre)>5 and !$lfl) {
5036 ($lfl) = grep /$lfre/, @mflines;
5037 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
5040 $lfl =~ s/\s.*//; # remove comments
5041 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
5042 my $lfl_abs = MM->catfile($dist->{build_dir},$lfl);
5043 # warn "lfl_abs[$lfl_abs]";
5045 $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
5051 for $item (qw/MANPAGE/) {
5052 push @m, sprintf($sprintf, $item, $self->{$item})
5053 if exists $self->{$item};
5055 for $item (qw/CONTAINS/) {
5056 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
5057 if exists $self->{$item} && @{$self->{$item}};
5059 push @m, sprintf($sprintf, 'INST_FILE',
5060 $local_file || "(not installed)");
5061 push @m, sprintf($sprintf, 'INST_VERSION',
5062 $self->inst_version) if $local_file;
5066 sub manpage_headline {
5067 my($self,$local_file) = @_;
5068 my(@local_file) = $local_file;
5069 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
5070 push @local_file, $local_file;
5072 for $locf (@local_file) {
5073 next unless -f $locf;
5074 my $fh = FileHandle->new($locf)
5075 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
5079 $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
5080 m/^=head1\s+NAME/ ? 1 : $inpod;
5093 #-> sub CPAN::Module::cpan_file ;
5096 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
5097 unless (defined $self->{RO}{CPAN_FILE}) {
5098 CPAN::Index->reload;
5100 if (exists $self->{RO}{CPAN_FILE} && defined $self->{RO}{CPAN_FILE}){
5101 return $self->{RO}{CPAN_FILE};
5103 my $userid = $self->userid;
5105 if ($CPAN::META->exists("CPAN::Author",$userid)) {
5106 my $author = $CPAN::META->instance("CPAN::Author",
5108 my $fullname = $author->fullname;
5109 my $email = $author->email;
5110 unless (defined $fullname && defined $email) {
5111 return sprintf("Contact Author %s",
5115 return "Contact Author $fullname <$email>";
5117 return "UserID $userid";
5125 #-> sub CPAN::Module::cpan_version ;
5129 $self->{RO}{CPAN_VERSION} = 'undef'
5130 unless defined $self->{RO}{CPAN_VERSION};
5131 # I believe this is always a bug in the index and should be reported
5132 # as such, but usually I find out such an error and do not want to
5133 # provoke too many bugreports
5135 $self->{RO}{CPAN_VERSION};
5138 #-> sub CPAN::Module::force ;
5141 $self->{'force_update'}++;
5144 #-> sub CPAN::Module::rematein ;
5146 my($self,$meth) = @_;
5147 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
5150 my $cpan_file = $self->cpan_file;
5151 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
5152 $CPAN::Frontend->mywarn(sprintf qq{
5153 The module %s isn\'t available on CPAN.
5155 Either the module has not yet been uploaded to CPAN, or it is
5156 temporary unavailable. Please contact the author to find out
5157 more about the status. Try 'i %s'.
5164 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
5165 $pack->called_for($self->id);
5166 $pack->force($meth) if exists $self->{'force_update'};
5168 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
5169 delete $self->{'force_update'};
5172 #-> sub CPAN::Module::readme ;
5173 sub readme { shift->rematein('readme') }
5174 #-> sub CPAN::Module::look ;
5175 sub look { shift->rematein('look') }
5176 #-> sub CPAN::Module::cvs_import ;
5177 sub cvs_import { shift->rematein('cvs_import') }
5178 #-> sub CPAN::Module::get ;
5179 sub get { shift->rematein('get',@_); }
5180 #-> sub CPAN::Module::make ;
5183 $self->rematein('make');
5185 #-> sub CPAN::Module::test ;
5188 $self->{badtestcnt} ||= 0;
5189 $self->rematein('test',@_);
5191 #-> sub CPAN::Module::uptodate ;
5194 my($latest) = $self->cpan_version;
5196 my($inst_file) = $self->inst_file;
5198 if (defined $inst_file) {
5199 $have = $self->inst_version;
5204 ! CPAN::Version->vgt($latest, $have)
5206 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
5207 "latest[$latest] have[$have]") if $CPAN::DEBUG;
5212 #-> sub CPAN::Module::install ;
5218 not exists $self->{'force_update'}
5220 $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
5224 $self->rematein('install') if $doit;
5226 #-> sub CPAN::Module::clean ;
5227 sub clean { shift->rematein('clean') }
5229 #-> sub CPAN::Module::inst_file ;
5233 @packpath = split /::/, $self->{ID};
5234 $packpath[-1] .= ".pm";
5235 foreach $dir (@INC) {
5236 my $pmfile = MM->catfile($dir,@packpath);
5244 #-> sub CPAN::Module::xs_file ;
5248 @packpath = split /::/, $self->{ID};
5249 push @packpath, $packpath[-1];
5250 $packpath[-1] .= "." . $Config::Config{'dlext'};
5251 foreach $dir (@INC) {
5252 my $xsfile = MM->catfile($dir,'auto',@packpath);
5260 #-> sub CPAN::Module::inst_version ;
5263 my $parsefile = $self->inst_file or return;
5264 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
5267 # there was a bug in 5.6.0 that let lots of unini warnings out of
5268 # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
5269 # the following workaround after 5.6.1 is out.
5270 local($SIG{__WARN__}) = sub { my $w = shift;
5271 return if $w =~ /uninitialized/i;
5275 $have = MM->parse_version($parsefile) || "undef";
5276 $have =~ s/^ //; # since the %vd hack these two lines here are needed
5277 $have =~ s/ $//; # trailing whitespace happens all the time
5279 # My thoughts about why %vd processing should happen here
5281 # Alt1 maintain it as string with leading v:
5282 # read index files do nothing
5283 # compare it use utility for compare
5284 # print it do nothing
5286 # Alt2 maintain it as what is is
5287 # read index files convert
5288 # compare it use utility because there's still a ">" vs "gt" issue
5289 # print it use CPAN::Version for print
5291 # Seems cleaner to hold it in memory as a string starting with a "v"
5293 # If the author of this module made a mistake and wrote a quoted
5294 # "v1.13" instead of v1.13, we simply leave it at that with the
5295 # effect that *we* will treat it like a v-tring while the rest of
5296 # perl won't. Seems sensible when we consider that any action we
5297 # could take now would just add complexity.
5299 $have = CPAN::Version->readable($have);
5301 $have =~ s/\s*//g; # stringify to float around floating point issues
5302 $have; # no stringify needed, \s* above matches always
5305 package CPAN::Tarzip;
5307 # CPAN::Tarzip::gzip
5309 my($class,$read,$write) = @_;
5310 if ($CPAN::META->has_inst("Compress::Zlib")) {
5312 $fhw = FileHandle->new($read)
5313 or $CPAN::Frontend->mydie("Could not open $read: $!");
5314 my $gz = Compress::Zlib::gzopen($write, "wb")
5315 or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
5316 $gz->gzwrite($buffer)
5317 while read($fhw,$buffer,4096) > 0 ;
5322 system("$CPAN::Config->{gzip} -c $read > $write")==0;
5327 # CPAN::Tarzip::gunzip
5329 my($class,$read,$write) = @_;
5330 if ($CPAN::META->has_inst("Compress::Zlib")) {
5332 $fhw = FileHandle->new(">$write")
5333 or $CPAN::Frontend->mydie("Could not open >$write: $!");
5334 my $gz = Compress::Zlib::gzopen($read, "rb")
5335 or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
5336 $fhw->print($buffer)
5337 while $gz->gzread($buffer) > 0 ;
5338 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
5339 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
5344 system("$CPAN::Config->{gzip} -dc $read > $write")==0;
5349 # CPAN::Tarzip::gtest
5351 my($class,$read) = @_;
5352 # After I had reread the documentation in zlib.h, I discovered that
5353 # uncompressed files do not lead to an gzerror (anymore?).
5354 if ( $CPAN::META->has_inst("Compress::Zlib") ) {
5357 my $gz = Compress::Zlib::gzopen($read, "rb")
5358 or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
5360 $Compress::Zlib::gzerrno));
5361 while ($gz->gzread($buffer) > 0 ){
5362 $len += length($buffer);
5365 my $err = $gz->gzerror;
5366 my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
5367 if ($len == -s $read){
5369 CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
5372 CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
5375 return system("$CPAN::Config->{gzip} -dt $read")==0;
5380 # CPAN::Tarzip::TIEHANDLE
5382 my($class,$file) = @_;
5384 $class->debug("file[$file]");
5385 if ($CPAN::META->has_inst("Compress::Zlib")) {
5386 my $gz = Compress::Zlib::gzopen($file,"rb") or
5387 die "Could not gzopen $file";
5388 $ret = bless {GZ => $gz}, $class;
5390 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $file |";
5391 my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
5393 $ret = bless {FH => $fh}, $class;
5399 # CPAN::Tarzip::READLINE
5402 if (exists $self->{GZ}) {
5403 my $gz = $self->{GZ};
5404 my($line,$bytesread);
5405 $bytesread = $gz->gzreadline($line);
5406 return undef if $bytesread <= 0;
5409 my $fh = $self->{FH};
5410 return scalar <$fh>;
5415 # CPAN::Tarzip::READ
5417 my($self,$ref,$length,$offset) = @_;
5418 die "read with offset not implemented" if defined $offset;
5419 if (exists $self->{GZ}) {
5420 my $gz = $self->{GZ};
5421 my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
5424 my $fh = $self->{FH};
5425 return read($fh,$$ref,$length);
5430 # CPAN::Tarzip::DESTROY
5433 if (exists $self->{GZ}) {
5434 my $gz = $self->{GZ};
5435 $gz->gzclose() if defined $gz; # hard to say if it is allowed
5436 # to be undef ever. AK, 2000-09
5438 my $fh = $self->{FH};
5439 $fh->close if defined $fh;
5445 # CPAN::Tarzip::untar
5447 my($class,$file) = @_;
5450 if (0) { # makes changing order easier
5451 } elsif ($BUGHUNTING){
5453 } elsif (MM->maybe_command($CPAN::Config->{gzip})
5455 MM->maybe_command($CPAN::Config->{'tar'})) {
5456 # should be default until Archive::Tar is fixed
5459 $CPAN::META->has_inst("Archive::Tar")
5461 $CPAN::META->has_inst("Compress::Zlib") ) {
5464 $CPAN::Frontend->mydie(qq{
5465 CPAN.pm needs either both external programs tar and gzip installed or
5466 both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
5467 is available. Can\'t continue.
5470 if ($prefer==1) { # 1 => external gzip+tar
5472 my $is_compressed = $class->gtest($file);
5473 if ($is_compressed) {
5474 $system = "$CPAN::Config->{gzip} --decompress --stdout " .
5475 "< $file | $CPAN::Config->{tar} xvf -";
5477 $system = "$CPAN::Config->{tar} xvf $file";
5479 if (system($system) != 0) {
5480 # people find the most curious tar binaries that cannot handle
5482 if ($is_compressed) {
5483 (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
5484 if (CPAN::Tarzip->gunzip($file, $ungzf)) {
5485 $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
5487 $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
5491 $system = "$CPAN::Config->{tar} xvf $file";
5492 $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
5493 if (system($system)==0) {
5494 $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
5496 $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
5502 } elsif ($prefer==2) { # 2 => modules
5503 my $tar = Archive::Tar->new($file,1);
5504 my $af; # archive file
5507 # RCS 1.337 had this code, it turned out unacceptable slow but
5508 # it revealed a bug in Archive::Tar. Code is only here to hunt
5509 # the bug again. It should never be enabled in published code.
5510 # GDGraph3d-0.53 was an interesting case according to Larry
5512 warn(">>>Bughunting code enabled<<< " x 20);
5513 for $af ($tar->list_files) {
5514 if ($af =~ m!^(/|\.\./)!) {
5515 $CPAN::Frontend->mydie("ALERT: Archive contains ".
5516 "illegal member [$af]");
5518 $CPAN::Frontend->myprint("$af\n");
5519 $tar->extract($af); # slow but effective for finding the bug
5520 return if $CPAN::Signal;
5523 for $af ($tar->list_files) {
5524 if ($af =~ m!^(/|\.\./)!) {
5525 $CPAN::Frontend->mydie("ALERT: Archive contains ".
5526 "illegal member [$af]");
5528 $CPAN::Frontend->myprint("$af\n");
5530 return if $CPAN::Signal;
5535 ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
5536 if ($^O eq 'MacOS');
5543 my($class,$file) = @_;
5544 if ($CPAN::META->has_inst("Archive::Zip")) {
5545 # blueprint of the code from Archive::Zip::Tree::extractTree();
5546 my $zip = Archive::Zip->new();
5548 $status = $zip->read($file);
5549 die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
5550 $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
5551 my @members = $zip->members();
5552 for my $member ( @members ) {
5553 my $af = $member->fileName();
5554 if ($af =~ m!^(/|\.\./)!) {
5555 $CPAN::Frontend->mydie("ALERT: Archive contains ".
5556 "illegal member [$af]");
5558 my $status = $member->extractToFileNamed( $af );
5559 $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
5560 die "Extracting of file[$af] from zipfile[$file] failed\n" if
5561 $status != Archive::Zip::AZ_OK();
5562 return if $CPAN::Signal;
5566 my $unzip = $CPAN::Config->{unzip} or
5567 $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
5568 my @system = ($unzip, $file);
5569 return system(@system) == 0;
5574 package CPAN::Version;
5575 # CPAN::Version::vcmp courtesy Jost Krieger
5577 my($self,$l,$r) = @_;
5579 CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
5581 return 0 if $l eq $r; # short circuit for quicker success
5583 if ($l=~/^v/ <=> $r=~/^v/) {
5586 $_ = $self->float2vv($_);
5591 ($l ne "undef") <=> ($r ne "undef") ||
5595 $self->vstring($l) cmp $self->vstring($r)) ||
5601 my($self,$l,$r) = @_;
5602 $self->vcmp($l,$r) > 0;
5607 $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
5608 pack "U*", split /\./, $n;
5611 # vv => visible vstring
5616 my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
5617 # architecture influence
5619 $mantissa .= "0" while length($mantissa)%3;
5620 my $ret = "v" . $rev;
5622 $mantissa =~ s/(\d{1,3})// or
5623 die "Panic: length>0 but not a digit? mantissa[$mantissa]";
5624 $ret .= ".".int($1);
5626 # warn "n[$n]ret[$ret]";
5632 $n =~ /^([\w\-\+\.]+)/;
5634 return $1 if defined $1 && length($1)>0;
5635 # if the first user reaches version v43, he will be treated as "+".
5636 # We'll have to decide about a new rule here then, depending on what
5637 # will be the prevailing versioning behavior then.
5639 if ($] < 5.006) { # or whenever v-strings were introduced
5640 # we get them wrong anyway, whatever we do, because 5.005 will
5641 # have already interpreted 0.2.4 to be "0.24". So even if he
5642 # indexer sends us something like "v0.2.4" we compare wrongly.
5644 # And if they say v1.2, then the old perl takes it as "v12"
5646 $CPAN::Frontend->mywarn("Suspicious version string seen [$n]");
5649 my $better = sprintf "v%vd", $n;
5650 CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
5662 CPAN - query, download and build perl modules from CPAN sites
5668 perl -MCPAN -e shell;
5674 autobundle, clean, install, make, recompile, test
5678 The CPAN module is designed to automate the make and install of perl
5679 modules and extensions. It includes some searching capabilities and
5680 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
5681 to fetch the raw data from the net.
5683 Modules are fetched from one or more of the mirrored CPAN
5684 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
5687 The CPAN module also supports the concept of named and versioned
5688 I<bundles> of modules. Bundles simplify the handling of sets of
5689 related modules. See Bundles below.
5691 The package contains a session manager and a cache manager. There is
5692 no status retained between sessions. The session manager keeps track
5693 of what has been fetched, built and installed in the current
5694 session. The cache manager keeps track of the disk space occupied by
5695 the make processes and deletes excess space according to a simple FIFO
5698 For extended searching capabilities there's a plugin for CPAN available,
5699 L<C<CPAN::WAIT>|CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine
5700 that indexes all documents available in CPAN authors directories. If
5701 C<CPAN::WAIT> is installed on your system, the interactive shell of
5702 CPAN.pm will enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands
5703 which send queries to the WAIT server that has been configured for your
5706 All other methods provided are accessible in a programmer style and in an
5707 interactive shell style.
5709 =head2 Interactive Mode
5711 The interactive mode is entered by running
5713 perl -MCPAN -e shell
5715 which puts you into a readline interface. You will have the most fun if
5716 you install Term::ReadKey and Term::ReadLine to enjoy both history and
5719 Once you are on the command line, type 'h' and the rest should be
5722 The function call C<shell> takes two optional arguments, one is the
5723 prompt, the second is the default initial command line (the latter
5724 only works if a real ReadLine interface module is installed).
5726 The most common uses of the interactive modes are
5730 =item Searching for authors, bundles, distribution files and modules
5732 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
5733 for each of the four categories and another, C<i> for any of the
5734 mentioned four. Each of the four entities is implemented as a class
5735 with slightly differing methods for displaying an object.
5737 Arguments you pass to these commands are either strings exactly matching
5738 the identification string of an object or regular expressions that are
5739 then matched case-insensitively against various attributes of the
5740 objects. The parser recognizes a regular expression only if you
5741 enclose it between two slashes.
5743 The principle is that the number of found objects influences how an
5744 item is displayed. If the search finds one item, the result is
5745 displayed with the rather verbose method C<as_string>, but if we find
5746 more than one, we display each object with the terse method
5749 =item make, test, install, clean modules or distributions
5751 These commands take any number of arguments and investigate what is
5752 necessary to perform the action. If the argument is a distribution
5753 file name (recognized by embedded slashes), it is processed. If it is
5754 a module, CPAN determines the distribution file in which this module
5755 is included and processes that, following any dependencies named in
5756 the module's Makefile.PL (this behavior is controlled by
5757 I<prerequisites_policy>.)
5759 Any C<make> or C<test> are run unconditionally. An
5761 install <distribution_file>
5763 also is run unconditionally. But for
5767 CPAN checks if an install is actually needed for it and prints
5768 I<module up to date> in the case that the distribution file containing
5769 the module doesn't need to be updated.
5771 CPAN also keeps track of what it has done within the current session
5772 and doesn't try to build a package a second time regardless if it
5773 succeeded or not. The C<force> command takes as a first argument the
5774 method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
5775 command from scratch.
5779 cpan> install OpenGL
5780 OpenGL is up to date.
5781 cpan> force install OpenGL
5784 OpenGL-0.4/COPYRIGHT
5787 A C<clean> command results in a
5791 being executed within the distribution file's working directory.
5793 =item get, readme, look module or distribution
5795 C<get> downloads a distribution file without further action. C<readme>
5796 displays the README file of the associated distribution. C<Look> gets
5797 and untars (if not yet done) the distribution file, changes to the
5798 appropriate directory and opens a subshell process in that directory.
5802 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
5803 in the cpan-shell it is intended that you can press C<^C> anytime and
5804 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
5805 to clean up and leave the shell loop. You can emulate the effect of a
5806 SIGTERM by sending two consecutive SIGINTs, which usually means by
5807 pressing C<^C> twice.
5809 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
5810 SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
5816 The commands that are available in the shell interface are methods in
5817 the package CPAN::Shell. If you enter the shell command, all your
5818 input is split by the Text::ParseWords::shellwords() routine which
5819 acts like most shells do. The first word is being interpreted as the
5820 method to be called and the rest of the words are treated as arguments
5821 to this method. Continuation lines are supported if a line ends with a
5826 C<autobundle> writes a bundle file into the
5827 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
5828 a list of all modules that are both available from CPAN and currently
5829 installed within @INC. The name of the bundle file is based on the
5830 current date and a counter.
5834 recompile() is a very special command in that it takes no argument and
5835 runs the make/test/install cycle with brute force over all installed
5836 dynamically loadable extensions (aka XS modules) with 'force' in
5837 effect. The primary purpose of this command is to finish a network
5838 installation. Imagine, you have a common source tree for two different
5839 architectures. You decide to do a completely independent fresh
5840 installation. You start on one architecture with the help of a Bundle
5841 file produced earlier. CPAN installs the whole Bundle for you, but
5842 when you try to repeat the job on the second architecture, CPAN
5843 responds with a C<"Foo up to date"> message for all modules. So you
5844 invoke CPAN's recompile on the second architecture and you're done.
5846 Another popular use for C<recompile> is to act as a rescue in case your
5847 perl breaks binary compatibility. If one of the modules that CPAN uses
5848 is in turn depending on binary compatibility (so you cannot run CPAN
5849 commands), then you should try the CPAN::Nox module for recovery.
5851 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
5853 Although it may be considered internal, the class hierarchy does matter
5854 for both users and programmer. CPAN.pm deals with above mentioned four
5855 classes, and all those classes share a set of methods. A classical
5856 single polymorphism is in effect. A metaclass object registers all
5857 objects of all kinds and indexes them with a string. The strings
5858 referencing objects have a separated namespace (well, not completely
5863 words containing a "/" (slash) Distribution
5864 words starting with Bundle:: Bundle
5865 everything else Module or Author
5867 Modules know their associated Distribution objects. They always refer
5868 to the most recent official release. Developers may mark their releases
5869 as unstable development versions (by inserting an underbar into the
5870 visible version number), so the really hottest and newest distribution
5871 file is not always the default. If a module Foo circulates on CPAN in
5872 both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
5873 install version 1.23 by saying
5877 This would install the complete distribution file (say
5878 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
5879 like to install version 1.23_90, you need to know where the
5880 distribution file resides on CPAN relative to the authors/id/
5881 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
5882 so you would have to say
5884 install BAR/Foo-1.23_90.tar.gz
5886 The first example will be driven by an object of the class
5887 CPAN::Module, the second by an object of class CPAN::Distribution.
5889 =head2 Programmer's interface
5891 If you do not enter the shell, the available shell commands are both
5892 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
5893 functions in the calling package (C<install(...)>).
5895 There's currently only one class that has a stable interface -
5896 CPAN::Shell. All commands that are available in the CPAN shell are
5897 methods of the class CPAN::Shell. Each of the commands that produce
5898 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
5899 the IDs of all modules within the list.
5903 =item expand($type,@things)
5905 The IDs of all objects available within a program are strings that can
5906 be expanded to the corresponding real objects with the
5907 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
5908 list of CPAN::Module objects according to the C<@things> arguments
5909 given. In scalar context it only returns the first element of the
5912 =item expandany(@things)
5914 Like expand, but returns objects of the appropriate type, i.e.
5915 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
5916 CPAN::Distribution objects fro distributions.
5918 =item Programming Examples
5920 This enables the programmer to do operations that combine
5921 functionalities that are available in the shell.
5923 # install everything that is outdated on my disk:
5924 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
5926 # install my favorite programs if necessary:
5927 for $mod (qw(Net::FTP MD5 Data::Dumper)){
5928 my $obj = CPAN::Shell->expand('Module',$mod);
5932 # list all modules on my disk that have no VERSION number
5933 for $mod (CPAN::Shell->expand("Module","/./")){
5934 next unless $mod->inst_file;
5935 # MakeMaker convention for undefined $VERSION:
5936 next unless $mod->inst_version eq "undef";
5937 print "No VERSION in ", $mod->id, "\n";
5940 # find out which distribution on CPAN contains a module:
5941 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
5943 Or if you want to write a cronjob to watch The CPAN, you could list
5944 all modules that need updating. First a quick and dirty way:
5946 perl -e 'use CPAN; CPAN::Shell->r;'
5948 If you don't want to get any output in the case that all modules are
5949 up to date, you can parse the output of above command for the regular
5950 expression //modules are up to date// and decide to mail the output
5951 only if it doesn't match. Ick?
5953 If you prefer to do it more in a programmer style in one single
5954 process, maybe something like this suits you better:
5956 # list all modules on my disk that have newer versions on CPAN
5957 for $mod (CPAN::Shell->expand("Module","/./")){
5958 next unless $mod->inst_file;
5959 next if $mod->uptodate;
5960 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
5961 $mod->id, $mod->inst_version, $mod->cpan_version;
5964 If that gives you too much output every day, you maybe only want to
5965 watch for three modules. You can write
5967 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
5969 as the first line instead. Or you can combine some of the above
5972 # watch only for a new mod_perl module
5973 $mod = CPAN::Shell->expand("Module","mod_perl");
5974 exit if $mod->uptodate;
5975 # new mod_perl arrived, let me know all update recommendations
5980 =head2 Methods in the other Classes
5982 The programming interface for the classes CPAN::Module,
5983 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
5984 beta and partially even alpha. In the following paragraphs only those
5985 methods are documented that have proven useful over a longer time and
5986 thus are unlikely to change.
5990 =item CPAN::Author::as_glimpse()
5992 Returns a one-line description of the author
5994 =item CPAN::Author::as_string()
5996 Returns a multi-line description of the author
5998 =item CPAN::Author::email()
6000 Returns the author's email address
6002 =item CPAN::Author::fullname()
6004 Returns the author's name
6006 =item CPAN::Author::name()
6008 An alias for fullname
6010 =item CPAN::Bundle::as_glimpse()
6012 Returns a one-line description of the bundle
6014 =item CPAN::Bundle::as_string()
6016 Returns a multi-line description of the bundle
6018 =item CPAN::Bundle::clean()
6020 Recursively runs the C<clean> method on all items contained in the bundle.
6022 =item CPAN::Bundle::contains()
6024 Returns a list of objects' IDs contained in a bundle. The associated
6025 objects may be bundles, modules or distributions.
6027 =item CPAN::Bundle::force($method,@args)
6029 Forces CPAN to perform a task that normally would have failed. Force
6030 takes as arguments a method name to be called and any number of
6031 additional arguments that should be passed to the called method. The
6032 internals of the object get the needed changes so that CPAN.pm does
6033 not refuse to take the action. The C<force> is passed recursively to
6034 all contained objects.
6036 =item CPAN::Bundle::get()
6038 Recursively runs the C<get> method on all items contained in the bundle
6040 =item CPAN::Bundle::inst_file()
6042 Returns the highest installed version of the bundle in either @INC or
6043 C<$CPAN::Config->{cpan_home}>. Note that this is different from
6044 CPAN::Module::inst_file.
6046 =item CPAN::Bundle::inst_version()
6048 Like CPAN::Bundle::inst_file, but returns the $VERSION
6050 =item CPAN::Bundle::uptodate()
6052 Returns 1 if the bundle itself and all its members are uptodate.
6054 =item CPAN::Bundle::install()
6056 Recursively runs the C<install> method on all items contained in the bundle
6058 =item CPAN::Bundle::make()
6060 Recursively runs the C<make> method on all items contained in the bundle
6062 =item CPAN::Bundle::readme()
6064 Recursively runs the C<readme> method on all items contained in the bundle
6066 =item CPAN::Bundle::test()
6068 Recursively runs the C<test> method on all items contained in the bundle
6070 =item CPAN::Distribution::as_glimpse()
6072 Returns a one-line description of the distribution
6074 =item CPAN::Distribution::as_string()
6076 Returns a multi-line description of the distribution
6078 =item CPAN::Distribution::clean()
6080 Changes to the directory where the distribution has been unpacked and
6081 runs C<make clean> there.
6083 =item CPAN::Distribution::containsmods()
6085 Returns a list of IDs of modules contained in a distribution file.
6086 Only works for distributions listed in the 02packages.details.txt.gz
6087 file. This typically means that only the most recent version of a
6088 distribution is covered.
6090 =item CPAN::Distribution::cvs_import()
6092 Changes to the directory where the distribution has been unpacked and
6095 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
6099 =item CPAN::Distribution::dir()
6101 Returns the directory into which this distribution has been unpacked.
6103 =item CPAN::Distribution::force($method,@args)
6105 Forces CPAN to perform a task that normally would have failed. Force
6106 takes as arguments a method name to be called and any number of
6107 additional arguments that should be passed to the called method. The
6108 internals of the object get the needed changes so that CPAN.pm does
6109 not refuse to take the action.
6111 =item CPAN::Distribution::get()
6113 Downloads the distribution from CPAN and unpacks it. Does nothing if
6114 the distribution has already been downloaded and unpacked within the
6117 =item CPAN::Distribution::install()
6119 Changes to the directory where the distribution has been unpacked and
6120 runs the external command C<make install> there. If C<make> has not
6121 yet been run, it will be run first. A C<make test> will be issued in
6122 any case and if this fails, the install will be cancelled. The
6123 cancellation can be avoided by letting C<force> run the C<install> for
6126 =item CPAN::Distribution::isa_perl()
6128 Returns 1 if this distribution file seems to be a perl distribution.
6129 Normally this is derived from the file name only, but the index from
6130 CPAN can contain a hint to achieve a return value of true for other
6133 =item CPAN::Distribution::look()
6135 Changes to the directory where the distribution has been unpacked and
6136 opens a subshell there. Exiting the subshell returns.
6138 =item CPAN::Distribution::make()
6140 First runs the C<get> method to make sure the distribution is
6141 downloaded and unpacked. Changes to the directory where the
6142 distribution has been unpacked and runs the external commands C<perl
6143 Makefile.PL> and C<make> there.
6145 =item CPAN::Distribution::prereq_pm()
6147 Returns the hash reference that has been announced by a distribution
6148 as the PREREQ_PM hash in the Makefile.PL. Note: works only after an
6149 attempt has been made to C<make> the distribution. Returns undef
6152 =item CPAN::Distribution::readme()
6154 Downloads the README file associated with a distribution and runs it
6155 through the pager specified in C<$CPAN::Config->{pager}>.
6157 =item CPAN::Distribution::test()
6159 Changes to the directory where the distribution has been unpacked and
6160 runs C<make test> there.
6162 =item CPAN::Distribution::uptodate()
6164 Returns 1 if all the modules contained in the distribution are
6165 uptodate. Relies on containsmods.
6167 =item CPAN::Index::force_reload()
6169 Forces a reload of all indices.
6171 =item CPAN::Index::reload()
6173 Reloads all indices if they have been read more than
6174 C<$CPAN::Config->{index_expire}> days.
6176 =item CPAN::InfoObj::dump()
6178 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
6179 inherit this method. It prints the data structure associated with an
6180 object. Useful for debugging. Note: the data structure is considered
6181 internal and thus subject to change without notice.
6183 =item CPAN::Module::as_glimpse()
6185 Returns a one-line description of the module
6187 =item CPAN::Module::as_string()
6189 Returns a multi-line description of the module
6191 =item CPAN::Module::clean()
6193 Runs a clean on the distribution associated with this module.
6195 =item CPAN::Module::cpan_file()
6197 Returns the filename on CPAN that is associated with the module.
6199 =item CPAN::Module::cpan_version()
6201 Returns the latest version of this module available on CPAN.
6203 =item CPAN::Module::cvs_import()
6205 Runs a cvs_import on the distribution associated with this module.
6207 =item CPAN::Module::description()
6209 Returns a 44 chracter description of this module. Only available for
6210 modules listed in The Module List (CPAN/modules/00modlist.long.html
6211 or 00modlist.long.txt.gz)
6213 =item CPAN::Module::force($method,@args)
6215 Forces CPAN to perform a task that normally would have failed. Force
6216 takes as arguments a method name to be called and any number of
6217 additional arguments that should be passed to the called method. The
6218 internals of the object get the needed changes so that CPAN.pm does
6219 not refuse to take the action.
6221 =item CPAN::Module::get()
6223 Runs a get on the distribution associated with this module.
6225 =item CPAN::Module::inst_file()
6227 Returns the filename of the module found in @INC. The first file found
6228 is reported just like perl itself stops searching @INC when it finds a
6231 =item CPAN::Module::inst_version()
6233 Returns the version number of the module in readable format.
6235 =item CPAN::Module::install()
6237 Runs an C<install> on the distribution associated with this module.
6239 =item CPAN::Module::look()
6241 Changes to the directory where the distribution assoicated with this
6242 module has been unpacked and opens a subshell there. Exiting the
6245 =item CPAN::Module::make()
6247 Runs a C<make> on the distribution associated with this module.
6249 =item CPAN::Module::manpage_headline()
6251 If module is installed, peeks into the module's manpage, reads the
6252 headline and returns it. Moreover, if the module has been downloaded
6253 within this session, does the equivalent on the downloaded module even
6254 if it is not installed.
6256 =item CPAN::Module::readme()
6258 Runs a C<readme> on the distribution associated with this module.
6260 =item CPAN::Module::test()
6262 Runs a C<test> on the distribution associated with this module.
6264 =item CPAN::Module::uptodate()
6266 Returns 1 if the module is installed and up-to-date.
6268 =item CPAN::Module::userid()
6270 Returns the author's ID of the module.
6274 =head2 Cache Manager
6276 Currently the cache manager only keeps track of the build directory
6277 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
6278 deletes complete directories below C<build_dir> as soon as the size of
6279 all directories there gets bigger than $CPAN::Config->{build_cache}
6280 (in MB). The contents of this cache may be used for later
6281 re-installations that you intend to do manually, but will never be
6282 trusted by CPAN itself. This is due to the fact that the user might
6283 use these directories for building modules on different architectures.
6285 There is another directory ($CPAN::Config->{keep_source_where}) where
6286 the original distribution files are kept. This directory is not
6287 covered by the cache manager and must be controlled by the user. If
6288 you choose to have the same directory as build_dir and as
6289 keep_source_where directory, then your sources will be deleted with
6290 the same fifo mechanism.
6294 A bundle is just a perl module in the namespace Bundle:: that does not
6295 define any functions or methods. It usually only contains documentation.
6297 It starts like a perl module with a package declaration and a $VERSION
6298 variable. After that the pod section looks like any other pod with the
6299 only difference being that I<one special pod section> exists starting with
6304 In this pod section each line obeys the format
6306 Module_Name [Version_String] [- optional text]
6308 The only required part is the first field, the name of a module
6309 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
6310 of the line is optional. The comment part is delimited by a dash just
6311 as in the man page header.
6313 The distribution of a bundle should follow the same convention as
6314 other distributions.
6316 Bundles are treated specially in the CPAN package. If you say 'install
6317 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
6318 the modules in the CONTENTS section of the pod. You can install your
6319 own Bundles locally by placing a conformant Bundle file somewhere into
6320 your @INC path. The autobundle() command which is available in the
6321 shell interface does that for you by including all currently installed
6322 modules in a snapshot bundle file.
6324 =head2 Prerequisites
6326 If you have a local mirror of CPAN and can access all files with
6327 "file:" URLs, then you only need a perl better than perl5.003 to run
6328 this module. Otherwise Net::FTP is strongly recommended. LWP may be
6329 required for non-UNIX systems or if your nearest CPAN site is
6330 associated with an URL that is not C<ftp:>.
6332 If you have neither Net::FTP nor LWP, there is a fallback mechanism
6333 implemented for an external ftp command or for an external lynx
6336 =head2 Finding packages and VERSION
6338 This module presumes that all packages on CPAN
6344 declare their $VERSION variable in an easy to parse manner. This
6345 prerequisite can hardly be relaxed because it consumes far too much
6346 memory to load all packages into the running program just to determine
6347 the $VERSION variable. Currently all programs that are dealing with
6348 version use something like this
6350 perl -MExtUtils::MakeMaker -le \
6351 'print MM->parse_version(shift)' filename
6353 If you are author of a package and wonder if your $VERSION can be
6354 parsed, please try the above method.
6358 come as compressed or gzipped tarfiles or as zip files and contain a
6359 Makefile.PL (well, we try to handle a bit more, but without much
6366 The debugging of this module is a bit complex, because we have
6367 interferences of the software producing the indices on CPAN, of the
6368 mirroring process on CPAN, of packaging, of configuration, of
6369 synchronicity, and of bugs within CPAN.pm.
6371 For code debugging in interactive mode you can try "o debug" which
6372 will list options for debugging the various parts of the code. You
6373 should know that "o debug" has built-in completion support.
6375 For data debugging there is the C<dump> command which takes the same
6376 arguments as make/test/install and outputs the object's Data::Dumper
6379 =head2 Floppy, Zip, Offline Mode
6381 CPAN.pm works nicely without network too. If you maintain machines
6382 that are not networked at all, you should consider working with file:
6383 URLs. Of course, you have to collect your modules somewhere first. So
6384 you might use CPAN.pm to put together all you need on a networked
6385 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
6386 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
6387 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
6388 with this floppy. See also below the paragraph about CD-ROM support.
6390 =head1 CONFIGURATION
6392 When the CPAN module is installed, a site wide configuration file is
6393 created as CPAN/Config.pm. The default values defined there can be
6394 overridden in another configuration file: CPAN/MyConfig.pm. You can
6395 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
6396 $HOME/.cpan is added to the search path of the CPAN module before the
6397 use() or require() statements.
6399 Currently the following keys in the hash reference $CPAN::Config are
6402 build_cache size of cache for directories to build modules
6403 build_dir locally accessible directory to build modules
6404 index_expire after this many days refetch index files
6405 cache_metadata use serializer to cache metadata
6406 cpan_home local directory reserved for this package
6407 dontload_hash anonymous hash: modules in the keys will not be
6408 loaded by the CPAN::has_inst() routine
6409 gzip location of external program gzip
6410 inactivity_timeout breaks interactive Makefile.PLs after this
6411 many seconds inactivity. Set to 0 to never break.
6412 inhibit_startup_message
6413 if true, does not print the startup message
6414 keep_source_where directory in which to keep the source (if we do)
6415 make location of external make program
6416 make_arg arguments that should always be passed to 'make'
6417 make_install_arg same as make_arg for 'make install'
6418 makepl_arg arguments passed to 'perl Makefile.PL'
6419 pager location of external program more (or any pager)
6420 prerequisites_policy
6421 what to do if you are missing module prerequisites
6422 ('follow' automatically, 'ask' me, or 'ignore')
6423 scan_cache controls scanning of cache ('atstart' or 'never')
6424 tar location of external program tar
6425 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
6426 (and nonsense for characters outside latin range)
6427 unzip location of external program unzip
6428 urllist arrayref to nearby CPAN sites (or equivalent locations)
6429 wait_list arrayref to a wait server to try (See CPAN::WAIT)
6430 ftp_proxy, } the three usual variables for configuring
6431 http_proxy, } proxy requests. Both as CPAN::Config variables
6432 no_proxy } and as environment variables configurable.
6434 You can set and query each of these options interactively in the cpan
6435 shell with the command set defined within the C<o conf> command:
6439 =item C<o conf E<lt>scalar optionE<gt>>
6441 prints the current value of the I<scalar option>
6443 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
6445 Sets the value of the I<scalar option> to I<value>
6447 =item C<o conf E<lt>list optionE<gt>>
6449 prints the current value of the I<list option> in MakeMaker's
6452 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
6454 shifts or pops the array in the I<list option> variable
6456 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
6458 works like the corresponding perl commands.
6462 =head2 Note on urllist parameter's format
6464 urllist parameters are URLs according to RFC 1738. We do a little
6465 guessing if your URL is not compliant, but if you have problems with
6466 file URLs, please try the correct format. Either:
6468 file://localhost/whatever/ftp/pub/CPAN/
6472 file:///home/ftp/pub/CPAN/
6474 =head2 urllist parameter has CD-ROM support
6476 The C<urllist> parameter of the configuration table contains a list of
6477 URLs that are to be used for downloading. If the list contains any
6478 C<file> URLs, CPAN always tries to get files from there first. This
6479 feature is disabled for index files. So the recommendation for the
6480 owner of a CD-ROM with CPAN contents is: include your local, possibly
6481 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
6483 o conf urllist push file://localhost/CDROM/CPAN
6485 CPAN.pm will then fetch the index files from one of the CPAN sites
6486 that come at the beginning of urllist. It will later check for each
6487 module if there is a local copy of the most recent version.
6489 Another peculiarity of urllist is that the site that we could
6490 successfully fetch the last file from automatically gets a preference
6491 token and is tried as the first site for the next request. So if you
6492 add a new site at runtime it may happen that the previously preferred
6493 site will be tried another time. This means that if you want to disallow
6494 a site for the next transfer, it must be explicitly removed from
6499 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
6500 install foreign, unmasked, unsigned code on your machine. We compare
6501 to a checksum that comes from the net just as the distribution file
6502 itself. If somebody has managed to tamper with the distribution file,
6503 they may have as well tampered with the CHECKSUMS file. Future
6504 development will go towards strong authentication.
6508 Most functions in package CPAN are exported per default. The reason
6509 for this is that the primary use is intended for the cpan shell or for
6512 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
6514 Populating a freshly installed perl with my favorite modules is pretty
6515 easy if you maintain a private bundle definition file. To get a useful
6516 blueprint of a bundle definition file, the command autobundle can be used
6517 on the CPAN shell command line. This command writes a bundle definition
6518 file for all modules that are installed for the currently running perl
6519 interpreter. It's recommended to run this command only once and from then
6520 on maintain the file manually under a private name, say
6521 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
6523 cpan> install Bundle::my_bundle
6525 then answer a few questions and then go out for a coffee.
6527 Maintaining a bundle definition file means keeping track of two
6528 things: dependencies and interactivity. CPAN.pm sometimes fails on
6529 calculating dependencies because not all modules define all MakeMaker
6530 attributes correctly, so a bundle definition file should specify
6531 prerequisites as early as possible. On the other hand, it's a bit
6532 annoying that many distributions need some interactive configuring. So
6533 what I try to accomplish in my private bundle file is to have the
6534 packages that need to be configured early in the file and the gentle
6535 ones later, so I can go out after a few minutes and leave CPAN.pm
6538 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
6540 Thanks to Graham Barr for contributing the following paragraphs about
6541 the interaction between perl, and various firewall configurations. For
6542 further informations on firewalls, it is recommended to consult the
6543 documentation that comes with the ncftp program. If you are unable to
6544 go through the firewall with a simple Perl setup, it is very likely
6545 that you can configure ncftp so that it works for your firewall.
6547 =head2 Three basic types of firewalls
6549 Firewalls can be categorized into three basic types.
6555 This is where the firewall machine runs a web server and to access the
6556 outside world you must do it via the web server. If you set environment
6557 variables like http_proxy or ftp_proxy to a values beginning with http://
6558 or in your web browser you have to set proxy information then you know
6559 you are running a http firewall.
6561 To access servers outside these types of firewalls with perl (even for
6562 ftp) you will need to use LWP.
6566 This where the firewall machine runs a ftp server. This kind of
6567 firewall will only let you access ftp servers outside the firewall.
6568 This is usually done by connecting to the firewall with ftp, then
6569 entering a username like "user@outside.host.com"
6571 To access servers outside these type of firewalls with perl you
6572 will need to use Net::FTP.
6574 =item One way visibility
6576 I say one way visibility as these firewalls try to make themselve look
6577 invisible to the users inside the firewall. An FTP data connection is
6578 normally created by sending the remote server your IP address and then
6579 listening for the connection. But the remote server will not be able to
6580 connect to you because of the firewall. So for these types of firewall
6581 FTP connections need to be done in a passive mode.
6583 There are two that I can think off.
6589 If you are using a SOCKS firewall you will need to compile perl and link
6590 it with the SOCKS library, this is what is normally called a 'socksified'
6591 perl. With this executable you will be able to connect to servers outside
6592 the firewall as if it is not there.
6596 This is the firewall implemented in the Linux kernel, it allows you to
6597 hide a complete network behind one IP address. With this firewall no
6598 special compiling is needed as you can access hosts directly.
6604 =head2 Configuring lynx or ncftp for going through a firewall
6606 If you can go through your firewall with e.g. lynx, presumably with a
6609 /usr/local/bin/lynx -pscott:tiger
6611 then you would configure CPAN.pm with the command
6613 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
6615 That's all. Similarly for ncftp or ftp, you would configure something
6618 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
6620 Your milage may vary...
6628 I installed a new version of module X but CPAN keeps saying,
6629 I have the old version installed
6631 Most probably you B<do> have the old version installed. This can
6632 happen if a module installs itself into a different directory in the
6633 @INC path than it was previously installed. This is not really a
6634 CPAN.pm problem, you would have the same problem when installing the
6635 module manually. The easiest way to prevent this behaviour is to add
6636 the argument C<UNINST=1> to the C<make install> call, and that is why
6637 many people add this argument permanently by configuring
6639 o conf make_install_arg UNINST=1
6643 So why is UNINST=1 not the default?
6645 Because there are people who have their precise expectations about who
6646 may install where in the @INC path and who uses which @INC array. In
6647 fine tuned environments C<UNINST=1> can cause damage.
6651 I want to clean up my mess, and install a new perl along with
6652 all modules I have. How do I go about it?
6654 Run the autobundle command for your old perl and optionally rename the
6655 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
6656 with the Configure option prefix, e.g.
6658 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
6660 Install the bundle file you produced in the first step with something like
6662 cpan> install Bundle::mybundle
6668 When I install bundles or multiple modules with one command
6669 there is too much output to keep track of.
6671 You may want to configure something like
6673 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
6674 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
6676 so that STDOUT is captured in a file for later inspection.
6681 I am not root, how can I install a module in a personal directory?
6683 You will most probably like something like this:
6685 o conf makepl_arg "LIB=~/myperl/lib \
6686 INSTALLMAN1DIR=~/myperl/man/man1 \
6687 INSTALLMAN3DIR=~/myperl/man/man3"
6688 install Sybase::Sybperl
6690 You can make this setting permanent like all C<o conf> settings with
6693 You will have to add ~/myperl/man to the MANPATH environment variable
6694 and also tell your perl programs to look into ~/myperl/lib, e.g. by
6697 use lib "$ENV{HOME}/myperl/lib";
6699 or setting the PERL5LIB environment variable.
6701 Another thing you should bear in mind is that the UNINST parameter
6702 should never be set if you are not root.
6706 How to get a package, unwrap it, and make a change before building it?
6708 look Sybase::Sybperl
6712 I installed a Bundle and had a couple of fails. When I
6713 retried, everything resolved nicely. Can this be fixed to work
6716 The reason for this is that CPAN does not know the dependencies of all
6717 modules when it starts out. To decide about the additional items to
6718 install, it just uses data found in the generated Makefile. An
6719 undetected missing piece breaks the process. But it may well be that
6720 your Bundle installs some prerequisite later than some depending item
6721 and thus your second try is able to resolve everything. Please note,
6722 CPAN.pm does not know the dependency tree in advance and cannot sort
6723 the queue of things to install in a topologically correct order. It
6724 resolves perfectly well IFF all modules declare the prerequisites
6725 correctly with the PREREQ_PM attribute to MakeMaker. For bundles which
6726 fail and you need to install often, it is recommended sort the Bundle
6727 definition file manually. It is planned to improve the metadata
6728 situation for dependencies on CPAN in general, but this will still
6733 In our intranet we have many modules for internal use. How
6734 can I integrate these modules with CPAN.pm but without uploading
6735 the modules to CPAN?
6737 Have a look at the CPAN::Site module.
6741 When I run CPAN's shell, I get error msg about line 1 to 4,
6742 setting meta input/output via the /etc/inputrc file.
6744 Some versions of readline are picky about capitalization in the
6745 /etc/inputrc file and specifically RedHat 6.2 comes with a
6746 /etc/inputrc that contains the word C<on> in lowercase. Change the
6747 occurrences of C<on> to C<On> and the bug should disappear.
6751 Some authors have strange characters in their names.
6753 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
6754 expecting ISO-8859-1 charset, a converter can be activated by setting
6755 term_is_latin to a true value in your config file. One way of doing so
6758 cpan> ! $CPAN::Config->{term_is_latin}=1
6760 Extended support for converters will be made available as soon as perl
6761 becomes stable with regard to charset issues.
6767 We should give coverage for B<all> of the CPAN and not just the PAUSE
6768 part, right? In this discussion CPAN and PAUSE have become equal --
6769 but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is
6770 PAUSE plus the clpa/, doc/, misc/, ports/, and src/.
6772 Future development should be directed towards a better integration of
6775 If a Makefile.PL requires special customization of libraries, prompts
6776 the user for special input, etc. then you may find CPAN is not able to
6777 build the distribution. In that case, you should attempt the
6778 traditional method of building a Perl module package from a shell.
6782 Andreas Koenig E<lt>andreas.koenig@anima.deE<gt>
6786 perl(1), CPAN::Nox(3)