2 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
6 # $Id: CPAN.pm,v 1.92 1996/12/23 13:13:05 k Exp $
8 # my $version = substr q$Revision: 1.92 $, 10; # only used during development
10 BEGIN {require 5.003;}
11 require UNIVERSAL if $] == 5.003;
18 use ExtUtils::MakeMaker ();
19 use File::Basename ();
25 use Text::ParseWords ();
29 END { $End++; &cleanup; }
50 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META);
53 @CPAN::ISA = qw(CPAN::Debug Exporter MY); # the MY class from
57 $META ||= new CPAN; # In case we reeval ourselves we
62 @EXPORT = qw(autobundle bundle expand force install make 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 = IO::File->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 ($other). Trying to contact...\n};
122 if (kill 0, $other) {
123 Carp::croak qq{Other job is running.\n}.
124 qq{You may want to kill it and delete the lockfile, maybe. On UNIX try:\n}.
127 } elsif (-w $lockfile) {
129 ExtUtils::MakeMaker::prompt
130 (qq{Other job not responding. Shall I overwrite the lockfile? (Y/N)},"y");
131 print("Ok, bye\n"), exit unless $ans =~ /^y/i;
134 qq{Lockfile $lockfile not writeable by you. Cannot proceed.\n}.
137 qq{ and then rerun us.\n}
142 File::Path::mkpath($CPAN::Config->{cpan_home});
144 unless ($fh = IO::File->new(">$lockfile")) {
145 if ($! =~ /Permission/) {
146 my $incc = $INC{'CPAN/Config.pm'};
147 my $myincc = MY->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
150 Your configuration suggests that CPAN.pm should use a working
152 $CPAN::Config->{cpan_home}
153 Unfortunately we could not create the lock file
155 due to permission problems.
157 Please make sure that the configuration variable
158 \$CPAN::Config->{cpan_home}
159 points to a directory where you can write a .lock file. You can set
160 this variable in either
167 Carp::croak "Could not open >$lockfile: $!";
170 $self->{LOCK} = $lockfile;
172 $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
173 $SIG{'INT'} = sub { &cleanup, die "Got a second SIGINT" if $Signal; $Signal = 1; };
174 $SIG{'__DIE__'} = \&cleanup;
175 print STDERR "Signal handler set.\n" unless $CPAN::Config->{'inhibit_startup_message'};
178 #-> sub CPAN::DESTROY ;
180 &cleanup; # need an eval?
183 #-> sub CPAN::exists ;
185 my($mgr,$class,$id) = @_;
187 Carp::croak "exists called without class argument" unless $class;
189 exists $META->{$class}{$id};
192 #-> sub CPAN::hasFTP ;
196 return $self->{'hasFTP'} = $arg;
197 } elsif (not defined $self->{'hasFTP'}) {
198 eval {require Net::FTP;};
199 $self->{'hasFTP'} = $@ ? 0 : 1;
201 return $self->{'hasFTP'};
204 #-> sub CPAN::hasLWP ;
208 return $self->{'hasLWP'} = $arg;
209 } elsif (not defined $self->{'hasLWP'}) {
212 $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
214 return $self->{'hasLWP'};
217 #-> sub CPAN::hasMD5 ;
221 $self->{'hasMD5'} = $arg;
222 } elsif (not defined $self->{'hasMD5'}) {
225 print "MD5 security checks disabled because MD5 not installed. Please consider installing MD5\n";
226 $self->{'hasMD5'} = 0;
231 return $self->{'hasMD5'};
234 #-> sub CPAN::instance ;
236 my($mgr,$class,$id) = @_;
238 Carp::croak "instance called without class argument" unless $class;
240 $META->{$class}{$id} ||= $class->new(ID => $id );
248 #-> sub CPAN::cleanup ;
250 local $SIG{__DIE__} = '';
251 my $i = 0; my $ineval = 0; my $sub;
252 while ((undef,undef,undef,$sub) = caller(++$i)) {
253 $ineval = 1, last if $sub eq '(eval)';
255 return if $ineval && !$End;
256 return unless defined $META->{'LOCK'};
257 return unless -f $META->{'LOCK'};
258 unlink $META->{'LOCK'};
259 print STDERR "Lockfile removed.\n";
260 # my $mess = Carp::longmess(@_);
264 #-> sub CPAN::shell ;
266 $Suppress_readline ||= ! -t STDIN;
268 my $prompt = "cpan> ";
271 unless ($Suppress_readline) {
272 require Term::ReadLine;
273 import Term::ReadLine;
274 $term = new Term::ReadLine 'CPAN Monitor';
275 $readline::rl_completion_function =
276 $readline::rl_completion_function = 'CPAN::Complete::complete';
281 my $cwd = Cwd::cwd();
282 # How should we determine if we have more than stub ReadLine enabled?
283 my $rl_avail = $Suppress_readline ? "suppressed" :
284 defined &Term::ReadLine::Perl::readline ? "enabled" :
285 "available (get Term::ReadKey and Term::ReadLine)";
288 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
289 Readline support $rl_avail
291 } unless $CPAN::Config->{'inhibit_startup_message'} ;
293 if ($Suppress_readline) {
295 last unless defined (chomp($_ = <>));
297 last unless defined ($_ = $term->readline($prompt));
301 $_ = 'h' if $_ eq '?';
306 use vars qw($import_done);
307 CPAN->import(':DEFAULT') unless $import_done++;
308 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
311 } elsif (/^q(?:uit)?$/i) {
315 eval { @line = Text::ParseWords::shellwords($_) };
316 warn($@), next if $@;
317 $CPAN::META->debug("line[".join(":",@line)."]") if $CPAN::DEBUG;
318 my $command = shift @line;
319 eval { CPAN::Shell->$command(@line) };
323 &cleanup, die if $Signal;
330 use vars qw($AUTOLOAD);
331 @CPAN::Shell::ISA = qw(CPAN::Debug);
333 # private function ro re-eval this module (handy during development)
334 #-> sub CPAN::Shell::AUTOLOAD ;
336 warn "CPAN::Shell doesn't know how to autoload $AUTOLOAD :-(
342 #-> sub CPAN::Shell::h ;
344 my($class,$about) = @_;
345 if (defined $about) {
346 print "Detailed help not yet implemented\n";
349 command arguments description
352 d /regex/ info distributions
354 i none anything of above
356 r as reinstall recommendations
357 u above uninstalled distributions
358 See manpage for autobundle, recompile, force, etc.
361 test dists, bundles, make test (implies make)
362 install "r" or "u" make install (implies test)
365 reload index|cpan load most recent indices/CPAN.pm
366 h or ? display this menu
367 o various set and query options
368 ! perl-code eval a perl command
369 q quit the shell subroutine
374 #-> sub CPAN::Shell::a ;
375 sub a { print shift->format_result('Author',@_);}
376 #-> sub CPAN::Shell::b ;
378 my($self,@which) = @_;
379 my($incdir,$bdir,$dh);
380 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
381 $bdir = $CPAN::META->catdir($incdir,"Bundle");
382 if ($dh = DirHandle->new($bdir)) { # may fail
384 for $entry ($dh->read) {
385 next if -d $CPAN::META->catdir($bdir,$entry);
386 next unless $entry =~ s/\.pm$//;
387 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
391 print $self->format_result('Bundle',@which);
393 #-> sub CPAN::Shell::d ;
394 sub d { print shift->format_result('Distribution',@_);}
395 #-> sub CPAN::Shell::m ;
396 sub m { print shift->format_result('Module',@_);}
398 #-> sub CPAN::Shell::i ;
403 @type = qw/Author Bundle Distribution Module/;
404 @args = '/./' unless @args;
407 push @result, $self->expand($type,@args);
409 my $result = @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result;
410 $result ||= "No objects found of any type for argument @args\n";
414 #-> sub CPAN::Shell::o ;
416 my($self,$o_type,@o_what) = @_;
418 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
419 if ($o_type eq 'conf') {
420 shift @o_what if @o_what && $o_what[0] eq 'help';
423 print "CPAN::Config options:\n";
424 for $k (sort keys %CPAN::Config::can) {
425 $v = $CPAN::Config::can{$k};
426 printf " %-18s %s\n", $k, $v;
429 for $k (sort keys %$CPAN::Config) {
430 $v = $CPAN::Config->{$k};
432 printf " %-18s\n", $k;
433 print map {"\t$_\n"} @{$v};
435 printf " %-18s %s\n", $k, $v;
439 } elsif (!CPAN::Config->edit(@o_what)) {
440 print qq[Type 'o conf' to view configuration edit options\n\n];
442 } elsif ($o_type eq 'debug') {
444 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
447 my($what) = shift @o_what;
448 if ( exists $CPAN::DEBUG{$what} ) {
449 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
450 } elsif ($what =~ /^\d/) {
451 $CPAN::DEBUG = $what;
452 } elsif (lc $what eq 'all') {
454 for (values %CPAN::DEBUG) {
459 for (keys %CPAN::DEBUG) {
460 next unless lc($_) eq lc($what);
461 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
463 print "unknown argument $what\n";
467 print "Valid options for debug are ".join(", ",sort(keys %CPAN::DEBUG), 'all').
468 " or a number. Completion works on the options. Case is ignored.\n\n";
471 print "Options set for debugging:\n";
473 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
474 $v = $CPAN::DEBUG{$k};
475 printf " %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
478 print "Debugging turned off completely.\n";
483 conf set or get configuration variables
484 debug set or get debugging options
489 #-> sub CPAN::Shell::reload ;
491 if ($_[1] =~ /cpan/i) {
492 CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
493 my $fh = IO::File->new($INC{'CPAN.pm'});
498 } elsif ($_[1] =~ /index/) {
499 CPAN::Index->force_reload;
503 #-> sub CPAN::Shell::_binary_extensions ;
504 sub _binary_extensions {
505 my($self) = shift @_;
506 my(@result,$module,%seen,%need,$headerdone);
507 for $module ($self->expand('Module','/./')) {
508 my $file = $module->cpan_file;
509 next if $file eq "N/A";
510 next if $file =~ /^Contact Author/;
511 next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
512 next unless $module->xs_file;
513 push @result, $module;
515 # print join " | ", @result;
520 #-> sub CPAN::Shell::recompile ;
522 my($self) = shift @_;
523 my($module,@module,$cpan_file,%dist);
524 @module = $self->_binary_extensions();
525 for $module (@module){ # we force now and compile later, so we don't do it twice
526 $cpan_file = $module->cpan_file;
527 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
531 for $cpan_file (sort keys %dist) {
532 print " CPAN: Recompiling $cpan_file\n\n";
533 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
535 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
536 # stop a package from recompiling,
537 # e.g. IO-1.12 when we have perl5.003_10
541 #-> sub CPAN::Shell::_u_r_common ;
543 my($self) = shift @_;
544 my($what) = shift @_;
545 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
546 Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
547 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
549 @args = '/./' unless @args;
550 my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
552 my $sprintf = "%-25s %9s %9s %s\n";
553 for $module ($self->expand('Module',@args)) {
554 my $file = $module->cpan_file;
555 next unless defined $file; # ??
556 my($latest) = $module->cpan_version || 0;
557 my($inst_file) = $module->inst_file;
561 $have = $module->inst_version;
562 } elsif ($what eq "r") {
563 $have = $module->inst_version;
565 $version_zeroes++ unless $have;
566 next if $have >= $latest;
567 } elsif ($what eq "u") {
573 } elsif ($what eq "r") {
575 } elsif ($what eq "u") {
581 push @result, sprintf "%s %s\n", $module->id, $have;
582 } elsif ($what eq "r") {
583 push @result, $module->id;
584 next if $seen{$file}++;
585 } elsif ($what eq "u") {
586 push @result, $module->id;
587 next if $seen{$file}++;
588 next if $file =~ /^Contact/;
590 unless ($headerdone++){
592 printf $sprintf, "Package namespace", "installed", "latest", "in CPAN file";
594 $latest = substr($latest,0,8) if length($latest) > 8;
595 $have = substr($have,0,8) if length($have) > 8;
596 printf $sprintf, $module->id, $have, $latest, $file;
597 $need{$module->id}++;
598 return if $CPAN::Signal; # this is sometimes lengthy
602 print "No modules found for @args\n";
603 } elsif ($what eq "r") {
604 print "All modules are up to date for @args\n";
607 if ($what eq "r" && $version_zeroes) {
608 my $s = $version_zeroes>1 ? "s have" : " has";
609 print qq{$version_zeroes installed module$s no version number to compare\n};
614 #-> sub CPAN::Shell::r ;
616 shift->_u_r_common("r",@_);
619 #-> sub CPAN::Shell::u ;
621 shift->_u_r_common("u",@_);
624 #-> sub CPAN::Shell::autobundle ;
627 my(@bundle) = $self->_u_r_common("a",@_);
628 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
629 File::Path::mkpath($todir);
631 print "Couldn't mkdir $todir for some reason\n";
634 my($y,$m,$d) = (localtime)[5,4,3];
638 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
639 my($to) = $CPAN::META->catfile($todir,"$me.pm");
641 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
642 $to = $CPAN::META->catfile($todir,"$me.pm");
644 my($fh) = IO::File->new(">$to") or Carp::croak "Can't open >$to: $!";
646 "package Bundle::$me;\n\n",
647 "\$VERSION = '0.01';\n\n",
651 "Bundle::$me - Snapshot of installation on ",
652 $Config::Config{'myhostname'},
655 "\n\n=head1 SYNOPSIS\n\n",
656 "perl -MCPAN -e 'install Bundle::$me'\n\n",
657 "=head1 CONTENTS\n\n",
659 "\n\n=head1 CONFIGURATION\n\n",
661 "\n\n=head1 AUTHOR\n\n",
662 "This Bundle has been generated automatically by the autobundle routine in CPAN.pm.\n",
665 print "\nWrote bundle file
669 #-> sub CPAN::Shell::expand ;
672 my($type,@args) = @_;
676 if ($arg =~ m|^/(.*)/$|) {
679 my $class = "CPAN::$type";
681 if (defined $regex) {
682 for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
683 push @m, $obj if $obj->id =~ /$regex/i or $obj->can('name') && $obj->name =~ /$regex/i;
687 if ( $type eq 'Bundle' ) {
688 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
690 if ($CPAN::META->exists($class,$xarg)) {
691 $obj = $CPAN::META->instance($class,$xarg);
692 } elsif ($obj = $CPAN::META->exists($class,$arg)) {
693 $obj = $CPAN::META->instance($class,$arg);
703 #-> sub CPAN::Shell::format_result ;
706 my($type,@args) = @_;
707 @args = '/./' unless @args;
708 my(@result) = $self->expand($type,@args);
709 my $result = @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result;
710 $result ||= "No objects of type $type found for argument @args\n";
714 #-> sub CPAN::Shell::rematein ;
717 my($meth,@some) = @_;
719 if ($meth eq 'force') {
723 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
729 } elsif ($s =~ m|/|) { # looks like a file
730 $obj = $CPAN::META->instance('CPAN::Distribution',$s);
731 } elsif ($s =~ m|^Bundle::|) {
732 $obj = $CPAN::META->instance('CPAN::Bundle',$s);
734 $obj = $CPAN::META->instance('CPAN::Module',$s) if $CPAN::META->exists('CPAN::Module',$s);
737 CPAN->debug(qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.$obj->as_string.qq{\]}) if $CPAN::DEBUG;
738 $obj->$pragma() if $pragma && $obj->can($pragma);
741 print "Warning: Cannot $meth $s, don't know what it is\n";
746 #-> sub CPAN::Shell::force ;
747 sub force { shift->rematein('force',@_); }
748 #-> sub CPAN::Shell::readme ;
749 sub readme { shift->rematein('readme',@_); }
750 #-> sub CPAN::Shell::make ;
751 sub make { shift->rematein('make',@_); }
752 #-> sub CPAN::Shell::clean ;
753 sub clean { shift->rematein('clean',@_); }
754 #-> sub CPAN::Shell::test ;
755 sub test { shift->rematein('test',@_); }
756 #-> sub CPAN::Shell::install ;
757 sub install { shift->rematein('install',@_); }
761 @CPAN::FTP::ISA = qw(CPAN::Debug);
763 #-> sub CPAN::FTP::ftp_get ;
765 my($class,$host,$dir,$file,$target) = @_;
767 qq[Going to fetch file [$file] from dir [$dir]
768 on host [$host] as local [$target]\n]
770 my $ftp = Net::FTP->new($host);
771 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
772 $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
773 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
774 warn "Couldn't login on $host";
777 # print qq[Going to ->cwd("$dir")\n];
778 unless ( $ftp->cwd($dir) ){
779 warn "Couldn't cwd $dir";
783 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
784 unless ( $ftp->get($file,$target) ){
785 warn "Couldn't fetch $file from $host";
791 #-> sub CPAN::FTP::localize ;
793 my($self,$file,$aslocal,$force) = @_;
795 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])" unless defined $aslocal;
796 $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
798 return $aslocal if -f $aslocal && -r _ && ! $force;
800 my($aslocal_dir) = File::Basename::dirname($aslocal);
801 File::Path::mkpath($aslocal_dir);
802 print STDERR qq{Warning: You are not allowed to write into directory "$aslocal_dir".
803 I\'ll continue, but if you face any problems, they may be due
804 to insufficient permissions.\n} unless -w $aslocal_dir;
806 # Inheritance is not easier to manage than a few if/else branches
807 if ($CPAN::META->hasLWP) {
808 require LWP::UserAgent;
810 $Ua = new LWP::UserAgent;
811 $Ua->proxy('ftp', $ENV{'ftp_proxy'}) if defined $ENV{'ftp_proxy'};
812 $Ua->proxy('http', $ENV{'http_proxy'}) if defined $ENV{'http_proxy'};
813 $Ua->no_proxy($ENV{'no_proxy'}) if defined $ENV{'no_proxy'};
817 # Try the list of urls for each single object. We keep a record
818 # where we did get a file from
819 for (0..$#{$CPAN::Config->{urllist}}) {
820 my $url = $CPAN::Config->{urllist}[$_];
821 $url .= "/" unless substr($url,-1) eq "/";
823 $self->debug("localizing[$url]") if $CPAN::DEBUG;
824 if ($url =~ /^file:/) {
826 if ($CPAN::META->hasLWP) {
828 my $u = new URI::URL $url;
830 } else { # works only on Unix, is poorly constructed, but
831 # hopefully better than nothing.
832 # RFC 1738 says fileurl BNF is
833 # fileurl = "file://" [ host | "localhost" ] "/" fpath
834 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
835 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
836 $l =~ s/^file://; # assume they meant file://localhost
838 return $l if -f $l && -r _;
841 if ($CPAN::META->hasLWP) {
842 print "Fetching $url\n";
843 my $res = $Ua->mirror($url, $aslocal);
844 if ($res->is_success) {
848 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
849 my($host,$dir,$getfile) = ($1,$2,$3);
850 if ($CPAN::META->hasFTP) {
852 $self->debug("Going to fetch file [$getfile]
855 as local [$aslocal]") if $CPAN::DEBUG;
856 CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
857 } elsif (-x $CPAN::Config->{'ftp'}) {
858 my($netrc) = CPAN::FTP::netrc->new;
859 if ($netrc->contains($host)) {
862 Trying with external ftp to get $url
863 As this requires some features that are not thoroughly tested, we\'re
864 not sure, that we get it right. Please, install Net::FTP as soon
865 as possible. Just type "install Net::FTP". Thank you.
870 my($cwd) = Cwd::cwd();
872 my($targetfile) = File::Basename::basename($aslocal);
874 push @dialog, map {"cd $_\n"} split "/", $dir;
875 push @dialog, "get $getfile $targetfile\n";
876 push @dialog, "quit\n";
877 open(WTR, "|$CPAN::Config->{'ftp'} $host") or die "Couldn't open ftp: $!";
880 # print "To WTR>>$_<<\n";
887 my($netrcfile) = $netrc->{netrc};
889 print qq{ Your $netrcfile does not contain host $host.\n}
891 print qq{ I could not find or open your $netrcfile.\n}
893 print qq{ If you want to use external ftp,
894 please enter host $host into your .netrc file and retry.
896 The format of a proper entry in your .netrc file would be:
900 password $Config::Config{cf_email}
902 Please make also sure, your .netrc will not be readable by others.
903 You don\'t have to leave and restart CPAN.pm, I\'ll look again next
904 time I come around here.
909 if (-x $CPAN::Config->{'lynx'}) {
910 ## $self->debug("Trying with lynx for [$url]") if $CPAN::DEBUG;
911 my($want_compressed);
914 Trying with lynx to get $url
915 As lynx has so many options and versions, we\'re not sure, that we
916 get it right. It is recommended that you install Net::FTP as soon
917 as possible. Just type "install Net::FTP". Thank you.
921 $want_compressed = $aslocal =~ s/\.gz//;
922 my($system) = "$CPAN::Config->{'lynx'} -source '$url' > $aslocal";
923 if (system($system)==0) {
924 if ($want_compressed) {
925 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
926 if (system($system)==0) {
927 rename $aslocal, "$aslocal.gz";
929 $system = "$CPAN::Config->{'gzip'} $aslocal";
932 return "$aslocal.gz";
934 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
935 if (system($system)==0) {
936 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
939 # should be fine, eh?
945 warn "Can't access URL $url.
946 Either get LWP or Net::FTP
947 or an external lynx or ftp";
949 Carp::croak("Cannot fetch $file from anywhere");
952 package CPAN::FTP::external;
954 package CPAN::FTP::netrc;
958 my $file = MY->catfile($ENV{HOME},".netrc");
960 if($fh = IO::File->new($file,"r")){
963 next if /\bmacdef\b/;
964 my($machine) = /\bmachine\s+(\S+)/s;
965 push @machines, $machine;
977 my($self,$mach) = @_;
978 scalar grep {$_ eq $mach} @{$self->{mach}};
981 package CPAN::Complete;
982 @CPAN::Complete::ISA = qw(CPAN::Debug);
984 #-> sub CPAN::Complete::complete ;
986 my($word,$line,$pos) = @_;
990 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
994 @return = grep(/^$word/, sort qw(! a b d h i m o q r u autobundle clean make test install reload));
995 } elsif ( $line !~ /^[\!abdhimorut]/ ) {
997 } elsif ($line =~ /^a\s/) {
998 @return = completex('CPAN::Author',$word);
999 } elsif ($line =~ /^b\s/) {
1000 @return = completex('CPAN::Bundle',$word);
1001 } elsif ($line =~ /^d\s/) {
1002 @return = completex('CPAN::Distribution',$word);
1003 } elsif ($line =~ /^([mru]\s|(make|clean|test|install)\s)/ ) {
1004 @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
1005 } elsif ($line =~ /^i\s/) {
1006 @return = complete_any($word);
1007 } elsif ($line =~ /^reload\s/) {
1008 @return = complete_reload($word,$line,$pos);
1009 } elsif ($line =~ /^o\s/) {
1010 @return = complete_option($word,$line,$pos);
1017 #-> sub CPAN::Complete::completex ;
1019 my($class, $word) = @_;
1020 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1023 #-> sub CPAN::Complete::complete_any ;
1027 completex('CPAN::Author',$word),
1028 completex('CPAN::Bundle',$word),
1029 completex('CPAN::Distribution',$word),
1030 completex('CPAN::Module',$word),
1034 #-> sub CPAN::Complete::complete_reload ;
1035 sub complete_reload {
1036 my($word,$line,$pos) = @_;
1038 my(@words) = split " ", $line;
1039 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1040 my(@ok) = qw(cpan index);
1041 return @ok if @words==1;
1042 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1045 #-> sub CPAN::Complete::complete_option ;
1046 sub complete_option {
1047 my($word,$line,$pos) = @_;
1049 my(@words) = split " ", $line;
1050 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1051 my(@ok) = qw(conf debug);
1052 return @ok if @words==1;
1053 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1055 } elsif ($words[1] eq 'index') {
1057 } elsif ($words[1] eq 'conf') {
1058 return CPAN::Config::complete(@_);
1059 } elsif ($words[1] eq 'debug') {
1060 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1064 package CPAN::Index;
1065 use vars qw($last_time);
1066 @CPAN::Index::ISA = qw(CPAN::Debug);
1069 #-> sub CPAN::Index::force_reload ;
1072 $CPAN::Index::last_time = 0;
1076 #-> sub CPAN::Index::reload ;
1078 my($cl,$force) = @_;
1081 # XXX check if a newer one is available. (We currently read it from time to time)
1082 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1085 $cl->read_authindex($cl->reload_x("authors/01mailrc.txt.gz","01mailrc.gz",$force));
1086 return if $CPAN::Signal; # this is sometimes lengthy
1087 $cl->read_modpacks($cl->reload_x("modules/02packages.details.txt.gz","02packag.gz",$force));
1088 return if $CPAN::Signal; # this is sometimes lengthy
1089 $cl->read_modlist($cl->reload_x("modules/03modlist.data.gz","03mlist.gz",$force));
1092 #-> sub CPAN::Index::reload_x ;
1094 my($cl,$wanted,$localname,$force) = @_;
1096 my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
1097 if (-f $abs_wanted && -M $abs_wanted < $CPAN::Config->{'index_expire'} && !$force) {
1098 my($s) = $CPAN::Config->{'index_expire'} != 1;
1099 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} day$s. I\'ll use that.\n});
1104 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1107 #-> sub CPAN::Index::read_authindex ;
1108 sub read_authindex {
1109 my($cl,$index_target) = @_;
1110 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1111 warn "Going to read $index_target\n";
1112 my $fh = IO::File->new("$pipe|");
1115 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1116 next unless $userid && $fullname && $email;
1118 # instantiate an author object
1119 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
1120 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
1121 return if $CPAN::Signal;
1124 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1127 #-> sub CPAN::Index::read_modpacks ;
1129 my($cl,$index_target) = @_;
1130 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1131 warn "Going to read $index_target\n";
1132 my $fh = IO::File->new("$pipe|");
1136 my($mod,$version,$dist) = split;
1137 $version =~ s/^\+//;
1139 # if it as a bundle, instatiate a bundle object
1141 if ($mod =~ /^Bundle::(.*)/) {
1145 if ($mod eq 'CPAN') {
1147 if ($version > $CPAN::VERSION){
1149 Hey, you know what? There\'s a new CPAN.pm version (v$version)
1150 available! I\'d suggest--provided you have time--you try
1153 without quitting the current session. It should be a seemless upgrade
1154 while we are running...
1163 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
1164 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1165 # This "next" makes us faster but if the job is running long, we ignore
1166 # rereads which is bad. So we have to be a bit slower again.
1167 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
1170 # instantiate a module object
1171 $id = $CPAN::META->instance('CPAN::Module',$mod);
1172 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1175 # determine the author
1176 my($userid) = $dist =~ /([^\/]+)/;
1177 $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
1179 # instantiate a distribution object
1180 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1181 $CPAN::META->instance(
1182 'CPAN::Distribution' => $dist
1184 'CPAN_USERID' => $userid
1189 return if $CPAN::Signal;
1192 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1195 #-> sub CPAN::Index::read_modlist ;
1197 my($cl,$index_target) = @_;
1198 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1199 warn "Going to read $index_target\n";
1200 my $fh = IO::File->new("$pipe|");
1204 next if /use vars/; # will go away in 03...
1206 return if $CPAN::Signal;
1208 $eval .= q{CPAN::Modulelist->data;};
1210 my($comp) = Safe->new("CPAN::Safe1");
1211 my $ret = $comp->reval($eval);
1212 Carp::confess($@) if $@;
1213 return if $CPAN::Signal;
1215 my $obj = $CPAN::META->instance(CPAN::Module,$_);
1216 $obj->set(%{$ret->{$_}});
1217 return if $CPAN::Signal;
1221 package CPAN::InfoObj;
1222 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
1224 #-> sub CPAN::InfoObj::new ;
1225 sub new { my $this = bless {}, shift; %$this = @_; $this }
1227 #-> sub CPAN::InfoObj::set ;
1229 my($self,%att) = @_;
1230 my(%oldatt) = %$self;
1231 %$self = (%oldatt, %att);
1234 #-> sub CPAN::InfoObj::id ;
1235 sub id { shift->{'ID'} }
1237 #-> sub CPAN::InfoObj::as_glimpse ;
1241 my $class = ref($self);
1242 $class =~ s/^CPAN:://;
1243 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
1247 #-> sub CPAN::InfoObj::as_string ;
1251 my $class = ref($self);
1252 $class =~ s/^CPAN:://;
1253 push @m, $class, " id = $self->{ID}\n";
1254 for (sort keys %$self) {
1257 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
1258 if (ref $self->{$_}) { # Should we setup a language interface? XXX
1259 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
1261 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
1267 #-> sub CPAN::InfoObj::author ;
1270 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
1273 package CPAN::Author;
1274 @CPAN::Author::ISA = qw(CPAN::Debug CPAN::InfoObj);
1276 #-> sub CPAN::Author::as_glimpse ;
1280 my $class = ref($self);
1281 $class =~ s/^CPAN:://;
1282 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
1286 # Dead code, I would have liked to have,,, but it was never reached,,,
1289 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
1292 #-> sub CPAN::Author::fullname ;
1293 sub fullname { shift->{'FULLNAME'} }
1295 #-> sub CPAN::Author::email ;
1296 sub email { shift->{'EMAIL'} }
1298 package CPAN::Distribution;
1299 @CPAN::Distribution::ISA = qw(CPAN::Debug CPAN::InfoObj);
1301 #-> sub CPAN::Distribution::called_for ;
1304 $self->{'CALLED_FOR'} = $id if defined $id;
1305 return $self->{'CALLED_FOR'};
1308 #-> sub CPAN::Distribution::get ;
1313 exists $self->{'build_dir'} and push @e, "Unwrapped into directory $self->{'build_dir'}";
1314 print join "", map {" $_\n"} @e and return if @e;
1319 $CPAN::Config->{keep_source_where},
1322 split("/",$self->{ID})
1325 $self->debug("Doing localize") if $CPAN::DEBUG;
1326 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
1327 $self->{localfile} = $local_file;
1328 my $builddir = $CPAN::META->{cachemgr}->dir;
1329 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
1330 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
1333 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
1334 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
1335 $self->debug("Removing tmp") if $CPAN::DEBUG;
1336 File::Path::rmtree("tmp");
1337 mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
1339 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
1340 if ($local_file =~ /z$/i){
1341 $self->{archived} = "tar";
1342 if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
1343 $self->{unwrapped} = "YES";
1345 $self->{unwrapped} = "NO";
1347 } elsif ($local_file =~ /zip$/i) {
1348 $self->{archived} = "zip";
1349 if (system("$CPAN::Config->{unzip} $local_file")==0) {
1350 $self->{unwrapped} = "YES";
1352 $self->{unwrapped} = "NO";
1355 # Let's check if the package has its own directory.
1356 opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
1357 my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
1359 my ($distdir,$packagedir);
1360 if (@readdir == 1 && -d $readdir[0]) {
1361 $distdir = $readdir[0];
1362 $packagedir = $CPAN::META->catdir($builddir,$distdir);
1363 -d $packagedir and print "Removing previously used $packagedir\n";
1364 File::Path::rmtree($packagedir);
1365 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
1367 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
1368 $pragmatic_dir =~ s/\W_//g;
1369 $pragmatic_dir++ while -d "../$pragmatic_dir";
1370 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
1371 File::Path::mkpath($packagedir);
1373 for $f (@readdir) { # is already without "." and ".."
1374 my $to = $CPAN::META->catdir($packagedir,$f);
1375 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
1378 $self->{'build_dir'} = $packagedir;
1381 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") if $CPAN::DEBUG;
1382 File::Path::rmtree("tmp");
1383 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
1384 print "Going to unlink $local_file\n";
1385 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
1387 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
1388 unless (-f $makefilepl) {
1389 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
1390 if (-f $configure) {
1391 # do we have anything to do?
1392 $self->{'configure'} = $configure;
1394 my $fh = IO::File->new(">$makefilepl") or Carp::croak("Could not open >$makefilepl");
1395 my $cf = $self->called_for || "unknown";
1397 # This Makefile.PL has been autogenerated by the module CPAN.pm
1398 # Autogenerated on: }.scalar localtime().qq{
1399 use ExtUtils::MakeMaker;
1400 WriteMakefile(NAME => q[$cf]);
1402 print qq{Package comes without Makefile.PL.\n}.
1403 qq{ Writing one on our own (calling it $cf)\n};
1407 $self->{archived} = "NO";
1412 #-> sub CPAN::Distribution::new ;
1414 my($class,%att) = @_;
1416 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
1418 my $this = { %att };
1419 return bless $this, $class;
1422 #-> sub CPAN::Distribution::readme ;
1425 print "Readme not yet implemented (says ".$self->id.")\n";
1428 #-> sub CPAN::Distribution::verifyMD5 ;
1433 $self->{MD5_STATUS} and push @e, "MD5 Checksum was ok";
1434 print join "", map {" $_\n"} @e and return if @e;
1437 my(@local) = split("/",$self->{ID});
1438 my($basename) = pop @local;
1439 push @local, "CHECKSUMS";
1442 $CPAN::Config->{keep_source_where},
1451 $self->MD5_check_file($local_wanted,$basename)
1453 return $self->{MD5_STATUS}="OK";
1455 $local_file = CPAN::FTP->localize("authors/id/@local", $local_wanted, 'force>:-{');
1460 $local[-1] .= ".gz";
1461 $local_file = CPAN::FTP->localize(
1462 "authors/id/@local",
1466 my $system = "$CPAN::Config->{gzip} --decompress $local_file";
1467 system($system)==0 or die "Could not uncompress $local_file";
1468 $local_file =~ s/\.gz$//;
1470 $self->MD5_check_file($local_file,$basename);
1473 #-> sub CPAN::Distribution::MD5_check_file ;
1474 sub MD5_check_file {
1475 my($self,$lfile,$basename) = @_;
1477 my $fh = new IO::File;
1479 if (open $fh, $lfile){
1482 my($comp) = Safe->new();
1483 $cksum = $comp->reval($eval);
1484 Carp::confess($@) if $@;
1485 if ($cksum->{$basename}->{md5}) {
1486 $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
1487 my $file = $self->{localfile};
1488 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
1490 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
1492 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
1494 print "Checksum for $file ok\n";
1495 return $self->{MD5_STATUS}="OK";
1499 "\nChecksum mismatch for distribution file. Please investigate.\n\n",
1501 $CPAN::META->instance('CPAN::Author',$self->{CPAN_USERID})->as_string,
1502 "Please contact the author or your CPAN site admin"
1505 close $fh if fileno($fh);
1507 print "No md5 checksum for $basename in local $lfile\n";
1511 Carp::carp "Could not open $lfile for reading";
1515 #-> sub CPAN::Distribution::eq_MD5 ;
1517 my($self,$fh,$expectMD5) = @_;
1520 my $hexdigest = $md5->hexdigest;
1521 $hexdigest eq $expectMD5;
1524 #-> sub CPAN::Distribution::force ;
1527 $self->{'force_update'}++;
1528 delete $self->{'MD5_STATUS'};
1529 delete $self->{'archived'};
1530 delete $self->{'build_dir'};
1531 delete $self->{'localfile'};
1532 delete $self->{'make'};
1533 delete $self->{'install'};
1534 delete $self->{'unwrapped'};
1535 delete $self->{'writemakefile'};
1538 #-> sub CPAN::Distribution::make ;
1541 $self->debug($self->id) if $CPAN::DEBUG;
1542 print "Running make\n";
1544 if ($CPAN::META->hasMD5) {
1549 $self->{archived} eq "NO" and push @e, "Is neither a tar nor a zip archive.";
1550 $self->{unwrapped} eq "NO" and push @e, "had problems unarchiving. Please build manually";
1551 exists $self->{writemakefile} && $self->{writemakefile} eq "NO" and push @e, "Had some problem writing Makefile";
1552 defined $self->{'make'} and push @e, "Has already been processed within this session";
1553 print join "", map {" $_\n"} @e and return if @e;
1555 print "\n CPAN: Going to build ".$self->id."\n\n";
1556 my $builddir = $self->dir;
1557 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
1558 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
1561 if ($self->{'configure'}) {
1562 $system = $self->{'configure'};
1564 my($perl) = $^X =~ /^\.\// ? "$CPAN::Cwd/$^X" : $^X; # XXX subclassing folks, forgive me!
1565 $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
1567 $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
1570 if ($CPAN::Config->{inactivity_timeout}) {
1572 alarm $CPAN::Config->{inactivity_timeout};
1573 #$SIG{CHLD} = \&REAPER;
1574 if (defined($pid=fork)) {
1581 print "Cannot fork: $!";
1584 $ret = system($system);
1588 $ret = system($system);
1594 $self->{writemakefile} = "NO - $@";
1597 } elsif ($ret != 0) {
1598 $self->{writemakefile} = "NO";
1601 $self->{writemakefile} = "YES";
1602 return if $CPAN::Signal;
1603 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
1604 if (system($system)==0) {
1605 print " $system -- OK\n";
1606 $self->{'make'} = "YES";
1608 $self->{writemakefile} = "YES";
1609 $self->{'make'} = "NO";
1610 print " $system -- NOT OK\n";
1614 #-> sub CPAN::Distribution::test ;
1618 return if $CPAN::Signal;
1619 print "Running make test\n";
1622 exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't test";
1623 exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
1624 exists $self->{'build_dir'} or push @e, "Has no own directory";
1625 print join "", map {" $_\n"} @e and return if @e;
1627 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1628 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1629 my $system = join " ", $CPAN::Config->{'make'}, "test";
1630 if (system($system)==0) {
1631 print " $system -- OK\n";
1632 $self->{'make_test'} = "YES";
1634 $self->{'make_test'} = "NO";
1635 print " $system -- NOT OK\n";
1639 #-> sub CPAN::Distribution::clean ;
1642 print "Running make clean\n";
1645 exists $self->{'build_dir'} or push @e, "Has no own directory";
1646 print join "", map {" $_\n"} @e and return if @e;
1648 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1649 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1650 my $system = join " ", $CPAN::Config->{'make'}, "clean";
1651 if (system($system)==0) {
1652 print " $system -- OK\n";
1655 # Hmmm, what to do if make clean failed?
1659 #-> sub CPAN::Distribution::install ;
1663 return if $CPAN::Signal;
1664 print "Running make install\n";
1667 exists $self->{'build_dir'} or push @e, "Has no own directory";
1668 exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't install";
1669 exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
1670 exists $self->{'install'} and push @e, $self->{'install'} eq "YES" ? "Already done" : "Already tried without success";
1671 print join "", map {" $_\n"} @e and return if @e;
1673 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1674 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1675 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
1676 my($pipe) = IO::File->new("$system 2>&1 |");
1679 # #If I were to try this, I'd do something like:
1681 # # $SIG{ALRM} = sub { die "alarm\n" };
1683 # # open(PROC,"make somesuch|");
1693 # #I'm really not sure how reliable this would is, though.
1696 # #Kenneth Albanowski (kjahds@kjahds.com, CIS: 70705,126)
1707 print " $system -- OK\n";
1708 $self->{'install'} = "YES";
1710 $self->{'install'} = "NO";
1711 print " $system -- NOT OK\n";
1712 if ($makeout =~ /permission/s && $> > 0) {
1713 print " You may have to su to root to install the package\n";
1718 #-> sub CPAN::Distribution::dir ;
1720 shift->{'build_dir'};
1723 package CPAN::Bundle;
1724 @CPAN::Bundle::ISA = qw(CPAN::Debug CPAN::InfoObj CPAN::Module);
1726 #-> sub CPAN::Bundle::as_string ;
1730 return $self->SUPER::as_string;
1733 #-> sub CPAN::Bundle::contains ;
1736 my($parsefile) = $self->inst_file;
1737 unless ($parsefile) {
1738 # Try to get at it in the cpan directory
1739 $self->debug("no parsefile") if $CPAN::DEBUG;
1740 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
1741 $self->debug($dist->as_string) if $CPAN::DEBUG;
1743 $self->debug($dist->as_string) if $CPAN::DEBUG;
1744 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1745 File::Path::mkpath($todir);
1747 ($me = $self->id) =~ s/.*://;
1748 $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
1749 $to = $CPAN::META->catfile($todir,"$me.pm");
1750 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
1754 my $fh = new IO::File;
1756 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
1759 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
1764 push @result, (split " ", $_, 2)[0];
1767 delete $self->{STATUS};
1768 $self->{CONTAINS} = [@result];
1772 #-> sub CPAN::Bundle::inst_file ;
1776 ($me = $self->id) =~ s/.*://;
1777 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
1778 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
1779 $inst_file = $self->SUPER::inst_file;
1780 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
1781 return $self->{'INST_FILE'}; # even if undefined?
1784 #-> sub CPAN::Bundle::rematein ;
1786 my($self,$meth) = @_;
1787 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
1789 for $s ($self->contains) {
1790 $CPAN::META->instance('CPAN::Module',$s)->$meth();
1794 #-> sub CPAN::Bundle::force ;
1795 sub force { shift->rematein('force',@_); }
1796 #-> sub CPAN::Bundle::install ;
1797 sub install { shift->rematein('install',@_); }
1798 #-> sub CPAN::Bundle::clean ;
1799 sub clean { shift->rematein('clean',@_); }
1800 #-> sub CPAN::Bundle::test ;
1801 sub test { shift->rematein('test',@_); }
1802 #-> sub CPAN::Bundle::make ;
1803 sub make { shift->rematein('make',@_); }
1805 # XXX not yet implemented!
1806 #-> sub CPAN::Bundle::readme ;
1809 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
1810 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
1811 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
1812 # CPAN::FTP->localize("authors/id/$file",$index_wanted); # XXX
1815 package CPAN::Module;
1816 @CPAN::Module::ISA = qw(CPAN::Debug CPAN::InfoObj);
1818 #-> sub CPAN::Module::as_glimpse ;
1822 my $class = ref($self);
1823 $class =~ s/^CPAN:://;
1824 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
1828 #-> sub CPAN::Module::as_string ;
1832 CPAN->debug($self) if $CPAN::DEBUG;
1833 my $class = ref($self);
1834 $class =~ s/^CPAN:://;
1836 push @m, $class, " id = $self->{ID}\n";
1837 my $sprintf = " %-12s %s\n";
1838 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
1839 my $sprintf2 = " %-12s %s (%s)\n";
1841 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
1846 $CPAN::META->instance(CPAN::Author,$userid)->fullname
1849 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
1850 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
1851 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
1852 my(%statd,%stats,%statl,%stati);
1853 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
1854 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
1855 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
1856 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
1857 $statd{' '} = 'unknown';
1858 $stats{' '} = 'unknown';
1859 $statl{' '} = 'unknown';
1860 $stati{' '} = 'unknown';
1868 $statd{$self->{statd}},
1869 $stats{$self->{stats}},
1870 $statl{$self->{statl}},
1871 $stati{$self->{stati}}
1872 ) if $self->{statd};
1873 my $local_file = $self->inst_file;
1874 if ($local_file && ! exists $self->{MANPAGE}) {
1875 my $fh = IO::File->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
1880 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
1888 $self->{MANPAGE} = join " ", @result;
1890 push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE};
1891 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
1892 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
1896 #-> sub CPAN::Module::cpan_file ;
1899 CPAN->debug($self->id) if $CPAN::DEBUG;
1900 unless (defined $self->{'CPAN_FILE'}) {
1901 CPAN::Index->reload;
1903 if (defined $self->{'CPAN_FILE'}){
1904 return $self->{'CPAN_FILE'};
1905 } elsif (defined $self->{'userid'}) {
1906 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
1912 *name = \&cpan_file;
1914 #-> sub CPAN::Module::cpan_version ;
1915 sub cpan_version { shift->{'CPAN_VERSION'} }
1917 #-> sub CPAN::Module::force ;
1920 $self->{'force_update'}++;
1923 #-> sub CPAN::Module::rematein ;
1925 my($self,$meth) = @_;
1926 $self->debug($self->id) if $CPAN::DEBUG;
1927 my $cpan_file = $self->cpan_file;
1928 return if $cpan_file eq "N/A";
1929 return if $cpan_file =~ /^Contact Author/;
1930 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1931 $pack->called_for($self->id);
1932 $pack->force if exists $self->{'force_update'};
1934 delete $self->{'force_update'};
1937 #-> sub CPAN::Module::readme ;
1938 sub readme { shift->rematein('readme') }
1939 #-> sub CPAN::Module::make ;
1940 sub make { shift->rematein('make') }
1941 #-> sub CPAN::Module::clean ;
1942 sub clean { shift->rematein('clean') }
1943 #-> sub CPAN::Module::test ;
1944 sub test { shift->rematein('test') }
1945 #-> sub CPAN::Module::install ;
1949 my($latest) = $self->cpan_version;
1951 my($inst_file) = $self->inst_file;
1953 if (defined $inst_file) {
1954 $have = $self->inst_version;
1956 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
1957 print $self->id, " is up to date.\n";
1961 $self->rematein('install') if $doit;
1964 #-> sub CPAN::Module::inst_file ;
1968 @packpath = split /::/, $self->{ID};
1969 $packpath[-1] .= ".pm";
1970 foreach $dir (@INC) {
1971 my $pmfile = CPAN->catfile($dir,@packpath);
1978 #-> sub CPAN::Module::xs_file ;
1982 @packpath = split /::/, $self->{ID};
1983 push @packpath, $packpath[-1];
1984 $packpath[-1] .= "." . $Config::Config{'dlext'};
1985 foreach $dir (@INC) {
1986 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
1993 #-> sub CPAN::Module::inst_version ;
1996 my $parsefile = $self->inst_file or return 0;
1997 my $have = MY->parse_version($parsefile);
2004 package CPAN::CacheMgr;
2006 @CPAN::CacheMgr::ISA = qw(CPAN::Debug CPAN::InfoObj);
2009 #-> sub CPAN::CacheMgr::as_string ;
2011 eval { require Data::Dumper };
2013 return shift->SUPER::as_string;
2015 return Data::Dumper::Dumper(shift);
2019 #-> sub CPAN::CacheMgr::cachesize ;
2025 # my($self,@dirs) = @_;
2026 # return unless -d $self->{ID};
2028 # @dirs = $self->dirs unless @dirs;
2029 # for $dir (@dirs) {
2030 # $self->disk_usage($dir);
2034 #-> sub CPAN::CacheMgr::clean_cache ;
2038 while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
2039 $self->force_clean_cache($dir);
2041 $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
2044 #-> sub CPAN::CacheMgr::dir ;
2049 #-> sub CPAN::CacheMgr::entries ;
2051 my($self,$dir) = @_;
2052 $dir ||= $self->{ID};
2053 my($cwd) = Cwd::cwd();
2054 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
2055 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
2058 next if $_ eq "." || $_ eq "..";
2060 push @entries, $CPAN::META->catfile($dir,$_);
2062 push @entries, $CPAN::META->catdir($dir,$_);
2064 print STDERR "Warning: weird direntry in $dir: $_\n";
2067 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
2068 sort {-M $b <=> -M $a} @entries;
2071 #-> sub CPAN::CacheMgr::disk_usage ;
2073 my($self,$dir) = @_;
2074 if (! defined $dir or $dir eq "") {
2075 $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
2078 return if defined $self->{SIZE}{$dir};
2087 $self->{SIZE}{$dir} = $Du/1024/1024;
2088 push @{$self->{FIFO}}, $dir;
2089 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
2090 $self->{DU} += $Du/1024/1024;
2091 if ($self->{DU} > $self->{'MAX'} ) {
2092 printf "...Hold on a sec... CPAN's cleaning the cache: %.2f MB > %.2f MB\n",
2093 $self->{DU}, $self->{'MAX'};
2096 $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}") if $CPAN::DEBUG;
2097 $self->debug($self->as_string) if $CPAN::DEBUG;
2102 #-> sub CPAN::CacheMgr::force_clean_cache ;
2103 sub force_clean_cache {
2104 my($self,$dir) = @_;
2105 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}") if $CPAN::DEBUG;
2106 File::Path::rmtree($dir);
2107 $self->{DU} -= $self->{SIZE}{$dir};
2108 delete $self->{SIZE}{$dir};
2111 #-> sub CPAN::CacheMgr::new ;
2114 my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, DU => 0 };
2115 File::Path::mkpath($self->{ID});
2116 my $dh = DirHandle->new($self->{ID});
2117 bless $self, $class;
2118 $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
2120 for $e ($self->entries) {
2121 next if $e eq ".." || $e eq ".";
2122 $self->debug("Have to check size $e") if $CPAN::DEBUG;
2123 $self->disk_usage($e);
2128 package CPAN::Debug;
2130 #-> sub CPAN::Debug::debug ;
2132 my($self,$arg) = @_;
2133 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg Complete, caller(1) eg readline
2134 ($caller) = caller(0);
2135 $caller =~ s/.*:://;
2136 # print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
2137 # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
2138 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
2140 eval { require Data::Dumper };
2142 print $arg->as_string;
2144 print Data::Dumper::Dumper($arg);
2147 print "Debug($caller:$func,$line,@rest): $arg\n"
2152 package CPAN::Config;
2153 import ExtUtils::MakeMaker 'neatvalue';
2157 'commit' => "Commit changes to disk",
2158 'defaults' => "Reload defaults from disk",
2161 #-> sub CPAN::Config::edit ;
2163 my($class,@args) = @_;
2164 return unless @args;
2165 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
2166 my($o,$str,$func,$args,$key_exists);
2172 if (ref($CPAN::Config->{$o}) eq ARRAY) {
2173 $func = shift @args;
2174 # Let's avoid eval, it's easier to comprehend without.
2175 if ($func eq "push") {
2176 push @{$CPAN::Config->{$o}}, @args;
2177 } elsif ($func eq "pop") {
2178 pop @{$CPAN::Config->{$o}};
2179 } elsif ($func eq "shift") {
2180 shift @{$CPAN::Config->{$o}};
2181 } elsif ($func eq "unshift") {
2182 unshift @{$CPAN::Config->{$o}}, @args;
2183 } elsif ($func eq "splice") {
2184 splice @{$CPAN::Config->{$o}}, @args;
2186 $CPAN::Config->{$o} = [@args];
2189 $CPAN::Config->{$o} = $args[0];
2191 print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
2196 #-> sub CPAN::Config::commit ;
2198 my($self, $configpm) = @_;
2202 my($fh) = IO::File->new;
2203 $configpm ||= cfile();
2205 $mode = (stat $configpm)[2];
2206 if ($mode && ! -w _) {
2207 print "$configpm is not writable\n" and return;
2209 #chmod 0644, $configpm; #?
2212 my $msg = <<EOF unless $configpm =~ /MyConfig/;
2214 # This is CPAN.pm's systemwide configuration file. This file provides
2215 # defaults for users, and the values can be changed in a per-user configuration
2216 # file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
2220 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
2221 print $fh qq[$msg\$CPAN::Config = \{\n];
2222 foreach (sort keys %$CPAN::Config) {
2223 print $fh " '$_' => ", ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}), ",\n";
2226 print $fh "};\n1;\n__END__\n";
2229 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
2230 #chmod $mode, $configpm;
2232 print "commit: wrote $configpm\n";
2236 *default = \&defaults;
2237 #-> sub CPAN::Config::defaults ;
2246 #-> sub CPAN::Config::load ;
2249 eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems
2250 unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
2251 eval {require CPAN::MyConfig;}; # where you can override system wide settings
2252 unless ( $self->load_succeeded ) {
2253 require CPAN::FirstTime;
2255 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
2256 $configpm = $INC{"CPAN/Config.pm"};
2257 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
2258 $configpm = $INC{"CPAN/MyConfig.pm"};
2260 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
2261 my($configpmdir) = MY->catdir($path_to_cpan,"CPAN");
2262 my($configpmtest) = MY->catfile($configpmdir,"Config.pm");
2263 if (-d $configpmdir || File::Path::mkpath($configpmdir)) {
2264 #_#_# following code dumped core on me with 5.003_11, a.k.
2265 #_#_# $fh = IO::File->new;
2266 #_#_# if ($fh->open(">$configpmtest")) {
2267 #_#_# $fh->print("1;\n");
2268 #_#_# $configpm = $configpmtest;
2270 if (-w $configpmtest or -w $configpmdir) {
2271 $configpm = $configpmtest;
2274 unless ($configpm) {
2275 $configpmdir = MY->catdir($ENV{HOME},".cpan","CPAN");
2276 File::Path::mkpath($configpmdir);
2277 $configpmtest = MY->catfile($configpmdir,"MyConfig.pm");
2278 if (-w $configpmtest or -w $configpmdir) {
2279 $configpm = $configpmtest;
2281 warn "WARNING: CPAN.pm is unable to create a configuration file.\n";
2285 warn "Calling CPAN::FirstTime::init($configpm)";
2286 CPAN::FirstTime::init($configpm);
2290 #-> sub CPAN::Config::load_succeeded ;
2291 sub load_succeeded {
2294 cpan_home keep_source_where build_dir build_cache index_expire
2295 gzip tar unzip make pager makepl_arg make_arg make_install_arg
2296 urllist inhibit_startup_message
2298 $miss++ unless defined $CPAN::Config->{$_}; # we want them all
2303 #-> sub CPAN::Config::unload ;
2305 delete $INC{'CPAN/MyConfig.pm'};
2306 delete $INC{'CPAN/Config.pm'};
2309 #-> sub CPAN::Config::cfile ;
2311 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'};
2315 #-> sub CPAN::Config::help ;
2319 defaults reload default config values from disk
2320 commit commit session changes to disk
2322 You may edit key values in the follow fashion:
2324 o conf build_cache 15
2326 o conf build_dir "/foo/bar"
2328 o conf urllist shift
2330 o conf urllist unshift ftp://ftp.foo.bar/
2333 undef; #don't reprint CPAN::Config
2336 #-> sub CPAN::Config::complete ;
2338 my($word,$line,$pos) = @_;
2340 my(@words) = split " ", $line;
2341 my(@o_conf) = (sort keys %CPAN::Config::can, sort keys %$CPAN::Config);
2342 return (@o_conf) unless @words>2;
2343 if($words[2] =~ /->(.*)/) {
2345 my(@methods) = qw(shift unshift push pop splice);
2346 return @methods unless $meth;
2347 return sort grep /^\Q$meth\E/, @methods;
2349 return sort grep /^\Q$word\E/, @o_conf;
2356 CPAN - query, download and build perl modules from CPAN sites
2362 perl -MCPAN -e shell;
2368 autobundle, clean, install, make, recompile, test
2372 The CPAN module is designed to automate the make and install of perl
2373 modules and extensions. It includes some searching capabilities as
2374 well knows a how to use Net::FTP or LWP to fetch the raw data from the
2377 Modules are fetched from one or more of the mirrored CPAN
2378 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
2381 The CPAN module also supports the concept of named and versioned
2382 'bundles' of modules. Bundles simplify the handling of sets of
2383 related modules. See BUNDLES below.
2385 The package contains a session manager and a cache manager. There is
2386 no status retained between sessions. The session manager keeps track
2387 of what has been fetched, built and installed in the current
2388 session. The cache manager keeps track of the disk space occupied by
2389 the make processes and deletes excess space in a simple FIFO style.
2391 All methods provided are accessible in a programmer style and in an
2392 interactive shell style.
2394 =head2 Interactive Mode
2396 The interactive mode is entered by running
2398 perl -MCPAN -e shell
2400 which puts you into a readline interface. You will have most fun if
2401 you install Term::ReadKey and Term::ReadLine to enjoy both history and
2404 Once you are on the command line, type 'h' and the rest should be
2407 The most common uses of the interactive modes are
2411 =item Searching for authors, bundles, distribution files and modules
2413 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
2414 for each of the four categories and another, C<i> for any of the other
2415 four. Each of the four entities is implemented as a class with
2416 slightly differing methods for displaying an object.
2418 Arguments you pass to these commands are either strings matching exact
2419 the identification string of an object or regular expressions that are
2420 then matched case-insensitively against various attributes of the
2421 objects. The parser recognizes a regualar expression only if you
2422 enclose it between two slashes.
2424 The principle is that the number of found objects influences how an
2425 item is displayed. If the search finds one item, we display the result
2426 of object-E<gt>as_string, but if we find more than one, we display
2427 each as object-E<gt>as_glimpse. E.g.
2431 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2432 FULLNAME Andreas König
2437 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2438 FULLNAME Andreas König
2442 Author ANDYD (Andy Dougherty)
2443 Author MERLYN (Randal L. Schwartz)
2445 =item make, test, install, clean modules or distributions
2447 The four commands do indeed exist just as written above. Each of them
2448 takes as many arguments as provided and investigates for each what it
2449 might be. Is it a distribution file (recognized by embedded slashes),
2450 this file is being processed. Is it a module, CPAN determines the
2451 distribution file where this module is included and processes that.
2453 Any C<make> and C<test> are run unconditionally. An C<install
2454 E<lt>distribution_fileE<gt>> also is run unconditionally. But for
2455 C<install E<lt>module<gt>> CPAN checks if an install is actually
2456 needed for it and prints I<"Foo up to date"> in case the module
2457 doesnE<39>t need to be updated.
2459 CPAN also keeps track of what it has done within the current session
2460 and doesnE<39>t try to build a package a second time regardless if it
2461 succeeded or not. The C<force > command takes as first argument the
2462 method to invoke (currently: make, test, or install) and executes the
2463 command from scratch.
2467 cpan> install OpenGL
2468 OpenGL is up to date.
2469 cpan> force install OpenGL
2472 OpenGL-0.4/COPYRIGHT
2479 The commands that are available in the shell interface are methods in
2480 the package CPAN::Shell. If you enter the shell command, all your
2481 input is split by the Text::ParseWords::shellwords() routine which
2482 acts like most shells do. The first word is being interpreted as the
2483 method to be called and the rest of the words are treated as arguments
2486 =head2 ProgrammerE<39>s interface
2488 If you do not enter the shell, the available shell commands are both
2489 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
2490 functions in the calling package (C<install(...)>). The
2491 programmerE<39>s interface has beta status. Do not heavily rely on it,
2492 changes may still happen.
2494 =head2 Cache Manager
2496 Currently the cache manager only keeps track of the build directory
2497 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
2498 deletes complete directories below build_dir as soon as the size of
2499 all directories there gets bigger than $CPAN::Config->{build_cache}
2500 (in MB). The contents of this cache may be used for later
2501 re-installations that you intend to do manually, but will never be
2502 trusted by CPAN itself. This is due to the fact that the user might
2503 use these directories for building modules on different architectures.
2505 There is another directory ($CPAN::Config->{keep_source_where}) where
2506 the original distribution files are kept. This directory is not
2507 covered by the cache manager and must be controlled by the user. If
2508 you choose to have the same directory as build_dir and as
2509 keep_source_where directory, then your sources will be deleted with
2510 the same fifo mechanism.
2514 A bundle is just a perl module in the namespace Bundle:: that does not
2515 define any functions or methods. It usually only contains documentation.
2517 It starts like a perl module with a package declaration and a $VERSION
2518 variable. After that the pod section looks like any other pod with the
2519 only difference, that I<one special pod section> exists starting with
2524 In this pod section each line obeys the format
2526 Module_Name [Version_String] [- optional text]
2528 The only required part is the first field, the name of a module
2529 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
2530 of the line is optional. The comment part is delimited by a dash just
2531 as in the man page header.
2533 The distribution of a bundle should follow the same convention as
2534 other distributions. The bundle() function in the CPAN module simply
2535 parses the module that defines the bundle and returns the module names
2536 that are listed in the described CONTENTS section.
2538 Bundles are treated specially in the CPAN package. If you say 'install
2539 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
2540 the modules in the CONTENTS section of the pod. You can install your
2541 own Bundles locally by placing a conformant Bundle file somewhere into
2542 your @INC path. The autobundle() command which is available in the
2543 shell interface does that for you by including all currently installed
2544 modules in a snapshot bundle file.
2546 There is a meaningless Bundle::Demo available on CPAN. Try to install
2547 it, it usually does no harm, just demonstrates what the Bundle
2548 interface looks like.
2552 C<autobundle> writes a bundle file into the
2553 C<$CPAN::Config->{cpan_home}/Bundle> directory. The file contains a list
2554 of all modules that are both available from CPAN and currently
2555 installed within @INC. The name of the bundle file is based on the
2556 current date and a counter.
2560 recompile() is a very special command in that it takes no argument and
2561 runs the make/test/install cycle with brute force over all installed
2562 dynamically loadable extensions (aka XS modules) with 'force' in
2563 effect. Primary purpose of this command is to act as a rescue in case
2564 your perl breaks binary compatibility. If one of the modules that CPAN
2565 uses is in turn depending on binary compatibility (so you cannot run
2566 CPAN commands), then you should try the CPAN::Nox module for recovery.
2568 A very popular use for recompile is to finish a network
2569 installation. Imagine, you have a common source tree for two different
2570 architectures. You decide to do a completely independent fresh
2571 installation. You start on one architecture with the help of a Bundle
2572 file produced earlier. CPAN installs the whole Bundle for you, but
2573 when you try to repeat the job on the second architecture, CPAN
2574 responds with a C<"Foo up to date"> message for all modules. So you
2575 will be glad to run recompile in the second architecture and
2578 =head1 CONFIGURATION
2580 When the CPAN module is installed a site wide configuration file is
2581 created as CPAN/Config.pm. The default values defined there can be
2582 overridden in another configuration file: CPAN/MyConfig.pm. You can
2583 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
2584 $HOME/.cpan is added to the search path of the CPAN module before the
2585 use() or require() statements.
2587 Currently the following keys in the hash reference $CPAN::Config are
2590 build_cache size of cache for directories to build modules
2591 build_dir locally accessible directory to build modules
2592 index_expire after how many days refetch index files
2593 cpan_home local directory reserved for this package
2594 gzip location of external program gzip
2595 inhibit_startup_message
2596 if true, does not print the startup message
2597 keep_source keep the source in a local directory?
2598 keep_source_where where keep the source (if we do)
2599 make location of external program make
2600 make_arg arguments that should always be passed to 'make'
2601 make_install_arg same as make_arg for 'make install'
2602 makepl_arg arguments passed to 'perl Makefile.PL'
2603 pager location of external program more (or any pager)
2604 tar location of external program tar
2605 unzip location of external program unzip
2606 urllist arrayref to nearby CPAN sites (or equivalent locations)
2608 You can set and query each of these options interactively in the cpan
2609 shell with the command set defined within the C<o conf> command:
2613 =item o conf E<lt>scalar optionE<gt>
2615 prints the current value of the I<scalar option>
2617 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
2619 Sets the value of the I<scalar option> to I<value>
2621 =item o conf E<lt>list optionE<gt>
2623 prints the current value of the I<list option> in MakeMaker's
2626 =item o conf E<lt>list optionE<gt> [shift|pop]
2628 shifts or pops the array in the I<list option> variable
2630 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
2632 works like the corresponding perl commands. Whitespace is used to
2633 determine the arguments.
2639 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
2640 install foreign, unmasked, unsigned code on your machine. We compare
2641 to a checksum that comes from the net just as the distribution file
2642 itself. If somebody has managed to tamper with the distribution file,
2643 they may have as well tampered with the CHECKSUMS file. Future
2644 development will go towards stong authentification.
2648 Most functions in package CPAN are exported per default. The reason
2649 for this is that the primary use is intended for the cpan shell or for
2654 The debugging of this module is pretty difficult, because we have
2655 interferences of the software producing the indices on CPAN, of the
2656 mirroring process on CPAN, of packaging, of configuration, of
2657 synchronicity, and of bugs within CPAN.pm.
2659 In interactive mode you can try "o debug" which will list options for
2660 debugging the various parts of the package. The output may not be very
2661 useful for you as it's just a byproduct of my own testing, but if you
2662 have an idea which part of the package may have a bug, it's sometimes
2663 worth to give it a try and send me more specific output. You should
2664 know that "o debug" has built-in completion support.
2666 =head2 Prerequisites
2668 If you have a local mirror of CPAN and can access all files with
2669 "file:" URLs, then you only need perl5.003 to run this
2670 module. Otherwise you need Net::FTP intalled. LWP may be required for
2671 non-UNIX systems or if your nearest CPAN site is associated with an
2672 URL that is not C<ftp:>.
2674 This module presumes that all packages on CPAN
2680 declare their $VERSION variable in an easy to parse manner. This
2681 prerequisite can hardly be relaxed because it consumes by far too much
2682 memory to load all packages into the running program just to determine
2683 the $VERSION variable . Currently all programs that are dealing with
2684 VERSION use something like this
2686 perl -MExtUtils::MakeMaker -le \
2687 'print MM->parse_version($ARGV[0])' filename
2689 If you are author of a package and wonder if your VERSION can be
2690 parsed, please try the above method.
2694 come as compressed or gzipped tarfiles or as zip files and contain a
2695 Makefile.PL (well we try to handle a bit more, but without much
2702 Andreas König E<lt>a.koenig@mind.deE<gt>
2706 perl(1), CPAN::Nox(3)