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 && 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->tested_ok_but_not_installed) {
 181                 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
 182             }
 183             $restored++;
 184         }
 185         $i++;
 186         while (($painted/76) < ($i/@candidates)) {
 187             $CPAN::Frontend->myprint(".");
 188             $painted++;
 189         }
 190     }
 191     my $took = CPAN::FTP::_mytime() - $start;
 192     $CPAN::Frontend->myprint(sprintf(
 193                                      "DONE\nRestored the state of %s (in %.4f secs)\n",
 194                                      $restored || "none",
 195                                      $took,
 196                                     ));
 197 }
 198
 199
 200 #-> sub CPAN::Index::reload_x ;
 201 sub reload_x {
 202     my($cl,$wanted,$localname,$force) = @_;
 203     $force |= 2; # means we're dealing with an index here
 204     CPAN::HandleConfig->load; # we should guarantee loading wherever
 205                               # we rely on Config XXX
 206     $localname ||= $wanted;
 207     my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
 208                                          $localname);
 209     if (
 210         -f $abs_wanted &&
 211         -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
 212         !($force & 1)
 213        ) {
 214         my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
 215         $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
 216                    qq{day$s. I\'ll use that.});
 217         return $abs_wanted;
 218     } else {
 219         $force |= 1; # means we're quite serious about it.
 220     }
 221     return CPAN::FTP->localize($wanted,$abs_wanted,$force);
 222 }
 223
 224 #-> sub CPAN::Index::rd_authindex ;
 225 sub rd_authindex {
 226     my($cl, $index_target) = @_;
 227     return unless defined $index_target;
 228     return if CPAN::_sqlite_running();
 229     my @lines;
 230     $CPAN::Frontend->myprint("Going to read '$index_target'\n");
 231     local(*FH);
 232     tie *FH, 'CPAN::Tarzip', $index_target;
 233     local($/) = "\n";
 234     local($_);
 235     push @lines, split /\012/ while <FH>;
 236     my $i = 0;
 237     my $painted = 0;
 238     foreach (@lines) {
 239         my($userid,$fullname,$email) =
 240             m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
 241         $fullname ||= $email;
 242         if ($userid && $fullname && $email) {
 243             my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
 244             $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
 245         } else {
 246             CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
 247         }
 248         $i++;
 249         while (($painted/76) < ($i/@lines)) {
 250             $CPAN::Frontend->myprint(".");
 251             $painted++;
 252         }
 253         return if $CPAN::Signal;
 254     }
 255     $CPAN::Frontend->myprint("DONE\n");
 256 }
 257
 258 sub userid {
 259   my($self,$dist) = @_;
 260   $dist = $self->{'id'} unless defined $dist;
 261   my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
 262   $ret;
 263 }
 264
 265 #-> sub CPAN::Index::rd_modpacks ;
 266 sub rd_modpacks {
 267     my($self, $index_target) = @_;
 268     return unless defined $index_target;
 269     return if CPAN::_sqlite_running();
 270     $CPAN::Frontend->myprint("Going to read '$index_target'\n");
 271     my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
 272     local $_;
 273     CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
 274     my $slurp = "";
 275     my $chunk;
 276     while (my $bytes = $fh->READ(\$chunk,8192)) {
 277         $slurp.=$chunk;
 278     }
 279     my @lines = split /\012/, $slurp;
 280     CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
 281     undef $fh;
 282     # read header
 283     my($line_count,$last_updated);
 284     while (@lines) {
 285         my $shift = shift(@lines);
 286         last if $shift =~ /^\s*$/;
 287         $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
 288         $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
 289     }
 290     CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
 291     if (not defined $line_count) {
 292
 293         $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
 294 Please check the validity of the index file by comparing it to more
 295 than one CPAN mirror. I'll continue but problems seem likely to
 296 happen.\a
 297 });
 298
 299         $CPAN::Frontend->mysleep(5);
 300     } elsif ($line_count != scalar @lines) {
 301
 302         $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
 303 contains a Line-Count header of %d but I see %d lines there. Please
 304 check the validity of the index file by comparing it to more than one
 305 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
 306 $index_target, $line_count, scalar(@lines));
 307
 308     }
 309     if (not defined $last_updated) {
 310
 311         $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
 312 Please check the validity of the index file by comparing it to more
 313 than one CPAN mirror. I'll continue but problems seem likely to
 314 happen.\a
 315 });
 316
 317         $CPAN::Frontend->mysleep(5);
 318     } else {
 319
 320         $CPAN::Frontend
 321             ->myprint(sprintf qq{  Database was generated on %s\n},
 322                       $last_updated);
 323         $DATE_OF_02 = $last_updated;
 324
 325         my $age = time;
 326         if ($CPAN::META->has_inst('HTTP::Date')) {
 327             require HTTP::Date;
 328             $age -= HTTP::Date::str2time($last_updated);
 329         } else {
 330             $CPAN::Frontend->mywarn("  HTTP::Date not available\n");
 331             require Time::Local;
 332             my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
 333             $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
 334             $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
 335         }
 336         $age /= 3600*24;
 337         if ($age > 30) {
 338
 339             $CPAN::Frontend
 340                 ->mywarn(sprintf
 341                          qq{Warning: This index file is %d days old.
 342   Please check the host you chose as your CPAN mirror for staleness.
 343   I'll continue but problems seem likely to happen.\a\n},
 344                          $age);
 345
 346         } elsif ($age < -1) {
 347
 348             $CPAN::Frontend
 349                 ->mywarn(sprintf
 350                          qq{Warning: Your system date is %d days behind this index file!
 351   System time:          %s
 352   Timestamp index file: %s
 353   Please fix your system time, problems with the make command expected.\n},
 354                          -$age,
 355                          scalar gmtime,
 356                          $DATE_OF_02,
 357                         );
 358
 359         }
 360     }
 361
 362
 363     # A necessity since we have metadata_cache: delete what isn't
 364     # there anymore
 365     my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
 366     CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
 367     my(%exists);
 368     my $i = 0;
 369     my $painted = 0;
 370     foreach (@lines) {
 371         # before 1.56 we split into 3 and discarded the rest. From
 372         # 1.57 we assign remaining text to $comment thus allowing to
 373         # influence isa_perl
 374         my($mod,$version,$dist,$comment) = split " ", $_, 4;
 375         unless ($mod && defined $version && $dist) {
 376             $CPAN::Frontend->mywarn("Could not split line[$_]\n");
 377             next;
 378         }
 379         my($bundle,$id,$userid);
 380
 381         if ($mod eq 'CPAN' &&
 382             ! (
 383             CPAN::Queue->exists('Bundle::CPAN') ||
 384             CPAN::Queue->exists('CPAN')
 385             )
 386         ) {
 387             local($^W)= 0;
 388             if ($version > $CPAN::VERSION) {
 389                 $CPAN::Frontend->mywarn(qq{
 390   New CPAN.pm version (v$version) available.
 391   [Currently running version is v$CPAN::VERSION]
 392   You might want to try
 393     install CPAN
 394     reload cpan
 395   to both upgrade CPAN.pm and run the new version without leaving
 396   the current session.
 397
 398 }); #});
 399                 $CPAN::Frontend->mysleep(2);
 400                 $CPAN::Frontend->myprint(qq{\n});
 401             }
 402             last if $CPAN::Signal;
 403         } elsif ($mod =~ /^Bundle::(.*)/) {
 404             $bundle = $1;
 405         }
 406
 407         if ($bundle) {
 408             $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
 409             # Let's make it a module too, because bundles have so much
 410             # in common with modules.
 411
 412             # Changed in 1.57_63: seems like memory bloat now without
 413             # any value, so commented out
 414
 415             # $CPAN::META->instance('CPAN::Module',$mod);
 416
 417         } else {
 418
 419             # instantiate a module object
 420             $id = $CPAN::META->instance('CPAN::Module',$mod);
 421
 422         }
 423
 424         # Although CPAN prohibits same name with different version the
 425         # indexer may have changed the version for the same distro
 426         # since the last time ("Force Reindexing" feature)
 427         if ($id->cpan_file ne $dist
 428             ||
 429             $id->cpan_version ne $version
 430            ) {
 431             $userid = $id->userid || $self->userid($dist);
 432             $id->set(
 433                      'CPAN_USERID' => $userid,
 434                      'CPAN_VERSION' => $version,
 435                      'CPAN_FILE' => $dist,
 436                     );
 437         }
 438
 439         # instantiate a distribution object
 440         if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
 441         # we do not need CONTAINSMODS unless we do something with
 442         # this dist, so we better produce it on demand.
 443
 444         ## my $obj = $CPAN::META->instance(
 445         ##                                 'CPAN::Distribution' => $dist
 446         ##                                );
 447         ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
 448         } else {
 449             $CPAN::META->instance(
 450                                   'CPAN::Distribution' => $dist
 451                                  )->set(
 452                                         'CPAN_USERID' => $userid,
 453                                         'CPAN_COMMENT' => $comment,
 454                                        );
 455         }
 456         if ($secondtime) {
 457             for my $name ($mod,$dist) {
 458                 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
 459                 $exists{$name} = undef;
 460             }
 461         }
 462         $i++;
 463         while (($painted/76) < ($i/@lines)) {
 464             $CPAN::Frontend->myprint(".");
 465             $painted++;
 466         }
 467         return if $CPAN::Signal;
 468     }
 469     $CPAN::Frontend->myprint("DONE\n");
 470     if ($secondtime) {
 471         for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
 472             for my $o ($CPAN::META->all_objects($class)) {
 473                 next if exists $exists{$o->{ID}};
 474                 $CPAN::META->delete($class,$o->{ID});
 475                 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
 476                 #     if $CPAN::DEBUG;
 477             }
 478         }
 479     }
 480 }
 481
 482 #-> sub CPAN::Index::rd_modlist ;
 483 sub rd_modlist {
 484     my($cl,$index_target) = @_;
 485     return unless defined $index_target;
 486     return if CPAN::_sqlite_running();
 487     $CPAN::Frontend->myprint("Going to read '$index_target'\n");
 488     my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
 489     local $_;
 490     my $slurp = "";
 491     my $chunk;
 492     while (my $bytes = $fh->READ(\$chunk,8192)) {
 493         $slurp.=$chunk;
 494     }
 495     my @eval2 = split /\012/, $slurp;
 496
 497     while (@eval2) {
 498         my $shift = shift(@eval2);
 499         if ($shift =~ /^Date:\s+(.*)/) {
 500             if ($DATE_OF_03 eq $1) {
 501                 $CPAN::Frontend->myprint("Unchanged.\n");
 502                 return;
 503             }
 504             ($DATE_OF_03) = $1;
 505         }
 506         last if $shift =~ /^\s*$/;
 507     }
 508     push @eval2, q{CPAN::Modulelist->data;};
 509     local($^W) = 0;
 510     my($compmt) = Safe->new("CPAN::Safe1");
 511     my($eval2) = join("\n", @eval2);
 512     CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
 513     my $ret = $compmt->reval($eval2);
 514     Carp::confess($@) if $@;
 515     return if $CPAN::Signal;
 516     my $i = 0;
 517     my $until = keys(%$ret);
 518     my $painted = 0;
 519     CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
 520     for (keys %$ret) {
 521         my $obj = $CPAN::META->instance("CPAN::Module",$_);
 522         delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
 523         $obj->set(%{$ret->{$_}});
 524         $i++;
 525         while (($painted/76) < ($i/$until)) {
 526             $CPAN::Frontend->myprint(".");
 527             $painted++;
 528         }
 529         return if $CPAN::Signal;
 530     }
 531     $CPAN::Frontend->myprint("DONE\n");
 532 }
 533
 534 #-> sub CPAN::Index::write_metadata_cache ;
 535 sub write_metadata_cache {
 536     my($self) = @_;
 537     return unless $CPAN::Config->{'cache_metadata'};
 538     return if CPAN::_sqlite_running();
 539     return unless $CPAN::META->has_usable("Storable");
 540     my $cache;
 541     foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
 542                       CPAN::Distribution)) {
 543         $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
 544     }
 545     my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
 546     $cache->{last_time} = $LAST_TIME;
 547     $cache->{DATE_OF_02} = $DATE_OF_02;
 548     $cache->{PROTOCOL} = PROTOCOL;
 549     $CPAN::Frontend->myprint("Going to write $metadata_file\n");
 550     eval { Storable::nstore($cache, $metadata_file) };
 551     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
 552 }
 553
 554 #-> sub CPAN::Index::read_metadata_cache ;
 555 sub read_metadata_cache {
 556     my($self) = @_;
 557     return unless $CPAN::Config->{'cache_metadata'};
 558     return if CPAN::_sqlite_running();
 559     return unless $CPAN::META->has_usable("Storable");
 560     my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
 561     return unless -r $metadata_file and -f $metadata_file;
 562     $CPAN::Frontend->myprint("Going to read '$metadata_file'\n");
 563     my $cache;
 564     eval { $cache = Storable::retrieve($metadata_file) };
 565     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
 566     if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
 567         $LAST_TIME = 0;
 568         return;
 569     }
 570     if (exists $cache->{PROTOCOL}) {
 571         if (PROTOCOL > $cache->{PROTOCOL}) {
 572             $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
 573                                             "with protocol v%s, requiring v%s\n",
 574                                             $cache->{PROTOCOL},
 575                                             PROTOCOL)
 576                                    );
 577             return;
 578         }
 579     } else {
 580         $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
 581                                 "with protocol v1.0\n");
 582         return;
 583     }
 584     my $clcnt = 0;
 585     my $idcnt = 0;
 586     while(my($class,$v) = each %$cache) {
 587         next unless $class =~ /^CPAN::/;
 588         $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
 589         while (my($id,$ro) = each %$v) {
 590             $CPAN::META->{readwrite}{$class}{$id} ||=
 591                 $class->new(ID=>$id, RO=>$ro);
 592             $idcnt++;
 593         }
 594         $clcnt++;
 595     }
 596     unless ($clcnt) { # sanity check
 597         $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
 598         return;
 599     }
 600     if ($idcnt < 1000) {
 601         $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
 602                                  "in $metadata_file\n");
 603         return;
 604     }
 605     $CPAN::META->{PROTOCOL} ||=
 606         $cache->{PROTOCOL}; # reading does not up or downgrade, but it
 607                             # does initialize to some protocol
 608     $LAST_TIME = $cache->{last_time};
 609     $DATE_OF_02 = $cache->{DATE_OF_02};
 610     $CPAN::Frontend->myprint("  Database was generated on $DATE_OF_02\n")
 611         if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
 612     return;
 613 }
 614
 615 1;