3 # This script's job is to clean up the version file and remove old
4 # versions when there are multiple versions older than the archive
10 use Debbugs::Config qw(:config);
11 use MLDBM qw(DB_File Storable);
14 $MLDBM::DumpMeth=q(portable);
17 tie %db, "MLDBM", "versions_time.idx.new",O_CREAT|O_RDWR, 0664
18 or die "tie versions_time.idx.new failed: $!";
21 for my $package (keys %db) {
22 my $temp = $db{$package};
23 for my $dist (keys %{$temp}) {
24 for my $arch (keys %{$temp->{$dist}}) {
25 my @versions = (sort {$temp->{$dist}{$arch}{$a} <=>
26 $temp->{$dist}{$arch}{$b}
28 keys %{$temp->{$dist}{$arch}});
29 next unless @versions > 1;
30 for my $i (0 .. ($#versions-1)) {
31 last if $temp->{$dist}{$arch}{$versions[$i+1]} > ($time - $config{remove_age}*60*60*24);
32 last if keys %{$temp->{$dist}{$arch}} <= 1;
33 delete $temp->{$dist}{$arch}{$versions[$i]};
37 $db{$package} = $temp;