Spaces:
Running
Running
| package CPAN::Index; | |
| use strict; | |
| use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION); | |
| $VERSION = "2.12"; | |
| @CPAN::Index::ISA = qw(CPAN::Debug); | |
| $LAST_TIME ||= 0; | |
| $DATE_OF_03 ||= 0; | |
| # use constant PROTOCOL => "2.0"; # commented out to avoid warning on upgrade from 1.57 | |
| sub PROTOCOL { 2.0 } | |
| #-> sub CPAN::Index::force_reload ; | |
| sub force_reload { | |
| my($class) = @_; | |
| $CPAN::Index::LAST_TIME = 0; | |
| $class->reload(1); | |
| } | |
| my @indexbundle = | |
| ( | |
| { | |
| reader => "rd_authindex", | |
| dir => "authors", | |
| remotefile => '01mailrc.txt.gz', | |
| shortlocalfile => '01mailrc.gz', | |
| }, | |
| { | |
| reader => "rd_modpacks", | |
| dir => "modules", | |
| remotefile => '02packages.details.txt.gz', | |
| shortlocalfile => '02packag.gz', | |
| }, | |
| { | |
| reader => "rd_modlist", | |
| dir => "modules", | |
| remotefile => '03modlist.data.gz', | |
| shortlocalfile => '03mlist.gz', | |
| }, | |
| ); | |
| #-> sub CPAN::Index::reload ; | |
| sub reload { | |
| my($self,$force) = @_; | |
| my $time = time; | |
| # XXX check if a newer one is available. (We currently read it | |
| # from time to time) | |
| for ($CPAN::Config->{index_expire}) { | |
| $_ = 0.001 unless $_ && $_ > 0.001; | |
| } | |
| unless (1 || $CPAN::Have_warned->{readmetadatacache}++) { | |
| # debug here when CPAN doesn't seem to read the Metadata | |
| require Carp; | |
| Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]"); | |
| } | |
| unless ($CPAN::META->{PROTOCOL}) { | |
| $self->read_metadata_cache; | |
| $CPAN::META->{PROTOCOL} ||= "1.0"; | |
| } | |
| if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) { | |
| # warn "Setting last_time to 0"; | |
| $LAST_TIME = 0; # No warning necessary | |
| } | |
| if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time | |
| and ! $force) { | |
| # called too often | |
| # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]"); | |
| } elsif (0) { | |
| # IFF we are developing, it helps to wipe out the memory | |
| # between reloads, otherwise it is not what a user expects. | |
| undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274) | |
| $CPAN::META = CPAN->new; | |
| } else { | |
| my($debug,$t2); | |
| local $LAST_TIME = $time; | |
| local $CPAN::META->{PROTOCOL} = PROTOCOL; | |
| my $needshort = $^O eq "dos"; | |
| INX: for my $indexbundle (@indexbundle) { | |
| my $reader = $indexbundle->{reader}; | |
| my $localfile = $needshort ? $indexbundle->{shortlocalfile} : $indexbundle->{remotefile}; | |
| my $localpath = File::Spec->catfile($indexbundle->{dir}, $localfile); | |
| my $remote = join "/", $indexbundle->{dir}, $indexbundle->{remotefile}; | |
| my $localized = $self->reload_x($remote, $localpath, $force); | |
| $self->$reader($localized); # may die but we let the shell catch it | |
| if ($CPAN::DEBUG){ | |
| $t2 = time; | |
| $debug = "timing reading 01[".($t2 - $time)."]"; | |
| $time = $t2; | |
| } | |
| return if $CPAN::Signal; # this is sometimes lengthy | |
| } | |
| $self->write_metadata_cache; | |
| if ($CPAN::DEBUG){ | |
| $t2 = time; | |
| $debug .= "03[".($t2 - $time)."]"; | |
| $time = $t2; | |
| } | |
| CPAN->debug($debug) if $CPAN::DEBUG; | |
| } | |
| if ($CPAN::Config->{build_dir_reuse}) { | |
| $self->reanimate_build_dir; | |
| } | |
| if (CPAN::_sqlite_running()) { | |
| $CPAN::SQLite->reload(time => $time, force => $force) | |
| if not $LAST_TIME; | |
| } | |
| $LAST_TIME = $time; | |
| $CPAN::META->{PROTOCOL} = PROTOCOL; | |
| } | |
| #-> sub CPAN::Index::reanimate_build_dir ; | |
| sub reanimate_build_dir { | |
| my($self) = @_; | |
| unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) { | |
| return; | |
| } | |
| return if $HAVE_REANIMATED++; | |
| my $d = $CPAN::Config->{build_dir}; | |
| my $dh = DirHandle->new; | |
| opendir $dh, $d or return; # does not exist | |
| my $dirent; | |
| my $i = 0; | |
| my $painted = 0; | |
| my $restored = 0; | |
| my $start = CPAN::FTP::_mytime(); | |
| my @candidates = map { $_->[0] } | |
| sort { $b->[1] <=> $a->[1] } | |
| map { [ $_, -M File::Spec->catfile($d,$_) ] } | |
| grep {/(.+)\.yml$/ && -d File::Spec->catfile($d,$1)} readdir $dh; | |
| if ( @candidates ) { | |
| $CPAN::Frontend->myprint | |
| (sprintf("Reading %d yaml file%s from %s/\n", | |
| scalar @candidates, | |
| @candidates==1 ? "" : "s", | |
| $CPAN::Config->{build_dir} | |
| )); | |
| DISTRO: for $i (0..$#candidates) { | |
| my $dirent = $candidates[$i]; | |
| my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))}; | |
| if ($@) { | |
| warn "Error while parsing file '$dirent'; error: '$@'"; | |
| next DISTRO; | |
| } | |
| my $c = $y->[0]; | |
| if ($c && $c->{perl} && $c->{distribution} && CPAN->_perl_fingerprint($c->{perl})) { | |
| my $key = $c->{distribution}{ID}; | |
| for my $k (keys %{$c->{distribution}}) { | |
| if ($c->{distribution}{$k} | |
| && ref $c->{distribution}{$k} | |
| && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) { | |
| $c->{distribution}{$k}{COMMANDID} = $i - @candidates; | |
| } | |
| } | |
| #we tried to restore only if element already | |
| #exists; but then we do not work with metadata | |
| #turned off. | |
| my $do | |
| = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key} | |
| = $c->{distribution}; | |
| for my $skipper (qw( | |
| badtestcnt | |
| configure_requires_later | |
| configure_requires_later_for | |
| force_update | |
| later | |
| later_for | |
| notest | |
| should_report | |
| sponsored_mods | |
| prefs | |
| negative_prefs_cache | |
| )) { | |
| delete $do->{$skipper}; | |
| } | |
| if ($do->can("tested_ok_but_not_installed")) { | |
| if ($do->tested_ok_but_not_installed) { | |
| $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME}); | |
| } else { | |
| next DISTRO; | |
| } | |
| } | |
| $restored++; | |
| } | |
| $i++; | |
| while (($painted/76) < ($i/@candidates)) { | |
| $CPAN::Frontend->myprint("."); | |
| $painted++; | |
| } | |
| } | |
| } | |
| else { | |
| $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n"); | |
| } | |
| my $took = CPAN::FTP::_mytime() - $start; | |
| $CPAN::Frontend->myprint(sprintf( | |
| "DONE\nRestored the state of %s (in %.4f secs)\n", | |
| $restored || "none", | |
| $took, | |
| )); | |
| } | |
| #-> sub CPAN::Index::reload_x ; | |
| sub reload_x { | |
| my($cl,$wanted,$localname,$force) = @_; | |
| $force |= 2; # means we're dealing with an index here | |
| CPAN::HandleConfig->load; # we should guarantee loading wherever | |
| # we rely on Config XXX | |
| $localname ||= $wanted; | |
| my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'}, | |
| $localname); | |
| if ( | |
| -f $abs_wanted && | |
| -M $abs_wanted < $CPAN::Config->{'index_expire'} && | |
| !($force & 1) | |
| ) { | |
| my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s"; | |
| $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }. | |
| qq{day$s. I\'ll use that.}); | |
| return $abs_wanted; | |
| } else { | |
| $force |= 1; # means we're quite serious about it. | |
| } | |
| return CPAN::FTP->localize($wanted,$abs_wanted,$force); | |
| } | |
| #-> sub CPAN::Index::rd_authindex ; | |
| sub rd_authindex { | |
| my($cl, $index_target) = @_; | |
| return unless defined $index_target; | |
| return if CPAN::_sqlite_running(); | |
| my @lines; | |
| $CPAN::Frontend->myprint("Reading '$index_target'\n"); | |
| local(*FH); | |
| tie *FH, 'CPAN::Tarzip', $index_target; | |
| local($/) = "\n"; | |
| local($_); | |
| push @lines, split /\012/ while <FH>; | |
| my $i = 0; | |
| my $painted = 0; | |
| foreach (@lines) { | |
| my($userid,$fullname,$email) = | |
| m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/; | |
| $fullname ||= $email; | |
| if ($userid && $fullname && $email) { | |
| my $userobj = $CPAN::META->instance('CPAN::Author',$userid); | |
| $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email); | |
| } else { | |
| CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG; | |
| } | |
| $i++; | |
| while (($painted/76) < ($i/@lines)) { | |
| $CPAN::Frontend->myprint("."); | |
| $painted++; | |
| } | |
| return if $CPAN::Signal; | |
| } | |
| $CPAN::Frontend->myprint("DONE\n"); | |
| } | |
| sub userid { | |
| my($self,$dist) = @_; | |
| $dist = $self->{'id'} unless defined $dist; | |
| my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|; | |
| $ret; | |
| } | |
| #-> sub CPAN::Index::rd_modpacks ; | |
| sub rd_modpacks { | |
| my($self, $index_target) = @_; | |
| return unless defined $index_target; | |
| return if CPAN::_sqlite_running(); | |
| $CPAN::Frontend->myprint("Reading '$index_target'\n"); | |
| my $fh = CPAN::Tarzip->TIEHANDLE($index_target); | |
| local $_; | |
| CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG; | |
| my $slurp = ""; | |
| my $chunk; | |
| while (my $bytes = $fh->READ(\$chunk,8192)) { | |
| $slurp.=$chunk; | |
| } | |
| my @lines = split /\012/, $slurp; | |
| CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG; | |
| undef $fh; | |
| # read header | |
| my($line_count,$last_updated); | |
| while (@lines) { | |
| my $shift = shift(@lines); | |
| last if $shift =~ /^\s*$/; | |
| $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1; | |
| $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1; | |
| } | |
| CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG; | |
| my $errors = 0; | |
| if (not defined $line_count) { | |
| $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header. | |
| Please check the validity of the index file by comparing it to more | |
| than one CPAN mirror. I'll continue but problems seem likely to | |
| happen.\a | |
| }); | |
| $errors++; | |
| $CPAN::Frontend->mysleep(5); | |
| } elsif ($line_count != scalar @lines) { | |
| $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s | |
| contains a Line-Count header of %d but I see %d lines there. Please | |
| check the validity of the index file by comparing it to more than one | |
| CPAN mirror. I'll continue but problems seem likely to happen.\a\n}, | |
| $index_target, $line_count, scalar(@lines)); | |
| } | |
| if (not defined $last_updated) { | |
| $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header. | |
| Please check the validity of the index file by comparing it to more | |
| than one CPAN mirror. I'll continue but problems seem likely to | |
| happen.\a | |
| }); | |
| $errors++; | |
| $CPAN::Frontend->mysleep(5); | |
| } else { | |
| $CPAN::Frontend | |
| ->myprint(sprintf qq{ Database was generated on %s\n}, | |
| $last_updated); | |
| $DATE_OF_02 = $last_updated; | |
| my $age = time; | |
| if ($CPAN::META->has_inst('HTTP::Date')) { | |
| require HTTP::Date; | |
| $age -= HTTP::Date::str2time($last_updated); | |
| } else { | |
| $CPAN::Frontend->mywarn(" HTTP::Date not available\n"); | |
| require Time::Local; | |
| my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /; | |
| $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4; | |
| $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0; | |
| } | |
| $age /= 3600*24; | |
| if ($age > 30) { | |
| $CPAN::Frontend | |
| ->mywarn(sprintf | |
| qq{Warning: This index file is %d days old. | |
| Please check the host you chose as your CPAN mirror for staleness. | |
| I'll continue but problems seem likely to happen.\a\n}, | |
| $age); | |
| } elsif ($age < -1) { | |
| $CPAN::Frontend | |
| ->mywarn(sprintf | |
| qq{Warning: Your system date is %d days behind this index file! | |
| System time: %s | |
| Timestamp index file: %s | |
| Please fix your system time, problems with the make command expected.\n}, | |
| -$age, | |
| scalar gmtime, | |
| $DATE_OF_02, | |
| ); | |
| } | |
| } | |
| # A necessity since we have metadata_cache: delete what isn't | |
| # there anymore | |
| my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN"); | |
| CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG; | |
| my(%exists); | |
| my $i = 0; | |
| my $painted = 0; | |
| LINE: foreach (@lines) { | |
| # before 1.56 we split into 3 and discarded the rest. From | |
| # 1.57 we assign remaining text to $comment thus allowing to | |
| # influence isa_perl | |
| my($mod,$version,$dist,$comment) = split " ", $_, 4; | |
| unless ($mod && defined $version && $dist) { | |
| require Dumpvalue; | |
| my $dv = Dumpvalue->new(tick => '"'); | |
| $CPAN::Frontend->mywarn(sprintf "Could not split line[%s]\n", $dv->stringify($_)); | |
| if ($errors++ >= 5){ | |
| $CPAN::Frontend->mydie("Giving up parsing your $index_target, too many errors"); | |
| } | |
| next LINE; | |
| } | |
| my($bundle,$id,$userid); | |
| if ($mod eq 'CPAN' && | |
| ! ( | |
| CPAN::Queue->exists('Bundle::CPAN') || | |
| CPAN::Queue->exists('CPAN') | |
| ) | |
| ) { | |
| local($^W)= 0; | |
| if ($version > $CPAN::VERSION) { | |
| $CPAN::Frontend->mywarn(qq{ | |
| New CPAN.pm version (v$version) available. | |
| [Currently running version is v$CPAN::VERSION] | |
| You might want to try | |
| install CPAN | |
| reload cpan | |
| to both upgrade CPAN.pm and run the new version without leaving | |
| the current session. | |
| }); #}); | |
| $CPAN::Frontend->mysleep(2); | |
| $CPAN::Frontend->myprint(qq{\n}); | |
| } | |
| last if $CPAN::Signal; | |
| } elsif ($mod =~ /^Bundle::(.*)/) { | |
| $bundle = $1; | |
| } | |
| if ($bundle) { | |
| $id = $CPAN::META->instance('CPAN::Bundle',$mod); | |
| # Let's make it a module too, because bundles have so much | |
| # in common with modules. | |
| # Changed in 1.57_63: seems like memory bloat now without | |
| # any value, so commented out | |
| # $CPAN::META->instance('CPAN::Module',$mod); | |
| } else { | |
| # instantiate a module object | |
| $id = $CPAN::META->instance('CPAN::Module',$mod); | |
| } | |
| # 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, | |
| 'CPAN_VERSION' => $version, | |
| 'CPAN_FILE' => $dist, | |
| ); | |
| } | |
| # instantiate a distribution object | |
| if ($CPAN::META->exists('CPAN::Distribution',$dist)) { | |
| # we do not need CONTAINSMODS unless we do something with | |
| # this dist, so we better produce it on demand. | |
| ## my $obj = $CPAN::META->instance( | |
| ## 'CPAN::Distribution' => $dist | |
| ## ); | |
| ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental | |
| } else { | |
| $CPAN::META->instance( | |
| 'CPAN::Distribution' => $dist | |
| )->set( | |
| 'CPAN_USERID' => $userid, | |
| 'CPAN_COMMENT' => $comment, | |
| ); | |
| } | |
| if ($secondtime) { | |
| for my $name ($mod,$dist) { | |
| # $self->debug("exists name[$name]") if $CPAN::DEBUG; | |
| $exists{$name} = undef; | |
| } | |
| } | |
| $i++; | |
| while (($painted/76) < ($i/@lines)) { | |
| $CPAN::Frontend->myprint("."); | |
| $painted++; | |
| } | |
| return if $CPAN::Signal; | |
| } | |
| $CPAN::Frontend->myprint("DONE\n"); | |
| if ($secondtime) { | |
| for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) { | |
| for my $o ($CPAN::META->all_objects($class)) { | |
| next if exists $exists{$o->{ID}}; | |
| $CPAN::META->delete($class,$o->{ID}); | |
| # CPAN->debug("deleting ID[$o->{ID}] in class[$class]") | |
| # if $CPAN::DEBUG; | |
| } | |
| } | |
| } | |
| } | |
| #-> sub CPAN::Index::rd_modlist ; | |
| sub rd_modlist { | |
| my($cl,$index_target) = @_; | |
| return unless defined $index_target; | |
| return if CPAN::_sqlite_running(); | |
| $CPAN::Frontend->myprint("Reading '$index_target'\n"); | |
| my $fh = CPAN::Tarzip->TIEHANDLE($index_target); | |
| local $_; | |
| my $slurp = ""; | |
| my $chunk; | |
| while (my $bytes = $fh->READ(\$chunk,8192)) { | |
| $slurp.=$chunk; | |
| } | |
| my @eval2 = split /\012/, $slurp; | |
| while (@eval2) { | |
| my $shift = shift(@eval2); | |
| if ($shift =~ /^Date:\s+(.*)/) { | |
| if ($DATE_OF_03 eq $1) { | |
| $CPAN::Frontend->myprint("Unchanged.\n"); | |
| return; | |
| } | |
| ($DATE_OF_03) = $1; | |
| } | |
| last if $shift =~ /^\s*$/; | |
| } | |
| push @eval2, q{CPAN::Modulelist->data;}; | |
| local($^W) = 0; | |
| my($compmt) = Safe->new("CPAN::Safe1"); | |
| my($eval2) = join("\n", @eval2); | |
| CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG; | |
| my $ret = $compmt->reval($eval2); | |
| Carp::confess($@) if $@; | |
| return if $CPAN::Signal; | |
| my $i = 0; | |
| my $until = keys(%$ret); | |
| my $painted = 0; | |
| CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG; | |
| for (sort keys %$ret) { | |
| my $obj = $CPAN::META->instance("CPAN::Module",$_); | |
| delete $ret->{$_}{modid}; # not needed here, maybe elsewhere | |
| $obj->set(%{$ret->{$_}}); | |
| $i++; | |
| while (($painted/76) < ($i/$until)) { | |
| $CPAN::Frontend->myprint("."); | |
| $painted++; | |
| } | |
| return if $CPAN::Signal; | |
| } | |
| $CPAN::Frontend->myprint("DONE\n"); | |
| } | |
| #-> sub CPAN::Index::write_metadata_cache ; | |
| sub write_metadata_cache { | |
| my($self) = @_; | |
| return unless $CPAN::Config->{'cache_metadata'}; | |
| return if CPAN::_sqlite_running(); | |
| 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->{readonly}{$k}; # unsafe meta access, ok | |
| } | |
| my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata"); | |
| $cache->{last_time} = $LAST_TIME; | |
| $cache->{DATE_OF_02} = $DATE_OF_02; | |
| $cache->{PROTOCOL} = PROTOCOL; | |
| $CPAN::Frontend->myprint("Writing $metadata_file\n"); | |
| eval { Storable::nstore($cache, $metadata_file) }; | |
| $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ?? | |
| } | |
| #-> sub CPAN::Index::read_metadata_cache ; | |
| sub read_metadata_cache { | |
| my($self) = @_; | |
| return unless $CPAN::Config->{'cache_metadata'}; | |
| return if CPAN::_sqlite_running(); | |
| return unless $CPAN::META->has_usable("Storable"); | |
| my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata"); | |
| return unless -r $metadata_file and -f $metadata_file; | |
| $CPAN::Frontend->myprint("Reading '$metadata_file'\n"); | |
| my $cache; | |
| eval { $cache = Storable::retrieve($metadata_file) }; | |
| $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ?? | |
| if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) { | |
| $LAST_TIME = 0; | |
| return; | |
| } | |
| if (exists $cache->{PROTOCOL}) { | |
| if (PROTOCOL > $cache->{PROTOCOL}) { | |
| $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ". | |
| "with protocol v%s, requiring v%s\n", | |
| $cache->{PROTOCOL}, | |
| PROTOCOL) | |
| ); | |
| return; | |
| } | |
| } else { | |
| $CPAN::Frontend->mywarn("Ignoring Metadata cache written ". | |
| "with protocol v1.0\n"); | |
| return; | |
| } | |
| my $clcnt = 0; | |
| my $idcnt = 0; | |
| while(my($class,$v) = each %$cache) { | |
| next unless $class =~ /^CPAN::/; | |
| $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok | |
| while (my($id,$ro) = each %$v) { | |
| $CPAN::META->{readwrite}{$class}{$id} ||= | |
| $class->new(ID=>$id, RO=>$ro); | |
| $idcnt++; | |
| } | |
| $clcnt++; | |
| } | |
| unless ($clcnt) { # sanity check | |
| $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n"); | |
| return; | |
| } | |
| if ($idcnt < 1000) { | |
| $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ". | |
| "in $metadata_file\n"); | |
| return; | |
| } | |
| $CPAN::META->{PROTOCOL} ||= | |
| $cache->{PROTOCOL}; # reading does not up or downgrade, but it | |
| # does initialize to some protocol | |
| $LAST_TIME = $cache->{last_time}; | |
| $DATE_OF_02 = $cache->{DATE_OF_02}; | |
| $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n") | |
| if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02 | |
| return; | |
| } | |
| 1; | |