$Frontend $Defaultsite
}; #};
-$VERSION = '1.57';
+$VERSION = '1.57_51';
-# $Id: CPAN.pm,v 1.305 2000/08/16 12:42:32 k Exp $
+# $Id: CPAN.pm,v 1.314 2000/08/21 12:37:43 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.305 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.314 $, 10)."]";
use Carp ();
use Config ();
Eval 2048
Config 4096
Tarzip 8192
+ Version 16384
];
$CPAN::DEBUG ||= 0;
$Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
CPAN::Config->load unless $CPAN::Config_loaded++;
+ CPAN::Index->read_metadata_cache;
+
my $prompt = "cpan> ";
local($^W) = 1;
unless ($Suppress_readline) {
use File::Find;
package CPAN::Config;
-import ExtUtils::MakeMaker 'neatvalue';
use vars qw(%can $dot_cpan);
%can = (
#-> sub CPAN::Config::edit ;
# returns true on successful action
sub edit {
- my($class,@args) = @_;
+ my($self,@args) = @_;
return unless @args;
- CPAN->debug("class[$class]args[".join(" | ",@args)."]");
+ CPAN->debug("self[$self]args[".join(" | ",@args)."]");
my($o,$str,$func,$args,$key_exists);
$o = shift @args;
if($can{$o}) {
- $class->$o(@args);
+ $self->$o(@args);
return 1;
} else {
CPAN->debug("o[$o]") if $CPAN::DEBUG;
$CPAN::Config->{$o} = [@args];
$changed = 1;
} else {
- $CPAN::Frontend->myprint(
- join "",
- " $o ",
- ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
- "\n"
- );
+ $self->prettyprint($o);
}
if ($o eq "urllist" && $changed) {
# reset the cached values
return $changed;
} else {
$CPAN::Config->{$o} = $args[0] if defined $args[0];
- $CPAN::Frontend->myprint(" $o " .
- (defined $CPAN::Config->{$o} ?
- $CPAN::Config->{$o} : "UNDEFINED"));
+ $self->prettyprint($o);
}
}
}
+sub prettyprint {
+ my($self,$k) = @_;
+ my $v = $CPAN::Config->{$k};
+ if (ref $v) {
+ my(@report) = ref $v eq "ARRAY" ?
+ @$v :
+ map { sprintf(" %-18s => %s\n",
+ $_,
+ defined $v->{$_} ? $v->{$_} : "UNDEFINED"
+ )} keys %$v;
+ $CPAN::Frontend->myprint(
+ join(
+ "",
+ sprintf(
+ " %-18s\n",
+ $k
+ ),
+ map {"\t$_\n"} @report
+ )
+ );
+ } elsif (defined $v) {
+ $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
+ } else {
+ $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, "UNDEFINED");
+ }
+}
+
#-> sub CPAN::Config::commit ;
sub commit {
my($self,$configpm) = @_;
index_expire gzip tar unzip make pager makepl_arg make_arg
make_install_arg urllist inhibit_startup_message
ftp_proxy http_proxy no_proxy prerequisites_policy
+ cache_metadata
)) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
}
#-> sub CPAN::Shell::o ;
+
+# CPAN::Shell::o and CPAN::Config::edit are closely related. I suspect
+# some code duplication
sub o {
my($self,$o_type,@o_what) = @_;
$o_type ||= "";
CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
if ($o_type eq 'conf') {
shift @o_what if @o_what && $o_what[0] eq 'help';
- if (!@o_what) {
+ if (!@o_what) { # print all things, "o conf"
my($k,$v);
$CPAN::Frontend->myprint("CPAN::Config options");
if (exists $INC{'CPAN/Config.pm'}) {
}
$CPAN::Frontend->myprint("\n");
for $k (sort keys %$CPAN::Config) {
- $v = $CPAN::Config->{$k};
- if (ref $v) {
- my(@report) = ref $v eq "ARRAY" ? @$v : %$v;
- $CPAN::Frontend->myprint(
- join(
- "",
- sprintf(
- " %-18s\n",
- $k
- ),
- map {"\t$_\n"} @report
- )
- );
- } else {
- $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
- }
+ CPAN::Config->prettyprint($k);
}
$CPAN::Frontend->myprint("\n");
} elsif (!CPAN::Config->edit(@o_what)) {
for $module ($self->expand('Module',@args)) {
my $file = $module->cpan_file;
next unless defined $file; # ??
- my($latest) = $module->cpan_version; # %vd
+ my($latest) = $module->cpan_version; # %vd not needed
my($inst_file) = $module->inst_file;
my($have);
return if $CPAN::Signal;
if ($inst_file){
if ($what eq "a") {
- $have = $module->inst_version; # %vd
+ $have = $module->inst_version; # %vd already applied
} elsif ($what eq "r") {
- $have = $module->inst_version; # %vd
+ $have = $module->inst_version; # %vd already applied
local($^W) = 0;
if ($have eq "undef"){
$version_undefs++;
} elsif ($have == 0){
$version_zeroes++;
}
- next if $have >= $latest;
+ next unless CPAN::Version->vgt($latest, $have);
# to be pedantic we should probably say:
# && !($have eq "undef" && $latest ne "undef" && $latest gt "");
# to catch the case where CPAN has a version 0 and we have a version undef
"in CPAN file"
));
}
- for ($have,$latest) {
- if ($] >= 5.006) { # people start using v-strings
- local($^W) = 0;
- unless (/^([+-]?)([\d_]*)(\.([\d_]*))?([Ee]([+-]?[\d_]+))?$/
- && "$2$4" ne ""
- ||
- /^undef$/
- ||
- /^-$/ # not installed
- ) {
- $_ = sprintf "%vd", $_;
- }
- }
- $_ = substr($_,0,8) if length($_) > 8;
- }
+#### for ($have,$latest) {
+#### # $_ = CPAN::Version->readable($_); # %vd already applied
+#### if (length($_) > 8){
+#### my $trunc = substr($_,0,8);
+#### $CPAN::Frontend->mywarn("Truncating VERSION from [$_] to [$trunc]\n");
+#### $_ = $trunc;
+#### }
+#### }
$CPAN::Frontend->myprint(sprintf $sprintf,
$module->id,
$have,
File::Spec->catfile('modules', '03mlist.gz') :
File::Spec->catfile('modules', '03modlist.data.gz'),
$force));
+ $cl->write_metadata_cache;
$t2 = time;
$debug .= "03[".($t2 - $time)."]";
$time = $t2;
$id = $CPAN::META->instance('CPAN::Module',$mod);
}
- if ($id->cpan_file ne $dist){
+ if ($id->cpan_file ne $dist){ # update only if file is
+ # different. CPAN prohibits same
+ # name with different version
$userid = $self->userid($dist);
$id->set(
'CPAN_USERID' => $userid,
- 'CPAN_VERSION' => $version, # %vd
+ 'CPAN_VERSION' => $version, # %vd not needed
'CPAN_FILE' => $dist,
'CPAN_COMMENT' => $comment,
);
}
}
+#-> sub CPAN::Index::write_metadata_cache ;
+sub write_metadata_cache {
+ my($self) = @_;
+ return unless $CPAN::Config->{'cache_metadata'};
+ return unless $CPAN::META->has_usable("Storable");
+ my $cache;
+ foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
+ CPAN::Distribution)) {
+ $cache->{$k} = $CPAN::META->{$k};
+ }
+ my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
+ $CPAN::Frontend->myprint("Going to write $metadata_file\n");
+ $cache->{last_time} = $last_time;
+ eval { Storable::store($cache, $metadata_file) };
+ $CPAN::Frontent->mywarn($@) if $@;
+}
+
+#-> sub CPAN::Index::read_metadata_cache ;
+sub read_metadata_cache {
+ my($self) = @_;
+ return unless $CPAN::Config->{'cache_metadata'};
+ return unless $CPAN::META->has_usable("Storable");
+ my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
+ return unless -r $metadata_file and -f $metadata_file;
+ $CPAN::Frontend->myprint("Going to read $metadata_file\n");
+ my $cache;
+ eval { $cache = Storable::retrieve($metadata_file) };
+ $CPAN::Frontend->mywarn($@) if $@;
+ return if (!$cache || ref $cache ne 'HASH');
+ while(my($k,$v) = each %$cache) {
+ next unless $k =~ /^CPAN::/;
+ $CPAN::META->{$k} = $v;
+ }
+ $last_time = $cache->{last_time};
+}
+
package CPAN::InfoObj;
#-> sub CPAN::InfoObj::new ;
CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
$self->{localfile} = $local_file;
+ $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
my $builddir = $CPAN::META->{cachemgr}->dir;
$self->debug("doing chdir $builddir") if $CPAN::DEBUG;
chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
sub new {
my($class,%att) = @_;
- $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
+ # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
my $this = { %att };
return bless $this, $class;
my $package = $self->called_for;
my $module = $CPAN::META->instance('CPAN::Module', $package);
- my $version = $module->cpan_version; # %vd
+ my $version = $module->cpan_version; # %vd not needed
my $userid = $self->{CPAN_USERID};
$CPAN::META->instance(
'CPAN::Module',
$self->called_for
- )->cpan_version, # %vd
+ )->cpan_version, # %vd not needed
$self->called_for,
$self->isa_perl,
$self->called_for,
# check, because if 'force' is in effect, nobody else will check.
{
local($^W) = 0;
- if (defined $mo->inst_file &&
- $mo->inst_version >= $need_version){ # %vd
+ if (
+ defined $mo->inst_file &&
+ ! CPAN::Version->vgt($need_version, $mo->inst_version)
+ ){
CPAN->debug(sprintf "inst_file[%s]inst_version[%s]need_version[%s]",
- $mo->inst_file, $mo->inst_version, $need_version
+ $mo->inst_file,
+ $mo->inst_version,
+ CPAN::Version->readable($need_version)
);
next NEED;
}
sub as_string {
my($self) = @_;
$self->contains;
- $self->{INST_VERSION} ||= $self->inst_version; # %vd
+ # following line must be "=", not "||=" because we have a moving target
+ $self->{INST_VERSION} = $self->inst_version; # %vd already applied
return $self->SUPER::as_string;
}
);
}
}
- push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION}) # %vd
- if $self->{CPAN_VERSION}; # %vd
+ push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION}) # %vd not needed
+ if $self->{CPAN_VERSION}; # %vd not needed
push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
if $self->{CPAN_FILE};
my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
push @m, sprintf($sprintf, 'INST_FILE',
$local_file || "(not installed)");
push @m, sprintf($sprintf, 'INST_VERSION',
- $self->inst_version) if $local_file; #%vd
+ $self->inst_version) if $local_file; #%vd already applied
join "", @m, "\n";
}
# and do not want to
# provoke too many
# bugreports
- $self->{'CPAN_VERSION'}; # %vd
+ $self->{'CPAN_VERSION'}; # %vd not needed
}
#-> sub CPAN::Module::force ;
#-> sub CPAN::Module::uptodate ;
sub uptodate {
my($self) = @_;
- my($latest) = $self->cpan_version; # %vd
+ my($latest) = $self->cpan_version; # %vd not needed
$latest ||= 0;
my($inst_file) = $self->inst_file;
my($have) = 0;
if (defined $inst_file) {
- $have = $self->inst_version; # %vd?
+ $have = $self->inst_version; # %vd already applied
}
local($^W)=0;
if ($inst_file
&&
- $have >= $latest # %vd
+ ! CPAN::Version->vgt($latest, $have)
) {
return 1;
}
my($self) = @_;
my $parsefile = $self->inst_file or return;
local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
- # warn "HERE";
my $have;
# local($SIG{__WARN__}) = sub { warn "1. have[$have]"; };
# local($SIG{__WARN__}) = sub { warn "2. have[$have]"; };
- if ($] >= 5.006) { # people start using v-strings
- unless ($have =~ /^([+-]?)([\d_]*)(\.([\d_]*))?([Ee]([+-]?[\d_]+))?$/
- && "$2$4" ne ""
- ||
- /^undef$/
- ||
- /^-$/
- ) {
- $have = sprintf "%vd", $have;
- }
- }
+ # Should %vd hack happen here? Must we not maintain the original
+ # version string until it is used? Do we for printing make it
+ # human readable? Or do we maintain it in a human readable form?
+ # "v1.0.2"?
+
+ # OK, let's discuss the pros and cons:
+ #-maintain it as string with leading v:
+ # read index files do nothing
+ # compare it use utility for compare
+ # print it do nothing
+
+ # maintain it as what is is
+ # read index files convert
+ # compare it use utility because there's still a ">" vs "gt" issue
+ # print it use CPAN::Version for print
+
+ # Seems cleaner to hold it in memory as a string starting with a "v"
+
+ $have = CPAN::Version->readable($have);
$have =~ s/\s*//g; # stringify to float around floating point issues
- # local($SIG{__WARN__}) = sub { warn "3. have[$have]"; };
$have; # no stringify needed, \s* above matches always
}
return 1;
}
+package CPAN::Version;
+
+sub vgt {
+ my($self,$l,$r) = @_;
+ local($^W) = 0;
+ CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+ return 1 if $r eq "undef" && $l ne "undef";
+ return if $l eq "undef" && $r ne "undef";
+ return 1 if $] >= 5.006 && $l =~ /^v/ && $r =~ /^v/ &&
+ $self->vstring($l) gt $self->vstring($r);
+ return 1 if $l > $r;
+ return 1 if $l gt $r;
+ return;
+}
+
+sub vstring {
+ my($self,$n) = @_;
+ $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid argument [$n]";
+ pack "U*", split /\./, $n;
+}
+
+sub readable {
+ my($self,$n) = @_;
+ $n =~ /^([\w\-\+\.]+)/;
+ return $1 if length($1)>0;
+ if ($] < 5.006) { # or whenever v-strings were introduced
+ # we get them wrong anyway, whatever we do, because 5.005 will
+ # have already interpreted 0.2.4 to be "0.24". So even if he
+ # indexer sends us something like "v0.2.4" we compare wrongly.
+
+ # And if they say v1.2, then the old perl takes it as "v12"
+
+ $CPAN::Frontend->mywarn("Suspicious version string seen [$n]");
+ return $n;
+ }
+ my $better = sprintf "v%vd", $n;
+ CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
+ return $better;
+}
+
package CPAN;
1;
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
projects / p5sagit/p5-mst-13.2.git / blobdiff