projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Refresh CPAN module to 1.08
[p5sagit/p5-mst-13.2.git] / lib / CPAN.pm
CommitLineData
5f05dabc 1package CPAN;
2use vars qw{$META $Signal $Cwd $End $Suppress_readline};
3
10b2abe6 4$VERSION = '1.08';
5f05dabc 5
10b2abe6 6# $Id: CPAN.pm,v 1.92 1996/12/23 13:13:05 k Exp $
5f05dabc 7
10b2abe6 8# my $version = substr q$Revision: 1.92 $, 10; # only used during development
5f05dabc 9
10BEGIN {require 5.003;}
11require UNIVERSAL if $] == 5.003;
12
13use Carp ();
14use Config ();
15use Cwd ();
16use DirHandle;
17use Exporter ();
18use ExtUtils::MakeMaker ();
19use File::Basename ();
10b2abe6 20use File::Copy ();
5f05dabc 21use File::Find;
22use File::Path ();
23use IO::File ();
24use Safe ();
10b2abe6 25use Text::ParseWords ();
5f05dabc 26
27$Cwd = Cwd::cwd();
28
29END { $End++; &cleanup; }
30
31%CPAN::DEBUG = qw(
32 CPAN 1
33 Index 2
34 InfoObj 4
35 Author 8
36 Distribution 16
37 Bundle 32
38 Module 64
39 CacheMgr 128
40 Complete 256
41 FTP 512
42 Shell 1024
43 Eval 2048
44 Config 4096
45 );
46
47$CPAN::DEBUG ||= 0;
48
49package CPAN;
10b2abe6 50use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META);
5f05dabc 51use strict qw(vars);
52
10b2abe6 53@CPAN::ISA = qw(CPAN::Debug Exporter MY); # the MY class from
54 # MakeMaker, gives us
55 # catfile and catdir
5f05dabc 56
10b2abe6 57$META ||= new CPAN; # In case we reeval ourselves we
58 # need a ||
5f05dabc 59
60CPAN::Config->load;
61
62@EXPORT = qw(autobundle bundle expand force install make recompile shell test clean);
63
10b2abe6 64
65
66#-> sub CPAN::autobundle ;
5f05dabc 67sub autobundle;
10b2abe6 68#-> sub CPAN::bundle ;
5f05dabc 69sub bundle;
10b2abe6 70#-> sub CPAN::expand ;
5f05dabc 71sub expand;
10b2abe6 72#-> sub CPAN::force ;
5f05dabc 73sub force;
10b2abe6 74#-> sub CPAN::install ;
5f05dabc 75sub install;
10b2abe6 76#-> sub CPAN::make ;
5f05dabc 77sub make;
10b2abe6 78#-> sub CPAN::shell ;
5f05dabc 79sub shell;
10b2abe6 80#-> sub CPAN::clean ;
5f05dabc 81sub clean;
10b2abe6 82#-> sub CPAN::test ;
5f05dabc 83sub test;
84
10b2abe6 85#-> sub CPAN::AUTOLOAD ;
5f05dabc 86sub AUTOLOAD {
87 my($l) = $AUTOLOAD;
88 $l =~ s/.*:://;
89 my(%EXPORT);
90 @EXPORT{@EXPORT} = '';
91 if (exists $EXPORT{$l}){
92 CPAN::Shell->$l(@_);
93 } else {
94 warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
95Nothing Done.
96";
97 CPAN::Shell->h;
98 }
99}
100
10b2abe6 101#-> sub CPAN::all ;
5f05dabc 102sub all {
103 my($mgr,$class) = @_;
104 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
105 CPAN::Index->reload;
106 values %{ $META->{$class} };
107}
108
109# Called by shell, not in batch mode. Not clean XXX
10b2abe6 110#-> sub CPAN::checklock ;
5f05dabc 111sub checklock {
112 my($self) = @_;
113 my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
114 if (-f $lockfile && -M _ > 0) {
115 my $fh = IO::File->new($lockfile);
116 my $other = <$fh>;
117 $fh->close;
118 if (defined $other && $other) {
119 chomp $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}.
125 qq{ kill $other\n}.
126 qq{ rm $lockfile\n};
127 } elsif (-w $lockfile) {
128 my($ans)=
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;
132 } else {
133 Carp::croak(
134 qq{Lockfile $lockfile not writeable by you. Cannot proceed.\n}.
135 qq{ On UNIX try:\n}.
136 qq{ rm $lockfile\n}.
137 qq{ and then rerun us.\n}
138 );
139 }
140 }
141 }
142 File::Path::mkpath($CPAN::Config->{cpan_home});
143 my $fh;
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');
148 print qq{
149
150Your configuration suggests that CPAN.pm should use a working
151directory of
152 $CPAN::Config->{cpan_home}
153Unfortunately we could not create the lock file
154 $lockfile
155due to permission problems.
156
157Please make sure that the configuration variable
158 \$CPAN::Config->{cpan_home}
159points to a directory where you can write a .lock file. You can set
160this variable in either
161 $incc
162or
163 $myincc
164
165};
166 }
167 Carp::croak "Could not open >$lockfile: $!";
168 }
169 print $fh $$, "\n";
170 $self->{LOCK} = $lockfile;
171 $fh->close;
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'};
176}
177
10b2abe6 178#-> sub CPAN::DESTROY ;
5f05dabc 179sub DESTROY {
180 &cleanup; # need an eval?
181}
182
10b2abe6 183#-> sub CPAN::exists ;
5f05dabc 184sub exists {
185 my($mgr,$class,$id) = @_;
186 CPAN::Index->reload;
187 Carp::croak "exists called without class argument" unless $class;
188 $id ||= "";
189 exists $META->{$class}{$id};
190}
191
10b2abe6 192#-> sub CPAN::hasFTP ;
5f05dabc 193sub hasFTP {
194 my($self,$arg) = @_;
195 if (defined $arg) {
196 return $self->{'hasFTP'} = $arg;
197 } elsif (not defined $self->{'hasFTP'}) {
198 eval {require Net::FTP;};
199 $self->{'hasFTP'} = $@ ? 0 : 1;
200 }
201 return $self->{'hasFTP'};
202}
203
10b2abe6 204#-> sub CPAN::hasLWP ;
5f05dabc 205sub hasLWP {
206 my($self,$arg) = @_;
207 if (defined $arg) {
208 return $self->{'hasLWP'} = $arg;
209 } elsif (not defined $self->{'hasLWP'}) {
210 eval {require LWP;};
211 $LWP::VERSION ||= 0;
212 $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
213 }
214 return $self->{'hasLWP'};
215}
216
10b2abe6 217#-> sub CPAN::hasMD5 ;
5f05dabc 218sub hasMD5 {
219 my($self,$arg) = @_;
220 if (defined $arg) {
221 $self->{'hasMD5'} = $arg;
222 } elsif (not defined $self->{'hasMD5'}) {
223 eval {require MD5;};
224 if ($@) {
225 print "MD5 security checks disabled because MD5 not installed. Please consider installing MD5\n";
226 $self->{'hasMD5'} = 0;
227 } else {
228 $self->{'hasMD5'}++;
229 }
230 }
231 return $self->{'hasMD5'};
232}
233
10b2abe6 234#-> sub CPAN::instance ;
5f05dabc 235sub instance {
236 my($mgr,$class,$id) = @_;
237 CPAN::Index->reload;
238 Carp::croak "instance called without class argument" unless $class;
239 $id ||= "";
240 $META->{$class}{$id} ||= $class->new(ID => $id );
241}
242
10b2abe6 243#-> sub CPAN::new ;
5f05dabc 244sub new {
245 bless {}, shift;
246}
247
10b2abe6 248#-> sub CPAN::cleanup ;
5f05dabc 249sub 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)';
254 }
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(@_);
261# die @_;
262}
263
10b2abe6 264#-> sub CPAN::shell ;
5f05dabc 265sub shell {
266 $Suppress_readline ||= ! -t STDIN;
267
268 my $prompt = "cpan> ";
269 local($^W) = 1;
270 my $term;
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';
277 }
278
279 no strict;
280 $META->checklock();
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" :
10b2abe6 285 "available (get Term::ReadKey and Term::ReadLine)";
5f05dabc 286
287 print qq{
288cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
289Readline support $rl_avail
290
291} unless $CPAN::Config->{'inhibit_startup_message'} ;
292 while () {
293 if ($Suppress_readline) {
294 print $prompt;
295 last unless defined (chomp($_ = <>));
296 } else {
297 last unless defined ($_ = $term->readline($prompt));
298 }
299 s/^\s//;
300 next if /^$/;
301 $_ = 'h' if $_ eq '?';
302 if (/^\!/) {
303 s/^\!//;
304 my($eval) = $_;
305 package CPAN::Eval;
306 use vars qw($import_done);
307 CPAN->import(':DEFAULT') unless $import_done++;
308 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
309 eval($eval);
310 warn $@ if $@;
311 } elsif (/^q(?:uit)?$/i) {
312 last;
313 } elsif (/./) {
10b2abe6 314 my(@line);
315 eval { @line = Text::ParseWords::shellwords($_) };
316 warn($@), next if $@;
317 $CPAN::META->debug("line[".join(":",@line)."]") if $CPAN::DEBUG;
5f05dabc 318 my $command = shift @line;
319 eval { CPAN::Shell->$command(@line) };
320 warn $@ if $@;
321 }
322 } continue {
323 &cleanup, die if $Signal;
324 chdir $cwd;
325 print "\n";
326 }
327}
328
329package CPAN::Shell;
10b2abe6 330use vars qw($AUTOLOAD);
331@CPAN::Shell::ISA = qw(CPAN::Debug);
5f05dabc 332
333# private function ro re-eval this module (handy during development)
10b2abe6 334#-> sub CPAN::Shell::AUTOLOAD ;
5f05dabc 335sub AUTOLOAD {
336 warn "CPAN::Shell doesn't know how to autoload $AUTOLOAD :-(
337Nothing Done.
338";
339 CPAN::Shell->h;
340}
341
10b2abe6 342#-> sub CPAN::Shell::h ;
5f05dabc 343sub h {
344 my($class,$about) = @_;
345 if (defined $about) {
346 print "Detailed help not yet implemented\n";
347 } else {
348 print q{
349command arguments description
350a string authors
351b or display bundles
352d /regex/ info distributions
353m or about modules
354i none anything of above
355
356r as reinstall recommendations
357u above uninstalled distributions
10b2abe6 358See manpage for autobundle, recompile, force, etc.
5f05dabc 359
360make modules, make
361test dists, bundles, make test (implies make)
362install "r" or "u" make install (implies test)
363clean make clean
364
365reload index|cpan load most recent indices/CPAN.pm
366h or ? display this menu
367o various set and query options
368! perl-code eval a perl command
369q quit the shell subroutine
370};
371 }
372}
373
10b2abe6 374#-> sub CPAN::Shell::a ;
5f05dabc 375sub a { print shift->format_result('Author',@_);}
10b2abe6 376#-> sub CPAN::Shell::b ;
5f05dabc 377sub b {
378 my($self,@which) = @_;
10b2abe6 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
383 my($entry);
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");
388 }
389 }
5f05dabc 390 }
391 print $self->format_result('Bundle',@which);
392}
10b2abe6 393#-> sub CPAN::Shell::d ;
5f05dabc 394sub d { print shift->format_result('Distribution',@_);}
10b2abe6 395#-> sub CPAN::Shell::m ;
5f05dabc 396sub m { print shift->format_result('Module',@_);}
397
10b2abe6 398#-> sub CPAN::Shell::i ;
5f05dabc 399sub i {
400 my($self) = shift;
401 my(@args) = @_;
402 my(@type,$type,@m);
403 @type = qw/Author Bundle Distribution Module/;
404 @args = '/./' unless @args;
405 my(@result);
406 for $type (@type) {
407 push @result, $self->expand($type,@args);
408 }
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";
411 print $result;
412}
413
10b2abe6 414#-> sub CPAN::Shell::o ;
5f05dabc 415sub o {
416 my($self,$o_type,@o_what) = @_;
417 $o_type ||= "";
10b2abe6 418 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
5f05dabc 419 if ($o_type eq 'conf') {
420 shift @o_what if @o_what && $o_what[0] eq 'help';
421 if (!@o_what) {
422 my($k,$v);
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;
427 }
428 print "\n";
429 for $k (sort keys %$CPAN::Config) {
430 $v = $CPAN::Config->{$k};
431 if (ref $v) {
432 printf " %-18s\n", $k;
433 print map {"\t$_\n"} @{$v};
434 } else {
435 printf " %-18s %s\n", $k, $v;
436 }
437 }
438 print "\n";
439 } elsif (!CPAN::Config->edit(@o_what)) {
440 print qq[Type 'o conf' to view configuration edit options\n\n];
441 }
442 } elsif ($o_type eq 'debug') {
443 my(%valid);
444 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
445 if (@o_what) {
446 while (@o_what) {
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') {
453 my($max) = 0;
454 for (values %CPAN::DEBUG) {
455 $max += $_;
456 }
457 $CPAN::DEBUG = $max;
458 } else {
459 for (keys %CPAN::DEBUG) {
460 next unless lc($_) eq lc($what);
461 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
462 }
463 print "unknown argument $what\n";
464 }
465 }
466 } else {
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";
469 }
470 if ($CPAN::DEBUG) {
471 print "Options set for debugging:\n";
472 my($k,$v);
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;
476 }
477 } else {
478 print "Debugging turned off completely.\n";
479 }
480 } else {
481 print qq{
482Known options:
483 conf set or get configuration variables
484 debug set or get debugging options
485};
486 }
487}
488
10b2abe6 489#-> sub CPAN::Shell::reload ;
5f05dabc 490sub 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'});
494 local $/;
495 undef $/;
496 eval <$fh>;
497 warn $@ if $@;
498 } elsif ($_[1] =~ /index/) {
499 CPAN::Index->force_reload;
500 }
501}
502
10b2abe6 503#-> sub CPAN::Shell::_binary_extensions ;
5f05dabc 504sub _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;
514 }
515# print join " | ", @result;
516# print "\n";
517 return @result;
518}
519
10b2abe6 520#-> sub CPAN::Shell::recompile ;
5f05dabc 521sub 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);
528 $pack->force;
529 $dist{$cpan_file}++;
530 }
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);
534 $pack->install;
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
538 }
539}
540
10b2abe6 541#-> sub CPAN::Shell::_u_r_common ;
5f05dabc 542sub _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]$/;
548 my(@args) = @_;
549 @args = '/./' unless @args;
550 my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
551 $version_zeroes = 0;
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;
558 my($have);
559 if ($inst_file){
560 if ($what eq "a") {
561 $have = $module->inst_version;
562 } elsif ($what eq "r") {
563 $have = $module->inst_version;
564 local($^W) = 0;
565 $version_zeroes++ unless $have;
566 next if $have >= $latest;
567 } elsif ($what eq "u") {
568 next;
569 }
570 } else {
571 if ($what eq "a") {
572 next;
573 } elsif ($what eq "r") {
574 next;
575 } elsif ($what eq "u") {
576 $have = "-";
577 }
578 }
579 $seen{$file} ||= 0;
580 if ($what eq "a") {
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/;
589 }
590 unless ($headerdone++){
591 print "\n";
592 printf $sprintf, "Package namespace", "installed", "latest", "in CPAN file";
593 }
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
599 }
600 unless (%need) {
601 if ($what eq "u") {
602 print "No modules found for @args\n";
603 } elsif ($what eq "r") {
604 print "All modules are up to date for @args\n";
605 }
606 }
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};
610 }
611 @result;
612}
613
10b2abe6 614#-> sub CPAN::Shell::r ;
5f05dabc 615sub r {
616 shift->_u_r_common("r",@_);
617}
618
10b2abe6 619#-> sub CPAN::Shell::u ;
5f05dabc 620sub u {
621 shift->_u_r_common("u",@_);
622}
623
10b2abe6 624#-> sub CPAN::Shell::autobundle ;
5f05dabc 625sub autobundle {
626 my($self) = shift;
627 my(@bundle) = $self->_u_r_common("a",@_);
628 my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
629 File::Path::mkpath($todir);
630 unless (-d $todir) {
631 print "Couldn't mkdir $todir for some reason\n";
632 return;
633 }
634 my($y,$m,$d) = (localtime)[5,4,3];
635 $y+=1900;
636 $m++;
637 my($c) = 0;
638 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
639 my($to) = $CPAN::META->catfile($todir,"$me.pm");
640 while (-f $to) {
641 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
642 $to = $CPAN::META->catfile($todir,"$me.pm");
643 }
644 my($fh) = IO::File->new(">$to") or Carp::croak "Can't open >$to: $!";
645 $fh->print(
646 "package Bundle::$me;\n\n",
647 "\$VERSION = '0.01';\n\n",
648 "1;\n\n",
649 "__END__\n\n",
650 "=head1 NAME\n\n",
651 "Bundle::$me - Snapshot of installation on ",
652 $Config::Config{'myhostname'},
653 " on ",
654 scalar(localtime),
655 "\n\n=head1 SYNOPSIS\n\n",
656 "perl -MCPAN -e 'install Bundle::$me'\n\n",
657 "=head1 CONTENTS\n\n",
658 join("\n", @bundle),
659 "\n\n=head1 CONFIGURATION\n\n",
660 Config->myconfig,
661 "\n\n=head1 AUTHOR\n\n",
662 "This Bundle has been generated automatically by the autobundle routine in CPAN.pm.\n",
663 );
664 $fh->close;
665 print "\nWrote bundle file
666 $to\n\n";
667}
668
10b2abe6 669#-> sub CPAN::Shell::expand ;
5f05dabc 670sub expand {
671 shift;
672 my($type,@args) = @_;
673 my($arg,@m);
674 for $arg (@args) {
675 my $regex;
676 if ($arg =~ m|^/(.*)/$|) {
677 $regex = $1;
678 }
679 my $class = "CPAN::$type";
680 my $obj;
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;
684 }
685 } else {
686 my($xarg) = $arg;
687 if ( $type eq 'Bundle' ) {
688 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
689 }
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);
694 } else {
695 next;
696 }
697 push @m, $obj;
698 }
699 }
700 return @m;
701}
702
10b2abe6 703#-> sub CPAN::Shell::format_result ;
5f05dabc 704sub format_result {
705 my($self) = shift;
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";
711 $result;
712}
713
10b2abe6 714#-> sub CPAN::Shell::rematein ;
5f05dabc 715sub rematein {
716 shift;
717 my($meth,@some) = @_;
718 my $pragma = "";
719 if ($meth eq 'force') {
720 $pragma = $meth;
721 $meth = shift @some;
722 }
723 CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
724 my($s,@s);
725 foreach $s (@some) {
726 my $obj;
727 if (ref $s) {
728 $obj = $s;
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);
733 } else {
734 $obj = $CPAN::META->instance('CPAN::Module',$s) if $CPAN::META->exists('CPAN::Module',$s);
735 }
736 if (ref $obj) {
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);
739 $obj->$meth();
740 } else {
741 print "Warning: Cannot $meth $s, don't know what it is\n";
742 }
743 }
744}
745
10b2abe6 746#-> sub CPAN::Shell::force ;
5f05dabc 747sub force { shift->rematein('force',@_); }
10b2abe6 748#-> sub CPAN::Shell::readme ;
5f05dabc 749sub readme { shift->rematein('readme',@_); }
10b2abe6 750#-> sub CPAN::Shell::make ;
5f05dabc 751sub make { shift->rematein('make',@_); }
10b2abe6 752#-> sub CPAN::Shell::clean ;
5f05dabc 753sub clean { shift->rematein('clean',@_); }
10b2abe6 754#-> sub CPAN::Shell::test ;
5f05dabc 755sub test { shift->rematein('test',@_); }
10b2abe6 756#-> sub CPAN::Shell::install ;
5f05dabc 757sub install { shift->rematein('install',@_); }
758
759package CPAN::FTP;
10b2abe6 760use vars qw($Ua);
761@CPAN::FTP::ISA = qw(CPAN::Debug);
5f05dabc 762
10b2abe6 763#-> sub CPAN::FTP::ftp_get ;
5f05dabc 764sub ftp_get {
765 my($class,$host,$dir,$file,$target) = @_;
766 $class->debug(
767 qq[Going to fetch file [$file] from dir [$dir]
768 on host [$host] as local [$target]\n]
769 ) if $CPAN::DEBUG;
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";
775 return;
776 }
777 # print qq[Going to ->cwd("$dir")\n];
778 unless ( $ftp->cwd($dir) ){
779 warn "Couldn't cwd $dir";
780 return;
781 }
782 $ftp->binary;
10b2abe6 783 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
5f05dabc 784 unless ( $ftp->get($file,$target) ){
785 warn "Couldn't fetch $file from $host";
786 return;
787 }
788 $ftp->quit;
789}
790
10b2abe6 791#-> sub CPAN::FTP::localize ;
5f05dabc 792sub localize {
793 my($self,$file,$aslocal,$force) = @_;
794 $force ||= 0;
795 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])" unless defined $aslocal;
796 $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
797
798 return $aslocal if -f $aslocal && -r _ && ! $force;
799
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;
805
806 # Inheritance is not easier to manage than a few if/else branches
807 if ($CPAN::META->hasLWP) {
808 require LWP::UserAgent;
809 unless ($Ua) {
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'};
814 }
815 }
816
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 "/";
822 $url .= $file;
823 $self->debug("localizing[$url]") if $CPAN::DEBUG;
824 if ($url =~ /^file:/) {
825 my $l;
826 if ($CPAN::META->hasLWP) {
827 require URI::URL;
828 my $u = new URI::URL $url;
829 $l = $u->path;
10b2abe6 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
5f05dabc 837 }
838 return $l if -f $l && -r _;
839 }
840
841 if ($CPAN::META->hasLWP) {
842 print "Fetching $url\n";
843 my $res = $Ua->mirror($url, $aslocal);
844 if ($res->is_success) {
845 return $aslocal;
846 }
10b2abe6 847 }
848 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
5f05dabc 849 my($host,$dir,$getfile) = ($1,$2,$3);
10b2abe6 850 if ($CPAN::META->hasFTP) {
851 $dir =~ s|/+|/|g;
852 $self->debug("Going to fetch file [$getfile]
853 from dir [$dir]
854 on host [$host]
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)) {
860 print(
861 qq{
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.
866
867}
868 );
869 local(*WTR);
870 my($cwd) = Cwd::cwd();
871 chdir $aslocal_dir;
872 my($targetfile) = File::Basename::basename($aslocal);
873 my(@dialog);
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: $!";
878 # pilot blind
879 for (@dialog) {
880# print "To WTR>>$_<<\n";
881 print WTR $_;
882 }
883# close WTR;
884 chdir($cwd);
885 return $aslocal;
886 } else {
887 my($netrcfile) = $netrc->{netrc};
888 if ($netrcfile) {
889 print qq{ Your $netrcfile does not contain host $host.\n}
890 } else {
891 print qq{ I could not find or open your $netrcfile.\n}
892 }
893 print qq{ If you want to use external ftp,
894 please enter host $host into your .netrc file and retry.
895
896 The format of a proper entry in your .netrc file would be:
5f05dabc 897
10b2abe6 898machine $host
899login ftp
900password $Config::Config{cf_email}
901
902Please make also sure, your .netrc will not be readable by others.
903You don\'t have to leave and restart CPAN.pm, I\'ll look again next
904time I come around here.
905\n};
906 }
907 }
5f05dabc 908 }
10b2abe6 909 if (-x $CPAN::Config->{'lynx'}) {
910## $self->debug("Trying with lynx for [$url]") if $CPAN::DEBUG;
911 my($want_compressed);
912 print(
913 qq{
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.
918
919}
920 );
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";
928 } else {
929 $system = "$CPAN::Config->{'gzip'} $aslocal";
930 system($system);
931 }
932 return "$aslocal.gz";
933 } else {
934 $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
935 if (system($system)==0) {
936 $system = "$CPAN::Config->{'gzip'} -d $aslocal";
937 system($system);
938 } else {
939 # should be fine, eh?
940 }
941 return $aslocal;
942 }
943 }
944 }
945 warn "Can't access URL $url.
946 Either get LWP or Net::FTP
947 or an external lynx or ftp";
5f05dabc 948 }
949 Carp::croak("Cannot fetch $file from anywhere");
950}
951
10b2abe6 952package CPAN::FTP::external;
953
954package CPAN::FTP::netrc;
955
956sub new {
957 my($class) = @_;
958 my $file = MY->catfile($ENV{HOME},".netrc");
959 my($fh,@machines);
960 if($fh = IO::File->new($file,"r")){
961 local($/) = "";
962 while (<$fh>) {
963 next if /\bmacdef\b/;
964 my($machine) = /\bmachine\s+(\S+)/s;
965 push @machines, $machine;
966 }
967 } else {
968 $file = "";
969 }
970 bless {
971 mach => [@machines],
972 netrc => $file,
973 }, $class;
974}
975
976sub contains {
977 my($self,$mach) = @_;
978 scalar grep {$_ eq $mach} @{$self->{mach}};
979}
980
5f05dabc 981package CPAN::Complete;
10b2abe6 982@CPAN::Complete::ISA = qw(CPAN::Debug);
5f05dabc 983
10b2abe6 984#-> sub CPAN::Complete::complete ;
5f05dabc 985sub complete {
986 my($word,$line,$pos) = @_;
987 $word ||= "";
988 $line ||= "";
989 $pos ||= 0;
990 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
991 $line =~ s/^\s*//;
992 my @return;
993 if ($pos == 0) {
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]/ ) {
996 @return = ();
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);
1011 } else {
1012 @return = ();
1013 }
1014 return @return;
1015}
1016
10b2abe6 1017#-> sub CPAN::Complete::completex ;
5f05dabc 1018sub completex {
1019 my($class, $word) = @_;
1020 grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1021}
1022
10b2abe6 1023#-> sub CPAN::Complete::complete_any ;
5f05dabc 1024sub complete_any {
1025 my($word) = shift;
1026 return (
1027 completex('CPAN::Author',$word),
1028 completex('CPAN::Bundle',$word),
1029 completex('CPAN::Distribution',$word),
1030 completex('CPAN::Module',$word),
1031 );
1032}
1033
10b2abe6 1034#-> sub CPAN::Complete::complete_reload ;
5f05dabc 1035sub complete_reload {
1036 my($word,$line,$pos) = @_;
1037 $word ||= "";
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;
1043}
1044
10b2abe6 1045#-> sub CPAN::Complete::complete_option ;
5f05dabc 1046sub complete_option {
1047 my($word,$line,$pos) = @_;
1048 $word ||= "";
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;
1054 if (0) {
1055 } elsif ($words[1] eq 'index') {
1056 return ();
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';
1061 }
1062}
1063
1064package CPAN::Index;
10b2abe6 1065use vars qw($last_time);
1066@CPAN::Index::ISA = qw(CPAN::Debug);
5f05dabc 1067$last_time ||= 0;
1068
10b2abe6 1069#-> sub CPAN::Index::force_reload ;
5f05dabc 1070sub force_reload {
1071 my($class) = @_;
1072 $CPAN::Index::last_time = 0;
1073 $class->reload(1);
1074}
1075
10b2abe6 1076#-> sub CPAN::Index::reload ;
5f05dabc 1077sub reload {
1078 my($cl,$force) = @_;
1079 my $time = time;
1080
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;
1083 $last_time = $time;
1084
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));
1090}
1091
10b2abe6 1092#-> sub CPAN::Index::reload_x ;
5f05dabc 1093sub reload_x {
1094 my($cl,$wanted,$localname,$force) = @_;
1095 $force ||= 0;
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});
1100 return $abs_wanted;
1101 } else {
1102 $force ||= 1;
1103 }
1104 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1105}
1106
10b2abe6 1107#-> sub CPAN::Index::read_authindex ;
5f05dabc 1108sub 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|");
1113 while (<$fh>) {
1114 chomp;
1115 my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1116 next unless $userid && $fullname && $email;
1117
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;
1122 }
1123 $fh->close;
1124 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1125}
1126
10b2abe6 1127#-> sub CPAN::Index::read_modpacks ;
5f05dabc 1128sub 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|");
1133 while (<$fh>) {
1134 next if 1../^\s*$/;
1135 chomp;
1136 my($mod,$version,$dist) = split;
1137 $version =~ s/^\+//;
1138
1139 # if it as a bundle, instatiate a bundle object
10b2abe6 1140 my($bundle);
1141 if ($mod =~ /^Bundle::(.*)/) {
1142 $bundle = $1;
1143 }
5f05dabc 1144
1145 if ($mod eq 'CPAN') {
1146 local($^W)=0;
1147 if ($version > $CPAN::VERSION){
1148 print qq{
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
1151 install CPAN
1152 reload cpan
1153 without quitting the current session. It should be a seemless upgrade
1154 while we are running...
1155};
1156 sleep 2;
1157 print qq{\n};
1158 }
1159 }
1160
1161 my($id);
1162 if ($bundle){
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)) {
1168# next;
1169 } else {
1170 # instantiate a module object
1171 $id = $CPAN::META->instance('CPAN::Module',$mod);
1172 $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1173 }
1174
1175 # determine the author
1176 my($userid) = $dist =~ /([^\/]+)/;
1177 $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
1178
1179 # instantiate a distribution object
1180 unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1181 $CPAN::META->instance(
1182 'CPAN::Distribution' => $dist
1183 )->set(
1184 'CPAN_USERID' => $userid
1185 )
1186 if $userid =~ /\w/;
1187 }
1188
1189 return if $CPAN::Signal;
1190 }
1191 $fh->close;
1192 $? and Carp::croak "FAILED $pipe: exit status [$?]";
1193}
1194
10b2abe6 1195#-> sub CPAN::Index::read_modlist ;
5f05dabc 1196sub 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|");
1201 my $eval = "";
1202 while (<$fh>) {
1203 next if 1../^\s*$/;
1204 next if /use vars/; # will go away in 03...
1205 $eval .= $_;
1206 return if $CPAN::Signal;
1207 }
1208 $eval .= q{CPAN::Modulelist->data;};
1209 local($^W) = 0;
1210 my($comp) = Safe->new("CPAN::Safe1");
1211 my $ret = $comp->reval($eval);
1212 Carp::confess($@) if $@;
1213 return if $CPAN::Signal;
1214 for (keys %$ret) {
1215 my $obj = $CPAN::META->instance(CPAN::Module,$_);
1216 $obj->set(%{$ret->{$_}});
1217 return if $CPAN::Signal;
1218 }
1219}
1220
1221package CPAN::InfoObj;
10b2abe6 1222@CPAN::InfoObj::ISA = qw(CPAN::Debug);
5f05dabc 1223
10b2abe6 1224#-> sub CPAN::InfoObj::new ;
5f05dabc 1225sub new { my $this = bless {}, shift; %$this = @_; $this }
1226
10b2abe6 1227#-> sub CPAN::InfoObj::set ;
5f05dabc 1228sub set {
1229 my($self,%att) = @_;
1230 my(%oldatt) = %$self;
1231 %$self = (%oldatt, %att);
1232}
1233
10b2abe6 1234#-> sub CPAN::InfoObj::id ;
5f05dabc 1235sub id { shift->{'ID'} }
1236
10b2abe6 1237#-> sub CPAN::InfoObj::as_glimpse ;
5f05dabc 1238sub as_glimpse {
1239 my($self) = @_;
1240 my(@m);
1241 my $class = ref($self);
1242 $class =~ s/^CPAN:://;
1243 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
1244 join "", @m;
1245}
1246
10b2abe6 1247#-> sub CPAN::InfoObj::as_string ;
5f05dabc 1248sub as_string {
1249 my($self) = @_;
1250 my(@m);
1251 my $class = ref($self);
1252 $class =~ s/^CPAN:://;
1253 push @m, $class, " id = $self->{ID}\n";
1254 for (sort keys %$self) {
1255 next if $_ eq 'ID';
1256 my $extra = "";
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;
1260 } else {
1261 push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
1262 }
1263 }
1264 join "", @m, "\n";
1265}
1266
10b2abe6 1267#-> sub CPAN::InfoObj::author ;
5f05dabc 1268sub author {
1269 my($self) = @_;
1270 $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
1271}
1272
1273package CPAN::Author;
10b2abe6 1274@CPAN::Author::ISA = qw(CPAN::Debug CPAN::InfoObj);
5f05dabc 1275
10b2abe6 1276#-> sub CPAN::Author::as_glimpse ;
5f05dabc 1277sub as_glimpse {
1278 my($self) = @_;
1279 my(@m);
1280 my $class = ref($self);
1281 $class =~ s/^CPAN:://;
1282 push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
1283 join "", @m;
1284}
1285
10b2abe6 1286# Dead code, I would have liked to have,,, but it was never reached,,,
1287#sub make {
1288# my($self) = @_;
1289# return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
1290#}
1291
1292#-> sub CPAN::Author::fullname ;
5f05dabc 1293sub fullname { shift->{'FULLNAME'} }
1294*name = \&fullname;
10b2abe6 1295#-> sub CPAN::Author::email ;
5f05dabc 1296sub email { shift->{'EMAIL'} }
1297
1298package CPAN::Distribution;
10b2abe6 1299@CPAN::Distribution::ISA = qw(CPAN::Debug CPAN::InfoObj);
5f05dabc 1300
10b2abe6 1301#-> sub CPAN::Distribution::called_for ;
5f05dabc 1302sub called_for {
1303 my($self,$id) = @_;
1304 $self->{'CALLED_FOR'} = $id if defined $id;
1305 return $self->{'CALLED_FOR'};
1306}
1307
10b2abe6 1308#-> sub CPAN::Distribution::get ;
5f05dabc 1309sub get {
1310 my($self) = @_;
1311 EXCUSE: {
1312 my @e;
1313 exists $self->{'build_dir'} and push @e, "Unwrapped into directory $self->{'build_dir'}";
1314 print join "", map {" $_\n"} @e and return if @e;
1315 }
1316 my($local_file);
1317 my($local_wanted) =
1318 CPAN->catfile(
1319 $CPAN::Config->{keep_source_where},
1320 "authors",
1321 "id",
1322 split("/",$self->{ID})
1323 );
1324
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: $!");
1331 my $packagedir;
1332
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: $!";
1338 chdir "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";
1344 } else {
1345 $self->{unwrapped} = "NO";
1346 }
1347 } elsif ($local_file =~ /zip$/i) {
1348 $self->{archived} = "zip";
1349 if (system("$CPAN::Config->{unzip} $local_file")==0) {
1350 $self->{unwrapped} = "YES";
1351 } else {
1352 $self->{unwrapped} = "NO";
1353 }
1354 }
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??
1358 closedir DIR;
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);
10b2abe6 1365 rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
5f05dabc 1366 } else {
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);
1372 my($f);
1373 for $f (@readdir) { # is already without "." and ".."
1374 my $to = $CPAN::META->catdir($packagedir,$f);
10b2abe6 1375 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
5f05dabc 1376 }
1377 }
1378 $self->{'build_dir'} = $packagedir;
1379
1380 chdir "..";
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";
1386 }
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;
1393 } else {
1394 my $fh = IO::File->new(">$makefilepl") or Carp::croak("Could not open >$makefilepl");
1395 my $cf = $self->called_for || "unknown";
1396 $fh->print(qq{
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]);
1401});
1402 print qq{Package comes without Makefile.PL.\n}.
1403 qq{ Writing one on our own (calling it $cf)\n};
1404 }
1405 }
1406 } else {
1407 $self->{archived} = "NO";
1408 }
1409 return $self;
1410}
1411
10b2abe6 1412#-> sub CPAN::Distribution::new ;
5f05dabc 1413sub new {
1414 my($class,%att) = @_;
1415
1416 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
1417
1418 my $this = { %att };
1419 return bless $this, $class;
1420}
1421
10b2abe6 1422#-> sub CPAN::Distribution::readme ;
5f05dabc 1423sub readme {
1424 my($self) = @_;
1425 print "Readme not yet implemented (says ".$self->id.")\n";
1426}
1427
10b2abe6 1428#-> sub CPAN::Distribution::verifyMD5 ;
5f05dabc 1429sub verifyMD5 {
1430 my($self) = @_;
1431 EXCUSE: {
1432 my @e;
1433 $self->{MD5_STATUS} and push @e, "MD5 Checksum was ok";
1434 print join "", map {" $_\n"} @e and return if @e;
1435 }
1436 my($local_file);
1437 my(@local) = split("/",$self->{ID});
1438 my($basename) = pop @local;
1439 push @local, "CHECKSUMS";
1440 my($local_wanted) =
1441 CPAN->catfile(
1442 $CPAN::Config->{keep_source_where},
1443 "authors",
1444 "id",
1445 @local
1446 );
1447 local($") = "/";
1448 if (
1449 -f $local_wanted
1450 &&
1451 $self->MD5_check_file($local_wanted,$basename)
1452 ) {
1453 return $self->{MD5_STATUS}="OK";
1454 }
1455 $local_file = CPAN::FTP->localize("authors/id/@local", $local_wanted, 'force>:-{');
1456 my($checksum_pipe);
1457 if ($local_file) {
1458 # fine
1459 } else {
1460 $local[-1] .= ".gz";
1461 $local_file = CPAN::FTP->localize(
1462 "authors/id/@local",
1463 "$local_wanted.gz",
1464 'force>:-{'
1465 );
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$//;
1469 }
1470 $self->MD5_check_file($local_file,$basename);
1471}
1472
10b2abe6 1473#-> sub CPAN::Distribution::MD5_check_file ;
5f05dabc 1474sub MD5_check_file {
1475 my($self,$lfile,$basename) = @_;
1476 my($cksum);
1477 my $fh = new IO::File;
1478 local($/)=undef;
1479 if (open $fh, $lfile){
1480 my $eval = <$fh>;
1481 close $fh;
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}|";
1489 if (
1490 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
1491 or
1492 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
1493 ){
1494 print "Checksum for $file ok\n";
1495 return $self->{MD5_STATUS}="OK";
1496 } else {
1497 die join(
1498 "",
1499 "\nChecksum mismatch for distribution file. Please investigate.\n\n",
1500 $self->as_string,
1501 $CPAN::META->instance('CPAN::Author',$self->{CPAN_USERID})->as_string,
1502 "Please contact the author or your CPAN site admin"
1503 );
1504 }
1505 close $fh if fileno($fh);
1506 } else {
1507 print "No md5 checksum for $basename in local $lfile\n";
1508 return;
1509 }
1510 } else {
1511 Carp::carp "Could not open $lfile for reading";
1512 }
1513}
1514
10b2abe6 1515#-> sub CPAN::Distribution::eq_MD5 ;
5f05dabc 1516sub eq_MD5 {
1517 my($self,$fh,$expectMD5) = @_;
1518 my $md5 = new MD5;
1519 $md5->addfile($fh);
1520 my $hexdigest = $md5->hexdigest;
1521 $hexdigest eq $expectMD5;
1522}
1523
10b2abe6 1524#-> sub CPAN::Distribution::force ;
5f05dabc 1525sub force {
1526 my($self) = @_;
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'};
1536}
1537
10b2abe6 1538#-> sub CPAN::Distribution::make ;
5f05dabc 1539sub make {
1540 my($self) = @_;
1541 $self->debug($self->id) if $CPAN::DEBUG;
1542 print "Running make\n";
1543 $self->get;
1544 if ($CPAN::META->hasMD5) {
1545 $self->verifyMD5;
1546 }
1547 EXCUSE: {
1548 my @e;
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;
1554 }
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;
1559
1560 my $system;
1561 if ($self->{'configure'}) {
1562 $system = $self->{'configure'};
1563 } else {
1564 my($perl) = $^X =~ /^\.\// ? "$CPAN::Cwd/$^X" : $^X; # XXX subclassing folks, forgive me!
1565 $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
1566 }
10b2abe6 1567 $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
1568 my($ret,$pid);
1569 $@ = "";
1570 if ($CPAN::Config->{inactivity_timeout}) {
1571 eval {
1572 alarm $CPAN::Config->{inactivity_timeout};
1573 #$SIG{CHLD} = \&REAPER;
1574 if (defined($pid=fork)) {
1575 if ($pid) { #parent
1576 wait;
1577 } else { #child
1578 exec $system;
1579 }
1580 } else {
1581 print "Cannot fork: $!";
1582 return;
1583 }
1584 $ret = system($system);
1585 };
1586 alarm 0;
1587 } else {
1588 $ret = system($system);
1589 }
1590 if ($@){
1591 kill 9, $pid;
1592 waitpid $pid, 0;
1593 print $@;
1594 $self->{writemakefile} = "NO - $@";
1595 $@ = "";
1596 return;
1597 } elsif ($ret != 0) {
5f05dabc 1598 $self->{writemakefile} = "NO";
1599 return;
1600 }
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";
1607 } else {
1608 $self->{writemakefile} = "YES";
1609 $self->{'make'} = "NO";
1610 print " $system -- NOT OK\n";
1611 }
1612}
1613
10b2abe6 1614#-> sub CPAN::Distribution::test ;
5f05dabc 1615sub test {
1616 my($self) = @_;
1617 $self->make;
1618 return if $CPAN::Signal;
1619 print "Running make test\n";
1620 EXCUSE: {
1621 my @e;
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;
1626 }
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";
1633 } else {
1634 $self->{'make_test'} = "NO";
1635 print " $system -- NOT OK\n";
1636 }
1637}
1638
10b2abe6 1639#-> sub CPAN::Distribution::clean ;
5f05dabc 1640sub clean {
1641 my($self) = @_;
1642 print "Running make clean\n";
1643 EXCUSE: {
1644 my @e;
1645 exists $self->{'build_dir'} or push @e, "Has no own directory";
1646 print join "", map {" $_\n"} @e and return if @e;
1647 }
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";
1653 $self->force;
1654 } else {
1655 # Hmmm, what to do if make clean failed?
1656 }
1657}
1658
10b2abe6 1659#-> sub CPAN::Distribution::install ;
5f05dabc 1660sub install {
1661 my($self) = @_;
1662 $self->test;
1663 return if $CPAN::Signal;
1664 print "Running make install\n";
1665 EXCUSE: {
1666 my @e;
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;
1672 }
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 |");
1677 my($makeout) = "";
10b2abe6 1678
1679 # #If I were to try this, I'd do something like:
1680 # #
1681 # # $SIG{ALRM} = sub { die "alarm\n" };
1682 # #
1683 # # open(PROC,"make somesuch|");
1684 # # eval {
1685 # # alarm 30;
1686 # # while(<PROC>) {
1687 # # alarm 30;
1688 # # }
1689 # # }
1690 # # close(PROC);
1691 # # alarm 0;
1692 # #
1693 # #I'm really not sure how reliable this would is, though.
1694 # #
1695 # #--
1696 # #Kenneth Albanowski (kjahds@kjahds.com, CIS: 70705,126)
1697 # #
1698 # #
1699 # #
1700 # #
1701 while (<$pipe>){
5f05dabc 1702 print;
1703 $makeout .= $_;
1704 }
1705 $pipe->close;
1706 if ($?==0) {
1707 print " $system -- OK\n";
1708 $self->{'install'} = "YES";
1709 } else {
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";
1714 }
1715 }
1716}
1717
10b2abe6 1718#-> sub CPAN::Distribution::dir ;
5f05dabc 1719sub dir {
1720 shift->{'build_dir'};
1721}
1722
1723package CPAN::Bundle;
10b2abe6 1724@CPAN::Bundle::ISA = qw(CPAN::Debug CPAN::InfoObj CPAN::Module);
5f05dabc 1725
10b2abe6 1726#-> sub CPAN::Bundle::as_string ;
5f05dabc 1727sub as_string {
1728 my($self) = @_;
1729 $self->contains;
1730 return $self->SUPER::as_string;
1731}
1732
10b2abe6 1733#-> sub CPAN::Bundle::contains ;
5f05dabc 1734sub contains {
1735 my($self) = @_;
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;
1742 $dist->get;
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);
1746 my($me,$from,$to);
1747 ($me = $self->id) =~ s/.*://;
1748 $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
1749 $to = $CPAN::META->catfile($todir,"$me.pm");
10b2abe6 1750 File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
5f05dabc 1751 $parsefile = $to;
1752 }
1753 my @result;
1754 my $fh = new IO::File;
1755 local $/ = "\n";
1756 open($fh,$parsefile) or die "Could not open '$parsefile': $!";
1757 my $inpod = 0;
1758 while (<$fh>) {
1759 $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
1760 next unless $inpod;
1761 next if /^=/;
1762 next if /^\s+$/;
1763 chomp;
1764 push @result, (split " ", $_, 2)[0];
1765 }
1766 close $fh;
1767 delete $self->{STATUS};
1768 $self->{CONTAINS} = [@result];
1769 @result;
1770}
1771
10b2abe6 1772#-> sub CPAN::Bundle::inst_file ;
5f05dabc 1773sub inst_file {
1774 my($self) = @_;
1775 my($me,$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?
1782}
1783
10b2abe6 1784#-> sub CPAN::Bundle::rematein ;
5f05dabc 1785sub rematein {
1786 my($self,$meth) = @_;
1787 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
1788 my($s);
1789 for $s ($self->contains) {
1790 $CPAN::META->instance('CPAN::Module',$s)->$meth();
1791 }
1792}
1793
10b2abe6 1794#-> sub CPAN::Bundle::force ;
1795sub force { shift->rematein('force',@_); }
1796#-> sub CPAN::Bundle::install ;
5f05dabc 1797sub install { shift->rematein('install',@_); }
10b2abe6 1798#-> sub CPAN::Bundle::clean ;
5f05dabc 1799sub clean { shift->rematein('clean',@_); }
10b2abe6 1800#-> sub CPAN::Bundle::test ;
5f05dabc 1801sub test { shift->rematein('test',@_); }
10b2abe6 1802#-> sub CPAN::Bundle::make ;
5f05dabc 1803sub make { shift->rematein('make',@_); }
1804
1805# XXX not yet implemented!
10b2abe6 1806#-> sub CPAN::Bundle::readme ;
5f05dabc 1807sub readme {
1808 my($self) = @_;
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
1813}
1814
1815package CPAN::Module;
10b2abe6 1816@CPAN::Module::ISA = qw(CPAN::Debug CPAN::InfoObj);
5f05dabc 1817
10b2abe6 1818#-> sub CPAN::Module::as_glimpse ;
5f05dabc 1819sub as_glimpse {
1820 my($self) = @_;
1821 my(@m);
1822 my $class = ref($self);
1823 $class =~ s/^CPAN:://;
1824 push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
1825 join "", @m;
1826}
1827
10b2abe6 1828#-> sub CPAN::Module::as_string ;
5f05dabc 1829sub as_string {
1830 my($self) = @_;
1831 my(@m);
1832 CPAN->debug($self) if $CPAN::DEBUG;
1833 my $class = ref($self);
1834 $class =~ s/^CPAN:://;
1835 local($^W) = 0;
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";
1840 my($userid);
1841 if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
1842 push @m, sprintf(
1843 $sprintf2,
1844 'CPAN_USERID',
1845 $userid,
1846 $CPAN::META->instance(CPAN::Author,$userid)->fullname
1847 )
1848 }
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';
1861 push @m, sprintf(
1862 $sprintf3,
1863 'DSLI_STATUS',
1864 $self->{statd},
1865 $self->{stats},
1866 $self->{statl},
1867 $self->{stati},
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: $!");
1876 my $inpod = 0;
1877 my(@result);
1878 local $/ = "\n";
1879 while (<$fh>) {
1880 $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
1881 next unless $inpod;
1882 next if /^=/;
1883 next if /^\s+$/;
1884 chomp;
1885 push @result, $_;
1886 }
1887 close $fh;
1888 $self->{MANPAGE} = join " ", @result;
1889 }
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;
1893 join "", @m, "\n";
1894}
1895
10b2abe6 1896#-> sub CPAN::Module::cpan_file ;
5f05dabc 1897sub cpan_file {
1898 my $self = shift;
1899 CPAN->debug($self->id) if $CPAN::DEBUG;
1900 unless (defined $self->{'CPAN_FILE'}) {
1901 CPAN::Index->reload;
1902 }
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
1907 } else {
1908 return "N/A";
1909 }
1910}
1911
1912*name = \&cpan_file;
1913
10b2abe6 1914#-> sub CPAN::Module::cpan_version ;
5f05dabc 1915sub cpan_version { shift->{'CPAN_VERSION'} }
1916
10b2abe6 1917#-> sub CPAN::Module::force ;
5f05dabc 1918sub force {
1919 my($self) = @_;
1920 $self->{'force_update'}++;
1921}
1922
10b2abe6 1923#-> sub CPAN::Module::rematein ;
5f05dabc 1924sub 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'};
1933 $pack->$meth();
1934 delete $self->{'force_update'};
1935}
1936
10b2abe6 1937#-> sub CPAN::Module::readme ;
5f05dabc 1938sub readme { shift->rematein('readme') }
10b2abe6 1939#-> sub CPAN::Module::make ;
5f05dabc 1940sub make { shift->rematein('make') }
10b2abe6 1941#-> sub CPAN::Module::clean ;
5f05dabc 1942sub clean { shift->rematein('clean') }
10b2abe6 1943#-> sub CPAN::Module::test ;
5f05dabc 1944sub test { shift->rematein('test') }
10b2abe6 1945#-> sub CPAN::Module::install ;
5f05dabc 1946sub install {
1947 my($self) = @_;
1948 my($doit) = 0;
1949 my($latest) = $self->cpan_version;
1950 $latest ||= 0;
1951 my($inst_file) = $self->inst_file;
1952 my($have) = 0;
1953 if (defined $inst_file) {
1954 $have = $self->inst_version;
1955 }
1956 if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
1957 print $self->id, " is up to date.\n";
1958 } else {
1959 $doit = 1;
1960 }
1961 $self->rematein('install') if $doit;
1962}
1963
10b2abe6 1964#-> sub CPAN::Module::inst_file ;
5f05dabc 1965sub inst_file {
1966 my($self) = @_;
1967 my($dir,@packpath);
1968 @packpath = split /::/, $self->{ID};
1969 $packpath[-1] .= ".pm";
1970 foreach $dir (@INC) {
1971 my $pmfile = CPAN->catfile($dir,@packpath);
1972 if (-f $pmfile){
1973 return $pmfile;
1974 }
1975 }
1976}
1977
10b2abe6 1978#-> sub CPAN::Module::xs_file ;
5f05dabc 1979sub xs_file {
1980 my($self) = @_;
1981 my($dir,@packpath);
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);
1987 if (-f $xsfile){
1988 return $xsfile;
1989 }
1990 }
1991}
1992
10b2abe6 1993#-> sub CPAN::Module::inst_version ;
5f05dabc 1994sub inst_version {
1995 my($self) = @_;
1996 my $parsefile = $self->inst_file or return 0;
1997 my $have = MY->parse_version($parsefile);
1998 $have ||= 0;
1999 $have =~ s/\s+//g;
2000 $have ||= 0;
2001 $have;
2002}
2003
2004package CPAN::CacheMgr;
10b2abe6 2005use vars qw($Du);
2006@CPAN::CacheMgr::ISA = qw(CPAN::Debug CPAN::InfoObj);
5f05dabc 2007use File::Find;
2008
10b2abe6 2009#-> sub CPAN::CacheMgr::as_string ;
5f05dabc 2010sub as_string {
2011 eval { require Data::Dumper };
2012 if ($@) {
2013 return shift->SUPER::as_string;
2014 } else {
2015 return Data::Dumper::Dumper(shift);
2016 }
2017}
2018
10b2abe6 2019#-> sub CPAN::CacheMgr::cachesize ;
5f05dabc 2020sub cachesize {
2021 shift->{DU};
2022}
2023
2024# sub check {
2025# my($self,@dirs) = @_;
2026# return unless -d $self->{ID};
2027# my $dir;
2028# @dirs = $self->dirs unless @dirs;
2029# for $dir (@dirs) {
2030# $self->disk_usage($dir);
2031# }
2032# }
2033
10b2abe6 2034#-> sub CPAN::CacheMgr::clean_cache ;
5f05dabc 2035sub clean_cache {
2036 my $self = shift;
2037 my $dir;
2038 while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
2039 $self->force_clean_cache($dir);
2040 }
2041 $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
2042}
2043
10b2abe6 2044#-> sub CPAN::CacheMgr::dir ;
5f05dabc 2045sub dir {
2046 shift->{ID};
2047}
2048
10b2abe6 2049#-> sub CPAN::CacheMgr::entries ;
5f05dabc 2050sub 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: $!");
2056 my(@entries);
2057 for ($dh->read) {
2058 next if $_ eq "." || $_ eq "..";
2059 if (-f $_) {
2060 push @entries, $CPAN::META->catfile($dir,$_);
2061 } elsif (-d _) {
2062 push @entries, $CPAN::META->catdir($dir,$_);
2063 } else {
2064 print STDERR "Warning: weird direntry in $dir: $_\n";
2065 }
2066 }
2067 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
2068 sort {-M $b <=> -M $a} @entries;
2069}
2070
10b2abe6 2071#-> sub CPAN::CacheMgr::disk_usage ;
5f05dabc 2072sub 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;
2076 return;
2077 }
2078 return if defined $self->{SIZE}{$dir};
2079 local($Du) = 0;
2080 find(
2081 sub {
2082 return if -l $_;
2083 $Du += -s;
2084 },
2085 $dir
2086 );
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'};
2094 $self->clean_cache;
2095 } else {
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;
2098 }
2099 $self->{DU};
2100}
2101
10b2abe6 2102#-> sub CPAN::CacheMgr::force_clean_cache ;
5f05dabc 2103sub 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};
2109}
2110
10b2abe6 2111#-> sub CPAN::CacheMgr::new ;
5f05dabc 2112sub new {
2113 my $class = shift;
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;
2119 my $e;
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);
2124 }
2125 $self;
2126}
2127
2128package CPAN::Debug;
2129
10b2abe6 2130#-> sub CPAN::Debug::debug ;
5f05dabc 2131sub 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){
2139 if (ref $arg) {
2140 eval { require Data::Dumper };
2141 if ($@) {
2142 print $arg->as_string;
2143 } else {
2144 print Data::Dumper::Dumper($arg);
2145 }
2146 } else {
2147 print "Debug($caller:$func,$line,@rest): $arg\n"
2148 }
2149 }
2150}
2151
2152package CPAN::Config;
2153import ExtUtils::MakeMaker 'neatvalue';
2154use vars qw(%can);
2155
2156%can = (
2157 'commit' => "Commit changes to disk",
2158 'defaults' => "Reload defaults from disk",
2159);
2160
10b2abe6 2161#-> sub CPAN::Config::edit ;
5f05dabc 2162sub edit {
2163 my($class,@args) = @_;
2164 return unless @args;
10b2abe6 2165 CPAN->debug("class[$class]args[".join(" | ",@args)."]");
5f05dabc 2166 my($o,$str,$func,$args,$key_exists);
2167 $o = shift @args;
2168 if($can{$o}) {
2169 $class->$o(@args);
2170 return 1;
10b2abe6 2171 } else {
2172 if (ref($CPAN::Config->{$o}) eq ARRAY) {
5f05dabc 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;
2185 } else {
2186 $CPAN::Config->{$o} = [@args];
2187 }
2188 } else {
5f05dabc 2189 $CPAN::Config->{$o} = $args[0];
10b2abe6 2190 print " $o ";
2191 print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
5f05dabc 2192 }
5f05dabc 2193 }
2194}
2195
10b2abe6 2196#-> sub CPAN::Config::commit ;
5f05dabc 2197sub commit {
2198 my($self, $configpm) = @_;
2199 my $mode;
2200 # mkpath!?
2201
2202 my($fh) = IO::File->new;
2203 $configpm ||= cfile();
2204 if (-f $configpm) {
2205 $mode = (stat $configpm)[2];
2206 if ($mode && ! -w _) {
2207 print "$configpm is not writable\n" and return;
2208 }
2209 #chmod 0644, $configpm; #?
2210 }
2211
2212 my $msg = <<EOF unless $configpm =~ /MyConfig/;
2213
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.
2217
2218EOF
2219 $msg ||= "\n";
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";
2224 }
2225
2226 print $fh "};\n1;\n__END__\n";
2227 close $fh;
2228
2229 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
2230 #chmod $mode, $configpm;
2231 $self->defaults;
2232 print "commit: wrote $configpm\n";
2233 1;
2234}
2235
2236*default = \&defaults;
10b2abe6 2237#-> sub CPAN::Config::defaults ;
5f05dabc 2238sub defaults {
2239 my($self) = @_;
2240 $self->unload;
2241 $self->load;
2242 1;
2243}
2244
2245my $dot_cpan;
10b2abe6 2246#-> sub CPAN::Config::load ;
5f05dabc 2247sub load {
2248 my($self) = @_;
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;
2254 my($configpm,$fh);
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"};
2259 } else {
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;
2269#_#_# }
2270 if (-w $configpmtest or -w $configpmdir) {
2271 $configpm = $configpmtest;
2272 }
2273 }
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;
2280 } else {
2281 warn "WARNING: CPAN.pm is unable to create a configuration file.\n";
2282 }
2283 }
2284 }
2285 warn "Calling CPAN::FirstTime::init($configpm)";
2286 CPAN::FirstTime::init($configpm);
2287 }
2288}
2289
10b2abe6 2290#-> sub CPAN::Config::load_succeeded ;
5f05dabc 2291sub load_succeeded {
2292 my($miss) = 0;
2293 for (qw(
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
2297 )) {
2298 $miss++ unless defined $CPAN::Config->{$_}; # we want them all
2299 }
2300 return !$miss;
2301}
2302
10b2abe6 2303#-> sub CPAN::Config::unload ;
5f05dabc 2304sub unload {
2305 delete $INC{'CPAN/MyConfig.pm'};
2306 delete $INC{'CPAN/Config.pm'};
2307}
2308
10b2abe6 2309#-> sub CPAN::Config::cfile ;
5f05dabc 2310sub cfile {
2311 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'};
2312}
2313
2314*h = \&help;
10b2abe6 2315#-> sub CPAN::Config::help ;
5f05dabc 2316sub help {
2317 print <<EOF;
2318Known options:
2319 defaults reload default config values from disk
2320 commit commit session changes to disk
2321
2322You may edit key values in the follow fashion:
2323
2324 o conf build_cache 15
2325
2326 o conf build_dir "/foo/bar"
2327
2328 o conf urllist shift
2329
2330 o conf urllist unshift ftp://ftp.foo.bar/
2331
2332EOF
2333 undef; #don't reprint CPAN::Config
2334}
2335
10b2abe6 2336#-> sub CPAN::Config::complete ;
5f05dabc 2337sub complete {
2338 my($word,$line,$pos) = @_;
2339 $word ||= "";
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] =~ /->(.*)/) {
2344 my $meth = $1;
2345 my(@methods) = qw(shift unshift push pop splice);
2346 return @methods unless $meth;
2347 return sort grep /^\Q$meth\E/, @methods;
2348 }
2349 return sort grep /^\Q$word\E/, @o_conf;
2350}
2351
23521;
2353
2354=head1 NAME
2355
2356CPAN - query, download and build perl modules from CPAN sites
2357
2358=head1 SYNOPSIS
2359
2360Interactive mode:
2361
2362 perl -MCPAN -e shell;
2363
2364Batch mode:
2365
2366 use CPAN;
2367
10b2abe6 2368 autobundle, clean, install, make, recompile, test
5f05dabc 2369
2370=head1 DESCRIPTION
2371
10b2abe6 2372The CPAN module is designed to automate the make and install of perl
2373modules and extensions. It includes some searching capabilities as
2374well knows a how to use Net::FTP or LWP to fetch the raw data from the
2375net.
5f05dabc 2376
2377Modules are fetched from one or more of the mirrored CPAN
2378(Comprehensive Perl Archive Network) sites and unpacked in a dedicated
2379directory.
2380
2381The CPAN module also supports the concept of named and versioned
2382'bundles' of modules. Bundles simplify the handling of sets of
2383related modules. See BUNDLES below.
2384
2385The package contains a session manager and a cache manager. There is
2386no status retained between sessions. The session manager keeps track
2387of what has been fetched, built and installed in the current
2388session. The cache manager keeps track of the disk space occupied by
2389the make processes and deletes excess space in a simple FIFO style.
2390
10b2abe6 2391All methods provided are accessible in a programmer style and in an
2392interactive shell style.
2393
5f05dabc 2394=head2 Interactive Mode
2395
2396The interactive mode is entered by running
2397
2398 perl -MCPAN -e shell
2399
2400which puts you into a readline interface. You will have most fun if
2401you install Term::ReadKey and Term::ReadLine to enjoy both history and
2402completion.
2403
2404Once you are on the command line, type 'h' and the rest should be
2405self-explanatory.
2406
10b2abe6 2407The most common uses of the interactive modes are
2408
2409=over 2
2410
2411=item Searching for authors, bundles, distribution files and modules
2412
2413There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
2414for each of the four categories and another, C<i> for any of the other
2415four. Each of the four entities is implemented as a class with
2416slightly differing methods for displaying an object.
2417
2418Arguments you pass to these commands are either strings matching exact
2419the identification string of an object or regular expressions that are
2420then matched case-insensitively against various attributes of the
2421objects. The parser recognizes a regualar expression only if you
2422enclose it between two slashes.
2423
2424The principle is that the number of found objects influences how an
2425item is displayed. If the search finds one item, we display the result
2426of object-E<gt>as_string, but if we find more than one, we display
2427each as object-E<gt>as_glimpse. E.g.
2428
2429 cpan> a ANDK
2430 Author id = ANDK
2431 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2432 FULLNAME Andreas König
2433
2434
2435 cpan> a /andk/
2436 Author id = ANDK
2437 EMAIL a.koenig@franz.ww.TU-Berlin.DE
2438 FULLNAME Andreas König
2439
2440
2441 cpan> a /and.*rt/
2442 Author ANDYD (Andy Dougherty)
2443 Author MERLYN (Randal L. Schwartz)
2444
2445=item make, test, install, clean modules or distributions
2446
2447The four commands do indeed exist just as written above. Each of them
2448takes as many arguments as provided and investigates for each what it
2449might be. Is it a distribution file (recognized by embedded slashes),
2450this file is being processed. Is it a module, CPAN determines the
2451distribution file where this module is included and processes that.
2452
2453Any C<make> and C<test> are run unconditionally. An C<install
2454E<lt>distribution_fileE<gt>> also is run unconditionally. But for
2455C<install E<lt>module<gt>> CPAN checks if an install is actually
2456needed for it and prints I<"Foo up to date"> in case the module
2457doesnE<39>t need to be updated.
2458
2459CPAN also keeps track of what it has done within the current session
2460and doesnE<39>t try to build a package a second time regardless if it
2461succeeded or not. The C<force > command takes as first argument the
2462method to invoke (currently: make, test, or install) and executes the
2463command from scratch.
2464
2465Example:
2466
2467 cpan> install OpenGL
2468 OpenGL is up to date.
2469 cpan> force install OpenGL
2470 Running make
2471 OpenGL-0.4/
2472 OpenGL-0.4/COPYRIGHT
2473 [...]
2474
2475=back
2476
5f05dabc 2477=head2 CPAN::Shell
2478
2479The commands that are available in the shell interface are methods in
2480the package CPAN::Shell. If you enter the shell command, all your
10b2abe6 2481input is split by the Text::ParseWords::shellwords() routine which
2482acts like most shells do. The first word is being interpreted as the
2483method to be called and the rest of the words are treated as arguments
2484to this method.
2485
2486=head2 ProgrammerE<39>s interface
5f05dabc 2487
10b2abe6 2488If you do not enter the shell, the available shell commands are both
2489available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
2490functions in the calling package (C<install(...)>). The
2491programmerE<39>s interface has beta status. Do not heavily rely on it,
2492changes may still happen.
5f05dabc 2493
2494=head2 Cache Manager
2495
2496Currently the cache manager only keeps track of the build directory
2497($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
2498deletes complete directories below build_dir as soon as the size of
2499all directories there gets bigger than $CPAN::Config->{build_cache}
2500(in MB). The contents of this cache may be used for later
2501re-installations that you intend to do manually, but will never be
10b2abe6 2502trusted by CPAN itself. This is due to the fact that the user might
2503use these directories for building modules on different architectures.
5f05dabc 2504
2505There is another directory ($CPAN::Config->{keep_source_where}) where
2506the original distribution files are kept. This directory is not
2507covered by the cache manager and must be controlled by the user. If
2508you choose to have the same directory as build_dir and as
2509keep_source_where directory, then your sources will be deleted with
2510the same fifo mechanism.
2511
2512=head2 Bundles
2513
2514A bundle is just a perl module in the namespace Bundle:: that does not
2515define any functions or methods. It usually only contains documentation.
2516
2517It starts like a perl module with a package declaration and a $VERSION
2518variable. After that the pod section looks like any other pod with the
10b2abe6 2519only difference, that I<one special pod section> exists starting with
2520(verbatim):
5f05dabc 2521
2522 =head1 CONTENTS
2523
2524In this pod section each line obeys the format
2525
2526 Module_Name [Version_String] [- optional text]
2527
2528The 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
2530of the line is optional. The comment part is delimited by a dash just
2531as in the man page header.
2532
2533The distribution of a bundle should follow the same convention as
2534other distributions. The bundle() function in the CPAN module simply
2535parses the module that defines the bundle and returns the module names
2536that are listed in the described CONTENTS section.
2537
2538Bundles are treated specially in the CPAN package. If you say 'install
2539Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
2540the modules in the CONTENTS section of the pod. You can install your
2541own Bundles locally by placing a conformant Bundle file somewhere into
2542your @INC path. The autobundle() command which is available in the
2543shell interface does that for you by including all currently installed
2544modules in a snapshot bundle file.
2545
10b2abe6 2546There is a meaningless Bundle::Demo available on CPAN. Try to install
2547it, it usually does no harm, just demonstrates what the Bundle
2548interface looks like.
2549
5f05dabc 2550=head2 autobundle
2551
10b2abe6 2552C<autobundle> writes a bundle file into the
2553C<$CPAN::Config->{cpan_home}/Bundle> directory. The file contains a list
5f05dabc 2554of all modules that are both available from CPAN and currently
2555installed within @INC. The name of the bundle file is based on the
2556current date and a counter.
2557
5f05dabc 2558=head2 recompile
2559
2560recompile() is a very special command in that it takes no argument and
2561runs the make/test/install cycle with brute force over all installed
2562dynamically loadable extensions (aka XS modules) with 'force' in
2563effect. Primary purpose of this command is to act as a rescue in case
2564your perl breaks binary compatibility. If one of the modules that CPAN
2565uses is in turn depending on binary compatibility (so you cannot run
2566CPAN commands), then you should try the CPAN::Nox module for recovery.
2567
10b2abe6 2568A very popular use for recompile is to finish a network
2569installation. Imagine, you have a common source tree for two different
2570architectures. You decide to do a completely independent fresh
2571installation. You start on one architecture with the help of a Bundle
2572file produced earlier. CPAN installs the whole Bundle for you, but
2573when you try to repeat the job on the second architecture, CPAN
2574responds with a C<"Foo up to date"> message for all modules. So you
2575will be glad to run recompile in the second architecture and
2576youE<39>re done.
2577
5f05dabc 2578=head1 CONFIGURATION
2579
2580When the CPAN module is installed a site wide configuration file is
2581created as CPAN/Config.pm. The default values defined there can be
2582overridden in another configuration file: CPAN/MyConfig.pm. You can
2583store 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
2585use() or require() statements.
2586
2587Currently the following keys in the hash reference $CPAN::Config are
2588defined:
2589
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)
2607
2608You can set and query each of these options interactively in the cpan
2609shell with the command set defined within the C<o conf> command:
2610
2611=over 2
2612
2613=item o conf E<lt>scalar optionE<gt>
2614
2615prints the current value of the I<scalar option>
2616
2617=item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
2618
2619Sets the value of the I<scalar option> to I<value>
2620
2621=item o conf E<lt>list optionE<gt>
2622
2623prints the current value of the I<list option> in MakeMaker's
2624neatvalue format.
2625
2626=item o conf E<lt>list optionE<gt> [shift|pop]
2627
2628shifts or pops the array in the I<list option> variable
2629
2630=item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
2631
2632works like the corresponding perl commands. Whitespace is used to
2633determine the arguments.
2634
2635=back
2636
2637=head1 SECURITY
2638
2639There's no strong security layer in CPAN.pm. CPAN.pm helps you to
2640install foreign, unmasked, unsigned code on your machine. We compare
2641to a checksum that comes from the net just as the distribution file
2642itself. If somebody has managed to tamper with the distribution file,
2643they may have as well tampered with the CHECKSUMS file. Future
2644development will go towards stong authentification.
2645
2646=head1 EXPORT
2647
2648Most functions in package CPAN are exported per default. The reason
2649for this is that the primary use is intended for the cpan shell or for
2650oneliners.
2651
2652=head1 Debugging
2653
2654The debugging of this module is pretty difficult, because we have
2655interferences of the software producing the indices on CPAN, of the
2656mirroring process on CPAN, of packaging, of configuration, of
2657synchronicity, and of bugs within CPAN.pm.
2658
2659In interactive mode you can try "o debug" which will list options for
2660debugging the various parts of the package. The output may not be very
2661useful for you as it's just a byproduct of my own testing, but if you
2662have an idea which part of the package may have a bug, it's sometimes
2663worth to give it a try and send me more specific output. You should
2664know that "o debug" has built-in completion support.
2665
2666=head2 Prerequisites
2667
2668If 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
2670module. Otherwise you need Net::FTP intalled. LWP may be required for
2671non-UNIX systems or if your nearest CPAN site is associated with an
2672URL that is not C<ftp:>.
2673
2674This module presumes that all packages on CPAN
2675
2676=over 2
2677
2678=item *
2679
2680declare their $VERSION variable in an easy to parse manner. This
2681prerequisite can hardly be relaxed because it consumes by far too much
2682memory to load all packages into the running program just to determine
2683the $VERSION variable . Currently all programs that are dealing with
2684VERSION use something like this
2685
2686 perl -MExtUtils::MakeMaker -le \
2687 'print MM->parse_version($ARGV[0])' filename
2688
2689If you are author of a package and wonder if your VERSION can be
2690parsed, please try the above method.
2691
2692=item *
2693
2694come as compressed or gzipped tarfiles or as zip files and contain a
2695Makefile.PL (well we try to handle a bit more, but without much
2696enthusiasm).
2697
2698=back
2699
2700=head1 AUTHOR
2701
2702Andreas König E<lt>a.koenig@mind.deE<gt>
2703
2704=head1 SEE ALSO
2705
2706perl(1), CPAN::Nox(3)
2707
2708=cut
2709
Unnamed repository; edit this file to name it for gitweb.