# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.76_60';
+$VERSION = '1.80';
$VERSION = eval $VERSION;
use CPAN::Version;
use File::Copy ();
use File::Find;
use File::Path ();
+use File::Spec;
+use File::Temp ();
use FileHandle ();
use Safe ();
+use Sys::Hostname;
use Text::ParseWords ();
use Text::Wrap;
-use File::Spec;
-use File::Temp ();
-use Sys::Hostname;
no lib "."; # we need to run chdir all over and we would get at wrong
# libraries there
package CPAN;
-use strict qw(vars);
+use strict;
use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
$Signal $End $Suppress_readline $Frontend
@CPAN::ISA = qw(CPAN::Debug Exporter);
@EXPORT = qw(
- autobundle bundle expand force notest get cvs_import
+ autobundle bundle expand force notest get cvs_import
install make readme recompile shell test clean
- perldoc recent
+ perldoc recent
);
#-> sub CPAN::AUTOLOAD ;
sub {require HTTP::Request},
sub {require URI::URL},
],
- Net::FTP => [
+ 'Net::FTP' => [
sub {require Net::FTP},
sub {require Net::Config},
]
$CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
if ($mod eq "CPAN::WAIT") {
- push @CPAN::Shell::ISA, CPAN::WAIT;
+ push @CPAN::Shell::ISA, 'CPAN::WAIT';
}
return 1;
} elsif ($mod eq "Net::FTP") {
#-> sub CPAN::Config::load ;
sub load {
- my($self, %args) = [at]_;
+ my($self, %args) = @_;
$CPAN::Be_Silent++ if $args{be_silent};
my(@miss);
i WORD or /REGEXP/ about any of the above
r NONE report updatable modules
ls AUTHOR about files in the author's directory
- recent NONE latest CPAN uploads
+ (with WORD being a module, bundle or author name or a distribution
+ name of the form AUTHOR/DISTRIBUTION)
Download, Test, Make, Install...
- get download
- make make (implies get)
- test MODULES, make test (implies make)
- install DISTS, BUNDLES make install (implies test)
- clean make clean
- look open subshell in these dists' directories
- readme display these dists' README files
- perldoc display module's POD documentation
+ 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
+
+Pragmas
+ force COMMAND unconditionally do command
+ notest COMMAND 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 force cmd unconditionally do cmd});
+ autobundle Snapshot recent latest CPAN uploads});
}
}
if ($command =~ /cpan/i) {
for my $f (qw(CPAN.pm CPAN/FirstTime.pm)) {
next unless $INC{$f};
- CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$p
-wd'")
+ my $pwd = CPAN::anycwd();
+ CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
if $CPAN::DEBUG;
my $fh = FileHandle->new($INC{$f});
local($/);
push @result, sprintf "%s %s\n", $module->id, $have;
} elsif ($what eq "r") {
push @result, $module->id;
- next MODULE if $seen{$file}++;
+ next MODULE if $seen{$file}++;
} elsif ($what eq "u") {
push @result, $module->id;
- next MODULE if $seen{$file}++;
- next MODULE if $file =~ /^Contact/;
+ next MODULE if $seen{$file}++;
+ next MODULE if $file =~ /^Contact/;
}
unless ($headerdone++){
$CPAN::Frontend->myprint("\n");
shift;
my($meth,@some) = @_;
my @pragma;
- if ($meth =~ /^(force|notest)$/) {
+ while($meth =~ /^(force|notest)$/) {
push @pragma, $meth;
$meth = shift @some;
}
#-> sub CPAN::Shell::recent ;
sub recent {
- my($self) = [at]_;
+ my($self) = @_;
CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
return;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
local(*FH);
- tie *FH, CPAN::Tarzip, $index_target;
+ tie *FH, 'CPAN::Tarzip', $index_target;
local($/) = "\n";
push @lines, split /\012/ while <FH>;
foreach (@lines) {
$last_updated);
$DATE_OF_02 = $last_updated;
- if ($CPAN::META->has_inst(HTTP::Date)) {
+ if ($CPAN::META->has_inst('HTTP::Date')) {
require HTTP::Date;
my($age) = (time - HTTP::Date::str2time($last_updated))/3600/24;
if ($age > 30) {
}
- if ($id->cpan_file ne $dist){ # update only if file is
- # different. CPAN prohibits same
- # name with different version
+ # 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,
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 ;
+ $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 $sil
-ent;
+ $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
return;
}
@dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
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
my $line = <$fh>; close $fh;
unlink($lc_want) unless $line =~ /PGP/;
}
+
local($") = "/";
# connect "force" argument with "index_expire".
my $force = 0;
my $self = shift;
return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
my(@local_wanted) = split(/\//,$self->id);
- my $filename = pop [at]local_wanted;
- push [at]local_wanted, "CHECKSUMS";
+ my $filename = pop @local_wanted;
+ push @local_wanted, "CHECKSUMS";
my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
return unless $author;
- my [at]dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
- return unless [at]dl;
- my($dirent) = grep { $_->[2] eq $filename } [at]dl;
+ 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 notest {
- my($self, $method) = [at]_;
+ my($self, $method) = @_;
# warn "XDEBUG: set notest for $self $method";
$self->{"notest"}++; # name should probably have been force_install
}
sub unnotest {
- my($self) = [at]_;
+ my($self) = @_;
# warn "XDEBUG: deleting notest";
delete $self->{'notest'};
}
#-> sub CPAN::Distribution::perldoc ;
sub perldoc {
- my($self) = [at]_;
+ my($self) = @_;
my($dist) = $self->id;
my $package = $self->called_for;
#-> sub CPAN::Distribution::_check_binary ;
sub _check_binary {
- my ($dist,$shell,$binary) = [at]_;
+ my ($dist,$shell,$binary) = @_;
my ($pid,$readme,$out);
$CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
if $CPAN::DEBUG;
- $pid = open $readme, "-|", "which", $binary
- or $CPAN::Frontend->mydie(qq{Could not fork $binary: $!});
+ $pid = open $readme, "which $binary|"
+ or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
while (<$readme>) {
$out .= $_;
}
- close $readme;
+ close $readme or die "Could not run 'which $binary': $!";
$CPAN::Frontend->myprint(qq{ + $out \n})
if $CPAN::DEBUG && $out;
#-> sub CPAN::Distribution::_display_url ;
sub _display_url {
- my($self,$url) = [at]_;
+ my($self,$url) = @_;
my($res,$saved_file,$pid,$readme,$out);
$CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
$CPAN::Frontend->myprint(qq{ERROR: problems while getting $url, $!\n})
unless defined($saved_file);
- $pid = open $readme, "-|", $html_converter, $saved_file
+ $pid = open $readme, "$html_converter $saved_file |"
or $CPAN::Frontend->mydie(qq{
-Could not fork $html_converter $saved_file: $!});
+Could not fork '$html_converter $saved_file': $!});
my $fh = File::Temp->new(
template => 'cpan_htmlconvert_XXXX',
suffix => '.txt',
$fh->print($_);
}
close $readme
- or $CPAN::Frontend->mydie(qq{Could not close file handle: $!});
+ 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
#-> sub CPAN::Distribution::_getsave_url ;
sub _getsave_url {
- my($dist, $shell, $url) = [at]_;
+ my($dist, $shell, $url) = @_;
$CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
if $CPAN::DEBUG;
$self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
my $obj = $CPAN::META->instance($type,$s);
$obj->$meth();
- if ($obj->isa(CPAN::Bundle)
+ if ($obj->isa('CPAN::Bundle')
&&
exists $obj->{install_failed}
&&
}
sub notest {
- my($self) = [at]_;
+ my($self) = @_;
# warn "XDEBUG: set notest for Module";
$self->{'notest'}++;
}
Or you leave the CPAN shell and start it again.
+Or, if you're not really sure and just want to run some make, test or
+install command without this pesky error message, say C<force get
+Foo::Bar> first and then continue as always. C<Force get> I<forgets>
+previous error conditions.
+
For the really curious, by accessing internals directly, you I<could>
! delete CPAN::Shell->expand("Distribution", \
projects / p5sagit/p5-mst-13.2.git / blobdiff