lib/CPAN/CacheMgr.pm helper package for CPAN.pm
lib/CPAN/Complete.pm helper package for CPAN.pm
lib/CPAN/Debug.pm helper package for CPAN.pm
-lib/CPAN/DeferedCode.pm helper package for CPAN.pm
lib/CPAN/DeferredCode.pm helper package for CPAN.pm
lib/CPAN/Distribution.pm helper package for CPAN.pm
lib/CPAN/Distroprefs.pm helper package for CPAN.pm
lib/CPAN/Distrostatus.pm helper package for CPAN.pm
+lib/CPAN/Exception/blocked_urllist.pm helper package for CPAN.pm
lib/CPAN/Exception/RecursiveDependency.pm helper package for CPAN.pm
lib/CPAN/Exception/yaml_not_installed.pm helper package for CPAN.pm
lib/CPAN/FirstTime.pm Utility for creating CPAN config files
# vim: ts=4 sts=4 sw=4:
use strict;
package CPAN;
-$CPAN::VERSION = '1.93_51';
+$CPAN::VERSION = '1.93_52';
$CPAN::VERSION =~ s/_//;
# we need to run chdir all over and we would get at wrong libraries
use CPAN::Distribution;
use CPAN::Distrostatus;
use CPAN::FTP;
-use CPAN::Index;
+use CPAN::Index 1.93; # https://rt.cpan.org/Ticket/Display.html?id=43349
use CPAN::InfoObj;
use CPAN::Module;
use CPAN::Prompt;
sub _uniq {
my(@list) = @_;
my %seen;
- return map { !$seen{$_} } @list;
+ return grep { !$seen{$_}++ } @list;
}
#-> sub CPAN::shell ;
} elsif (/^\!/) {
s/^\!//;
my($eval) = $_;
- package CPAN::Eval;
+ package
+ CPAN::Eval; # hide from the indexer
use strict;
use vars qw($import_done);
CPAN->import(':DEFAULT') unless $import_done++;
CPAN::Shell->$command(@line)
};
_unredirect;
+ my $reported_error;
if ($@) {
- my $err = "$@";
- if ($err =~ /\S/) {
- require Carp;
- require Dumpvalue;
- my $dv = Dumpvalue->new(tick => '"');
- Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
+ my $err = $@;
+ 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 =~ /^(
|upgrade
)$/x) {
# only commands that tell us something about failed distros
- CPAN::Shell->failed($CPAN::CurrentCommandId,1);
+ # 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");
@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);
- @dl = grep { $_->[2] =~ /$rglob/ } @dl;
+ 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\n", $_->[0], $_->[1], $id, $_->[2])
- } sort { $a->[2] cmp $b->[2] } @dl);
+ $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;
}
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.)
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);
@return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
} elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
@return = ();
- } elsif ($line =~ /^(a|ls)\s/) {
+ } 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);
if (CPAN::_sqlite_running()) {
$CPAN::SQLite->search($class, "^\Q$word\E");
}
- sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
+ 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 ;
+++ /dev/null
-package CPAN::DeferedCode;
-
-use strict;
-use vars qw/$VERSION/;
-
-use overload fallback => 1, map { ($_ => 'run') } qw/
- bool "" 0+
-/;
-
-$VERSION = "5.50";
-
-sub run {
- $_[0]->();
-}
-
-1;
delete $self->{build_dir};
return;
}
+ binmode($writefh);
while (my $x = $readfh->READLINE) {
print $writefh $x;
}
$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;
$CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
return;
}
- my $yaml = File::Spec->catfile($build_dir,"META.yml");
+ # 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]; };
$self->{yaml_content} = +{};
}
}
- if (not exists $self->{yaml_content}{dynamic_config}
- or $self->{yaml_content}{dynamic_config}
+ # 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;
}
$want_install =
CPAN::Shell::colorable_makemaker_prompt
("$id is just needed temporarily during building or testing. ".
- "Do you want to install it permanently? (Y/n)",
+ "Do you want to install it permanently?",
$default);
}
}
sub _pattern {
my $re = shift;
- return eval sprintf 'qr{%s}', $re;
+ my $p = eval sprintf 'qr{%s}', $re;
+ if ($@) {
+ $@ =~ s/\n$//;
+ die "Error in Distroprefs pattern qr{$re}\n$@";
+ }
+ return $p;
}
sub _match_scalar {
sub new {
my($class) = shift;
- my($deps) = shift;
+ my($deps_arg) = shift;
my (@deps,%seen,$loop_starts_with);
- DCHAIN: for my $dep (@$deps) {
+ DCHAIN: for my $dep (@$deps_arg) {
push @deps, {name => $dep, display_as => $dep};
if ($seen{$dep}++) {
$loop_starts_with = $dep;
my $in_loop = 0;
for my $i (0..$#deps) {
my $x = $deps[$i]{name};
- $in_loop ||= $x eq $loop_starts_with;
+ $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";
# the next session
}
}
- bless { deps => \@deps }, $class;
+ 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}} @{$self->{deps}});
+ $ret .= join("\n => ", map {$_->{display_as}} @$deps);
$ret .= ".\nCannot resolve.\n";
$ret;
}
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);
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 (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 File::Basename::dirname($last->{file});
+ next unless $file eq dirname($last->{file});
return $last->{thesiteurl};
}
}
$force ||= 0;
Carp::croak( "Usage: ->localize(cpan_file,as_local_file[,$force])" )
unless defined $aslocal;
- $self->debug("file[$file] aslocal[$aslocal] force[$force]")
- if $CPAN::DEBUG;
-
+ 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
$maybe_restore++;
}
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- $self->mymkpath($aslocal_dir); # too early for file URLs / RT #28438
+ 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) {
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) {
if ($connect_to_internet_ok) {
@urllist = @CPAN::Defaultsites;
} else {
- my $sleep = 5;
- $CPAN::Frontend->mywarn(sprintf qq{
-
-You have not configured a urllist and did not allow to connect to the
-internet. I will continue but it is very likely that we will face
-problems. If this happens, please consider to call either
-
- o conf init connect_to_internet_ok
-or
- o conf init urllist
-
-Sleeping $sleep seconds now.
-});
- $CPAN::Frontend->mysleep($sleep);
- @urllist = ();
+ 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/ ?
sub mymkpath {
my($self, $aslocal_dir) = @_;
- File::Path::mkpath($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
my($ro_url);
my($devnull) = $CPAN::Config->{devnull} || "";
# < /dev/null ";
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- File::Path::mkpath($aslocal_dir);
+ my($aslocal_dir) = dirname($aslocal);
+ mkpath($aslocal_dir);
HOSTHARD: for $ro_url (@$host_seq) {
$self->_set_attempt($stats,"dlhard",$ro_url);
my $url = "$ro_url$file";
return unless @$host_seq;
my($ro_url);
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- File::Path::mkpath($aslocal_dir);
+ 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");
package CPAN::FTP::netrc;
use strict;
+$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00";
+
# package CPAN::FTP::netrc;
sub new {
my($class) = @_;
=item yaml_module
-At the time of this writing there are two competing YAML modules,
-YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
-installed on your system. There may be more alternative YAML
-conforming modules but at the time of writing a potential third
-player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
+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?
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: $!";
}
- my $loopcount = 0;
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 now,
-please answer 'n' to the following question.
+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");
- $overwrite_local = 1 unless $ans =~ /^y/i;
+ if ($ans =~ /^y/i) {
+ $CPAN::Config->{connect_to_internet_ok} = 1;
+ } else {
+ $overwrite_local = 1;
+ }
}
- while ($mby) {
- if ($overwrite_local) {
- $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $overwrite_local = 0;
- } elsif ( ! -f $mby ) {
- $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } elsif (-M $mby > 60 && $loopcount == 0) {
- $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }.
- qq{to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $loopcount++;
- } elsif (-s $mby == 0) {
- $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
+ local $urllist = $CPAN::Config->{urllist};
+ my $better_mby;
+ 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;
+ }
+ 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;
+ }
} else {
last;
}
}
- local $urllist = [];
- read_mirrored_by($mby);
+ 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;
}
}
} while $ans || !%seen;
- push @$urllist, @urls;
+ @$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 set of picks:\n");
- map { $CPAN::Frontend->myprint(" $_\n") } @$urllist;
+ for ( @$urllist ) { $CPAN::Frontend->myprint(" $_\n") };
}
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++;
$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 $needshort = $^O eq "dos";
- $self->rd_authindex($self
- ->reload_x(
- "authors/01mailrc.txt.gz",
- $needshort ?
- File::Spec->catfile('authors', '01mailrc.gz') :
- File::Spec->catfile('authors', '01mailrc.txt.gz'),
- $force));
- $t2 = time;
- $debug = "timing reading 01[".($t2 - $time)."]";
- $time = $t2;
- return if $CPAN::Signal; # this is sometimes lengthy
- $self->rd_modpacks($self
- ->reload_x(
- "modules/02packages.details.txt.gz",
- $needshort ?
- File::Spec->catfile('modules', '02packag.gz') :
- File::Spec->catfile('modules', '02packages.details.txt.gz'),
- $force));
- $t2 = time;
- $debug .= "02[".($t2 - $time)."]";
- $time = $t2;
- return if $CPAN::Signal; # this is sometimes lengthy
- $self->rd_modlist($self
- ->reload_x(
- "modules/03modlist.data.gz",
- $needshort ?
- File::Spec->catfile('modules', '03mlist.gz') :
- File::Spec->catfile('modules', '03modlist.data.gz'),
- $force));
+ 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;
- $t2 = time;
- $debug .= "03[".($t2 - $time)."]";
- $time = $t2;
+ if ($CPAN::DEBUG){
+ $t2 = time;
+ $debug .= "03[".($t2 - $time)."]";
+ $time = $t2;
+ }
CPAN->debug($debug) if $CPAN::DEBUG;
}
if ($CPAN::Config->{build_dir_reuse}) {
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')) {
my $cpan = $self->cpan_version;
local ($^W) = 0;
CPAN::Version->vgt($cpan,$inst) and return 0;
- CPAN->debug(join("",
- "returning uptodate. inst_file[",
- $self->inst_file,
- "cpan[$cpan] inst[$inst]")) if $CPAN::DEBUG;
+ 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) = @_;
);
@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",
$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
projects / p5sagit/p5-mst-13.2.git / commitdiff