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