2 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
6 # $Id: CPAN.pm,v 1.94 1996/12/24 00:41:14 k Exp $
8 # my $version = substr q$Revision: 1.94 $, 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->hasdefault() || $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.
869 my($fh) = IO::File->new;
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($fh, "|$CPAN::Config->{'ftp'} $host") or die "Couldn't open ftp: $!";
885 my($netrcfile) = $netrc->netrc();
887 print qq{ Your $netrcfile does not contain host $host.\n}
889 print qq{ I could not find or open your .netrc file.\n}
891 print qq{ If you want to use external ftp,
892 please enter the host $host (or a default entry)
893 into your .netrc file and retry.
895 The format of a proper entry in your .netrc file would be:
898 password $Config::Config{cf_email}
900 A typical default entry would be:
901 default login ftp password $Config::Config{cf_email}
903 Please make also sure, your .netrc will not be readable by others.
904 You don\'t have to leave and restart CPAN.pm, I\'ll look again next
905 time I come around here.\n\n};
910 if (-x $CPAN::Config->{'lynx'}) {
911 ## $self->debug("Trying with lynx for [$url]") if $CPAN::DEBUG;
912 my($want_compressed);
915 Trying with lynx to get $url
916 As lynx has so many options and versions, we\'re not sure, that we
917 get it right. It is recommended that you install Net::FTP as soon
918 as possible. Just type "install Net::FTP". Thank you.
922 $want_compressed = $aslocal =~ s/\.gz//;
923 my($system) = "$CPAN::Config->{'lynx'} -source '$url' > $aslocal";
924 if (system($system)==0) {
925 if ($want_compressed) {
926 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
927 if (system($system)==0) {
928 rename $aslocal, "$aslocal.gz";
930 $system = "$CPAN::Config->{'gzip'} $aslocal";
933 return "$aslocal.gz";
935 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
936 if (system($system)==0) {
937 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
940 # should be fine, eh?
946 warn "Can't access URL $url.
947 Either get LWP or Net::FTP
948 or an external lynx or ftp";
950 Carp::croak("Cannot fetch $file from anywhere");
953 package CPAN::FTP::external;
955 package CPAN::FTP::netrc;
959 my $file = MY->catfile($ENV{HOME},".netrc");
960 my($fh,@machines,$hasdefault);
962 if($fh = IO::File->new($file,"r")){
964 NETRC: while (<$fh>) {
965 my(@tokens) = split ' ', $_;
966 TOKEN: while (@tokens) {
967 my($t) = shift @tokens;
968 $hasdefault++, last NETRC if $t eq "default"; # we will most
971 last TOKEN if $t eq "macdef";
972 if ($t eq "machine") {
973 push @machines, shift @tokens;
981 'mach' => [@machines],
983 'hasdefault' => $hasdefault,
987 sub hasdefault { shift->{'hasdefault'} }
988 sub netrc { shift->{'netrc'} }
990 my($self,$mach) = @_;
991 scalar grep {$_ eq $mach} @{$self->{'mach'}};
994 package CPAN::Complete;
995 @CPAN::Complete::ISA = qw(CPAN::Debug);
997 #-> sub CPAN::Complete::complete ;
999 my($word,$line,$pos) = @_;
1003 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1007 @return = grep(/^$word/, sort qw(! a b d h i m o q r u autobundle clean make test install reload));
1008 } elsif ( $line !~ /^[\!abdhimorut]/ ) {
1010 } elsif ($line =~ /^a\s/) {
1011 @return = completex('CPAN::Author',$word);
1012 } elsif ($line =~ /^b\s/) {
1013 @return = completex('CPAN::Bundle',$word);
1014 } elsif ($line =~ /^d\s/) {
1015 @return = completex('CPAN::Distribution',$word);
1016 } elsif ($line =~ /^([mru]\s|(make|clean|test|install)\s)/ ) {
1017 @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
1018 } elsif ($line =~ /^i\s/) {
1019 @return = complete_any($word);
1020 } elsif ($line =~ /^reload\s/) {
1021 @return = complete_reload($word,$line,$pos);
1022 } elsif ($line =~ /^o\s/) {
1023 @return = complete_option($word,$line,$pos);
1030 #-> sub CPAN::Complete::completex ;
1032 my($class, $word) = @_;
1033 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1036 #-> sub CPAN::Complete::complete_any ;
1040 completex('CPAN::Author',$word),
1041 completex('CPAN::Bundle',$word),
1042 completex('CPAN::Distribution',$word),
1043 completex('CPAN::Module',$word),
1047 #-> sub CPAN::Complete::complete_reload ;
1048 sub complete_reload {
1049 my($word,$line,$pos) = @_;
1051 my(@words) = split " ", $line;
1052 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1053 my(@ok) = qw(cpan index);
1054 return @ok if @words==1;
1055 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1058 #-> sub CPAN::Complete::complete_option ;
1059 sub complete_option {
1060 my($word,$line,$pos) = @_;
1062 my(@words) = split " ", $line;
1063 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1064 my(@ok) = qw(conf debug);
1065 return @ok if @words==1;
1066 return grep /^\Q$word\E/, @ok if @words==2 && $word;
1068 } elsif ($words[1] eq 'index') {
1070 } elsif ($words[1] eq 'conf') {
1071 return CPAN::Config::complete(@_);
1072 } elsif ($words[1] eq 'debug') {
1073 return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1077 package CPAN::Index;
1078 use vars qw($last_time);
1079 @CPAN::Index::ISA = qw(CPAN::Debug);
1082 #-> sub CPAN::Index::force_reload ;
1085 $CPAN::Index::last_time = 0;
1089 #-> sub CPAN::Index::reload ;
1091 my($cl,$force) = @_;
1094 # XXX check if a newer one is available. (We currently read it from time to time)
1095 return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1098 $cl->read_authindex($cl->reload_x("authors/01mailrc.txt.gz","01mailrc.gz",$force));
1099 return if $CPAN::Signal; # this is sometimes lengthy
1100 $cl->read_modpacks($cl->reload_x("modules/02packages.details.txt.gz","02packag.gz",$force));
1101 return if $CPAN::Signal; # this is sometimes lengthy
1102 $cl->read_modlist($cl->reload_x("modules/03modlist.data.gz","03mlist.gz",$force));
1105 #-> sub CPAN::Index::reload_x ;
1107 my($cl,$wanted,$localname,$force) = @_;
1109 my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
1110 if (-f $abs_wanted && -M $abs_wanted < $CPAN::Config->{'index_expire'} && !$force) {
1111 my($s) = $CPAN::Config->{'index_expire'} != 1;
1112 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} day$s. I\'ll use that.\n});
1117 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1120 #-> sub CPAN::Index::read_authindex ;
1121 sub read_authindex {
1122 my($cl,$index_target) = @_;
1123 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1124 warn "Going to read $index_target\n";
1125 my $fh = IO::File->new("$pipe|");
1128 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1129 next unless $userid && $fullname && $email;
1131 # instantiate an author object
1132 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
1133 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
1134 return if $CPAN::Signal;
1137 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1140 #-> sub CPAN::Index::read_modpacks ;
1142 my($cl,$index_target) = @_;
1143 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1144 warn "Going to read $index_target\n";
1145 my $fh = IO::File->new("$pipe|");
1149 my($mod,$version,$dist) = split;
1150 $version =~ s/^\+//;
1152 # if it as a bundle, instatiate a bundle object
1154 if ($mod =~ /^Bundle::(.*)/) {
1158 if ($mod eq 'CPAN') {
1160 if ($version > $CPAN::VERSION){
1162 Hey, you know what? There\'s a new CPAN.pm version (v$version)
1163 available! I\'d suggest--provided you have time--you try
1166 without quitting the current session. It should be a seemless upgrade
1167 while we are running...
1176 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
1177 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1178 # This "next" makes us faster but if the job is running long, we ignore
1179 # rereads which is bad. So we have to be a bit slower again.
1180 # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
1183 # instantiate a module object
1184 $id = $CPAN::META->instance('CPAN::Module',$mod);
1185 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1188 # determine the author
1189 my($userid) = $dist =~ /([^\/]+)/;
1190 $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
1192 # instantiate a distribution object
1193 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1194 $CPAN::META->instance(
1195 'CPAN::Distribution' => $dist
1197 'CPAN_USERID' => $userid
1202 return if $CPAN::Signal;
1205 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1208 #-> sub CPAN::Index::read_modlist ;
1210 my($cl,$index_target) = @_;
1211 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1212 warn "Going to read $index_target\n";
1213 my $fh = IO::File->new("$pipe|");
1217 next if /use vars/; # will go away in 03...
1219 return if $CPAN::Signal;
1221 $eval .= q{CPAN::Modulelist->data;};
1223 my($comp) = Safe->new("CPAN::Safe1");
1224 my $ret = $comp->reval($eval);
1225 Carp::confess($@) if $@;
1226 return if $CPAN::Signal;
1228 my $obj = $CPAN::META->instance(CPAN::Module,$_);
1229 $obj->set(%{$ret->{$_}});
1230 return if $CPAN::Signal;
1234 package CPAN::InfoObj;
1235 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
1237 #-> sub CPAN::InfoObj::new ;
1238 sub new { my $this = bless {}, shift; %$this = @_; $this }
1240 #-> sub CPAN::InfoObj::set ;
1242 my($self,%att) = @_;
1243 my(%oldatt) = %$self;
1244 %$self = (%oldatt, %att);
1247 #-> sub CPAN::InfoObj::id ;
1248 sub id { shift->{'ID'} }
1250 #-> sub CPAN::InfoObj::as_glimpse ;
1254 my $class = ref($self);
1255 $class =~ s/^CPAN:://;
1256 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
1260 #-> sub CPAN::InfoObj::as_string ;
1264 my $class = ref($self);
1265 $class =~ s/^CPAN:://;
1266 push @m, $class, " id = $self->{ID}\n";
1267 for (sort keys %$self) {
1270 $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
1271 if (ref $self->{$_}) { # Should we setup a language interface? XXX
1272 push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
1274 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
1280 #-> sub CPAN::InfoObj::author ;
1283 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
1286 package CPAN::Author;
1287 @CPAN::Author::ISA = qw(CPAN::Debug CPAN::InfoObj);
1289 #-> sub CPAN::Author::as_glimpse ;
1293 my $class = ref($self);
1294 $class =~ s/^CPAN:://;
1295 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
1299 # Dead code, I would have liked to have,,, but it was never reached,,,
1302 # return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
1305 #-> sub CPAN::Author::fullname ;
1306 sub fullname { shift->{'FULLNAME'} }
1308 #-> sub CPAN::Author::email ;
1309 sub email { shift->{'EMAIL'} }
1311 package CPAN::Distribution;
1312 @CPAN::Distribution::ISA = qw(CPAN::Debug CPAN::InfoObj);
1314 #-> sub CPAN::Distribution::called_for ;
1317 $self->{'CALLED_FOR'} = $id if defined $id;
1318 return $self->{'CALLED_FOR'};
1321 #-> sub CPAN::Distribution::get ;
1326 exists $self->{'build_dir'} and push @e, "Unwrapped into directory $self->{'build_dir'}";
1327 print join "", map {" $_\n"} @e and return if @e;
1332 $CPAN::Config->{keep_source_where},
1335 split("/",$self->{ID})
1338 $self->debug("Doing localize") if $CPAN::DEBUG;
1339 $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
1340 $self->{localfile} = $local_file;
1341 my $builddir = $CPAN::META->{cachemgr}->dir;
1342 $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
1343 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
1346 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
1347 if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
1348 $self->debug("Removing tmp") if $CPAN::DEBUG;
1349 File::Path::rmtree("tmp");
1350 mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
1352 $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
1353 if ($local_file =~ /z$/i){
1354 $self->{archived} = "tar";
1355 if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
1356 $self->{unwrapped} = "YES";
1358 $self->{unwrapped} = "NO";
1360 } elsif ($local_file =~ /zip$/i) {
1361 $self->{archived} = "zip";
1362 if (system("$CPAN::Config->{unzip} $local_file")==0) {
1363 $self->{unwrapped} = "YES";
1365 $self->{unwrapped} = "NO";
1368 # Let's check if the package has its own directory.
1369 opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
1370 my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
1372 my ($distdir,$packagedir);
1373 if (@readdir == 1 && -d $readdir[0]) {
1374 $distdir = $readdir[0];
1375 $packagedir = $CPAN::META->catdir($builddir,$distdir);
1376 -d $packagedir and print "Removing previously used $packagedir\n";
1377 File::Path::rmtree($packagedir);
1378 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
1380 my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
1381 $pragmatic_dir =~ s/\W_//g;
1382 $pragmatic_dir++ while -d "../$pragmatic_dir";
1383 $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
1384 File::Path::mkpath($packagedir);
1386 for $f (@readdir) { # is already without "." and ".."
1387 my $to = $CPAN::META->catdir($packagedir,$f);
1388 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
1391 $self->{'build_dir'} = $packagedir;
1394 $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") if $CPAN::DEBUG;
1395 File::Path::rmtree("tmp");
1396 if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
1397 print "Going to unlink $local_file\n";
1398 unlink $local_file or Carp::carp "Couldn't unlink $local_file";
1400 my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
1401 unless (-f $makefilepl) {
1402 my($configure) = $CPAN::META->catfile($packagedir,"Configure");
1403 if (-f $configure) {
1404 # do we have anything to do?
1405 $self->{'configure'} = $configure;
1407 my $fh = IO::File->new(">$makefilepl") or Carp::croak("Could not open >$makefilepl");
1408 my $cf = $self->called_for || "unknown";
1410 # This Makefile.PL has been autogenerated by the module CPAN.pm
1411 # Autogenerated on: }.scalar localtime().qq{
1412 use ExtUtils::MakeMaker;
1413 WriteMakefile(NAME => q[$cf]);
1415 print qq{Package comes without Makefile.PL.\n}.
1416 qq{ Writing one on our own (calling it $cf)\n};
1420 $self->{archived} = "NO";
1425 #-> sub CPAN::Distribution::new ;
1427 my($class,%att) = @_;
1429 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
1431 my $this = { %att };
1432 return bless $this, $class;
1435 #-> sub CPAN::Distribution::readme ;
1438 print "Readme not yet implemented (says ".$self->id.")\n";
1441 #-> sub CPAN::Distribution::verifyMD5 ;
1446 $self->{MD5_STATUS} and push @e, "MD5 Checksum was ok";
1447 print join "", map {" $_\n"} @e and return if @e;
1450 my(@local) = split("/",$self->{ID});
1451 my($basename) = pop @local;
1452 push @local, "CHECKSUMS";
1455 $CPAN::Config->{keep_source_where},
1464 $self->MD5_check_file($local_wanted,$basename)
1466 return $self->{MD5_STATUS}="OK";
1468 $local_file = CPAN::FTP->localize("authors/id/@local", $local_wanted, 'force>:-{');
1473 $local[-1] .= ".gz";
1474 $local_file = CPAN::FTP->localize(
1475 "authors/id/@local",
1479 my $system = "$CPAN::Config->{gzip} --decompress $local_file";
1480 system($system)==0 or die "Could not uncompress $local_file";
1481 $local_file =~ s/\.gz$//;
1483 $self->MD5_check_file($local_file,$basename);
1486 #-> sub CPAN::Distribution::MD5_check_file ;
1487 sub MD5_check_file {
1488 my($self,$lfile,$basename) = @_;
1490 my $fh = new IO::File;
1492 if (open $fh, $lfile){
1495 my($comp) = Safe->new();
1496 $cksum = $comp->reval($eval);
1497 Carp::confess($@) if $@;
1498 if ($cksum->{$basename}->{md5}) {
1499 $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
1500 my $file = $self->{localfile};
1501 my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
1503 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
1505 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
1507 print "Checksum for $file ok\n";
1508 return $self->{MD5_STATUS}="OK";
1512 "\nChecksum mismatch for distribution file. Please investigate.\n\n",
1514 $CPAN::META->instance('CPAN::Author',$self->{CPAN_USERID})->as_string,
1515 "Please contact the author or your CPAN site admin"
1518 close $fh if fileno($fh);
1520 print "No md5 checksum for $basename in local $lfile\n";
1524 Carp::carp "Could not open $lfile for reading";
1528 #-> sub CPAN::Distribution::eq_MD5 ;
1530 my($self,$fh,$expectMD5) = @_;
1533 my $hexdigest = $md5->hexdigest;
1534 $hexdigest eq $expectMD5;
1537 #-> sub CPAN::Distribution::force ;
1540 $self->{'force_update'}++;
1541 delete $self->{'MD5_STATUS'};
1542 delete $self->{'archived'};
1543 delete $self->{'build_dir'};
1544 delete $self->{'localfile'};
1545 delete $self->{'make'};
1546 delete $self->{'install'};
1547 delete $self->{'unwrapped'};
1548 delete $self->{'writemakefile'};
1551 #-> sub CPAN::Distribution::make ;
1554 $self->debug($self->id) if $CPAN::DEBUG;
1555 print "Running make\n";
1557 if ($CPAN::META->hasMD5) {
1562 $self->{archived} eq "NO" and push @e, "Is neither a tar nor a zip archive.";
1563 $self->{unwrapped} eq "NO" and push @e, "had problems unarchiving. Please build manually";
1564 exists $self->{writemakefile} && $self->{writemakefile} eq "NO" and push @e, "Had some problem writing Makefile";
1565 defined $self->{'make'} and push @e, "Has already been processed within this session";
1566 print join "", map {" $_\n"} @e and return if @e;
1568 print "\n CPAN: Going to build ".$self->id."\n\n";
1569 my $builddir = $self->dir;
1570 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
1571 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
1574 if ($self->{'configure'}) {
1575 $system = $self->{'configure'};
1577 my($perl) = $^X =~ /^\.\// ? "$CPAN::Cwd/$^X" : $^X; # XXX subclassing folks, forgive me!
1578 $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
1580 $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
1583 if ($CPAN::Config->{inactivity_timeout}) {
1585 alarm $CPAN::Config->{inactivity_timeout};
1586 #$SIG{CHLD} = \&REAPER;
1587 if (defined($pid=fork)) {
1594 print "Cannot fork: $!";
1597 $ret = system($system);
1601 $ret = system($system);
1607 $self->{writemakefile} = "NO - $@";
1610 } elsif ($ret != 0) {
1611 $self->{writemakefile} = "NO";
1614 $self->{writemakefile} = "YES";
1615 return if $CPAN::Signal;
1616 $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
1617 if (system($system)==0) {
1618 print " $system -- OK\n";
1619 $self->{'make'} = "YES";
1621 $self->{writemakefile} = "YES";
1622 $self->{'make'} = "NO";
1623 print " $system -- NOT OK\n";
1627 #-> sub CPAN::Distribution::test ;
1631 return if $CPAN::Signal;
1632 print "Running make test\n";
1635 exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't test";
1636 exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
1637 exists $self->{'build_dir'} or push @e, "Has no own directory";
1638 print join "", map {" $_\n"} @e and return if @e;
1640 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1641 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1642 my $system = join " ", $CPAN::Config->{'make'}, "test";
1643 if (system($system)==0) {
1644 print " $system -- OK\n";
1645 $self->{'make_test'} = "YES";
1647 $self->{'make_test'} = "NO";
1648 print " $system -- NOT OK\n";
1652 #-> sub CPAN::Distribution::clean ;
1655 print "Running make clean\n";
1658 exists $self->{'build_dir'} or push @e, "Has no own directory";
1659 print join "", map {" $_\n"} @e and return if @e;
1661 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1662 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1663 my $system = join " ", $CPAN::Config->{'make'}, "clean";
1664 if (system($system)==0) {
1665 print " $system -- OK\n";
1668 # Hmmm, what to do if make clean failed?
1672 #-> sub CPAN::Distribution::install ;
1676 return if $CPAN::Signal;
1677 print "Running make install\n";
1680 exists $self->{'build_dir'} or push @e, "Has no own directory";
1681 exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't install";
1682 exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
1683 exists $self->{'install'} and push @e, $self->{'install'} eq "YES" ? "Already done" : "Already tried without success";
1684 print join "", map {" $_\n"} @e and return if @e;
1686 chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
1687 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
1688 my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
1689 my($pipe) = IO::File->new("$system 2>&1 |");
1692 # #If I were to try this, I'd do something like:
1694 # # $SIG{ALRM} = sub { die "alarm\n" };
1696 # # open(PROC,"make somesuch|");
1706 # #I'm really not sure how reliable this would is, though.
1709 # #Kenneth Albanowski (kjahds@kjahds.com, CIS: 70705,126)
1720 print " $system -- OK\n";
1721 $self->{'install'} = "YES";
1723 $self->{'install'} = "NO";
1724 print " $system -- NOT OK\n";
1725 if ($makeout =~ /permission/s && $> > 0) {
1726 print " You may have to su to root to install the package\n";
1731 #-> sub CPAN::Distribution::dir ;
1733 shift->{'build_dir'};
1736 package CPAN::Bundle;
1737 @CPAN::Bundle::ISA = qw(CPAN::Debug CPAN::InfoObj CPAN::Module);
1739 #-> sub CPAN::Bundle::as_string ;
1743 return $self->SUPER::as_string;
1746 #-> sub CPAN::Bundle::contains ;
1749 my($parsefile) = $self->inst_file;
1750 unless ($parsefile) {
1751 # Try to get at it in the cpan directory
1752 $self->debug("no parsefile") if $CPAN::DEBUG;
1753 my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
1754 $self->debug($dist->as_string) if $CPAN::DEBUG;
1756 $self->debug($dist->as_string) if $CPAN::DEBUG;
1757 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1758 File::Path::mkpath($todir);
1760 ($me = $self->id) =~ s/.*://;
1761 $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
1762 $to = $CPAN::META->catfile($todir,"$me.pm");
1763 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
1767 my $fh = new IO::File;
1769 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
1772 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
1777 push @result, (split " ", $_, 2)[0];
1780 delete $self->{STATUS};
1781 $self->{CONTAINS} = [@result];
1785 #-> sub CPAN::Bundle::inst_file ;
1789 ($me = $self->id) =~ s/.*://;
1790 $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
1791 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
1792 $inst_file = $self->SUPER::inst_file;
1793 return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
1794 return $self->{'INST_FILE'}; # even if undefined?
1797 #-> sub CPAN::Bundle::rematein ;
1799 my($self,$meth) = @_;
1800 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
1802 for $s ($self->contains) {
1803 $CPAN::META->instance('CPAN::Module',$s)->$meth();
1807 #-> sub CPAN::Bundle::force ;
1808 sub force { shift->rematein('force',@_); }
1809 #-> sub CPAN::Bundle::install ;
1810 sub install { shift->rematein('install',@_); }
1811 #-> sub CPAN::Bundle::clean ;
1812 sub clean { shift->rematein('clean',@_); }
1813 #-> sub CPAN::Bundle::test ;
1814 sub test { shift->rematein('test',@_); }
1815 #-> sub CPAN::Bundle::make ;
1816 sub make { shift->rematein('make',@_); }
1818 # XXX not yet implemented!
1819 #-> sub CPAN::Bundle::readme ;
1822 my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
1823 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
1824 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
1825 # CPAN::FTP->localize("authors/id/$file",$index_wanted); # XXX
1828 package CPAN::Module;
1829 @CPAN::Module::ISA = qw(CPAN::Debug CPAN::InfoObj);
1831 #-> sub CPAN::Module::as_glimpse ;
1835 my $class = ref($self);
1836 $class =~ s/^CPAN:://;
1837 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
1841 #-> sub CPAN::Module::as_string ;
1845 CPAN->debug($self) if $CPAN::DEBUG;
1846 my $class = ref($self);
1847 $class =~ s/^CPAN:://;
1849 push @m, $class, " id = $self->{ID}\n";
1850 my $sprintf = " %-12s %s\n";
1851 push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
1852 my $sprintf2 = " %-12s %s (%s)\n";
1854 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
1859 $CPAN::META->instance(CPAN::Author,$userid)->fullname
1862 push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
1863 push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
1864 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
1865 my(%statd,%stats,%statl,%stati);
1866 @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
1867 @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,;
1868 @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
1869 @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,;
1870 $statd{' '} = 'unknown';
1871 $stats{' '} = 'unknown';
1872 $statl{' '} = 'unknown';
1873 $stati{' '} = 'unknown';
1881 $statd{$self->{statd}},
1882 $stats{$self->{stats}},
1883 $statl{$self->{statl}},
1884 $stati{$self->{stati}}
1885 ) if $self->{statd};
1886 my $local_file = $self->inst_file;
1887 if ($local_file && ! exists $self->{MANPAGE}) {
1888 my $fh = IO::File->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
1893 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
1901 $self->{MANPAGE} = join " ", @result;
1903 push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE};
1904 push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
1905 push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
1909 #-> sub CPAN::Module::cpan_file ;
1912 CPAN->debug($self->id) if $CPAN::DEBUG;
1913 unless (defined $self->{'CPAN_FILE'}) {
1914 CPAN::Index->reload;
1916 if (defined $self->{'CPAN_FILE'}){
1917 return $self->{'CPAN_FILE'};
1918 } elsif (defined $self->{'userid'}) {
1919 return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
1925 *name = \&cpan_file;
1927 #-> sub CPAN::Module::cpan_version ;
1928 sub cpan_version { shift->{'CPAN_VERSION'} }
1930 #-> sub CPAN::Module::force ;
1933 $self->{'force_update'}++;
1936 #-> sub CPAN::Module::rematein ;
1938 my($self,$meth) = @_;
1939 $self->debug($self->id) if $CPAN::DEBUG;
1940 my $cpan_file = $self->cpan_file;
1941 return if $cpan_file eq "N/A";
1942 return if $cpan_file =~ /^Contact Author/;
1943 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1944 $pack->called_for($self->id);
1945 $pack->force if exists $self->{'force_update'};
1947 delete $self->{'force_update'};
1950 #-> sub CPAN::Module::readme ;
1951 sub readme { shift->rematein('readme') }
1952 #-> sub CPAN::Module::make ;
1953 sub make { shift->rematein('make') }
1954 #-> sub CPAN::Module::clean ;
1955 sub clean { shift->rematein('clean') }
1956 #-> sub CPAN::Module::test ;
1957 sub test { shift->rematein('test') }
1958 #-> sub CPAN::Module::install ;
1962 my($latest) = $self->cpan_version;
1964 my($inst_file) = $self->inst_file;
1966 if (defined $inst_file) {
1967 $have = $self->inst_version;
1969 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
1970 print $self->id, " is up to date.\n";
1974 $self->rematein('install') if $doit;
1977 #-> sub CPAN::Module::inst_file ;
1981 @packpath = split /::/, $self->{ID};
1982 $packpath[-1] .= ".pm";
1983 foreach $dir (@INC) {
1984 my $pmfile = CPAN->catfile($dir,@packpath);
1991 #-> sub CPAN::Module::xs_file ;
1995 @packpath = split /::/, $self->{ID};
1996 push @packpath, $packpath[-1];
1997 $packpath[-1] .= "." . $Config::Config{'dlext'};
1998 foreach $dir (@INC) {
1999 my $xsfile = CPAN->catfile($dir,'auto',@packpath);
2006 #-> sub CPAN::Module::inst_version ;
2009 my $parsefile = $self->inst_file or return 0;
2010 my $have = MY->parse_version($parsefile);
2017 package CPAN::CacheMgr;
2019 @CPAN::CacheMgr::ISA = qw(CPAN::Debug CPAN::InfoObj);
2022 #-> sub CPAN::CacheMgr::as_string ;
2024 eval { require Data::Dumper };
2026 return shift->SUPER::as_string;
2028 return Data::Dumper::Dumper(shift);
2032 #-> sub CPAN::CacheMgr::cachesize ;
2038 # my($self,@dirs) = @_;
2039 # return unless -d $self->{ID};
2041 # @dirs = $self->dirs unless @dirs;
2042 # for $dir (@dirs) {
2043 # $self->disk_usage($dir);
2047 #-> sub CPAN::CacheMgr::clean_cache ;
2051 while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
2052 $self->force_clean_cache($dir);
2054 $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
2057 #-> sub CPAN::CacheMgr::dir ;
2062 #-> sub CPAN::CacheMgr::entries ;
2064 my($self,$dir) = @_;
2065 $dir ||= $self->{ID};
2066 my($cwd) = Cwd::cwd();
2067 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
2068 my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
2071 next if $_ eq "." || $_ eq "..";
2073 push @entries, $CPAN::META->catfile($dir,$_);
2075 push @entries, $CPAN::META->catdir($dir,$_);
2077 print STDERR "Warning: weird direntry in $dir: $_\n";
2080 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
2081 sort {-M $b <=> -M $a} @entries;
2084 #-> sub CPAN::CacheMgr::disk_usage ;
2086 my($self,$dir) = @_;
2087 if (! defined $dir or $dir eq "") {
2088 $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
2091 return if defined $self->{SIZE}{$dir};
2100 $self->{SIZE}{$dir} = $Du/1024/1024;
2101 push @{$self->{FIFO}}, $dir;
2102 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
2103 $self->{DU} += $Du/1024/1024;
2104 if ($self->{DU} > $self->{'MAX'} ) {
2105 printf "...Hold on a sec... CPAN's cleaning the cache: %.2f MB > %.2f MB\n",
2106 $self->{DU}, $self->{'MAX'};
2109 $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}") if $CPAN::DEBUG;
2110 $self->debug($self->as_string) if $CPAN::DEBUG;
2115 #-> sub CPAN::CacheMgr::force_clean_cache ;
2116 sub force_clean_cache {
2117 my($self,$dir) = @_;
2118 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}") if $CPAN::DEBUG;
2119 File::Path::rmtree($dir);
2120 $self->{DU} -= $self->{SIZE}{$dir};
2121 delete $self->{SIZE}{$dir};
2124 #-> sub CPAN::CacheMgr::new ;
2127 my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, DU => 0 };
2128 File::Path::mkpath($self->{ID});
2129 my $dh = DirHandle->new($self->{ID});
2130 bless $self, $class;
2131 $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
2133 for $e ($self->entries) {
2134 next if $e eq ".." || $e eq ".";
2135 $self->debug("Have to check size $e") if $CPAN::DEBUG;
2136 $self->disk_usage($e);
2141 package CPAN::Debug;
2143 #-> sub CPAN::Debug::debug ;
2145 my($self,$arg) = @_;
2146 my($caller,$func,$line,@rest) = caller(1); # caller(0) eg Complete, caller(1) eg readline
2147 ($caller) = caller(0);
2148 $caller =~ s/.*:://;
2149 # print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
2150 # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
2151 if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
2153 eval { require Data::Dumper };
2155 print $arg->as_string;
2157 print Data::Dumper::Dumper($arg);
2160 print "Debug($caller:$func,$line,@rest): $arg\n"
2165 package CPAN::Config;
2166 import ExtUtils::MakeMaker 'neatvalue';
2170 'commit' => "Commit changes to disk",
2171 'defaults' => "Reload defaults from disk",
2174 #-> sub CPAN::Config::edit ;
2176 my($class,@args) = @_;
2177 return unless @args;
2178 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
2179 my($o,$str,$func,$args,$key_exists);
2185 if (ref($CPAN::Config->{$o}) eq ARRAY) {
2186 $func = shift @args;
2187 # Let's avoid eval, it's easier to comprehend without.
2188 if ($func eq "push") {
2189 push @{$CPAN::Config->{$o}}, @args;
2190 } elsif ($func eq "pop") {
2191 pop @{$CPAN::Config->{$o}};
2192 } elsif ($func eq "shift") {
2193 shift @{$CPAN::Config->{$o}};
2194 } elsif ($func eq "unshift") {
2195 unshift @{$CPAN::Config->{$o}}, @args;
2196 } elsif ($func eq "splice") {
2197 splice @{$CPAN::Config->{$o}}, @args;
2199 $CPAN::Config->{$o} = [@args];
2202 $CPAN::Config->{$o} = $args[0];
2204 print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
2209 #-> sub CPAN::Config::commit ;
2211 my($self, $configpm) = @_;
2215 my($fh) = IO::File->new;
2216 $configpm ||= cfile();
2218 $mode = (stat $configpm)[2];
2219 if ($mode && ! -w _) {
2220 print "$configpm is not writable\n" and return;
2222 #chmod 0644, $configpm; #?
2225 my $msg = <<EOF unless $configpm =~ /MyConfig/;
2227 # This is CPAN.pm's systemwide configuration file. This file provides
2228 # defaults for users, and the values can be changed in a per-user configuration
2229 # file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
2233 open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
2234 print $fh qq[$msg\$CPAN::Config = \{\n];
2235 foreach (sort keys %$CPAN::Config) {
2236 print $fh " '$_' => ", ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}), ",\n";
2239 print $fh "};\n1;\n__END__\n";
2242 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
2243 #chmod $mode, $configpm;
2245 print "commit: wrote $configpm\n";
2249 *default = \&defaults;
2250 #-> sub CPAN::Config::defaults ;
2259 #-> sub CPAN::Config::load ;
2262 eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems
2263 unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
2264 eval {require CPAN::MyConfig;}; # where you can override system wide settings
2265 unless ( $self->load_succeeded ) {
2266 require CPAN::FirstTime;
2268 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
2269 $configpm = $INC{"CPAN/Config.pm"};
2270 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
2271 $configpm = $INC{"CPAN/MyConfig.pm"};
2273 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
2274 my($configpmdir) = MY->catdir($path_to_cpan,"CPAN");
2275 my($configpmtest) = MY->catfile($configpmdir,"Config.pm");
2276 if (-d $configpmdir || File::Path::mkpath($configpmdir)) {
2277 #_#_# following code dumped core on me with 5.003_11, a.k.
2278 #_#_# $fh = IO::File->new;
2279 #_#_# if ($fh->open(">$configpmtest")) {
2280 #_#_# $fh->print("1;\n");
2281 #_#_# $configpm = $configpmtest;
2283 if (-w $configpmtest or -w $configpmdir) {
2284 $configpm = $configpmtest;
2287 unless ($configpm) {
2288 $configpmdir = MY->catdir($ENV{HOME},".cpan","CPAN");
2289 File::Path::mkpath($configpmdir);
2290 $configpmtest = MY->catfile($configpmdir,"MyConfig.pm");
2291 if (-w $configpmtest or -w $configpmdir) {
2292 $configpm = $configpmtest;
2294 warn "WARNING: CPAN.pm is unable to create a configuration file.\n";
2298 warn "Calling CPAN::FirstTime::init($configpm)";
2299 CPAN::FirstTime::init($configpm);
2303 #-> sub CPAN::Config::load_succeeded ;
2304 sub load_succeeded {
2307 cpan_home keep_source_where build_dir build_cache index_expire
2308 gzip tar unzip make pager makepl_arg make_arg make_install_arg
2309 urllist inhibit_startup_message
2311 $miss++ unless defined $CPAN::Config->{$_}; # we want them all
2316 #-> sub CPAN::Config::unload ;
2318 delete $INC{'CPAN/MyConfig.pm'};
2319 delete $INC{'CPAN/Config.pm'};
2322 #-> sub CPAN::Config::cfile ;
2324 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'};
2328 #-> sub CPAN::Config::help ;
2332 defaults reload default config values from disk
2333 commit commit session changes to disk
2335 You may edit key values in the follow fashion:
2337 o conf build_cache 15
2339 o conf build_dir "/foo/bar"
2341 o conf urllist shift
2343 o conf urllist unshift ftp://ftp.foo.bar/
2346 undef; #don't reprint CPAN::Config
2349 #-> sub CPAN::Config::complete ;
2351 my($word,$line,$pos) = @_;
2353 my(@words) = split " ", $line;
2354 my(@o_conf) = (sort keys %CPAN::Config::can, sort keys %$CPAN::Config);
2355 return (@o_conf) unless @words>2;
2356 if($words[2] =~ /->(.*)/) {
2358 my(@methods) = qw(shift unshift push pop splice);
2359 return @methods unless $meth;
2360 return sort grep /^\Q$meth\E/, @methods;
2362 return sort grep /^\Q$word\E/, @o_conf;
2369 CPAN - query, download and build perl modules from CPAN sites
2375 perl -MCPAN -e shell;
2381 autobundle, clean, install, make, recompile, test
2385 The CPAN module is designed to automate the make and install of perl
2386 modules and extensions. It includes some searching capabilities and
2387 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
2388 to fetch the raw data from the net.
2390 Modules are fetched from one or more of the mirrored CPAN
2391 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
2394 The CPAN module also supports the concept of named and versioned
2395 'bundles' of modules. Bundles simplify the handling of sets of
2396 related modules. See BUNDLES below.
2398 The package contains a session manager and a cache manager. There is
2399 no status retained between sessions. The session manager keeps track
2400 of what has been fetched, built and installed in the current
2401 session. The cache manager keeps track of the disk space occupied by
2402 the make processes and deletes excess space according to a simple FIFO
2405 All methods provided are accessible in a programmer style and in an
2406 interactive shell style.
2408 =head2 Interactive Mode
2410 The interactive mode is entered by running
2412 perl -MCPAN -e shell
2414 which puts you into a readline interface. You will have most fun if
2415 you install Term::ReadKey and Term::ReadLine to enjoy both history and
2418 Once you are on the command line, type 'h' and the rest should be
2421 The most common uses of the interactive modes are
2425 =item Searching for authors, bundles, distribution files and modules
2427 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
2428 for each of the four categories and another, C<i> for any of the
2429 mentioned four. Each of the four entities is implemented as a class
2430 with slightly differing methods for displaying an object.
2432 Arguments you pass to these commands are either strings matching exact
2433 the identification string of an object or regular expressions that are
2434 then matched case-insensitively against various attributes of the
2435 objects. The parser recognizes a regualar expression only if you
2436 enclose it between two slashes.
2438 The principle is that the number of found objects influences how an
2439 item is displayed. If the search finds one item, we display the result
2440 of object-E<gt>as_string, but if we find more than one, we display
2441 each as object-E<gt>as_glimpse. E.g.
2445 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2446 FULLNAME Andreas König
2451 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2452 FULLNAME Andreas König
2456 Author ANDYD (Andy Dougherty)
2457 Author MERLYN (Randal L. Schwartz)
2459 =item make, test, install, clean modules or distributions
2461 The four commands do indeed exist just as written above. Each of them
2462 takes as many arguments as provided and investigates for each what it
2463 might be. Is it a distribution file (recognized by embedded slashes),
2464 this file is being processed. Is it a module, CPAN determines the
2465 distribution file where this module is included and processes that.
2467 Any C<make> and C<test> are run unconditionally. A
2469 C<install E<lt>distribution_fileE<gt>>
2471 also is run unconditionally. But for
2473 C<install E<lt>moduleE<gt>>
2475 CPAN checks if an install is actually needed for it and prints
2476 I<Foo up to date> in case the module doesnE<39>t need to be updated.
2478 CPAN also keeps track of what it has done within the current session
2479 and doesnE<39>t try to build a package a second time regardless if it
2480 succeeded or not. The C<force > command takes as first argument the
2481 method to invoke (currently: make, test, or install) and executes the
2482 command from scratch.
2486 cpan> install OpenGL
2487 OpenGL is up to date.
2488 cpan> force install OpenGL
2491 OpenGL-0.4/COPYRIGHT
2498 The commands that are available in the shell interface are methods in
2499 the package CPAN::Shell. If you enter the shell command, all your
2500 input is split by the Text::ParseWords::shellwords() routine which
2501 acts like most shells do. The first word is being interpreted as the
2502 method to be called and the rest of the words are treated as arguments
2505 =head2 ProgrammerE<39>s interface
2507 If you do not enter the shell, the available shell commands are both
2508 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
2509 functions in the calling package (C<install(...)>). The
2510 programmerE<39>s interface has beta status. Do not heavily rely on it,
2511 changes may still be necessary.
2513 =head2 Cache Manager
2515 Currently the cache manager only keeps track of the build directory
2516 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
2517 deletes complete directories below C<build_dir> as soon as the size of
2518 all directories there gets bigger than $CPAN::Config->{build_cache}
2519 (in MB). The contents of this cache may be used for later
2520 re-installations that you intend to do manually, but will never be
2521 trusted by CPAN itself. This is due to the fact that the user might
2522 use these directories for building modules on different architectures.
2524 There is another directory ($CPAN::Config->{keep_source_where}) where
2525 the original distribution files are kept. This directory is not
2526 covered by the cache manager and must be controlled by the user. If
2527 you choose to have the same directory as build_dir and as
2528 keep_source_where directory, then your sources will be deleted with
2529 the same fifo mechanism.
2533 A bundle is just a perl module in the namespace Bundle:: that does not
2534 define any functions or methods. It usually only contains documentation.
2536 It starts like a perl module with a package declaration and a $VERSION
2537 variable. After that the pod section looks like any other pod with the
2538 only difference, that I<one special pod section> exists starting with
2543 In this pod section each line obeys the format
2545 Module_Name [Version_String] [- optional text]
2547 The only required part is the first field, the name of a module
2548 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
2549 of the line is optional. The comment part is delimited by a dash just
2550 as in the man page header.
2552 The distribution of a bundle should follow the same convention as
2553 other distributions.
2555 Bundles are treated specially in the CPAN package. If you say 'install
2556 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
2557 the modules in the CONTENTS section of the pod. You can install your
2558 own Bundles locally by placing a conformant Bundle file somewhere into
2559 your @INC path. The autobundle() command which is available in the
2560 shell interface does that for you by including all currently installed
2561 modules in a snapshot bundle file.
2563 There is a meaningless Bundle::Demo available on CPAN. Try to install
2564 it, it usually does no harm, just demonstrates what the Bundle
2565 interface looks like.
2569 C<autobundle> writes a bundle file into the
2570 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
2571 a list of all modules that are both available from CPAN and currently
2572 installed within @INC. The name of the bundle file is based on the
2573 current date and a counter.
2577 recompile() is a very special command in that it takes no argument and
2578 runs the make/test/install cycle with brute force over all installed
2579 dynamically loadable extensions (aka XS modules) with 'force' in
2580 effect. Primary purpose of this command is to act as a rescue in case
2581 your perl breaks binary compatibility. If one of the modules that CPAN
2582 uses is in turn depending on binary compatibility (so you cannot run
2583 CPAN commands), then you should try the CPAN::Nox module for recovery.
2585 Another popular use for recompile is to finish a network
2586 installation. Imagine, you have a common source tree for two different
2587 architectures. You decide to do a completely independent fresh
2588 installation. You start on one architecture with the help of a Bundle
2589 file produced earlier. CPAN installs the whole Bundle for you, but
2590 when you try to repeat the job on the second architecture, CPAN
2591 responds with a C<"Foo up to date"> message for all modules. So you
2592 will be glad to run recompile in the second architecture and
2595 =head1 CONFIGURATION
2597 When the CPAN module is installed a site wide configuration file is
2598 created as CPAN/Config.pm. The default values defined there can be
2599 overridden in another configuration file: CPAN/MyConfig.pm. You can
2600 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
2601 $HOME/.cpan is added to the search path of the CPAN module before the
2602 use() or require() statements.
2604 Currently the following keys in the hash reference $CPAN::Config are
2607 build_cache size of cache for directories to build modules
2608 build_dir locally accessible directory to build modules
2609 index_expire after how many days refetch index files
2610 cpan_home local directory reserved for this package
2611 gzip location of external program gzip
2612 inactivity_timeout breaks interactive Makefile.PLs after that
2613 many seconds inactivity. Set to 0 to never break.
2614 inhibit_startup_message
2615 if true, does not print the startup message
2616 keep_source keep the source in a local directory?
2617 keep_source_where where keep the source (if we do)
2618 make location of external program make
2619 make_arg arguments that should always be passed to 'make'
2620 make_install_arg same as make_arg for 'make install'
2621 makepl_arg arguments passed to 'perl Makefile.PL'
2622 pager location of external program more (or any pager)
2623 tar location of external program tar
2624 unzip location of external program unzip
2625 urllist arrayref to nearby CPAN sites (or equivalent locations)
2627 You can set and query each of these options interactively in the cpan
2628 shell with the command set defined within the C<o conf> command:
2632 =item o conf E<lt>scalar optionE<gt>
2634 prints the current value of the I<scalar option>
2636 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
2638 Sets the value of the I<scalar option> to I<value>
2640 =item o conf E<lt>list optionE<gt>
2642 prints the current value of the I<list option> in MakeMaker's
2645 =item o conf E<lt>list optionE<gt> [shift|pop]
2647 shifts or pops the array in the I<list option> variable
2649 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
2651 works like the corresponding perl commands.
2657 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
2658 install foreign, unmasked, unsigned code on your machine. We compare
2659 to a checksum that comes from the net just as the distribution file
2660 itself. If somebody has managed to tamper with the distribution file,
2661 they may have as well tampered with the CHECKSUMS file. Future
2662 development will go towards strong authentification.
2666 Most functions in package CPAN are exported per default. The reason
2667 for this is that the primary use is intended for the cpan shell or for
2672 The debugging of this module is pretty difficult, because we have
2673 interferences of the software producing the indices on CPAN, of the
2674 mirroring process on CPAN, of packaging, of configuration, of
2675 synchronicity, and of bugs within CPAN.pm.
2677 In interactive mode you can try "o debug" which will list options for
2678 debugging the various parts of the package. The output may not be very
2679 useful for you as it's just a byproduct of my own testing, but if you
2680 have an idea which part of the package may have a bug, it's sometimes
2681 worth to give it a try and send me more specific output. You should
2682 know that "o debug" has built-in completion support.
2684 =head2 Prerequisites
2686 If you have a local mirror of CPAN and can access all files with
2687 "file:" URLs, then you only need perl5.003 to run this
2688 module. Otherwise Net::FTP is recommended. LWP may be required for
2689 non-UNIX systems or if your nearest CPAN site is associated with an
2690 URL that is not C<ftp:>.
2692 If you have neither Net::FTP nor LWP, there is a fallback mechanism
2693 implemented for an external ftp command or for an external lynx
2696 This module presumes that all packages on CPAN
2702 declare their $VERSION variable in an easy to parse manner. This
2703 prerequisite can hardly be relaxed because it consumes by far too much
2704 memory to load all packages into the running program just to determine
2705 the $VERSION variable . Currently all programs that are dealing with
2706 version use something like this
2708 perl -MExtUtils::MakeMaker -le \
2709 'print MM->parse_version($ARGV[0])' filename
2711 If you are author of a package and wonder if your $VERSION can be
2712 parsed, please try the above method.
2716 come as compressed or gzipped tarfiles or as zip files and contain a
2717 Makefile.PL (well we try to handle a bit more, but without much
2724 Andreas König E<lt>a.koenig@mind.deE<gt>
2728 perl(1), CPAN::Nox(3)