From 6df60a5f39f3b9b890df28f39ad92c2ffd598e40 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sat, 26 Sep 2009 10:06:30 +0100 Subject: Move CPAN from ext/ to cpan/ --- cpan/CPAN/Makefile.PL | 10 + cpan/CPAN/lib/CPAN.pm | 3717 +++++++++++++++++++ cpan/CPAN/lib/CPAN/API/HOWTO.pod | 44 + cpan/CPAN/lib/CPAN/Author.pm | 228 ++ cpan/CPAN/lib/CPAN/Bundle.pm | 287 ++ cpan/CPAN/lib/CPAN/CacheMgr.pm | 246 ++ cpan/CPAN/lib/CPAN/Complete.pm | 175 + cpan/CPAN/lib/CPAN/Debug.pm | 79 + cpan/CPAN/lib/CPAN/DeferredCode.pm | 16 + cpan/CPAN/lib/CPAN/Distribution.pm | 3840 ++++++++++++++++++++ cpan/CPAN/lib/CPAN/Distroprefs.pm | 451 +++ cpan/CPAN/lib/CPAN/Distrostatus.pm | 45 + .../CPAN/lib/CPAN/Exception/RecursiveDependency.pm | 85 + cpan/CPAN/lib/CPAN/Exception/blocked_urllist.pm | 46 + cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm | 73 + cpan/CPAN/lib/CPAN/FTP.pm | 1090 ++++++ cpan/CPAN/lib/CPAN/FTP/netrc.pm | 63 + cpan/CPAN/lib/CPAN/FirstTime.pm | 1738 +++++++++ cpan/CPAN/lib/CPAN/HandleConfig.pm | 734 ++++ cpan/CPAN/lib/CPAN/Index.pm | 619 ++++ cpan/CPAN/lib/CPAN/InfoObj.pm | 224 ++ cpan/CPAN/lib/CPAN/Kwalify.pm | 136 + cpan/CPAN/lib/CPAN/Kwalify/distroprefs.dd | 150 + cpan/CPAN/lib/CPAN/Kwalify/distroprefs.yml | 92 + cpan/CPAN/lib/CPAN/LWP/UserAgent.pm | 135 + cpan/CPAN/lib/CPAN/Module.pm | 681 ++++ cpan/CPAN/lib/CPAN/Nox.pm | 51 + cpan/CPAN/lib/CPAN/PAUSE2003.pub | 31 + cpan/CPAN/lib/CPAN/PAUSE2005.pub | 46 + cpan/CPAN/lib/CPAN/PAUSE2007.pub | 62 + cpan/CPAN/lib/CPAN/PAUSE2009.pub | 78 + cpan/CPAN/lib/CPAN/Prompt.pm | 29 + cpan/CPAN/lib/CPAN/Queue.pm | 198 + cpan/CPAN/lib/CPAN/SIGNATURE | 481 +++ cpan/CPAN/lib/CPAN/Shell.pm | 1939 ++++++++++ cpan/CPAN/lib/CPAN/Tarzip.pm | 404 ++ cpan/CPAN/lib/CPAN/URL.pm | 31 + cpan/CPAN/lib/CPAN/Version.pm | 173 + cpan/CPAN/scripts/cpan | 467 +++ cpan/CPAN/t/01loadme.t | 15 + cpan/CPAN/t/02nox.t | 36 + cpan/CPAN/t/03pkgs.t | 36 + cpan/CPAN/t/10version.t | 129 + cpan/CPAN/t/11mirroredby.t | 29 + 44 files changed, 19239 insertions(+) create mode 100644 cpan/CPAN/Makefile.PL create mode 100644 cpan/CPAN/lib/CPAN.pm create mode 100644 cpan/CPAN/lib/CPAN/API/HOWTO.pod create mode 100644 cpan/CPAN/lib/CPAN/Author.pm create mode 100644 cpan/CPAN/lib/CPAN/Bundle.pm create mode 100644 cpan/CPAN/lib/CPAN/CacheMgr.pm create mode 100644 cpan/CPAN/lib/CPAN/Complete.pm create mode 100644 cpan/CPAN/lib/CPAN/Debug.pm create mode 100644 cpan/CPAN/lib/CPAN/DeferredCode.pm create mode 100644 cpan/CPAN/lib/CPAN/Distribution.pm create mode 100644 cpan/CPAN/lib/CPAN/Distroprefs.pm create mode 100644 cpan/CPAN/lib/CPAN/Distrostatus.pm create mode 100644 cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm create mode 100644 cpan/CPAN/lib/CPAN/Exception/blocked_urllist.pm create mode 100644 cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm create mode 100644 cpan/CPAN/lib/CPAN/FTP.pm create mode 100644 cpan/CPAN/lib/CPAN/FTP/netrc.pm create mode 100644 cpan/CPAN/lib/CPAN/FirstTime.pm create mode 100644 cpan/CPAN/lib/CPAN/HandleConfig.pm create mode 100644 cpan/CPAN/lib/CPAN/Index.pm create mode 100644 cpan/CPAN/lib/CPAN/InfoObj.pm create mode 100644 cpan/CPAN/lib/CPAN/Kwalify.pm create mode 100644 cpan/CPAN/lib/CPAN/Kwalify/distroprefs.dd create mode 100644 cpan/CPAN/lib/CPAN/Kwalify/distroprefs.yml create mode 100644 cpan/CPAN/lib/CPAN/LWP/UserAgent.pm create mode 100644 cpan/CPAN/lib/CPAN/Module.pm create mode 100644 cpan/CPAN/lib/CPAN/Nox.pm create mode 100644 cpan/CPAN/lib/CPAN/PAUSE2003.pub create mode 100644 cpan/CPAN/lib/CPAN/PAUSE2005.pub create mode 100644 cpan/CPAN/lib/CPAN/PAUSE2007.pub create mode 100644 cpan/CPAN/lib/CPAN/PAUSE2009.pub create mode 100644 cpan/CPAN/lib/CPAN/Prompt.pm create mode 100644 cpan/CPAN/lib/CPAN/Queue.pm create mode 100644 cpan/CPAN/lib/CPAN/SIGNATURE create mode 100644 cpan/CPAN/lib/CPAN/Shell.pm create mode 100644 cpan/CPAN/lib/CPAN/Tarzip.pm create mode 100644 cpan/CPAN/lib/CPAN/URL.pm create mode 100644 cpan/CPAN/lib/CPAN/Version.pm create mode 100644 cpan/CPAN/scripts/cpan create mode 100644 cpan/CPAN/t/01loadme.t create mode 100644 cpan/CPAN/t/02nox.t create mode 100644 cpan/CPAN/t/03pkgs.t create mode 100644 cpan/CPAN/t/10version.t create mode 100644 cpan/CPAN/t/11mirroredby.t (limited to 'cpan/CPAN') diff --git a/cpan/CPAN/Makefile.PL b/cpan/CPAN/Makefile.PL new file mode 100644 index 0000000000..589b59769c --- /dev/null +++ b/cpan/CPAN/Makefile.PL @@ -0,0 +1,10 @@ +use strict; +use ExtUtils::MakeMaker; + +WriteMakefile ( + NAME => 'CPAN', + VERSION_FROM => 'lib/CPAN.pm', # finds $VERSION + EXE_FILES => ['scripts/cpan'], + AUTHOR => 'Andreas Koenig ', + ABSTRACT_FROM => 'lib/CPAN.pm', +); diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm new file mode 100644 index 0000000000..1196cb0fcf --- /dev/null +++ b/cpan/CPAN/lib/CPAN.pm @@ -0,0 +1,3717 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +use strict; +package CPAN; +$CPAN::VERSION = '1.9402'; +$CPAN::VERSION =~ s/_//; + +# we need to run chdir all over and we would get at wrong libraries +# there +use File::Spec (); +BEGIN { + if (File::Spec->can("rel2abs")) { + for my $inc (@INC) { + $inc = File::Spec->rel2abs($inc) unless ref $inc; + } + } +} +use CPAN::Author; +use CPAN::HandleConfig; +use CPAN::Version; +use CPAN::Bundle; +use CPAN::CacheMgr; +use CPAN::Complete; +use CPAN::Debug; +use CPAN::Distribution; +use CPAN::Distrostatus; +use CPAN::FTP; +use CPAN::Index 1.93; # https://rt.cpan.org/Ticket/Display.html?id=43349 +use CPAN::InfoObj; +use CPAN::Module; +use CPAN::Prompt; +use CPAN::URL; +use CPAN::Queue; +use CPAN::Tarzip; +use CPAN::DeferredCode; +use CPAN::Shell; +use CPAN::LWP::UserAgent; +use CPAN::Exception::RecursiveDependency; +use CPAN::Exception::yaml_not_installed; + +use Carp (); +use Config (); +use Cwd qw(chdir); +use DirHandle (); +use Exporter (); +use ExtUtils::MakeMaker qw(prompt); # for some unknown reason, + # 5.005_04 does not work without + # this +use File::Basename (); +use File::Copy (); +use File::Find; +use File::Path (); +use FileHandle (); +use Fcntl qw(:flock); +use Safe (); +use Sys::Hostname qw(hostname); +use Text::ParseWords (); +use Text::Wrap (); + +# protect against "called too early" +sub find_perl (); +sub anycwd (); +sub _uniq; + +no lib "."; + +require Mac::BuildTools if $^O eq 'MacOS'; +if ($ENV{PERL5_CPAN_IS_RUNNING} && $$ != $ENV{PERL5_CPAN_IS_RUNNING}) { + $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} ||= $ENV{PERL5_CPAN_IS_RUNNING}; + my @rec = _uniq split(/,/, $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION}), $$; + $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} = join ",", @rec; + # warn "# Note: Recursive call of CPAN.pm detected\n"; + my $w = sprintf "# Note: CPAN.pm is running in process %d now", pop @rec; + my %sleep = ( + 5 => 30, + 6 => 60, + 7 => 120, + ); + my $sleep = @rec > 7 ? 300 : ($sleep{scalar @rec}||0); + my $verbose = @rec >= 4; + while (@rec) { + $w .= sprintf " which has been called by process %d", pop @rec; + } + if ($sleep) { + $w .= ".\n\n# Sleeping $sleep seconds to protect other processes\n"; + } + if ($verbose) { + warn $w; + } + local $| = 1; + while ($sleep > 0) { + printf "\r#%5d", --$sleep; + sleep 1; + } + print "\n"; +} +$ENV{PERL5_CPAN_IS_RUNNING}=$$; +$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735 + +END { $CPAN::End++; &cleanup; } + +$CPAN::Signal ||= 0; +$CPAN::Frontend ||= "CPAN::Shell"; +unless (@CPAN::Defaultsites) { + @CPAN::Defaultsites = map { + CPAN::URL->new(TEXT => $_, FROM => "DEF") + } + "http://www.perl.org/CPAN/", + "ftp://ftp.perl.org/pub/CPAN/"; +} +# $CPAN::iCwd (i for initial) +$CPAN::iCwd ||= CPAN::anycwd(); +$CPAN::Perl ||= CPAN::find_perl(); +$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?"; +$CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf"; +$CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml"; + +# our globals are getting a mess +use vars qw( + $AUTOLOAD + $Be_Silent + $CONFIG_DIRTY + $Defaultdocs + $Echo_readline + $Frontend + $GOTOSHELL + $HAS_USABLE + $Have_warned + $MAX_RECURSION + $META + $RUN_DEGRADED + $Signal + $SQLite + $Suppress_readline + $VERSION + $autoload_recursion + $term + @Defaultsites + @EXPORT + ); + +$MAX_RECURSION = 32; + +@CPAN::ISA = qw(CPAN::Debug Exporter); + +# note that these functions live in CPAN::Shell and get executed via +# AUTOLOAD when called directly +@EXPORT = qw( + autobundle + bundle + clean + cvs_import + expand + force + fforce + get + install + install_tested + is_tested + make + mkmyconfig + notest + perldoc + readme + recent + recompile + report + shell + smoke + test + upgrade + ); + +sub soft_chdir_with_alternatives ($); + +{ + $autoload_recursion ||= 0; + + #-> sub CPAN::AUTOLOAD ; + sub AUTOLOAD { ## no critic + $autoload_recursion++; + my($l) = $AUTOLOAD; + $l =~ s/.*:://; + if ($CPAN::Signal) { + warn "Refusing to autoload '$l' while signal pending"; + $autoload_recursion--; + return; + } + if ($autoload_recursion > 1) { + my $fullcommand = join " ", map { "'$_'" } $l, @_; + warn "Refusing to autoload $fullcommand in recursion\n"; + $autoload_recursion--; + return; + } + my(%export); + @export{@EXPORT} = ''; + CPAN::HandleConfig->load unless $CPAN::Config_loaded++; + if (exists $export{$l}) { + CPAN::Shell->$l(@_); + } else { + die(qq{Unknown CPAN command "$AUTOLOAD". }. + qq{Type ? for help.\n}); + } + $autoload_recursion--; + } +} + +{ + my $x = *SAVEOUT; # avoid warning + open($x,">&STDOUT") or die "dup failed"; + my $redir = 0; + sub _redirect(@) { + #die if $redir; + local $_; + push(@_,undef); + while(defined($_=shift)) { + if (s/^\s*>//){ + my ($m) = s/^>// ? ">" : ""; + s/\s+//; + $_=shift unless length; + die "no dest" unless defined; + open(STDOUT,">$m$_") or die "open:$_:$!\n"; + $redir=1; + } elsif ( s/^\s*\|\s*// ) { + my $pipe="| $_"; + while(defined($_[0])){ + $pipe .= ' ' . shift; + } + open(STDOUT,$pipe) or die "open:$pipe:$!\n"; + $redir=1; + } else { + push(@_,$_); + } + } + return @_; + } + sub _unredirect { + return unless $redir; + $redir = 0; + ## redirect: unredirect and propagate errors. explicit close to wait for pipe. + close(STDOUT); + open(STDOUT,">&SAVEOUT"); + die "$@" if "$@"; + ## redirect: done + } +} + +sub _uniq { + my(@list) = @_; + my %seen; + return grep { !$seen{$_}++ } @list; +} + +#-> sub CPAN::shell ; +sub shell { + my($self) = @_; + $Suppress_readline = ! -t STDIN unless defined $Suppress_readline; + CPAN::HandleConfig->load unless $CPAN::Config_loaded++; + + my $oprompt = shift || CPAN::Prompt->new; + my $prompt = $oprompt; + my $commandline = shift || ""; + $CPAN::CurrentCommandId ||= 1; + + local($^W) = 1; + unless ($Suppress_readline) { + require Term::ReadLine; + if (! $term + or + $term->ReadLine eq "Term::ReadLine::Stub" + ) { + $term = Term::ReadLine->new('CPAN Monitor'); + } + if ($term->ReadLine eq "Term::ReadLine::Gnu") { + my $attribs = $term->Attribs; + $attribs->{attempted_completion_function} = sub { + &CPAN::Complete::gnu_cpl; + } + } else { + $readline::rl_completion_function = + $readline::rl_completion_function = 'CPAN::Complete::cpl'; + } + if (my $histfile = $CPAN::Config->{'histfile'}) {{ + unless ($term->can("AddHistory")) { + $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n"); + last; + } + $META->readhist($term,$histfile); + }} + for ($CPAN::Config->{term_ornaments}) { # alias + local $Term::ReadLine::termcap_nowarn = 1; + $term->ornaments($_) if defined; + } + # $term->OUT is autoflushed anyway + my $odef = select STDERR; + $| = 1; + select STDOUT; + $| = 1; + select $odef; + } + + $META->checklock(); + my @cwd = grep { defined $_ and length $_ } + CPAN::anycwd(), + File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (), + File::Spec->rootdir(); + my $try_detect_readline; + $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term; + unless ($CPAN::Config->{inhibit_startup_message}) { + my $rl_avail = $Suppress_readline ? "suppressed" : + ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" : + "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)"; + $CPAN::Frontend->myprint( + sprintf qq{ +cpan shell -- CPAN exploration and modules installation (v%s) +Enter 'h' for help. + +}, + $CPAN::VERSION, + $rl_avail + ) + } + my($continuation) = ""; + my $last_term_ornaments; + SHELLCOMMAND: while () { + if ($Suppress_readline) { + if ($Echo_readline) { + $|=1; + } + print $prompt; + last SHELLCOMMAND unless defined ($_ = <> ); + if ($Echo_readline) { + # backdoor: I could not find a way to record sessions + print $_; + } + chomp; + } else { + last SHELLCOMMAND unless + defined ($_ = $term->readline($prompt, $commandline)); + } + $_ = "$continuation$_" if $continuation; + s/^\s+//; + next SHELLCOMMAND if /^$/; + s/^\s*\?\s*/help /; + if (/^(?:q(?:uit)?|bye|exit)$/i) { + last SHELLCOMMAND; + } elsif (s/\\$//s) { + chomp; + $continuation = $_; + $prompt = " > "; + } elsif (/^\!/) { + s/^\!//; + my($eval) = $_; + package + CPAN::Eval; # hide from the indexer + use strict; + use vars qw($import_done); + CPAN->import(':DEFAULT') unless $import_done++; + CPAN->debug("eval[$eval]") if $CPAN::DEBUG; + eval($eval); + warn $@ if $@; + $continuation = ""; + $prompt = $oprompt; + } elsif (/./) { + my(@line); + eval { @line = Text::ParseWords::shellwords($_) }; + warn($@), next SHELLCOMMAND if $@; + warn("Text::Parsewords could not parse the line [$_]"), + next SHELLCOMMAND unless @line; + $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG; + my $command = shift @line; + eval { + local (*STDOUT)=*STDOUT; + @line = _redirect(@line); + CPAN::Shell->$command(@line) + }; + my $command_error = $@; + _unredirect; + my $reported_error; + if ($command_error) { + my $err = $command_error; + if (ref $err and $err->isa('CPAN::Exception::blocked_urllist')) { + $CPAN::Frontend->mywarn("Client not fully configured, please proceed with configuring.$err"); + $reported_error = ref $err; + } else { + # I'd prefer never to arrive here and make all errors exception objects + if ($err =~ /\S/) { + require Carp; + require Dumpvalue; + my $dv = Dumpvalue->new(tick => '"'); + Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err)); + } + } + } + if ($command =~ /^( + # classic commands + make + |test + |install + |clean + + # pragmas for classic commands + |ff?orce + |notest + + # compounds + |report + |smoke + |upgrade + )$/x) { + # only commands that tell us something about failed distros + # eval necessary for people without an urllist + eval {CPAN::Shell->failed($CPAN::CurrentCommandId,1);}; + if (my $err = $@) { + unless (ref $err and $reported_error eq ref $err) { + die $@; + } + } + } + soft_chdir_with_alternatives(\@cwd); + $CPAN::Frontend->myprint("\n"); + $continuation = ""; + $CPAN::CurrentCommandId++; + $prompt = $oprompt; + } + } continue { + $commandline = ""; # I do want to be able to pass a default to + # shell, but on the second command I see no + # use in that + $Signal=0; + CPAN::Queue->nullify_queue; + if ($try_detect_readline) { + if ($CPAN::META->has_inst("Term::ReadLine::Gnu") + || + $CPAN::META->has_inst("Term::ReadLine::Perl") + ) { + delete $INC{"Term/ReadLine.pm"}; + my $redef = 0; + local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef); + require Term::ReadLine; + $CPAN::Frontend->myprint("\n$redef subroutines in ". + "Term::ReadLine redefined\n"); + $GOTOSHELL = 1; + } + } + if ($term and $term->can("ornaments")) { + for ($CPAN::Config->{term_ornaments}) { # alias + if (defined $_) { + if (not defined $last_term_ornaments + or $_ != $last_term_ornaments + ) { + local $Term::ReadLine::termcap_nowarn = 1; + $term->ornaments($_); + $last_term_ornaments = $_; + } + } else { + undef $last_term_ornaments; + } + } + } + for my $class (qw(Module Distribution)) { + # again unsafe meta access? + for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) { + next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor}; + CPAN->debug("BUG: $class '$dm' was in command state, resetting"); + delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor}; + } + } + if ($GOTOSHELL) { + $GOTOSHELL = 0; # not too often + $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory"); + @_ = ($oprompt,""); + goto &shell; + } + } + soft_chdir_with_alternatives(\@cwd); +} + +#-> CPAN::soft_chdir_with_alternatives ; +sub soft_chdir_with_alternatives ($) { + my($cwd) = @_; + unless (@$cwd) { + my $root = File::Spec->rootdir(); + $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to! +Trying '$root' as temporary haven. +}); + push @$cwd, $root; + } + while () { + if (chdir $cwd->[0]) { + return; + } else { + if (@$cwd>1) { + $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $! +Trying to chdir to "$cwd->[1]" instead. +}); + shift @$cwd; + } else { + $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!}); + } + } + } +} + +sub _flock { + my($fh,$mode) = @_; + if ( $Config::Config{d_flock} || $Config::Config{d_fcntl_can_lock} ) { + return flock $fh, $mode; + } elsif (!$Have_warned->{"d_flock"}++) { + $CPAN::Frontend->mywarn("Your OS does not seem to support locking; continuing and ignoring all locking issues\n"); + $CPAN::Frontend->mysleep(5); + return 1; + } else { + return 1; + } +} + +sub _yaml_module () { + my $yaml_module = $CPAN::Config->{yaml_module} || "YAML"; + if ( + $yaml_module ne "YAML" + && + !$CPAN::META->has_inst($yaml_module) + ) { + # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n"); + $yaml_module = "YAML"; + } + if ($yaml_module eq "YAML" + && + $CPAN::META->has_inst($yaml_module) + && + $YAML::VERSION < 0.60 + && + !$Have_warned->{"YAML"}++ + ) { + $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n". + "I'll continue but problems are *very* likely to happen.\n" + ); + $CPAN::Frontend->mysleep(5); + } + return $yaml_module; +} + +# CPAN::_yaml_loadfile +sub _yaml_loadfile { + my($self,$local_file) = @_; + return +[] unless -s $local_file; + my $yaml_module = _yaml_module; + if ($CPAN::META->has_inst($yaml_module)) { + # temporarly enable yaml code deserialisation + no strict 'refs'; + # 5.6.2 could not do the local() with the reference + # so we do it manually instead + my $old_loadcode = ${"$yaml_module\::LoadCode"}; + ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0; + + my ($code, @yaml); + if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) { + eval { @yaml = $code->($local_file); }; + if ($@) { + # this shall not be done by the frontend + die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@); + } + } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) { + local *FH; + open FH, $local_file or die "Could not open '$local_file': $!"; + local $/; + my $ystream = ; + eval { @yaml = $code->($ystream); }; + if ($@) { + # this shall not be done by the frontend + die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@); + } + } + ${"$yaml_module\::LoadCode"} = $old_loadcode; + return \@yaml; + } else { + # this shall not be done by the frontend + die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse"); + } + return +[]; +} + +# CPAN::_yaml_dumpfile +sub _yaml_dumpfile { + my($self,$local_file,@what) = @_; + my $yaml_module = _yaml_module; + if ($CPAN::META->has_inst($yaml_module)) { + my $code; + if (UNIVERSAL::isa($local_file, "FileHandle")) { + $code = UNIVERSAL::can($yaml_module, "Dump"); + eval { print $local_file $code->(@what) }; + } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) { + eval { $code->($local_file,@what); }; + } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) { + local *FH; + open FH, ">$local_file" or die "Could not open '$local_file': $!"; + print FH $code->(@what); + } + if ($@) { + die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@); + } + } else { + if (UNIVERSAL::isa($local_file, "FileHandle")) { + # I think this case does not justify a warning at all + } else { + die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump"); + } + } +} + +sub _init_sqlite () { + unless ($CPAN::META->has_inst("CPAN::SQLite")) { + $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n}) + unless $Have_warned->{"CPAN::SQLite"}++; + return; + } + require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17 + $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META); +} + +{ + my $negative_cache = {}; + sub _sqlite_running { + if ($negative_cache->{time} && time < $negative_cache->{time} + 60) { + # need to cache the result, otherwise too slow + return $negative_cache->{fact}; + } else { + $negative_cache = {}; # reset + } + my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite()); + return $ret if $ret; # fast anyway + $negative_cache->{time} = time; + return $negative_cache->{fact} = $ret; + } +} + +$META ||= CPAN->new; # In case we re-eval ourselves we need the || + +# from here on only subs. +################################################################################ + +sub _perl_fingerprint { + my($self,$other_fingerprint) = @_; + my $dll = eval {OS2::DLLname()}; + my $mtime_dll = 0; + if (defined $dll) { + $mtime_dll = (-f $dll ? (stat(_))[9] : '-1'); + } + my $mtime_perl = (-f CPAN::find_perl ? (stat(_))[9] : '-1'); + my $this_fingerprint = { + '$^X' => CPAN::find_perl, + sitearchexp => $Config::Config{sitearchexp}, + 'mtime_$^X' => $mtime_perl, + 'mtime_dll' => $mtime_dll, + }; + if ($other_fingerprint) { + if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57 + $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9]; + } + # mandatory keys since 1.88_57 + for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) { + return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key}; + } + return 1; + } else { + return $this_fingerprint; + } +} + +sub suggest_myconfig () { + SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) { + $CPAN::Frontend->myprint("You don't seem to have a user ". + "configuration (MyConfig.pm) yet.\n"); + my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ". + "user configuration now? (Y/n)", + "yes"); + if($new =~ m{^y}i) { + CPAN::Shell->mkmyconfig(); + return &checklock; + } else { + $CPAN::Frontend->mydie("OK, giving up."); + } + } +} + +#-> sub CPAN::all_objects ; +sub all_objects { + my($mgr,$class) = @_; + CPAN::HandleConfig->load unless $CPAN::Config_loaded++; + CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG; + CPAN::Index->reload; + values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok +} + +# Called by shell, not in batch mode. In batch mode I see no risk in +# having many processes updating something as installations are +# continually checked at runtime. In shell mode I suspect it is +# unintentional to open more than one shell at a time + +#-> sub CPAN::checklock ; +sub checklock { + my($self) = @_; + my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock"); + if (-f $lockfile && -M _ > 0) { + my $fh = FileHandle->new($lockfile) or + $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!"); + my $otherpid = <$fh>; + my $otherhost = <$fh>; + $fh->close; + if (defined $otherpid && $otherpid) { + chomp $otherpid; + } + if (defined $otherhost && $otherhost) { + chomp $otherhost; + } + my $thishost = hostname(); + if (defined $otherhost && defined $thishost && + $otherhost ne '' && $thishost ne '' && + $otherhost ne $thishost) { + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n". + "reports other host $otherhost and other ". + "process $otherpid.\n". + "Cannot proceed.\n")); + } elsif ($RUN_DEGRADED) { + $CPAN::Frontend->mywarn("Running in downgraded mode (experimental)\n"); + } elsif (defined $otherpid && $otherpid) { + return if $$ == $otherpid; # should never happen + $CPAN::Frontend->mywarn( + qq{ +There seems to be running another CPAN process (pid $otherpid). Contacting... +}); + if (kill 0, $otherpid or $!{EPERM}) { + $CPAN::Frontend->mywarn(qq{Other job is running.\n}); + my($ans) = + CPAN::Shell::colorable_makemaker_prompt + (qq{Shall I try to run in downgraded }. + qq{mode? (Y/n)},"y"); + if ($ans =~ /^y/i) { + $CPAN::Frontend->mywarn("Running in downgraded mode (experimental). +Please report if something unexpected happens\n"); + $RUN_DEGRADED = 1; + for ($CPAN::Config) { + # XXX + # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that? + $_->{commandnumber_in_prompt} = 0; # visibility + $_->{histfile} = ""; # who should win otherwise? + $_->{cache_metadata} = 0; # better would be a lock? + $_->{use_sqlite} = 0; # better would be a write lock! + $_->{auto_commit} = 0; # we are violent, do not persist + $_->{test_report} = 0; # Oliver Paukstadt had sent wrong reports in degraded mode + } + } else { + $CPAN::Frontend->mydie(" +You may want to kill the other job and delete the lockfile. On UNIX try: + kill $otherpid + rm $lockfile +"); + } + } elsif (-w $lockfile) { + my($ans) = + CPAN::Shell::colorable_makemaker_prompt + (qq{Other job not responding. Shall I overwrite }. + qq{the lockfile '$lockfile'? (Y/n)},"y"); + $CPAN::Frontend->myexit("Ok, bye\n") + unless $ans =~ /^y/i; + } else { + Carp::croak( + qq{Lockfile '$lockfile' not writable by you. }. + qq{Cannot proceed.\n}. + qq{ On UNIX try:\n}. + qq{ rm '$lockfile'\n}. + qq{ and then rerun us.\n} + ); + } + } else { + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ". + "'$lockfile', please remove. Cannot proceed.\n")); + } + } + my $dotcpan = $CPAN::Config->{cpan_home}; + eval { File::Path::mkpath($dotcpan);}; + if ($@) { + # A special case at least for Jarkko. + my $firsterror = $@; + my $seconderror; + my $symlinkcpan; + if (-l $dotcpan) { + $symlinkcpan = readlink $dotcpan; + die "readlink $dotcpan failed: $!" unless defined $symlinkcpan; + eval { File::Path::mkpath($symlinkcpan); }; + if ($@) { + $seconderror = $@; + } else { + $CPAN::Frontend->mywarn(qq{ +Working directory $symlinkcpan created. +}); + } + } + unless (-d $dotcpan) { + my $mess = qq{ +Your configuration suggests "$dotcpan" as your +CPAN.pm working directory. I could not create this directory due +to this error: $firsterror\n}; + $mess .= qq{ +As "$dotcpan" is a symlink to "$symlinkcpan", +I tried to create that, but I failed with this error: $seconderror +} if $seconderror; + $mess .= qq{ +Please make sure the directory exists and is writable. +}; + $CPAN::Frontend->mywarn($mess); + return suggest_myconfig; + } + } # $@ after eval mkpath $dotcpan + if (0) { # to test what happens when a race condition occurs + for (reverse 1..10) { + print $_, "\n"; + sleep 1; + } + } + # locking + if (!$RUN_DEGRADED && !$self->{LOCKFH}) { + my $fh; + unless ($fh = FileHandle->new("+>>$lockfile")) { + if ($! =~ /Permission/) { + $CPAN::Frontend->mywarn(qq{ + +Your configuration suggests that CPAN.pm should use a working +directory of + $CPAN::Config->{cpan_home} +Unfortunately we could not create the lock file + $lockfile +due to permission problems. + +Please make sure that the configuration variable + \$CPAN::Config->{cpan_home} +points to a directory where you can write a .lock file. You can set +this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your +\@INC path; +}); + return suggest_myconfig; + } + } + my $sleep = 1; + while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) { + if ($sleep>10) { + $CPAN::Frontend->mydie("Giving up\n"); + } + $CPAN::Frontend->mysleep($sleep++); + $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n"); + } + + seek $fh, 0, 0; + truncate $fh, 0; + $fh->autoflush(1); + $fh->print($$, "\n"); + $fh->print(hostname(), "\n"); + $self->{LOCK} = $lockfile; + $self->{LOCKFH} = $fh; + } + $SIG{TERM} = sub { + my $sig = shift; + &cleanup; + $CPAN::Frontend->mydie("Got SIG$sig, leaving"); + }; + $SIG{INT} = sub { + # no blocks!!! + my $sig = shift; + &cleanup if $Signal; + die "Got yet another signal" if $Signal > 1; + $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal; + $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n"); + $Signal++; + }; + +# From: Larry Wall +# Subject: Re: deprecating SIGDIE +# To: perl5-porters@perl.org +# Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT) +# +# The original intent of __DIE__ was only to allow you to substitute one +# kind of death for another on an application-wide basis without respect +# to whether you were in an eval or not. As a global backstop, it should +# not be used any more lightly (or any more heavily :-) than class +# UNIVERSAL. Any attempt to build a general exception model on it should +# be politely squashed. Any bug that causes every eval {} to have to be +# modified should be not so politely squashed. +# +# Those are my current opinions. It is also my optinion that polite +# arguments degenerate to personal arguments far too frequently, and that +# when they do, it's because both people wanted it to, or at least didn't +# sufficiently want it not to. +# +# Larry + + # global backstop to cleanup if we should really die + $SIG{__DIE__} = \&cleanup; + $self->debug("Signal handler set.") if $CPAN::DEBUG; +} + +#-> sub CPAN::DESTROY ; +sub DESTROY { + &cleanup; # need an eval? +} + +#-> sub CPAN::anycwd ; +sub anycwd () { + my $getcwd; + $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + CPAN->$getcwd(); +} + +#-> sub CPAN::cwd ; +sub cwd {Cwd::cwd();} + +#-> sub CPAN::getcwd ; +sub getcwd {Cwd::getcwd();} + +#-> sub CPAN::fastcwd ; +sub fastcwd {Cwd::fastcwd();} + +#-> sub CPAN::backtickcwd ; +sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd} + +#-> sub CPAN::find_perl ; +sub find_perl () { + my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : ""; + unless ($perl) { + my $candidate = File::Spec->catfile($CPAN::iCwd,$^X); + $^X = $perl = $candidate if MM->maybe_command($candidate); + } + unless ($perl) { + my ($component,$perl_name); + DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") { + PATH_COMPONENT: foreach $component (File::Spec->path(), + $Config::Config{'binexp'}) { + next unless defined($component) && $component; + my($abs) = File::Spec->catfile($component,$perl_name); + if (MM->maybe_command($abs)) { + $^X = $perl = $abs; + last DIST_PERLNAME; + } + } + } + } + return $perl; +} + + +#-> sub CPAN::exists ; +sub exists { + my($mgr,$class,$id) = @_; + CPAN::HandleConfig->load unless $CPAN::Config_loaded++; + CPAN::Index->reload; + ### Carp::croak "exists called without class argument" unless $class; + $id ||= ""; + $id =~ s/:+/::/g if $class eq "CPAN::Module"; + my $exists; + if (CPAN::_sqlite_running) { + $exists = (exists $META->{readonly}{$class}{$id} or + $CPAN::SQLite->set($class, $id)); + } else { + $exists = exists $META->{readonly}{$class}{$id}; + } + $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok +} + +#-> sub CPAN::delete ; +sub delete { + my($mgr,$class,$id) = @_; + delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok + delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok +} + +#-> sub CPAN::has_usable +# has_inst is sometimes too optimistic, we should replace it with this +# has_usable whenever a case is given +sub has_usable { + my($self,$mod,$message) = @_; + return 1 if $HAS_USABLE->{$mod}; + my $has_inst = $self->has_inst($mod,$message); + return unless $has_inst; + my $usable; + $usable = { + LWP => [ # we frequently had "Can't locate object + # method "new" via package "LWP::UserAgent" at + # (eval 69) line 2006 + sub {require LWP}, + sub {require LWP::UserAgent}, + sub {require HTTP::Request}, + sub {require URI::URL}, + ], + 'Net::FTP' => [ + sub {require Net::FTP}, + sub {require Net::Config}, + ], + 'File::HomeDir' => [ + sub {require File::HomeDir; + unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) { + for ("Will not use File::HomeDir, need 0.52\n") { + $CPAN::Frontend->mywarn($_); + die $_; + } + } + }, + ], + 'Archive::Tar' => [ + sub {require Archive::Tar; + unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.50)) { + for ("Will not use Archive::Tar, need 1.00\n") { + $CPAN::Frontend->mywarn($_); + die $_; + } + } + unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.50)) { + my $atv = Archive::Tar->VERSION; + $CPAN::Frontend->mywarn("You have Archive::Tar $atv, but 1.50 or later is recommended. Please upgrade.\n"); + } + }, + ], + 'File::Temp' => [ + # XXX we should probably delete from + # %INC too so we can load after we + # installed a new enough version -- + # I'm not sure. + sub {require File::Temp; + unless (CPAN::Version->vge(File::Temp::->VERSION,0.16)) { + for ("Will not use File::Temp, need 0.16\n") { + $CPAN::Frontend->mywarn($_); + die $_; + } + } + }, + ] + }; + if ($usable->{$mod}) { + for my $c (0..$#{$usable->{$mod}}) { + my $code = $usable->{$mod}[$c]; + my $ret = eval { &$code() }; + $ret = "" unless defined $ret; + if ($@) { + # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]"; + return; + } + } + } + return $HAS_USABLE->{$mod} = 1; +} + +#-> sub CPAN::has_inst +sub has_inst { + my($self,$mod,$message) = @_; + Carp::croak("CPAN->has_inst() called without an argument") + unless defined $mod; + my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}}, + keys %{$CPAN::Config->{dontload_hash}||{}}, + @{$CPAN::Config->{dontload_list}||[]}; + if (defined $message && $message eq "no" # afair only used by Nox + || + $dont{$mod} + ) { + $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok + return 0; + } + my $file = $mod; + my $obj; + $file =~ s|::|/|g; + $file .= ".pm"; + if ($INC{$file}) { + # checking %INC is wrong, because $INC{LWP} may be true + # although $INC{"URI/URL.pm"} may have failed. But as + # I really want to say "bla loaded OK", I have to somehow + # cache results. + ### warn "$file in %INC"; #debug + return 1; + } elsif (eval { require $file }) { + # eval is good: if we haven't yet read the database it's + # perfect and if we have installed the module in the meantime, + # it tries again. The second require is only a NOOP returning + # 1 if we had success, otherwise it's retrying + + my $mtime = (stat $INC{$file})[9]; + # privileged files loaded by has_inst; Note: we use $mtime + # as a proxy for a checksum. + $CPAN::Shell::reload->{$file} = $mtime; + my $v = eval "\$$mod\::VERSION"; + $v = $v ? " (v$v)" : ""; + CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n"); + if ($mod eq "CPAN::WAIT") { + push @CPAN::Shell::ISA, 'CPAN::WAIT'; + } + return 1; + } elsif ($mod eq "Net::FTP") { + $CPAN::Frontend->mywarn(qq{ + Please, install Net::FTP as soon as possible. CPAN.pm installs it for you + if you just type + install Bundle::libnet + +}) unless $Have_warned->{"Net::FTP"}++; + $CPAN::Frontend->mysleep(3); + } elsif ($mod eq "Digest::SHA") { + if ($Have_warned->{"Digest::SHA"}++) { + $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }. + qq{because Digest::SHA not installed.\n}); + } else { + $CPAN::Frontend->mywarn(qq{ + CPAN: checksum security checks disabled because Digest::SHA not installed. + Please consider installing the Digest::SHA module. + +}); + $CPAN::Frontend->mysleep(2); + } + } elsif ($mod eq "Module::Signature") { + # NOT prefs_lookup, we are not a distro + my $check_sigs = $CPAN::Config->{check_sigs}; + if (not $check_sigs) { + # they do not want us:-( + } elsif (not $Have_warned->{"Module::Signature"}++) { + # No point in complaining unless the user can + # reasonably install and use it. + if (eval { require Crypt::OpenPGP; 1 } || + ( + defined $CPAN::Config->{'gpg'} + && + $CPAN::Config->{'gpg'} =~ /\S/ + ) + ) { + $CPAN::Frontend->mywarn(qq{ + CPAN: Module::Signature security checks disabled because Module::Signature + not installed. Please consider installing the Module::Signature module. + You may also need to be able to connect over the Internet to the public + keyservers like pgp.mit.edu (port 11371). + +}); + $CPAN::Frontend->mysleep(2); + } + } + } else { + delete $INC{$file}; # if it inc'd LWP but failed during, say, URI + } + return 0; +} + +#-> sub CPAN::instance ; +sub instance { + my($mgr,$class,$id) = @_; + CPAN::Index->reload; + $id ||= ""; + # unsafe meta access, ok? + return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id}; + $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id); +} + +#-> sub CPAN::new ; +sub new { + bless {}, shift; +} + +#-> sub CPAN::cleanup ; +sub cleanup { + # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]"; + local $SIG{__DIE__} = ''; + my($message) = @_; + my $i = 0; + my $ineval = 0; + my($subroutine); + while ((undef,undef,undef,$subroutine) = caller(++$i)) { + $ineval = 1, last if + $subroutine eq '(eval)'; + } + return if $ineval && !$CPAN::End; + return unless defined $META->{LOCK}; + return unless -f $META->{LOCK}; + $META->savehist; + close $META->{LOCKFH}; + unlink $META->{LOCK}; + # require Carp; + # Carp::cluck("DEBUGGING"); + if ( $CPAN::CONFIG_DIRTY ) { + $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n"); + } + $CPAN::Frontend->myprint("Lockfile removed.\n"); +} + +#-> sub CPAN::readhist +sub readhist { + my($self,$term,$histfile) = @_; + my $histsize = $CPAN::Config->{'histsize'} || 100; + $term->Attribs->{'MaxHistorySize'} = $histsize if (defined($term->Attribs->{'MaxHistorySize'})); + my($fh) = FileHandle->new; + open $fh, "<$histfile" or return; + local $/ = "\n"; + while (<$fh>) { + chomp; + $term->AddHistory($_); + } + close $fh; +} + +#-> sub CPAN::savehist +sub savehist { + my($self) = @_; + my($histfile,$histsize); + unless ($histfile = $CPAN::Config->{'histfile'}) { + $CPAN::Frontend->mywarn("No history written (no histfile specified).\n"); + return; + } + $histsize = $CPAN::Config->{'histsize'} || 100; + if ($CPAN::term) { + unless ($CPAN::term->can("GetHistory")) { + $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n"); + return; + } + } else { + return; + } + my @h = $CPAN::term->GetHistory; + splice @h, 0, @h-$histsize if @h>$histsize; + my($fh) = FileHandle->new; + open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!"); + local $\ = local $, = "\n"; + print $fh @h; + close $fh; +} + +#-> sub CPAN::is_tested +sub is_tested { + my($self,$what,$when) = @_; + unless ($what) { + Carp::cluck("DEBUG: empty what"); + return; + } + $self->{is_tested}{$what} = $when; +} + +#-> sub CPAN::reset_tested +# forget all distributions tested -- resets what gets included in PERL5LIB +sub reset_tested { + my ($self) = @_; + $self->{is_tested} = {}; +} + +#-> sub CPAN::is_installed +# unsets the is_tested flag: as soon as the thing is installed, it is +# not needed in set_perl5lib anymore +sub is_installed { + my($self,$what) = @_; + delete $self->{is_tested}{$what}; +} + +sub _list_sorted_descending_is_tested { + my($self) = @_; + sort + { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) } + keys %{$self->{is_tested}} +} + +#-> sub CPAN::set_perl5lib +# Notes on max environment variable length: +# - Win32 : XP or later, 8191; Win2000 or NT4, 2047 +{ +my $fh; +sub set_perl5lib { + my($self,$for) = @_; + unless ($for) { + (undef,undef,undef,$for) = caller(1); + $for =~ s/.*://; + } + $self->{is_tested} ||= {}; + return unless %{$self->{is_tested}}; + my $env = $ENV{PERL5LIB}; + $env = $ENV{PERLLIB} unless defined $env; + my @env; + push @env, split /\Q$Config::Config{path_sep}\E/, $env if defined $env and length $env; + #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}}; + #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n"); + + my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested; + return if !@dirs; + + if (@dirs < 12) { + $CPAN::Frontend->optprint('perl5lib', "Prepending @dirs to PERL5LIB for '$for'\n"); + $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env; + } elsif (@dirs < 24 ) { + my @d = map {my $cp = $_; + $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/; + $cp + } @dirs; + $CPAN::Frontend->optprint('perl5lib', "Prepending @d to PERL5LIB; ". + "%BUILDDIR%=$CPAN::Config->{build_dir} ". + "for '$for'\n" + ); + $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env; + } else { + my $cnt = keys %{$self->{is_tested}}; + $CPAN::Frontend->optprint('perl5lib', "Prepending blib/arch and blib/lib of ". + "$cnt build dirs to PERL5LIB; ". + "for '$for'\n" + ); + $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env; + } +}} + + +1; + + +__END__ + +=head1 NAME + +CPAN - query, download and build perl modules from CPAN sites + +=head1 SYNOPSIS + +Interactive mode: + + perl -MCPAN -e shell + +--or-- + + cpan + +Basic commands: + + # Modules: + + cpan> install Acme::Meta # in the shell + + CPAN::Shell->install("Acme::Meta"); # in perl + + # Distributions: + + cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell + + CPAN::Shell-> + install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl + + # module objects: + + $mo = CPAN::Shell->expandany($mod); + $mo = CPAN::Shell->expand("Module",$mod); # same thing + + # distribution objects: + + $do = CPAN::Shell->expand("Module",$mod)->distribution; + $do = CPAN::Shell->expandany($distro); # same thing + $do = CPAN::Shell->expand("Distribution", + $distro); # same thing + +=head1 DESCRIPTION + +The CPAN module automates or at least simplifies the make and install +of perl modules and extensions. It includes some primitive searching +capabilities and knows how to use Net::FTP, LWP, and certain external +download clients to fetch distributions from the net. + +These are fetched from one or more mirrored CPAN (Comprehensive +Perl Archive Network) sites and unpacked in a dedicated directory. + +The CPAN module also supports named and versioned +I of modules. Bundles simplify handling of sets of +related modules. See Bundles below. + +The package contains a session manager and a cache manager. The +session manager keeps track of what has been fetched, built, and +installed in the current session. The cache manager keeps track of the +disk space occupied by the make processes and deletes excess space +using a simple FIFO mechanism. + +All methods provided are accessible in a programmer style and in an +interactive shell style. + +=head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode + +Enter interactive mode by running + + perl -MCPAN -e shell + +or + + cpan + +which puts you into a readline interface. If C and +either of C or C are installed, +history and command completion are supported. + +Once at the command line, type C for one-page help +screen; the rest should be self-explanatory. + +The function call C takes two optional arguments: one the +prompt, the second the default initial command line (the latter +only works if a real ReadLine interface module is installed). + +The most common uses of the interactive modes are + +=over 2 + +=item Searching for authors, bundles, distribution files and modules + +There are corresponding one-letter commands C, C, C, and C +for each of the four categories and another, C for any of the +mentioned four. Each of the four entities is implemented as a class +with slightly differing methods for displaying an object. + +Arguments to these commands are either strings exactly matching +the identification string of an object, or regular expressions +matched case-insensitively against various attributes of the +objects. The parser only recognizes a regular expression when you +enclose it with slashes. + +The principle is that the number of objects found influences how an +item is displayed. If the search finds one item, the result is +displayed with the rather verbose method C, but if +more than one is found, each object is displayed with the terse method +C. + +Examples: + + cpan> m Acme::MetaSyntactic + Module id = Acme::MetaSyntactic + CPAN_USERID BOOK (Philippe Bruhat (BooK) <[...]>) + CPAN_VERSION 0.99 + CPAN_FILE B/BO/BOOK/Acme-MetaSyntactic-0.99.tar.gz + UPLOAD_DATE 2006-11-06 + MANPAGE Acme::MetaSyntactic - Themed metasyntactic variables names + INST_FILE /usr/local/lib/perl/5.10.0/Acme/MetaSyntactic.pm + INST_VERSION 0.99 + cpan> a BOOK + Author id = BOOK + EMAIL [...] + FULLNAME Philippe Bruhat (BooK) + cpan> d BOOK/Acme-MetaSyntactic-0.99.tar.gz + Distribution id = B/BO/BOOK/Acme-MetaSyntactic-0.99.tar.gz + CPAN_USERID BOOK (Philippe Bruhat (BooK) <[...]>) + CONTAINSMODS Acme::MetaSyntactic Acme::MetaSyntactic::Alias [...] + UPLOAD_DATE 2006-11-06 + cpan> m /lorem/ + Module = Acme::MetaSyntactic::loremipsum (BOOK/Acme-MetaSyntactic-0.99.tar.gz) + Module Text::Lorem (ADEOLA/Text-Lorem-0.3.tar.gz) + Module Text::Lorem::More (RKRIMEN/Text-Lorem-More-0.12.tar.gz) + Module Text::Lorem::More::Source (RKRIMEN/Text-Lorem-More-0.12.tar.gz) + cpan> i /berlin/ + Distribution BEATNIK/Filter-NumberLines-0.02.tar.gz + Module = DateTime::TimeZone::Europe::Berlin (DROLSKY/DateTime-TimeZone-0.7904.tar.gz) + Module Filter::NumberLines (BEATNIK/Filter-NumberLines-0.02.tar.gz) + Author [...] + +The examples illustrate several aspects: the first three queries +target modules, authors, or distros directly and yield exactly one +result. The last two use regular expressions and yield several +results. The last one targets all of bundles, modules, authors, and +distros simultaneously. When more than one result is available, they +are printed in one-line format. + +=item C, C, C, C, C modules or distributions + +These commands take any number of arguments and investigate what is +necessary to perform the action. If the argument is a distribution +file name (recognized by embedded slashes), it is processed. If it is +a module, CPAN determines the distribution file in which this module +is included and processes that, following any dependencies named in +the module's META.yml or Makefile.PL (this behavior is controlled by +the configuration parameter C.) + +C downloads a distribution file and untars or unzips it, C +builds it, C runs the test suite, and C installs it. + +Any C or C is run unconditionally. An + + install + +is also run unconditionally. But for + + install + +CPAN checks whether an install is needed and prints +I if the distribution file containing +the module doesn't need updating. + +CPAN also keeps track of what it has done within the current session +and doesn't try to build a package a second time regardless of whether it +succeeded or not. It does not repeat a test run if the test +has been run successfully before. Same for install runs. + +The C pragma may precede another command (currently: C, +C, C, or C) to execute the command from scratch +and attempt to continue past certain errors. See the section below on +the C and the C pragma. + +The C pragma skips the test part in the build +process. + +Example: + + cpan> notest install Tk + +A C command results in a + + make clean + +being executed within the distribution file's working directory. + +=item C, C, C module or distribution + +C displays the README file of the associated distribution. +C gets and untars (if not yet done) the distribution file, +changes to the appropriate directory and opens a subshell process in +that directory. C displays the module's pod documentation +in html or plain text format. + +=item C author + +=item C globbing_expression + +The first form lists all distribution files in and below an author's +CPAN directory as stored in the CHECKUMS files distributed on +CPAN. The listing recurses into subdirectories. + +The second form limits or expands the output with shell +globbing as in the following examples: + + ls JV/make* + ls GSAR/*make* + ls */*make* + +The last example is very slow and outputs extra progress indicators +that break the alignment of the result. + +Note that globbing only lists directories explicitly asked for, for +example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be +regarded as a bug that may be changed in some future version. + +=item C + +The C command reports all distributions that failed on one of +C, C or C for some reason in the currently +running shell session. + +=item Persistence between sessions + +If the C or the C module is installed a record of +the internal state of all modules is written to disk after each step. +The files contain a signature of the currently running perl version +for later perusal. + +If the configurations variable C is set to a true +value, then CPAN.pm reads the collected YAML files. If the stored +signature matches the currently running perl, the stored state is +loaded into memory such that persistence between sessions +is effectively established. + +=item The C and the C pragma + +To speed things up in complex installation scenarios, CPAN.pm keeps +track of what it has already done and refuses to do some things a +second time. A C, a C, and an C are not repeated. +A C is repeated only if the previous test was unsuccessful. The +diagnostic message when CPAN.pm refuses to do something a second time +is one of IC or +something similar. Another situation where CPAN refuses to act is an +C if the corresponding C was not successful. + +In all these cases, the user can override this stubborn behaviour by +prepending the command with the word force, for example: + + cpan> force get Foo + cpan> force make AUTHOR/Bar-3.14.tar.gz + cpan> force test Baz + cpan> force install Acme::Meta + +Each I command is executed with the corresponding part of its +memory erased. + +The C pragma is a variant that emulates a C which +erases the entire memory followed by the action specified, effectively +restarting the whole get/make/test/install procedure from scratch. + +=item Lockfile + +Interactive sessions maintain a lockfile, by default C<~/.cpan/.lock>. +Batch jobs can run without a lockfile and not disturb each other. + +The shell offers to run in I when another process is +holding the lockfile. This is an experimental feature that is not yet +tested very well. This second shell then does not write the history +file, does not use the metadata file, and has a different prompt. + +=item Signals + +CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are +in the cpan-shell, it is intended that you can press C<^C> anytime and +return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell +to clean up and leave the shell loop. You can emulate the effect of a +SIGTERM by sending two consecutive SIGINTs, which usually means by +pressing C<^C> twice. + +CPAN.pm ignores SIGPIPE. If the user sets C, a +SIGALRM is used during the run of the C or C subprocess. + +=back + +=head2 CPAN::Shell + +The commands available in the shell interface are methods in +the package CPAN::Shell. If you enter the shell command, your +input is split by the Text::ParseWords::shellwords() routine, which +acts like most shells do. The first word is interpreted as the +method to be invoked, and the rest of the words are treated as the method's arguments. +Continuation lines are supported by ending a line with a +literal backslash. + +=head2 autobundle + +C writes a bundle file into the +C<$CPAN::Config-E{cpan_home}/Bundle> directory. The file contains +a list of all modules that are both available from CPAN and currently +installed within @INC. The name of the bundle file is based on the +current date and a counter. + +=head2 hosts + +Note: this feature is still in alpha state and may change in future +versions of CPAN.pm + +This commands provides a statistical overview over recent download +activities. The data for this is collected in the YAML file +C in your C directory. If no YAML module is +configured or YAML not installed, no stats are provided. + +=head2 mkmyconfig + +mkmyconfig() writes your own CPAN::MyConfig file into your C<~/.cpan/> +directory so that you can save your own preferences instead of the +system-wide ones. + +=head2 recent ***EXPERIMENTAL COMMAND*** + +The C command downloads a list of recent uploads to CPAN and +displays them I. While the command is running, a $SIG{INT} +exits the loop after displaying the current item. + +B: This command requires XML::LibXML installed. + +B: This whole command currently is just a hack and will +probably change in future versions of CPAN.pm, but the general +approach will likely remain. + +B: See also L + +=head2 recompile + +recompile() is a special command that takes no argument and +runs the make/test/install cycle with brute force over all installed +dynamically loadable extensions (aka XS modules) with 'force' in +effect. The primary purpose of this command is to finish a network +installation. Imagine you have a common source tree for two different +architectures. You decide to do a completely independent fresh +installation. You start on one architecture with the help of a Bundle +file produced earlier. CPAN installs the whole Bundle for you, but +when you try to repeat the job on the second architecture, CPAN +responds with a C<"Foo up to date"> message for all modules. So you +invoke CPAN's recompile on the second architecture and you're done. + +Another popular use for C is to act as a rescue in case your +perl breaks binary compatibility. If one of the modules that CPAN uses +is in turn depending on binary compatibility (so you cannot run CPAN +commands), then you should try the CPAN::Nox module for recovery. + +=head2 report Bundle|Distribution|Module + +The C command temporarily turns on the C config +variable, then runs the C command with the given +arguments. The C pragma reruns the tests and repeats +every step that might have failed before. + +=head2 smoke ***EXPERIMENTAL COMMAND*** + +B<*** WARNING: this command downloads and executes software from CPAN to +your computer of completely unknown status. You should never do +this with your normal account and better have a dedicated well +separated and secured machine to do this. ***> + +The C command takes the list of recent uploads to CPAN as +provided by the C command and tests them all. While the +command is running $SIG{INT} is defined to mean that the current item +shall be skipped. + +B: This whole command currently is just a hack and will +probably change in future versions of CPAN.pm, but the general +approach will likely remain. + +B: See also L + +=head2 upgrade [Module|/Regex/]... + +The C command first runs an C command with the given +arguments and then installs the newest versions of all modules that +were listed by that. + +=head2 The four C Classes: Author, Bundle, Module, Distribution + +Although it may be considered internal, the class hierarchy does matter +for both users and programmer. CPAN.pm deals with the four +classes mentioned above, and those classes all share a set of methods. Classical +single polymorphism is in effect. A metaclass object registers all +objects of all kinds and indexes them with a string. The strings +referencing objects have a separated namespace (well, not completely +separated): + + Namespace Class + + words containing a "/" (slash) Distribution + words starting with Bundle:: Bundle + everything else Module or Author + +Modules know their associated Distribution objects. They always refer +to the most recent official release. Developers may mark their releases +as unstable development versions (by inserting an underbar into the +module version number which will also be reflected in the distribution +name when you run 'make dist'), so the really hottest and newest +distribution is not always the default. If a module Foo circulates +on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient +way to install version 1.23 by saying + + install Foo + +This would install the complete distribution file (say +BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would +like to install version 1.23_90, you need to know where the +distribution file resides on CPAN relative to the authors/id/ +directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz; +so you would have to say + + install BAR/Foo-1.23_90.tar.gz + +The first example will be driven by an object of the class +CPAN::Module, the second by an object of class CPAN::Distribution. + +=head2 Integrating local directories + +Note: this feature is still in alpha state and may change in future +versions of CPAN.pm + +Distribution objects are normally distributions from the CPAN, but +there is a slightly degenerate case for Distribution objects, too, of +projects held on the local disk. These distribution objects have the +same name as the local directory and end with a dot. A dot by itself +is also allowed for the current directory at the time CPAN.pm was +used. All actions such as C, C, and C are applied +directly to that directory. This gives the command C an +interesting touch: while the normal mantra of installing a CPAN module +without CPAN.pm is one of + + perl Makefile.PL perl Build.PL + ( go and get prerequisites ) + make ./Build + make test ./Build test + make install ./Build install + +the command C does all of this at once. It figures out which +of the two mantras is appropriate, fetches and installs all +prerequisites, takes care of them recursively, and finally finishes the +installation of the module in the current directory, be it a CPAN +module or not. + +The typical usage case is for private modules or working copies of +projects from remote repositories on the local disk. + +=head2 Redirection + +The usual shell redirection symbols C< | > and C<< > >> are recognized +by the cpan shell B. So piping to +pager or redirecting output into a file works somewhat as in a normal +shell, with the stipulation that you must type extra spaces. + +=head1 CONFIGURATION + +When the CPAN module is used for the first time, a configuration +dialogue tries to determine a couple of site specific options. The +result of the dialog is stored in a hash reference C< $CPAN::Config > +in a file CPAN/Config.pm. + +Default values defined in the CPAN/Config.pm file can be +overridden in a user specific file: CPAN/MyConfig.pm. Such a file is +best placed in C<$HOME/.cpan/CPAN/MyConfig.pm>, because C<$HOME/.cpan> is +added to the search path of the CPAN module before the use() or +require() statements. The mkmyconfig command writes this file for you. + +The C command has various bells and whistles: + +=over + +=item completion support + +If you have a ReadLine module installed, you can hit TAB at any point +of the commandline and C will offer you completion for the +built-in subcommands and/or config variable names. + +=item displaying some help: o conf help + +Displays a short help + +=item displaying current values: o conf [KEY] + +Displays the current value(s) for this config variable. Without KEY, +displays all subcommands and config variables. + +Example: + + o conf shell + +If KEY starts and ends with a slash, the string in between is +treated as a regular expression and only keys matching this regex +are displayed + +Example: + + o conf /color/ + +=item changing of scalar values: o conf KEY VALUE + +Sets the config variable KEY to VALUE. The empty string can be +specified as usual in shells, with C<''> or C<""> + +Example: + + o conf wget /usr/bin/wget + +=item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST + +If a config variable name ends with C, it is a list. C removes the first element of the list, C +removes the last element of the list. C +prepends a list of values to the list, C +appends a list of valued to the list. + +Likewise, C passes the LIST to the corresponding +splice command. + +Finally, any other list of arguments is taken as a new list value for +the KEY variable discarding the previous value. + +Examples: + + o conf urllist unshift http://cpan.dev.local/CPAN + o conf urllist splice 3 1 + o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org + +=item reverting to saved: o conf defaults + +Reverts all config variables to the state in the saved config file. + +=item saving the config: o conf commit + +Saves all config variables to the current config file (CPAN/Config.pm +or CPAN/MyConfig.pm that was loaded at start). + +=back + +The configuration dialog can be started any time later again by +issuing the command C< o conf init > in the CPAN shell. A subset of +the configuration dialog can be run by issuing C +where WORD is any valid config variable or a regular expression. + +=head2 Config Variables + +The following keys in the hash reference $CPAN::Config are +currently defined: + + applypatch path to external prg + auto_commit commit all changes to config variables to disk + build_cache size of cache for directories to build modules + build_dir locally accessible directory to build modules + build_dir_reuse boolean if distros in build_dir are persistent + build_requires_install_policy + to install or not to install when a module is + only needed for building. yes|no|ask/yes|ask/no + bzip2 path to external prg + cache_metadata use serializer to cache metadata + check_sigs if signatures should be verified + colorize_debug Term::ANSIColor attributes for debugging output + colorize_output boolean if Term::ANSIColor should colorize output + colorize_print Term::ANSIColor attributes for normal output + colorize_warn Term::ANSIColor attributes for warnings + commandnumber_in_prompt + boolean if you want to see current command number + commands_quote preferred character to use for quoting external + commands when running them. Defaults to double + quote on Windows, single tick everywhere else; + can be set to space to disable quoting + connect_to_internet_ok + whether to ask if opening a connection is ok before + urllist is specified + cpan_home local directory reserved for this package + curl path to external prg + dontload_hash DEPRECATED + dontload_list arrayref: modules in the list will not be + loaded by the CPAN::has_inst() routine + ftp path to external prg + ftp_passive if set, the envariable FTP_PASSIVE is set for downloads + ftp_proxy proxy host for ftp requests + ftpstats_period max number of days to keep download statistics + ftpstats_size max number of items to keep in the download statistics + getcwd see below + gpg path to external prg + gzip location of external program gzip + halt_on_failure stop processing after the first failure of queued + items or dependencies + histfile file to maintain history between sessions + histsize maximum number of lines to keep in histfile + http_proxy proxy host for http requests + inactivity_timeout breaks interactive Makefile.PLs or Build.PLs + after this many seconds inactivity. Set to 0 to + disable timeouts. + index_expire refetch index files after this many days + inhibit_startup_message + if true, suppress the startup message + keep_source_where directory in which to keep the source (if we do) + load_module_verbosity + report loading of optional modules used by CPAN.pm + lynx path to external prg + make location of external make program + make_arg arguments that should always be passed to 'make' + make_install_make_command + the make command for running 'make install', for + example 'sudo make' + make_install_arg same as make_arg for 'make install' + makepl_arg arguments passed to 'perl Makefile.PL' + mbuild_arg arguments passed to './Build' + mbuild_install_arg arguments passed to './Build install' + mbuild_install_build_command + command to use instead of './Build' when we are + in the install stage, for example 'sudo ./Build' + mbuildpl_arg arguments passed to 'perl Build.PL' + ncftp path to external prg + ncftpget path to external prg + no_proxy don't proxy to these hosts/domains (comma separated list) + pager location of external program more (or any pager) + password your password if you CPAN server wants one + patch path to external prg + patches_dir local directory containing patch files + perl5lib_verbosity verbosity level for PERL5LIB additions + prefer_installer legal values are MB and EUMM: if a module comes + with both a Makefile.PL and a Build.PL, use the + former (EUMM) or the latter (MB); if the module + comes with only one of the two, that one will be + used no matter the setting + prerequisites_policy + what to do if you are missing module prerequisites + ('follow' automatically, 'ask' me, or 'ignore') + prefs_dir local directory to store per-distro build options + proxy_user username for accessing an authenticating proxy + proxy_pass password for accessing an authenticating proxy + randomize_urllist add some randomness to the sequence of the urllist + scan_cache controls scanning of cache ('atstart' or 'never') + shell your favorite shell + show_unparsable_versions + boolean if r command tells which modules are versionless + show_upload_date boolean if commands should try to determine upload date + show_zero_versions boolean if r command tells for which modules $version==0 + tar location of external program tar + tar_verbosity verbosity level for the tar command + term_is_latin deprecated: if true Unicode is translated to ISO-8859-1 + (and nonsense for characters outside latin range) + term_ornaments boolean to turn ReadLine ornamenting on/off + test_report email test reports (if CPAN::Reporter is installed) + trust_test_report_history + skip testing when previously tested ok (according to + CPAN::Reporter history) + unzip location of external program unzip + urllist arrayref to nearby CPAN sites (or equivalent locations) + use_sqlite use CPAN::SQLite for metadata storage (fast and lean) + username your username if you CPAN server wants one + wait_list arrayref to a wait server to try (See CPAN::WAIT) + wget path to external prg + yaml_load_code enable YAML code deserialisation via CPAN::DeferredCode + yaml_module which module to use to read/write YAML files + +You can set and query each of these options interactively in the cpan +shell with the C or the C command as specified below. + +=over 2 + +=item Cscalar optionE> + +prints the current value of the I + +=item Cscalar optionE EvalueE> + +Sets the value of the I to I + +=item Clist optionE> + +prints the current value of the I in MakeMaker's +neatvalue format. + +=item Clist optionE [shift|pop]> + +shifts or pops the array in the I variable + +=item Clist optionE [unshift|push|splice] ElistE> + +works like the corresponding perl commands. + +=item interactive editing: o conf init [MATCH|LIST] + +Runs an interactive configuration dialog for matching variables. +Without argument runs the dialog over all supported config variables. +To specify a MATCH the argument must be enclosed by slashes. + +Examples: + + o conf init ftp_passive ftp_proxy + o conf init /color/ + +Note: this method of setting config variables often provides more +explanation about the functioning of a variable than the manpage. + +=back + +=head2 CPAN::anycwd($path): Note on config variable getcwd + +CPAN.pm changes the current working directory often and needs to +determine its own current working directory. By default it uses +Cwd::cwd, but if for some reason this doesn't work on your system, +configure alternatives according to the following table: + +=over 4 + +=item cwd + +Calls Cwd::cwd + +=item getcwd + +Calls Cwd::getcwd + +=item fastcwd + +Calls Cwd::fastcwd + +=item backtickcwd + +Calls the external command cwd. + +=back + +=head2 Note on the format of the urllist parameter + +urllist parameters are URLs according to RFC 1738. We do a little +guessing if your URL is not compliant, but if you have problems with +C URLs, please try the correct format. Either: + + file://localhost/whatever/ftp/pub/CPAN/ + +or + + file:///home/ftp/pub/CPAN/ + +=head2 The urllist parameter has CD-ROM support + +The C parameter of the configuration table contains a list of +URLs used for downloading. If the list contains any +C URLs, CPAN always tries there first. This +feature is disabled for index files. So the recommendation for the +owner of a CD-ROM with CPAN contents is: include your local, possibly +outdated CD-ROM as a C URL at the end of urllist, e.g. + + o conf urllist push file://localhost/CDROM/CPAN + +CPAN.pm will then fetch the index files from one of the CPAN sites +that come at the beginning of urllist. It will later check for each +module to see whether there is a local copy of the most recent version. + +Another peculiarity of urllist is that the site that we could +successfully fetch the last file from automatically gets a preference +token and is tried as the first site for the next request. So if you +add a new site at runtime it may happen that the previously preferred +site will be tried another time. This means that if you want to disallow +a site for the next transfer, it must be explicitly removed from +urllist. + +=head2 Maintaining the urllist parameter + +If you have YAML.pm (or some other YAML module configured in +C) installed, CPAN.pm collects a few statistical data +about recent downloads. You can view the statistics with the C +command or inspect them directly by looking into the C +file in your C directory. + +To get some interesting statistics, it is recommended that +C be set; this introduces some amount of +randomness into the URL selection. + +=head2 The C and C dependency declarations + +Since CPAN.pm version 1.88_51 modules declared as C by +a distribution are treated differently depending on the config +variable C. By setting +C to C, such a module is not +installed. It is only built and tested, and then kept in the list of +tested but uninstalled modules. As such, it is available during the +build of the dependent module by integrating the path to the +C and C directories in the environment variable +PERL5LIB. If C is set ti C, then +both modules declared as C and those declared as +C are treated alike. By setting to C or +C, CPAN.pm asks the user and sets the default accordingly. + +=head2 Configuration for individual distributions (I) + +(B This feature has been introduced in CPAN.pm 1.8854 and is +still considered beta quality) + +Distributions on CPAN usually behave according to what we call the +CPAN mantra. Or since the advent of Module::Build we should talk about +two mantras: + + perl Makefile.PL perl Build.PL + make ./Build + make test ./Build test + make install ./Build install + +But some modules cannot be built with this mantra. They try to get +some extra data from the user via the environment, extra arguments, or +interactively--thus disturbing the installation of large bundles like +Phalanx100 or modules with many dependencies like Plagger. + +The distroprefs system of C addresses this problem by +allowing the user to specify extra informations and recipes in YAML +files to either + +=over + +=item + +pass additional arguments to one of the four commands, + +=item + +set environment variables + +=item + +instantiate an Expect object that reads from the console, waits for +some regular expressions and enters some answers + +=item + +temporarily override assorted C configuration variables + +=item + +specify dependencies the original maintainer forgot + +=item + +disable the installation of an object altogether + +=back + +See the YAML and Data::Dumper files that come with the C +distribution in the C directory for examples. + +=head2 Filenames + +The YAML files themselves must have the C<.yml> extension; all other +files are ignored (for two exceptions see I below). The containing directory can be specified in +C in the C config variable. Try C in the CPAN shell to set and activate the distroprefs +system. + +Every YAML file may contain arbitrary documents according to the YAML +specification, and every document is treated as an entity that +can specify the treatment of a single distribution. + +Filenames can be picked arbitrarily; C always reads +all files (in alphabetical order) and takes the key C (see +below in I) as a hashref containing match criteria +that determine if the current distribution matches the YAML document +or not. + +=head2 Fallback Data::Dumper and Storable + +If neither your configured C nor YAML.pm is installed, +CPAN.pm falls back to using Data::Dumper and Storable and looks for +files with the extensions C<.dd> or C<.st> in the C +directory. These files are expected to contain one or more hashrefs. +For Data::Dumper generated files, this is expected to be done with by +defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these +with the command + + ysh < somefile.yml > somefile.dd + +For Storable files the rule is that they must be constructed such that +C returns an array reference and the array +elements represent one distropref object each. The conversion from +YAML would look like so: + + perl -MYAML=LoadFile -MStorable=nstore -e ' + @y=LoadFile(shift); + nstore(\@y, shift)' somefile.yml somefile.st + +In bootstrapping situations it is usually sufficient to translate only +a few YAML files to Data::Dumper for crucial modules like +C, C and C. If you prefer Storable +over Data::Dumper, remember to pull out a Storable version that writes +an older format than all the other Storable versions that will need to +read them. + +=head2 Blueprint + +The following example contains all supported keywords and structures +with the exception of C which can be used instead of +C. + + --- + comment: "Demo" + match: + module: "Dancing::Queen" + distribution: "^CHACHACHA/Dancing-" + not_distribution: "\.zip$" + perl: "/usr/local/cariba-perl/bin/perl" + perlconfig: + archname: "freebsd" + not_cc: "gcc" + env: + DANCING_FLOOR: "Shubiduh" + disabled: 1 + cpanconfig: + make: gmake + pl: + args: + - "--somearg=specialcase" + + env: {} + + expect: + - "Which is your favorite fruit" + - "apple\n" + + make: + args: + - all + - extra-all + + env: {} + + expect: [] + + commendline: "echo SKIPPING make" + + test: + args: [] + + env: {} + + expect: [] + + install: + args: [] + + env: + WANT_TO_INSTALL: YES + + expect: + - "Do you really want to install" + - "y\n" + + patches: + - "ABCDE/Fedcba-3.14-ABCDE-01.patch" + + depends: + configure_requires: + LWP: 5.8 + build_requires: + Test::Exception: 0.25 + requires: + Spiffy: 0.30 + + +=head2 Language Specs + +Every YAML document represents a single hash reference. The valid keys +in this hash are as follows: + +=over + +=item comment [scalar] + +A comment + +=item cpanconfig [hash] + +Temporarily override assorted C configuration variables. + +Supported are: C, C, +C, C, C, +C. Please report as a bug when you need another one +supported. + +=item depends [hash] *** EXPERIMENTAL FEATURE *** + +All three types, namely C, C, and +C are supported in the way specified in the META.yml +specification. The current implementation I the specified +dependencies with those declared by the package maintainer. In a +future implementation this may be changed to override the original +declaration. + +=item disabled [boolean] + +Specifies that this distribution shall not be processed at all. + +=item features [array] *** EXPERIMENTAL FEATURE *** + +Experimental implementation to deal with optional_features from +META.yml. Still needs coordination with installer software and +currently works only for META.yml declaring C. Use +with caution. + +=item goto [string] + +The canonical name of a delegate distribution to install +instead. Useful when a new version, although it tests OK itself, +breaks something else or a developer release or a fork is already +uploaded that is better than the last released version. + +=item install [hash] + +Processing instructions for the C or C<./Build install> +phase of the CPAN mantra. See below under I. + +=item make [hash] + +Processing instructions for the C or C<./Build> phase of the +CPAN mantra. See below under I. + +=item match [hash] + +A hashref with one or more of the keys C, C, +C, C, and C that specify whether a document is +targeted at a specific CPAN distribution or installation. +Keys prefixed with C negates the corresponding match. + +The corresponding values are interpreted as regular expressions. The +C related one will be matched against the canonical +distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz". + +The C related one will be matched against I modules +contained in the distribution until one module matches. + +The C related one will be matched against C<$^X> (but with the +absolute path). + +The value associated with C is itself a hashref that is +matched against corresponding values in the C<%Config::Config> hash +living in the C module. +Keys prefixed with C negates the corresponding match. + +The value associated with C is itself a hashref that is +matched against corresponding values in the C<%ENV> hash. +Keys prefixed with C negates the corresponding match. + +If more than one restriction of C, C, etc. is +specified, the results of the separately computed match values must +all match. If so, the hashref represented by the +YAML document is returned as the preference structure for the current +distribution. + +=item patches [array] + +An array of patches on CPAN or on the local disk to be applied in +order via an external patch program. If the value for the C<-p> +parameter is C<0> or C<1> is determined by reading the patch +beforehand. The path to each patch is either an absolute path on the +local filesystem or relative to a patch directory specified in the +C configuration variable or in the format of a canonical +distroname. For examples please consult the distroprefs/ directory in +the CPAN.pm distribution (these examples are not installed by +default). + +Note: if the C program is installed and C +knows about it B a patch is written by the C program, +then C lets C apply the patch. Both C +and C are available from CPAN in the C +distribution. + +=item pl [hash] + +Processing instructions for the C or C phase of the CPAN mantra. See below under I. + +=item test [hash] + +Processing instructions for the C or C<./Build test> phase +of the CPAN mantra. See below under I. + +=back + +=head2 Processing Instructions + +=over + +=item args [array] + +Arguments to be added to the command line + +=item commandline + +A full commandline to run via C. +During execution, the environment variable PERL is set +to $^X (but with an absolute path). If C is specified, +C is not used. + +=item eexpect [hash] + +Extended C. This is a hash reference with four allowed keys, +C, C, C, and C. + +C may have the values C for the case where all +questions come in the order written down and C for the case +where the questions may come in any order. The default mode is +C. + +C denotes a timeout in seconds. Floating-point timeouts are +OK. With C, the timeout denotes the +timeout per question; with C it denotes the +timeout per byte received from the stream or questions. + +C is a reference to an array that contains alternating questions +and answers. Questions are regular expressions and answers are literal +strings. The Expect module watches the stream from the +execution of the external program (C, C, C, etc.). + +For C, the CPAN.pm injects the +corresponding answer as soon as the stream matches the regular expression. + +For C CPAN.pm answers a question as soon +as the timeout is reached for the next byte in the input stream. In +this mode you can use the C parameter to decide what will +happen with a question-answer pair after it has been used. In the +default case (reuse=0) it is removed from the array, avoiding being +used again accidentally. If you want to answer the +question C several times, then it must +be included in the array at least as often as you want this answer to +be given. Setting the parameter C to 1 makes this repetition +unnecessary. + +=item env [hash] + +Environment variables to be set during the command + +=item expect [array] + +C<< expect: >> is a short notation for + +eexpect: + mode: deterministic + timeout: 15 + talk: + +=back + +=head2 Schema verification with C + +If you have the C module installed (which is part of the +Bundle::CPANxxl), then all your distroprefs files are checked for +syntactic correctness. + +=head2 Example Distroprefs Files + +C comes with a collection of example YAML files. Note that these +are really just examples and should not be used without care because +they cannot fit everybody's purpose. After all, the authors of the +packages that ask questions had a need to ask, so you should watch +their questions and adjust the examples to your environment and your +needs. You have been warned:-) + +=head1 PROGRAMMER'S INTERFACE + +If you do not enter the shell, shell commands are +available both as methods (Cinstall(...)>) and as +functions in the calling package (C). Before calling low-level +commands, it makes sense to initialize components of CPAN you need, e.g.: + + CPAN::HandleConfig->load; + CPAN::Shell::setup_output; + CPAN::Index->reload; + +High-level commands do such initializations automatically. + +There's currently only one class that has a stable interface - +CPAN::Shell. All commands that are available in the CPAN shell are +methods of the class CPAN::Shell. Each of the commands that produce +listings of modules (C, C, C) also return a list of +the IDs of all modules within the list. + +=over 2 + +=item expand($type,@things) + +The IDs of all objects available within a program are strings that can +be expanded to the corresponding real objects with the +Cexpand("Module",@things)> method. Expand returns a +list of CPAN::Module objects according to the C<@things> arguments +given. In scalar context, it returns only the first element of the +list. + +=item expandany(@things) + +Like expand, but returns objects of the appropriate type, i.e. +CPAN::Bundle objects for bundles, CPAN::Module objects for modules, and +CPAN::Distribution objects for distributions. Note: it does not expand +to CPAN::Author objects. + +=item Programming Examples + +This enables the programmer to do operations that combine +functionalities that are available in the shell. + + # install everything that is outdated on my disk: + perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)' + + # install my favorite programs if necessary: + for $mod (qw(Net::FTP Digest::SHA Data::Dumper)) { + CPAN::Shell->install($mod); + } + + # list all modules on my disk that have no VERSION number + for $mod (CPAN::Shell->expand("Module","/./")) { + next unless $mod->inst_file; + # MakeMaker convention for undefined $VERSION: + next unless $mod->inst_version eq "undef"; + print "No VERSION in ", $mod->id, "\n"; + } + + # find out which distribution on CPAN contains a module: + print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file + +Or if you want to schedule a I job to watch CPAN, you could list +all modules that need updating. First a quick and dirty way: + + perl -e 'use CPAN; CPAN::Shell->r;' + +If you don't want any output should all modules be +up to date, parse the output of above command for the regular +expression C and decide to mail the output +only if it doesn't match. + +If you prefer to do it more in a programmerish style in one single +process, something like this may better suit you: + + # list all modules on my disk that have newer versions on CPAN + for $mod (CPAN::Shell->expand("Module","/./")) { + next unless $mod->inst_file; + next if $mod->uptodate; + printf "Module %s is installed as %s, could be updated to %s from CPAN\n", + $mod->id, $mod->inst_version, $mod->cpan_version; + } + +If that gives too much output every day, you may want to +watch only for three modules. You can write + + for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")) { + +as the first line instead. Or you can combine some of the above +tricks: + + # watch only for a new mod_perl module + $mod = CPAN::Shell->expand("Module","mod_perl"); + exit if $mod->uptodate; + # new mod_perl arrived, let me know all update recommendations + CPAN::Shell->r; + +=back + +=head2 Methods in the other Classes + +=over 4 + +=item CPAN::Author::as_glimpse() + +Returns a one-line description of the author + +=item CPAN::Author::as_string() + +Returns a multi-line description of the author + +=item CPAN::Author::email() + +Returns the author's email address + +=item CPAN::Author::fullname() + +Returns the author's name + +=item CPAN::Author::name() + +An alias for fullname + +=item CPAN::Bundle::as_glimpse() + +Returns a one-line description of the bundle + +=item CPAN::Bundle::as_string() + +Returns a multi-line description of the bundle + +=item CPAN::Bundle::clean() + +Recursively runs the C method on all items contained in the bundle. + +=item CPAN::Bundle::contains() + +Returns a list of objects' IDs contained in a bundle. The associated +objects may be bundles, modules or distributions. + +=item CPAN::Bundle::force($method,@args) + +Forces CPAN to perform a task that it normally would have refused to +do. Force takes as arguments a method name to be called and any number +of additional arguments that should be passed to the called method. +The internals of the object get the needed changes so that CPAN.pm +does not refuse to take the action. The C is passed recursively +to all contained objects. See also the section above on the C +and the C pragma. + +=item CPAN::Bundle::get() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::inst_file() + +Returns the highest installed version of the bundle in either @INC or +C<$CPAN::Config->{cpan_home}>. Note that this is different from +CPAN::Module::inst_file. + +=item CPAN::Bundle::inst_version() + +Like CPAN::Bundle::inst_file, but returns the $VERSION + +=item CPAN::Bundle::uptodate() + +Returns 1 if the bundle itself and all its members are uptodate. + +=item CPAN::Bundle::install() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::make() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::readme() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::test() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Distribution::as_glimpse() + +Returns a one-line description of the distribution + +=item CPAN::Distribution::as_string() + +Returns a multi-line description of the distribution + +=item CPAN::Distribution::author + +Returns the CPAN::Author object of the maintainer who uploaded this +distribution + +=item CPAN::Distribution::pretty_id() + +Returns a string of the form "AUTHORID/TARBALL", where AUTHORID is the +author's PAUSE ID and TARBALL is the distribution filename. + +=item CPAN::Distribution::base_id() + +Returns the distribution filename without any archive suffix. E.g +"Foo-Bar-0.01" + +=item CPAN::Distribution::clean() + +Changes to the directory where the distribution has been unpacked and +runs C there. + +=item CPAN::Distribution::containsmods() + +Returns a list of IDs of modules contained in a distribution file. +Works only for distributions listed in the 02packages.details.txt.gz +file. This typically means that just most recent version of a +distribution is covered. + +=item CPAN::Distribution::cvs_import() + +Changes to the directory where the distribution has been unpacked and +runs something like + + cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version + +there. + +=item CPAN::Distribution::dir() + +Returns the directory into which this distribution has been unpacked. + +=item CPAN::Distribution::force($method,@args) + +Forces CPAN to perform a task that it normally would have refused to +do. Force takes as arguments a method name to be called and any number +of additional arguments that should be passed to the called method. +The internals of the object get the needed changes so that CPAN.pm +does not refuse to take the action. See also the section above on the +C and the C pragma. + +=item CPAN::Distribution::get() + +Downloads the distribution from CPAN and unpacks it. Does nothing if +the distribution has already been downloaded and unpacked within the +current session. + +=item CPAN::Distribution::install() + +Changes to the directory where the distribution has been unpacked and +runs the external command C there. If C has not +yet been run, it will be run first. A C is issued in +any case and if this fails, the install is cancelled. The +cancellation can be avoided by letting C run the C for +you. + +This install method only has the power to install the distribution if +there are no dependencies in the way. To install an object along with all +its dependencies, use CPAN::Shell->install. + +Note that install() gives no meaningful return value. See uptodate(). + +=item CPAN::Distribution::install_tested() + +Install all distributions that have tested sucessfully but +not yet installed. See also C. + +=item CPAN::Distribution::isa_perl() + +Returns 1 if this distribution file seems to be a perl distribution. +Normally this is derived from the file name only, but the index from +CPAN can contain a hint to achieve a return value of true for other +filenames too. + +=item CPAN::Distribution::look() + +Changes to the directory where the distribution has been unpacked and +opens a subshell there. Exiting the subshell returns. + +=item CPAN::Distribution::make() + +First runs the C method to make sure the distribution is +downloaded and unpacked. Changes to the directory where the +distribution has been unpacked and runs the external commands C or C and C there. + +=item CPAN::Distribution::perldoc() + +Downloads the pod documentation of the file associated with a +distribution (in HTML format) and runs it through the external +command I specified in C<$CPAN::Config->{lynx}>. If I +isn't available, it converts it to plain text with the external +command I and runs it through the pager specified +in C<$CPAN::Config->{pager}> + +=item CPAN::Distribution::prefs() + +Returns the hash reference from the first matching YAML file that the +user has deposited in the C directory. The first +succeeding match wins. The files in the C are processed +alphabetically, and the canonical distroname (e.g. +AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions +stored in the $root->{match}{distribution} attribute value. +Additionally all module names contained in a distribution are matched +against the regular expressions in the $root->{match}{module} attribute +value. The two match values are ANDed together. Each of the two +attributes are optional. + +=item CPAN::Distribution::prereq_pm() + +Returns the hash reference that has been announced by a distribution +as the C and C elements. These can be +declared either by the C (if authoritative) or can be +deposited after the run of C in the file C<./_build/prereqs> +or after the run of C written as the C hash in +a comment in the produced C. I: this method only works +after an attempt has been made to C the distribution. Returns +undef otherwise. + +=item CPAN::Distribution::readme() + +Downloads the README file associated with a distribution and runs it +through the pager specified in C<$CPAN::Config->{pager}>. + +=item CPAN::Distribution::reports() + +Downloads report data for this distribution from www.cpantesters.org +and displays a subset of them. + +=item CPAN::Distribution::read_yaml() + +Returns the content of the META.yml of this distro as a hashref. Note: +works only after an attempt has been made to C the distribution. +Returns undef otherwise. Also returns undef if the content of META.yml +is not authoritative. (The rules about what exactly makes the content +authoritative are still in flux.) + +=item CPAN::Distribution::test() + +Changes to the directory where the distribution has been unpacked and +runs C there. + +=item CPAN::Distribution::uptodate() + +Returns 1 if all the modules contained in the distribution are +uptodate. Relies on containsmods. + +=item CPAN::Index::force_reload() + +Forces a reload of all indices. + +=item CPAN::Index::reload() + +Reloads all indices if they have not been read for more than +C<$CPAN::Config->{index_expire}> days. + +=item CPAN::InfoObj::dump() + +CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution +inherit this method. It prints the data structure associated with an +object. Useful for debugging. Note: the data structure is considered +internal and thus subject to change without notice. + +=item CPAN::Module::as_glimpse() + +Returns a one-line description of the module in four columns: The +first column contains the word C, the second column consists +of one character: an equals sign if this module is already installed +and uptodate, a less-than sign if this module is installed but can be +upgraded, and a space if the module is not installed. The third column +is the name of the module and the fourth column gives maintainer or +distribution information. + +=item CPAN::Module::as_string() + +Returns a multi-line description of the module + +=item CPAN::Module::clean() + +Runs a clean on the distribution associated with this module. + +=item CPAN::Module::cpan_file() + +Returns the filename on CPAN that is associated with the module. + +=item CPAN::Module::cpan_version() + +Returns the latest version of this module available on CPAN. + +=item CPAN::Module::cvs_import() + +Runs a cvs_import on the distribution associated with this module. + +=item CPAN::Module::description() + +Returns a 44 character description of this module. Only available for +modules listed in The Module List (CPAN/modules/00modlist.long.html +or 00modlist.long.txt.gz) + +=item CPAN::Module::distribution() + +Returns the CPAN::Distribution object that contains the current +version of this module. + +=item CPAN::Module::dslip_status() + +Returns a hash reference. The keys of the hash are the letters C, +C, C, C, and

, for development status, support level, +language, interface and public licence respectively. The data for the +DSLIP status are collected by pause.perl.org when authors register +their namespaces. The values of the 5 hash elements are one-character +words whose meaning is described in the table below. There are also 5 +hash elements C, C, C, C, and that carry a more +verbose value of the 5 status variables. + +Where the 'DSLIP' characters have the following meanings: + + D - Development Stage (Note: *NO IMPLIED TIMESCALES*): + i - Idea, listed to gain consensus or as a placeholder + c - under construction but pre-alpha (not yet released) + a/b - Alpha/Beta testing + R - Released + M - Mature (no rigorous definition) + S - Standard, supplied with Perl 5 + + S - Support Level: + m - Mailing-list + d - Developer + u - Usenet newsgroup comp.lang.perl.modules + n - None known, try comp.lang.perl.modules + a - abandoned; volunteers welcome to take over maintainance + + L - Language Used: + p - Perl-only, no compiler needed, should be platform independent + c - C and perl, a C compiler will be needed + h - Hybrid, written in perl with optional C code, no compiler needed + + - C++ and perl, a C++ compiler will be needed + o - perl and another language other than C or C++ + + I - Interface Style + f - plain Functions, no references used + h - hybrid, object and function interfaces available + n - no interface at all (huh?) + r - some use of unblessed References or ties + O - Object oriented using blessed references and/or inheritance + + P - Public License + p - Standard-Perl: user may choose between GPL and Artistic + g - GPL: GNU General Public License + l - LGPL: "GNU Lesser General Public License" (previously known as + "GNU Library General Public License") + b - BSD: The BSD License + a - Artistic license alone + 2 - Artistic license 2.0 or later + o - open source: appoved by www.opensource.org + d - allows distribution without restrictions + r - restricted distribtion + n - no license at all + +=item CPAN::Module::force($method,@args) + +Forces CPAN to perform a task it would normally refuse to +do. Force takes as arguments a method name to be invoked and any number +of additional arguments to pass that method. +The internals of the object get the needed changes so that CPAN.pm +does not refuse to take the action. See also the section above on the +C and the C pragma. + +=item CPAN::Module::get() + +Runs a get on the distribution associated with this module. + +=item CPAN::Module::inst_file() + +Returns the filename of the module found in @INC. The first file found +is reported, just as perl itself stops searching @INC once it finds a +module. + +=item CPAN::Module::available_file() + +Returns the filename of the module found in PERL5LIB or @INC. The +first file found is reported. The advantage of this method over +C is that modules that have been tested but not yet +installed are included because PERL5LIB keeps track of tested modules. + +=item CPAN::Module::inst_version() + +Returns the version number of the installed module in readable format. + +=item CPAN::Module::available_version() + +Returns the version number of the available module in readable format. + +=item CPAN::Module::install() + +Runs an C on the distribution associated with this module. + +=item CPAN::Module::look() + +Changes to the directory where the distribution associated with this +module has been unpacked and opens a subshell there. Exiting the +subshell returns. + +=item CPAN::Module::make() + +Runs a C on the distribution associated with this module. + +=item CPAN::Module::manpage_headline() + +If module is installed, peeks into the module's manpage, reads the +headline, and returns it. Moreover, if the module has been downloaded +within this session, does the equivalent on the downloaded module even +if it hasn't been installed yet. + +=item CPAN::Module::perldoc() + +Runs a C on this module. + +=item CPAN::Module::readme() + +Runs a C on the distribution associated with this module. + +=item CPAN::Module::reports() + +Calls the reports() method on the associated distribution object. + +=item CPAN::Module::test() + +Runs a C on the distribution associated with this module. + +=item CPAN::Module::uptodate() + +Returns 1 if the module is installed and up-to-date. + +=item CPAN::Module::userid() + +Returns the author's ID of the module. + +=back + +=head2 Cache Manager + +Currently the cache manager only keeps track of the build directory +($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that +deletes complete directories below C as soon as the size of +all directories there gets bigger than $CPAN::Config->{build_cache} +(in MB). The contents of this cache may be used for later +re-installations that you intend to do manually, but will never be +trusted by CPAN itself. This is due to the fact that the user might +use these directories for building modules on different architectures. + +There is another directory ($CPAN::Config->{keep_source_where}) where +the original distribution files are kept. This directory is not +covered by the cache manager and must be controlled by the user. If +you choose to have the same directory as build_dir and as +keep_source_where directory, then your sources will be deleted with +the same fifo mechanism. + +=head2 Bundles + +A bundle is just a perl module in the namespace Bundle:: that does not +define any functions or methods. It usually only contains documentation. + +It starts like a perl module with a package declaration and a $VERSION +variable. After that the pod section looks like any other pod with the +only difference being that I exists starting with +(verbatim): + + =head1 CONTENTS + +In this pod section each line obeys the format + + Module_Name [Version_String] [- optional text] + +The only required part is the first field, the name of a module +(e.g. Foo::Bar, ie. I the name of the distribution file). The rest +of the line is optional. The comment part is delimited by a dash just +as in the man page header. + +The distribution of a bundle should follow the same convention as +other distributions. + +Bundles are treated specially in the CPAN package. If you say 'install +Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all +the modules in the CONTENTS section of the pod. You can install your +own Bundles locally by placing a conformant Bundle file somewhere into +your @INC path. The autobundle() command which is available in the +shell interface does that for you by including all currently installed +modules in a snapshot bundle file. + +=head1 PREREQUISITES + +If you have a local mirror of CPAN and can access all files with +"file:" URLs, then you only need a perl later than perl5.003 to run +this module. Otherwise Net::FTP is strongly recommended. LWP may be +required for non-UNIX systems, or if your nearest CPAN site is +associated with a URL that is not C. + +If you have neither Net::FTP nor LWP, there is a fallback mechanism +implemented for an external ftp command or for an external lynx +command. + +=head1 UTILITIES + +=head2 Finding packages and VERSION + +This module presumes that all packages on CPAN + +=over 2 + +=item * + +declare their $VERSION variable in an easy to parse manner. This +prerequisite can hardly be relaxed because it consumes far too much +memory to load all packages into the running program just to determine +the $VERSION variable. Currently all programs that are dealing with +version use something like this + + perl -MExtUtils::MakeMaker -le \ + 'print MM->parse_version(shift)' filename + +If you are author of a package and wonder if your $VERSION can be +parsed, please try the above method. + +=item * + +come as compressed or gzipped tarfiles or as zip files and contain a +C or C (well, we try to handle a bit more, but +with little enthusiasm). + +=back + +=head2 Debugging + +Debugging this module is more than a bit complex due to interference from +the software producing the indices on CPAN, the mirroring process on CPAN, +packaging, configuration, synchronicity, and even (gasp!) due to bugs +within the CPAN.pm module itself. + +For debugging the code of CPAN.pm itself in interactive mode, some +debugging aid can be turned on for most packages within +CPAN.pm with one of + +=over 2 + +=item o debug package... + +sets debug mode for packages. + +=item o debug -package... + +unsets debug mode for packages. + +=item o debug all + +turns debugging on for all packages. + +=item o debug number + +=back + +which sets the debugging packages directly. Note that C +turns debugging off. + +What seems a successful strategy is the combination of C and the debugging switches. Add a new debug statement while +running in the shell and then issue a C and see the new +debugging messages immediately without losing the current context. + +C without an argument lists the valid package names and the +current set of packages in debugging mode. C has built-in +completion support. + +For debugging of CPAN data there is the C command which takes +the same arguments as make/test/install and outputs each object's +Data::Dumper dump. If an argument looks like a perl variable and +contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to +Data::Dumper directly. + +=head2 Floppy, Zip, Offline Mode + +CPAN.pm works nicely without network access, too. If you maintain machines +that are not networked at all, you should consider working with C +URLs. You'll have to collect your modules somewhere first. So +you might use CPAN.pm to put together all you need on a networked +machine. Then copy the $CPAN::Config->{keep_source_where} (but not +$CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind +of a personal CPAN. CPAN.pm on the non-networked machines works nicely +with this floppy. See also below the paragraph about CD-ROM support. + +=head2 Basic Utilities for Programmers + +=over 2 + +=item has_inst($module) + +Returns true if the module is installed. Used to load all modules into +the running CPAN.pm that are considered optional. The config variable +C intercepts the C call such +that an optional module is not loaded despite being available. For +example, the following command will prevent C from being +loaded: + + cpan> o conf dontload_list push YAML + +See the source for details. + +=item has_usable($module) + +Returns true if the module is installed and in a usable state. Only +useful for a handful of modules that are used internally. See the +source for details. + +=item instance($module) + +The constructor for all the singletons used to represent modules, +distributions, authors, and bundles. If the object already exists, this +method returns the object; otherwise, it calls the constructor. + +=back + +=head1 SECURITY + +There's no strong security layer in CPAN.pm. CPAN.pm helps you to +install foreign, unmasked, unsigned code on your machine. We compare +to a checksum that comes from the net just as the distribution file +itself. But we try to make it easy to add security on demand: + +=head2 Cryptographically signed modules + +Since release 1.77, CPAN.pm has been able to verify cryptographically +signed module distributions using Module::Signature. The CPAN modules +can be signed by their authors, thus giving more security. The simple +unsigned MD5 checksums that were used before by CPAN protect mainly +against accidental file corruption. + +You will need to have Module::Signature installed, which in turn +requires that you have at least one of Crypt::OpenPGP module or the +command-line F tool installed. + +You will also need to be able to connect over the Internet to the public +keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol). + +The configuration parameter check_sigs is there to turn signature +checking on or off. + +=head1 EXPORT + +Most functions in package CPAN are exported by default. The reason +for this is that the primary use is intended for the cpan shell or for +one-liners. + +=head1 ENVIRONMENT + +When the CPAN shell enters a subshell via the look command, it sets +the environment CPAN_SHELL_LEVEL to 1, or increments that variable if it is +already set. + +When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING +to the ID of the running process. It also sets +PERL5_CPANPLUS_IS_RUNNING to prevent runaway processes which could +happen with older versions of Module::Install. + +When running C, the environment variable +C is set to the full path of the +C that is being executed. This prevents runaway processes +with newer versions of Module::Install. + +When the config variable ftp_passive is set, all downloads will be run +with the environment variable FTP_PASSIVE set to this value. This is +in general a good idea as it influences both Net::FTP and LWP based +connections. The same effect can be achieved by starting the cpan +shell with this environment variable set. For Net::FTP alone, one can +also always set passive mode by running libnetcfg. + +=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES + +Populating a freshly installed perl with one's favorite modules is pretty +easy if you maintain a private bundle definition file. To get a useful +blueprint of a bundle definition file, the command autobundle can be used +on the CPAN shell command line. This command writes a bundle definition +file for all modules installed for the current perl +interpreter. It's recommended to run this command once only, and from then +on maintain the file manually under a private name, say +Bundle/my_bundle.pm. With a clever bundle file you can then simply say + + cpan> install Bundle::my_bundle + +then answer a few questions and go out for coffee (possibly +even in a different city). + +Maintaining a bundle definition file means keeping track of two +things: dependencies and interactivity. CPAN.pm sometimes fails on +calculating dependencies because not all modules define all MakeMaker +attributes correctly, so a bundle definition file should specify +prerequisites as early as possible. On the other hand, it's +annoying that so many distributions need some interactive configuring. So +what you can try to accomplish in your private bundle file is to have the +packages that need to be configured early in the file and the gentle +ones later, so you can go out for cofeee after a few minutes and leave CPAN.pm +to churn away untended. + +=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS + +Thanks to Graham Barr for contributing the following paragraphs about +the interaction between perl, and various firewall configurations. For +further information on firewalls, it is recommended to consult the +documentation that comes with the I program. If you are unable to +go through the firewall with a simple Perl setup, it is likely +that you can configure I so that it works through your firewall. + +=head2 Three basic types of firewalls + +Firewalls can be categorized into three basic types. + +=over 4 + +=item http firewall + +This is when the firewall machine runs a web server, and to access the +outside world, you must do so via that web server. If you set environment +variables like http_proxy or ftp_proxy to values beginning with http://, +or in your web browser you've proxy information set, then you know +you are running behind an http firewall. + +To access servers outside these types of firewalls with perl (even for +ftp), you need LWP. + +=item ftp firewall + +This where the firewall machine runs an ftp server. This kind of +firewall will only let you access ftp servers outside the firewall. +This is usually done by connecting to the firewall with ftp, then +entering a username like "user@outside.host.com". + +To access servers outside these type of firewalls with perl, you +need Net::FTP. + +=item One-way visibility + +One-way visibility means these firewalls try to make themselves +invisible to users inside the firewall. An FTP data connection is +normally created by sending your IP address to the remote server and then +listening for the return connection. But the remote server will not be able to +connect to you because of the firewall. For these types of firewall, +FTP connections need to be done in a passive mode. + +There are two that I can think off. + +=over 4 + +=item SOCKS + +If you are using a SOCKS firewall, you will need to compile perl and link +it with the SOCKS library. This is what is normally called a 'socksified' +perl. With this executable you will be able to connect to servers outside +the firewall as if it were not there. + +=item IP Masquerade + +This is when the firewall implemented in the kernel (via NAT, or networking +address translation), it allows you to hide a complete network behind one +IP address. With this firewall no special compiling is needed as you can +access hosts directly. + +For accessing ftp servers behind such firewalls you usually need to +set the environment variable C or the config variable +ftp_passive to a true value. + +=back + +=back + +=head2 Configuring lynx or ncftp for going through a firewall + +If you can go through your firewall with e.g. lynx, presumably with a +command such as + + /usr/local/bin/lynx -pscott:tiger + +then you would configure CPAN.pm with the command + + o conf lynx "/usr/local/bin/lynx -pscott:tiger" + +That's all. Similarly for ncftp or ftp, you would configure something +like + + o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg" + +Your mileage may vary... + +=head1 FAQ + +=over 4 + +=item 1) + +I installed a new version of module X but CPAN keeps saying, +I have the old version installed + +Probably you B have the old version installed. This can +happen if a module installs itself into a different directory in the +@INC path than it was previously installed. This is not really a +CPAN.pm problem, you would have the same problem when installing the +module manually. The easiest way to prevent this behaviour is to add +the argument C to the C call, and that is why +many people add this argument permanently by configuring + + o conf make_install_arg UNINST=1 + +=item 2) + +So why is UNINST=1 not the default? + +Because there are people who have their precise expectations about who +may install where in the @INC path and who uses which @INC array. In +fine tuned environments C can cause damage. + +=item 3) + +I want to clean up my mess, and install a new perl along with +all modules I have. How do I go about it? + +Run the autobundle command for your old perl and optionally rename the +resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl +with the Configure option prefix, e.g. + + ./Configure -Dprefix=/usr/local/perl-5.6.78.9 + +Install the bundle file you produced in the first step with something like + + cpan> install Bundle::mybundle + +and you're done. + +=item 4) + +When I install bundles or multiple modules with one command +there is too much output to keep track of. + +You may want to configure something like + + o conf make_arg "| tee -ai /root/.cpan/logs/make.out" + o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out" + +so that STDOUT is captured in a file for later inspection. + + +=item 5) + +I am not root, how can I install a module in a personal directory? + +First of all, you will want to use your own configuration, not the one +that your root user installed. If you do not have permission to write +in the cpan directory that root has configured, you will be asked if +you want to create your own config. Answering "yes" will bring you into +CPAN's configuration stage, using the system config for all defaults except +things that have to do with CPAN's work directory, saving your choices to +your MyConfig.pm file. + +You can also manually initiate this process with the following command: + + % perl -MCPAN -e 'mkmyconfig' + +or by running + + mkmyconfig + +from the CPAN shell. + +You will most probably also want to configure something like this: + + o conf makepl_arg "LIB=~/myperl/lib \ + INSTALLMAN1DIR=~/myperl/man/man1 \ + INSTALLMAN3DIR=~/myperl/man/man3 \ + INSTALLSCRIPT=~/myperl/bin \ + INSTALLBIN=~/myperl/bin" + +and then the equivalent command for Module::Build, which is + + o conf mbuildpl_arg "--lib=~/myperl/lib \ + --installman1dir=~/myperl/man/man1 \ + --installman3dir=~/myperl/man/man3 \ + --installscript=~/myperl/bin \ + --installbin=~/myperl/bin" + +You can make this setting permanent like all C settings with +C or by setting C beforehand. + +You will have to add ~/myperl/man to the MANPATH environment variable +and also tell your perl programs to look into ~/myperl/lib, e.g. by +including + + use lib "$ENV{HOME}/myperl/lib"; + +or setting the PERL5LIB environment variable. + +While we're speaking about $ENV{HOME}, it might be worth mentioning, +that for Windows we use the File::HomeDir module that provides an +equivalent to the concept of the home directory on Unix. + +Another thing you should bear in mind is that the UNINST parameter can +be dangerous when you are installing into a private area because you +might accidentally remove modules that other people depend on that are +not using the private area. + +=item 6) + +How to get a package, unwrap it, and make a change before building it? + +Have a look at the C (!) command. + +=item 7) + +I installed a Bundle and had a couple of fails. When I +retried, everything resolved nicely. Can this be fixed to work +on first try? + +The reason for this is that CPAN does not know the dependencies of all +modules when it starts out. To decide about the additional items to +install, it just uses data found in the META.yml file or the generated +Makefile. An undetected missing piece breaks the process. But it may +well be that your Bundle installs some prerequisite later than some +depending item and thus your second try is able to resolve everything. +Please note, CPAN.pm does not know the dependency tree in advance and +cannot sort the queue of things to install in a topologically correct +order. It resolves perfectly well B all modules declare the +prerequisites correctly with the PREREQ_PM attribute to MakeMaker or +the C stanza of Module::Build. For bundles which fail and +you need to install often, it is recommended to sort the Bundle +definition file manually. + +=item 8) + +In our intranet, we have many modules for internal use. How +can I integrate these modules with CPAN.pm but without uploading +the modules to CPAN? + +Have a look at the CPAN::Site module. + +=item 9) + +When I run CPAN's shell, I get an error message about things in my +C (or C<~/.inputrc>) file. + +These are readline issues and can only be fixed by studying readline +configuration on your architecture and adjusting the referenced file +accordingly. Please make a backup of the C or C<~/.inputrc> +and edit them. Quite often harmless changes like uppercasing or +lowercasing some arguments solves the problem. + +=item 10) + +Some authors have strange characters in their names. + +Internally CPAN.pm uses the UTF-8 charset. If your terminal is +expecting ISO-8859-1 charset, a converter can be activated by setting +term_is_latin to a true value in your config file. One way of doing so +would be + + cpan> o conf term_is_latin 1 + +If other charset support is needed, please file a bugreport against +CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend +the support or maybe UTF-8 terminals become widely available. + +Note: this config variable is deprecated and will be removed in a +future version of CPAN.pm. It will be replaced with the conventions +around the family of $LANG and $LC_* environment variables. + +=item 11) + +When an install fails for some reason and then I correct the error +condition and retry, CPAN.pm refuses to install the module, saying +C. + +Use the force pragma like so + + force install Foo::Bar + +Or you can use + + look Foo::Bar + +and then C directly in the subshell. + +=item 12) + +How do I install a "DEVELOPER RELEASE" of a module? + +By default, CPAN will install the latest non-developer release of a +module. If you want to install a dev release, you have to specify the +partial path starting with the author id to the tarball you wish to +install, like so: + + cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz + +Note that you can use the C command to get this path listed. + +=item 13) + +How do I install a module and all its dependencies from the commandline, +without being prompted for anything, despite my CPAN configuration +(or lack thereof)? + +CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so +if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be +asked any questions at all (assuming the modules you are installing are +nice about obeying that variable as well): + + % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module' + +=item 14) + +How do I create a Module::Build based Build.PL derived from an +ExtUtils::MakeMaker focused Makefile.PL? + +http://search.cpan.org/search?query=Module::Build::Convert + +http://www.refcnt.org/papers/module-build-convert + +=item 15) + +I'm frequently irritated with the CPAN shell's inability to help me +select a good mirror. + +The urllist config parameter is yours. You can add and remove sites at +will. You should find out which sites have the best uptodateness, +bandwidth, reliability, etc. and are topologically close to you. Some +people prefer fast downloads, others uptodateness, others reliability. +You decide which to try in which order. + +Henk P. Penning maintains a site that collects data about CPAN sites: + + http://www.cs.uu.nl/people/henkp/mirmon/cpan.html + +Also, feel free to play with experimental features. Run + + o conf init randomize_urllist ftpstats_period ftpstats_size + +and choose your favorite parameters. After a few downloads running the +C command will probably assist you in choosing the best mirror +sites. + +=item 16) + +Why do I get asked the same questions every time I start the shell? + +You can make your configuration changes permanent by calling the +command C. Alternatively set the C +variable to true by running C and answering +the following question with yes. + +=item 17) + +Older versions of CPAN.pm had the original root directory of all +tarballs in the build directory. Now there are always random +characters appended to these directory names. Why was this done? + +The random characters are provided by File::Temp and ensure that each +module's individual build directory is unique. This makes running +CPAN.pm in concurrent processes simultaneously safe. + +=item 18) + +Speaking of the build directory. Do I have to clean it up myself? + +You have the choice to set the config variable C to +C. Then you must clean it up yourself. The other possible +value, C only cleans up the build directory when you start +the CPAN shell. If you never start up the CPAN shell, you probably +also have to clean up the build directory yourself. + +=back + +=head1 COMPATIBILITY + +=head2 OLD PERL VERSIONS + +CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted +newer versions. It is getting more and more difficult to get the +minimal prerequisites working on older perls. It is close to +impossible to get the whole Bundle::CPAN working there. If you're in +the position to have only these old versions, be advised that CPAN is +designed to work fine without the Bundle::CPAN installed. + +To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is +compatible with ancient perls and that File::Temp is listed as a +prerequisite but CPAN has reasonable workarounds if it is missing. + +=head2 CPANPLUS + +This module and its competitor, the CPANPLUS module, are both much +cooler than the other. CPAN.pm is older. CPANPLUS was designed to be +more modular, but it was never intended to be compatible with CPAN.pm. + +=head1 SECURITY ADVICE + +This software enables you to upgrade software on your computer and so +is inherently dangerous because the newly installed software may +contain bugs and may alter the way your computer works or even make it +unusable. Please consider backing up your data before every upgrade. + +=head1 BUGS + +Please report bugs via L + +Before submitting a bug, please make sure that the traditional method +of building a Perl module package from a shell by following the +installation instructions of that package still works in your +environment. + +=head1 AUTHOR + +Andreas Koenig C<< >> + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L + +=head1 TRANSLATIONS + +Kawai,Takanori provides a Japanese translation of this manpage at +L + +=head1 SEE ALSO + +L, L, L + +=cut diff --git a/cpan/CPAN/lib/CPAN/API/HOWTO.pod b/cpan/CPAN/lib/CPAN/API/HOWTO.pod new file mode 100644 index 0000000000..e65a4bc931 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/API/HOWTO.pod @@ -0,0 +1,44 @@ +=head1 NAME + +CPAN::API::HOWTO - a recipe book for programming with CPAN.pm + +=head1 RECIPES + +All of these recipes assume that you have put "use CPAN" at the top of +your program. + +=head2 What distribution contains a particular module? + + my $distribution = CPAN::Shell->expand( + "Module", "Data::UUID" + )->distribution()->pretty_id(); + +This returns a string of the form "AUTHORID/TARBALL". If you want the +full path and filename to this distribution on a CPAN mirror, then it is +C<.../authors/id/A/AU/AUTHORID/TARBALL>. + +=head2 What modules does a particular distribution contain? + + CPAN::Index->reload(); + my @modules = CPAN::Shell->expand( + "Distribution", "JHI/Graph-0.83.tar.gz" + )->containsmods(); + +You may also refer to a distribution in the form A/AU/AUTHORID/TARBALL. + +=head1 SEE ALSO + +the main CPAN.pm documentation + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L + +=head1 AUTHOR + +David Cantrell + +=cut diff --git a/cpan/CPAN/lib/CPAN/Author.pm b/cpan/CPAN/lib/CPAN/Author.pm new file mode 100644 index 0000000000..14ef2ef633 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Author.pm @@ -0,0 +1,228 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Author; +use strict; + +use CPAN::InfoObj; +@CPAN::Author::ISA = qw(CPAN::InfoObj); +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +package CPAN::Author; +use strict; + +#-> sub CPAN::Author::force +sub force { + my $self = shift; + $self->{force}++; +} + +#-> sub CPAN::Author::force +sub unforce { + my $self = shift; + delete $self->{force}; +} + +#-> sub CPAN::Author::id +sub id { + my $self = shift; + my $id = $self->{ID}; + $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/; + $id; +} + +#-> sub CPAN::Author::as_glimpse ; +sub as_glimpse { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n}, + $class, + $self->{ID}, + $self->fullname, + $self->email); + join "", @m; +} + +#-> sub CPAN::Author::fullname ; +sub fullname { + shift->ro->{FULLNAME}; +} +*name = \&fullname; + +#-> sub CPAN::Author::email ; +sub email { shift->ro->{EMAIL}; } + +#-> sub CPAN::Author::ls ; +sub ls { + my $self = shift; + my $glob = shift || ""; + my $silent = shift || 0; + my $id = $self->id; + + # adapted from CPAN::Distribution::verifyCHECKSUM ; + my(@csf); # chksumfile + @csf = $self->id =~ /(.)(.)(.*)/; + $csf[1] = join "", @csf[0,1]; + $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK") + my(@dl); + @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1); + unless (grep {$_->[2] eq $csf[1]} @dl) { + $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ; + return; + } + @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1); + unless (grep {$_->[2] eq $csf[2]} @dl) { + $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent; + return; + } + @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1); + if ($glob) { + if ($CPAN::META->has_inst("Text::Glob")) { + $glob =~ s|/$|/*|; + my $rglob = Text::Glob::glob_to_regex($glob); + CPAN->debug("glob[$glob]rglob[$rglob]dl[@dl]") if $CPAN::DEBUG; + my @tmpdl = grep { $_->[2] =~ /$rglob/ } @dl; + if (1==@tmpdl && $tmpdl[0][0]==0) { + $rglob = Text::Glob::glob_to_regex("$glob/*"); + @dl = grep { $_->[2] =~ /$rglob/ } @dl; + } else { + @dl = @tmpdl; + } + CPAN->debug("rglob[$rglob]dl[@dl]") if $CPAN::DEBUG; + } else { + $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed"); + } + } + unless ($silent >= 2) { + $CPAN::Frontend->myprint + ( + join "", + map { + sprintf + ( + "%8d %10s %s/%s%s\n", + $_->[0], + $_->[1], + $id, + $_->[2], + 0==$_->[0]?"/":"", + ) + } sort { $a->[2] cmp $b->[2] } @dl + ); + } + @dl; +} + +# returns an array of arrays, the latter contain (size,mtime,filename) +#-> sub CPAN::Author::dir_listing ; +sub dir_listing { + my $self = shift; + my $chksumfile = shift; + my $recursive = shift; + my $may_ftp = shift; + + my $lc_want = + File::Spec->catfile($CPAN::Config->{keep_source_where}, + "authors", "id", @$chksumfile); + + my $fh; + + CPAN->debug("chksumfile[@$chksumfile]recursive[$recursive]may_ftp[$may_ftp]") if $CPAN::DEBUG; + # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security + # hazard. (Without GPG installed they are not that much better, + # though.) + $fh = FileHandle->new; + if (open($fh, $lc_want)) { + my $line = <$fh>; close $fh; + unlink($lc_want) unless $line =~ /PGP/; + } + + local($") = "/"; + # connect "force" argument with "index_expire". + my $force = $self->{force}; + if (my @stat = stat $lc_want) { + $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time; + } + my $lc_file; + if ($may_ftp) { + $lc_file = CPAN::FTP->localize( + "authors/id/@$chksumfile", + $lc_want, + $force, + ); + unless ($lc_file) { + $CPAN::Frontend->myprint("Trying $lc_want.gz\n"); + $chksumfile->[-1] .= ".gz"; + $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile", + "$lc_want.gz",1); + if ($lc_file) { + $lc_file =~ s{\.gz(?!\n)\Z}{}; #}; + eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)}; + } else { + return; + } + } + } else { + $lc_file = $lc_want; + # we *could* second-guess and if the user has a file: URL, + # then we could look there. But on the other hand, if they do + # have a file: URL, wy did they choose to set + # $CPAN::Config->{show_upload_date} to false? + } + + # adapted from CPAN::Distribution::CHECKSUM_check_file ; + $fh = FileHandle->new; + my($cksum); + if (open $fh, $lc_file) { + local($/); + my $eval = <$fh>; + $eval =~ s/\015?\012/\n/g; + close $fh; + my($compmt) = Safe->new(); + $cksum = $compmt->reval($eval); + if ($@) { + rename $lc_file, "$lc_file.bad"; + Carp::confess($@) if $@; + } + } elsif ($may_ftp) { + Carp::carp ("Could not open '$lc_file' for reading."); + } else { + # Maybe should warn: "You may want to set show_upload_date to a true value" + return; + } + my(@result,$f); + for $f (sort keys %$cksum) { + if (exists $cksum->{$f}{isdir}) { + if ($recursive) { + my(@dir) = @$chksumfile; + pop @dir; + push @dir, $f, "CHECKSUMS"; + push @result, [ 0, "-", $f ]; + push @result, map { + [$_->[0], $_->[1], "$f/$_->[2]"] + } $self->dir_listing(\@dir,1,$may_ftp); + } else { + push @result, [ 0, "-", $f ]; + } + } else { + push @result, [ + ($cksum->{$f}{"size"}||0), + $cksum->{$f}{"mtime"}||"---", + $f + ]; + } + } + @result; +} + +#-> sub CPAN::Author::reports +sub reports { + $CPAN::Frontend->mywarn("reports on authors not implemented. +Please file a bugreport if you need this.\n"); +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Bundle.pm b/cpan/CPAN/lib/CPAN/Bundle.pm new file mode 100644 index 0000000000..e7360f8048 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Bundle.pm @@ -0,0 +1,287 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Bundle; +use strict; +use CPAN::Module; +@CPAN::Bundle::ISA = qw(CPAN::Module); + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +sub look { + my $self = shift; + $CPAN::Frontend->myprint($self->as_string); +} + +#-> CPAN::Bundle::undelay +sub undelay { + my $self = shift; + delete $self->{later}; + for my $c ( $self->contains ) { + my $obj = CPAN::Shell->expandany($c) or next; + $obj->undelay; + } +} + +# mark as dirty/clean +#-> sub CPAN::Bundle::color_cmd_tmps ; +sub color_cmd_tmps { + my($self) = shift; + my($depth) = shift || 0; + my($color) = shift || 0; + my($ancestors) = shift || []; + # a module needs to recurse to its cpan_file, a distribution needs + # to recurse into its prereq_pms, a bundle needs to recurse into its modules + + return if exists $self->{incommandcolor} + && $color==1 + && $self->{incommandcolor}==$color; + if ($depth>=$CPAN::MAX_RECURSION) { + die(CPAN::Exception::RecursiveDependency->new($ancestors)); + } + # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; + + for my $c ( $self->contains ) { + my $obj = CPAN::Shell->expandany($c) or next; + CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG; + $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]); + } + # never reached code? + #if ($color==0) { + #delete $self->{badtestcnt}; + #} + $self->{incommandcolor} = $color; +} + +#-> sub CPAN::Bundle::as_string ; +sub as_string { + my($self) = @_; + $self->contains; + # following line must be "=", not "||=" because we have a moving target + $self->{INST_VERSION} = $self->inst_version; + return $self->SUPER::as_string; +} + +#-> sub CPAN::Bundle::contains ; +sub contains { + my($self) = @_; + my($inst_file) = $self->inst_file || ""; + my($id) = $self->id; + $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG; + if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) { + undef $inst_file; + } + unless ($inst_file) { + # Try to get at it in the cpan directory + $self->debug("no inst_file") if $CPAN::DEBUG; + my $cpan_file; + $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless + $cpan_file = $self->cpan_file; + if ($cpan_file eq "N/A") { + $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN. + Maybe stale symlink? Maybe removed during session? Giving up.\n"); + } + my $dist = $CPAN::META->instance('CPAN::Distribution', + $self->cpan_file); + $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG; + $dist->get; + $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG; + my($todir) = $CPAN::Config->{'cpan_home'}; + my(@me,$from,$to,$me); + @me = split /::/, $self->id; + $me[-1] .= ".pm"; + $me = File::Spec->catfile(@me); + $from = $self->find_bundle_file($dist->{build_dir},join('/',@me)); + $to = File::Spec->catfile($todir,$me); + File::Path::mkpath(File::Basename::dirname($to)); + File::Copy::copy($from, $to) + or Carp::confess("Couldn't copy $from to $to: $!"); + $inst_file = $to; + } + my @result; + my $fh = FileHandle->new; + local $/ = "\n"; + open($fh,$inst_file) or die "Could not open '$inst_file': $!"; + my $in_cont = 0; + $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG; + while (<$fh>) { + $in_cont = m/^=(?!head1\s+(?i-xsm:CONTENTS))/ ? 0 : + m/^=head1\s+(?i-xsm:CONTENTS)/ ? 1 : $in_cont; + next unless $in_cont; + next if /^=/; + s/\#.*//; + next if /^\s+$/; + chomp; + push @result, (split " ", $_, 2)[0]; + } + close $fh; + delete $self->{STATUS}; + $self->{CONTAINS} = \@result; + $self->debug("CONTAINS[@result]") if $CPAN::DEBUG; + unless (@result) { + $CPAN::Frontend->mywarn(qq{ +The bundle file "$inst_file" may be a broken +bundlefile. It seems not to contain any bundle definition. +Please check the file and if it is bogus, please delete it. +Sorry for the inconvenience. +}); + } + @result; +} + +#-> sub CPAN::Bundle::find_bundle_file +# $where is in local format, $what is in unix format +sub find_bundle_file { + my($self,$where,$what) = @_; + $self->debug("where[$where]what[$what]") if $CPAN::DEBUG; +### The following two lines let CPAN.pm become Bundle/CPAN.pm :-( +### my $bu = File::Spec->catfile($where,$what); +### return $bu if -f $bu; + my $manifest = File::Spec->catfile($where,"MANIFEST"); + unless (-f $manifest) { + require ExtUtils::Manifest; + my $cwd = CPAN::anycwd(); + $self->safe_chdir($where); + ExtUtils::Manifest::mkmanifest(); + $self->safe_chdir($cwd); + } + my $fh = FileHandle->new($manifest) + or Carp::croak("Couldn't open $manifest: $!"); + local($/) = "\n"; + my $bundle_filename = $what; + $bundle_filename =~ s|Bundle.*/||; + my $bundle_unixpath; + while (<$fh>) { + next if /^\s*\#/; + my($file) = /(\S+)/; + if ($file =~ m|\Q$what\E$|) { + $bundle_unixpath = $file; + # return File::Spec->catfile($where,$bundle_unixpath); # bad + last; + } + # retry if she managed to have no Bundle directory + $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|; + } + return File::Spec->catfile($where, split /\//, $bundle_unixpath) + if $bundle_unixpath; + Carp::croak("Couldn't find a Bundle file in $where"); +} + +# needs to work quite differently from Module::inst_file because of +# cpan_home/Bundle/ directory and the possibility that we have +# shadowing effect. As it makes no sense to take the first in @INC for +# Bundles, we parse them all for $VERSION and take the newest. + +#-> sub CPAN::Bundle::inst_file ; +sub inst_file { + my($self) = @_; + my($inst_file); + my(@me); + @me = split /::/, $self->id; + $me[-1] .= ".pm"; + my($incdir,$bestv); + foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) { + my $parsefile = File::Spec->catfile($incdir, @me); + CPAN->debug("parsefile[$parsefile]") if $CPAN::DEBUG; + next unless -f $parsefile; + my $have = eval { MM->parse_version($parsefile); }; + if ($@) { + $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n"); + } + if (!$bestv || CPAN::Version->vgt($have,$bestv)) { + $self->{INST_FILE} = $parsefile; + $self->{INST_VERSION} = $bestv = $have; + } + } + $self->{INST_FILE}; +} + +#-> sub CPAN::Bundle::inst_version ; +sub inst_version { + my($self) = @_; + $self->inst_file; # finds INST_VERSION as side effect + $self->{INST_VERSION}; +} + +#-> sub CPAN::Bundle::rematein ; +sub rematein { + my($self,$meth) = @_; + $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG; + my($id) = $self->id; + Carp::croak( "Can't $meth $id, don't have an associated bundle file. :-(\n" ) + unless $self->inst_file || $self->cpan_file; + my($s,%fail); + for $s ($self->contains) { + my($type) = $s =~ m|/| ? 'CPAN::Distribution' : + $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module'; + if ($type eq 'CPAN::Distribution') { + $CPAN::Frontend->mywarn(qq{ +The Bundle }.$self->id.qq{ contains +explicitly a file '$s'. +Going to $meth that. +}); + $CPAN::Frontend->mysleep(5); + } + # possibly noisy action: + $self->debug("type[$type] s[$s]") if $CPAN::DEBUG; + my $obj = $CPAN::META->instance($type,$s); + $obj->{reqtype} = $self->{reqtype}; + $obj->$meth(); + } +} + +# If a bundle contains another that contains an xs_file we have here, +# we just don't bother I suppose +#-> sub CPAN::Bundle::xs_file +sub xs_file { + return 0; +} + +#-> sub CPAN::Bundle::force ; +sub fforce { shift->rematein('fforce',@_); } +#-> sub CPAN::Bundle::force ; +sub force { shift->rematein('force',@_); } +#-> sub CPAN::Bundle::notest ; +sub notest { shift->rematein('notest',@_); } +#-> sub CPAN::Bundle::get ; +sub get { shift->rematein('get',@_); } +#-> sub CPAN::Bundle::make ; +sub make { shift->rematein('make',@_); } +#-> sub CPAN::Bundle::test ; +sub test { + my $self = shift; + # $self->{badtestcnt} ||= 0; + $self->rematein('test',@_); +} +#-> sub CPAN::Bundle::install ; +sub install { + my $self = shift; + $self->rematein('install',@_); +} +#-> sub CPAN::Bundle::clean ; +sub clean { shift->rematein('clean',@_); } + +#-> sub CPAN::Bundle::uptodate ; +sub uptodate { + my($self) = @_; + return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def + my $c; + foreach $c ($self->contains) { + my $obj = CPAN::Shell->expandany($c); + return 0 unless $obj->uptodate; + } + return 1; +} + +#-> sub CPAN::Bundle::readme ; +sub readme { + my($self) = @_; + my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{ +No File found for bundle } . $self->id . qq{\n}), return; + $self->debug("self[$self] file[$file]") if $CPAN::DEBUG; + $CPAN::META->instance('CPAN::Distribution',$file)->readme; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/CacheMgr.pm b/cpan/CPAN/lib/CPAN/CacheMgr.pm new file mode 100644 index 0000000000..827baeaefd --- /dev/null +++ b/cpan/CPAN/lib/CPAN/CacheMgr.pm @@ -0,0 +1,246 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::CacheMgr; +use strict; +use CPAN::InfoObj; +@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN); +use Cwd qw(chdir); +use File::Find; + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +package CPAN::CacheMgr; +use strict; + +#-> sub CPAN::CacheMgr::as_string ; +sub as_string { + eval { require Data::Dumper }; + if ($@) { + return shift->SUPER::as_string; + } else { + return Data::Dumper::Dumper(shift); + } +} + +#-> sub CPAN::CacheMgr::cachesize ; +sub cachesize { + shift->{DU}; +} + +#-> sub CPAN::CacheMgr::tidyup ; +sub tidyup { + my($self) = @_; + return unless $CPAN::META->{LOCK}; + return unless -d $self->{ID}; + my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}}; + for my $current (0..$#toremove) { + my $toremove = $toremove[$current]; + $CPAN::Frontend->myprint(sprintf( + "DEL(%d/%d): %s \n", + $current+1, + scalar @toremove, + $toremove, + ) + ); + return if $CPAN::Signal; + $self->_clean_cache($toremove); + return if $CPAN::Signal; + } +} + +#-> sub CPAN::CacheMgr::dir ; +sub dir { + shift->{ID}; +} + +#-> sub CPAN::CacheMgr::entries ; +sub entries { + my($self,$dir) = @_; + return unless defined $dir; + $self->debug("reading dir[$dir]") if $CPAN::DEBUG; + $dir ||= $self->{ID}; + my($cwd) = CPAN::anycwd(); + chdir $dir or Carp::croak("Can't chdir to $dir: $!"); + my $dh = DirHandle->new(File::Spec->curdir) + or Carp::croak("Couldn't opendir $dir: $!"); + my(@entries); + for ($dh->read) { + next if $_ eq "." || $_ eq ".."; + if (-f $_) { + push @entries, File::Spec->catfile($dir,$_); + } elsif (-d _) { + push @entries, File::Spec->catdir($dir,$_); + } else { + $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n"); + } + } + chdir $cwd or Carp::croak("Can't chdir to $cwd: $!"); + sort { -M $a <=> -M $b} @entries; +} + +#-> sub CPAN::CacheMgr::disk_usage ; +sub disk_usage { + my($self,$dir,$fast) = @_; + return if exists $self->{SIZE}{$dir}; + return if $CPAN::Signal; + my($Du) = 0; + if (-e $dir) { + if (-d $dir) { + unless (-x $dir) { + unless (chmod 0755, $dir) { + $CPAN::Frontend->mywarn("I have neither the -x permission nor the ". + "permission to change the permission; cannot ". + "estimate disk usage of '$dir'\n"); + $CPAN::Frontend->mysleep(5); + return; + } + } + } elsif (-f $dir) { + # nothing to say, no matter what the permissions + } + } else { + $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n"); + return; + } + if ($fast) { + $Du = 0; # placeholder + } else { + find( + sub { + $File::Find::prune++ if $CPAN::Signal; + return if -l $_; + if ($^O eq 'MacOS') { + require Mac::Files; + my $cat = Mac::Files::FSpGetCatInfo($_); + $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat; + } else { + if (-d _) { + unless (-x _) { + unless (chmod 0755, $_) { + $CPAN::Frontend->mywarn("I have neither the -x permission nor ". + "the permission to change the permission; ". + "can only partially estimate disk usage ". + "of '$_'\n"); + $CPAN::Frontend->mysleep(5); + return; + } + } + } else { + $Du += (-s _); + } + } + }, + $dir + ); + } + return if $CPAN::Signal; + $self->{SIZE}{$dir} = $Du/1024/1024; + unshift @{$self->{FIFO}}, $dir; + $self->debug("measured $dir is $Du") if $CPAN::DEBUG; + $self->{DU} += $Du/1024/1024; + $self->{DU}; +} + +#-> sub CPAN::CacheMgr::_clean_cache ; +sub _clean_cache { + my($self,$dir) = @_; + return unless -e $dir; + unless (File::Spec->canonpath(File::Basename::dirname($dir)) + eq File::Spec->canonpath($CPAN::Config->{build_dir})) { + $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ". + "will not remove\n"); + $CPAN::Frontend->mysleep(5); + return; + } + $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}") + if $CPAN::DEBUG; + File::Path::rmtree($dir); + my $id_deleted = 0; + if ($dir !~ /\.yml$/ && -f "$dir.yml") { + my $yaml_module = CPAN::_yaml_module(); + if ($CPAN::META->has_inst($yaml_module)) { + my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); }; + if ($@) { + $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)"); + unlink "$dir.yml" or + $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)"); + return; + } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) { + $CPAN::META->delete("CPAN::Distribution", $id); + + # XXX we should restore the state NOW, otherise this + # distro does not exist until we read an index. BUG ALERT(?) + + # $CPAN::Frontend->mywarn (" +++\n"); + $id_deleted++; + } + } + unlink "$dir.yml"; # may fail + unless ($id_deleted) { + CPAN->debug("no distro found associated with '$dir'"); + } + } + $self->{DU} -= $self->{SIZE}{$dir}; + delete $self->{SIZE}{$dir}; +} + +#-> sub CPAN::CacheMgr::new ; +sub new { + my $class = shift; + my $time = time; + my($debug,$t2); + $debug = ""; + my $self = { + ID => $CPAN::Config->{build_dir}, + MAX => $CPAN::Config->{'build_cache'}, + SCAN => $CPAN::Config->{'scan_cache'} || 'atstart', + DU => 0 + }; + File::Path::mkpath($self->{ID}); + my $dh = DirHandle->new($self->{ID}); + bless $self, $class; + $self->scan_cache; + $t2 = time; + $debug .= "timing of CacheMgr->new: ".($t2 - $time); + $time = $t2; + CPAN->debug($debug) if $CPAN::DEBUG; + $self; +} + +#-> sub CPAN::CacheMgr::scan_cache ; +sub scan_cache { + my $self = shift; + return if $self->{SCAN} eq 'never'; + $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}") + unless $self->{SCAN} eq 'atstart'; + return unless $CPAN::META->{LOCK}; + $CPAN::Frontend->myprint( + sprintf("Scanning cache %s for sizes\n", + $self->{ID})); + my $e; + my @entries = $self->entries($self->{ID}); + my $i = 0; + my $painted = 0; + for $e (@entries) { + my $symbol = "."; + if ($self->{DU} > $self->{MAX}) { + $symbol = "-"; + $self->disk_usage($e,1); + } else { + $self->disk_usage($e); + } + $i++; + while (($painted/76) < ($i/@entries)) { + $CPAN::Frontend->myprint($symbol); + $painted++; + } + return if $CPAN::Signal; + } + $CPAN::Frontend->myprint("DONE\n"); + $self->tidyup; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Complete.pm b/cpan/CPAN/lib/CPAN/Complete.pm new file mode 100644 index 0000000000..e1fe896d4a --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Complete.pm @@ -0,0 +1,175 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Complete; +use strict; +@CPAN::Complete::ISA = qw(CPAN::Debug); +# Q: where is the "How do I add a new command" HOWTO? +# A: svn diff -r 1048:1049 where andk added the report command +@CPAN::Complete::COMMANDS = sort qw( + ? ! a b d h i m o q r u + autobundle + bye + clean + cvs_import + dump + exit + failed + force + fforce + hosts + install + install_tested + is_tested + look + ls + make + mkmyconfig + notest + perldoc + quit + readme + recent + recompile + reload + report + reports + scripts + smoke + test + upgrade +); + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +package CPAN::Complete; +use strict; + +sub gnu_cpl { + my($text, $line, $start, $end) = @_; + my(@perlret) = cpl($text, $line, $start); + # find longest common match. Can anybody show me how to peruse + # T::R::Gnu to have this done automatically? Seems expensive. + return () unless @perlret; + my($newtext) = $text; + for (my $i = length($text)+1;;$i++) { + last unless length($perlret[0]) && length($perlret[0]) >= $i; + my $try = substr($perlret[0],0,$i); + my @tries = grep {substr($_,0,$i) eq $try} @perlret; + # warn "try[$try]tries[@tries]"; + if (@tries == @perlret) { + $newtext = $try; + } else { + last; + } + } + ($newtext,@perlret); +} + +#-> sub CPAN::Complete::cpl ; +sub cpl { + my($word,$line,$pos) = @_; + $word ||= ""; + $line ||= ""; + $pos ||= 0; + CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG; + $line =~ s/^\s*//; + if ($line =~ s/^((?:notest|f?force)\s*)//) { + $pos -= length($1); + } + my @return; + if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) { + @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS; + } elsif ( $line !~ /^[\!abcdghimorutl]/ ) { + @return = (); + } elsif ($line =~ /^a\s/) { + @return = cplx('CPAN::Author',uc($word)); + } elsif ($line =~ /^ls\s/) { + my($author,$rest) = $word =~ m|([^/]+)/?(.*)|; + @return = $rest ? () : map {"$_/"} cplx('CPAN::Author',uc($author||"")); + if (0 && 1==@return) { # XXX too slow and even wrong when there is a * already + @return = grep /^\Q$word\E/, map {"$author/$_->[2]"} CPAN::Shell->expand("Author",$author)->ls("$rest*","2"); + } + } elsif ($line =~ /^b\s/) { + CPAN::Shell->local_bundles; + @return = cplx('CPAN::Bundle',$word); + } elsif ($line =~ /^d\s/) { + @return = cplx('CPAN::Distribution',$word); + } elsif ($line =~ m/^( + [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent + )\s/x ) { + if ($word =~ /^Bundle::/) { + CPAN::Shell->local_bundles; + } + @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word)); + } elsif ($line =~ /^i\s/) { + @return = cpl_any($word); + } elsif ($line =~ /^reload\s/) { + @return = cpl_reload($word,$line,$pos); + } elsif ($line =~ /^o\s/) { + @return = cpl_option($word,$line,$pos); + } elsif ($line =~ m/^\S+\s/ ) { + # fallback for future commands and what we have forgotten above + @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word)); + } else { + @return = (); + } + return @return; +} + +#-> sub CPAN::Complete::cplx ; +sub cplx { + my($class, $word) = @_; + if (CPAN::_sqlite_running()) { + $CPAN::SQLite->search($class, "^\Q$word\E"); + } + my $method = "id"; + $method = "pretty_id" if $class eq "CPAN::Distribution"; + sort grep /^\Q$word\E/, map { $_->$method() } $CPAN::META->all_objects($class); +} + +#-> sub CPAN::Complete::cpl_any ; +sub cpl_any { + my($word) = shift; + return ( + cplx('CPAN::Author',$word), + cplx('CPAN::Bundle',$word), + cplx('CPAN::Distribution',$word), + cplx('CPAN::Module',$word), + ); +} + +#-> sub CPAN::Complete::cpl_reload ; +sub cpl_reload { + my($word,$line,$pos) = @_; + $word ||= ""; + my(@words) = split " ", $line; + CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; + my(@ok) = qw(cpan index); + return @ok if @words == 1; + return grep /^\Q$word\E/, @ok if @words == 2 && $word; +} + +#-> sub CPAN::Complete::cpl_option ; +sub cpl_option { + my($word,$line,$pos) = @_; + $word ||= ""; + my(@words) = split " ", $line; + CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; + my(@ok) = qw(conf debug); + return @ok if @words == 1; + return grep /^\Q$word\E/, @ok if @words == 2 && length($word); + if (0) { + } elsif ($words[1] eq 'index') { + return (); + } elsif ($words[1] eq 'conf') { + return CPAN::HandleConfig::cpl(@_); + } elsif ($words[1] eq 'debug') { + return sort grep /^\Q$word\E/i, + sort keys %CPAN::DEBUG, 'all'; + } +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Debug.pm b/cpan/CPAN/lib/CPAN/Debug.pm new file mode 100644 index 0000000000..926b0d79b4 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Debug.pm @@ -0,0 +1,79 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +package CPAN::Debug; +use strict; +use vars qw($VERSION); + +$VERSION = "5.5"; +# module is internal to CPAN.pm + +%CPAN::DEBUG = qw[ + CPAN 1 + Index 2 + InfoObj 4 + Author 8 + Distribution 16 + Bundle 32 + Module 64 + CacheMgr 128 + Complete 256 + FTP 512 + Shell 1024 + Eval 2048 + HandleConfig 4096 + Tarzip 8192 + Version 16384 + Queue 32768 + FirstTime 65536 +]; + +$CPAN::DEBUG ||= 0; + +#-> sub CPAN::Debug::debug ; +sub debug { + my($self,$arg) = @_; + + my @caller; + my $i = 0; + while () { + my(@c) = (caller($i))[0 .. ($i ? 3 : 2)]; + last unless defined $c[0]; + push @caller, \@c; + for (0,3) { + last if $_ > $#c; + $c[$_] =~ s/.*:://; + } + for (1) { + $c[$_] =~ s|.*/||; + } + last if ++$i>=3; + } + pop @caller; + if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) { + if ($arg and ref $arg) { + eval { require Data::Dumper }; + if ($@) { + $CPAN::Frontend->myprint($arg->as_string); + } else { + $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg)); + } + } else { + my $outer = ""; + local $" = ","; + if (@caller>1) { + $outer = ",[@{$caller[1]}]"; + } + $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n"); + } + } +} + +1; + +__END__ + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut diff --git a/cpan/CPAN/lib/CPAN/DeferredCode.pm b/cpan/CPAN/lib/CPAN/DeferredCode.pm new file mode 100644 index 0000000000..0db37a6485 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/DeferredCode.pm @@ -0,0 +1,16 @@ +package CPAN::DeferredCode; + +use strict; +use vars qw/$VERSION/; + +use overload fallback => 1, map { ($_ => 'run') } qw/ + bool "" 0+ +/; + +$VERSION = "5.50"; + +sub run { + $_[0]->(); +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm b/cpan/CPAN/lib/CPAN/Distribution.pm new file mode 100644 index 0000000000..45192bdb9d --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Distribution.pm @@ -0,0 +1,3840 @@ +package CPAN::Distribution; +use strict; +use Cwd qw(chdir); +use CPAN::Distroprefs; +use CPAN::InfoObj; +@CPAN::Distribution::ISA = qw(CPAN::InfoObj); +use vars qw($VERSION); +$VERSION = "1.93"; + +# Accessors +sub cpan_comment { + my $self = shift; + my $ro = $self->ro or return; + $ro->{CPAN_COMMENT} +} + +#-> CPAN::Distribution::undelay +sub undelay { + my $self = shift; + for my $delayer ( + "configure_requires_later", + "configure_requires_later_for", + "later", + "later_for", + ) { + delete $self->{$delayer}; + } +} + +#-> CPAN::Distribution::is_dot_dist +sub is_dot_dist { + my($self) = @_; + return substr($self->id,-1,1) eq "."; +} + +# add the A/AN/ stuff +#-> CPAN::Distribution::normalize +sub normalize { + my($self,$s) = @_; + $s = $self->id unless defined $s; + if (substr($s,-1,1) eq ".") { + # using a global because we are sometimes called as static method + if (!$CPAN::META->{LOCK} + && !$CPAN::Have_warned->{"$s is unlocked"}++ + ) { + $CPAN::Frontend->mywarn("You are visiting the local directory + '$s' + without lock, take care that concurrent processes do not do likewise.\n"); + $CPAN::Frontend->mysleep(1); + } + if ($s eq ".") { + $s = "$CPAN::iCwd/."; + } elsif (File::Spec->file_name_is_absolute($s)) { + } elsif (File::Spec->can("rel2abs")) { + $s = File::Spec->rel2abs($s); + } else { + $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec"); + } + CPAN->debug("s[$s]") if $CPAN::DEBUG; + unless ($CPAN::META->exists("CPAN::Distribution", $s)) { + for ($CPAN::META->instance("CPAN::Distribution", $s)) { + $_->{build_dir} = $s; + $_->{archived} = "local_directory"; + $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory"); + } + } + } elsif ( + $s =~ tr|/|| == 1 + or + $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/| + ) { + return $s if $s =~ m:^N/A|^Contact Author: ; + $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|; + CPAN->debug("s[$s]") if $CPAN::DEBUG; + } + $s; +} + +#-> sub CPAN::Distribution::author ; +sub author { + my($self) = @_; + my($authorid); + if (substr($self->id,-1,1) eq ".") { + $authorid = "LOCAL"; + } else { + ($authorid) = $self->pretty_id =~ /^([\w\-]+)/; + } + CPAN::Shell->expand("Author",$authorid); +} + +# tries to get the yaml from CPAN instead of the distro itself: +# EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels +sub fast_yaml { + my($self) = @_; + my $meta = $self->pretty_id; + $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/; + my(@ls) = CPAN::Shell->globls($meta); + my $norm = $self->normalize($meta); + + my($local_file); + my($local_wanted) = + File::Spec->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + split(/\//,$norm) + ); + $self->debug("Doing localize") if $CPAN::DEBUG; + unless ($local_file = + CPAN::FTP->localize("authors/id/$norm", + $local_wanted)) { + $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n"); + } + my $yaml = CPAN->_yaml_loadfile($local_file)->[0]; +} + +#-> sub CPAN::Distribution::cpan_userid +sub cpan_userid { + my $self = shift; + if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) { + return $1; + } + return $self->SUPER::cpan_userid; +} + +#-> sub CPAN::Distribution::pretty_id +sub pretty_id { + my $self = shift; + my $id = $self->id; + return $id unless $id =~ m|^./../|; + substr($id,5); +} + +#-> sub CPAN::Distribution::base_id +sub base_id { + my $self = shift; + my $id = $self->pretty_id(); + my $base_id = File::Basename::basename($id); + $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; + return $base_id; +} + +#-> sub CPAN::Distribution::tested_ok_but_not_installed +sub tested_ok_but_not_installed { + my $self = shift; + return ( + $self->{make_test} + && $self->{build_dir} + && (UNIVERSAL::can($self->{make_test},"failed") ? + ! $self->{make_test}->failed : + $self->{make_test} =~ /^YES/ + ) + && ( + !$self->{install} + || + $self->{install}->failed + ) + ); +} + + +# mark as dirty/clean for the sake of recursion detection. $color=1 +# means "in use", $color=0 means "not in use anymore". $color=2 means +# we have determined prereqs now and thus insist on passing this +# through (at least) once again. + +#-> sub CPAN::Distribution::color_cmd_tmps ; +sub color_cmd_tmps { + my($self) = shift; + my($depth) = shift || 0; + my($color) = shift || 0; + my($ancestors) = shift || []; + # a distribution needs to recurse into its prereq_pms + + return if exists $self->{incommandcolor} + && $color==1 + && $self->{incommandcolor}==$color; + if ($depth>=$CPAN::MAX_RECURSION) { + die(CPAN::Exception::RecursiveDependency->new($ancestors)); + } + # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; + my $prereq_pm = $self->prereq_pm; + if (defined $prereq_pm) { + PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}}, + keys %{$prereq_pm->{build_requires}||{}}) { + next PREREQ if $pre eq "perl"; + my $premo; + unless ($premo = CPAN::Shell->expand("Module",$pre)) { + $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n"); + $CPAN::Frontend->mysleep(2); + next PREREQ; + } + $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]); + } + } + if ($color==0) { + delete $self->{sponsored_mods}; + + # as we are at the end of a command, we'll give up this + # reminder of a broken test. Other commands may test this guy + # again. Maybe 'badtestcnt' should be renamed to + # 'make_test_failed_within_command'? + delete $self->{badtestcnt}; + } + $self->{incommandcolor} = $color; +} + +#-> sub CPAN::Distribution::as_string ; +sub as_string { + my $self = shift; + $self->containsmods; + $self->upload_date; + $self->SUPER::as_string(@_); +} + +#-> sub CPAN::Distribution::containsmods ; +sub containsmods { + my $self = shift; + return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; + my $dist_id = $self->{ID}; + for my $mod ($CPAN::META->all_objects("CPAN::Module")) { + my $mod_file = $mod->cpan_file or next; + my $mod_id = $mod->{ID} or next; + # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]"; + # sleep 1; + if ($CPAN::Signal) { + delete $self->{CONTAINSMODS}; + return; + } + $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id; + } + keys %{$self->{CONTAINSMODS}||={}}; +} + +#-> sub CPAN::Distribution::upload_date ; +sub upload_date { + my $self = shift; + return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE}; + my(@local_wanted) = split(/\//,$self->id); + my $filename = pop @local_wanted; + push @local_wanted, "CHECKSUMS"; + my $author = CPAN::Shell->expand("Author",$self->cpan_userid); + return unless $author; + my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date}); + return unless @dl; + my($dirent) = grep { $_->[2] eq $filename } @dl; + # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id; + return unless $dirent->[1]; + return $self->{UPLOAD_DATE} = $dirent->[1]; +} + +#-> sub CPAN::Distribution::uptodate ; +sub uptodate { + my($self) = @_; + my $c; + foreach $c ($self->containsmods) { + my $obj = CPAN::Shell->expandany($c); + unless ($obj->uptodate) { + my $id = $self->pretty_id; + $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG; + return 0; + } + } + return 1; +} + +#-> sub CPAN::Distribution::called_for ; +sub called_for { + my($self,$id) = @_; + $self->{CALLED_FOR} = $id if defined $id; + return $self->{CALLED_FOR}; +} + +#-> sub CPAN::Distribution::get ; +sub get { + my($self) = @_; + $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG; + if (my $goto = $self->prefs->{goto}) { + $CPAN::Frontend->mywarn + (sprintf( + "delegating to '%s' as specified in prefs file '%s' doc %d\n", + $goto, + $self->{prefs_file}, + $self->{prefs_file_doc}, + )); + return $self->goto($goto); + } + local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) + ? $ENV{PERL5LIB} + : ($ENV{PERLLIB} || ""); + local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; + $CPAN::META->set_perl5lib; + local $ENV{MAKEFLAGS}; # protect us from outer make calls + + EXCUSE: { + my @e; + my $goodbye_message; + $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG; + if ($self->prefs->{disabled} && ! $self->{force_update}) { + my $why = sprintf( + "Disabled via prefs file '%s' doc %d", + $self->{prefs_file}, + $self->{prefs_file_doc}, + ); + push @e, $why; + $self->{unwrapped} = CPAN::Distrostatus->new("NO $why"); + $goodbye_message = "[disabled] -- NA $why"; + # note: not intended to be persistent but at least visible + # during this session + } else { + if (exists $self->{build_dir} && -d $self->{build_dir} + && ($self->{modulebuild}||$self->{writemakefile}) + ) { + # this deserves print, not warn: + $CPAN::Frontend->myprint(" Has already been unwrapped into directory ". + "$self->{build_dir}\n" + ); + return 1; + } + + # although we talk about 'force' we shall not test on + # force directly. New model of force tries to refrain from + # direct checking of force. + exists $self->{unwrapped} and ( + UNIVERSAL::can($self->{unwrapped},"failed") ? + $self->{unwrapped}->failed : + $self->{unwrapped} =~ /^NO/ + ) + and push @e, "Unwrapping had some problem, won't try again without force"; + } + if (@e) { + $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e); + if ($goodbye_message) { + $self->goodbye($goodbye_message); + } + return; + } + } + my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible + + my($local_file); + unless ($self->{build_dir} && -d $self->{build_dir}) { + $self->get_file_onto_local_disk; + return if $CPAN::Signal; + $self->check_integrity; + return if $CPAN::Signal; + (my $packagedir,$local_file) = $self->run_preps_on_packagedir; + if (exists $self->{writemakefile} && ref $self->{writemakefile} + && $self->{writemakefile}->can("failed") && + $self->{writemakefile}->failed) { + return; + } + $packagedir ||= $self->{build_dir}; + $self->{build_dir} = $packagedir; + } + + if ($CPAN::Signal) { + $self->safe_chdir($sub_wd); + return; + } + return $self->choose_MM_or_MB($local_file); +} + +#-> CPAN::Distribution::get_file_onto_local_disk +sub get_file_onto_local_disk { + my($self) = @_; + + return if $self->is_dot_dist; + my($local_file); + my($local_wanted) = + File::Spec->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + split(/\//,$self->id) + ); + + $self->debug("Doing localize") if $CPAN::DEBUG; + unless ($local_file = + CPAN::FTP->localize("authors/id/$self->{ID}", + $local_wanted)) { + my $note = ""; + if ($CPAN::Index::DATE_OF_02) { + $note = "Note: Current database in memory was generated ". + "on $CPAN::Index::DATE_OF_02\n"; + } + $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note"); + } + + $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG; + $self->{localfile} = $local_file; +} + + +#-> CPAN::Distribution::check_integrity +sub check_integrity { + my($self) = @_; + + return if $self->is_dot_dist; + if ($CPAN::META->has_inst("Digest::SHA")) { + $self->debug("Digest::SHA is installed, verifying"); + $self->verifyCHECKSUM; + } else { + $self->debug("Digest::SHA is NOT installed"); + } +} + +#-> CPAN::Distribution::run_preps_on_packagedir +sub run_preps_on_packagedir { + my($self) = @_; + return if $self->is_dot_dist; + + $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok + my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok + $self->safe_chdir($builddir); + $self->debug("Removing tmp-$$") if $CPAN::DEBUG; + File::Path::rmtree("tmp-$$"); + unless (mkdir "tmp-$$", 0755) { + $CPAN::Frontend->unrecoverable_error(<safe_chdir("tmp-$$"); + + # + # Unpack the goods + # + my $local_file = $self->{localfile}; + my $ct = eval{CPAN::Tarzip->new($local_file)}; + unless ($ct) { + $self->{unwrapped} = CPAN::Distrostatus->new("NO"); + delete $self->{build_dir}; + return; + } + if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) { + $self->{was_uncompressed}++ unless eval{$ct->gtest()}; + $self->untar_me($ct); + } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) { + $self->unzip_me($ct); + } else { + $self->{was_uncompressed}++ unless $ct->gtest(); + $local_file = $self->handle_singlefile($local_file); + } + + # we are still in the tmp directory! + # Let's check if the package has its own directory. + my $dh = DirHandle->new(File::Spec->curdir) + or Carp::croak("Couldn't opendir .: $!"); + my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC?? + if (grep { $_ eq "pax_global_header" } @readdir) { + $CPAN::Frontend->mywarn("Your (un)tar seems to have extracted a file named 'pax_global_header' +from the tarball '$local_file'. +This is almost certainly an error. Please upgrade your tar. +I'll ignore this file for now. +See also http://rt.cpan.org/Ticket/Display.html?id=38932\n"); + $CPAN::Frontend->mysleep(5); + @readdir = grep { $_ ne "pax_global_header" } @readdir; + } + $dh->close; + my ($packagedir); + # XXX here we want in each branch File::Temp to protect all build_dir directories + if (CPAN->has_usable("File::Temp")) { + my $tdir_base; + my $from_dir; + my @dirents; + if (@readdir == 1 && -d $readdir[0]) { + $tdir_base = $readdir[0]; + $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]); + my $dh2; + unless ($dh2 = DirHandle->new($from_dir)) { + my($mode) = (stat $from_dir)[2]; + my $why = sprintf + ( + "Couldn't opendir '%s', mode '%o': %s", + $from_dir, + $mode, + $!, + ); + $CPAN::Frontend->mywarn("$why\n"); + $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why"); + return; + } + @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC?? + } else { + my $userid = $self->cpan_userid; + CPAN->debug("userid[$userid]"); + if (!$userid or $userid eq "N/A") { + $userid = "anon"; + } + $tdir_base = $userid; + $from_dir = File::Spec->curdir; + @dirents = @readdir; + } + $packagedir = File::Temp::tempdir( + "$tdir_base-XXXXXX", + DIR => $builddir, + CLEANUP => 0, + ); + chmod 0777 &~ umask, $packagedir; # may fail + my $f; + for $f (@dirents) { # is already without "." and ".." + my $from = File::Spec->catdir($from_dir,$f); + my $to = File::Spec->catdir($packagedir,$f); + unless (File::Copy::move($from,$to)) { + my $err = $!; + $from = File::Spec->rel2abs($from); + Carp::confess("Couldn't move $from to $to: $err"); + } + } + } else { # older code below, still better than nothing when there is no File::Temp + my($distdir); + if (@readdir == 1 && -d $readdir[0]) { + $distdir = $readdir[0]; + $packagedir = File::Spec->catdir($builddir,$distdir); + $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]") + if $CPAN::DEBUG; + -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ". + "$packagedir\n"); + File::Path::rmtree($packagedir); + unless (File::Copy::move($distdir,$packagedir)) { + $CPAN::Frontend->unrecoverable_error(<debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]", + $distdir, + $packagedir, + -e $packagedir, + -d $packagedir, + )) if $CPAN::DEBUG; + } else { + my $userid = $self->cpan_userid; + CPAN->debug("userid[$userid]") if $CPAN::DEBUG; + if (!$userid or $userid eq "N/A") { + $userid = "anon"; + } + my $pragmatic_dir = $userid . '000'; + $pragmatic_dir =~ s/\W_//g; + $pragmatic_dir++ while -d "../$pragmatic_dir"; + $packagedir = File::Spec->catdir($builddir,$pragmatic_dir); + $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG; + File::Path::mkpath($packagedir); + my($f); + for $f (@readdir) { # is already without "." and ".." + my $to = File::Spec->catdir($packagedir,$f); + File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!"); + } + } + } + $self->{build_dir} = $packagedir; + $self->safe_chdir($builddir); + File::Path::rmtree("tmp-$$"); + + $self->safe_chdir($packagedir); + $self->_signature_business(); + $self->safe_chdir($builddir); + + return($packagedir,$local_file); +} + +#-> sub CPAN::Distribution::parse_meta_yml ; +sub parse_meta_yml { + my($self) = @_; + my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir"; + my $yaml = File::Spec->catfile($build_dir,"META.yml"); + $self->debug("yaml[$yaml]") if $CPAN::DEBUG; + return unless -f $yaml; + my $early_yaml; + eval { + require Parse::CPAN::Meta; + $early_yaml = Parse::CPAN::Meta::LoadFile($yaml)->[0]; + }; + unless ($early_yaml) { + eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; }; + } + unless ($early_yaml) { + return; + } + return $early_yaml; +} + +#-> sub CPAN::Distribution::satisfy_requires ; +sub satisfy_requires { + my ($self) = @_; + if (my @prereq = $self->unsat_prereq("later")) { + if ($prereq[0][0] eq "perl") { + my $need = "requires perl '$prereq[0][1]'"; + my $id = $self->pretty_id; + $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n"); + $self->{make} = CPAN::Distrostatus->new("NO $need"); + $self->store_persistent_state; + die "[prereq] -- NOT OK\n"; + } else { + my $follow = eval { $self->follow_prereqs("later",@prereq); }; + if (0) { + } elsif ($follow) { + # signal success to the queuerunner + return 1; + } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) { + $CPAN::Frontend->mywarn($@); + die "[depend] -- NOT OK\n"; + } + } + } +} + +#-> sub CPAN::Distribution::satisfy_configure_requires ; +sub satisfy_configure_requires { + my($self) = @_; + my $enable_configure_requires = 1; + if (!$enable_configure_requires) { + return 1; + # if we return 1 here, everything is as before we introduced + # configure_requires that means, things with + # configure_requires simply fail, all others succeed + } + my @prereq = $self->unsat_prereq("configure_requires_later") or return 1; + if ($self->{configure_requires_later}) { + for my $k (keys %{$self->{configure_requires_later_for}||{}}) { + if ($self->{configure_requires_later_for}{$k}>1) { + # we must not come here a second time + $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate..."); + require YAML::Syck; + $CPAN::Frontend->mydie + ( + YAML::Syck::Dump + ({self=>$self, prereq=>\@prereq}) + ); + } + } + } + if ($prereq[0][0] eq "perl") { + my $need = "requires perl '$prereq[0][1]'"; + my $id = $self->pretty_id; + $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n"); + $self->{make} = CPAN::Distrostatus->new("NO $need"); + $self->store_persistent_state; + return $self->goodbye("[prereq] -- NOT OK"); + } else { + my $follow = eval { + $self->follow_prereqs("configure_requires_later", @prereq); + }; + if (0) { + } elsif ($follow) { + return; + } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) { + $CPAN::Frontend->mywarn($@); + return $self->goodbye("[depend] -- NOT OK"); + } + } + die "never reached"; +} + +#-> sub CPAN::Distribution::choose_MM_or_MB ; +sub choose_MM_or_MB { + my($self,$local_file) = @_; + $self->satisfy_configure_requires() or return; + my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL"); + my($mpl_exists) = -f $mpl; + unless ($mpl_exists) { + # NFS has been reported to have racing problems after the + # renaming of a directory in some environments. + # This trick helps. + $CPAN::Frontend->mysleep(1); + my $mpldh = DirHandle->new($self->{build_dir}) + or Carp::croak("Couldn't opendir $self->{build_dir}: $!"); + $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read; + $mpldh->close; + } + my $prefer_installer = "eumm"; # eumm|mb + if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) { + if ($mpl_exists) { # they *can* choose + if ($CPAN::META->has_inst("Module::Build")) { + $prefer_installer = CPAN::HandleConfig->prefs_lookup($self, + q{prefer_installer}); + } + } else { + $prefer_installer = "mb"; + } + } + return unless $self->patch; + if (lc($prefer_installer) eq "rand") { + $prefer_installer = rand()<.5 ? "eumm" : "mb"; + } + if (lc($prefer_installer) eq "mb") { + $self->{modulebuild} = 1; + } elsif ($self->{archived} eq "patch") { + # not an edge case, nothing to install for sure + my $why = "A patch file cannot be installed"; + $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n"); + $self->{writemakefile} = CPAN::Distrostatus->new("NO $why"); + } elsif (! $mpl_exists) { + $self->_edge_cases($mpl,$local_file); + } + if ($self->{build_dir} + && + $CPAN::Config->{build_dir_reuse} + ) { + $self->store_persistent_state; + } + return $self; +} + +#-> CPAN::Distribution::store_persistent_state +sub store_persistent_state { + my($self) = @_; + my $dir = $self->{build_dir}; + unless (File::Spec->canonpath(File::Basename::dirname($dir)) + eq File::Spec->canonpath($CPAN::Config->{build_dir})) { + $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ". + "will not store persistent state\n"); + return; + } + my $file = sprintf "%s.yml", $dir; + my $yaml_module = CPAN::_yaml_module(); + if ($CPAN::META->has_inst($yaml_module)) { + CPAN->_yaml_dumpfile( + $file, + { + time => time, + perl => CPAN::_perl_fingerprint(), + distribution => $self, + } + ); + } else { + $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ". + "will not store persistent state\n"); + } +} + +#-> CPAN::Distribution::try_download +sub try_download { + my($self,$patch) = @_; + my $norm = $self->normalize($patch); + my($local_wanted) = + File::Spec->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + split(/\//,$norm), + ); + $self->debug("Doing localize") if $CPAN::DEBUG; + return CPAN::FTP->localize("authors/id/$norm", + $local_wanted); +} + +{ + my $stdpatchargs = ""; + #-> CPAN::Distribution::patch + sub patch { + my($self) = @_; + $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG; + my $patches = $self->prefs->{patches}; + $patches ||= ""; + $self->debug("patches[$patches]") if $CPAN::DEBUG; + if ($patches) { + return unless @$patches; + $self->safe_chdir($self->{build_dir}); + CPAN->debug("patches[$patches]") if $CPAN::DEBUG; + my $patchbin = $CPAN::Config->{patch}; + unless ($patchbin && length $patchbin) { + $CPAN::Frontend->mydie("No external patch command configured\n\n". + "Please run 'o conf init /patch/'\n\n"); + } + unless (MM->maybe_command($patchbin)) { + $CPAN::Frontend->mydie("No external patch command available\n\n". + "Please run 'o conf init /patch/'\n\n"); + } + $patchbin = CPAN::HandleConfig->safe_quote($patchbin); + local $ENV{PATCH_GET} = 0; # formerly known as -g0 + unless ($stdpatchargs) { + my $system = "$patchbin --version |"; + local *FH; + open FH, $system or die "Could not fork '$system': $!"; + local $/ = "\n"; + my $pversion; + PARSEVERSION: while () { + if (/^patch\s+([\d\.]+)/) { + $pversion = $1; + last PARSEVERSION; + } + } + if ($pversion) { + $stdpatchargs = "-N --fuzz=3"; + } else { + $stdpatchargs = "-N"; + } + } + my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches"); + $CPAN::Frontend->myprint("Going to apply $countedpatches:\n"); + my $patches_dir = $CPAN::Config->{patches_dir}; + for my $patch (@$patches) { + if ($patches_dir && !File::Spec->file_name_is_absolute($patch)) { + my $f = File::Spec->catfile($patches_dir, $patch); + $patch = $f if -f $f; + } + unless (-f $patch) { + if (my $trydl = $self->try_download($patch)) { + $patch = $trydl; + } else { + my $fail = "Could not find patch '$patch'"; + $CPAN::Frontend->mywarn("$fail; cannot continue\n"); + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail"); + delete $self->{build_dir}; + return; + } + } + $CPAN::Frontend->myprint(" $patch\n"); + my $readfh = CPAN::Tarzip->TIEHANDLE($patch); + + my $pcommand; + my $ppp = $self->_patch_p_parameter($readfh); + if ($ppp eq "applypatch") { + $pcommand = "$CPAN::Config->{applypatch} -verbose"; + } else { + my $thispatchargs = join " ", $stdpatchargs, $ppp; + $pcommand = "$patchbin $thispatchargs"; + } + + $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again + my $writefh = FileHandle->new; + $CPAN::Frontend->myprint(" $pcommand\n"); + unless (open $writefh, "|$pcommand") { + my $fail = "Could not fork '$pcommand'"; + $CPAN::Frontend->mywarn("$fail; cannot continue\n"); + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail"); + delete $self->{build_dir}; + return; + } + binmode($writefh); + while (my $x = $readfh->READLINE) { + print $writefh $x; + } + unless (close $writefh) { + my $fail = "Could not apply patch '$patch'"; + $CPAN::Frontend->mywarn("$fail; cannot continue\n"); + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail"); + delete $self->{build_dir}; + return; + } + } + $self->{patched}++; + } + return 1; + } +} + +sub _patch_p_parameter { + my($self,$fh) = @_; + my $cnt_files = 0; + my $cnt_p0files = 0; + local($_); + while ($_ = $fh->READLINE) { + if ( + $CPAN::Config->{applypatch} + && + /\#\#\#\# ApplyPatch data follows \#\#\#\#/ + ) { + return "applypatch" + } + next unless /^[\*\+]{3}\s(\S+)/; + my $file = $1; + $cnt_files++; + $cnt_p0files++ if -f $file; + CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]") + if $CPAN::DEBUG; + } + return "-p1" unless $cnt_files; + return $cnt_files==$cnt_p0files ? "-p0" : "-p1"; +} + +#-> sub CPAN::Distribution::_edge_cases +# with "configure" or "Makefile" or single file scripts +sub _edge_cases { + my($self,$mpl,$local_file) = @_; + $self->debug(sprintf("makefilepl[%s]anycwd[%s]", + $mpl, + CPAN::anycwd(), + )) if $CPAN::DEBUG; + my $build_dir = $self->{build_dir}; + my($configure) = File::Spec->catfile($build_dir,"Configure"); + if (-f $configure) { + # do we have anything to do? + $self->{configure} = $configure; + } elsif (-f File::Spec->catfile($build_dir,"Makefile")) { + $CPAN::Frontend->mywarn(qq{ +Package comes with a Makefile and without a Makefile.PL. +We\'ll try to build it with that Makefile then. +}); + $self->{writemakefile} = CPAN::Distrostatus->new("YES"); + $CPAN::Frontend->mysleep(2); + } else { + my $cf = $self->called_for || "unknown"; + if ($cf =~ m|/|) { + $cf =~ s|.*/||; + $cf =~ s|\W.*||; + } + $cf =~ s|[/\\:]||g; # risk of filesystem damage + $cf = "unknown" unless length($cf); + if (my $crud = $self->_contains_crud($build_dir)) { + my $why = qq{Package contains $crud; not recognized as a perl package, giving up}; + $CPAN::Frontend->mywarn("$why\n"); + $self->{writemakefile} = CPAN::Distrostatus->new(qq{NO -- $why}); + return; + } + $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL. + (The test -f "$mpl" returned false.) + Writing one on our own (setting NAME to $cf)\a\n}); + $self->{had_no_makefile_pl}++; + $CPAN::Frontend->mysleep(3); + + # Writing our own Makefile.PL + + my $exefile_stanza = ""; + if ($self->{archived} eq "maybe_pl") { + $exefile_stanza = $self->_exefile_stanza($build_dir,$local_file); + } + + my $fh = FileHandle->new; + $fh->open(">$mpl") + or Carp::croak("Could not open >$mpl: $!"); + $fh->print( + qq{# This Makefile.PL has been autogenerated by the module CPAN.pm +# because there was no Makefile.PL supplied. +# Autogenerated on: }.scalar localtime().qq{ + +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => q[$cf],$exefile_stanza + ); +}); + $fh->close; + } +} + +#-> CPAN;:Distribution::_contains_crud +sub _contains_crud { + my($self,$dir) = @_; + my(@dirs, $dh, @files); + opendir $dh, $dir or return; + my $dirent; + for $dirent (readdir $dh) { + next if $dirent =~ /^\.\.?$/; + my $path = File::Spec->catdir($dir,$dirent); + if (-d $path) { + push @dirs, $dirent; + } elsif (-f $path) { + push @files, $dirent; + } + } + if (@dirs && @files) { + return "both files[@files] and directories[@dirs]"; + } elsif (@files > 2) { + return "several files[@files] but no Makefile.PL or Build.PL"; + } + return; +} + +#-> CPAN;:Distribution::_exefile_stanza +sub _exefile_stanza { + my($self,$build_dir,$local_file) = @_; + + my $fh = FileHandle->new; + my $script_file = File::Spec->catfile($build_dir,$local_file); + $fh->open($script_file) + or Carp::croak("Could not open script '$script_file': $!"); + local $/ = "\n"; + # name parsen und prereq + my($state) = "poddir"; + my($name, $prereq) = ("", ""); + while (<$fh>) { + if ($state eq "poddir" && /^=head\d\s+(\S+)/) { + if ($1 eq 'NAME') { + $state = "name"; + } elsif ($1 eq 'PREREQUISITES') { + $state = "prereq"; + } + } elsif ($state =~ m{^(name|prereq)$}) { + if (/^=/) { + $state = "poddir"; + } elsif (/^\s*$/) { + # nop + } elsif ($state eq "name") { + if ($name eq "") { + ($name) = /^(\S+)/; + $state = "poddir"; + } + } elsif ($state eq "prereq") { + $prereq .= $_; + } + } elsif (/^=cut\b/) { + last; + } + } + $fh->close; + + for ($name) { + s{.*<}{}; # strip X<...> + s{>.*}{}; + } + chomp $prereq; + $prereq = join " ", split /\s+/, $prereq; + my($PREREQ_PM) = join("\n", map { + s{.*<}{}; # strip X<...> + s{>.*}{}; + if (/[\s\'\"]/) { # prose? + } else { + s/[^\w:]$//; # period? + " "x28 . "'$_' => 0,"; + } + } split /\s*,\s*/, $prereq); + + if ($name) { + my $to_file = File::Spec->catfile($build_dir, $name); + rename $script_file, $to_file + or die "Can't rename $script_file to $to_file: $!"; + } + + return " + EXE_FILES => ['$name'], + PREREQ_PM => { +$PREREQ_PM + }, +"; +} + +#-> CPAN::Distribution::_signature_business +sub _signature_business { + my($self) = @_; + my $check_sigs = CPAN::HandleConfig->prefs_lookup($self, + q{check_sigs}); + if ($check_sigs) { + if ($CPAN::META->has_inst("Module::Signature")) { + if (-f "SIGNATURE") { + $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG; + my $rv = Module::Signature::verify(); + if ($rv != Module::Signature::SIGNATURE_OK() and + $rv != Module::Signature::SIGNATURE_MISSING()) { + $CPAN::Frontend->mywarn( + qq{\nSignature invalid for }. + qq{distribution file. }. + qq{Please investigate.\n\n} + ); + + my $wrap = + sprintf(qq{I'd recommend removing %s. Some error occurred }. + qq{while checking its signature, so it could }. + qq{be invalid. Maybe you have configured }. + qq{your 'urllist' with a bad URL. Please check this }. + qq{array with 'o conf urllist' and retry. Or }. + qq{examine the distribution in a subshell. Try + look %s +and run + cpansign -v +}, + $self->{localfile}, + $self->pretty_id, + ); + $self->{signature_verify} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap)); + $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep"); + } else { + $self->{signature_verify} = CPAN::Distrostatus->new("YES"); + $self->debug("Module::Signature has verified") if $CPAN::DEBUG; + } + } else { + $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n}); + } + } else { + $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG; + } + } +} + +#-> CPAN::Distribution::untar_me ; +sub untar_me { + my($self,$ct) = @_; + $self->{archived} = "tar"; + my $result = eval { $ct->untar() }; + if ($result) { + $self->{unwrapped} = CPAN::Distrostatus->new("YES"); + } else { + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed"); + } +} + +# CPAN::Distribution::unzip_me ; +sub unzip_me { + my($self,$ct) = @_; + $self->{archived} = "zip"; + if ($ct->unzip()) { + $self->{unwrapped} = CPAN::Distrostatus->new("YES"); + } else { + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed"); + } + return; +} + +sub handle_singlefile { + my($self,$local_file) = @_; + + if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) { + $self->{archived} = "pm"; + } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) { + $self->{archived} = "patch"; + } else { + $self->{archived} = "maybe_pl"; + } + + my $to = File::Basename::basename($local_file); + if ($to =~ s/\.(gz|Z)(?!\n)\Z//) { + if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) { + $self->{unwrapped} = CPAN::Distrostatus->new("YES"); + } else { + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed"); + } + } else { + if (File::Copy::cp($local_file,".")) { + $self->{unwrapped} = CPAN::Distrostatus->new("YES"); + } else { + $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed"); + } + } + return $to; +} + +#-> sub CPAN::Distribution::new ; +sub new { + my($class,%att) = @_; + + # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); + + my $this = { %att }; + return bless $this, $class; +} + +#-> sub CPAN::Distribution::look ; +sub look { + my($self) = @_; + + if ($^O eq 'MacOS') { + $self->Mac::BuildTools::look; + return; + } + + if ( $CPAN::Config->{'shell'} ) { + $CPAN::Frontend->myprint(qq{ +Trying to open a subshell in the build directory... +}); + } else { + $CPAN::Frontend->myprint(qq{ +Your configuration does not define a value for subshells. +Please define it with "o conf shell " +}); + return; + } + my $dist = $self->id; + my $dir; + unless ($dir = $self->dir) { + $self->get; + } + unless ($dir ||= $self->dir) { + $CPAN::Frontend->mywarn(qq{ +Could not determine which directory to use for looking at $dist. +}); + return; + } + my $pwd = CPAN::anycwd(); + $self->safe_chdir($dir); + $CPAN::Frontend->myprint(qq{Working directory is $dir\n}); + { + local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0; + $ENV{CPAN_SHELL_LEVEL} += 1; + my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'}); + + local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) + ? $ENV{PERL5LIB} + : ($ENV{PERLLIB} || ""); + + local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; + $CPAN::META->set_perl5lib; + local $ENV{MAKEFLAGS}; # protect us from outer make calls + + unless (system($shell) == 0) { + my $code = $? >> 8; + $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n"); + } + } + $self->safe_chdir($pwd); +} + +# CPAN::Distribution::cvs_import ; +sub cvs_import { + my($self) = @_; + $self->get; + my $dir = $self->dir; + + my $package = $self->called_for; + my $module = $CPAN::META->instance('CPAN::Module', $package); + my $version = $module->cpan_version; + + my $userid = $self->cpan_userid; + + my $cvs_dir = (split /\//, $dir)[-1]; + $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//; + my $cvs_root = + $CPAN::Config->{cvsroot} || $ENV{CVSROOT}; + my $cvs_site_perl = + $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL}; + if ($cvs_site_perl) { + $cvs_dir = "$cvs_site_perl/$cvs_dir"; + } + my $cvs_log = qq{"imported $package $version sources"}; + $version =~ s/\./_/g; + # XXX cvs: undocumented and unclear how it was meant to work + my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log, + "$cvs_dir", $userid, "v$version"); + + my $pwd = CPAN::anycwd(); + chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!}); + + $CPAN::Frontend->myprint(qq{Working directory is $dir\n}); + + $CPAN::Frontend->myprint(qq{@cmd\n}); + system(@cmd) == 0 or + # XXX cvs + $CPAN::Frontend->mydie("cvs import failed"); + chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!}); +} + +#-> sub CPAN::Distribution::readme ; +sub readme { + my($self) = @_; + my($dist) = $self->id; + my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/; + $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG; + my($local_file); + my($local_wanted) = + File::Spec->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + split(/\//,"$sans.readme"), + ); + $self->debug("Doing localize") if $CPAN::DEBUG; + $local_file = CPAN::FTP->localize("authors/id/$sans.readme", + $local_wanted) + or $CPAN::Frontend->mydie(qq{No $sans.readme found});; + + if ($^O eq 'MacOS') { + Mac::BuildTools::launch_file($local_file); + return; + } + + my $fh_pager = FileHandle->new; + local($SIG{PIPE}) = "IGNORE"; + my $pager = $CPAN::Config->{'pager'} || "cat"; + $fh_pager->open("|$pager") + or die "Could not open pager $pager\: $!"; + my $fh_readme = FileHandle->new; + $fh_readme->open($local_file) + or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!}); + $CPAN::Frontend->myprint(qq{ +Displaying file + $local_file +with pager "$pager" +}); + $fh_pager->print(<$fh_readme>); + $fh_pager->close; +} + +#-> sub CPAN::Distribution::verifyCHECKSUM ; +sub verifyCHECKSUM { + my($self) = @_; + EXCUSE: { + my @e; + $self->{CHECKSUM_STATUS} ||= ""; + $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok"; + $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; + } + my($lc_want,$lc_file,@local,$basename); + @local = split(/\//,$self->id); + pop @local; + push @local, "CHECKSUMS"; + $lc_want = + File::Spec->catfile($CPAN::Config->{keep_source_where}, + "authors", "id", @local); + local($") = "/"; + if (my $size = -s $lc_want) { + $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG; + if ($self->CHECKSUM_check_file($lc_want,1)) { + return $self->{CHECKSUM_STATUS} = "OK"; + } + } + $lc_file = CPAN::FTP->localize("authors/id/@local", + $lc_want,1); + unless ($lc_file) { + $CPAN::Frontend->myprint("Trying $lc_want.gz\n"); + $local[-1] .= ".gz"; + $lc_file = CPAN::FTP->localize("authors/id/@local", + "$lc_want.gz",1); + if ($lc_file) { + $lc_file =~ s/\.gz(?!\n)\Z//; + eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)}; + } else { + return; + } + } + if ($self->CHECKSUM_check_file($lc_file)) { + return $self->{CHECKSUM_STATUS} = "OK"; + } +} + +#-> sub CPAN::Distribution::SIG_check_file ; +sub SIG_check_file { + my($self,$chk_file) = @_; + my $rv = eval { Module::Signature::_verify($chk_file) }; + + if ($rv == Module::Signature::SIGNATURE_OK()) { + $CPAN::Frontend->myprint("Signature for $chk_file ok\n"); + return $self->{SIG_STATUS} = "OK"; + } else { + $CPAN::Frontend->myprint(qq{\nSignature invalid for }. + qq{distribution file. }. + qq{Please investigate.\n\n}. + $self->as_string, + $CPAN::META->instance( + 'CPAN::Author', + $self->cpan_userid + )->as_string); + + my $wrap = qq{I\'d recommend removing $chk_file. Its signature +is invalid. Maybe you have configured your 'urllist' with +a bad URL. Please check this array with 'o conf urllist', and +retry.}; + + $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap)); + } +} + +#-> sub CPAN::Distribution::CHECKSUM_check_file ; + +# sloppy is 1 when we have an old checksums file that maybe is good +# enough + +sub CHECKSUM_check_file { + my($self,$chk_file,$sloppy) = @_; + my($cksum,$file,$basename); + + $sloppy ||= 0; + $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG; + my $check_sigs = CPAN::HandleConfig->prefs_lookup($self, + q{check_sigs}); + if ($check_sigs) { + if ($CPAN::META->has_inst("Module::Signature")) { + $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG; + $self->SIG_check_file($chk_file); + } else { + $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG; + } + } + + $file = $self->{localfile}; + $basename = File::Basename::basename($file); + my $fh = FileHandle->new; + if (open $fh, $chk_file) { + local($/); + my $eval = <$fh>; + $eval =~ s/\015?\012/\n/g; + close $fh; + my($compmt) = Safe->new(); + $cksum = $compmt->reval($eval); + if ($@) { + rename $chk_file, "$chk_file.bad"; + Carp::confess($@) if $@; + } + } else { + Carp::carp "Could not open $chk_file for reading"; + } + + if (! ref $cksum or ref $cksum ne "HASH") { + $CPAN::Frontend->mywarn(qq{ +Warning: checksum file '$chk_file' broken. + +When trying to read that file I expected to get a hash reference +for further processing, but got garbage instead. +}); + my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no"); + $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n"); + $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken"; + return; + } elsif (exists $cksum->{$basename}{sha256}) { + $self->debug("Found checksum for $basename:" . + "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG; + + open($fh, $file); + binmode $fh; + my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256}); + $fh->close; + $fh = CPAN::Tarzip->TIEHANDLE($file); + + unless ($eq) { + my $dg = Digest::SHA->new(256); + my($data,$ref); + $ref = \$data; + while ($fh->READ($ref, 4096) > 0) { + $dg->add($data); + } + my $hexdigest = $dg->hexdigest; + $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'}; + } + + if ($eq) { + $CPAN::Frontend->myprint("Checksum for $file ok\n"); + return $self->{CHECKSUM_STATUS} = "OK"; + } else { + $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }. + qq{distribution file. }. + qq{Please investigate.\n\n}. + $self->as_string, + $CPAN::META->instance( + 'CPAN::Author', + $self->cpan_userid + )->as_string); + + my $wrap = qq{I\'d recommend removing $file. Its +checksum is incorrect. Maybe you have configured your 'urllist' with +a bad URL. Please check this array with 'o conf urllist', and +retry.}; + + $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap)); + + # former versions just returned here but this seems a + # serious threat that deserves a die + + # $CPAN::Frontend->myprint("\n\n"); + # sleep 3; + # return; + } + # close $fh if fileno($fh); + } else { + return if $sloppy; + unless ($self->{CHECKSUM_STATUS}) { + $CPAN::Frontend->mywarn(qq{ +Warning: No checksum for $basename in $chk_file. + +The cause for this may be that the file is very new and the checksum +has not yet been calculated, but it may also be that something is +going awry right now. +}); + my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes"); + $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n"); + } + $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file"; + return; + } +} + +#-> sub CPAN::Distribution::eq_CHECKSUM ; +sub eq_CHECKSUM { + my($self,$fh,$expect) = @_; + if ($CPAN::META->has_inst("Digest::SHA")) { + my $dg = Digest::SHA->new(256); + my($data); + while (read($fh, $data, 4096)) { + $dg->add($data); + } + my $hexdigest = $dg->hexdigest; + # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]"; + return $hexdigest eq $expect; + } + return 1; +} + +#-> sub CPAN::Distribution::force ; + +# Both CPAN::Modules and CPAN::Distributions know if "force" is in +# effect by autoinspection, not by inspecting a global variable. One +# of the reason why this was chosen to work that way was the treatment +# of dependencies. They should not automatically inherit the force +# status. But this has the downside that ^C and die() will return to +# the prompt but will not be able to reset the force_update +# attributes. We try to correct for it currently in the read_metadata +# routine, and immediately before we check for a Signal. I hope this +# works out in one of v1.57_53ff + +# "Force get forgets previous error conditions" + +#-> sub CPAN::Distribution::fforce ; +sub fforce { + my($self, $method) = @_; + $self->force($method,1); +} + +#-> sub CPAN::Distribution::force ; +sub force { + my($self, $method,$fforce) = @_; + my %phase_map = ( + get => [ + "unwrapped", + "build_dir", + "archived", + "localfile", + "CHECKSUM_STATUS", + "signature_verify", + "prefs", + "prefs_file", + "prefs_file_doc", + ], + make => [ + "writemakefile", + "make", + "modulebuild", + "prereq_pm", + "prereq_pm_detected", + ], + test => [ + "badtestcnt", + "make_test", + ], + install => [ + "install", + ], + unknown => [ + "reqtype", + "yaml_content", + ], + ); + my $methodmatch = 0; + my $ldebug = 0; + PHASE: for my $phase (qw(unknown get make test install)) { # order matters + $methodmatch = 1 if $fforce || $phase eq $method; + next unless $methodmatch; + ATTRIBUTE: for my $att (@{$phase_map{$phase}}) { + if ($phase eq "get") { + if (substr($self->id,-1,1) eq "." + && $att =~ /(unwrapped|build_dir|archived)/ ) { + # cannot be undone for local distros + next ATTRIBUTE; + } + if ($att eq "build_dir" + && $self->{build_dir} + && $CPAN::META->{is_tested} + ) { + delete $CPAN::META->{is_tested}{$self->{build_dir}}; + } + } elsif ($phase eq "test") { + if ($att eq "make_test" + && $self->{make_test} + && $self->{make_test}{COMMANDID} + && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId + ) { + # endless loop too likely + next ATTRIBUTE; + } + } + delete $self->{$att}; + if ($ldebug || $CPAN::DEBUG) { + # local $CPAN::DEBUG = 16; # Distribution + CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att); + } + } + } + if ($method && $method =~ /make|test|install/) { + $self->{force_update} = 1; # name should probably have been force_install + } +} + +#-> sub CPAN::Distribution::notest ; +sub notest { + my($self, $method) = @_; + # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method"); + $self->{"notest"}++; # name should probably have been force_install +} + +#-> sub CPAN::Distribution::unnotest ; +sub unnotest { + my($self) = @_; + # warn "XDEBUG: deleting notest"; + delete $self->{notest}; +} + +#-> sub CPAN::Distribution::unforce ; +sub unforce { + my($self) = @_; + delete $self->{force_update}; +} + +#-> sub CPAN::Distribution::isa_perl ; +sub isa_perl { + my($self) = @_; + my $file = File::Basename::basename($self->id); + if ($file =~ m{ ^ perl + -? + (5) + ([._-]) + ( + \d{3}(_[0-4][0-9])? + | + \d+\.\d+ + ) + \.tar[._-](?:gz|bz2) + (?!\n)\Z + }xs) { + return "$1.$3"; + } elsif ($self->cpan_comment + && + $self->cpan_comment =~ /isa_perl\(.+?\)/) { + return $1; + } +} + + +#-> sub CPAN::Distribution::perl ; +sub perl { + my ($self) = @_; + if (! $self) { + use Carp qw(carp); + carp __PACKAGE__ . "::perl was called without parameters."; + } + return CPAN::HandleConfig->safe_quote($CPAN::Perl); +} + + +#-> sub CPAN::Distribution::make ; +sub make { + my($self) = @_; + if (my $goto = $self->prefs->{goto}) { + return $self->goto($goto); + } + my $make = $self->{modulebuild} ? "Build" : "make"; + # Emergency brake if they said install Pippi and get newest perl + if ($self->isa_perl) { + if ( + $self->called_for ne $self->id && + ! $self->{force_update} + ) { + # if we die here, we break bundles + $CPAN::Frontend + ->mywarn(sprintf( + qq{The most recent version "%s" of the module "%s" +is part of the perl-%s distribution. To install that, you need to run + force install %s --or-- + install %s +}, + $CPAN::META->instance( + 'CPAN::Module', + $self->called_for + )->cpan_version, + $self->called_for, + $self->isa_perl, + $self->called_for, + $self->id, + )); + $self->{make} = CPAN::Distrostatus->new("NO isa perl"); + $CPAN::Frontend->mysleep(1); + return; + } + } + $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id); + $self->get; + return if $self->prefs->{disabled} && ! $self->{force_update}; + if ($self->{configure_requires_later}) { + return; + } + local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) + ? $ENV{PERL5LIB} + : ($ENV{PERLLIB} || ""); + local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; + $CPAN::META->set_perl5lib; + local $ENV{MAKEFLAGS}; # protect us from outer make calls + + if ($CPAN::Signal) { + delete $self->{force_update}; + return; + } + + my $builddir; + EXCUSE: { + my @e; + if (!$self->{archived} || $self->{archived} eq "NO") { + push @e, "Is neither a tar nor a zip archive."; + } + + if (!$self->{unwrapped} + || ( + UNIVERSAL::can($self->{unwrapped},"failed") ? + $self->{unwrapped}->failed : + $self->{unwrapped} =~ /^NO/ + )) { + push @e, "Had problems unarchiving. Please build manually"; + } + + unless ($self->{force_update}) { + exists $self->{signature_verify} and + ( + UNIVERSAL::can($self->{signature_verify},"failed") ? + $self->{signature_verify}->failed : + $self->{signature_verify} =~ /^NO/ + ) + and push @e, "Did not pass the signature test."; + } + + if (exists $self->{writemakefile} && + ( + UNIVERSAL::can($self->{writemakefile},"failed") ? + $self->{writemakefile}->failed : + $self->{writemakefile} =~ /^NO/ + )) { + # XXX maybe a retry would be in order? + my $err = UNIVERSAL::can($self->{writemakefile},"text") ? + $self->{writemakefile}->text : + $self->{writemakefile}; + $err =~ s/^NO\s*(--\s+)?//; + $err ||= "Had some problem writing Makefile"; + $err .= ", won't make"; + push @e, $err; + } + + if (defined $self->{make}) { + if (UNIVERSAL::can($self->{make},"failed") ? + $self->{make}->failed : + $self->{make} =~ /^NO/) { + if ($self->{force_update}) { + # Trying an already failed 'make' (unless somebody else blocks) + } else { + # introduced for turning recursion detection into a distrostatus + my $error = length $self->{make}>3 + ? substr($self->{make},3) : "Unknown error"; + $CPAN::Frontend->mywarn("Could not make: $error\n"); + $self->store_persistent_state; + return; + } + } else { + push @e, "Has already been made"; + my $wait_for_prereqs = eval { $self->satisfy_requires }; + return 1 if $wait_for_prereqs; # tells queuerunner to continue + return $self->goodbye($@) if $@; # tells queuerunner to stop + } + } + + my $later = $self->{later} || $self->{configure_requires_later}; + if ($later) { # see also undelay + if ($later) { + push @e, $later; + } + } + + $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; + $builddir = $self->dir or + $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n"); + unless (chdir $builddir) { + push @e, "Couldn't chdir to '$builddir': $!"; + } + $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e; + } + if ($CPAN::Signal) { + delete $self->{force_update}; + return; + } + $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n"); + $self->debug("Changed directory to $builddir") if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + Mac::BuildTools::make($self); + return; + } + + my %env; + while (my($k,$v) = each %ENV) { + next unless defined $v; + $env{$k} = $v; + } + local %ENV = %env; + my $system; + my $pl_commandline; + if ($self->prefs->{pl}) { + $pl_commandline = $self->prefs->{pl}{commandline}; + } + if ($pl_commandline) { + $system = $pl_commandline; + $ENV{PERL} = $^X; + } elsif ($self->{'configure'}) { + $system = $self->{'configure'}; + } elsif ($self->{modulebuild}) { + my($perl) = $self->perl or die "Couldn\'t find executable perl\n"; + $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}"; + } else { + my($perl) = $self->perl or die "Couldn\'t find executable perl\n"; + my $switch = ""; +# This needs a handler that can be turned on or off: +# $switch = "-MExtUtils::MakeMaker ". +# "-Mops=:default,:filesys_read,:filesys_open,require,chdir" +# if $] > 5.00310; + my $makepl_arg = $self->_make_phase_arg("pl"); + $ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir}, + "Makefile.PL"); + $system = sprintf("%s%s Makefile.PL%s", + $perl, + $switch ? " $switch" : "", + $makepl_arg ? " $makepl_arg" : "", + ); + } + my $pl_env; + if ($self->prefs->{pl}) { + $pl_env = $self->prefs->{pl}{env}; + } + if ($pl_env) { + for my $e (keys %$pl_env) { + $ENV{$e} = $pl_env->{$e}; + } + } + if (exists $self->{writemakefile}) { + } else { + local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" }; + my($ret,$pid,$output); + $@ = ""; + my $go_via_alarm; + if ($CPAN::Config->{inactivity_timeout}) { + require Config; + if ($Config::Config{d_alarm} + && + $Config::Config{d_alarm} eq "define" + ) { + $go_via_alarm++ + } else { + $CPAN::Frontend->mywarn("Warning: you have configured the config ". + "variable 'inactivity_timeout' to ". + "'$CPAN::Config->{inactivity_timeout}'. But ". + "on this machine the system call 'alarm' ". + "isn't available. This means that we cannot ". + "provide the feature of intercepting long ". + "waiting code and will turn this feature off.\n" + ); + $CPAN::Config->{inactivity_timeout} = 0; + } + } + if ($go_via_alarm) { + if ( $self->_should_report('pl') ) { + ($output, $ret) = CPAN::Reporter::record_command( + $system, + $CPAN::Config->{inactivity_timeout}, + ); + CPAN::Reporter::grade_PL( $self, $system, $output, $ret ); + } + else { + eval { + alarm $CPAN::Config->{inactivity_timeout}; + local $SIG{CHLD}; # = sub { wait }; + if (defined($pid = fork)) { + if ($pid) { #parent + # wait; + waitpid $pid, 0; + } else { #child + # note, this exec isn't necessary if + # inactivity_timeout is 0. On the Mac I'd + # suggest, we set it always to 0. + exec $system; + } + } else { + $CPAN::Frontend->myprint("Cannot fork: $!"); + return; + } + }; + alarm 0; + if ($@) { + kill 9, $pid; + waitpid $pid, 0; + my $err = "$@"; + $CPAN::Frontend->myprint($err); + $self->{writemakefile} = CPAN::Distrostatus->new("NO $err"); + $@ = ""; + $self->store_persistent_state; + return $self->goodbye("$system -- TIMED OUT"); + } + } + } else { + if (my $expect_model = $self->_prefs_with_expect("pl")) { + # XXX probably want to check _should_report here and warn + # about not being able to use CPAN::Reporter with expect + $ret = $self->_run_via_expect($system,'writemakefile',$expect_model); + if (! defined $ret + && $self->{writemakefile} + && $self->{writemakefile}->failed) { + # timeout + return; + } + } + elsif ( $self->_should_report('pl') ) { + ($output, $ret) = CPAN::Reporter::record_command($system); + CPAN::Reporter::grade_PL( $self, $system, $output, $ret ); + } + else { + $ret = system($system); + } + if ($ret != 0) { + $self->{writemakefile} = CPAN::Distrostatus + ->new("NO '$system' returned status $ret"); + $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n"); + $self->store_persistent_state; + return $self->goodbye("$system -- NOT OK"); + } + } + if (-f "Makefile" || -f "Build") { + $self->{writemakefile} = CPAN::Distrostatus->new("YES"); + delete $self->{make_clean}; # if cleaned before, enable next + } else { + my $makefile = $self->{modulebuild} ? "Build" : "Makefile"; + my $why = "No '$makefile' created"; + $CPAN::Frontend->mywarn($why); + $self->{writemakefile} = CPAN::Distrostatus + ->new(qq{NO -- $why\n}); + $self->store_persistent_state; + return $self->goodbye("$system -- NOT OK"); + } + } + if ($CPAN::Signal) { + delete $self->{force_update}; + return; + } + my $wait_for_prereqs = eval { $self->satisfy_requires }; + return 1 if $wait_for_prereqs; # tells queuerunner to continue + return $self->goodbye($@) if $@; # tells queuerunner to stop + if ($CPAN::Signal) { + delete $self->{force_update}; + return; + } + my $make_commandline; + if ($self->prefs->{make}) { + $make_commandline = $self->prefs->{make}{commandline}; + } + if ($make_commandline) { + $system = $make_commandline; + $ENV{PERL} = CPAN::find_perl(); + } else { + if ($self->{modulebuild}) { + unless (-f "Build") { + my $cwd = CPAN::anycwd(); + $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'". + " in cwd[$cwd]. Danger, Will Robinson!\n"); + $CPAN::Frontend->mysleep(5); + } + $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg}; + } else { + $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg}; + } + $system =~ s/\s+$//; + my $make_arg = $self->_make_phase_arg("make"); + $system = sprintf("%s%s", + $system, + $make_arg ? " $make_arg" : "", + ); + } + my $make_env; + if ($self->prefs->{make}) { + $make_env = $self->prefs->{make}{env}; + } + if ($make_env) { # overriding the local ENV of PL, not the outer + # ENV, but unlikely to be a risk + for my $e (keys %$make_env) { + $ENV{$e} = $make_env->{$e}; + } + } + my $expect_model = $self->_prefs_with_expect("make"); + my $want_expect = 0; + if ( $expect_model && @{$expect_model->{talk}} ) { + my $can_expect = $CPAN::META->has_inst("Expect"); + if ($can_expect) { + $want_expect = 1; + } else { + $CPAN::Frontend->mywarn("Expect not installed, falling back to ". + "system()\n"); + } + } + my $system_ok; + if ($want_expect) { + # XXX probably want to check _should_report here and + # warn about not being able to use CPAN::Reporter with expect + $system_ok = $self->_run_via_expect($system,'make',$expect_model) == 0; + } + elsif ( $self->_should_report('make') ) { + my ($output, $ret) = CPAN::Reporter::record_command($system); + CPAN::Reporter::grade_make( $self, $system, $output, $ret ); + $system_ok = ! $ret; + } + else { + $system_ok = system($system) == 0; + } + $self->introduce_myself; + if ( $system_ok ) { + $CPAN::Frontend->myprint(" $system -- OK\n"); + $self->{make} = CPAN::Distrostatus->new("YES"); + } else { + $self->{writemakefile} ||= CPAN::Distrostatus->new("YES"); + $self->{make} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); + } + $self->store_persistent_state; +} + +# CPAN::Distribution::goodbye ; +sub goodbye { + my($self,$goodbye) = @_; + my $id = $self->pretty_id; + $CPAN::Frontend->mywarn(" $id\n $goodbye\n"); + return; +} + +# CPAN::Distribution::_run_via_expect ; +sub _run_via_expect { + my($self,$system,$phase,$expect_model) = @_; + CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG; + if ($CPAN::META->has_inst("Expect")) { + my $expo = Expect->new; # expo Expect object; + $expo->spawn($system); + $expect_model->{mode} ||= "deterministic"; + if ($expect_model->{mode} eq "deterministic") { + return $self->_run_via_expect_deterministic($expo,$phase,$expect_model); + } elsif ($expect_model->{mode} eq "anyorder") { + return $self->_run_via_expect_anyorder($expo,$phase,$expect_model); + } else { + die "Panic: Illegal expect mode: $expect_model->{mode}"; + } + } else { + $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n"); + return system($system); + } +} + +sub _run_via_expect_anyorder { + my($self,$expo,$phase,$expect_model) = @_; + my $timeout = $expect_model->{timeout} || 5; + my $reuse = $expect_model->{reuse}; + my @expectacopy = @{$expect_model->{talk}}; # we trash it! + my $but = ""; + my $timeout_start = time; + EXPECT: while () { + my($eof,$ran_into_timeout); + # XXX not up to the full power of expect. one could certainly + # wrap all of the talk pairs into a single expect call and on + # success tweak it and step ahead to the next question. The + # current implementation unnecessarily limits itself to a + # single match. + my @match = $expo->expect(1, + [ eof => sub { + $eof++; + } ], + [ timeout => sub { + $ran_into_timeout++; + } ], + -re => eval"qr{.}", + ); + if ($match[2]) { + $but .= $match[2]; + } + $but .= $expo->clear_accum; + if ($eof) { + $expo->soft_close; + return $expo->exitstatus(); + } elsif ($ran_into_timeout) { + # warn "DEBUG: they are asking a question, but[$but]"; + for (my $i = 0; $i <= $#expectacopy; $i+=2) { + my($next,$send) = @expectacopy[$i,$i+1]; + my $regex = eval "qr{$next}"; + # warn "DEBUG: will compare with regex[$regex]."; + if ($but =~ /$regex/) { + # warn "DEBUG: will send send[$send]"; + $expo->send($send); + # never allow reusing an QA pair unless they told us + splice @expectacopy, $i, 2 unless $reuse; + next EXPECT; + } + } + my $have_waited = time - $timeout_start; + if ($have_waited < $timeout) { + # warn "DEBUG: have_waited[$have_waited]timeout[$timeout]"; + next EXPECT; + } + my $why = "could not answer a question during the dialog"; + $CPAN::Frontend->mywarn("Failing: $why\n"); + $self->{$phase} = + CPAN::Distrostatus->new("NO $why"); + return 0; + } + } +} + +sub _run_via_expect_deterministic { + my($self,$expo,$phase,$expect_model) = @_; + my $ran_into_timeout; + my $ran_into_eof; + my $timeout = $expect_model->{timeout} || 15; # currently unsettable + my $expecta = $expect_model->{talk}; + EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) { + my($re,$send) = @$expecta[$i,$i+1]; + CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG; + my $regex = eval "qr{$re}"; + $expo->expect($timeout, + [ eof => sub { + my $but = $expo->clear_accum; + $CPAN::Frontend->mywarn("EOF (maybe harmless) +expected[$regex]\nbut[$but]\n\n"); + $ran_into_eof++; + } ], + [ timeout => sub { + my $but = $expo->clear_accum; + $CPAN::Frontend->mywarn("TIMEOUT +expected[$regex]\nbut[$but]\n\n"); + $ran_into_timeout++; + } ], + -re => $regex); + if ($ran_into_timeout) { + # note that the caller expects 0 for success + $self->{$phase} = + CPAN::Distrostatus->new("NO timeout during expect dialog"); + return 0; + } elsif ($ran_into_eof) { + last EXPECT; + } + $expo->send($send); + } + $expo->soft_close; + return $expo->exitstatus(); +} + +#-> CPAN::Distribution::_validate_distropref +sub _validate_distropref { + my($self,@args) = @_; + if ( + $CPAN::META->has_inst("CPAN::Kwalify") + && + $CPAN::META->has_inst("Kwalify") + ) { + eval {CPAN::Kwalify::_validate("distroprefs",@args);}; + if ($@) { + $CPAN::Frontend->mywarn($@); + } + } else { + CPAN->debug("not validating '@args'") if $CPAN::DEBUG; + } +} + +#-> CPAN::Distribution::_find_prefs +sub _find_prefs { + my($self) = @_; + my $distroid = $self->pretty_id; + #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG; + my $prefs_dir = $CPAN::Config->{prefs_dir}; + return if $prefs_dir =~ /^\s*$/; + eval { File::Path::mkpath($prefs_dir); }; + if ($@) { + $CPAN::Frontend->mydie("Cannot create directory $prefs_dir"); + } + my $yaml_module = CPAN::_yaml_module(); + my $ext_map = {}; + my @extensions; + if ($CPAN::META->has_inst($yaml_module)) { + $ext_map->{yml} = 'CPAN'; + } else { + my @fallbacks; + if ($CPAN::META->has_inst("Data::Dumper")) { + push @fallbacks, $ext_map->{dd} = 'Data::Dumper'; + } + if ($CPAN::META->has_inst("Storable")) { + push @fallbacks, $ext_map->{st} = 'Storable'; + } + if (@fallbacks) { + local $" = " and "; + unless ($self->{have_complained_about_missing_yaml}++) { + $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ". + "to @fallbacks to read prefs '$prefs_dir'\n"); + } + } else { + unless ($self->{have_complained_about_missing_yaml}++) { + $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ". + "read prefs '$prefs_dir'\n"); + } + } + } + my $finder = CPAN::Distroprefs->find($prefs_dir, $ext_map); + DIRENT: while (my $result = $finder->next) { + if ($result->is_warning) { + $CPAN::Frontend->mywarn($result->as_string); + $CPAN::Frontend->mysleep(1); + next DIRENT; + } elsif ($result->is_fatal) { + $CPAN::Frontend->mydie($result->as_string); + } + + my @prefs = @{ $result->prefs }; + + ELEMENT: for my $y (0..$#prefs) { + my $pref = $prefs[$y]; + $self->_validate_distropref($pref->data, $result->abs, $y); + + # I don't know why we silently skip when there's no match, but + # complain if there's an empty match hashref, and there's no + # comment explaining why -- hdp, 2008-03-18 + unless ($pref->has_any_match) { + next ELEMENT; + } + + unless ($pref->has_valid_subkeys) { + $CPAN::Frontend->mydie(sprintf + "Nonconforming .%s file '%s': " . + "missing match/* subattribute. " . + "Please remove, cannot continue.", + $result->ext, $result->abs, + ); + } + + my $arg = { + env => \%ENV, + distribution => $distroid, + perl => \&CPAN::find_perl, + perlconfig => \%Config::Config, + module => sub { [ $self->containsmods ] }, + }; + + if ($pref->matches($arg)) { + return { + prefs => $pref->data, + prefs_file => $result->abs, + prefs_file_doc => $y, + }; + } + + } + } + return; +} + +# CPAN::Distribution::prefs +sub prefs { + my($self) = @_; + if (exists $self->{negative_prefs_cache} + && + $self->{negative_prefs_cache} != $CPAN::CurrentCommandId + ) { + delete $self->{negative_prefs_cache}; + delete $self->{prefs}; + } + if (exists $self->{prefs}) { + return $self->{prefs}; # XXX comment out during debugging + } + if ($CPAN::Config->{prefs_dir}) { + CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG; + my $prefs = $self->_find_prefs(); + $prefs ||= ""; # avoid warning next line + CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG; + if ($prefs) { + for my $x (qw(prefs prefs_file prefs_file_doc)) { + $self->{$x} = $prefs->{$x}; + } + my $bs = sprintf( + "%s[%s]", + File::Basename::basename($self->{prefs_file}), + $self->{prefs_file_doc}, + ); + my $filler1 = "_" x 22; + my $filler2 = int(66 - length($bs))/2; + $filler2 = 0 if $filler2 < 0; + $filler2 = " " x $filler2; + $CPAN::Frontend->myprint(" +$filler1 D i s t r o P r e f s $filler1 +$filler2 $bs $filler2 +"); + $CPAN::Frontend->mysleep(1); + return $self->{prefs}; + } + } + $self->{negative_prefs_cache} = $CPAN::CurrentCommandId; + return $self->{prefs} = +{}; +} + +# CPAN::Distribution::_make_phase_arg +sub _make_phase_arg { + my($self, $phase) = @_; + my $_make_phase_arg; + my $prefs = $self->prefs; + if ( + $prefs + && exists $prefs->{$phase} + && exists $prefs->{$phase}{args} + && $prefs->{$phase}{args} + ) { + $_make_phase_arg = join(" ", + map {CPAN::HandleConfig + ->safe_quote($_)} @{$prefs->{$phase}{args}}, + ); + } + +# cpan[2]> o conf make[TAB] +# make make_install_make_command +# make_arg makepl_arg +# make_install_arg +# cpan[2]> o conf mbuild[TAB] +# mbuild_arg mbuild_install_build_command +# mbuild_install_arg mbuildpl_arg + + my $mantra; # must switch make/mbuild here + if ($self->{modulebuild}) { + $mantra = "mbuild"; + } else { + $mantra = "make"; + } + my %map = ( + pl => "pl_arg", + make => "_arg", + test => "_test_arg", # does not really exist but maybe + # will some day and now protects + # us from unini warnings + install => "_install_arg", + ); + my $phase_underscore_meshup = $map{$phase}; + my $what = sprintf "%s%s", $mantra, $phase_underscore_meshup; + + $_make_phase_arg ||= $CPAN::Config->{$what}; + return $_make_phase_arg; +} + +# CPAN::Distribution::_make_command +sub _make_command { + my ($self) = @_; + if ($self) { + return + CPAN::HandleConfig + ->safe_quote( + CPAN::HandleConfig->prefs_lookup($self, + q{make}) + || $Config::Config{make} + || 'make' + ); + } else { + # Old style call, without object. Deprecated + Carp::confess("CPAN::_make_command() used as function. Don't Do That."); + return + safe_quote(undef, + CPAN::HandleConfig->prefs_lookup($self,q{make}) + || $CPAN::Config->{make} + || $Config::Config{make} + || 'make'); + } +} + +#-> sub CPAN::Distribution::follow_prereqs ; +sub follow_prereqs { + my($self) = shift; + my($slot) = shift; + my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_; + return unless @prereq_tuples; + my(@good_prereq_tuples); + for my $p (@prereq_tuples) { + # XXX watch out for foul ones + push @good_prereq_tuples, $p; + } + my $pretty_id = $self->pretty_id; + my %map = ( + b => "build_requires", + r => "requires", + c => "commandline", + ); + my($filler1,$filler2,$filler3,$filler4); + my $unsat = "Unsatisfied dependencies detected during"; + my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id); + { + my $r = int(($w - length($unsat))/2); + my $l = $w - length($unsat) - $r; + $filler1 = "-"x4 . " "x$l; + $filler2 = " "x$r . "-"x4 . "\n"; + } + { + my $r = int(($w - length($pretty_id))/2); + my $l = $w - length($pretty_id) - $r; + $filler3 = "-"x4 . " "x$l; + $filler4 = " "x$r . "-"x4 . "\n"; + } + $CPAN::Frontend-> + myprint("$filler1 $unsat $filler2". + "$filler3 $pretty_id $filler4". + join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @good_prereq_tuples), + ); + my $follow = 0; + if ($CPAN::Config->{prerequisites_policy} eq "follow") { + $follow = 1; + } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") { + my $answer = CPAN::Shell::colorable_makemaker_prompt( +"Shall I follow them and prepend them to the queue +of modules we are processing right now?", "yes"); + $follow = $answer =~ /^\s*y/i; + } else { + my @prereq = map { $_=>[0] } @good_prereq_tuples; + local($") = ", "; + $CPAN::Frontend-> + myprint(" Ignoring dependencies on modules @prereq\n"); + } + if ($follow) { + my $id = $self->id; + # color them as dirty + for my $gp (@good_prereq_tuples) { + # warn "calling color_cmd_tmps(0,1)"; + my $p = $gp->[0]; + my $any = CPAN::Shell->expandany($p); + $self->{$slot . "_for"}{$any->id}++; + if ($any) { + $any->color_cmd_tmps(0,2); + } else { + $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n"); + $CPAN::Frontend->mysleep(2); + } + } + # queue them and re-queue yourself + CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}}, + map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @good_prereq_tuples); + $self->{$slot} = "Delayed until after prerequisites"; + return 1; # signal success to the queuerunner + } + return; +} + +sub _feature_depends { + my($self) = @_; + my $meta_yml = $self->parse_meta_yml(); + my $optf = $meta_yml->{optional_features} or return; + if (!ref $optf or ref $optf ne "HASH"){ + $CPAN::Frontend->mywarn("The content of optional_features is not a HASH reference. Cannot use it.\n"); + $optf = {}; + } + my $wantf = $self->prefs->{features} or return; + if (!ref $wantf or ref $wantf ne "ARRAY"){ + $CPAN::Frontend->mywarn("The content of 'features' is not an ARRAY reference. Cannot use it.\n"); + $wantf = []; + } + my $dep = +{}; + for my $wf (@$wantf) { + if (my $f = $optf->{$wf}) { + $CPAN::Frontend->myprint("Found the demanded feature '$wf' that ". + "is accompanied by this description:\n". + $f->{description}. + "\n\n" + ); + # configure_requires currently not in the spec, unlikely to be useful anyway + for my $reqtype (qw(configure_requires build_requires requires)) { + my $reqhash = $f->{$reqtype} or next; + while (my($k,$v) = each %$reqhash) { + $dep->{$reqtype}{$k} = $v; + } + } + } else { + $CPAN::Frontend->mywarn("The demanded feature '$wf' was not ". + "found in the META.yml file". + "\n\n" + ); + } + } + $dep; +} + +#-> sub CPAN::Distribution::unsat_prereq ; +# return ([Foo,"r"],[Bar,"b"]) for normal modules +# return ([perl=>5.008]) if we need a newer perl than we are running under +# (sorry for the inconsistency, it was an accident) +sub unsat_prereq { + my($self,$slot) = @_; + my(%merged,$prereq_pm); + my $prefs_depends = $self->prefs->{depends}||{}; + my $feature_depends = $self->_feature_depends(); + if ($slot eq "configure_requires_later") { + my $meta_yml = $self->parse_meta_yml(); + if (defined $meta_yml && (! ref $meta_yml || ref $meta_yml ne "HASH")) { + $CPAN::Frontend->mywarn("The content of META.yml is defined but not a HASH reference. Cannot use it.\n"); + $meta_yml = +{}; + } + %merged = ( + %{$meta_yml->{configure_requires}||{}}, + %{$prefs_depends->{configure_requires}||{}}, + %{$feature_depends->{configure_requires}||{}}, + ); + $prereq_pm = {}; # configure_requires defined as "b" + } elsif ($slot eq "later") { + my $prereq_pm_0 = $self->prereq_pm || {}; + for my $reqtype (qw(requires build_requires)) { + $prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it + for my $dep ($prefs_depends,$feature_depends) { + for my $k (keys %{$dep->{$reqtype}||{}}) { + $prereq_pm->{$reqtype}{$k} = $dep->{$reqtype}{$k}; + } + } + } + %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}}); + } else { + die "Panic: illegal slot '$slot'"; + } + my(@need); + my @merged = %merged; + CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG; + NEED: while (my($need_module, $need_version) = each %merged) { + my($available_version,$available_file,$nmo); + if ($need_module eq "perl") { + $available_version = $]; + $available_file = CPAN::find_perl(); + } else { + if (CPAN::_sqlite_running()) { + CPAN::Index->reload; + $CPAN::SQLite->search("CPAN::Module",$need_module); + } + $nmo = $CPAN::META->instance("CPAN::Module",$need_module); + next if $nmo->uptodate; + $available_file = $nmo->available_file; + + # if they have not specified a version, we accept any installed one + if (defined $available_file + and ( # a few quick shortcurcuits + not defined $need_version + or $need_version eq '0' # "==" would trigger warning when not numeric + or $need_version eq "undef" + )) { + next NEED; + } + + $available_version = $nmo->available_version; + } + + # We only want to install prereqs if either they're not installed + # or if the installed version is too old. We cannot omit this + # check, because if 'force' is in effect, nobody else will check. + if (defined $available_file) { + my $fulfills_all_version_rqs = $self->_fulfills_all_version_rqs + ($need_module,$available_file,$available_version,$need_version); + next NEED if $fulfills_all_version_rqs; + } + + if ($need_module eq "perl") { + return ["perl", $need_version]; + } + $self->{sponsored_mods}{$need_module} ||= 0; + CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG; + if (my $sponsoring = $self->{sponsored_mods}{$need_module}++) { + # We have already sponsored it and for some reason it's still + # not available. So we do ... what?? + + # if we push it again, we have a potential infinite loop + + # The following "next" was a very problematic construct. + # It helped a lot but broke some day and had to be + # replaced. + + # We must be able to deal with modules that come again and + # again as a prereq and have themselves prereqs and the + # queue becomes long but finally we would find the correct + # order. The RecursiveDependency check should trigger a + # die when it's becoming too weird. Unfortunately removing + # this next breaks many other things. + + # The bug that brought this up is described in Todo under + # "5.8.9 cannot install Compress::Zlib" + + # next; # this is the next that had to go away + + # The following "next NEED" are fine and the error message + # explains well what is going on. For example when the DBI + # fails and consequently DBD::SQLite fails and now we are + # processing CPAN::SQLite. Then we must have a "next" for + # DBD::SQLite. How can we get it and how can we identify + # all other cases we must identify? + + my $do = $nmo->distribution; + next NEED unless $do; # not on CPAN + if (CPAN::Version->vcmp($need_version, $nmo->ro->{CPAN_VERSION}) > 0){ + $CPAN::Frontend->mywarn("Warning: Prerequisite ". + "'$need_module => $need_version' ". + "for '$self->{ID}' seems ". + "not available according to the indices\n" + ); + next NEED; + } + NOSAYER: for my $nosayer ( + "unwrapped", + "writemakefile", + "signature_verify", + "make", + "make_test", + "install", + "make_clean", + ) { + if ($do->{$nosayer}) { + my $selfid = $self->pretty_id; + my $did = $do->pretty_id; + if (UNIVERSAL::can($do->{$nosayer},"failed") ? + $do->{$nosayer}->failed : + $do->{$nosayer} =~ /^NO/) { + if ($nosayer eq "make_test" + && + $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId + ) { + next NOSAYER; + } + $CPAN::Frontend->mywarn("Warning: Prerequisite ". + "'$need_module => $need_version' ". + "for '$selfid' failed when ". + "processing '$did' with ". + "'$nosayer => $do->{$nosayer}'. Continuing, ". + "but chances to succeed are limited.\n" + ); + $CPAN::Frontend->mysleep($sponsoring/10); + next NEED; + } else { # the other guy succeeded + if ($nosayer =~ /^(install|make_test)$/) { + # we had this with + # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz + # in 2007-03 for 'make install' + # and 2008-04: #30464 (for 'make test') + $CPAN::Frontend->mywarn("Warning: Prerequisite ". + "'$need_module => $need_version' ". + "for '$selfid' already built ". + "but the result looks suspicious. ". + "Skipping another build attempt, ". + "to prevent looping endlessly.\n" + ); + next NEED; + } + } + } + } + } + my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b"; + push @need, [$need_module,$needed_as]; + } + my @unfolded = map { "[".join(",",@$_)."]" } @need; + CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG; + @need; +} + +sub _fulfills_all_version_rqs { + my($self,$need_module,$available_file,$available_version,$need_version) = @_; + my(@all_requirements) = split /\s*,\s*/, $need_version; + local($^W) = 0; + my $ok = 0; + RQ: for my $rq (@all_requirements) { + if ($rq =~ s|>=\s*||) { + } elsif ($rq =~ s|>\s*||) { + # 2005-12: one user + if (CPAN::Version->vgt($available_version,$rq)) { + $ok++; + } + next RQ; + } elsif ($rq =~ s|!=\s*||) { + # 2005-12: no user + if (CPAN::Version->vcmp($available_version,$rq)) { + $ok++; + next RQ; + } else { + last RQ; + } + } elsif ($rq =~ m|<=?\s*|) { + # 2005-12: no user + $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n"); + $ok++; + next RQ; + } + if (! CPAN::Version->vgt($rq, $available_version)) { + $ok++; + } + CPAN->debug(sprintf("need_module[%s]available_file[%s]". + "available_version[%s]rq[%s]ok[%d]", + $need_module, + $available_file, + $available_version, + CPAN::Version->readable($rq), + $ok, + )) if $CPAN::DEBUG; + } + return $ok == @all_requirements; +} + +#-> sub CPAN::Distribution::read_yaml ; +sub read_yaml { + my($self) = @_; + return $self->{yaml_content} if exists $self->{yaml_content}; + my $build_dir; + unless ($build_dir = $self->{build_dir}) { + # maybe permission on build_dir was missing + $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n"); + return; + } + # if MYMETA.yml exists, that takes precedence over META.yml + my $meta = File::Spec->catfile($build_dir,"META.yml"); + my $mymeta = File::Spec->catfile($build_dir,"MYMETA.yml"); + my $yaml = -f $mymeta ? $mymeta : $meta; + $self->debug("yaml[$yaml]") if $CPAN::DEBUG; + return unless -f $yaml; + eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; }; + if ($@) { + $CPAN::Frontend->mywarn("Could not read ". + "'$yaml'. Falling back to other ". + "methods to determine prerequisites\n"); + return $self->{yaml_content} = undef; # if we die, then we + # cannot read YAML's own + # META.yml + } + # not "authoritative" + for ($self->{yaml_content}) { + if (defined $_ && (! ref $_ || ref $_ ne "HASH")) { + $CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n"); + $self->{yaml_content} = +{}; + } + } + # MYMETA.yml is not dynamic by definition + if ( $yaml ne $mymeta && + ( not exists $self->{yaml_content}{dynamic_config} + or $self->{yaml_content}{dynamic_config} + ) + ) { + $self->{yaml_content} = undef; + } + $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF") + if $CPAN::DEBUG; + return $self->{yaml_content}; +} + +#-> sub CPAN::Distribution::prereq_pm ; +sub prereq_pm { + my($self) = @_; + $self->{prereq_pm_detected} ||= 0; + CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG; + return $self->{prereq_pm} if $self->{prereq_pm_detected}; + return unless $self->{writemakefile} # no need to have succeeded + # but we must have run it + || $self->{modulebuild}; + unless ($self->{build_dir}) { + return; + } + CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]", + $self->{writemakefile}||"", + $self->{modulebuild}||"", + ) if $CPAN::DEBUG; + my($req,$breq); + if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here + $req = $yaml->{requires} || {}; + $breq = $yaml->{build_requires} || {}; + undef $req unless ref $req eq "HASH" && %$req; + if ($req) { + if ($yaml->{generated_by} && + $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) { + my $eummv = do { local $^W = 0; $1+0; }; + if ($eummv < 6.2501) { + # thanks to Slaven for digging that out: MM before + # that could be wrong because it could reflect a + # previous release + undef $req; + } + } + my $areq; + my $do_replace; + while (my($k,$v) = each %{$req||{}}) { + if ($v =~ /\d/) { + $areq->{$k} = $v; + } elsif ($k =~ /[A-Za-z]/ && + $v =~ /[A-Za-z]/ && + $CPAN::META->exists("CPAN::Module",$v) + ) { + $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ". + "requires hash: $k => $v; I'll take both ". + "key and value as a module name\n"); + $CPAN::Frontend->mysleep(1); + $areq->{$k} = 0; + $areq->{$v} = 0; + $do_replace++; + } + } + $req = $areq if $do_replace; + } + } + unless ($req || $breq) { + my $build_dir; + unless ( $build_dir = $self->{build_dir} ) { + return; + } + my $makefile = File::Spec->catfile($build_dir,"Makefile"); + my $fh; + if (-f $makefile + and + $fh = FileHandle->new("<$makefile\0")) { + CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG; + local($/) = "\n"; + while (<$fh>) { + last if /MakeMaker post_initialize section/; + my($p) = m{^[\#] + \s+PREREQ_PM\s+=>\s+(.+) + }x; + next unless $p; + # warn "Found prereq expr[$p]"; + + # Regexp modified by A.Speer to remember actual version of file + # PREREQ_PM hash key wants, then add to + while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) { + # In case a prereq is mentioned twice, complain. + if ( defined $req->{$1} ) { + warn "Warning: PREREQ_PM mentions $1 more than once, ". + "last mention wins"; + } + my($m,$n) = ($1,$2); + if ($n =~ /^q\[(.*?)\]$/) { + $n = $1; + } + $req->{$m} = $n; + } + last; + } + } + } + unless ($req || $breq) { + my $build_dir = $self->{build_dir} or die "Panic: no build_dir?"; + my $buildfile = File::Spec->catfile($build_dir,"Build"); + if (-f $buildfile) { + CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG; + my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs"); + if (-f $build_prereqs) { + CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG; + my $content = do { local *FH; + open FH, $build_prereqs + or $CPAN::Frontend->mydie("Could not open ". + "'$build_prereqs': $!"); + local $/; + ; + }; + my $bphash = eval $content; + if ($@) { + } else { + $req = $bphash->{requires} || +{}; + $breq = $bphash->{build_requires} || +{}; + } + } + } + } + if (-f "Build.PL" + && ! -f "Makefile.PL" + && ! exists $req->{"Module::Build"} + && ! $CPAN::META->has_inst("Module::Build")) { + $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ". + "undeclared prerequisite.\n". + " Adding it now as such.\n" + ); + $CPAN::Frontend->mysleep(5); + $req->{"Module::Build"} = 0; + delete $self->{writemakefile}; + } + if ($req || $breq) { + $self->{prereq_pm_detected}++; + return $self->{prereq_pm} = { requires => $req, build_requires => $breq }; + } +} + +#-> sub CPAN::Distribution::test ; +sub test { + my($self) = @_; + if (my $goto = $self->prefs->{goto}) { + return $self->goto($goto); + } + $self->make; + return if $self->prefs->{disabled} && ! $self->{force_update}; + if ($CPAN::Signal) { + delete $self->{force_update}; + return; + } + # warn "XDEBUG: checking for notest: $self->{notest} $self"; + if ($self->{notest}) { + $CPAN::Frontend->myprint("Skipping test because of notest pragma\n"); + return 1; + } + + my $make = $self->{modulebuild} ? "Build" : "make"; + + local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) + ? $ENV{PERL5LIB} + : ($ENV{PERLLIB} || ""); + + local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; + $CPAN::META->set_perl5lib; + local $ENV{MAKEFLAGS}; # protect us from outer make calls + + $CPAN::Frontend->myprint("Running $make test\n"); + + EXCUSE: { + my @e; + if ($self->{make} or $self->{later}) { + # go ahead + } else { + push @e, + "Make had some problems, won't test"; + } + + exists $self->{make} and + ( + UNIVERSAL::can($self->{make},"failed") ? + $self->{make}->failed : + $self->{make} =~ /^NO/ + ) and push @e, "Can't test without successful make"; + $self->{badtestcnt} ||= 0; + if ($self->{badtestcnt} > 0) { + require Data::Dumper; + CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG; + push @e, "Won't repeat unsuccessful test during this command"; + } + + push @e, $self->{later} if $self->{later}; + push @e, $self->{configure_requires_later} if $self->{configure_requires_later}; + + if (exists $self->{build_dir}) { + if (exists $self->{make_test}) { + if ( + UNIVERSAL::can($self->{make_test},"failed") ? + $self->{make_test}->failed : + $self->{make_test} =~ /^NO/ + ) { + if ( + UNIVERSAL::can($self->{make_test},"commandid") + && + $self->{make_test}->commandid == $CPAN::CurrentCommandId + ) { + push @e, "Has already been tested within this command"; + } + } else { + push @e, "Has already been tested successfully"; + # if global "is_tested" has been cleared, we need to mark this to + # be added to PERL5LIB if not already installed + if ($self->tested_ok_but_not_installed) { + $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME}); + } + } + } + } elsif (!@e) { + push @e, "Has no own directory"; + } + $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; + unless (chdir $self->{build_dir}) { + push @e, "Couldn't chdir to '$self->{build_dir}': $!"; + } + $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e; + } + $self->debug("Changed directory to $self->{build_dir}") + if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + Mac::BuildTools::make_test($self); + return; + } + + if ($self->{modulebuild}) { + my $thm = CPAN::Shell->expand("Module","Test::Harness"); + my $v = $thm->inst_version; + if (CPAN::Version->vlt($v,2.62)) { + # XXX Eric Wilhelm reported this as a bug: klapperl: + # Test::Harness 3.0 self-tests, so that should be 'unless + # installing Test::Harness' + unless ($self->id eq $thm->distribution->id) { + $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only + '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n}); + $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old"); + return; + } + } + } + + if ( ! $self->{force_update} ) { + # bypass actual tests if "trust_test_report_history" and have a report + my $have_tested_fcn; + if ( $CPAN::Config->{trust_test_report_history} + && $CPAN::META->has_inst("CPAN::Reporter::History") + && ( $have_tested_fcn = CPAN::Reporter::History->can("have_tested" ))) { + if ( my @reports = $have_tested_fcn->( dist => $self->base_id ) ) { + # Do nothing if grade was DISCARD + if ( $reports[-1]->{grade} =~ /^(?:PASS|UNKNOWN)$/ ) { + $self->{make_test} = CPAN::Distrostatus->new("YES"); + # if global "is_tested" has been cleared, we need to mark this to + # be added to PERL5LIB if not already installed + if ($self->tested_ok_but_not_installed) { + $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME}); + } + $CPAN::Frontend->myprint("Found prior test report -- OK\n"); + return; + } + elsif ( $reports[-1]->{grade} =~ /^(?:FAIL|NA)$/ ) { + $self->{make_test} = CPAN::Distrostatus->new("NO"); + $self->{badtestcnt}++; + $CPAN::Frontend->mywarn("Found prior test report -- NOT OK\n"); + return; + } + } + } + } + + my $system; + my $prefs_test = $self->prefs->{test}; + if (my $commandline + = exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") { + $system = $commandline; + $ENV{PERL} = CPAN::find_perl(); + } elsif ($self->{modulebuild}) { + $system = sprintf "%s test", $self->_build_command(); + unless (-e "Build") { + my $id = $self->pretty_id; + $CPAN::Frontend->mywarn("Alert: no 'Build' file found while trying to test '$id'"); + } + } else { + $system = join " ", $self->_make_command(), "test"; + } + my $make_test_arg = $self->_make_phase_arg("test"); + $system = sprintf("%s%s", + $system, + $make_test_arg ? " $make_test_arg" : "", + ); + my($tests_ok); + my %env; + while (my($k,$v) = each %ENV) { + next unless defined $v; + $env{$k} = $v; + } + local %ENV = %env; + my $test_env; + if ($self->prefs->{test}) { + $test_env = $self->prefs->{test}{env}; + } + if ($test_env) { + for my $e (keys %$test_env) { + $ENV{$e} = $test_env->{$e}; + } + } + my $expect_model = $self->_prefs_with_expect("test"); + my $want_expect = 0; + if ( $expect_model && @{$expect_model->{talk}} ) { + my $can_expect = $CPAN::META->has_inst("Expect"); + if ($can_expect) { + $want_expect = 1; + } else { + $CPAN::Frontend->mywarn("Expect not installed, falling back to ". + "testing without\n"); + } + } + if ($want_expect) { + if ($self->_should_report('test')) { + $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ". + "not supported when distroprefs specify ". + "an interactive test\n"); + } + $tests_ok = $self->_run_via_expect($system,'test',$expect_model) == 0; + } elsif ( $self->_should_report('test') ) { + $tests_ok = CPAN::Reporter::test($self, $system); + } else { + $tests_ok = system($system) == 0; + } + $self->introduce_myself; + if ( $tests_ok ) { + { + my @prereq; + + # local $CPAN::DEBUG = 16; # Distribution + for my $m (keys %{$self->{sponsored_mods}}) { + next unless $self->{sponsored_mods}{$m} > 0; + my $m_obj = CPAN::Shell->expand("Module",$m) or next; + # XXX we need available_version which reflects + # $ENV{PERL5LIB} so that already tested but not yet + # installed modules are counted. + my $available_version = $m_obj->available_version; + my $available_file = $m_obj->available_file; + if ($available_version && + !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m}) + ) { + CPAN->debug("m[$m] good enough available_version[$available_version]") + if $CPAN::DEBUG; + } elsif ($available_file + && ( + !$self->{prereq_pm}{$m} + || + $self->{prereq_pm}{$m} == 0 + ) + ) { + # lex Class::Accessor::Chained::Fast which has no $VERSION + CPAN->debug("m[$m] have available_file[$available_file]") + if $CPAN::DEBUG; + } else { + push @prereq, $m; + } + } + if (@prereq) { + my $cnt = @prereq; + my $which = join ",", @prereq; + my $but = $cnt == 1 ? "one dependency not OK ($which)" : + "$cnt dependencies missing ($which)"; + $CPAN::Frontend->mywarn("Tests succeeded but $but\n"); + $self->{make_test} = CPAN::Distrostatus->new("NO $but"); + $self->store_persistent_state; + return $self->goodbye("[dependencies] -- NA"); + } + } + + $CPAN::Frontend->myprint(" $system -- OK\n"); + $self->{make_test} = CPAN::Distrostatus->new("YES"); + $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME}); + # probably impossible to need the next line because badtestcnt + # has a lifespan of one command + delete $self->{badtestcnt}; + } else { + $self->{make_test} = CPAN::Distrostatus->new("NO"); + $self->{badtestcnt}++; + $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); + CPAN::Shell->optprint + ("hint", + sprintf + ("//hint// to see the cpan-testers results for installing this module, try: + reports %s\n", + $self->pretty_id)); + } + $self->store_persistent_state; +} + +sub _prefs_with_expect { + my($self,$where) = @_; + return unless my $prefs = $self->prefs; + return unless my $where_prefs = $prefs->{$where}; + if ($where_prefs->{expect}) { + return { + mode => "deterministic", + timeout => 15, + talk => $where_prefs->{expect}, + }; + } elsif ($where_prefs->{"eexpect"}) { + return $where_prefs->{"eexpect"}; + } + return; +} + +#-> sub CPAN::Distribution::clean ; +sub clean { + my($self) = @_; + my $make = $self->{modulebuild} ? "Build" : "make"; + $CPAN::Frontend->myprint("Running $make clean\n"); + unless (exists $self->{archived}) { + $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped". + "/untarred, nothing done\n"); + return 1; + } + unless (exists $self->{build_dir}) { + $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n"); + return 1; + } + if (exists $self->{writemakefile} + and $self->{writemakefile}->failed + ) { + $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n"); + return 1; + } + EXCUSE: { + my @e; + exists $self->{make_clean} and $self->{make_clean} eq "YES" and + push @e, "make clean already called once"; + $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; + } + chdir $self->{build_dir} or + Carp::confess("Couldn't chdir to $self->{build_dir}: $!"); + $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + Mac::BuildTools::make_clean($self); + return; + } + + my $system; + if ($self->{modulebuild}) { + unless (-f "Build") { + my $cwd = CPAN::anycwd(); + $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}". + " in cwd[$cwd]. Danger, Will Robinson!"); + $CPAN::Frontend->mysleep(5); + } + $system = sprintf "%s clean", $self->_build_command(); + } else { + $system = join " ", $self->_make_command(), "clean"; + } + my $system_ok = system($system) == 0; + $self->introduce_myself; + if ( $system_ok ) { + $CPAN::Frontend->myprint(" $system -- OK\n"); + + # $self->force; + + # Jost Krieger pointed out that this "force" was wrong because + # it has the effect that the next "install" on this distribution + # will untar everything again. Instead we should bring the + # object's state back to where it is after untarring. + + for my $k (qw( + force_update + install + writemakefile + make + make_test + )) { + delete $self->{$k}; + } + $self->{make_clean} = CPAN::Distrostatus->new("YES"); + + } else { + # Hmmm, what to do if make clean failed? + + $self->{make_clean} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n}); + + # 2006-02-27: seems silly to me to force a make now + # $self->force("make"); # so that this directory won't be used again + + } + $self->store_persistent_state; +} + +#-> sub CPAN::Distribution::goto ; +sub goto { + my($self,$goto) = @_; + $goto = $self->normalize($goto); + my $why = sprintf( + "Goto '$goto' via prefs file '%s' doc %d", + $self->{prefs_file}, + $self->{prefs_file_doc}, + ); + $self->{unwrapped} = CPAN::Distrostatus->new("NO $why"); + # 2007-07-16 akoenig : Better than NA would be if we could inherit + # the status of the $goto distro but given the exceptional nature + # of 'goto' I feel reluctant to implement it + my $goodbye_message = "[goto] -- NA $why"; + $self->goodbye($goodbye_message); + + # inject into the queue + + CPAN::Queue->delete($self->id); + CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}}); + + # and run where we left off + + my($method) = (caller(1))[3]; + CPAN->instance("CPAN::Distribution",$goto)->$method(); + CPAN::Queue->delete_first($goto); +} + +#-> sub CPAN::Distribution::install ; +sub install { + my($self) = @_; + if (my $goto = $self->prefs->{goto}) { + return $self->goto($goto); + } + unless ($self->{badtestcnt}) { + $self->test; + } + if ($CPAN::Signal) { + delete $self->{force_update}; + return; + } + my $make = $self->{modulebuild} ? "Build" : "make"; + $CPAN::Frontend->myprint("Running $make install\n"); + EXCUSE: { + my @e; + if ($self->{make} or $self->{later}) { + # go ahead + } else { + push @e, + "Make had some problems, won't install"; + } + + exists $self->{make} and + ( + UNIVERSAL::can($self->{make},"failed") ? + $self->{make}->failed : + $self->{make} =~ /^NO/ + ) and + push @e, "Make had returned bad status, install seems impossible"; + + if (exists $self->{build_dir}) { + } elsif (!@e) { + push @e, "Has no own directory"; + } + + if (exists $self->{make_test} and + ( + UNIVERSAL::can($self->{make_test},"failed") ? + $self->{make_test}->failed : + $self->{make_test} =~ /^NO/ + )) { + if ($self->{force_update}) { + $self->{make_test}->text("FAILED but failure ignored because ". + "'force' in effect"); + } else { + push @e, "make test had returned bad status, ". + "won't install without force" + } + } + if (exists $self->{install}) { + if (UNIVERSAL::can($self->{install},"text") ? + $self->{install}->text eq "YES" : + $self->{install} =~ /^YES/ + ) { + $CPAN::Frontend->myprint(" Already done\n"); + $CPAN::META->is_installed($self->{build_dir}); + return 1; + } else { + # comment in Todo on 2006-02-11; maybe retry? + push @e, "Already tried without success"; + } + } + + push @e, $self->{later} if $self->{later}; + push @e, $self->{configure_requires_later} if $self->{configure_requires_later}; + + $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; + unless (chdir $self->{build_dir}) { + push @e, "Couldn't chdir to '$self->{build_dir}': $!"; + } + $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e; + } + $self->debug("Changed directory to $self->{build_dir}") + if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + Mac::BuildTools::make_install($self); + return; + } + + my $system; + if (my $commandline = $self->prefs->{install}{commandline}) { + $system = $commandline; + $ENV{PERL} = CPAN::find_perl(); + } elsif ($self->{modulebuild}) { + my($mbuild_install_build_command) = + exists $CPAN::HandleConfig::keys{mbuild_install_build_command} && + $CPAN::Config->{mbuild_install_build_command} ? + $CPAN::Config->{mbuild_install_build_command} : + $self->_build_command(); + $system = sprintf("%s install %s", + $mbuild_install_build_command, + $CPAN::Config->{mbuild_install_arg}, + ); + } else { + my($make_install_make_command) = + CPAN::HandleConfig->prefs_lookup($self, + q{make_install_make_command}) + || $self->_make_command(); + $system = sprintf("%s install %s", + $make_install_make_command, + $CPAN::Config->{make_install_arg}, + ); + } + + my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 "; + my $brip = CPAN::HandleConfig->prefs_lookup($self, + q{build_requires_install_policy}); + $brip ||="ask/yes"; + my $id = $self->id; + my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command + my $want_install = "yes"; + if ($reqtype eq "b") { + if ($brip eq "no") { + $want_install = "no"; + } elsif ($brip =~ m|^ask/(.+)|) { + my $default = $1; + $default = "yes" unless $default =~ /^(y|n)/i; + $want_install = + CPAN::Shell::colorable_makemaker_prompt + ("$id is just needed temporarily during building or testing. ". + "Do you want to install it permanently?", + $default); + } + } + unless ($want_install =~ /^y/i) { + my $is_only = "is only 'build_requires'"; + $CPAN::Frontend->mywarn("Not installing because $is_only\n"); + $self->{install} = CPAN::Distrostatus->new("NO -- $is_only"); + delete $self->{force_update}; + return; + } + local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) + ? $ENV{PERL5LIB} + : ($ENV{PERLLIB} || ""); + + local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; + $CPAN::META->set_perl5lib; + my($pipe) = FileHandle->new("$system $stderr |") || Carp::croak +("Can't execute $system: $!"); + my($makeout) = ""; + while (<$pipe>) { + print $_; # intentionally NOT use Frontend->myprint because it + # looks irritating when we markup in color what we + # just pass through from an external program + $makeout .= $_; + } + $pipe->close; + my $close_ok = $? == 0; + $self->introduce_myself; + if ( $close_ok ) { + $CPAN::Frontend->myprint(" $system -- OK\n"); + $CPAN::META->is_installed($self->{build_dir}); + $self->{install} = CPAN::Distrostatus->new("YES"); + } else { + $self->{install} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); + my $mimc = + CPAN::HandleConfig->prefs_lookup($self, + q{make_install_make_command}); + if ( + $makeout =~ /permission/s + && $> > 0 + && ( + ! $mimc + || $mimc eq (CPAN::HandleConfig->prefs_lookup($self, + q{make})) + ) + ) { + $CPAN::Frontend->myprint( + qq{----\n}. + qq{ You may have to su }. + qq{to root to install the package\n}. + qq{ (Or you may want to run something like\n}. + qq{ o conf make_install_make_command 'sudo make'\n}. + qq{ to raise your permissions.} + ); + } + } + delete $self->{force_update}; + $self->store_persistent_state; +} + +sub introduce_myself { + my($self) = @_; + $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id)); +} + +#-> sub CPAN::Distribution::dir ; +sub dir { + shift->{build_dir}; +} + +#-> sub CPAN::Distribution::perldoc ; +sub perldoc { + my($self) = @_; + + my($dist) = $self->id; + my $package = $self->called_for; + + if ($CPAN::META->has_inst("Pod::Perldocs")) { + my($perl) = $self->perl + or $CPAN::Frontend->mydie("Couldn't find executable perl\n"); + my @args = ($perl, q{-MPod::Perldocs}, q{-e}, + q{Pod::Perldocs->run()}, $package); + my($wstatus); + unless ( ($wstatus = system(@args)) == 0 ) { + my $estatus = $wstatus >> 8; + $CPAN::Frontend->myprint(qq{ + Function system("@args") + returned status $estatus (wstat $wstatus) + }); + } + } + else { + $self->_display_url( $CPAN::Defaultdocs . $package ); + } +} + +#-> sub CPAN::Distribution::_check_binary ; +sub _check_binary { + my ($dist,$shell,$binary) = @_; + my ($pid,$out); + + $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n}) + if $CPAN::DEBUG; + + if ($CPAN::META->has_inst("File::Which")) { + return File::Which::which($binary); + } else { + local *README; + $pid = open README, "which $binary|" + or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n}); + return unless $pid; + while () { + $out .= $_; + } + close README + or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n") + and return; + } + + $CPAN::Frontend->myprint(qq{ + $out \n}) + if $CPAN::DEBUG && $out; + + return $out; +} + +#-> sub CPAN::Distribution::_display_url ; +sub _display_url { + my($self,$url) = @_; + my($res,$saved_file,$pid,$out); + + $CPAN::Frontend->myprint(qq{ + _display_url($url)\n}) + if $CPAN::DEBUG; + + # should we define it in the config instead? + my $html_converter = "html2text.pl"; + + my $web_browser = $CPAN::Config->{'lynx'} || undef; + my $web_browser_out = $web_browser + ? CPAN::Distribution->_check_binary($self,$web_browser) + : undef; + + if ($web_browser_out) { + # web browser found, run the action + my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'}); + $CPAN::Frontend->myprint(qq{system[$browser $url]}) + if $CPAN::DEBUG; + $CPAN::Frontend->myprint(qq{ +Displaying URL + $url +with browser $browser +}); + $CPAN::Frontend->mysleep(1); + system("$browser $url"); + if ($saved_file) { 1 while unlink($saved_file) } + } else { + # web browser not found, let's try text only + my $html_converter_out = + CPAN::Distribution->_check_binary($self,$html_converter); + $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out); + + if ($html_converter_out ) { + # html2text found, run it + $saved_file = CPAN::Distribution->_getsave_url( $self, $url ); + $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n}) + unless defined($saved_file); + + local *README; + $pid = open README, "$html_converter $saved_file |" + or $CPAN::Frontend->mydie(qq{ +Could not fork '$html_converter $saved_file': $!}); + my($fh,$filename); + if ($CPAN::META->has_usable("File::Temp")) { + $fh = File::Temp->new( + dir => File::Spec->tmpdir, + template => 'cpan_htmlconvert_XXXX', + suffix => '.txt', + unlink => 0, + ); + $filename = $fh->filename; + } else { + $filename = "cpan_htmlconvert_$$.txt"; + $fh = FileHandle->new(); + open $fh, ">$filename" or die; + } + while () { + $fh->print($_); + } + close README or + $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!}); + my $tmpin = $fh->filename; + $CPAN::Frontend->myprint(sprintf(qq{ +Run '%s %s' and +saved output to %s\n}, + $html_converter, + $saved_file, + $tmpin, + )) if $CPAN::DEBUG; + close $fh; + local *FH; + open FH, $tmpin + or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!}); + my $fh_pager = FileHandle->new; + local($SIG{PIPE}) = "IGNORE"; + my $pager = $CPAN::Config->{'pager'} || "cat"; + $fh_pager->open("|$pager") + or $CPAN::Frontend->mydie(qq{ +Could not open pager '$pager': $!}); + $CPAN::Frontend->myprint(qq{ +Displaying URL + $url +with pager "$pager" +}); + $CPAN::Frontend->mysleep(1); + $fh_pager->print(); + $fh_pager->close; + } else { + # coldn't find the web browser or html converter + $CPAN::Frontend->myprint(qq{ +You need to install lynx or $html_converter to use this feature.}); + } + } +} + +#-> sub CPAN::Distribution::_getsave_url ; +sub _getsave_url { + my($dist, $shell, $url) = @_; + + $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n}) + if $CPAN::DEBUG; + + my($fh,$filename); + if ($CPAN::META->has_usable("File::Temp")) { + $fh = File::Temp->new( + dir => File::Spec->tmpdir, + template => "cpan_getsave_url_XXXX", + suffix => ".html", + unlink => 0, + ); + $filename = $fh->filename; + } else { + $fh = FileHandle->new; + $filename = "cpan_getsave_url_$$.html"; + } + my $tmpin = $filename; + if ($CPAN::META->has_usable('LWP')) { + $CPAN::Frontend->myprint("Fetching with LWP: + $url +"); + my $Ua; + CPAN::LWP::UserAgent->config; + eval { $Ua = CPAN::LWP::UserAgent->new; }; + if ($@) { + $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n"); + return; + } else { + my($var); + $Ua->proxy('http', $var) + if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy}; + $Ua->no_proxy($var) + if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy}; + } + + my $req = HTTP::Request->new(GET => $url); + $req->header('Accept' => 'text/html'); + my $res = $Ua->request($req); + if ($res->is_success) { + $CPAN::Frontend->myprint(" + request successful.\n") + if $CPAN::DEBUG; + print $fh $res->content; + close $fh; + $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n}) + if $CPAN::DEBUG; + return $tmpin; + } else { + $CPAN::Frontend->myprint(sprintf( + "LWP failed with code[%s], message[%s]\n", + $res->code, + $res->message, + )); + return; + } + } else { + $CPAN::Frontend->mywarn(" LWP not available\n"); + return; + } +} + +#-> sub CPAN::Distribution::_build_command +sub _build_command { + my($self) = @_; + if ($^O eq "MSWin32") { # special code needed at least up to + # Module::Build 0.2611 and 0.2706; a fix + # in M:B has been promised 2006-01-30 + my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n"); + return "$perl ./Build"; + } + return "./Build"; +} + +#-> sub CPAN::Distribution::_should_report +sub _should_report { + my($self, $phase) = @_; + die "_should_report() requires a 'phase' argument" + if ! defined $phase; + + # configured + my $test_report = CPAN::HandleConfig->prefs_lookup($self, + q{test_report}); + return unless $test_report; + + # don't repeat if we cached a result + return $self->{should_report} + if exists $self->{should_report}; + + # don't report if we generated a Makefile.PL + if ( $self->{had_no_makefile_pl} ) { + $CPAN::Frontend->mywarn( + "Will not send CPAN Testers report with generated Makefile.PL.\n" + ); + return $self->{should_report} = 0; + } + + # available + if ( ! $CPAN::META->has_inst("CPAN::Reporter")) { + $CPAN::Frontend->mywarn( + "CPAN::Reporter not installed. No reports will be sent.\n" + ); + return $self->{should_report} = 0; + } + + # capable + my $crv = CPAN::Reporter->VERSION; + if ( CPAN::Version->vlt( $crv, 0.99 ) ) { + # don't cache $self->{should_report} -- need to check each phase + if ( $phase eq 'test' ) { + return 1; + } + else { + $CPAN::Frontend->mywarn( + "Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" . + "you only have version $crv\. Only 'test' phase reports will be sent.\n" + ); + return; + } + } + + # appropriate + if ($self->is_dot_dist) { + $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ". + "for local directories\n"); + return $self->{should_report} = 0; + } + if ($self->prefs->{patches} + && + @{$self->prefs->{patches}} + && + $self->{patched} + ) { + $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ". + "when the source has been patched\n"); + return $self->{should_report} = 0; + } + + # proceed and cache success + return $self->{should_report} = 1; +} + +#-> sub CPAN::Distribution::reports +sub reports { + my($self) = @_; + my $pathname = $self->id; + $CPAN::Frontend->myprint("Distribution: $pathname\n"); + + unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) { + $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue"); + } + unless ($CPAN::META->has_usable("LWP")) { + $CPAN::Frontend->mydie("LWP not installed; cannot continue"); + } + unless ($CPAN::META->has_usable("File::Temp")) { + $CPAN::Frontend->mydie("File::Temp not installed; cannot continue"); + } + + my $d = CPAN::DistnameInfo->new($pathname); + + my $dist = $d->dist; # "CPAN-DistnameInfo" + my $version = $d->version; # "0.02" + my $maturity = $d->maturity; # "released" + my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz" + my $cpanid = $d->cpanid; # "GBARR" + my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02" + + my $url = sprintf "http://www.cpantesters.org/show/%s.yaml", $dist; + + CPAN::LWP::UserAgent->config; + my $Ua; + eval { $Ua = CPAN::LWP::UserAgent->new; }; + if ($@) { + $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n"); + } + $CPAN::Frontend->myprint("Fetching '$url'..."); + my $resp = $Ua->get($url); + unless ($resp->is_success) { + $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code); + } + $CPAN::Frontend->myprint("DONE\n\n"); + my $yaml = $resp->content; + # was fuer ein Umweg! + my $fh = File::Temp->new( + dir => File::Spec->tmpdir, + template => 'cpan_reports_XXXX', + suffix => '.yaml', + unlink => 0, + ); + my $tfilename = $fh->filename; + print $fh $yaml; + close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!"); + my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0]; + unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!"); + my %other_versions; + my $this_version_seen; + for my $rep (@$unserialized) { + my $rversion = $rep->{version}; + if ($rversion eq $version) { + unless ($this_version_seen++) { + $CPAN::Frontend->myprint ("$rep->{version}:\n"); + } + my $arch = $rep->{archname} || $rep->{platform} || '????'; + my $grade = $rep->{action} || $rep->{status} || '????'; + my $ostext = $rep->{ostext} || ucfirst($rep->{osname}) || '????'; + $CPAN::Frontend->myprint + (sprintf("%1s%1s%-4s %s on %s %s (%s)\n", + $arch eq $Config::Config{archname}?"*":"", + $grade eq "PASS"?"+":$grade eq"FAIL"?"-":"", + $grade, + $rep->{perl}, + $ostext, + $rep->{osvers}, + $arch, + )); + } else { + $other_versions{$rep->{version}}++; + } + } + unless ($this_version_seen) { + $CPAN::Frontend->myprint("No reports found for version '$version' +Reports for other versions:\n"); + for my $v (sort keys %other_versions) { + $CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n"); + } + } + $url =~ s/\.yaml/.html/; + $CPAN::Frontend->myprint("See $url for details\n"); +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Distroprefs.pm b/cpan/CPAN/lib/CPAN/Distroprefs.pm new file mode 100644 index 0000000000..e1be9cdf74 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Distroprefs.pm @@ -0,0 +1,451 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: + +use strict; +package CPAN::Distroprefs; + +use vars qw($VERSION); +$VERSION = '6'; + +package CPAN::Distroprefs::Result; + +use File::Spec; + +sub new { bless $_[1] || {} => $_[0] } + +sub abs { File::Spec->catfile($_[0]->dir, $_[0]->file) } + +sub __cloner { + my ($class, $name, $newclass) = @_; + $newclass = 'CPAN::Distroprefs::Result::' . $newclass; + no strict 'refs'; + *{$class . '::' . $name} = sub { + $newclass->new({ + %{ $_[0] }, + %{ $_[1] }, + }); + }; +} +BEGIN { __PACKAGE__->__cloner(as_warning => 'Warning') } +BEGIN { __PACKAGE__->__cloner(as_fatal => 'Fatal') } +BEGIN { __PACKAGE__->__cloner(as_success => 'Success') } + +sub __accessor { + my ($class, $key) = @_; + no strict 'refs'; + *{$class . '::' . $key} = sub { $_[0]->{$key} }; +} +BEGIN { __PACKAGE__->__accessor($_) for qw(type file ext dir) } + +sub is_warning { 0 } +sub is_fatal { 0 } +sub is_success { 0 } + +package CPAN::Distroprefs::Result::Error; +use vars qw(@ISA); +BEGIN { @ISA = 'CPAN::Distroprefs::Result' } ## no critic +BEGIN { __PACKAGE__->__accessor($_) for qw(msg) } + +sub as_string { + my ($self) = @_; + if ($self->msg) { + return sprintf $self->fmt_reason, $self->file, $self->msg; + } else { + return sprintf $self->fmt_unknown, $self->file; + } +} + +package CPAN::Distroprefs::Result::Warning; +use vars qw(@ISA); +BEGIN { @ISA = 'CPAN::Distroprefs::Result::Error' } ## no critic +sub is_warning { 1 } +sub fmt_reason { "Error reading distroprefs file %s, skipping: %s" } +sub fmt_unknown { "Unknown error reading distroprefs file %s, skipping." } + +package CPAN::Distroprefs::Result::Fatal; +use vars qw(@ISA); +BEGIN { @ISA = 'CPAN::Distroprefs::Result::Error' } ## no critic +sub is_fatal { 1 } +sub fmt_reason { "Error reading distroprefs file %s: %s" } +sub fmt_unknown { "Unknown error reading distroprefs file %s." } + +package CPAN::Distroprefs::Result::Success; +use vars qw(@ISA); +BEGIN { @ISA = 'CPAN::Distroprefs::Result' } ## no critic +BEGIN { __PACKAGE__->__accessor($_) for qw(prefs extension) } +sub is_success { 1 } + +package CPAN::Distroprefs::Iterator; + +sub new { bless $_[1] => $_[0] } + +sub next { $_[0]->() } + +package CPAN::Distroprefs; + +use Carp (); +use DirHandle; + +sub _load_method { + my ($self, $loader, $result) = @_; + return '_load_yaml' if $loader eq 'CPAN' or $loader =~ /^YAML(::|$)/; + return '_load_' . $result->ext; +} + +sub _load_yaml { + my ($self, $loader, $result) = @_; + my $data = eval { + $loader eq 'CPAN' + ? $loader->_yaml_loadfile($result->abs) + : [ $loader->can('LoadFile')->($result->abs) ] + }; + if (my $err = $@) { + die $result->as_warning({ + msg => $err, + }); + } elsif (!$data) { + die $result->as_warning; + } else { + return @$data; + } +} + +sub _load_dd { + my ($self, $loader, $result) = @_; + my @data; + { + package CPAN::Eval; + # this caused a die in CPAN.pm, and I am leaving it 'fatal', though I'm + # not sure why we wouldn't just skip the file as we do for all other + # errors. -- hdp + my $abs = $result->abs; + open FH, "<$abs" or die $result->as_fatal(msg => "$!"); + local $/; + my $eval = ; + close FH; + no strict; + eval $eval; + if (my $err = $@) { + die $result->as_warning({ msg => $err }); + } + my $i = 1; + while (${"VAR$i"}) { + push @data, ${"VAR$i"}; + $i++; + } + } + return @data; +} + +sub _load_st { + my ($self, $loader, $result) = @_; + # eval because Storable is never forward compatible + my @data = eval { @{scalar $loader->can('retrieve')->($result->abs) } }; + if (my $err = $@) { + die $result->as_warning({ msg => $err }); + } + return @data; +} + +sub find { + my ($self, $dir, $ext_map) = @_; + + my $dh = DirHandle->new($dir) or Carp::croak("Couldn't open '$dir': $!"); + my @files = sort $dh->read; + + # label the block so that we can use redo in the middle + return CPAN::Distroprefs::Iterator->new(sub { LOOP: { + return unless %$ext_map; + + local $_ = shift @files; + return unless defined; + redo if $_ eq '.' || $_ eq '..'; + + my $possible_ext = join "|", map { quotemeta } keys %$ext_map; + my ($ext) = /\.($possible_ext)$/ or redo; + my $loader = $ext_map->{$ext}; + + my $result = CPAN::Distroprefs::Result->new({ + file => $_, ext => $ext, dir => $dir + }); + # copied from CPAN.pm; is this ever actually possible? + redo unless -f $result->abs; + + my $load_method = $self->_load_method($loader, $result); + my @prefs = eval { $self->$load_method($loader, $result) }; + if (my $err = $@) { + if (ref($err) && eval { $err->isa('CPAN::Distroprefs::Result') }) { + return $err; + } + # rethrow any exceptions that we did not generate + die $err; + } elsif (!@prefs) { + # the loader should have handled this, but just in case: + return $result->as_warning; + } + return $result->as_success({ + prefs => [ + map { CPAN::Distroprefs::Pref->new({ data => $_ }) } @prefs + ], + }); + } }); +} + +package CPAN::Distroprefs::Pref; + +use Carp (); + +sub new { bless $_[1] => $_[0] } + +sub data { shift->{data} } + +sub has_any_match { $_[0]->data->{match} ? 1 : 0 } + +sub has_match { + my $match = $_[0]->data->{match} || return 0; + exists $match->{$_[1]} || exists $match->{"not_$_[1]"} +} + +sub has_valid_subkeys { + grep { exists $_[0]->data->{match}{$_} } + map { $_, "not_$_" } + $_[0]->match_attributes +} + +sub _pattern { + my $re = shift; + my $p = eval sprintf 'qr{%s}', $re; + if ($@) { + $@ =~ s/\n$//; + die "Error in Distroprefs pattern qr{$re}\n$@"; + } + return $p; +} + +sub _match_scalar { + my ($match, $data) = @_; + my $qr = _pattern($match); + return $data =~ /$qr/; +} + +sub _match_hash { + my ($match, $data) = @_; + for my $mkey (keys %$match) { + (my $dkey = $mkey) =~ s/^not_//; + my $val = defined $data->{$dkey} ? $data->{$dkey} : ''; + if (_match_scalar($match->{$mkey}, $val)) { + return 0 if $mkey =~ /^not_/; + } + else { + return 0 if $mkey !~ /^not_/; + } + } + return 1; +} + +sub _match { + my ($self, $key, $data, $matcher) = @_; + my $m = $self->data->{match}; + if (exists $m->{$key}) { + return 0 unless $matcher->($m->{$key}, $data); + } + if (exists $m->{"not_$key"}) { + return 0 if $matcher->($m->{"not_$key"}, $data); + } + return 1; +} + +sub _scalar_match { + my ($self, $key, $data) = @_; + return $self->_match($key, $data, \&_match_scalar); +} + +sub _hash_match { + my ($self, $key, $data) = @_; + return $self->_match($key, $data, \&_match_hash); +} + +# do not take the order of C because "module" is by far the +# slowest +sub match_attributes { qw(env distribution perl perlconfig module) } + +sub match_module { + my ($self, $modules) = @_; + return $self->_match("module", $modules, sub { + my($match, $data) = @_; + my $qr = _pattern($match); + for my $module (@$data) { + return 1 if $module =~ /$qr/; + } + return 0; + }); +} + +sub match_distribution { shift->_scalar_match(distribution => @_) } +sub match_perl { shift->_scalar_match(perl => @_) } + +sub match_perlconfig { shift->_hash_match(perlconfig => @_) } +sub match_env { shift->_hash_match(env => @_) } + +sub matches { + my ($self, $arg) = @_; + + my $default_match = 0; + for my $key (grep { $self->has_match($_) } $self->match_attributes) { + unless (exists $arg->{$key}) { + Carp::croak "Can't match pref: missing argument key $key"; + } + $default_match = 1; + my $val = $arg->{$key}; + # make it possible to avoid computing things until we have to + if (ref($val) eq 'CODE') { $val = $val->() } + my $meth = "match_$key"; + return 0 unless $self->$meth($val); + } + + return $default_match; +} + +1; + +__END__ + +=head1 NAME + +CPAN::Distroprefs -- read and match distroprefs + +=head1 SYNOPSIS + + use CPAN::Distroprefs; + + my %info = (... distribution/environment info ...); + + my $finder = CPAN::Distroprefs->find($prefs_dir, \%ext_map); + + while (my $result = $finder->next) { + + die $result->as_string if $result->is_fatal; + + warn($result->as_string), next if $result->is_warning; + + for my $pref (@{ $result->prefs }) { + if ($pref->matches(\%info)) { + return $pref; + } + } + } + + +=head1 DESCRIPTION + +This module encapsulates reading L and matching them against CPAN distributions. + +=head1 INTERFACE + + my $finder = CPAN::Distroprefs->find($dir, \%ext_map); + + while (my $result = $finder->next) { ... } + +Build an iterator which finds distroprefs files in the given directory. + +C<%ext_map> is a hashref whose keys are file extensions and whose values are +modules used to load matching files: + + { + 'yml' => 'YAML::Syck', + 'dd' => 'Data::Dumper', + ... + } + +Each time C<< $finder->next >> is called, the iterator returns one of two +possible values: + +=over + +=item * a CPAN::Distroprefs::Result object + +=item * C, indicating that no prefs files remain to be found + +=back + +=head1 RESULTS + +L|/INTERFACE> returns CPAN::Distroprefs::Result objects to +indicate success or failure when reading a prefs file. + +=head2 Common + +All results share some common attributes: + +=head3 type + +C, C, or C + +=head3 file + +the file from which these prefs were read, or to which this error refers (relative filename) + +=head3 ext + +the file's extension, which determines how to load it + +=head3 dir + +the directory the file was read from + +=head3 abs + +the absolute path to the file + +=head2 Errors + +Error results (warning and fatal) contain: + +=head3 msg + +the error message (usually either C<$!> or a YAML error) + +=head2 Successes + +Success results contain: + +=head3 prefs + +an arrayref of CPAN::Distroprefs::Pref objects + +=head1 PREFS + +CPAN::Distroprefs::Pref objects represent individual distroprefs documents. +They are constructed automatically as part of C results from C. + +=head3 data + +the pref information as a hashref, suitable for e.g. passing to Kwalify + +=head3 match_attributes + +returns a list of the valid match attributes (see the Distroprefs section in L) + +currently: C + +=head3 has_any_match + +true if this pref has a 'match' attribute at all + +=head3 has_valid_subkeys + +true if this pref has a 'match' attribute and at least one valid match attribute + +=head3 matches + + if ($pref->matches(\%arg)) { ... } + +true if this pref matches the passed-in hashref, which must have a value for +each of the C (above) + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/cpan/CPAN/lib/CPAN/Distrostatus.pm b/cpan/CPAN/lib/CPAN/Distrostatus.pm new file mode 100644 index 0000000000..0cc6cc9a79 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Distrostatus.pm @@ -0,0 +1,45 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Distrostatus; +use overload '""' => "as_string", + fallback => 1; +use vars qw($something_has_failed_at); +use vars qw( + $VERSION +); +$VERSION = "5.5"; + + +sub new { + my($class,$arg) = @_; + my $failed = substr($arg,0,2) eq "NO"; + if ($failed) { + $something_has_failed_at = $CPAN::CurrentCommandId; + } + bless { + TEXT => $arg, + FAILED => $failed, + COMMANDID => $CPAN::CurrentCommandId, + TIME => time, + }, $class; +} +sub something_has_just_failed () { + defined $something_has_failed_at && + $something_has_failed_at == $CPAN::CurrentCommandId; +} +sub commandid { shift->{COMMANDID} } +sub failed { shift->{FAILED} } +sub text { + my($self,$set) = @_; + if (defined $set) { + $self->{TEXT} = $set; + } + $self->{TEXT}; +} +sub as_string { + my($self) = @_; + $self->text; +} + + +1; diff --git a/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm b/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm new file mode 100644 index 0000000000..b928ad74e3 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm @@ -0,0 +1,85 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Exception::RecursiveDependency; +use strict; +use overload '""' => "as_string"; + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +# a module sees its distribution (no version) +# a distribution sees its prereqs (which are module names) (usually with versions) +# a bundle sees its module names and/or its distributions (no version) + +sub new { + my($class) = shift; + my($deps_arg) = shift; + my (@deps,%seen,$loop_starts_with); + DCHAIN: for my $dep (@$deps_arg) { + push @deps, {name => $dep, display_as => $dep}; + if ($seen{$dep}++) { + $loop_starts_with = $dep; + last DCHAIN; + } + } + my $in_loop = 0; + for my $i (0..$#deps) { + my $x = $deps[$i]{name}; + $in_loop ||= $loop_starts_with && $x eq $loop_starts_with; + my $xo = CPAN::Shell->expandany($x) or next; + if ($xo->isa("CPAN::Module")) { + my $have = $xo->inst_version || "N/A"; + my($want,$d,$want_type); + if ($i>0 and $d = $deps[$i-1]{name}) { + my $do = CPAN::Shell->expandany($d); + $want = $do->{prereq_pm}{requires}{$x}; + if (defined $want) { + $want_type = "requires: "; + } else { + $want = $do->{prereq_pm}{build_requires}{$x}; + if (defined $want) { + $want_type = "build_requires: "; + } else { + $want_type = "unknown status"; + $want = "???"; + } + } + } else { + $want = $xo->cpan_version; + $want_type = "want: "; + } + $deps[$i]{have} = $have; + $deps[$i]{want_type} = $want_type; + $deps[$i]{want} = $want; + $deps[$i]{display_as} = "$x (have: $have; $want_type$want)"; + } elsif ($xo->isa("CPAN::Distribution")) { + $deps[$i]{display_as} = $xo->pretty_id; + if ($in_loop) { + $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency"); + } else { + $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency"); + } + $xo->store_persistent_state; # otherwise I will not reach + # all involved parties for + # the next session + } + } + bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class; +} + +sub as_string { + my($self) = shift; + my $deps = $self->{deps}; + my $loop_starts_with = $self->{loop_starts_with}; + unless ($loop_starts_with) { + return "--not a recursive/circular dependency--"; + } + my $ret = "\nRecursive dependency detected:\n "; + $ret .= join("\n => ", map {$_->{display_as}} @$deps); + $ret .= ".\nCannot resolve.\n"; + $ret; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Exception/blocked_urllist.pm b/cpan/CPAN/lib/CPAN/Exception/blocked_urllist.pm new file mode 100644 index 0000000000..102c194e61 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Exception/blocked_urllist.pm @@ -0,0 +1,46 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Exception::blocked_urllist; +use strict; +use overload '""' => "as_string"; + +use vars qw( + $VERSION +); +$VERSION = "1.0"; + + +sub new { + my($class) = @_; + bless {}, $class; +} + +sub as_string { + my($self) = shift; + if ($CPAN::Config->{connect_to_internet_ok}) { + return qq{ + +You have not configured a urllist for CPAN mirrors. Configure it with + + o conf init urllist + +}; + } else { + return qq{ + +You have not configured a urllist and do not allow connections to the +internet to get a list of mirrors. If you wish to get a list of CPAN +mirrors to pick from, use this command + + o conf init connect_to_internet_ok urllist + +If you do not wish to get a list of mirrors and would prefer to set +your urllist manually, use just this command instead + + o conf init urllist + +}; + } +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm b/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm new file mode 100644 index 0000000000..e1259e5397 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm @@ -0,0 +1,73 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Exception::yaml_not_installed; +use strict; +use overload '""' => "as_string"; + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + + +sub new { + my($class,$module,$file,$during) = @_; + bless { module => $module, file => $file, during => $during }, $class; +} + +sub as_string { + my($self) = shift; + "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n"; +} + +package CPAN::Exception::yaml_process_error; +use strict; +use overload '""' => "as_string"; + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + + +sub new { + my($class,$module,$file,$during,$error) = @_; + # my $at = Carp::longmess(""); # XXX find something more beautiful + bless { module => $module, + file => $file, + during => $during, + error => $error, + # at => $at, + }, $class; +} + +sub as_string { + my($self) = shift; + if ($self->{during}) { + if ($self->{file}) { + if ($self->{module}) { + if ($self->{error}) { + return "Alert: While trying to '$self->{during}' YAML file\n". + " '$self->{file}'\n". + "with '$self->{module}' the following error was encountered:\n". + " $self->{error}\n"; + } else { + return "Alert: While trying to '$self->{during}' YAML file\n". + " '$self->{file}'\n". + "with '$self->{module}' some unknown error was encountered\n"; + } + } else { + return "Alert: While trying to '$self->{during}' YAML file\n". + " '$self->{file}'\n". + "some unknown error was encountered\n"; + } + } else { + return "Alert: While trying to '$self->{during}' some YAML file\n". + "some unknown error was encountered\n"; + } + } else { + return "Alert: unknown error encountered\n"; + } +} + +1; diff --git a/cpan/CPAN/lib/CPAN/FTP.pm b/cpan/CPAN/lib/CPAN/FTP.pm new file mode 100644 index 0000000000..fab3d123ef --- /dev/null +++ b/cpan/CPAN/lib/CPAN/FTP.pm @@ -0,0 +1,1090 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::FTP; +use strict; + +use Fcntl qw(:flock); +use File::Basename qw(dirname); +use File::Path qw(mkpath); +use CPAN::FTP::netrc; +use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod); +@CPAN::FTP::ISA = qw(CPAN::Debug); + +use vars qw( + $VERSION +); +$VERSION = "5.5001"; + +#-> sub CPAN::FTP::ftp_statistics +# if they want to rewrite, they need to pass in a filehandle +sub _ftp_statistics { + my($self,$fh) = @_; + my $locktype = $fh ? LOCK_EX : LOCK_SH; + $fh ||= FileHandle->new; + my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml"); + mkpath dirname $file; + open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!"); + my $sleep = 1; + my $waitstart; + while (!CPAN::_flock($fh, $locktype|LOCK_NB)) { + $waitstart ||= localtime(); + if ($sleep>3) { + $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n"); + } + $CPAN::Frontend->mysleep($sleep); + if ($sleep <= 3) { + $sleep+=0.33; + } elsif ($sleep <=6) { + $sleep+=0.11; + } + } + my $stats = eval { CPAN->_yaml_loadfile($file); }; + if ($@) { + if (ref $@) { + if (ref $@ eq "CPAN::Exception::yaml_not_installed") { + $CPAN::Frontend->myprint("Warning (usually harmless): $@"); + return; + } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") { + $CPAN::Frontend->mydie($@); + } + } else { + $CPAN::Frontend->mydie($@); + } + } + return $stats->[0]; +} + +#-> sub CPAN::FTP::_mytime +sub _mytime () { + if (CPAN->has_inst("Time::HiRes")) { + return Time::HiRes::time(); + } else { + return time; + } +} + +#-> sub CPAN::FTP::_new_stats +sub _new_stats { + my($self,$file) = @_; + my $ret = { + file => $file, + attempts => [], + start => _mytime, + }; + $ret; +} + +#-> sub CPAN::FTP::_add_to_statistics +sub _add_to_statistics { + my($self,$stats) = @_; + my $yaml_module = CPAN::_yaml_module(); + $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG; + if ($CPAN::META->has_inst($yaml_module)) { + $stats->{thesiteurl} = $ThesiteURL; + $stats->{end} = CPAN::FTP::_mytime(); + my $fh = FileHandle->new; + my $time = time; + my $sdebug = 0; + my @debug; + @debug = $time if $sdebug; + my $fullstats = $self->_ftp_statistics($fh); + close $fh; + $fullstats->{history} ||= []; + push @debug, scalar @{$fullstats->{history}} if $sdebug; + push @debug, time if $sdebug; + push @{$fullstats->{history}}, $stats; + # YAML.pm 0.62 is unacceptably slow with 999; + # YAML::Syck 0.82 has no noticable performance problem with 999; + my $ftpstats_size = $CPAN::Config->{ftpstats_size} || 99; + my $ftpstats_period = $CPAN::Config->{ftpstats_period} || 14; + while ( + @{$fullstats->{history}} > $ftpstats_size + || $time - $fullstats->{history}[0]{start} > 86400*$ftpstats_period + ) { + shift @{$fullstats->{history}} + } + push @debug, scalar @{$fullstats->{history}} if $sdebug; + push @debug, time if $sdebug; + push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug; + # need no eval because if this fails, it is serious + my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml"); + CPAN->_yaml_dumpfile("$sfile.$$",$fullstats); + if ( $sdebug ) { + local $CPAN::DEBUG = 512; # FTP + push @debug, time; + CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]". + "after[%d]at[%d]oldest[%s]dumped backat[%d]", + @debug, + )); + } + # Win32 cannot rename a file to an existing filename + unlink($sfile) if ($^O eq 'MSWin32'); + _copy_stat($sfile, "$sfile.$$") if -e $sfile; + rename "$sfile.$$", $sfile + or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n"); + } +} + +# Copy some stat information (owner, group, mode and) from one file to +# another. +# This is a utility function which might be moved to a utility repository. +#-> sub CPAN::FTP::_copy_stat +sub _copy_stat { + my($src, $dest) = @_; + my @stat = stat($src); + if (!@stat) { + $CPAN::Frontend->mywarn("Can't stat '$src': $!\n"); + return; + } + + eval { + chmod $stat[2], $dest + or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n"); + }; + warn $@ if $@; + eval { + chown $stat[4], $stat[5], $dest + or do { + my $save_err = $!; # otherwise it's lost in the get... calls + $CPAN::Frontend->mywarn("Can't chown '$dest' to " . + (getpwuid($stat[4]))[0] . "/" . + (getgrgid($stat[5]))[0] . ": $save_err\n" + ); + }; + }; + warn $@ if $@; +} + +# if file is CHECKSUMS, suggest the place where we got the file to be +# checked from, maybe only for young files? +#-> sub CPAN::FTP::_recommend_url_for +sub _recommend_url_for { + my($self, $file) = @_; + my $urllist = $self->_get_urllist; + if ($file =~ s|/CHECKSUMS(.gz)?$||) { + my $fullstats = $self->_ftp_statistics(); + my $history = $fullstats->{history} || []; + while (my $last = pop @$history) { + last if $last->{end} - time > 3600; # only young results are interesting + next unless $last->{file}; # dirname of nothing dies! + next unless $file eq dirname($last->{file}); + return $last->{thesiteurl}; + } + } + if ($CPAN::Config->{randomize_urllist} + && + rand(1) < $CPAN::Config->{randomize_urllist} + ) { + $urllist->[int rand scalar @$urllist]; + } else { + return (); + } +} + +#-> sub CPAN::FTP::_get_urllist +sub _get_urllist { + my($self) = @_; + $CPAN::Config->{urllist} ||= []; + unless (ref $CPAN::Config->{urllist} eq 'ARRAY') { + $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n"); + $CPAN::Config->{urllist} = []; + } + my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}}; + for my $u (@urllist) { + CPAN->debug("u[$u]") if $CPAN::DEBUG; + if (UNIVERSAL::can($u,"text")) { + $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/"; + } else { + $u .= "/" unless substr($u,-1) eq "/"; + $u = CPAN::URL->new(TEXT => $u, FROM => "USER"); + } + } + \@urllist; +} + +#-> sub CPAN::FTP::ftp_get ; +sub ftp_get { + my($class,$host,$dir,$file,$target) = @_; + $class->debug( + qq[Going to fetch file [$file] from dir [$dir] + on host [$host] as local [$target]\n] + ) if $CPAN::DEBUG; + my $ftp = Net::FTP->new($host); + unless ($ftp) { + $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n"); + return; + } + return 0 unless defined $ftp; + $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; + $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]); + unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) { + my $msg = $ftp->message; + $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg"); + return; + } + unless ( $ftp->cwd($dir) ) { + my $msg = $ftp->message; + $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg"); + return; + } + $ftp->binary; + $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG; + unless ( $ftp->get($file,$target) ) { + my $msg = $ftp->message; + $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg"); + return; + } + $ftp->quit; # it's ok if this fails + return 1; +} + +# If more accuracy is wanted/needed, Chris Leach sent me this patch... + + # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997 + # > --- /tmp/cp Wed Sep 24 13:26:40 1997 + # > *************** + # > *** 1562,1567 **** + # > --- 1562,1580 ---- + # > return 1 if substr($url,0,4) eq "file"; + # > return 1 unless $url =~ m|://([^/]+)|; + # > my $host = $1; + # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; + # > + if ($proxy) { + # > + $proxy =~ m|://([^/:]+)|; + # > + $proxy = $1; + # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'}; + # > + if ($noproxy) { + # > + if ($host !~ /$noproxy$/) { + # > + $host = $proxy; + # > + } + # > + } else { + # > + $host = $proxy; + # > + } + # > + } + # > require Net::Ping; + # > return 1 unless $Net::Ping::VERSION >= 2; + # > my $p; + + +#-> sub CPAN::FTP::localize ; +sub localize { + my($self,$file,$aslocal,$force) = @_; + $force ||= 0; + Carp::croak( "Usage: ->localize(cpan_file,as_local_file[,$force])" ) + unless defined $aslocal; + if ($CPAN::DEBUG){ + require Carp; + my $longmess = Carp::longmess(); + $self->debug("file[$file] aslocal[$aslocal] force[$force] carplongmess[$longmess]"); + } + if ($^O eq 'MacOS') { + # Comment by AK on 2000-09-03: Uniq short filenames would be + # available in CHECKSUMS file + my($name, $path) = File::Basename::fileparse($aslocal, ''); + if (length($name) > 31) { + $name =~ s/( + \.( + readme(\.(gz|Z))? | + (tar\.)?(gz|Z) | + tgz | + zip | + pm\.(gz|Z) + ) + )$//x; + my $suf = $1; + my $size = 31 - length($suf); + while (length($name) > $size) { + chop $name; + } + $name .= $suf; + $aslocal = File::Spec->catfile($path, $name); + } + } + + if (-f $aslocal && -r _ && !($force & 1)) { + my $size; + if ($size = -s $aslocal) { + $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG; + return $aslocal; + } else { + # empty file from a previous unsuccessful attempt to download it + unlink $aslocal or + $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ". + "could not remove."); + } + } + my($maybe_restore) = 0; + if (-f $aslocal) { + rename $aslocal, "$aslocal.bak$$"; + $maybe_restore++; + } + + my($aslocal_dir) = dirname($aslocal); + # Inheritance is not easier to manage than a few if/else branches + if ($CPAN::META->has_usable('LWP::UserAgent')) { + unless ($Ua) { + CPAN::LWP::UserAgent->config; + eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough? + if ($@) { + $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n") + if $CPAN::DEBUG; + } else { + my($var); + $Ua->proxy('ftp', $var) + if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy}; + $Ua->proxy('http', $var) + if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy}; + $Ua->no_proxy($var) + if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy}; + } + } + } + for my $prx (qw(ftp_proxy http_proxy no_proxy)) { + $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx}; + } + + # Try the list of urls for each single object. We keep a record + # where we did get a file from + my(@reordered,$last); + my $ccurllist = $self->_get_urllist; + $last = $#$ccurllist; + if ($force & 2) { # local cpans probably out of date, don't reorder + @reordered = (0..$last); + } else { + @reordered = + sort { + (substr($ccurllist->[$b],0,4) eq "file") + <=> + (substr($ccurllist->[$a],0,4) eq "file") + or + defined($ThesiteURL) + and + ($ccurllist->[$b] eq $ThesiteURL) + <=> + ($ccurllist->[$a] eq $ThesiteURL) + } 0..$last; + } + my(@levels); + $Themethod ||= ""; + $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG; + my @all_levels = ( + ["dleasy", "file"], + ["dleasy"], + ["dlhard"], + ["dlhardest"], + ["dleasy", "http","defaultsites"], + ["dlhard", "http","defaultsites"], + ["dleasy", "ftp", "defaultsites"], + ["dlhard", "ftp", "defaultsites"], + ["dlhardest","", "defaultsites"], + ); + if ($Themethod) { + @levels = grep {$_->[0] eq $Themethod} @all_levels; + push @levels, grep {$_->[0] ne $Themethod} @all_levels; + } else { + @levels = @all_levels; + } + @levels = qw/dleasy/ if $^O eq 'MacOS'; + my($levelno); + local $ENV{FTP_PASSIVE} = + exists $CPAN::Config->{ftp_passive} ? + $CPAN::Config->{ftp_passive} : 1; + my $ret; + my $stats = $self->_new_stats($file); + for ($CPAN::Config->{connect_to_internet_ok}) { + $connect_to_internet_ok = $_ if not defined $connect_to_internet_ok and defined $_; + } + LEVEL: for $levelno (0..$#levels) { + my $level_tuple = $levels[$levelno]; + my($level,$scheme,$sitetag) = @$level_tuple; + $self->mymkpath($aslocal_dir) unless $scheme && "file" eq $scheme; + my $defaultsites = $sitetag && $sitetag eq "defaultsites"; + my @urllist; + if ($defaultsites) { + unless (defined $connect_to_internet_ok) { + $CPAN::Frontend->myprint(sprintf qq{ +I would like to connect to one of the following sites to get '%s': + +%s +}, + $file, + join("",map { " ".$_->text."\n" } @CPAN::Defaultsites), + ); + my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes"); + if ($answer =~ /^y/i) { + $connect_to_internet_ok = 1; + } else { + $connect_to_internet_ok = 0; + } + } + if ($connect_to_internet_ok) { + @urllist = @CPAN::Defaultsites; + } else { + my $sleep = 2; + # the tricky thing about dying here is that everybody + # believes that calls to exists() or all_objects() are + # safe. + require CPAN::Exception::blocked_urllist; + die CPAN::Exception::blocked_urllist->new; + } + } else { + my @host_seq = $level =~ /dleasy/ ? + @reordered : 0..$last; # reordered has file and $Thesiteurl first + @urllist = map { $ccurllist->[$_] } @host_seq; + } + $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG; + my $aslocal_tempfile = $aslocal . ".tmp" . $$; + if (my $recommend = $self->_recommend_url_for($file)) { + @urllist = grep { $_ ne $recommend } @urllist; + unshift @urllist, $recommend; + } + $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG; + $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats); + if ($ret) { + CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG; + if ($ret eq $aslocal_tempfile) { + # if we got it exactly as we asked for, only then we + # want to rename + rename $aslocal_tempfile, $aslocal + or $CPAN::Frontend->mydie("Error while trying to rename ". + "'$ret' to '$aslocal': $!"); + $ret = $aslocal; + } + $Themethod = $level; + my $now = time; + # utime $now, $now, $aslocal; # too bad, if we do that, we + # might alter a local mirror + $self->debug("level[$level]") if $CPAN::DEBUG; + last LEVEL; + } else { + unlink $aslocal_tempfile; + last if $CPAN::Signal; # need to cleanup + } + } + if ($ret) { + $stats->{filesize} = -s $ret; + } + $self->debug("before _add_to_statistics") if $CPAN::DEBUG; + $self->_add_to_statistics($stats); + $self->debug("after _add_to_statistics") if $CPAN::DEBUG; + if ($ret) { + unlink "$aslocal.bak$$"; + return $ret; + } + unless ($CPAN::Signal) { + my(@mess); + local $" = " "; + if (@{$CPAN::Config->{urllist}}) { + push @mess, + qq{Please check, if the URLs I found in your configuration file \(}. + join(", ", @{$CPAN::Config->{urllist}}). + qq{\) are valid.}; + } else { + push @mess, qq{Your urllist is empty!}; + } + push @mess, qq{The urllist can be edited.}, + qq{E.g. with 'o conf urllist push ftp://myurl/'}; + $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n"); + $CPAN::Frontend->mydie("Could not fetch $file\n"); + } + if ($maybe_restore) { + rename "$aslocal.bak$$", $aslocal; + $CPAN::Frontend->myprint("Trying to get away with old file:\n" . + $self->ls($aslocal)); + return $aslocal; + } + return; +} + +sub mymkpath { + my($self, $aslocal_dir) = @_; + mkpath($aslocal_dir); + $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }. + qq{directory "$aslocal_dir". + I\'ll continue, but if you encounter problems, they may be due + to insufficient permissions.\n}) unless -w $aslocal_dir; +} + +sub hostdlxxx { + my $self = shift; + my $level = shift; + my $scheme = shift; + my $h = shift; + $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme; + my $method = "host$level"; + $self->$method($h, @_); +} + +sub _set_attempt { + my($self,$stats,$method,$url) = @_; + push @{$stats->{attempts}}, { + method => $method, + start => _mytime, + url => $url, + }; +} + +# package CPAN::FTP; +sub hostdleasy { #called from hostdlxxx + my($self,$host_seq,$file,$aslocal,$stats) = @_; + my($ro_url); + HOSTEASY: for $ro_url (@$host_seq) { + $self->_set_attempt($stats,"dleasy",$ro_url); + my $url .= "$ro_url$file"; + $self->debug("localizing perlish[$url]") if $CPAN::DEBUG; + if ($url =~ /^file:/) { + my $l; + if ($CPAN::META->has_inst('URI::URL')) { + my $u = URI::URL->new($url); + $l = $u->path; + } else { # works only on Unix, is poorly constructed, but + # hopefully better than nothing. + # RFC 1738 says fileurl BNF is + # fileurl = "file://" [ host | "localhost" ] "/" fpath + # Thanks to "Mark D. Baushke" for + # the code + ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part + $l =~ s|^file:||; # assume they + # meant + # file://localhost + $l =~ s|^/||s + if ! -f $l && $l =~ m|^/\w:|; # e.g. /P: + } + $self->debug("local file[$l]") if $CPAN::DEBUG; + if ( -f $l && -r _) { + $ThesiteURL = $ro_url; + return $l; + } + if ($l =~ /(.+)\.gz$/) { + my $ungz = $1; + if ( -f $ungz && -r _) { + $ThesiteURL = $ro_url; + return $ungz; + } + } + # Maybe mirror has compressed it? + if (-f "$l.gz") { + $self->debug("found compressed $l.gz") if $CPAN::DEBUG; + eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) }; + if ( -f $aslocal) { + $ThesiteURL = $ro_url; + return $aslocal; + } + } + $CPAN::Frontend->mywarn("Could not find '$l'\n"); + } + $self->debug("it was not a file URL") if $CPAN::DEBUG; + if ($CPAN::META->has_usable('LWP')) { + $CPAN::Frontend->myprint("Fetching with LWP: + $url +"); + unless ($Ua) { + CPAN::LWP::UserAgent->config; + eval { $Ua = CPAN::LWP::UserAgent->new; }; + if ($@) { + $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n"); + } + } + my $res = $Ua->mirror($url, $aslocal); + if ($res->is_success) { + $ThesiteURL = $ro_url; + my $now = time; + utime $now, $now, $aslocal; # download time is more + # important than upload + # time + return $aslocal; + } elsif ($url !~ /\.gz(?!\n)\Z/) { + my $gzurl = "$url.gz"; + $CPAN::Frontend->myprint("Fetching with LWP: + $gzurl +"); + $res = $Ua->mirror($gzurl, "$aslocal.gz"); + if ($res->is_success) { + if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) { + $ThesiteURL = $ro_url; + return $aslocal; + } + } + } else { + $CPAN::Frontend->myprint(sprintf( + "LWP failed with code[%s] message[%s]\n", + $res->code, + $res->message, + )); + # Alan Burlison informed me that in firewall environments + # Net::FTP can still succeed where LWP fails. So we do not + # skip Net::FTP anymore when LWP is available. + } + } else { + $CPAN::Frontend->mywarn(" LWP not available\n"); + } + return if $CPAN::Signal; + if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { + # that's the nice and easy way thanks to Graham + $self->debug("recognized ftp") if $CPAN::DEBUG; + my($host,$dir,$getfile) = ($1,$2,$3); + if ($CPAN::META->has_usable('Net::FTP')) { + $dir =~ s|/+|/|g; + $CPAN::Frontend->myprint("Fetching with Net::FTP: + $url +"); + $self->debug("getfile[$getfile]dir[$dir]host[$host]" . + "aslocal[$aslocal]") if $CPAN::DEBUG; + if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) { + $ThesiteURL = $ro_url; + return $aslocal; + } + if ($aslocal !~ /\.gz(?!\n)\Z/) { + my $gz = "$aslocal.gz"; + $CPAN::Frontend->myprint("Fetching with Net::FTP + $url.gz +"); + if (CPAN::FTP->ftp_get($host, + $dir, + "$getfile.gz", + $gz) && + eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)} + ) { + $ThesiteURL = $ro_url; + return $aslocal; + } + } + # next HOSTEASY; + } else { + CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG; + } + } + if ( + UNIVERSAL::can($ro_url,"text") + and + $ro_url->{FROM} eq "USER" + ) { + ##address #17973: default URLs should not try to override + ##user-defined URLs just because LWP is not available + my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats); + return $ret if $ret; + } + return if $CPAN::Signal; + } +} + +# package CPAN::FTP; +sub hostdlhard { + my($self,$host_seq,$file,$aslocal,$stats) = @_; + + # Came back if Net::FTP couldn't establish connection (or + # failed otherwise) Maybe they are behind a firewall, but they + # gave us a socksified (or other) ftp program... + + my($ro_url); + my($devnull) = $CPAN::Config->{devnull} || ""; + # < /dev/null "; + my($aslocal_dir) = dirname($aslocal); + mkpath($aslocal_dir); + my $some_dl_success = 0; + HOSTHARD: for $ro_url (@$host_seq) { + $self->_set_attempt($stats,"dlhard",$ro_url); + my $url = "$ro_url$file"; + my($proto,$host,$dir,$getfile); + + # Courtesy Mark Conty mark_conty@cargill.com change from + # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { + # to + if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) { + # proto not yet used + ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4); + } else { + next HOSTHARD; # who said, we could ftp anything except ftp? + } + next HOSTHARD if $proto eq "file"; # file URLs would have had + # success above. Likely a bogus URL + + $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG; + + # Try the most capable first and leave ncftp* for last as it only + # does FTP. + my $proxy_vars = $self->_proxy_vars($ro_url); + DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) { + my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f}); + next DLPRG unless defined $funkyftp; + next DLPRG if $funkyftp =~ /^\s*$/; + + my($asl_ungz, $asl_gz); + ($asl_ungz = $aslocal) =~ s/\.gz//; + $asl_gz = "$asl_ungz.gz"; + + my($src_switch) = ""; + my($chdir) = ""; + my($stdout_redir) = " > $asl_ungz"; + if ($f eq "lynx") { + $src_switch = " -source"; + } elsif ($f eq "ncftp") { + $src_switch = " -c"; + } elsif ($f eq "wget") { + $src_switch = " -O $asl_ungz"; + $stdout_redir = ""; + } elsif ($f eq 'curl') { + $src_switch = ' -L -f -s -S --netrc-optional'; + if ($proxy_vars->{http_proxy}) { + $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"}; + } + } + + if ($f eq "ncftpget") { + $chdir = "cd $aslocal_dir && "; + $stdout_redir = ""; + } + $CPAN::Frontend->myprint( + qq[ +Trying with "$funkyftp$src_switch" to get + "$url" +]); + my($system) = + "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir"; + $self->debug("system[$system]") if $CPAN::DEBUG; + my($wstatus) = system($system); + if ($f eq "lynx") { + # lynx returns 0 when it fails somewhere + if (-s $asl_ungz) { + my $content = do { local *FH; + open FH, $asl_ungz or die; + local $/; + }; + if ($content =~ /^<.*([45]|Error [45])/si) { + $CPAN::Frontend->mywarn(qq{ +No success, the file that lynx has downloaded looks like an error message: +$content +}); + $CPAN::Frontend->mysleep(1); + next DLPRG; + } + $some_dl_success++; + } else { + $CPAN::Frontend->myprint(qq{ +No success, the file that lynx has downloaded is an empty file. +}); + next DLPRG; + } + } + if ($wstatus == 0) { + if (-s $aslocal) { + # Looks good + $some_dl_success++; + } elsif ($asl_ungz ne $aslocal) { + # test gzip integrity + if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) { + # e.g. foo.tar is gzipped --> foo.tar.gz + rename $asl_ungz, $aslocal; + $some_dl_success++; + } else { + eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)}; + if ($@) { + warn "Warning: $@"; + } else { + $some_dl_success++; + } + } + } + $ThesiteURL = $ro_url; + return $aslocal; + } elsif ($url !~ /\.gz(?!\n)\Z/) { + unlink $asl_ungz if + -f $asl_ungz && -s _ == 0; + my $gz = "$aslocal.gz"; + my $gzurl = "$url.gz"; + $CPAN::Frontend->myprint( + qq[ + Trying with "$funkyftp$src_switch" to get + "$url.gz" + ]); + my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz"; + $self->debug("system[$system]") if $CPAN::DEBUG; + my($wstatus); + if (($wstatus = system($system)) == 0 + && + -s $asl_gz + ) { + # test gzip integrity + my $ct = eval{CPAN::Tarzip->new($asl_gz)}; + if ($ct && $ct->gtest) { + $ct->gunzip($aslocal); + } else { + # somebody uncompressed file for us? + rename $asl_ungz, $aslocal; + } + $ThesiteURL = $ro_url; + return $aslocal; + } else { + unlink $asl_gz if -f $asl_gz; + } + } else { + my $estatus = $wstatus >> 8; + my $size = -f $aslocal ? + ", left\n$aslocal with size ".-s _ : + "\nWarning: expected file [$aslocal] doesn't exist"; + $CPAN::Frontend->myprint(qq{ + Function system("$system") + returned status $estatus (wstat $wstatus)$size + }); + } + return if $CPAN::Signal; + } # download/transfer programs (DLPRG) + } # host + require Carp; + if ($some_dl_success) { + Carp::carp("Warning: doesn't seem we had substantial success downloading '$aslocal'. Don't know how to proceed."); + } else { + Carp::carp("Warning: no success downloading '$aslocal'. Giving up on it."); + } + $CPAN::Frontend->mysleep(5); + return; +} + +#-> CPAN::FTP::_proxy_vars +sub _proxy_vars { + my($self,$url) = @_; + my $ret = +{}; + my $http_proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; + if ($http_proxy) { + my($host) = $url =~ m|://([^/:]+)|; + my $want_proxy = 1; + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'} || ""; + my @noproxy = split /\s*,\s*/, $noproxy; + if ($host) { + DOMAIN: for my $domain (@noproxy) { + if ($host =~ /\Q$domain\E$/) { # cf. LWP::UserAgent + $want_proxy = 0; + last DOMAIN; + } + } + } else { + $CPAN::Frontend->mywarn(" Could not determine host from http_proxy '$http_proxy'\n"); + } + if ($want_proxy) { + my($user, $pass) = + &CPAN::LWP::UserAgent::get_proxy_credentials(); + $ret = { + proxy_user => $user, + proxy_pass => $pass, + http_proxy => $http_proxy + }; + } + } + return $ret; +} + +# package CPAN::FTP; +sub hostdlhardest { + my($self,$host_seq,$file,$aslocal,$stats) = @_; + + return unless @$host_seq; + my($ro_url); + my($aslocal_dir) = dirname($aslocal); + mkpath($aslocal_dir); + my $ftpbin = $CPAN::Config->{ftp}; + unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) { + $CPAN::Frontend->myprint("No external ftp command available\n\n"); + return; + } + $CPAN::Frontend->mywarn(qq{ +As a last resort we now switch to the external ftp command '$ftpbin' +to get '$aslocal'. + +Doing so often leads to problems that are hard to diagnose. + +If you're the victim of such problems, please consider unsetting the +ftp config variable with + + o conf ftp "" + o conf commit + +}); + $CPAN::Frontend->mysleep(2); + HOSTHARDEST: for $ro_url (@$host_seq) { + $self->_set_attempt($stats,"dlhardest",$ro_url); + my $url = "$ro_url$file"; + $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG; + unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { + next; + } + my($host,$dir,$getfile) = ($1,$2,$3); + my $timestamp = 0; + my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, + $ctime,$blksize,$blocks) = stat($aslocal); + $timestamp = $mtime ||= 0; + my($netrc) = CPAN::FTP::netrc->new; + my($netrcfile) = $netrc->netrc; + my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : ""; + my $targetfile = File::Basename::basename($aslocal); + my(@dialog); + push( + @dialog, + "lcd $aslocal_dir", + "cd /", + map("cd $_", split /\//, $dir), # RFC 1738 + "bin", + "get $getfile $targetfile", + "quit" + ); + if (! $netrcfile) { + CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG; + } elsif ($netrc->hasdefault || $netrc->contains($host)) { + CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]", + $netrc->hasdefault, + $netrc->contains($host))) if $CPAN::DEBUG; + if ($netrc->protected) { + my $dialog = join "", map { " $_\n" } @dialog; + my $netrc_explain; + if ($netrc->contains($host)) { + $netrc_explain = "Relying that your .netrc entry for '$host' ". + "manages the login"; + } else { + $netrc_explain = "Relying that your default .netrc entry ". + "manages the login"; + } + $CPAN::Frontend->myprint(qq{ + Trying with external ftp to get + '$url' + $netrc_explain + Going to send the dialog +$dialog +} + ); + $self->talk_ftp("$ftpbin$verbose $host", + @dialog); + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal); + $mtime ||= 0; + if ($mtime > $timestamp) { + $CPAN::Frontend->myprint("GOT $aslocal\n"); + $ThesiteURL = $ro_url; + return $aslocal; + } else { + $CPAN::Frontend->myprint("Hmm... Still failed!\n"); + } + return if $CPAN::Signal; + } else { + $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }. + qq{correctly protected.\n}); + } + } else { + $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host + nor does it have a default entry\n"); + } + + # OK, they don't have a valid ~/.netrc. Use 'ftp -n' + # then and login manually to host, using e-mail as + # password. + $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n}); + unshift( + @dialog, + "open $host", + "user anonymous $Config::Config{'cf_email'}" + ); + my $dialog = join "", map { " $_\n" } @dialog; + $CPAN::Frontend->myprint(qq{ + Trying with external ftp to get + $url + Going to send the dialog +$dialog +} + ); + $self->talk_ftp("$ftpbin$verbose -n", @dialog); + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal); + $mtime ||= 0; + if ($mtime > $timestamp) { + $CPAN::Frontend->myprint("GOT $aslocal\n"); + $ThesiteURL = $ro_url; + return $aslocal; + } else { + $CPAN::Frontend->myprint("Bad luck... Still failed!\n"); + } + return if $CPAN::Signal; + $CPAN::Frontend->mywarn("Can't access URL $url.\n\n"); + $CPAN::Frontend->mysleep(2); + } # host +} + +# package CPAN::FTP; +sub talk_ftp { + my($self,$command,@dialog) = @_; + my $fh = FileHandle->new; + $fh->open("|$command") or die "Couldn't open ftp: $!"; + foreach (@dialog) { $fh->print("$_\n") } + $fh->close; # Wait for process to complete + my $wstatus = $?; + my $estatus = $wstatus >> 8; + $CPAN::Frontend->myprint(qq{ +Subprocess "|$command" + returned status $estatus (wstat $wstatus) +}) if $wstatus; +} + +# find2perl needs modularization, too, all the following is stolen +# from there +# CPAN::FTP::ls +sub ls { + my($self,$name) = @_; + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm, + $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name); + + my($perms,%user,%group); + my $pname = $name; + + if ($blocks) { + $blocks = int(($blocks + 1) / 2); + } + else { + $blocks = int(($sizemm + 1023) / 1024); + } + + if (-f _) { $perms = '-'; } + elsif (-d _) { $perms = 'd'; } + elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; } + elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; } + elsif (-p _) { $perms = 'p'; } + elsif (-S _) { $perms = 's'; } + else { $perms = 'l'; $pname .= ' -> ' . readlink($_); } + + my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx'); + my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + my $tmpmode = $mode; + my $tmp = $rwx[$tmpmode & 7]; + $tmpmode >>= 3; + $tmp = $rwx[$tmpmode & 7] . $tmp; + $tmpmode >>= 3; + $tmp = $rwx[$tmpmode & 7] . $tmp; + substr($tmp,2,1) =~ tr/-x/Ss/ if -u _; + substr($tmp,5,1) =~ tr/-x/Ss/ if -g _; + substr($tmp,8,1) =~ tr/-x/Tt/ if -k _; + $perms .= $tmp; + + my $user = $user{$uid} || $uid; # too lazy to implement lookup + my $group = $group{$gid} || $gid; + + my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime); + my($timeyear); + my($moname) = $moname[$mon]; + if (-M _ > 365.25 / 2) { + $timeyear = $year + 1900; + } + else { + $timeyear = sprintf("%02d:%02d", $hour, $min); + } + + sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n", + $ino, + $blocks, + $perms, + $nlink, + $user, + $group, + $sizemm, + $moname, + $mday, + $timeyear, + $pname; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/FTP/netrc.pm b/cpan/CPAN/lib/CPAN/FTP/netrc.pm new file mode 100644 index 0000000000..c05405e7ef --- /dev/null +++ b/cpan/CPAN/lib/CPAN/FTP/netrc.pm @@ -0,0 +1,63 @@ +package CPAN::FTP::netrc; +use strict; + +$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00"; + +# package CPAN::FTP::netrc; +sub new { + my($class) = @_; + my $home = CPAN::HandleConfig::home(); + my $file = File::Spec->catfile($home,".netrc"); + + my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) + = stat($file); + $mode ||= 0; + my $protected = 0; + + my($fh,@machines,$hasdefault); + $hasdefault = 0; + $fh = FileHandle->new or die "Could not create a filehandle"; + + if($fh->open($file)) { + $protected = ($mode & 077) == 0; + local($/) = ""; + NETRC: while (<$fh>) { + my(@tokens) = split " ", $_; + TOKEN: while (@tokens) { + my($t) = shift @tokens; + if ($t eq "default") { + $hasdefault++; + last NETRC; + } + last TOKEN if $t eq "macdef"; + if ($t eq "machine") { + push @machines, shift @tokens; + } + } + } + } else { + $file = $hasdefault = $protected = ""; + } + + bless { + 'mach' => [@machines], + 'netrc' => $file, + 'hasdefault' => $hasdefault, + 'protected' => $protected, + }, $class; +} + +# CPAN::FTP::netrc::hasdefault; +sub hasdefault { shift->{'hasdefault'} } +sub netrc { shift->{'netrc'} } +sub protected { shift->{'protected'} } +sub contains { + my($self,$mach) = @_; + for ( @{$self->{'mach'}} ) { + return 1 if $_ eq $mach; + } + return 0; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm new file mode 100644 index 0000000000..50bebc349a --- /dev/null +++ b/cpan/CPAN/lib/CPAN/FirstTime.pm @@ -0,0 +1,1738 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +package CPAN::Mirrored::By; +use strict; + +sub new { + my($self,@arg) = @_; + bless [@arg], $self; +} +sub continent { shift->[0] } +sub country { shift->[1] } +sub url { shift->[2] } + +package CPAN::FirstTime; +use strict; + +use ExtUtils::MakeMaker (); +use FileHandle (); +use File::Basename (); +use File::Path (); +use File::Spec (); +use vars qw($VERSION $urllist); +$VERSION = "5.53"; + +=head1 NAME + +CPAN::FirstTime - Utility for CPAN::Config file Initialization + +=head1 SYNOPSIS + +CPAN::FirstTime::init() + +=head1 DESCRIPTION + +The init routine asks a few questions and writes a CPAN/Config.pm or +CPAN/MyConfig.pm file (depending on what it is currently using). + +In the following all questions and explanations regarding config +variables are collected. + +=cut + +# down until the next =back the manpage must be parsed by the program +# because the text is used in the init dialogues. + +my @podpara = split /\n\n/, <<'=back'; + +=over 2 + +=item auto_commit + +Normally CPAN.pm keeps config variables in memory and changes need to +be saved in a separate 'o conf commit' command to make them permanent +between sessions. If you set the 'auto_commit' option to true, changes +to a config variable are always automatically committed to disk. + +Always commit changes to config variables to disk? + +=item build_cache + +CPAN.pm can limit the size of the disk area for keeping the build +directories with all the intermediate files. + +Cache size for build directory (in MB)? + +=item build_dir + +Directory where the build process takes place? + +=item build_dir_reuse + +Until version 1.88 CPAN.pm never trusted the contents of the build_dir +directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based +mechanism that makes it possible to share the contents of the +build_dir/ directory between different sessions with the same version +of perl. People who prefer to test things several days before +installing will like this feature because it safes a lot of time. + +If you say yes to the following question, CPAN will try to store +enough information about the build process so that it can pick up in +future sessions at the same state of affairs as it left a previous +session. + +Store and re-use state information about distributions between +CPAN.pm sessions? + +=item build_requires_install_policy + +When a module declares another one as a 'build_requires' prerequisite +this means that the other module is only needed for building or +testing the module but need not be installed permanently. In this case +you may wish to install that other module nonetheless or just keep it +in the 'build_dir' directory to have it available only temporarily. +Installing saves time on future installations but makes the perl +installation bigger. + +You can choose if you want to always install (yes), never install (no) +or be always asked. In the latter case you can set the default answer +for the question to yes (ask/yes) or no (ask/no). + +Policy on installing 'build_requires' modules (yes, no, ask/yes, +ask/no)? + +=item cache_metadata + +To considerably speed up the initial CPAN shell startup, it is +possible to use Storable to create a cache of metadata. If Storable is +not available, the normal index mechanism will be used. + +Note: this mechanism is not used when use_sqlite is on and SQLLite is +running. + +Cache metadata (yes/no)? + +=item check_sigs + +CPAN packages can be digitally signed by authors and thus verified +with the security provided by strong cryptography. The exact mechanism +is defined in the Module::Signature module. While this is generally +considered a good thing, it is not always convenient to the end user +to install modules that are signed incorrectly or where the key of the +author is not available or where some prerequisite for +Module::Signature has a bug and so on. + +With the check_sigs parameter you can turn signature checking on and +off. The default is off for now because the whole tool chain for the +functionality is not yet considered mature by some. The author of +CPAN.pm would recommend setting it to true most of the time and +turning it off only if it turns out to be annoying. + +Note that if you do not have Module::Signature installed, no signature +checks will be performed at all. + +Always try to check and verify signatures if a SIGNATURE file is in +the package and Module::Signature is installed (yes/no)? + +=item colorize_output + +When you have Term::ANSIColor installed, you can turn on colorized +output to have some visual differences between normal CPAN.pm output, +warnings, debugging output, and the output of the modules being +installed. Set your favorite colors after some experimenting with the +Term::ANSIColor module. + +Do you want to turn on colored output? + +=item colorize_print + +Color for normal output? + +=item colorize_warn + +Color for warnings? + +=item colorize_debug + +Color for debugging messages? + +=item commandnumber_in_prompt + +The prompt of the cpan shell can contain the current command number +for easier tracking of the session or be a plain string. + +Do you want the command number in the prompt (yes/no)? + +=item connect_to_internet_ok + +If you have never defined your own C<urllist> in your configuration +then C<CPAN.pm> will be hesitant to use the built in default sites for +downloading. It will ask you once per session if a connection to the +internet is OK and only if you say yes, it will try to connect. But to +avoid this question, you can choose your favorite download sites once +and get away with it. Or, if you have no favorite download sites +answer yes to the following question. + +If no urllist has been chosen yet, would you prefer CPAN.pm to connect +to the built-in default sites without asking? (yes/no)? + +=item ftp_passive + +Shall we always set the FTP_PASSIVE environment variable when dealing +with ftp download (yes/no)? + +=item ftpstats_period + +Statistics about downloads are truncated by size and period +simultaneously. + +How many days shall we keep statistics about downloads? + +=item ftpstats_size + +Statistics about downloads are truncated by size and period +simultaneously. + +How many items shall we keep in the statistics about downloads? + +=item getcwd + +CPAN.pm changes the current working directory often and needs to +determine its own current working directory. Per default it uses +Cwd::cwd but if this doesn't work on your system for some reason, +alternatives can be configured according to the following table: + + cwd Cwd::cwd + getcwd Cwd::getcwd + fastcwd Cwd::fastcwd + backtickcwd external command cwd + +Preferred method for determining the current working directory? + +=item halt_on_failure + +Normaly, CPAN.pm continues processing the full list of targets and +dependencies, even if one of them fails. However, you can specify +that CPAN should halt after the first failure. + +Do you want to halt on failure (yes/no)? + +=item histfile + +If you have one of the readline packages (Term::ReadLine::Perl, +Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN +shell will have history support. The next two questions deal with the +filename of the history file and with its size. If you do not want to +set this variable, please hit SPACE RETURN to the following question. + +File to save your history? + +=item histsize + +Number of lines to save? + +=item inactivity_timeout + +Sometimes you may wish to leave the processes run by CPAN alone +without caring about them. Because the Makefile.PL or the Build.PL +sometimes contains question you're expected to answer, you can set a +timer that will kill a 'perl Makefile.PL' process after the specified +time in seconds. + +If you set this value to 0, these processes will wait forever. This is +the default and recommended setting. + +Timeout for inactivity during {Makefile,Build}.PL? + +=item index_expire + +The CPAN indexes are usually rebuilt once or twice per hour, but the +typical CPAN mirror mirrors only once or twice per day. Depending on +the quality of your mirror and your desire to be on the bleeding edge, +you may want to set the following value to more or less than one day +(which is the default). It determines after how many days CPAN.pm +downloads new indexes. + +Let the index expire after how many days? + +=item inhibit_startup_message + +When the CPAN shell is started it normally displays a greeting message +that contains the running version and the status of readline support. + +Do you want to turn this message off? + +=item keep_source_where + +Unless you are accessing the CPAN on your filesystem via a file: URL, +CPAN.pm needs to keep the source files it downloads somewhere. Please +supply a directory where the downloaded files are to be kept. + +Download target directory? + +=item load_module_verbosity + +When CPAN.pm loads a module it needs for some optional feature, it +usually reports about module name and version. Choose 'v' to get this +message, 'none' to suppress it. + +Verbosity level for loading modules (none or v)? + +=item makepl_arg + +Every Makefile.PL is run by perl in a separate process. Likewise we +run 'make' and 'make install' in separate processes. If you have +any parameters (e.g. PREFIX, UNINST or the like) you want to +pass to the calls, please specify them here. + +If you don't understand this question, just press ENTER. + +Typical frequently used settings: + + PREFIX=~/perl # non-root users (please see manual for more hints) + +Parameters for the 'perl Makefile.PL' command? + +=item make_arg + +Parameters for the 'make' command? Typical frequently used setting: + + -j3 # dual processor system (on GNU make) + +Your choice: + +=item make_install_arg + +Parameters for the 'make install' command? +Typical frequently used setting: + + UNINST=1 # to always uninstall potentially conflicting files + +Your choice: + +=item make_install_make_command + +Do you want to use a different make command for 'make install'? +Cautious people will probably prefer: + + su root -c make + or + sudo make + or + /path1/to/sudo -u admin_account /path2/to/make + +or some such. Your choice: + +=item mbuildpl_arg + +A Build.PL is run by perl in a separate process. Likewise we run +'./Build' and './Build install' in separate processes. If you have any +parameters you want to pass to the calls, please specify them here. + +Typical frequently used settings: + + --install_base /home/xxx # different installation directory + +Parameters for the 'perl Build.PL' command? + +=item mbuild_arg + +Parameters for the './Build' command? Setting might be: + + --extra_linker_flags -L/usr/foo/lib # non-standard library location + +Your choice: + +=item mbuild_install_arg + +Parameters for the './Build install' command? Typical frequently used +setting: + + --uninst 1 # uninstall conflicting files + +Your choice: + +=item mbuild_install_build_command + +Do you want to use a different command for './Build install'? Sudo +users will probably prefer: + + su root -c ./Build + or + sudo ./Build + or + /path1/to/sudo -u admin_account ./Build + +or some such. Your choice: + +=item pager + +What is your favorite pager program? + +=item prefer_installer + +When you have Module::Build installed and a module comes with both a +Makefile.PL and a Build.PL, which shall have precedence? + +The main two standard installer modules are the old and well +established ExtUtils::MakeMaker (for short: EUMM) which uses the +Makefile.PL. And the next generation installer Module::Build (MB) +which works with the Build.PL (and often comes with a Makefile.PL +too). If a module comes only with one of the two we will use that one +but if both are supplied then a decision must be made between EUMM and +MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a +discussion about the right default. + +Or, as a third option you can choose RAND which will make a random +decision (something regular CPAN testers will enjoy). + +In case you can choose between running a Makefile.PL or a Build.PL, +which installer would you prefer (EUMM or MB or RAND)? + +=item prefs_dir + +CPAN.pm can store customized build environments based on regular +expressions for distribution names. These are YAML files where the +default options for CPAN.pm and the environment can be overridden and +dialog sequences can be stored that can later be executed by an +Expect.pm object. The CPAN.pm distribution comes with some prefab YAML +files that cover sample distributions that can be used as blueprints +to store one own prefs. Please check out the distroprefs/ directory of +the CPAN.pm distribution to get a quick start into the prefs system. + +Directory where to store default options/environment/dialogs for +building modules that need some customization? + +=item prerequisites_policy + +The CPAN module can detect when a module which you are trying to build +depends on prerequisites. If this happens, it can build the +prerequisites for you automatically ('follow'), ask you for +confirmation ('ask'), or just ignore them ('ignore'). Please set your +policy to one of the three values. + +Policy on building prerequisites (follow, ask or ignore)? + +=item randomize_urllist + +CPAN.pm can introduce some randomness when using hosts for download +that are configured in the urllist parameter. Enter a numeric value +between 0 and 1 to indicate how often you want to let CPAN.pm try a +random host from the urllist. A value of one specifies to always use a +random host as the first try. A value of zero means no randomness at +all. Anything in between specifies how often, on average, a random +host should be tried first. + +Randomize parameter + +=item scan_cache + +By default, each time the CPAN module is started, cache scanning is +performed to keep the cache size in sync. To prevent this, answer +'never'. + +Perform cache scanning (atstart or never)? + +=item shell + +What is your favorite shell? + +=item show_unparsable_versions + +During the 'r' command CPAN.pm finds modules without version number. +When the command finishes, it prints a report about this. If you +want this report to be very verbose, say yes to the following +variable. + +Show all individual modules that have no $VERSION? + +=item show_upload_date + +The 'd' and the 'm' command normally only show you information they +have in their in-memory database and thus will never connect to the +internet. If you set the 'show_upload_date' variable to true, 'm' and +'d' will additionally show you the upload date of the module or +distribution. Per default this feature is off because it may require a +net connection to get at the upload date. + +Always try to show upload date with 'd' and 'm' command (yes/no)? + +=item show_zero_versions + +During the 'r' command CPAN.pm finds modules with a version number of +zero. When the command finishes, it prints a report about this. If you +want this report to be very verbose, say yes to the following +variable. + +Show all individual modules that have a $VERSION of zero? + +=item tar_verbosity + +When CPAN.pm uses the tar command, which switch for the verbosity +shall be used? Choose 'none' for quiet operation, 'v' for file +name listing, 'vv' for full listing. + +Tar command verbosity level (none or v or vv)? + +=item term_is_latin + +The next option deals with the charset (aka character set) your +terminal supports. In general, CPAN is English speaking territory, so +the charset does not matter much but some CPAN have names that are +outside the ASCII range. If your terminal supports UTF-8, you should +say no to the next question. If it expects ISO-8859-1 (also known as +LATIN1) then you should say yes. If it supports neither, your answer +does not matter because you will not be able to read the names of some +authors anyway. If you answer no, names will be output in UTF-8. + +Your terminal expects ISO-8859-1 (yes/no)? + +=item term_ornaments + +When using Term::ReadLine, you can turn ornaments on so that your +input stands out against the output from CPAN.pm. + +Do you want to turn ornaments on? + +=item test_report + +The goal of the CPAN Testers project (http://testers.cpan.org/) is to +test as many CPAN packages as possible on as many platforms as +possible. This provides valuable feedback to module authors and +potential users to identify bugs or platform compatibility issues and +improves the overall quality and value of CPAN. + +One way you can contribute is to send test results for each module +that you install. If you install the CPAN::Reporter module, you have +the option to automatically generate and email test reports to CPAN +Testers whenever you run tests on a CPAN package. + +See the CPAN::Reporter documentation for additional details and +configuration settings. If your firewall blocks outgoing email, +you will need to configure CPAN::Reporter before sending reports. + +Email test reports if CPAN::Reporter is installed (yes/no)? + +=item perl5lib_verbosity + +When CPAN.pm extends @INC via PERL5LIB, it prints a list of +directories added (or a summary of how many directories are +added). Choose 'v' to get this message, 'none' to suppress it. + +Verbosity level for PERL5LIB changes (none or v)? + +=item trust_test_report_history + +When a distribution has already been tested by CPAN::Reporter on +this machine, CPAN can skip the test phase and just rely on the +test report history instead. + +Note that this will not apply to distributions that failed tests +because of missing dependencies. Also, tests can be run +regardless of the history using "force". + +Do you want to rely on the test report history (yes/no)? + +=item use_sqlite + +CPAN::SQLite is a layer between the index files that are downloaded +from the CPAN and CPAN.pm that speeds up metadata queries and reduces +memory consumption of CPAN.pm considerably. + +Use CPAN::SQLite if available? (yes/no)? + +=item yaml_load_code + +Both YAML.pm and YAML::Syck are capable of deserialising code. As this +requires a string eval, which might be a security risk, you can use +this option to enable or disable the deserialisation of code via +CPAN::DeferredCode. (Note: This does not work under perl 5.6) + +Do you want to enable code deserialisation (yes/no)? + +=item yaml_module + +At the time of this writing (2009-03) there are three YAML +implementations working: YAML, YAML::Syck, and YAML::XS. The latter +two are faster but need a C compiler installed on your system. There +may be more alternative YAML conforming modules. When I tried two +other players, YAML::Tiny and YAML::Perl, they seemed not powerful +enough to work with CPAN.pm. This may have changed in the meantime. + +Which YAML implementation would you prefer? + +=back + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +use vars qw( %prompts ); + +{ + + my @prompts = ( + +manual_config => qq[ + +CPAN is the world-wide archive of perl resources. It consists of about +300 sites that all replicate the same contents around the globe. Many +countries have at least one CPAN site already. The resources found on +CPAN are easily accessible with the CPAN.pm module. If you want to use +CPAN.pm, lots of things have to be configured. Fortunately, most of +them can be determined automatically. If you prefer the automatic +configuration, answer 'yes' below. + +If you prefer to enter a dialog instead, you can answer 'no' to this +question and I'll let you configure in small steps one thing after the +other. (Note: you can revisit this dialog anytime later by typing 'o +conf init' at the cpan prompt.) +], + +config_intro => qq{ + +The following questions are intended to help you with the +configuration. The CPAN module needs a directory of its own to cache +important index files and maybe keep a temporary mirror of CPAN files. +This may be a site-wide or a personal directory. + +}, + +# cpan_home => qq{ }, + +cpan_home_where => qq{ + +First of all, I'd like to create this directory. Where? + +}, + +external_progs => qq{ + +The CPAN module will need a few external programs to work properly. +Please correct me, if I guess the wrong path for a program. Don't +panic if you do not have some of them, just press ENTER for those. To +disable the use of a program, you can type a space followed by ENTER. + +}, + +proxy_intro => qq{ + +If you're accessing the net via proxies, you can specify them in the +CPAN configuration or via environment variables. The variable in +the \$CPAN::Config takes precedence. + +}, + +proxy_user => qq{ + +If your proxy is an authenticating proxy, you can store your username +permanently. If you do not want that, just press RETURN. You will then +be asked for your username in every future session. + +}, + +proxy_pass => qq{ + +Your password for the authenticating proxy can also be stored +permanently on disk. If this violates your security policy, just press +RETURN. You will then be asked for the password in every future +session. + +}, + +urls_intro => qq{ + +Now we need to know where your favorite CPAN sites are located. Push +a few sites onto the array (just in case the first on the array won\'t +work). If you are mirroring CPAN to your local workstation, specify a +file: URL. + +First, pick a nearby continent and country by typing in the number(s) +in front of the item(s) you want to select. You can pick several of +each, separated by spaces. Then, you will be presented with a list of +URLs of CPAN mirrors in the countries you selected, along with +previously selected URLs. Select some of those URLs, or just keep the +old list. Finally, you will be prompted for any extra URLs -- file:, +ftp:, or http: -- that host a CPAN mirror. + +}, + +password_warn => qq{ + +Warning: Term::ReadKey seems not to be available, your password will +be echoed to the terminal! + +}, + + ); + + die "Coding error in \@prompts declaration. Odd number of elements, above" + if (@prompts % 2); + + %prompts = @prompts; + + if (scalar(keys %prompts) != scalar(@prompts)/2) { + my %already; + for my $item (0..$#prompts) { + next if $item % 2; + die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++; + } + } + + shift @podpara; + while (@podpara) { + warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//; + my $name = shift @podpara; + my @para; + while (@podpara && $podpara[0] !~ /^=item/) { + push @para, shift @podpara; + } + $prompts{$name} = pop @para; + if (@para) { + $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para; + } + } + +} + +sub init { + my($configpm, %args) = @_; + use Config; + # extra args after 'o conf init' + my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : ''; + if ($matcher =~ /^\/(.*)\/$/) { + # case /regex/ => take the first, ignore the rest + $matcher = $1; + shift @{$args{args}}; + if (@{$args{args}}) { + local $" = " "; + $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'"); + $CPAN::Frontend->mysleep(2); + } + } elsif (0 == length $matcher) { + } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea + my @unconfigured = grep { not exists $CPAN::Config->{$_} + or not defined $CPAN::Config->{$_} + or not length $CPAN::Config->{$_} + } keys %$CPAN::Config; + $matcher = "\\b(".join("|", @unconfigured).")\\b"; + $CPAN::Frontend->mywarn("matcher[$matcher]"); + } else { + # case WORD... => all arguments must be valid + for my $arg (@{$args{args}}) { + unless (exists $CPAN::HandleConfig::keys{$arg}) { + $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n"); + return; + } + } + $matcher = "\\b(".join("|",@{$args{args}}).")\\b"; + } + CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG; + + unless ($CPAN::VERSION) { + require CPAN::Nox; + } + require CPAN::HandleConfig; + CPAN::HandleConfig::require_myconfig_or_config(); + $CPAN::Config ||= {}; + local($/) = "\n"; + local($\) = ""; + local($|) = 1; + + my($ans,$default); # why so half global? + + # + #= Files, directories + # + + unless ($matcher) { + $CPAN::Frontend->myprint($prompts{manual_config}); + } + + my $manual_conf; + + local *_real_prompt; + if ( $args{autoconfig} ) { + $manual_conf = "no"; + } elsif ($matcher) { + $manual_conf = "yes"; + } else { + my $_conf = prompt("Would you like me to configure as much as possible ". + "automatically?", "yes"); + $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes"; + } + CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG; + my $fastread; + { + if ($manual_conf =~ /^y/i) { + $fastread = 0; + } else { + $fastread = 1; + $CPAN::Config->{urllist} ||= []; + $CPAN::Config->{connect_to_internet_ok} ||= 1; + + local $^W = 0; + # prototype should match that of &MakeMaker::prompt + my $current_second = time; + my $current_second_count = 0; + my $i_am_mad = 0; + *_real_prompt = sub { + my($q,$a) = @_; + my($ret) = defined $a ? $a : ""; + $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret); + eval { require Time::HiRes }; + unless ($@) { + if (time == $current_second) { + $current_second_count++; + if ($current_second_count > 20) { + # I don't like more than 20 prompts per second + $i_am_mad++; + } + } else { + $current_second = time; + $current_second_count = 0; + $i_am_mad-- if $i_am_mad>0; + } + if ($i_am_mad>0) { + #require Carp; + #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG"); + Time::HiRes::sleep(0.1); + } + } + $ret; + }; + } + } + + if (!$matcher or q{ + build_dir + build_dir_reuse + cpan_home + keep_source_where + prefs_dir + } =~ /$matcher/) { + $CPAN::Frontend->myprint($prompts{config_intro}); + + init_cpan_home($matcher); + + my_dflt_prompt("keep_source_where", + File::Spec->catdir($CPAN::Config->{cpan_home},"sources"), + $matcher, + ); + my_dflt_prompt("build_dir", + File::Spec->catdir($CPAN::Config->{cpan_home},"build"), + $matcher + ); + my_yn_prompt(build_dir_reuse => 0, $matcher); + my_dflt_prompt("prefs_dir", + File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"), + $matcher + ); + } + + # + #= Config: auto_commit + # + + my_yn_prompt(auto_commit => 0, $matcher); + + # + #= Cache size, Index expire + # + my_dflt_prompt(build_cache => 100, $matcher); + + my_dflt_prompt(index_expire => 1, $matcher); + my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never'); + + # + #= cache_metadata + # + + my_yn_prompt(cache_metadata => 1, $matcher); + my_yn_prompt(use_sqlite => 0, $matcher); + + # + #= Do we follow PREREQ_PM? + # + + my_prompt_loop(prerequisites_policy => 'ask', $matcher, + 'follow|ask|ignore'); + my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher, + 'yes|no|ask/yes|ask/no'); + + # + #= Module::Signature + # + my_yn_prompt(check_sigs => 0, $matcher); + + # + #= CPAN::Reporter + # + if (!$matcher or 'test_report' =~ /$matcher/) { + my_yn_prompt(test_report => 0, $matcher); + if ( + $CPAN::Config->{test_report} && + $CPAN::META->has_inst("CPAN::Reporter") && + CPAN::Reporter->can('configure') + ) { + $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n"); + CPAN::Reporter::configure(); + $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n"); + } + } + + my_yn_prompt(trust_test_report_history => 0, $matcher); + + # + #= YAML vs. YAML::Syck + # + if (!$matcher or "yaml_module" =~ /$matcher/) { + my_dflt_prompt(yaml_module => "YAML", $matcher); + unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) { + $CPAN::Frontend->mywarn + ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n"); + $CPAN::Frontend->mysleep(3); + } + } + + # + #= YAML code deserialisation + # + my_yn_prompt(yaml_load_code => 0, $matcher); + + # + #= External programs + # + my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'}; + _init_external_progs($matcher,\@path); + + { + my $path = $CPAN::Config->{'pager'} || + $ENV{PAGER} || find_exe("less",\@path) || + find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 ) + || "more"; + my_dflt_prompt(pager => $path, $matcher); + } + + { + my $path = $CPAN::Config->{'shell'}; + if ($path && File::Spec->file_name_is_absolute($path)) { + $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n") + unless -e $path; + $path = ""; + } + $path ||= $ENV{SHELL}; + $path ||= $ENV{COMSPEC} if $^O eq "MSWin32"; + if ($^O eq 'MacOS') { + $CPAN::Config->{'shell'} = 'not_here'; + } else { + $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only + my_dflt_prompt(shell => $path, $matcher); + } + } + + # + # verbosity + # + + my_prompt_loop(tar_verbosity => 'v', $matcher, + 'none|v|vv'); + my_prompt_loop(load_module_verbosity => 'v', $matcher, + 'none|v'); + my_prompt_loop(perl5lib_verbosity => 'v', $matcher, + 'none|v'); + my_yn_prompt(inhibit_startup_message => 0, $matcher); + + # + #= Installer, arguments to make etc. + # + + my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND'); + + if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) { + my_dflt_prompt(makepl_arg => "", $matcher); + my_dflt_prompt(make_arg => "", $matcher); + if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) { + $CPAN::Frontend->mywarn( + "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" . + "that specify their own LIBS or INC options in Makefile.PL.\n" + ); + } + + } + + require CPAN::HandleConfig; + if (exists $CPAN::HandleConfig::keys{make_install_make_command}) { + # as long as Windows needs $self->_build_command, we cannot + # support sudo on windows :-) + my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "", + $matcher); + } + + my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", + $matcher); + + my_dflt_prompt(mbuildpl_arg => "", $matcher); + my_dflt_prompt(mbuild_arg => "", $matcher); + + if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command} + and $^O ne "MSWin32") { + # as long as Windows needs $self->_build_command, we cannot + # support sudo on windows :-) + my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher); + } + + my_dflt_prompt(mbuild_install_arg => "", $matcher); + + # + #= Alarm period + # + + my_dflt_prompt(inactivity_timeout => 0, $matcher); + + # + #== halt_on_failure + # + my_yn_prompt(halt_on_failure => 0, $matcher); + + # + #= Proxies + # + + my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/; + my @proxy_user_vars = qw/proxy_user proxy_pass/; + if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) { + $CPAN::Frontend->myprint($prompts{proxy_intro}); + + for (@proxy_vars) { + $prompts{$_} = "Your $_?"; + my_dflt_prompt($_ => $ENV{$_}||"", $matcher); + } + + if ($CPAN::Config->{ftp_proxy} || + $CPAN::Config->{http_proxy}) { + + $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || ""; + + $CPAN::Frontend->myprint($prompts{proxy_user}); + + if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) { + $CPAN::Frontend->myprint($prompts{proxy_pass}); + + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("noecho"); + } else { + $CPAN::Frontend->myprint($prompts{password_warn}); + } + $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?"); + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("restore"); + } + $CPAN::Frontend->myprint("\n\n"); + } + } + } + + # + #= how FTP works + # + + my_yn_prompt(ftp_passive => 1, $matcher); + + # + #= how cwd works + # + + my_prompt_loop(getcwd => 'cwd', $matcher, + 'cwd|getcwd|fastcwd|backtickcwd'); + + # + #= the CPAN shell itself (prompt, color) + # + + my_yn_prompt(commandnumber_in_prompt => 1, $matcher); + my_yn_prompt(term_ornaments => 1, $matcher); + if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) { + my_yn_prompt(colorize_output => 0, $matcher); + if ($CPAN::Config->{colorize_output}) { + if ($CPAN::META->has_inst("Term::ANSIColor")) { + my $T="gYw"; + print " on_ on_y ". + " on_ma on_\n"; + print " on_black on_red green ellow ". + "on_blue genta on_cyan white\n"; + + for my $FG ("", "bold", + map {$_,"bold $_"} "black","red","green", + "yellow","blue", + "magenta", + "cyan","white") { + printf "%12s ", $FG; + for my $BG ("",map {"on_$_"} qw(black red green yellow + blue magenta cyan white)) { + print $FG||$BG ? + Term::ANSIColor::colored(" $T ","$FG $BG") : " $T "; + } + print "\n"; + } + print "\n"; + } + for my $tuple ( + ["colorize_print", "bold blue on_white"], + ["colorize_warn", "bold red on_white"], + ["colorize_debug", "black on_cyan"], + ) { + my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher); + if ($CPAN::META->has_inst("Term::ANSIColor")) { + eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})}; + if ($@) { + $CPAN::Config->{$tuple->[0]} = $tuple->[1]; + $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n"); + } + } + } + } + } + + # + #== term_is_latin + # + + my_yn_prompt(term_is_latin => 1, $matcher); + + # + #== save history in file 'histfile' + # + + if (!$matcher or 'histfile histsize' =~ /$matcher/) { + $CPAN::Frontend->myprint($prompts{histfile_intro}); + defined($default = $CPAN::Config->{histfile}) or + $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile"); + my_dflt_prompt(histfile => $default, $matcher); + + if ($CPAN::Config->{histfile}) { + defined($default = $CPAN::Config->{histsize}) or $default = 100; + my_dflt_prompt(histsize => $default, $matcher); + } + } + + # + #== do an ls on the m or the d command + # + my_yn_prompt(show_upload_date => 0, $matcher); + + # + #== verbosity at the end of the r command + # + if (!$matcher + or 'show_unparsable_versions' =~ /$matcher/ + or 'show_zero_versions' =~ /$matcher/ + ) { + $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro}); + my_yn_prompt(show_unparsable_versions => 0, $matcher); + my_yn_prompt(show_zero_versions => 0, $matcher); + } + + # + #= MIRRORED.BY and conf_sites() + # + + # remember, this is only triggered if no urllist is given, so 0 is + # fair and protects the default site from being overloaded and + # gives the user more chances to select his own urllist. + my_yn_prompt("connect_to_internet_ok" => 0, $matcher); + if ($matcher) { + if ("urllist" =~ $matcher) { + # conf_sites would go into endless loop with the smash prompt + local *_real_prompt; + *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt; + conf_sites(); + } + if ("randomize_urllist" =~ $matcher) { + my_dflt_prompt(randomize_urllist => 0, $matcher); + } + if ("ftpstats_size" =~ $matcher) { + my_dflt_prompt(ftpstats_size => 99, $matcher); + } + if ("ftpstats_period" =~ $matcher) { + my_dflt_prompt(ftpstats_period => 14, $matcher); + } + } elsif ($fastread) { + $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n". + "Please call 'o conf init urllist' to configure ". + "your CPAN server(s) now!\n\n"); + } else { + conf_sites(); + } + + $CPAN::Frontend->myprint("\n\n"); + if ($matcher && !$CPAN::Config->{auto_commit}) { + $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ". + "make the config permanent!\n\n"); + } else { + CPAN::HandleConfig->commit($configpm); + } +} + +sub _init_external_progs { + my($matcher,$PATH) = @_; + my @external_progs = qw/bzip2 gzip tar unzip + + make + + curl lynx wget ncftpget ncftp ftp + + gpg + + patch applypatch + /; + if (!$matcher or "@external_progs" =~ /$matcher/) { + $CPAN::Frontend->myprint($prompts{external_progs}); + + my $old_warn = $^W; + local $^W if $^O eq 'MacOS'; + local $^W = $old_warn; + my $progname; + for $progname (@external_progs) { + next if $matcher && $progname !~ /$matcher/; + if ($^O eq 'MacOS') { + $CPAN::Config->{$progname} = 'not_here'; + next; + } + + my $progcall = $progname; + unless ($matcher) { + # we really don't need ncftp if we have ncftpget, but + # if they chose this dialog via matcher, they shall have it + next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " "; + } + my $path = $CPAN::Config->{$progname} + || $Config::Config{$progname} + || ""; + if (File::Spec->file_name_is_absolute($path)) { + # testing existence is not good enough, some have these exe + # extensions + + # warn "Warning: configured $path does not exist\n" unless -e $path; + # $path = ""; + } elsif ($path =~ /^\s+$/) { + # preserve disabled programs + } else { + $path = ''; + } + unless ($path) { + # e.g. make -> nmake + $progcall = $Config::Config{$progname} if $Config::Config{$progname}; + } + + $path ||= find_exe($progcall,$PATH); + unless ($path) { # not -e $path, because find_exe already checked that + local $"=";"; + $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n"); + if ($progname eq "make") { + $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ". + "building perl Modules. Please make sure you ". + "have 'make' (or some equivalent) ". + "working.\n" + ); + if ($^O eq "MSWin32") { + $CPAN::Frontend->mywarn(" +Windows users may want to follow this procedure when back in the CPAN shell: + + look YVES/scripts/alien_nmake.pl + perl alien_nmake.pl + +This will install nmake on your system which can be used as a 'make' +substitute. You can then revisit this dialog with + + o conf init make + +"); + } + } + } + $prompts{$progname} = "Where is your $progname program?"; + my_dflt_prompt($progname,$path,$matcher); + } + } +} + +sub init_cpan_home { + my($matcher) = @_; + if (!$matcher or 'cpan_home' =~ /$matcher/) { + my $cpan_home = $CPAN::Config->{cpan_home} + || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan"); + + if (-d $cpan_home) { + $CPAN::Frontend->myprint(qq{ + +I see you already have a directory + $cpan_home +Shall we use it as the general CPAN build and cache directory? + +}); + } else { + # no cpan-home, must prompt and get one + $CPAN::Frontend->myprint($prompts{cpan_home_where}); + } + + my $default = $cpan_home; + my $loop = 0; + my($last_ans,$ans); + $CPAN::Frontend->myprint(" <cpan_home>\n"); + PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) { + print "\n"; + if (File::Spec->file_name_is_absolute($ans)) { + my @cpan_home = split /[\/\\]/, $ans; + DIR: for my $dir (@cpan_home) { + if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) { + $CPAN::Frontend + ->mywarn("Warning: a tilde in the path will be ". + "taken as a literal tilde. Please ". + "confirm again if you want to keep it\n"); + $last_ans = $default = $ans; + next PROMPT; + } + } + } else { + require Cwd; + my $cwd = Cwd::cwd(); + my $absans = File::Spec->catdir($cwd,$ans); + $CPAN::Frontend->mywarn("The path '$ans' is not an ". + "absolute path. Please specify ". + "an absolute path\n"); + $default = $absans; + next PROMPT; + } + eval { File::Path::mkpath($ans); }; # dies if it can't + if ($@) { + $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n". + "Please retry.\n"); + next PROMPT; + } + if (-d $ans && -w _) { + last PROMPT; + } else { + $CPAN::Frontend->mywarn("Couldn't find directory $ans\n". + "or directory is not writable. Please retry.\n"); + if (++$loop > 5) { + $CPAN::Frontend->mydie("Giving up"); + } + } + } + $CPAN::Config->{cpan_home} = $ans; + } +} + +sub my_dflt_prompt { + my ($item, $dflt, $m) = @_; + my $default = $CPAN::Config->{$item} || $dflt; + + if (!$m || $item =~ /$m/) { + if (my $intro = $prompts{$item . "_intro"}) { + $CPAN::Frontend->myprint($intro); + } + $CPAN::Frontend->myprint(" <$item>\n"); + $CPAN::Config->{$item} = prompt($prompts{$item}, $default); + print "\n"; + } else { + $CPAN::Config->{$item} = $default; + } +} + +sub my_yn_prompt { + my ($item, $dflt, $m) = @_; + my $default; + defined($default = $CPAN::Config->{$item}) or $default = $dflt; + + # $DB::single = 1; + if (!$m || $item =~ /$m/) { + if (my $intro = $prompts{$item . "_intro"}) { + $CPAN::Frontend->myprint($intro); + } + $CPAN::Frontend->myprint(" <$item>\n"); + my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no'); + $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0); + print "\n"; + } else { + $CPAN::Config->{$item} = $default; + } +} + +sub my_prompt_loop { + my ($item, $dflt, $m, $ok) = @_; + my $default = $CPAN::Config->{$item} || $dflt; + my $ans; + + if (!$m || $item =~ /$m/) { + $CPAN::Frontend->myprint($prompts{$item . "_intro"}); + $CPAN::Frontend->myprint(" <$item>\n"); + do { $ans = prompt($prompts{$item}, $default); + } until $ans =~ /$ok/; + $CPAN::Config->{$item} = $ans; + print "\n"; + } else { + $CPAN::Config->{$item} = $default; + } +} + + +sub conf_sites { + my $m = 'MIRRORED.BY'; + my $use_mby; + my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m); + File::Path::mkpath(File::Basename::dirname($mby)); + if (-f $mby && -f $m && -M $m < -M $mby) { + $use_mby = 1; + require File::Copy; + File::Copy::copy($m,$mby) or die "Could not update $mby: $!"; + } + local $^T = time; + my $overwrite_local = 0; + if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) { + $use_mby = 1; + my $mtime = localtime((stat _)[9]); + my $prompt = qq{Found $mby as of $mtime + +I'd use that as a database of CPAN sites. If that is OK for you, +please answer 'y', but if you want me to get a new database from the +internet now, please answer 'n' to the following question. + +Shall I use the local database in $mby?}; + my $ans = prompt($prompt,"y"); + if ($ans =~ /^y/i) { + $CPAN::Config->{connect_to_internet_ok} = 1; + } else { + $overwrite_local = 1; + } + } + local $urllist = $CPAN::Config->{urllist}; + my $better_mby; + LOOP: while () { # multiple errors possible + if ($use_mby + or (defined $CPAN::Config->{connect_to_internet_ok} + and $CPAN::Config->{connect_to_internet_ok})){ + if ($overwrite_local) { + $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $overwrite_local = 0; + $use_mby=1 if $mby; + } elsif ( ! -f $mby ) { + $CPAN::Frontend->myprint(qq{You have no $mby\n I'm trying to fetch one\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $use_mby=1 if $mby; + } elsif ( -M $mby > 60 ) { + $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I'm trying }. + qq{to fetch a new one\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $use_mby=1 if $mby; + } elsif (-s $mby == 0) { + $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I'm trying to fetch a better one\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $use_mby=1 if $mby; + } else { + last LOOP; + } + if ($better_mby) { + $mby = $better_mby; + } + } elsif (not @{$urllist||[]} + and (not defined $CPAN::Config->{connect_to_internet_ok} + or not $CPAN::Config->{connect_to_internet_ok})) { + $CPAN::Frontend->myprint(qq{CPAN needs access to at least one CPAN mirror. + +As you did not allow me to connect to the internet you need to supply +a valid CPAN URL now.\n\n}); + + my @default = map {"file://$_"} grep {-e} "/home/ftp/pub/CPAN", "/home/ftp/pub/PAUSE"; + my $ans = prompt("Please enter the URL of your CPAN mirror",shift @default); + if ($ans) { + push @$urllist, $ans; + next LOOP; + } + } else { + last LOOP; + } + } + if ($use_mby){ + read_mirrored_by($mby); + } else { + if (not defined $CPAN::Config->{connect_to_internet_ok} + or not $CPAN::Config->{connect_to_internet_ok}) { + $CPAN::Frontend->myprint("Configuration does not allow connecting to the internet.\n"); + } + $CPAN::Frontend->myprint("Current set of CPAN URLs:\n"); + map { $CPAN::Frontend->myprint(" $_\n") } @$urllist; + } + bring_your_own(); + $CPAN::Config->{urllist} = $urllist; +} + +sub find_exe { + my($exe,$path) = @_; + my($dir); + #warn "in find_exe exe[$exe] path[@$path]"; + for $dir (@$path) { + my $abs = File::Spec->catfile($dir,$exe); + if (($abs = MM->maybe_command($abs))) { + return $abs; + } + } +} + +sub picklist { + my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_; + CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',". + "'$empty_warning')") if $CPAN::DEBUG; + $default ||= ''; + + my $pos = 0; + + my @nums; + SELECTION: while (1) { + + # display, at most, 15 items at a time + my $limit = $#{ $items } - $pos; + $limit = 15 if $limit > 15; + + # show the next $limit items, get the new position + $pos = display_some($items, $limit, $pos, $default); + $pos = 0 if $pos >= @$items; + + my $num = prompt($prompt,$default); + + @nums = split (' ', $num); + { + my %seen; + @nums = grep { !$seen{$_}++ } @nums; + } + my $i = scalar @$items; + unrangify(\@nums); + if (0 == @nums) { + # cannot allow nothing because nothing means paging! + # return; + } elsif (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) { + $CPAN::Frontend->mywarn("invalid items entered, try again\n"); + if ("@nums" =~ /\D/) { + $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n"); + } + next SELECTION; + } + if ($require_nonempty && !@nums) { + $CPAN::Frontend->mywarn("$empty_warning\n"); + } + $CPAN::Frontend->myprint("\n"); + + # a blank line continues... + unless (@nums){ + $CPAN::Frontend->mysleep(0.1); # prevent hot spinning process on the next bug + next SELECTION; + } + last; + } + for (@nums) { $_-- } + @{$items}[@nums]; +} + +sub unrangify ($) { + my($nums) = $_[0]; + my @nums2 = (); + while (@{$nums||[]}) { + my $n = shift @$nums; + if ($n =~ /^(\d+)-(\d+)$/) { + my @range = $1 .. $2; + # warn "range[@range]"; + push @nums2, @range; + } else { + push @nums2, $n; + } + } + push @$nums, @nums2; +} + +sub display_some { + my ($items, $limit, $pos, $default) = @_; + $pos ||= 0; + + my @displayable = @$items[$pos .. ($pos + $limit)]; + for my $item (@displayable) { + $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item); + } + my $hit_what = $default ? "SPACE RETURN" : "RETURN"; + $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n", + (@$items - $pos), + $hit_what, + )) + if $pos < @$items; + return $pos; +} + +sub read_mirrored_by { + my $local = shift or return; + my(%all,$url,$expected_size,$default,$ans,$host, + $dst,$country,$continent,@location); + my $fh = FileHandle->new; + $fh->open($local) or die "Couldn't open $local: $!"; + local $/ = "\012"; + while (<$fh>) { + ($host) = /^([\w\.\-]+)/ unless defined $host; + next unless defined $host; + next unless /\s+dst_(dst|location)/; + /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and + ($continent, $country) = @location[-1,-2]; + $continent =~ s/\s\(.*//; + $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude + /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1; + next unless $host && $dst && $continent && $country; + $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst); + undef $host; + $dst=$continent=$country=""; + } + $fh->close; + $CPAN::Config->{urllist} ||= []; + my @previous_urls = @{$CPAN::Config->{urllist}}; + + $CPAN::Frontend->myprint($prompts{urls_intro}); + + my (@cont, $cont, %cont, @countries, @urls, %seen); + my $no_previous_warn = + "Sorry! since you don't have any existing picks, you must make a\n" . + "geographic selection."; + my $offer_cont = [sort keys %all]; + if (@previous_urls) { + push @$offer_cont, "(edit previous picks)"; + $default = @$offer_cont; + } else { + # cannot allow nothing because nothing means paging! + # push @$offer_cont, "(none of the above)"; + } + @cont = picklist($offer_cont, + "Select your continent (or several nearby continents)", + $default, + ! @previous_urls, + $no_previous_warn); + # cannot allow nothing because nothing means paging! + # return unless @cont; + + foreach $cont (@cont) { + my @c = sort keys %{$all{$cont}}; + @cont{@c} = map ($cont, 0..$#c); + @c = map ("$_ ($cont)", @c) if @cont > 1; + push (@countries, @c); + } + if (@previous_urls && @countries) { + push @countries, "(edit previous picks)"; + $default = @countries; + } + + if (@countries) { + @countries = picklist (\@countries, + "Select your country (or several nearby countries)", + $default, + ! @previous_urls, + $no_previous_warn); + %seen = map (($_ => 1), @previous_urls); + # hmmm, should take list of defaults from CPAN::Config->{'urllist'}... + foreach $country (@countries) { + next if $country =~ /edit previous picks/; + (my $bare_country = $country) =~ s/ \(.*\)//; + my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}}; + @u = grep (! $seen{$_}, @u); + @u = map ("$_ ($bare_country)", @u) + if @countries > 1; + push (@urls, @u); + } + } + push (@urls, map ("$_ (previous pick)", @previous_urls)); + my $prompt = "Select as many URLs as you like (by number), +put them on one line, separated by blanks, hyphenated ranges allowed + e.g. '1 4 5' or '7 1-4 8'"; + if (@previous_urls) { + $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) .. + (scalar @urls)); + $prompt .= "\n(or just hit RETURN to keep your previous picks)"; + } + + @urls = picklist (\@urls, $prompt, $default); + foreach (@urls) { s/ \(.*\)//; } + if (@urls) { + $urllist = \@urls; + } else { + push @$urllist, @urls; + } +} + +sub bring_your_own { + my %seen = map (($_ => 1), @$urllist); + my($ans,@urls); + my $eacnt = 0; # empty answers + do { + my $prompt = "Enter another URL or RETURN to quit:"; + unless (%seen) { + $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from. + +Please enter your CPAN site:}; + } + $ans = prompt ($prompt, ""); + + if ($ans) { + $ans =~ s|/?\z|/|; # has to end with one slash + $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: + if ($ans =~ /^\w+:\/./) { + push @urls, $ans unless $seen{$ans}++; + } else { + $CPAN::Frontend-> + myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight. +I\'ll ignore it for now. +You can add it to your %s +later if you\'re sure it\'s right.\n}, + $ans, + $INC{'CPAN/MyConfig.pm'} + || $INC{'CPAN/Config.pm'} + || "configuration file", + )); + } + } else { + if (++$eacnt >= 5) { + $CPAN::Frontend-> + mywarn("Giving up.\n"); + $CPAN::Frontend->mysleep(5); + return; + } + } + } while $ans || !%seen; + + @$urllist = CPAN::_uniq(@$urllist, @urls); + $CPAN::Config->{urllist} = $urllist; + # xxx delete or comment these out when you're happy that it works + $CPAN::Frontend->myprint("New urllist\n"); + for ( @$urllist ) { $CPAN::Frontend->myprint(" $_\n") }; +} + + +sub _strip_spaces { + $_[0] =~ s/^\s+//; # no leading spaces + $_[0] =~ s/\s+\z//; # no trailing spaces +} + +sub prompt ($;$) { + unless (defined &_real_prompt) { + *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt; + } + my $ans = _real_prompt(@_); + + _strip_spaces($ans); + + return $ans; +} + + +sub prompt_no_strip ($;$) { + return _real_prompt(@_); +} + + + +1; diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm new file mode 100644 index 0000000000..903b414464 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm @@ -0,0 +1,734 @@ +package CPAN::HandleConfig; +use strict; +use vars qw(%can %keys $loading $VERSION); + +$VERSION = "5.5"; + +%can = ( + commit => "Commit changes to disk", + defaults => "Reload defaults from disk", + help => "Short help about 'o conf' usage", + init => "Interactive setting of all options", +); + +# Q: where is the "How do I add a new config option" HOWTO? +# A1: svn diff -r 757:758 # where dagolden added test_report +# A2: svn diff -r 985:986 # where andk added yaml_module +# A3: 1. add new config option to %keys below +# 2. add a Pod description in CPAN::FirstTime; it should include a +# prompt line; see others for examples +# 3. add a "matcher" section in CPAN::FirstTime::init that includes +# a prompt function; see others for examples +# 4. add config option to documentation section in CPAN.pm + +%keys = map { $_ => undef } + ( + "applypatch", + "auto_commit", + "build_cache", + "build_dir", + "build_dir_reuse", + "build_requires_install_policy", + "bzip2", + "cache_metadata", + "check_sigs", + "colorize_debug", + "colorize_output", + "colorize_print", + "colorize_warn", + "commandnumber_in_prompt", + "commands_quote", + "connect_to_internet_ok", + "cpan_home", + "curl", + "dontload_hash", # deprecated after 1.83_68 (rev. 581) + "dontload_list", + "ftp", + "ftp_passive", + "ftp_proxy", + "ftpstats_size", + "ftpstats_period", + "getcwd", + "gpg", + "gzip", + "halt_on_failure", + "histfile", + "histsize", + "http_proxy", + "inactivity_timeout", + "index_expire", + "inhibit_startup_message", + "keep_source_where", + "load_module_verbosity", + "lynx", + "make", + "make_arg", + "make_install_arg", + "make_install_make_command", + "makepl_arg", + "mbuild_arg", + "mbuild_install_arg", + "mbuild_install_build_command", + "mbuildpl_arg", + "ncftp", + "ncftpget", + "no_proxy", + "pager", + "password", + "patch", + "patches_dir", + "perl5lib_verbosity", + "prefer_installer", + "prefs_dir", + "prerequisites_policy", + "proxy_pass", + "proxy_user", + "randomize_urllist", + "scan_cache", + "shell", + "show_unparsable_versions", + "show_upload_date", + "show_zero_versions", + "tar", + "tar_verbosity", + "term_is_latin", + "term_ornaments", + "test_report", + "trust_test_report_history", + "unzip", + "urllist", + "use_sqlite", + "username", + "wait_list", + "wget", + "yaml_load_code", + "yaml_module", + ); + +my %prefssupport = map { $_ => 1 } + ( + "build_requires_install_policy", + "check_sigs", + "make", + "make_install_make_command", + "prefer_installer", + "test_report", + ); + +# returns true on successful action +sub edit { + my($self,@args) = @_; + return unless @args; + CPAN->debug("self[$self]args[".join(" | ",@args)."]"); + my($o,$str,$func,$args,$key_exists); + $o = shift @args; + if($can{$o}) { + my $success = $self->$o(args => \@args); # o conf init => sub init => sub load + unless ($success) { + die "Panic: could not configure CPAN.pm for args [@args]. Giving up."; + } + } else { + CPAN->debug("o[$o]") if $CPAN::DEBUG; + unless (exists $keys{$o}) { + $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n"); + } + my $changed; + + + # one day I used randomize_urllist for a boolean, so we must + # list them explicitly --ak + if (0) { + } elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) { + + # + # ARRAYS + # + + $func = shift @args; + $func ||= ""; + CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG; + # Let's avoid eval, it's easier to comprehend without. + if ($func eq "push") { + push @{$CPAN::Config->{$o}}, @args; + $changed = 1; + } elsif ($func eq "pop") { + pop @{$CPAN::Config->{$o}}; + $changed = 1; + } elsif ($func eq "shift") { + shift @{$CPAN::Config->{$o}}; + $changed = 1; + } elsif ($func eq "unshift") { + unshift @{$CPAN::Config->{$o}}, @args; + $changed = 1; + } elsif ($func eq "splice") { + my $offset = shift @args || 0; + my $length = shift @args || 0; + splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn + $changed = 1; + } elsif ($func) { + $CPAN::Config->{$o} = [$func, @args]; + $changed = 1; + } else { + $self->prettyprint($o); + } + if ($changed) { + if ($o eq "urllist") { + # reset the cached values + undef $CPAN::FTP::Thesite; + undef $CPAN::FTP::Themethod; + $CPAN::Index::LAST_TIME = 0; + } elsif ($o eq "dontload_list") { + # empty it, it will be built up again + $CPAN::META->{dontload_hash} = {}; + } + } + } elsif ($o =~ /_hash$/) { + + # + # HASHES + # + + if (@args==1 && $args[0] eq "") { + @args = (); + } elsif (@args % 2) { + push @args, ""; + } + $CPAN::Config->{$o} = { @args }; + $changed = 1; + } else { + + # + # SCALARS + # + + if (defined $args[0]) { + $CPAN::CONFIG_DIRTY = 1; + $CPAN::Config->{$o} = $args[0]; + $changed = 1; + } + $self->prettyprint($o) + if exists $keys{$o} or defined $CPAN::Config->{$o}; + } + if ($changed) { + if ($CPAN::Config->{auto_commit}) { + $self->commit; + } else { + $CPAN::CONFIG_DIRTY = 1; + $CPAN::Frontend->myprint("Please use 'o conf commit' to ". + "make the config permanent!\n\n"); + } + } + } +} + +sub prettyprint { + my($self,$k) = @_; + my $v = $CPAN::Config->{$k}; + if (ref $v) { + my(@report); + if (ref $v eq "ARRAY") { + @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v; + } else { + @report = map + { + sprintf "\t%-18s => %s\n", + "[$_]", + defined $v->{$_} ? "[$v->{$_}]" : "undef" + } keys %$v; + } + $CPAN::Frontend->myprint( + join( + "", + sprintf( + " %-18s\n", + $k + ), + @report + ) + ); + } elsif (defined $v) { + $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v); + } else { + $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k); + } +} + +sub commit { + my($self,@args) = @_; + CPAN->debug("args[@args]") if $CPAN::DEBUG; + if ($CPAN::RUN_DEGRADED) { + $CPAN::Frontend->mydie( + "'o conf commit' disabled in ". + "degraded mode. Maybe try\n". + " !undef \$CPAN::RUN_DEGRADED\n" + ); + } + my $configpm; + if (@args) { + if ($args[0] eq "args") { + # we have not signed that contract + } else { + $configpm = $args[0]; + } + } + unless (defined $configpm) { + $configpm ||= $INC{"CPAN/MyConfig.pm"}; + $configpm ||= $INC{"CPAN/Config.pm"}; + $configpm || Carp::confess(q{ +CPAN::Config::commit called without an argument. +Please specify a filename where to save the configuration or try +"o conf init" to have an interactive course through configing. +}); + } + my($mode); + if (-f $configpm) { + $mode = (stat $configpm)[2]; + if ($mode && ! -w _) { + Carp::confess("$configpm is not writable"); + } + } + + my $msg; + my $home = home(); + $msg = <<EOF unless $configpm =~ /MyConfig/; + +# This is CPAN.pm's systemwide configuration file. This file provides +# defaults for users, and the values can be changed in a per-user +# configuration file. The user-config file is being looked for as +# $home/.cpan/CPAN/MyConfig.pm. + +EOF + $msg ||= "\n"; + my($fh) = FileHandle->new; + rename $configpm, "$configpm~" if -f $configpm; + open $fh, ">$configpm" or + $CPAN::Frontend->mydie("Couldn't open >$configpm: $!"); + $fh->print(qq[$msg\$CPAN::Config = \{\n]); + foreach (sort keys %$CPAN::Config) { + unless (exists $keys{$_}) { + # do not drop them: forward compatibility! + $CPAN::Frontend->mywarn("Unknown config variable '$_'\n"); + next; + } + $fh->print( + " '$_' => ", + $self->neatvalue($CPAN::Config->{$_}), + ",\n" + ); + } + + $fh->print("};\n1;\n__END__\n"); + close $fh; + + #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); + #chmod $mode, $configpm; +###why was that so? $self->defaults; + $CPAN::Frontend->myprint("commit: wrote '$configpm'\n"); + $CPAN::CONFIG_DIRTY = 0; + 1; +} + +# stolen from MakeMaker; not taking the original because it is buggy; +# bugreport will have to say: keys of hashes remain unquoted and can +# produce syntax errors +sub neatvalue { + my($self, $v) = @_; + return "undef" unless defined $v; + my($t) = ref $v; + unless ($t) { + $v =~ s/\\/\\\\/g; + return "q[$v]"; + } + if ($t eq 'ARRAY') { + my(@m, @neat); + push @m, "["; + foreach my $elem (@$v) { + push @neat, "q[$elem]"; + } + push @m, join ", ", @neat; + push @m, "]"; + return join "", @m; + } + return "$v" unless $t eq 'HASH'; + my(@m, $key, $val); + while (($key,$val) = each %$v) { + last unless defined $key; # cautious programming in case (undef,undef) is true + push(@m,"q[$key]=>".$self->neatvalue($val)) ; + } + return "{ ".join(', ',@m)." }"; +} + +sub defaults { + my($self) = @_; + if ($CPAN::RUN_DEGRADED) { + $CPAN::Frontend->mydie( + "'o conf defaults' disabled in ". + "degraded mode. Maybe try\n". + " !undef \$CPAN::RUN_DEGRADED\n" + ); + } + my $done; + for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) { + if ($INC{$config}) { + CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG; + CPAN::Shell->_reload_this($config,{reloforce => 1}); + $CPAN::Frontend->myprint("'$INC{$config}' reread\n"); + last; + } + } + $CPAN::CONFIG_DIRTY = 0; + 1; +} + +=head2 C<< CLASS->safe_quote ITEM >> + +Quotes an item to become safe against spaces +in shell interpolation. An item is enclosed +in double quotes if: + + - the item contains spaces in the middle + - the item does not start with a quote + +This happens to avoid shell interpolation +problems when whitespace is present in +directory names. + +This method uses C<commands_quote> to determine +the correct quote. If C<commands_quote> is +a space, no quoting will take place. + + +if it starts and ends with the same quote character: leave it as it is + +if it contains no whitespace: leave it as it is + +if it contains whitespace, then + +if it contains quotes: better leave it as it is + +else: quote it with the correct quote type for the box we're on + +=cut + +{ + # Instead of patching the guess, set commands_quote + # to the right value + my ($quotes,$use_quote) + = $^O eq 'MSWin32' + ? ('"', '"') + : (q{"'}, "'") + ; + + sub safe_quote { + my ($self, $command) = @_; + # Set up quote/default quote + my $quote = $CPAN::Config->{commands_quote} || $quotes; + + if ($quote ne ' ' + and defined($command ) + and $command =~ /\s/ + and $command !~ /[$quote]/) { + return qq<$use_quote$command$use_quote> + } + return $command; + } +} + +sub init { + my($self,@args) = @_; + CPAN->debug("self[$self]args[".join(",",@args)."]"); + $self->load(doit => 1, @args); + 1; +} + +# This is a piece of repeated code that is abstracted here for +# maintainability. RMB +# +sub _configpmtest { + my($configpmdir, $configpmtest) = @_; + if (-w $configpmtest) { + return $configpmtest; + } elsif (-w $configpmdir) { + #_#_# following code dumped core on me with 5.003_11, a.k. + my $configpm_bak = "$configpmtest.bak"; + unlink $configpm_bak if -f $configpm_bak; + if( -f $configpmtest ) { + if( rename $configpmtest, $configpm_bak ) { + $CPAN::Frontend->mywarn(<<END); +Old configuration file $configpmtest + moved to $configpm_bak +END + } + } + my $fh = FileHandle->new; + if ($fh->open(">$configpmtest")) { + $fh->print("1;\n"); + return $configpmtest; + } else { + # Should never happen + Carp::confess("Cannot open >$configpmtest"); + } + } else { return } +} + +sub require_myconfig_or_config () { + return if $INC{"CPAN/MyConfig.pm"}; + local @INC = @INC; + my $home = home(); + unshift @INC, File::Spec->catdir($home,'.cpan'); + eval { require CPAN::MyConfig }; + my $err_myconfig = $@; + if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) { + die "Error while requiring CPAN::MyConfig:\n$err_myconfig"; + } + unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already + eval {require CPAN::Config;}; # not everybody has one + my $err_config = $@; + if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) { + die "Error while requiring CPAN::Config:\n$err_config"; + } + } +} + +sub home () { + my $home; + # Suppress load messages until we load the config and know whether + # load messages are desired. Otherwise, it's unexpected and odd + # why one load message pops up even when verbosity is turned off. + # This means File::HomeDir load messages are never seen, but I + # think that's probably OK -- DAGOLDEN + + # 5.6.2 seemed to segfault localizing a value in a hashref + # so do it manually instead + my $old_v = $CPAN::Config->{load_module_verbosity}; + $CPAN::Config->{load_module_verbosity} = q[none]; + if ($CPAN::META->has_usable("File::HomeDir")) { + $home = File::HomeDir->can('my_dot_config') + ? File::HomeDir->my_dot_config + : File::HomeDir->my_data; + unless (defined $home) { + $home = File::HomeDir->my_home + } + } + unless (defined $home) { + $home = $ENV{HOME}; + } + $CPAN::Config->{load_module_verbosity} = $old_v; + $home; +} + +sub load { + my($self, %args) = @_; + $CPAN::Be_Silent++ if $args{be_silent}; + my $doit; + $doit = delete $args{doit}; + + use Carp; + require_myconfig_or_config; + my @miss = $self->missing_config_data; + CPAN->debug("doit[$doit]loading[$loading]miss[@miss]") if $CPAN::DEBUG; + return unless $doit || @miss; + return if $loading; + $loading++; + + require CPAN::FirstTime; + my($configpm,$fh,$redo); + $redo ||= ""; + if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) { + $configpm = $INC{"CPAN/Config.pm"}; + $redo++; + } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) { + $configpm = $INC{"CPAN/MyConfig.pm"}; + $redo++; + } else { + my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); + my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN"); + my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm"); + my $inc_key; + if (-d $configpmdir or File::Path::mkpath($configpmdir)) { + $configpm = _configpmtest($configpmdir,$configpmtest); + $inc_key = "CPAN/Config.pm"; + } + unless ($configpm) { + $configpmdir = File::Spec->catdir(home,".cpan","CPAN"); + File::Path::mkpath($configpmdir); + $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm"); + $configpm = _configpmtest($configpmdir,$configpmtest); + $inc_key = "CPAN/MyConfig.pm"; + } + if ($configpm) { + $INC{$inc_key} = $configpm; + } else { + my $text = qq{WARNING: CPAN.pm is unable to } . + qq{create a configuration file.}; + output($text, 'confess'); + } + + } + local($") = ", "; + if ($redo && !$doit) { + $CPAN::Frontend->myprint(<<END); +Sorry, we have to rerun the configuration dialog for CPAN.pm due to +some missing parameters... + +END + $args{args} = \@miss; + } + my $initialized = CPAN::FirstTime::init($configpm, %args); + $loading--; + return $initialized; +} + + +# returns mandatory but missing entries in the Config +sub missing_config_data { + my(@miss); + for ( + "auto_commit", + "build_cache", + "build_dir", + "cache_metadata", + "cpan_home", + "ftp_proxy", + #"gzip", + "http_proxy", + "index_expire", + #"inhibit_startup_message", + "keep_source_where", + #"make", + "make_arg", + "make_install_arg", + "makepl_arg", + "mbuild_arg", + "mbuild_install_arg", + ($^O eq "MSWin32" ? "" : "mbuild_install_build_command"), + "mbuildpl_arg", + "no_proxy", + #"pager", + "prerequisites_policy", + "scan_cache", + #"tar", + #"unzip", + "urllist", + ) { + next unless exists $keys{$_}; + push @miss, $_ unless defined $CPAN::Config->{$_}; + } + return @miss; +} + +sub help { + $CPAN::Frontend->myprint(q[ +Known options: + commit commit session changes to disk + defaults reload default config values from disk + help this help + init enter a dialog to set all or a set of parameters + +Edit key values as in the following (the "o" is a literal letter o): + o conf build_cache 15 + o conf build_dir "/foo/bar" + o conf urllist shift + o conf urllist unshift ftp://ftp.foo.bar/ + o conf inhibit_startup_message 1 + +]); + undef; #don't reprint CPAN::Config +} + +sub cpl { + my($word,$line,$pos) = @_; + $word ||= ""; + CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; + my(@words) = split " ", substr($line,0,$pos+1); + if ( + defined($words[2]) + and + $words[2] =~ /list$/ + and + ( + @words == 3 + || + @words == 4 && length($word) + ) + ) { + return grep /^\Q$word\E/, qw(splice shift unshift pop push); + } elsif (defined($words[2]) + and + $words[2] eq "init" + and + ( + @words == 3 + || + @words >= 4 && length($word) + )) { + return sort grep /^\Q$word\E/, keys %keys; + } elsif (@words >= 4) { + return (); + } + my %seen; + my(@o_conf) = sort grep { !$seen{$_}++ } + keys %can, + keys %$CPAN::Config, + keys %keys; + return grep /^\Q$word\E/, @o_conf; +} + +sub prefs_lookup { + my($self,$distro,$what) = @_; + + if ($prefssupport{$what}) { + return $CPAN::Config->{$what} unless + $distro + and $distro->prefs + and $distro->prefs->{cpanconfig} + and defined $distro->prefs->{cpanconfig}{$what}; + return $distro->prefs->{cpanconfig}{$what}; + } else { + $CPAN::Frontend->mywarn("Warning: $what not yet officially ". + "supported for distroprefs, doing a normal lookup"); + return $CPAN::Config->{$what}; + } +} + + +{ + package + CPAN::Config; ####::###### #hide from indexer + # note: J. Nick Koston wrote me that they are using + # CPAN::Config->commit although undocumented. I suggested + # CPAN::Shell->o("conf","commit") even when ugly it is at least + # documented + + # that's why I added the CPAN::Config class with autoload and + # deprecated warning + + use strict; + use vars qw($AUTOLOAD $VERSION); + $VERSION = "5.5"; + + # formerly CPAN::HandleConfig was known as CPAN::Config + sub AUTOLOAD { ## no critic + my $class = shift; # e.g. in dh-make-perl: CPAN::Config + my($l) = $AUTOLOAD; + $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n"); + $l =~ s/.*:://; + CPAN::HandleConfig->$l(@_); + } +} + +1; + +__END__ + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# End: diff --git a/cpan/CPAN/lib/CPAN/Index.pm b/cpan/CPAN/lib/CPAN/Index.pm new file mode 100644 index 0000000000..3fa9e60229 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Index.pm @@ -0,0 +1,619 @@ +package CPAN::Index; +use strict; +use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION); +$VERSION = "1.93"; +@CPAN::Index::ISA = qw(CPAN::Debug); +$LAST_TIME ||= 0; +$DATE_OF_03 ||= 0; +# use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57 +sub PROTOCOL { 2.0 } + +#-> sub CPAN::Index::force_reload ; +sub force_reload { + my($class) = @_; + $CPAN::Index::LAST_TIME = 0; + $class->reload(1); +} + +my @indexbundle = + ( + { + reader => "rd_authindex", + dir => "authors", + remotefile => '01mailrc.txt.gz', + shortlocalfile => '01mailrc.gz', + }, + { + reader => "rd_modpacks", + dir => "modules", + remotefile => '02packages.details.txt.gz', + shortlocalfile => '02packag.gz', + }, + { + reader => "rd_modlist", + dir => "modules", + remotefile => '03modlist.data.gz', + shortlocalfile => '03mlist.gz', + }, + ); + +#-> sub CPAN::Index::reload ; +sub reload { + my($self,$force) = @_; + my $time = time; + + # XXX check if a newer one is available. (We currently read it + # from time to time) + for ($CPAN::Config->{index_expire}) { + $_ = 0.001 unless $_ && $_ > 0.001; + } + unless (1 || $CPAN::Have_warned->{readmetadatacache}++) { + # debug here when CPAN doesn't seem to read the Metadata + require Carp; + Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]"); + } + unless ($CPAN::META->{PROTOCOL}) { + $self->read_metadata_cache; + $CPAN::META->{PROTOCOL} ||= "1.0"; + } + if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) { + # warn "Setting last_time to 0"; + $LAST_TIME = 0; # No warning necessary + } + if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time + and ! $force) { + # called too often + # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]"); + } elsif (0) { + # IFF we are developing, it helps to wipe out the memory + # between reloads, otherwise it is not what a user expects. + undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274) + $CPAN::META = CPAN->new; + } else { + my($debug,$t2); + local $LAST_TIME = $time; + local $CPAN::META->{PROTOCOL} = PROTOCOL; + + my $needshort = $^O eq "dos"; + + INX: for my $indexbundle (@indexbundle) { + my $reader = $indexbundle->{reader}; + my $localfile = $needshort ? $indexbundle->{shortlocalfile} : $indexbundle->{remotefile}; + my $localpath = File::Spec->catfile($indexbundle->{dir}, $localfile); + my $remote = join "/", $indexbundle->{dir}, $indexbundle->{remotefile}; + my $localized = $self->reload_x($remote, $localpath, $force); + $self->$reader($localized); # may die but we let the shell catch it + if ($CPAN::DEBUG){ + $t2 = time; + $debug = "timing reading 01[".($t2 - $time)."]"; + $time = $t2; + } + return if $CPAN::Signal; # this is sometimes lengthy + } + $self->write_metadata_cache; + if ($CPAN::DEBUG){ + $t2 = time; + $debug .= "03[".($t2 - $time)."]"; + $time = $t2; + } + CPAN->debug($debug) if $CPAN::DEBUG; + } + if ($CPAN::Config->{build_dir_reuse}) { + $self->reanimate_build_dir; + } + if (CPAN::_sqlite_running()) { + $CPAN::SQLite->reload(time => $time, force => $force) + if not $LAST_TIME; + } + $LAST_TIME = $time; + $CPAN::META->{PROTOCOL} = PROTOCOL; +} + +#-> sub CPAN::Index::reanimate_build_dir ; +sub reanimate_build_dir { + my($self) = @_; + unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) { + return; + } + return if $HAVE_REANIMATED++; + my $d = $CPAN::Config->{build_dir}; + my $dh = DirHandle->new; + opendir $dh, $d or return; # does not exist + my $dirent; + my $i = 0; + my $painted = 0; + my $restored = 0; + my @candidates = map { $_->[0] } + sort { $b->[1] <=> $a->[1] } + map { [ $_, -M File::Spec->catfile($d,$_) ] } + grep {/\.yml$/} readdir $dh; + unless (@candidates) { + $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n"); + return; + } + $CPAN::Frontend->myprint + (sprintf("Going to read %d yaml file%s from %s/\n", + scalar @candidates, + @candidates==1 ? "" : "s", + $CPAN::Config->{build_dir} + )); + my $start = CPAN::FTP::_mytime(); + DISTRO: for $i (0..$#candidates) { + my $dirent = $candidates[$i]; + my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))}; + if ($@) { + warn "Error while parsing file '$dirent'; error: '$@'"; + next DISTRO; + } + my $c = $y->[0]; + if ($c && $c->{perl} && $c->{distribution} && CPAN->_perl_fingerprint($c->{perl})) { + my $key = $c->{distribution}{ID}; + for my $k (keys %{$c->{distribution}}) { + if ($c->{distribution}{$k} + && ref $c->{distribution}{$k} + && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) { + $c->{distribution}{$k}{COMMANDID} = $i - @candidates; + } + } + + #we tried to restore only if element already + #exists; but then we do not work with metadata + #turned off. + my $do + = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key} + = $c->{distribution}; + for my $skipper (qw( + badtestcnt + configure_requires_later + configure_requires_later_for + force_update + later + later_for + notest + should_report + sponsored_mods + prefs + negative_prefs_cache + )) { + delete $do->{$skipper}; + } + if ($do->can("tested_ok_but_not_installed")) { + if ($do->tested_ok_but_not_installed) { + $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME}); + } else { + next DISTRO; + } + } + $restored++; + } + $i++; + while (($painted/76) < ($i/@candidates)) { + $CPAN::Frontend->myprint("."); + $painted++; + } + } + my $took = CPAN::FTP::_mytime() - $start; + $CPAN::Frontend->myprint(sprintf( + "DONE\nRestored the state of %s (in %.4f secs)\n", + $restored || "none", + $took, + )); +} + + +#-> sub CPAN::Index::reload_x ; +sub reload_x { + my($cl,$wanted,$localname,$force) = @_; + $force |= 2; # means we're dealing with an index here + CPAN::HandleConfig->load; # we should guarantee loading wherever + # we rely on Config XXX + $localname ||= $wanted; + my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'}, + $localname); + if ( + -f $abs_wanted && + -M $abs_wanted < $CPAN::Config->{'index_expire'} && + !($force & 1) + ) { + my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s"; + $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }. + qq{day$s. I\'ll use that.}); + return $abs_wanted; + } else { + $force |= 1; # means we're quite serious about it. + } + return CPAN::FTP->localize($wanted,$abs_wanted,$force); +} + +#-> sub CPAN::Index::rd_authindex ; +sub rd_authindex { + my($cl, $index_target) = @_; + return unless defined $index_target; + return if CPAN::_sqlite_running(); + my @lines; + $CPAN::Frontend->myprint("Going to read '$index_target'\n"); + local(*FH); + tie *FH, 'CPAN::Tarzip', $index_target; + local($/) = "\n"; + local($_); + push @lines, split /\012/ while <FH>; + my $i = 0; + my $painted = 0; + foreach (@lines) { + my($userid,$fullname,$email) = + m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/; + $fullname ||= $email; + if ($userid && $fullname && $email) { + my $userobj = $CPAN::META->instance('CPAN::Author',$userid); + $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email); + } else { + CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG; + } + $i++; + while (($painted/76) < ($i/@lines)) { + $CPAN::Frontend->myprint("."); + $painted++; + } + return if $CPAN::Signal; + } + $CPAN::Frontend->myprint("DONE\n"); +} + +sub userid { + my($self,$dist) = @_; + $dist = $self->{'id'} unless defined $dist; + my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|; + $ret; +} + +#-> sub CPAN::Index::rd_modpacks ; +sub rd_modpacks { + my($self, $index_target) = @_; + return unless defined $index_target; + return if CPAN::_sqlite_running(); + $CPAN::Frontend->myprint("Going to read '$index_target'\n"); + my $fh = CPAN::Tarzip->TIEHANDLE($index_target); + local $_; + CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG; + my $slurp = ""; + my $chunk; + while (my $bytes = $fh->READ(\$chunk,8192)) { + $slurp.=$chunk; + } + my @lines = split /\012/, $slurp; + CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG; + undef $fh; + # read header + my($line_count,$last_updated); + while (@lines) { + my $shift = shift(@lines); + last if $shift =~ /^\s*$/; + $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1; + $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1; + } + CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG; + if (not defined $line_count) { + + $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header. +Please check the validity of the index file by comparing it to more +than one CPAN mirror. I'll continue but problems seem likely to +happen.\a +}); + + $CPAN::Frontend->mysleep(5); + } elsif ($line_count != scalar @lines) { + + $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s +contains a Line-Count header of %d but I see %d lines there. Please +check the validity of the index file by comparing it to more than one +CPAN mirror. I'll continue but problems seem likely to happen.\a\n}, +$index_target, $line_count, scalar(@lines)); + + } + if (not defined $last_updated) { + + $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header. +Please check the validity of the index file by comparing it to more +than one CPAN mirror. I'll continue but problems seem likely to +happen.\a +}); + + $CPAN::Frontend->mysleep(5); + } else { + + $CPAN::Frontend + ->myprint(sprintf qq{ Database was generated on %s\n}, + $last_updated); + $DATE_OF_02 = $last_updated; + + my $age = time; + if ($CPAN::META->has_inst('HTTP::Date')) { + require HTTP::Date; + $age -= HTTP::Date::str2time($last_updated); + } else { + $CPAN::Frontend->mywarn(" HTTP::Date not available\n"); + require Time::Local; + my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /; + $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4; + $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0; + } + $age /= 3600*24; + if ($age > 30) { + + $CPAN::Frontend + ->mywarn(sprintf + qq{Warning: This index file is %d days old. + Please check the host you chose as your CPAN mirror for staleness. + I'll continue but problems seem likely to happen.\a\n}, + $age); + + } elsif ($age < -1) { + + $CPAN::Frontend + ->mywarn(sprintf + qq{Warning: Your system date is %d days behind this index file! + System time: %s + Timestamp index file: %s + Please fix your system time, problems with the make command expected.\n}, + -$age, + scalar gmtime, + $DATE_OF_02, + ); + + } + } + + + # A necessity since we have metadata_cache: delete what isn't + # there anymore + my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN"); + CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG; + my(%exists); + my $i = 0; + my $painted = 0; + foreach (@lines) { + # before 1.56 we split into 3 and discarded the rest. From + # 1.57 we assign remaining text to $comment thus allowing to + # influence isa_perl + my($mod,$version,$dist,$comment) = split " ", $_, 4; + unless ($mod && defined $version && $dist) { + $CPAN::Frontend->mywarn("Could not split line[$_]\n"); + next; + } + my($bundle,$id,$userid); + + if ($mod eq 'CPAN' && + ! ( + CPAN::Queue->exists('Bundle::CPAN') || + CPAN::Queue->exists('CPAN') + ) + ) { + local($^W)= 0; + if ($version > $CPAN::VERSION) { + $CPAN::Frontend->mywarn(qq{ + New CPAN.pm version (v$version) available. + [Currently running version is v$CPAN::VERSION] + You might want to try + install CPAN + reload cpan + to both upgrade CPAN.pm and run the new version without leaving + the current session. + +}); #}); + $CPAN::Frontend->mysleep(2); + $CPAN::Frontend->myprint(qq{\n}); + } + last if $CPAN::Signal; + } elsif ($mod =~ /^Bundle::(.*)/) { + $bundle = $1; + } + + if ($bundle) { + $id = $CPAN::META->instance('CPAN::Bundle',$mod); + # Let's make it a module too, because bundles have so much + # in common with modules. + + # Changed in 1.57_63: seems like memory bloat now without + # any value, so commented out + + # $CPAN::META->instance('CPAN::Module',$mod); + + } else { + + # instantiate a module object + $id = $CPAN::META->instance('CPAN::Module',$mod); + + } + + # Although CPAN prohibits same name with different version the + # indexer may have changed the version for the same distro + # since the last time ("Force Reindexing" feature) + if ($id->cpan_file ne $dist + || + $id->cpan_version ne $version + ) { + $userid = $id->userid || $self->userid($dist); + $id->set( + 'CPAN_USERID' => $userid, + 'CPAN_VERSION' => $version, + 'CPAN_FILE' => $dist, + ); + } + + # instantiate a distribution object + if ($CPAN::META->exists('CPAN::Distribution',$dist)) { + # we do not need CONTAINSMODS unless we do something with + # this dist, so we better produce it on demand. + + ## my $obj = $CPAN::META->instance( + ## 'CPAN::Distribution' => $dist + ## ); + ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental + } else { + $CPAN::META->instance( + 'CPAN::Distribution' => $dist + )->set( + 'CPAN_USERID' => $userid, + 'CPAN_COMMENT' => $comment, + ); + } + if ($secondtime) { + for my $name ($mod,$dist) { + # $self->debug("exists name[$name]") if $CPAN::DEBUG; + $exists{$name} = undef; + } + } + $i++; + while (($painted/76) < ($i/@lines)) { + $CPAN::Frontend->myprint("."); + $painted++; + } + return if $CPAN::Signal; + } + $CPAN::Frontend->myprint("DONE\n"); + if ($secondtime) { + for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) { + for my $o ($CPAN::META->all_objects($class)) { + next if exists $exists{$o->{ID}}; + $CPAN::META->delete($class,$o->{ID}); + # CPAN->debug("deleting ID[$o->{ID}] in class[$class]") + # if $CPAN::DEBUG; + } + } + } +} + +#-> sub CPAN::Index::rd_modlist ; +sub rd_modlist { + my($cl,$index_target) = @_; + return unless defined $index_target; + return if CPAN::_sqlite_running(); + $CPAN::Frontend->myprint("Going to read '$index_target'\n"); + my $fh = CPAN::Tarzip->TIEHANDLE($index_target); + local $_; + my $slurp = ""; + my $chunk; + while (my $bytes = $fh->READ(\$chunk,8192)) { + $slurp.=$chunk; + } + my @eval2 = split /\012/, $slurp; + + while (@eval2) { + my $shift = shift(@eval2); + if ($shift =~ /^Date:\s+(.*)/) { + if ($DATE_OF_03 eq $1) { + $CPAN::Frontend->myprint("Unchanged.\n"); + return; + } + ($DATE_OF_03) = $1; + } + last if $shift =~ /^\s*$/; + } + push @eval2, q{CPAN::Modulelist->data;}; + local($^W) = 0; + my($compmt) = Safe->new("CPAN::Safe1"); + my($eval2) = join("\n", @eval2); + CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG; + my $ret = $compmt->reval($eval2); + Carp::confess($@) if $@; + return if $CPAN::Signal; + my $i = 0; + my $until = keys(%$ret); + my $painted = 0; + CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG; + for (keys %$ret) { + my $obj = $CPAN::META->instance("CPAN::Module",$_); + delete $ret->{$_}{modid}; # not needed here, maybe elsewhere + $obj->set(%{$ret->{$_}}); + $i++; + while (($painted/76) < ($i/$until)) { + $CPAN::Frontend->myprint("."); + $painted++; + } + return if $CPAN::Signal; + } + $CPAN::Frontend->myprint("DONE\n"); +} + +#-> sub CPAN::Index::write_metadata_cache ; +sub write_metadata_cache { + my($self) = @_; + return unless $CPAN::Config->{'cache_metadata'}; + return if CPAN::_sqlite_running(); + return unless $CPAN::META->has_usable("Storable"); + my $cache; + foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module + CPAN::Distribution)) { + $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok + } + my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata"); + $cache->{last_time} = $LAST_TIME; + $cache->{DATE_OF_02} = $DATE_OF_02; + $cache->{PROTOCOL} = PROTOCOL; + $CPAN::Frontend->myprint("Going to write $metadata_file\n"); + eval { Storable::nstore($cache, $metadata_file) }; + $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ?? +} + +#-> sub CPAN::Index::read_metadata_cache ; +sub read_metadata_cache { + my($self) = @_; + return unless $CPAN::Config->{'cache_metadata'}; + return if CPAN::_sqlite_running(); + return unless $CPAN::META->has_usable("Storable"); + my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata"); + return unless -r $metadata_file and -f $metadata_file; + $CPAN::Frontend->myprint("Going to read '$metadata_file'\n"); + my $cache; + eval { $cache = Storable::retrieve($metadata_file) }; + $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ?? + if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) { + $LAST_TIME = 0; + return; + } + if (exists $cache->{PROTOCOL}) { + if (PROTOCOL > $cache->{PROTOCOL}) { + $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ". + "with protocol v%s, requiring v%s\n", + $cache->{PROTOCOL}, + PROTOCOL) + ); + return; + } + } else { + $CPAN::Frontend->mywarn("Ignoring Metadata cache written ". + "with protocol v1.0\n"); + return; + } + my $clcnt = 0; + my $idcnt = 0; + while(my($class,$v) = each %$cache) { + next unless $class =~ /^CPAN::/; + $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok + while (my($id,$ro) = each %$v) { + $CPAN::META->{readwrite}{$class}{$id} ||= + $class->new(ID=>$id, RO=>$ro); + $idcnt++; + } + $clcnt++; + } + unless ($clcnt) { # sanity check + $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n"); + return; + } + if ($idcnt < 1000) { + $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ". + "in $metadata_file\n"); + return; + } + $CPAN::META->{PROTOCOL} ||= + $cache->{PROTOCOL}; # reading does not up or downgrade, but it + # does initialize to some protocol + $LAST_TIME = $cache->{last_time}; + $DATE_OF_02 = $cache->{DATE_OF_02}; + $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n") + if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02 + return; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/InfoObj.pm b/cpan/CPAN/lib/CPAN/InfoObj.pm new file mode 100644 index 0000000000..9198316c69 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/InfoObj.pm @@ -0,0 +1,224 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::InfoObj; +use strict; + +use CPAN::Debug; +@CPAN::InfoObj::ISA = qw(CPAN::Debug); + +use Cwd qw(chdir); + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +sub ro { + my $self = shift; + exists $self->{RO} and return $self->{RO}; +} + +#-> sub CPAN::InfoObj::cpan_userid +sub cpan_userid { + my $self = shift; + my $ro = $self->ro; + if ($ro) { + return $ro->{CPAN_USERID} || "N/A"; + } else { + $self->debug("ID[$self->{ID}]"); + # N/A for bundles found locally + return "N/A"; + } +} + +sub id { shift->{ID}; } + +#-> sub CPAN::InfoObj::new ; +sub new { + my $this = bless {}, shift; + %$this = @_; + $this +} + +# The set method may only be used by code that reads index data or +# otherwise "objective" data from the outside world. All session +# related material may do anything else with instance variables but +# must not touch the hash under the RO attribute. The reason is that +# the RO hash gets written to Metadata file and is thus persistent. + +#-> sub CPAN::InfoObj::safe_chdir ; +sub safe_chdir { + my($self,$todir) = @_; + # we die if we cannot chdir and we are debuggable + Carp::confess("safe_chdir called without todir argument") + unless defined $todir and length $todir; + if (chdir $todir) { + $self->debug(sprintf "changed directory to %s", CPAN::anycwd()) + if $CPAN::DEBUG; + } else { + if (-e $todir) { + unless (-x $todir) { + unless (chmod 0755, $todir) { + my $cwd = CPAN::anycwd(); + $CPAN::Frontend->mywarn("I have neither the -x permission nor the ". + "permission to change the permission; cannot ". + "chdir to '$todir'\n"); + $CPAN::Frontend->mysleep(5); + $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }. + qq{to todir[$todir]: $!}); + } + } + } else { + $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n"); + } + if (chdir $todir) { + $self->debug(sprintf "changed directory to %s", CPAN::anycwd()) + if $CPAN::DEBUG; + } else { + my $cwd = CPAN::anycwd(); + $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }. + qq{to todir[$todir] (a chmod has been issued): $!}); + } + } +} + +#-> sub CPAN::InfoObj::set ; +sub set { + my($self,%att) = @_; + my $class = ref $self; + + # This must be ||=, not ||, because only if we write an empty + # reference, only then the set method will write into the readonly + # area. But for Distributions that spring into existence, maybe + # because of a typo, we do not like it that they are written into + # the readonly area and made permanent (at least for a while) and + # that is why we do not "allow" other places to call ->set. + unless ($self->id) { + CPAN->debug("Bug? Empty ID, rejecting"); + return; + } + my $ro = $self->{RO} = + $CPAN::META->{readonly}{$class}{$self->id} ||= {}; + + while (my($k,$v) = each %att) { + $ro->{$k} = $v; + } +} + +#-> sub CPAN::InfoObj::as_glimpse ; +sub as_glimpse { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID}; + push @m, sprintf "%-15s %s\n", $class, $id; + join "", @m; +} + +#-> sub CPAN::InfoObj::as_string ; +sub as_string { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + push @m, $class, " id = $self->{ID}\n"; + my $ro; + unless ($ro = $self->ro) { + if (substr($self->{ID},-1,1) eq ".") { # directory + $ro = +{}; + } else { + $CPAN::Frontend->mywarn("Unknown object $self->{ID}\n"); + $CPAN::Frontend->mysleep(5); + return; + } + } + for (sort keys %$ro) { + # next if m/^(ID|RO)$/; + my $extra = ""; + if ($_ eq "CPAN_USERID") { + $extra .= " ("; + $extra .= $self->fullname; + my $email; # old perls! + if ($email = $CPAN::META->instance("CPAN::Author", + $self->cpan_userid + )->email) { + $extra .= " <$email>"; + } else { + $extra .= " <no email>"; + } + $extra .= ")"; + } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion + push @m, sprintf " %-12s %s\n", $_, $self->fullname; + next; + } + next unless defined $ro->{$_}; + push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra; + } + KEY: for (sort keys %$self) { + next if m/^(ID|RO)$/; + unless (defined $self->{$_}) { + delete $self->{$_}; + next KEY; + } + if (ref($self->{$_}) eq "ARRAY") { + push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}"; + } elsif (ref($self->{$_}) eq "HASH") { + my $value; + if (/^CONTAINSMODS$/) { + $value = join(" ",sort keys %{$self->{$_}}); + } elsif (/^prereq_pm$/) { + my @value; + my $v = $self->{$_}; + for my $x (sort keys %$v) { + my @svalue; + for my $y (sort keys %{$v->{$x}}) { + push @svalue, "$y=>$v->{$x}{$y}"; + } + push @value, "$x\:" . join ",", @svalue if @svalue; + } + $value = join ";", @value; + } else { + $value = $self->{$_}; + } + push @m, sprintf( + " %-12s %s\n", + $_, + $value, + ); + } else { + push @m, sprintf " %-12s %s\n", $_, $self->{$_}; + } + } + join "", @m, "\n"; +} + +#-> sub CPAN::InfoObj::fullname ; +sub fullname { + my($self) = @_; + $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname; +} + +#-> sub CPAN::InfoObj::dump ; +sub dump { + my($self, $what) = @_; + unless ($CPAN::META->has_inst("Data::Dumper")) { + $CPAN::Frontend->mydie("dump command requires Data::Dumper installed"); + } + local $Data::Dumper::Sortkeys; + $Data::Dumper::Sortkeys = 1; + my $out = Data::Dumper::Dumper($what ? eval $what : $self); + if (length $out > 100000) { + my $fh_pager = FileHandle->new; + local($SIG{PIPE}) = "IGNORE"; + my $pager = $CPAN::Config->{'pager'} || "cat"; + $fh_pager->open("|$pager") + or die "Could not open pager $pager\: $!"; + $fh_pager->print($out); + close $fh_pager; + } else { + $CPAN::Frontend->myprint($out); + } +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Kwalify.pm b/cpan/CPAN/lib/CPAN/Kwalify.pm new file mode 100644 index 0000000000..3cade90b91 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Kwalify.pm @@ -0,0 +1,136 @@ +=head1 NAME + +CPAN::Kwalify - Interface between CPAN.pm and Kwalify.pm + +=head1 SYNOPSIS + + use CPAN::Kwalify; + validate($schema_name, $data, $file, $doc); + +=head1 DESCRIPTION + +=over + +=item _validate($schema_name, $data, $file, $doc) + +$schema_name is the name of a supported schema. Currently only +C<distroprefs> is supported. $data is the data to be validated. $file +is the absolute path to the file the data are coming from. $doc is the +index of the document within $doc that is to be validated. The last +two arguments are only there for better error reporting. + +Relies on being called from within CPAN.pm. + +Dies if something fails. Does not return anything useful. + +=item yaml($schema_name) + +Returns the YAML text of that schema. Dies if something fails. + +=back + +=head1 AUTHOR + +Andreas Koenig C<< <andk@cpan.org> >> + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L<http://www.perl.com/perl/misc/Artistic.html> + + + +=cut + + +use strict; + +package CPAN::Kwalify; +use vars qw($VERSION $VAR1); +$VERSION = "5.50"; + +use File::Spec (); + +my %vcache = (); + +my $schema_loaded = {}; + +sub _validate { + my($schema_name,$data,$abs,$y) = @_; + my $yaml_module = CPAN->_yaml_module; + if ( + $CPAN::META->has_inst($yaml_module) + && + $CPAN::META->has_inst("Kwalify") + ) { + my $load = UNIVERSAL::can($yaml_module,"Load"); + unless ($schema_loaded->{$schema_name}) { + eval { + my $schema_yaml = yaml($schema_name); + $schema_loaded->{$schema_name} = $load->($schema_yaml); + }; + if ($@) { + # we know that YAML.pm 0.62 cannot parse the schema, + # so we try a fallback + my $content = do { + my $path = __FILE__; + $path =~ s/\.pm$//; + $path = File::Spec->catfile($path, "$schema_name.dd"); + local *FH; + open FH, $path or die "Could not open '$path': $!"; + local $/; + <FH>; + }; + $VAR1 = undef; + eval $content; + if (my $err = $@) { + die "parsing of '$schema_name.dd' failed: $err"; + } + $schema_loaded->{$schema_name} = $VAR1; + } + } + } + if (my $schema = $schema_loaded->{$schema_name}) { + my $mtime = (stat $abs)[9]; + for my $k (keys %{$vcache{$abs}}) { + delete $vcache{$abs}{$k} unless $k eq $mtime; + } + return if $vcache{$abs}{$mtime}{$y}++; + eval { Kwalify::validate($schema, $data) }; + if (my $err = $@) { + my $info = {}; yaml($schema_name, info => $info); + die "validation of distropref '$abs'[$y] against schema '$info->{path}' failed: $err"; + } + } +} + +sub _clear_cache { + %vcache = (); +} + +sub yaml { + my($schema_name, %opt) = @_; + my $content = do { + my $path = __FILE__; + $path =~ s/\.pm$//; + $path = File::Spec->catfile($path, "$schema_name.yml"); + if ($opt{info}) { + $opt{info}{path} = $path; + } + local *FH; + open FH, $path or die "Could not open '$path': $!"; + local $/; + <FH>; + }; + return $content; +} + +1; + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# End: + diff --git a/cpan/CPAN/lib/CPAN/Kwalify/distroprefs.dd b/cpan/CPAN/lib/CPAN/Kwalify/distroprefs.dd new file mode 100644 index 0000000000..fd046271b8 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Kwalify/distroprefs.dd @@ -0,0 +1,150 @@ +$VAR1 = { + "mapping" => { + "comment" => { + "type" => "text" + }, + "cpanconfig" => { + "mapping" => { + "=" => { + "type" => "text" + } + }, + "type" => "map" + }, + "depends" => { + "mapping" => { + "build_requires" => { + "mapping" => { + "=" => { + "type" => "text" + } + }, + "type" => "map" + }, + "configure_requires" => {}, + "requires" => {} + }, + "type" => "map" + }, + "disabled" => { + "enum" => [ + 0, + 1 + ], + "type" => "int" + }, + "features" => { + "sequence" => [ + { + "type" => "text" + } + ], + "type" => "seq" + }, + "goto" => { + "type" => "text" + }, + "install" => { + "mapping" => { + "args" => { + "sequence" => [ + { + "type" => "text" + } + ], + "type" => "seq" + }, + "commandline" => { + "type" => "text" + }, + "eexpect" => { + "mapping" => { + "mode" => { + "enum" => [ + "deterministic", + "anyorder" + ], + "type" => "text" + }, + "reuse" => { + "type" => "int" + }, + "talk" => { + "sequence" => [ + { + "type" => "text" + } + ], + "type" => "seq" + }, + "timeout" => { + "type" => "number" + } + }, + "type" => "map" + }, + "env" => { + "mapping" => { + "=" => { + "type" => "text" + } + }, + "type" => "map" + }, + "expect" => { + "sequence" => [ + { + "type" => "text" + } + ], + "type" => "seq" + } + }, + "type" => "map" + }, + "make" => {}, + "match" => { + "mapping" => { + "distribution" => { + "type" => "text" + }, + "env" => { + "mapping" => { + "=" => { + "type" => "text" + } + }, + "type" => "map" + }, + "module" => { + "type" => "text" + }, + "perl" => { + "type" => "text" + }, + "perlconfig" => {} + }, + "type" => "map" + }, + "patches" => { + "sequence" => [ + { + "type" => "text" + } + ], + "type" => "seq" + }, + "pl" => {}, + "reminder" => { + "type" => "text" + }, + "test" => {} + }, + "type" => "map" +}; +$VAR1->{"mapping"}{"depends"}{"mapping"}{"configure_requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"}; +$VAR1->{"mapping"}{"depends"}{"mapping"}{"requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"}; +$VAR1->{"mapping"}{"make"} = $VAR1->{"mapping"}{"install"}; +$VAR1->{"mapping"}{"match"}{"mapping"}{"perlconfig"} = $VAR1->{"mapping"}{"match"}{"mapping"}{"env"}; +$VAR1->{"mapping"}{"pl"} = $VAR1->{"mapping"}{"install"}; +$VAR1->{"mapping"}{"test"} = $VAR1->{"mapping"}{"install"}; diff --git a/cpan/CPAN/lib/CPAN/Kwalify/distroprefs.yml b/cpan/CPAN/lib/CPAN/Kwalify/distroprefs.yml new file mode 100644 index 0000000000..431f174276 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Kwalify/distroprefs.yml @@ -0,0 +1,92 @@ +--- +type: map +mapping: + comment: + type: text + depends: + type: map + mapping: + configure_requires: + &requires_common + type: map + mapping: + =: + type: text + build_requires: *requires_common + requires: *requires_common + match: + type: map + mapping: + distribution: + type: text + module: + type: text + perl: + type: text + perlconfig: + &matchhash_common + type: map + mapping: + =: + type: text + env: *matchhash_common + install: + &args_env_expect + type: map + mapping: + args: + type: seq + sequence: + - type: text + commandline: + type: text + env: + type: map + mapping: + =: + type: text + expect: + type: seq + sequence: + - type: text + eexpect: + type: map + mapping: + mode: + type: text + enum: + - deterministic + - anyorder + timeout: + type: number + reuse: + type: int + talk: + type: seq + sequence: + - type: text + make: *args_env_expect + pl: *args_env_expect + test: *args_env_expect + patches: + type: seq + sequence: + - type: text + disabled: + type: int + enum: + - 0 + - 1 + goto: + type: text + cpanconfig: + type: map + mapping: + =: + type: text + features: + type: seq + sequence: + - type: text + reminder: + type: text diff --git a/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm b/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm new file mode 100644 index 0000000000..8a5d8447e6 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm @@ -0,0 +1,135 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::LWP::UserAgent; +use strict; +use vars qw(@ISA $USER $PASSWD $SETUPDONE); +# we delay requiring LWP::UserAgent and setting up inheritance until we need it + +$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.00"; + +sub config { + return if $SETUPDONE; + if ($CPAN::META->has_usable('LWP::UserAgent')) { + require LWP::UserAgent; + @ISA = qw(Exporter LWP::UserAgent); ## no critic + $SETUPDONE++; + } else { + $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n"); + } +} + +sub get_basic_credentials { + my($self, $realm, $uri, $proxy) = @_; + if ($USER && $PASSWD) { + return ($USER, $PASSWD); + } + if ( $proxy ) { + ($USER,$PASSWD) = $self->get_proxy_credentials(); + } else { + ($USER,$PASSWD) = $self->get_non_proxy_credentials(); + } + return($USER,$PASSWD); +} + +sub get_proxy_credentials { + my $self = shift; + my ($user, $password); + if ( defined $CPAN::Config->{proxy_user} ) { + $user = $CPAN::Config->{proxy_user}; + $password = $CPAN::Config->{proxy_pass} || ""; + return ($user, $password); + } + my $username_prompt = "\nProxy authentication needed! + (Note: to permanently configure username and password run + o conf proxy_user your_username + o conf proxy_pass your_password + )\nUsername:"; + ($user, $password) = + _get_username_and_password_from_user($username_prompt); + return ($user,$password); +} + +sub get_non_proxy_credentials { + my $self = shift; + my ($user,$password); + if ( defined $CPAN::Config->{username} ) { + $user = $CPAN::Config->{username}; + $password = $CPAN::Config->{password} || ""; + return ($user, $password); + } + my $username_prompt = "\nAuthentication needed! + (Note: to permanently configure username and password run + o conf username your_username + o conf password your_password + )\nUsername:"; + + ($user, $password) = + _get_username_and_password_from_user($username_prompt); + return ($user,$password); +} + +sub _get_username_and_password_from_user { + my $username_message = shift; + my ($username,$password); + + ExtUtils::MakeMaker->import(qw(prompt)); + $username = prompt($username_message); + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("noecho"); + } + else { + $CPAN::Frontend->mywarn( + "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n" + ); + } + $password = prompt("Password:"); + + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("restore"); + } + $CPAN::Frontend->myprint("\n\n"); + return ($username,$password); +} + +# mirror(): Its purpose is to deal with proxy authentication. When we +# call SUPER::mirror, we relly call the mirror method in +# LWP::UserAgent. LWP::UserAgent will then call +# $self->get_basic_credentials or some equivalent and this will be +# $self->dispatched to our own get_basic_credentials method. + +# Our own get_basic_credentials sets $USER and $PASSWD, two globals. + +# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means +# although we have gone through our get_basic_credentials, the proxy +# server refuses to connect. This could be a case where the username or +# password has changed in the meantime, so I'm trying once again without +# $USER and $PASSWD to give the get_basic_credentials routine another +# chance to set $USER and $PASSWD. + +# mirror(): Its purpose is to deal with proxy authentication. When we +# call SUPER::mirror, we relly call the mirror method in +# LWP::UserAgent. LWP::UserAgent will then call +# $self->get_basic_credentials or some equivalent and this will be +# $self->dispatched to our own get_basic_credentials method. + +# Our own get_basic_credentials sets $USER and $PASSWD, two globals. + +# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means +# although we have gone through our get_basic_credentials, the proxy +# server refuses to connect. This could be a case where the username or +# password has changed in the meantime, so I'm trying once again without +# $USER and $PASSWD to give the get_basic_credentials routine another +# chance to set $USER and $PASSWD. + +sub mirror { + my($self,$url,$aslocal) = @_; + my $result = $self->SUPER::mirror($url,$aslocal); + if ($result->code == 407) { + undef $USER; + undef $PASSWD; + $result = $self->SUPER::mirror($url,$aslocal); + } + $result; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Module.pm b/cpan/CPAN/lib/CPAN/Module.pm new file mode 100644 index 0000000000..eae5a73aaa --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Module.pm @@ -0,0 +1,681 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Module; +use strict; +@CPAN::Module::ISA = qw(CPAN::InfoObj); + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +# Accessors +#-> sub CPAN::Module::userid +sub userid { + my $self = shift; + my $ro = $self->ro; + return unless $ro; + return $ro->{userid} || $ro->{CPAN_USERID}; +} +#-> sub CPAN::Module::description +sub description { + my $self = shift; + my $ro = $self->ro or return ""; + $ro->{description} +} + +#-> sub CPAN::Module::distribution +sub distribution { + my($self) = @_; + CPAN::Shell->expand("Distribution",$self->cpan_file); +} + +#-> sub CPAN::Module::_is_representative_module +sub _is_representative_module { + my($self) = @_; + return $self->{_is_representative_module} if defined $self->{_is_representative_module}; + my $pm = $self->cpan_file or return $self->{_is_representative_module} = 0; + $pm =~ s|.+/||; + $pm =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; # see base_id + $pm =~ s|-\d+\.\d+.+$||; + $pm =~ s|-[\d\.]+$||; + $pm =~ s/-/::/g; + $self->{_is_representative_module} = $pm eq $self->{ID} ? 1 : 0; + # warn "DEBUG: $pm eq $self->{ID} => $self->{_is_representative_module}"; + $self->{_is_representative_module}; +} + +#-> sub CPAN::Module::undelay +sub undelay { + my $self = shift; + delete $self->{later}; + if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) { + $dist->undelay; + } +} + +# mark as dirty/clean +#-> sub CPAN::Module::color_cmd_tmps ; +sub color_cmd_tmps { + my($self) = shift; + my($depth) = shift || 0; + my($color) = shift || 0; + my($ancestors) = shift || []; + # a module needs to recurse to its cpan_file + + return if exists $self->{incommandcolor} + && $color==1 + && $self->{incommandcolor}==$color; + return if $color==0 && !$self->{incommandcolor}; + if ($color>=1) { + if ( $self->uptodate ) { + $self->{incommandcolor} = $color; + return; + } elsif (my $have_version = $self->available_version) { + # maybe what we have is good enough + if (@$ancestors) { + my $who_asked_for_me = $ancestors->[-1]; + my $obj = CPAN::Shell->expandany($who_asked_for_me); + if (0) { + } elsif ($obj->isa("CPAN::Bundle")) { + # bundles cannot specify a minimum version + return; + } elsif ($obj->isa("CPAN::Distribution")) { + if (my $prereq_pm = $obj->prereq_pm) { + for my $k (keys %$prereq_pm) { + if (my $want_version = $prereq_pm->{$k}{$self->id}) { + if (CPAN::Version->vcmp($have_version,$want_version) >= 0) { + $self->{incommandcolor} = $color; + return; + } + } + } + } + } + } + } + } else { + $self->{incommandcolor} = $color; # set me before recursion, + # so we can break it + } + if ($depth>=$CPAN::MAX_RECURSION) { + die(CPAN::Exception::RecursiveDependency->new($ancestors)); + } + # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; + + if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) { + $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]); + } + # unreached code? + # if ($color==0) { + # delete $self->{badtestcnt}; + # } + $self->{incommandcolor} = $color; +} + +#-> sub CPAN::Module::as_glimpse ; +sub as_glimpse { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + my $color_on = ""; + my $color_off = ""; + if ( + $CPAN::Shell::COLOR_REGISTERED + && + $CPAN::META->has_inst("Term::ANSIColor") + && + $self->description + ) { + $color_on = Term::ANSIColor::color("green"); + $color_off = Term::ANSIColor::color("reset"); + } + my $uptodateness = " "; + unless ($class eq "Bundle") { + my $u = $self->uptodate; + $uptodateness = $u ? "=" : "<" if defined $u; + }; + my $id = do { + my $d = $self->distribution; + $d ? $d -> pretty_id : $self->cpan_userid; + }; + push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n", + $class, + $uptodateness, + $color_on, + $self->id, + $color_off, + $id, + ); + join "", @m; +} + +#-> sub CPAN::Module::dslip_status +sub dslip_status { + my($self) = @_; + my($stat); + # development status + @{$stat->{D}}{qw,i c a b R M S,} = qw,idea + pre-alpha alpha beta released + mature standard,; + # support level + @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list + developer comp.lang.perl.* + none abandoned,; + # language + @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,; + # interface + @{$stat->{I}}{qw,f r O p h n,} = qw,functions + references+ties + object-oriented pragma + hybrid none,; + # public licence + @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl + GPL LGPL + BSD Artistic Artistic_2 + open-source + distribution_allowed + restricted_distribution + no_licence,; + for my $x (qw(d s l i p)) { + $stat->{$x}{' '} = 'unknown'; + $stat->{$x}{'?'} = 'unknown'; + } + my $ro = $self->ro; + return +{} unless $ro && $ro->{statd}; + return { + D => $ro->{statd}, + S => $ro->{stats}, + L => $ro->{statl}, + I => $ro->{stati}, + P => $ro->{statp}, + DV => $stat->{D}{$ro->{statd}}, + SV => $stat->{S}{$ro->{stats}}, + LV => $stat->{L}{$ro->{statl}}, + IV => $stat->{I}{$ro->{stati}}, + PV => $stat->{P}{$ro->{statp}}, + }; +} + +#-> sub CPAN::Module::as_string ; +sub as_string { + my($self) = @_; + my(@m); + CPAN->debug("$self entering as_string") if $CPAN::DEBUG; + my $class = ref($self); + $class =~ s/^CPAN:://; + local($^W) = 0; + push @m, $class, " id = $self->{ID}\n"; + my $sprintf = " %-12s %s\n"; + push @m, sprintf($sprintf, 'DESCRIPTION', $self->description) + if $self->description; + my $sprintf2 = " %-12s %s (%s)\n"; + my($userid); + $userid = $self->userid; + if ( $userid ) { + my $author; + if ($author = CPAN::Shell->expand('Author',$userid)) { + my $email = ""; + my $m; # old perls + if ($m = $author->email) { + $email = " <$m>"; + } + push @m, sprintf( + $sprintf2, + 'CPAN_USERID', + $userid, + $author->fullname . $email + ); + } + } + push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version) + if $self->cpan_version; + if (my $cpan_file = $self->cpan_file) { + push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file); + if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) { + my $upload_date = $dist->upload_date; + if ($upload_date) { + push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date); + } + } + } + my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n"; + my $dslip = $self->dslip_status; + push @m, sprintf( + $sprintf3, + 'DSLIP_STATUS', + @{$dslip}{qw(D S L I P DV SV LV IV PV)}, + ) if $dslip->{D}; + my $local_file = $self->inst_file; + unless ($self->{MANPAGE}) { + my $manpage; + if ($local_file) { + $manpage = $self->manpage_headline($local_file); + } else { + # If we have already untarred it, we should look there + my $dist = $CPAN::META->instance('CPAN::Distribution', + $self->cpan_file); + # warn "dist[$dist]"; + # mff=manifest file; mfh=manifest handle + my($mff,$mfh); + if ( + $dist->{build_dir} + and + (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST"))) + and + $mfh = FileHandle->new($mff) + ) { + CPAN->debug("mff[$mff]") if $CPAN::DEBUG; + my $lfre = $self->id; # local file RE + $lfre =~ s/::/./g; + $lfre .= "\\.pm\$"; + my($lfl); # local file file + local $/ = "\n"; + my(@mflines) = <$mfh>; + for (@mflines) { + s/^\s+//; + s/\s.*//s; + } + while (length($lfre)>5 and !$lfl) { + ($lfl) = grep /$lfre/, @mflines; + CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG; + $lfre =~ s/.+?\.//; + } + $lfl =~ s/\s.*//; # remove comments + $lfl =~ s/\s+//g; # chomp would maybe be too system-specific + my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl); + # warn "lfl_abs[$lfl_abs]"; + if (-f $lfl_abs) { + $manpage = $self->manpage_headline($lfl_abs); + } + } + } + $self->{MANPAGE} = $manpage if $manpage; + } + my($item); + for $item (qw/MANPAGE/) { + push @m, sprintf($sprintf, $item, $self->{$item}) + if exists $self->{$item}; + } + for $item (qw/CONTAINS/) { + push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}})) + if exists $self->{$item} && @{$self->{$item}}; + } + push @m, sprintf($sprintf, 'INST_FILE', + $local_file || "(not installed)"); + push @m, sprintf($sprintf, 'INST_VERSION', + $self->inst_version) if $local_file; + if (%{$CPAN::META->{is_tested}||{}}) { # XXX needs to be methodified somehow + my $available_file = $self->available_file; + if ($available_file && $available_file ne $local_file) { + push @m, sprintf($sprintf, 'AVAILABLE_FILE', $available_file); + push @m, sprintf($sprintf, 'AVAILABLE_VERSION', $self->available_version); + } + } + join "", @m, "\n"; +} + +#-> sub CPAN::Module::manpage_headline +sub manpage_headline { + my($self,$local_file) = @_; + my(@local_file) = $local_file; + $local_file =~ s/\.pm(?!\n)\Z/.pod/; + push @local_file, $local_file; + my(@result,$locf); + for $locf (@local_file) { + next unless -f $locf; + my $fh = FileHandle->new($locf) + or $Carp::Frontend->mydie("Couldn't open $locf: $!"); + my $inpod = 0; + local $/ = "\n"; + while (<$fh>) { + $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 : + m/^=head1\s+NAME\s*$/ ? 1 : $inpod; + next unless $inpod; + next if /^=/; + next if /^\s+$/; + chomp; + push @result, $_; + } + close $fh; + last if @result; + } + for (@result) { + s/^\s+//; + s/\s+$//; + } + join " ", @result; +} + +#-> sub CPAN::Module::cpan_file ; +# Note: also inherited by CPAN::Bundle +sub cpan_file { + my $self = shift; + # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG; + unless ($self->ro) { + CPAN::Index->reload; + } + my $ro = $self->ro; + if ($ro && defined $ro->{CPAN_FILE}) { + return $ro->{CPAN_FILE}; + } else { + my $userid = $self->userid; + if ( $userid ) { + if ($CPAN::META->exists("CPAN::Author",$userid)) { + my $author = $CPAN::META->instance("CPAN::Author", + $userid); + my $fullname = $author->fullname; + my $email = $author->email; + unless (defined $fullname && defined $email) { + return sprintf("Contact Author %s", + $userid, + ); + } + return "Contact Author $fullname <$email>"; + } else { + return "Contact Author $userid (Email address not available)"; + } + } else { + return "N/A"; + } + } +} + +#-> sub CPAN::Module::cpan_version ; +sub cpan_version { + my $self = shift; + + my $ro = $self->ro; + unless ($ro) { + # Can happen with modules that are not on CPAN + $ro = {}; + } + $ro->{CPAN_VERSION} = 'undef' + unless defined $ro->{CPAN_VERSION}; + $ro->{CPAN_VERSION}; +} + +#-> sub CPAN::Module::force ; +sub force { + my($self) = @_; + $self->{force_update} = 1; +} + +#-> sub CPAN::Module::fforce ; +sub fforce { + my($self) = @_; + $self->{force_update} = 2; +} + +#-> sub CPAN::Module::notest ; +sub notest { + my($self) = @_; + # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module"); + $self->{notest}++; +} + +#-> sub CPAN::Module::rematein ; +sub rematein { + my($self,$meth) = @_; + $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n", + $meth, + $self->id)); + my $cpan_file = $self->cpan_file; + if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) { + $CPAN::Frontend->mywarn(sprintf qq{ + The module %s isn\'t available on CPAN. + + Either the module has not yet been uploaded to CPAN, or it is + temporary unavailable. Please contact the author to find out + more about the status. Try 'i %s'. +}, + $self->id, + $self->id, + ); + return; + } + my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); + $pack->called_for($self->id); + if (exists $self->{force_update}) { + if ($self->{force_update} == 2) { + $pack->fforce($meth); + } else { + $pack->force($meth); + } + } + $pack->notest($meth) if exists $self->{notest} && $self->{notest}; + + $pack->{reqtype} ||= ""; + CPAN->debug("dist-reqtype[$pack->{reqtype}]". + "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG; + if ($pack->{reqtype}) { + if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) { + $pack->{reqtype} = $self->{reqtype}; + if ( + exists $pack->{install} + && + ( + UNIVERSAL::can($pack->{install},"failed") ? + $pack->{install}->failed : + $pack->{install} =~ /^NO/ + ) + ) { + delete $pack->{install}; + $CPAN::Frontend->mywarn + ("Promoting $pack->{ID} from 'build_requires' to 'requires'"); + } + } + } else { + $pack->{reqtype} = $self->{reqtype}; + } + + my $success = eval { + $pack->$meth(); + }; + my $err = $@; + $pack->unforce if $pack->can("unforce") && exists $self->{force_update}; + $pack->unnotest if $pack->can("unnotest") && exists $self->{notest}; + delete $self->{force_update}; + delete $self->{notest}; + if ($err) { + die $err; + } + return $success; +} + +#-> sub CPAN::Module::perldoc ; +sub perldoc { shift->rematein('perldoc') } +#-> sub CPAN::Module::readme ; +sub readme { shift->rematein('readme') } +#-> sub CPAN::Module::look ; +sub look { shift->rematein('look') } +#-> sub CPAN::Module::cvs_import ; +sub cvs_import { shift->rematein('cvs_import') } +#-> sub CPAN::Module::get ; +sub get { shift->rematein('get',@_) } +#-> sub CPAN::Module::make ; +sub make { shift->rematein('make') } +#-> sub CPAN::Module::test ; +sub test { + my $self = shift; + # $self->{badtestcnt} ||= 0; + $self->rematein('test',@_); +} + +#-> sub CPAN::Module::uptodate ; +sub uptodate { + my ($self) = @_; + local ($_); + my $inst = $self->inst_version or return undef; + my $cpan = $self->cpan_version; + local ($^W) = 0; + CPAN::Version->vgt($cpan,$inst) and return 0; + my $inst_file = $self->inst_file; + # trying to support deprecated.pm by Nicholas 2009-02 + my $in_priv_or_arch = ""; + my $isa_perl = ""; + if ($] >= 5.011) { # probably harmful when distros say INSTALLDIRS=perl? + if (0 == CPAN::Version->vcmp($cpan,$inst)) { + if ($in_priv_or_arch = $self->_in_priv_or_arch($inst_file)) { + if (my $distribution = $self->distribution) { + unless ($isa_perl = $distribution->isa_perl) { + return 0; + } + } + } + } + } + CPAN->debug + (join + ("", + "returning uptodate. ", + "inst_file[$inst_file]", + "cpan[$cpan]inst[$inst]", + "in_priv_or_arch[$in_priv_or_arch]", + "isa_perl[$isa_perl]", + )) if $CPAN::DEBUG; + return 1; +} + +# returns true if installed in privlib or archlib +sub _in_priv_or_arch { + my($self,$inst_file) = @_; + for my $confdirname (qw(archlibexp privlibexp)) { + my $confdir = $Config::Config{$confdirname}; + if ($confdir eq substr($inst_file,0,length($confdir))) { + return 1; + } + } + return 0; +} + +#-> sub CPAN::Module::install ; +sub install { + my($self) = @_; + my($doit) = 0; + if ($self->uptodate + && + not exists $self->{force_update} + ) { + $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n", + $self->id, + $self->inst_version, + )); + } else { + $doit = 1; + } + my $ro = $self->ro; + if ($ro && $ro->{stats} && $ro->{stats} eq "a") { + $CPAN::Frontend->mywarn(qq{ +\n\n\n ***WARNING*** + The module $self->{ID} has no active maintainer.\n\n\n +}); + $CPAN::Frontend->mysleep(5); + } + return $doit ? $self->rematein('install') : 1; +} +#-> sub CPAN::Module::clean ; +sub clean { shift->rematein('clean') } + +#-> sub CPAN::Module::inst_file ; +sub inst_file { + my($self) = @_; + $self->_file_in_path([@INC]); +} + +#-> sub CPAN::Module::available_file ; +sub available_file { + my($self) = @_; + my $sep = $Config::Config{path_sep}; + my $perllib = $ENV{PERL5LIB}; + $perllib = $ENV{PERLLIB} unless defined $perllib; + my @perllib = split(/$sep/,$perllib) if defined $perllib; + my @cpan_perl5inc; + if ($CPAN::Perl5lib_tempfile) { + my $yaml = CPAN->_yaml_loadfile($CPAN::Perl5lib_tempfile); + @cpan_perl5inc = @{$yaml->[0]{inc} || []}; + } + $self->_file_in_path([@cpan_perl5inc,@perllib,@INC]); +} + +#-> sub CPAN::Module::file_in_path ; +sub _file_in_path { + my($self,$path) = @_; + my($dir,@packpath); + @packpath = split /::/, $self->{ID}; + $packpath[-1] .= ".pm"; + if (@packpath == 1 && $packpath[0] eq "readline.pm") { + unshift @packpath, "Term", "ReadLine"; # historical reasons + } + foreach $dir (@$path) { + my $pmfile = File::Spec->catfile($dir,@packpath); + if (-f $pmfile) { + return $pmfile; + } + } + return; +} + +#-> sub CPAN::Module::xs_file ; +sub xs_file { + my($self) = @_; + my($dir,@packpath); + @packpath = split /::/, $self->{ID}; + push @packpath, $packpath[-1]; + $packpath[-1] .= "." . $Config::Config{'dlext'}; + foreach $dir (@INC) { + my $xsfile = File::Spec->catfile($dir,'auto',@packpath); + if (-f $xsfile) { + return $xsfile; + } + } + return; +} + +#-> sub CPAN::Module::inst_version ; +sub inst_version { + my($self) = @_; + my $parsefile = $self->inst_file or return; + my $have = $self->parse_version($parsefile); + $have; +} + +#-> sub CPAN::Module::inst_version ; +sub available_version { + my($self) = @_; + my $parsefile = $self->available_file or return; + my $have = $self->parse_version($parsefile); + $have; +} + +#-> sub CPAN::Module::parse_version ; +sub parse_version { + my($self,$parsefile) = @_; + alarm(10); + my $have = eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + MM->parse_version($parsefile); + }; + if ($@) { + $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n"); + } + alarm(0); + my $leastsanity = eval { defined $have && length $have; }; + $have = "undef" unless $leastsanity; + $have =~ s/^ //; # since the %vd hack these two lines here are needed + $have =~ s/ $//; # trailing whitespace happens all the time + + $have = CPAN::Version->readable($have); + + $have =~ s/\s*//g; # stringify to float around floating point issues + $have; # no stringify needed, \s* above matches always +} + +#-> sub CPAN::Module::reports +sub reports { + my($self) = @_; + $self->distribution->reports; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Nox.pm b/cpan/CPAN/lib/CPAN/Nox.pm new file mode 100644 index 0000000000..5fe5a25ae6 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Nox.pm @@ -0,0 +1,51 @@ +package CPAN::Nox; +use strict; +use vars qw($VERSION @EXPORT); + +BEGIN{ + $CPAN::Suppress_readline=1 unless defined $CPAN::term; +} + +use base 'Exporter'; +use CPAN; + +$VERSION = "5.50"; +$CPAN::META->has_inst('Digest::MD5','no'); +$CPAN::META->has_inst('LWP','no'); +$CPAN::META->has_inst('Compress::Zlib','no'); +@EXPORT = @CPAN::EXPORT; + +*AUTOLOAD = \&CPAN::AUTOLOAD; + +1; + +__END__ + +=head1 NAME + +CPAN::Nox - Wrapper around CPAN.pm without using any XS module + +=head1 SYNOPSIS + +Interactive mode: + + perl -MCPAN::Nox -e shell; + +=head1 DESCRIPTION + +This package has the same functionality as CPAN.pm, but tries to +prevent the usage of compiled extensions during its own +execution. Its primary purpose is a rescue in case you upgraded perl +and broke binary compatibility somehow. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<CPAN> + +=cut + diff --git a/cpan/CPAN/lib/CPAN/PAUSE2003.pub b/cpan/CPAN/lib/CPAN/PAUSE2003.pub new file mode 100644 index 0000000000..7817562962 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/PAUSE2003.pub @@ -0,0 +1,31 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: OpenKeyServer v1.2 +Comment: Extracted from belgium.keyserver.net + +mQGiBD4+cJARBACxOByY0SJBBuJoFrH2hoqRFny423gY6V3jq1uTgGY/PPaxP+Sq +r3RzxPct4vJcsoo48pwBsMHLrWfORq26zb6eKgmMq/CQo2gzaRbeRxCi3ke4KBmu +aREi6RjaZSU94yABtDmspUBrpYV8zfZMv5ZIQlg9W1Tu66BFOUrrNeDpKwCgosCp +9dtNAMhHkzxs8UJH5i3Uzb0D/0VLoAE8sOfUXqjc38rxiHuGBFSNC70Ih4mzGUCJ +MGT4z1X3K6uUawnXMoc8XqPaYnEgOzztMymydtr+urjUwcGnuXDSpV6nulE5irxh +zlikSTJy/42QzTMcrdRynffmJo9PRgymMI8GgWaYG5g3zzGAhi5BA6G8JKfC93IV +xiRPBACXJpLBYQljqJY9UDNJuq8nHhKiWHBXdZzrC3LM0FSF3PKuP/ugc+KBIKXm +clNPNFKla/SRbH6dMHsGIy8wnGPI5AtTS0roNQrttv3/ghRT7+OKXrGmBxZ/KHVr +v3PVgiRA5MDr1mIsovfuc9WQnFu2TkgnN/F3pDcrVVSi5b+rZLQzUEFVU0UgQmF0 +Y2ggU2lnbmluZyBLZXkgMjAwMyA8cGF1c2VAcGF1c2UucGVybC5vcmc+iF8EExEC +AB8FAj4+cJAFCQPCZwAECwcDAgMVAgMDFgIBAh4BAheAAAoJEDKNqGdFD4nsd4sA +n3gYvr37VkUycx61wm5t4BoSO904AJ9dkl/zU5BbDnXEPKk0FNWFSnwnxbkCDQQ+ +PnCyEAgAjAKDcvpogvJvSrg3rkstDhxP4O+JZvfxzrdL9Qk0FPBlb31ECxPMBf2z +KObrwGKwxgD3+lSb/y9SgOYnAsuwztn6BqjQ8AVKiI0MFDTa+tLrtY5860X7TxJD +9bzMx/A4gEsYoFZYR4s/alGAzcqFcdQ2IiFnKE4KPtNXEMQ67lCEw5zdYSoJta9J +UKsCX3KI/DOne1NnjNZL2dQadqjsEc8mjvUOTXSG1sCawzTP5tNoPHg13GeyJ0XG +HbHY35BbF33yr9kP76+zQFaiMyLDUnyQAU/0P+rm/I6Ts6q4OZwKK/tC5LD0SPDe +08uAzkb4krRqxheo6seHdT7HjdDbKwADBgf/RGpQhhZc+F9o79S9aLV4XnY5CFev +4EJvUqq6TF9V0rvZg148mbO/b8EtOfcBSdvAfo3H8w6wcC7X8Kt/6Pl69UZKuQOt +354092gTrjJyg1uZBK9Ey/LSh0k+BNCfIw04+6W8ijARkpdoBrU3CwDKTyroWYkS +FDkkzLvJRTkMpVpqyI0xIEExPXZTf67Abv1dzceTDciblLJfQcsfDyWYv8D12ELE +zLYQnFM1s6yD6Q51Xk/XQ6MJ59bB3uuFO8VpkCMEvqIxZXsLjgqyQgo73y1qFizs +KnFG+TTvooBdG3yqSt9OsLSoRrJkZbMX3PKpbT0ceWL8dULc1v2ol4fJGohMBBgR +AgAMBQI+PnCyBQkDwmcAAAoJEDKNqGdFD4nsS44An14sFX5E2jJc87HFJeqPmeas +hdayAKCCmOqjo0CW5uepN19pXdP7BujUOw== +=ocE3 +-----END PGP PUBLIC KEY BLOCK----- diff --git a/cpan/CPAN/lib/CPAN/PAUSE2005.pub b/cpan/CPAN/lib/CPAN/PAUSE2005.pub new file mode 100644 index 0000000000..8b3324773c --- /dev/null +++ b/cpan/CPAN/lib/CPAN/PAUSE2005.pub @@ -0,0 +1,46 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.1 (GNU/Linux) + +mQGiBD4+cJARBACxOByY0SJBBuJoFrH2hoqRFny423gY6V3jq1uTgGY/PPaxP+Sq +r3RzxPct4vJcsoo48pwBsMHLrWfORq26zb6eKgmMq/CQo2gzaRbeRxCi3ke4KBmu +aREi6RjaZSU94yABtDmspUBrpYV8zfZMv5ZIQlg9W1Tu66BFOUrrNeDpKwCgosCp +9dtNAMhHkzxs8UJH5i3Uzb0D/0VLoAE8sOfUXqjc38rxiHuGBFSNC70Ih4mzGUCJ +MGT4z1X3K6uUawnXMoc8XqPaYnEgOzztMymydtr+urjUwcGnuXDSpV6nulE5irxh +zlikSTJy/42QzTMcrdRynffmJo9PRgymMI8GgWaYG5g3zzGAhi5BA6G8JKfC93IV +xiRPBACXJpLBYQljqJY9UDNJuq8nHhKiWHBXdZzrC3LM0FSF3PKuP/ugc+KBIKXm +clNPNFKla/SRbH6dMHsGIy8wnGPI5AtTS0roNQrttv3/ghRT7+OKXrGmBxZ/KHVr +v3PVgiRA5MDr1mIsovfuc9WQnFu2TkgnN/F3pDcrVVSi5b+rZLQzUEFVU0UgQmF0 +Y2ggU2lnbmluZyBLZXkgMjAwMyA8cGF1c2VAcGF1c2UucGVybC5vcmc+iF8EExEC +AB8ECwcDAgMVAgMDFgIBAh4BAheABQJB4aBfBQkHp4HPAAoJEDKNqGdFD4nsZVQA +ni9ZYmebwXfO9NgBzoDHk7g+zkiLAJ9iTRgd9ts62eNkSd9zirqRS5Rbi7QzUEFV +U0UgQmF0Y2ggU2lnbmluZyBLZXkgMjAwNSA8cGF1c2VAcGF1c2UucGVybC5vcmc+ +iGQEExECACQFAkHhoIQCGwMFCQengc8GCwkIBwMCAxUCAwMWAgECHgECF4AACgkQ +Mo2oZ0UPiezRGwCeJ4J/wVG7Vs1Uf4zlkrHcGsA5O3kAnj+9Fz0WZJWpqCqY6r75 +Fe0NlDg3uQINBD4+cLIQCACMAoNy+miC8m9KuDeuSy0OHE/g74lm9/HOt0v1CTQU +8GVvfUQLE8wF/bMo5uvAYrDGAPf6VJv/L1KA5icCy7DO2foGqNDwBUqIjQwUNNr6 +0uu1jnzrRftPEkP1vMzH8DiASxigVlhHiz9qUYDNyoVx1DYiIWcoTgo+01cQxDru +UITDnN1hKgm1r0lQqwJfcoj8M6d7U2eM1kvZ1Bp2qOwRzyaO9Q5NdIbWwJrDNM/m +02g8eDXcZ7InRcYdsdjfkFsXffKv2Q/vr7NAVqIzIsNSfJABT/Q/6ub8jpOzqrg5 +nAor+0LksPRI8N7Ty4DORviStGrGF6jqx4d1PseN0NsrAAMGB/9EalCGFlz4X2jv +1L1otXhedjkIV6/gQm9SqrpMX1XSu9mDXjyZs79vwS059wFJ28B+jcfzDrBwLtfw +q3/o+Xr1Rkq5A63fnjT3aBOuMnKDW5kEr0TL8tKHST4E0J8jDTj7pbyKMBGSl2gG +tTcLAMpPKuhZiRIUOSTMu8lFOQylWmrIjTEgQTE9dlN/rsBu/V3Nx5MNyJuUsl9B +yx8PJZi/wPXYQsTMthCcUzWzrIPpDnVeT9dDownn1sHe64U7xWmQIwS+ojFlewuO +CrJCCjvfLWoWLOwqcUb5NO+igF0bfKpK306wtKhGsmRlsxfc8qltPRx5Yvx1QtzW +/aiXh8kaiEwEGBECAAwFAj4+cLIFCQPCZwAACgkQMo2oZ0UPiexLjgCfXiwVfkTa +MlzzscUl6o+Z5qyF1rIAoIKY6qOjQJbm56k3X2ld0/sG6NQ7uQINBEHhoKMQCADR +OlH7Qrmle54v34l8wqpfjLFOoIpYdwQ/5y8dKBc6sEHxjSP80oww+PZMh/gj55yu +UimS5IaNeu6tPQZjWkzNCxZmvr+BEiTPKekJpCVy5j2b1CTZC56mIjdrqDxj2SiO +TlWP8JO7Ga0qt5AjOliLC6hy9K/20o0P8wb0yxgl0azLbwxaHPgiDyOGI9EL0p2m +k4KZmj4otFcYfGyvEi1D2fQ20u9M+S9Z//cxL+lgJFJTAe5dQaq+fVBPo7ZGVtxh +eikCVkTKsyYbpTAuW2rI12lSaKDT8QI6tIdQFYp2W49QjPFav9QdjrJOUb9QC16c +snhOiz1172aZ8TmkIb9vAAMFCACdKhFlosy6l2GzXUmWdKqdY6G/5waMKylaNY1f +lHK1D/zYJELYgOjPMmRjjUsao8dCQQ7jg/0SgBhUsc1eDOr/XuxiVwDJ0k5a/92y +Nxop35ADLcmZiRl0J7LOcXvq0sAz/s0x4C90DZreosT6SQFghOm9wD6dlmPoopaI +2TUJf6xhU9M+34uBfAa4d98gyvUKhLGHGnsapJwzZ40TLwt7HTnAcLlKv/e5x0dD +XDHEf+GlhnPpDVsgz9sU5ihO0WDZyu+NG0xLh64/YP58EIinTNvPI2VzD5TyJywa +mnQlXuQbXVdCe2DRSICkDXxC/CifwbtKW8YwLzQD4bNQp2oQiE8EGBECAA8FAkHh +oKMCGwwFCQQEUgAACgkQMo2oZ0UPiezhPgCfWjFgFrRrtruhD2+gooDofopH4WsA +n0LcYsCHZxfSskeJ5vvanfeJXv9M +=TCMr +-----END PGP PUBLIC KEY BLOCK----- diff --git a/cpan/CPAN/lib/CPAN/PAUSE2007.pub b/cpan/CPAN/lib/CPAN/PAUSE2007.pub new file mode 100644 index 0000000000..49ab2dca93 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/PAUSE2007.pub @@ -0,0 +1,62 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.6 (GNU/Linux) + +mQGiBD4+cJARBACxOByY0SJBBuJoFrH2hoqRFny423gY6V3jq1uTgGY/PPaxP+Sq +r3RzxPct4vJcsoo48pwBsMHLrWfORq26zb6eKgmMq/CQo2gzaRbeRxCi3ke4KBmu +aREi6RjaZSU94yABtDmspUBrpYV8zfZMv5ZIQlg9W1Tu66BFOUrrNeDpKwCgosCp +9dtNAMhHkzxs8UJH5i3Uzb0D/0VLoAE8sOfUXqjc38rxiHuGBFSNC70Ih4mzGUCJ +MGT4z1X3K6uUawnXMoc8XqPaYnEgOzztMymydtr+urjUwcGnuXDSpV6nulE5irxh +zlikSTJy/42QzTMcrdRynffmJo9PRgymMI8GgWaYG5g3zzGAhi5BA6G8JKfC93IV +xiRPBACXJpLBYQljqJY9UDNJuq8nHhKiWHBXdZzrC3LM0FSF3PKuP/ugc+KBIKXm +clNPNFKla/SRbH6dMHsGIy8wnGPI5AtTS0roNQrttv3/ghRT7+OKXrGmBxZ/KHVr +v3PVgiRA5MDr1mIsovfuc9WQnFu2TkgnN/F3pDcrVVSi5b+rZLQzUEFVU0UgQmF0 +Y2ggU2lnbmluZyBLZXkgMjAwNSA8cGF1c2VAcGF1c2UucGVybC5vcmc+iGQEExEC +ACQCGwMGCwkIBwMCAxUCAwMWAgECHgECF4AFAkWZglsFCQwMGEsACgkQMo2oZ0UP +iezv0gCePbUh5lK3Y2g47X+D68Pm2o5xvNQAnjvyfWafKbhDY3dNNPeuyed51x2+ +tDNQQVVTRSBCYXRjaCBTaWduaW5nIEtleSAyMDAzIDxwYXVzZUBwYXVzZS5wZXJs +Lm9yZz6IXwQTEQIAHwQLBwMCAxUCAwMWAgECHgECF4AFAkWZglsFCQwMGEsACgkQ +Mo2oZ0UPieyRJwCgjG/zr1XJhZG1O+z1RdRVbAKa7FkAoJ0z9N3AWDhv8+JGW00n ++/Asy5NUtDNQQVVTRSBCYXRjaCBTaWduaW5nIEtleSAyMDA3IDxwYXVzZUBwYXVz +ZS5wZXJsLm9yZz6IZgQTEQIAJgUCRZmClAIbAwUJDAwYSwYLCQgHAwIEFQIIAwQW +AgMBAh4BAheAAAoJEDKNqGdFD4nsSroAoIR0lnjwlXdUBv+xzI8zzwuYZryvAJ4o +d9kQPAYFcY/t68AEkzGqpGE7BrkCDQQ+PnCyEAgAjAKDcvpogvJvSrg3rkstDhxP +4O+JZvfxzrdL9Qk0FPBlb31ECxPMBf2zKObrwGKwxgD3+lSb/y9SgOYnAsuwztn6 +BqjQ8AVKiI0MFDTa+tLrtY5860X7TxJD9bzMx/A4gEsYoFZYR4s/alGAzcqFcdQ2 +IiFnKE4KPtNXEMQ67lCEw5zdYSoJta9JUKsCX3KI/DOne1NnjNZL2dQadqjsEc8m +jvUOTXSG1sCawzTP5tNoPHg13GeyJ0XGHbHY35BbF33yr9kP76+zQFaiMyLDUnyQ +AU/0P+rm/I6Ts6q4OZwKK/tC5LD0SPDe08uAzkb4krRqxheo6seHdT7HjdDbKwAD +Bgf/RGpQhhZc+F9o79S9aLV4XnY5CFev4EJvUqq6TF9V0rvZg148mbO/b8EtOfcB +SdvAfo3H8w6wcC7X8Kt/6Pl69UZKuQOt354092gTrjJyg1uZBK9Ey/LSh0k+BNCf +Iw04+6W8ijARkpdoBrU3CwDKTyroWYkSFDkkzLvJRTkMpVpqyI0xIEExPXZTf67A +bv1dzceTDciblLJfQcsfDyWYv8D12ELEzLYQnFM1s6yD6Q51Xk/XQ6MJ59bB3uuF +O8VpkCMEvqIxZXsLjgqyQgo73y1qFizsKnFG+TTvooBdG3yqSt9OsLSoRrJkZbMX +3PKpbT0ceWL8dULc1v2ol4fJGohMBBgRAgAMBQI+PnCyBQkDwmcAAAoJEDKNqGdF +D4nsS44An14sFX5E2jJc87HFJeqPmeashdayAKCCmOqjo0CW5uepN19pXdP7BujU +O7kCDQRB4aCjEAgA0TpR+0K5pXueL9+JfMKqX4yxTqCKWHcEP+cvHSgXOrBB8Y0j +/NKMMPj2TIf4I+ecrlIpkuSGjXrurT0GY1pMzQsWZr6/gRIkzynpCaQlcuY9m9Qk +2QuepiI3a6g8Y9kojk5Vj/CTuxmtKreQIzpYiwuocvSv9tKND/MG9MsYJdGsy28M +Whz4Ig8jhiPRC9KdppOCmZo+KLRXGHxsrxItQ9n0NtLvTPkvWf/3MS/pYCRSUwHu +XUGqvn1QT6O2RlbcYXopAlZEyrMmG6UwLltqyNdpUmig0/ECOrSHUBWKdluPUIzx +Wr/UHY6yTlG/UAtenLJ4Tos9de9mmfE5pCG/bwADBQgAnSoRZaLMupdhs11JlnSq +nWOhv+cGjCspWjWNX5RytQ/82CRC2IDozzJkY41LGqPHQkEO44P9EoAYVLHNXgzq +/17sYlcAydJOWv/dsjcaKd+QAy3JmYkZdCeyznF76tLAM/7NMeAvdA2a3qLE+kkB +YITpvcA+nZZj6KKWiNk1CX+sYVPTPt+LgXwGuHffIMr1CoSxhxp7GqScM2eNEy8L +ex05wHC5Sr/3ucdHQ1wxxH/hpYZz6Q1bIM/bFOYoTtFg2crvjRtMS4euP2D+fBCI +p0zbzyNlcw+U8icsGpp0JV7kG11XQntg0UiApA18Qvwon8G7SlvGMC80A+GzUKdq +EIhPBBgRAgAPBQJB4aCjAhsMBQkEBFIAAAoJEDKNqGdFD4ns4T4An1oxYBa0a7a7 +oQ9voKKA6H6KR+FrAJ9C3GLAh2cX0rJHieb72p33iV7/TLkCDQRFmYK5EAgA7pV2 +du4vVF/P6R6UPEWHgFh0LgiNhxoyP+nWSC/6F2etZBaaaS4DvoaVBGfiQ3SjCP5a +UrsdeBckhN4F+sO42ZX1+ioAXQYrZ3i80NS9LbwEzeFhgCA+u5MnF+HzapwSI7dQ +EJchlgbOeAIA5EfS3lbgG4jxUbfMBgvTWeKi/c6S9IFo9KPaRm9GyScOcGqdZAFR +JN3NUKMOPiVdiUxJdl/K1434Vcs9DSMPY3nOb56PJhjSWK+k1IjcV/zOTxSXNJVK +nzS9+eybSpgBIkwJYfKxPZQndmEdR4btgwZdD6FJ21h2YlPJBc8BpFSoIal2Ulz/ +3d1KbCoE1GmduMDGDwADBwgAu1P2QBZ7uDREdcowhYX6OR/JeMkdV92ueoCTLUnV +Zv//tNOL5sVVtGB9l4ZbsFaJ41YlUs4CIQu2nGemAKm6fAztVpZoJZ0gNbqIZ2BJ +mK1ALvR4clBqax1QudZDEcvz5C+ej9cMIzmnnk1PDSE/iH/jBXxVi+QQncd0mpFq +YZvCeAUsH/GZwAEwqFDbM3kN+Z+ED9Fy3xOYpBmfUpMCH+i+P49dNeCvNFyRtPEl +Q/BsRbVdUJy8xZUMT2NZpfR/cLrlWMN6TNPRgAYHeLIlPLYsYsje95/ZSzEXeDP5 +2HAjCVlXTMdhbvQams3Ozvmj+/+pqcB7q6OmzZpbLMcCBohPBBgRAgAPBQJFmYK5 +AhsMBQkEsQaAAAoJEDKNqGdFD4ns+ZMAoIthsa+zF8MlnHDtmFpDKTJoH4FDAJ9N +eBWYgAgj15TYGkXTsXm08udw4Q== +=t3xm +-----END PGP PUBLIC KEY BLOCK----- diff --git a/cpan/CPAN/lib/CPAN/PAUSE2009.pub b/cpan/CPAN/lib/CPAN/PAUSE2009.pub new file mode 100644 index 0000000000..fd76ec618c --- /dev/null +++ b/cpan/CPAN/lib/CPAN/PAUSE2009.pub @@ -0,0 +1,78 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.6 (GNU/Linux) + +mQGiBD4+cJARBACxOByY0SJBBuJoFrH2hoqRFny423gY6V3jq1uTgGY/PPaxP+Sq +r3RzxPct4vJcsoo48pwBsMHLrWfORq26zb6eKgmMq/CQo2gzaRbeRxCi3ke4KBmu +aREi6RjaZSU94yABtDmspUBrpYV8zfZMv5ZIQlg9W1Tu66BFOUrrNeDpKwCgosCp +9dtNAMhHkzxs8UJH5i3Uzb0D/0VLoAE8sOfUXqjc38rxiHuGBFSNC70Ih4mzGUCJ +MGT4z1X3K6uUawnXMoc8XqPaYnEgOzztMymydtr+urjUwcGnuXDSpV6nulE5irxh +zlikSTJy/42QzTMcrdRynffmJo9PRgymMI8GgWaYG5g3zzGAhi5BA6G8JKfC93IV +xiRPBACXJpLBYQljqJY9UDNJuq8nHhKiWHBXdZzrC3LM0FSF3PKuP/ugc+KBIKXm +clNPNFKla/SRbH6dMHsGIy8wnGPI5AtTS0roNQrttv3/ghRT7+OKXrGmBxZ/KHVr +v3PVgiRA5MDr1mIsovfuc9WQnFu2TkgnN/F3pDcrVVSi5b+rZLQzUEFVU0UgQmF0 +Y2ggU2lnbmluZyBLZXkgMjAwNyA8cGF1c2VAcGF1c2UucGVybC5vcmc+iGYEExEC +ACYCGwMGCwkIBwMCBBUCCAMEFgIDAQIeAQIXgAUCSXjfkAUJD850gAAKCRAyjahn +RQ+J7CnPAJ9gnTiIu532a8hxfBiSXfifTbSxaQCfXrrAg8QnRrpr//n7anf4Cife +2D20M1BBVVNFIEJhdGNoIFNpZ25pbmcgS2V5IDIwMDUgPHBhdXNlQHBhdXNlLnBl +cmwub3JnPohkBBMRAgAkAhsDBgsJCAcDAgMVAgMDFgIBAh4BAheABQJJeN+QBQkP +znSAAAoJEDKNqGdFD4nsRTMAn1ZQRTgeyvxMjP5jFnih3xOqmmLQAJwKbkN5e52T +aU5sFKRdg7rL1g9Ad7QzUEFVU0UgQmF0Y2ggU2lnbmluZyBLZXkgMjAwMyA8cGF1 +c2VAcGF1c2UucGVybC5vcmc+iF8EExECAB8ECwcDAgMVAgMDFgIBAh4BAheABQJJ +eN+QBQkPznSAAAoJEDKNqGdFD4nshpwAn0DDhprbvctI9hGxBQ7qYZDZzD50AJ0Z +vNSi4hFXgEtXii2GfPEhlHyObrQzUEFVU0UgQmF0Y2ggU2lnbmluZyBLZXkgMjAw +OSA8cGF1c2VAcGF1c2UucGVybC5vcmc+iGYEExECACYFAkl43/ECGwMFCQ/OdIAG +CwkIBwMCBBUCCAMEFgIDAQIeAQIXgAAKCRAyjahnRQ+J7IDEAJ40F0fyg6NTAZ2n +Wizs/C/RSPYPsgCfSqnVpaqF6k0H/5AabfdNbcS2Wm65Ag0EPj5wshAIAIwCg3L6 +aILyb0q4N65LLQ4cT+DviWb38c63S/UJNBTwZW99RAsTzAX9syjm68BisMYA9/pU +m/8vUoDmJwLLsM7Z+gao0PAFSoiNDBQ02vrS67WOfOtF+08SQ/W8zMfwOIBLGKBW +WEeLP2pRgM3KhXHUNiIhZyhOCj7TVxDEOu5QhMOc3WEqCbWvSVCrAl9yiPwzp3tT +Z4zWS9nUGnao7BHPJo71Dk10htbAmsM0z+bTaDx4NdxnsidFxh2x2N+QWxd98q/Z +D++vs0BWojMiw1J8kAFP9D/q5vyOk7OquDmcCiv7QuSw9Ejw3tPLgM5G+JK0asYX +qOrHh3U+x43Q2ysAAwYH/0RqUIYWXPhfaO/UvWi1eF52OQhXr+BCb1KqukxfVdK7 +2YNePJmzv2/BLTn3AUnbwH6Nx/MOsHAu1/Crf+j5evVGSrkDrd+eNPdoE64ycoNb +mQSvRMvy0odJPgTQnyMNOPulvIowEZKXaAa1NwsAyk8q6FmJEhQ5JMy7yUU5DKVa +asiNMSBBMT12U3+uwG79Xc3Hkw3Im5SyX0HLHw8lmL/A9dhCxMy2EJxTNbOsg+kO +dV5P10OjCefWwd7rhTvFaZAjBL6iMWV7C44KskIKO98tahYs7CpxRvk076KAXRt8 +qkrfTrC0qEayZGWzF9zyqW09HHli/HVC3Nb9qJeHyRqITAQYEQIADAUCPj5wsgUJ +A8JnAAAKCRAyjahnRQ+J7EuOAJ9eLBV+RNoyXPOxxSXqj5nmrIXWsgCggpjqo6NA +lubnqTdfaV3T+wbo1Du5Ag0EQeGgoxAIANE6UftCuaV7ni/fiXzCql+MsU6gilh3 +BD/nLx0oFzqwQfGNI/zSjDD49kyH+CPnnK5SKZLkho167q09BmNaTM0LFma+v4ES +JM8p6QmkJXLmPZvUJNkLnqYiN2uoPGPZKI5OVY/wk7sZrSq3kCM6WIsLqHL0r/bS +jQ/zBvTLGCXRrMtvDFoc+CIPI4Yj0QvSnaaTgpmaPii0Vxh8bK8SLUPZ9DbS70z5 +L1n/9zEv6WAkUlMB7l1Bqr59UE+jtkZW3GF6KQJWRMqzJhulMC5basjXaVJooNPx +Ajq0h1AVinZbj1CM8Vq/1B2Osk5Rv1ALXpyyeE6LPXXvZpnxOaQhv28AAwUIAJ0q +EWWizLqXYbNdSZZ0qp1job/nBowrKVo1jV+UcrUP/NgkQtiA6M8yZGONSxqjx0JB +DuOD/RKAGFSxzV4M6v9e7GJXAMnSTlr/3bI3GinfkAMtyZmJGXQnss5xe+rSwDP+ +zTHgL3QNmt6ixPpJAWCE6b3APp2WY+iilojZNQl/rGFT0z7fi4F8Brh33yDK9QqE +sYcaexqknDNnjRMvC3sdOcBwuUq/97nHR0NcMcR/4aWGc+kNWyDP2xTmKE7RYNnK +740bTEuHrj9g/nwQiKdM288jZXMPlPInLBqadCVe5BtdV0J7YNFIgKQNfEL8KJ/B +u0pbxjAvNAPhs1CnahCITwQYEQIADwUCQeGgowIbDAUJBARSAAAKCRAyjahnRQ+J +7OE+AJ9aMWAWtGu2u6EPb6CigOh+ikfhawCfQtxiwIdnF9KyR4nm+9qd94le/0y5 +Ag0ERZmCuRAIAO6VdnbuL1Rfz+kelDxFh4BYdC4IjYcaMj/p1kgv+hdnrWQWmmku +A76GlQRn4kN0owj+WlK7HXgXJITeBfrDuNmV9foqAF0GK2d4vNDUvS28BM3hYYAg +PruTJxfh82qcEiO3UBCXIZYGzngCAORH0t5W4BuI8VG3zAYL01niov3OkvSBaPSj +2kZvRsknDnBqnWQBUSTdzVCjDj4lXYlMSXZfyteN+FXLPQ0jD2N5zm+ejyYY0liv +pNSI3Ff8zk8UlzSVSp80vfnsm0qYASJMCWHysT2UJ3ZhHUeG7YMGXQ+hSdtYdmJT +yQXPAaRUqCGpdlJc/93dSmwqBNRpnbjAxg8AAwcIALtT9kAWe7g0RHXKMIWF+jkf +yXjJHVfdrnqAky1J1Wb//7TTi+bFVbRgfZeGW7BWieNWJVLOAiELtpxnpgCpunwM +7VaWaCWdIDW6iGdgSZitQC70eHJQamsdULnWQxHL8+Qvno/XDCM5p55NTw0hP4h/ +4wV8VYvkEJ3HdJqRamGbwngFLB/xmcABMKhQ2zN5DfmfhA/Rct8TmKQZn1KTAh/o +vj+PXTXgrzRckbTxJUPwbEW1XVCcvMWVDE9jWaX0f3C65VjDekzT0YAGB3iyJTy2 +LGLI3vef2UsxF3gz+dhwIwlZV0zHYW70GprNzs75o/v/qanAe6ujps2aWyzHAgaI +TwQYEQIADwUCRZmCuQIbDAUJBLEGgAAKCRAyjahnRQ+J7PmTAKCLYbGvsxfDJZxw +7ZhaQykyaB+BQwCfTXgVmIAII9eU2BpF07F5tPLncOG5Ag0ESXjgRxAIANNFPYOO +sVGbMk7D420WQHC0Sbs+DVRP6U254nAdNQNQw9PbyFB0vwkfWddsFEA/g9OLVlQV +uSsIVgAiDNuKIxRT3GApZwtFYz5M4Hfc923HP9+Co50kNwYKbgoB43RkZB+1/pFs +ncH73vXg7G9BK/EsZ3uMV/LVhxu6+xR8rnxyfh4F/11XVvrnZ6e/b1Nn6YkZDtEv +MpkF5jAyfJyCy/UPT8s5kQFSKF5+bB7m7Thlvcd+Z6ucQ7XJHeqEyWY3XRBsUk21 +Zu8IzkL4hCLdkhXnRjbHPpIrZQ7ALlIXjAUX4sizSiHK9MqiL2lkAne+jQgse8La +tut0jI8MsUOwNTMAAwUH/jzhcmsEAcYpICwZ3z5vyynrTYAkSfYByrKVXLPFpChZ +rAVCfgKu0oPqsdzEWj47eNR2aZv/DX8w2/PbvqAZgqP8GSQy41/K1g9KIiPUuUlq +wujm0OVZ+DEAhBh0J3HJLinR+HSuxQqjb7CkSPz7Em8GP1MfnQPTngHxHQuQ39Sb +u06VM8IofmzgsvR61OMS0c+yc43xRflTrWSaiu6hnGdrIs0WKH0OZQafkeHwzg8w +tw+nwYj4o3F9TFDWeVB/GSD1yUCJ7TTfAjwR7pgToQ45BLhf7RMEW2U1Wn8VFBWj +f9wI34+aOrvLWxlEhAyosHBOf10xNQVWyeYcjJ299k6ITwQYEQIADwUCSXjgRwIb +DAUJBJQFgAAKCRAyjahnRQ+J7FyoAJ4pjYHpZnaaLnTTjygCTZO4COljpQCdHkqE +cVHe2u7+E3qfdy9iNsdAqww= +=Aadt +-----END PGP PUBLIC KEY BLOCK----- diff --git a/cpan/CPAN/lib/CPAN/Prompt.pm b/cpan/CPAN/lib/CPAN/Prompt.pm new file mode 100644 index 0000000000..7a4e2d81e1 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Prompt.pm @@ -0,0 +1,29 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::Prompt; +use overload '""' => "as_string"; +use vars qw($prompt); +use vars qw( + $VERSION +); +$VERSION = "5.5"; + + +$prompt = "cpan> "; +$CPAN::CurrentCommandId ||= 0; +sub new { + bless {}, shift; +} +sub as_string { + my $word = "cpan"; + unless ($CPAN::META->{LOCK}) { + $word = "nolock_cpan"; + } + if ($CPAN::Config->{commandnumber_in_prompt}) { + sprintf "$word\[%d]> ", $CPAN::CurrentCommandId; + } else { + "$word> "; + } +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Queue.pm b/cpan/CPAN/lib/CPAN/Queue.pm new file mode 100644 index 0000000000..b60f57c1cf --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Queue.pm @@ -0,0 +1,198 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +use strict; +package CPAN::Queue::Item; + +# CPAN::Queue::Item::new ; +sub new { + my($class,@attr) = @_; + my $self = bless { @attr }, $class; + return $self; +} + +sub as_string { + my($self) = @_; + $self->{qmod}; +} + +# r => requires, b => build_requires, c => commandline +sub reqtype { + my($self) = @_; + $self->{reqtype}; +} + +package CPAN::Queue; + +# One use of the queue is to determine if we should or shouldn't +# announce the availability of a new CPAN module + +# Now we try to use it for dependency tracking. For that to happen +# we need to draw a dependency tree and do the leaves first. This can +# easily be reached by running CPAN.pm recursively, but we don't want +# to waste memory and run into deep recursion. So what we can do is +# this: + +# CPAN::Queue is the package where the queue is maintained. Dependencies +# often have high priority and must be brought to the head of the queue, +# possibly by jumping the queue if they are already there. My first code +# attempt tried to be extremely correct. Whenever a module needed +# immediate treatment, I either unshifted it to the front of the queue, +# or, if it was already in the queue, I spliced and let it bypass the +# others. This became a too correct model that made it impossible to put +# an item more than once into the queue. Why would you need that? Well, +# you need temporary duplicates as the manager of the queue is a loop +# that +# +# (1) looks at the first item in the queue without shifting it off +# +# (2) cares for the item +# +# (3) removes the item from the queue, *even if its agenda failed and +# even if the item isn't the first in the queue anymore* (that way +# protecting against never ending queues) +# +# So if an item has prerequisites, the installation fails now, but we +# want to retry later. That's easy if we have it twice in the queue. +# +# I also expect insane dependency situations where an item gets more +# than two lives in the queue. Simplest example is triggered by 'install +# Foo Foo Foo'. People make this kind of mistakes and I don't want to +# get in the way. I wanted the queue manager to be a dumb servant, not +# one that knows everything. +# +# Who would I tell in this model that the user wants to be asked before +# processing? I can't attach that information to the module object, +# because not modules are installed but distributions. So I'd have to +# tell the distribution object that it should ask the user before +# processing. Where would the question be triggered then? Most probably +# in CPAN::Distribution::rematein. + +use vars qw{ @All $VERSION }; +$VERSION = "5.5"; + +# CPAN::Queue::queue_item ; +sub queue_item { + my($class,@attr) = @_; + my $item = "$class\::Item"->new(@attr); + $class->qpush($item); + return 1; +} + +# CPAN::Queue::qpush ; +sub qpush { + my($class,$obj) = @_; + push @All, $obj; + CPAN->debug(sprintf("in new All[%s]", + join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All), + )) if $CPAN::DEBUG; +} + +# CPAN::Queue::first ; +sub first { + my $obj = $All[0]; + $obj; +} + +# CPAN::Queue::delete_first ; +sub delete_first { + my($class,$what) = @_; + my $i; + for my $i (0..$#All) { + if ( $All[$i]->{qmod} eq $what ) { + splice @All, $i, 1; + return; + } + } +} + +# CPAN::Queue::jumpqueue ; +sub jumpqueue { + my $class = shift; + my @what = @_; + CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]", + join("", + map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All, @what + ))) if $CPAN::DEBUG; + unless (defined $what[0]{reqtype}) { + # apparently it was not the Shell that sent us this enquiry, + # treat it as commandline + $what[0]{reqtype} = "c"; + } + my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b"; + WHAT: for my $what_tuple (@what) { + my($what,$reqtype) = @$what_tuple{qw(qmod reqtype)}; + if ($reqtype eq "r" + && + $inherit_reqtype eq "b" + ) { + $reqtype = "b"; + } + my $jumped = 0; + for (my $i=0; $i<$#All;$i++) { #prevent deep recursion + # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG; + if ($All[$i]{qmod} eq $what) { + $jumped++; + if ($jumped >= 50) { + die "PANIC: object[$what] 50 instances on the queue, looks like ". + "some recursiveness has hit"; + } elsif ($jumped > 25) { # one's OK if e.g. just processing + # now; more are OK if user typed + # it several times + my $sleep = sprintf "%.1f", $jumped/10; + $CPAN::Frontend->mywarn( +qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n} + ); + $CPAN::Frontend->mysleep($sleep); + # next WHAT; + } + } + } + my $obj = "$class\::Item"->new( + qmod => $what, + reqtype => $reqtype + ); + unshift @All, $obj; + } + CPAN->debug(sprintf("after jumpqueue All[%s]", + join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All) + )) if $CPAN::DEBUG; +} + +# CPAN::Queue::exists ; +sub exists { + my($self,$what) = @_; + my @all = map { $_->{qmod} } @All; + my $exists = grep { $_->{qmod} eq $what } @All; + # warn "in exists what[$what] all[@all] exists[$exists]"; + $exists; +} + +# CPAN::Queue::delete ; +sub delete { + my($self,$mod) = @_; + @All = grep { $_->{qmod} ne $mod } @All; + CPAN->debug(sprintf("after delete mod[%s] All[%s]", + $mod, + join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All) + )) if $CPAN::DEBUG; +} + +# CPAN::Queue::nullify_queue ; +sub nullify_queue { + @All = (); +} + +# CPAN::Queue::size ; +sub size { + return scalar @All; +} + +1; + +__END__ + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut diff --git a/cpan/CPAN/lib/CPAN/SIGNATURE b/cpan/CPAN/lib/CPAN/SIGNATURE new file mode 100644 index 0000000000..286b255575 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/SIGNATURE @@ -0,0 +1,481 @@ +This file contains message digests of all files listed in MANIFEST, +signed via the Module::Signature module, version 0.55. + +To verify the content in this distribution, first make sure you have +Module::Signature installed, then type: + + % cpansign -v + +It will check each file's integrity, as well as the signature's +validity. If "==> Signature verified OK! <==" is not displayed, +the distribution may already have been compromised, and you should +not run its Makefile.PL or Build.PL. + +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +SHA1 6e8d0b0d1883761e588707bd952de40bbe3a485e Changes +SHA1 0ea0887959becc8c039f8c37b6a9b2c164200aeb MANIFEST +SHA1 97732eaafa3212deb5fe0e292f70e25ce5ee66a7 MANIFEST.SKIP +SHA1 bfb57c4a633e130303959cd23ba5798e59adeb67 META.yml +SHA1 90bcb550c498de8b05a636e9c85ff1dad5b107d0 Makefile.PL +SHA1 37e858c51409a297ef5d3fb35dc57cd3b57f9a4d PAUSE2003.pub +SHA1 af016003ad503ed078c5f8254521d13a3e0c494f PAUSE2005.pub +SHA1 a3941566358617b918e0bb7b5c4c2638f451a9d8 PAUSE2007.pub +SHA1 6bd0c71ccaf4e9cd77d13a330f02714c08af4de8 PAUSE2009.pub +SHA1 baf5f4df67c583a50193fbc88a465f733492ce23 README +SHA1 efeeb5816ec6e9fbf95384b37fd0a3f76870658c SlayMakefile +SHA1 c08973601e45068809e6499b98a181b4445f5e33 Todo +SHA1 9928e72969096af7df7a4e54c284da21b457c47f distroprefs/00.README +SHA1 79848ebd7fbf81020d38ea81c3b8b989f2ab16fb distroprefs/01.DISABLED.yml +SHA1 377ded2410b847e9ed060b2d1c0dc165cc85c9e7 distroprefs/02.NOREPORT.yml +SHA1 326fc1d05811f13b9e71d341a4eac86c60f06f7d distroprefs/ABELTJE.Test-Smoke.yml +SHA1 a45e5c86c772444a72c22303758f835780ba6b71 distroprefs/ABW.Template-Toolkit.yml +SHA1 adc4cb439b28ecc2ef10c63f34efb88475e306be distroprefs/ACG.Scrabble-Dict.yml +SHA1 de18eeb17d580afbe86e05c71b56457c43f61dde distroprefs/ACH.Tk-Contrib.yml +SHA1 f548764dc4b575d772c3af9f9d83d18321fbd202 distroprefs/ADAMK.Chart-Math-Axis.yml +SHA1 8b68d317e8a2f7875fc634536fe10159a8bf81e2 distroprefs/ADAMK.Image-Delivery.yml +SHA1 002442babbc2b516bbe4793188ad5435a1c8189d distroprefs/ADAMK.PPI.yml +SHA1 4b46b611acd0265d98e43a8263716f5fae83b9cc distroprefs/ADAMK.Test-ClassAPI.yml +SHA1 18d53ac2d3d801cdd37d4f5280c76ef89335c3f1 distroprefs/ADAMK.Test-Inline.yml +SHA1 6e505736a3259660f80d96db4e995938decd40b4 distroprefs/AGENT.OpenResty.yml +SHA1 af2a4a9c72895c8e13b6c194bbf53d75e79eb0aa distroprefs/AGRUNDMA.POE-Loop-EV.yml +SHA1 57ed2146b1be91f5248db77dcabf47f77bda36ac distroprefs/AMICHAUER.Unicode-Lite.yml +SHA1 25d2ff1b3f7e949b0e0583b7d0bbad1c6ae3eac9 distroprefs/ANDK.CPAN-Test-Dummy-Perl5-Build-Fails.yml +SHA1 0baa8fb59f69008f11a6a17043d2a5954534bbaa distroprefs/ANDK.CPAN-Test-Dummy-Perl5-Make-Expect.yml +SHA1 6a2015457edfc1e81682496645ec8ad654393246 distroprefs/ANDREWF.LaTeX-Driver.yml +SHA1 e2e0a4de163ed00631cc43c6efa6b0d0baca0181 distroprefs/ANDYA.File-Find-Parallel.yml +SHA1 75ba6bf3dc08ff216c5ea687cc60445504813bc4 distroprefs/ANDYA.Perl-Version.yml +SHA1 fc84f7d472266de36c6d4c7047584cbcfd085a00 distroprefs/ANDYA.TAP-Parser.yml +SHA1 38e8d5afae5d648ba306fbb5a4ffc892c0297148 distroprefs/ANDYA.Test-Harness.yml +SHA1 240a4624bbc62e5ca3ac878ad45fc47e2ffcc57c distroprefs/ARFREITAS.DTS.yml +SHA1 878a77df89c8b3225112290b037e421dfd264104 distroprefs/ARJAY.Compress-Bzip2.yml +SHA1 c2b41372baf5e79cd2d825baa000d00bdf612b4f distroprefs/ASCOPE.Net-Google.yml +SHA1 1bf3201e105ac95c74fd65853ce97691751610a0 distroprefs/ATOURBIN.rpm-build-perl.yml +SHA1 decf7fc4f592603470c410b823c24726c6acaa57 distroprefs/AUDREYT.Module-Signature.yml +SHA1 a64c5cae865216bb69bfa8147e034000e484a0c0 distroprefs/AUDREYT.PDF-FromHTML.yml +SHA1 61ff9755c8c70276d4514232bbb13a966e663097 distroprefs/AUDREYT.YAML-Syck.yml +SHA1 b0c942fa0256d96898732c8ac3cf023777ca4c01 distroprefs/AVIF.Time-Duration.yml +SHA1 5fb5917c8b746c671f180ffeb7139554aa11f150 distroprefs/BDFOY.Business-ISBN.yml +SHA1 eb02bdafd0208a823f10c68d326682d9ab209b49 distroprefs/BDFOY.Module-Release.yml +SHA1 7695bd3c485f904f3550281e8018cac5b9fa90df distroprefs/BDFOY.Test-HTTPStatus.yml +SHA1 a48bf158f64e969c5796a504143af509c63c5a25 distroprefs/BINGOS.POE-Component-CPAN-YACSmoke.yml +SHA1 6f8ad46c577b0d5c88b4ce69da1a959dd7df1df8 distroprefs/BINGOS.POE-Component-Client-FTP.yml +SHA1 9792abff9bc890fb1d13bc59c9f0b72828cd4cc4 distroprefs/BINGOS.POE-Component-Client-NSCA.yml +SHA1 1c09964633212cd946ca6cae5f17924a8b34d040 distroprefs/BINGOS.POE-Component-Server-NSCA.yml +SHA1 9d7985a25ad9127436ab1d4dc95b71808da6c8cf distroprefs/BINGOS.POE-Component-Server-SimpleContent.yml +SHA1 b46647f67ca1748b4f2d5db8b3d41ce4253b19b6 distroprefs/BINGOS.POE-Component-Server-SimpleHTTP.yml +SHA1 3aee22657088b5f7c99db2c74ff59c69e4ee6a20 distroprefs/BINGOS.POE-Component-SmokeBox-Recent.yml +SHA1 1260ac0f4afb91470b46fc6adf634c1f86142443 distroprefs/BLUEFEET.GIS-Distance.yml +SHA1 45833aebd23d35076bfb8f9ebc958237f3a970a9 distroprefs/BOBTFISH.Text-Markdown.yml +SHA1 261bb596940d3639374d6debace056282e34ac58 distroprefs/BRADFITZ.Perlbal.yml +SHA1 ac322ccd006c03a4799dbfd47701a4202ef73f8b distroprefs/BRIANSKI.XML-Comma.yml +SHA1 48303ba0f66618b81b35a9667265ed4ea8215f16 distroprefs/BRYCE.SVG-Metadata.yml +SHA1 1af9575bdc1f1412f8ee6a7161260944905413e6 distroprefs/BSMITH.Devel-EvalContext.yml +SHA1 7c19fdbeef0a8caf0d0b3a23d5697e7310ae6417 distroprefs/BTROTT.Convert-PEM.yml +SHA1 80302cbcb79e9f24ac6b26bc5b00e43856fb400c distroprefs/BTROTT.Crypt-DH.yml +SHA1 75095401e767dadd92b0e5543923493a5ec78a18 distroprefs/BTROTT.Crypt-DSA.yml +SHA1 8f24308b2d750350a95132b8735f5211f6abfa37 distroprefs/BTROTT.Crypt-OpenPGP.yml +SHA1 cfe5f5535232d6f1f10ad00635d313895ddcbb84 distroprefs/BTROTT.XML-FOAF.yml +SHA1 c7b27ae98c2a16d7119dcfa0db3fa5f996a695a3 distroprefs/BWARFIELD.GDGraph.yml +SHA1 46e075883c9f9530d80b8fc64d4bf2d8b13a979f distroprefs/BYRNE.SOAP-Lite.yml +SHA1 0e237d1b65ba8a93e7bfd108c7accb7e4249fd42 distroprefs/CAPTTOFU.DBD-mysql.yml +SHA1 39fd3feb1b9cce3acb94375fba517d5481baba70 distroprefs/CDENT.Kwiki-Test.yml +SHA1 279eaba864447b22b4c95f8088b5b06c1f2eb1ff distroprefs/CERNEY.Tk-IDElayout.yml +SHA1 6a168c6f5d311b9e55a7d6591115d7f95df68084 distroprefs/CHANG-LIU.XML-Node.yml +SHA1 81c8581de621425cbc94d7d6e1550a0f050198b8 distroprefs/CHARTGRP.Chart.yml +SHA1 fa614c51395fd70d8a0400c5daecf2984645e853 distroprefs/CHISEL.Zucchini.yml +SHA1 abc806da6a613e656d580a7803427a810f3b46ff distroprefs/CHOCOLATE.Scalar-Util-Clone.yml +SHA1 e68d441a2d833c7b5655df8c9fc953f9e6538050 distroprefs/CLACO.Class-Accessor-Grouped.yml +SHA1 6721dfa1e464c57ec7221a44107de736ae71584d distroprefs/CLAESJAC.JavaScript.yml +SHA1 752fd5d043349c7bb32b58a817b3af4251b6e758 distroprefs/CLKAO.App-CLI.yml +SHA1 a97c93bab5620a33ec3b940f40a36b29e3d6ab1e distroprefs/CLKAO.IO-Digest.yml +SHA1 84755defdbb3b2c85d1db01458ced9f4dc8a76c9 distroprefs/CLKAO.SVN-Mirror.yml +SHA1 cfd953eebabdef8e99d7130efe0956a61c21f18a distroprefs/CMOORE.Archive-Any.yml +SHA1 9c3ac6c4a83954425ebfb99e43218d49062c09e4 distroprefs/CORDATA.Kwiki-Formatter-Emphasis.yml +SHA1 7eaac0445622a261cc2e16fd662da8403fc94f77 distroprefs/CORION.List-Sliding-Changes.yml +SHA1 3e715d83c3a6dd91b41e0cfc3da65ac2a30b9bba distroprefs/CRISB.WWW-Curl.yml +SHA1 ed4cd51161403364c068704fad18798cd6149c0c distroprefs/CSOE.PDL.yml +SHA1 7bbe66d00c3b861812492df464a8fe41e9684c0d distroprefs/DAGOLDEN.CPAN-Reporter.yml +SHA1 720b4fd7ffde3134624a6125e97f2165a25a744f distroprefs/DAGOLDEN.Term-Title.yml +SHA1 49d0a317721ef32c8e80d678fa9d7bfe4745edb3 distroprefs/DAMS.RT-Client-REST.yml +SHA1 871d0ded5a5fbaaa1cb9ce5a5e8ad332d5d5693d distroprefs/DANKOGAI.Regexp-Optimizer.yml +SHA1 d6577eaba4d306d0afbd4428292a496d39c7712c distroprefs/DAXIM.Yahoo-Photos.yml +SHA1 b4e4d7072114273e67f177dba5ae56a012bc94e3 distroprefs/DBRIAN.XML-SimpleObject.yml +SHA1 1cb001f569255d50296839883bdfc07190a4269d distroprefs/DBROBINS.Net-SSH-Perl.yml +SHA1 bc25efab0318c03d85a104bbbcb0660bb57ac942 distroprefs/DCANTRELL.Devel-CheckOS.yml +SHA1 75fcbf2e105cbd0891c785693b73c15b936e304e distroprefs/DCONWAY.Parse-RecDescent.yml +SHA1 b975d4234f75c698cd7fca674c0411c86e6bfcb6 distroprefs/DCOPPIT.Mail-Mbox-MessageParser.yml +SHA1 b565742f186afb736dc03acc204446b6135abff5 distroprefs/DDUMONT.Tk-ObjScanner.yml +SHA1 03cd47b82170c01f58a17d954f125ce1ac9a839f distroprefs/DHARRIS.DB_File-Lock.yml +SHA1 f96104c3f60214bd50789474e1e31624045f239d distroprefs/DJBERG.Tk-JListbox.yml +SHA1 1b23871720a7ed2e114dd5e93ae88455b0c1f376 distroprefs/DJKERNEN.Mail-IMAPClient.yml +SHA1 07975dd28ea0f7a8abc9d7f1cbc69791a012952d distroprefs/DKWILSON.Tk-DKW.yml +SHA1 27b107f473bafaf91a0cee9fed5ecb9d9c0dcc0c distroprefs/DLAND.Crypt-SSLeay.yml +SHA1 3f62c22b461eef2b8b592903295fe2cbf28e08a4 distroprefs/DMAKI.Class-DBI-Plugin-DateTime.yml +SHA1 607278c77aa229dd6c9b382704f52cfc494e58fc distroprefs/DMAKI.DateTime-X.yml +SHA1 66725756baf6fd496751267731bcfcbbb54d1f5b distroprefs/DMAKI.File-Extract.yml +SHA1 41d5f13d007f533076378052cbf48a51e880b160 distroprefs/DMAKI.Xango.yml +SHA1 f11b7065a6dd00234f6bca7f2ab13771cdacad98 distroprefs/DMARTIN.Unix-SavedIDs.yml +SHA1 c2481ac12aacc6008b390881263db6028243dcc8 distroprefs/DMUEY.File-Copy-Recursive.yml +SHA1 f16da80410d98c48476b0f7b2f856f74b79ed640 distroprefs/DOM.OpenGuides.yml +SHA1 1f9de8d8d780f71b34b240205501adb1dacc724e distroprefs/DOMM.Module-CPANTS-ProcessCPAN.yml +SHA1 4e6948397ea832c86b374db4bd3b7895f096d3b1 distroprefs/DONEILL.MIME-tools.yml +SHA1 aa33f55f43be8d220492b125e8ab9296bbb01de1 distroprefs/DOWENS.JSON-DWIW.yml +SHA1 640e6c03aab5df568d27816e7e6a81adf1359237 distroprefs/DROLSKY.Alzabo.yml +SHA1 99275c9aadec7e586e576256599dfa5b393e9261 distroprefs/DROLSKY.DateTime-Locale.yml +SHA1 1e5e84bb7b5ebaa44988207050da37883bbd0335 distroprefs/DROLSKY.Devel-StackTrace.yml +SHA1 72078280d49350a50ee9035f1d3190a10bc4d19e distroprefs/DROLSKY.Params-Validate.yml +SHA1 4913fc5a830a7e7a2a5ec2737c302a7ee8ac39f1 distroprefs/DRTECH.Config-Loader.yml +SHA1 e21fd0031c45a351fcd8ca0095d0aa09629aa24d distroprefs/DSKOLL.MIME-tools.yml +SHA1 fe533a848487ea3ea99f21c2f553d3e608efb85f distroprefs/DSUGAL.Devel-Size.yml +SHA1 659f3e3a410d4ad3866cf90c98e52420c9c892f1 distroprefs/DUNNIGANJ.Tk-CursorControl.yml +SHA1 887d92e9be51998e75b0707e1127abdd773dc252 distroprefs/DURIST.WWW-Babelfish.yml +SHA1 01ffd3bc7d2e67d2507c55e50c560ea0da409a13 distroprefs/DWHEELER.Params-CallbackRequest.yml +SHA1 bf61479adb94d120f118e6635f48f6beb0f653a9 distroprefs/EBOHLMAN.Text-Query.yml +SHA1 47bf06fd295ae32fcd87fb78bb92adeeaeaa2341 distroprefs/EESTABROO.IMAP-Admin.yml +SHA1 4bf20fc79554ef1ab798b752f5533de3ee8b31ba distroprefs/EIJABB.MARC-Errorchecks.yml +SHA1 85ea296fe8cde1230bc184a179eb9363be57f52a distroprefs/ERIC.OpenThought.yml +SHA1 6fb9d41f672ec668c4da795045111ea826fc1c12 distroprefs/ERYQ.Convert-BinHex.yml +SHA1 6d1af2cd50467aeefc6fb0af9ba3ca85b446c4db distroprefs/ESUMMERS.MARC-Charset.yml +SHA1 ad2e43724d80e3b02de39fbcd4581e0742c666cd distroprefs/EWILHELM.Math-Vec.yml +SHA1 45a715a5322fb362a87857ae77a1613520bf7f83 distroprefs/FABPOT.Plucene-Plugin-Analyzer-SnowballAnalyzer.yml +SHA1 62acd9323137cf1f1e5425d19c645066018c172d distroprefs/FDALY.Test-Deep.yml +SHA1 19af3c488c75abd32b650a17ff24b9f141ebb524 distroprefs/FHOXH.Test-Reporter.yml +SHA1 6082e0f3ed911a319ef67d4f3a47cc3cf42cb82f distroprefs/FLORA.File-Extractor.yml +SHA1 5cb56427373f2bfd8a332b49dfef8670d1d01538 distroprefs/FLORA.Net_SSLeay.yml +SHA1 8be3d5141dc0059621cc5d6ea8883719339fff85 distroprefs/FLUFFY.Class-MethodMaker.yml +SHA1 f790c18e2a9195ff6b8902f267636137dfd3d86e distroprefs/FOTANGO.Data-Structure-Util.yml +SHA1 564f4f0390742d30773d246bbbf2596670927b90 distroprefs/GAAS.Data-Dump.yml +SHA1 0dfc149b7f84faa02445145672b55936a7aa553d distroprefs/GAAS.Font-AFM.yml +SHA1 58897de05768f6fb56541fc1a4b55f4d10be03bc distroprefs/GAAS.libwww.yml +SHA1 9dd2f59c685e05fccfc788c04586929bcbdcdc64 distroprefs/GBARR.libnet.dd +SHA1 ff6eb4e4887f137049aff6d8e338cae8c8652a37 distroprefs/GBARR.libnet.yml +SHA1 d27f83106d5b5f0274c0640b3ffe10177929667d distroprefs/GBARR.perl-ldap.yml +SHA1 64ad406e29b8d008773815820432dfdcf230c80e distroprefs/GBROCK.Tk-StayOnTop.yml +SHA1 bf302a0bc219482c5561799397ce626989ce19dd distroprefs/GEOFF.Apache-Test.yml +SHA1 d504e51e5f0588137a8ee587bdffafcf4d31780c distroprefs/GIRAFFED.Curses.yml +SHA1 ff3ab58e7d0c36d871143e46e9343bae48133782 distroprefs/GIULIENK.Audio-Beep.yml +SHA1 04de161e38b8d28d9ea86cf97952f808d85cdb5a distroprefs/GOMOR.Net-Write.yml +SHA1 8090887eb0c4e580e126411dd6e195a6dcfceb99 distroprefs/GOZER.mod_perl.yml +SHA1 57ab08cae44386211c9ae4b7334f9247d184a997 distroprefs/GRANTM.XML-SAX.yml +SHA1 aa0777a56689449e15f93c584da5bacced67cb21 distroprefs/GRAY.IO-AIO-Util.yml +SHA1 16ea294f575a95e9d4c13312d5664c9bbc0fb6fe distroprefs/GRICHTER.Embperl.yml +SHA1 02e8382912872a228896414c24344f7ba813650e distroprefs/GRM.App-CamelPKI.yml +SHA1 bfabe2072c878359c50622b0d481f997559bfb28 distroprefs/GTERMARS.Apache2-Filter-Minifier-JavaScript.yml +SHA1 a4228e454b2931f7a85a8412703cf02d439d5b10 distroprefs/GWYN.POE-Component-Daemon.yml +SHA1 fea17425dd1c9b1e735a800dee80a6d405aa1283 distroprefs/HANJE.Syntax-Highlight-Engine-Kate.yml +SHA1 b7b962604271f9dd8fc5e37c540f750f5978a988 distroprefs/HAYASHI.Term-ReadLine-Gnu.yml +SHA1 3bebe187a2e07cd301a8c096fdec91ecccd9e148 distroprefs/HDP.Perl-Version.yml +SHA1 982698f38157411cddae1d2279e9502dc4b7d72b distroprefs/HMBRAND.Spreadsheet-Read.yml +SHA1 3a8461222d63b13643fd39cd746dc7c85a6b0236 distroprefs/HMBRAND.Tk-Clock.yml +SHA1 7c46625bc8be1ea720225bb453edcd1626005cc5 distroprefs/HORROCKS.PersistentPerl.yml +SHA1 90883f7670a88b102891ed83e8ee1a849ca0f4cb distroprefs/ILMARI.DBIx-Class-Schema-Loader.yml +SHA1 9e1facd2099e165bfd0d9bd892e5edb2b9d50fbf distroprefs/ILYAZ.FreezeThaw.yml +SHA1 3f9674ffb2696c29ec8f4286f647c16db0020e84 distroprefs/ILYAZ.Math-Pari.yml +SHA1 caf4578aeacf41d51b43880ea8455358b4d0964a distroprefs/ILYAZ.Term-ReadLine-Perl.dd +SHA1 bda02b677e273259d186961f7c8eae480d7ef910 distroprefs/ILYAZ.Term-ReadLine-Perl.yml +SHA1 d8efd70bd00c80243eb9bfa8338a0d6801752984 distroprefs/INGY.Inline.yml +SHA1 f93375cd230872202736427f640e94642b285afc distroprefs/INGY.YAML.dd +SHA1 87d2f34018deaf22ec78903576efb4ad51ca986d distroprefs/INGY.YAML.yml +SHA1 5f163956229ec897a0fb1a00c4c5d615ffaf8326 distroprefs/ITYNDALL.Net-Amazon-Thumbnail.yml +SHA1 982a7dc0489ab5ab1b998c245ad222fe15ea4a90 distroprefs/JAYK.Catalyst-Authen-S-D-C.yml +SHA1 08bb2709bf24a070983b0c975c56b283e199519a distroprefs/JCRISTY.PerlMagick.yml +SHA1 917a7b41d5d888eb4c4a598afc740758db164658 distroprefs/JDIEPEN.Audio-LADSPA.yml +SHA1 daff1027ab61bf9f4f8b0c12b214917028bf320d distroprefs/JENDA.Mail-Sender.yml +SHA1 c637c9d82ec754647624a5f751e35b59f8e41df2 distroprefs/JESSE.HTTP-Server-Simple.yml +SHA1 4dd8ee17665f8756abc689b13952f1a2ccaf89b5 distroprefs/JESSE.Jifty-DBI.yml +SHA1 43f0ac97dcacbf4d6c621e47cf6af96b06313987 distroprefs/JGMYERS.Encode-Detect.yml +SHA1 b39ac99266e6e2260b31f8a702d64adfc9f71073 distroprefs/JHOBLITT.DateTime-Format-ISO8601.yml +SHA1 4b4ed3298ec9ef5453f96321a5db458bb33cb404 distroprefs/JJORE.AI-Prolog.yml +SHA1 90ad00be735bb0ef97da631d358a52bfccb7179f distroprefs/JJORE.Carp-Clan.yml +SHA1 3fd695351b85b620ff582808541afa0602f7bc32 distroprefs/JKEGL.Test-Weaken.yml +SHA1 3fb457e8ef5eadc9cdc41a75005ec1e2316ab20e distroprefs/JMASON.Mail-SpamAssassin.yml +SHA1 3c5c0f1e7345627d0972071b2eed8471fffce313 distroprefs/JMGDOC.OpenOffice-OODoc.yml +SHA1 eb82c1c6a29983f568b70a29aef638b271667970 distroprefs/JOHNL.DBD-Informix.yml +SHA1 ec602332d67ee23ac665c2a1cedd673317e270c6 distroprefs/JOHNSCA.TkCarp.yml +SHA1 d3c237042968d3a9c867bbdf554f16327252160e distroprefs/JOSEPHW.XML-Writer.yml +SHA1 8dc8c3c8d694fbeb9d494e4823d9a185501ae8e5 distroprefs/JPEACOCK.SVN-Notify-Mirror.yml +SHA1 9f7191057584e9a1e183c9eb11dc9d6dfab90d0a distroprefs/JPIERCE.IO-Pager.yml +SHA1 d4b3f3e610d71e522e5f172c25114417819720f3 distroprefs/JPRIT.Event.yml +SHA1 3cf93c56099bc9490e1c464b294f007b98749283 distroprefs/JRENNIE.WordNet-QueryData.yml +SHA1 96e6ee6973df7502f4ca12d72d22793ad6f71123 distroprefs/JROBINSON.SQL-Translator.yml +SHA1 fdc328eb31d839df7580566406fec0ea740a44ce distroprefs/JROCKWAY.Chroniton.yml +SHA1 8a83f61832a64fb882932ae6c300546d1081437b distroprefs/JSHIRLEY.Catalyst-Action-REST.yml +SHA1 6ee53f5c33fb9eab74894425ab90cac264a97e04 distroprefs/JSTENZEL.Getopt-ArgvFile.yml +SHA1 e4b8d7b83a07f16f45ec27dd7806ab591c7507f0 distroprefs/JV.Getopt-Long.yml +SHA1 3d3c6a30b7d36cb51be07b39c3fee0b955999cbc distroprefs/KANE.CPANPLUS.yml +SHA1 7a75592e12385a241f528b4c3f839c4dd8a0c1d4 distroprefs/KARASIK.IO-Lambda.yml +SHA1 a0e37e20668fed466d5f1906930032879a8e11ae distroprefs/KARMAN.SWISH-Prog.yml +SHA1 4aeb3d2f054d46ddda79037479cd4fef15e2e040 distroprefs/KASEI.Class-Accessor.yml +SHA1 43cc5a3f630449d8765a170f4124193f0cd8db46 distroprefs/KAWASAKI.Lingua-JA-Romanize-Japanese.yml +SHA1 633cdf46c0f756288284ab7a769e28c72f4c59ee distroprefs/KBROWN.SOAP.yml +SHA1 53ed4eaff4ac164f2a9598d3fb6d564865df37f8 distroprefs/KCLARK.SQL-Translator.yml +SHA1 321d9140e1002d8ed84222c09b6a000e3742f2d3 distroprefs/KNORR.Net-MirrorDir.yml +SHA1 003f000da142cd81fd447b1af36f0b58841a58af distroprefs/KROW.DBIx-Password.yml +SHA1 eac68d766e6e3421717b5735e5763a54743fc3c8 distroprefs/KRUSCOE.Tie-DxHash.yml +SHA1 9b4696fccd85473b34975421663c4f8e3a9370cc distroprefs/KVAIL.Tk-Stderr.yml +SHA1 7a31b880a7dceabc3b1664a67900843970041b85 distroprefs/KWILLIAMS.AI-Categorizer.yml +SHA1 9579da4838305cfdf6abdc17d38af21ab9b7577d distroprefs/KWILLIAMS.Crypt-SKey.yml +SHA1 5f4abfa152948882cce3cae77ec3b1cf79a2037a distroprefs/KWILLIAMS.Module-Build.yml +SHA1 2aafd38003e89cbba2ebf438e469e2bf180b18ff distroprefs/LAMPRECHT.Tk-GraphItems.yml +SHA1 5943f8e87d88380f1e5348839698f87b03eed113 distroprefs/LBROCARD.Test-WWW-Mechanize-Catalyst.yml +SHA1 aa66a9c8f43b15356f9a3c75441879f9825f5c87 distroprefs/LDS.Crypt-CBC.yml +SHA1 e9bd2016d5029e7c5359569bddb9946f2f171de9 distroprefs/LEAKIN.File-Rsync.yml +SHA1 943b55a0724fe881729693b15dec362628e6cb5d distroprefs/LETO.Math-GSL.yml +SHA1 4111b8de3b970ef9c37402dd5f138a68a7c97d0a distroprefs/LICHTKIND.Kephra.yml +SHA1 376b298af821012956f0b2a44c09130fa6f60bbe distroprefs/LOCAL.trailing_dot_distros.yml +SHA1 8ca6ecb4a6f5f50e0b8f7776b0ae918b44c530a9 distroprefs/LUKEC.Socialtext-Resting.yml +SHA1 1fb3bd1b3b64d405a5b64aa0f620fcfe61eff58c distroprefs/LUSOL.Tk-Gauge.yml +SHA1 e240d9feee9e4a748b5c47687048b86706952907 distroprefs/LZE.HTML-Menu-TreeView.yml +SHA1 2c123a146740841003b53fa4f532c55a6893a707 distroprefs/MAHEX.Image-Grab.yml +SHA1 5b22419dce7cd965f5ce42fab1437f2ca8952dc0 distroprefs/MAKAMAKA.JSON.yml +SHA1 4baf7d00fe4cd4a088f6f15360cdf46326ff96ac distroprefs/MARKOV.CPAN-Site.yml +SHA1 eb36763e5faea82f614289f3e9068101f17bc217 distroprefs/MARKOV.Mail-Box.yml +SHA1 a1b69bdd26e030bfa9639c880a8aec24dcd69bd7 distroprefs/MARKOV.Mail-IMAPClient.yml +SHA1 4697d319f8a1ee08100a03d302cd0e77b2238f94 distroprefs/MARKOV.MailTools.yml +SHA1 b67a04cc1d49ace0c5f46a73a38f1d7014aa2f18 distroprefs/MARKSTOS.CGI-Session.yml +SHA1 713aefbcda0e1c0f2d6c20f347e0c2eb046f2222 distroprefs/MAURICE.IPC-ShareLite.yml +SHA1 01bc9f5a0b2fbeecc9f5b3e5d745f826ccaad0f0 distroprefs/MBARBON.Alien-wxWidgets.yml +SHA1 2358f5a919f43c64914859eacbe0807fc4440b4b distroprefs/MCEGLOWS.Bloom-Filter.yml +SHA1 367e8ee57fca8ae24e28e9368faeb46108a41e48 distroprefs/METZZO.Java.yml +SHA1 64daf7e6381bc169b445252fc6f6e61e4d1f2e76 distroprefs/MI.yml +SHA1 bc2d5da2f5eeaa6c59e528ca60a69ca72b88fa4e distroprefs/MIKER.IPtables-IPv4-DBTarpit.yml +SHA1 1caa9b2931820a0d118dd08bba2daf830a00fde8 distroprefs/MIROD.XML-Twig.yml +SHA1 7a5e89593d15ca28422e4c9fbdbf0319a0ebb27b distroprefs/MIYAGAWA.Catalyst-View-JSON.yml +SHA1 81234f17fa226bd5dd5b12bbefd91d7b90b4804f distroprefs/MIYAGAWA.Net-IDN-Nameprep.yml +SHA1 3c9a8a247ddc8daf1f01efa16ff1e432464f852a distroprefs/MIYAGAWA.Plagger.yml +SHA1 0498de191664f9a6f57c093330c82dc80000ccff distroprefs/MIYAGAWA.XML-Atom.yml +SHA1 b779cd0a110b5963058200aa5d9436d28e217b32 distroprefs/MInoinc.yml +SHA1 c956ad9757ef03929cd0d5ac5e620d9be91a9b0d distroprefs/MJCARMAN.Tie-Tk-Text.yml +SHA1 6afc4ac0d42adee5bb0282e2ba6c8e1ed2bb5fe8 distroprefs/MJD.Devel-Trace.yml +SHA1 59c1d7fb23e107b3c161a2f9eb1ded77f0023c5b distroprefs/MJD.Text-Template.yml +SHA1 31144ad752fca3fde8f62437ef4acc5019852cf5 distroprefs/MJEVANS.DBD-ODBC.yml +SHA1 317bf6276a6ebf41446eb55bb3ae8470836ed329 distroprefs/MLEHMANN.AnyEvent.yml +SHA1 ccdce00914e7b9d47f3b813113d63c89ae8416b7 distroprefs/MLEHMANN.Coro.yml +SHA1 56ef6643b596f97790a1cf401216e7163ddff1d9 distroprefs/MLEHMANN.EV.yml +SHA1 f7d763be7c995766db9efa9d9733e80e74cbf88c distroprefs/MLEHMANN.Gtk-Perl.yml +SHA1 ef5ae5be19cdde5f70fcd66be7f0ecd42e659b73 distroprefs/MLEHMANN.IO-AIO.yml +SHA1 cc92b51441f76cbe8a43144dd7f5fa2286012faf distroprefs/MLEHMANN.PApp.yml +SHA1 1c6b084c0a5506834e69252494c1eeabb8919d1a distroprefs/MLFISHER.Test-MockDBI.yml +SHA1 307852f9e405b3d41c0eca188cfc8a5bbe4ff4f7 distroprefs/MRAMBERG.Catalyst-View-TT.yml +SHA1 a43818203eff0377ddea029d9e572b6e6f055639 distroprefs/MRAMBERG.MojoMojo.yml +SHA1 ea08ac5ba983335b9ed317a7131f561b6a09b35e distroprefs/MSCHILLI.RRDTool-OO.yml +SHA1 c656d271124382d9ef947cdab375dc1b4d7900b0 distroprefs/MSCHWERN.Test-Simple.yml +SHA1 26e2bf3370edfcb0a5b912d1c57d84dc75e5a92e distroprefs/MSERGEANT.AxKit.yml +SHA1 509237359e8567b1c5a0237b677ce68eabd4c5b2 distroprefs/MSERGEANT.CDB_File.yml +SHA1 eb27ebf7dcd920fac1b267c0df06a3d71970ffd2 distroprefs/MSERGEANT.DBD-SQLite.yml +SHA1 de835cac688de5a1b7bf5da1a49eecfcb3c9c836 distroprefs/MSERGEANT.DBIx-AnyDBD.yml +SHA1 635817d11c7cae6a6ba7eb944d53eef63bf4810c distroprefs/MSERGEANT.XML-Filter-XInclude.yml +SHA1 5ddcdacacb67cdfd2dd4187ecdc8071d85865a7d distroprefs/MSERGEANT.XML-Parser.yml +SHA1 176cdbdb4f2c7e266230c81d435eb82f5ba6d4d7 distroprefs/MSISK.HTML-TableExtract.yml +SHA1 4a01d74570a8ea3d97a0c09a7c85750f70b83f13 distroprefs/MTHURN.I18N-Charset.yml +SHA1 436a7539d42846ae6fd208840bf57940e05c7ca5 distroprefs/MTHURN.Tk-Wizard.yml +SHA1 f1fafcd2e29375836edc55f476a3b78150a7d529 distroprefs/NEELY.Data-Serializer.yml +SHA1 95850096aeec405f90853bd2ed77427e9ecfda0f distroprefs/NEILW.Inline-CPP.yml +SHA1 a0e77e23618b2f94dcbd7eb9fc4d1126164647c7 distroprefs/NESTING.Unicode-Wrap.yml +SHA1 027c98c1cef03db9a01c8f8a0e3a214181cf4440 distroprefs/NI-S.Tk-HTML.yml +SHA1 2290190920c5631a17022740a2739c9b62c450a6 distroprefs/NI-S.Tk.yml +SHA1 65b26d3e23cb5f767536e7545d70b7e65479af8e distroprefs/NICOLAW.WWW-Comic.yml +SHA1 665ee093dc30d34798b6033a4103f2d32e1bb68a distroprefs/NIKIP.Authen-PAM.yml +SHA1 1932708493d031589fc82d94941e7952e0a54e54 distroprefs/NKH.PerlBuildSystem.yml +SHA1 59df82e4d6967fb05be903f925962de382db977c distroprefs/NODINE.Text-Restructured.yml +SHA1 9411052097df9b437f814025fa5128911c0cbe64 distroprefs/NUFFIN.Catalyst-Plugin-Session.yml +SHA1 4ed5526b451138b0019d3bfa824eed56b4f4562b distroprefs/NUFFIN.Devel-Events.yml +SHA1 e614f58ea1329b33f7ae4a7a284cf91d4ab6d2ef distroprefs/OLAF.Net-DNS.yml +SHA1 6ce4f3b443ad8bc05fcdbdced7b7bb8ad0517926 distroprefs/OVID.Class-Trait.yml +SHA1 ad47a62f5f8ee2ed48e7e0d23013c969ad2fcfeb distroprefs/OVID.HOP-Parser.yml +SHA1 fb59671cf11946d81095bde9e119915bbed99e08 distroprefs/OVID.Perl6-Caller.yml +SHA1 f113f114501c6bdba1934c864a2dba6b29e827a5 distroprefs/OVID.TAPx-Parser.yml +SHA1 377a8b9fcedb722e6815fb0598f381ffea6e2f7d distroprefs/OVID.Test-JSON.yml +SHA1 0fb226f103b085c5ce9dcbb87bb11256ebe1235b distroprefs/OWEN.PDF-Labels.yml +SHA1 e0d96552a62d758d3441e54b601664ebbccdbf1c distroprefs/PAJAS.XML-LibXML.yml +SHA1 c5410e306690773e9f20d835394938b97b06d677 distroprefs/PARDUS.File-MimeInfo.yml +SHA1 d20084e5fe455b21f3d2fa9fb961df990277ee19 distroprefs/PCIMPRICH.XML-SAX-ExpatXS.yml +SHA1 38b4ea6d0dc0860ff0390fe866c7a47ed151a890 distroprefs/PDCAWLEY.Class-Inner.yml +SHA1 c075527dd2dc2421e8d10e6d2b487a6bebdd022c distroprefs/PETDANCE.HTML-Tidy.yml +SHA1 bb1852ea960185c4f8c1e9ea9653e6f181280cf5 distroprefs/PETDANCE.WWW-Mechanize.yml +SHA1 4bdbd049ef90db9c3b5f93dee475615e3a65fb7c distroprefs/PETERW.SVG-Parser.yml +SHA1 b04c24b7ca5b2a2a9fb3683705bfcdeac9747875 distroprefs/PEVANS.IPC-PerlSSH.yml +SHA1 2a9a8d6e2692d71c84c626a75f88454e019421aa distroprefs/PHOENIX.Term-ReadPassword.yml +SHA1 0de6bcb1c34b234ae3a688b530f674aa52b78158 distroprefs/PHRED.Apache-Reload.yml +SHA1 b7fb26c1fc512ea3327daea890a6da0c8afc6e13 distroprefs/PIERS.sapnwrfc.yml +SHA1 138800ebf67920e445c0af7fb77de42236067c43 distroprefs/PODMASTER.HTML-Scrubber.yml +SHA1 bd799efc3e69f33849806c0780880ebbe512d6c6 distroprefs/QANTINS.BitTorrent.yml +SHA1 b82524dc1381b4838de18d05fd5612b1088952ea distroprefs/RBERJON.JSON-Any.yml +SHA1 e16549c2d3b38458a0d4a087403908d616b39fd8 distroprefs/RBS.XML-AutoWriter.yml +SHA1 8b5c37da162d0e2528b93bde03940292c51d9981 distroprefs/RCAPUTO.POE.yml +SHA1 c77cb2de786cd8774a60121033d713ddcfc6da8f distroprefs/RCLAMP.Devel-Caller.yml +SHA1 0f84e232b4a810a6cf4823e9bc2921c050afea7b distroprefs/RCLAMP.POE-Component-Server-HTTP.yml +SHA1 dd8d375bac703677c9c364639a4fe22a0c24986e distroprefs/RCSEEGE.Tk-JComboBox.yml +SHA1 ac70ac1656c18554111c802050dfcd36ebb1fb64 distroprefs/RDF.Clone.yml +SHA1 5f24b2f06148034a0dd0fa52537942e18a68b852 distroprefs/REDTREE.PDF-API2-Simple.yml +SHA1 27d3ef5f6c8042a845836a3393c1d13e8d566406 distroprefs/RHOOPER.HTTP-Lite.yml +SHA1 208670861d878584d638ac3f42b5d3fe66a7cec4 distroprefs/RICKM.DateTime-Format-Strptime.yml +SHA1 e3698e8e15378d9c2271bd12d14c394564b572f9 distroprefs/RIZEN.Config-JSON.yml +SHA1 faff33ebc17d0bf928933f25a3f8d94ced7f9686 distroprefs/RJBS.Data-UUID.yml +SHA1 ddef237ae46cc9301143c993ba85e64998351a3a distroprefs/RJBS.Email-Send.yml +SHA1 562b28d9e31de226bdade009f481a7d5aa0a02eb distroprefs/RJBS.MIME-Light.yml +SHA1 f29703d516f1a48946dc75c669ae87786ee23640 distroprefs/RJRAY.RPC-XML.yml +SHA1 e0f009c1951f544f6c9c847db53133562fc72e2d distroprefs/RKINYON.DBM-Deep.yml +SHA1 442a17ba8976e87c80a4d301e4a8babfd66500d4 distroprefs/RKOBES.PPM-Make.yml +SHA1 04fb044577e1480ce2d2d8bdcc992825cc03e4f1 distroprefs/RMUHLE.classes.yml +SHA1 634fe921e8f30fe00ef5511ee08cab8c94a8d532 distroprefs/ROBIN.PadWalker.yml +SHA1 44f72a0292cd70207b9d6ed945b8849ee967e16c distroprefs/ROBIN.Want.yml +SHA1 e7a741f3a4c834149678dfcd30c6a997f613f0ec distroprefs/RONAN.Transform-Canvas.yml +SHA1 2eda35ba49baafaf5bfac771531da48eba0f12a4 distroprefs/ROODE.Readonly-XS.yml +SHA1 e30268d47a0e36d1f2eebfe9810641bbb0a13943 distroprefs/ROODE.Time-Format.yml +SHA1 755467bbc5e8d01fbf978116064bf96140db72ac distroprefs/RRA.PGP-Sign.yml +SHA1 cd4e611d7b14e78dc2158a121b923f7ed9a9be10 distroprefs/RRWO.Graphics-ColorNames.yml +SHA1 d32579b1cd343d4bd7fd6cc15edd9e66a9dd1015 distroprefs/RSOD.IPC-Run.yml +SHA1 da6ccad2744265f551ad93c4aed00d98c40efdd8 distroprefs/RUZ.DBIx-SearchBuilder.yml +SHA1 b13ac86dfa01c3483209d47ea72cf95f02762e94 distroprefs/RYBSKEJ.forks.yml +SHA1 26c91594d6fe20a3d3775788d174848e9b2e33a3 distroprefs/SAMTREGAR.DBIx-Timeout.yml +SHA1 1753817f3641ebbfb7f9e53befb28e9353a769c0 distroprefs/SAMTREGAR.Devel-Profiler.yml +SHA1 e5faa48a8b2732778fa70687e1427d7c99386a3a distroprefs/SANKO.Net-BitTorrent.yml +SHA1 66bc1cd74cecc694696aa91cd3ced68ea84e7a89 distroprefs/SCHUBIGER.DateTime-Format.yml +SHA1 9c855fb07371bc4398ed09825935f0459d5c9ebc distroprefs/SCHWERN.Class-Fields.yml +SHA1 f5bb7075f6f866d1ccabba59da2037bd0c672dd8 distroprefs/SCHWERN.Exporter-Lite.yml +SHA1 9b357284ed3394ea13f6dfa547a83898e65cad16 distroprefs/SCHWIGON.Class-MethodMaker.yml +SHA1 0b27043f34609943cd31652f32e6d2672c8666bf distroprefs/SEANO.Sepia.yml +SHA1 f720892dd9fc401edfd729cdf410719b1933ffbb distroprefs/SHEVEK.Mail-Karmasphere-Client.yml +SHA1 b24ef8e7e28b0e34aa8239057c9d4b59e017cfb1 distroprefs/SLANNING.Ogre.yml +SHA1 8adedb297bd507915e20c89ad6b0cf3c8c08dc28 distroprefs/SREZIC.Tk-Autoscroll.yml +SHA1 4a918cbdd8c70bda8b6e4b69d2c578e442d92cba distroprefs/SREZIC.Tk-HistEntry.yml +SHA1 9a5435df02413b4380a5ff4418f2dc8c66885072 distroprefs/SREZIC.Tk-Pod.yml +SHA1 2b12729f92abfa2c0321ca56874da036e0e35a09 distroprefs/STAS.libapreq.yml +SHA1 297068a64c962a6291988f5e2272f25b764a79b9 distroprefs/STEPANOV.IMDB-Film.yml +SHA1 6df65d0332537ffc179f06c65871fc296ad370ef distroprefs/STEVAN.Class-MOP.yml +SHA1 02cb639f8176717e5188264073b56ddb9c807fd2 distroprefs/SWALTERS.typesafety.yml +SHA1 b0bd11384a7fb5696eb078ca78f07e65adb4b056 distroprefs/SZABGAB.Spreadsheet-ParseExcel.yml +SHA1 9c99712a6c02ff72c0a4701a0582bbdfeb6a59f6 distroprefs/TBONE.HTTP-File.yml +SHA1 22ea6dbf9b3a59dd93a57921cbab7deb230b8108 distroprefs/TELS.Devel-Size.yml +SHA1 329fc641ff34839390f758ea59435a8333601f9d distroprefs/TELS.Math-BigInt-GMP.yml +SHA1 6dd413afbe634d8dc5a27139fa2b13a1691862b2 distroprefs/TIMB.Apache-Status-DBI.yml +SHA1 69b1b6a2a22e7ee0c3c12baa47209f6d1779d009 distroprefs/TIMB.DBI.yml +SHA1 88e6d22214caaa73fe58db2e943739df75064918 distroprefs/TIMB.GoferTransport-http.yml +SHA1 115e1ddce36d8f2b4bbe767eebe039dadd451292 distroprefs/TJENNESS.Tk-TextANSIColor.yml +SHA1 864adef44010b28ad51c3415a6a69d7b69f88367 distroprefs/TKEEFER.Gantry.yml +SHA1 87852bf34685e71a48a3b1fdca17f89a4e252cd8 distroprefs/TLOWERY.DBI-Shell.yml +SHA1 e069e88c15c3f51941ac239ffa0f84c9e3a3404a distroprefs/TODDR.Net-Jabber-Bot.yml +SHA1 008e495fa890c64b8b2ece13e6ed233675227470 distroprefs/TSCH.Cairo.yml +SHA1 129209372806830e309175508c5144ecf34efdef distroprefs/TSCH.Gtk2.yml +SHA1 1f4f49c326e4bcbeab03a42010a1e3ed77ae236e distroprefs/URI.File-Slurp.yml +SHA1 4cc66677ef70c183cf4b1e1d03775abecb2aa393 distroprefs/VKON.Tcl-Tk.yml +SHA1 55c0187a55d564a31550fb658e09f8b62916d603 distroprefs/VKON.Tcl.yml +SHA1 37961a7ab58622f3768d372a1bac4199a850097d distroprefs/VMAN.Net-Libdnet.yml +SHA1 08cbe5308d60009eb1ca06ed15146e9de1977d26 distroprefs/VPIT.Variable-Magic.yml +SHA1 f39e1d313dc706534d2f6a3b31c61e350c11c756 distroprefs/WITTROCK.Tk-PathEntry.yml +SHA1 b885a02b5c5f5fe8fc210b53d976af7271538134 distroprefs/WRW.Barcode-Code128.yml +SHA1 ccbb7be5f9f4058bb9b68c662f1be0a5fd5fa1da distroprefs/WYANT.Astro-SpaceTrack.yml +SHA1 85cd3d85b6c522cf8d76526555bf8b1fc3e41d81 distroprefs/WYANT.Astro-satpass.yml +SHA1 365689ad47e9ba130bcc5804ac834ee8d3b0911d distroprefs/YAMATO.QDBM_File.yml +SHA1 4d57e3ed8074de47151df2741cbd5af152ad9f5a distroprefs/YANICK.XML-XPathScript.yml +SHA1 da98fd4fcb98d2f05a4ca34300f7720374196ffe distroprefs/YEWENBIN.Calendar.yml +SHA1 d901436429a68a96235760113c13c882258877e1 distroprefs/YOSHIDA.WebService-YouTube.yml +SHA1 4ac38e824e7fd50ae249b2ea9becb73459809e15 distroprefs/YSAS.SWF-Builder.yml +SHA1 9b50b7bace5e919c93e08e3837224967f5ef310d distroprefs/YVES.Data-Dump-Streamer.yml +SHA1 4cb61254d009abe65f1d943885cfb72aeda3fa15 distroprefs/YVES.Date-Simple.yml +SHA1 4059727e80d999ba2cb69aab77c47d970d0ef077 distroprefs/ZEV.Test-Dependencies.yml +SHA1 daac7f7627860e2372a3de6ce35e6e9eec80d8d6 distroprefs/ZINCDEV.tk-zinc.yml +SHA1 2d0520a16c25609a0748bc7423d7cbeb5dcba776 distroprefs/ZOFFIX.LWP-UserAgent-ProxyHopper.yml +SHA1 3a216694d57bb44948f1433947cd9aff8e7a03dd distroprefs/ZOOLEIKA.RDF-Simple.yml +SHA1 eeaec00a7b15e8e0dc0ef86b7d92949a70efbd34 distroprefs/ZOOLEIKA.SVG-Plot.yml +SHA1 efbe8e6882a2caa0d741b113959a706830ab5882 inc/Test/Builder.pm +SHA1 ae1d68262bedc2475e2c6fd478d99b259b4fb109 inc/Test/More.pm +SHA1 dc0eab8096ce8e37ef81e4b685f66e5e9682402f lib/CPAN.pm +SHA1 ca47203e0e6479e2be6fac33069ea2cd09d463ec lib/CPAN/API/HOWTO.pod +SHA1 31fe6809bca43dc74f54ecf6a6ace8706b5ed226 lib/CPAN/Admin.pm +SHA1 15d7b0a87447db7f0787172ce315ae552465a7d9 lib/CPAN/Author.pm +SHA1 fcd7c55afb6cd979845010c0290993d33571f419 lib/CPAN/Bundle.pm +SHA1 6613db3adad2817cc30f63ba060f214dba3de008 lib/CPAN/CacheMgr.pm +SHA1 6277f7d06dfb92da050e0ee78fa5fe4ca96537fc lib/CPAN/Complete.pm +SHA1 7e763ea4ad3c8da421e313efa1cc74783d5cb3aa lib/CPAN/Debug.pm +SHA1 34c8162aa20cc7074fe2cffe3fce0573e68515b8 lib/CPAN/DeferredCode.pm +SHA1 5d44abe7ae749db5d21cc4574389ce923721f43e lib/CPAN/Distribution.pm +SHA1 43d3b96072d651441cee8412573f5f18baa72510 lib/CPAN/Distroprefs.pm +SHA1 cd39b0f1bb9763a516bffd2e81b5347c0c797d1f lib/CPAN/Distrostatus.pm +SHA1 62b728edde39be16a38cce29b08f88b4709a1abd lib/CPAN/Exception/RecursiveDependency.pm +SHA1 0914803a2ed6c20f050d6377969fc086e7da56ac lib/CPAN/Exception/blocked_urllist.pm +SHA1 06015c184c85de35a9e7832524a4776d27b20265 lib/CPAN/Exception/yaml_not_installed.pm +SHA1 44b0126e756f43980a469b17e3600f1cecc63a70 lib/CPAN/FTP.pm +SHA1 72a3b878de0fb72a9fd0ef5f806060cf6113acc4 lib/CPAN/FTP/netrc.pm +SHA1 19c4ed734ae2b36d38fb001be4ac99e50494d5f7 lib/CPAN/FirstTime.pm +SHA1 209ffa1405d3356d34ead21255d1b23732c4c8b5 lib/CPAN/HandleConfig.pm +SHA1 2c95b20a0d342635da3d8d7967637fa4ba10b057 lib/CPAN/Index.pm +SHA1 7cf0d99ff78c97afa4e6d042b18338f5f1477198 lib/CPAN/InfoObj.pm +SHA1 d12264dc1735654f0a7e6e31387106336be8726d lib/CPAN/Kwalify.pm +SHA1 0460d53b1b0b4fb6b1b1ec3218a3182210e0802a lib/CPAN/Kwalify/distroprefs.dd +SHA1 ca22988f7fd6d0989d04df8b5f84e913e8a1a593 lib/CPAN/Kwalify/distroprefs.yml +SHA1 d38e7c2e5b019bedd00423fbf82a14defa0aa7c6 lib/CPAN/LWP/UserAgent.pm +SHA1 42e9a304da0a6ef87e8a73ec180fbd915d8628a4 lib/CPAN/Module.pm +SHA1 6faf2d6787bcb6c6d2a205f59a92d78e73fc7f14 lib/CPAN/Nox.pm +SHA1 e18c032c69ccafc2d224ae6dfbb0b60628c7848a lib/CPAN/Prompt.pm +SHA1 ac4e3fd3b264404956de68d227909d8d2abd8498 lib/CPAN/Queue.pm +SHA1 9f656fefbf93517fe0a121000ae5b5bc0e1a44ef lib/CPAN/Shell.pm +SHA1 f742634c1110ab6c66b92b1b9f052027d14a6280 lib/CPAN/Tarzip.pm +SHA1 c572134ef16d4cfdbee4e23f1946062fb5fff5fe lib/CPAN/URL.pm +SHA1 2492ea05e3fd53d03876bdf112cadca009e65418 lib/CPAN/Version.pm +SHA1 01c2c0d35ce8b8e5c472ac2b542a3529d88c4a37 scripts/cpan +SHA1 ce8f1c86172c6cd2698c27f6f76864de724a1282 t/00signature.t +SHA1 215dace24b507de20011d36cbe2d16ddea78bcf3 t/01loadme.t +SHA1 11b0e1300cef04885330d292a52296a44ed689d2 t/02nox.t +SHA1 4f58adf390660cddecf31274a838e48e65dca940 t/03pkgs.t +SHA1 cf39823c3aba766be6f8b99bf74634013b4d6029 t/04clean_load.t +SHA1 6799037363cbb460183f1b483784055cb96c7e40 t/10version.t +SHA1 4c7da618cd8a3054b32b218e4d7daf13ce5fedf2 t/11mirroredby.t +SHA1 9d2be90f9c95844cf3d16c175b3620770d61617c t/12cpan.t +SHA1 c5697c558df9cc12e8a1fb42b9d4eeb2eeae0c6a t/13tarzip.t +SHA1 54e904dc7362af2710b130bafbf7b3ea6e2ddbb8 t/14forkbomb.t +SHA1 e0e62c08ee1152d64d70180a6a06199ec13b05b1 t/30shell.coverage +SHA1 03bbe31acae1d5c4bc3760cea20dbadc842e3960 t/30shell.t +SHA1 514cceea939d34aba0102d5bf76e47b64069dfc6 t/31sessions.t +SHA1 874c4086a55b6d3f2856b47d1be8e39c61bd05ab t/41distribution.t +SHA1 5acddcbee26d5bd075119d309efae14c6f8f8ff7 t/42distroprefs.t +SHA1 b86a9ffad6b939c5091524a6c210dc89cc3cea0c t/43distroprefspref.t +SHA1 6a79f15a10337bd3450604abf39d4462df2a550b t/50pod.t +SHA1 5d5d4a23a6fc5238d05aefc62410dcea7a7e8cd8 t/51pod.t +SHA1 c7ff8e849c791315b09e5fd3e9195b28429ff918 t/52podcover.t +SHA1 8197b806d196bcd1a5c013da22807afe8721b46d t/60credentials.t +SHA1 c4c1beb50a6545c80f42234dcc21beee8e2ac20f t/70_critic.t +SHA1 7efe930efd0a07d8101679ed15d4700dcf208137 t/CPAN/CpanTestDummies-1.55.pm +SHA1 f7dc1c86ff96f2ff444a375024652c50d710e195 t/CPAN/TestConfig.pm +SHA1 081ed556ae14a75c43ca31e67cfc99d180c9ef41 t/CPAN/TestMirroredBy +SHA1 455480f7053abe4ac853a4c456d52b83e8b922e8 t/CPAN/TestPatch.txt +SHA1 b4fd27234696da334ac6a1716222c70610a98c3a t/CPAN/authors/01mailrc.txt +SHA1 816c992e5853ed7312a7789fcab11719de958727 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS +SHA1 d1a101f24d2d0719c9991df28ede729d58005bb4 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS.2nd +SHA1 34cf1bf9c95007fe02a4b4f4977eb017516b0cdc t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-1.03.tar.gz +SHA1 3f66b598a79d5b120205715e86a5eed19251cd13 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails-1.02.tar.gz +SHA1 57ec31da473af149806cfd0689f6852c5fd3f12a t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails-1.03.tar.gz +SHA1 4b30a5ff87f92f68616a9d7436be37ee9d0e9b87 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake-1.02.tar.gz +SHA1 7378a536ffa854a49a4fd6082a8d9f924be23d8d t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-1.05.tar.gz +SHA1 f82f789dfdaa4cf3f34fad2d0f8c97f0f0bd9941 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne-1.00.tar.gz +SHA1 faf5f6c6218c8d862a2e807538a468049cb2263f t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree-1.00.tar.gz +SHA1 ffffd32d5e63075ce47527d5af689e76f7421b13 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo-1.00.tar.gz +SHA1 0a897ebf94b88af75dcd6495f736c317601b9878 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq-1.00.tar.gz +SHA1 b992aebcd2fa43e3d83113247d2310abf028068f t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect-1.00.tar.gz +SHA1 522f39ed6921d9704b38bd7dd0c3559815f45a68 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly-1.02.tar.gz +SHA1 35b9020b23e004f349e14fd2cd79b16b94b8c8a9 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq-1.00.tar.gz +SHA1 a424441767925cd6eb4db35098a896ac15b42991 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip-1.03.zip +SHA1 043196f76ae3b0bb245ac2a4428fd910cfeff509 t/CPAN/authors/id/A/AN/ANDK/NotInChecksums-0.000.tar.gz +SHA1 1a5b3cc1fbd14373bc8f1820fdb2e981052d4b70 t/CPAN/authors/id/A/AN/ANDK/cpantestdummies/CHECKSUMS +SHA1 9a5a44d2abc57f3003a0eb2883538f2bb4e5fe79 t/CPAN/authors/id/A/AN/ANDK/cpantestdummies/CPAN-Test-Dummy-Perl5-Make-Features-1.05.tgz +SHA1 5bc14cda7abdb6306caec36f804dfba54b113e80 t/CPAN/authors/id/A/AN/ANDK/patches/CHECKSUMS +SHA1 1aee1bed21f0e9755d693419e810ec75543eb0b7 t/CPAN/authors/id/A/AN/CHECKSUMS +SHA1 1f3304f219bf0da4db6a60f638e11b61c2c2f4c0 t/CPAN/authors/id/A/CHECKSUMS +SHA1 dfc900f5bfbc9683fa91977a1c7198222fbd4452 t/CPAN/authors/id/CHECKSUMS +SHA1 8466a904cf7a0e8522051d19fc028689449a5d73 t/CPAN/modules/02packages.details.txt +SHA1 f4c1a524de16347b37df6427ca01f98dd27f3c81 t/CPAN/modules/03modlist.data +SHA1 e635fad8933c18200afe49290ca25bb1c4694f14 t/data/META-dynamic.yml +SHA1 0182c65f3032611635ad5f008e181ea4eba71ef4 t/data/META-static.yml +SHA1 3735e39de4ee6753cde1c3078afa2d16be8c2f65 t/local_utils.pm +SHA1 3b6f98262392387823dd49f342e6731e1a6ec291 t/perlcriticrc +SHA1 8a00e60e767af838833dea621abe9683cd360e5d t/yaml_code.yml +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEARECAAYFAkpFhmsACgkQ7IA58KMXwV0zJQCfdE9L000Ea1PMXQ5vZHupO6vD +yYEAoKMlsaOxc2+RDRh+o8uM5QY4AxpB +=K/sX +-----END PGP SIGNATURE----- diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm new file mode 100644 index 0000000000..84f67ffafb --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Shell.pm @@ -0,0 +1,1939 @@ +package CPAN::Shell; +use strict; + +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: + +use vars qw( + $ADVANCED_QUERY + $AUTOLOAD + $COLOR_REGISTERED + $Help + $autoload_recursion + $reload + @ISA + @relo + $VERSION + ); +@relo = ( + "CPAN.pm", + "CPAN/Author.pm", + "CPAN/CacheMgr.pm", + "CPAN/Complete.pm", + "CPAN/Debug.pm", + "CPAN/DeferredCode.pm", + "CPAN/Distribution.pm", + "CPAN/Distroprefs.pm", + "CPAN/Distrostatus.pm", + "CPAN/Exception/RecursiveDependency.pm", + "CPAN/Exception/yaml_not_installed.pm", + "CPAN/FirstTime.pm", + "CPAN/FTP.pm", + "CPAN/FTP/netrc.pm", + "CPAN/HandleConfig.pm", + "CPAN/Index.pm", + "CPAN/InfoObj.pm", + "CPAN/Kwalify.pm", + "CPAN/LWP/UserAgent.pm", + "CPAN/Module.pm", + "CPAN/Prompt.pm", + "CPAN/Queue.pm", + "CPAN/Reporter/Config.pm", + "CPAN/Reporter/History.pm", + "CPAN/Reporter/PrereqCheck.pm", + "CPAN/Reporter.pm", + "CPAN/Shell.pm", + "CPAN/SQLite.pm", + "CPAN/Tarzip.pm", + "CPAN/Version.pm", + ); +$VERSION = "5.5"; +# record the initial timestamp for reload. +$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo }; +@CPAN::Shell::ISA = qw(CPAN::Debug); +use Cwd qw(chdir); +use Carp (); +$COLOR_REGISTERED ||= 0; +$Help = { + '?' => \"help", + '!' => "eval the rest of the line as perl", + a => "whois author", + autobundle => "write inventory into a bundle file", + b => "info about bundle", + bye => \"quit", + clean => "clean up a distribution's build directory", + # cvs_import + d => "info about a distribution", + # dump + exit => \"quit", + failed => "list all failed actions within current session", + fforce => "redo a command from scratch", + force => "redo a command", + get => "download a distribution", + h => \"help", + help => "overview over commands; 'help ...' explains specific commands", + hosts => "statistics about recently used hosts", + i => "info about authors/bundles/distributions/modules", + install => "install a distribution", + install_tested => "install all distributions tested OK", + is_tested => "list all distributions tested OK", + look => "open a subshell in a distribution's directory", + ls => "list distributions matching a fileglob", + m => "info about a module", + make => "make/build a distribution", + mkmyconfig => "write current config into a CPAN/MyConfig.pm file", + notest => "run a (usually install) command but leave out the test phase", + o => "'o conf ...' for config stuff; 'o debug ...' for debugging", + perldoc => "try to get a manpage for a module", + q => \"quit", + quit => "leave the cpan shell", + r => "review upgradable modules", + readme => "display the README of a distro with a pager", + recent => "show recent uploads to the CPAN", + # recompile + reload => "'reload cpan' or 'reload index'", + report => "test a distribution and send a test report to cpantesters", + reports => "info about reported tests from cpantesters", + # scripts + # smoke + test => "test a distribution", + u => "display uninstalled modules", + upgrade => "combine 'r' command with immediate installation", + }; +{ + $autoload_recursion ||= 0; + + #-> sub CPAN::Shell::AUTOLOAD ; + sub AUTOLOAD { ## no critic + $autoload_recursion++; + my($l) = $AUTOLOAD; + my $class = shift(@_); + # warn "autoload[$l] class[$class]"; + $l =~ s/.*:://; + if ($CPAN::Signal) { + warn "Refusing to autoload '$l' while signal pending"; + $autoload_recursion--; + return; + } + if ($autoload_recursion > 1) { + my $fullcommand = join " ", map { "'$_'" } $l, @_; + warn "Refusing to autoload $fullcommand in recursion\n"; + $autoload_recursion--; + return; + } + if ($l =~ /^w/) { + # XXX needs to be reconsidered + if ($CPAN::META->has_inst('CPAN::WAIT')) { + CPAN::WAIT->$l(@_); + } else { + $CPAN::Frontend->mywarn(qq{ +Commands starting with "w" require CPAN::WAIT to be installed. +Please consider installing CPAN::WAIT to use the fulltext index. +For this you just need to type + install CPAN::WAIT +}); + } + } else { + $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }. + qq{Type ? for help. +}); + } + $autoload_recursion--; + } +} + + +#-> sub CPAN::Shell::h ; +sub h { + my($class,$about) = @_; + if (defined $about) { + my $help; + if (exists $Help->{$about}) { + if (ref $Help->{$about}) { # aliases + $about = ${$Help->{$about}}; + } + $help = $Help->{$about}; + } else { + $help = "No help available"; + } + $CPAN::Frontend->myprint("$about\: $help\n"); + } else { + my $filler = " " x (80 - 28 - length($CPAN::VERSION)); + $CPAN::Frontend->myprint(qq{ +Display Information $filler (ver $CPAN::VERSION) + command argument description + a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules + i WORD or /REGEXP/ about any of the above + ls AUTHOR or GLOB about files in the author's directory + (with WORD being a module, bundle or author name or a distribution + name of the form AUTHOR/DISTRIBUTION) + +Download, Test, Make, Install... + get download clean make clean + make make (implies get) look open subshell in dist directory + test make test (implies make) readme display these README files + install make install (implies test) perldoc display POD documentation + +Upgrade + r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules + upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules + +Pragmas + force CMD try hard to do command fforce CMD try harder + notest CMD skip testing + +Other + h,? display this menu ! perl-code eval a perl command + o conf [opt] set and query options q quit the cpan shell + reload cpan load CPAN.pm again reload index load newer indices + autobundle Snapshot recent latest CPAN uploads}); +} +} + +*help = \&h; + +#-> sub CPAN::Shell::a ; +sub a { + my($self,@arg) = @_; + # authors are always UPPERCASE + for (@arg) { + $_ = uc $_ unless /=/; + } + $CPAN::Frontend->myprint($self->format_result('Author',@arg)); +} + +#-> sub CPAN::Shell::globls ; +sub globls { + my($self,$s,$pragmas) = @_; + # ls is really very different, but we had it once as an ordinary + # command in the Shell (upto rev. 321) and we could not handle + # force well then + my(@accept,@preexpand); + if ($s =~ /[\*\?\/]/) { + if ($CPAN::META->has_inst("Text::Glob")) { + if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) { + my $rau = Text::Glob::glob_to_regex(uc $au); + CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]") + if $CPAN::DEBUG; + push @preexpand, map { $_->id . "/" . $pathglob } + CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/"); + } else { + my $rau = Text::Glob::glob_to_regex(uc $s); + push @preexpand, map { $_->id } + CPAN::Shell->expand_by_method('CPAN::Author', + ['id'], + "/$rau/"); + } + } else { + $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed"); + } + } else { + push @preexpand, uc $s; + } + for (@preexpand) { + unless (/^[A-Z0-9\-]+(\/|$)/i) { + $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n"); + next; + } + push @accept, $_; + } + my $silent = @accept>1; + my $last_alpha = ""; + my @results; + for my $a (@accept) { + my($author,$pathglob); + if ($a =~ m|(.*?)/(.*)|) { + my $a2 = $1; + $pathglob = $2; + $author = CPAN::Shell->expand_by_method('CPAN::Author', + ['id'], + $a2) + or $CPAN::Frontend->mydie("No author found for $a2\n"); + } else { + $author = CPAN::Shell->expand_by_method('CPAN::Author', + ['id'], + $a) + or $CPAN::Frontend->mydie("No author found for $a\n"); + } + if ($silent) { + my $alpha = substr $author->id, 0, 1; + my $ad; + if ($alpha eq $last_alpha) { + $ad = ""; + } else { + $ad = "[$alpha]"; + $last_alpha = $alpha; + } + $CPAN::Frontend->myprint($ad); + } + for my $pragma (@$pragmas) { + if ($author->can($pragma)) { + $author->$pragma(); + } + } + CPAN->debug("author[$author]pathglob[$pathglob]silent[$silent]") if $CPAN::DEBUG; + push @results, $author->ls($pathglob,$silent); # silent if + # more than one + # author + for my $pragma (@$pragmas) { + my $unpragma = "un$pragma"; + if ($author->can($unpragma)) { + $author->$unpragma(); + } + } + } + @results; +} + +#-> sub CPAN::Shell::local_bundles ; +sub local_bundles { + my($self,@which) = @_; + my($incdir,$bdir,$dh); + foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) { + my @bbase = "Bundle"; + while (my $bbase = shift @bbase) { + $bdir = File::Spec->catdir($incdir,split /::/, $bbase); + CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG; + if ($dh = DirHandle->new($bdir)) { # may fail + my($entry); + for $entry ($dh->read) { + next if $entry =~ /^\./; + next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/; + if (-d File::Spec->catdir($bdir,$entry)) { + push @bbase, "$bbase\::$entry"; + } else { + next unless $entry =~ s/\.pm(?!\n)\Z//; + $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry"); + } + } + } + } + } +} + +#-> sub CPAN::Shell::b ; +sub b { + my($self,@which) = @_; + CPAN->debug("which[@which]") if $CPAN::DEBUG; + $self->local_bundles; + $CPAN::Frontend->myprint($self->format_result('Bundle',@which)); +} + +#-> sub CPAN::Shell::d ; +sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));} + +#-> sub CPAN::Shell::m ; +sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here + my $self = shift; + $CPAN::Frontend->myprint($self->format_result('Module',@_)); +} + +#-> sub CPAN::Shell::i ; +sub i { + my($self) = shift; + my(@args) = @_; + @args = '/./' unless @args; + my(@result); + for my $type (qw/Bundle Distribution Module/) { + push @result, $self->expand($type,@args); + } + # Authors are always uppercase. + push @result, $self->expand("Author", map { uc $_ } @args); + + my $result = @result == 1 ? + $result[0]->as_string : + @result == 0 ? + "No objects found of any type for argument @args\n" : + join("", + (map {$_->as_glimpse} @result), + scalar @result, " items found\n", + ); + $CPAN::Frontend->myprint($result); +} + +#-> sub CPAN::Shell::o ; + +# CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o +# conf' calls through to CPAN::HandleConfig::edit. 'o conf' should +# probably have been called 'set' and 'o debug' maybe 'set debug' or +# 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm +sub o { + my($self,$o_type,@o_what) = @_; + $o_type ||= ""; + CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n"); + if ($o_type eq 'conf') { + my($cfilter); + ($cfilter) = $o_what[0] =~ m|^/(.*)/$| if @o_what; + if (!@o_what or $cfilter) { # print all things, "o conf" + $cfilter ||= ""; + my $qrfilter = eval 'qr/$cfilter/'; + my($k,$v); + $CPAN::Frontend->myprint("\$CPAN::Config options from "); + my @from; + if (exists $INC{'CPAN/Config.pm'}) { + push @from, $INC{'CPAN/Config.pm'}; + } + if (exists $INC{'CPAN/MyConfig.pm'}) { + push @from, $INC{'CPAN/MyConfig.pm'}; + } + $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from); + $CPAN::Frontend->myprint(":\n"); + for $k (sort keys %CPAN::HandleConfig::can) { + next unless $k =~ /$qrfilter/; + $v = $CPAN::HandleConfig::can{$k}; + $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v); + } + $CPAN::Frontend->myprint("\n"); + for $k (sort keys %CPAN::HandleConfig::keys) { + next unless $k =~ /$qrfilter/; + CPAN::HandleConfig->prettyprint($k); + } + $CPAN::Frontend->myprint("\n"); + } else { + if (CPAN::HandleConfig->edit(@o_what)) { + } else { + $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }. + qq{items\n\n}); + } + } + } elsif ($o_type eq 'debug') { + my(%valid); + @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i; + if (@o_what) { + while (@o_what) { + my($what) = shift @o_what; + if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) { + $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what}; + next; + } + if ( exists $CPAN::DEBUG{$what} ) { + $CPAN::DEBUG |= $CPAN::DEBUG{$what}; + } elsif ($what =~ /^\d/) { + $CPAN::DEBUG = $what; + } elsif (lc $what eq 'all') { + my($max) = 0; + for (values %CPAN::DEBUG) { + $max += $_; + } + $CPAN::DEBUG = $max; + } else { + my($known) = 0; + for (keys %CPAN::DEBUG) { + next unless lc($_) eq lc($what); + $CPAN::DEBUG |= $CPAN::DEBUG{$_}; + $known = 1; + } + $CPAN::Frontend->myprint("unknown argument [$what]\n") + unless $known; + } + } + } else { + my $raw = "Valid options for debug are ". + join(", ",sort(keys %CPAN::DEBUG), 'all'). + qq{ or a number. Completion works on the options. }. + qq{Case is ignored.}; + require Text::Wrap; + $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw)); + $CPAN::Frontend->myprint("\n\n"); + } + if ($CPAN::DEBUG) { + $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n"); + my($k,$v); + for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) { + $v = $CPAN::DEBUG{$k}; + $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) + if $v & $CPAN::DEBUG; + } + } else { + $CPAN::Frontend->myprint("Debugging turned off completely.\n"); + } + } else { + $CPAN::Frontend->myprint(qq{ +Known options: + conf set or get configuration variables + debug set or get debugging options +}); + } +} + +# CPAN::Shell::paintdots_onreload +sub paintdots_onreload { + my($ref) = shift; + sub { + if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) { + my($subr) = $1; + ++$$ref; + local($|) = 1; + # $CPAN::Frontend->myprint(".($subr)"); + $CPAN::Frontend->myprint("."); + if ($subr =~ /\bshell\b/i) { + # warn "debug[$_[0]]"; + + # It would be nice if we could detect that a + # subroutine has actually changed, but for now we + # practically always set the GOTOSHELL global + + $CPAN::GOTOSHELL=1; + } + return; + } + warn @_; + }; +} + +#-> sub CPAN::Shell::hosts ; +sub hosts { + my($self) = @_; + my $fullstats = CPAN::FTP->_ftp_statistics(); + my $history = $fullstats->{history} || []; + my %S; # statistics + while (my $last = pop @$history) { + my $attempts = $last->{attempts} or next; + my $start; + if (@$attempts) { + $start = $attempts->[-1]{start}; + if ($#$attempts > 0) { + for my $i (0..$#$attempts-1) { + my $url = $attempts->[$i]{url} or next; + $S{no}{$url}++; + } + } + } else { + $start = $last->{start}; + } + next unless $last->{thesiteurl}; # C-C? bad filenames? + $S{start} = $start; + $S{end} ||= $last->{end}; + my $dltime = $last->{end} - $start; + my $dlsize = $last->{filesize} || 0; + my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl}; + my $s = $S{ok}{$url} ||= {}; + $s->{n}++; + $s->{dlsize} ||= 0; + $s->{dlsize} += $dlsize/1024; + $s->{dltime} ||= 0; + $s->{dltime} += $dltime; + } + my $res; + for my $url (keys %{$S{ok}}) { + next if $S{ok}{$url}{dltime} == 0; # div by zero + push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)}, + $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime}, + $url, + ]; + } + for my $url (keys %{$S{no}}) { + push @{$res->{no}}, [$S{no}{$url}, + $url, + ]; + } + my $R = ""; # report + if ($S{start} && $S{end}) { + $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown"; + $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown"; + } + if ($res->{ok} && @{$res->{ok}}) { + $R .= sprintf "\nSuccessful downloads: + N kB secs kB/s url\n"; + my $i = 20; + for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) { + $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_; + last if --$i<=0; + } + } + if ($res->{no} && @{$res->{no}}) { + $R .= sprintf "\nUnsuccessful downloads:\n"; + my $i = 20; + for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) { + $R .= sprintf "%4d %s\n", @$_; + last if --$i<=0; + } + } + $CPAN::Frontend->myprint($R); +} + +# here is where 'reload cpan' is done +#-> sub CPAN::Shell::reload ; +sub reload { + my($self,$command,@arg) = @_; + $command ||= ""; + $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG; + if ($command =~ /^cpan$/i) { + my $redef = 0; + chdir $CPAN::iCwd if $CPAN::iCwd; # may fail + my $failed; + MFILE: for my $f (@relo) { + next unless exists $INC{$f}; + my $p = $f; + $p =~ s/\.pm$//; + $p =~ s|/|::|g; + $CPAN::Frontend->myprint("($p"); + local($SIG{__WARN__}) = paintdots_onreload(\$redef); + $self->_reload_this($f) or $failed++; + my $v = eval "$p\::->VERSION"; + $CPAN::Frontend->myprint("v$v)"); + } + $CPAN::Frontend->myprint("\n$redef subroutines redefined\n"); + if ($failed) { + my $errors = $failed == 1 ? "error" : "errors"; + $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ". + "this session.\n"); + } + } elsif ($command =~ /^index$/i) { + CPAN::Index->force_reload; + } else { + $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules +index re-reads the index files\n}); + } +} + +# reload means only load again what we have loaded before +#-> sub CPAN::Shell::_reload_this ; +sub _reload_this { + my($self,$f,$args) = @_; + CPAN->debug("f[$f]") if $CPAN::DEBUG; + return 1 unless $INC{$f}; # we never loaded this, so we do not + # reload but say OK + my $pwd = CPAN::anycwd(); + CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG; + my($file); + for my $inc (@INC) { + $file = File::Spec->catfile($inc,split /\//, $f); + last if -f $file; + $file = ""; + } + CPAN->debug("file[$file]") if $CPAN::DEBUG; + my @inc = @INC; + unless ($file && -f $file) { + # this thingie is not in the INC path, maybe CPAN/MyConfig.pm? + $file = $INC{$f}; + unless (CPAN->has_inst("File::Basename")) { + @inc = File::Basename::dirname($file); + } else { + # do we ever need this? + @inc = substr($file,0,-length($f)-1); # bring in back to me! + } + } + CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG; + unless (-f $file) { + $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n"); + return; + } + my $mtime = (stat $file)[9]; + $reload->{$f} ||= -1; + my $must_reload = $mtime != $reload->{$f}; + $args ||= {}; + $must_reload ||= $args->{reloforce}; # o conf defaults needs this + if ($must_reload) { + my $fh = FileHandle->new($file) or + $CPAN::Frontend->mydie("Could not open $file: $!"); + local($/); + local $^W = 1; + my $content = <$fh>; + CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128))) + if $CPAN::DEBUG; + delete $INC{$f}; + local @INC = @inc; + eval "require '$f'"; + if ($@) { + warn $@; + return; + } + $reload->{$f} = $mtime; + } else { + $CPAN::Frontend->myprint("__unchanged__"); + } + return 1; +} + +#-> sub CPAN::Shell::mkmyconfig ; +sub mkmyconfig { + my($self, $cpanpm, %args) = @_; + require CPAN::FirstTime; + my $home = CPAN::HandleConfig::home(); + $cpanpm = $INC{'CPAN/MyConfig.pm'} || + File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm"); + File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm; + CPAN::HandleConfig::require_myconfig_or_config(); + $CPAN::Config ||= {}; + $CPAN::Config = { + %$CPAN::Config, + build_dir => undef, + cpan_home => undef, + keep_source_where => undef, + histfile => undef, + }; + CPAN::FirstTime::init($cpanpm, %args); +} + +#-> sub CPAN::Shell::_binary_extensions ; +sub _binary_extensions { + my($self) = shift @_; + my(@result,$module,%seen,%need,$headerdone); + for $module ($self->expand('Module','/./')) { + my $file = $module->cpan_file; + next if $file eq "N/A"; + next if $file =~ /^Contact Author/; + my $dist = $CPAN::META->instance('CPAN::Distribution',$file); + next if $dist->isa_perl; + next unless $module->xs_file; + local($|) = 1; + $CPAN::Frontend->myprint("."); + push @result, $module; + } +# print join " | ", @result; + $CPAN::Frontend->myprint("\n"); + return @result; +} + +#-> sub CPAN::Shell::recompile ; +sub recompile { + my($self) = shift @_; + my($module,@module,$cpan_file,%dist); + @module = $self->_binary_extensions(); + for $module (@module) { # we force now and compile later, so we + # don't do it twice + $cpan_file = $module->cpan_file; + my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); + $pack->force; + $dist{$cpan_file}++; + } + for $cpan_file (sort keys %dist) { + $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n"); + my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); + $pack->install; + $CPAN::Signal = 0; # it's tempting to reset Signal, so we can + # stop a package from recompiling, + # e.g. IO-1.12 when we have perl5.003_10 + } +} + +#-> sub CPAN::Shell::scripts ; +sub scripts { + my($self, $arg) = @_; + $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n"); + + for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) { + unless ($CPAN::META->has_inst($req)) { + $CPAN::Frontend->mywarn(" $req not available\n"); + } + } + my $p = HTML::LinkExtor->new(); + my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html"; + unless (-f $indexfile) { + $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n"); + } + $p->parse_file($indexfile); + my @hrefs; + my $qrarg; + if ($arg =~ s|^/(.+)/$|$1|) { + $qrarg = eval 'qr/$arg/'; # hide construct from 5.004 + } + for my $l ($p->links) { + my $tag = shift @$l; + next unless $tag eq "a"; + my %att = @$l; + my $href = $att{href}; + next unless $href =~ s|^\.\./authors/id/./../||; + if ($arg) { + if ($qrarg) { + if ($href =~ $qrarg) { + push @hrefs, $href; + } + } else { + if ($href =~ /\Q$arg\E/) { + push @hrefs, $href; + } + } + } else { + push @hrefs, $href; + } + } + # now filter for the latest version if there is more than one of a name + my %stems; + for (sort @hrefs) { + my $href = $_; + s/-v?\d.*//; + my $stem = $_; + $stems{$stem} ||= []; + push @{$stems{$stem}}, $href; + } + for (sort keys %stems) { + my $highest; + if (@{$stems{$_}} > 1) { + $highest = List::Util::reduce { + Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b + } @{$stems{$_}}; + } else { + $highest = $stems{$_}[0]; + } + $CPAN::Frontend->myprint("$highest\n"); + } +} + +#-> sub CPAN::Shell::report ; +sub report { + my($self,@args) = @_; + unless ($CPAN::META->has_inst("CPAN::Reporter")) { + $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue"); + } + local $CPAN::Config->{test_report} = 1; + $self->force("test",@args); # force is there so that the test be + # re-run (as documented) +} + +# compare with is_tested +#-> sub CPAN::Shell::install_tested +sub install_tested { + my($self,@some) = @_; + $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"), + return if @some; + CPAN::Index->reload; + + for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) { + my $yaml = "$b.yml"; + unless (-f $yaml) { + $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n"); + next; + } + my $yaml_content = CPAN->_yaml_loadfile($yaml); + my $id = $yaml_content->[0]{distribution}{ID}; + unless ($id) { + $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n"); + next; + } + my $do = CPAN::Shell->expandany($id); + unless ($do) { + $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n"); + next; + } + unless ($do->{build_dir}) { + $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n"); + next; + } + unless ($do->{build_dir} eq $b) { + $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n"); + next; + } + push @some, $do; + } + + $CPAN::Frontend->mywarn("No tested distributions found.\n"), + return unless @some; + + @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some; + $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"), + return unless @some; + + # @some = grep { not $_->uptodate } @some; + # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"), + # return unless @some; + + CPAN->debug("some[@some]"); + for my $d (@some) { + my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id; + $CPAN::Frontend->myprint("install_tested: Running for $id\n"); + $CPAN::Frontend->mysleep(1); + $self->install($d); + } +} + +#-> sub CPAN::Shell::upgrade ; +sub upgrade { + my($self,@args) = @_; + $self->install($self->r(@args)); +} + +#-> sub CPAN::Shell::_u_r_common ; +sub _u_r_common { + my($self) = shift @_; + my($what) = shift @_; + CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG; + Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless + $what && $what =~ /^[aru]$/; + my(@args) = @_; + @args = '/./' unless @args; + my(@result,$module,%seen,%need,$headerdone, + $version_undefs,$version_zeroes, + @version_undefs,@version_zeroes); + $version_undefs = $version_zeroes = 0; + my $sprintf = "%s%-25s%s %9s %9s %s\n"; + my @expand = $self->expand('Module',@args); + if ($CPAN::DEBUG) { # Looks like noise to me, was very useful for debugging + # for metadata cache + my $expand = scalar @expand; + $CPAN::Frontend->myprint(sprintf "%d matches in the database, time[%d]\n", $expand, time); + } + my @sexpand; + if ($] < 5.008) { + # hard to believe that the more complex sorting can lead to + # stack curruptions on older perl + @sexpand = sort {$a->id cmp $b->id} @expand; + } else { + @sexpand = map { + $_->[1] + } sort { + $b->[0] <=> $a->[0] + || + $a->[1]{ID} cmp $b->[1]{ID}, + } map { + [$_->_is_representative_module, + $_ + ] + } @expand; + } + if ($CPAN::DEBUG) { + $CPAN::Frontend->myprint(sprintf "sorted at time[%d]\n", time); + sleep 1; + } + MODULE: for $module (@sexpand) { + my $file = $module->cpan_file; + next MODULE unless defined $file; # ?? + $file =~ s!^./../!!; + my($latest) = $module->cpan_version; + my($inst_file) = $module->inst_file; + CPAN->debug("file[$file]latest[$latest]") if $CPAN::DEBUG; + my($have); + return if $CPAN::Signal; + my($next_MODULE); + eval { # version.pm involved! + if ($inst_file) { + if ($what eq "a") { + $have = $module->inst_version; + } elsif ($what eq "r") { + $have = $module->inst_version; + local($^W) = 0; + if ($have eq "undef") { + $version_undefs++; + push @version_undefs, $module->as_glimpse; + } elsif (CPAN::Version->vcmp($have,0)==0) { + $version_zeroes++; + push @version_zeroes, $module->as_glimpse; + } + ++$next_MODULE unless CPAN::Version->vgt($latest, $have); + # to be pedantic we should probably say: + # && !($have eq "undef" && $latest ne "undef" && $latest gt ""); + # to catch the case where CPAN has a version 0 and we have a version undef + } elsif ($what eq "u") { + ++$next_MODULE; + } + } else { + if ($what eq "a") { + ++$next_MODULE; + } elsif ($what eq "r") { + ++$next_MODULE; + } elsif ($what eq "u") { + $have = "-"; + } + } + }; + next MODULE if $next_MODULE; + if ($@) { + $CPAN::Frontend->mywarn + (sprintf("Error while comparing cpan/installed versions of '%s': +INST_FILE: %s +INST_VERSION: %s %s +CPAN_VERSION: %s %s +", + $module->id, + $inst_file || "", + (defined $have ? $have : "[UNDEFINED]"), + (ref $have ? ref $have : ""), + $latest, + (ref $latest ? ref $latest : ""), + )); + next MODULE; + } + return if $CPAN::Signal; # this is sometimes lengthy + $seen{$file} ||= 0; + if ($what eq "a") { + push @result, sprintf "%s %s\n", $module->id, $have; + } elsif ($what eq "r") { + push @result, $module->id; + next MODULE if $seen{$file}++; + } elsif ($what eq "u") { + push @result, $module->id; + next MODULE if $seen{$file}++; + next MODULE if $file =~ /^Contact/; + } + unless ($headerdone++) { + $CPAN::Frontend->myprint("\n"); + $CPAN::Frontend->myprint(sprintf( + $sprintf, + "", + "Package namespace", + "", + "installed", + "latest", + "in CPAN file" + )); + } + my $color_on = ""; + my $color_off = ""; + if ( + $COLOR_REGISTERED + && + $CPAN::META->has_inst("Term::ANSIColor") + && + $module->description + ) { + $color_on = Term::ANSIColor::color("green"); + $color_off = Term::ANSIColor::color("reset"); + } + $CPAN::Frontend->myprint(sprintf $sprintf, + $color_on, + $module->id, + $color_off, + $have, + $latest, + $file); + $need{$module->id}++; + } + unless (%need) { + if ($what eq "u") { + $CPAN::Frontend->myprint("No modules found for @args\n"); + } elsif ($what eq "r") { + $CPAN::Frontend->myprint("All modules are up to date for @args\n"); + } + } + if ($what eq "r") { + if ($version_zeroes) { + my $s_has = $version_zeroes > 1 ? "s have" : " has"; + $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }. + qq{a version number of 0\n}); + if ($CPAN::Config->{show_zero_versions}) { + local $" = "\t"; + $CPAN::Frontend->myprint(qq{ they are\n\t@version_zeroes\n}); + $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 0' }. + qq{to hide them)\n}); + } else { + $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 1' }. + qq{to show them)\n}); + } + } + if ($version_undefs) { + my $s_has = $version_undefs > 1 ? "s have" : " has"; + $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }. + qq{parsable version number\n}); + if ($CPAN::Config->{show_unparsable_versions}) { + local $" = "\t"; + $CPAN::Frontend->myprint(qq{ they are\n\t@version_undefs\n}); + $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 0' }. + qq{to hide them)\n}); + } else { + $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 1' }. + qq{to show them)\n}); + } + } + } + @result; +} + +#-> sub CPAN::Shell::r ; +sub r { + shift->_u_r_common("r",@_); +} + +#-> sub CPAN::Shell::u ; +sub u { + shift->_u_r_common("u",@_); +} + +#-> sub CPAN::Shell::failed ; +sub failed { + my($self,$only_id,$silent) = @_; + my @failed; + DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { + my $failed = ""; + NAY: for my $nosayer ( # order matters! + "unwrapped", + "writemakefile", + "signature_verify", + "make", + "make_test", + "install", + "make_clean", + ) { + next unless exists $d->{$nosayer}; + next unless defined $d->{$nosayer}; + next unless ( + UNIVERSAL::can($d->{$nosayer},"failed") ? + $d->{$nosayer}->failed : + $d->{$nosayer} =~ /^NO/ + ); + next NAY if $only_id && $only_id != ( + UNIVERSAL::can($d->{$nosayer},"commandid") + ? + $d->{$nosayer}->commandid + : + $CPAN::CurrentCommandId + ); + $failed = $nosayer; + last; + } + next DIST unless $failed; + my $id = $d->id; + $id =~ s|^./../||; + #$print .= sprintf( + # " %-45s: %s %s\n", + push @failed, + ( + UNIVERSAL::can($d->{$failed},"failed") ? + [ + $d->{$failed}->commandid, + $id, + $failed, + $d->{$failed}->text, + $d->{$failed}{TIME}||0, + ] : + [ + 1, + $id, + $failed, + $d->{$failed}, + 0, + ] + ); + } + my $scope; + if ($only_id) { + $scope = "this command"; + } elsif ($CPAN::Index::HAVE_REANIMATED) { + $scope = "this or a previous session"; + # it might be nice to have a section for previous session and + # a second for this + } else { + $scope = "this session"; + } + if (@failed) { + my $print; + my $debug = 0; + if ($debug) { + $print = join "", + map { sprintf "%5d %-45s: %s %s\n", @$_ } + sort { $a->[0] <=> $b->[0] } @failed; + } else { + $print = join "", + map { sprintf " %-45s: %s %s\n", @$_[1..3] } + sort { + $a->[0] <=> $b->[0] + || + $a->[4] <=> $b->[4] + } @failed; + } + $CPAN::Frontend->myprint("Failed during $scope:\n$print"); + } elsif (!$only_id || !$silent) { + $CPAN::Frontend->myprint("Nothing failed in $scope\n"); + } +} + +# XXX intentionally undocumented because completely bogus, unportable, +# useless, etc. + +#-> sub CPAN::Shell::status ; +sub status { + my($self) = @_; + require Devel::Size; + my $ps = FileHandle->new; + open $ps, "/proc/$$/status"; + my $vm = 0; + while (<$ps>) { + next unless /VmSize:\s+(\d+)/; + $vm = $1; + last; + } + $CPAN::Frontend->mywarn(sprintf( + "%-27s %6d\n%-27s %6d\n", + "vm", + $vm, + "CPAN::META", + Devel::Size::total_size($CPAN::META)/1024, + )); + for my $k (sort keys %$CPAN::META) { + next unless substr($k,0,4) eq "read"; + warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024; + for my $k2 (sort keys %{$CPAN::META->{$k}}) { + warn sprintf " %-25s %6d (keys: %6d)\n", + $k2, + Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024, + scalar keys %{$CPAN::META->{$k}{$k2}}; + } + } +} + +# compare with install_tested +#-> sub CPAN::Shell::is_tested +sub is_tested { + my($self) = @_; + CPAN::Index->reload; + for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) { + my $time; + if ($CPAN::META->{is_tested}{$b}) { + $time = scalar(localtime $CPAN::META->{is_tested}{$b}); + } else { + $time = scalar localtime; + $time =~ s/\S/?/g; + } + $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b); + } +} + +#-> sub CPAN::Shell::autobundle ; +sub autobundle { + my($self) = shift; + CPAN::HandleConfig->load unless $CPAN::Config_loaded++; + my(@bundle) = $self->_u_r_common("a",@_); + my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle"); + File::Path::mkpath($todir); + unless (-d $todir) { + $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n"); + return; + } + my($y,$m,$d) = (localtime)[5,4,3]; + $y+=1900; + $m++; + my($c) = 0; + my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c; + my($to) = File::Spec->catfile($todir,"$me.pm"); + while (-f $to) { + $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c; + $to = File::Spec->catfile($todir,"$me.pm"); + } + my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!"; + $fh->print( + "package Bundle::$me;\n\n", + "\$VERSION = '0.01';\n\n", + "1;\n\n", + "__END__\n\n", + "=head1 NAME\n\n", + "Bundle::$me - Snapshot of installation on ", + $Config::Config{'myhostname'}, + " on ", + scalar(localtime), + "\n\n=head1 SYNOPSIS\n\n", + "perl -MCPAN -e 'install Bundle::$me'\n\n", + "=head1 CONTENTS\n\n", + join("\n", @bundle), + "\n\n=head1 CONFIGURATION\n\n", + Config->myconfig, + "\n\n=head1 AUTHOR\n\n", + "This Bundle has been generated automatically ", + "by the autobundle routine in CPAN.pm.\n", + ); + $fh->close; + $CPAN::Frontend->myprint("\nWrote bundle file + $to\n\n"); +} + +#-> sub CPAN::Shell::expandany ; +sub expandany { + my($self,$s) = @_; + CPAN->debug("s[$s]") if $CPAN::DEBUG; + if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory + $s = CPAN::Distribution->normalize($s); + return $CPAN::META->instance('CPAN::Distribution',$s); + # Distributions spring into existence, not expand + } elsif ($s =~ m|^Bundle::|) { + $self->local_bundles; # scanning so late for bundles seems + # both attractive and crumpy: always + # current state but easy to forget + # somewhere + return $self->expand('Bundle',$s); + } else { + return $self->expand('Module',$s) + if $CPAN::META->exists('CPAN::Module',$s); + } + return; +} + +#-> sub CPAN::Shell::expand ; +sub expand { + my $self = shift; + my($type,@args) = @_; + CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG; + my $class = "CPAN::$type"; + my $methods = ['id']; + for my $meth (qw(name)) { + next unless $class->can($meth); + push @$methods, $meth; + } + $self->expand_by_method($class,$methods,@args); +} + +#-> sub CPAN::Shell::expand_by_method ; +sub expand_by_method { + my $self = shift; + my($class,$methods,@args) = @_; + my($arg,@m); + for $arg (@args) { + my($regex,$command); + if ($arg =~ m|^/(.*)/$|) { + $regex = $1; +# FIXME: there seem to be some ='s in the author data, which trigger +# a failure here. This needs to be contemplated. +# } elsif ($arg =~ m/=/) { +# $command = 1; + } + my $obj; + CPAN->debug(sprintf "class[%s]regex[%s]command[%s]", + $class, + defined $regex ? $regex : "UNDEFINED", + defined $command ? $command : "UNDEFINED", + ) if $CPAN::DEBUG; + if (defined $regex) { + if (CPAN::_sqlite_running()) { + CPAN::Index->reload; + $CPAN::SQLite->search($class, $regex); + } + for $obj ( + $CPAN::META->all_objects($class) + ) { + unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id) { + # BUG, we got an empty object somewhere + require Data::Dumper; + CPAN->debug(sprintf( + "Bug in CPAN: Empty id on obj[%s][%s]", + $obj, + Data::Dumper::Dumper($obj) + )) if $CPAN::DEBUG; + next; + } + for my $method (@$methods) { + my $match = eval {$obj->$method() =~ /$regex/i}; + if ($@) { + my($err) = $@ =~ /^(.+) at .+? line \d+\.$/; + $err ||= $@; # if we were too restrictive above + $CPAN::Frontend->mydie("$err\n"); + } elsif ($match) { + push @m, $obj; + last; + } + } + } + } elsif ($command) { + die "equal sign in command disabled (immature interface), ". + "you can set + ! \$CPAN::Shell::ADVANCED_QUERY=1 +to enable it. But please note, this is HIGHLY EXPERIMENTAL code +that may go away anytime.\n" + unless $ADVANCED_QUERY; + my($method,$criterion) = $arg =~ /(.+?)=(.+)/; + my($matchcrit) = $criterion =~ m/^~(.+)/; + for my $self ( + sort + {$a->id cmp $b->id} + $CPAN::META->all_objects($class) + ) { + my $lhs = $self->$method() or next; # () for 5.00503 + if ($matchcrit) { + push @m, $self if $lhs =~ m/$matchcrit/; + } else { + push @m, $self if $lhs eq $criterion; + } + } + } else { + my($xarg) = $arg; + if ( $class eq 'CPAN::Bundle' ) { + $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/; + } elsif ($class eq "CPAN::Distribution") { + $xarg = CPAN::Distribution->normalize($arg); + } else { + $xarg =~ s/:+/::/g; + } + if ($CPAN::META->exists($class,$xarg)) { + $obj = $CPAN::META->instance($class,$xarg); + } elsif ($CPAN::META->exists($class,$arg)) { + $obj = $CPAN::META->instance($class,$arg); + } else { + next; + } + push @m, $obj; + } + } + @m = sort {$a->id cmp $b->id} @m; + if ( $CPAN::DEBUG ) { + my $wantarray = wantarray; + my $join_m = join ",", map {$_->id} @m; + # $self->debug("wantarray[$wantarray]join_m[$join_m]"); + my $count = scalar @m; + $self->debug("class[$class]wantarray[$wantarray]count m[$count]"); + } + return wantarray ? @m : $m[0]; +} + +#-> sub CPAN::Shell::format_result ; +sub format_result { + my($self) = shift; + my($type,@args) = @_; + @args = '/./' unless @args; + my(@result) = $self->expand($type,@args); + my $result = @result == 1 ? + $result[0]->as_string : + @result == 0 ? + "No objects of type $type found for argument @args\n" : + join("", + (map {$_->as_glimpse} @result), + scalar @result, " items found\n", + ); + $result; +} + +#-> sub CPAN::Shell::report_fh ; +{ + my $installation_report_fh; + my $previously_noticed = 0; + + sub report_fh { + return $installation_report_fh if $installation_report_fh; + if ($CPAN::META->has_usable("File::Temp")) { + $installation_report_fh + = File::Temp->new( + dir => File::Spec->tmpdir, + template => 'cpan_install_XXXX', + suffix => '.txt', + unlink => 0, + ); + } + unless ( $installation_report_fh ) { + warn("Couldn't open installation report file; " . + "no report file will be generated." + ) unless $previously_noticed++; + } + } +} + + +# The only reason for this method is currently to have a reliable +# debugging utility that reveals which output is going through which +# channel. No, I don't like the colors ;-) + +# to turn colordebugging on, write +# cpan> o conf colorize_output 1 + +#-> sub CPAN::Shell::colorize_output ; +{ + my $print_ornamented_have_warned = 0; + sub colorize_output { + my $colorize_output = $CPAN::Config->{colorize_output}; + if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) { + unless ($print_ornamented_have_warned++) { + # no myprint/mywarn within myprint/mywarn! + warn "Colorize_output is set to true but Term::ANSIColor is not +installed. To activate colorized output, please install Term::ANSIColor.\n\n"; + } + $colorize_output = 0; + } + return $colorize_output; + } +} + + +#-> sub CPAN::Shell::print_ornamented ; +sub print_ornamented { + my($self,$what,$ornament) = @_; + return unless defined $what; + + local $| = 1; # Flush immediately + if ( $CPAN::Be_Silent ) { + print {report_fh()} $what; + return; + } + my $swhat = "$what"; # stringify if it is an object + if ($CPAN::Config->{term_is_latin}) { + # note: deprecated, need to switch to $LANG and $LC_* + # courtesy jhi: + $swhat + =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #}; + } + if ($self->colorize_output) { + if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) { + # if you want to have this configurable, please file a bugreport + $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan"; + } + my $color_on = eval { Term::ANSIColor::color($ornament) } || ""; + if ($@) { + print "Term::ANSIColor rejects color[$ornament]: $@\n +Please choose a different color (Hint: try 'o conf init /color/')\n"; + } + # GGOLDBACH/Test-GreaterVersion-0.008 broke without this + # $trailer construct. We want the newline be the last thing if + # there is a newline at the end ensuring that the next line is + # empty for other players + my $trailer = ""; + $trailer = $1 if $swhat =~ s/([\r\n]+)\z//; + print $color_on, + $swhat, + Term::ANSIColor::color("reset"), + $trailer; + } else { + print $swhat; + } +} + +#-> sub CPAN::Shell::myprint ; + +# where is myprint/mywarn/Frontend/etc. documented? Where to use what? +# I think, we send everything to STDOUT and use print for normal/good +# news and warn for news that need more attention. Yes, this is our +# working contract for now. +sub myprint { + my($self,$what) = @_; + $self->print_ornamented($what, + $CPAN::Config->{colorize_print}||'bold blue on_white', + ); +} + +sub optprint { + my($self,$category,$what) = @_; + my $vname = $category . "_verbosity"; + CPAN::HandleConfig->load unless $CPAN::Config_loaded++; + if (!$CPAN::Config->{$vname} + || $CPAN::Config->{$vname} =~ /^v/ + ) { + $CPAN::Frontend->myprint($what); + } +} + +#-> sub CPAN::Shell::myexit ; +sub myexit { + my($self,$what) = @_; + $self->myprint($what); + exit; +} + +#-> sub CPAN::Shell::mywarn ; +sub mywarn { + my($self,$what) = @_; + $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white'); +} + +# only to be used for shell commands +#-> sub CPAN::Shell::mydie ; +sub mydie { + my($self,$what) = @_; + $self->mywarn($what); + + # If it is the shell, we want the following die to be silent, + # but if it is not the shell, we would need a 'die $what'. We need + # to take care that only shell commands use mydie. Is this + # possible? + + die "\n"; +} + +# sub CPAN::Shell::colorable_makemaker_prompt ; +sub colorable_makemaker_prompt { + my($foo,$bar) = @_; + if (CPAN::Shell->colorize_output) { + my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white'; + my $color_on = eval { Term::ANSIColor::color($ornament); } || ""; + print $color_on; + } + my $ans = ExtUtils::MakeMaker::prompt($foo,$bar); + if (CPAN::Shell->colorize_output) { + print Term::ANSIColor::color('reset'); + } + return $ans; +} + +# use this only for unrecoverable errors! +#-> sub CPAN::Shell::unrecoverable_error ; +sub unrecoverable_error { + my($self,$what) = @_; + my @lines = split /\n/, $what; + my $longest = 0; + for my $l (@lines) { + $longest = length $l if length $l > $longest; + } + $longest = 62 if $longest > 62; + for my $l (@lines) { + if ($l =~ /^\s*$/) { + $l = "\n"; + next; + } + $l = "==> $l"; + if (length $l < 66) { + $l = pack "A66 A*", $l, "<=="; + } + $l .= "\n"; + } + unshift @lines, "\n"; + $self->mydie(join "", @lines); +} + +#-> sub CPAN::Shell::mysleep ; +sub mysleep { + my($self, $sleep) = @_; + if (CPAN->has_inst("Time::HiRes")) { + Time::HiRes::sleep($sleep); + } else { + sleep($sleep < 1 ? 1 : int($sleep + 0.5)); + } +} + +#-> sub CPAN::Shell::setup_output ; +sub setup_output { + return if -t STDOUT; + my $odef = select STDERR; + $| = 1; + select STDOUT; + $| = 1; + select $odef; +} + +#-> sub CPAN::Shell::rematein ; +# RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here +sub rematein { + my $self = shift; + my($meth,@some) = @_; + my @pragma; + while($meth =~ /^(ff?orce|notest)$/) { + push @pragma, $meth; + $meth = shift @some or + $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ". + "cannot continue"); + } + setup_output(); + CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG; + + # Here is the place to set "test_count" on all involved parties to + # 0. We then can pass this counter on to the involved + # distributions and those can refuse to test if test_count > X. In + # the first stab at it we could use a 1 for "X". + + # But when do I reset the distributions to start with 0 again? + # Jost suggested to have a random or cycling interaction ID that + # we pass through. But the ID is something that is just left lying + # around in addition to the counter, so I'd prefer to set the + # counter to 0 now, and repeat at the end of the loop. But what + # about dependencies? They appear later and are not reset, they + # enter the queue but not its copy. How do they get a sensible + # test_count? + + # With configure_requires, "get" is vulnerable in recursion. + + my $needs_recursion_protection = "get|make|test|install"; + + # construct the queue + my($s,@s,@qcopy); + STHING: foreach $s (@some) { + my $obj; + if (ref $s) { + CPAN->debug("s is an object[$s]") if $CPAN::DEBUG; + $obj = $s; + } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable + } elsif ($s =~ m|^/|) { # looks like a regexp + if (substr($s,-1,1) eq ".") { + $obj = CPAN::Shell->expandany($s); + } else { + $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ". + "not supported.\nRejecting argument '$s'\n"); + $CPAN::Frontend->mysleep(2); + next; + } + } elsif ($meth eq "ls") { + $self->globls($s,\@pragma); + next STHING; + } else { + CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG; + $obj = CPAN::Shell->expandany($s); + } + if (0) { + } elsif (ref $obj) { + if ($meth =~ /^($needs_recursion_protection)$/) { + # it would be silly to check for recursion for look or dump + # (we are in CPAN::Shell::rematein) + CPAN->debug("Going to test against recursion") if $CPAN::DEBUG; + eval { $obj->color_cmd_tmps(0,1); }; + if ($@) { + if (ref $@ + and $@->isa("CPAN::Exception::RecursiveDependency")) { + $CPAN::Frontend->mywarn($@); + } else { + if (0) { + require Carp; + Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@); + } + die; + } + } + } + CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c"); + push @qcopy, $obj; + } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) { + $obj = $CPAN::META->instance('CPAN::Author',uc($s)); + if ($meth =~ /^(dump|ls|reports)$/) { + $obj->$meth(); + } else { + $CPAN::Frontend->mywarn( + join "", + "Don't be silly, you can't $meth ", + $obj->fullname, + " ;-)\n" + ); + $CPAN::Frontend->mysleep(2); + } + } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") { + CPAN::InfoObj->dump($s); + } else { + $CPAN::Frontend + ->mywarn(qq{Warning: Cannot $meth $s, }. + qq{don't know what it is. +Try the command + + i /$s/ + +to find objects with matching identifiers. +}); + $CPAN::Frontend->mysleep(2); + } + } + + # queuerunner (please be warned: when I started to change the + # queue to hold objects instead of names, I made one or two + # mistakes and never found which. I reverted back instead) + QITEM: while (my $q = CPAN::Queue->first) { + my $obj; + my $s = $q->as_string; + my $reqtype = $q->reqtype || ""; + $obj = CPAN::Shell->expandany($s); + unless ($obj) { + # don't know how this can happen, maybe we should panic, + # but maybe we get a solution from the first user who hits + # this unfortunate exception? + $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ". + "to an object. Skipping.\n"); + $CPAN::Frontend->mysleep(5); + CPAN::Queue->delete_first($s); + next QITEM; + } + $obj->{reqtype} ||= ""; + { + # force debugging because CPAN::SQLite somehow delivers us + # an empty object; + + # local $CPAN::DEBUG = 1024; # Shell; probably fixed now + + CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]". + "q-reqtype[$reqtype]") if $CPAN::DEBUG; + } + if ($obj->{reqtype}) { + if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) { + $obj->{reqtype} = $reqtype; + if ( + exists $obj->{install} + && + ( + UNIVERSAL::can($obj->{install},"failed") ? + $obj->{install}->failed : + $obj->{install} =~ /^NO/ + ) + ) { + delete $obj->{install}; + $CPAN::Frontend->mywarn + ("Promoting $obj->{ID} from 'build_requires' to 'requires'"); + } + } + } else { + $obj->{reqtype} = $reqtype; + } + + for my $pragma (@pragma) { + if ($pragma + && + $obj->can($pragma)) { + $obj->$pragma($meth); + } + } + if (UNIVERSAL::can($obj, 'called_for')) { + $obj->called_for($s); + } + CPAN->debug(qq{pragma[@pragma]meth[$meth]}. + qq{ID[$obj->{ID}]}) if $CPAN::DEBUG; + + push @qcopy, $obj; + if ($meth =~ /^(report)$/) { # they came here with a pragma? + $self->$meth($obj); + } elsif (! UNIVERSAL::can($obj,$meth)) { + # Must never happen + my $serialized = ""; + if (0) { + } elsif ($CPAN::META->has_inst("YAML::Syck")) { + $serialized = YAML::Syck::Dump($obj); + } elsif ($CPAN::META->has_inst("YAML")) { + $serialized = YAML::Dump($obj); + } elsif ($CPAN::META->has_inst("Data::Dumper")) { + $serialized = Data::Dumper::Dumper($obj); + } else { + require overload; + $serialized = overload::StrVal($obj); + } + CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG; + $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]"); + } elsif ($obj->$meth()) { + CPAN::Queue->delete($s); + CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG; + } else { + CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG; + } + + $obj->undelay; + for my $pragma (@pragma) { + my $unpragma = "un$pragma"; + if ($obj->can($unpragma)) { + $obj->$unpragma(); + } + } + if ($CPAN::Config->{halt_on_failure} + && + CPAN::Distrostatus::something_has_just_failed() + ) { + $CPAN::Frontend->mywarn("Stopping: '$meth' failed for '$s'.\n"); + CPAN::Queue->nullify_queue; + last QITEM; + } + CPAN::Queue->delete_first($s); + } + if ($meth =~ /^($needs_recursion_protection)$/) { + for my $obj (@qcopy) { + $obj->color_cmd_tmps(0,0); + } + } +} + +#-> sub CPAN::Shell::recent ; +sub recent { + my($self) = @_; + if ($CPAN::META->has_inst("XML::LibXML")) { + my $url = $CPAN::Defaultrecent; + $CPAN::Frontend->myprint("Going to fetch '$url'\n"); + unless ($CPAN::META->has_usable("LWP")) { + $CPAN::Frontend->mydie("LWP not installed; cannot continue"); + } + CPAN::LWP::UserAgent->config; + my $Ua; + eval { $Ua = CPAN::LWP::UserAgent->new; }; + if ($@) { + $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n"); + } + my $resp = $Ua->get($url); + unless ($resp->is_success) { + $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code); + } + $CPAN::Frontend->myprint("DONE\n\n"); + my $xml = XML::LibXML->new->parse_string($resp->content); + if (0) { + my $s = $xml->serialize(2); + $s =~ s/\n\s*\n/\n/g; + $CPAN::Frontend->myprint($s); + return; + } + my @distros; + if ($url =~ /winnipeg/) { + my $pubdate = $xml->findvalue("/rss/channel/pubDate"); + $CPAN::Frontend->myprint(" pubDate: $pubdate\n\n"); + for my $eitem ($xml->findnodes("/rss/channel/item")) { + my $distro = $eitem->findvalue("enclosure/\@url"); + $distro =~ s|.*?/authors/id/./../||; + my $size = $eitem->findvalue("enclosure/\@length"); + my $desc = $eitem->findvalue("description"); + $desc =~ s/.+? - //; + $CPAN::Frontend->myprint("$distro [$size b]\n $desc\n"); + push @distros, $distro; + } + } elsif ($url =~ /search.*uploads.rdf/) { + # xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" + # xmlns="http://purl.org/rss/1.0/" + # xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/" + # xmlns:dc="http://purl.org/dc/elements/1.1/" + # xmlns:syn="http://purl.org/rss/1.0/modules/syndication/" + # xmlns:admin="http://webns.net/mvcb/" + + + my $dc_date = $xml->findvalue("//*[local-name(.) = 'RDF']/*[local-name(.) = 'channel']/*[local-name(.) = 'date']"); + $CPAN::Frontend->myprint(" dc:date: $dc_date\n\n"); + my $finish_eitem = 0; + local $SIG{INT} = sub { $finish_eitem = 1 }; + EITEM: for my $eitem ($xml->findnodes("//*[local-name(.) = 'RDF']/*[local-name(.) = 'item']")) { + my $distro = $eitem->findvalue("\@rdf:about"); + $distro =~ s|.*~||; # remove up to the tilde before the name + $distro =~ s|/$||; # remove trailing slash + $distro =~ s|([^/]+)|\U$1\E|; # upcase the name + my $author = uc $1 or die "distro[$distro] without author, cannot continue"; + my $desc = $eitem->findvalue("*[local-name(.) = 'description']"); + my $i = 0; + SUBDIRTEST: while () { + last SUBDIRTEST if ++$i >= 6; # half a dozen must do! + if (my @ret = $self->globls("$distro*")) { + @ret = grep {$_->[2] !~ /meta/} @ret; + @ret = grep {length $_->[2]} @ret; + if (@ret) { + $distro = "$author/$ret[0][2]"; + last SUBDIRTEST; + } + } + $distro =~ s|/|/*/|; # allow it to reside in a subdirectory + } + + next EITEM if $distro =~ m|\*|; # did not find the thing + $CPAN::Frontend->myprint("____$desc\n"); + push @distros, $distro; + last EITEM if $finish_eitem; + } + } + return \@distros; + } else { + # deprecated old version + $CPAN::Frontend->mydie("no XML::LibXML installed, cannot continue\n"); + } +} + +#-> sub CPAN::Shell::smoke ; +sub smoke { + my($self) = @_; + my $distros = $self->recent; + DISTRO: for my $distro (@$distros) { + next if $distro =~ m|/Bundle-|; # XXX crude heuristic to skip bundles + $CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n"); + { + my $skip = 0; + local $SIG{INT} = sub { $skip = 1 }; + for (0..9) { + $CPAN::Frontend->myprint(sprintf "\r%2d (Hit ^C to skip)", 10-$_); + sleep 1; + if ($skip) { + $CPAN::Frontend->myprint(" skipped\n"); + next DISTRO; + } + } + } + $CPAN::Frontend->myprint("\r \n"); # leave the dirty line with a newline + $self->test($distro); + } +} + +{ + # set up the dispatching methods + no strict "refs"; + for my $command (qw( + clean + cvs_import + dump + force + fforce + get + install + look + ls + make + notest + perldoc + readme + reports + test + )) { + *$command = sub { shift->rematein($command, @_); }; + } +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Tarzip.pm b/cpan/CPAN/lib/CPAN/Tarzip.pm new file mode 100644 index 0000000000..17b3cd748d --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Tarzip.pm @@ -0,0 +1,404 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +package CPAN::Tarzip; +use strict; +use vars qw($VERSION @ISA $BUGHUNTING); +use CPAN::Debug; +use File::Basename qw(basename); +$VERSION = "5.501"; +# module is internal to CPAN.pm + +@ISA = qw(CPAN::Debug); ## no critic +$BUGHUNTING ||= 0; # released code must have turned off + +# it's ok if file doesn't exist, it just matters if it is .gz or .bz2 +sub new { + my($class,$file) = @_; + $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file; + if (0) { + # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available + $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/") + unless $file =~ /\.(bz2|gz|zip|tgz)$/i; + } + my $me = { FILE => $file }; + if (0) { + } elsif ($file =~ /\.bz2$/i) { + unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) { + my $bzip2 = _my_which("bzip2"); + if ($bzip2) { + $me->{UNGZIPPRG} = $bzip2; + } else { + $CPAN::Frontend->mydie(qq{ +CPAN.pm needs the external program bzip2 in order to handle '$file'. +Please install it now and run 'o conf init' to register it as external +program. +}); + } + } + } else { + $me->{UNGZIPPRG} = _my_which("gzip"); + } + $me->{TARPRG} = _my_which("tar") || _my_which("gtar"); + bless $me, $class; +} + +sub _my_which { + my($what) = @_; + if ($CPAN::Config->{$what}) { + return $CPAN::Config->{$what}; + } + if ($CPAN::META->has_inst("File::Which")) { + return File::Which::which($what); + } + my @cand = MM->maybe_command($what); + return $cand[0] if @cand; + require File::Spec; + my $component; + PATH_COMPONENT: foreach $component (File::Spec->path()) { + next unless defined($component) && $component; + my($abs) = File::Spec->catfile($component,$what); + if (MM->maybe_command($abs)) { + return $abs; + } + } + return; +} + +sub gzip { + my($self,$read) = @_; + my $write = $self->{FILE}; + if ($CPAN::META->has_inst("Compress::Zlib")) { + my($buffer,$fhw); + $fhw = FileHandle->new($read) + or $CPAN::Frontend->mydie("Could not open $read: $!"); + my $cwd = `pwd`; + my $gz = Compress::Zlib::gzopen($write, "wb") + or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n"); + $gz->gzwrite($buffer) + while read($fhw,$buffer,4096) > 0 ; + $gz->gzclose() ; + $fhw->close; + return 1; + } else { + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + system(qq{$command -c "$read" > "$write"})==0; + } +} + + +sub gunzip { + my($self,$write) = @_; + my $read = $self->{FILE}; + if ($CPAN::META->has_inst("Compress::Zlib")) { + my($buffer,$fhw); + $fhw = FileHandle->new(">$write") + or $CPAN::Frontend->mydie("Could not open >$write: $!"); + my $gz = Compress::Zlib::gzopen($read, "rb") + or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n"); + $fhw->print($buffer) + while $gz->gzread($buffer) > 0 ; + $CPAN::Frontend->mydie("Error reading from $read: $!\n") + if $gz->gzerror != Compress::Zlib::Z_STREAM_END(); + $gz->gzclose() ; + $fhw->close; + return 1; + } else { + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + system(qq{$command -dc "$read" > "$write"})==0; + } +} + + +sub gtest { + my($self) = @_; + return $self->{GTEST} if exists $self->{GTEST}; + defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified"); + my $read = $self->{FILE}; + my $success; + # After I had reread the documentation in zlib.h, I discovered that + # uncompressed files do not lead to an gzerror (anymore?). + if ( $CPAN::META->has_inst("Compress::Zlib") ) { + my($buffer,$len); + $len = 0; + my $gz = Compress::Zlib::gzopen($read, "rb") + or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n", + $read, + $Compress::Zlib::gzerrno)); + while ($gz->gzread($buffer) > 0 ) { + $len += length($buffer); + $buffer = ""; + } + my $err = $gz->gzerror; + $success = ! $err || $err == Compress::Zlib::Z_STREAM_END(); + if ($len == -s $read) { + $success = 0; + CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG; + } + $gz->gzclose(); + CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG; + } else { + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + $success = 0==system(qq{$command -qdt "$read"}); + } + return $self->{GTEST} = $success; +} + + +sub TIEHANDLE { + my($class,$file) = @_; + my $ret; + $class->debug("file[$file]"); + my $self = $class->new($file); + if (0) { + } elsif (!$self->gtest) { + my $fh = FileHandle->new($file) + or $CPAN::Frontend->mydie("Could not open file[$file]: $!"); + binmode $fh; + $self->{FH} = $fh; + $class->debug("via uncompressed FH"); + } elsif ($CPAN::META->has_inst("Compress::Zlib")) { + my $gz = Compress::Zlib::gzopen($file,"rb") or + $CPAN::Frontend->mydie("Could not gzopen $file"); + $self->{GZ} = $gz; + $class->debug("via Compress::Zlib"); + } else { + my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + my $pipe = "$gzip -dc $file |"; + my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!"); + binmode $fh; + $self->{FH} = $fh; + $class->debug("via external gzip"); + } + $self; +} + + +sub READLINE { + my($self) = @_; + if (exists $self->{GZ}) { + my $gz = $self->{GZ}; + my($line,$bytesread); + $bytesread = $gz->gzreadline($line); + return undef if $bytesread <= 0; + return $line; + } else { + my $fh = $self->{FH}; + return scalar <$fh>; + } +} + + +sub READ { + my($self,$ref,$length,$offset) = @_; + $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset; + if (exists $self->{GZ}) { + my $gz = $self->{GZ}; + my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8 + return $byteread; + } else { + my $fh = $self->{FH}; + return read($fh,$$ref,$length); + } +} + + +sub DESTROY { + my($self) = @_; + if (exists $self->{GZ}) { + my $gz = $self->{GZ}; + $gz->gzclose() if defined $gz; # hard to say if it is allowed + # to be undef ever. AK, 2000-09 + } else { + my $fh = $self->{FH}; + $fh->close if defined $fh; + } + undef $self; +} + +sub untar { + my($self) = @_; + my $file = $self->{FILE}; + my($prefer) = 0; + + my $exttar = $self->{TARPRG} || ""; + $exttar = "" if $exttar =~ /^\s+$/; # user refuses to use it + my $extgzip = $self->{UNGZIPPRG} || ""; + $extgzip = "" if $extgzip =~ /^\s+$/; # user refuses to use it + if (0) { # makes changing order easier + } elsif ($BUGHUNTING) { + $prefer=2; + } elsif ($exttar && $extgzip && $file =~ /\.bz2$/i) { + # until Archive::Tar handles bzip2 + $prefer = 1; + } elsif ( + $CPAN::META->has_usable("Archive::Tar") + && + $CPAN::META->has_inst("Compress::Zlib") ) { + $prefer = 2; + } elsif ($exttar && $extgzip) { + # no modules and not bz2 + $prefer = 1; + } else { + my $foundtar = $exttar ? "'$exttar'" : "nothing"; + my $foundzip = $extgzip ? "'$extgzip'" : $foundtar ? "nothing" : "also nothing"; + my $foundAT; + if ($CPAN::META->has_usable("Archive::Tar")) { + $foundAT = sprintf "'%s'", "Archive::Tar::"->VERSION; + } else { + $foundAT = "nothing"; + } + my $foundCZ; + if ($CPAN::META->has_inst("Compress::Zlib")) { + $foundCZ = sprintf "'%s'", "Compress::Zlib::"->VERSION; + } elsif ($foundAT) { + $foundCZ = "nothing"; + } else { + $foundCZ = "also nothing"; + } + $CPAN::Frontend->mydie(qq{ + +CPAN.pm needs either the external programs tar and gzip -or- both +modules Archive::Tar and Compress::Zlib installed. + +For tar I found $foundtar, for gzip $foundzip. + +For Archive::Tar I found $foundAT, for Compress::Zlib $foundCZ; + +Can't continue cutting file '$file'. +}); + } + my $tar_verb = "v"; + if (defined $CPAN::Config->{tar_verbosity}) { + $tar_verb = $CPAN::Config->{tar_verbosity} eq "none" ? "" : + $CPAN::Config->{tar_verbosity}; + } + if ($prefer==1) { # 1 => external gzip+tar + my($system); + my $is_compressed = $self->gtest(); + my $tarcommand = CPAN::HandleConfig->safe_quote($exttar); + if ($is_compressed) { + my $command = CPAN::HandleConfig->safe_quote($extgzip); + $system = qq{$command -dc }. + qq{< "$file" | $tarcommand x${tar_verb}f -}; + } else { + $system = qq{$tarcommand x${tar_verb}f "$file"}; + } + if (system($system) != 0) { + # people find the most curious tar binaries that cannot handle + # pipes + if ($is_compressed) { + (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//; + $ungzf = basename $ungzf; + my $ct = CPAN::Tarzip->new($file); + if ($ct->gunzip($ungzf)) { + $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n}); + } else { + $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n}); + } + $file = $ungzf; + } + $system = qq{$tarcommand x${tar_verb}f "$file"}; + $CPAN::Frontend->myprint(qq{Using Tar:$system:\n}); + if (system($system)==0) { + $CPAN::Frontend->myprint(qq{Untarred $file successfully\n}); + } else { + $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n}); + } + return 1; + } else { + return 1; + } + } elsif ($prefer==2) { # 2 => modules + unless ($CPAN::META->has_usable("Archive::Tar")) { + $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue"); + } + # Make sure AT does not use uid/gid/permissions in the archive + # This leaves it to the user's umask instead + local $Archive::Tar::CHMOD = 1; + local $Archive::Tar::SAME_PERMISSIONS = 0; + # Make sure AT leaves current user as owner + local $Archive::Tar::CHOWN = 0; + my $tar = Archive::Tar->new($file,1); + my $af; # archive file + my @af; + if ($BUGHUNTING) { + # RCS 1.337 had this code, it turned out unacceptable slow but + # it revealed a bug in Archive::Tar. Code is only here to hunt + # the bug again. It should never be enabled in published code. + # GDGraph3d-0.53 was an interesting case according to Larry + # Virden. + warn(">>>Bughunting code enabled<<< " x 20); + for $af ($tar->list_files) { + if ($af =~ m!^(/|\.\./)!) { + $CPAN::Frontend->mydie("ALERT: Archive contains ". + "illegal member [$af]"); + } + $CPAN::Frontend->myprint("$af\n"); + $tar->extract($af); # slow but effective for finding the bug + return if $CPAN::Signal; + } + } else { + for $af ($tar->list_files) { + if ($af =~ m!^(/|\.\./)!) { + $CPAN::Frontend->mydie("ALERT: Archive contains ". + "illegal member [$af]"); + } + if ($tar_verb eq "v" || $tar_verb eq "vv") { + $CPAN::Frontend->myprint("$af\n"); + } + push @af, $af; + return if $CPAN::Signal; + } + $tar->extract(@af) or + $CPAN::Frontend->mydie("Could not untar with Archive::Tar."); + } + + Mac::BuildTools::convert_files([$tar->list_files], 1) + if ($^O eq 'MacOS'); + + return 1; + } +} + +sub unzip { + my($self) = @_; + my $file = $self->{FILE}; + if ($CPAN::META->has_inst("Archive::Zip")) { + # blueprint of the code from Archive::Zip::Tree::extractTree(); + my $zip = Archive::Zip->new(); + my $status; + $status = $zip->read($file); + $CPAN::Frontend->mydie("Read of file[$file] failed\n") + if $status != Archive::Zip::AZ_OK(); + $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG; + my @members = $zip->members(); + for my $member ( @members ) { + my $af = $member->fileName(); + if ($af =~ m!^(/|\.\./)!) { + $CPAN::Frontend->mydie("ALERT: Archive contains ". + "illegal member [$af]"); + } + $status = $member->extractToFileNamed( $af ); + $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG; + $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if + $status != Archive::Zip::AZ_OK(); + return if $CPAN::Signal; + } + return 1; + } else { + my $unzip = $CPAN::Config->{unzip} or + $CPAN::Frontend->mydie("Cannot unzip, no unzip program available"); + my @system = ($unzip, $file); + return system(@system) == 0; + } +} + +1; + +__END__ + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut diff --git a/cpan/CPAN/lib/CPAN/URL.pm b/cpan/CPAN/lib/CPAN/URL.pm new file mode 100644 index 0000000000..52b42eec88 --- /dev/null +++ b/cpan/CPAN/lib/CPAN/URL.pm @@ -0,0 +1,31 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- +# vim: ts=4 sts=4 sw=4: +package CPAN::URL; +use overload '""' => "as_string", fallback => 1; +# accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist), +# planned are things like age or quality + +use vars qw( + $VERSION +); +$VERSION = "5.5"; + +sub new { + my($class,%args) = @_; + bless { + %args + }, $class; +} +sub as_string { + my($self) = @_; + $self->text; +} +sub text { + my($self,$set) = @_; + if (defined $set) { + $self->{TEXT} = $set; + } + $self->{TEXT}; +} + +1; diff --git a/cpan/CPAN/lib/CPAN/Version.pm b/cpan/CPAN/lib/CPAN/Version.pm new file mode 100644 index 0000000000..da876aac2d --- /dev/null +++ b/cpan/CPAN/lib/CPAN/Version.pm @@ -0,0 +1,173 @@ +package CPAN::Version; + +use strict; +use vars qw($VERSION); +$VERSION = "5.5"; + +# CPAN::Version::vcmp courtesy Jost Krieger +sub vcmp { + my($self,$l,$r) = @_; + local($^W) = 0; + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + + return 0 if $l eq $r; # short circuit for quicker success + + for ($l,$r) { + s/_//g; + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + for ($l,$r) { + next unless tr/.// > 1 || /^v/; + s/^v?/v/; + 1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + if ($l=~/^v/ <=> $r=~/^v/) { + for ($l,$r) { + next if /^v/; + $_ = $self->float2vv($_); + } + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + my $lvstring = "v0"; + my $rvstring = "v0"; + if ($] >= 5.006 + && $l =~ /^v/ + && $r =~ /^v/) { + $lvstring = $self->vstring($l); + $rvstring = $self->vstring($r); + CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG; + } + + return ( + ($l ne "undef") <=> ($r ne "undef") + || + $lvstring cmp $rvstring + || + $l <=> $r + || + $l cmp $r + ); +} + +sub vgt { + my($self,$l,$r) = @_; + $self->vcmp($l,$r) > 0; +} + +sub vlt { + my($self,$l,$r) = @_; + 0 + ($self->vcmp($l,$r) < 0); +} + +sub vge { + my($self,$l,$r) = @_; + $self->vcmp($l,$r) >= 0; +} + +sub vle { + my($self,$l,$r) = @_; + 0 + ($self->vcmp($l,$r) <= 0); +} + +sub vstring { + my($self,$n) = @_; + $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]"; + pack "U*", split /\./, $n; +} + +# vv => visible vstring +sub float2vv { + my($self,$n) = @_; + my($rev) = int($n); + $rev ||= 0; + my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit + # architecture influence + $mantissa ||= 0; + $mantissa .= "0" while length($mantissa)%3; + my $ret = "v" . $rev; + while ($mantissa) { + $mantissa =~ s/(\d{1,3})// or + die "Panic: length>0 but not a digit? mantissa[$mantissa]"; + $ret .= ".".int($1); + } + # warn "n[$n]ret[$ret]"; + $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0 + $ret; +} + +sub readable { + my($self,$n) = @_; + $n =~ /^([\w\-\+\.]+)/; + + return $1 if defined $1 && length($1)>0; + # if the first user reaches version v43, he will be treated as "+". + # We'll have to decide about a new rule here then, depending on what + # will be the prevailing versioning behavior then. + + if ($] < 5.006) { # or whenever v-strings were introduced + # we get them wrong anyway, whatever we do, because 5.005 will + # have already interpreted 0.2.4 to be "0.24". So even if he + # indexer sends us something like "v0.2.4" we compare wrongly. + + # And if they say v1.2, then the old perl takes it as "v12" + + if (defined $CPAN::Frontend) { + $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n"); + } else { + warn("Suspicious version string seen [$n]\n"); + } + return $n; + } + my $better = sprintf "v%vd", $n; + CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG; + return $better; +} + +1; + +__END__ + +=head1 NAME + +CPAN::Version - utility functions to compare CPAN versions + +=head1 SYNOPSIS + + use CPAN::Version; + + CPAN::Version->vgt("1.1","1.1.1"); # 1 bc. 1.1 > 1.001001 + + CPAN::Version->vlt("1.1","1.1"); # 0 bc. 1.1 not < 1.1 + + CPAN::Version->vcmp("1.1","1.1.1"); # 1 bc. first is larger + + CPAN::Version->vcmp("1.1.1","1.1"); # -1 bc. first is smaller + + CPAN::Version->readable(v1.2.3); # "v1.2.3" + + CPAN::Version->vstring("v1.2.3"); # v1.2.3 + + CPAN::Version->float2vv(1.002003); # "v1.2.3" + +=head1 DESCRIPTION + +This module mediates between some version that perl sees in a package +and the version that is published by the CPAN indexer. + +It's only written as a helper module for both CPAN.pm and CPANPLUS.pm. + +As it stands it predates version.pm but has the same goal: make +version strings visible and comparable. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# End: diff --git a/cpan/CPAN/scripts/cpan b/cpan/CPAN/scripts/cpan new file mode 100644 index 0000000000..d06666e78f --- /dev/null +++ b/cpan/CPAN/scripts/cpan @@ -0,0 +1,467 @@ +#!/usr/bin/perl +# $Id: cpan,v 1.9 2006/11/01 21:49:31 comdog Exp $ +use strict; + +=head1 NAME + +cpan - easily interact with CPAN from the command line + +=head1 SYNOPSIS + + # with arguments and no switches, installs specified modules + cpan module_name [ module_name ... ] + + # with switches, installs modules with extra behavior + cpan [-cfimt] module_name [ module_name ... ] + + # without arguments, starts CPAN.pm shell + cpan + + # without arguments, but some switches + cpan [-ahrvACDLO] + +=head1 DESCRIPTION + +This script provides a command interface (not a shell) to CPAN. At the +moment it uses CPAN.pm to do the work, but it is not a one-shot command +runner for CPAN.pm. + +=head2 Meta Options + +These options are mutually exclusive, and the script processes them in +this order: [hvCAar]. Once the script finds one, it ignores the others, +and then exits after it finishes the task. The script ignores any other +command line options. + +=over 4 + +=item -a + +Creates the CPAN.pm autobundle with CPAN::Shell->autobundle. + +=item -A module [ module ... ] + +Shows the primary maintainers for the specified modules + +=item -C module [ module ... ] + +Show the C<Changes> files for the specified modules + +=item -D module [ module ... ] + +Show the module details. This prints one line for each out-of-date module +(meaning, modules locally installed but have newer versions on CPAN). +Each line has three columns: module name, local version, and CPAN +version. + +=item -L author [ author ... ] + +List the modules by the specified authors. + +=item -h + +Prints a help message. + +=item -O + +Show the out-of-date modules. + +=item -r + +Recompiles dynamically loaded modules with CPAN::Shell->recompile. + +=item -v + +Print the script version and CPAN.pm version. + +=back + +=head2 Module options + +These options are mutually exclusive, and the script processes them in +alphabetical order. It only processes the first one it finds. + +=over 4 + +=item c + +Runs a `make clean` in the specified module's directories. + +=item f + +Forces the specified action, when it normally would have failed. + +=item i + +Installed the specified modules. + +=item m + +Makes the specified modules. + +=item t + +Runs a `make test` on the specified modules. + +=back + +=head2 Examples + + # print a help message + cpan -h + + # print the version numbers + cpan -v + + # create an autobundle + cpan -a + + # recompile modules + cpan -r + + # install modules ( sole -i is optional ) + cpan -i Netscape::Booksmarks Business::ISBN + + # force install modules ( must use -i ) + cpan -fi CGI::Minimal URI + +=head1 TO DO + + +=head1 BUGS + +* none noted + +=head1 SEE ALSO + +Most behaviour, including environment variables and configuration, +comes directly from CPAN.pm. + +=head1 SOURCE AVAILABILITY + +This source is part of a SourceForge project which always has the +latest sources in CVS, as well as all of the previous releases. + + http://sourceforge.net/projects/brian-d-foy/ + +If, for some reason, I disappear from the world, one of the other +members of the project can shepherd this module appropriately. + +=head1 CREDITS + +Japheth Cleaver added the bits to allow a forced install (-f). + +Jim Brandt suggest and provided the initial implementation for the +up-to-date and Changes features. + +Adam Kennedy pointed out that exit() causes problems on Windows +where this script ends up with a .bat extension + +=head1 AUTHOR + +brian d foy, C<< <bdfoy@cpan.org> >> + +=head1 COPYRIGHT + +Copyright (c) 2001-2006, brian d foy, All Rights Reserved. + +You may redistribute this under the same terms as Perl itself. + +=cut + +use CPAN (); +use Getopt::Std; + +my $VERSION = + sprintf "%d.%d", q$Revision: 1.9 $ =~ m/ (\d+) \. (\d+) /xg; + +if( $ARGV[0] eq 'install' ) + { + my @args = @ARGV; + shift @args; + + die <<"HERE"; +It looks like you specified 'install' as an argument to cpan(1). This +script is not the CPAN.pm prompt and doesn't understand the same commands. +In fact, doesn't require the extra typing. You probably just want to +list the modules you want to install: + + cpan @args + +See the documentation for more details on using this script. +HERE + } + +if( 0 == @ARGV ) { CPAN::shell(); exit 0 } + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# set up the order of options that we layer over CPAN::Shell +my @META_OPTIONS = qw( h v C A D O L a r ); + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# map switches to method names in CPAN::Shell +my $Default = 'default'; + +my %CPAN_METHODS = ( + $Default => 'install', + 'c' => 'clean', + 'f' => 'force', + 'i' => 'install', + 'm' => 'make', + 't' => 'test', + ); +my @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS; + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# map switches to the subroutines in this script, along with other information. +# use this stuff instead of hard-coded indices and values +my %Method_table = ( +# key => [ sub ref, takes args?, exit value, description ] + h => [ \&_print_help, 0, 0, 'Printing help' ], + v => [ \&_print_version, 0, 0, 'Printing version' ], + C => [ \&_show_Changes, 1, 0, 'Showing Changes file' ], + A => [ \&_show_Author, 1, 0, 'Showing Author' ], + D => [ \&_show_Details, 1, 0, 'Showing Details' ], + O => [ \&_show_out_of_date, 0, 0, 'Showing Out of date' ], + L => [ \&_show_author_mods, 1, 0, 'Showing author mods' ], + a => [ \&_create_autobundle, 0, 0, 'Creating autobundle' ], + r => [ \&_recompiling, 0, 0, 'Recompiling' ], + + c => [ \&_default, 1, 0, 'Running `make clean`' ], + f => [ \&_default, 1, 0, 'Installing with force' ], + i => [ \&_default, 1, 0, 'Running `make install`' ], + 'm' => [ \&_default, 1, 0, 'Running `make`' ], + t => [ \&_default, 1, 0, 'Running `make test`' ], + + ); + +my %Method_table_index = ( + code => 0, + takes_args => 1, + exit_value => 2, + description => 3, + ); + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# finally, do some argument processing +my @option_order = ( @META_OPTIONS, @CPAN_OPTIONS ); + +my %options; +Getopt::Std::getopts( + join( '', @option_order ), \%options ); + +my $option_count = grep { $options{$_} } @option_order; +$option_count -= $options{'f'}; # don't count force + +# if there are no options, set -i (this line fixes RT ticket 16915) +$options{i}++ unless $option_count; + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# try each of the possible switches until we find one to handle +# print an error message if there are too many switches +# print an error message if there are arguments when there shouldn't be any +foreach my $option ( @option_order ) + { + next unless $options{$option}; + die unless + ref $Method_table{$option}[ $Method_table_index{code} ] eq ref sub {}; + + print "$Method_table{$option}[ $Method_table_index{description} ] " . + "-- ignoring other opitions\n" if $option_count > 1; + print "$Method_table{$option}[ $Method_table_index{description} ] " . + "-- ignoring other arguments\n" + if( @ARGV && ! $Method_table{$option}[ $Method_table_index{takes_args} ] ); + + $Method_table{$option}[ $Method_table_index{code} ]->( \@ARGV ); + + last; + } + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # + # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # + +sub _default + { + my $args = shift; + + my $switch = ''; + + # choose the option that we're going to use + # we'll deal with 'f' (force) later, so skip it + foreach my $option ( @CPAN_OPTIONS ) + { + next if $option eq 'f'; + next unless $options{$option}; + $switch = $option; + last; + } + + # 1. with no switches, but arguments, use the default switch (install) + # 2. with no switches and no args, start the shell + # 3. With a switch but no args, die! These switches need arguments. + if( not $switch and @$args ) { $switch = $Default; } + elsif( not $switch and not @$args ) { CPAN::shell(); return } + elsif( $switch and not @$args ) + { die "Nothing to $CPAN_METHODS{$switch}!\n"; } + + # Get and cheeck the method from CPAN::Shell + my $method = $CPAN_METHODS{$switch}; + die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method ); + + # call the CPAN::Shell method, with force if specified + foreach my $arg ( @$args ) + { + if( $options{f} ) { CPAN::Shell->force( $method, $arg ) } + else { CPAN::Shell->$method( $arg ) } + } + } + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +sub _print_help + { + print STDERR "Use perldoc to read the documentation\n"; + exec "perldoc $0"; + } + +sub _print_version + { + print STDERR "$0 script version $VERSION, CPAN.pm version " . + CPAN->VERSION . "\n"; + } + +sub _create_autobundle + { + print "Creating autobundle in ", $CPAN::Config->{cpan_home}, + "/Bundle\n"; + + CPAN::Shell->autobundle; + } + +sub _recompiling + { + print "Recompiling dynamically-loaded extensions\n"; + + CPAN::Shell->recompile; + } + +sub _show_Changes + { + my $args = shift; + + foreach my $arg ( @$args ) + { + print "Checking $arg\n"; + my $module = CPAN::Shell->expand( "Module", $arg ); + + next unless $module->inst_file; + #next if $module->uptodate; + + ( my $id = $module->id() ) =~ s/::/\-/; + + my $url = "http://search.cpan.org/~" . lc( $module->userid ) . "/" . + $id . "-" . $module->cpan_version() . "/"; + + #print "URL: $url\n"; + _get_changes_file($url); + } + } + +sub _get_changes_file + { + die "Reading Changes files requires LWP::Simple and URI\n" + unless eval { require LWP::Simple; require URI; }; + + my $url = shift; + + my $content = LWP::Simple::get( $url ); + print "Got $url ...\n" if defined $content; + #print $content; + + my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi; + + my $changes_url = URI->new_abs( $change_link, $url ); + #print "change link is: $changes_url\n"; + my $changes = LWP::Simple::get( $changes_url ); + #print "change text is: " . $change_link->text() . "\n"; + print $changes; + } + +sub _show_Author + { + my $args = shift; + + foreach my $arg ( @$args ) + { + my $module = CPAN::Shell->expand( "Module", $arg ); + my $author = CPAN::Shell->expand( "Author", $module->userid ); + + next unless $module->userid; + + printf "%-25s %-8s %-25s %s\n", + $arg, $module->userid, $author->email, $author->fullname; + } + } + +sub _show_Details + { + my $args = shift; + + foreach my $arg ( @$args ) + { + my $module = CPAN::Shell->expand( "Module", $arg ); + my $author = CPAN::Shell->expand( "Author", $module->userid ); + + next unless $module->userid; + + print "$arg\n", "-" x 73, "\n\t"; + print join "\n\t", + $module->description ? $module->description : "(no description)", + $module->cpan_file, + $module->inst_file, + 'Installed: ' . $module->inst_version, + 'CPAN: ' . $module->cpan_version . ' ' . + ($module->uptodate ? "" : "Not ") . "up to date", + $author->fullname . " (" . $module->userid . ")", + $author->email; + print "\n\n"; + + } + } + +sub _show_out_of_date + { + my @modules = CPAN::Shell->expand( "Module", "/./" ); + + printf "%-40s %6s %6s\n", "Module Name", "Local", "CPAN"; + print "-" x 73, "\n"; + + foreach my $module ( @modules ) + { + next unless $module->inst_file; + next if $module->uptodate; + printf "%-40s %.4f %.4f\n", + $module->id, + $module->inst_version ? $module->inst_version : '', + $module->cpan_version; + } + + } + +sub _show_author_mods + { + my $args = shift; + + my %hash = map { lc $_, 1 } @$args; + + my @modules = CPAN::Shell->expand( "Module", "/./" ); + + foreach my $module ( @modules ) + { + next unless exists $hash{ lc $module->userid }; + print $module->id, "\n"; + } + + } + +1; diff --git a/cpan/CPAN/t/01loadme.t b/cpan/CPAN/t/01loadme.t new file mode 100644 index 0000000000..c22589b656 --- /dev/null +++ b/cpan/CPAN/t/01loadme.t @@ -0,0 +1,15 @@ +#!/usr/bin/perl -w + +BEGIN { + print "1..1\n"; +} +use strict; +use CPAN; +use CPAN::FirstTime; + +print "ok 1\n"; + +# Local Variables: +# mode: cperl +# cperl-indent-level: 2 +# End: diff --git a/cpan/CPAN/t/02nox.t b/cpan/CPAN/t/02nox.t new file mode 100644 index 0000000000..15eae05fa8 --- /dev/null +++ b/cpan/CPAN/t/02nox.t @@ -0,0 +1,36 @@ +#!./perl + +if (! eval { require Test::More; 1 }) { + printf "1..1\nok 1 # Test::More not available: skipping %s\n", __FILE__; + exit; +} +require Test::More; +Test::More->import(tests => 8); + +# use this first to $CPAN::term can be undefined +use_ok( 'CPAN' ); +$CPAN::Suppress_readline = $CPAN::Suppress_readline; # silence +$CPAN::META = $CPAN::META; # silence +$CPAN::term = $CPAN::term; # silence +undef $CPAN::term; + +# this kicks off all the magic +use_ok( 'CPAN::Nox' ); + +# this will be set if $CPAN::term is undefined +is( $CPAN::Suppress_readline, 1, 'should set suppress readline flag' ); + +# all of these modules have XS components, should be marked unavailable +my $mod; +for $mod (qw( Digest::MD5 LWP Compress::Zlib )) { + is( $CPAN::META->has_inst($mod), 0, "$mod should be marked unavailable" ); +} + +# and these will be set to those in CPAN +is( scalar @CPAN::Nox::EXPORT, scalar @CPAN::EXPORT, 'should export just what CPAN does' ); +is( \&CPAN::Nox::AUTOLOAD, \&CPAN::AUTOLOAD, 'AUTOLOAD should be aliased' ); + +# Local Variables: +# mode: cperl +# cperl-indent-level: 2 +# End: diff --git a/cpan/CPAN/t/03pkgs.t b/cpan/CPAN/t/03pkgs.t new file mode 100644 index 0000000000..1d877fc4a1 --- /dev/null +++ b/cpan/CPAN/t/03pkgs.t @@ -0,0 +1,36 @@ +# test if our own version numbers meet expectations + +use strict; +eval 'use warnings'; +use lib "lib"; + +my @m; +if ($ENV{PERL_CORE}){ + @m = ("CPAN", map { "CPAN::$_" } qw(Debug + DeferredCode + Distroprefs + FirstTime + Kwalify + Nox + Queue + Tarzip + Version + )); +} else { + opendir DH, "lib/CPAN" or die; + @m = ("CPAN", map { "CPAN::$_" } grep { s/\.pm$// } readdir DH); +} + +use Test::More; +plan(tests => scalar @m); + +for my $m (@m) { + local $^W = 0; + eval "require $m"; + ok($m->VERSION >= 1.76, sprintf "Found version > 1.76 for %20s: %s", $m, $m->VERSION); +} + +# Local Variables: +# mode: cperl +# cperl-indent-level: 2 +# End: diff --git a/cpan/CPAN/t/10version.t b/cpan/CPAN/t/10version.t new file mode 100644 index 0000000000..c1199e99a7 --- /dev/null +++ b/cpan/CPAN/t/10version.t @@ -0,0 +1,129 @@ +# -*- Mode: cperl; coding: utf-8; -*- + +use strict; +use CPAN::Version; +use vars qw($D $N); + +# for debugging uncomment the next two lines +# use CPAN; +# $CPAN::DEBUG = 16384; + +while (<DATA>) { + next if tr/.// > 1 && $]<5.006; # multidot tests are not for pre-5.6.0 + last if /^__END__$/; + chomp; + s/\s*#.*//; + push @$D, [ split ]; +} + +$N = scalar @$D; +print "1..$N\n"; + +my $has_sort_versions = eval { require Sort::Versions; 1 }; +my $has_versionpm = eval q{ use version 0.7203; 1 }; +my $has_perl_versionpm = eval { require Perl::Version; 1 }; +while (@$D) { + my($l,$r,$exp) = @{shift @$D}; + my $res = CPAN::Version->vcmp($l,$r); + if ($res != $exp){ + print "# l[$l]r[$r]exp[$exp]res[$res]\n"; + print "not "; + } + my @other = (); + if ($has_sort_versions) { + if (Sort::Versions::versioncmp($l,$r) != $res) { + push @other, sprintf "SV: %d", Sort::Versions::versioncmp($l,$r); + } + } + if ($has_versionpm) { + local $^W; + my $vpack = "version"; # hide the name from 5.004 + my $vres = eval { $vpack->new($l) cmp $vpack->new($r); }; + if ($@) { + push @other, "v.pm: $@"; + } elsif ($vres != $res) { + push @other, sprintf "v.pm: %d", $vres; + } + } + if ($has_perl_versionpm) { + local $^W; + my $vpack = "Perl::Version"; # hide the name from 5.004 + my $vres = eval { $vpack->new($l) cmp $vpack->new($r); }; + if ($@) { + push @other, "PV: $@"; + } elsif ($vres != $res) { + push @other, sprintf "PV: %d", $vres; + } + } + my $other = @other ? " (".join("; ", @other).")" : ""; + printf "ok %2d # %12s %12s %3d%s\n", $N-@$D, $l, $r, $res, $other; + die "Panic" if CPAN::Version->vgt($l,$r) && CPAN::Version->vlt($l,$r); +} + +__END__ +0 0 0 +1 0 1 +0 1 -1 +1 1 0 +1.1 0.0a 1 +1.1a 0.0 1 +1.2.3 1.1.1 1 +v1.2.3 v1.1.1 1 +v1.2.3 v1.2.1 1 +v1.2.3 v1.2.11 -1 +v2.4 2.004000 -1 +v2.4 2.004 0 +1.2.3 1.2.11 -1 +1.9 1.10 1 +VERSION VERSION 0 +0.02 undef 1 +1.57_00 1.57 1 +1.5700 1.57 1 +1.57_01 1.57 1 +1.88_51 1.8801 1 +1.8_8_5_1 1.8801 1 +0.2.10 0.2 -1 +20000000.00 19990108 1 +1.00 0.96 1 +0.7.2 0.7 -1 +0.7.02 0.7 -1 +0.07.02 0.7 -1 +1.3a5 1.3 1 +undef 1.00 -1 +v1.0 undef 1 +v0.2.4 0.24 -1 +v1.0.22 122 -1 +1.0.22 122 -1 +5.00556 v5.5.560 0 +5.005056 v5.5.56 0 +5.00557 v5.5.560 1 +5.00056 v5.0.561 -1 +0.0.2 0.000002 0 +1.0.3 1.000003 0 +1.0.1 1.000001 0 +0.0.1 0.000001 0 +0.01.04 0.001004 0 +0.05.18 0.005018 0 +4.08.00 4.008000 0 +0.001.004 0.001004 0 +0.005.018 0.005018 0 +4.008.000 4.008000 0 +4.008.000 4.008 1 +v4.8 4.008 0 +v4.8.0 4.008000 0 +v1.99.1_1 1.98 -1 +v2.3999 v2.4000 -1 +v2.3999 2.004000 1 +v2.3999 2.999999 1 +v2.1000 2.999999 1 +0123 123 -1 +v2.005 2.005 0 +v1.0 1.0 0 +v1.0 1.000 0 +v1.0 1.000000 0 +__END__ + +# Local Variables: +# mode: cperl +# cperl-indent-level: 2 +# End: diff --git a/cpan/CPAN/t/11mirroredby.t b/cpan/CPAN/t/11mirroredby.t new file mode 100644 index 0000000000..840dfa3a51 --- /dev/null +++ b/cpan/CPAN/t/11mirroredby.t @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + } +} + +use strict; +use lib "BUNDLE"; +use Test::More tests => 6; + +use_ok( 'CPAN::FirstTime' ); +can_ok( 'CPAN::Mirrored::By', 'new', 'continent', 'country', 'url' ); +my $cmb = CPAN::Mirrored::By->new(); +isa_ok( $cmb, 'CPAN::Mirrored::By' ); + +@$cmb = qw( continent country url ); +is( $cmb->continent(), 'continent', + 'continent() should return continent entry' ); +is( $cmb->country(), 'country', 'country() should return country entry' ); +is( $cmb->url(), 'url', 'url() should return url entry' ); + +__END__ +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# End: -- cgit v1.2.1