diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/Index.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/Index.pm | 123 |
1 files changed, 62 insertions, 61 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Index.pm b/Master/tlpkg/tlperl/lib/CPAN/Index.pm index c338cc7ec7b..8205d78bd02 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/Index.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/Index.pm @@ -1,11 +1,11 @@ package CPAN::Index; use strict; use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION); -$VERSION = "1.9600"; +$VERSION = "1.9601"; @CPAN::Index::ISA = qw(CPAN::Debug); $LAST_TIME ||= 0; $DATE_OF_03 ||= 0; -# use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57 +# use constant PROTOCOL => "2.0"; # commented out to avoid warning on upgrade from 1.57 sub PROTOCOL { 2.0 } #-> sub CPAN::Index::force_reload ; @@ -123,75 +123,76 @@ sub reanimate_build_dir { 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; - unless (@candidates) { - $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n"); - return; - } - $CPAN::Frontend->myprint - (sprintf("Reading %d yaml file%s from %s/\n", - scalar @candidates, - @candidates==1 ? "" : "s", - $CPAN::Config->{build_dir} - )); - my $start = CPAN::FTP::_mytime(); - 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; - } + 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; + #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++; } - $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", |