2 use vars qw{$Try_autoload
4 $META $Signal $Cwd $End
5 $Suppress_readline %Dontload
11 # $Id: CPAN.pm,v 1.264 1999/05/23 14:26:49 k Exp $
13 # only used during development:
15 # $Revision = "[".substr(q$Revision: 1.264 $, 10)."]";
22 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
23 use File::Basename ();
29 use Text::ParseWords ();
33 END { $End++; &cleanup; }
54 $CPAN::Frontend ||= "CPAN::Shell";
55 $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
58 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
61 @CPAN::ISA = qw(CPAN::Debug Exporter);
64 autobundle bundle expand force get
65 install make readme recompile shell test clean
68 #-> sub CPAN::AUTOLOAD ;
73 @EXPORT{@EXPORT} = '';
74 CPAN::Config->load unless $CPAN::Config_loaded++;
75 if (exists $EXPORT{$l}){
78 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
82 # $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD");
84 $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
93 $Suppress_readline ||= ! -t STDIN;
94 CPAN::Config->load unless $CPAN::Config_loaded++;
96 my $prompt = "cpan> ";
98 unless ($Suppress_readline) {
99 require Term::ReadLine;
100 # import Term::ReadLine;
101 $term = Term::ReadLine->new('CPAN Monitor');
102 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
103 my $attribs = $term->Attribs;
104 # $attribs->{completion_entry_function} =
105 # $attribs->{'list_completion_function'};
106 $attribs->{attempted_completion_function} = sub {
107 &CPAN::Complete::gnu_cpl;
109 # $attribs->{completion_word} =
110 # [qw(help me somebody to find out how
111 # to use completion with GNU)];
113 $readline::rl_completion_function =
114 $readline::rl_completion_function = 'CPAN::Complete::cpl';
121 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
122 my $cwd = CPAN->$getcwd();
123 my $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub";
124 my $rl_avail = $Suppress_readline ? "suppressed" :
125 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
126 "available (try ``install Bundle::CPAN'')";
128 $CPAN::Frontend->myprint(
130 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision)
131 ReadLine support $rl_avail
133 }) unless $CPAN::Config->{'inhibit_startup_message'} ;
134 my($continuation) = "";
136 if ($Suppress_readline) {
138 last unless defined ($_ = <> );
141 last unless defined ($_ = $term->readline($prompt));
143 $_ = "$continuation$_" if $continuation;
146 $_ = 'h' if /^\s*\?/;
147 if (/^(?:q(?:uit)?|bye|exit)$/i) {
157 use vars qw($import_done);
158 CPAN->import(':DEFAULT') unless $import_done++;
159 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
166 if ($] < 5.00322) { # parsewords had a bug until recently
169 eval { @line = Text::ParseWords::shellwords($_) };
170 warn($@), next if $@;
172 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
173 my $command = shift @line;
174 eval { CPAN::Shell->$command(@line) };
177 $CPAN::Frontend->myprint("\n");
183 CPAN::Queue->nullify_queue;
184 if ($try_detect_readline) {
185 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
187 $CPAN::META->has_inst("Term::ReadLine::Perl")
189 delete $INC{"Term/ReadLine.pm"};
191 local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef);
192 require Term::ReadLine;
193 $CPAN::Frontend->myprint("\n$redef subroutines in Term::ReadLine redefined\n");
200 package CPAN::CacheMgr;
201 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
204 package CPAN::Config;
205 import ExtUtils::MakeMaker 'neatvalue';
206 use vars qw(%can $dot_cpan);
209 'commit' => "Commit changes to disk",
210 'defaults' => "Reload defaults from disk",
211 'init' => "Interactive setting of all options",
215 use vars qw($Ua $Thesite $Themethod);
216 @CPAN::FTP::ISA = qw(CPAN::Debug);
218 package CPAN::Complete;
219 @CPAN::Complete::ISA = qw(CPAN::Debug);
222 use vars qw($last_time $date_of_03);
223 @CPAN::Index::ISA = qw(CPAN::Debug);
227 package CPAN::InfoObj;
228 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
230 package CPAN::Author;
231 @CPAN::Author::ISA = qw(CPAN::InfoObj);
233 package CPAN::Distribution;
234 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
236 package CPAN::Bundle;
237 @CPAN::Bundle::ISA = qw(CPAN::Module);
239 package CPAN::Module;
240 @CPAN::Module::ISA = qw(CPAN::InfoObj);
243 use vars qw($AUTOLOAD $redef @ISA);
244 @CPAN::Shell::ISA = qw(CPAN::Debug);
246 #-> sub CPAN::Shell::AUTOLOAD ;
248 my($autoload) = $AUTOLOAD;
249 my $class = shift(@_);
250 # warn "autoload[$autoload] class[$class]";
251 $autoload =~ s/.*:://;
252 if ($autoload =~ /^w/) {
253 if ($CPAN::META->has_inst('CPAN::WAIT')) {
254 CPAN::WAIT->$autoload(@_);
256 $CPAN::Frontend->mywarn(qq{
257 Commands starting with "w" require CPAN::WAIT to be installed.
258 Please consider installing CPAN::WAIT to use the fulltext index.
259 For this you just need to type
264 my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
268 # $CPAN::Frontend->mywarn("Could not autoload $autoload");
270 $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
276 #-> CPAN::Shell::try_dot_al
278 my($class,$autoload) = @_;
279 return unless $CPAN::Try_autoload;
280 # I don't see how to re-use that from the AutoLoader...
282 # Braces used to preserve $1 et al.
284 my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/;
286 if (defined($name=$INC{"$pkg.pm"}))
288 $name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
289 $name = undef unless (-r $name);
291 unless (defined $name)
293 $name = "auto/$autoload.al";
298 eval {local $SIG{__DIE__};require $name};
300 if (substr($autoload,-9) eq '::DESTROY') {
304 if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
305 eval {local $SIG{__DIE__};require $name};
320 # my $lm = Carp::longmess();
321 # warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
325 #### autoloader is experimental
326 #### to try it we have to set $Try_autoload and uncomment
327 #### the use statement and uncomment the __END__ below
328 #### You also need AutoSplit 1.01 available. MakeMaker will
329 #### then build CPAN with all the AutoLoad stuff.
333 if ($CPAN::Try_autoload) {
336 CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
337 CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
338 CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
340 *{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD;
344 package CPAN::Tarzip;
345 use vars qw($AUTOLOAD @ISA);
346 @CPAN::Tarzip::ISA = qw(CPAN::Debug);
350 # One use of the queue is to determine if we should or shouldn't
351 # announce the availability of a new CPAN module
353 # Now we try to use it for dependency tracking. For that to happen
354 # we need to draw a dependency tree and do the leaves first. This can
355 # easily be reached by running CPAN.pm recursively, but we don't want
356 # to waste memory and run into deep recursion. So what we can do is
359 # CPAN::Queue is the package where the queue is maintained. Dependencies
360 # often have high priority and must be brought to the head of the queue,
361 # possibly by jumping the queue if they are already there. My first code
362 # attempt tried to be extremely correct. Whenever a module needed
363 # immediate treatment, I either unshifted it to the front of the queue,
364 # or, if it was already in the queue, I spliced and let it bypass the
365 # others. This became a too correct model that made it impossible to put
366 # an item more than once into the queue. Why would you need that? Well,
367 # you need temporary duplicates as the manager of the queue is a loop
370 # (1) looks at the first item in the queue without shifting it off
372 # (2) cares for the item
374 # (3) removes the item from the queue, *even if its agenda failed and
375 # even if the item isn't the first in the queue anymore* (that way
376 # protecting against never ending queues)
378 # So if an item has prerequisites, the installation fails now, but we
379 # want to retry later. That's easy if we have it twice in the queue.
381 # I also expect insane dependency situations where an item gets more
382 # than two lives in the queue. Simplest example is triggered by 'install
383 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
384 # get in the way. I wanted the queue manager to be a dumb servant, not
385 # one that knows everything.
387 # Who would I tell in this model that the user wants to be asked before
388 # processing? I can't attach that information to the module object,
389 # because not modules are installed but distributions. So I'd have to
390 # tell the distribution object that it should ask the user before
391 # processing. Where would the question be triggered then? Most probably
392 # in CPAN::Distribution::rematein.
393 # Hope that makes sense, my head is a bit off:-) -- AK
398 my($class,$mod) = @_;
399 my $self = bless {mod => $mod}, $class;
401 # my @all = map { $_->{mod} } @All;
402 # warn "Adding Queue object for mod[$mod] all[@all]";
412 my($class,$what) = @_;
414 for my $i (0..$#All) {
415 if ( $All[$i]->{mod} eq $what ) {
426 WHAT: for my $what (reverse @what) {
428 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
429 if ($All[$i]->{mod} eq $what){
431 if ($jumped > 100) { # one's OK if e.g. just processing now;
432 # more are OK if user typed it several
434 $CPAN::Frontend->mywarn(
435 qq{Object [$what] queued more than 100 times, ignoring}
441 my $obj = bless { mod => $what }, $class;
447 my($self,$what) = @_;
448 my @all = map { $_->{mod} } @All;
449 my $exists = grep { $_->{mod} eq $what } @All;
450 # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]";
456 @All = grep { $_->{mod} ne $mod } @All;
457 # my @all = map { $_->{mod} } @All;
458 # warn "Deleting Queue object for mod[$mod] all[@all]";
469 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
473 # __END__ # uncomment this and AutoSplit version 1.01 will split it
475 #-> sub CPAN::autobundle ;
477 #-> sub CPAN::bundle ;
479 #-> sub CPAN::expand ;
481 #-> sub CPAN::force ;
483 #-> sub CPAN::install ;
487 #-> sub CPAN::clean ;
494 my($mgr,$class) = @_;
495 CPAN::Config->load unless $CPAN::Config_loaded++;
496 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
498 values %{ $META->{$class} };
500 *all = \&all_objects;
502 # Called by shell, not in batch mode. Not clean XXX
503 #-> sub CPAN::checklock ;
506 my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
507 if (-f $lockfile && -M _ > 0) {
508 my $fh = FileHandle->new($lockfile);
511 if (defined $other && $other) {
513 return if $$==$other; # should never happen
514 $CPAN::Frontend->mywarn(
516 There seems to be running another CPAN process ($other). Contacting...
518 if (kill 0, $other) {
519 $CPAN::Frontend->mydie(qq{Other job is running.
520 You may want to kill it and delete the lockfile, maybe. On UNIX try:
524 } elsif (-w $lockfile) {
526 ExtUtils::MakeMaker::prompt
527 (qq{Other job not responding. Shall I overwrite }.
528 qq{the lockfile? (Y/N)},"y");
529 $CPAN::Frontend->myexit("Ok, bye\n")
530 unless $ans =~ /^y/i;
533 qq{Lockfile $lockfile not writeable by you. }.
534 qq{Cannot proceed.\n}.
537 qq{ and then rerun us.\n}
542 my $dotcpan = $CPAN::Config->{cpan_home};
543 eval { File::Path::mkpath($dotcpan);};
545 # A special case at least for Jarkko.
550 $symlinkcpan = readlink $dotcpan;
551 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
552 eval { File::Path::mkpath($symlinkcpan); };
556 $CPAN::Frontend->mywarn(qq{
557 Working directory $symlinkcpan created.
561 unless (-d $dotcpan) {
563 Your configuration suggests "$dotcpan" as your
564 CPAN.pm working directory. I could not create this directory due
565 to this error: $firsterror\n};
567 As "$dotcpan" is a symlink to "$symlinkcpan",
568 I tried to create that, but I failed with this error: $seconderror
571 Please make sure the directory exists and is writable.
573 $CPAN::Frontend->mydie($diemess);
577 unless ($fh = FileHandle->new(">$lockfile")) {
578 if ($! =~ /Permission/ || $!{EACCES}) {
579 my $incc = $INC{'CPAN/Config.pm'};
580 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
581 $CPAN::Frontend->myprint(qq{
583 Your configuration suggests that CPAN.pm should use a working
585 $CPAN::Config->{cpan_home}
586 Unfortunately we could not create the lock file
588 due to permission problems.
590 Please make sure that the configuration variable
591 \$CPAN::Config->{cpan_home}
592 points to a directory where you can write a .lock file. You can set
593 this variable in either
600 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
602 $fh->print($$, "\n");
603 $self->{LOCK} = $lockfile;
607 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
612 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
613 print "Caught SIGINT\n";
616 $SIG{'__DIE__'} = \&cleanup;
617 $self->debug("Signal handler set.") if $CPAN::DEBUG;
620 #-> sub CPAN::DESTROY ;
622 &cleanup; # need an eval?
626 sub cwd {Cwd::cwd();}
628 #-> sub CPAN::getcwd ;
629 sub getcwd {Cwd::getcwd();}
631 #-> sub CPAN::exists ;
633 my($mgr,$class,$id) = @_;
635 ### Carp::croak "exists called without class argument" unless $class;
637 exists $META->{$class}{$id};
640 #-> sub CPAN::delete ;
642 my($mgr,$class,$id) = @_;
643 delete $META->{$class}{$id};
646 #-> sub CPAN::has_inst
648 my($self,$mod,$message) = @_;
649 Carp::croak("CPAN->has_inst() called without an argument")
651 if (defined $message && $message eq "no") {
654 } elsif (exists $Dontload{$mod}) {
660 $file =~ s|/|\\|g if $^O eq 'MSWin32';
663 # checking %INC is wrong, because $INC{LWP} may be true
664 # although $INC{"URI/URL.pm"} may have failed. But as
665 # I really want to say "bla loaded OK", I have to somehow
667 ### warn "$file in %INC"; #debug
669 } elsif (eval { require $file }) {
670 # eval is good: if we haven't yet read the database it's
671 # perfect and if we have installed the module in the meantime,
672 # it tries again. The second require is only a NOOP returning
673 # 1 if we had success, otherwise it's retrying
675 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
676 if ($mod eq "CPAN::WAIT") {
677 push @CPAN::Shell::ISA, CPAN::WAIT;
680 } elsif ($mod eq "Net::FTP") {
682 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
684 install Bundle::libnet
688 } elsif ($mod eq "MD5"){
689 $CPAN::Frontend->myprint(qq{
690 CPAN: MD5 security checks disabled because MD5 not installed.
691 Please consider installing the MD5 module.
696 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
701 #-> sub CPAN::instance ;
703 my($mgr,$class,$id) = @_;
706 $META->{$class}{$id} ||= $class->new(ID => $id );
714 #-> sub CPAN::cleanup ;
716 # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
717 local $SIG{__DIE__} = '';
722 0 && # disabled, try reload cpan with it
723 $] > 5.004_60 # thereabouts
728 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
730 $subroutine eq '(eval)';
733 return if $ineval && !$End;
734 return unless defined $META->{'LOCK'};
735 return unless -f $META->{'LOCK'};
736 unlink $META->{'LOCK'};
738 # Carp::cluck("DEBUGGING");
739 $CPAN::Frontend->mywarn("Lockfile removed.\n");
742 package CPAN::CacheMgr;
744 #-> sub CPAN::CacheMgr::as_string ;
746 eval { require Data::Dumper };
748 return shift->SUPER::as_string;
750 return Data::Dumper::Dumper(shift);
754 #-> sub CPAN::CacheMgr::cachesize ;
761 return unless -d $self->{ID};
762 while ($self->{DU} > $self->{'MAX'} ) {
763 my($toremove) = shift @{$self->{FIFO}};
764 $CPAN::Frontend->myprint(sprintf(
765 "Deleting from cache".
766 ": $toremove (%.1f>%.1f MB)\n",
767 $self->{DU}, $self->{'MAX'})
769 return if $CPAN::Signal;
770 $self->force_clean_cache($toremove);
771 return if $CPAN::Signal;
775 #-> sub CPAN::CacheMgr::dir ;
780 #-> sub CPAN::CacheMgr::entries ;
783 return unless defined $dir;
784 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
785 $dir ||= $self->{ID};
787 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
788 my($cwd) = CPAN->$getcwd();
789 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
790 my $dh = DirHandle->new(File::Spec->curdir)
791 or Carp::croak("Couldn't opendir $dir: $!");
794 next if $_ eq "." || $_ eq "..";
796 push @entries, MM->catfile($dir,$_);
798 push @entries, MM->catdir($dir,$_);
800 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
803 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
804 sort { -M $b <=> -M $a} @entries;
807 #-> sub CPAN::CacheMgr::disk_usage ;
810 return if exists $self->{SIZE}{$dir};
811 return if $CPAN::Signal;
815 $File::Find::prune++ if $CPAN::Signal;
817 if ($^O eq 'MacOS') {
819 my $cat = Mac::Files::FSpGetCatInfo($_);
820 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen();
827 return if $CPAN::Signal;
828 $self->{SIZE}{$dir} = $Du/1024/1024;
829 push @{$self->{FIFO}}, $dir;
830 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
831 $self->{DU} += $Du/1024/1024;
835 #-> sub CPAN::CacheMgr::force_clean_cache ;
836 sub force_clean_cache {
838 return unless -e $dir;
839 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
841 File::Path::rmtree($dir);
842 $self->{DU} -= $self->{SIZE}{$dir};
843 delete $self->{SIZE}{$dir};
846 #-> sub CPAN::CacheMgr::new ;
853 ID => $CPAN::Config->{'build_dir'},
854 MAX => $CPAN::Config->{'build_cache'},
855 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
858 File::Path::mkpath($self->{ID});
859 my $dh = DirHandle->new($self->{ID});
863 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
865 CPAN->debug($debug) if $CPAN::DEBUG;
869 #-> sub CPAN::CacheMgr::scan_cache ;
872 return if $self->{SCAN} eq 'never';
873 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
874 unless $self->{SCAN} eq 'atstart';
875 $CPAN::Frontend->myprint(
876 sprintf("Scanning cache %s for sizes\n",
879 for $e ($self->entries($self->{ID})) {
880 next if $e eq ".." || $e eq ".";
881 $self->disk_usage($e);
882 return if $CPAN::Signal;
889 #-> sub CPAN::Debug::debug ;
892 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
893 # Complete, caller(1)
895 ($caller) = caller(0);
897 $arg = "" unless defined $arg;
898 my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
899 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
900 if ($arg and ref $arg) {
901 eval { require Data::Dumper };
903 $CPAN::Frontend->myprint($arg->as_string);
905 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
908 $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
913 package CPAN::Config;
915 #-> sub CPAN::Config::edit ;
917 my($class,@args) = @_;
919 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
920 my($o,$str,$func,$args,$key_exists);
926 if (ref($CPAN::Config->{$o}) eq ARRAY) {
929 # Let's avoid eval, it's easier to comprehend without.
930 if ($func eq "push") {
931 push @{$CPAN::Config->{$o}}, @args;
932 } elsif ($func eq "pop") {
933 pop @{$CPAN::Config->{$o}};
934 } elsif ($func eq "shift") {
935 shift @{$CPAN::Config->{$o}};
936 } elsif ($func eq "unshift") {
937 unshift @{$CPAN::Config->{$o}}, @args;
938 } elsif ($func eq "splice") {
939 splice @{$CPAN::Config->{$o}}, @args;
941 $CPAN::Config->{$o} = [@args];
943 $CPAN::Frontend->myprint(
946 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
951 $CPAN::Config->{$o} = $args[0] if defined $args[0];
952 $CPAN::Frontend->myprint(" $o " .
953 (defined $CPAN::Config->{$o} ?
954 $CPAN::Config->{$o} : "UNDEFINED"));
959 #-> sub CPAN::Config::commit ;
961 my($self,$configpm) = @_;
962 unless (defined $configpm){
963 $configpm ||= $INC{"CPAN/MyConfig.pm"};
964 $configpm ||= $INC{"CPAN/Config.pm"};
965 $configpm || Carp::confess(q{
966 CPAN::Config::commit called without an argument.
967 Please specify a filename where to save the configuration or try
968 "o conf init" to have an interactive course through configing.
973 $mode = (stat $configpm)[2];
974 if ($mode && ! -w _) {
975 Carp::confess("$configpm is not writable");
979 my $msg = <<EOF unless $configpm =~ /MyConfig/;
981 # This is CPAN.pm's systemwide configuration file. This file provides
982 # defaults for users, and the values can be changed in a per-user
983 # configuration file. The user-config file is being looked for as
984 # ~/.cpan/CPAN/MyConfig.pm.
988 my($fh) = FileHandle->new;
989 rename $configpm, "$configpm~" if -f $configpm;
990 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
991 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
992 foreach (sort keys %$CPAN::Config) {
995 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
1000 $fh->print("};\n1;\n__END__\n");
1003 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
1004 #chmod $mode, $configpm;
1005 ###why was that so? $self->defaults;
1006 $CPAN::Frontend->myprint("commit: wrote $configpm\n");
1010 *default = \&defaults;
1011 #-> sub CPAN::Config::defaults ;
1021 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
1030 #-> sub CPAN::Config::load ;
1035 eval {require CPAN::Config;}; # We eval because of some
1036 # MakeMaker problems
1037 unless ($dot_cpan++){
1038 unshift @INC, MM->catdir($ENV{HOME},".cpan");
1039 eval {require CPAN::MyConfig;}; # where you can override
1040 # system wide settings
1043 return unless @miss = $self->not_loaded;
1044 # XXX better check for arrayrefs too
1045 require CPAN::FirstTime;
1046 my($configpm,$fh,$redo,$theycalled);
1048 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
1049 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
1050 $configpm = $INC{"CPAN/Config.pm"};
1052 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
1053 $configpm = $INC{"CPAN/MyConfig.pm"};
1056 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
1057 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
1058 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
1059 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
1060 if (-w $configpmtest) {
1061 $configpm = $configpmtest;
1062 } elsif (-w $configpmdir) {
1063 #_#_# following code dumped core on me with 5.003_11, a.k.
1064 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
1065 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
1066 my $fh = FileHandle->new;
1067 if ($fh->open(">$configpmtest")) {
1069 $configpm = $configpmtest;
1071 # Should never happen
1072 Carp::confess("Cannot open >$configpmtest");
1076 unless ($configpm) {
1077 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
1078 File::Path::mkpath($configpmdir);
1079 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
1080 if (-w $configpmtest) {
1081 $configpm = $configpmtest;
1082 } elsif (-w $configpmdir) {
1083 #_#_# following code dumped core on me with 5.003_11, a.k.
1084 my $fh = FileHandle->new;
1085 if ($fh->open(">$configpmtest")) {
1087 $configpm = $configpmtest;
1089 # Should never happen
1090 Carp::confess("Cannot open >$configpmtest");
1093 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
1094 qq{create a configuration file.});
1099 $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
1100 We have to reconfigure CPAN.pm due to following uninitialized parameters:
1104 $CPAN::Frontend->myprint(qq{
1105 $configpm initialized.
1108 CPAN::FirstTime::init($configpm);
1111 #-> sub CPAN::Config::not_loaded ;
1115 cpan_home keep_source_where build_dir build_cache scan_cache
1116 index_expire gzip tar unzip make pager makepl_arg make_arg
1117 make_install_arg urllist inhibit_startup_message
1118 ftp_proxy http_proxy no_proxy prerequisites_policy
1120 push @miss, $_ unless defined $CPAN::Config->{$_};
1125 #-> sub CPAN::Config::unload ;
1127 delete $INC{'CPAN/MyConfig.pm'};
1128 delete $INC{'CPAN/Config.pm'};
1131 #-> sub CPAN::Config::help ;
1133 $CPAN::Frontend->myprint(q[
1135 defaults reload default config values from disk
1136 commit commit session changes to disk
1137 init go through a dialog to set all parameters
1139 You may edit key values in the follow fashion:
1141 o conf build_cache 15
1143 o conf build_dir "/foo/bar"
1145 o conf urllist shift
1147 o conf urllist unshift ftp://ftp.foo.bar/
1150 undef; #don't reprint CPAN::Config
1153 #-> sub CPAN::Config::cpl ;
1155 my($word,$line,$pos) = @_;
1157 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1158 my(@words) = split " ", substr($line,0,$pos+1);
1163 $words[2] =~ /list$/ && @words == 3
1165 $words[2] =~ /list$/ && @words == 4 && length($word)
1168 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
1169 } elsif (@words >= 4) {
1172 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
1173 return grep /^\Q$word\E/, @o_conf;
1176 package CPAN::Shell;
1178 #-> sub CPAN::Shell::h ;
1180 my($class,$about) = @_;
1181 if (defined $about) {
1182 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1184 $CPAN::Frontend->myprint(q{
1185 command arguments description
1187 b or display bundles
1188 d /regex/ info distributions
1190 i none anything of above
1192 r as reinstall recommendations
1193 u above uninstalled distributions
1194 See manpage for autobundle, recompile, force, look, etc.
1197 test modules, make test (implies make)
1198 install dists, bundles, make install (implies test)
1199 clean "r" or "u" make clean
1200 readme display the README file
1202 reload index|cpan load most recent indices/CPAN.pm
1203 h or ? display this menu
1204 o various set and query options
1205 ! perl-code eval a perl command
1206 q quit the shell subroutine
1213 #-> sub CPAN::Shell::a ;
1214 sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
1215 #-> sub CPAN::Shell::b ;
1217 my($self,@which) = @_;
1218 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1219 my($incdir,$bdir,$dh);
1220 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1221 $bdir = MM->catdir($incdir,"Bundle");
1222 if ($dh = DirHandle->new($bdir)) { # may fail
1224 for $entry ($dh->read) {
1225 next if -d MM->catdir($bdir,$entry);
1226 next unless $entry =~ s/\.pm$//;
1227 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
1231 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1233 #-> sub CPAN::Shell::d ;
1234 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1235 #-> sub CPAN::Shell::m ;
1236 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1237 $CPAN::Frontend->myprint(shift->format_result('Module',@_));
1240 #-> sub CPAN::Shell::i ;
1245 @type = qw/Author Bundle Distribution Module/;
1246 @args = '/./' unless @args;
1249 push @result, $self->expand($type,@args);
1251 my $result = @result == 1 ?
1252 $result[0]->as_string :
1253 join "", map {$_->as_glimpse} @result;
1254 $result ||= "No objects found of any type for argument @args\n";
1255 $CPAN::Frontend->myprint($result);
1258 #-> sub CPAN::Shell::o ;
1260 my($self,$o_type,@o_what) = @_;
1262 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1263 if ($o_type eq 'conf') {
1264 shift @o_what if @o_what && $o_what[0] eq 'help';
1267 $CPAN::Frontend->myprint("CPAN::Config options");
1268 if (exists $INC{'CPAN/Config.pm'}) {
1269 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1271 if (exists $INC{'CPAN/MyConfig.pm'}) {
1272 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1274 $CPAN::Frontend->myprint(":\n");
1275 for $k (sort keys %CPAN::Config::can) {
1276 $v = $CPAN::Config::can{$k};
1277 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1279 $CPAN::Frontend->myprint("\n");
1280 for $k (sort keys %$CPAN::Config) {
1281 $v = $CPAN::Config->{$k};
1283 $CPAN::Frontend->myprint(
1290 map {"\t$_\n"} @{$v}
1294 $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
1297 $CPAN::Frontend->myprint("\n");
1298 } elsif (!CPAN::Config->edit(@o_what)) {
1299 $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]);
1301 } elsif ($o_type eq 'debug') {
1303 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1306 my($what) = shift @o_what;
1307 if ( exists $CPAN::DEBUG{$what} ) {
1308 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1309 } elsif ($what =~ /^\d/) {
1310 $CPAN::DEBUG = $what;
1311 } elsif (lc $what eq 'all') {
1313 for (values %CPAN::DEBUG) {
1316 $CPAN::DEBUG = $max;
1319 for (keys %CPAN::DEBUG) {
1320 next unless lc($_) eq lc($what);
1321 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1324 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1329 $CPAN::Frontend->myprint("Valid options for debug are ".
1330 join(", ",sort(keys %CPAN::DEBUG), 'all').
1331 qq{ or a number. Completion works on the options. }.
1332 qq{Case is ignored.\n\n});
1335 $CPAN::Frontend->myprint("Options set for debugging:\n");
1337 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1338 $v = $CPAN::DEBUG{$k};
1339 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
1342 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1345 $CPAN::Frontend->myprint(qq{
1347 conf set or get configuration variables
1348 debug set or get debugging options
1353 sub dotdot_onreload {
1356 if ( $_[0] =~ /Subroutine (\w+) redefined/ ) {
1360 # $CPAN::Frontend->myprint(".($subr)");
1361 $CPAN::Frontend->myprint(".");
1368 #-> sub CPAN::Shell::reload ;
1370 my($self,$command,@arg) = @_;
1372 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1373 if ($command =~ /cpan/i) {
1374 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
1375 my $fh = FileHandle->new($INC{'CPAN.pm'});
1378 local($SIG{__WARN__}) = dotdot_onreload(\$redef);
1381 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1382 } elsif ($command =~ /index/) {
1383 CPAN::Index->force_reload;
1385 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1386 index re-reads the index files\n});
1390 #-> sub CPAN::Shell::_binary_extensions ;
1391 sub _binary_extensions {
1392 my($self) = shift @_;
1393 my(@result,$module,%seen,%need,$headerdone);
1394 my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz$};
1395 for $module ($self->expand('Module','/./')) {
1396 my $file = $module->cpan_file;
1397 next if $file eq "N/A";
1398 next if $file =~ /^Contact Author/;
1399 next if $file =~ / $isaperl /xo;
1400 next unless $module->xs_file;
1402 $CPAN::Frontend->myprint(".");
1403 push @result, $module;
1405 # print join " | ", @result;
1406 $CPAN::Frontend->myprint("\n");
1410 #-> sub CPAN::Shell::recompile ;
1412 my($self) = shift @_;
1413 my($module,@module,$cpan_file,%dist);
1414 @module = $self->_binary_extensions();
1415 for $module (@module){ # we force now and compile later, so we
1417 $cpan_file = $module->cpan_file;
1418 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1420 $dist{$cpan_file}++;
1422 for $cpan_file (sort keys %dist) {
1423 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1424 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1426 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1427 # stop a package from recompiling,
1428 # e.g. IO-1.12 when we have perl5.003_10
1432 #-> sub CPAN::Shell::_u_r_common ;
1434 my($self) = shift @_;
1435 my($what) = shift @_;
1436 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1437 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1438 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1440 @args = '/./' unless @args;
1441 my(@result,$module,%seen,%need,$headerdone,
1442 $version_undefs,$version_zeroes);
1443 $version_undefs = $version_zeroes = 0;
1444 my $sprintf = "%-25s %9s %9s %s\n";
1445 for $module ($self->expand('Module',@args)) {
1446 my $file = $module->cpan_file;
1447 next unless defined $file; # ??
1448 my($latest) = $module->cpan_version;
1449 my($inst_file) = $module->inst_file;
1451 return if $CPAN::Signal;
1454 $have = $module->inst_version;
1455 } elsif ($what eq "r") {
1456 $have = $module->inst_version;
1458 if ($have eq "undef"){
1460 } elsif ($have == 0){
1463 next if $have >= $latest;
1464 # to be pedantic we should probably say:
1465 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1466 # to catch the case where CPAN has a version 0 and we have a version undef
1467 } elsif ($what eq "u") {
1473 } elsif ($what eq "r") {
1475 } elsif ($what eq "u") {
1479 return if $CPAN::Signal; # this is sometimes lengthy
1482 push @result, sprintf "%s %s\n", $module->id, $have;
1483 } elsif ($what eq "r") {
1484 push @result, $module->id;
1485 next if $seen{$file}++;
1486 } elsif ($what eq "u") {
1487 push @result, $module->id;
1488 next if $seen{$file}++;
1489 next if $file =~ /^Contact/;
1491 unless ($headerdone++){
1492 $CPAN::Frontend->myprint("\n");
1493 $CPAN::Frontend->myprint(sprintf(
1495 "Package namespace",
1501 $latest = substr($latest,0,8) if length($latest) > 8;
1502 $have = substr($have,0,8) if length($have) > 8;
1503 $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
1504 $need{$module->id}++;
1508 $CPAN::Frontend->myprint("No modules found for @args\n");
1509 } elsif ($what eq "r") {
1510 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1514 if ($version_zeroes) {
1515 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1516 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1517 qq{a version number of 0\n});
1519 if ($version_undefs) {
1520 my $s_has = $version_undefs > 1 ? "s have" : " has";
1521 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1522 qq{parseable version number\n});
1528 #-> sub CPAN::Shell::r ;
1530 shift->_u_r_common("r",@_);
1533 #-> sub CPAN::Shell::u ;
1535 shift->_u_r_common("u",@_);
1538 #-> sub CPAN::Shell::autobundle ;
1541 CPAN::Config->load unless $CPAN::Config_loaded++;
1542 my(@bundle) = $self->_u_r_common("a",@_);
1543 my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1544 File::Path::mkpath($todir);
1545 unless (-d $todir) {
1546 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1549 my($y,$m,$d) = (localtime)[5,4,3];
1553 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1554 my($to) = MM->catfile($todir,"$me.pm");
1556 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1557 $to = MM->catfile($todir,"$me.pm");
1559 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1561 "package Bundle::$me;\n\n",
1562 "\$VERSION = '0.01';\n\n",
1566 "Bundle::$me - Snapshot of installation on ",
1567 $Config::Config{'myhostname'},
1570 "\n\n=head1 SYNOPSIS\n\n",
1571 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1572 "=head1 CONTENTS\n\n",
1573 join("\n", @bundle),
1574 "\n\n=head1 CONFIGURATION\n\n",
1576 "\n\n=head1 AUTHOR\n\n",
1577 "This Bundle has been generated automatically ",
1578 "by the autobundle routine in CPAN.pm.\n",
1581 $CPAN::Frontend->myprint("\nWrote bundle file
1585 #-> sub CPAN::Shell::expand ;
1588 my($type,@args) = @_;
1592 if ($arg =~ m|^/(.*)/$|) {
1595 my $class = "CPAN::$type";
1597 if (defined $regex) {
1598 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all_objects($class)) {
1601 $obj->id =~ /$regex/i
1605 $] < 5.00303 ### provide sort of compatibility with 5.003
1610 $obj->name =~ /$regex/i
1615 if ( $type eq 'Bundle' ) {
1616 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1618 if ($CPAN::META->exists($class,$xarg)) {
1619 $obj = $CPAN::META->instance($class,$xarg);
1620 } elsif ($CPAN::META->exists($class,$arg)) {
1621 $obj = $CPAN::META->instance($class,$arg);
1628 return wantarray ? @m : $m[0];
1631 #-> sub CPAN::Shell::format_result ;
1634 my($type,@args) = @_;
1635 @args = '/./' unless @args;
1636 my(@result) = $self->expand($type,@args);
1637 my $result = @result == 1 ?
1638 $result[0]->as_string :
1639 join "", map {$_->as_glimpse} @result;
1640 $result ||= "No objects of type $type found for argument @args\n";
1644 # The only reason for this method is currently to have a reliable
1645 # debugging utility that reveals which output is going through which
1646 # channel. No, I don't like the colors ;-)
1647 sub print_ornamented {
1648 my($self,$what,$ornament) = @_;
1650 my $ornamenting = 0; # turn the colors on
1653 unless (defined &color) {
1654 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1655 import Term::ANSIColor "color";
1657 *color = sub { return "" };
1661 for $line (split /\n/, $what) {
1662 $longest = length($line) if length($line) > $longest;
1664 my $sprintf = "%-" . $longest . "s";
1666 $what =~ s/(.*\n?)//m;
1669 my($nl) = chomp $line ? "\n" : "";
1670 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
1671 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
1679 my($self,$what) = @_;
1680 $self->print_ornamented($what, 'bold blue on_yellow');
1684 my($self,$what) = @_;
1685 $self->myprint($what);
1690 my($self,$what) = @_;
1691 $self->print_ornamented($what, 'bold red on_yellow');
1695 my($self,$what) = @_;
1696 $self->print_ornamented($what, 'bold red on_white');
1697 Carp::confess "died";
1701 my($self,$what) = @_;
1702 $self->print_ornamented($what, 'bold red on_white');
1706 #-> sub CPAN::Shell::rematein ;
1707 # RE-adme||MA-ke||TE-st||IN-stall
1710 my($meth,@some) = @_;
1712 if ($meth eq 'force') {
1714 $meth = shift @some;
1716 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1718 foreach $s (@some) {
1719 CPAN::Queue->new($s);
1721 while ($s = CPAN::Queue->first) {
1725 } elsif ($s =~ m|/|) { # looks like a file
1726 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1727 } elsif ($s =~ m|^Bundle::|) {
1728 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1730 $obj = $CPAN::META->instance('CPAN::Module',$s)
1731 if $CPAN::META->exists('CPAN::Module',$s);
1735 qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
1743 ($] < 5.00303 || $obj->can($pragma)); ###
1747 if ($]>=5.00303 && $obj->can('called_for')) {
1748 $obj->called_for($s);
1750 CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
1753 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1754 $obj = $CPAN::META->instance('CPAN::Author',$s);
1755 $CPAN::Frontend->myprint(
1757 "Don't be silly, you can't $meth ",
1763 ->myprint(qq{Warning: Cannot $meth $s, }.
1764 qq{don\'t know what it is.
1769 to find objects with similar identifiers.
1772 CPAN::Queue->delete_first($s);
1776 #-> sub CPAN::Shell::force ;
1777 sub force { shift->rematein('force',@_); }
1778 #-> sub CPAN::Shell::get ;
1779 sub get { shift->rematein('get',@_); }
1780 #-> sub CPAN::Shell::readme ;
1781 sub readme { shift->rematein('readme',@_); }
1782 #-> sub CPAN::Shell::make ;
1783 sub make { shift->rematein('make',@_); }
1784 #-> sub CPAN::Shell::test ;
1785 sub test { shift->rematein('test',@_); }
1786 #-> sub CPAN::Shell::install ;
1787 sub install { shift->rematein('install',@_); }
1788 #-> sub CPAN::Shell::clean ;
1789 sub clean { shift->rematein('clean',@_); }
1790 #-> sub CPAN::Shell::look ;
1791 sub look { shift->rematein('look',@_); }
1795 #-> sub CPAN::FTP::ftp_get ;
1797 my($class,$host,$dir,$file,$target) = @_;
1799 qq[Going to fetch file [$file] from dir [$dir]
1800 on host [$host] as local [$target]\n]
1802 my $ftp = Net::FTP->new($host);
1803 return 0 unless defined $ftp;
1804 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1805 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1806 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1807 warn "Couldn't login on $host";
1810 unless ( $ftp->cwd($dir) ){
1811 warn "Couldn't cwd $dir";
1815 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1816 unless ( $ftp->get($file,$target) ){
1817 warn "Couldn't fetch $file from $host\n";
1820 $ftp->quit; # it's ok if this fails
1824 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
1826 # leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
1827 # leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997
1828 # leach,> ***************
1829 # leach,> *** 1562,1567 ****
1830 # leach,> --- 1562,1580 ----
1831 # leach,> return 1 if substr($url,0,4) eq "file";
1832 # leach,> return 1 unless $url =~ m|://([^/]+)|;
1833 # leach,> my $host = $1;
1834 # leach,> + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1835 # leach,> + if ($proxy) {
1836 # leach,> + $proxy =~ m|://([^/:]+)|;
1837 # leach,> + $proxy = $1;
1838 # leach,> + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1839 # leach,> + if ($noproxy) {
1840 # leach,> + if ($host !~ /$noproxy$/) {
1841 # leach,> + $host = $proxy;
1843 # leach,> + } else {
1844 # leach,> + $host = $proxy;
1847 # leach,> require Net::Ping;
1848 # leach,> return 1 unless $Net::Ping::VERSION >= 2;
1852 # this is quite optimistic and returns one on several occasions where
1853 # inappropriate. But this does no harm. It would do harm if we were
1854 # too pessimistic (as I was before the http_proxy
1856 my($self,$url) = @_;
1857 return 1; # we can't simply roll our own, firewalls may break ping
1858 return 0 unless $url;
1859 return 1 if substr($url,0,4) eq "file";
1860 return 1 unless $url =~ m|^(\w+)://([^/]+)|;
1861 my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy
1863 return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype};
1865 return 1 unless $Net::Ping::VERSION >= 2;
1867 # 1.3101 had it different: only if the first eval raised an
1868 # exception we tried it with TCP. Now we are happy if icmp wins
1869 # the order and return, we don't even check for $@. Thanks to
1870 # thayer@uis.edu for the suggestion.
1871 eval {$p = Net::Ping->new("icmp");};
1872 return 1 if $p && ref($p) && $p->ping($host, 10);
1873 eval {$p = Net::Ping->new("tcp");};
1874 $CPAN::Frontend->mydie($@) if $@;
1875 return $p->ping($host, 10);
1878 #-> sub CPAN::FTP::localize ;
1879 # sorry for the ugly code here, I'll clean it up as soon as Net::FTP
1882 my($self,$file,$aslocal,$force) = @_;
1884 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1885 unless defined $aslocal;
1886 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
1889 if ($^O eq 'MacOS') {
1890 my($name, $path) = File::Basename::fileparse($aslocal, '');
1891 if (length($name) > 31) {
1892 $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//;
1894 my $size = 31 - length($suf);
1895 while (length($name) > $size) {
1899 $aslocal = File::Spec->catfile($path, $name);
1903 return $aslocal if -f $aslocal && -r _ && !($force & 1);
1906 rename $aslocal, "$aslocal.bak";
1910 my($aslocal_dir) = File::Basename::dirname($aslocal);
1911 File::Path::mkpath($aslocal_dir);
1912 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
1913 qq{directory "$aslocal_dir".
1914 I\'ll continue, but if you encounter problems, they may be due
1915 to insufficient permissions.\n}) unless -w $aslocal_dir;
1917 # Inheritance is not easier to manage than a few if/else branches
1918 if ($CPAN::META->has_inst('LWP::UserAgent')) {
1919 require LWP::UserAgent;
1921 $Ua = LWP::UserAgent->new;
1923 $Ua->proxy('ftp', $var)
1924 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1925 $Ua->proxy('http', $var)
1926 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1928 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1932 # Try the list of urls for each single object. We keep a record
1933 # where we did get a file from
1934 my(@reordered,$last);
1935 $CPAN::Config->{urllist} ||= [];
1936 $last = $#{$CPAN::Config->{urllist}};
1937 if ($force & 2) { # local cpans probably out of date, don't reorder
1938 @reordered = (0..$last);
1942 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
1944 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
1955 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
1957 @levels = qw/easy hard hardest/;
1959 @levels = qw/easy/ if $^O eq 'MacOS';
1960 for $level (@levels) {
1961 my $method = "host$level";
1962 my @host_seq = $level eq "easy" ?
1963 @reordered : 0..$last; # reordered has CDROM up front
1964 @host_seq = (0) unless @host_seq;
1965 my $ret = $self->$method(\@host_seq,$file,$aslocal);
1967 $Themethod = $level;
1968 $self->debug("level[$level]") if $CPAN::DEBUG;
1976 qq{Please check, if the URLs I found in your configuration file \(}.
1977 join(", ", @{$CPAN::Config->{urllist}}).
1978 qq{\) are valid. The urllist can be edited.},
1979 qq{E.g. with ``o conf urllist push ftp://myurl/''};
1980 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
1982 $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
1984 rename "$aslocal.bak", $aslocal;
1985 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
1986 $self->ls($aslocal));
1993 my($self,$host_seq,$file,$aslocal) = @_;
1995 HOSTEASY: for $i (@$host_seq) {
1996 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
1997 unless ($self->is_reachable($url)) {
1998 $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
2002 $url .= "/" unless substr($url,-1) eq "/";
2004 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2005 if ($url =~ /^file:/) {
2007 if ($CPAN::META->has_inst('LWP')) {
2009 my $u = URI::URL->new($url);
2011 } else { # works only on Unix, is poorly constructed, but
2012 # hopefully better than nothing.
2013 # RFC 1738 says fileurl BNF is
2014 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2015 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2017 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2018 $l =~ s|^file:||; # assume they
2021 $l =~ s|^/|| unless -f $l; # e.g. /P:
2023 if ( -f $l && -r _) {
2027 # Maybe mirror has compressed it?
2029 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2030 CPAN::Tarzip->gunzip("$l.gz", $aslocal);
2037 if ($CPAN::META->has_inst('LWP')) {
2038 $CPAN::Frontend->myprint("Fetching with LWP:
2042 require LWP::UserAgent;
2043 $Ua = LWP::UserAgent->new;
2045 my $res = $Ua->mirror($url, $aslocal);
2046 if ($res->is_success) {
2049 } elsif ($url !~ /\.gz$/) {
2050 my $gzurl = "$url.gz";
2051 $CPAN::Frontend->myprint("Fetching with LWP:
2054 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2055 if ($res->is_success &&
2056 CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
2064 # Alan Burlison informed me that in firewall envs Net::FTP
2065 # can still succeed where LWP fails. So we do not skip
2066 # Net::FTP anymore when LWP is available.
2070 $self->debug("LWP not installed") if $CPAN::DEBUG;
2072 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2073 # that's the nice and easy way thanks to Graham
2074 my($host,$dir,$getfile) = ($1,$2,$3);
2075 if ($CPAN::META->has_inst('Net::FTP')) {
2077 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2080 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2081 "aslocal[$aslocal]") if $CPAN::DEBUG;
2082 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2086 if ($aslocal !~ /\.gz$/) {
2087 my $gz = "$aslocal.gz";
2088 $CPAN::Frontend->myprint("Fetching with Net::FTP
2091 if (CPAN::FTP->ftp_get($host,
2095 CPAN::Tarzip->gunzip($gz,$aslocal)
2108 my($self,$host_seq,$file,$aslocal) = @_;
2110 # Came back if Net::FTP couldn't establish connection (or
2111 # failed otherwise) Maybe they are behind a firewall, but they
2112 # gave us a socksified (or other) ftp program...
2115 my($devnull) = $CPAN::Config->{devnull} || "";
2117 my($aslocal_dir) = File::Basename::dirname($aslocal);
2118 File::Path::mkpath($aslocal_dir);
2119 HOSTHARD: for $i (@$host_seq) {
2120 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2121 unless ($self->is_reachable($url)) {
2122 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2125 $url .= "/" unless substr($url,-1) eq "/";
2127 my($proto,$host,$dir,$getfile);
2129 # Courtesy Mark Conty mark_conty@cargill.com change from
2130 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2132 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2133 # proto not yet used
2134 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2136 next HOSTHARD; # who said, we could ftp anything except ftp?
2138 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2140 for $f ('lynx','ncftpget','ncftp') {
2141 next unless exists $CPAN::Config->{$f};
2142 $funkyftp = $CPAN::Config->{$f};
2143 next unless defined $funkyftp;
2144 next if $funkyftp =~ /^\s*$/;
2145 my($want_compressed);
2146 my $aslocal_uncompressed;
2147 ($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
2148 my($source_switch) = "";
2149 $source_switch = " -source" if $funkyftp =~ /\blynx$/;
2150 $source_switch = " -c" if $funkyftp =~ /\bncftp$/;
2151 $CPAN::Frontend->myprint(
2153 Trying with "$funkyftp$source_switch" to get
2156 my($system) = "$funkyftp$source_switch '$url' $devnull > ".
2157 "$aslocal_uncompressed";
2158 $self->debug("system[$system]") if $CPAN::DEBUG;
2160 if (($wstatus = system($system)) == 0
2162 -s $aslocal_uncompressed # lynx returns 0 on my
2163 # system even if it fails
2165 if ($aslocal_uncompressed ne $aslocal) {
2166 # test gzip integrity
2168 CPAN::Tarzip->gtest($aslocal_uncompressed)
2170 rename $aslocal_uncompressed, $aslocal;
2172 CPAN::Tarzip->gzip($aslocal_uncompressed,
2173 "$aslocal_uncompressed.gz");
2178 } elsif ($url !~ /\.gz$/) {
2179 unlink $aslocal_uncompressed if
2180 -f $aslocal_uncompressed && -s _ == 0;
2181 my $gz = "$aslocal.gz";
2182 my $gzurl = "$url.gz";
2183 $CPAN::Frontend->myprint(
2185 Trying with "$funkyftp$source_switch" to get
2188 my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ".
2189 "$aslocal_uncompressed.gz";
2190 $self->debug("system[$system]") if $CPAN::DEBUG;
2192 if (($wstatus = system($system)) == 0
2194 -s "$aslocal_uncompressed.gz"
2196 # test gzip integrity
2197 if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
2198 CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
2201 rename $aslocal_uncompressed, $aslocal;
2206 unlink "$aslocal_uncompressed.gz" if
2207 -f "$aslocal_uncompressed.gz";
2210 my $estatus = $wstatus >> 8;
2211 my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
2212 $CPAN::Frontend->myprint(qq{
2213 System call "$system"
2214 returned status $estatus (wstat $wstatus)$size
2222 my($self,$host_seq,$file,$aslocal) = @_;
2225 my($aslocal_dir) = File::Basename::dirname($aslocal);
2226 File::Path::mkpath($aslocal_dir);
2227 HOSTHARDEST: for $i (@$host_seq) {
2228 unless (length $CPAN::Config->{'ftp'}) {
2229 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2232 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2233 unless ($self->is_reachable($url)) {
2234 $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
2237 $url .= "/" unless substr($url,-1) eq "/";
2239 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2240 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2243 my($host,$dir,$getfile) = ($1,$2,$3);
2246 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2247 $ctime,$blksize,$blocks) = stat($aslocal);
2248 $timestamp = $mtime ||= 0;
2249 my($netrc) = CPAN::FTP::netrc->new;
2250 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2251 my $targetfile = File::Basename::basename($aslocal);
2257 map("cd $_", split "/", $dir), # RFC 1738
2259 "get $getfile $targetfile",
2262 if (! $netrc->netrc) {
2263 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2264 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2265 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2267 $netrc->contains($host))) if $CPAN::DEBUG;
2268 if ($netrc->protected) {
2269 $CPAN::Frontend->myprint(qq{
2270 Trying with external ftp to get
2272 As this requires some features that are not thoroughly tested, we\'re
2273 not sure, that we get it right....
2277 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
2279 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2280 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2282 if ($mtime > $timestamp) {
2283 $CPAN::Frontend->myprint("GOT $aslocal\n");
2287 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2290 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2291 qq{correctly protected.\n});
2294 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2295 nor does it have a default entry\n");
2298 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2299 # then and login manually to host, using e-mail as
2301 $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
2305 "user anonymous $Config::Config{'cf_email'}"
2307 $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
2308 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2309 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2311 if ($mtime > $timestamp) {
2312 $CPAN::Frontend->myprint("GOT $aslocal\n");
2316 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2318 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2324 my($self,$command,@dialog) = @_;
2325 my $fh = FileHandle->new;
2326 $fh->open("|$command") or die "Couldn't open ftp: $!";
2327 foreach (@dialog) { $fh->print("$_\n") }
2328 $fh->close; # Wait for process to complete
2330 my $estatus = $wstatus >> 8;
2331 $CPAN::Frontend->myprint(qq{
2332 Subprocess "|$command"
2333 returned status $estatus (wstat $wstatus)
2337 # find2perl needs modularization, too, all the following is stolen
2341 my($self,$name) = @_;
2342 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2343 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2345 my($perms,%user,%group);
2349 $blocks = int(($blocks + 1) / 2);
2352 $blocks = int(($sizemm + 1023) / 1024);
2355 if (-f _) { $perms = '-'; }
2356 elsif (-d _) { $perms = 'd'; }
2357 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2358 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2359 elsif (-p _) { $perms = 'p'; }
2360 elsif (-S _) { $perms = 's'; }
2361 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2363 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2364 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2365 my $tmpmode = $mode;
2366 my $tmp = $rwx[$tmpmode & 7];
2368 $tmp = $rwx[$tmpmode & 7] . $tmp;
2370 $tmp = $rwx[$tmpmode & 7] . $tmp;
2371 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
2372 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
2373 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
2376 my $user = $user{$uid} || $uid; # too lazy to implement lookup
2377 my $group = $group{$gid} || $gid;
2379 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
2381 my($moname) = $moname[$mon];
2382 if (-M _ > 365.25 / 2) {
2383 $timeyear = $year + 1900;
2386 $timeyear = sprintf("%02d:%02d", $hour, $min);
2389 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
2403 package CPAN::FTP::netrc;
2407 my $file = MM->catfile($ENV{HOME},".netrc");
2409 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2410 $atime,$mtime,$ctime,$blksize,$blocks)
2415 my($fh,@machines,$hasdefault);
2417 $fh = FileHandle->new or die "Could not create a filehandle";
2419 if($fh->open($file)){
2420 $protected = ($mode & 077) == 0;
2422 NETRC: while (<$fh>) {
2423 my(@tokens) = split " ", $_;
2424 TOKEN: while (@tokens) {
2425 my($t) = shift @tokens;
2426 if ($t eq "default"){
2430 last TOKEN if $t eq "macdef";
2431 if ($t eq "machine") {
2432 push @machines, shift @tokens;
2437 $file = $hasdefault = $protected = "";
2441 'mach' => [@machines],
2443 'hasdefault' => $hasdefault,
2444 'protected' => $protected,
2448 sub hasdefault { shift->{'hasdefault'} }
2449 sub netrc { shift->{'netrc'} }
2450 sub protected { shift->{'protected'} }
2452 my($self,$mach) = @_;
2453 for ( @{$self->{'mach'}} ) {
2454 return 1 if $_ eq $mach;
2459 package CPAN::Complete;
2462 my($text, $line, $start, $end) = @_;
2463 my(@perlret) = cpl($text, $line, $start);
2464 # find longest common match. Can anybody show me how to peruse
2465 # T::R::Gnu to have this done automatically? Seems expensive.
2466 return () unless @perlret;
2467 my($newtext) = $text;
2468 for (my $i = length($text)+1;;$i++) {
2469 last unless length($perlret[0]) && length($perlret[0]) >= $i;
2470 my $try = substr($perlret[0],0,$i);
2471 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
2472 # warn "try[$try]tries[@tries]";
2473 if (@tries == @perlret) {
2479 ($newtext,@perlret);
2482 #-> sub CPAN::Complete::cpl ;
2484 my($word,$line,$pos) = @_;
2488 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2490 if ($line =~ s/^(force\s*)//) {
2498 ! a b d h i m o q r u autobundle clean
2499 make test install force reload look
2502 } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
2504 } elsif ($line =~ /^a\s/) {
2505 @return = cplx('CPAN::Author',$word);
2506 } elsif ($line =~ /^b\s/) {
2507 @return = cplx('CPAN::Bundle',$word);
2508 } elsif ($line =~ /^d\s/) {
2509 @return = cplx('CPAN::Distribution',$word);
2510 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
2511 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
2512 } elsif ($line =~ /^i\s/) {
2513 @return = cpl_any($word);
2514 } elsif ($line =~ /^reload\s/) {
2515 @return = cpl_reload($word,$line,$pos);
2516 } elsif ($line =~ /^o\s/) {
2517 @return = cpl_option($word,$line,$pos);
2524 #-> sub CPAN::Complete::cplx ;
2526 my($class, $word) = @_;
2527 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
2530 #-> sub CPAN::Complete::cpl_any ;
2534 cplx('CPAN::Author',$word),
2535 cplx('CPAN::Bundle',$word),
2536 cplx('CPAN::Distribution',$word),
2537 cplx('CPAN::Module',$word),
2541 #-> sub CPAN::Complete::cpl_reload ;
2543 my($word,$line,$pos) = @_;
2545 my(@words) = split " ", $line;
2546 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2547 my(@ok) = qw(cpan index);
2548 return @ok if @words == 1;
2549 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
2552 #-> sub CPAN::Complete::cpl_option ;
2554 my($word,$line,$pos) = @_;
2556 my(@words) = split " ", $line;
2557 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
2558 my(@ok) = qw(conf debug);
2559 return @ok if @words == 1;
2560 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
2562 } elsif ($words[1] eq 'index') {
2564 } elsif ($words[1] eq 'conf') {
2565 return CPAN::Config::cpl(@_);
2566 } elsif ($words[1] eq 'debug') {
2567 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
2571 package CPAN::Index;
2573 #-> sub CPAN::Index::force_reload ;
2576 $CPAN::Index::last_time = 0;
2580 #-> sub CPAN::Index::reload ;
2582 my($cl,$force) = @_;
2585 # XXX check if a newer one is available. (We currently read it
2586 # from time to time)
2587 for ($CPAN::Config->{index_expire}) {
2588 $_ = 0.001 unless $_ && $_ > 0.001;
2590 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
2595 my $needshort = $^O eq "dos";
2597 $cl->rd_authindex($cl
2599 "authors/01mailrc.txt.gz",
2601 File::Spec->catfile('authors', '01mailrc.gz') :
2602 File::Spec->catfile('authors', '01mailrc.txt.gz'),
2605 $debug = "timing reading 01[".($t2 - $time)."]";
2607 return if $CPAN::Signal; # this is sometimes lengthy
2608 $cl->rd_modpacks($cl
2610 "modules/02packages.details.txt.gz",
2612 File::Spec->catfile('modules', '02packag.gz') :
2613 File::Spec->catfile('modules', '02packages.details.txt.gz'),
2616 $debug .= "02[".($t2 - $time)."]";
2618 return if $CPAN::Signal; # this is sometimes lengthy
2621 "modules/03modlist.data.gz",
2623 File::Spec->catfile('modules', '03mlist.gz') :
2624 File::Spec->catfile('modules', '03modlist.data.gz'),
2627 $debug .= "03[".($t2 - $time)."]";
2629 CPAN->debug($debug) if $CPAN::DEBUG;
2632 #-> sub CPAN::Index::reload_x ;
2634 my($cl,$wanted,$localname,$force) = @_;
2635 $force |= 2; # means we're dealing with an index here
2636 CPAN::Config->load; # we should guarantee loading wherever we rely
2638 $localname ||= $wanted;
2639 my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
2643 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
2646 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
2647 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
2648 qq{day$s. I\'ll use that.});
2651 $force |= 1; # means we're quite serious about it.
2653 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
2656 #-> sub CPAN::Index::rd_authindex ;
2658 my($cl, $index_target) = @_;
2660 return unless defined $index_target;
2661 $CPAN::Frontend->myprint("Going to read $index_target\n");
2662 # my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2663 # while ($_ = $fh->READLINE) {
2666 tie *FH, CPAN::Tarzip, $index_target;
2668 push @lines, split /\012/ while <FH>;
2670 my($userid,$fullname,$email) =
2671 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
2672 next unless $userid && $fullname && $email;
2674 # instantiate an author object
2675 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
2676 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
2677 return if $CPAN::Signal;
2682 my($self,$dist) = @_;
2683 $dist = $self->{'id'} unless defined $dist;
2684 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
2688 #-> sub CPAN::Index::rd_modpacks ;
2690 my($cl, $index_target) = @_;
2692 return unless defined $index_target;
2693 $CPAN::Frontend->myprint("Going to read $index_target\n");
2694 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2696 while ($_ = $fh->READLINE) {
2698 my @ls = map {"$_\n"} split /\n/, $_;
2699 unshift @ls, "\n" x length($1) if /^(\n+)/;
2703 my $shift = shift(@lines);
2704 last if $shift =~ /^\s*$/;
2708 my($mod,$version,$dist) = split;
2709 ### $version =~ s/^\+//;
2711 # if it is a bundle, instatiate a bundle object
2712 my($bundle,$id,$userid);
2714 if ($mod eq 'CPAN' &&
2716 CPAN::Queue->exists('Bundle::CPAN') ||
2717 CPAN::Queue->exists('CPAN')
2721 if ($version > $CPAN::VERSION){
2722 $CPAN::Frontend->myprint(qq{
2723 There\'s a new CPAN.pm version (v$version) available!
2724 You might want to try
2725 install Bundle::CPAN
2727 without quitting the current session. It should be a seamless upgrade
2728 while we are running...
2731 $CPAN::Frontend->myprint(qq{\n});
2733 last if $CPAN::Signal;
2734 } elsif ($mod =~ /^Bundle::(.*)/) {
2739 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
2740 # warn "made mod[$mod]a bundle";
2741 # Let's make it a module too, because bundles have so much
2742 # in common with modules
2743 $CPAN::META->instance('CPAN::Module',$mod);
2744 # warn "made mod[$mod]a module";
2746 # This "next" makes us faster but if the job is running long, we ignore
2747 # rereads which is bad. So we have to be a bit slower again.
2748 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
2753 # instantiate a module object
2754 $id = $CPAN::META->instance('CPAN::Module',$mod);
2757 if ($id->cpan_file ne $dist){
2758 $userid = $cl->userid($dist);
2760 'CPAN_USERID' => $userid,
2761 'CPAN_VERSION' => $version,
2762 'CPAN_FILE' => $dist
2766 # instantiate a distribution object
2767 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
2768 $CPAN::META->instance(
2769 'CPAN::Distribution' => $dist
2771 'CPAN_USERID' => $userid
2775 return if $CPAN::Signal;
2780 #-> sub CPAN::Index::rd_modlist ;
2782 my($cl,$index_target) = @_;
2783 return unless defined $index_target;
2784 $CPAN::Frontend->myprint("Going to read $index_target\n");
2785 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
2788 while ($_ = $fh->READLINE) {
2790 my @ls = map {"$_\n"} split /\n/, $_;
2791 unshift @ls, "\n" x length($1) if /^(\n+)/;
2795 my $shift = shift(@eval);
2796 if ($shift =~ /^Date:\s+(.*)/){
2797 return if $date_of_03 eq $1;
2800 last if $shift =~ /^\s*$/;
2803 push @eval, q{CPAN::Modulelist->data;};
2805 my($comp) = Safe->new("CPAN::Safe1");
2806 my($eval) = join("", @eval);
2807 my $ret = $comp->reval($eval);
2808 Carp::confess($@) if $@;
2809 return if $CPAN::Signal;
2811 my $obj = $CPAN::META->instance(CPAN::Module,$_);
2812 $obj->set(%{$ret->{$_}});
2813 return if $CPAN::Signal;
2817 package CPAN::InfoObj;
2819 #-> sub CPAN::InfoObj::new ;
2820 sub new { my $this = bless {}, shift; %$this = @_; $this }
2822 #-> sub CPAN::InfoObj::set ;
2824 my($self,%att) = @_;
2825 my(%oldatt) = %$self;
2826 %$self = (%oldatt, %att);
2829 #-> sub CPAN::InfoObj::id ;
2830 sub id { shift->{'ID'} }
2832 #-> sub CPAN::InfoObj::as_glimpse ;
2836 my $class = ref($self);
2837 $class =~ s/^CPAN:://;
2838 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2842 #-> sub CPAN::InfoObj::as_string ;
2846 my $class = ref($self);
2847 $class =~ s/^CPAN:://;
2848 push @m, $class, " id = $self->{ID}\n";
2849 for (sort keys %$self) {
2852 if ($_ eq "CPAN_USERID") {
2853 $extra .= " (".$self->author;
2854 my $email; # old perls!
2855 if ($email = $CPAN::META->instance(CPAN::Author,
2858 $extra .= " <$email>";
2860 $extra .= " <no email>";
2864 if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX
2865 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2867 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
2873 #-> sub CPAN::InfoObj::author ;
2876 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2881 require Data::Dumper;
2882 Data::Dumper::Dumper($self);
2885 package CPAN::Author;
2887 #-> sub CPAN::Author::as_glimpse ;
2891 my $class = ref($self);
2892 $class =~ s/^CPAN:://;
2893 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2897 # Dead code, I would have liked to have,,, but it was never reached,,,
2900 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
2903 #-> sub CPAN::Author::fullname ;
2904 sub fullname { shift->{'FULLNAME'} }
2907 #-> sub CPAN::Author::email ;
2908 sub email { shift->{'EMAIL'} }
2910 package CPAN::Distribution;
2912 #-> sub CPAN::Distribution::called_for ;
2915 $self->{'CALLED_FOR'} = $id if defined $id;
2916 return $self->{'CALLED_FOR'};
2919 #-> sub CPAN::Distribution::get ;
2924 exists $self->{'build_dir'} and push @e,
2925 "Unwrapped into directory $self->{'build_dir'}";
2926 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
2931 $CPAN::Config->{keep_source_where},
2934 split("/",$self->{ID})
2937 $self->debug("Doing localize") if $CPAN::DEBUG;
2939 CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
2940 or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
2941 $self->{localfile} = $local_file;
2942 my $builddir = $CPAN::META->{cachemgr}->dir;
2943 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2944 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2947 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2948 if ($CPAN::META->has_inst('MD5')) {
2949 $self->debug("MD5 is installed, verifying");
2952 $self->debug("MD5 is NOT installed");
2954 $self->debug("Removing tmp") if $CPAN::DEBUG;
2955 File::Path::rmtree("tmp");
2956 mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
2958 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2959 if (! $local_file) {
2960 Carp::croak "bad download, can't do anything :-(\n";
2961 } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
2962 $self->untar_me($local_file);
2963 } elsif ( $local_file =~ /\.zip$/i ) {
2964 $self->unzip_me($local_file);
2965 } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
2966 $self->pm2dir_me($local_file);
2968 $self->{archived} = "NO";
2970 chdir File::Spec->updir;
2971 if ($self->{archived} ne 'NO') {
2972 chdir File::Spec->catdir(File::Spec->curdir, "tmp");
2973 # Let's check if the package has its own directory.
2974 my $dh = DirHandle->new(File::Spec->curdir)
2975 or Carp::croak("Couldn't opendir .: $!");
2976 my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
2978 my ($distdir,$packagedir);
2979 if (@readdir == 1 && -d $readdir[0]) {
2980 $distdir = $readdir[0];
2981 $packagedir = MM->catdir($builddir,$distdir);
2982 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
2983 File::Path::rmtree($packagedir);
2984 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2986 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2987 $pragmatic_dir =~ s/\W_//g;
2988 $pragmatic_dir++ while -d "../$pragmatic_dir";
2989 $packagedir = MM->catdir($builddir,$pragmatic_dir);
2990 File::Path::mkpath($packagedir);
2992 for $f (@readdir) { # is already without "." and ".."
2993 my $to = MM->catdir($packagedir,$f);
2994 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2997 $self->{'build_dir'} = $packagedir;
2998 chdir File::Spec->updir;
3000 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
3002 File::Path::rmtree("tmp");
3003 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
3004 $CPAN::Frontend->myprint("Going to unlink $local_file\n");
3005 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
3007 my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
3008 unless (-f $makefilepl) {
3009 my($configure) = MM->catfile($packagedir,"Configure");
3010 if (-f $configure) {
3011 # do we have anything to do?
3012 $self->{'configure'} = $configure;
3013 } elsif (-f MM->catfile($packagedir,"Makefile")) {
3014 $CPAN::Frontend->myprint(qq{
3015 Package comes with a Makefile and without a Makefile.PL.
3016 We\'ll try to build it with that Makefile then.
3018 $self->{writemakefile} = "YES";
3021 my $fh = FileHandle->new(">$makefilepl")
3022 or Carp::croak("Could not open >$makefilepl");
3023 my $cf = $self->called_for || "unknown";
3025 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
3026 # because there was no Makefile.PL supplied.
3027 # Autogenerated on: }.scalar localtime().qq{
3029 use ExtUtils::MakeMaker;
3030 WriteMakefile(NAME => q[$cf]);
3033 $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
3034 Writing one on our own (calling it $cf)\n});
3042 my($self,$local_file) = @_;
3043 $self->{archived} = "tar";
3044 if (CPAN::Tarzip->untar($local_file)) {
3045 $self->{unwrapped} = "YES";
3047 $self->{unwrapped} = "NO";
3052 my($self,$local_file) = @_;
3053 $self->{archived} = "zip";
3054 my $system = "$CPAN::Config->{unzip} $local_file";
3055 if (system($system) == 0) {
3056 $self->{unwrapped} = "YES";
3058 $self->{unwrapped} = "NO";
3063 my($self,$local_file) = @_;
3064 $self->{archived} = "pm";
3065 my $to = File::Basename::basename($local_file);
3066 $to =~ s/\.(gz|Z)$//;
3067 if (CPAN::Tarzip->gunzip($local_file,$to)) {
3068 $self->{unwrapped} = "YES";
3070 $self->{unwrapped} = "NO";
3074 #-> sub CPAN::Distribution::new ;
3076 my($class,%att) = @_;
3078 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
3080 my $this = { %att };
3081 return bless $this, $class;
3084 #-> sub CPAN::Distribution::look ;
3088 if ($^O eq 'MacOS') {
3089 $self->ExtUtils::MM_MacOS::look;
3093 if ( $CPAN::Config->{'shell'} ) {
3094 $CPAN::Frontend->myprint(qq{
3095 Trying to open a subshell in the build directory...
3098 $CPAN::Frontend->myprint(qq{
3099 Your configuration does not define a value for subshells.
3100 Please define it with "o conf shell <your shell>"
3104 my $dist = $self->id;
3105 my $dir = $self->dir or $self->get;
3108 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3109 my $pwd = CPAN->$getcwd();
3111 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
3112 system($CPAN::Config->{'shell'}) == 0
3113 or $CPAN::Frontend->mydie("Subprocess shell error");
3117 #-> sub CPAN::Distribution::readme ;
3120 my($dist) = $self->id;
3121 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
3122 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
3126 $CPAN::Config->{keep_source_where},
3129 split("/","$sans.readme"),
3131 $self->debug("Doing localize") if $CPAN::DEBUG;
3132 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
3134 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
3136 if ($^O eq 'MacOS') {
3137 ExtUtils::MM_MacOS::launch_file($local_file);
3141 my $fh_pager = FileHandle->new;
3142 local($SIG{PIPE}) = "IGNORE";
3143 $fh_pager->open("|$CPAN::Config->{'pager'}")
3144 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
3145 my $fh_readme = FileHandle->new;
3146 $fh_readme->open($local_file)
3147 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
3148 $CPAN::Frontend->myprint(qq{
3151 with pager "$CPAN::Config->{'pager'}"
3154 $fh_pager->print(<$fh_readme>);
3157 #-> sub CPAN::Distribution::verifyMD5 ;
3162 $self->{MD5_STATUS} ||= "";
3163 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
3164 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3166 my($lc_want,$lc_file,@local,$basename);
3167 @local = split("/",$self->{ID});
3169 push @local, "CHECKSUMS";
3171 MM->catfile($CPAN::Config->{keep_source_where},
3172 "authors", "id", @local);
3177 $self->MD5_check_file($lc_want)
3179 return $self->{MD5_STATUS} = "OK";
3181 $lc_file = CPAN::FTP->localize("authors/id/@local",
3184 $local[-1] .= ".gz";
3185 $lc_file = CPAN::FTP->localize("authors/id/@local",
3188 $lc_file =~ s/\.gz$//;
3189 CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
3194 $self->MD5_check_file($lc_file);
3197 #-> sub CPAN::Distribution::MD5_check_file ;
3198 sub MD5_check_file {
3199 my($self,$chk_file) = @_;
3200 my($cksum,$file,$basename);
3201 $file = $self->{localfile};
3202 $basename = File::Basename::basename($file);
3203 my $fh = FileHandle->new;
3204 if (open $fh, $chk_file){
3207 $eval =~ s/\015?\012/\n/g;
3209 my($comp) = Safe->new();
3210 $cksum = $comp->reval($eval);
3212 rename $chk_file, "$chk_file.bad";
3213 Carp::confess($@) if $@;
3216 Carp::carp "Could not open $chk_file for reading";
3219 if (exists $cksum->{$basename}{md5}) {
3220 $self->debug("Found checksum for $basename:" .
3221 "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
3225 my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
3227 $fh = CPAN::Tarzip->TIEHANDLE($file);
3230 # had to inline it, when I tied it, the tiedness got lost on
3231 # the call to eq_MD5. (Jan 1998)
3235 while ($fh->READ($ref, 4096) > 0){
3238 my $hexdigest = $md5->hexdigest;
3239 $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
3243 $CPAN::Frontend->myprint("Checksum for $file ok\n");
3244 return $self->{MD5_STATUS} = "OK";
3246 $CPAN::Frontend->myprint(qq{Checksum mismatch for }.
3247 qq{distribution file. }.
3248 qq{Please investigate.\n\n}.
3250 $CPAN::META->instance(
3252 $self->{CPAN_USERID}
3254 my $wrap = qq{I\'d recommend removing $file. It seems to
3255 be a bogus file. Maybe you have configured your \`urllist\' with a
3256 bad URL. Please check this array with \`o conf urllist\', and
3258 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
3259 $CPAN::Frontend->myprint("\n\n");
3263 # close $fh if fileno($fh);
3265 $self->{MD5_STATUS} ||= "";
3266 if ($self->{MD5_STATUS} eq "NIL") {
3267 $CPAN::Frontend->myprint(qq{
3268 No md5 checksum for $basename in local $chk_file.
3271 unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
3274 $self->{MD5_STATUS} = "NIL";
3279 #-> sub CPAN::Distribution::eq_MD5 ;
3281 my($self,$fh,$expectMD5) = @_;
3284 while (read($fh, $data, 4096)){
3287 # $md5->addfile($fh);
3288 my $hexdigest = $md5->hexdigest;
3289 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
3290 $hexdigest eq $expectMD5;
3293 #-> sub CPAN::Distribution::force ;
3296 $self->{'force_update'}++;
3298 MD5_STATUS archived build_dir localfile make install unwrapped
3301 delete $self->{$att};
3307 my $file = File::Basename::basename($self->id);
3308 return unless $file =~ m{ ^ perl
3311 (\d{3}(_[0-4][0-9])?)
3318 #-> sub CPAN::Distribution::perl ;
3321 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
3322 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3323 my $pwd = CPAN->$getcwd();
3324 my $candidate = MM->catfile($pwd,$^X);
3325 $perl ||= $candidate if MM->maybe_command($candidate);
3327 my ($component,$perl_name);
3328 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
3329 PATH_COMPONENT: foreach $component (MM->path(),
3330 $Config::Config{'binexp'}) {
3331 next unless defined($component) && $component;
3332 my($abs) = MM->catfile($component,$perl_name);
3333 if (MM->maybe_command($abs)) {
3343 #-> sub CPAN::Distribution::make ;
3346 $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
3347 # Emergency brake if they said install Pippi and get newest perl
3348 if ($self->isa_perl) {
3350 $self->called_for ne $self->id && ! $self->{'force_update'}
3352 $CPAN::Frontend->mydie(sprintf qq{
3353 The most recent version "%s" of the module "%s"
3354 comes with the current version of perl (%s).
3355 I\'ll build that only if you ask for something like
3360 $CPAN::META->instance(
3373 $self->{archived} eq "NO" and push @e,
3374 "Is neither a tar nor a zip archive.";
3376 $self->{unwrapped} eq "NO" and push @e,
3377 "had problems unarchiving. Please build manually";
3379 exists $self->{writemakefile} &&
3380 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
3381 $1 || "Had some problem writing Makefile";
3383 defined $self->{'make'} and push @e,
3384 "Has already been processed within this session";
3386 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3388 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
3389 my $builddir = $self->dir;
3390 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
3391 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
3393 if ($^O eq 'MacOS') {
3394 ExtUtils::MM_MacOS::make($self);
3399 if ($self->{'configure'}) {
3400 $system = $self->{'configure'};
3402 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
3404 # This needs a handler that can be turned on or off:
3405 # $switch = "-MExtUtils::MakeMaker ".
3406 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
3408 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
3410 unless (exists $self->{writemakefile}) {
3411 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
3414 if ($CPAN::Config->{inactivity_timeout}) {
3416 alarm $CPAN::Config->{inactivity_timeout};
3417 local $SIG{CHLD}; # = sub { wait };
3418 if (defined($pid = fork)) {
3423 # note, this exec isn't necessary if
3424 # inactivity_timeout is 0. On the Mac I'd
3425 # suggest, we set it always to 0.
3429 $CPAN::Frontend->myprint("Cannot fork: $!");
3437 $CPAN::Frontend->myprint($@);
3438 $self->{writemakefile} = "NO $@";
3443 $ret = system($system);
3445 $self->{writemakefile} = "NO Makefile.PL returned status $ret";
3449 if (-f "Makefile") {
3450 $self->{writemakefile} = "YES";
3452 $self->{writemakefile} =
3453 qq{NO Makefile.PL refused to write a Makefile.};
3454 # It's probably worth to record the reason, so let's retry
3456 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
3457 # $self->{writemakefile} .= <$fh>;
3460 return if $CPAN::Signal;
3461 if (my @prereq = $self->needs_prereq){
3463 $CPAN::Frontend->myprint("---- Dependencies detected ".
3464 "during [$id] -----\n");
3466 for my $p (@prereq) {
3467 $CPAN::Frontend->myprint(" $p\n");
3470 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
3472 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
3473 require ExtUtils::MakeMaker;
3474 my $answer = ExtUtils::MakeMaker::prompt(
3475 "Shall I follow them and prepend them to the queue
3476 of modules we are processing right now?", "yes");
3477 $follow = $answer =~ /^\s*y/i;
3480 $CPAN::Frontend->myprint(" Ignoring dependencies on modules @prereq\n");
3483 CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
3487 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
3488 if (system($system) == 0) {
3489 $CPAN::Frontend->myprint(" $system -- OK\n");
3490 $self->{'make'} = "YES";
3492 $self->{writemakefile} ||= "YES";
3493 $self->{'make'} = "NO";
3494 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3498 #-> sub CPAN::Distribution::needs_prereq ;
3501 return unless -f "Makefile"; # we cannot say much
3502 my $fh = FileHandle->new("<Makefile") or
3503 $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
3508 last if /MakeMaker post_initialize section/;
3510 \s+PREREQ_PM\s+=>\s+(.+)
3513 # warn "Found prereq expr[$p]";
3515 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
3521 my $mo = $CPAN::META->instance("CPAN::Module",$p);
3522 next if $mo->uptodate;
3523 # it's not needed, so don't push it. We cannot omit this step, because
3524 # if 'force' is in effect, nobody else will check.
3525 if ($self->{have_sponsored}{$p}++){
3526 # We have already sponsored it and for some reason it's still
3527 # not available. So we do nothing. Or what should we do?
3528 # if we push it again, we have a potential infinite loop
3536 #-> sub CPAN::Distribution::test ;
3540 return if $CPAN::Signal;
3541 $CPAN::Frontend->myprint("Running make test\n");
3544 exists $self->{'make'} or push @e,
3545 "Make had some problems, maybe interrupted? Won't test";
3547 exists $self->{'make'} and
3548 $self->{'make'} eq 'NO' and
3549 push @e, "Oops, make had returned bad status";
3551 exists $self->{'build_dir'} or push @e, "Has no own directory";
3552 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3554 chdir $self->{'build_dir'} or
3555 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3556 $self->debug("Changed directory to $self->{'build_dir'}")
3559 if ($^O eq 'MacOS') {
3560 ExtUtils::MM_MacOS::make_test($self);
3564 my $system = join " ", $CPAN::Config->{'make'}, "test";
3565 if (system($system) == 0) {
3566 $CPAN::Frontend->myprint(" $system -- OK\n");
3567 $self->{'make_test'} = "YES";
3569 $self->{'make_test'} = "NO";
3570 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3574 #-> sub CPAN::Distribution::clean ;
3577 $CPAN::Frontend->myprint("Running make clean\n");
3580 exists $self->{'build_dir'} or push @e, "Has no own directory";
3581 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3583 chdir $self->{'build_dir'} or
3584 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3585 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
3587 if ($^O eq 'MacOS') {
3588 ExtUtils::MM_MacOS::make_clean($self);
3592 my $system = join " ", $CPAN::Config->{'make'}, "clean";
3593 if (system($system) == 0) {
3594 $CPAN::Frontend->myprint(" $system -- OK\n");
3597 # Hmmm, what to do if make clean failed?
3601 #-> sub CPAN::Distribution::install ;
3605 return if $CPAN::Signal;
3606 $CPAN::Frontend->myprint("Running make install\n");
3609 exists $self->{'build_dir'} or push @e, "Has no own directory";
3611 exists $self->{'make'} or push @e,
3612 "Make had some problems, maybe interrupted? Won't install";
3614 exists $self->{'make'} and
3615 $self->{'make'} eq 'NO' and
3616 push @e, "Oops, make had returned bad status";
3618 push @e, "make test had returned bad status, ".
3619 "won't install without force"
3620 if exists $self->{'make_test'} and
3621 $self->{'make_test'} eq 'NO' and
3622 ! $self->{'force_update'};
3624 exists $self->{'install'} and push @e,
3625 $self->{'install'} eq "YES" ?
3626 "Already done" : "Already tried without success";
3628 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
3630 chdir $self->{'build_dir'} or
3631 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
3632 $self->debug("Changed directory to $self->{'build_dir'}")
3635 if ($^O eq 'MacOS') {
3636 ExtUtils::MM_MacOS::make_install($self);
3640 my $system = join(" ", $CPAN::Config->{'make'},
3641 "install", $CPAN::Config->{make_install_arg});
3642 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
3643 my($pipe) = FileHandle->new("$system $stderr |");
3646 $CPAN::Frontend->myprint($_);
3651 $CPAN::Frontend->myprint(" $system -- OK\n");
3652 return $self->{'install'} = "YES";
3654 $self->{'install'} = "NO";
3655 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
3656 if ($makeout =~ /permission/s && $> > 0) {
3657 $CPAN::Frontend->myprint(qq{ You may have to su }.
3658 qq{to root to install the package\n});
3663 #-> sub CPAN::Distribution::dir ;
3665 shift->{'build_dir'};
3668 package CPAN::Bundle;
3670 #-> sub CPAN::Bundle::as_string ;
3674 $self->{INST_VERSION} = $self->inst_version;
3675 return $self->SUPER::as_string;
3678 #-> sub CPAN::Bundle::contains ;
3681 my($parsefile) = $self->inst_file;
3682 my($id) = $self->id;
3683 $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
3684 unless ($parsefile) {
3685 # Try to get at it in the cpan directory
3686 $self->debug("no parsefile") if $CPAN::DEBUG;
3687 Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
3688 my $dist = $CPAN::META->instance('CPAN::Distribution',
3689 $self->{CPAN_FILE});
3691 $self->debug($dist->as_string) if $CPAN::DEBUG;
3692 my($todir) = $CPAN::Config->{'cpan_home'};
3693 my(@me,$from,$to,$me);
3694 @me = split /::/, $self->id;
3696 $me = MM->catfile(@me);
3697 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
3698 $to = MM->catfile($todir,$me);
3699 File::Path::mkpath(File::Basename::dirname($to));
3700 File::Copy::copy($from, $to)
3701 or Carp::confess("Couldn't copy $from to $to: $!");
3705 my $fh = FileHandle->new;
3707 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
3709 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
3711 $inpod = m/^=(?!head1\s+CONTENTS)/ ? 0 :
3712 m/^=head1\s+CONTENTS/ ? 1 : $inpod;
3717 push @result, (split " ", $_, 2)[0];
3720 delete $self->{STATUS};
3721 $self->{CONTAINS} = join ", ", @result;
3722 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
3724 $CPAN::Frontend->mywarn(qq{
3725 The bundle file "$parsefile" may be a broken
3726 bundlefile. It seems not to contain any bundle definition.
3727 Please check the file and if it is bogus, please delete it.
3728 Sorry for the inconvenience.
3734 #-> sub CPAN::Bundle::find_bundle_file
3735 sub find_bundle_file {
3736 my($self,$where,$what) = @_;
3737 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
3738 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
3739 ### my $bu = MM->catfile($where,$what);
3740 ### return $bu if -f $bu;
3741 my $manifest = MM->catfile($where,"MANIFEST");
3742 unless (-f $manifest) {
3743 require ExtUtils::Manifest;
3744 my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
3745 my $cwd = CPAN->$getcwd();
3747 ExtUtils::Manifest::mkmanifest();
3750 my $fh = FileHandle->new($manifest)
3751 or Carp::croak("Couldn't open $manifest: $!");
3754 if ($^O eq 'MacOS') {
3757 $what2 =~ s/:Bundle://;
3760 $what2 =~ s|Bundle/||;
3765 my($file) = /(\S+)/;
3766 if ($file =~ m|\Q$what\E$|) {
3768 # return MM->catfile($where,$bu); # bad
3771 # retry if she managed to
3772 # have no Bundle directory
3773 $bu = $file if $file =~ m|\Q$what2\E$|;
3775 $bu =~ tr|/|:| if $^O eq 'MacOS';
3776 return MM->catfile($where, $bu) if $bu;
3777 Carp::croak("Couldn't find a Bundle file in $where");
3780 #-> sub CPAN::Bundle::inst_file ;
3784 ($me = $self->id) =~ s/.*://;
3785 ## my(@me,$inst_file);
3786 ## @me = split /::/, $self->id;
3787 ## $me[-1] .= ".pm";
3788 $inst_file = MM->catfile($CPAN::Config->{'cpan_home'},
3789 "Bundle", "$me.pm");
3791 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
3793 $self->SUPER::inst_file;
3794 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
3795 # return $self->{'INST_FILE'}; # even if undefined?
3798 #-> sub CPAN::Bundle::rematein ;
3800 my($self,$meth) = @_;
3801 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
3802 my($id) = $self->id;
3803 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
3804 unless $self->inst_file || $self->{CPAN_FILE};
3806 for $s ($self->contains) {
3807 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
3808 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
3809 if ($type eq 'CPAN::Distribution') {
3810 $CPAN::Frontend->mywarn(qq{
3811 The Bundle }.$self->id.qq{ contains
3812 explicitly a file $s.
3816 # possibly noisy action:
3817 my $obj = $CPAN::META->instance($type,$s);
3819 my $success = $obj->can("uptodate") ? $obj->uptodate : 0;
3820 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
3821 $fail{$s} = 1 unless $success;
3823 # recap with less noise
3824 if ( $meth eq "install") {
3826 $CPAN::Frontend->myprint(qq{\nBundle summary: }.
3827 qq{The following items seem to }.
3828 qq{have had installation problems:\n});
3829 for $s ($self->contains) {
3830 $CPAN::Frontend->myprint( "$s " ) if $fail{$s};
3832 $CPAN::Frontend->myprint(qq{\n});
3834 $self->{'install'} = 'YES';
3839 #sub CPAN::Bundle::xs_file
3841 # If a bundle contains another that contains an xs_file we have
3842 # here, we just don't bother I suppose
3846 #-> sub CPAN::Bundle::force ;
3847 sub force { shift->rematein('force',@_); }
3848 #-> sub CPAN::Bundle::get ;
3849 sub get { shift->rematein('get',@_); }
3850 #-> sub CPAN::Bundle::make ;
3851 sub make { shift->rematein('make',@_); }
3852 #-> sub CPAN::Bundle::test ;
3853 sub test { shift->rematein('test',@_); }
3854 #-> sub CPAN::Bundle::install ;
3857 $self->rematein('install',@_);
3859 #-> sub CPAN::Bundle::clean ;
3860 sub clean { shift->rematein('clean',@_); }
3862 #-> sub CPAN::Bundle::readme ;
3865 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
3866 No File found for bundle } . $self->id . qq{\n}), return;
3867 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
3868 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
3871 package CPAN::Module;
3873 #-> sub CPAN::Module::as_glimpse ;
3877 my $class = ref($self);
3878 $class =~ s/^CPAN:://;
3879 push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
3884 #-> sub CPAN::Module::as_string ;
3888 CPAN->debug($self) if $CPAN::DEBUG;
3889 my $class = ref($self);
3890 $class =~ s/^CPAN:://;
3892 push @m, $class, " id = $self->{ID}\n";
3893 my $sprintf = " %-12s %s\n";
3894 push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description})
3895 if $self->{description};
3896 my $sprintf2 = " %-12s %s (%s)\n";
3898 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
3900 if ($author = CPAN::Shell->expand('Author',$userid)) {
3903 if ($m = $author->email) {
3910 $author->fullname . $email
3914 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
3915 if $self->{CPAN_VERSION};
3916 push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
3917 if $self->{CPAN_FILE};
3918 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
3919 my(%statd,%stats,%statl,%stati);
3920 @statd{qw,? i c a b R M S,} = qw,unknown idea
3921 pre-alpha alpha beta released mature standard,;
3922 @stats{qw,? m d u n,} = qw,unknown mailing-list
3923 developer comp.lang.perl.* none,;
3924 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
3925 @stati{qw,? f r O h,} = qw,unknown functions
3926 references+ties object-oriented hybrid,;
3927 $statd{' '} = 'unknown';
3928 $stats{' '} = 'unknown';
3929 $statl{' '} = 'unknown';
3930 $stati{' '} = 'unknown';
3938 $statd{$self->{statd}},
3939 $stats{$self->{stats}},
3940 $statl{$self->{statl}},
3941 $stati{$self->{stati}}
3942 ) if $self->{statd};
3943 my $local_file = $self->inst_file;
3945 $self->{MANPAGE} ||= $self->manpage_headline($local_file);
3948 for $item (qw/MANPAGE CONTAINS/) {
3949 push @m, sprintf($sprintf, $item, $self->{$item})
3950 if exists $self->{$item};
3952 push @m, sprintf($sprintf, 'INST_FILE',
3953 $local_file || "(not installed)");
3954 push @m, sprintf($sprintf, 'INST_VERSION',
3955 $self->inst_version) if $local_file;
3959 sub manpage_headline {
3960 my($self,$local_file) = @_;
3961 my(@local_file) = $local_file;
3962 $local_file =~ s/\.pm$/.pod/;
3963 push @local_file, $local_file;
3965 for $locf (@local_file) {
3966 next unless -f $locf;
3967 my $fh = FileHandle->new($locf)
3968 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
3972 $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
3973 m/^=head1\s+NAME/ ? 1 : $inpod;
3986 #-> sub CPAN::Module::cpan_file ;
3989 CPAN->debug($self->id) if $CPAN::DEBUG;
3990 unless (defined $self->{'CPAN_FILE'}) {
3991 CPAN::Index->reload;
3993 if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){
3994 return $self->{'CPAN_FILE'};
3995 } elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
3996 my $fullname = $CPAN::META->instance(CPAN::Author,
3997 $self->{'userid'})->fullname;
3998 my $email = $CPAN::META->instance(CPAN::Author,
3999 $self->{'userid'})->email;
4000 unless (defined $fullname && defined $email) {
4001 return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
4003 return "Contact Author $fullname <$email>";
4009 *name = \&cpan_file;
4011 #-> sub CPAN::Module::cpan_version ;
4014 $self->{'CPAN_VERSION'} = 'undef'
4015 unless defined $self->{'CPAN_VERSION'}; # I believe this is
4016 # always a bug in the
4017 # index and should be
4019 # but usually I find
4021 # and do not want to
4024 $self->{'CPAN_VERSION'};
4027 #-> sub CPAN::Module::force ;
4030 $self->{'force_update'}++;
4033 #-> sub CPAN::Module::rematein ;
4035 my($self,$meth) = @_;
4036 $self->debug($self->id) if $CPAN::DEBUG;
4037 my $cpan_file = $self->cpan_file;
4038 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
4039 $CPAN::Frontend->mywarn(sprintf qq{
4040 The module %s isn\'t available on CPAN.
4042 Either the module has not yet been uploaded to CPAN, or it is
4043 temporary unavailable. Please contact the author to find out
4044 more about the status. Try ``i %s''.
4051 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
4052 $pack->called_for($self->id);
4053 $pack->force if exists $self->{'force_update'};
4055 delete $self->{'force_update'};
4058 #-> sub CPAN::Module::readme ;
4059 sub readme { shift->rematein('readme') }
4060 #-> sub CPAN::Module::look ;
4061 sub look { shift->rematein('look') }
4062 #-> sub CPAN::Module::get ;
4063 sub get { shift->rematein('get',@_); }
4064 #-> sub CPAN::Module::make ;
4065 sub make { shift->rematein('make') }
4066 #-> sub CPAN::Module::test ;
4067 sub test { shift->rematein('test') }
4068 #-> sub CPAN::Module::uptodate ;
4071 my($latest) = $self->cpan_version;
4073 my($inst_file) = $self->inst_file;
4075 if (defined $inst_file) {
4076 $have = $self->inst_version;
4087 #-> sub CPAN::Module::install ;
4093 not exists $self->{'force_update'}
4095 $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
4099 $self->rematein('install') if $doit;
4101 #-> sub CPAN::Module::clean ;
4102 sub clean { shift->rematein('clean') }
4104 #-> sub CPAN::Module::inst_file ;
4108 @packpath = split /::/, $self->{ID};
4109 $packpath[-1] .= ".pm";
4110 foreach $dir (@INC) {
4111 my $pmfile = MM->catfile($dir,@packpath);
4119 #-> sub CPAN::Module::xs_file ;
4123 @packpath = split /::/, $self->{ID};
4124 push @packpath, $packpath[-1];
4125 $packpath[-1] .= "." . $Config::Config{'dlext'};
4126 foreach $dir (@INC) {
4127 my $xsfile = MM->catfile($dir,'auto',@packpath);
4135 #-> sub CPAN::Module::inst_version ;
4138 my $parsefile = $self->inst_file or return;
4139 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
4141 my $have = MM->parse_version($parsefile) || "undef";
4146 package CPAN::Tarzip;
4149 my($class,$read,$write) = @_;
4150 if ($CPAN::META->has_inst("Compress::Zlib")) {
4152 $fhw = FileHandle->new($read)
4153 or $CPAN::Frontend->mydie("Could not open $read: $!");
4154 my $gz = Compress::Zlib::gzopen($write, "wb")
4155 or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
4156 $gz->gzwrite($buffer)
4157 while read($fhw,$buffer,4096) > 0 ;
4162 system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
4167 my($class,$read,$write) = @_;
4168 if ($CPAN::META->has_inst("Compress::Zlib")) {
4170 $fhw = FileHandle->new(">$write")
4171 or $CPAN::Frontend->mydie("Could not open >$write: $!");
4172 my $gz = Compress::Zlib::gzopen($read, "rb")
4173 or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
4174 $fhw->print($buffer)
4175 while $gz->gzread($buffer) > 0 ;
4176 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
4177 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
4182 system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
4187 my($class,$read) = @_;
4188 if ($CPAN::META->has_inst("Compress::Zlib")) {
4190 my $gz = Compress::Zlib::gzopen($read, "rb")
4191 or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
4192 1 while $gz->gzread($buffer) > 0 ;
4193 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
4194 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
4198 return system("$CPAN::Config->{'gzip'} -dt $read")==0;
4203 my($class,$file) = @_;
4205 $class->debug("file[$file]");
4206 if ($CPAN::META->has_inst("Compress::Zlib")) {
4207 my $gz = Compress::Zlib::gzopen($file,"rb") or
4208 die "Could not gzopen $file";
4209 $ret = bless {GZ => $gz}, $class;
4211 my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |";
4212 my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
4214 $ret = bless {FH => $fh}, $class;
4221 if (exists $self->{GZ}) {
4222 my $gz = $self->{GZ};
4223 my($line,$bytesread);
4224 $bytesread = $gz->gzreadline($line);
4225 return undef if $bytesread <= 0;
4228 my $fh = $self->{FH};
4229 return scalar <$fh>;
4234 my($self,$ref,$length,$offset) = @_;
4235 die "read with offset not implemented" if defined $offset;
4236 if (exists $self->{GZ}) {
4237 my $gz = $self->{GZ};
4238 my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
4241 my $fh = $self->{FH};
4242 return read($fh,$$ref,$length);
4248 if (exists $self->{GZ}) {
4249 my $gz = $self->{GZ};
4252 my $fh = $self->{FH};
4259 my($class,$file) = @_;
4260 # had to disable, because version 0.07 seems to be buggy
4261 if (MM->maybe_command($CPAN::Config->{'gzip'})
4263 MM->maybe_command($CPAN::Config->{'tar'})) {
4264 if ($^O =~ /win/i) { # irgggh
4265 # people find the most curious tar binaries that cannot handle
4267 my $system = "$CPAN::Config->{'gzip'} --decompress $file";
4268 if (system($system)==0) {
4269 $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
4271 $CPAN::Frontend->mydie(
4272 qq{Couldn\'t uncompress $file\n}
4276 $system = "$CPAN::Config->{tar} xvf $file";
4277 if (system($system)==0) {
4278 $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
4280 $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
4284 my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
4285 "< $file | $CPAN::Config->{tar} xvf -";
4286 return system($system) == 0;
4288 } elsif ($CPAN::META->has_inst("Archive::Tar")
4290 $CPAN::META->has_inst("Compress::Zlib") ) {
4291 my $tar = Archive::Tar->new($file,1);
4292 $tar->extract($tar->list_files); # I'm pretty sure we have nothing
4293 # that isn't compressed
4295 ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
4296 if ($^O eq 'MacOS');
4300 $CPAN::Frontend->mydie(qq{
4301 CPAN.pm needs either both external programs tar and gzip installed or
4302 both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
4303 is available. Can\'t continue.
4316 CPAN - query, download and build perl modules from CPAN sites
4322 perl -MCPAN -e shell;
4328 autobundle, clean, install, make, recompile, test
4332 The CPAN module is designed to automate the make and install of perl
4333 modules and extensions. It includes some searching capabilities and
4334 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
4335 to fetch the raw data from the net.
4337 Modules are fetched from one or more of the mirrored CPAN
4338 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
4341 The CPAN module also supports the concept of named and versioned
4342 'bundles' of modules. Bundles simplify the handling of sets of
4343 related modules. See BUNDLES below.
4345 The package contains a session manager and a cache manager. There is
4346 no status retained between sessions. The session manager keeps track
4347 of what has been fetched, built and installed in the current
4348 session. The cache manager keeps track of the disk space occupied by
4349 the make processes and deletes excess space according to a simple FIFO
4352 For extended searching capabilities there's a plugin for CPAN available,
4353 L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
4354 all documents available in CPAN authors directories. If C<CPAN::WAIT>
4355 is installed on your system, the interactive shell of <CPAN.pm> will
4356 enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands which send
4357 queries to the WAIT server that has been configured for your
4360 All other methods provided are accessible in a programmer style and in an
4361 interactive shell style.
4363 =head2 Interactive Mode
4365 The interactive mode is entered by running
4367 perl -MCPAN -e shell
4369 which puts you into a readline interface. You will have the most fun if
4370 you install Term::ReadKey and Term::ReadLine to enjoy both history and
4373 Once you are on the command line, type 'h' and the rest should be
4376 The most common uses of the interactive modes are
4380 =item Searching for authors, bundles, distribution files and modules
4382 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
4383 for each of the four categories and another, C<i> for any of the
4384 mentioned four. Each of the four entities is implemented as a class
4385 with slightly differing methods for displaying an object.
4387 Arguments you pass to these commands are either strings exactly matching
4388 the identification string of an object or regular expressions that are
4389 then matched case-insensitively against various attributes of the
4390 objects. The parser recognizes a regular expression only if you
4391 enclose it between two slashes.
4393 The principle is that the number of found objects influences how an
4394 item is displayed. If the search finds one item, the result is displayed
4395 as object-E<gt>as_string, but if we find more than one, we display
4396 each as object-E<gt>as_glimpse. E.g.
4400 EMAIL a.koenig@franz.ww.TU-Berlin.DE
4401 FULLNAME Andreas König
4406 EMAIL a.koenig@franz.ww.TU-Berlin.DE
4407 FULLNAME Andreas König
4411 Author ANDYD (Andy Dougherty)
4412 Author MERLYN (Randal L. Schwartz)
4414 =item make, test, install, clean modules or distributions
4416 These commands take any number of arguments and investigates what is
4417 necessary to perform the action. If the argument is a distribution
4418 file name (recognized by embedded slashes), it is processed. If it is
4419 a module, CPAN determines the distribution file in which this module
4420 is included and processes that, following any dependencies named in
4421 the module's Makefile.PL (this behavior is controlled by
4422 I<prerequisites_policy>.)
4424 Any C<make> or C<test> are run unconditionally. An
4426 install <distribution_file>
4428 also is run unconditionally. But for
4432 CPAN checks if an install is actually needed for it and prints
4433 I<module up to date> in the case that the distribution file containing
4434 the module doesnE<39>t need to be updated.
4436 CPAN also keeps track of what it has done within the current session
4437 and doesnE<39>t try to build a package a second time regardless if it
4438 succeeded or not. The C<force> command takes as a first argument the
4439 method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
4440 command from scratch.
4444 cpan> install OpenGL
4445 OpenGL is up to date.
4446 cpan> force install OpenGL
4449 OpenGL-0.4/COPYRIGHT
4452 A C<clean> command results in a
4456 being executed within the distribution file's working directory.
4458 =item readme, look module or distribution
4460 These two commands take only one argument, be it a module or a
4461 distribution file. C<readme> unconditionally runs, displaying the
4462 README of the associated distribution file. C<Look> gets and
4463 untars (if not yet done) the distribution file, changes to the
4464 appropriate directory and opens a subshell process in that directory.
4468 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
4469 in the cpan-shell it is intended that you can press C<^C> anytime and
4470 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
4471 to clean up and leave the shell loop. You can emulate the effect of a
4472 SIGTERM by sending two consecutive SIGINTs, which usually means by
4473 pressing C<^C> twice.
4475 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
4476 SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
4482 The commands that are available in the shell interface are methods in
4483 the package CPAN::Shell. If you enter the shell command, all your
4484 input is split by the Text::ParseWords::shellwords() routine which
4485 acts like most shells do. The first word is being interpreted as the
4486 method to be called and the rest of the words are treated as arguments
4487 to this method. Continuation lines are supported if a line ends with a
4492 C<autobundle> writes a bundle file into the
4493 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
4494 a list of all modules that are both available from CPAN and currently
4495 installed within @INC. The name of the bundle file is based on the
4496 current date and a counter.
4500 recompile() is a very special command in that it takes no argument and
4501 runs the make/test/install cycle with brute force over all installed
4502 dynamically loadable extensions (aka XS modules) with 'force' in
4503 effect. The primary purpose of this command is to finish a network
4504 installation. Imagine, you have a common source tree for two different
4505 architectures. You decide to do a completely independent fresh
4506 installation. You start on one architecture with the help of a Bundle
4507 file produced earlier. CPAN installs the whole Bundle for you, but
4508 when you try to repeat the job on the second architecture, CPAN
4509 responds with a C<"Foo up to date"> message for all modules. So you
4510 invoke CPAN's recompile on the second architecture and youE<39>re done.
4512 Another popular use for C<recompile> is to act as a rescue in case your
4513 perl breaks binary compatibility. If one of the modules that CPAN uses
4514 is in turn depending on binary compatibility (so you cannot run CPAN
4515 commands), then you should try the CPAN::Nox module for recovery.
4517 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
4519 Although it may be considered internal, the class hierarchy does matter
4520 for both users and programmer. CPAN.pm deals with above mentioned four
4521 classes, and all those classes share a set of methods. A classical
4522 single polymorphism is in effect. A metaclass object registers all
4523 objects of all kinds and indexes them with a string. The strings
4524 referencing objects have a separated namespace (well, not completely
4529 words containing a "/" (slash) Distribution
4530 words starting with Bundle:: Bundle
4531 everything else Module or Author
4533 Modules know their associated Distribution objects. They always refer
4534 to the most recent official release. Developers may mark their releases
4535 as unstable development versions (by inserting an underbar into the
4536 visible version number), so the really hottest and newest distribution
4537 file is not always the default. If a module Foo circulates on CPAN in
4538 both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
4539 install version 1.23 by saying
4543 This would install the complete distribution file (say
4544 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
4545 like to install version 1.23_90, you need to know where the
4546 distribution file resides on CPAN relative to the authors/id/
4547 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
4548 so you would have to say
4550 install BAR/Foo-1.23_90.tar.gz
4552 The first example will be driven by an object of the class
4553 CPAN::Module, the second by an object of class CPAN::Distribution.
4555 =head2 ProgrammerE<39>s interface
4557 If you do not enter the shell, the available shell commands are both
4558 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
4559 functions in the calling package (C<install(...)>).
4561 There's currently only one class that has a stable interface -
4562 CPAN::Shell. All commands that are available in the CPAN shell are
4563 methods of the class CPAN::Shell. Each of the commands that produce
4564 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
4565 the IDs of all modules within the list.
4569 =item expand($type,@things)
4571 The IDs of all objects available within a program are strings that can
4572 be expanded to the corresponding real objects with the
4573 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
4574 list of CPAN::Module objects according to the C<@things> arguments
4575 given. In scalar context it only returns the first element of the
4578 =item Programming Examples
4580 This enables the programmer to do operations that combine
4581 functionalities that are available in the shell.
4583 # install everything that is outdated on my disk:
4584 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
4586 # install my favorite programs if necessary:
4587 for $mod (qw(Net::FTP MD5 Data::Dumper)){
4588 my $obj = CPAN::Shell->expand('Module',$mod);
4592 # list all modules on my disk that have no VERSION number
4593 for $mod (CPAN::Shell->expand("Module","/./")){
4594 next unless $mod->inst_file;
4595 # MakeMaker convention for undefined $VERSION:
4596 next unless $mod->inst_version eq "undef";
4597 print "No VERSION in ", $mod->id, "\n";
4600 Or if you want to write a cronjob to watch The CPAN, you could list
4601 all modules that need updating:
4603 perl -e 'use CPAN; CPAN::Shell->r;'
4605 If you don't want to get any output if all modules are up to date, you
4606 can parse the output of above command for the regular expression
4607 //modules are up to date// and decide to mail the output only if it
4610 If you prefer to do it more in a programmer style in one single
4611 process, maybe something like this suites you better:
4613 # list all modules on my disk that have newer versions on CPAN
4614 for $mod (CPAN::Shell->expand("Module","/./")){
4615 next unless $mod->inst_file;
4616 next if $mod->uptodate;
4617 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
4618 $mod->id, $mod->inst_version, $mod->cpan_version;
4621 If that gives you too much output every day, you maybe only want to
4622 watch for three modules. You can write
4624 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
4626 as the first line instead. Or you can combine some of the above
4629 # watch only for a new mod_perl module
4630 $mod = CPAN::Shell->expand("Module","mod_perl");
4631 exit if $mod->uptodate;
4632 # new mod_perl arrived, let me know all update recommendations
4637 =head2 Methods in the four Classes
4639 =head2 Cache Manager
4641 Currently the cache manager only keeps track of the build directory
4642 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
4643 deletes complete directories below C<build_dir> as soon as the size of
4644 all directories there gets bigger than $CPAN::Config->{build_cache}
4645 (in MB). The contents of this cache may be used for later
4646 re-installations that you intend to do manually, but will never be
4647 trusted by CPAN itself. This is due to the fact that the user might
4648 use these directories for building modules on different architectures.
4650 There is another directory ($CPAN::Config->{keep_source_where}) where
4651 the original distribution files are kept. This directory is not
4652 covered by the cache manager and must be controlled by the user. If
4653 you choose to have the same directory as build_dir and as
4654 keep_source_where directory, then your sources will be deleted with
4655 the same fifo mechanism.
4659 A bundle is just a perl module in the namespace Bundle:: that does not
4660 define any functions or methods. It usually only contains documentation.
4662 It starts like a perl module with a package declaration and a $VERSION
4663 variable. After that the pod section looks like any other pod with the
4664 only difference being that I<one special pod section> exists starting with
4669 In this pod section each line obeys the format
4671 Module_Name [Version_String] [- optional text]
4673 The only required part is the first field, the name of a module
4674 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
4675 of the line is optional. The comment part is delimited by a dash just
4676 as in the man page header.
4678 The distribution of a bundle should follow the same convention as
4679 other distributions.
4681 Bundles are treated specially in the CPAN package. If you say 'install
4682 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
4683 the modules in the CONTENTS section of the pod. You can install your
4684 own Bundles locally by placing a conformant Bundle file somewhere into
4685 your @INC path. The autobundle() command which is available in the
4686 shell interface does that for you by including all currently installed
4687 modules in a snapshot bundle file.
4689 =head2 Prerequisites
4691 If you have a local mirror of CPAN and can access all files with
4692 "file:" URLs, then you only need a perl better than perl5.003 to run
4693 this module. Otherwise Net::FTP is strongly recommended. LWP may be
4694 required for non-UNIX systems or if your nearest CPAN site is
4695 associated with an URL that is not C<ftp:>.
4697 If you have neither Net::FTP nor LWP, there is a fallback mechanism
4698 implemented for an external ftp command or for an external lynx
4701 =head2 Finding packages and VERSION
4703 This module presumes that all packages on CPAN
4709 declare their $VERSION variable in an easy to parse manner. This
4710 prerequisite can hardly be relaxed because it consumes far too much
4711 memory to load all packages into the running program just to determine
4712 the $VERSION variable. Currently all programs that are dealing with
4713 version use something like this
4715 perl -MExtUtils::MakeMaker -le \
4716 'print MM->parse_version(shift)' filename
4718 If you are author of a package and wonder if your $VERSION can be
4719 parsed, please try the above method.
4723 come as compressed or gzipped tarfiles or as zip files and contain a
4724 Makefile.PL (well, we try to handle a bit more, but without much
4731 The debugging of this module is pretty difficult, because we have
4732 interferences of the software producing the indices on CPAN, of the
4733 mirroring process on CPAN, of packaging, of configuration, of
4734 synchronicity, and of bugs within CPAN.pm.
4736 In interactive mode you can try "o debug" which will list options for
4737 debugging the various parts of the package. The output may not be very
4738 useful for you as it's just a by-product of my own testing, but if you
4739 have an idea which part of the package may have a bug, it's sometimes
4740 worth to give it a try and send me more specific output. You should
4741 know that "o debug" has built-in completion support.
4743 =head2 Floppy, Zip, Offline Mode
4745 CPAN.pm works nicely without network too. If you maintain machines
4746 that are not networked at all, you should consider working with file:
4747 URLs. Of course, you have to collect your modules somewhere first. So
4748 you might use CPAN.pm to put together all you need on a networked
4749 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
4750 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
4751 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
4752 with this floppy. See also below the paragraph about CD-ROM support.
4754 =head1 CONFIGURATION
4756 When the CPAN module is installed, a site wide configuration file is
4757 created as CPAN/Config.pm. The default values defined there can be
4758 overridden in another configuration file: CPAN/MyConfig.pm. You can
4759 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
4760 $HOME/.cpan is added to the search path of the CPAN module before the
4761 use() or require() statements.
4763 Currently the following keys in the hash reference $CPAN::Config are
4766 build_cache size of cache for directories to build modules
4767 build_dir locally accessible directory to build modules
4768 index_expire after this many days refetch index files
4769 cpan_home local directory reserved for this package
4770 gzip location of external program gzip
4771 inactivity_timeout breaks interactive Makefile.PLs after this
4772 many seconds inactivity. Set to 0 to never break.
4773 inhibit_startup_message
4774 if true, does not print the startup message
4775 keep_source_where directory in which to keep the source (if we do)
4776 make location of external make program
4777 make_arg arguments that should always be passed to 'make'
4778 make_install_arg same as make_arg for 'make install'
4779 makepl_arg arguments passed to 'perl Makefile.PL'
4780 pager location of external program more (or any pager)
4781 prerequisites_policy
4782 what to do if you are missing module prerequisites
4783 ('follow' automatically, 'ask' me, or 'ignore')
4784 scan_cache controls scanning of cache ('atstart' or 'never')
4785 tar location of external program tar
4786 unzip location of external program unzip
4787 urllist arrayref to nearby CPAN sites (or equivalent locations)
4788 wait_list arrayref to a wait server to try (See CPAN::WAIT)
4789 ftp_proxy, } the three usual variables for configuring
4790 http_proxy, } proxy requests. Both as CPAN::Config variables
4791 no_proxy } and as environment variables configurable.
4793 You can set and query each of these options interactively in the cpan
4794 shell with the command set defined within the C<o conf> command:
4798 =item o conf E<lt>scalar optionE<gt>
4800 prints the current value of the I<scalar option>
4802 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
4804 Sets the value of the I<scalar option> to I<value>
4806 =item o conf E<lt>list optionE<gt>
4808 prints the current value of the I<list option> in MakeMaker's
4811 =item o conf E<lt>list optionE<gt> [shift|pop]
4813 shifts or pops the array in the I<list option> variable
4815 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
4817 works like the corresponding perl commands.
4821 =head2 Note on urllist parameter's format
4823 urllist parameters are URLs according to RFC 1738. We do a little
4824 guessing if your URL is not compliant, but if you have problems with file URLs, please try the correct format. Either:
4826 file://localhost/whatever/ftp/pub/CPAN/
4830 file:///home/ftp/pub/CPAN/
4832 =head2 urllist parameter has CD-ROM support
4834 The C<urllist> parameter of the configuration table contains a list of
4835 URLs that are to be used for downloading. If the list contains any
4836 C<file> URLs, CPAN always tries to get files from there first. This
4837 feature is disabled for index files. So the recommendation for the
4838 owner of a CD-ROM with CPAN contents is: include your local, possibly
4839 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
4841 o conf urllist push file://localhost/CDROM/CPAN
4843 CPAN.pm will then fetch the index files from one of the CPAN sites
4844 that come at the beginning of urllist. It will later check for each
4845 module if there is a local copy of the most recent version.
4847 Another peculiarity of urllist is that the site that we could
4848 successfully fetch the last file from automatically gets a preference
4849 token and is tried as the first site for the next request. So if you
4850 add a new site at runtime it may happen that the previously preferred
4851 site will be tried another time. This means that if you want to disallow
4852 a site for the next transfer, it must be explicitly removed from
4857 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
4858 install foreign, unmasked, unsigned code on your machine. We compare
4859 to a checksum that comes from the net just as the distribution file
4860 itself. If somebody has managed to tamper with the distribution file,
4861 they may have as well tampered with the CHECKSUMS file. Future
4862 development will go towards strong authentication.
4866 Most functions in package CPAN are exported per default. The reason
4867 for this is that the primary use is intended for the cpan shell or for
4870 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
4872 To populate a freshly installed perl with my favorite modules is pretty
4873 easiest by maintaining a private bundle definition file. To get a useful
4874 blueprint of a bundle definition file, the command autobundle can be used
4875 on the CPAN shell command line. This command writes a bundle definition
4876 file for all modules that are installed for the currently running perl
4877 interpreter. It's recommended to run this command only once and from then
4878 on maintain the file manually under a private name, say
4879 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
4881 cpan> install Bundle::my_bundle
4883 then answer a few questions and then go out for a coffee.
4885 Maintaining a bundle definition file means to keep track of two
4886 things: dependencies and interactivity. CPAN.pm sometimes fails on
4887 calculating dependencies because not all modules define all MakeMaker
4888 attributes correctly, so a bundle definition file should specify
4889 prerequisites as early as possible. On the other hand, it's a bit
4890 annoying that many distributions need some interactive configuring. So
4891 what I try to accomplish in my private bundle file is to have the
4892 packages that need to be configured early in the file and the gentle
4893 ones later, so I can go out after a few minutes and leave CPAN.pm
4896 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
4898 Thanks to Graham Barr for contributing the following paragraphs about
4899 the interaction between perl, and various firewall configurations.
4901 Firewalls can be categorized into three basic types.
4907 This is where the firewall machine runs a web server and to access the
4908 outside world you must do it via the web server. If you set environment
4909 variables like http_proxy or ftp_proxy to a values beginning with http://
4910 or in your web browser you have to set proxy information then you know
4911 you are running a http firewall.
4913 To access servers outside these types of firewalls with perl (even for
4914 ftp) you will need to use LWP.
4918 This where the firewall machine runs a ftp server. This kind of firewall will
4919 only let you access ftp serves outside the firewall. This is usually done by
4920 connecting to the firewall with ftp, then entering a username like
4921 "user@outside.host.com"
4923 To access servers outside these type of firewalls with perl you
4924 will need to use Net::FTP.
4926 =item One way visibility
4928 I say one way visibility as these firewalls try to make themselve look
4929 invisible to the users inside the firewall. An FTP data connection is
4930 normally created by sending the remote server your IP address and then
4931 listening for the connection. But the remote server will not be able to
4932 connect to you because of the firewall. So for these types of firewall
4933 FTP connections need to be done in a passive mode.
4935 There are two that I can think off.
4941 If you are using a SOCKS firewall you will need to compile perl and link
4942 it with the SOCKS library, this is what is normally called a ``socksified''
4943 perl. With this executable you will be able to connect to servers outside
4944 the firewall as if it is not there.
4948 This is the firewall implemented in the Linux kernel, it allows you to
4949 hide a complete network behind one IP address. With this firewall no
4950 special compiling is need as you can access hosts directly.
4958 We should give coverage for B<all> of the CPAN and not just the PAUSE
4959 part, right? In this discussion CPAN and PAUSE have become equal --
4960 but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus
4961 the clpa/, doc/, misc/, ports/, src/, scripts/.
4963 Future development should be directed towards a better integration of
4966 If a Makefile.PL requires special customization of libraries, prompts
4967 the user for special input, etc. then you may find CPAN is not able to
4968 build the distribution. In that case, you should attempt the
4969 traditional method of building a Perl module package from a shell.
4973 Andreas König E<lt>a.koenig@kulturbox.deE<gt>
4977 perl(1), CPAN::Nox(3)