view release on metacpan or  search on metacpan

lib/CPAN/Index.pm  view on Meta::CPAN

#-> 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), {loadblessed => 1})};
            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();