lib/CPAN/Index.pm

   1 package CPAN::Index;
   2 use strict;
   3 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION);
   4 $VERSION = "1.93";
   5 @CPAN::Index::ISA = qw(CPAN::Debug);
   6 $LAST_TIME ||= 0;
   7 $DATE_OF_03 ||= 0;
   8 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
   9 sub PROTOCOL { 2.0 }
  10
  11 #-> sub CPAN::Index::force_reload ;
  12 sub force_reload {
  13     my($class) = @_;
  14     $CPAN::Index::LAST_TIME = 0;
  15     $class->reload(1);
  16 }
  17
  18 my @indexbundle =
  19     (
  20      {
  21       reader => "rd_authindex",
  22       dir => "authors",
  23       remotefile => '01mailrc.txt.gz',
  24       shortlocalfile => '01mailrc.gz',
  25      },
  26      {
  27       reader => "rd_modpacks",
  28       dir => "modules",
  29       remotefile => '02packages.details.txt.gz',
  30       shortlocalfile => '02packag.gz',
  31      },
  32      {
  33       reader => "rd_modlist",
  34       dir => "modules",
  35       remotefile => '03modlist.data.gz',
  36       shortlocalfile => '03mlist.gz',
  37      },
  38     );
  39
  40 #-> sub CPAN::Index::reload ;
  41 sub reload {
  42     my($self,$force) = @_;
  43     my $time = time;
  44
  45     # XXX check if a newer one is available. (We currently read it
  46     # from time to time)
  47     for ($CPAN::Config->{index_expire}) {
  48         $_ = 0.001 unless $_ && $_ > 0.001;
  49     }
  50     unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
  51         # debug here when CPAN doesn't seem to read the Metadata
  52         require Carp;
  53         Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
  54     }
  55     unless ($CPAN::META->{PROTOCOL}) {
  56         $self->read_metadata_cache;
  57         $CPAN::META->{PROTOCOL} ||= "1.0";
  58     }
  59     if ( $CPAN::META->{PROTOCOL} < PROTOCOL  ) {
  60         # warn "Setting last_time to 0";
  61         $LAST_TIME = 0; # No warning necessary
  62     }
  63     if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
  64         and ! $force) {
  65         # called too often
  66         # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
  67     } elsif (0) {
  68         # IFF we are developing, it helps to wipe out the memory
  69         # between reloads, otherwise it is not what a user expects.
  70         undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
  71         $CPAN::META = CPAN->new;
  72     } else {
  73         my($debug,$t2);
  74         local $LAST_TIME = $time;
  75         local $CPAN::META->{PROTOCOL} = PROTOCOL;
  76
  77         my $needshort = $^O eq "dos";
  78
  79     INX: for my $indexbundle (@indexbundle) {
  80             my $reader = $indexbundle->{reader};
  81             my $localfile = $needshort ? $indexbundle->{shortlocalfile} : $indexbundle->{remotefile};
  82             my $localpath = File::Spec->catfile($indexbundle->{dir}, $localfile);
  83             my $remote = join "/", $indexbundle->{dir}, $indexbundle->{remotefile};
  84             my $localized = $self->reload_x($remote, $localpath, $force);
  85             $self->$reader($localized); # may die but we let the shell catch it
  86             if ($CPAN::DEBUG){
  87                 $t2 = time;
  88                 $debug = "timing reading 01[".($t2 - $time)."]";
  89                 $time = $t2;
  90             }
  91             return if $CPAN::Signal; # this is sometimes lengthy
  92         }
  93         $self->write_metadata_cache;
  94         if ($CPAN::DEBUG){
  95             $t2 = time;
  96             $debug .= "03[".($t2 - $time)."]";
  97             $time = $t2;
  98         }
  99         CPAN->debug($debug) if $CPAN::DEBUG;
 100     }
 101     if ($CPAN::Config->{build_dir_reuse}) {
 102         $self->reanimate_build_dir;
 103     }
 104     if (CPAN::_sqlite_running()) {
 105         $CPAN::SQLite->reload(time => $time, force => $force)
 106             if not $LAST_TIME;
 107     }
 108     $LAST_TIME = $time;
 109     $CPAN::META->{PROTOCOL} = PROTOCOL;
 110 }
 111
 112 #-> sub CPAN::Index::reanimate_build_dir ;
 113 sub reanimate_build_dir {
 114     my($self) = @_;
 115     unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
 116         return;
 117     }
 118     return if $HAVE_REANIMATED++;
 119     my $d = $CPAN::Config->{build_dir};
 120     my $dh = DirHandle->new;
 121     opendir $dh, $d or return; # does not exist
 122     my $dirent;
 123     my $i = 0;
 124     my $painted = 0;
 125     my $restored = 0;
 126     my @candidates = map { $_->[0] }
 127         sort { $b->[1] <=> $a->[1] }
 128             map { [ $_, -M File::Spec->catfile($d,$_) ] }
 129                 grep {/\.yml$/} readdir $dh;
 130     unless (@candidates) {
 131         $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n");
 132         return;
 133     }
 134     $CPAN::Frontend->myprint
 135         (sprintf("Going to read %d yaml file%s from %s/\n",
 136                  scalar @candidates,
 137                  @candidates==1 ? "" : "s",
 138                  $CPAN::Config->{build_dir}
 139                 ));
 140     my $start = CPAN::FTP::_mytime();
 141   DISTRO: for $i (0..$#candidates) {
 142         my $dirent = $candidates[$i];
 143         my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
 144         if ($@) {
 145             warn "Error while parsing file '$dirent'; error: '$@'";
 146             next DISTRO;
 147         }
 148         my $c = $y->[0];
 149         if ($c && $c->{perl} && $c->{distribution} && CPAN->_perl_fingerprint($c->{perl})) {
 150             my $key = $c->{distribution}{ID};
 151             for my $k (keys %{$c->{distribution}}) {
 152                 if ($c->{distribution}{$k}
 153                     && ref $c->{distribution}{$k}
 154                     && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
 155                     $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
 156                 }
 157             }
 158
 159             #we tried to restore only if element already
 160             #exists; but then we do not work with metadata
 161             #turned off.
 162             my $do
 163                 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
 164                     = $c->{distribution};
 165             for my $skipper (qw(
 166                                 badtestcnt
 167                                 configure_requires_later
 168                                 configure_requires_later_for
 169                                 force_update
 170                                 later
 171                                 later_for
 172                                 notest
 173                                 should_report
 174                                 sponsored_mods
 175                                 prefs
 176                                 negative_prefs_cache
 177                                )) {
 178                 delete $do->{$skipper};
 179             }
 180             if ($do->can("tested_ok_but_not_installed")) {
 181                 if ($do->tested_ok_but_not_installed) {
 182                     $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
 183                 } else {
 184                     next DISTRO;
 185                 }
 186             }
 187             $restored++;
 188         }
 189         $i++;
 190         while (($painted/76) < ($i/@candidates)) {
 191             $CPAN::Frontend->myprint(".");
 192             $painted++;
 193         }
 194     }
 195     my $took = CPAN::FTP::_mytime() - $start;
 196     $CPAN::Frontend->myprint(sprintf(
 197                                      "DONE\nRestored the state of %s (in %.4f secs)\n",
 198                                      $restored || "none",
 199                                      $took,
 200                                     ));
 201 }
 202
 203
 204 #-> sub CPAN::Index::reload_x ;
 205 sub reload_x {
 206     my($cl,$wanted,$localname,$force) = @_;
 207     $force |= 2; # means we're dealing with an index here
 208     CPAN::HandleConfig->load; # we should guarantee loading wherever
 209                               # we rely on Config XXX
 210     $localname ||= $wanted;
 211     my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
 212                                          $localname);
 213     if (
 214         -f $abs_wanted &&
 215         -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
 216         !($force & 1)
 217        ) {
 218         my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
 219         $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
 220                    qq{day$s. I\'ll use that.});
 221         return $abs_wanted;
 222     } else {
 223         $force |= 1; # means we're quite serious about it.
 224     }
 225     return CPAN::FTP->localize($wanted,$abs_wanted,$force);
 226 }
 227
 228 #-> sub CPAN::Index::rd_authindex ;
 229 sub rd_authindex {
 230     my($cl, $index_target) = @_;
 231     return unless defined $index_target;
 232     return if CPAN::_sqlite_running();
 233     my @lines;
 234     $CPAN::Frontend->myprint("Going to read '$index_target'\n");
 235     local(*FH);
 236     tie *FH, 'CPAN::Tarzip', $index_target;
 237     local($/) = "\n";
 238     local($_);
 239     push @lines, split /\012/ while <FH>;
 240     my $i = 0;
 241     my $painted = 0;
 242     foreach (@lines) {
 243         my($userid,$fullname,$email) =
 244             m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
 245         $fullname ||= $email;
 246         if ($userid && $fullname && $email) {
 247             my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
 248             $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
 249         } else {
 250             CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
 251         }
 252         $i++;
 253         while (($painted/76) < ($i/@lines)) {
 254             $CPAN::Frontend->myprint(".");
 255             $painted++;
 256         }
 257         return if $CPAN::Signal;
 258     }
 259     $CPAN::Frontend->myprint("DONE\n");
 260 }
 261
 262 sub userid {
 263   my($self,$dist) = @_;
 264   $dist = $self->{'id'} unless defined $dist;
 265   my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
 266   $ret;
 267 }
 268
 269 #-> sub CPAN::Index::rd_modpacks ;
 270 sub rd_modpacks {
 271     my($self, $index_target) = @_;
 272     return unless defined $index_target;
 273     return if CPAN::_sqlite_running();
 274     $CPAN::Frontend->myprint("Going to read '$index_target'\n");
 275     my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
 276     local $_;
 277     CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
 278     my $slurp = "";
 279     my $chunk;
 280     while (my $bytes = $fh->READ(\$chunk,8192)) {
 281         $slurp.=$chunk;
 282     }
 283     my @lines = split /\012/, $slurp;
 284     CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
 285     undef $fh;
 286     # read header
 287     my($line_count,$last_updated);
 288     while (@lines) {
 289         my $shift = shift(@lines);
 290         last if $shift =~ /^\s*$/;
 291         $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
 292         $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
 293     }
 294     CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
 295     if (not defined $line_count) {
 296
 297         $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
 298 Please check the validity of the index file by comparing it to more
 299 than one CPAN mirror. I'll continue but problems seem likely to
 300 happen.\a
 301 });
 302
 303         $CPAN::Frontend->mysleep(5);
 304     } elsif ($line_count != scalar @lines) {
 305
 306         $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
 307 contains a Line-Count header of %d but I see %d lines there. Please
 308 check the validity of the index file by comparing it to more than one
 309 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
 310 $index_target, $line_count, scalar(@lines));
 311
 312     }
 313     if (not defined $last_updated) {
 314
 315         $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
 316 Please check the validity of the index file by comparing it to more
 317 than one CPAN mirror. I'll continue but problems seem likely to
 318 happen.\a
 319 });
 320
 321         $CPAN::Frontend->mysleep(5);
 322     } else {
 323
 324         $CPAN::Frontend
 325             ->myprint(sprintf qq{  Database was generated on %s\n},
 326                       $last_updated);
 327         $DATE_OF_02 = $last_updated;
 328
 329         my $age = time;
 330         if ($CPAN::META->has_inst('HTTP::Date')) {
 331             require HTTP::Date;
 332             $age -= HTTP::Date::str2time($last_updated);
 333         } else {
 334             $CPAN::Frontend->mywarn("  HTTP::Date not available\n");
 335             require Time::Local;
 336             my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
 337             $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
 338             $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
 339         }
 340         $age /= 3600*24;
 341         if ($age > 30) {
 342
 343             $CPAN::Frontend
 344                 ->mywarn(sprintf
 345                          qq{Warning: This index file is %d days old.
 346   Please check the host you chose as your CPAN mirror for staleness.
 347   I'll continue but problems seem likely to happen.\a\n},
 348                          $age);
 349
 350         } elsif ($age < -1) {
 351
 352             $CPAN::Frontend
 353                 ->mywarn(sprintf
 354                          qq{Warning: Your system date is %d days behind this index file!
 355   System time:          %s
 356   Timestamp index file: %s
 357   Please fix your system time, problems with the make command expected.\n},
 358                          -$age,
 359                          scalar gmtime,
 360                          $DATE_OF_02,
 361                         );
 362
 363         }
 364     }
 365
 366
 367     # A necessity since we have metadata_cache: delete what isn't
 368     # there anymore
 369     my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
 370     CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
 371     my(%exists);
 372     my $i = 0;
 373     my $painted = 0;
 374     foreach (@lines) {
 375         # before 1.56 we split into 3 and discarded the rest. From
 376         # 1.57 we assign remaining text to $comment thus allowing to
 377         # influence isa_perl
 378         my($mod,$version,$dist,$comment) = split " ", $_, 4;
 379         unless ($mod && defined $version && $dist) {
 380             $CPAN::Frontend->mywarn("Could not split line[$_]\n");
 381             next;
 382         }
 383         my($bundle,$id,$userid);
 384
 385         if ($mod eq 'CPAN' &&
 386             ! (
 387             CPAN::Queue->exists('Bundle::CPAN') ||
 388             CPAN::Queue->exists('CPAN')
 389             )
 390         ) {
 391             local($^W)= 0;
 392             if ($version > $CPAN::VERSION) {
 393                 $CPAN::Frontend->mywarn(qq{
 394   New CPAN.pm version (v$version) available.
 395   [Currently running version is v$CPAN::VERSION]
 396   You might want to try
 397     install CPAN
 398     reload cpan
 399   to both upgrade CPAN.pm and run the new version without leaving
 400   the current session.
 401
 402 }); #});
 403                 $CPAN::Frontend->mysleep(2);
 404                 $CPAN::Frontend->myprint(qq{\n});
 405             }
 406             last if $CPAN::Signal;
 407         } elsif ($mod =~ /^Bundle::(.*)/) {
 408             $bundle = $1;
 409         }
 410
 411         if ($bundle) {
 412             $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
 413             # Let's make it a module too, because bundles have so much
 414             # in common with modules.
 415
 416             # Changed in 1.57_63: seems like memory bloat now without
 417             # any value, so commented out
 418
 419             # $CPAN::META->instance('CPAN::Module',$mod);
 420
 421         } else {
 422
 423             # instantiate a module object
 424             $id = $CPAN::META->instance('CPAN::Module',$mod);
 425
 426         }
 427
 428         # Although CPAN prohibits same name with different version the
 429         # indexer may have changed the version for the same distro
 430         # since the last time ("Force Reindexing" feature)
 431         if ($id->cpan_file ne $dist
 432             ||
 433             $id->cpan_version ne $version
 434            ) {
 435             $userid = $id->userid || $self->userid($dist);
 436             $id->set(
 437                      'CPAN_USERID' => $userid,
 438                      'CPAN_VERSION' => $version,
 439                      'CPAN_FILE' => $dist,
 440                     );
 441         }
 442
 443         # instantiate a distribution object
 444         if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
 445         # we do not need CONTAINSMODS unless we do something with
 446         # this dist, so we better produce it on demand.
 447
 448         ## my $obj = $CPAN::META->instance(
 449         ##                                 'CPAN::Distribution' => $dist
 450         ##                                );
 451         ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
 452         } else {
 453             $CPAN::META->instance(
 454                                   'CPAN::Distribution' => $dist
 455                                  )->set(
 456                                         'CPAN_USERID' => $userid,
 457                                         'CPAN_COMMENT' => $comment,
 458                                        );
 459         }
 460         if ($secondtime) {
 461             for my $name ($mod,$dist) {
 462                 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
 463                 $exists{$name} = undef;
 464             }
 465         }
 466         $i++;
 467         while (($painted/76) < ($i/@lines)) {
 468             $CPAN::Frontend->myprint(".");
 469             $painted++;
 470         }
 471         return if $CPAN::Signal;
 472     }
 473     $CPAN::Frontend->myprint("DONE\n");
 474     if ($secondtime) {
 475         for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
 476             for my $o ($CPAN::META->all_objects($class)) {
 477                 next if exists $exists{$o->{ID}};
 478                 $CPAN::META->delete($class,$o->{ID});
 479                 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
 480                 #     if $CPAN::DEBUG;
 481             }
 482         }
 483     }
 484 }
 485
 486 #-> sub CPAN::Index::rd_modlist ;
 487 sub rd_modlist {
 488     my($cl,$index_target) = @_;
 489     return unless defined $index_target;
 490     return if CPAN::_sqlite_running();
 491     $CPAN::Frontend->myprint("Going to read '$index_target'\n");
 492     my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
 493     local $_;
 494     my $slurp = "";
 495     my $chunk;
 496     while (my $bytes = $fh->READ(\$chunk,8192)) {
 497         $slurp.=$chunk;
 498     }
 499     my @eval2 = split /\012/, $slurp;
 500
 501     while (@eval2) {
 502         my $shift = shift(@eval2);
 503         if ($shift =~ /^Date:\s+(.*)/) {
 504             if ($DATE_OF_03 eq $1) {
 505                 $CPAN::Frontend->myprint("Unchanged.\n");
 506                 return;
 507             }
 508             ($DATE_OF_03) = $1;
 509         }
 510         last if $shift =~ /^\s*$/;
 511     }
 512     push @eval2, q{CPAN::Modulelist->data;};
 513     local($^W) = 0;
 514     my($compmt) = Safe->new("CPAN::Safe1");
 515     my($eval2) = join("\n", @eval2);
 516     CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
 517     my $ret = $compmt->reval($eval2);
 518     Carp::confess($@) if $@;
 519     return if $CPAN::Signal;
 520     my $i = 0;
 521     my $until = keys(%$ret);
 522     my $painted = 0;
 523     CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
 524     for (keys %$ret) {
 525         my $obj = $CPAN::META->instance("CPAN::Module",$_);
 526         delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
 527         $obj->set(%{$ret->{$_}});
 528         $i++;
 529         while (($painted/76) < ($i/$until)) {
 530             $CPAN::Frontend->myprint(".");
 531             $painted++;
 532         }
 533         return if $CPAN::Signal;
 534     }
 535     $CPAN::Frontend->myprint("DONE\n");
 536 }
 537
 538 #-> sub CPAN::Index::write_metadata_cache ;
 539 sub write_metadata_cache {
 540     my($self) = @_;
 541     return unless $CPAN::Config->{'cache_metadata'};
 542     return if CPAN::_sqlite_running();
 543     return unless $CPAN::META->has_usable("Storable");
 544     my $cache;
 545     foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
 546                       CPAN::Distribution)) {
 547         $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
 548     }
 549     my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
 550     $cache->{last_time} = $LAST_TIME;
 551     $cache->{DATE_OF_02} = $DATE_OF_02;
 552     $cache->{PROTOCOL} = PROTOCOL;
 553     $CPAN::Frontend->myprint("Going to write $metadata_file\n");
 554     eval { Storable::nstore($cache, $metadata_file) };
 555     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
 556 }
 557
 558 #-> sub CPAN::Index::read_metadata_cache ;
 559 sub read_metadata_cache {
 560     my($self) = @_;
 561     return unless $CPAN::Config->{'cache_metadata'};
 562     return if CPAN::_sqlite_running();
 563     return unless $CPAN::META->has_usable("Storable");
 564     my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
 565     return unless -r $metadata_file and -f $metadata_file;
 566     $CPAN::Frontend->myprint("Going to read '$metadata_file'\n");
 567     my $cache;
 568     eval { $cache = Storable::retrieve($metadata_file) };
 569     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
 570     if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
 571         $LAST_TIME = 0;
 572         return;
 573     }
 574     if (exists $cache->{PROTOCOL}) {
 575         if (PROTOCOL > $cache->{PROTOCOL}) {
 576             $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
 577                                             "with protocol v%s, requiring v%s\n",
 578                                             $cache->{PROTOCOL},
 579                                             PROTOCOL)
 580                                    );
 581             return;
 582         }
 583     } else {
 584         $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
 585                                 "with protocol v1.0\n");
 586         return;
 587     }
 588     my $clcnt = 0;
 589     my $idcnt = 0;
 590     while(my($class,$v) = each %$cache) {
 591         next unless $class =~ /^CPAN::/;
 592         $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
 593         while (my($id,$ro) = each %$v) {
 594             $CPAN::META->{readwrite}{$class}{$id} ||=
 595                 $class->new(ID=>$id, RO=>$ro);
 596             $idcnt++;
 597         }
 598         $clcnt++;
 599     }
 600     unless ($clcnt) { # sanity check
 601         $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
 602         return;
 603     }
 604     if ($idcnt < 1000) {
 605         $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
 606                                  "in $metadata_file\n");
 607         return;
 608     }
 609     $CPAN::META->{PROTOCOL} ||=
 610         $cache->{PROTOCOL}; # reading does not up or downgrade, but it
 611                             # does initialize to some protocol
 612     $LAST_TIME = $cache->{last_time};
 613     $DATE_OF_02 = $cache->{DATE_OF_02};
 614     $CPAN::Frontend->myprint("  Database was generated on $DATE_OF_02\n")
 615         if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
 616     return;
 617 }
 618
 619 1;