package CPAN;
-$VERSION = '1.83_58';
+$VERSION = '1.83_59';
$VERSION = eval $VERSION;
use strict;
$CPAN::Signal ||= 0;
$CPAN::Frontend ||= "CPAN::Shell";
-$CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
+@CPAN::Defaultsites = ("http://www.perl.org/CPAN/","ftp://ftp.perl.org/pub/CPAN/")
+ unless @CPAN::Defaultsites;
# $CPAN::iCwd (i for initial) is going to be initialized during find_perl
$CPAN::Perl ||= CPAN::find_perl();
$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
$Signal $Suppress_readline $Frontend
- $Defaultsite $Have_warned $Defaultdocs $Defaultrecent
+ @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
$Be_Silent );
@CPAN::ISA = qw(CPAN::Debug Exporter);
#-> 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 : "";
$CPAN::Frontend->myprint($self->format_result('Author',@arg));
}
-sub handle_ls {
- my($self,$pragmas,$s) = @_;
+#-> 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 $silent = @accept>1;
my $last_alpha = "";
+ my @results;
for my $a (@accept){
my($author,$pathglob);
if ($a =~ m|(.*?)/(.*)|) {
$author->$pragma();
}
}
- $author->ls($pathglob,$silent); # silent if more than one author
+ push @results, $author->ls($pathglob,$silent); # silent if
+ # more than one
+ # author
for my $pragma (@$pragmas) {
my $meth = "un$pragma";
if ($author->can($meth)) {
}
}
}
+ @results;
}
#-> sub CPAN::Shell::local_bundles ;
sleep 2;
next;
} elsif ($meth eq "ls") {
- $self->handle_ls(\@pragma,$s);
+ $self->globls($s,\@pragma);
next STHING;
} else {
CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
my(@reordered,$last);
$CPAN::Config->{urllist} ||= [];
unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
- warn "Malformed urllist; ignoring. Configuration file corrupt?\n";
+ $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
+ $CPAN::Config->{urllist} = [];
}
$last = $#{$CPAN::Config->{urllist}};
if ($force & 2) { # local cpans probably out of date, don't reorder
or
defined($Thesite)
and
- ($b == $Thesite)
+ ($CPAN::Config->{urllist}[$b] eq $Thesite)
<=>
- ($a == $Thesite)
+ ($CPAN::Config->{urllist}[$a] eq $Thesite)
} 0..$last;
}
my(@levels);
}
@levels = qw/easy/ if $^O eq 'MacOS';
my($levelno);
+ local $ENV{FTP_PASSIVE} = $CPAN::Config->{ftp_passive} if exists $CPAN::Config->{ftp_passive};
for $levelno (0..$#levels) {
my $level = $levels[$levelno];
my $method = "host$level";
my @host_seq = $level eq "easy" ?
@reordered : 0..$last; # reordered has CDROM up front
- @host_seq = (0) unless @host_seq;
- my $ret = $self->$method(\@host_seq,$file,$aslocal);
+ my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
+ for my $u (@urllist) {
+ $u .= "/" unless substr($u,-1) eq "/";
+ }
+ for my $u (@CPAN::Defaultsites) {
+ push @urllist, $u unless grep { $_ eq $u } @urllist;
+ }
+ $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
+ my $ret = $self->$method(\@urllist,$file,$aslocal);
if ($ret) {
$Themethod = $level;
my $now = time;
return;
}
+# package CPAN::FTP;
sub hosteasy {
my($self,$host_seq,$file,$aslocal) = @_;
- my($i);
- HOSTEASY: for $i (@$host_seq) {
- my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
- $url .= "/" unless substr($url,-1) eq "/";
- $url .= $file;
+ my($ro_url);
+ HOSTEASY: for $ro_url (@$host_seq) {
+ my $url .= "$ro_url$file";
$self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
if ($url =~ /^file:/) {
my $l;
$self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG;
}
if ( -f $l && -r _) {
- $Thesite = $i;
+ $Thesite = $ro_url;
return $l;
}
# Maybe mirror has compressed it?
$self->debug("found compressed $l.gz") if $CPAN::DEBUG;
CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
if ( -f $aslocal) {
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
}
}
}
my $res = $Ua->mirror($url, $aslocal);
if ($res->is_success) {
- $Thesite = $i;
+ $Thesite = $ro_url;
my $now = time;
utime $now, $now, $aslocal; # download time is more
# important than upload time
if ($res->is_success &&
CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
) {
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
}
} else {
$self->debug("getfile[$getfile]dir[$dir]host[$host]" .
"aslocal[$aslocal]") if $CPAN::DEBUG;
if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
}
if ($aslocal !~ /\.gz(?!\n)\Z/) {
$gz) &&
CPAN::Tarzip->new($gz)->gunzip($aslocal)
){
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
}
}
}
}
+# package CPAN::FTP;
sub hosthard {
my($self,$host_seq,$file,$aslocal) = @_;
# failed otherwise) Maybe they are behind a firewall, but they
# gave us a socksified (or other) ftp program...
- my($i);
+ my($ro_url);
my($devnull) = $CPAN::Config->{devnull} || "";
# < /dev/null ";
my($aslocal_dir) = File::Basename::dirname($aslocal);
File::Path::mkpath($aslocal_dir);
- HOSTHARD: for $i (@$host_seq) {
- my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
- $url .= "/" unless substr($url,-1) eq "/";
- $url .= $file;
+ HOSTHARD: for $ro_url (@$host_seq) {
+ my $url = "$ro_url$file";
my($proto,$host,$dir,$getfile);
# Courtesy Mark Conty mark_conty@cargill.com change from
CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
}
}
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
} elsif ($url !~ /\.gz(?!\n)\Z/) {
unlink $asl_ungz if
# somebody uncompressed file for us?
rename $asl_ungz, $aslocal;
}
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
} else {
unlink $asl_gz if -f $asl_gz;
} # host
}
+# package CPAN::FTP;
sub hosthardest {
my($self,$host_seq,$file,$aslocal) = @_;
- my($i);
+ my($ro_url);
my($aslocal_dir) = File::Basename::dirname($aslocal);
File::Path::mkpath($aslocal_dir);
my $ftpbin = $CPAN::Config->{ftp};
- HOSTHARDEST: for $i (@$host_seq) {
- unless (length $ftpbin && MM->maybe_command($ftpbin)) {
- $CPAN::Frontend->myprint("No external ftp command available\n\n");
- last HOSTHARDEST;
- }
- my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
- $url .= "/" unless substr($url,-1) eq "/";
- $url .= $file;
+ unless (length $ftpbin && MM->maybe_command($ftpbin)) {
+ $CPAN::Frontend->myprint("No external ftp command available\n\n");
+ return;
+ }
+ $CPAN::Frontend->myprint(qq{
+As a last ressort we now switch to the external ftp command '$ftpbin'
+to get '$aslocal'.
+
+Doing so often leads to problems that are hard to diagnose, even endless
+loops may be encountered.
+
+If you're victim of such problems, please consider unsetting the ftp
+config variable with
+
+ o conf ftp ""
+ o conf commit
+
+});
+ $CPAN::Frontend->mysleep(4);
+ HOSTHARDEST: for $ro_url (@$host_seq) {
+ my $url = "$ro_url$file";
$self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
next;
$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
- As this requires some features that are not thoroughly tested, we\'re
- not sure, that we get it right....
-
+ $netrc_explain
+ Going to send the dialog
+$dialog
}
);
$self->talk_ftp("$ftpbin$verbose $host",
$mtime ||= 0;
if ($mtime > $timestamp) {
$CPAN::Frontend->myprint("GOT $aslocal\n");
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
} else {
$CPAN::Frontend->myprint("Hmm... Still failed!\n");
"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");
- $Thesite = $i;
+ $Thesite = $ro_url;
return $aslocal;
} else {
$CPAN::Frontend->myprint("Bad luck... Still failed!\n");
} # host
}
+# package CPAN::FTP;
sub talk_ftp {
my($self,$command,@dialog) = @_;
my $fh = FileHandle->new;
package CPAN::FTP::netrc;
use strict;
+# package CPAN::FTP::netrc;
sub new {
my($class) = @_;
my $file = File::Spec->catfile($ENV{HOME},".netrc");
}, $class;
}
-# CPAN::FTP::hasdefault;
+# CPAN::FTP::netrc::hasdefault;
sub hasdefault { shift->{'hasdefault'} }
sub netrc { shift->{'netrc'} }
sub protected { shift->{'protected'} }
$CPAN::Frontend->myprint(join "", map {
sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
} sort { $a->[2] cmp $b->[2] } @dl);
+ @dl;
}
# returns an array of arrays, the latter contain (size,mtime,filename)
}
$req = $areq if $do_replace;
}
+ if ($yaml->{build_requires}
+ && ref $yaml->{build_requires}
+ && ref $yaml->{build_requires} eq "HASH") {
+ while (my($k,$v) = each %{$yaml->{build_requires}}) {
+ if ($req->{$k}) {
+ # merging of two "requires"-type values--what should we do?
+ } else {
+ $req->{$k} = $v;
+ }
+ }
+ }
if ($req) {
delete $req->{perl};
}
$color_on,
$self->id,
$color_off,
- $self->distribution->pretty_id,
+ $self->distribution ? $self->distribution->pretty_id : $self->id,
);
join "", @m;
}
=item ls author
-=item ls globbing_expresion
+=item ls globbing_expression
The first form lists all distribution files in and below an author's
-CPAN directory as they are stored in the CHECKUMS files distrbute on
-CPAN.
+CPAN directory as they are stored in the CHECKUMS files distributed on
+CPAN. The listing goes recursive into all subdirectories.
The second form allows to limit or expand the output with shell
globbing as in the following examples:
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 and may be changed in future versions.
+
=item failed
The C<failed> command reports all distributions that failed on one of
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 fro distributions.
+CPAN::Distribution objects for distributions. Note: it does not expand
+to CPAN::Author objects.
=item Programming Examples
build_cache size of cache for directories to build modules
build_dir locally accessible directory to build modules
- index_expire after this many days refetch index files
cache_metadata use serializer to cache metadata
cpan_home local directory reserved for this package
dontload_hash anonymous hash: modules in the keys will not be
loaded by the CPAN::has_inst() routine
+ getcwd see below
gzip location of external program gzip
histfile file to maintain history between sessions
histsize maximum number of lines to keep in histfile
inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
after this many seconds inactivity. Set to 0 to
never break.
+ index_expire after this many days refetch index files
inhibit_startup_message
if true, does not print the startup message
keep_source_where directory in which to keep the source (if we do)
=back
+=head2 Not on config variable 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
+
=head2 Note on urllist parameter's format
urllist parameters are URLs according to RFC 1738. We do a little
possible approach:
% mkdir -p $HOME/.cpan/CPAN
- % echo '$CPAN::Config={ };' > $HOME/.cpan/CPAN/MyConfig.pm
+ % echo '1;' > $HOME/.cpan/CPAN/MyConfig.pm
% cpan
[...answer all questions...]
projects / p5sagit/p5-mst-13.2.git / commitdiff