# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.74_01';
-# $Id: CPAN.pm,v 1.409 2003/07/28 22:07:23 k Exp $
+$VERSION = '1.76_02';
+$VERSION = eval $VERSION;
+# $Id: CPAN.pm,v 1.412 2003/07/31 14:53:04 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.409 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.412 $, 10)."]";
use Carp ();
use Config ();
$CPAN::Signal ||= 0;
$CPAN::Frontend ||= "CPAN::Shell";
$CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
+$CPAN::Perl ||= CPAN::find_perl();
+
package CPAN;
use strict qw(vars);
}
}
+
#-> sub CPAN::shell ;
sub shell {
my($self) = @_;
package CPAN::LWP::UserAgent;
use vars qw(@ISA $USER $PASSWD $SETUPDONE);
-# we delay requiring LWP::UserAgent and setting up inheritence until we need it
+# we delay requiring LWP::UserAgent and setting up inheritance until we need it
package CPAN::Complete;
@CPAN::Complete::ISA = qw(CPAN::Debug);
#-> sub CPAN::getcwd ;
sub getcwd {Cwd::getcwd();}
+#-> sub CPAN::find_perl ;
+sub find_perl {
+ my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
+ my $pwd = CPAN::anycwd();
+ my $candidate = File::Spec->catfile($pwd,$^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)) {
+ $perl = $abs;
+ last DIST_PERLNAME;
+ }
+ }
+ }
+ }
+
+ return $perl;
+}
+
+
#-> sub CPAN::exists ;
sub exists {
my($mgr,$class,$id) = @_;
});
sleep 2;
- } elsif ($mod eq "Module::Signature"){
- # No point in complaining unless the user can reasonably install it.
- if (eval { require Crypt::OpenPGP; 1 } or
- defined $CPAN::Config->{'gpg'}) {
- $CPAN::Frontend->myprint(qq{
- CPAN: Module::Signature security checks disabled because Module::Signature
- not installed. Please consider installing the Module::Signature module.
-});
- sleep 2;
- }
} else {
delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
}
Display Information
command argument description
a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
- i WORD or /REGEXP/ about anything of above
- r NONE reinstall recommendations
+ i WORD or /REGEXP/ about any of the above
+ r NONE report updatable modules
ls AUTHOR about files in the author's directory
Download, Test, Make, Install...
sub i {
my($self) = shift;
my(@args) = @_;
- my(@type,$type,@m);
- @type = qw/Author Bundle Distribution Module/;
@args = '/./' unless @args;
my(@result);
- for $type (@type) {
+ 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 ?
return unless $proxy;
if ($USER && $PASSWD) {
} elsif (defined $CPAN::Config->{proxy_user} &&
- defined $CPAN::Config->{proxy_pass}) {
+ defined $CPAN::Config->{proxy_pass}) {
$USER = $CPAN::Config->{proxy_user};
$PASSWD = $CPAN::Config->{proxy_pass};
} else {
return($USER,$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);
# success above. Likely a bogus URL
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
- my($f,$funkyftp);
- for $f ('lynx','ncftpget','ncftp','wget') {
- next unless exists $CPAN::Config->{$f};
- $funkyftp = $CPAN::Config->{$f};
- next unless defined $funkyftp;
+
+ # Try the most capable first and leave ncftp* for last as it only
+ # does FTP.
+ for my $f (qw(curl wget lynx ncftpget ncftp)) {
+ my $funkyftp = $CPAN::Config->{$f};
+ next unless defined $funkyftp;
next if $funkyftp =~ /^\s*$/;
+
my($asl_ungz, $asl_gz);
($asl_ungz = $aslocal) =~ s/\.gz//;
$asl_gz = "$asl_ungz.gz";
+
my($src_switch) = "";
if ($f eq "lynx"){
$src_switch = " -source";
} elsif ($f eq "ncftp"){
$src_switch = " -c";
- } elsif ($f eq "wget"){
- $src_switch = " -O -";
+ } elsif ($f eq "wget"){
+ $src_switch = " -O -";
+ } elsif ($f eq 'curl'){
+ $src_switch = ' -L';
}
+
my($chdir) = "";
my($stdout_redir) = " > $asl_ungz";
if ($f eq "ncftpget"){
});
}
return if $CPAN::Signal;
- } # lynx,ncftpget,ncftp
+ } # transfer programs
} # host
}
my $lc_want =
File::Spec->catfile($CPAN::Config->{keep_source_where},
"authors", "id", @$chksumfile);
-
- my $fh;
-
- # 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 = 0;
}
# adapted from CPAN::Distribution::MD5_check_file ;
- $fh = FileHandle->new;
+ my $fh = FileHandle->new;
my($cksum);
if (open $fh, $lc_file){
local($/);
-d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
"$packagedir\n");
File::Path::rmtree($packagedir);
- rename($distdir,$packagedir) or
- Carp::confess("Couldn't rename $distdir to $packagedir: $!");
- $self->debug(sprintf("renamed distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
+ File::Copy::move($distdir,$packagedir) or
+ Carp::confess("Couldn't move $distdir to $packagedir: $!");
+ $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
$distdir,
$packagedir,
-e $packagedir,
my($f);
for $f (@readdir) { # is already without "." and ".."
my $to = File::Spec->catdir($packagedir,$f);
- rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+ File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
}
}
if ($CPAN::Signal){
$self->safe_chdir($builddir);
File::Path::rmtree("tmp");
- $self->safe_chdir($packagedir);
- 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->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 $self->{localfile}. 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));
- }
- } else {
- $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
- }
- } else {
- $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
- }
- $self->safe_chdir($builddir);
- return if $CPAN::Signal;
-
-
-
my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
my($mpl_exists) = -f $mpl;
unless ($mpl_exists) {
$self->MD5_check_file($lc_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::MD5_check_file ;
sub MD5_check_file {
my($self,$chk_file) = @_;
my($cksum,$file,$basename);
-
- if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
- $self->debug("Module::Signature is installed, verifying");
- $self->SIG_check_file($chk_file);
- } else {
- $self->debug("Module::Signature is NOT installed");
- }
-
$file = $self->{localfile};
$basename = File::Basename::basename($file);
my $fh = FileHandle->new;
}
}
+
#-> sub CPAN::Distribution::perl ;
sub perl {
- my($self) = @_;
- my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
- my $pwd = CPAN::anycwd();
- my $candidate = File::Spec->catfile($pwd,$^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)) {
- $perl = $abs;
- last DIST_PERLNAME;
- }
- }
- }
- }
- $perl;
+ return $CPAN::Perl;
}
+
#-> sub CPAN::Distribution::make ;
sub make {
my($self) = @_;
}
return "Contact Author $fullname <$email>";
} else {
- return "UserID $userid";
+ return "Contact Author $userid (Email address not available)";
}
} else {
return "N/A";
require() statements.
The configuration dialog can be started any time later again by
-issueing the command C< o conf init > in the CPAN shell.
+issuing the command C< o conf init > in the CPAN shell.
Currently the following keys in the hash reference $CPAN::Config are
defined:
Thanks to Graham Barr for contributing the following paragraphs about
the interaction between perl, and various firewall configurations. For
-further informations on firewalls, it is recommended to consult the
+further information on firewalls, it is recommended to consult the
documentation that comes with the ncftp program. If you are unable to
go through the firewall with a simple Perl setup, it is very likely
that you can configure ncftp so that it works for your firewall.
projects / p5sagit/p5-mst-13.2.git / blobdiff