# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
use strict;
package CPAN;
-$CPAN::VERSION = '1.88_66';
+$CPAN::VERSION = '1.88_69';
$CPAN::VERSION = eval $CPAN::VERSION;
use CPAN::HandleConfig;
cvs_import
expand
force
+ fforce
get
install
install_tested
$CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
my $command = shift @line;
eval { CPAN::Shell->$command(@line) };
- if ($@){
+ if ($@ && "$@" =~ /\S/){
require Carp;
- Carp::cluck($@);
+ Carp::cluck("Catching error: '$@'");
}
if ($command =~ /^(make|test|install|ff?orce|notest|clean|report|upgrade)$/) {
CPAN::Shell->failed($CPAN::CurrentCommandId,1);
}
}
-sub _yaml_module {
+sub _yaml_module () {
my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
if (
$yaml_module ne "YAML"
sub _yaml_loadfile {
my($self,$local_file) = @_;
return +[] unless -s $local_file;
- my $yaml_module = $self->_yaml_module;
+ my $yaml_module = _yaml_module;
if ($CPAN::META->has_inst($yaml_module)) {
my $code = UNIVERSAL::can($yaml_module, "LoadFile");
my @yaml;
eval { @yaml = $code->($local_file); };
if ($@) {
- $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
- " $local_file\n".
- "with $yaml_module the following error was encountered:\n".
- " $@\n"
- );
+ # this shall not be done by the frontend
+ die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
}
return \@yaml;
} else {
- $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
+ # 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,$to_local_file,@what) = @_;
- my $yaml_module = $self->_yaml_module;
+ my($self,$local_file,@what) = @_;
+ my $yaml_module = _yaml_module;
if ($CPAN::META->has_inst($yaml_module)) {
- if (UNIVERSAL::isa($to_local_file, "FileHandle")) {
+ if (UNIVERSAL::isa($local_file, "FileHandle")) {
my $code = UNIVERSAL::can($yaml_module, "Dump");
- eval { print $to_local_file $code->(@what) };
+ eval { print $local_file $code->(@what) };
} else {
my $code = UNIVERSAL::can($yaml_module, "DumpFile");
- eval { $code->($to_local_file,@what); };
+ eval { $code->($local_file,@what); };
}
if ($@) {
- $CPAN::Frontend->mydie("Alert: While trying to dump YAML file\n".
- " $to_local_file\n".
- "with $yaml_module the following error was encountered:\n".
- " $@\n"
- );
+ die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
}
} else {
- if (UNIVERSAL::isa($to_local_file, "FileHandle")) {
+ if (UNIVERSAL::isa($local_file, "FileHandle")) {
# I think this case does not justify a warning at all
} else {
- $CPAN::Frontend->myprint("Note (usually harmless): '$yaml_module' ".
- "not installed, not dumping to '$to_local_file'\n");
+ 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, cannot work with it\n})
+ $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
unless $Have_warned->{"CPAN::SQLite"}++;
return;
}
cvs_import
dump
force
+ fforce
hosts
install
install_tested
".\nCannot continue.\n";
}
+package CPAN::Exception::yaml_not_installed;
+use strict;
+use overload '""' => "as_string";
+
+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";
+
+sub new {
+ my($class,$module,$file,$during,$error) = shift;
+ bless { module => $module,
+ file => $file,
+ during => $during,
+ error => $error }, $class;
+}
+
+sub as_string {
+ my($self) = shift;
+ "Alert: While trying to $self->{during} YAML file\n".
+ " $self->{file}\n".
+ "with '$self->{module}' the following error was encountered:\n".
+ " $self->{error}\n";
+}
+
package CPAN::Prompt; use overload '""' => "as_string";
use vars qw($prompt);
$prompt = "cpan> ";
$_->{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!
}
} else {
$CPAN::Frontend->mydie("
return unless defined $META->{LOCK};
return unless -f $META->{LOCK};
$META->savehist;
+ close $META->{LOCKFH};
unlink $META->{LOCK};
# require Carp;
# Carp::cluck("DEBUGGING");
#-> sub CPAN::is_tested
sub is_tested {
- my($self,$what) = @_;
- $self->{is_tested}{$what} = 1;
+ my($self,$what,$when) = @_;
+ unless ($what) {
+ Carp::cluck("DEBUG: empty what");
+ return;
+ }
+ $self->{is_tested}{$what} = $when;
}
#-> sub CPAN::is_installed
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
sub set_perl5lib {
my($self,$for) = @_;
push @env, $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")} sort keys %{$self->{is_tested}};
- if (@dirs < 15) {
- $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for $for\n");
+
+ my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
+ if (@dirs < 12) {
+ $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
+ } elsif (@dirs < 24) {
+ my @d = map {my $cp = $_;
+ $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
+ $cp
+ } @dirs;
+ $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
+ "%BUILDDIR%=$CPAN::Config->{build_dir} ".
+ "for '$for'\n"
+ );
} else {
- my @d = map {s/^\Q$CPAN::Config->{'build_dir'}/%BUILDDIR%/; $_ }
- sort keys %{$self->{is_tested}};
- $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib subdirs of ".
- "@d to PERL5LIB; ".
- "%BUILDDIR%=$CPAN::Config->{'build_dir'} ".
- "for $for\n"
+ my $cnt = keys %{$self->{is_tested}};
+ $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
+ "$cnt build dirs to PERL5LIB; ".
+ "for '$for'\n"
);
}
my($toremove) = shift @{$self->{FIFO}};
unless ($toremove =~ /\.yml$/) {
$CPAN::Frontend->myprint(sprintf(
- "Deleting from cache".
- ": $toremove (%.1f>%.1f MB)\n",
+ "DEL: $toremove (%.1f>%.1f MB)\n",
$self->{DU}, $self->{'MAX'})
);
}
my($debug,$t2);
$debug = "";
my $self = {
- ID => $CPAN::Config->{'build_dir'},
+ ID => $CPAN::Config->{build_dir},
MAX => $CPAN::Config->{'build_cache'},
SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
DU => 0
sprintf("Scanning cache %s for sizes\n",
$self->{ID}));
my $e;
- for $e ($self->entries($self->{ID})) {
- next if $e eq ".." || $e eq ".";
+ my @entries = grep { !/^\.\.?$/ } $self->entries($self->{ID});
+ my $i = 0;
+ my $painted = 0;
+ for $e (@entries) {
+ # next if $e eq ".." || $e eq ".";
$self->disk_usage($e);
+ $i++;
+ while (($painted/76) < ($i/@entries)) {
+ $CPAN::Frontend->myprint(".");
+ $painted++;
+ }
return if $CPAN::Signal;
}
+ $CPAN::Frontend->myprint("DONE\n");
$self->tidyup;
}
upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
Pragmas
- force CMD try hard to do command
+ force CMD try hard to do command fforce CMD try harder
notest CMD skip testing
Other
$pathglob = $2;
$author = CPAN::Shell->expand_by_method('CPAN::Author',
['id'],
- $a2) or die "No author found for $a2";
+ $a2)
+ or $CPAN::Frontend->mydie("No author found for $a2\n");
} else {
$author = CPAN::Shell->expand_by_method('CPAN::Author',
['id'],
- $a) or die "No author found for $a";
+ $a)
+ or $CPAN::Frontend->mydie("No author found for $a\n");
}
if ($silent) {
my $alpha = substr $author->id, 0, 1;
$CPAN::Frontend->myprint("\n");
} else {
if (CPAN::HandleConfig->edit(@o_what)) {
- unless ($o_what[0] =~ /^(init|commit|defaults)$/) {
- $CPAN::Frontend->myprint("Please use 'o conf commit' to ".
- "make the config permanent!\n\n");
- }
} else {
$CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
qq{items\n\n});
];
}
my $R = ""; # report
- $R .= sprintf "Log starts: %s\n", scalar(localtime $S{start}) || "unknown";
- $R .= sprintf "Log ends : %s\n", scalar(localtime $S{end}) || "unknown";
+ 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";
# re-run (as documented)
}
+# experimental (compare with _is_tested)
#-> sub CPAN::Shell::install_tested
sub install_tested {
my($self,@some) = @_;
- $CPAN::Frontend->mywarn("install_tested() requires no arguments.\n"),
+ $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
return if @some;
CPAN::Index->reload;
- for my $d (%{$CPAN::META->{readwrite}{'CPAN::Distribution'}}) {
- my $do = CPAN::Shell->expandany($d);
- next unless $do->{build_dir};
+ 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]{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 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;
+ # @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->sleep(1);
+ $CPAN::Frontend->mysleep(1);
$self->install($d);
}
}
}
}
+# experimental (must run after failed or similar [I think])
+# intended as a preparation ot install_tested
+#-> sub CPAN::Shell::is_tested
+sub _is_tested {
+ my($self) = @_;
+ 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;
for $obj (
$CPAN::META->all_objects($class)
) {
- unless ($obj->id){
+ unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id){
# BUG, we got an empty object somewhere
require Data::Dumper;
CPAN->debug(sprintf(
if ($self->colorize_output) {
if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
# if you want to have this configurable, please file a bugreport
- $ornament = "black on_cyan";
+ $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
}
my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
if ($@) {
my $self = shift;
my($meth,@some) = @_;
my @pragma;
- while($meth =~ /^(force|notest)$/) {
+ while($meth =~ /^(ff?orce|notest)$/) {
push @pragma, $meth;
$meth = shift @some or
$CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
cvs_import
dump
force
+ fforce
get
install
look
$sleep+=0.11;
}
}
- my $stats = CPAN->_yaml_loadfile($file);
+ 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::_add_to_statistics
sub _add_to_statistics {
my($self,$stats) = @_;
- my $yaml_module = $self->CPAN::_yaml_module;
+ my $yaml_module = CPAN::_yaml_module;
if ($CPAN::META->has_inst($yaml_module)) {
$stats->{thesiteurl} = $ThesiteURL;
if (CPAN->has_inst("Time::HiRes")) {
$stats->{end} = time;
}
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} ||= [];
- my @debug = scalar @{$fullstats->{history}};
+ push @debug, scalar @{$fullstats->{history}} if $sdebug;
+ push @debug, time if $sdebug;
push @{$fullstats->{history}}, $stats;
- my $time = time;
- shift @{$fullstats->{history}}
- while $time - $fullstats->{history}[0]{start} > 30*86400; # one month too much?
- push @debug, scalar @{$fullstats->{history}};
- push @debug, scalar localtime($fullstats->{history}[0]{start});
- {
- # local $CPAN::DEBUG = 512;
- CPAN->debug(sprintf("DEBUG history: before[%d]after[%d]oldest[%s]",
+ # arbitrary hardcoded constants until somebody demands to have
+ # them settable
+ while (
+ @{$fullstats->{history}} > 9999
+ || $time - $fullstats->{history}[0]{start} > 30*86400 # one month
+ ) {
+ 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||$CPAN::DEBUG ) {
+ 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,
- )) if $CPAN::DEBUG;
+ ));
}
- seek $fh, 0, 0;
- truncate $fh, 0;
- CPAN->_yaml_dumpfile($fh,$fullstats);
+ # Win32 cannot rename a file to an existing filename
+ unlink($sfile) if ($^O eq 'MSWin32');
+ rename "$sfile.$$", $sfile
+ or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
}
}
#-> sub CPAN::Complete::cplx ;
sub cplx {
my($class, $word) = @_;
- # I believed for many years that this was sorted, today I
- # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
- # make it sorted again. Maybe sort was dropped when GNU-readline
- # support came in? The RCS file is difficult to read on that:-(
+ if (CPAN::_sqlite_running) {
+ $CPAN::SQLite->search($class, "^\Q$word\E");
+ }
sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
}
map { [ $_, -M File::Spec->catfile($d,$_) ] }
grep {/\.yml$/} readdir $dh;
DISTRO: for $dirent (@candidates) {
- my $c = CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))->[0];
+ my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
+ die $@ if $@;
+ my $c = $y->[0];
if ($c && CPAN->_perl_fingerprint($c->{perl})) {
my $key = $c->{distribution}{ID};
for my $k (keys %{$c->{distribution}}) {
#we tried to restore only if element already
#exists; but then we do not work with metadata
#turned off.
- $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key} = $c->{distribution};
+ my $do
+ = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
+ = $c->{distribution};
+ delete $do->{badtestcnt};
+ # $DB::single = 1;
+ if ($do->{make_test}
+ && $do->{build_dir}
+ && !$do->{make_test}->failed
+ && (
+ !$do->{install}
+ ||
+ $do->{install}->failed
+ )
+ ) {
+ $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
+ }
$restored++;
}
$i++;
}
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
+ # 'makte_test_failed_within_command'?
delete $self->{badtestcnt};
}
$self->{incommandcolor} = $color;
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}};
+ keys %{$self->{CONTAINSMODS}||{}};
}
#-> sub CPAN::Distribution::upload_date ;
#-> 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(
EXCUSE: {
my @e;
+ $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
if ($self->prefs->{disabled}) {
my $why = sprintf(
"Disabled via prefs file '%s' doc %d",
# note: not intended to be persistent but at least visible
# during this session
} else {
- exists $self->{build_dir} and push @e,
- "Is already unwrapped into directory $self->{build_dir}";
+ if (exists $self->{build_dir}) {
+ # this deserves print, not warn:
+ $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
+ "$self->{build_dir}\n"
+ );
+ return;
+ }
+ # 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 :
)) if $CPAN::DEBUG;
} else {
my $userid = $self->cpan_userid;
- CPAN->debug("userid[$userid]");
+ CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
if (!$userid or $userid eq "N/A") {
$userid = "anon";
}
return;
}
- $self->{'build_dir'} = $packagedir;
+ $self->{build_dir} = $packagedir;
$self->safe_chdir($builddir);
File::Path::rmtree("tmp-$$");
return;
}
my $file = sprintf "%s.yml", $dir;
- CPAN->_yaml_dumpfile(
- $file,
- {
- time => time,
- perl => CPAN::_perl_fingerprint,
- distribution => $self,
- }
- );
+ 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::patch
#-> CPAN::Distribution::patch
sub patch {
my($self) = @_;
- if (my $patches = $self->prefs->{patches}) {
+ $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]");
+ 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".
}
$CPAN::Frontend->myprint(" $patch\n");
my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
- my $thispatchargs = join " ", $stdpatchargs, $self->_patch_p_parameter($readfh);
- CPAN->debug("thispatchargs[$thispatchargs]") if $CPAN::DEBUG;
- $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;
- unless (open $writefh, "|$patchbin $thispatchargs") {
- my $fail = "Could not fork '$patchbin $thispatchargs'";
+ $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};
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;
+ 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";
q{check_sigs});
if ($check_sigs) {
if ($CPAN::META->has_inst("Module::Signature")) {
- $self->debug("Module::Signature is installed, verifying");
+ $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
$self->SIG_check_file($chk_file);
} else {
- $self->debug("Module::Signature is NOT installed");
+ $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
}
}
# "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) = @_;
+ my($self, $method,$fforce) = @_;
my %phase_map = (
get => [
"unwrapped",
"yaml_content",
],
);
- PHASE: for my $phase (qw(get make test install unknown)) { # tentative
+ 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" && $self->id =~ /\.$/ && $att =~ /(unwrapped|build_dir)/ ) {
- # cannot be undone for local distros
- next ATTRIBUTE;
+ 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};
- CPAN->debug(sprintf "phase[%s]att[%s]", $phase, $att) if $CPAN::DEBUG;
+ 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"}++; # name should probably have been force_install
+ $self->{force_update} = 1; # name should probably have been force_install
}
}
#-> sub CPAN::Distribution::unforce ;
sub unforce {
my($self) = @_;
- delete $self->{'force_update'};
+ delete $self->{force_update};
}
#-> sub CPAN::Distribution::isa_perl ;
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
-
$CPAN::META->set_perl5lib;
local $ENV{MAKEFLAGS}; # protect us from outer make calls
delete $self->{force_update};
return;
}
+
+ my $builddir;
EXCUSE: {
my @e;
if (!$self->{archived} || $self->{archived} eq "NO") {
}
defined $self->{make} and push @e,
- "Has already been processed within this session";
+ "Has already been made";
if (exists $self->{later} and length($self->{later})) {
if ($self->unsat_prereq) {
}
$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");
- my $builddir = $self->dir or
- $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
- chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
$self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
" in cwd[$cwd]. Danger, Will Robinson!");
$CPAN::Frontend->mysleep(5);
}
- $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
+ $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
} else {
- $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
+ $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
}
+ $system =~ s/\s+$//;
my $make_arg = $self->make_x_arg("make");
$system = sprintf("%s%s",
$system,
return $expo->exitstatus();
}
+#-> CPAN::Distribution::_validate_distropref
sub _validate_distropref {
my($self,@args) = @_;
if (
}
}
-# CPAN::Distribution::_find_prefs
+#-> CPAN::Distribution::_find_prefs
sub _find_prefs {
my($self) = @_;
my $distroid = $self->pretty_id;
- CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
+ #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
my $prefs_dir = $CPAN::Config->{prefs_dir};
eval { File::Path::mkpath($prefs_dir); };
if ($@) {
$CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
}
- my $yaml_module = CPAN->_yaml_module;
+ my $yaml_module = CPAN::_yaml_module;
my @extensions;
if ($CPAN::META->has_inst($yaml_module)) {
push @extensions, "yml";
my $thisexte = $1;
my $abs = File::Spec->catfile($prefs_dir, $_);
if (-f $abs) {
- CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
+ #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
my @distropref;
if ($thisexte eq "yml") {
+ # need no eval because if we have no YAML we do not try to read *.yml
+ #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
@distropref = @{CPAN->_yaml_loadfile($abs)};
+ #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
} elsif ($thisexte eq "dd") {
package CPAN::Eval;
no strict;
}
}
# $DB::single=1;
+ #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
ELEMENT: for my $y (0..$#distropref) {
my $distropref = $distropref[$y];
$self->_validate_distropref($distropref,$abs,$y);
my $match = $distropref->{match};
unless ($match) {
- CPAN->debug("no 'match' in abs[$abs], skipping");
+ #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
next ELEMENT;
}
my $ok = 1;
- for my $sub_attribute (keys %$match) {
+ # do not take the order of C<keys %$match> because
+ # "module" is by far the slowest
+ for my $sub_attribute (qw(distribution perl module)) {
+ next unless exists $match->{$sub_attribute};
my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
if ($sub_attribute eq "module") {
my $okm = 0;
- CPAN->debug(sprintf "abs[%s]distropref[%d]", $abs, scalar @distropref) if $CPAN::DEBUG;
+ #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
my @modules = $self->containsmods;
- CPAN->debug(sprintf "abs[%s]distropref[%d]modules[%s]", $abs, scalar @distropref, join(",",@modules)) if $CPAN::DEBUG;
+ #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
MODULE: for my $module (@modules) {
$okm ||= $module =~ /$qr/;
last MODULE if $okm;
"Please ".
"remove, cannot continue.");
}
+ last if $ok == 0; # short circuit
}
- CPAN->debug(sprintf "abs[%s]distropref[%d]ok[%d]", $abs, scalar @distropref, $ok) if $CPAN::DEBUG;
+ #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
if ($ok) {
return {
prefs => $distropref,
}
}
}
+ $dh->close;
}
return;
}
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(@need);
my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
NEED: while (my($need_module, $need_version) = each %merged) {
- my($have_version,$inst_file);
+ my($available_version,$available_file);
if ($need_module eq "perl") {
- $have_version = $];
- $inst_file = $^X;
+ $available_version = $];
+ $available_file = $^X;
} else {
my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
next if $nmo->uptodate;
- $inst_file = $nmo->inst_file;
+ $available_file = $nmo->available_file;
# if they have not specified a version, we accept any installed one
if (not defined $need_version or
$need_version eq "0" or
$need_version eq "undef") {
- next if defined $inst_file;
+ next if defined $available_file;
}
- $have_version = $nmo->inst_version;
+ $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 $inst_file) {
+ if (defined $available_file) {
my(@all_requirements) = split /\s*,\s*/, $need_version;
local($^W) = 0;
my $ok = 0;
if ($rq =~ s|>=\s*||) {
} elsif ($rq =~ s|>\s*||) {
# 2005-12: one user
- if (CPAN::Version->vgt($have_version,$rq)){
+ if (CPAN::Version->vgt($available_version,$rq)){
$ok++;
}
next RQ;
} elsif ($rq =~ s|!=\s*||) {
# 2005-12: no user
- if (CPAN::Version->vcmp($have_version,$rq)){
+ if (CPAN::Version->vcmp($available_version,$rq)){
$ok++;
next RQ;
} else {
$ok++;
next RQ;
}
- if (! CPAN::Version->vgt($rq, $have_version)){
+ if (! CPAN::Version->vgt($rq, $available_version)){
$ok++;
}
- CPAN->debug(sprintf("need_module[%s]inst_file[%s]".
- "inst_version[%s]rq[%s]ok[%d]",
+ CPAN->debug(sprintf("need_module[%s]available_file[%s]".
+ "available_version[%s]rq[%s]ok[%d]",
$need_module,
- $inst_file,
- $have_version,
+ $available_file,
+ $available_version,
CPAN::Version->readable($rq),
$ok,
)) if $CPAN::DEBUG;
return unless -f $yaml;
eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
if ($@) {
- $CPAN::Frontend->mywarn("Warning (probably harmless): Could not read ".
+ $CPAN::Frontend->mywarn("Could not read ".
"'$yaml'. Falling back to other ".
"methods to determine prerequisites\n");
- return; # if we die, then we cannot read YAML's own META.yml
+ return $self->{yaml_content} = undef; # if we die, then we
+ # cannot read YAML's own
+ # META.yml
}
if (not exists $self->{yaml_content}{dynamic_config}
or $self->{yaml_content}{dynamic_config}
$self->{make_test} =~ /^NO/
)
) {
- push @e, "Already tested successfully";
+ push @e, "Has already been tested successfully";
}
} 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;
}
- chdir $self->{'build_dir'} or
- Carp::croak("Couldn't chdir to $self->{'build_dir'}");
- $self->debug("Changed directory to $self->{'build_dir'}")
+ $self->debug("Changed directory to $self->{build_dir}")
if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
{
my @prereq;
+ # local $CPAN::DEBUG = 16; # Distribution
for my $m (keys %{$self->{sponsored_mods}}) {
my $m_obj = CPAN::Shell->expand("Module",$m);
# 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::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;
}
}
$CPAN::Frontend->myprint(" $system -- OK\n");
- $CPAN::META->is_tested($self->{'build_dir'});
$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}++;
push @e, "make clean already called once";
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
- chdir $self->{'build_dir'} or
- Carp::croak("Couldn't chdir to $self->{'build_dir'}");
- $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+ 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);
my($method) = (caller(1))[3];
CPAN->instance("CPAN::Distribution",$goto)->$method;
-
+ CPAN::Queue->delete_first($goto);
}
#-> sub CPAN::Distribution::install ;
push @e, $self->{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;
}
- chdir $self->{'build_dir'} or
- Carp::croak("Couldn't chdir to $self->{'build_dir'}");
- $self->debug("Changed directory to $self->{'build_dir'}")
+ $self->debug("Changed directory to $self->{build_dir}")
if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
if ( $close_ok ) {
$CPAN::Frontend->myprint(" $system -- OK\n");
$CPAN::META->is_installed($self->{build_dir});
- return $self->{install} = CPAN::Distrostatus->new("YES");
+ $self->{install} = CPAN::Distrostatus->new("YES");
} else {
$self->{install} = CPAN::Distrostatus->new("NO");
$CPAN::Frontend->mywarn(" $system -- NOT OK\n");
}
}
delete $self->{force_update};
+ # $DB::single = 1;
$self->store_persistent_state;
}
#-> sub CPAN::Distribution::dir ;
sub dir {
- shift->{'build_dir'};
+ shift->{build_dir};
}
#-> sub CPAN::Distribution::perldoc ;
CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
$obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
- if ($color==0) {
- delete $self->{badtestcnt};
- }
+ # never reached code?
+ #if ($color==0) {
+ #delete $self->{badtestcnt};
+ #}
$self->{incommandcolor} = $color;
}
}
my $dist = $CPAN::META->instance('CPAN::Distribution',
$self->cpan_file);
+ $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
$dist->get;
- $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
+ $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));
+ $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)
}
#-> 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::test ;
sub test {
my $self = shift;
- $self->{badtestcnt} ||= 0;
+ # $self->{badtestcnt} ||= 0;
$self->rematein('test',@_);
}
#-> sub CPAN::Bundle::install ;
if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
$dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
- if ($color==0) {
- delete $self->{badtestcnt};
- }
+ # unreached code?
+ # if ($color==0) {
+ # delete $self->{badtestcnt};
+ # }
$self->{incommandcolor} = $color;
}
#-> sub CPAN::Module::force ;
sub force {
my($self) = @_;
- $self->{'force_update'}++;
+ $self->{force_update} = 1;
+}
+
+#-> sub CPAN::Module::fforce ;
+sub fforce {
+ my($self) = @_;
+ $self->{force_update} = 2;
}
sub notest {
}
my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
$pack->called_for($self->id);
- $pack->force($meth) if exists $self->{'force_update'};
+ if (exists $self->{force_update}){
+ if ($self->{force_update} == 2) {
+ $pack->fforce($meth);
+ } else {
+ $pack->force($meth);
+ }
+ }
$pack->notest($meth) if exists $self->{'notest'};
$pack->{reqtype} ||= "";
$pack->$meth();
};
my $err = $@;
- $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
+ $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->{force_update};
delete $self->{'notest'};
if ($err) {
die $err;
#-> sub CPAN::Module::test ;
sub test {
my $self = shift;
- $self->{badtestcnt} ||= 0;
+ # $self->{badtestcnt} ||= 0;
$self->rematein('test',@_);
}
#-> sub CPAN::Module::uptodate ;
my($doit) = 0;
if ($self->uptodate
&&
- not exists $self->{'force_update'}
+ not exists $self->{force_update}
) {
$CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
$self->id,
$do = CPAN::Shell->expand("Distribution",
$distro); # same thing
-=head1 STATUS
-
-This module and its competitor, the CPANPLUS module, are both much
-cooler than the other.
-
-=head1 COMPATIBILITY
-
-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.
-
=head1 DESCRIPTION
The CPAN module is designed to automate the make and install of perl
capabilities and knows how to use Net::FTP or LWP (or some external
download clients) to fetch the raw data from the net.
-Modules are fetched from one or more of the mirrored CPAN
+Distributions are fetched from one or more of the mirrored CPAN
(Comprehensive Perl Archive Network) sites and unpacked in a dedicated
directory.
I<bundles> of modules. Bundles simplify the handling of sets of
related modules. See Bundles below.
-The package contains a session manager and a cache manager. There is
-no status retained between sessions. 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 according to a simple FIFO
-mechanism.
+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
+according to a simple FIFO mechanism.
All methods provided are accessible in a programmer style and in an
interactive shell style.
perl -MCPAN -e shell
-which puts you into a readline interface. You will have the most fun if
-you install Term::ReadKey and Term::ReadLine to enjoy both history and
-command completion.
+which puts you into a readline interface. If Term::ReadKey and either
+Term::ReadLine::Perl or Term::ReadLine::Gnu are installed it supports
+both history and command completion.
-Once you are on the command line, type 'h' and the rest should be
-self-explanatory.
+Once you are on the command line, type 'h' to get a one page help
+screen and the rest should be self-explanatory.
The function call C<shell> takes two optional arguments, one is the
prompt, the second is the default initial command line (the latter
more than one, we display each object with the terse method
C<as_glimpse>.
-=item make, test, install, clean modules or distributions
+=item get, make, test, install, clean 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
the module's META.yml or Makefile.PL (this behavior is controlled by
the configuration parameter C<prerequisites_policy>.)
+C<get> downloads a distribution file and untars or unzips it, C<make>
+builds it, C<test> runs the test suite, and C<install> installs it.
+
Any C<make> or C<test> are run unconditionally. An
install <distribution_file>
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 if it
-succeeded or not. The C<force> pragma may precede another command
-(currently: C<make>, C<test>, or C<install>) and executes the
-command from scratch and tries to continue in case of some errors.
-
-Example:
+succeeded or not. It does not repeat a test run if the test
+has been run successfully before. Same for install runs.
- cpan> install OpenGL
- OpenGL is up to date.
- cpan> force install OpenGL
- Running make
- OpenGL-0.4/
- OpenGL-0.4/COPYRIGHT
- [...]
+The C<force> pragma may precede another command (currently: C<get>,
+C<make>, C<test>, or C<install>) and executes the command from scratch
+and tries to continue in case of some errors. See the section below on
+The C<force> and the C<fforce> pragma.
-The C<notest> pragma may be set to skip the test part in the build
+The C<notest> pragma may be used to skip the test part in the build
process.
Example:
being executed within the distribution file's working directory.
-=item get, readme, perldoc, look module or distribution
+=item readme, perldoc, look module or distribution
-C<get> downloads a distribution file without further action. C<readme>
-displays the README file of the associated distribution. C<Look> gets
-and untars (if not yet done) the distribution file, changes to the
-appropriate directory and opens a subshell process in that directory.
-C<perldoc> displays the pod documentation of the module in html or
-plain text format.
+C<readme> displays the README file of the associated distribution.
+C<Look> gets and untars (if not yet done) the distribution file,
+changes to the appropriate directory and opens a subshell process in
+that directory. C<perldoc> displays the pod documentation of the
+module in html or plain text format.
=item ls author
C<make>, C<test> or C<install> for some reason in the currently
running shell session.
+=item Persistence between sessions
+
+If the C<YAML> or the c<YAML::Syck> 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<build_dir_reuse> 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 effectively persistence between sessions
+is established.
+
+=item The C<force> and the C<fforce> 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<get>, a C<make>, and an C<install> are not repeated.
+A C<test> is only repeated if the previous test was unsuccessful. The
+diagnostic message when CPAN.pm refuses to do something a second time
+is one of I<Has already been >C<unwrapped|made|tested successfully> or
+something similar. Another situation where CPAN refuses to act is an
+C<install> if the according C<test> was not successful.
+
+In all these cases, the user can override the goatish 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<forced> command is executed with the according part of its
+memory erased.
+
+The C<fforce> pragma is a variant that emulates a C<force get> 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, per default C<~/.cpan/.lock>.
=head2 Integrating local directories
Distribution objects are normally distributions from the CPAN, but
-there is a slightly degenerate case for Distribution objects, too,
-normally only needed by developers. If a distribution object ends with
-a dot or is a dot by itself, then it represents a local directory and
-all actions such as C<make>, C<test>, and C<install> are applied
+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<make>, C<test>, and C<install> are applied
directly to that directory. This gives the command C<cpan .> an
interesting touch: while the normal mantra of installing a CPAN module
without CPAN.pm is one of
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.
+
=head1 PROGRAMMER'S INTERFACE
If you do not enter the shell, the available shell commands are both
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<force> is passed recursively
-to all contained objects.
+to all contained objects. See also the section above on the C<force>
+and the C<fforce> pragma.
=item CPAN::Bundle::get()
=item CPAN::Distribution::force($method,@args)
-Forces CPAN to perform a task that normally would have failed. 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.
+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<force> and the C<fforce> pragma.
=item CPAN::Distribution::get()
=item CPAN::Module::force($method,@args)
-Forces CPAN to perform a task that normally would have failed. 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.
+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<force> and the C<fforce> pragma.
=item CPAN::Module::get()
=item has_inst($module)
-Returns true if the module is installed. See the source for details.
+Returns true if the module is installed. Used to load all modules into
+the running CPAN.pm which are considered optional. The config variable
+C<dontload_list> can be used to intercept the C<has_inst()> call such
+that an optional module is not loaded despite being available. For
+example the following command will prevent that C<YAML.pm> is being
+loaded:
-=item has_usable($module)
+ cpan> o conf dontload_list push YAML
-Returns true if the module is installed and several and is in a usable
-state. Only useful for a handful of modules that are used internally.
See the source for details.
+=item has_usable($module)
+
+Returns true if the module is installed and is 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,
Currently the following keys in the hash reference $CPAN::Config are
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
quote on Windows, single tick everywhere else;
can be set to space to disable quoting
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
CPAN.pm comes with a couple of such YAML files. The structure is
currently not documented because in flux. Please see the distroprefs
-directory of the CPAN distribution for examples and follow the README
-in there.
+directory of the CPAN distribution for examples and follow the
+C<00.README> file in there.
Please note that setting the environment variable PERL_MM_USE_DEFAULT
to a true value can also get you a long way if you want to always pick
force install Foo::Bar
-This does a bit more than really needed because it untars the
-distribution again and runs make and test and only then install.
-
-Or, if you find this is too fast and you would prefer to do smaller
-steps, say
-
- force get Foo::Bar
-
-first and then continue as always. C<Force get> I<forgets> previous
-error conditions.
-
Or you can use
look Foo::Bar
and then 'make install' directly in the subshell.
-Or you leave the CPAN shell and start it again.
-
-For the really curious, by accessing internals directly, you I<could>
-
- !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
-
-but this is neither guaranteed to work in the future nor is it a
-decent command.
-
=item 12)
How do I install a "DEVELOPER RELEASE" of a module?
=back
-=head1 BUGS
+=head1 COMPATIBILITY
-Please report bugs via http://rt.cpan.org/
+=head2 OLD PERL VERSIONS
-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.
+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 tried to make it compatible with CPAN.pm.
=head1 SECURITY ADVICE
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 http://rt.cpan.org/
+
+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<< <andk@cpan.org> >>
projects / platform / upstream / perl.git / commitdiff