2 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
6 # $Id: CPAN.pm,v 1.127 1997/02/11 06:23:10 k Exp $
8 # my $version = substr q$Revision: 1.127 $, 10; # only used during development
15 use ExtUtils::MakeMaker ();
16 use File::Basename ();
22 use Text::ParseWords ();
27 END { $End++; &cleanup; }
49 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
52 @CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
56 $META ||= new CPAN; # In case we reeval ourselves we
60 autobundle bundle expand force get
61 install make readme recompile shell test clean
66 #-> sub CPAN::autobundle ;
68 #-> sub CPAN::bundle ;
70 #-> sub CPAN::expand ;
74 #-> sub CPAN::install ;
85 #-> sub CPAN::AUTOLOAD ;
90 @EXPORT{@EXPORT} = '';
91 if (exists $EXPORT{$l}){
94 warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
103 my($mgr,$class) = @_;
104 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
106 values %{ $META->{$class} };
109 # Called by shell, not in batch mode. Not clean XXX
110 #-> sub CPAN::checklock ;
113 my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
114 if (-f $lockfile && -M _ > 0) {
115 my $fh = FileHandle->new($lockfile);
118 if (defined $other && $other) {
120 return if $$==$other; # should never happen
121 print qq{There seems to be running another CPAN process }.
122 qq{($other). Trying to contact...\n};
123 if (kill 0, $other) {
124 Carp::croak qq{Other job is running.\n}.
125 qq{You may want to kill it and delete the lockfile, }.
126 qq{maybe. On UNIX try:\n}.
129 } elsif (-w $lockfile) {
131 ExtUtils::MakeMaker::prompt
132 (qq{Other job not responding. Shall I overwrite }.
133 qq{the lockfile? (Y/N)},"y");
134 print("Ok, bye\n"), exit unless $ans =~ /^y/i;
137 qq{Lockfile $lockfile not writeable by you. }.
138 qq{Cannot proceed.\n}.
141 qq{ and then rerun us.\n}
146 File::Path::mkpath($CPAN::Config->{cpan_home});
148 unless ($fh = FileHandle->new(">$lockfile")) {
149 if ($! =~ /Permission/) {
150 my $incc = $INC{'CPAN/Config.pm'};
151 my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
154 Your configuration suggests that CPAN.pm should use a working
156 $CPAN::Config->{cpan_home}
157 Unfortunately we could not create the lock file
159 due to permission problems.
161 Please make sure that the configuration variable
162 \$CPAN::Config->{cpan_home}
163 points to a directory where you can write a .lock file. You can set
164 this variable in either
171 Carp::croak "Could not open >$lockfile: $!";
174 $self->{LOCK} = $lockfile;
176 $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
178 my $s = $Signal == 2 ? "a second" : "another";
179 &cleanup, die "Got $s SIGINT" if $Signal;
182 $SIG{'__DIE__'} = \&cleanup;
183 print STDERR "Signal handler set.\n"
184 unless $CPAN::Config->{'inhibit_startup_message'};
187 #-> sub CPAN::DESTROY ;
189 &cleanup; # need an eval?
192 #-> sub CPAN::exists ;
194 my($mgr,$class,$id) = @_;
196 Carp::croak "exists called without class argument" unless $class;
198 exists $META->{$class}{$id};
201 #-> sub CPAN::hasFTP ;
205 return $self->{'hasFTP'} = $arg;
206 } elsif (not defined $self->{'hasFTP'}) {
207 eval {require Net::FTP;};
208 $self->{'hasFTP'} = $@ ? 0 : 1;
210 return $self->{'hasFTP'};
213 #-> sub CPAN::hasLWP ;
217 return $self->{'hasLWP'} = $arg;
218 } elsif (not defined $self->{'hasLWP'}) {
221 $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
223 return $self->{'hasLWP'};
226 #-> sub CPAN::hasMD5 ;
230 $self->{'hasMD5'} = $arg;
231 } elsif (not defined $self->{'hasMD5'}) {
234 print "MD5 security checks disabled because MD5 not installed.
235 Please consider installing the MD5 module\n";
236 $self->{'hasMD5'} = 0;
241 return $self->{'hasMD5'};
244 #-> sub CPAN::hasWAIT ;
248 $self->{'hasWAIT'} = $arg;
249 } elsif (not defined $self->{'hasWAIT'}) {
250 eval {require CPAN::WAIT;};
252 $self->{'hasWAIT'} = 0;
254 $self->{'hasWAIT'} = 1;
257 return $self->{'hasWAIT'};
260 #-> sub CPAN::instance ;
262 my($mgr,$class,$id) = @_;
264 Carp::croak "instance called without class argument" unless $class;
266 $META->{$class}{$id} ||= $class->new(ID => $id );
274 #-> sub CPAN::cleanup ;
276 local $SIG{__DIE__} = '';
277 my $i = 0; my $ineval = 0; my $sub;
278 while ((undef,undef,undef,$sub) = caller(++$i)) {
279 $ineval = 1, last if $sub eq '(eval)';
281 return if $ineval && !$End;
282 return unless defined $META->{'LOCK'};
283 return unless -f $META->{'LOCK'};
284 unlink $META->{'LOCK'};
285 print STDERR "Lockfile removed.\n";
286 # my $mess = Carp::longmess(@_);
290 #-> sub CPAN::shell ;
292 $Suppress_readline ||= ! -t STDIN;
294 my $prompt = "cpan> ";
296 unless ($Suppress_readline) {
297 require Term::ReadLine;
298 # import Term::ReadLine;
299 $term = new Term::ReadLine 'CPAN Monitor';
300 $readline::rl_completion_function =
301 $readline::rl_completion_function = 'CPAN::Complete::complete';
306 my $cwd = Cwd::cwd();
307 # How should we determine if we have more than stub ReadLine enabled?
308 my $rl_avail = $Suppress_readline ? "suppressed" :
309 defined &Term::ReadLine::Perl::readline ? "enabled" :
310 "available (get Term::ReadKey and Term::ReadLine::Perl)";
313 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
314 Readline support $rl_avail
316 } unless $CPAN::Config->{'inhibit_startup_message'} ;
318 if ($Suppress_readline) {
320 last unless defined ($_ = <>);
323 # if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024
326 # for $item (qw/ReadLine IN OUT MinLine findConsole Features/) {
327 # $report .= sprintf "%-15s", $item;
328 # $report .= $term->$item() || "";
332 # CPAN->debug($report);
334 last unless defined ($_ = $term->readline($prompt));
338 $_ = 'h' if $_ eq '?';
343 use vars qw($import_done);
344 CPAN->import(':DEFAULT') unless $import_done++;
345 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
348 } elsif (/^q(?:uit)?$/i) {
352 if ($] < 5.00322) { # parsewords had a bug until recently
355 eval { @line = Text::ParseWords::shellwords($_) };
356 warn($@), next if $@;
358 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
359 my $command = shift @line;
360 eval { CPAN::Shell->$command(@line) };
364 &cleanup, die if $Signal;
370 package CPAN::CacheMgr;
372 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
375 #-> sub CPAN::CacheMgr::as_string ;
377 eval { require Data::Dumper };
379 return shift->SUPER::as_string;
381 return Data::Dumper::Dumper(shift);
385 #-> sub CPAN::CacheMgr::cachesize ;
391 # my($self,@dirs) = @_;
392 # return unless -d $self->{ID};
394 # @dirs = $self->dirs unless @dirs;
396 # $self->disk_usage($dir);
400 #-> sub CPAN::CacheMgr::clean_cache ;
404 while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
405 $self->force_clean_cache($dir);
407 $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
410 #-> sub CPAN::CacheMgr::dir ;
415 #-> sub CPAN::CacheMgr::entries ;
418 $dir ||= $self->{ID};
419 my($cwd) = Cwd::cwd();
420 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
421 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
424 next if $_ eq "." || $_ eq "..";
426 push @entries, $CPAN::META->catfile($dir,$_);
428 push @entries, $CPAN::META->catdir($dir,$_);
430 print STDERR "Warning: weird direntry in $dir: $_\n";
433 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
434 sort {-M $b <=> -M $a} @entries;
437 #-> sub CPAN::CacheMgr::disk_usage ;
440 if (! defined $dir or $dir eq "") {
441 $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
444 return if defined $self->{SIZE}{$dir};
453 $self->{SIZE}{$dir} = $Du/1024/1024;
454 push @{$self->{FIFO}}, $dir;
455 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
456 $self->{DU} += $Du/1024/1024;
457 if ($self->{DU} > $self->{'MAX'} ) {
458 my($toremove) = $self->{FIFO}[0];
459 printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
460 $self->{DU}, $self->{'MAX'};
463 $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}")
465 $self->debug($self->as_string) if $CPAN::DEBUG;
470 #-> sub CPAN::CacheMgr::force_clean_cache ;
471 sub force_clean_cache {
473 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
475 File::Path::rmtree($dir);
476 $self->{DU} -= $self->{SIZE}{$dir};
477 delete $self->{SIZE}{$dir};
480 #-> sub CPAN::CacheMgr::new ;
484 ID => $CPAN::Config->{'build_dir'},
485 MAX => $CPAN::Config->{'build_cache'},
488 File::Path::mkpath($self->{ID});
489 my $dh = DirHandle->new($self->{ID});
491 $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
493 for $e ($self->entries) {
494 next if $e eq ".." || $e eq ".";
495 $self->debug("Have to check size $e") if $CPAN::DEBUG;
496 $self->disk_usage($e);
503 #-> sub CPAN::Debug::debug ;
506 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
507 # Complete, caller(1)
509 ($caller) = caller(0);
511 # print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
512 # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
513 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
515 eval { require Data::Dumper };
517 print $arg->as_string;
519 print Data::Dumper::Dumper($arg);
522 print "Debug($caller:$func,$line,@rest): $arg\n"
527 package CPAN::Config;
528 import ExtUtils::MakeMaker 'neatvalue';
532 'commit' => "Commit changes to disk",
533 'defaults' => "Reload defaults from disk",
534 'init' => "Interactive setting of all options",
537 #-> sub CPAN::Config::edit ;
539 my($class,@args) = @_;
541 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
542 my($o,$str,$func,$args,$key_exists);
548 if (ref($CPAN::Config->{$o}) eq ARRAY) {
551 # Let's avoid eval, it's easier to comprehend without.
552 if ($func eq "push") {
553 push @{$CPAN::Config->{$o}}, @args;
554 } elsif ($func eq "pop") {
555 pop @{$CPAN::Config->{$o}};
556 } elsif ($func eq "shift") {
557 shift @{$CPAN::Config->{$o}};
558 } elsif ($func eq "unshift") {
559 unshift @{$CPAN::Config->{$o}}, @args;
560 } elsif ($func eq "splice") {
561 splice @{$CPAN::Config->{$o}}, @args;
563 $CPAN::Config->{$o} = [@args];
567 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
572 $CPAN::Config->{$o} = $args[0] if defined $args[0];
574 print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
579 #-> sub CPAN::Config::commit ;
581 my($self,$configpm) = @_;
582 unless (defined $configpm){
583 $configpm ||= $INC{"CPAN/MyConfig.pm"};
584 $configpm ||= $INC{"CPAN/Config.pm"};
585 $configpm || Carp::confess(qq{
586 CPAN::Config::commit called without an argument.
587 Please specify a filename where to save the configuration or try
588 "o conf init" to have an interactive course through configing.
593 $mode = (stat $configpm)[2];
594 if ($mode && ! -w _) {
595 Carp::confess("$configpm is not writable");
599 my $msg = <<EOF unless $configpm =~ /MyConfig/;
601 # This is CPAN.pm's systemwide configuration file. This file provides
602 # defaults for users, and the values can be changed in a per-user configuration
603 # file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
607 my($fh) = FileHandle->new;
608 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
609 print $fh qq[$msg\$CPAN::Config = \{\n];
610 foreach (sort keys %$CPAN::Config) {
613 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
618 print $fh "};\n1;\n__END__\n";
621 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
622 #chmod $mode, $configpm;
624 print "commit: wrote $configpm\n";
628 *default = \&defaults;
629 #-> sub CPAN::Config::defaults ;
639 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
649 #-> sub CPAN::Config::load ;
652 eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems
653 unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
654 eval {require CPAN::MyConfig;}; # where you can override system wide settings
655 unless ( $self->load_succeeded ) {
656 require CPAN::FirstTime;
658 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
659 $configpm = $INC{"CPAN/Config.pm"};
660 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
661 $configpm = $INC{"CPAN/MyConfig.pm"};
663 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
664 my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
665 my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
666 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
667 if (-w $configpmtest) {
668 $configpm = $configpmtest;
669 } elsif (-w $configpmdir) {
670 #_#_# following code dumped core on me with 5.003_11, a.k.
671 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
672 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
673 my $fh = FileHandle->new;
674 if ($fh->open(">$configpmtest")) {
676 $configpm = $configpmtest;
678 # Should never happen
679 Carp::confess("Cannot open >$configpmtest");
684 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
685 File::Path::mkpath($configpmdir);
686 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
687 if (-w $configpmtest) {
688 $configpm = $configpmtest;
689 } elsif (-w $configpmdir) {
690 #_#_# following code dumped core on me with 5.003_11, a.k.
691 my $fh = FileHandle->new;
692 if ($fh->open(">$configpmtest")) {
694 $configpm = $configpmtest;
696 # Should never happen
697 Carp::confess("Cannot open >$configpmtest");
700 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
701 qq{create a configuration file.});
705 CPAN->debug(qq{Calling CPAN::FirstTime::init("$configpm")})
709 $configpm initialized.
711 CPAN::FirstTime::init($configpm);
715 #-> sub CPAN::Config::load_succeeded ;
719 cpan_home keep_source_where build_dir build_cache index_expire
720 gzip tar unzip make pager makepl_arg make_arg make_install_arg
721 urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
723 unless (defined $CPAN::Config->{$_}){
725 CPAN->debug("undefined configuration parameter $_") if $CPAN::DEBUG;
731 #-> sub CPAN::Config::unload ;
733 delete $INC{'CPAN/MyConfig.pm'};
734 delete $INC{'CPAN/Config.pm'};
738 #-> sub CPAN::Config::help ;
742 defaults reload default config values from disk
743 commit commit session changes to disk
744 init go through a dialog to set all parameters
746 You may edit key values in the follow fashion:
748 o conf build_cache 15
750 o conf build_dir "/foo/bar"
754 o conf urllist unshift ftp://ftp.foo.bar/
757 undef; #don't reprint CPAN::Config
760 #-> sub CPAN::Config::complete ;
762 my($word,$line,$pos) = @_;
764 my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
765 return grep /^\Q$word\E/, @o_conf;
769 use vars qw($AUTOLOAD $redef @ISA);
770 @CPAN::Shell::ISA = qw(CPAN::Debug);
771 if ($CPAN::META->hasWAIT) {
772 unshift @ISA, "CPAN::WAIT";
774 # private function ro re-eval this module (handy during development)
775 #-> sub CPAN::Shell::AUTOLOAD ;
777 my($autoload) = $AUTOLOAD;
778 $autoload =~ s/.*:://;
779 if ($autoload =~ /^w/) {
780 if ($CPAN::META->hasWAIT) {
785 Commands starting with "w" require CPAN::WAIT to be installed.
786 Please consider installing CPAN::WAIT to use the fulltext index.
787 Type "install CPAN::WAIT" and restart CPAN.pm.
791 warn "CPAN::Shell doesn't know how to autoload $autoload :-(
798 #-> sub CPAN::Shell::h ;
800 my($class,$about) = @_;
801 if (defined $about) {
802 print "Detailed help not yet implemented\n";
805 command arguments description
808 d /regex/ info distributions
810 i none anything of above
812 r as reinstall recommendations
813 u above uninstalled distributions
814 See manpage for autobundle, recompile, force, look, etc.
817 test modules, make test (implies make)
818 install dists, bundles, make install (implies test)
819 clean "r" or "u" make clean
820 readme display the README file
822 reload index|cpan load most recent indices/CPAN.pm
823 h or ? display this menu
824 o various set and query options
825 ! perl-code eval a perl command
826 q quit the shell subroutine
831 #-> sub CPAN::Shell::a ;
832 sub a { print shift->format_result('Author',@_);}
833 #-> sub CPAN::Shell::b ;
835 my($self,@which) = @_;
836 CPAN->debug("which[@which]") if $CPAN::DEBUG;
837 my($incdir,$bdir,$dh);
838 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
839 $bdir = $CPAN::META->catdir($incdir,"Bundle");
840 if ($dh = DirHandle->new($bdir)) { # may fail
842 for $entry ($dh->read) {
843 next if -d $CPAN::META->catdir($bdir,$entry);
844 next unless $entry =~ s/\.pm$//;
845 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
849 print $self->format_result('Bundle',@which);
851 #-> sub CPAN::Shell::d ;
852 sub d { print shift->format_result('Distribution',@_);}
853 #-> sub CPAN::Shell::m ;
854 sub m { print shift->format_result('Module',@_);}
856 #-> sub CPAN::Shell::i ;
861 @type = qw/Author Bundle Distribution Module/;
862 @args = '/./' unless @args;
865 push @result, $self->expand($type,@args);
867 my $result = @result==1 ?
868 $result[0]->as_string :
869 join "", map {$_->as_glimpse} @result;
870 $result ||= "No objects found of any type for argument @args\n";
874 #-> sub CPAN::Shell::o ;
876 my($self,$o_type,@o_what) = @_;
878 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
879 if ($o_type eq 'conf') {
880 shift @o_what if @o_what && $o_what[0] eq 'help';
883 print "CPAN::Config options:\n";
884 for $k (sort keys %CPAN::Config::can) {
885 $v = $CPAN::Config::can{$k};
886 printf " %-18s %s\n", $k, $v;
889 for $k (sort keys %$CPAN::Config) {
890 $v = $CPAN::Config->{$k};
892 printf " %-18s\n", $k;
893 print map {"\t$_\n"} @{$v};
895 printf " %-18s %s\n", $k, $v;
899 } elsif (!CPAN::Config->edit(@o_what)) {
900 print qq[Type 'o conf' to view configuration edit options\n\n];
902 } elsif ($o_type eq 'debug') {
904 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
907 my($what) = shift @o_what;
908 if ( exists $CPAN::DEBUG{$what} ) {
909 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
910 } elsif ($what =~ /^\d/) {
911 $CPAN::DEBUG = $what;
912 } elsif (lc $what eq 'all') {
914 for (values %CPAN::DEBUG) {
920 for (keys %CPAN::DEBUG) {
921 next unless lc($_) eq lc($what);
922 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
925 print "unknown argument [$what]\n" unless $known;
929 print "Valid options for debug are ".
930 join(", ",sort(keys %CPAN::DEBUG), 'all').
931 qq{ or a number. Completion works on the options. }.
932 qq{Case is ignored.\n\n};
935 print "Options set for debugging:\n";
937 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
938 $v = $CPAN::DEBUG{$k};
939 printf " %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
942 print "Debugging turned off completely.\n";
947 conf set or get configuration variables
948 debug set or get debugging options
953 #-> sub CPAN::Shell::reload ;
955 my($self,$command,@arg) = @_;
957 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
958 if ($command =~ /cpan/i) {
959 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
960 my $fh = FileHandle->new($INC{'CPAN.pm'});
964 local($SIG{__WARN__})
966 if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
976 print "\n$redef subroutines redefined\n";
977 } elsif ($command =~ /index/) {
978 CPAN::Index->force_reload;
980 print qq{cpan re-evals the CPAN.pm file\n};
981 print qq{index re-reads the index files\n};
985 #-> sub CPAN::Shell::_binary_extensions ;
986 sub _binary_extensions {
987 my($self) = shift @_;
988 my(@result,$module,%seen,%need,$headerdone);
989 for $module ($self->expand('Module','/./')) {
990 my $file = $module->cpan_file;
991 next if $file eq "N/A";
992 next if $file =~ /^Contact Author/;
993 next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
994 next unless $module->xs_file;
997 push @result, $module;
999 # print join " | ", @result;
1004 #-> sub CPAN::Shell::recompile ;
1006 my($self) = shift @_;
1007 my($module,@module,$cpan_file,%dist);
1008 @module = $self->_binary_extensions();
1009 for $module (@module){ # we force now and compile later, so we don't do it twice
1010 $cpan_file = $module->cpan_file;
1011 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1013 $dist{$cpan_file}++;
1015 for $cpan_file (sort keys %dist) {
1016 print " CPAN: Recompiling $cpan_file\n\n";
1017 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1019 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1020 # stop a package from recompiling,
1021 # e.g. IO-1.12 when we have perl5.003_10
1025 #-> sub CPAN::Shell::_u_r_common ;
1027 my($self) = shift @_;
1028 my($what) = shift @_;
1029 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1030 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1031 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1033 @args = '/./' unless @args;
1034 my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
1035 $version_zeroes = 0;
1036 my $sprintf = "%-25s %9s %9s %s\n";
1037 for $module ($self->expand('Module',@args)) {
1038 my $file = $module->cpan_file;
1039 next unless defined $file; # ??
1040 my($latest) = $module->cpan_version || 0;
1041 my($inst_file) = $module->inst_file;
1045 $have = $module->inst_version;
1046 } elsif ($what eq "r") {
1047 $have = $module->inst_version;
1049 $version_zeroes++ unless $have;
1050 next if $have >= $latest;
1051 } elsif ($what eq "u") {
1057 } elsif ($what eq "r") {
1059 } elsif ($what eq "u") {
1063 return if $CPAN::Signal; # this is sometimes lengthy
1066 push @result, sprintf "%s %s\n", $module->id, $have;
1067 } elsif ($what eq "r") {
1068 push @result, $module->id;
1069 next if $seen{$file}++;
1070 } elsif ($what eq "u") {
1071 push @result, $module->id;
1072 next if $seen{$file}++;
1073 next if $file =~ /^Contact/;
1075 unless ($headerdone++){
1079 "Package namespace",
1085 $latest = substr($latest,0,8) if length($latest) > 8;
1086 $have = substr($have,0,8) if length($have) > 8;
1087 printf $sprintf, $module->id, $have, $latest, $file;
1088 $need{$module->id}++;
1092 print "No modules found for @args\n";
1093 } elsif ($what eq "r") {
1094 print "All modules are up to date for @args\n";
1097 if ($what eq "r" && $version_zeroes) {
1098 my $s = $version_zeroes>1 ? "s have" : " has";
1099 print qq{$version_zeroes installed module$s no version number to compare\n};
1104 #-> sub CPAN::Shell::r ;
1106 shift->_u_r_common("r",@_);
1109 #-> sub CPAN::Shell::u ;
1111 shift->_u_r_common("u",@_);
1114 #-> sub CPAN::Shell::autobundle ;
1117 my(@bundle) = $self->_u_r_common("a",@_);
1118 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1119 File::Path::mkpath($todir);
1120 unless (-d $todir) {
1121 print "Couldn't mkdir $todir for some reason\n";
1124 my($y,$m,$d) = (localtime)[5,4,3];
1128 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1129 my($to) = $CPAN::META->catfile($todir,"$me.pm");
1131 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1132 $to = $CPAN::META->catfile($todir,"$me.pm");
1134 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1136 "package Bundle::$me;\n\n",
1137 "\$VERSION = '0.01';\n\n",
1141 "Bundle::$me - Snapshot of installation on ",
1142 $Config::Config{'myhostname'},
1145 "\n\n=head1 SYNOPSIS\n\n",
1146 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1147 "=head1 CONTENTS\n\n",
1148 join("\n", @bundle),
1149 "\n\n=head1 CONFIGURATION\n\n",
1151 "\n\n=head1 AUTHOR\n\n",
1152 "This Bundle has been generated automatically ",
1153 "by the autobundle routine in CPAN.pm.\n",
1156 print "\nWrote bundle file
1160 #-> sub CPAN::Shell::expand ;
1163 my($type,@args) = @_;
1167 if ($arg =~ m|^/(.*)/$|) {
1170 my $class = "CPAN::$type";
1172 if (defined $regex) {
1173 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
1176 $obj->id =~ /$regex/i
1180 $] < 5.00303 ### provide sort of compatibility with 5.003
1185 $obj->name =~ /$regex/i
1190 if ( $type eq 'Bundle' ) {
1191 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1193 if ($CPAN::META->exists($class,$xarg)) {
1194 $obj = $CPAN::META->instance($class,$xarg);
1195 } elsif ($CPAN::META->exists($class,$arg)) {
1196 $obj = $CPAN::META->instance($class,$arg);
1206 #-> sub CPAN::Shell::format_result ;
1209 my($type,@args) = @_;
1210 @args = '/./' unless @args;
1211 my(@result) = $self->expand($type,@args);
1212 my $result = @result==1 ?
1213 $result[0]->as_string :
1214 join "", map {$_->as_glimpse} @result;
1215 $result ||= "No objects of type $type found for argument @args\n";
1219 #-> sub CPAN::Shell::rematein ;
1222 my($meth,@some) = @_;
1224 if ($meth eq 'force') {
1226 $meth = shift @some;
1228 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1230 foreach $s (@some) {
1234 } elsif ($s =~ m|/|) { # looks like a file
1235 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1236 } elsif ($s =~ m|^Bundle::|) {
1237 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1239 $obj = $CPAN::META->instance('CPAN::Module',$s)
1240 if $CPAN::META->exists('CPAN::Module',$s);
1244 qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
1252 ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
1254 } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1255 $obj = $CPAN::META->instance('CPAN::Author',$s);
1256 print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
1258 print "Warning: Cannot $meth $s, don't know what it is\n";
1263 #-> sub CPAN::Shell::force ;
1264 sub force { shift->rematein('force',@_); }
1265 #-> sub CPAN::Shell::get ;
1266 sub get { shift->rematein('get',@_); }
1267 #-> sub CPAN::Shell::readme ;
1268 sub readme { shift->rematein('readme',@_); }
1269 #-> sub CPAN::Shell::make ;
1270 sub make { shift->rematein('make',@_); }
1271 #-> sub CPAN::Shell::test ;
1272 sub test { shift->rematein('test',@_); }
1273 #-> sub CPAN::Shell::install ;
1274 sub install { shift->rematein('install',@_); }
1275 #-> sub CPAN::Shell::clean ;
1276 sub clean { shift->rematein('clean',@_); }
1277 #-> sub CPAN::Shell::look ;
1278 sub look { shift->rematein('look',@_); }
1282 @CPAN::FTP::ISA = qw(CPAN::Debug);
1284 #-> sub CPAN::FTP::ftp_get ;
1286 my($class,$host,$dir,$file,$target) = @_;
1288 qq[Going to fetch file [$file] from dir [$dir]
1289 on host [$host] as local [$target]\n]
1291 my $ftp = Net::FTP->new($host);
1292 return 0 unless defined $ftp;
1293 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1294 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1295 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1296 warn "Couldn't login on $host";
1299 # print qq[Going to ->cwd("$dir")\n];
1300 unless ( $ftp->cwd($dir) ){
1301 warn "Couldn't cwd $dir";
1305 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1306 unless ( $ftp->get($file,$target) ){
1307 warn "Couldn't fetch $file from $host\n";
1310 $ftp->quit; # it's ok if this fails
1314 #-> sub CPAN::FTP::localize ;
1316 my($self,$file,$aslocal,$force) = @_;
1318 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1319 unless defined $aslocal;
1320 $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
1322 return $aslocal if -f $aslocal && -r _ && ! $force;
1324 my($aslocal_dir) = File::Basename::dirname($aslocal);
1325 File::Path::mkpath($aslocal_dir);
1326 print STDERR qq{Warning: You are not allowed to write into }.
1327 qq{directory "$aslocal_dir".
1328 I\'ll continue, but if you face any problems, they may be due
1329 to insufficient permissions.\n} unless -w $aslocal_dir;
1331 # Inheritance is not easier to manage than a few if/else branches
1332 if ($CPAN::META->hasLWP) {
1333 require LWP::UserAgent;
1335 $Ua = new LWP::UserAgent;
1337 $Ua->proxy('ftp', $var)
1338 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1339 $Ua->proxy('http', $var)
1340 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1342 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1346 # Try the list of urls for each single object. We keep a record
1347 # where we did get a file from
1349 for $i (0..$#{$CPAN::Config->{urllist}}) {
1350 my $url = $CPAN::Config->{urllist}[$i];
1351 $url .= "/" unless substr($url,-1) eq "/";
1353 $self->debug("localizing[$url]") if $CPAN::DEBUG;
1354 if ($url =~ /^file:/) {
1356 if ($CPAN::META->hasLWP) {
1358 my $u = new URI::URL $url;
1360 } else { # works only on Unix, is poorly constructed, but
1361 # hopefully better than nothing.
1362 # RFC 1738 says fileurl BNF is
1363 # fileurl = "file://" [ host | "localhost" ] "/" fpath
1364 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
1365 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
1366 $l =~ s/^file://; # assume they meant file://localhost
1368 return $l if -f $l && -r _;
1369 # Maybe mirror has compressed it?
1371 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
1372 system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
1373 return $aslocal if -f $aslocal;
1377 if ($CPAN::META->hasLWP) {
1378 print "Fetching $url with LWP\n";
1379 my $res = $Ua->mirror($url, $aslocal);
1380 if ($res->is_success) {
1384 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1385 # that's the nice and easy way thanks to Graham
1386 my($host,$dir,$getfile) = ($1,$2,$3);
1387 if ($CPAN::META->hasFTP) {
1389 $self->debug("Going to fetch file [$getfile]
1392 as local [$aslocal]") if $CPAN::DEBUG;
1393 CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
1394 warn "Net::FTP failed for some reason\n";
1397 Please, install Net::FTP as soon as possible. Just type
1405 # Came back if Net::FTP couldn't establish connection (or failed otherwise)
1406 # Maybe they are behind a firewall, but they gave us
1407 # a socksified (or other) ftp program...
1410 # does ncftp handle http?
1411 for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
1412 next unless defined $funkyftp;
1413 next unless -x $funkyftp;
1414 my($want_compressed);
1417 Trying with $funkyftp to get
1420 $want_compressed = $aslocal =~ s/\.gz//;
1421 my($source_switch) = "";
1422 $source_switch = "-source" if $funkyftp =~ /\blynx$/;
1423 my($system) = "$funkyftp $source_switch '$url' > $aslocal";
1425 if (($wstatus = system($system)) == 0) {
1426 if ($want_compressed) {
1427 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1428 if (system($system)==0) {
1429 rename $aslocal, "$aslocal.gz";
1431 $system = "$CPAN::Config->{'gzip'} $aslocal";
1434 return "$aslocal.gz";
1436 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1437 if (system($system)==0) {
1438 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
1441 # should be fine, eh?
1446 my $estatus = $wstatus >> 8;
1448 System call "$system"
1449 returned status $estatus (wstat $wstatus)
1454 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1455 my($host,$dir,$getfile) = ($1,$2,$3);
1457 if (-x $CPAN::Config->{'ftp'}) {
1459 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
1460 $ctime,$blksize,$blocks) = stat($aslocal);
1461 $timestamp = $mtime ||=0;
1463 my($netrc) = CPAN::FTP::netrc->new;
1464 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
1466 my $targetfile = File::Basename::basename($aslocal);
1472 map("cd $_", split "/", $dir), # RFC 1738
1474 "get $getfile $targetfile",
1477 if (! $netrc->netrc) {
1478 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
1479 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
1482 "hasdef[%d]cont($host)[%d]",
1484 $netrc->contains($host)
1487 if ($netrc->protected) {
1490 Trying with external ftp to get
1492 As this requires some features that are not thoroughly tested, we\'re
1493 not sure, that we get it right....
1497 my $fh = FileHandle->new;
1498 $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
1499 or die "Couldn't open ftp: $!";
1500 # pilot is blind now
1501 CPAN->debug("dialog [".(join "|",@dialog)."]")
1503 foreach (@dialog) { $fh->print("$_\n") }
1504 $fh->close; # Wait for process to complete
1506 my $estatus = $wstatus >> 8;
1508 Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
1509 returned status $estatus (wstat $wstatus)
1511 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1512 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1514 if ($mtime > $timestamp) {
1515 print "GOT $aslocal\n";
1518 print "Hmm... Still failed!\n";
1521 warn "Your $netrcfile is not correctly protected.\n";
1524 warn "Your ~/.netrc neither contains $host
1525 nor does it have a default entry\n";
1528 # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
1529 # login manually to host, using e-mail as password.
1530 print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
1534 "user anonymous $Config::Config{'cf_email'}"
1536 CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
1537 $fh = FileHandle->new;
1538 $fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
1539 die "Cannot fork: $!\n";
1540 foreach (@dialog) { $fh->print("$_\n") }
1543 my $estatus = $wstatus >> 8;
1545 Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
1546 returned status $estatus (wstat $wstatus)
1548 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1549 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1551 if ($mtime > $timestamp) {
1552 print "GOT $aslocal\n";
1555 print "Bad luck... Still failed!\n";
1561 print "Can't access URL $url.\n\n";
1563 push @mess, "LWP" unless CPAN->hasLWP;
1564 push @mess, "Net::FTP" unless CPAN->hasFTP;
1566 for $ext (qw/lynx ncftp ftp/) {
1567 $CPAN::Config->{$ext} ||= "";
1568 push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
1570 $mess = qq{Either get }.
1572 qq{ or check, if the URL found in your configuration file, }.
1573 $CPAN::Config->{urllist}[$i].
1575 print Text::Wrap::wrap("","",$mess), "\n";
1577 print "Cannot fetch $file\n";
1581 package CPAN::FTP::netrc;
1585 my $file = MM->catfile($ENV{HOME},".netrc");
1587 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1588 $atime,$mtime,$ctime,$blksize,$blocks)
1593 my($fh,@machines,$hasdefault);
1595 $fh = FileHandle->new or die "Could not create a filehandle";
1597 if($fh->open($file)){
1598 $protected = ($mode & 077) == 0;
1600 NETRC: while (<$fh>) {
1601 my(@tokens) = split " ", $_;
1602 TOKEN: while (@tokens) {
1603 my($t) = shift @tokens;
1604 if ($t eq "default"){
1606 # warn "saw a default entry before tokens[@tokens]";
1609 last TOKEN if $t eq "macdef";
1610 if ($t eq "machine") {
1611 push @machines, shift @tokens;
1616 $file = $hasdefault = $protected = "";
1620 'mach' => [@machines],
1622 'hasdefault' => $hasdefault,
1623 'protected' => $protected,
1627 sub hasdefault { shift->{'hasdefault'} }
1628 sub netrc { shift->{'netrc'} }
1629 sub protected { shift->{'protected'} }
1631 my($self,$mach) = @_;
1632 for ( @{$self->{'mach'}} ) {
1633 return 1 if $_ eq $mach;
1638 package CPAN::Complete;
1639 @CPAN::Complete::ISA = qw(CPAN::Debug);
1641 #-> sub CPAN::Complete::complete ;
1643 my($word,$line,$pos) = @_;
1647 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1649 if ($line =~ s/^(force\s*)//) {
1657 ! a b d h i m o q r u autobundle clean
1658 make test install force reload look
1661 } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
1663 } elsif ($line =~ /^a\s/) {
1664 @return = completex('CPAN::Author',$word);
1665 } elsif ($line =~ /^b\s/) {
1666 @return = completex('CPAN::Bundle',$word);
1667 } elsif ($line =~ /^d\s/) {
1668 @return = completex('CPAN::Distribution',$word);
1669 } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
1670 @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
1671 } elsif ($line =~ /^i\s/) {
1672 @return = complete_any($word);
1673 } elsif ($line =~ /^reload\s/) {
1674 @return = complete_reload($word,$line,$pos);
1675 } elsif ($line =~ /^o\s/) {
1676 @return = complete_option($word,$line,$pos);
1683 #-> sub CPAN::Complete::completex ;
1685 my($class, $word) = @_;
1686 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1689 #-> sub CPAN::Complete::complete_any ;
1693 completex('CPAN::Author',$word),
1694 completex('CPAN::Bundle',$word),
1695 completex('CPAN::Distribution',$word),
1696 completex('CPAN::Module',$word),
1700 #-> sub CPAN::Complete::complete_reload ;
1701 sub complete_reload {
1702 my($word,$line,$pos) = @_;
1704 my(@words) = split " ", $line;
1705 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1706 my(@ok) = qw(cpan index);
1707 return @ok if @words==1;
1708 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1711 #-> sub CPAN::Complete::complete_option ;
1712 sub complete_option {
1713 my($word,$line,$pos) = @_;
1715 my(@words) = split " ", $line;
1716 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1717 my(@ok) = qw(conf debug);
1718 return @ok if @words==1;
1719 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1721 } elsif ($words[1] eq 'index') {
1723 } elsif ($words[1] eq 'conf') {
1724 return CPAN::Config::complete(@_);
1725 } elsif ($words[1] eq 'debug') {
1726 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1730 package CPAN::Index;
1731 use vars qw($last_time);
1732 @CPAN::Index::ISA = qw(CPAN::Debug);
1735 #-> sub CPAN::Index::force_reload ;
1738 $CPAN::Index::last_time = 0;
1742 #-> sub CPAN::Index::reload ;
1744 my($cl,$force) = @_;
1747 # XXX check if a newer one is available. (We currently read it from time to time)
1748 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1751 $cl->read_authindex($cl->reload_x(
1752 "authors/01mailrc.txt.gz",
1755 return if $CPAN::Signal; # this is sometimes lengthy
1756 $cl->read_modpacks($cl->reload_x(
1757 "modules/02packages.details.txt.gz",
1760 return if $CPAN::Signal; # this is sometimes lengthy
1761 $cl->read_modlist($cl->reload_x(
1762 "modules/03modlist.data.gz",
1767 #-> sub CPAN::Index::reload_x ;
1769 my($cl,$wanted,$localname,$force) = @_;
1771 my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
1772 if (-f $abs_wanted &&
1773 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
1775 my($s) = $CPAN::Config->{'index_expire'} != 1;
1776 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
1777 qq{day$s. I\'ll use that.\n});
1782 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1785 #-> sub CPAN::Index::read_authindex ;
1786 sub read_authindex {
1787 my($cl,$index_target) = @_;
1788 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1789 print "Going to read $index_target\n";
1790 my $fh = FileHandle->new("$pipe|");
1793 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1794 next unless $userid && $fullname && $email;
1796 # instantiate an author object
1797 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
1798 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
1799 return if $CPAN::Signal;
1802 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1805 #-> sub CPAN::Index::read_modpacks ;
1807 my($cl,$index_target) = @_;
1808 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1809 print "Going to read $index_target\n";
1810 my $fh = FileHandle->new("$pipe|");
1814 my($mod,$version,$dist) = split;
1815 $version =~ s/^\+//;
1817 # if it as a bundle, instatiate a bundle object
1819 if ($mod =~ /^Bundle::(.*)/) {
1823 if ($mod eq 'CPAN') {
1825 if ($version > $CPAN::VERSION){
1827 Hey, you know what? There\'s a new CPAN.pm version (v$version)
1828 available! I\'d suggest--provided you have time--you try
1831 without quitting the current session. It should be a seemless upgrade
1832 while we are running...
1837 last if $CPAN::Signal;
1842 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
1843 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1844 # This "next" makes us faster but if the job is running long, we ignore
1845 # rereads which is bad. So we have to be a bit slower again.
1846 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
1849 # instantiate a module object
1850 $id = $CPAN::META->instance('CPAN::Module',$mod);
1851 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1854 # determine the author
1855 my($userid) = $dist =~ /([^\/]+)/;
1856 $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
1858 # instantiate a distribution object
1859 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1860 $CPAN::META->instance(
1861 'CPAN::Distribution' => $dist
1863 'CPAN_USERID' => $userid
1868 return if $CPAN::Signal;
1871 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1874 #-> sub CPAN::Index::read_modlist ;
1876 my($cl,$index_target) = @_;
1877 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1878 print "Going to read $index_target\n";
1879 my $fh = FileHandle->new("$pipe|");
1887 $eval .= q{CPAN::Modulelist->data;};
1889 my($comp) = Safe->new("CPAN::Safe1");
1890 my $ret = $comp->reval($eval);
1891 Carp::confess($@) if $@;
1892 return if $CPAN::Signal;
1894 my $obj = $CPAN::META->instance(CPAN::Module,$_);
1895 $obj->set(%{$ret->{$_}});
1896 return if $CPAN::Signal;
1900 package CPAN::InfoObj;
1901 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
1903 #-> sub CPAN::InfoObj::new ;
1904 sub new { my $this = bless {}, shift; %$this = @_; $this }
1906 #-> sub CPAN::InfoObj::set ;
1908 my($self,%att) = @_;
1909 my(%oldatt) = %$self;
1910 %$self = (%oldatt, %att);
1913 #-> sub CPAN::InfoObj::id ;
1914 sub id { shift->{'ID'} }
1916 #-> sub CPAN::InfoObj::as_glimpse ;
1920 my $class = ref($self);
1921 $class =~ s/^CPAN:://;
1922 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
1926 #-> sub CPAN::InfoObj::as_string ;
1930 my $class = ref($self);
1931 $class =~ s/^CPAN:://;
1932 push @m, $class, " id = $self->{ID}\n";
1933 for (sort keys %$self) {
1936 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
1937 if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
1938 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
1940 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
1946 #-> sub CPAN::InfoObj::author ;
1949 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
1952 package CPAN::Author;
1953 @CPAN::Author::ISA = qw(CPAN::InfoObj);
1955 #-> sub CPAN::Author::as_glimpse ;
1959 my $class = ref($self);
1960 $class =~ s/^CPAN:://;
1961 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
1965 # Dead code, I would have liked to have,,, but it was never reached,,,
1968 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
1971 #-> sub CPAN::Author::fullname ;
1972 sub fullname { shift->{'FULLNAME'} }
1974 #-> sub CPAN::Author::email ;
1975 sub email { shift->{'EMAIL'} }
1977 package CPAN::Distribution;
1978 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
1980 #-> sub CPAN::Distribution::called_for ;
1983 $self->{'CALLED_FOR'} = $id if defined $id;
1984 return $self->{'CALLED_FOR'};
1987 #-> sub CPAN::Distribution::get ;
1992 exists $self->{'build_dir'} and push @e,
1993 "Unwrapped into directory $self->{'build_dir'}";
1994 print join "", map {" $_\n"} @e and return if @e;
1999 $CPAN::Config->{keep_source_where},
2002 split("/",$self->{ID})
2005 $self->debug("Doing localize") if $CPAN::DEBUG;
2006 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
2007 $self->{localfile} = $local_file;
2008 my $builddir = $CPAN::META->{cachemgr}->dir;
2009 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2010 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2013 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2014 if ($CPAN::META->hasMD5) {
2017 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
2018 $self->debug("Removing tmp") if $CPAN::DEBUG;
2019 File::Path::rmtree("tmp");
2020 mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
2022 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2023 if ($local_file =~ /z$/i){
2024 $self->{archived} = "tar";
2025 if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
2026 $self->{unwrapped} = "YES";
2028 $self->{unwrapped} = "NO";
2030 } elsif ($local_file =~ /zip$/i) {
2031 $self->{archived} = "zip";
2032 if (system("$CPAN::Config->{unzip} $local_file")==0) {
2033 $self->{unwrapped} = "YES";
2035 $self->{unwrapped} = "NO";
2038 # Let's check if the package has its own directory.
2039 opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
2040 my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
2042 my ($distdir,$packagedir);
2043 if (@readdir == 1 && -d $readdir[0]) {
2044 $distdir = $readdir[0];
2045 $packagedir = $CPAN::META->catdir($builddir,$distdir);
2046 -d $packagedir and print "Removing previously used $packagedir\n";
2047 File::Path::rmtree($packagedir);
2048 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2050 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2051 $pragmatic_dir =~ s/\W_//g;
2052 $pragmatic_dir++ while -d "../$pragmatic_dir";
2053 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
2054 File::Path::mkpath($packagedir);
2056 for $f (@readdir) { # is already without "." and ".."
2057 my $to = $CPAN::META->catdir($packagedir,$f);
2058 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2061 $self->{'build_dir'} = $packagedir;
2064 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
2066 File::Path::rmtree("tmp");
2067 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
2068 print "Going to unlink $local_file\n";
2069 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
2071 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
2072 unless (-f $makefilepl) {
2073 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
2074 if (-f $configure) {
2075 # do we have anything to do?
2076 $self->{'configure'} = $configure;
2078 my $fh = FileHandle->new(">$makefilepl")
2079 or Carp::croak("Could not open >$makefilepl");
2080 my $cf = $self->called_for || "unknown";
2082 # This Makefile.PL has been autogenerated by the module CPAN.pm
2083 # Autogenerated on: }.scalar localtime().qq{
2084 use ExtUtils::MakeMaker;
2085 WriteMakefile(NAME => q[$cf]);
2087 print qq{Package comes without Makefile.PL.\n}.
2088 qq{ Writing one on our own (calling it $cf)\n};
2092 $self->{archived} = "NO";
2097 #-> sub CPAN::Distribution::new ;
2099 my($class,%att) = @_;
2101 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
2103 my $this = { %att };
2104 return bless $this, $class;
2107 #-> sub CPAN::Distribution::look ;
2110 if ( $CPAN::Config->{'shell'} ) {
2112 Trying to open a subshell in the build directory...
2116 Your configuration does not define a value for subshells.
2117 Please define it with "o conf shell <your shell>"
2121 my $dist = $self->id;
2122 my $dir = $self->dir or $self->get;
2124 my $pwd = Cwd::cwd();
2126 print qq{Working directory is $dir.\n};
2127 system($CPAN::Config->{'shell'})==0 or die "Subprocess shell error";
2131 #-> sub CPAN::Distribution::readme ;
2134 my($dist) = $self->id;
2135 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
2136 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
2140 $CPAN::Config->{keep_source_where},
2143 split("/","$sans.readme"),
2145 $self->debug("Doing localize") if $CPAN::DEBUG;
2146 $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
2147 my $fh_pager = FileHandle->new;
2148 $fh_pager->open("|$CPAN::Config->{'pager'}")
2149 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
2150 my $fh_readme = FileHandle->new;
2151 $fh_readme->open($local_file) or die "Could not open $local_file: $!";
2152 $fh_pager->print(<$fh_readme>);
2155 #-> sub CPAN::Distribution::verifyMD5 ;
2160 $self->{MD5_STATUS} ||= "";
2161 $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
2162 print join "", map {" $_\n"} @e and return if @e;
2165 my(@local) = split("/",$self->{ID});
2166 my($basename) = pop @local;
2167 push @local, "CHECKSUMS";
2170 $CPAN::Config->{keep_source_where},
2179 $self->MD5_check_file($local_wanted,$basename)
2181 return $self->{MD5_STATUS} = "OK";
2183 $local_file = CPAN::FTP->localize(
2184 "authors/id/@local",
2191 $local[-1] .= ".gz";
2192 $local_file = CPAN::FTP->localize(
2193 "authors/id/@local",
2197 my $system = "$CPAN::Config->{gzip} --decompress $local_file";
2198 system($system)==0 or die "Could not uncompress $local_file";
2199 $local_file =~ s/\.gz$//;
2201 $self->MD5_check_file($local_file,$basename);
2204 #-> sub CPAN::Distribution::MD5_check_file ;
2205 sub MD5_check_file {
2206 my($self,$lfile,$basename) = @_;
2208 my $fh = new FileHandle;
2210 if (open $fh, $lfile){
2213 my($comp) = Safe->new();
2214 $cksum = $comp->reval($eval);
2215 Carp::confess($@) if $@;
2216 if ($cksum->{$basename}->{md5}) {
2217 $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n")
2219 my $file = $self->{localfile};
2220 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
2222 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
2224 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
2226 print "Checksum for $file ok\n";
2227 return $self->{MD5_STATUS} = "OK";
2231 qq{Checksum mismatch for distribution file. },
2232 qq{Please investigate.\n\n}
2234 print $self->as_string;
2235 print $CPAN::META->instance(
2237 $self->{CPAN_USERID}
2239 my $wrap = qq{I\'d recommend removing $self->{'localfile'}}.
2240 qq{, put another URL at the top of the list of URLs to }.
2241 qq{visit, and restart CPAN.pm. If all this doesn\'t help, }.
2242 qq{please contact the author or your CPAN site admin};
2243 print Text::Wrap::wrap("","",$wrap);
2248 close $fh if fileno($fh);
2250 $self->{MD5_STATUS} ||= "";
2251 if ($self->{MD5_STATUS} eq "NIL") {
2252 print "\nNo md5 checksum for $basename in local $lfile.";
2253 print "Removing $lfile\n";
2254 unlink $lfile or print "Could not unlink: $!";
2257 $self->{MD5_STATUS} = "NIL";
2261 Carp::carp "Could not open $lfile for reading";
2265 #-> sub CPAN::Distribution::eq_MD5 ;
2267 my($self,$fh,$expectMD5) = @_;
2270 my $hexdigest = $md5->hexdigest;
2271 $hexdigest eq $expectMD5;
2274 #-> sub CPAN::Distribution::force ;
2277 $self->{'force_update'}++;
2278 delete $self->{'MD5_STATUS'};
2279 delete $self->{'archived'};
2280 delete $self->{'build_dir'};
2281 delete $self->{'localfile'};
2282 delete $self->{'make'};
2283 delete $self->{'install'};
2284 delete $self->{'unwrapped'};
2285 delete $self->{'writemakefile'};
2288 #-> sub CPAN::Distribution::perl ;
2291 my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
2292 $perl ||= "$CPAN::Cwd/$^X" if -x "$CPAN::Cwd/$^X";
2294 my ($component,$perl_name);
2295 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
2296 PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
2297 next unless defined($component) && $component;
2298 my($abs) = MM->catfile($component,$perl_name);
2299 if (MM->maybe_command($abs)) {
2309 #-> sub CPAN::Distribution::make ;
2312 $self->debug($self->id) if $CPAN::DEBUG;
2313 print "Running make\n";
2317 $self->{archived} eq "NO" and push @e,
2318 "Is neither a tar nor a zip archive.";
2320 $self->{unwrapped} eq "NO" and push @e,
2321 "had problems unarchiving. Please build manually";
2323 exists $self->{writemakefile} &&
2324 $self->{writemakefile} eq "NO" and push @e,
2325 "Had some problem writing Makefile";
2327 defined $self->{'make'} and push @e,
2328 "Has already been processed within this session";
2330 print join "", map {" $_\n"} @e and return if @e;
2332 print "\n CPAN.pm: Going to build ".$self->id."\n\n";
2333 my $builddir = $self->dir;
2334 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2335 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
2338 if ($self->{'configure'}) {
2339 $system = $self->{'configure'};
2341 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
2343 # This needs a handler that can be turned on or off:
2344 # $switch = "-MExtUtils::MakeMaker ".
2345 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
2347 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
2349 $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
2352 if ($CPAN::Config->{inactivity_timeout}) {
2354 alarm $CPAN::Config->{inactivity_timeout};
2355 #$SIG{CHLD} = \&REAPER;
2356 if (defined($pid=fork)) {
2363 print "Cannot fork: $!";
2366 $ret = system($system);
2370 $ret = system($system);
2376 $self->{writemakefile} = "NO - $@";
2379 } elsif ($ret != 0) {
2380 $self->{writemakefile} = "NO";
2383 $self->{writemakefile} = "YES";
2384 return if $CPAN::Signal;
2385 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
2386 if (system($system)==0) {
2387 print " $system -- OK\n";
2388 $self->{'make'} = "YES";
2390 $self->{writemakefile} = "YES";
2391 $self->{'make'} = "NO";
2392 print " $system -- NOT OK\n";
2396 #-> sub CPAN::Distribution::test ;
2400 return if $CPAN::Signal;
2401 print "Running make test\n";
2404 exists $self->{'make'} or push @e,
2405 "Make had some problems, maybe interrupted? Won't test";
2407 exists $self->{'make'} and
2408 $self->{'make'} eq 'NO' and
2409 push @e, "Oops, make had returned bad status";
2411 exists $self->{'build_dir'} or push @e, "Has no own directory";
2412 print join "", map {" $_\n"} @e and return if @e;
2414 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2415 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2416 my $system = join " ", $CPAN::Config->{'make'}, "test";
2417 if (system($system)==0) {
2418 print " $system -- OK\n";
2419 $self->{'make_test'} = "YES";
2421 $self->{'make_test'} = "NO";
2422 print " $system -- NOT OK\n";
2426 #-> sub CPAN::Distribution::clean ;
2429 print "Running make clean\n";
2432 exists $self->{'build_dir'} or push @e, "Has no own directory";
2433 print join "", map {" $_\n"} @e and return if @e;
2435 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2436 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2437 my $system = join " ", $CPAN::Config->{'make'}, "clean";
2438 if (system($system)==0) {
2439 print " $system -- OK\n";
2442 # Hmmm, what to do if make clean failed?
2446 #-> sub CPAN::Distribution::install ;
2450 return if $CPAN::Signal;
2451 print "Running make install\n";
2454 exists $self->{'build_dir'} or push @e, "Has no own directory";
2456 exists $self->{'make'} or push @e,
2457 "Make had some problems, maybe interrupted? Won't install";
2459 exists $self->{'make'} and
2460 $self->{'make'} eq 'NO' and
2461 push @e, "Oops, make had returned bad status";
2463 push @e, "make test had returned bad status, won't install without force"
2464 if exists $self->{'make_test'} and
2465 $self->{'make_test'} eq 'NO' and
2466 ! $self->{'force_update'};
2468 exists $self->{'install'} and push @e,
2469 $self->{'install'} eq "YES" ?
2470 "Already done" : "Already tried without success";
2472 print join "", map {" $_\n"} @e and return if @e;
2474 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2475 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2476 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
2477 my($pipe) = FileHandle->new("$system 2>&1 |");
2485 print " $system -- OK\n";
2486 $self->{'install'} = "YES";
2488 $self->{'install'} = "NO";
2489 print " $system -- NOT OK\n";
2490 if ($makeout =~ /permission/s && $> > 0) {
2491 print " You may have to su to root to install the package\n";
2496 #-> sub CPAN::Distribution::dir ;
2498 shift->{'build_dir'};
2501 package CPAN::Bundle;
2502 @CPAN::Bundle::ISA = qw(CPAN::Module);
2504 #-> sub CPAN::Bundle::as_string ;
2508 $self->{INST_VERSION} = $self->inst_version;
2509 return $self->SUPER::as_string;
2512 #-> sub CPAN::Bundle::contains ;
2515 my($parsefile) = $self->inst_file;
2516 unless ($parsefile) {
2517 # Try to get at it in the cpan directory
2518 $self->debug("no parsefile") if $CPAN::DEBUG;
2519 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
2520 $self->debug($dist->as_string) if $CPAN::DEBUG;
2522 $self->debug($dist->as_string) if $CPAN::DEBUG;
2523 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2524 File::Path::mkpath($todir);
2526 ($me = $self->id) =~ s/.*://;
2527 $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
2528 $to = $CPAN::META->catfile($todir,"$me.pm");
2529 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
2533 my $fh = new FileHandle;
2535 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
2537 $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
2539 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
2544 push @result, (split " ", $_, 2)[0];
2547 delete $self->{STATUS};
2548 $self->{CONTAINS} = join ", ", @result;
2549 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
2553 #-> sub CPAN::Bundle::inst_file ;
2557 ($me = $self->id) =~ s/.*://;
2558 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
2559 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2561 $self->SUPER::inst_file;
2562 # return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2563 # return $self->{'INST_FILE'}; # even if undefined?
2566 #-> sub CPAN::Bundle::rematein ;
2568 my($self,$meth) = @_;
2569 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
2571 for $s ($self->contains) {
2572 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
2573 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
2574 if ($type eq 'CPAN::Distribution') {
2576 The Bundle }.$self->id.qq{ contains
2577 explicitly a file $s.
2581 $CPAN::META->instance($type,$s)->$meth();
2585 #-> sub CPAN::Bundle::force ;
2586 sub force { shift->rematein('force',@_); }
2587 #-> sub CPAN::Bundle::get ;
2588 sub get { shift->rematein('get',@_); }
2589 #-> sub CPAN::Bundle::make ;
2590 sub make { shift->rematein('make',@_); }
2591 #-> sub CPAN::Bundle::test ;
2592 sub test { shift->rematein('test',@_); }
2593 #-> sub CPAN::Bundle::install ;
2594 sub install { shift->rematein('install',@_); }
2595 #-> sub CPAN::Bundle::clean ;
2596 sub clean { shift->rematein('clean',@_); }
2598 #-> sub CPAN::Bundle::readme ;
2601 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
2602 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
2603 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
2606 package CPAN::Module;
2607 @CPAN::Module::ISA = qw(CPAN::InfoObj);
2609 #-> sub CPAN::Module::as_glimpse ;
2613 my $class = ref($self);
2614 $class =~ s/^CPAN:://;
2615 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
2619 #-> sub CPAN::Module::as_string ;
2623 CPAN->debug($self) if $CPAN::DEBUG;
2624 my $class = ref($self);
2625 $class =~ s/^CPAN:://;
2627 push @m, $class, " id = $self->{ID}\n";
2628 my $sprintf = " %-12s %s\n";
2629 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
2630 my $sprintf2 = " %-12s %s (%s)\n";
2632 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
2637 $CPAN::META->instance(CPAN::Author,$userid)->fullname
2640 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
2641 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
2642 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
2643 my(%statd,%stats,%statl,%stati);
2644 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
2645 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
2646 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
2647 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
2648 $statd{' '} = 'unknown';
2649 $stats{' '} = 'unknown';
2650 $statl{' '} = 'unknown';
2651 $stati{' '} = 'unknown';
2659 $statd{$self->{statd}},
2660 $stats{$self->{stats}},
2661 $statl{$self->{statl}},
2662 $stati{$self->{stati}}
2663 ) if $self->{statd};
2664 my $local_file = $self->inst_file;
2665 if ($local_file && ! exists $self->{MANPAGE}) {
2666 my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
2671 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
2679 $self->{MANPAGE} = join " ", @result;
2682 for $item (qw/MANPAGE CONTAINS/) {
2683 push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
2685 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
2686 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
2690 #-> sub CPAN::Module::cpan_file ;
2693 CPAN->debug($self->id) if $CPAN::DEBUG;
2694 unless (defined $self->{'CPAN_FILE'}) {
2695 CPAN::Index->reload;
2697 if (defined $self->{'CPAN_FILE'}){
2698 return $self->{'CPAN_FILE'};
2699 } elsif (defined $self->{'userid'}) {
2700 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
2706 *name = \&cpan_file;
2708 #-> sub CPAN::Module::cpan_version ;
2709 sub cpan_version { shift->{'CPAN_VERSION'} }
2711 #-> sub CPAN::Module::force ;
2714 $self->{'force_update'}++;
2717 #-> sub CPAN::Module::rematein ;
2719 my($self,$meth) = @_;
2720 $self->debug($self->id) if $CPAN::DEBUG;
2721 my $cpan_file = $self->cpan_file;
2722 return if $cpan_file eq "N/A";
2723 return if $cpan_file =~ /^Contact Author/;
2724 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2725 $pack->called_for($self->id);
2726 $pack->force if exists $self->{'force_update'};
2728 delete $self->{'force_update'};
2731 #-> sub CPAN::Module::readme ;
2732 sub readme { shift->rematein('readme') }
2733 #-> sub CPAN::Module::look ;
2734 sub look { shift->rematein('look') }
2735 #-> sub CPAN::Module::get ;
2736 sub get { shift->rematein('get',@_); }
2737 #-> sub CPAN::Module::make ;
2738 sub make { shift->rematein('make') }
2739 #-> sub CPAN::Module::test ;
2740 sub test { shift->rematein('test') }
2741 #-> sub CPAN::Module::install ;
2745 my($latest) = $self->cpan_version;
2747 my($inst_file) = $self->inst_file;
2749 if (defined $inst_file) {
2750 $have = $self->inst_version;
2752 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
2753 print $self->id, " is up to date.\n";
2757 $self->rematein('install') if $doit;
2759 #-> sub CPAN::Module::clean ;
2760 sub clean { shift->rematein('clean') }
2762 #-> sub CPAN::Module::inst_file ;
2766 @packpath = split /::/, $self->{ID};
2767 $packpath[-1] .= ".pm";
2768 foreach $dir (@INC) {
2769 my $pmfile = CPAN->catfile($dir,@packpath);
2777 #-> sub CPAN::Module::xs_file ;
2781 @packpath = split /::/, $self->{ID};
2782 push @packpath, $packpath[-1];
2783 $packpath[-1] .= "." . $Config::Config{'dlext'};
2784 foreach $dir (@INC) {
2785 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
2793 #-> sub CPAN::Module::inst_version ;
2796 my $parsefile = $self->inst_file or return 0;
2797 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
2798 my $have = MM->parse_version($parsefile);
2805 # Do this after you have set up the whole inheritance
2806 CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
2812 CPAN - query, download and build perl modules from CPAN sites
2818 perl -MCPAN -e shell;
2824 autobundle, clean, install, make, recompile, test
2828 The CPAN module is designed to automate the make and install of perl
2829 modules and extensions. It includes some searching capabilities and
2830 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
2831 to fetch the raw data from the net.
2833 Modules are fetched from one or more of the mirrored CPAN
2834 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
2837 The CPAN module also supports the concept of named and versioned
2838 'bundles' of modules. Bundles simplify the handling of sets of
2839 related modules. See BUNDLES below.
2841 The package contains a session manager and a cache manager. There is
2842 no status retained between sessions. The session manager keeps track
2843 of what has been fetched, built and installed in the current
2844 session. The cache manager keeps track of the disk space occupied by
2845 the make processes and deletes excess space according to a simple FIFO
2848 All methods provided are accessible in a programmer style and in an
2849 interactive shell style.
2851 =head2 Interactive Mode
2853 The interactive mode is entered by running
2855 perl -MCPAN -e shell
2857 which puts you into a readline interface. You will have most fun if
2858 you install Term::ReadKey and Term::ReadLine to enjoy both history and
2861 Once you are on the command line, type 'h' and the rest should be
2864 The most common uses of the interactive modes are
2868 =item Searching for authors, bundles, distribution files and modules
2870 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
2871 for each of the four categories and another, C<i> for any of the
2872 mentioned four. Each of the four entities is implemented as a class
2873 with slightly differing methods for displaying an object.
2875 Arguments you pass to these commands are either strings matching exact
2876 the identification string of an object or regular expressions that are
2877 then matched case-insensitively against various attributes of the
2878 objects. The parser recognizes a regualar expression only if you
2879 enclose it between two slashes.
2881 The principle is that the number of found objects influences how an
2882 item is displayed. If the search finds one item, we display the result
2883 of object-E<gt>as_string, but if we find more than one, we display
2884 each as object-E<gt>as_glimpse. E.g.
2888 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2889 FULLNAME Andreas König
2894 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2895 FULLNAME Andreas König
2899 Author ANDYD (Andy Dougherty)
2900 Author MERLYN (Randal L. Schwartz)
2902 =item make, test, install, clean modules or distributions
2904 These commands do indeed exist just as written above. Each of them
2905 takes any number of arguments and investigates for each what it might
2906 be. Is it a distribution file (recognized by embedded slashes), this
2907 file is being processed. Is it a module, CPAN determines the
2908 distribution file where this module is included and processes that.
2910 Any C<make>, C<test>, and C<readme> are run unconditionally. A
2912 install <distribution_file>
2914 also is run unconditionally. But for
2918 CPAN checks if an install is actually needed for it and prints
2919 I<Foo up to date> in case the module doesnE<39>t need to be updated.
2921 CPAN also keeps track of what it has done within the current session
2922 and doesnE<39>t try to build a package a second time regardless if it
2923 succeeded or not. The C<force > command takes as first argument the
2924 method to invoke (currently: make, test, or install) and executes the
2925 command from scratch.
2929 cpan> install OpenGL
2930 OpenGL is up to date.
2931 cpan> force install OpenGL
2934 OpenGL-0.4/COPYRIGHT
2937 =item readme, look module or distribution
2939 These two commands take only one argument, be it a module or a
2940 distribution file. C<readme> displays the README of the associated
2941 distribution file. C<Look> gets and untars (if not yet done) the
2942 distribution file, changes to the appropriate directory and opens a
2943 subshell process in that directory.
2949 The commands that are available in the shell interface are methods in
2950 the package CPAN::Shell. If you enter the shell command, all your
2951 input is split by the Text::ParseWords::shellwords() routine which
2952 acts like most shells do. The first word is being interpreted as the
2953 method to be called and the rest of the words are treated as arguments
2958 C<autobundle> writes a bundle file into the
2959 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
2960 a list of all modules that are both available from CPAN and currently
2961 installed within @INC. The name of the bundle file is based on the
2962 current date and a counter.
2966 recompile() is a very special command in that it takes no argument and
2967 runs the make/test/install cycle with brute force over all installed
2968 dynamically loadable extensions (aka XS modules) with 'force' in
2969 effect. Primary purpose of this command is to finish a network
2970 installation. Imagine, you have a common source tree for two different
2971 architectures. You decide to do a completely independent fresh
2972 installation. You start on one architecture with the help of a Bundle
2973 file produced earlier. CPAN installs the whole Bundle for you, but
2974 when you try to repeat the job on the second architecture, CPAN
2975 responds with a C<"Foo up to date"> message for all modules. So you
2976 will be glad to run recompile in the second architecture and
2979 Another popular use for C<recompile> is to act as a rescue in case your
2980 perl breaks binary compatibility. If one of the modules that CPAN uses
2981 is in turn depending on binary compatibility (so you cannot run CPAN
2982 commands), then you should try the CPAN::Nox module for recovery.
2984 =head2 ProgrammerE<39>s interface
2986 If you do not enter the shell, the available shell commands are both
2987 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
2988 functions in the calling package (C<install(...)>). The
2989 programmerE<39>s interface has beta status. Do not heavily rely on it,
2990 changes may still be necessary.
2992 =head2 Cache Manager
2994 Currently the cache manager only keeps track of the build directory
2995 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
2996 deletes complete directories below C<build_dir> as soon as the size of
2997 all directories there gets bigger than $CPAN::Config->{build_cache}
2998 (in MB). The contents of this cache may be used for later
2999 re-installations that you intend to do manually, but will never be
3000 trusted by CPAN itself. This is due to the fact that the user might
3001 use these directories for building modules on different architectures.
3003 There is another directory ($CPAN::Config->{keep_source_where}) where
3004 the original distribution files are kept. This directory is not
3005 covered by the cache manager and must be controlled by the user. If
3006 you choose to have the same directory as build_dir and as
3007 keep_source_where directory, then your sources will be deleted with
3008 the same fifo mechanism.
3012 A bundle is just a perl module in the namespace Bundle:: that does not
3013 define any functions or methods. It usually only contains documentation.
3015 It starts like a perl module with a package declaration and a $VERSION
3016 variable. After that the pod section looks like any other pod with the
3017 only difference, that I<one special pod section> exists starting with
3022 In this pod section each line obeys the format
3024 Module_Name [Version_String] [- optional text]
3026 The only required part is the first field, the name of a module
3027 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
3028 of the line is optional. The comment part is delimited by a dash just
3029 as in the man page header.
3031 The distribution of a bundle should follow the same convention as
3032 other distributions.
3034 Bundles are treated specially in the CPAN package. If you say 'install
3035 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
3036 the modules in the CONTENTS section of the pod. You can install your
3037 own Bundles locally by placing a conformant Bundle file somewhere into
3038 your @INC path. The autobundle() command which is available in the
3039 shell interface does that for you by including all currently installed
3040 modules in a snapshot bundle file.
3042 There is a meaningless Bundle::Demo available on CPAN. Try to install
3043 it, it usually does no harm, just demonstrates what the Bundle
3044 interface looks like.
3046 =head2 Prerequisites
3048 If you have a local mirror of CPAN and can access all files with
3049 "file:" URLs, then you only need a perl better than perl5.003 to run
3050 this module. Otherwise Net::FTP is strongly recommended. LWP may be
3051 required for non-UNIX systems or if your nearest CPAN site is
3052 associated with an URL that is not C<ftp:>.
3054 If you have neither Net::FTP nor LWP, there is a fallback mechanism
3055 implemented for an external ftp command or for an external lynx
3058 This module presumes that all packages on CPAN
3064 declare their $VERSION variable in an easy to parse manner. This
3065 prerequisite can hardly be relaxed because it consumes by far too much
3066 memory to load all packages into the running program just to determine
3067 the $VERSION variable . Currently all programs that are dealing with
3068 version use something like this
3070 perl -MExtUtils::MakeMaker -le \
3071 'print MM->parse_version($ARGV[0])' filename
3073 If you are author of a package and wonder if your $VERSION can be
3074 parsed, please try the above method.
3078 come as compressed or gzipped tarfiles or as zip files and contain a
3079 Makefile.PL (well we try to handle a bit more, but without much
3086 The debugging of this module is pretty difficult, because we have
3087 interferences of the software producing the indices on CPAN, of the
3088 mirroring process on CPAN, of packaging, of configuration, of
3089 synchronicity, and of bugs within CPAN.pm.
3091 In interactive mode you can try "o debug" which will list options for
3092 debugging the various parts of the package. The output may not be very
3093 useful for you as it's just a byproduct of my own testing, but if you
3094 have an idea which part of the package may have a bug, it's sometimes
3095 worth to give it a try and send me more specific output. You should
3096 know that "o debug" has built-in completion support.
3098 =head2 Floppy, Zip, and all that Jazz
3100 CPAN.pm works nicely without network too. If you maintain machines
3101 that are not networked at all, you should consider working with file:
3102 URLs. Of course, you have to collect your modules somewhere first. So
3103 you might use CPAN.pm to put together all you need on a networked
3104 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
3105 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
3106 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
3109 =head1 CONFIGURATION
3111 When the CPAN module is installed a site wide configuration file is
3112 created as CPAN/Config.pm. The default values defined there can be
3113 overridden in another configuration file: CPAN/MyConfig.pm. You can
3114 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
3115 $HOME/.cpan is added to the search path of the CPAN module before the
3116 use() or require() statements.
3118 Currently the following keys in the hash reference $CPAN::Config are
3121 build_cache size of cache for directories to build modules
3122 build_dir locally accessible directory to build modules
3123 index_expire after how many days refetch index files
3124 cpan_home local directory reserved for this package
3125 gzip location of external program gzip
3126 inactivity_timeout breaks interactive Makefile.PLs after that
3127 many seconds inactivity. Set to 0 to never break.
3128 inhibit_startup_message
3129 if true, does not print the startup message
3130 keep_source keep the source in a local directory?
3131 keep_source_where where keep the source (if we do)
3132 make location of external program make
3133 make_arg arguments that should always be passed to 'make'
3134 make_install_arg same as make_arg for 'make install'
3135 makepl_arg arguments passed to 'perl Makefile.PL'
3136 pager location of external program more (or any pager)
3137 tar location of external program tar
3138 unzip location of external program unzip
3139 urllist arrayref to nearby CPAN sites (or equivalent locations)
3141 You can set and query each of these options interactively in the cpan
3142 shell with the command set defined within the C<o conf> command:
3146 =item o conf E<lt>scalar optionE<gt>
3148 prints the current value of the I<scalar option>
3150 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
3152 Sets the value of the I<scalar option> to I<value>
3154 =item o conf E<lt>list optionE<gt>
3156 prints the current value of the I<list option> in MakeMaker's
3159 =item o conf E<lt>list optionE<gt> [shift|pop]
3161 shifts or pops the array in the I<list option> variable
3163 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
3165 works like the corresponding perl commands.
3171 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
3172 install foreign, unmasked, unsigned code on your machine. We compare
3173 to a checksum that comes from the net just as the distribution file
3174 itself. If somebody has managed to tamper with the distribution file,
3175 they may have as well tampered with the CHECKSUMS file. Future
3176 development will go towards strong authentification.
3180 Most functions in package CPAN are exported per default. The reason
3181 for this is that the primary use is intended for the cpan shell or for
3186 we should give coverage for _all_ of the CPAN and not just the
3187 __PAUSE__ part, right? In this discussion CPAN and PAUSE have become
3188 equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
3189 PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
3191 Future development should be directed towards a better intergration of
3196 Andreas König E<lt>a.koenig@mind.deE<gt>
3200 perl(1), CPAN::Nox(3)