1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_55';
5 $CPAN::VERSION = eval $CPAN::VERSION;
7 use CPAN::HandleConfig;
17 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
18 # 5.005_04 does not work without
20 use File::Basename ();
27 use Sys::Hostname qw(hostname);
28 use Text::ParseWords ();
31 # we need to run chdir all over and we would get at wrong libraries
34 if (File::Spec->can("rel2abs")) {
36 $inc = File::Spec->rel2abs($inc);
42 require Mac::BuildTools if $^O eq 'MacOS';
44 END { $CPAN::End++; &cleanup; }
47 $CPAN::Frontend ||= "CPAN::Shell";
48 unless (@CPAN::Defaultsites){
49 @CPAN::Defaultsites = map {
50 CPAN::URL->new(TEXT => $_, FROM => "DEF")
52 "http://www.perl.org/CPAN/",
53 "ftp://ftp.perl.org/pub/CPAN/";
55 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
56 $CPAN::Perl ||= CPAN::find_perl();
57 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
58 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
61 use vars qw($VERSION @EXPORT $AUTOLOAD
62 $DEBUG $META $HAS_USABLE $term
64 $Signal $Suppress_readline $Frontend
65 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
70 @CPAN::ISA = qw(CPAN::Debug Exporter);
72 # note that these functions live in CPAN::Shell and get executed via
73 # AUTOLOAD when called directly
96 sub soft_chdir_with_alternatives ($);
99 $autoload_recursion ||= 0;
101 #-> sub CPAN::AUTOLOAD ;
103 $autoload_recursion++;
107 warn "Refusing to autoload '$l' while signal pending";
108 $autoload_recursion--;
111 if ($autoload_recursion > 1) {
112 my $fullcommand = join " ", map { "'$_'" } $l, @_;
113 warn "Refusing to autoload $fullcommand in recursion\n";
114 $autoload_recursion--;
118 @export{@EXPORT} = '';
119 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
120 if (exists $export{$l}){
123 die(qq{Unknown CPAN command "$AUTOLOAD". }.
124 qq{Type ? for help.\n});
126 $autoload_recursion--;
130 #-> sub CPAN::shell ;
133 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
134 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
136 my $oprompt = shift || CPAN::Prompt->new;
137 my $prompt = $oprompt;
138 my $commandline = shift || "";
139 $CPAN::CurrentCommandId ||= 1;
142 unless ($Suppress_readline) {
143 require Term::ReadLine;
146 $term->ReadLine eq "Term::ReadLine::Stub"
148 $term = Term::ReadLine->new('CPAN Monitor');
150 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
151 my $attribs = $term->Attribs;
152 $attribs->{attempted_completion_function} = sub {
153 &CPAN::Complete::gnu_cpl;
156 $readline::rl_completion_function =
157 $readline::rl_completion_function = 'CPAN::Complete::cpl';
159 if (my $histfile = $CPAN::Config->{'histfile'}) {{
160 unless ($term->can("AddHistory")) {
161 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
164 my($fh) = FileHandle->new;
165 open $fh, "<$histfile" or last;
169 $term->AddHistory($_);
173 for ($CPAN::Config->{term_ornaments}) { # alias
174 local $Term::ReadLine::termcap_nowarn = 1;
175 $term->ornaments($_) if defined;
177 # $term->OUT is autoflushed anyway
178 my $odef = select STDERR;
185 # no strict; # I do not recall why no strict was here (2000-09-03)
187 my @cwd = grep { defined $_ and length $_ }
189 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
190 File::Spec->rootdir();
191 my $try_detect_readline;
192 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
193 my $rl_avail = $Suppress_readline ? "suppressed" :
194 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
195 "available (try 'install Bundle::CPAN')";
197 unless ($CPAN::Config->{'inhibit_startup_message'}){
198 $CPAN::Frontend->myprint(
200 cpan shell -- CPAN exploration and modules installation (v%s)
208 my($continuation) = "";
209 my $last_term_ornaments;
210 SHELLCOMMAND: while () {
211 if ($Suppress_readline) {
213 last SHELLCOMMAND unless defined ($_ = <> );
216 last SHELLCOMMAND unless
217 defined ($_ = $term->readline($prompt, $commandline));
219 $_ = "$continuation$_" if $continuation;
221 next SHELLCOMMAND if /^$/;
222 $_ = 'h' if /^\s*\?/;
223 if (/^(?:q(?:uit)?|bye|exit)$/i) {
234 use vars qw($import_done);
235 CPAN->import(':DEFAULT') unless $import_done++;
236 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
243 eval { @line = Text::ParseWords::shellwords($_) };
244 warn($@), next SHELLCOMMAND if $@;
245 warn("Text::Parsewords could not parse the line [$_]"),
246 next SHELLCOMMAND unless @line;
247 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
248 my $command = shift @line;
249 eval { CPAN::Shell->$command(@line) };
251 if ($command =~ /^(make|test|install|force|notest|clean|report|upgrade)$/) {
252 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
254 soft_chdir_with_alternatives(\@cwd);
255 $CPAN::Frontend->myprint("\n");
257 $CPAN::CurrentCommandId++;
261 $commandline = ""; # I do want to be able to pass a default to
262 # shell, but on the second command I see no
265 CPAN::Queue->nullify_queue;
266 if ($try_detect_readline) {
267 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
269 $CPAN::META->has_inst("Term::ReadLine::Perl")
271 delete $INC{"Term/ReadLine.pm"};
273 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
274 require Term::ReadLine;
275 $CPAN::Frontend->myprint("\n$redef subroutines in ".
276 "Term::ReadLine redefined\n");
280 if ($term and $term->can("ornaments")) {
281 for ($CPAN::Config->{term_ornaments}) { # alias
283 if (not defined $last_term_ornaments
284 or $_ != $last_term_ornaments
286 local $Term::ReadLine::termcap_nowarn = 1;
287 $term->ornaments($_);
288 $last_term_ornaments = $_;
291 undef $last_term_ornaments;
295 if ($CPAN::DEBUG && $CPAN::DEBUG & $CPAN::DEBUG{CPAN}) {
296 # debugging 'incommandcolor': should always be off at the end of a command
297 # (incommandcolor is used to detect recursive dependencies)
298 for my $class (qw(Module Distribution)) {
299 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
300 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
301 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
302 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
307 $GOTOSHELL = 0; # not too often
308 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
313 soft_chdir_with_alternatives(\@cwd);
316 sub soft_chdir_with_alternatives ($) {
319 my $root = File::Spec->rootdir();
320 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
321 Trying '$root' as temporary haven.
326 if (chdir $cwd->[0]) {
330 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
331 Trying to chdir to "$cwd->[1]" instead.
335 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
341 # CPAN::_yaml_loadfile
343 my($self,$local_file) = @_;
344 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
345 if ($CPAN::META->has_inst($yaml_module)) {
346 my $code = UNIVERSAL::can($yaml_module, "LoadFile");
348 eval { $yaml = $code->($local_file); };
350 $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
352 "with $yaml_module the following error was encountered:\n".
358 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
363 package CPAN::CacheMgr;
365 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
370 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
371 @CPAN::FTP::ISA = qw(CPAN::Debug);
373 package CPAN::LWP::UserAgent;
375 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
376 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
378 package CPAN::Complete;
380 @CPAN::Complete::ISA = qw(CPAN::Debug);
381 @CPAN::Complete::COMMANDS = sort qw(
382 ! a b d h i m o q r u
407 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
408 @CPAN::Index::ISA = qw(CPAN::Debug);
411 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
414 package CPAN::InfoObj;
416 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
418 package CPAN::Author;
420 @CPAN::Author::ISA = qw(CPAN::InfoObj);
422 package CPAN::Distribution;
424 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
426 package CPAN::Bundle;
428 @CPAN::Bundle::ISA = qw(CPAN::Module);
430 package CPAN::Module;
432 @CPAN::Module::ISA = qw(CPAN::InfoObj);
434 package CPAN::Exception::RecursiveDependency;
436 use overload '""' => "as_string";
443 for my $dep (@$deps) {
445 last if $seen{$dep}++;
447 bless { deps => \@deps }, $class;
452 "\nRecursive dependency detected:\n " .
453 join("\n => ", @{$self->{deps}}) .
454 ".\nCannot continue.\n";
457 package CPAN::Prompt; use overload '""' => "as_string";
458 use vars qw($prompt);
460 $CPAN::CurrentCommandId ||= 0;
465 if ($CPAN::Config->{commandnumber_in_prompt}) {
466 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
472 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
473 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
474 # planned are things like age or quality
476 my($class,%args) = @_;
488 $self->{TEXT} = $set;
493 package CPAN::Distrostatus;
494 use overload '""' => "as_string",
497 my($class,$arg) = @_;
500 FAILED => substr($arg,0,2) eq "NO",
501 COMMANDID => $CPAN::CurrentCommandId,
504 sub commandid { shift->{COMMANDID} }
505 sub failed { shift->{FAILED} }
509 $self->{TEXT} = $set;
528 @CPAN::Shell::ISA = qw(CPAN::Debug);
529 $COLOR_REGISTERED ||= 0;
532 # $GLOBAL_AUTOLOAD_RECURSION = 12;
533 $autoload_recursion ||= 0;
535 #-> sub CPAN::Shell::AUTOLOAD ;
537 $autoload_recursion++;
539 my $class = shift(@_);
540 # warn "autoload[$l] class[$class]";
543 warn "Refusing to autoload '$l' while signal pending";
544 $autoload_recursion--;
547 if ($autoload_recursion > 1) {
548 my $fullcommand = join " ", map { "'$_'" } $l, @_;
549 warn "Refusing to autoload $fullcommand in recursion\n";
550 $autoload_recursion--;
554 # XXX needs to be reconsidered
555 if ($CPAN::META->has_inst('CPAN::WAIT')) {
558 $CPAN::Frontend->mywarn(qq{
559 Commands starting with "w" require CPAN::WAIT to be installed.
560 Please consider installing CPAN::WAIT to use the fulltext index.
561 For this you just need to type
566 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
570 $autoload_recursion--;
577 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
579 # from here on only subs.
580 ################################################################################
582 sub suggest_myconfig () {
583 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
584 $CPAN::Frontend->myprint("You don't seem to have a user ".
585 "configuration (MyConfig.pm) yet.\n");
586 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
587 "user configuration now? (Y/n)",
590 CPAN::Shell->mkmyconfig();
593 $CPAN::Frontend->mydie("OK, giving up.");
598 #-> sub CPAN::all_objects ;
600 my($mgr,$class) = @_;
601 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
602 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
604 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
607 # Called by shell, not in batch mode. In batch mode I see no risk in
608 # having many processes updating something as installations are
609 # continually checked at runtime. In shell mode I suspect it is
610 # unintentional to open more than one shell at a time
612 #-> sub CPAN::checklock ;
615 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
616 if (-f $lockfile && -M _ > 0) {
617 my $fh = FileHandle->new($lockfile) or
618 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
619 my $otherpid = <$fh>;
620 my $otherhost = <$fh>;
622 if (defined $otherpid && $otherpid) {
625 if (defined $otherhost && $otherhost) {
628 my $thishost = hostname();
629 if (defined $otherhost && defined $thishost &&
630 $otherhost ne '' && $thishost ne '' &&
631 $otherhost ne $thishost) {
632 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
633 "reports other host $otherhost and other ".
634 "process $otherpid.\n".
635 "Cannot proceed.\n"));
637 elsif (defined $otherpid && $otherpid) {
638 return if $$ == $otherpid; # should never happen
639 $CPAN::Frontend->mywarn(
641 There seems to be running another CPAN process (pid $otherpid). Contacting...
643 if (kill 0, $otherpid) {
644 $CPAN::Frontend->mydie(qq{Other job is running.
645 You may want to kill it and delete the lockfile, maybe. On UNIX try:
649 } elsif (-w $lockfile) {
651 CPAN::Shell::colorable_makemaker_prompt
652 (qq{Other job not responding. Shall I overwrite }.
653 qq{the lockfile '$lockfile'? (Y/n)},"y");
654 $CPAN::Frontend->myexit("Ok, bye\n")
655 unless $ans =~ /^y/i;
658 qq{Lockfile '$lockfile' not writeable by you. }.
659 qq{Cannot proceed.\n}.
661 qq{ rm '$lockfile'\n}.
662 qq{ and then rerun us.\n}
666 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
667 "reports other process with ID ".
668 "$otherpid. Cannot proceed.\n"));
671 my $dotcpan = $CPAN::Config->{cpan_home};
672 eval { File::Path::mkpath($dotcpan);};
674 # A special case at least for Jarkko.
679 $symlinkcpan = readlink $dotcpan;
680 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
681 eval { File::Path::mkpath($symlinkcpan); };
685 $CPAN::Frontend->mywarn(qq{
686 Working directory $symlinkcpan created.
690 unless (-d $dotcpan) {
692 Your configuration suggests "$dotcpan" as your
693 CPAN.pm working directory. I could not create this directory due
694 to this error: $firsterror\n};
696 As "$dotcpan" is a symlink to "$symlinkcpan",
697 I tried to create that, but I failed with this error: $seconderror
700 Please make sure the directory exists and is writable.
702 $CPAN::Frontend->myprint($mess);
703 return suggest_myconfig;
705 } # $@ after eval mkpath $dotcpan
707 unless ($fh = FileHandle->new(">$lockfile")) {
708 if ($! =~ /Permission/) {
709 $CPAN::Frontend->myprint(qq{
711 Your configuration suggests that CPAN.pm should use a working
713 $CPAN::Config->{cpan_home}
714 Unfortunately we could not create the lock file
716 due to permission problems.
718 Please make sure that the configuration variable
719 \$CPAN::Config->{cpan_home}
720 points to a directory where you can write a .lock file. You can set
721 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
724 return suggest_myconfig;
727 $fh->print($$, "\n");
728 $fh->print(hostname(), "\n");
729 $self->{LOCK} = $lockfile;
734 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
740 die "Got yet another signal" if $Signal > 1;
741 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
742 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
746 # From: Larry Wall <larry@wall.org>
747 # Subject: Re: deprecating SIGDIE
748 # To: perl5-porters@perl.org
749 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
751 # The original intent of __DIE__ was only to allow you to substitute one
752 # kind of death for another on an application-wide basis without respect
753 # to whether you were in an eval or not. As a global backstop, it should
754 # not be used any more lightly (or any more heavily :-) than class
755 # UNIVERSAL. Any attempt to build a general exception model on it should
756 # be politely squashed. Any bug that causes every eval {} to have to be
757 # modified should be not so politely squashed.
759 # Those are my current opinions. It is also my optinion that polite
760 # arguments degenerate to personal arguments far too frequently, and that
761 # when they do, it's because both people wanted it to, or at least didn't
762 # sufficiently want it not to.
766 # global backstop to cleanup if we should really die
767 $SIG{__DIE__} = \&cleanup;
768 $self->debug("Signal handler set.") if $CPAN::DEBUG;
771 #-> sub CPAN::DESTROY ;
773 &cleanup; # need an eval?
776 #-> sub CPAN::anycwd ;
779 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
784 sub cwd {Cwd::cwd();}
786 #-> sub CPAN::getcwd ;
787 sub getcwd {Cwd::getcwd();}
789 #-> sub CPAN::fastcwd ;
790 sub fastcwd {Cwd::fastcwd();}
792 #-> sub CPAN::backtickcwd ;
793 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
795 #-> sub CPAN::find_perl ;
797 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
798 my $pwd = $CPAN::iCwd = CPAN::anycwd();
799 my $candidate = File::Spec->catfile($pwd,$^X);
800 $perl ||= $candidate if MM->maybe_command($candidate);
803 my ($component,$perl_name);
804 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
805 PATH_COMPONENT: foreach $component (File::Spec->path(),
806 $Config::Config{'binexp'}) {
807 next unless defined($component) && $component;
808 my($abs) = File::Spec->catfile($component,$perl_name);
809 if (MM->maybe_command($abs)) {
821 #-> sub CPAN::exists ;
823 my($mgr,$class,$id) = @_;
824 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
826 ### Carp::croak "exists called without class argument" unless $class;
828 $id =~ s/:+/::/g if $class eq "CPAN::Module";
829 exists $META->{readonly}{$class}{$id} or
830 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
833 #-> sub CPAN::delete ;
835 my($mgr,$class,$id) = @_;
836 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
837 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
840 #-> sub CPAN::has_usable
841 # has_inst is sometimes too optimistic, we should replace it with this
842 # has_usable whenever a case is given
844 my($self,$mod,$message) = @_;
845 return 1 if $HAS_USABLE->{$mod};
846 my $has_inst = $self->has_inst($mod,$message);
847 return unless $has_inst;
850 LWP => [ # we frequently had "Can't locate object
851 # method "new" via package "LWP::UserAgent" at
852 # (eval 69) line 2006
854 sub {require LWP::UserAgent},
855 sub {require HTTP::Request},
856 sub {require URI::URL},
859 sub {require Net::FTP},
860 sub {require Net::Config},
863 sub {require File::HomeDir;
864 unless (File::HomeDir->VERSION >= 0.52){
865 for ("Will not use File::HomeDir, need 0.52\n") {
866 $CPAN::Frontend->mywarn($_);
873 if ($usable->{$mod}) {
874 for my $c (0..$#{$usable->{$mod}}) {
875 my $code = $usable->{$mod}[$c];
876 my $ret = eval { &$code() };
877 $ret = "" unless defined $ret;
879 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
884 return $HAS_USABLE->{$mod} = 1;
887 #-> sub CPAN::has_inst
889 my($self,$mod,$message) = @_;
890 Carp::croak("CPAN->has_inst() called without an argument")
892 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
893 keys %{$CPAN::Config->{dontload_hash}||{}},
894 @{$CPAN::Config->{dontload_list}||[]};
895 if (defined $message && $message eq "no" # afair only used by Nox
899 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
907 # checking %INC is wrong, because $INC{LWP} may be true
908 # although $INC{"URI/URL.pm"} may have failed. But as
909 # I really want to say "bla loaded OK", I have to somehow
911 ### warn "$file in %INC"; #debug
913 } elsif (eval { require $file }) {
914 # eval is good: if we haven't yet read the database it's
915 # perfect and if we have installed the module in the meantime,
916 # it tries again. The second require is only a NOOP returning
917 # 1 if we had success, otherwise it's retrying
919 my $v = eval "\$$mod\::VERSION";
920 $v = $v ? " (v$v)" : "";
921 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
922 if ($mod eq "CPAN::WAIT") {
923 push @CPAN::Shell::ISA, 'CPAN::WAIT';
926 } elsif ($mod eq "Net::FTP") {
927 $CPAN::Frontend->mywarn(qq{
928 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
930 install Bundle::libnet
932 }) unless $Have_warned->{"Net::FTP"}++;
933 $CPAN::Frontend->mysleep(3);
934 } elsif ($mod eq "Digest::SHA"){
935 if ($Have_warned->{"Digest::SHA"}++) {
936 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
937 qq{because Digest::SHA not installed.\n});
939 $CPAN::Frontend->mywarn(qq{
940 CPAN: checksum security checks disabled because Digest::SHA not installed.
941 Please consider installing the Digest::SHA module.
944 $CPAN::Frontend->mysleep(2);
946 } elsif ($mod eq "Module::Signature"){
947 if (not $CPAN::Config->{check_sigs}) {
948 # they do not want us:-(
949 } elsif (not $Have_warned->{"Module::Signature"}++) {
950 # No point in complaining unless the user can
951 # reasonably install and use it.
952 if (eval { require Crypt::OpenPGP; 1 } ||
954 defined $CPAN::Config->{'gpg'}
956 $CPAN::Config->{'gpg'} =~ /\S/
959 $CPAN::Frontend->mywarn(qq{
960 CPAN: Module::Signature security checks disabled because Module::Signature
961 not installed. Please consider installing the Module::Signature module.
962 You may also need to be able to connect over the Internet to the public
963 keyservers like pgp.mit.edu (port 11371).
966 $CPAN::Frontend->mysleep(2);
970 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
975 #-> sub CPAN::instance ;
977 my($mgr,$class,$id) = @_;
980 # unsafe meta access, ok?
981 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
982 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
990 #-> sub CPAN::cleanup ;
992 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
993 local $SIG{__DIE__} = '';
998 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1000 $subroutine eq '(eval)';
1002 return if $ineval && !$CPAN::End;
1003 return unless defined $META->{LOCK};
1004 return unless -f $META->{LOCK};
1006 unlink $META->{LOCK};
1008 # Carp::cluck("DEBUGGING");
1009 $CPAN::Frontend->myprint("Lockfile removed.\n");
1012 #-> sub CPAN::savehist
1015 my($histfile,$histsize);
1016 unless ($histfile = $CPAN::Config->{'histfile'}){
1017 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1020 $histsize = $CPAN::Config->{'histsize'} || 100;
1022 unless ($CPAN::term->can("GetHistory")) {
1023 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1029 my @h = $CPAN::term->GetHistory;
1030 splice @h, 0, @h-$histsize if @h>$histsize;
1031 my($fh) = FileHandle->new;
1032 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1033 local $\ = local $, = "\n";
1039 my($self,$what) = @_;
1040 $self->{is_tested}{$what} = 1;
1043 # unsets the is_tested flag: as soon as the thing is installed, it is
1044 # not needed in set_perl5lib anymore
1046 my($self,$what) = @_;
1047 delete $self->{is_tested}{$what};
1052 $self->{is_tested} ||= {};
1053 return unless %{$self->{is_tested}};
1054 my $env = $ENV{PERL5LIB};
1055 $env = $ENV{PERLLIB} unless defined $env;
1057 push @env, $env if defined $env and length $env;
1058 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1059 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1060 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1063 package CPAN::CacheMgr;
1066 #-> sub CPAN::CacheMgr::as_string ;
1068 eval { require Data::Dumper };
1070 return shift->SUPER::as_string;
1072 return Data::Dumper::Dumper(shift);
1076 #-> sub CPAN::CacheMgr::cachesize ;
1081 #-> sub CPAN::CacheMgr::tidyup ;
1084 return unless -d $self->{ID};
1085 while ($self->{DU} > $self->{'MAX'} ) {
1086 my($toremove) = shift @{$self->{FIFO}};
1087 $CPAN::Frontend->myprint(sprintf(
1088 "Deleting from cache".
1089 ": $toremove (%.1f>%.1f MB)\n",
1090 $self->{DU}, $self->{'MAX'})
1092 return if $CPAN::Signal;
1093 $self->force_clean_cache($toremove);
1094 return if $CPAN::Signal;
1098 #-> sub CPAN::CacheMgr::dir ;
1103 #-> sub CPAN::CacheMgr::entries ;
1105 my($self,$dir) = @_;
1106 return unless defined $dir;
1107 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1108 $dir ||= $self->{ID};
1109 my($cwd) = CPAN::anycwd();
1110 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1111 my $dh = DirHandle->new(File::Spec->curdir)
1112 or Carp::croak("Couldn't opendir $dir: $!");
1115 next if $_ eq "." || $_ eq "..";
1117 push @entries, File::Spec->catfile($dir,$_);
1119 push @entries, File::Spec->catdir($dir,$_);
1121 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1124 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1125 sort { -M $b <=> -M $a} @entries;
1128 #-> sub CPAN::CacheMgr::disk_usage ;
1130 my($self,$dir) = @_;
1131 return if exists $self->{SIZE}{$dir};
1132 return if $CPAN::Signal;
1136 unless (chmod 0755, $dir) {
1137 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1138 "permission to change the permission; cannot ".
1139 "estimate disk usage of '$dir'\n");
1140 $CPAN::Frontend->mysleep(5);
1145 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1150 $File::Find::prune++ if $CPAN::Signal;
1152 if ($^O eq 'MacOS') {
1154 my $cat = Mac::Files::FSpGetCatInfo($_);
1155 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1159 unless (chmod 0755, $_) {
1160 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1161 "the permission to change the permission; ".
1162 "can only partially estimate disk usage ".
1164 $CPAN::Frontend->mysleep(5);
1175 return if $CPAN::Signal;
1176 $self->{SIZE}{$dir} = $Du/1024/1024;
1177 push @{$self->{FIFO}}, $dir;
1178 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1179 $self->{DU} += $Du/1024/1024;
1183 #-> sub CPAN::CacheMgr::force_clean_cache ;
1184 sub force_clean_cache {
1185 my($self,$dir) = @_;
1186 return unless -e $dir;
1187 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1189 File::Path::rmtree($dir);
1190 $self->{DU} -= $self->{SIZE}{$dir};
1191 delete $self->{SIZE}{$dir};
1194 #-> sub CPAN::CacheMgr::new ;
1201 ID => $CPAN::Config->{'build_dir'},
1202 MAX => $CPAN::Config->{'build_cache'},
1203 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1206 File::Path::mkpath($self->{ID});
1207 my $dh = DirHandle->new($self->{ID});
1208 bless $self, $class;
1211 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1213 CPAN->debug($debug) if $CPAN::DEBUG;
1217 #-> sub CPAN::CacheMgr::scan_cache ;
1220 return if $self->{SCAN} eq 'never';
1221 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1222 unless $self->{SCAN} eq 'atstart';
1223 $CPAN::Frontend->myprint(
1224 sprintf("Scanning cache %s for sizes\n",
1227 for $e ($self->entries($self->{ID})) {
1228 next if $e eq ".." || $e eq ".";
1229 $self->disk_usage($e);
1230 return if $CPAN::Signal;
1235 package CPAN::Shell;
1238 #-> sub CPAN::Shell::h ;
1240 my($class,$about) = @_;
1241 if (defined $about) {
1242 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1244 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1245 $CPAN::Frontend->myprint(qq{
1246 Display Information $filler (ver $CPAN::VERSION)
1247 command argument description
1248 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1249 i WORD or /REGEXP/ about any of the above
1250 ls AUTHOR or GLOB about files in the author's directory
1251 (with WORD being a module, bundle or author name or a distribution
1252 name of the form AUTHOR/DISTRIBUTION)
1254 Download, Test, Make, Install...
1255 get download clean make clean
1256 make make (implies get) look open subshell in dist directory
1257 test make test (implies make) readme display these README files
1258 install make install (implies test) perldoc display POD documentation
1261 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1262 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1265 force COMMAND unconditionally do command
1266 notest COMMAND skip testing
1269 h,? display this menu ! perl-code eval a perl command
1270 o conf [opt] set and query options q quit the cpan shell
1271 reload cpan load CPAN.pm again reload index load newer indices
1272 autobundle Snapshot recent latest CPAN uploads});
1278 #-> sub CPAN::Shell::a ;
1280 my($self,@arg) = @_;
1281 # authors are always UPPERCASE
1283 $_ = uc $_ unless /=/;
1285 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1288 #-> sub CPAN::Shell::globls ;
1290 my($self,$s,$pragmas) = @_;
1291 # ls is really very different, but we had it once as an ordinary
1292 # command in the Shell (upto rev. 321) and we could not handle
1294 my(@accept,@preexpand);
1295 if ($s =~ /[\*\?\/]/) {
1296 if ($CPAN::META->has_inst("Text::Glob")) {
1297 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1298 my $rau = Text::Glob::glob_to_regex(uc $au);
1299 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1301 push @preexpand, map { $_->id . "/" . $pathglob }
1302 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1304 my $rau = Text::Glob::glob_to_regex(uc $s);
1305 push @preexpand, map { $_->id }
1306 CPAN::Shell->expand_by_method('CPAN::Author',
1311 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1314 push @preexpand, uc $s;
1317 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1318 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1323 my $silent = @accept>1;
1324 my $last_alpha = "";
1326 for my $a (@accept){
1327 my($author,$pathglob);
1328 if ($a =~ m|(.*?)/(.*)|) {
1331 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1333 $a2) or die "No author found for $a2";
1335 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1337 $a) or die "No author found for $a";
1340 my $alpha = substr $author->id, 0, 1;
1342 if ($alpha eq $last_alpha) {
1346 $last_alpha = $alpha;
1348 $CPAN::Frontend->myprint($ad);
1350 for my $pragma (@$pragmas) {
1351 if ($author->can($pragma)) {
1355 push @results, $author->ls($pathglob,$silent); # silent if
1358 for my $pragma (@$pragmas) {
1359 my $meth = "un$pragma";
1360 if ($author->can($meth)) {
1368 #-> sub CPAN::Shell::local_bundles ;
1370 my($self,@which) = @_;
1371 my($incdir,$bdir,$dh);
1372 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1373 my @bbase = "Bundle";
1374 while (my $bbase = shift @bbase) {
1375 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1376 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1377 if ($dh = DirHandle->new($bdir)) { # may fail
1379 for $entry ($dh->read) {
1380 next if $entry =~ /^\./;
1381 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1382 if (-d File::Spec->catdir($bdir,$entry)){
1383 push @bbase, "$bbase\::$entry";
1385 next unless $entry =~ s/\.pm(?!\n)\Z//;
1386 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1394 #-> sub CPAN::Shell::b ;
1396 my($self,@which) = @_;
1397 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1398 $self->local_bundles;
1399 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1402 #-> sub CPAN::Shell::d ;
1403 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1405 #-> sub CPAN::Shell::m ;
1406 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1408 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1411 #-> sub CPAN::Shell::i ;
1415 @args = '/./' unless @args;
1417 for my $type (qw/Bundle Distribution Module/) {
1418 push @result, $self->expand($type,@args);
1420 # Authors are always uppercase.
1421 push @result, $self->expand("Author", map { uc $_ } @args);
1423 my $result = @result == 1 ?
1424 $result[0]->as_string :
1426 "No objects found of any type for argument @args\n" :
1428 (map {$_->as_glimpse} @result),
1429 scalar @result, " items found\n",
1431 $CPAN::Frontend->myprint($result);
1434 #-> sub CPAN::Shell::o ;
1436 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1437 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1438 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1439 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1441 my($self,$o_type,@o_what) = @_;
1444 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1445 if ($o_type eq 'conf') {
1446 if (!@o_what) { # print all things, "o conf"
1448 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1450 if (exists $INC{'CPAN/Config.pm'}) {
1451 push @from, $INC{'CPAN/Config.pm'};
1453 if (exists $INC{'CPAN/MyConfig.pm'}) {
1454 push @from, $INC{'CPAN/MyConfig.pm'};
1456 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1457 $CPAN::Frontend->myprint(":\n");
1458 for $k (sort keys %CPAN::HandleConfig::can) {
1459 $v = $CPAN::HandleConfig::can{$k};
1460 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1462 $CPAN::Frontend->myprint("\n");
1463 for $k (sort keys %$CPAN::Config) {
1464 CPAN::HandleConfig->prettyprint($k);
1466 $CPAN::Frontend->myprint("\n");
1467 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1468 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1471 } elsif ($o_type eq 'debug') {
1473 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1476 my($what) = shift @o_what;
1477 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1478 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1481 if ( exists $CPAN::DEBUG{$what} ) {
1482 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1483 } elsif ($what =~ /^\d/) {
1484 $CPAN::DEBUG = $what;
1485 } elsif (lc $what eq 'all') {
1487 for (values %CPAN::DEBUG) {
1490 $CPAN::DEBUG = $max;
1493 for (keys %CPAN::DEBUG) {
1494 next unless lc($_) eq lc($what);
1495 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1498 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1503 my $raw = "Valid options for debug are ".
1504 join(", ",sort(keys %CPAN::DEBUG), 'all').
1505 qq{ or a number. Completion works on the options. }.
1506 qq{Case is ignored.};
1508 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1509 $CPAN::Frontend->myprint("\n\n");
1512 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1514 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1515 $v = $CPAN::DEBUG{$k};
1516 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1517 if $v & $CPAN::DEBUG;
1520 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1523 $CPAN::Frontend->myprint(qq{
1525 conf set or get configuration variables
1526 debug set or get debugging options
1531 # CPAN::Shell::paintdots_onreload
1532 sub paintdots_onreload {
1535 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1539 # $CPAN::Frontend->myprint(".($subr)");
1540 $CPAN::Frontend->myprint(".");
1541 if ($subr =~ /\bshell\b/i) {
1542 # warn "debug[$_[0]]";
1544 # It would be nice if we could detect that a
1545 # subroutine has actually changed, but for now we
1546 # practically always set the GOTOSHELL global
1556 #-> sub CPAN::Shell::reload ;
1558 my($self,$command,@arg) = @_;
1560 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1561 if ($command =~ /^cpan$/i) {
1563 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1567 "CPAN/HandleConfig.pm",
1568 "CPAN/FirstTime.pm",
1575 MFILE: for my $f (@relo) {
1576 next unless exists $INC{$f};
1580 $CPAN::Frontend->myprint("($p");
1581 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1582 $self->reload_this($f) or $failed++;
1583 my $v = eval "$p\::->VERSION";
1584 $CPAN::Frontend->myprint("v$v)");
1586 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1588 my $errors = $failed == 1 ? "error" : "errors";
1589 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
1592 } elsif ($command =~ /^index$/i) {
1593 CPAN::Index->force_reload;
1595 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
1596 index re-reads the index files\n});
1600 # reload means only load again what we have loaded before
1601 #-> sub CPAN::Shell::reload_this ;
1603 my($self,$f,$args) = @_;
1604 CPAN->debug("f[$f]") if $CPAN::DEBUG;
1605 return 1 unless $INC{$f}; # we never loaded this, so we do not
1607 my $pwd = CPAN::anycwd();
1608 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
1610 for my $inc (@INC) {
1611 $file = File::Spec->catfile($inc,split /\//, $f);
1615 CPAN->debug("file[$file]") if $CPAN::DEBUG;
1617 unless ($file && -f $file) {
1618 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
1620 @inc = substr($file,0,-length($f)); # bring in back to me!
1622 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
1624 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1627 my $mtime = (stat $file)[9];
1628 $reload->{$f} ||= $^T;
1629 my $must_reload = $mtime > $reload->{$f};
1631 $must_reload ||= $args->{force};
1633 my $fh = FileHandle->new($file) or
1634 $CPAN::Frontend->mydie("Could not open $file: $!");
1637 my $content = <$fh>;
1638 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
1642 eval "require '$f'";
1647 $reload->{$f} = time;
1649 $CPAN::Frontend->myprint("__unchanged__");
1654 #-> sub CPAN::Shell::mkmyconfig ;
1656 my($self, $cpanpm, %args) = @_;
1657 require CPAN::FirstTime;
1658 my $home = CPAN::HandleConfig::home;
1659 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
1660 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
1661 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1662 CPAN::HandleConfig::require_myconfig_or_config;
1663 $CPAN::Config ||= {};
1668 keep_source_where => undef,
1671 CPAN::FirstTime::init($cpanpm, %args);
1674 #-> sub CPAN::Shell::_binary_extensions ;
1675 sub _binary_extensions {
1676 my($self) = shift @_;
1677 my(@result,$module,%seen,%need,$headerdone);
1678 for $module ($self->expand('Module','/./')) {
1679 my $file = $module->cpan_file;
1680 next if $file eq "N/A";
1681 next if $file =~ /^Contact Author/;
1682 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1683 next if $dist->isa_perl;
1684 next unless $module->xs_file;
1686 $CPAN::Frontend->myprint(".");
1687 push @result, $module;
1689 # print join " | ", @result;
1690 $CPAN::Frontend->myprint("\n");
1694 #-> sub CPAN::Shell::recompile ;
1696 my($self) = shift @_;
1697 my($module,@module,$cpan_file,%dist);
1698 @module = $self->_binary_extensions();
1699 for $module (@module){ # we force now and compile later, so we
1701 $cpan_file = $module->cpan_file;
1702 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1704 $dist{$cpan_file}++;
1706 for $cpan_file (sort keys %dist) {
1707 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1708 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1710 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1711 # stop a package from recompiling,
1712 # e.g. IO-1.12 when we have perl5.003_10
1716 #-> sub CPAN::Shell::scripts ;
1718 my($self, $arg) = @_;
1719 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
1721 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
1722 unless ($CPAN::META->has_inst($req)) {
1723 $CPAN::Frontend->mywarn(" $req not available\n");
1726 my $p = HTML::LinkExtor->new();
1727 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
1728 unless (-f $indexfile) {
1729 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
1731 $p->parse_file($indexfile);
1734 if ($arg =~ s|^/(.+)/$|$1|) {
1735 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
1737 for my $l ($p->links) {
1738 my $tag = shift @$l;
1739 next unless $tag eq "a";
1741 my $href = $att{href};
1742 next unless $href =~ s|^\.\./authors/id/./../||;
1745 if ($href =~ $qrarg) {
1749 if ($href =~ /\Q$arg\E/) {
1757 # now filter for the latest version if there is more than one of a name
1763 $stems{$stem} ||= [];
1764 push @{$stems{$stem}}, $href;
1766 for (sort keys %stems) {
1768 if (@{$stems{$_}} > 1) {
1769 $highest = List::Util::reduce {
1770 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
1773 $highest = $stems{$_}[0];
1775 $CPAN::Frontend->myprint("$highest\n");
1779 #-> sub CPAN::Shell::report ;
1781 my($self,@args) = @_;
1782 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
1783 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
1785 local $CPAN::Config->{test_report} = 1;
1786 $self->force("test",@args);
1789 #-> sub CPAN::Shell::upgrade ;
1791 my($self,@args) = @_;
1792 $self->install($self->r(@args));
1795 #-> sub CPAN::Shell::_u_r_common ;
1797 my($self) = shift @_;
1798 my($what) = shift @_;
1799 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1800 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1801 $what && $what =~ /^[aru]$/;
1803 @args = '/./' unless @args;
1804 my(@result,$module,%seen,%need,$headerdone,
1805 $version_undefs,$version_zeroes);
1806 $version_undefs = $version_zeroes = 0;
1807 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1808 my @expand = $self->expand('Module',@args);
1809 my $expand = scalar @expand;
1810 if (0) { # Looks like noise to me, was very useful for debugging
1811 # for metadata cache
1812 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1814 MODULE: for $module (@expand) {
1815 my $file = $module->cpan_file;
1816 next MODULE unless defined $file; # ??
1817 $file =~ s|^./../||;
1818 my($latest) = $module->cpan_version;
1819 my($inst_file) = $module->inst_file;
1821 return if $CPAN::Signal;
1824 $have = $module->inst_version;
1825 } elsif ($what eq "r") {
1826 $have = $module->inst_version;
1828 if ($have eq "undef"){
1830 } elsif ($have == 0){
1833 next MODULE unless CPAN::Version->vgt($latest, $have);
1834 # to be pedantic we should probably say:
1835 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1836 # to catch the case where CPAN has a version 0 and we have a version undef
1837 } elsif ($what eq "u") {
1843 } elsif ($what eq "r") {
1845 } elsif ($what eq "u") {
1849 return if $CPAN::Signal; # this is sometimes lengthy
1852 push @result, sprintf "%s %s\n", $module->id, $have;
1853 } elsif ($what eq "r") {
1854 push @result, $module->id;
1855 next MODULE if $seen{$file}++;
1856 } elsif ($what eq "u") {
1857 push @result, $module->id;
1858 next MODULE if $seen{$file}++;
1859 next MODULE if $file =~ /^Contact/;
1861 unless ($headerdone++){
1862 $CPAN::Frontend->myprint("\n");
1863 $CPAN::Frontend->myprint(sprintf(
1866 "Package namespace",
1875 # $GLOBAL_AUTOLOAD_RECURSION = 12;
1879 $CPAN::META->has_inst("Term::ANSIColor")
1881 $module->description
1883 $color_on = Term::ANSIColor::color("green");
1884 $color_off = Term::ANSIColor::color("reset");
1886 $CPAN::Frontend->myprint(sprintf $sprintf,
1893 $need{$module->id}++;
1897 $CPAN::Frontend->myprint("No modules found for @args\n");
1898 } elsif ($what eq "r") {
1899 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1903 if ($version_zeroes) {
1904 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1905 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1906 qq{a version number of 0\n});
1908 if ($version_undefs) {
1909 my $s_has = $version_undefs > 1 ? "s have" : " has";
1910 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1911 qq{parseable version number\n});
1917 #-> sub CPAN::Shell::r ;
1919 shift->_u_r_common("r",@_);
1922 #-> sub CPAN::Shell::u ;
1924 shift->_u_r_common("u",@_);
1927 #-> sub CPAN::Shell::failed ;
1929 my($self,$only_id,$silent) = @_;
1931 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1933 NAY: for my $nosayer (
1941 next unless exists $d->{$nosayer};
1943 $d->{$nosayer}->can("failed") ?
1944 $d->{$nosayer}->failed :
1945 $d->{$nosayer} =~ /^NO/
1947 next NAY if $only_id && $only_id != (
1948 $d->{$nosayer}->can("commandid")
1950 $d->{$nosayer}->commandid
1952 $CPAN::CurrentCommandId
1957 next DIST unless $failed;
1961 # " %-45s: %s %s\n",
1964 $d->{$failed}->can("failed") ?
1966 $d->{$failed}->commandid,
1969 $d->{$failed}->text,
1979 my $scope = $only_id ? "command" : "session";
1981 my $print = join "",
1982 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1983 sort { $a->[0] <=> $b->[0] } @failed;
1984 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1985 } elsif (!$only_id || !$silent) {
1986 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1990 # XXX intentionally undocumented because completely bogus, unportable,
1993 #-> sub CPAN::Shell::status ;
1996 require Devel::Size;
1997 my $ps = FileHandle->new;
1998 open $ps, "/proc/$$/status";
2001 next unless /VmSize:\s+(\d+)/;
2005 $CPAN::Frontend->mywarn(sprintf(
2006 "%-27s %6d\n%-27s %6d\n",
2010 Devel::Size::total_size($CPAN::META)/1024,
2012 for my $k (sort keys %$CPAN::META) {
2013 next unless substr($k,0,4) eq "read";
2014 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2015 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2016 warn sprintf " %-25s %6d (keys: %6d)\n",
2018 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2019 scalar keys %{$CPAN::META->{$k}{$k2}};
2024 #-> sub CPAN::Shell::autobundle ;
2027 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2028 my(@bundle) = $self->_u_r_common("a",@_);
2029 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2030 File::Path::mkpath($todir);
2031 unless (-d $todir) {
2032 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2035 my($y,$m,$d) = (localtime)[5,4,3];
2039 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2040 my($to) = File::Spec->catfile($todir,"$me.pm");
2042 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2043 $to = File::Spec->catfile($todir,"$me.pm");
2045 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2047 "package Bundle::$me;\n\n",
2048 "\$VERSION = '0.01';\n\n",
2052 "Bundle::$me - Snapshot of installation on ",
2053 $Config::Config{'myhostname'},
2056 "\n\n=head1 SYNOPSIS\n\n",
2057 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2058 "=head1 CONTENTS\n\n",
2059 join("\n", @bundle),
2060 "\n\n=head1 CONFIGURATION\n\n",
2062 "\n\n=head1 AUTHOR\n\n",
2063 "This Bundle has been generated automatically ",
2064 "by the autobundle routine in CPAN.pm.\n",
2067 $CPAN::Frontend->myprint("\nWrote bundle file
2071 #-> sub CPAN::Shell::expandany ;
2074 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2075 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2076 $s = CPAN::Distribution->normalize($s);
2077 return $CPAN::META->instance('CPAN::Distribution',$s);
2078 # Distributions spring into existence, not expand
2079 } elsif ($s =~ m|^Bundle::|) {
2080 $self->local_bundles; # scanning so late for bundles seems
2081 # both attractive and crumpy: always
2082 # current state but easy to forget
2084 return $self->expand('Bundle',$s);
2086 return $self->expand('Module',$s)
2087 if $CPAN::META->exists('CPAN::Module',$s);
2092 #-> sub CPAN::Shell::expand ;
2095 my($type,@args) = @_;
2096 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2097 my $class = "CPAN::$type";
2098 my $methods = ['id'];
2099 for my $meth (qw(name)) {
2100 next if $] < 5.00303; # no "can"
2101 next unless $class->can($meth);
2102 push @$methods, $meth;
2104 $self->expand_by_method($class,$methods,@args);
2107 sub expand_by_method {
2109 my($class,$methods,@args) = @_;
2112 my($regex,$command);
2113 if ($arg =~ m|^/(.*)/$|) {
2115 } elsif ($arg =~ m/=/) {
2119 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2121 defined $regex ? $regex : "UNDEFINED",
2122 defined $command ? $command : "UNDEFINED",
2124 if (defined $regex) {
2126 $CPAN::META->all_objects($class)
2129 # BUG, we got an empty object somewhere
2130 require Data::Dumper;
2131 CPAN->debug(sprintf(
2132 "Bug in CPAN: Empty id on obj[%s][%s]",
2134 Data::Dumper::Dumper($obj)
2138 for my $method (@$methods) {
2139 my $match = eval {$obj->$method() =~ /$regex/i};
2141 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2142 $err ||= $@; # if we were too restrictive above
2143 $CPAN::Frontend->mydie("$err\n");
2150 } elsif ($command) {
2151 die "equal sign in command disabled (immature interface), ".
2153 ! \$CPAN::Shell::ADVANCED_QUERY=1
2154 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2155 that may go away anytime.\n"
2156 unless $ADVANCED_QUERY;
2157 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2158 my($matchcrit) = $criterion =~ m/^~(.+)/;
2162 $CPAN::META->all_objects($class)
2164 my $lhs = $self->$method() or next; # () for 5.00503
2166 push @m, $self if $lhs =~ m/$matchcrit/;
2168 push @m, $self if $lhs eq $criterion;
2173 if ( $class eq 'CPAN::Bundle' ) {
2174 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2175 } elsif ($class eq "CPAN::Distribution") {
2176 $xarg = CPAN::Distribution->normalize($arg);
2180 if ($CPAN::META->exists($class,$xarg)) {
2181 $obj = $CPAN::META->instance($class,$xarg);
2182 } elsif ($CPAN::META->exists($class,$arg)) {
2183 $obj = $CPAN::META->instance($class,$arg);
2190 @m = sort {$a->id cmp $b->id} @m;
2191 if ( $CPAN::DEBUG ) {
2192 my $wantarray = wantarray;
2193 my $join_m = join ",", map {$_->id} @m;
2194 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2196 return wantarray ? @m : $m[0];
2199 #-> sub CPAN::Shell::format_result ;
2202 my($type,@args) = @_;
2203 @args = '/./' unless @args;
2204 my(@result) = $self->expand($type,@args);
2205 my $result = @result == 1 ?
2206 $result[0]->as_string :
2208 "No objects of type $type found for argument @args\n" :
2210 (map {$_->as_glimpse} @result),
2211 scalar @result, " items found\n",
2216 #-> sub CPAN::Shell::report_fh ;
2218 my $installation_report_fh;
2219 my $previously_noticed = 0;
2222 return $installation_report_fh if $installation_report_fh;
2223 if ($CPAN::META->has_inst("File::Temp")) {
2224 $installation_report_fh
2226 template => 'cpan_install_XXXX',
2231 unless ( $installation_report_fh ) {
2232 warn("Couldn't open installation report file; " .
2233 "no report file will be generated."
2234 ) unless $previously_noticed++;
2240 # The only reason for this method is currently to have a reliable
2241 # debugging utility that reveals which output is going through which
2242 # channel. No, I don't like the colors ;-)
2244 # to turn colordebugging on, write
2245 # cpan> o conf colorize_output 1
2247 #-> sub CPAN::Shell::print_ornamented ;
2249 my $print_ornamented_have_warned = 0;
2250 sub colorize_output {
2251 my $colorize_output = $CPAN::Config->{colorize_output};
2252 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2253 unless ($print_ornamented_have_warned++) {
2254 # no myprint/mywarn within myprint/mywarn!
2255 warn "Colorize_output is set to true but Term::ANSIColor is not
2256 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2258 $colorize_output = 0;
2260 return $colorize_output;
2265 sub print_ornamented {
2266 my($self,$what,$ornament) = @_;
2267 return unless defined $what;
2269 local $| = 1; # Flush immediately
2270 if ( $CPAN::Be_Silent ) {
2271 print {report_fh()} $what;
2274 my $swhat = "$what"; # stringify if it is an object
2275 if ($CPAN::Config->{term_is_latin}){
2278 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2280 if ($self->colorize_output) {
2281 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2282 # if you want to have this configurable, please file a bugreport
2283 $ornament = "black on_cyan";
2285 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2287 print "Term::ANSIColor rejects color[$ornament]: $@\n
2288 Please choose a different color (Hint: try 'o conf init color.*')\n";
2292 Term::ANSIColor::color("reset");
2298 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2299 # where to use what! I think, we send everything to STDOUT and use
2300 # print for normal/good news and warn for news that need more
2301 # attention. Yes, this is our working contract for now.
2303 my($self,$what) = @_;
2305 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2309 my($self,$what) = @_;
2310 $self->myprint($what);
2315 my($self,$what) = @_;
2316 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2319 # only to be used for shell commands
2321 my($self,$what) = @_;
2322 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2324 # If it is the shell, we want that the following die to be silent,
2325 # but if it is not the shell, we would need a 'die $what'. We need
2326 # to take care that only shell commands use mydie. Is this
2332 # sub CPAN::Shell::colorable_makemaker_prompt
2333 sub colorable_makemaker_prompt {
2335 if (CPAN::Shell->colorize_output) {
2336 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2337 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2340 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2341 if (CPAN::Shell->colorize_output) {
2342 print Term::ANSIColor::color('reset');
2347 # use this only for unrecoverable errors!
2348 sub unrecoverable_error {
2349 my($self,$what) = @_;
2350 my @lines = split /\n/, $what;
2352 for my $l (@lines) {
2353 $longest = length $l if length $l > $longest;
2355 $longest = 62 if $longest > 62;
2356 for my $l (@lines) {
2362 if (length $l < 66) {
2363 $l = pack "A66 A*", $l, "<==";
2367 unshift @lines, "\n";
2368 $self->mydie(join "", @lines);
2372 my($self, $sleep) = @_;
2377 return if -t STDOUT;
2378 my $odef = select STDERR;
2385 #-> sub CPAN::Shell::rematein ;
2386 # RE-adme||MA-ke||TE-st||IN-stall
2389 my($meth,@some) = @_;
2391 while($meth =~ /^(force|notest)$/) {
2392 push @pragma, $meth;
2393 $meth = shift @some or
2394 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2398 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2400 # Here is the place to set "test_count" on all involved parties to
2401 # 0. We then can pass this counter on to the involved
2402 # distributions and those can refuse to test if test_count > X. In
2403 # the first stab at it we could use a 1 for "X".
2405 # But when do I reset the distributions to start with 0 again?
2406 # Jost suggested to have a random or cycling interaction ID that
2407 # we pass through. But the ID is something that is just left lying
2408 # around in addition to the counter, so I'd prefer to set the
2409 # counter to 0 now, and repeat at the end of the loop. But what
2410 # about dependencies? They appear later and are not reset, they
2411 # enter the queue but not its copy. How do they get a sensible
2414 # construct the queue
2416 STHING: foreach $s (@some) {
2419 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2421 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2422 } elsif ($s =~ m|^/|) { # looks like a regexp
2423 if (substr($s,-1,1) eq ".") {
2424 $obj = CPAN::Shell->expandany($s);
2426 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2427 "not supported.\nRejecting argument '$s'\n");
2428 $CPAN::Frontend->mysleep(2);
2431 } elsif ($meth eq "ls") {
2432 $self->globls($s,\@pragma);
2435 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2436 $obj = CPAN::Shell->expandany($s);
2439 } elsif (ref $obj) {
2440 $obj->color_cmd_tmps(0,1);
2441 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2443 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2444 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2445 if ($meth =~ /^(dump|ls)$/) {
2448 $CPAN::Frontend->mywarn(
2450 "Don't be silly, you can't $meth ",
2454 $CPAN::Frontend->mysleep(2);
2456 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2457 CPAN::InfoObj->dump($s);
2460 ->mywarn(qq{Warning: Cannot $meth $s, }.
2461 qq{don't know what it is.
2466 to find objects with matching identifiers.
2468 $CPAN::Frontend->mysleep(2);
2472 # queuerunner (please be warned: when I started to change the
2473 # queue to hold objects instead of names, I made one or two
2474 # mistakes and never found which. I reverted back instead)
2475 while (my $q = CPAN::Queue->first) {
2477 my $s = $q->as_string;
2478 my $reqtype = $q->reqtype || "";
2479 $obj = CPAN::Shell->expandany($s);
2480 $obj->{reqtype} ||= "";
2481 CPAN->debug("obj-reqtype[$obj->{reqtype}]".
2482 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
2483 if ($obj->{reqtype}) {
2484 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
2485 $obj->{reqtype} = $reqtype;
2487 exists $obj->{install}
2490 $obj->{install}->can("failed") ?
2491 $obj->{install}->failed :
2492 $obj->{install} =~ /^NO/
2495 delete $obj->{install};
2496 $CPAN::Frontend->mywarn
2497 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
2501 $obj->{reqtype} = $reqtype;
2504 for my $pragma (@pragma) {
2507 ($] < 5.00303 || $obj->can($pragma))){
2508 ### compatibility with 5.003
2509 $obj->$pragma($meth); # the pragma "force" in
2510 # "CPAN::Distribution" must know
2511 # what we are intending
2514 if ($]>=5.00303 && $obj->can('called_for')) {
2515 $obj->called_for($s);
2517 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
2518 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
2522 CPAN::Queue->delete($s);
2524 CPAN->debug("failed");
2528 CPAN::Queue->delete_first($s);
2530 for my $obj (@qcopy) {
2531 $obj->color_cmd_tmps(0,0);
2535 #-> sub CPAN::Shell::recent ;
2539 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2544 # set up the dispatching methods
2546 for my $command (qw(
2561 *$command = sub { shift->rematein($command, @_); };
2565 package CPAN::LWP::UserAgent;
2569 return if $SETUPDONE;
2570 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2571 require LWP::UserAgent;
2572 @ISA = qw(Exporter LWP::UserAgent);
2575 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
2579 sub get_basic_credentials {
2580 my($self, $realm, $uri, $proxy) = @_;
2581 if ($USER && $PASSWD) {
2582 return ($USER, $PASSWD);
2585 ($USER,$PASSWD) = $self->get_proxy_credentials();
2587 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
2589 return($USER,$PASSWD);
2592 sub get_proxy_credentials {
2594 my ($user, $password);
2595 if ( defined $CPAN::Config->{proxy_user} &&
2596 defined $CPAN::Config->{proxy_pass}) {
2597 $user = $CPAN::Config->{proxy_user};
2598 $password = $CPAN::Config->{proxy_pass};
2599 return ($user, $password);
2601 my $username_prompt = "\nProxy authentication needed!
2602 (Note: to permanently configure username and password run
2603 o conf proxy_user your_username
2604 o conf proxy_pass your_password
2606 ($user, $password) =
2607 _get_username_and_password_from_user($username_prompt);
2608 return ($user,$password);
2611 sub get_non_proxy_credentials {
2613 my ($user,$password);
2614 if ( defined $CPAN::Config->{username} &&
2615 defined $CPAN::Config->{password}) {
2616 $user = $CPAN::Config->{username};
2617 $password = $CPAN::Config->{password};
2618 return ($user, $password);
2620 my $username_prompt = "\nAuthentication needed!
2621 (Note: to permanently configure username and password run
2622 o conf username your_username
2623 o conf password your_password
2626 ($user, $password) =
2627 _get_username_and_password_from_user($username_prompt);
2628 return ($user,$password);
2631 sub _get_username_and_password_from_user {
2633 my $username_message = shift;
2634 my ($username,$password);
2636 ExtUtils::MakeMaker->import(qw(prompt));
2637 $username = prompt($username_message);
2638 if ($CPAN::META->has_inst("Term::ReadKey")) {
2639 Term::ReadKey::ReadMode("noecho");
2642 $CPAN::Frontend->mywarn(
2643 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
2646 $password = prompt("Password:");
2648 if ($CPAN::META->has_inst("Term::ReadKey")) {
2649 Term::ReadKey::ReadMode("restore");
2651 $CPAN::Frontend->myprint("\n\n");
2652 return ($username,$password);
2655 # mirror(): Its purpose is to deal with proxy authentication. When we
2656 # call SUPER::mirror, we relly call the mirror method in
2657 # LWP::UserAgent. LWP::UserAgent will then call
2658 # $self->get_basic_credentials or some equivalent and this will be
2659 # $self->dispatched to our own get_basic_credentials method.
2661 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2663 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2664 # although we have gone through our get_basic_credentials, the proxy
2665 # server refuses to connect. This could be a case where the username or
2666 # password has changed in the meantime, so I'm trying once again without
2667 # $USER and $PASSWD to give the get_basic_credentials routine another
2668 # chance to set $USER and $PASSWD.
2670 # mirror(): Its purpose is to deal with proxy authentication. When we
2671 # call SUPER::mirror, we relly call the mirror method in
2672 # LWP::UserAgent. LWP::UserAgent will then call
2673 # $self->get_basic_credentials or some equivalent and this will be
2674 # $self->dispatched to our own get_basic_credentials method.
2676 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2678 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2679 # although we have gone through our get_basic_credentials, the proxy
2680 # server refuses to connect. This could be a case where the username or
2681 # password has changed in the meantime, so I'm trying once again without
2682 # $USER and $PASSWD to give the get_basic_credentials routine another
2683 # chance to set $USER and $PASSWD.
2686 my($self,$url,$aslocal) = @_;
2687 my $result = $self->SUPER::mirror($url,$aslocal);
2688 if ($result->code == 407) {
2691 $result = $self->SUPER::mirror($url,$aslocal);
2699 #-> sub CPAN::FTP::ftp_get ;
2701 my($class,$host,$dir,$file,$target) = @_;
2703 qq[Going to fetch file [$file] from dir [$dir]
2704 on host [$host] as local [$target]\n]
2706 my $ftp = Net::FTP->new($host);
2708 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2711 return 0 unless defined $ftp;
2712 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2713 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2714 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2715 my $msg = $ftp->message;
2716 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2719 unless ( $ftp->cwd($dir) ){
2720 my $msg = $ftp->message;
2721 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2725 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2726 unless ( $ftp->get($file,$target) ){
2727 my $msg = $ftp->message;
2728 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2731 $ftp->quit; # it's ok if this fails
2735 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2737 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2738 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2740 # > *** 1562,1567 ****
2741 # > --- 1562,1580 ----
2742 # > return 1 if substr($url,0,4) eq "file";
2743 # > return 1 unless $url =~ m|://([^/]+)|;
2745 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2747 # > + $proxy =~ m|://([^/:]+)|;
2749 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2750 # > + if ($noproxy) {
2751 # > + if ($host !~ /$noproxy$/) {
2752 # > + $host = $proxy;
2755 # > + $host = $proxy;
2758 # > require Net::Ping;
2759 # > return 1 unless $Net::Ping::VERSION >= 2;
2763 #-> sub CPAN::FTP::localize ;
2765 my($self,$file,$aslocal,$force) = @_;
2767 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2768 unless defined $aslocal;
2769 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2772 if ($^O eq 'MacOS') {
2773 # Comment by AK on 2000-09-03: Uniq short filenames would be
2774 # available in CHECKSUMS file
2775 my($name, $path) = File::Basename::fileparse($aslocal, '');
2776 if (length($name) > 31) {
2787 my $size = 31 - length($suf);
2788 while (length($name) > $size) {
2792 $aslocal = File::Spec->catfile($path, $name);
2796 if (-f $aslocal && -r _ && !($force & 1)){
2798 if ($size = -s $aslocal) {
2799 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
2802 # empty file from a previous unsuccessful attempt to download it
2804 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
2805 "could not remove.");
2810 rename $aslocal, "$aslocal.bak";
2814 my($aslocal_dir) = File::Basename::dirname($aslocal);
2815 File::Path::mkpath($aslocal_dir);
2816 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2817 qq{directory "$aslocal_dir".
2818 I\'ll continue, but if you encounter problems, they may be due
2819 to insufficient permissions.\n}) unless -w $aslocal_dir;
2821 # Inheritance is not easier to manage than a few if/else branches
2822 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2824 CPAN::LWP::UserAgent->config;
2825 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2827 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2831 $Ua->proxy('ftp', $var)
2832 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2833 $Ua->proxy('http', $var)
2834 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2837 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2839 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2840 # > use ones that require basic autorization.
2842 # > Example of when I use it manually in my own stuff:
2844 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2845 # > $req->proxy_authorization_basic("username","password");
2846 # > $res = $ua->request($req);
2850 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2854 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2855 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2858 # Try the list of urls for each single object. We keep a record
2859 # where we did get a file from
2860 my(@reordered,$last);
2861 $CPAN::Config->{urllist} ||= [];
2862 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2863 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2864 $CPAN::Config->{urllist} = [];
2866 $last = $#{$CPAN::Config->{urllist}};
2867 if ($force & 2) { # local cpans probably out of date, don't reorder
2868 @reordered = (0..$last);
2872 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2874 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2876 defined($ThesiteURL)
2878 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2880 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2885 $self->debug("Themethod[$Themethod]") if $CPAN::DEBUG;
2887 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2889 @levels = qw/easy hard hardest/;
2891 @levels = qw/easy/ if $^O eq 'MacOS';
2893 local $ENV{FTP_PASSIVE} =
2894 exists $CPAN::Config->{ftp_passive} ?
2895 $CPAN::Config->{ftp_passive} : 1;
2896 for $levelno (0..$#levels) {
2897 my $level = $levels[$levelno];
2898 my $method = "host$level";
2899 my @host_seq = $level eq "easy" ?
2900 @reordered : 0..$last; # reordered has CDROM up front
2901 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2902 for my $u (@urllist) {
2903 if ($u->can("text")) {
2904 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
2906 $u .= "/" unless substr($u,-1) eq "/";
2907 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
2910 for my $u (@CPAN::Defaultsites) {
2911 push @urllist, $u unless grep { $_ eq $u } @urllist;
2913 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2914 my $ret = $self->$method(\@urllist,$file,$aslocal);
2916 $Themethod = $level;
2918 # utime $now, $now, $aslocal; # too bad, if we do that, we
2919 # might alter a local mirror
2920 $self->debug("level[$level]") if $CPAN::DEBUG;
2924 last if $CPAN::Signal; # need to cleanup
2927 unless ($CPAN::Signal) {
2930 if (@{$CPAN::Config->{urllist}}) {
2932 qq{Please check, if the URLs I found in your configuration file \(}.
2933 join(", ", @{$CPAN::Config->{urllist}}).
2936 push @mess, qq{Your urllist is empty!};
2938 push @mess, qq{The urllist can be edited.},
2939 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2940 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
2941 $CPAN::Frontend->mywarn("Could not fetch $file\n");
2942 $CPAN::Frontend->mysleep(2);
2945 rename "$aslocal.bak", $aslocal;
2946 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2947 $self->ls($aslocal));
2953 # package CPAN::FTP;
2955 my($self,$host_seq,$file,$aslocal) = @_;
2957 HOSTEASY: for $ro_url (@$host_seq) {
2958 my $url .= "$ro_url$file";
2959 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2960 if ($url =~ /^file:/) {
2962 if ($CPAN::META->has_inst('URI::URL')) {
2963 my $u = URI::URL->new($url);
2965 } else { # works only on Unix, is poorly constructed, but
2966 # hopefully better than nothing.
2967 # RFC 1738 says fileurl BNF is
2968 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2969 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2971 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2972 $l =~ s|^file:||; # assume they
2976 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2978 $self->debug("local file[$l]") if $CPAN::DEBUG;
2979 if ( -f $l && -r _) {
2980 $ThesiteURL = $ro_url;
2983 if ($l =~ /(.+)\.gz$/) {
2985 if ( -f $ungz && -r _) {
2986 $ThesiteURL = $ro_url;
2990 # Maybe mirror has compressed it?
2992 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2993 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2995 $ThesiteURL = $ro_url;
3000 if ($CPAN::META->has_usable('LWP')) {
3001 $CPAN::Frontend->myprint("Fetching with LWP:
3005 CPAN::LWP::UserAgent->config;
3006 eval { $Ua = CPAN::LWP::UserAgent->new; };
3008 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3011 my $res = $Ua->mirror($url, $aslocal);
3012 if ($res->is_success) {
3013 $ThesiteURL = $ro_url;
3015 utime $now, $now, $aslocal; # download time is more
3016 # important than upload
3019 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3020 my $gzurl = "$url.gz";
3021 $CPAN::Frontend->myprint("Fetching with LWP:
3024 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3025 if ($res->is_success &&
3026 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
3028 $ThesiteURL = $ro_url;
3032 $CPAN::Frontend->myprint(sprintf(
3033 "LWP failed with code[%s] message[%s]\n",
3037 # Alan Burlison informed me that in firewall environments
3038 # Net::FTP can still succeed where LWP fails. So we do not
3039 # skip Net::FTP anymore when LWP is available.
3042 $ro_url->can("text")
3044 $ro_url->{FROM} eq "USER"
3046 my $ret = $self->hosthard([$ro_url],$file,$aslocal);
3047 return $ret if $ret;
3049 $CPAN::Frontend->mywarn(" LWP not available\n");
3051 return if $CPAN::Signal;
3052 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3053 # that's the nice and easy way thanks to Graham
3054 my($host,$dir,$getfile) = ($1,$2,$3);
3055 if ($CPAN::META->has_usable('Net::FTP')) {
3057 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3060 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3061 "aslocal[$aslocal]") if $CPAN::DEBUG;
3062 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3063 $ThesiteURL = $ro_url;
3066 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3067 my $gz = "$aslocal.gz";
3068 $CPAN::Frontend->myprint("Fetching with Net::FTP
3071 if (CPAN::FTP->ftp_get($host,
3075 CPAN::Tarzip->new($gz)->gunzip($aslocal)
3077 $ThesiteURL = $ro_url;
3084 return if $CPAN::Signal;
3088 # package CPAN::FTP;
3090 my($self,$host_seq,$file,$aslocal) = @_;
3092 # Came back if Net::FTP couldn't establish connection (or
3093 # failed otherwise) Maybe they are behind a firewall, but they
3094 # gave us a socksified (or other) ftp program...
3097 my($devnull) = $CPAN::Config->{devnull} || "";
3099 my($aslocal_dir) = File::Basename::dirname($aslocal);
3100 File::Path::mkpath($aslocal_dir);
3101 HOSTHARD: for $ro_url (@$host_seq) {
3102 my $url = "$ro_url$file";
3103 my($proto,$host,$dir,$getfile);
3105 # Courtesy Mark Conty mark_conty@cargill.com change from
3106 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3108 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3109 # proto not yet used
3110 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3112 next HOSTHARD; # who said, we could ftp anything except ftp?
3114 next HOSTHARD if $proto eq "file"; # file URLs would have had
3115 # success above. Likely a bogus URL
3117 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3119 # Try the most capable first and leave ncftp* for last as it only
3121 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3122 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3123 next unless defined $funkyftp;
3124 next if $funkyftp =~ /^\s*$/;
3126 my($asl_ungz, $asl_gz);
3127 ($asl_ungz = $aslocal) =~ s/\.gz//;
3128 $asl_gz = "$asl_ungz.gz";
3130 my($src_switch) = "";
3132 my($stdout_redir) = " > $asl_ungz";
3134 $src_switch = " -source";
3135 } elsif ($f eq "ncftp"){
3136 $src_switch = " -c";
3137 } elsif ($f eq "wget"){
3138 $src_switch = " -O $asl_ungz";
3140 } elsif ($f eq 'curl'){
3141 $src_switch = ' -L -f -s -S --netrc-optional';
3144 if ($f eq "ncftpget"){
3145 $chdir = "cd $aslocal_dir && ";
3148 $CPAN::Frontend->myprint(
3150 Trying with "$funkyftp$src_switch" to get
3154 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3155 $self->debug("system[$system]") if $CPAN::DEBUG;
3156 my($wstatus) = system($system);
3158 # lynx returns 0 when it fails somewhere
3160 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
3161 if ($content =~ /^<.*<title>[45]/si) {
3162 $CPAN::Frontend->mywarn(qq{
3163 No success, the file that lynx has has downloaded looks like an error message:
3166 $CPAN::Frontend->mysleep(1);
3170 $CPAN::Frontend->myprint(qq{
3171 No success, the file that lynx has has downloaded is an empty file.
3176 if ($wstatus == 0) {
3179 } elsif ($asl_ungz ne $aslocal) {
3180 # test gzip integrity
3181 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
3182 # e.g. foo.tar is gzipped --> foo.tar.gz
3183 rename $asl_ungz, $aslocal;
3185 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
3188 $ThesiteURL = $ro_url;
3190 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3192 -f $asl_ungz && -s _ == 0;
3193 my $gz = "$aslocal.gz";
3194 my $gzurl = "$url.gz";
3195 $CPAN::Frontend->myprint(
3197 Trying with "$funkyftp$src_switch" to get
3200 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3201 $self->debug("system[$system]") if $CPAN::DEBUG;
3203 if (($wstatus = system($system)) == 0
3207 # test gzip integrity
3208 my $ct = CPAN::Tarzip->new($asl_gz);
3210 $ct->gunzip($aslocal);
3212 # somebody uncompressed file for us?
3213 rename $asl_ungz, $aslocal;
3215 $ThesiteURL = $ro_url;
3218 unlink $asl_gz if -f $asl_gz;
3221 my $estatus = $wstatus >> 8;
3222 my $size = -f $aslocal ?
3223 ", left\n$aslocal with size ".-s _ :
3224 "\nWarning: expected file [$aslocal] doesn't exist";
3225 $CPAN::Frontend->myprint(qq{
3226 System call "$system"
3227 returned status $estatus (wstat $wstatus)$size
3230 return if $CPAN::Signal;
3231 } # transfer programs
3235 # package CPAN::FTP;
3237 my($self,$host_seq,$file,$aslocal) = @_;
3240 my($aslocal_dir) = File::Basename::dirname($aslocal);
3241 File::Path::mkpath($aslocal_dir);
3242 my $ftpbin = $CPAN::Config->{ftp};
3243 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
3244 $CPAN::Frontend->myprint("No external ftp command available\n\n");
3247 $CPAN::Frontend->mywarn(qq{
3248 As a last ressort we now switch to the external ftp command '$ftpbin'
3251 Doing so often leads to problems that are hard to diagnose.
3253 If you're victim of such problems, please consider unsetting the ftp
3254 config variable with
3260 $CPAN::Frontend->mysleep(2);
3261 HOSTHARDEST: for $ro_url (@$host_seq) {
3262 my $url = "$ro_url$file";
3263 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
3264 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3267 my($host,$dir,$getfile) = ($1,$2,$3);
3269 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
3270 $ctime,$blksize,$blocks) = stat($aslocal);
3271 $timestamp = $mtime ||= 0;
3272 my($netrc) = CPAN::FTP::netrc->new;
3273 my($netrcfile) = $netrc->netrc;
3274 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
3275 my $targetfile = File::Basename::basename($aslocal);
3281 map("cd $_", split /\//, $dir), # RFC 1738
3283 "get $getfile $targetfile",
3287 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
3288 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
3289 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
3291 $netrc->contains($host))) if $CPAN::DEBUG;
3292 if ($netrc->protected) {
3293 my $dialog = join "", map { " $_\n" } @dialog;
3295 if ($netrc->contains($host)) {
3296 $netrc_explain = "Relying that your .netrc entry for '$host' ".
3297 "manages the login";
3299 $netrc_explain = "Relying that your default .netrc entry ".
3300 "manages the login";
3302 $CPAN::Frontend->myprint(qq{
3303 Trying with external ftp to get
3306 Going to send the dialog
3310 $self->talk_ftp("$ftpbin$verbose $host",
3312 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3313 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3315 if ($mtime > $timestamp) {
3316 $CPAN::Frontend->myprint("GOT $aslocal\n");
3317 $ThesiteURL = $ro_url;
3320 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3322 return if $CPAN::Signal;
3324 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3325 qq{correctly protected.\n});
3328 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3329 nor does it have a default entry\n");
3332 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3333 # then and login manually to host, using e-mail as
3335 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3339 "user anonymous $Config::Config{'cf_email'}"
3341 my $dialog = join "", map { " $_\n" } @dialog;
3342 $CPAN::Frontend->myprint(qq{
3343 Trying with external ftp to get
3345 Going to send the dialog
3349 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3350 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3351 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3353 if ($mtime > $timestamp) {
3354 $CPAN::Frontend->myprint("GOT $aslocal\n");
3355 $ThesiteURL = $ro_url;
3358 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3360 return if $CPAN::Signal;
3361 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
3362 $CPAN::Frontend->mysleep(2);
3366 # package CPAN::FTP;
3368 my($self,$command,@dialog) = @_;
3369 my $fh = FileHandle->new;
3370 $fh->open("|$command") or die "Couldn't open ftp: $!";
3371 foreach (@dialog) { $fh->print("$_\n") }
3372 $fh->close; # Wait for process to complete
3374 my $estatus = $wstatus >> 8;
3375 $CPAN::Frontend->myprint(qq{
3376 Subprocess "|$command"
3377 returned status $estatus (wstat $wstatus)
3381 # find2perl needs modularization, too, all the following is stolen
3385 my($self,$name) = @_;
3386 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3387 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3389 my($perms,%user,%group);
3393 $blocks = int(($blocks + 1) / 2);
3396 $blocks = int(($sizemm + 1023) / 1024);
3399 if (-f _) { $perms = '-'; }
3400 elsif (-d _) { $perms = 'd'; }
3401 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3402 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3403 elsif (-p _) { $perms = 'p'; }
3404 elsif (-S _) { $perms = 's'; }
3405 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3407 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3408 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3409 my $tmpmode = $mode;
3410 my $tmp = $rwx[$tmpmode & 7];
3412 $tmp = $rwx[$tmpmode & 7] . $tmp;
3414 $tmp = $rwx[$tmpmode & 7] . $tmp;
3415 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3416 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3417 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3420 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3421 my $group = $group{$gid} || $gid;
3423 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3425 my($moname) = $moname[$mon];
3426 if (-M _ > 365.25 / 2) {
3427 $timeyear = $year + 1900;
3430 $timeyear = sprintf("%02d:%02d", $hour, $min);
3433 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3447 package CPAN::FTP::netrc;
3450 # package CPAN::FTP::netrc;
3453 my $home = CPAN::HandleConfig::home;
3454 my $file = File::Spec->catfile($home,".netrc");
3456 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3457 $atime,$mtime,$ctime,$blksize,$blocks)
3462 my($fh,@machines,$hasdefault);
3464 $fh = FileHandle->new or die "Could not create a filehandle";
3466 if($fh->open($file)){
3467 $protected = ($mode & 077) == 0;
3469 NETRC: while (<$fh>) {
3470 my(@tokens) = split " ", $_;
3471 TOKEN: while (@tokens) {
3472 my($t) = shift @tokens;
3473 if ($t eq "default"){
3477 last TOKEN if $t eq "macdef";
3478 if ($t eq "machine") {
3479 push @machines, shift @tokens;
3484 $file = $hasdefault = $protected = "";
3488 'mach' => [@machines],
3490 'hasdefault' => $hasdefault,
3491 'protected' => $protected,
3495 # CPAN::FTP::netrc::hasdefault;
3496 sub hasdefault { shift->{'hasdefault'} }
3497 sub netrc { shift->{'netrc'} }
3498 sub protected { shift->{'protected'} }
3500 my($self,$mach) = @_;
3501 for ( @{$self->{'mach'}} ) {
3502 return 1 if $_ eq $mach;
3507 package CPAN::Complete;
3511 my($text, $line, $start, $end) = @_;
3512 my(@perlret) = cpl($text, $line, $start);
3513 # find longest common match. Can anybody show me how to peruse
3514 # T::R::Gnu to have this done automatically? Seems expensive.
3515 return () unless @perlret;
3516 my($newtext) = $text;
3517 for (my $i = length($text)+1;;$i++) {
3518 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3519 my $try = substr($perlret[0],0,$i);
3520 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3521 # warn "try[$try]tries[@tries]";
3522 if (@tries == @perlret) {
3528 ($newtext,@perlret);
3531 #-> sub CPAN::Complete::cpl ;
3533 my($word,$line,$pos) = @_;
3537 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3539 if ($line =~ s/^(force\s*)//) {
3544 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3545 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3547 } elsif ($line =~ /^(a|ls)\s/) {
3548 @return = cplx('CPAN::Author',uc($word));
3549 } elsif ($line =~ /^b\s/) {
3550 CPAN::Shell->local_bundles;
3551 @return = cplx('CPAN::Bundle',$word);
3552 } elsif ($line =~ /^d\s/) {
3553 @return = cplx('CPAN::Distribution',$word);
3554 } elsif ($line =~ m/^(
3555 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3557 if ($word =~ /^Bundle::/) {
3558 CPAN::Shell->local_bundles;
3560 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3561 } elsif ($line =~ /^i\s/) {
3562 @return = cpl_any($word);
3563 } elsif ($line =~ /^reload\s/) {
3564 @return = cpl_reload($word,$line,$pos);
3565 } elsif ($line =~ /^o\s/) {
3566 @return = cpl_option($word,$line,$pos);
3567 } elsif ($line =~ m/^\S+\s/ ) {
3568 # fallback for future commands and what we have forgotten above
3569 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3576 #-> sub CPAN::Complete::cplx ;
3578 my($class, $word) = @_;
3579 # I believed for many years that this was sorted, today I
3580 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3581 # make it sorted again. Maybe sort was dropped when GNU-readline
3582 # support came in? The RCS file is difficult to read on that:-(
3583 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3586 #-> sub CPAN::Complete::cpl_any ;
3590 cplx('CPAN::Author',$word),
3591 cplx('CPAN::Bundle',$word),
3592 cplx('CPAN::Distribution',$word),
3593 cplx('CPAN::Module',$word),
3597 #-> sub CPAN::Complete::cpl_reload ;
3599 my($word,$line,$pos) = @_;
3601 my(@words) = split " ", $line;
3602 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3603 my(@ok) = qw(cpan index);
3604 return @ok if @words == 1;
3605 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3608 #-> sub CPAN::Complete::cpl_option ;
3610 my($word,$line,$pos) = @_;
3612 my(@words) = split " ", $line;
3613 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3614 my(@ok) = qw(conf debug);
3615 return @ok if @words == 1;
3616 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3618 } elsif ($words[1] eq 'index') {
3620 } elsif ($words[1] eq 'conf') {
3621 return CPAN::HandleConfig::cpl(@_);
3622 } elsif ($words[1] eq 'debug') {
3623 return sort grep /^\Q$word\E/i,
3624 sort keys %CPAN::DEBUG, 'all';
3628 package CPAN::Index;
3631 #-> sub CPAN::Index::force_reload ;
3634 $CPAN::Index::LAST_TIME = 0;
3638 #-> sub CPAN::Index::reload ;
3640 my($cl,$force) = @_;
3643 # XXX check if a newer one is available. (We currently read it
3644 # from time to time)
3645 for ($CPAN::Config->{index_expire}) {
3646 $_ = 0.001 unless $_ && $_ > 0.001;
3648 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3649 # debug here when CPAN doesn't seem to read the Metadata
3651 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3653 unless ($CPAN::META->{PROTOCOL}) {
3654 $cl->read_metadata_cache;
3655 $CPAN::META->{PROTOCOL} ||= "1.0";
3657 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3658 # warn "Setting last_time to 0";
3659 $LAST_TIME = 0; # No warning necessary
3661 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3664 # IFF we are developing, it helps to wipe out the memory
3665 # between reloads, otherwise it is not what a user expects.
3666 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3667 $CPAN::META = CPAN->new;
3671 local $LAST_TIME = $time;
3672 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3674 my $needshort = $^O eq "dos";
3676 $cl->rd_authindex($cl
3678 "authors/01mailrc.txt.gz",
3680 File::Spec->catfile('authors', '01mailrc.gz') :
3681 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3684 $debug = "timing reading 01[".($t2 - $time)."]";
3686 return if $CPAN::Signal; # this is sometimes lengthy
3687 $cl->rd_modpacks($cl
3689 "modules/02packages.details.txt.gz",
3691 File::Spec->catfile('modules', '02packag.gz') :
3692 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3695 $debug .= "02[".($t2 - $time)."]";
3697 return if $CPAN::Signal; # this is sometimes lengthy
3700 "modules/03modlist.data.gz",
3702 File::Spec->catfile('modules', '03mlist.gz') :
3703 File::Spec->catfile('modules', '03modlist.data.gz'),
3705 $cl->write_metadata_cache;
3707 $debug .= "03[".($t2 - $time)."]";
3709 CPAN->debug($debug) if $CPAN::DEBUG;
3712 $CPAN::META->{PROTOCOL} = PROTOCOL;
3715 #-> sub CPAN::Index::reload_x ;
3717 my($cl,$wanted,$localname,$force) = @_;
3718 $force |= 2; # means we're dealing with an index here
3719 CPAN::HandleConfig->load; # we should guarantee loading wherever
3720 # we rely on Config XXX
3721 $localname ||= $wanted;
3722 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3726 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3729 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3730 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3731 qq{day$s. I\'ll use that.});
3734 $force |= 1; # means we're quite serious about it.
3736 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3739 #-> sub CPAN::Index::rd_authindex ;
3741 my($cl, $index_target) = @_;
3743 return unless defined $index_target;
3744 $CPAN::Frontend->myprint("Going to read $index_target\n");
3746 tie *FH, 'CPAN::Tarzip', $index_target;
3749 push @lines, split /\012/ while <FH>;
3751 my $modulus = int($#lines/75) || 1;
3752 CPAN->debug(sprintf "modulus[%d]lines[%s]", $modulus, scalar @lines) if $CPAN::DEBUG;
3754 my($userid,$fullname,$email) =
3755 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
3756 $fullname ||= $email;
3757 if ($userid && $fullname && $email){
3758 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3759 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3761 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
3763 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
3764 return if $CPAN::Signal;
3766 $CPAN::Frontend->myprint("DONE\n");
3770 my($self,$dist) = @_;
3771 $dist = $self->{'id'} unless defined $dist;
3772 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3776 #-> sub CPAN::Index::rd_modpacks ;
3778 my($self, $index_target) = @_;
3779 return unless defined $index_target;
3780 $CPAN::Frontend->myprint("Going to read $index_target\n");
3781 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3783 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
3786 while (my $bytes = $fh->READ(\$chunk,8192)) {
3789 my @lines = split /\012/, $slurp;
3790 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
3793 my($line_count,$last_updated);
3795 my $shift = shift(@lines);
3796 last if $shift =~ /^\s*$/;
3797 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3798 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3800 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
3801 if (not defined $line_count) {
3803 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
3804 Please check the validity of the index file by comparing it to more
3805 than one CPAN mirror. I'll continue but problems seem likely to
3809 $CPAN::Frontend->mysleep(5);
3810 } elsif ($line_count != scalar @lines) {
3812 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
3813 contains a Line-Count header of %d but I see %d lines there. Please
3814 check the validity of the index file by comparing it to more than one
3815 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3816 $index_target, $line_count, scalar(@lines));
3819 if (not defined $last_updated) {
3821 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
3822 Please check the validity of the index file by comparing it to more
3823 than one CPAN mirror. I'll continue but problems seem likely to
3827 $CPAN::Frontend->mysleep(5);
3831 ->myprint(sprintf qq{ Database was generated on %s\n},
3833 $DATE_OF_02 = $last_updated;
3836 if ($CPAN::META->has_inst('HTTP::Date')) {
3838 $age -= HTTP::Date::str2time($last_updated);
3840 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
3841 require Time::Local;
3842 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3843 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3844 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3851 qq{Warning: This index file is %d days old.
3852 Please check the host you chose as your CPAN mirror for staleness.
3853 I'll continue but problems seem likely to happen.\a\n},
3856 } elsif ($age < -1) {
3860 qq{Warning: Your system date is %d days behind this index file!
3862 Timestamp index file: %s
3863 Please fix your system time, problems with the make command expected.\n},
3873 # A necessity since we have metadata_cache: delete what isn't
3875 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3876 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3879 my $modulus = int($#lines/75) || 1;
3881 # before 1.56 we split into 3 and discarded the rest. From
3882 # 1.57 we assign remaining text to $comment thus allowing to
3883 # influence isa_perl
3884 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3885 my($bundle,$id,$userid);
3887 if ($mod eq 'CPAN' &&
3889 CPAN::Queue->exists('Bundle::CPAN') ||
3890 CPAN::Queue->exists('CPAN')
3894 if ($version > $CPAN::VERSION){
3895 $CPAN::Frontend->mywarn(qq{
3896 New CPAN.pm version (v$version) available.
3897 [Currently running version is v$CPAN::VERSION]
3898 You might want to try
3901 to both upgrade CPAN.pm and run the new version without leaving
3902 the current session.
3905 $CPAN::Frontend->mysleep(2);
3906 $CPAN::Frontend->myprint(qq{\n});
3908 last if $CPAN::Signal;
3909 } elsif ($mod =~ /^Bundle::(.*)/) {
3914 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3915 # Let's make it a module too, because bundles have so much
3916 # in common with modules.
3918 # Changed in 1.57_63: seems like memory bloat now without
3919 # any value, so commented out
3921 # $CPAN::META->instance('CPAN::Module',$mod);
3925 # instantiate a module object
3926 $id = $CPAN::META->instance('CPAN::Module',$mod);
3930 # Although CPAN prohibits same name with different version the
3931 # indexer may have changed the version for the same distro
3932 # since the last time ("Force Reindexing" feature)
3933 if ($id->cpan_file ne $dist
3935 $id->cpan_version ne $version
3937 $userid = $id->userid || $self->userid($dist);
3939 'CPAN_USERID' => $userid,
3940 'CPAN_VERSION' => $version,
3941 'CPAN_FILE' => $dist,
3945 # instantiate a distribution object
3946 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3947 # we do not need CONTAINSMODS unless we do something with
3948 # this dist, so we better produce it on demand.
3950 ## my $obj = $CPAN::META->instance(
3951 ## 'CPAN::Distribution' => $dist
3953 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3955 $CPAN::META->instance(
3956 'CPAN::Distribution' => $dist
3958 'CPAN_USERID' => $userid,
3959 'CPAN_COMMENT' => $comment,
3963 for my $name ($mod,$dist) {
3964 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
3965 $exists{$name} = undef;
3968 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
3969 return if $CPAN::Signal;
3971 $CPAN::Frontend->myprint("DONE\n");
3973 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3974 for my $o ($CPAN::META->all_objects($class)) {
3975 next if exists $exists{$o->{ID}};
3976 $CPAN::META->delete($class,$o->{ID});
3977 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3984 #-> sub CPAN::Index::rd_modlist ;
3986 my($cl,$index_target) = @_;
3987 return unless defined $index_target;
3988 $CPAN::Frontend->myprint("Going to read $index_target\n");
3989 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3993 while (my $bytes = $fh->READ(\$chunk,8192)) {
3996 my @eval2 = split /\012/, $slurp;
3999 my $shift = shift(@eval2);
4000 if ($shift =~ /^Date:\s+(.*)/){
4001 if ($DATE_OF_03 eq $1){
4002 $CPAN::Frontend->myprint("Unchanged.\n");
4007 last if $shift =~ /^\s*$/;
4009 push @eval2, q{CPAN::Modulelist->data;};
4011 my($comp) = Safe->new("CPAN::Safe1");
4012 my($eval2) = join("\n", @eval2);
4013 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4014 my $ret = $comp->reval($eval2);
4015 Carp::confess($@) if $@;
4016 return if $CPAN::Signal;
4018 my $until = keys(%$ret) - 1;
4019 my $modulus = int($until/75) || 1;
4020 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4022 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4023 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4024 $obj->set(%{$ret->{$_}});
4025 $CPAN::Frontend->myprint(".") unless $i++ % $modulus;
4026 return if $CPAN::Signal;
4028 $CPAN::Frontend->myprint("DONE\n");
4031 #-> sub CPAN::Index::write_metadata_cache ;
4032 sub write_metadata_cache {
4034 return unless $CPAN::Config->{'cache_metadata'};
4035 return unless $CPAN::META->has_usable("Storable");
4037 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4038 CPAN::Distribution)) {
4039 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4041 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4042 $cache->{last_time} = $LAST_TIME;
4043 $cache->{DATE_OF_02} = $DATE_OF_02;
4044 $cache->{PROTOCOL} = PROTOCOL;
4045 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4046 eval { Storable::nstore($cache, $metadata_file) };
4047 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4050 #-> sub CPAN::Index::read_metadata_cache ;
4051 sub read_metadata_cache {
4053 return unless $CPAN::Config->{'cache_metadata'};
4054 return unless $CPAN::META->has_usable("Storable");
4055 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4056 return unless -r $metadata_file and -f $metadata_file;
4057 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4059 eval { $cache = Storable::retrieve($metadata_file) };
4060 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4061 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4065 if (exists $cache->{PROTOCOL}) {
4066 if (PROTOCOL > $cache->{PROTOCOL}) {
4067 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4068 "with protocol v%s, requiring v%s\n",
4075 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4076 "with protocol v1.0\n");
4081 while(my($class,$v) = each %$cache) {
4082 next unless $class =~ /^CPAN::/;
4083 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4084 while (my($id,$ro) = each %$v) {
4085 $CPAN::META->{readwrite}{$class}{$id} ||=
4086 $class->new(ID=>$id, RO=>$ro);
4091 unless ($clcnt) { # sanity check
4092 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4095 if ($idcnt < 1000) {
4096 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4097 "in $metadata_file\n");
4100 $CPAN::META->{PROTOCOL} ||=
4101 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4102 # does initialize to some protocol
4103 $LAST_TIME = $cache->{last_time};
4104 $DATE_OF_02 = $cache->{DATE_OF_02};
4105 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4106 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4110 package CPAN::InfoObj;
4115 exists $self->{RO} and return $self->{RO};
4120 my $ro = $self->ro or return "N/A"; # N/A for bundles found locally
4121 return $ro->{CPAN_USERID} || "N/A";
4124 sub id { shift->{ID}; }
4126 #-> sub CPAN::InfoObj::new ;
4128 my $this = bless {}, shift;
4133 # The set method may only be used by code that reads index data or
4134 # otherwise "objective" data from the outside world. All session
4135 # related material may do anything else with instance variables but
4136 # must not touch the hash under the RO attribute. The reason is that
4137 # the RO hash gets written to Metadata file and is thus persistent.
4139 #-> sub CPAN::InfoObj::safe_chdir ;
4141 my($self,$todir) = @_;
4142 # we die if we cannot chdir and we are debuggable
4143 Carp::confess("safe_chdir called without todir argument")
4144 unless defined $todir and length $todir;
4146 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4150 unless (-x $todir) {
4151 unless (chmod 0755, $todir) {
4152 my $cwd = CPAN::anycwd();
4153 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4154 "permission to change the permission; cannot ".
4155 "chdir to '$todir'\n");
4156 $CPAN::Frontend->mysleep(5);
4157 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4158 qq{to todir[$todir]: $!});
4162 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4165 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4168 my $cwd = CPAN::anycwd();
4169 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4170 qq{to todir[$todir] (a chmod has been issued): $!});
4175 #-> sub CPAN::InfoObj::set ;
4177 my($self,%att) = @_;
4178 my $class = ref $self;
4180 # This must be ||=, not ||, because only if we write an empty
4181 # reference, only then the set method will write into the readonly
4182 # area. But for Distributions that spring into existence, maybe
4183 # because of a typo, we do not like it that they are written into
4184 # the readonly area and made permanent (at least for a while) and
4185 # that is why we do not "allow" other places to call ->set.
4186 unless ($self->id) {
4187 CPAN->debug("Bug? Empty ID, rejecting");
4190 my $ro = $self->{RO} =
4191 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
4193 while (my($k,$v) = each %att) {
4198 #-> sub CPAN::InfoObj::as_glimpse ;
4202 my $class = ref($self);
4203 $class =~ s/^CPAN:://;
4204 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
4205 push @m, sprintf "%-15s %s\n", $class, $id;
4209 #-> sub CPAN::InfoObj::as_string ;
4213 my $class = ref($self);
4214 $class =~ s/^CPAN:://;
4215 push @m, $class, " id = $self->{ID}\n";
4217 unless ($ro = $self->ro) {
4218 if (substr($self->{ID},-1,1) eq ".") { # directory
4221 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
4224 for (sort keys %$ro) {
4225 # next if m/^(ID|RO)$/;
4227 if ($_ eq "CPAN_USERID") {
4229 $extra .= $self->fullname;
4230 my $email; # old perls!
4231 if ($email = $CPAN::META->instance("CPAN::Author",
4234 $extra .= " <$email>";
4236 $extra .= " <no email>";
4239 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
4240 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
4243 next unless defined $ro->{$_};
4244 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
4246 KEY: for (sort keys %$self) {
4247 next if m/^(ID|RO)$/;
4248 unless (defined $self->{$_}) {
4252 if (ref($self->{$_}) eq "ARRAY") {
4253 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
4254 } elsif (ref($self->{$_}) eq "HASH") {
4256 if (/^CONTAINSMODS$/) {
4257 $value = join(" ",sort keys %{$self->{$_}});
4258 } elsif (/^prereq_pm$/) {
4260 my $v = $self->{$_};
4261 for my $x (sort keys %$v) {
4263 for my $y (sort keys %{$v->{$x}}) {
4264 push @svalue, "$y=>$v->{$x}{$y}";
4266 push @value, "$x\:" . join ",", @svalue;
4268 $value = join ";", @value;
4270 $value = $self->{$_};
4278 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
4284 #-> sub CPAN::InfoObj::fullname ;
4287 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
4290 #-> sub CPAN::InfoObj::dump ;
4292 my($self, $what) = @_;
4293 unless ($CPAN::META->has_inst("Data::Dumper")) {
4294 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
4296 local $Data::Dumper::Sortkeys;
4297 $Data::Dumper::Sortkeys = 1;
4298 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
4299 if (length $out > 100000) {
4300 my $fh_pager = FileHandle->new;
4301 local($SIG{PIPE}) = "IGNORE";
4302 my $pager = $CPAN::Config->{'pager'} || "cat";
4303 $fh_pager->open("|$pager")
4304 or die "Could not open pager $pager\: $!";
4305 $fh_pager->print($out);
4308 $CPAN::Frontend->myprint($out);
4312 package CPAN::Author;
4315 #-> sub CPAN::Author::force
4321 #-> sub CPAN::Author::force
4324 delete $self->{force};
4327 #-> sub CPAN::Author::id
4330 my $id = $self->{ID};
4331 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
4335 #-> sub CPAN::Author::as_glimpse ;
4339 my $class = ref($self);
4340 $class =~ s/^CPAN:://;
4341 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
4349 #-> sub CPAN::Author::fullname ;
4351 shift->ro->{FULLNAME};
4355 #-> sub CPAN::Author::email ;
4356 sub email { shift->ro->{EMAIL}; }
4358 #-> sub CPAN::Author::ls ;
4361 my $glob = shift || "";
4362 my $silent = shift || 0;
4365 # adapted from CPAN::Distribution::verifyCHECKSUM ;
4366 my(@csf); # chksumfile
4367 @csf = $self->id =~ /(.)(.)(.*)/;
4368 $csf[1] = join "", @csf[0,1];
4369 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
4371 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
4372 unless (grep {$_->[2] eq $csf[1]} @dl) {
4373 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
4376 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
4377 unless (grep {$_->[2] eq $csf[2]} @dl) {
4378 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
4381 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
4383 if ($CPAN::META->has_inst("Text::Glob")) {
4384 my $rglob = Text::Glob::glob_to_regex($glob);
4385 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
4387 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
4390 $CPAN::Frontend->myprint(join "", map {
4391 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
4392 } sort { $a->[2] cmp $b->[2] } @dl);
4396 # returns an array of arrays, the latter contain (size,mtime,filename)
4397 #-> sub CPAN::Author::dir_listing ;
4400 my $chksumfile = shift;
4401 my $recursive = shift;
4402 my $may_ftp = shift;
4405 File::Spec->catfile($CPAN::Config->{keep_source_where},
4406 "authors", "id", @$chksumfile);
4410 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4411 # hazard. (Without GPG installed they are not that much better,
4413 $fh = FileHandle->new;
4414 if (open($fh, $lc_want)) {
4415 my $line = <$fh>; close $fh;
4416 unlink($lc_want) unless $line =~ /PGP/;
4420 # connect "force" argument with "index_expire".
4421 my $force = $self->{force};
4422 if (my @stat = stat $lc_want) {
4423 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4427 $lc_file = CPAN::FTP->localize(
4428 "authors/id/@$chksumfile",
4433 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4434 $chksumfile->[-1] .= ".gz";
4435 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4438 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4439 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4445 $lc_file = $lc_want;
4446 # we *could* second-guess and if the user has a file: URL,
4447 # then we could look there. But on the other hand, if they do
4448 # have a file: URL, wy did they choose to set
4449 # $CPAN::Config->{show_upload_date} to false?
4452 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4453 $fh = FileHandle->new;
4455 if (open $fh, $lc_file){
4458 $eval =~ s/\015?\012/\n/g;
4460 my($comp) = Safe->new();
4461 $cksum = $comp->reval($eval);
4463 rename $lc_file, "$lc_file.bad";
4464 Carp::confess($@) if $@;
4466 } elsif ($may_ftp) {
4467 Carp::carp "Could not open '$lc_file' for reading.";
4469 # Maybe should warn: "You may want to set show_upload_date to a true value"
4473 for $f (sort keys %$cksum) {
4474 if (exists $cksum->{$f}{isdir}) {
4476 my(@dir) = @$chksumfile;
4478 push @dir, $f, "CHECKSUMS";
4480 [$_->[0], $_->[1], "$f/$_->[2]"]
4481 } $self->dir_listing(\@dir,1,$may_ftp);
4483 push @result, [ 0, "-", $f ];
4487 ($cksum->{$f}{"size"}||0),
4488 $cksum->{$f}{"mtime"}||"---",
4496 package CPAN::Distribution;
4502 my $ro = $self->ro or return;
4506 # CPAN::Distribution::undelay
4509 delete $self->{later};
4512 # add the A/AN/ stuff
4513 # CPAN::Distribution::normalize
4516 $s = $self->id unless defined $s;
4517 if (substr($s,-1,1) eq ".") {
4519 $s = "$CPAN::iCwd/.";
4520 } elsif (File::Spec->file_name_is_absolute($s)) {
4521 } elsif (File::Spec->can("rel2abs")) {
4522 $s = File::Spec->rel2abs($s);
4524 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
4526 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4527 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
4528 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
4529 $_->{build_dir} = $s;
4530 $_->{archived} = "local_directory";
4531 $_->{unwrapped} = "local_directory";
4537 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4539 return $s if $s =~ m:^N/A|^Contact Author: ;
4540 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4541 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4542 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4547 #-> sub CPAN::Distribution::author ;
4550 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4551 CPAN::Shell->expand("Author",$authorid);
4554 # tries to get the yaml from CPAN instead of the distro itself:
4555 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4558 my $meta = $self->pretty_id;
4559 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4560 my(@ls) = CPAN::Shell->globls($meta);
4561 my $norm = $self->normalize($meta);
4565 File::Spec->catfile(
4566 $CPAN::Config->{keep_source_where},
4571 $self->debug("Doing localize") if $CPAN::DEBUG;
4572 unless ($local_file =
4573 CPAN::FTP->localize("authors/id/$norm",
4575 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4577 my $yaml = CPAN->_yaml_loadfile($local_file);
4580 #-> sub CPAN::Distribution::pretty_id
4584 return $id unless $id =~ m|^./../|;
4588 # mark as dirty/clean
4589 #-> sub CPAN::Distribution::color_cmd_tmps ;
4590 sub color_cmd_tmps {
4592 my($depth) = shift || 0;
4593 my($color) = shift || 0;
4594 my($ancestors) = shift || [];
4595 # a distribution needs to recurse into its prereq_pms
4597 return if exists $self->{incommandcolor}
4598 && $self->{incommandcolor}==$color;
4600 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4602 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4603 my $prereq_pm = $self->prereq_pm;
4604 if (defined $prereq_pm) {
4605 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
4606 keys %{$prereq_pm->{build_requires}||{}}) {
4607 next PREREQ if $pre eq "perl";
4609 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4610 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4611 $CPAN::Frontend->mysleep(2);
4614 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4618 delete $self->{sponsored_mods};
4619 delete $self->{badtestcnt};
4621 $self->{incommandcolor} = $color;
4624 #-> sub CPAN::Distribution::as_string ;
4627 $self->containsmods;
4629 $self->SUPER::as_string(@_);
4632 #-> sub CPAN::Distribution::containsmods ;
4635 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4636 my $dist_id = $self->{ID};
4637 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4638 my $mod_file = $mod->cpan_file or next;
4639 my $mod_id = $mod->{ID} or next;
4640 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4642 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4644 keys %{$self->{CONTAINSMODS}};
4647 #-> sub CPAN::Distribution::upload_date ;
4650 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4651 my(@local_wanted) = split(/\//,$self->id);
4652 my $filename = pop @local_wanted;
4653 push @local_wanted, "CHECKSUMS";
4654 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4655 return unless $author;
4656 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4658 my($dirent) = grep { $_->[2] eq $filename } @dl;
4659 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4660 return unless $dirent->[1];
4661 return $self->{UPLOAD_DATE} = $dirent->[1];
4664 #-> sub CPAN::Distribution::uptodate ;
4668 foreach $c ($self->containsmods) {
4669 my $obj = CPAN::Shell->expandany($c);
4670 unless ($obj->uptodate){
4671 my $id = $self->pretty_id;
4672 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
4679 #-> sub CPAN::Distribution::called_for ;
4682 $self->{CALLED_FOR} = $id if defined $id;
4683 return $self->{CALLED_FOR};
4686 #-> sub CPAN::Distribution::get ;
4691 exists $self->{'build_dir'} and push @e,
4692 "Is already unwrapped into directory $self->{'build_dir'}";
4693 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4695 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4698 # Get the file on local disk
4703 File::Spec->catfile(
4704 $CPAN::Config->{keep_source_where},
4707 split(/\//,$self->id)
4710 $self->debug("Doing localize") if $CPAN::DEBUG;
4711 unless ($local_file =
4712 CPAN::FTP->localize("authors/id/$self->{ID}",
4715 if ($CPAN::Index::DATE_OF_02) {
4716 $note = "Note: Current database in memory was generated ".
4717 "on $CPAN::Index::DATE_OF_02\n";
4719 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4721 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4722 $self->{localfile} = $local_file;
4723 return if $CPAN::Signal;
4728 if ($CPAN::META->has_inst("Digest::SHA")) {
4729 $self->debug("Digest::SHA is installed, verifying");
4730 $self->verifyCHECKSUM;
4732 $self->debug("Digest::SHA is NOT installed");
4734 return if $CPAN::Signal;
4737 # Create a clean room and go there
4739 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4740 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4741 $self->safe_chdir($builddir);
4742 $self->debug("Removing tmp") if $CPAN::DEBUG;
4743 File::Path::rmtree("tmp");
4744 unless (mkdir "tmp", 0755) {
4745 $CPAN::Frontend->unrecoverable_error(<<EOF);
4746 Couldn't mkdir '$builddir/tmp': $!
4748 Cannot continue: Please find the reason why I cannot make the
4751 and fix the problem, then retry.
4756 $self->safe_chdir($sub_wd);
4759 $self->safe_chdir("tmp");
4764 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4765 my $ct = CPAN::Tarzip->new($local_file);
4766 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4767 $self->{was_uncompressed}++ unless $ct->gtest();
4768 $self->untar_me($ct);
4769 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4770 $self->unzip_me($ct);
4772 $self->{was_uncompressed}++ unless $ct->gtest();
4773 $self->debug("calling pm2dir for local_file[$local_file]")
4775 $local_file = $self->handle_singlefile($local_file);
4777 # $self->{archived} = "NO";
4778 # $self->safe_chdir($sub_wd);
4782 # we are still in the tmp directory!
4783 # Let's check if the package has its own directory.
4784 my $dh = DirHandle->new(File::Spec->curdir)
4785 or Carp::croak("Couldn't opendir .: $!");
4786 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4788 my ($distdir,$packagedir);
4789 if (@readdir == 1 && -d $readdir[0]) {
4790 $distdir = $readdir[0];
4791 $packagedir = File::Spec->catdir($builddir,$distdir);
4792 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4794 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4796 File::Path::rmtree($packagedir);
4797 unless (File::Copy::move($distdir,$packagedir)) {
4798 $CPAN::Frontend->unrecoverable_error(<<EOF);
4799 Couldn't move '$distdir' to '$packagedir': $!
4801 Cannot continue: Please find the reason why I cannot move
4802 $builddir/tmp/$distdir
4805 and fix the problem, then retry
4809 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4816 my $userid = $self->cpan_userid;
4818 CPAN->debug("no userid? self[$self]");
4821 my $pragmatic_dir = $userid . '000';
4822 $pragmatic_dir =~ s/\W_//g;
4823 $pragmatic_dir++ while -d "../$pragmatic_dir";
4824 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4825 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4826 File::Path::mkpath($packagedir);
4828 for $f (@readdir) { # is already without "." and ".."
4829 my $to = File::Spec->catdir($packagedir,$f);
4830 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4834 $self->safe_chdir($sub_wd);
4838 $self->{'build_dir'} = $packagedir;
4839 $self->safe_chdir($builddir);
4840 File::Path::rmtree("tmp");
4842 $self->safe_chdir($packagedir);
4843 if ($CPAN::Config->{check_sigs}) {
4844 if ($CPAN::META->has_inst("Module::Signature")) {
4845 if (-f "SIGNATURE") {
4846 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4847 my $rv = Module::Signature::verify();
4848 if ($rv != Module::Signature::SIGNATURE_OK() and
4849 $rv != Module::Signature::SIGNATURE_MISSING()) {
4850 $CPAN::Frontend->myprint(
4851 qq{\nSignature invalid for }.
4852 qq{distribution file. }.
4853 qq{Please investigate.\n\n}.
4855 $CPAN::META->instance(
4862 sprintf(qq{I'd recommend removing %s. Its signature
4863 is invalid. Maybe you have configured your 'urllist' with
4864 a bad URL. Please check this array with 'o conf urllist', and
4865 retry. For more information, try opening a subshell with
4873 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4874 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4875 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4877 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4878 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
4881 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
4884 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4887 $self->safe_chdir($builddir);
4888 return if $CPAN::Signal;
4891 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4892 my($mpl_exists) = -f $mpl;
4893 unless ($mpl_exists) {
4894 # NFS has been reported to have racing problems after the
4895 # renaming of a directory in some environments.
4897 $CPAN::Frontend->mysleep(1);
4898 my $mpldh = DirHandle->new($packagedir)
4899 or Carp::croak("Couldn't opendir $packagedir: $!");
4900 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4903 my $prefer_installer = "eumm"; # eumm|mb
4904 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4905 if ($mpl_exists) { # they *can* choose
4906 if ($CPAN::META->has_inst("Module::Build")) {
4907 $prefer_installer = $CPAN::Config->{prefer_installer};
4910 $prefer_installer = "mb";
4913 if (lc($prefer_installer) eq "mb") {
4914 $self->{modulebuild} = 1;
4915 } elsif (! $mpl_exists) {
4916 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4920 my($configure) = File::Spec->catfile($packagedir,"Configure");
4921 if (-f $configure) {
4922 # do we have anything to do?
4923 $self->{'configure'} = $configure;
4924 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4925 $CPAN::Frontend->mywarn(qq{
4926 Package comes with a Makefile and without a Makefile.PL.
4927 We\'ll try to build it with that Makefile then.
4929 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4930 $CPAN::Frontend->mysleep(2);
4932 my $cf = $self->called_for || "unknown";
4937 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4938 $cf = "unknown" unless length($cf);
4939 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
4940 (The test -f "$mpl" returned false.)
4941 Writing one on our own (setting NAME to $cf)\a\n});
4942 $self->{had_no_makefile_pl}++;
4943 $CPAN::Frontend->mysleep(3);
4945 # Writing our own Makefile.PL
4948 if ($self->{archived} eq "maybe_pl"){
4949 my $fh = FileHandle->new;
4950 my $script_file = File::Spec->catfile($packagedir,$local_file);
4951 $fh->open($script_file)
4952 or Carp::croak("Could not open $script_file: $!");
4954 # name parsen und prereq
4955 my($state) = "poddir";
4956 my($name, $prereq) = ("", "");
4958 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
4961 } elsif ($1 eq 'PREREQUISITES') {
4964 } elsif ($state =~ m{^(name|prereq)$}) {
4969 } elsif ($state eq "name") {
4974 } elsif ($state eq "prereq") {
4977 } elsif (/^=cut\b/) {
4984 s{.*<}{}; # strip X<...>
4988 $prereq = join " ", split /\s+/, $prereq;
4989 my($PREREQ_PM) = join("\n", map {
4990 s{.*<}{}; # strip X<...>
4992 if (/[\s\'\"]/) { # prose?
4994 s/[^\w:]$//; # period?
4995 " "x28 . "'$_' => 0,";
4997 } split /\s*,\s*/, $prereq);
5000 EXE_FILES => ['$name'],
5006 my $to_file = File::Spec->catfile($packagedir, $name);
5007 rename $script_file, $to_file
5008 or die "Can't rename $script_file to $to_file: $!";
5011 my $fh = FileHandle->new;
5013 or Carp::croak("Could not open >$mpl: $!");
5015 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
5016 # because there was no Makefile.PL supplied.
5017 # Autogenerated on: }.scalar localtime().qq{
5019 use ExtUtils::MakeMaker;
5021 NAME => q[$cf],$script
5031 # CPAN::Distribution::untar_me ;
5034 $self->{archived} = "tar";
5036 $self->{unwrapped} = "YES";
5038 $self->{unwrapped} = "NO";
5042 # CPAN::Distribution::unzip_me ;
5045 $self->{archived} = "zip";
5047 $self->{unwrapped} = "YES";
5049 $self->{unwrapped} = "NO";
5054 sub handle_singlefile {
5055 my($self,$local_file) = @_;
5057 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
5058 $self->{archived} = "pm";
5060 $self->{archived} = "maybe_pl";
5063 my $to = File::Basename::basename($local_file);
5064 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
5065 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
5066 $self->{unwrapped} = "YES";
5068 $self->{unwrapped} = "NO";
5071 File::Copy::cp($local_file,".");
5072 $self->{unwrapped} = "YES";
5077 #-> sub CPAN::Distribution::new ;
5079 my($class,%att) = @_;
5081 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
5083 my $this = { %att };
5084 return bless $this, $class;
5087 #-> sub CPAN::Distribution::look ;
5091 if ($^O eq 'MacOS') {
5092 $self->Mac::BuildTools::look;
5096 if ( $CPAN::Config->{'shell'} ) {
5097 $CPAN::Frontend->myprint(qq{
5098 Trying to open a subshell in the build directory...
5101 $CPAN::Frontend->myprint(qq{
5102 Your configuration does not define a value for subshells.
5103 Please define it with "o conf shell <your shell>"
5107 my $dist = $self->id;
5109 unless ($dir = $self->dir) {
5112 unless ($dir ||= $self->dir) {
5113 $CPAN::Frontend->mywarn(qq{
5114 Could not determine which directory to use for looking at $dist.
5118 my $pwd = CPAN::anycwd();
5119 $self->safe_chdir($dir);
5120 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5122 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
5123 $ENV{CPAN_SHELL_LEVEL} += 1;
5124 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
5125 unless (system($shell) == 0) {
5127 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
5130 $self->safe_chdir($pwd);
5133 # CPAN::Distribution::cvs_import ;
5137 my $dir = $self->dir;
5139 my $package = $self->called_for;
5140 my $module = $CPAN::META->instance('CPAN::Module', $package);
5141 my $version = $module->cpan_version;
5143 my $userid = $self->cpan_userid;
5145 my $cvs_dir = (split /\//, $dir)[-1];
5146 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
5148 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
5150 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
5151 if ($cvs_site_perl) {
5152 $cvs_dir = "$cvs_site_perl/$cvs_dir";
5154 my $cvs_log = qq{"imported $package $version sources"};
5155 $version =~ s/\./_/g;
5156 # XXX cvs: undocumented and unclear how it was meant to work
5157 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
5158 "$cvs_dir", $userid, "v$version");
5160 my $pwd = CPAN::anycwd();
5161 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
5163 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
5165 $CPAN::Frontend->myprint(qq{@cmd\n});
5166 system(@cmd) == 0 or
5168 $CPAN::Frontend->mydie("cvs import failed");
5169 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
5172 #-> sub CPAN::Distribution::readme ;
5175 my($dist) = $self->id;
5176 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
5177 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
5180 File::Spec->catfile(
5181 $CPAN::Config->{keep_source_where},
5184 split(/\//,"$sans.readme"),
5186 $self->debug("Doing localize") if $CPAN::DEBUG;
5187 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
5189 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
5191 if ($^O eq 'MacOS') {
5192 Mac::BuildTools::launch_file($local_file);
5196 my $fh_pager = FileHandle->new;
5197 local($SIG{PIPE}) = "IGNORE";
5198 my $pager = $CPAN::Config->{'pager'} || "cat";
5199 $fh_pager->open("|$pager")
5200 or die "Could not open pager $pager\: $!";
5201 my $fh_readme = FileHandle->new;
5202 $fh_readme->open($local_file)
5203 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
5204 $CPAN::Frontend->myprint(qq{
5209 $fh_pager->print(<$fh_readme>);
5213 #-> sub CPAN::Distribution::verifyCHECKSUM ;
5214 sub verifyCHECKSUM {
5218 $self->{CHECKSUM_STATUS} ||= "";
5219 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
5220 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5222 my($lc_want,$lc_file,@local,$basename);
5223 @local = split(/\//,$self->id);
5225 push @local, "CHECKSUMS";
5227 File::Spec->catfile($CPAN::Config->{keep_source_where},
5228 "authors", "id", @local);
5230 if (my $size = -s $lc_want) {
5231 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
5232 if ($self->CHECKSUM_check_file($lc_want,1)) {
5233 return $self->{CHECKSUM_STATUS} = "OK";
5236 $lc_file = CPAN::FTP->localize("authors/id/@local",
5239 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5240 $local[-1] .= ".gz";
5241 $lc_file = CPAN::FTP->localize("authors/id/@local",
5244 $lc_file =~ s/\.gz(?!\n)\Z//;
5245 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
5250 if ($self->CHECKSUM_check_file($lc_file)) {
5251 return $self->{CHECKSUM_STATUS} = "OK";
5255 #-> sub CPAN::Distribution::SIG_check_file ;
5256 sub SIG_check_file {
5257 my($self,$chk_file) = @_;
5258 my $rv = eval { Module::Signature::_verify($chk_file) };
5260 if ($rv == Module::Signature::SIGNATURE_OK()) {
5261 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
5262 return $self->{SIG_STATUS} = "OK";
5264 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
5265 qq{distribution file. }.
5266 qq{Please investigate.\n\n}.
5268 $CPAN::META->instance(
5273 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
5274 is invalid. Maybe you have configured your 'urllist' with
5275 a bad URL. Please check this array with 'o conf urllist', and
5278 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5282 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
5284 # sloppy is 1 when we have an old checksums file that maybe is good
5287 sub CHECKSUM_check_file {
5288 my($self,$chk_file,$sloppy) = @_;
5289 my($cksum,$file,$basename);
5292 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
5293 if ($CPAN::Config->{check_sigs}) {
5294 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
5295 $self->debug("Module::Signature is installed, verifying");
5296 $self->SIG_check_file($chk_file);
5298 $self->debug("Module::Signature is NOT installed");
5302 $file = $self->{localfile};
5303 $basename = File::Basename::basename($file);
5304 my $fh = FileHandle->new;
5305 if (open $fh, $chk_file){
5308 $eval =~ s/\015?\012/\n/g;
5310 my($comp) = Safe->new();
5311 $cksum = $comp->reval($eval);
5313 rename $chk_file, "$chk_file.bad";
5314 Carp::confess($@) if $@;
5317 Carp::carp "Could not open $chk_file for reading";
5320 if (! ref $cksum or ref $cksum ne "HASH") {
5321 $CPAN::Frontend->mywarn(qq{
5322 Warning: checksum file '$chk_file' broken.
5324 When trying to read that file I expected to get a hash reference
5325 for further processing, but got garbage instead.
5327 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
5328 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5329 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
5331 } elsif (exists $cksum->{$basename}{sha256}) {
5332 $self->debug("Found checksum for $basename:" .
5333 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
5337 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
5339 $fh = CPAN::Tarzip->TIEHANDLE($file);
5342 my $dg = Digest::SHA->new(256);
5345 while ($fh->READ($ref, 4096) > 0){
5348 my $hexdigest = $dg->hexdigest;
5349 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
5353 $CPAN::Frontend->myprint("Checksum for $file ok\n");
5354 return $self->{CHECKSUM_STATUS} = "OK";
5356 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
5357 qq{distribution file. }.
5358 qq{Please investigate.\n\n}.
5360 $CPAN::META->instance(
5365 my $wrap = qq{I\'d recommend removing $file. Its
5366 checksum is incorrect. Maybe you have configured your 'urllist' with
5367 a bad URL. Please check this array with 'o conf urllist', and
5370 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
5372 # former versions just returned here but this seems a
5373 # serious threat that deserves a die
5375 # $CPAN::Frontend->myprint("\n\n");
5379 # close $fh if fileno($fh);
5382 unless ($self->{CHECKSUM_STATUS}) {
5383 $CPAN::Frontend->mywarn(qq{
5384 Warning: No checksum for $basename in $chk_file.
5386 The cause for this may be that the file is very new and the checksum
5387 has not yet been calculated, but it may also be that something is
5388 going awry right now.
5390 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
5391 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
5393 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
5398 #-> sub CPAN::Distribution::eq_CHECKSUM ;
5400 my($self,$fh,$expect) = @_;
5401 if ($CPAN::META->has_inst("Digest::SHA")) {
5402 my $dg = Digest::SHA->new(256);
5404 while (read($fh, $data, 4096)){
5407 my $hexdigest = $dg->hexdigest;
5408 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
5409 return $hexdigest eq $expect;
5414 #-> sub CPAN::Distribution::force ;
5416 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
5417 # effect by autoinspection, not by inspecting a global variable. One
5418 # of the reason why this was chosen to work that way was the treatment
5419 # of dependencies. They should not automatically inherit the force
5420 # status. But this has the downside that ^C and die() will return to
5421 # the prompt but will not be able to reset the force_update
5422 # attributes. We try to correct for it currently in the read_metadata
5423 # routine, and immediately before we check for a Signal. I hope this
5424 # works out in one of v1.57_53ff
5426 # "Force get forgets previous error conditions"
5428 #-> sub CPAN::Distribution::force ;
5430 my($self, $method) = @_;
5447 delete $self->{$att};
5448 CPAN->debug(sprintf "att[%s]", $att) if $CPAN::DEBUG;
5450 if ($method && $method =~ /make|test|install/) {
5451 $self->{"force_update"}++; # name should probably have been force_install
5456 my($self, $method) = @_;
5457 # warn "XDEBUG: set notest for $self $method";
5458 $self->{"notest"}++; # name should probably have been force_install
5463 # warn "XDEBUG: deleting notest";
5464 delete $self->{'notest'};
5467 #-> sub CPAN::Distribution::unforce ;
5470 delete $self->{'force_update'};
5473 #-> sub CPAN::Distribution::isa_perl ;
5476 my $file = File::Basename::basename($self->id);
5477 if ($file =~ m{ ^ perl
5490 } elsif ($self->cpan_comment
5492 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5498 #-> sub CPAN::Distribution::perl ;
5503 carp __PACKAGE__ . "::perl was called without parameters.";
5505 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
5509 #-> sub CPAN::Distribution::make ;
5512 my $make = $self->{modulebuild} ? "Build" : "make";
5513 # Emergency brake if they said install Pippi and get newest perl
5514 if ($self->isa_perl) {
5516 $self->called_for ne $self->id &&
5517 ! $self->{force_update}
5519 # if we die here, we break bundles
5522 qq{The most recent version "%s" of the module "%s"
5523 is part of the perl-%s distribution. To install that, you need to run
5524 force install %s --or--
5527 $CPAN::META->instance(
5536 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
5537 $CPAN::Frontend->mysleep(1);
5541 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5544 delete $self->{force_update};
5549 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5550 "Is neither a tar nor a zip archive.";
5552 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5553 "Had problems unarchiving. Please build manually";
5555 unless ($self->{force_update}) {
5556 exists $self->{signature_verify} and (
5557 $self->{signature_verify}->can("failed") ?
5558 $self->{signature_verify}->failed :
5559 $self->{signature_verify} =~ /^NO/
5561 and push @e, "Did not pass the signature test.";
5564 if (exists $self->{writemakefile} &&
5566 $self->{writemakefile}->can("failed") ?
5567 $self->{writemakefile}->failed :
5568 $self->{writemakefile} =~ /^NO/
5570 # XXX maybe a retry would be in order?
5571 my $err = $self->{writemakefile}->can("text") ?
5572 $self->{writemakefile}->text :
5573 $self->{writemakefile};
5575 $err ||= "Had some problem writing Makefile";
5576 $err .= ", won't make";
5580 defined $self->{make} and push @e,
5581 "Has already been processed within this session";
5583 if (exists $self->{later} and length($self->{later})) {
5584 if ($self->unsat_prereq) {
5585 push @e, $self->{later};
5586 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
5587 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
5588 # are not sufficient to be sure if we really must/may do the delete
5589 # here. SO I accept the suggested patch for now. If we trigger a bug
5590 # again, I must go into deep contemplation about the {later} flag.
5593 # delete $self->{later};
5597 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5600 delete $self->{force_update};
5603 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5604 my $builddir = $self->dir or
5605 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
5606 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5607 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5609 if ($^O eq 'MacOS') {
5610 Mac::BuildTools::make($self);
5615 if ($self->{'configure'}) {
5616 $system = $self->{'configure'};
5617 } elsif ($self->{modulebuild}) {
5618 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5619 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5621 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5623 # This needs a handler that can be turned on or off:
5624 # $switch = "-MExtUtils::MakeMaker ".
5625 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5627 my $makepl_arg = $self->make_x_arg("pl");
5628 $system = sprintf("%s%s Makefile.PL%s",
5630 $switch ? " $switch" : "",
5631 $makepl_arg ? " $makepl_arg" : "",
5635 if (my $env = $self->prefs->{pl}{env}) {
5636 for my $e (keys %$env) {
5637 $ENV{$e} = $env->{$e};
5640 if (exists $self->{writemakefile}) {
5642 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5646 if ($CPAN::Config->{inactivity_timeout}) {
5648 if ($Config::Config{d_alarm}
5650 $Config::Config{d_alarm} eq "define"
5654 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
5655 "variable 'inactivity_timeout' to ".
5656 "'$CPAN::Config->{inactivity_timeout}'. But ".
5657 "on this machine the system call 'alarm' ".
5658 "isn't available. This means that we cannot ".
5659 "provide the feature of intercepting long ".
5660 "waiting code and will turn this feature off.\n"
5662 $CPAN::Config->{inactivity_timeout} = 0;
5665 if ($go_via_alarm) {
5667 alarm $CPAN::Config->{inactivity_timeout};
5668 local $SIG{CHLD}; # = sub { wait };
5669 if (defined($pid = fork)) {
5674 # note, this exec isn't necessary if
5675 # inactivity_timeout is 0. On the Mac I'd
5676 # suggest, we set it always to 0.
5680 $CPAN::Frontend->myprint("Cannot fork: $!");
5689 $CPAN::Frontend->myprint($err);
5690 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
5695 if (my $expect = $self->prefs->{pl}{expect}) {
5696 $ret = $self->run_via_expect($system,$expect);
5698 $ret = system($system);
5701 $self->{writemakefile} = CPAN::Distrostatus
5702 ->new("NO '$system' returned status $ret");
5703 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
5707 if (-f "Makefile" || -f "Build") {
5708 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5709 delete $self->{make_clean}; # if cleaned before, enable next
5711 $self->{writemakefile} = CPAN::Distrostatus
5712 ->new(qq{NO -- Unknown reason.});
5716 delete $self->{force_update};
5719 if (my @prereq = $self->unsat_prereq){
5720 if ($prereq[0][0] eq "perl") {
5721 my $need = "requires perl '$prereq[0][1]'";
5722 my $id = $self->pretty_id;
5723 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
5724 $self->{make} = CPAN::Distrostatus->new("NO $need");
5727 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5731 delete $self->{force_update};
5734 if ($self->{modulebuild}) {
5735 unless (-f "Build") {
5737 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
5738 " in cwd[$cwd]. Danger, Will Robinson!");
5739 $CPAN::Frontend->mysleep(5);
5741 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5743 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
5745 my $make_arg = $self->make_x_arg("make");
5746 $system = sprintf("%s%s",
5748 $make_arg ? " $make_arg" : "",
5750 if (my $env = $self->prefs->{make}{env}) { # overriding the local
5751 # ENV of PL, not the
5753 # unlikely to be a risk
5754 for my $e (keys %$env) {
5755 $ENV{$e} = $env->{$e};
5758 if (system($system) == 0) {
5759 $CPAN::Frontend->myprint(" $system -- OK\n");
5760 $self->{make} = CPAN::Distrostatus->new("YES");
5762 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5763 $self->{make} = CPAN::Distrostatus->new("NO");
5764 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
5768 # CPAN::Distribution::run_via_expect
5769 sub run_via_expect {
5770 my($self,$system,$expect) = @_;
5771 CPAN->debug("system[$system]expect[$expect]") if $CPAN::DEBUG;
5772 if ($CPAN::META->has_inst("Expect")) {
5773 my $expo = Expect->new;
5774 $expo->spawn($system);
5775 EXPECT: for (my $i = 0; $i < $#$expect; $i+=2) {
5776 my $regex = eval "qr{$expect->[$i]}";
5777 my $send = $expect->[$i+1];
5780 my $but = $expo->clear_accum;
5781 $CPAN::Frontend->mywarn("EOF (maybe harmless) system[$system]
5782 expected[$regex]\nbut[$but]\n\n");
5786 my $but = $expo->clear_accum;
5787 $CPAN::Frontend->mydie("TIMEOUT system[$system]
5788 expected[$regex]\nbut[$but]\n\n");
5794 return $expo->exitstatus();
5796 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
5797 return system($system);
5801 # CPAN::Distribution::_find_prefs
5803 my($self,$distro) = @_;
5804 my $distroid = $distro->pretty_id;
5805 CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
5806 my $prefs_dir = $CPAN::Config->{prefs_dir};
5807 eval { File::Path::mkpath($prefs_dir); };
5809 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
5811 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
5812 if ($CPAN::META->has_inst($yaml_module)) {
5813 my $dh = DirHandle->new($prefs_dir)
5814 or die Carp::croak("Couldn't open '$prefs_dir': $!");
5815 DIRENT: for (sort $dh->read) {
5816 next if $_ eq "." || $_ eq "..";
5817 next unless /\.yml$/;
5818 my $abs = File::Spec->catfile($prefs_dir, $_);
5819 # CPAN->debug("abs[$abs]") if $CPAN::DEBUG;
5821 my $yaml = CPAN->_yaml_loadfile($abs);
5823 my $match = $yaml->{match} or
5824 $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
5825 "missing attribut 'match'. Please ".
5826 "remove, cannot continue.");
5827 for my $sub_attribute (keys %$match) {
5828 my $qr = eval "qr{$yaml->{match}{$sub_attribute}}";
5829 if ($sub_attribute eq "module") {
5831 my @modules = $distro->containsmods;
5832 for my $module (@modules) {
5833 $okm ||= $module =~ /$qr/;
5837 } elsif ($sub_attribute eq "distribution") {
5838 my $okd = $distroid =~ /$qr/;
5841 $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
5842 "unknown sub_attribut '$sub_attribute'. ".
5844 "remove, cannot continue.");
5856 unless ($self->{have_complained_about_missing_yaml}++) {
5857 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot read prefs '$prefs_dir'\n");
5863 # CPAN::Distribution::prefs
5866 if (exists $self->{prefs}) {
5867 return $self->{prefs}; # XXX comment out during debugging
5869 if ($CPAN::Config->{prefs_dir}) {
5870 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
5871 my $prefs = $self->_find_prefs($self);
5873 for my $x (qw(prefs prefs_file)) {
5874 $self->{$x} = $prefs->{$x};
5876 my $basename = File::Basename::basename($self->{prefs_file});
5877 my $filler1 = "_" x 22;
5878 my $filler2 = int(66 - length($basename))/2;
5879 $filler2 = 0 if $filler2 < 0;
5880 $filler2 = " " x $filler2;
5881 $CPAN::Frontend->myprint("
5882 $filler1 D i s t r o P r e f s $filler1
5883 $filler2 $basename $filler2
5885 $CPAN::Frontend->mysleep(1);
5886 return $self->{prefs};
5892 # CPAN::Distribution::make_x_arg
5894 my($self, $whixh) = @_;
5896 my $prefs = $self->prefs;
5899 && exists $prefs->{$whixh}
5900 && exists $prefs->{$whixh}{args}
5901 && $prefs->{$whixh}{args}
5903 $make_x_arg = join(" ",
5904 map {CPAN::HandleConfig
5905 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
5908 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
5909 $make_x_arg ||= $CPAN::Config->{$what};
5913 # CPAN::Distribution::_make_command
5920 $self->prefs->{cpanconfig}{make}
5921 || $CPAN::Config->{make}
5922 || $Config::Config{make}
5926 # Old style call, without object. Deprecated
5927 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
5930 $self->prefs->{cpanconfig}{make}
5931 || $CPAN::Config->{make}
5932 || $Config::Config{make}
5937 #-> sub CPAN::Distribution::follow_prereqs ;
5938 sub follow_prereqs {
5940 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
5941 return unless @prereq_tuples;
5942 my @prereq = map { $_->[0] } @prereq_tuples;
5945 b => "build_requires",
5950 myprint("---- Unsatisfied dependencies detected during\n".
5952 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
5955 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5957 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5958 my $answer = CPAN::Shell::colorable_makemaker_prompt(
5959 "Shall I follow them and prepend them to the queue
5960 of modules we are processing right now?", "yes");
5961 $follow = $answer =~ /^\s*y/i;
5965 myprint(" Ignoring dependencies on modules @prereq\n");
5968 # color them as dirty
5969 for my $p (@prereq) {
5970 # warn "calling color_cmd_tmps(0,1)";
5971 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5973 # queue them and re-queue yourself
5974 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
5975 reverse @prereq_tuples);
5976 $self->{later} = "Delayed until after prerequisites";
5977 return 1; # signal success to the queuerunner
5981 #-> sub CPAN::Distribution::unsat_prereq ;
5982 # return ([Foo=>1],[Bar=>1.2]) for normal modules
5983 # return ([perl=>5.008]) if we need a newer perl than we are running under
5986 my $prereq_pm = $self->prereq_pm or return;
5988 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
5989 NEED: while (my($need_module, $need_version) = each %merged) {
5990 my($have_version,$inst_file);
5991 if ($need_module eq "perl") {
5995 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5996 next if $nmo->uptodate;
5997 $inst_file = $nmo->inst_file;
5999 # if they have not specified a version, we accept any installed one
6000 if (not defined $need_version or
6001 $need_version eq "0" or
6002 $need_version eq "undef") {
6003 next if defined $inst_file;
6006 $have_version = $nmo->inst_version;
6009 # We only want to install prereqs if either they're not installed
6010 # or if the installed version is too old. We cannot omit this
6011 # check, because if 'force' is in effect, nobody else will check.
6012 if (defined $inst_file) {
6013 my(@all_requirements) = split /\s*,\s*/, $need_version;
6016 RQ: for my $rq (@all_requirements) {
6017 if ($rq =~ s|>=\s*||) {
6018 } elsif ($rq =~ s|>\s*||) {
6020 if (CPAN::Version->vgt($have_version,$rq)){
6024 } elsif ($rq =~ s|!=\s*||) {
6026 if (CPAN::Version->vcmp($have_version,$rq)){
6032 } elsif ($rq =~ m|<=?\s*|) {
6034 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
6038 if (! CPAN::Version->vgt($rq, $have_version)){
6041 CPAN->debug(sprintf("need_module[%s]inst_file[%s]".
6042 "inst_version[%s]rq[%s]ok[%d]",
6046 CPAN::Version->readable($rq),
6050 next NEED if $ok == @all_requirements;
6053 if ($need_module eq "perl") {
6054 return ["perl", $need_version];
6056 if ($self->{sponsored_mods}{$need_module}++){
6057 # We have already sponsored it and for some reason it's still
6058 # not available. So we do nothing. Or what should we do?
6059 # if we push it again, we have a potential infinite loop
6062 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
6063 push @need, [$need_module,$needed_as];
6068 #-> sub CPAN::Distribution::read_yaml ;
6071 return $self->{yaml_content} if exists $self->{yaml_content};
6072 my $build_dir = $self->{build_dir};
6073 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6074 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6075 return unless -f $yaml;
6076 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml); };
6078 return; # if we die, then we cannot read our own META.yml
6080 if (not exists $self->{yaml_content}{dynamic_config}
6081 or $self->{yaml_content}{dynamic_config}
6083 $self->{yaml_content} = undef;
6085 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
6087 return $self->{yaml_content};
6090 #-> sub CPAN::Distribution::prereq_pm ;
6093 return $self->{prereq_pm} if
6094 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
6095 return unless $self->{writemakefile} # no need to have succeeded
6096 # but we must have run it
6097 || $self->{modulebuild};
6099 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
6100 $req = $yaml->{requires} || {};
6101 $breq = $yaml->{build_requires} || {};
6102 undef $req unless ref $req eq "HASH" && %$req;
6104 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
6105 my $eummv = do { local $^W = 0; $1+0; };
6106 if ($eummv < 6.2501) {
6107 # thanks to Slaven for digging that out: MM before
6108 # that could be wrong because it could reflect a
6115 while (my($k,$v) = each %{$req||{}}) {
6118 } elsif ($k =~ /[A-Za-z]/ &&
6120 $CPAN::META->exists("Module",$v)
6122 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
6123 "requires hash: $k => $v; I'll take both ".
6124 "key and value as a module name\n");
6125 $CPAN::Frontend->mysleep(1);
6131 $req = $areq if $do_replace;
6134 unless ($req || $breq) {
6135 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
6136 my $makefile = File::Spec->catfile($build_dir,"Makefile");
6140 $fh = FileHandle->new("<$makefile\0")) {
6143 last if /MakeMaker post_initialize section/;
6145 \s+PREREQ_PM\s+=>\s+(.+)
6148 # warn "Found prereq expr[$p]";
6150 # Regexp modified by A.Speer to remember actual version of file
6151 # PREREQ_PM hash key wants, then add to
6152 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
6153 # In case a prereq is mentioned twice, complain.
6154 if ( defined $req->{$1} ) {
6155 warn "Warning: PREREQ_PM mentions $1 more than once, ".
6156 "last mention wins";
6162 } elsif (-f "Build") {
6163 if ($CPAN::META->has_inst("Module::Build")) {
6165 $req = Module::Build->current->requires();
6166 $breq = Module::Build->current->build_requires();
6169 # HTML::Mason prompted for this with bleadperl@28900 or so
6172 sprintf("Warning: while trying to determine ".
6173 "prerequisites for %s with the help of ".
6174 "Module::Build the following error ".
6175 "occurred: '%s'\n\nCannot care for prerequisites\n",
6179 $self->{prereq_pm_detected}++;
6180 return $self->{prereq_pm} = {requires=>{},build_requires=>{}};
6186 && ! -f "Makefile.PL"
6187 && ! exists $req->{"Module::Build"}
6188 && ! $CPAN::META->has_inst("Module::Build")) {
6189 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
6190 "undeclared prerequisite.\n".
6191 " Adding it now as such.\n"
6193 $CPAN::Frontend->mysleep(5);
6194 $req->{"Module::Build"} = 0;
6195 delete $self->{writemakefile};
6197 $self->{prereq_pm_detected}++;
6198 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
6201 #-> sub CPAN::Distribution::test ;
6206 delete $self->{force_update};
6209 # warn "XDEBUG: checking for notest: $self->{notest} $self";
6210 if ($self->{notest}) {
6211 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
6215 my $make = $self->{modulebuild} ? "Build" : "make";
6216 $CPAN::Frontend->myprint("Running $make test\n");
6217 if (my @prereq = $self->unsat_prereq){
6218 unless ($prereq[0][0] eq "perl") {
6219 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6224 unless (exists $self->{make} or exists $self->{later}) {
6226 "Make had some problems, won't test";
6229 exists $self->{make} and
6231 $self->{make}->can("failed") ?
6232 $self->{make}->failed :
6233 $self->{make} =~ /^NO/
6234 ) and push @e, "Can't test without successful make";
6236 $self->{badtestcnt} ||= 0;
6237 $self->{badtestcnt} > 0 and
6238 push @e, "Won't repeat unsuccessful test during this command";
6240 exists $self->{later} and length($self->{later}) and
6241 push @e, $self->{later};
6243 if (exists $self->{build_dir}) {
6244 if ($CPAN::META->{is_tested}{$self->{build_dir}}
6246 exists $self->{make_test}
6249 $self->{make_test}->can("failed") ?
6250 $self->{make_test}->failed :
6251 $self->{make_test} =~ /^NO/
6254 push @e, "Already tested successfully";
6257 push @e, "Has no own directory";
6260 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6262 chdir $self->{'build_dir'} or
6263 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6264 $self->debug("Changed directory to $self->{'build_dir'}")
6267 if ($^O eq 'MacOS') {
6268 Mac::BuildTools::make_test($self);
6272 if ($self->{modulebuild}) {
6273 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
6274 if (CPAN::Version->vlt($v,2.62)) {
6275 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
6276 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
6277 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
6282 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6284 : ($ENV{PERLLIB} || "");
6286 $CPAN::META->set_perl5lib;
6287 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6290 if ($self->{modulebuild}) {
6291 $system = sprintf "%s test", $self->_build_command();
6293 $system = join " ", $self->_make_command(), "test";
6296 # XXX fix unini warnings
6298 if (my $env = $self->prefs->{test}{env}) {
6299 for my $e (keys %$env) {
6300 $ENV{$e} = $env->{$e};
6303 my $expect = $self->prefs->{test}{expect};
6304 if ($expect && @$expect) {
6305 $tests_ok = $self->run_via_expect($system,$expect) == 0;
6306 } elsif ( $CPAN::Config->{test_report} &&
6307 $CPAN::META->has_inst("CPAN::Reporter") ) {
6308 $tests_ok = CPAN::Reporter::test($self, $system);
6310 $tests_ok = system($system) == 0;
6315 for my $m (keys %{$self->{sponsored_mods}}) {
6316 my $m_obj = CPAN::Shell->expand("Module",$m);
6317 my $d_obj = $m_obj->distribution;
6319 if (!$d_obj->{make_test}
6321 $d_obj->{make_test}->failed){
6329 my $which = join ",", @prereq;
6330 my $verb = $cnt == 1 ? "one dependency not OK ($which)" :
6331 "$cnt dependencies missing ($which)";
6332 $CPAN::Frontend->mywarn("Tests succeeded but $verb\n");
6333 $self->{make_test} = CPAN::Distrostatus->new("NO -- $verb");
6338 $CPAN::Frontend->myprint(" $system -- OK\n");
6339 $CPAN::META->is_tested($self->{'build_dir'});
6340 $self->{make_test} = CPAN::Distrostatus->new("YES");
6342 $self->{make_test} = CPAN::Distrostatus->new("NO");
6343 $self->{badtestcnt}++;
6344 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6348 #-> sub CPAN::Distribution::clean ;
6351 my $make = $self->{modulebuild} ? "Build" : "make";
6352 $CPAN::Frontend->myprint("Running $make clean\n");
6353 unless (exists $self->{archived}) {
6354 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
6355 "/untarred, nothing done\n");
6358 unless (exists $self->{build_dir}) {
6359 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
6364 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
6365 push @e, "make clean already called once";
6366 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6368 chdir $self->{'build_dir'} or
6369 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6370 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
6372 if ($^O eq 'MacOS') {
6373 Mac::BuildTools::make_clean($self);
6378 if ($self->{modulebuild}) {
6379 unless (-f "Build") {
6381 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
6382 " in cwd[$cwd]. Danger, Will Robinson!");
6383 $CPAN::Frontend->mysleep(5);
6385 $system = sprintf "%s clean", $self->_build_command();
6387 $system = join " ", $self->_make_command(), "clean";
6389 if (system($system) == 0) {
6390 $CPAN::Frontend->myprint(" $system -- OK\n");
6394 # Jost Krieger pointed out that this "force" was wrong because
6395 # it has the effect that the next "install" on this distribution
6396 # will untar everything again. Instead we should bring the
6397 # object's state back to where it is after untarring.
6408 $self->{make_clean} = CPAN::Distrostatus->new("YES");
6411 # Hmmm, what to do if make clean failed?
6413 $self->{make_clean} = CPAN::Distrostatus->new("NO");
6414 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
6416 # 2006-02-27: seems silly to me to force a make now
6417 # $self->force("make"); # so that this directory won't be used again
6422 #-> sub CPAN::Distribution::install ;
6427 delete $self->{force_update};
6430 my $make = $self->{modulebuild} ? "Build" : "make";
6431 $CPAN::Frontend->myprint("Running $make install\n");
6434 unless (exists $self->{make} or exists $self->{later}) {
6436 "Make had some problems, won't install";
6439 exists $self->{make} and
6441 $self->{make}->can("failed") ?
6442 $self->{make}->failed :
6443 $self->{make} =~ /^NO/
6445 push @e, "Make had returned bad status, install seems impossible";
6447 if (exists $self->{build_dir}) {
6449 push @e, "Has no own directory";
6452 if (exists $self->{make_test} and
6454 $self->{make_test}->can("failed") ?
6455 $self->{make_test}->failed :
6456 $self->{make_test} =~ /^NO/
6458 if ($self->{force_update}) {
6459 $self->{make_test}->text("FAILED but failure ignored because ".
6460 "'force' in effect");
6462 push @e, "make test had returned bad status, ".
6463 "won't install without force"
6466 if (exists $self->{'install'}) {
6467 if ($self->{'install'}->can("text") ?
6468 $self->{'install'}->text eq "YES" :
6469 $self->{'install'} =~ /^YES/
6471 push @e, "Already done";
6473 # comment in Todo on 2006-02-11; maybe retry?
6474 push @e, "Already tried without success";
6478 exists $self->{later} and length($self->{later}) and
6479 push @e, $self->{later};
6481 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6483 chdir $self->{'build_dir'} or
6484 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
6485 $self->debug("Changed directory to $self->{'build_dir'}")
6488 if ($^O eq 'MacOS') {
6489 Mac::BuildTools::make_install($self);
6494 if ($self->{modulebuild}) {
6495 my($mbuild_install_build_command) =
6496 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
6497 $CPAN::Config->{mbuild_install_build_command} ?
6498 $CPAN::Config->{mbuild_install_build_command} :
6499 $self->_build_command();
6500 $system = sprintf("%s install %s",
6501 $mbuild_install_build_command,
6502 $CPAN::Config->{mbuild_install_arg},
6505 my($make_install_make_command) =
6506 $self->prefs->{cpanconfig}{make_install_make_command}
6507 || $CPAN::Config->{make_install_make_command}
6508 || $self->_make_command();
6509 $system = sprintf("%s install %s",
6510 $make_install_make_command,
6511 $CPAN::Config->{make_install_arg},
6515 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
6516 my $brip = $self->prefs->{cpanconfig}{build_requires_install_policy};
6517 $brip ||= $CPAN::Config->{build_requires_install_policy};
6520 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
6521 my $want_install = "yes";
6522 if ($reqtype eq "b") {
6523 if ($brip eq "no") {
6524 $want_install = "no";
6525 } elsif ($brip =~ m|^ask/(.+)|) {
6527 $default = "yes" unless $default =~ /^(y|n)/i;
6529 CPAN::Shell::colorable_makemaker_prompt
6530 ("$id is just needed temporarily during building or testing. ".
6531 "Do you want to install it permanently? (Y/n)",
6535 unless ($want_install =~ /^y/i) {
6536 my $is_only = "is only 'build_requires'";
6537 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
6538 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
6539 delete $self->{force_update};
6542 my($pipe) = FileHandle->new("$system $stderr |");
6545 print $_; # intentionally NOT use Frontend->myprint because it
6546 # looks irritating when we markup in color what we
6547 # just pass through from an external program
6552 $CPAN::Frontend->myprint(" $system -- OK\n");
6553 $CPAN::META->is_installed($self->{build_dir});
6554 return $self->{install} = CPAN::Distrostatus->new("YES");
6556 $self->{install} = CPAN::Distrostatus->new("NO");
6557 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
6559 $self->prefs->{cpanconfig}{make_install_make_command} ||
6560 $CPAN::Config->{make_install_make_command};
6562 $makeout =~ /permission/s
6566 || $mimc eq ($self->prefs->{cpanconfig}{make}
6567 || $CPAN::Config->{make})
6570 $CPAN::Frontend->myprint(
6572 qq{ You may have to su }.
6573 qq{to root to install the package\n}.
6574 qq{ (Or you may want to run something like\n}.
6575 qq{ o conf make_install_make_command 'sudo make'\n}.
6576 qq{ to raise your permissions.}
6580 delete $self->{force_update};
6583 #-> sub CPAN::Distribution::dir ;
6585 shift->{'build_dir'};
6588 #-> sub CPAN::Distribution::perldoc ;
6592 my($dist) = $self->id;
6593 my $package = $self->called_for;
6595 $self->_display_url( $CPAN::Defaultdocs . $package );
6598 #-> sub CPAN::Distribution::_check_binary ;
6600 my ($dist,$shell,$binary) = @_;
6603 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
6607 $pid = open README, "which $binary|"
6608 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
6612 close README or die "Could not run 'which $binary': $!";
6614 $CPAN::Frontend->myprint(qq{ + $out \n})
6615 if $CPAN::DEBUG && $out;
6620 #-> sub CPAN::Distribution::_display_url ;
6622 my($self,$url) = @_;
6623 my($res,$saved_file,$pid,$out);
6625 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
6628 # should we define it in the config instead?
6629 my $html_converter = "html2text";
6631 my $web_browser = $CPAN::Config->{'lynx'} || undef;
6632 my $web_browser_out = $web_browser
6633 ? CPAN::Distribution->_check_binary($self,$web_browser)
6636 if ($web_browser_out) {
6637 # web browser found, run the action
6638 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
6639 $CPAN::Frontend->myprint(qq{system[$browser $url]})
6641 $CPAN::Frontend->myprint(qq{
6644 with browser $browser
6646 $CPAN::Frontend->mysleep(1);
6647 system("$browser $url");
6648 if ($saved_file) { 1 while unlink($saved_file) }
6650 # web browser not found, let's try text only
6651 my $html_converter_out =
6652 CPAN::Distribution->_check_binary($self,$html_converter);
6653 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
6655 if ($html_converter_out ) {
6656 # html2text found, run it
6657 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
6658 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
6659 unless defined($saved_file);
6662 $pid = open README, "$html_converter $saved_file |"
6663 or $CPAN::Frontend->mydie(qq{
6664 Could not fork '$html_converter $saved_file': $!});
6666 if ($CPAN::META->has_inst("File::Temp")) {
6667 $fh = File::Temp->new(
6668 template => 'cpan_htmlconvert_XXXX',
6672 $filename = $fh->filename;
6674 $filename = "cpan_htmlconvert_$$.txt";
6675 $fh = FileHandle->new();
6676 open $fh, ">$filename" or die;
6682 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
6683 my $tmpin = $fh->filename;
6684 $CPAN::Frontend->myprint(sprintf(qq{
6686 saved output to %s\n},
6694 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
6695 my $fh_pager = FileHandle->new;
6696 local($SIG{PIPE}) = "IGNORE";
6697 my $pager = $CPAN::Config->{'pager'} || "cat";
6698 $fh_pager->open("|$pager")
6699 or $CPAN::Frontend->mydie(qq{
6700 Could not open pager '$pager': $!});
6701 $CPAN::Frontend->myprint(qq{
6706 $CPAN::Frontend->mysleep(1);
6707 $fh_pager->print(<FH>);
6710 # coldn't find the web browser or html converter
6711 $CPAN::Frontend->myprint(qq{
6712 You need to install lynx or $html_converter to use this feature.});
6717 #-> sub CPAN::Distribution::_getsave_url ;
6719 my($dist, $shell, $url) = @_;
6721 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
6725 if ($CPAN::META->has_inst("File::Temp")) {
6726 $fh = File::Temp->new(
6727 template => "cpan_getsave_url_XXXX",
6731 $filename = $fh->filename;
6733 $fh = FileHandle->new;
6734 $filename = "cpan_getsave_url_$$.html";
6736 my $tmpin = $filename;
6737 if ($CPAN::META->has_usable('LWP')) {
6738 $CPAN::Frontend->myprint("Fetching with LWP:
6742 CPAN::LWP::UserAgent->config;
6743 eval { $Ua = CPAN::LWP::UserAgent->new; };
6745 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
6749 $Ua->proxy('http', $var)
6750 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
6752 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
6755 my $req = HTTP::Request->new(GET => $url);
6756 $req->header('Accept' => 'text/html');
6757 my $res = $Ua->request($req);
6758 if ($res->is_success) {
6759 $CPAN::Frontend->myprint(" + request successful.\n")
6761 print $fh $res->content;
6763 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
6767 $CPAN::Frontend->myprint(sprintf(
6768 "LWP failed with code[%s], message[%s]\n",
6775 $CPAN::Frontend->mywarn(" LWP not available\n");
6780 # sub CPAN::Distribution::_build_command
6781 sub _build_command {
6783 if ($^O eq "MSWin32") { # special code needed at least up to
6784 # Module::Build 0.2611 and 0.2706; a fix
6785 # in M:B has been promised 2006-01-30
6786 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
6787 return "$perl ./Build";
6792 package CPAN::Bundle;
6797 $CPAN::Frontend->myprint($self->as_string);
6802 delete $self->{later};
6803 for my $c ( $self->contains ) {
6804 my $obj = CPAN::Shell->expandany($c) or next;
6809 # mark as dirty/clean
6810 #-> sub CPAN::Bundle::color_cmd_tmps ;
6811 sub color_cmd_tmps {
6813 my($depth) = shift || 0;
6814 my($color) = shift || 0;
6815 my($ancestors) = shift || [];
6816 # a module needs to recurse to its cpan_file, a distribution needs
6817 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
6819 return if exists $self->{incommandcolor}
6820 && $self->{incommandcolor}==$color;
6822 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6824 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6826 for my $c ( $self->contains ) {
6827 my $obj = CPAN::Shell->expandany($c) or next;
6828 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
6829 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6832 delete $self->{badtestcnt};
6834 $self->{incommandcolor} = $color;
6837 #-> sub CPAN::Bundle::as_string ;
6841 # following line must be "=", not "||=" because we have a moving target
6842 $self->{INST_VERSION} = $self->inst_version;
6843 return $self->SUPER::as_string;
6846 #-> sub CPAN::Bundle::contains ;
6849 my($inst_file) = $self->inst_file || "";
6850 my($id) = $self->id;
6851 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
6852 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
6855 unless ($inst_file) {
6856 # Try to get at it in the cpan directory
6857 $self->debug("no inst_file") if $CPAN::DEBUG;
6859 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
6860 $cpan_file = $self->cpan_file;
6861 if ($cpan_file eq "N/A") {
6862 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
6863 Maybe stale symlink? Maybe removed during session? Giving up.\n");
6865 my $dist = $CPAN::META->instance('CPAN::Distribution',
6868 $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
6869 my($todir) = $CPAN::Config->{'cpan_home'};
6870 my(@me,$from,$to,$me);
6871 @me = split /::/, $self->id;
6873 $me = File::Spec->catfile(@me);
6874 $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
6875 $to = File::Spec->catfile($todir,$me);
6876 File::Path::mkpath(File::Basename::dirname($to));
6877 File::Copy::copy($from, $to)
6878 or Carp::confess("Couldn't copy $from to $to: $!");
6882 my $fh = FileHandle->new;
6884 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6886 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6888 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6889 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6890 next unless $in_cont;
6895 push @result, (split " ", $_, 2)[0];
6898 delete $self->{STATUS};
6899 $self->{CONTAINS} = \@result;
6900 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6902 $CPAN::Frontend->mywarn(qq{
6903 The bundle file "$inst_file" may be a broken
6904 bundlefile. It seems not to contain any bundle definition.
6905 Please check the file and if it is bogus, please delete it.
6906 Sorry for the inconvenience.
6912 #-> sub CPAN::Bundle::find_bundle_file
6913 # $where is in local format, $what is in unix format
6914 sub find_bundle_file {
6915 my($self,$where,$what) = @_;
6916 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6917 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6918 ### my $bu = File::Spec->catfile($where,$what);
6919 ### return $bu if -f $bu;
6920 my $manifest = File::Spec->catfile($where,"MANIFEST");
6921 unless (-f $manifest) {
6922 require ExtUtils::Manifest;
6923 my $cwd = CPAN::anycwd();
6924 $self->safe_chdir($where);
6925 ExtUtils::Manifest::mkmanifest();
6926 $self->safe_chdir($cwd);
6928 my $fh = FileHandle->new($manifest)
6929 or Carp::croak("Couldn't open $manifest: $!");
6931 my $bundle_filename = $what;
6932 $bundle_filename =~ s|Bundle.*/||;
6933 my $bundle_unixpath;
6936 my($file) = /(\S+)/;
6937 if ($file =~ m|\Q$what\E$|) {
6938 $bundle_unixpath = $file;
6939 # return File::Spec->catfile($where,$bundle_unixpath); # bad
6942 # retry if she managed to have no Bundle directory
6943 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
6945 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
6946 if $bundle_unixpath;
6947 Carp::croak("Couldn't find a Bundle file in $where");
6950 # needs to work quite differently from Module::inst_file because of
6951 # cpan_home/Bundle/ directory and the possibility that we have
6952 # shadowing effect. As it makes no sense to take the first in @INC for
6953 # Bundles, we parse them all for $VERSION and take the newest.
6955 #-> sub CPAN::Bundle::inst_file ;
6960 @me = split /::/, $self->id;
6963 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6964 my $bfile = File::Spec->catfile($incdir, @me);
6965 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6966 next unless -f $bfile;
6967 my $foundv = MM->parse_version($bfile);
6968 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6969 $self->{INST_FILE} = $bfile;
6970 $self->{INST_VERSION} = $bestv = $foundv;
6976 #-> sub CPAN::Bundle::inst_version ;
6979 $self->inst_file; # finds INST_VERSION as side effect
6980 $self->{INST_VERSION};
6983 #-> sub CPAN::Bundle::rematein ;
6985 my($self,$meth) = @_;
6986 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6987 my($id) = $self->id;
6988 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6989 unless $self->inst_file || $self->cpan_file;
6991 for $s ($self->contains) {
6992 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6993 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6994 if ($type eq 'CPAN::Distribution') {
6995 $CPAN::Frontend->mywarn(qq{
6996 The Bundle }.$self->id.qq{ contains
6997 explicitly a file $s.
6999 $CPAN::Frontend->mysleep(3);
7001 # possibly noisy action:
7002 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
7003 my $obj = $CPAN::META->instance($type,$s);
7004 $obj->{reqtype} = $self->{reqtype};
7006 if ($obj->isa('CPAN::Bundle')
7008 exists $obj->{install_failed}
7010 ref($obj->{install_failed}) eq "HASH"
7012 for (keys %{$obj->{install_failed}}) {
7013 $self->{install_failed}{$_} = undef; # propagate faiure up
7016 $fail{$s} = 1; # the bundle itself may have succeeded but
7021 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
7022 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
7024 delete $self->{install_failed}{$s};
7031 # recap with less noise
7032 if ( $meth eq "install" ) {
7035 my $raw = sprintf(qq{Bundle summary:
7036 The following items in bundle %s had installation problems:},
7039 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
7040 $CPAN::Frontend->myprint("\n");
7043 for $s ($self->contains) {
7045 $paragraph .= "$s ";
7046 $self->{install_failed}{$s} = undef;
7047 $reported{$s} = undef;
7050 my $report_propagated;
7051 for $s (sort keys %{$self->{install_failed}}) {
7052 next if exists $reported{$s};
7053 $paragraph .= "and the following items had problems
7054 during recursive bundle calls: " unless $report_propagated++;
7055 $paragraph .= "$s ";
7057 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
7058 $CPAN::Frontend->myprint("\n");
7060 $self->{'install'} = 'YES';
7065 # If a bundle contains another that contains an xs_file we have here,
7066 # we just don't bother I suppose
7067 #-> sub CPAN::Bundle::xs_file
7072 #-> sub CPAN::Bundle::force ;
7073 sub force { shift->rematein('force',@_); }
7074 #-> sub CPAN::Bundle::notest ;
7075 sub notest { shift->rematein('notest',@_); }
7076 #-> sub CPAN::Bundle::get ;
7077 sub get { shift->rematein('get',@_); }
7078 #-> sub CPAN::Bundle::make ;
7079 sub make { shift->rematein('make',@_); }
7080 #-> sub CPAN::Bundle::test ;
7083 $self->{badtestcnt} ||= 0;
7084 $self->rematein('test',@_);
7086 #-> sub CPAN::Bundle::install ;
7089 $self->rematein('install',@_);
7091 #-> sub CPAN::Bundle::clean ;
7092 sub clean { shift->rematein('clean',@_); }
7094 #-> sub CPAN::Bundle::uptodate ;
7097 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
7099 foreach $c ($self->contains) {
7100 my $obj = CPAN::Shell->expandany($c);
7101 return 0 unless $obj->uptodate;
7106 #-> sub CPAN::Bundle::readme ;
7109 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
7110 No File found for bundle } . $self->id . qq{\n}), return;
7111 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
7112 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
7115 package CPAN::Module;
7119 # sub CPAN::Module::userid
7124 return $ro->{userid} || $ro->{CPAN_USERID};
7126 # sub CPAN::Module::description
7129 my $ro = $self->ro or return "";
7135 CPAN::Shell->expand("Distribution",$self->cpan_file);
7138 # sub CPAN::Module::undelay
7141 delete $self->{later};
7142 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
7147 # mark as dirty/clean
7148 #-> sub CPAN::Module::color_cmd_tmps ;
7149 sub color_cmd_tmps {
7151 my($depth) = shift || 0;
7152 my($color) = shift || 0;
7153 my($ancestors) = shift || [];
7154 # a module needs to recurse to its cpan_file
7156 return if exists $self->{incommandcolor}
7157 && $self->{incommandcolor}==$color;
7158 return if $depth>=1 && $self->uptodate;
7160 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
7162 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
7164 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
7165 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
7168 delete $self->{badtestcnt};
7170 $self->{incommandcolor} = $color;
7173 #-> sub CPAN::Module::as_glimpse ;
7177 my $class = ref($self);
7178 $class =~ s/^CPAN:://;
7182 $CPAN::Shell::COLOR_REGISTERED
7184 $CPAN::META->has_inst("Term::ANSIColor")
7188 $color_on = Term::ANSIColor::color("green");
7189 $color_off = Term::ANSIColor::color("reset");
7191 my $uptodateness = " ";
7192 if ($class eq "Bundle") {
7193 } elsif ($self->uptodate) {
7194 $uptodateness = "=";
7195 } elsif ($self->inst_version) {
7196 $uptodateness = "<";
7198 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
7204 ($self->distribution ?
7205 $self->distribution->pretty_id :
7212 #-> sub CPAN::Module::dslip_status
7216 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
7217 pre-alpha alpha beta released
7219 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
7220 developer comp.lang.perl.*
7222 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
7223 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
7225 object-oriented pragma
7227 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
7231 distribution_allowed
7232 restricted_distribution
7234 for my $x (qw(d s l i p)) {
7235 $stat->{$x}{' '} = 'unknown';
7236 $stat->{$x}{'?'} = 'unknown';
7239 return +{} unless $ro && $ro->{statd};
7246 DV => $stat->{D}{$ro->{statd}},
7247 SV => $stat->{S}{$ro->{stats}},
7248 LV => $stat->{L}{$ro->{statl}},
7249 IV => $stat->{I}{$ro->{stati}},
7250 PV => $stat->{P}{$ro->{statp}},
7254 #-> sub CPAN::Module::as_string ;
7258 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
7259 my $class = ref($self);
7260 $class =~ s/^CPAN:://;
7262 push @m, $class, " id = $self->{ID}\n";
7263 my $sprintf = " %-12s %s\n";
7264 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
7265 if $self->description;
7266 my $sprintf2 = " %-12s %s (%s)\n";
7268 $userid = $self->userid;
7271 if ($author = CPAN::Shell->expand('Author',$userid)) {
7274 if ($m = $author->email) {
7281 $author->fullname . $email
7285 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
7286 if $self->cpan_version;
7287 if (my $cpan_file = $self->cpan_file){
7288 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
7289 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
7290 my $upload_date = $dist->upload_date;
7292 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
7296 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
7297 my $dslip = $self->dslip_status;
7301 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
7303 my $local_file = $self->inst_file;
7304 unless ($self->{MANPAGE}) {
7307 $manpage = $self->manpage_headline($local_file);
7309 # If we have already untarred it, we should look there
7310 my $dist = $CPAN::META->instance('CPAN::Distribution',
7312 # warn "dist[$dist]";
7313 # mff=manifest file; mfh=manifest handle
7318 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
7320 $mfh = FileHandle->new($mff)
7322 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
7323 my $lfre = $self->id; # local file RE
7326 my($lfl); # local file file
7328 my(@mflines) = <$mfh>;
7333 while (length($lfre)>5 and !$lfl) {
7334 ($lfl) = grep /$lfre/, @mflines;
7335 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
7338 $lfl =~ s/\s.*//; # remove comments
7339 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
7340 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
7341 # warn "lfl_abs[$lfl_abs]";
7343 $manpage = $self->manpage_headline($lfl_abs);
7347 $self->{MANPAGE} = $manpage if $manpage;
7350 for $item (qw/MANPAGE/) {
7351 push @m, sprintf($sprintf, $item, $self->{$item})
7352 if exists $self->{$item};
7354 for $item (qw/CONTAINS/) {
7355 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
7356 if exists $self->{$item} && @{$self->{$item}};
7358 push @m, sprintf($sprintf, 'INST_FILE',
7359 $local_file || "(not installed)");
7360 push @m, sprintf($sprintf, 'INST_VERSION',
7361 $self->inst_version) if $local_file;
7365 sub manpage_headline {
7366 my($self,$local_file) = @_;
7367 my(@local_file) = $local_file;
7368 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
7369 push @local_file, $local_file;
7371 for $locf (@local_file) {
7372 next unless -f $locf;
7373 my $fh = FileHandle->new($locf)
7374 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
7378 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
7379 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
7396 #-> sub CPAN::Module::cpan_file ;
7397 # Note: also inherited by CPAN::Bundle
7400 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
7401 unless ($self->ro) {
7402 CPAN::Index->reload;
7405 if ($ro && defined $ro->{CPAN_FILE}){
7406 return $ro->{CPAN_FILE};
7408 my $userid = $self->userid;
7410 if ($CPAN::META->exists("CPAN::Author",$userid)) {
7411 my $author = $CPAN::META->instance("CPAN::Author",
7413 my $fullname = $author->fullname;
7414 my $email = $author->email;
7415 unless (defined $fullname && defined $email) {
7416 return sprintf("Contact Author %s",
7420 return "Contact Author $fullname <$email>";
7422 return "Contact Author $userid (Email address not available)";
7430 #-> sub CPAN::Module::cpan_version ;
7436 # Can happen with modules that are not on CPAN
7439 $ro->{CPAN_VERSION} = 'undef'
7440 unless defined $ro->{CPAN_VERSION};
7441 $ro->{CPAN_VERSION};
7444 #-> sub CPAN::Module::force ;
7447 $self->{'force_update'}++;
7452 # warn "XDEBUG: set notest for Module";
7453 $self->{'notest'}++;
7456 #-> sub CPAN::Module::rematein ;
7458 my($self,$meth) = @_;
7459 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
7462 my $cpan_file = $self->cpan_file;
7463 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
7464 $CPAN::Frontend->mywarn(sprintf qq{
7465 The module %s isn\'t available on CPAN.
7467 Either the module has not yet been uploaded to CPAN, or it is
7468 temporary unavailable. Please contact the author to find out
7469 more about the status. Try 'i %s'.
7476 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
7477 $pack->called_for($self->id);
7478 $pack->force($meth) if exists $self->{'force_update'};
7479 $pack->notest($meth) if exists $self->{'notest'};
7481 $pack->{reqtype} ||= "";
7482 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
7483 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
7484 if ($pack->{reqtype}) {
7485 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
7486 $pack->{reqtype} = $self->{reqtype};
7488 exists $pack->{install}
7491 $pack->{install}->can("failed") ?
7492 $pack->{install}->failed :
7493 $pack->{install} =~ /^NO/
7496 delete $pack->{install};
7497 $CPAN::Frontend->mywarn
7498 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
7502 $pack->{reqtype} = $self->{reqtype};
7509 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
7510 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
7511 delete $self->{'force_update'};
7512 delete $self->{'notest'};
7518 #-> sub CPAN::Module::perldoc ;
7519 sub perldoc { shift->rematein('perldoc') }
7520 #-> sub CPAN::Module::readme ;
7521 sub readme { shift->rematein('readme') }
7522 #-> sub CPAN::Module::look ;
7523 sub look { shift->rematein('look') }
7524 #-> sub CPAN::Module::cvs_import ;
7525 sub cvs_import { shift->rematein('cvs_import') }
7526 #-> sub CPAN::Module::get ;
7527 sub get { shift->rematein('get',@_) }
7528 #-> sub CPAN::Module::make ;
7529 sub make { shift->rematein('make') }
7530 #-> sub CPAN::Module::test ;
7533 $self->{badtestcnt} ||= 0;
7534 $self->rematein('test',@_);
7536 #-> sub CPAN::Module::uptodate ;
7539 local($_); # protect against a bug in MakeMaker 6.17
7540 my($latest) = $self->cpan_version;
7542 my($inst_file) = $self->inst_file;
7544 if (defined $inst_file) {
7545 $have = $self->inst_version;
7550 ! CPAN::Version->vgt($latest, $have)
7552 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
7553 "latest[$latest] have[$have]") if $CPAN::DEBUG;
7558 #-> sub CPAN::Module::install ;
7564 not exists $self->{'force_update'}
7566 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
7568 $self->inst_version,
7574 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
7575 $CPAN::Frontend->mywarn(qq{
7576 \n\n\n ***WARNING***
7577 The module $self->{ID} has no active maintainer.\n\n\n
7579 $CPAN::Frontend->mysleep(5);
7581 $self->rematein('install') if $doit;
7583 #-> sub CPAN::Module::clean ;
7584 sub clean { shift->rematein('clean') }
7586 #-> sub CPAN::Module::inst_file ;
7590 @packpath = split /::/, $self->{ID};
7591 $packpath[-1] .= ".pm";
7592 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
7593 unshift @packpath, "Term", "ReadLine"; # historical reasons
7595 foreach $dir (@INC) {
7596 my $pmfile = File::Spec->catfile($dir,@packpath);
7604 #-> sub CPAN::Module::xs_file ;
7608 @packpath = split /::/, $self->{ID};
7609 push @packpath, $packpath[-1];
7610 $packpath[-1] .= "." . $Config::Config{'dlext'};
7611 foreach $dir (@INC) {
7612 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
7620 #-> sub CPAN::Module::inst_version ;
7623 my $parsefile = $self->inst_file or return;
7624 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
7627 $have = MM->parse_version($parsefile) || "undef";
7628 $have =~ s/^ //; # since the %vd hack these two lines here are needed
7629 $have =~ s/ $//; # trailing whitespace happens all the time
7631 # My thoughts about why %vd processing should happen here
7633 # Alt1 maintain it as string with leading v:
7634 # read index files do nothing
7635 # compare it use utility for compare
7636 # print it do nothing
7638 # Alt2 maintain it as what it is
7639 # read index files convert
7640 # compare it use utility because there's still a ">" vs "gt" issue
7641 # print it use CPAN::Version for print
7643 # Seems cleaner to hold it in memory as a string starting with a "v"
7645 # If the author of this module made a mistake and wrote a quoted
7646 # "v1.13" instead of v1.13, we simply leave it at that with the
7647 # effect that *we* will treat it like a v-tring while the rest of
7648 # perl won't. Seems sensible when we consider that any action we
7649 # could take now would just add complexity.
7651 $have = CPAN::Version->readable($have);
7653 $have =~ s/\s*//g; # stringify to float around floating point issues
7654 $have; # no stringify needed, \s* above matches always
7667 CPAN - query, download and build perl modules from CPAN sites
7673 perl -MCPAN -e shell;
7681 cpan> install Acme::Meta # in the shell
7683 CPAN::Shell->install("Acme::Meta"); # in perl
7687 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
7690 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
7694 $mo = CPAN::Shell->expandany($mod);
7695 $mo = CPAN::Shell->expand("Module",$mod); # same thing
7697 # distribution objects:
7699 $do = CPAN::Shell->expand("Module",$mod)->distribution;
7700 $do = CPAN::Shell->expandany($distro); # same thing
7701 $do = CPAN::Shell->expand("Distribution",
7702 $distro); # same thing
7706 This module and its competitor, the CPANPLUS module, are both much
7707 cooler than the other.
7709 =head1 COMPATIBILITY
7711 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
7712 newer versions. It is getting more and more difficult to get the
7713 minimal prerequisites working on older perls. It is close to
7714 impossible to get the whole Bundle::CPAN working there. If you're in
7715 the position to have only these old versions, be advised that CPAN is
7716 designed to work fine without the Bundle::CPAN installed.
7718 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
7719 compatible with ancient perls and that File::Temp is listed as a
7720 prerequisite but CPAN has reasonable workarounds if it is missing.
7724 The CPAN module is designed to automate the make and install of perl
7725 modules and extensions. It includes some primitive searching
7726 capabilities and knows how to use Net::FTP or LWP (or some external
7727 download clients) to fetch the raw data from the net.
7729 Modules are fetched from one or more of the mirrored CPAN
7730 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
7733 The CPAN module also supports the concept of named and versioned
7734 I<bundles> of modules. Bundles simplify the handling of sets of
7735 related modules. See Bundles below.
7737 The package contains a session manager and a cache manager. There is
7738 no status retained between sessions. The session manager keeps track
7739 of what has been fetched, built and installed in the current
7740 session. The cache manager keeps track of the disk space occupied by
7741 the make processes and deletes excess space according to a simple FIFO
7744 All methods provided are accessible in a programmer style and in an
7745 interactive shell style.
7747 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
7749 The interactive mode is entered by running
7751 perl -MCPAN -e shell
7753 which puts you into a readline interface. You will have the most fun if
7754 you install Term::ReadKey and Term::ReadLine to enjoy both history and
7757 Once you are on the command line, type 'h' and the rest should be
7760 The function call C<shell> takes two optional arguments, one is the
7761 prompt, the second is the default initial command line (the latter
7762 only works if a real ReadLine interface module is installed).
7764 The most common uses of the interactive modes are
7768 =item Searching for authors, bundles, distribution files and modules
7770 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
7771 for each of the four categories and another, C<i> for any of the
7772 mentioned four. Each of the four entities is implemented as a class
7773 with slightly differing methods for displaying an object.
7775 Arguments you pass to these commands are either strings exactly matching
7776 the identification string of an object or regular expressions that are
7777 then matched case-insensitively against various attributes of the
7778 objects. The parser recognizes a regular expression only if you
7779 enclose it between two slashes.
7781 The principle is that the number of found objects influences how an
7782 item is displayed. If the search finds one item, the result is
7783 displayed with the rather verbose method C<as_string>, but if we find
7784 more than one, we display each object with the terse method
7787 =item make, test, install, clean modules or distributions
7789 These commands take any number of arguments and investigate what is
7790 necessary to perform the action. If the argument is a distribution
7791 file name (recognized by embedded slashes), it is processed. If it is
7792 a module, CPAN determines the distribution file in which this module
7793 is included and processes that, following any dependencies named in
7794 the module's META.yml or Makefile.PL (this behavior is controlled by
7795 the configuration parameter C<prerequisites_policy>.)
7797 Any C<make> or C<test> are run unconditionally. An
7799 install <distribution_file>
7801 also is run unconditionally. But for
7805 CPAN checks if an install is actually needed for it and prints
7806 I<module up to date> in the case that the distribution file containing
7807 the module doesn't need to be updated.
7809 CPAN also keeps track of what it has done within the current session
7810 and doesn't try to build a package a second time regardless if it
7811 succeeded or not. The C<force> pragma may precede another command
7812 (currently: C<make>, C<test>, or C<install>) and executes the
7813 command from scratch and tries to continue in case of some errors.
7817 cpan> install OpenGL
7818 OpenGL is up to date.
7819 cpan> force install OpenGL
7822 OpenGL-0.4/COPYRIGHT
7825 The C<notest> pragma may be set to skip the test part in the build
7830 cpan> notest install Tk
7832 A C<clean> command results in a
7836 being executed within the distribution file's working directory.
7838 =item get, readme, perldoc, look module or distribution
7840 C<get> downloads a distribution file without further action. C<readme>
7841 displays the README file of the associated distribution. C<Look> gets
7842 and untars (if not yet done) the distribution file, changes to the
7843 appropriate directory and opens a subshell process in that directory.
7844 C<perldoc> displays the pod documentation of the module in html or
7849 =item ls globbing_expression
7851 The first form lists all distribution files in and below an author's
7852 CPAN directory as they are stored in the CHECKUMS files distributed on
7853 CPAN. The listing goes recursive into all subdirectories.
7855 The second form allows to limit or expand the output with shell
7856 globbing as in the following examples:
7862 The last example is very slow and outputs extra progress indicators
7863 that break the alignment of the result.
7865 Note that globbing only lists directories explicitly asked for, for
7866 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
7867 regarded as a bug and may be changed in future versions.
7871 The C<failed> command reports all distributions that failed on one of
7872 C<make>, C<test> or C<install> for some reason in the currently
7873 running shell session.
7877 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
7878 (but the directory can be configured via the C<cpan_home> config
7879 variable). The shell is a bit picky if you try to start another CPAN
7880 session. It dies immediately if there is a lockfile and the lock seems
7881 to belong to a running process. In case you want to run a second shell
7882 session, it is probably safest to maintain another directory, say
7883 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
7884 contains the configuration options. Then you can start the second
7887 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
7891 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
7892 in the cpan-shell it is intended that you can press C<^C> anytime and
7893 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
7894 to clean up and leave the shell loop. You can emulate the effect of a
7895 SIGTERM by sending two consecutive SIGINTs, which usually means by
7896 pressing C<^C> twice.
7898 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
7899 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
7900 Build.PL> subprocess.
7906 The commands that are available in the shell interface are methods in
7907 the package CPAN::Shell. If you enter the shell command, all your
7908 input is split by the Text::ParseWords::shellwords() routine which
7909 acts like most shells do. The first word is being interpreted as the
7910 method to be called and the rest of the words are treated as arguments
7911 to this method. Continuation lines are supported if a line ends with a
7916 C<autobundle> writes a bundle file into the
7917 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
7918 a list of all modules that are both available from CPAN and currently
7919 installed within @INC. The name of the bundle file is based on the
7920 current date and a counter.
7924 recompile() is a very special command in that it takes no argument and
7925 runs the make/test/install cycle with brute force over all installed
7926 dynamically loadable extensions (aka XS modules) with 'force' in
7927 effect. The primary purpose of this command is to finish a network
7928 installation. Imagine, you have a common source tree for two different
7929 architectures. You decide to do a completely independent fresh
7930 installation. You start on one architecture with the help of a Bundle
7931 file produced earlier. CPAN installs the whole Bundle for you, but
7932 when you try to repeat the job on the second architecture, CPAN
7933 responds with a C<"Foo up to date"> message for all modules. So you
7934 invoke CPAN's recompile on the second architecture and you're done.
7936 Another popular use for C<recompile> is to act as a rescue in case your
7937 perl breaks binary compatibility. If one of the modules that CPAN uses
7938 is in turn depending on binary compatibility (so you cannot run CPAN
7939 commands), then you should try the CPAN::Nox module for recovery.
7941 =head2 report Bundle|Distribution|Module
7943 The C<report> command temporarily turns on the C<test_report> config
7944 variable, then runs the C<force test> command with the given arguments.
7946 =head2 upgrade [Module|/Regex/]...
7948 The C<upgrade> command first runs an C<r> command with the given
7949 arguments and then installs the newest versions of all modules that
7950 were listed by that.
7954 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
7955 directory so that you can save your own preferences instead of the
7958 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
7960 Although it may be considered internal, the class hierarchy does matter
7961 for both users and programmer. CPAN.pm deals with above mentioned four
7962 classes, and all those classes share a set of methods. A classical
7963 single polymorphism is in effect. A metaclass object registers all
7964 objects of all kinds and indexes them with a string. The strings
7965 referencing objects have a separated namespace (well, not completely
7970 words containing a "/" (slash) Distribution
7971 words starting with Bundle:: Bundle
7972 everything else Module or Author
7974 Modules know their associated Distribution objects. They always refer
7975 to the most recent official release. Developers may mark their releases
7976 as unstable development versions (by inserting an underbar into the
7977 module version number which will also be reflected in the distribution
7978 name when you run 'make dist'), so the really hottest and newest
7979 distribution is not always the default. If a module Foo circulates
7980 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7981 way to install version 1.23 by saying
7985 This would install the complete distribution file (say
7986 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7987 like to install version 1.23_90, you need to know where the
7988 distribution file resides on CPAN relative to the authors/id/
7989 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7990 so you would have to say
7992 install BAR/Foo-1.23_90.tar.gz
7994 The first example will be driven by an object of the class
7995 CPAN::Module, the second by an object of class CPAN::Distribution.
7997 =head1 PROGRAMMER'S INTERFACE
7999 If you do not enter the shell, the available shell commands are both
8000 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
8001 functions in the calling package (C<install(...)>).
8003 There's currently only one class that has a stable interface -
8004 CPAN::Shell. All commands that are available in the CPAN shell are
8005 methods of the class CPAN::Shell. Each of the commands that produce
8006 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
8007 the IDs of all modules within the list.
8011 =item expand($type,@things)
8013 The IDs of all objects available within a program are strings that can
8014 be expanded to the corresponding real objects with the
8015 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
8016 list of CPAN::Module objects according to the C<@things> arguments
8017 given. In scalar context it only returns the first element of the
8020 =item expandany(@things)
8022 Like expand, but returns objects of the appropriate type, i.e.
8023 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
8024 CPAN::Distribution objects for distributions. Note: it does not expand
8025 to CPAN::Author objects.
8027 =item Programming Examples
8029 This enables the programmer to do operations that combine
8030 functionalities that are available in the shell.
8032 # install everything that is outdated on my disk:
8033 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
8035 # install my favorite programs if necessary:
8036 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
8037 CPAN::Shell->install($mod);
8040 # list all modules on my disk that have no VERSION number
8041 for $mod (CPAN::Shell->expand("Module","/./")){
8042 next unless $mod->inst_file;
8043 # MakeMaker convention for undefined $VERSION:
8044 next unless $mod->inst_version eq "undef";
8045 print "No VERSION in ", $mod->id, "\n";
8048 # find out which distribution on CPAN contains a module:
8049 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
8051 Or if you want to write a cronjob to watch The CPAN, you could list
8052 all modules that need updating. First a quick and dirty way:
8054 perl -e 'use CPAN; CPAN::Shell->r;'
8056 If you don't want to get any output in the case that all modules are
8057 up to date, you can parse the output of above command for the regular
8058 expression //modules are up to date// and decide to mail the output
8059 only if it doesn't match. Ick?
8061 If you prefer to do it more in a programmer style in one single
8062 process, maybe something like this suits you better:
8064 # list all modules on my disk that have newer versions on CPAN
8065 for $mod (CPAN::Shell->expand("Module","/./")){
8066 next unless $mod->inst_file;
8067 next if $mod->uptodate;
8068 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
8069 $mod->id, $mod->inst_version, $mod->cpan_version;
8072 If that gives you too much output every day, you maybe only want to
8073 watch for three modules. You can write
8075 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
8077 as the first line instead. Or you can combine some of the above
8080 # watch only for a new mod_perl module
8081 $mod = CPAN::Shell->expand("Module","mod_perl");
8082 exit if $mod->uptodate;
8083 # new mod_perl arrived, let me know all update recommendations
8088 =head2 Methods in the other Classes
8090 The programming interface for the classes CPAN::Module,
8091 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
8092 beta and partially even alpha. In the following paragraphs only those
8093 methods are documented that have proven useful over a longer time and
8094 thus are unlikely to change.
8098 =item CPAN::Author::as_glimpse()
8100 Returns a one-line description of the author
8102 =item CPAN::Author::as_string()
8104 Returns a multi-line description of the author
8106 =item CPAN::Author::email()
8108 Returns the author's email address
8110 =item CPAN::Author::fullname()
8112 Returns the author's name
8114 =item CPAN::Author::name()
8116 An alias for fullname
8118 =item CPAN::Bundle::as_glimpse()
8120 Returns a one-line description of the bundle
8122 =item CPAN::Bundle::as_string()
8124 Returns a multi-line description of the bundle
8126 =item CPAN::Bundle::clean()
8128 Recursively runs the C<clean> method on all items contained in the bundle.
8130 =item CPAN::Bundle::contains()
8132 Returns a list of objects' IDs contained in a bundle. The associated
8133 objects may be bundles, modules or distributions.
8135 =item CPAN::Bundle::force($method,@args)
8137 Forces CPAN to perform a task that normally would have failed. Force
8138 takes as arguments a method name to be called and any number of
8139 additional arguments that should be passed to the called method. The
8140 internals of the object get the needed changes so that CPAN.pm does
8141 not refuse to take the action. The C<force> is passed recursively to
8142 all contained objects.
8144 =item CPAN::Bundle::get()
8146 Recursively runs the C<get> method on all items contained in the bundle
8148 =item CPAN::Bundle::inst_file()
8150 Returns the highest installed version of the bundle in either @INC or
8151 C<$CPAN::Config->{cpan_home}>. Note that this is different from
8152 CPAN::Module::inst_file.
8154 =item CPAN::Bundle::inst_version()
8156 Like CPAN::Bundle::inst_file, but returns the $VERSION
8158 =item CPAN::Bundle::uptodate()
8160 Returns 1 if the bundle itself and all its members are uptodate.
8162 =item CPAN::Bundle::install()
8164 Recursively runs the C<install> method on all items contained in the bundle
8166 =item CPAN::Bundle::make()
8168 Recursively runs the C<make> method on all items contained in the bundle
8170 =item CPAN::Bundle::readme()
8172 Recursively runs the C<readme> method on all items contained in the bundle
8174 =item CPAN::Bundle::test()
8176 Recursively runs the C<test> method on all items contained in the bundle
8178 =item CPAN::Distribution::as_glimpse()
8180 Returns a one-line description of the distribution
8182 =item CPAN::Distribution::as_string()
8184 Returns a multi-line description of the distribution
8186 =item CPAN::Distribution::author
8188 Returns the CPAN::Author object of the maintainer who uploaded this
8191 =item CPAN::Distribution::clean()
8193 Changes to the directory where the distribution has been unpacked and
8194 runs C<make clean> there.
8196 =item CPAN::Distribution::containsmods()
8198 Returns a list of IDs of modules contained in a distribution file.
8199 Only works for distributions listed in the 02packages.details.txt.gz
8200 file. This typically means that only the most recent version of a
8201 distribution is covered.
8203 =item CPAN::Distribution::cvs_import()
8205 Changes to the directory where the distribution has been unpacked and
8208 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
8212 =item CPAN::Distribution::dir()
8214 Returns the directory into which this distribution has been unpacked.
8216 =item CPAN::Distribution::force($method,@args)
8218 Forces CPAN to perform a task that normally would have failed. Force
8219 takes as arguments a method name to be called and any number of
8220 additional arguments that should be passed to the called method. The
8221 internals of the object get the needed changes so that CPAN.pm does
8222 not refuse to take the action.
8224 =item CPAN::Distribution::get()
8226 Downloads the distribution from CPAN and unpacks it. Does nothing if
8227 the distribution has already been downloaded and unpacked within the
8230 =item CPAN::Distribution::install()
8232 Changes to the directory where the distribution has been unpacked and
8233 runs the external command C<make install> there. If C<make> has not
8234 yet been run, it will be run first. A C<make test> will be issued in
8235 any case and if this fails, the install will be canceled. The
8236 cancellation can be avoided by letting C<force> run the C<install> for
8239 This install method has only the power to install the distribution if
8240 there are no dependencies in the way. To install an object and all of
8241 its dependencies, use CPAN::Shell->install.
8243 Note that install() gives no meaningful return value. See uptodate().
8245 =item CPAN::Distribution::isa_perl()
8247 Returns 1 if this distribution file seems to be a perl distribution.
8248 Normally this is derived from the file name only, but the index from
8249 CPAN can contain a hint to achieve a return value of true for other
8252 =item CPAN::Distribution::look()
8254 Changes to the directory where the distribution has been unpacked and
8255 opens a subshell there. Exiting the subshell returns.
8257 =item CPAN::Distribution::make()
8259 First runs the C<get> method to make sure the distribution is
8260 downloaded and unpacked. Changes to the directory where the
8261 distribution has been unpacked and runs the external commands C<perl
8262 Makefile.PL> or C<perl Build.PL> and C<make> there.
8264 =item CPAN::Distribution::perldoc()
8266 Downloads the pod documentation of the file associated with a
8267 distribution (in html format) and runs it through the external
8268 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
8269 isn't available, it converts it to plain text with external
8270 command html2text and runs it through the pager specified
8271 in C<$CPAN::Config->{pager}>
8273 =item CPAN::Distribution::prefs()
8275 Returns the hash reference from the first matching YAML file that the
8276 user has deposited in the C<prefs_dir/> directory. The first
8277 succeeding match wins. The files in the C<prefs_dir/> are processed
8278 alphabetically and the canonical distroname (e.g.
8279 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
8280 stored in the $root->{match}{distribution} attribute value.
8281 Additionally all module names contained in a distribution are matched
8282 agains the regular expressions in the $root->{match}{module} attribute
8283 value. The two match values are ANDed together. Each of the two
8284 attributes are optional.
8286 =item CPAN::Distribution::prereq_pm()
8288 Returns the hash reference that has been announced by a distribution
8289 as the merge of the C<requires> element and the C<build_requires>
8290 element of the META.yml or the C<PREREQ_PM> hash in the
8291 C<Makefile.PL>. Note: works only after an attempt has been made to
8292 C<make> the distribution. Returns undef otherwise.
8294 =item CPAN::Distribution::readme()
8296 Downloads the README file associated with a distribution and runs it
8297 through the pager specified in C<$CPAN::Config->{pager}>.
8299 =item CPAN::Distribution::read_yaml()
8301 Returns the content of the META.yml of this distro as a hashref. Note:
8302 works only after an attempt has been made to C<make> the distribution.
8303 Returns undef otherwise.
8305 =item CPAN::Distribution::test()
8307 Changes to the directory where the distribution has been unpacked and
8308 runs C<make test> there.
8310 =item CPAN::Distribution::uptodate()
8312 Returns 1 if all the modules contained in the distribution are
8313 uptodate. Relies on containsmods.
8315 =item CPAN::Index::force_reload()
8317 Forces a reload of all indices.
8319 =item CPAN::Index::reload()
8321 Reloads all indices if they have not been read for more than
8322 C<$CPAN::Config->{index_expire}> days.
8324 =item CPAN::InfoObj::dump()
8326 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
8327 inherit this method. It prints the data structure associated with an
8328 object. Useful for debugging. Note: the data structure is considered
8329 internal and thus subject to change without notice.
8331 =item CPAN::Module::as_glimpse()
8333 Returns a one-line description of the module in four columns: The
8334 first column contains the word C<Module>, the second column consists
8335 of one character: an equals sign if this module is already installed
8336 and uptodate, a less-than sign if this module is installed but can be
8337 upgraded, and a space if the module is not installed. The third column
8338 is the name of the module and the fourth column gives maintainer or
8339 distribution information.
8341 =item CPAN::Module::as_string()
8343 Returns a multi-line description of the module
8345 =item CPAN::Module::clean()
8347 Runs a clean on the distribution associated with this module.
8349 =item CPAN::Module::cpan_file()
8351 Returns the filename on CPAN that is associated with the module.
8353 =item CPAN::Module::cpan_version()
8355 Returns the latest version of this module available on CPAN.
8357 =item CPAN::Module::cvs_import()
8359 Runs a cvs_import on the distribution associated with this module.
8361 =item CPAN::Module::description()
8363 Returns a 44 character description of this module. Only available for
8364 modules listed in The Module List (CPAN/modules/00modlist.long.html
8365 or 00modlist.long.txt.gz)
8367 =item CPAN::Module::distribution()
8369 Returns the CPAN::Distribution object that contains the current
8370 version of this module.
8372 =item CPAN::Module::dslip_status()
8374 Returns a hash reference. The keys of the hash are the letters C<D>,
8375 C<S>, C<L>, C<I>, and <P>, for development status, support level,
8376 language, interface and public licence respectively. The data for the
8377 DSLIP status are collected by pause.perl.org when authors register
8378 their namespaces. The values of the 5 hash elements are one-character
8379 words whose meaning is described in the table below. There are also 5
8380 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
8381 verbose value of the 5 status variables.
8383 Where the 'DSLIP' characters have the following meanings:
8385 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
8386 i - Idea, listed to gain consensus or as a placeholder
8387 c - under construction but pre-alpha (not yet released)
8388 a/b - Alpha/Beta testing
8390 M - Mature (no rigorous definition)
8391 S - Standard, supplied with Perl 5
8396 u - Usenet newsgroup comp.lang.perl.modules
8397 n - None known, try comp.lang.perl.modules
8398 a - abandoned; volunteers welcome to take over maintainance
8401 p - Perl-only, no compiler needed, should be platform independent
8402 c - C and perl, a C compiler will be needed
8403 h - Hybrid, written in perl with optional C code, no compiler needed
8404 + - C++ and perl, a C++ compiler will be needed
8405 o - perl and another language other than C or C++
8408 f - plain Functions, no references used
8409 h - hybrid, object and function interfaces available
8410 n - no interface at all (huh?)
8411 r - some use of unblessed References or ties
8412 O - Object oriented using blessed references and/or inheritance
8415 p - Standard-Perl: user may choose between GPL and Artistic
8416 g - GPL: GNU General Public License
8417 l - LGPL: "GNU Lesser General Public License" (previously known as
8418 "GNU Library General Public License")
8419 b - BSD: The BSD License
8420 a - Artistic license alone
8421 o - open source: appoved by www.opensource.org
8422 d - allows distribution without restrictions
8423 r - restricted distribtion
8424 n - no license at all
8426 =item CPAN::Module::force($method,@args)
8428 Forces CPAN to perform a task that normally would have failed. Force
8429 takes as arguments a method name to be called and any number of
8430 additional arguments that should be passed to the called method. The
8431 internals of the object get the needed changes so that CPAN.pm does
8432 not refuse to take the action.
8434 =item CPAN::Module::get()
8436 Runs a get on the distribution associated with this module.
8438 =item CPAN::Module::inst_file()
8440 Returns the filename of the module found in @INC. The first file found
8441 is reported just like perl itself stops searching @INC when it finds a
8444 =item CPAN::Module::inst_version()
8446 Returns the version number of the module in readable format.
8448 =item CPAN::Module::install()
8450 Runs an C<install> on the distribution associated with this module.
8452 =item CPAN::Module::look()
8454 Changes to the directory where the distribution associated with this
8455 module has been unpacked and opens a subshell there. Exiting the
8458 =item CPAN::Module::make()
8460 Runs a C<make> on the distribution associated with this module.
8462 =item CPAN::Module::manpage_headline()
8464 If module is installed, peeks into the module's manpage, reads the
8465 headline and returns it. Moreover, if the module has been downloaded
8466 within this session, does the equivalent on the downloaded module even
8467 if it is not installed.
8469 =item CPAN::Module::perldoc()
8471 Runs a C<perldoc> on this module.
8473 =item CPAN::Module::readme()
8475 Runs a C<readme> on the distribution associated with this module.
8477 =item CPAN::Module::test()
8479 Runs a C<test> on the distribution associated with this module.
8481 =item CPAN::Module::uptodate()
8483 Returns 1 if the module is installed and up-to-date.
8485 =item CPAN::Module::userid()
8487 Returns the author's ID of the module.
8491 =head2 Cache Manager
8493 Currently the cache manager only keeps track of the build directory
8494 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
8495 deletes complete directories below C<build_dir> as soon as the size of
8496 all directories there gets bigger than $CPAN::Config->{build_cache}
8497 (in MB). The contents of this cache may be used for later
8498 re-installations that you intend to do manually, but will never be
8499 trusted by CPAN itself. This is due to the fact that the user might
8500 use these directories for building modules on different architectures.
8502 There is another directory ($CPAN::Config->{keep_source_where}) where
8503 the original distribution files are kept. This directory is not
8504 covered by the cache manager and must be controlled by the user. If
8505 you choose to have the same directory as build_dir and as
8506 keep_source_where directory, then your sources will be deleted with
8507 the same fifo mechanism.
8511 A bundle is just a perl module in the namespace Bundle:: that does not
8512 define any functions or methods. It usually only contains documentation.
8514 It starts like a perl module with a package declaration and a $VERSION
8515 variable. After that the pod section looks like any other pod with the
8516 only difference being that I<one special pod section> exists starting with
8521 In this pod section each line obeys the format
8523 Module_Name [Version_String] [- optional text]
8525 The only required part is the first field, the name of a module
8526 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
8527 of the line is optional. The comment part is delimited by a dash just
8528 as in the man page header.
8530 The distribution of a bundle should follow the same convention as
8531 other distributions.
8533 Bundles are treated specially in the CPAN package. If you say 'install
8534 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
8535 the modules in the CONTENTS section of the pod. You can install your
8536 own Bundles locally by placing a conformant Bundle file somewhere into
8537 your @INC path. The autobundle() command which is available in the
8538 shell interface does that for you by including all currently installed
8539 modules in a snapshot bundle file.
8541 =head1 PREREQUISITES
8543 If you have a local mirror of CPAN and can access all files with
8544 "file:" URLs, then you only need a perl better than perl5.003 to run
8545 this module. Otherwise Net::FTP is strongly recommended. LWP may be
8546 required for non-UNIX systems or if your nearest CPAN site is
8547 associated with a URL that is not C<ftp:>.
8549 If you have neither Net::FTP nor LWP, there is a fallback mechanism
8550 implemented for an external ftp command or for an external lynx
8555 =head2 Finding packages and VERSION
8557 This module presumes that all packages on CPAN
8563 declare their $VERSION variable in an easy to parse manner. This
8564 prerequisite can hardly be relaxed because it consumes far too much
8565 memory to load all packages into the running program just to determine
8566 the $VERSION variable. Currently all programs that are dealing with
8567 version use something like this
8569 perl -MExtUtils::MakeMaker -le \
8570 'print MM->parse_version(shift)' filename
8572 If you are author of a package and wonder if your $VERSION can be
8573 parsed, please try the above method.
8577 come as compressed or gzipped tarfiles or as zip files and contain a
8578 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
8579 without much enthusiasm).
8585 The debugging of this module is a bit complex, because we have
8586 interferences of the software producing the indices on CPAN, of the
8587 mirroring process on CPAN, of packaging, of configuration, of
8588 synchronicity, and of bugs within CPAN.pm.
8590 For debugging the code of CPAN.pm itself in interactive mode some more
8591 or less useful debugging aid can be turned on for most packages within
8596 =item o debug package...
8598 sets debug mode for packages.
8600 =item o debug -package...
8602 unsets debug mode for packages.
8606 turns debugging on for all packages.
8608 =item o debug number
8612 which sets the debugging packages directly. Note that C<o debug 0>
8613 turns debugging off.
8615 What seems quite a successful strategy is the combination of C<reload
8616 cpan> and the debugging switches. Add a new debug statement while
8617 running in the shell and then issue a C<reload cpan> and see the new
8618 debugging messages immediately without losing the current context.
8620 C<o debug> without an argument lists the valid package names and the
8621 current set of packages in debugging mode. C<o debug> has built-in
8624 For debugging of CPAN data there is the C<dump> command which takes
8625 the same arguments as make/test/install and outputs each object's
8626 Data::Dumper dump. If an argument looks like a perl variable and
8627 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
8628 Data::Dumper directly.
8630 =head2 Floppy, Zip, Offline Mode
8632 CPAN.pm works nicely without network too. If you maintain machines
8633 that are not networked at all, you should consider working with file:
8634 URLs. Of course, you have to collect your modules somewhere first. So
8635 you might use CPAN.pm to put together all you need on a networked
8636 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
8637 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
8638 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
8639 with this floppy. See also below the paragraph about CD-ROM support.
8641 =head2 Basic Utilities for Programmers
8645 =item has_inst($module)
8647 Returns true if the module is installed. See the source for details.
8649 =item has_usable($module)
8651 Returns true if the module is installed and several and is in a usable
8652 state. Only useful for a handful of modules that are used internally.
8653 See the source for details.
8655 =item instance($module)
8657 The constructor for all the singletons used to represent modules,
8658 distributions, authors and bundles. If the object already exists, this
8659 method returns the object, otherwise it calls the constructor.
8663 =head1 CONFIGURATION
8665 When the CPAN module is used for the first time, a configuration
8666 dialog tries to determine a couple of site specific options. The
8667 result of the dialog is stored in a hash reference C< $CPAN::Config >
8668 in a file CPAN/Config.pm.
8670 The default values defined in the CPAN/Config.pm file can be
8671 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
8672 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
8673 added to the search path of the CPAN module before the use() or
8674 require() statements.
8676 The configuration dialog can be started any time later again by
8677 issuing the command C< o conf init > in the CPAN shell. A subset of
8678 the configuration dialog can be run by issuing C<o conf init WORD>
8679 where WORD is any valid config variable or a regular expression.
8681 Currently the following keys in the hash reference $CPAN::Config are
8684 build_cache size of cache for directories to build modules
8685 build_dir locally accessible directory to build modules
8686 build_requires_install_policy
8687 to install or not to install: when a module is
8688 only needed for building. yes|no|ask/yes|ask/no
8689 bzip2 path to external prg
8690 cache_metadata use serializer to cache metadata
8691 commands_quote prefered character to use for quoting external
8692 commands when running them. Defaults to double
8693 quote on Windows, single tick everywhere else;
8694 can be set to space to disable quoting
8695 check_sigs if signatures should be verified
8696 colorize_output boolean if Term::ANSIColor should colorize output
8697 colorize_print Term::ANSIColor attributes for normal output
8698 colorize_warn Term::ANSIColor attributes for warnings
8699 commandnumber_in_prompt
8700 boolean if you want to see current command number
8701 cpan_home local directory reserved for this package
8702 curl path to external prg
8703 dontload_hash DEPRECATED
8704 dontload_list arrayref: modules in the list will not be
8705 loaded by the CPAN::has_inst() routine
8706 ftp path to external prg
8707 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
8708 ftp_proxy proxy host for ftp requests
8710 gpg path to external prg
8711 gzip location of external program gzip
8712 histfile file to maintain history between sessions
8713 histsize maximum number of lines to keep in histfile
8714 http_proxy proxy host for http requests
8715 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
8716 after this many seconds inactivity. Set to 0 to
8718 index_expire after this many days refetch index files
8719 inhibit_startup_message
8720 if true, does not print the startup message
8721 keep_source_where directory in which to keep the source (if we do)
8722 lynx path to external prg
8723 make location of external make program
8724 make_arg arguments that should always be passed to 'make'
8725 make_install_make_command
8726 the make command for running 'make install', for
8728 make_install_arg same as make_arg for 'make install'
8729 makepl_arg arguments passed to 'perl Makefile.PL'
8730 mbuild_arg arguments passed to './Build'
8731 mbuild_install_arg arguments passed to './Build install'
8732 mbuild_install_build_command
8733 command to use instead of './Build' when we are
8734 in the install stage, for example 'sudo ./Build'
8735 mbuildpl_arg arguments passed to 'perl Build.PL'
8736 ncftp path to external prg
8737 ncftpget path to external prg
8738 no_proxy don't proxy to these hosts/domains (comma separated list)
8739 pager location of external program more (or any pager)
8740 password your password if you CPAN server wants one
8741 prefer_installer legal values are MB and EUMM: if a module comes
8742 with both a Makefile.PL and a Build.PL, use the
8743 former (EUMM) or the latter (MB); if the module
8744 comes with only one of the two, that one will be
8746 prerequisites_policy
8747 what to do if you are missing module prerequisites
8748 ('follow' automatically, 'ask' me, or 'ignore')
8749 prefs_dir local directory to store per-distro build options
8750 proxy_user username for accessing an authenticating proxy
8751 proxy_pass password for accessing an authenticating proxy
8752 scan_cache controls scanning of cache ('atstart' or 'never')
8753 shell your favorite shell
8754 show_upload_date boolean if commands should try to determine upload date
8755 tar location of external program tar
8756 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
8757 (and nonsense for characters outside latin range)
8758 term_ornaments boolean to turn ReadLine ornamenting on/off
8759 test_report email test reports (if CPAN::Reporter is installed)
8760 unzip location of external program unzip
8761 urllist arrayref to nearby CPAN sites (or equivalent locations)
8762 username your username if you CPAN server wants one
8763 wait_list arrayref to a wait server to try (See CPAN::WAIT)
8764 wget path to external prg
8765 yaml_module which module to use to read/write YAML files
8767 You can set and query each of these options interactively in the cpan
8768 shell with the command set defined within the C<o conf> command:
8772 =item C<o conf E<lt>scalar optionE<gt>>
8774 prints the current value of the I<scalar option>
8776 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
8778 Sets the value of the I<scalar option> to I<value>
8780 =item C<o conf E<lt>list optionE<gt>>
8782 prints the current value of the I<list option> in MakeMaker's
8785 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
8787 shifts or pops the array in the I<list option> variable
8789 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
8791 works like the corresponding perl commands.
8795 =head2 CPAN::anycwd($path): Note on config variable getcwd
8797 CPAN.pm changes the current working directory often and needs to
8798 determine its own current working directory. Per default it uses
8799 Cwd::cwd but if this doesn't work on your system for some reason,
8800 alternatives can be configured according to the following table:
8818 Calls the external command cwd.
8822 =head2 Note on urllist parameter's format
8824 urllist parameters are URLs according to RFC 1738. We do a little
8825 guessing if your URL is not compliant, but if you have problems with
8826 file URLs, please try the correct format. Either:
8828 file://localhost/whatever/ftp/pub/CPAN/
8832 file:///home/ftp/pub/CPAN/
8834 =head2 urllist parameter has CD-ROM support
8836 The C<urllist> parameter of the configuration table contains a list of
8837 URLs that are to be used for downloading. If the list contains any
8838 C<file> URLs, CPAN always tries to get files from there first. This
8839 feature is disabled for index files. So the recommendation for the
8840 owner of a CD-ROM with CPAN contents is: include your local, possibly
8841 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
8843 o conf urllist push file://localhost/CDROM/CPAN
8845 CPAN.pm will then fetch the index files from one of the CPAN sites
8846 that come at the beginning of urllist. It will later check for each
8847 module if there is a local copy of the most recent version.
8849 Another peculiarity of urllist is that the site that we could
8850 successfully fetch the last file from automatically gets a preference
8851 token and is tried as the first site for the next request. So if you
8852 add a new site at runtime it may happen that the previously preferred
8853 site will be tried another time. This means that if you want to disallow
8854 a site for the next transfer, it must be explicitly removed from
8857 =head2 prefs_dir for avoiding interactive questions (ALPHA)
8859 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
8860 still considered experimental and may still be changed)
8862 The files in the directory specified in C<prefs_dir> are YAML files
8863 that specify how CPAN.pm shall treat distributions that deviate from
8864 the normal non-interactive model of building and installing CPAN
8867 Some modules try to get some data from the user interactively thus
8868 disturbing the installation of large bundles like Phalanx100 or
8869 modules like Plagger.
8871 CPAN.pm can use YAML files to either pass additional arguments to one
8872 of the four commands, set environment variables or instantiate an
8873 Expect object that reads from the console, waits for some regular
8874 expression and enters some answer. Needless to say that for the latter
8875 option Expect.pm needs to be installed.
8877 CPAN.pm comes with a couple of such YAML files. The structure is
8878 currently not documented. Please see the distroprefs directory of the
8879 CPAN distribution for examples and follow the README in there.
8881 Please note that setting the environment variable PERL_MM_USE_DEFAULT
8882 to a true value can also get you a long way if you want to always pick
8883 the default answers. But this only works if the author of apackage
8884 used the prompt function provided by ExtUtils::MakeMaker and if the
8885 defaults are OK for you.
8889 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
8890 install foreign, unmasked, unsigned code on your machine. We compare
8891 to a checksum that comes from the net just as the distribution file
8892 itself. But we try to make it easy to add security on demand:
8894 =head2 Cryptographically signed modules
8896 Since release 1.77 CPAN.pm has been able to verify cryptographically
8897 signed module distributions using Module::Signature. The CPAN modules
8898 can be signed by their authors, thus giving more security. The simple
8899 unsigned MD5 checksums that were used before by CPAN protect mainly
8900 against accidental file corruption.
8902 You will need to have Module::Signature installed, which in turn
8903 requires that you have at least one of Crypt::OpenPGP module or the
8904 command-line F<gpg> tool installed.
8906 You will also need to be able to connect over the Internet to the public
8907 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
8909 The configuration parameter check_sigs is there to turn signature
8914 Most functions in package CPAN are exported per default. The reason
8915 for this is that the primary use is intended for the cpan shell or for
8920 When the CPAN shell enters a subshell via the look command, it sets
8921 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
8924 When the config variable ftp_passive is set, all downloads will be run
8925 with the environment variable FTP_PASSIVE set to this value. This is
8926 in general a good idea as it influences both Net::FTP and LWP based
8927 connections. The same effect can be achieved by starting the cpan
8928 shell with this environment variable set. For Net::FTP alone, one can
8929 also always set passive mode by running libnetcfg.
8931 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
8933 Populating a freshly installed perl with my favorite modules is pretty
8934 easy if you maintain a private bundle definition file. To get a useful
8935 blueprint of a bundle definition file, the command autobundle can be used
8936 on the CPAN shell command line. This command writes a bundle definition
8937 file for all modules that are installed for the currently running perl
8938 interpreter. It's recommended to run this command only once and from then
8939 on maintain the file manually under a private name, say
8940 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
8942 cpan> install Bundle::my_bundle
8944 then answer a few questions and then go out for a coffee.
8946 Maintaining a bundle definition file means keeping track of two
8947 things: dependencies and interactivity. CPAN.pm sometimes fails on
8948 calculating dependencies because not all modules define all MakeMaker
8949 attributes correctly, so a bundle definition file should specify
8950 prerequisites as early as possible. On the other hand, it's a bit
8951 annoying that many distributions need some interactive configuring. So
8952 what I try to accomplish in my private bundle file is to have the
8953 packages that need to be configured early in the file and the gentle
8954 ones later, so I can go out after a few minutes and leave CPAN.pm
8957 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
8959 Thanks to Graham Barr for contributing the following paragraphs about
8960 the interaction between perl, and various firewall configurations. For
8961 further information on firewalls, it is recommended to consult the
8962 documentation that comes with the ncftp program. If you are unable to
8963 go through the firewall with a simple Perl setup, it is very likely
8964 that you can configure ncftp so that it works for your firewall.
8966 =head2 Three basic types of firewalls
8968 Firewalls can be categorized into three basic types.
8974 This is where the firewall machine runs a web server and to access the
8975 outside world you must do it via the web server. If you set environment
8976 variables like http_proxy or ftp_proxy to a values beginning with http://
8977 or in your web browser you have to set proxy information then you know
8978 you are running an http firewall.
8980 To access servers outside these types of firewalls with perl (even for
8981 ftp) you will need to use LWP.
8985 This where the firewall machine runs an ftp server. This kind of
8986 firewall will only let you access ftp servers outside the firewall.
8987 This is usually done by connecting to the firewall with ftp, then
8988 entering a username like "user@outside.host.com"
8990 To access servers outside these type of firewalls with perl you
8991 will need to use Net::FTP.
8993 =item One way visibility
8995 I say one way visibility as these firewalls try to make themselves look
8996 invisible to the users inside the firewall. An FTP data connection is
8997 normally created by sending the remote server your IP address and then
8998 listening for the connection. But the remote server will not be able to
8999 connect to you because of the firewall. So for these types of firewall
9000 FTP connections need to be done in a passive mode.
9002 There are two that I can think off.
9008 If you are using a SOCKS firewall you will need to compile perl and link
9009 it with the SOCKS library, this is what is normally called a 'socksified'
9010 perl. With this executable you will be able to connect to servers outside
9011 the firewall as if it is not there.
9015 This is the firewall implemented in the Linux kernel, it allows you to
9016 hide a complete network behind one IP address. With this firewall no
9017 special compiling is needed as you can access hosts directly.
9019 For accessing ftp servers behind such firewalls you usually need to
9020 set the environment variable C<FTP_PASSIVE> or the config variable
9021 ftp_passive to a true value.
9027 =head2 Configuring lynx or ncftp for going through a firewall
9029 If you can go through your firewall with e.g. lynx, presumably with a
9032 /usr/local/bin/lynx -pscott:tiger
9034 then you would configure CPAN.pm with the command
9036 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
9038 That's all. Similarly for ncftp or ftp, you would configure something
9041 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
9043 Your mileage may vary...
9051 I installed a new version of module X but CPAN keeps saying,
9052 I have the old version installed
9054 Most probably you B<do> have the old version installed. This can
9055 happen if a module installs itself into a different directory in the
9056 @INC path than it was previously installed. This is not really a
9057 CPAN.pm problem, you would have the same problem when installing the
9058 module manually. The easiest way to prevent this behaviour is to add
9059 the argument C<UNINST=1> to the C<make install> call, and that is why
9060 many people add this argument permanently by configuring
9062 o conf make_install_arg UNINST=1
9066 So why is UNINST=1 not the default?
9068 Because there are people who have their precise expectations about who
9069 may install where in the @INC path and who uses which @INC array. In
9070 fine tuned environments C<UNINST=1> can cause damage.
9074 I want to clean up my mess, and install a new perl along with
9075 all modules I have. How do I go about it?
9077 Run the autobundle command for your old perl and optionally rename the
9078 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
9079 with the Configure option prefix, e.g.
9081 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
9083 Install the bundle file you produced in the first step with something like
9085 cpan> install Bundle::mybundle
9091 When I install bundles or multiple modules with one command
9092 there is too much output to keep track of.
9094 You may want to configure something like
9096 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
9097 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
9099 so that STDOUT is captured in a file for later inspection.
9104 I am not root, how can I install a module in a personal directory?
9106 First of all, you will want to use your own configuration, not the one
9107 that your root user installed. If you do not have permission to write
9108 in the cpan directory that root has configured, you will be asked if
9109 you want to create your own config. Answering "yes" will bring you into
9110 CPAN's configuration stage, using the system config for all defaults except
9111 things that have to do with CPAN's work directory, saving your choices to
9112 your MyConfig.pm file.
9114 You can also manually initiate this process with the following command:
9116 % perl -MCPAN -e 'mkmyconfig'
9122 from the CPAN shell.
9124 You will most probably also want to configure something like this:
9126 o conf makepl_arg "LIB=~/myperl/lib \
9127 INSTALLMAN1DIR=~/myperl/man/man1 \
9128 INSTALLMAN3DIR=~/myperl/man/man3"
9130 You can make this setting permanent like all C<o conf> settings with
9133 You will have to add ~/myperl/man to the MANPATH environment variable
9134 and also tell your perl programs to look into ~/myperl/lib, e.g. by
9137 use lib "$ENV{HOME}/myperl/lib";
9139 or setting the PERL5LIB environment variable.
9141 While we're speaking about $ENV{HOME}, it might be worth mentioning,
9142 that for Windows we use the File::HomeDir module that provides an
9143 equivalent to the concept of the home directory on Unix.
9145 Another thing you should bear in mind is that the UNINST parameter can
9146 be dnagerous when you are installing into a private area because you
9147 might accidentally remove modules that other people depend on that are
9148 not using the private area.
9152 How to get a package, unwrap it, and make a change before building it?
9154 Have a look at the C<look> (!) command.
9158 I installed a Bundle and had a couple of fails. When I
9159 retried, everything resolved nicely. Can this be fixed to work
9162 The reason for this is that CPAN does not know the dependencies of all
9163 modules when it starts out. To decide about the additional items to
9164 install, it just uses data found in the META.yml file or the generated
9165 Makefile. An undetected missing piece breaks the process. But it may
9166 well be that your Bundle installs some prerequisite later than some
9167 depending item and thus your second try is able to resolve everything.
9168 Please note, CPAN.pm does not know the dependency tree in advance and
9169 cannot sort the queue of things to install in a topologically correct
9170 order. It resolves perfectly well IF all modules declare the
9171 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
9172 the C<requires> stanza of Module::Build. For bundles which fail and
9173 you need to install often, it is recommended to sort the Bundle
9174 definition file manually.
9178 In our intranet we have many modules for internal use. How
9179 can I integrate these modules with CPAN.pm but without uploading
9180 the modules to CPAN?
9182 Have a look at the CPAN::Site module.
9186 When I run CPAN's shell, I get an error message about things in my
9187 /etc/inputrc (or ~/.inputrc) file.
9189 These are readline issues and can only be fixed by studying readline
9190 configuration on your architecture and adjusting the referenced file
9191 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
9192 and edit them. Quite often harmless changes like uppercasing or
9193 lowercasing some arguments solves the problem.
9197 Some authors have strange characters in their names.
9199 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
9200 expecting ISO-8859-1 charset, a converter can be activated by setting
9201 term_is_latin to a true value in your config file. One way of doing so
9204 cpan> o conf term_is_latin 1
9206 If other charset support is needed, please file a bugreport against
9207 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
9208 the support or maybe UTF-8 terminals become widely available.
9212 When an install fails for some reason and then I correct the error
9213 condition and retry, CPAN.pm refuses to install the module, saying
9214 C<Already tried without success>.
9216 Use the force pragma like so
9218 force install Foo::Bar
9220 This does a bit more than really needed because it untars the
9221 distribution again and runs make and test and only then install.
9223 Or, if you find this is too fast and you would prefer to do smaller
9228 first and then continue as always. C<Force get> I<forgets> previous
9235 and then 'make install' directly in the subshell.
9237 Or you leave the CPAN shell and start it again.
9239 For the really curious, by accessing internals directly, you I<could>
9241 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
9243 but this is neither guaranteed to work in the future nor is it a
9248 How do I install a "DEVELOPER RELEASE" of a module?
9250 By default, CPAN will install the latest non-developer release of a
9251 module. If you want to install a dev release, you have to specify the
9252 partial path starting with the author id to the tarball you wish to
9255 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
9257 Note that you can use the C<ls> command to get this path listed.
9261 How do I install a module and all its dependencies from the commandline,
9262 without being prompted for anything, despite my CPAN configuration
9265 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
9266 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
9267 asked any questions at all (assuming the modules you are installing are
9268 nice about obeying that variable as well):
9270 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
9274 How do I create a Module::Build based Build.PL derived from an
9275 ExtUtils::MakeMaker focused Makefile.PL?
9277 http://search.cpan.org/search?query=Module::Build::Convert
9279 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
9286 Please report bugs via http://rt.cpan.org/
9288 Before submitting a bug, please make sure that the traditional method
9289 of building a Perl module package from a shell by following the
9290 installation instructions of that package still works in your
9293 =head1 SECURITY ADVICE
9295 This software enables you to upgrade software on your computer and so
9296 is inherently dangerous because the newly installed software may
9297 contain bugs and may alter the way your computer works or even make it
9298 unusable. Please consider backing up your data before every upgrade.
9302 Andreas Koenig C<< <andk@cpan.org> >>
9306 This program is free software; you can redistribute it and/or
9307 modify it under the same terms as Perl itself.
9309 See L<http://www.perl.com/perl/misc/Artistic.html>
9313 Kawai,Takanori provides a Japanese translation of this manpage at
9314 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
9318 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)