bin/analysis-oldsolutions-extinction-program.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--help|h!>
  24
  25 This help
  26
  27 =item B<--max=i>
  28
  29 Stop after how many
  30
  31 =item B<--minage=f>
  32
  33 Minimum age in days of the target directory
  34 (measured with C<-M>).
  35
  36 =back
  37
  38 =head1 DESCRIPTION
  39
  40 We scan the C<solved> directory for families of files for one vdistro.
  41 If there is no corresponding tarfile or directory in the reports
  42 collection area, we remove it.
  43
  44 The first run on 20171230 removed about 3.5 G.
  45
  46 =cut
  47
  48
  49 use FindBin;
  50 use lib "$FindBin::Bin/../CPAN-Blame/lib";
  51
  52 use Dumpvalue;
  53 use File::Basename qw(dirname);
  54 use File::Path qw(mkpath);
  55 use File::Spec;
  56 use File::Temp;
  57 use Getopt::Long;
  58 use Pod::Usage;
  59 use Hash::Util qw(lock_keys);
  60 use CPAN::Blame::Config::Cnntp;
  61
  62 our %Opt;
  63 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  64 GetOptions(\%Opt,
  65            @opt,
  66           ) or pod2usage(1);
  67 if ($Opt{help}) {
  68     pod2usage(0);
  69 }
  70 $Opt{minage} //= 1440;
  71
  72 my $root = $CPAN::Blame::Config::Cnntp::Config->{ctgetreports_dir} || die;
  73 my $workdir = $CPAN::Blame::Config::Cnntp::Config->{solver_vardir} || die;
  74 $workdir =~ s"$"/workdir/solved";
  75 opendir my $dh, $workdir or die;
  76 my(%seen, $i);
  77 DIRENT: for my $dirent (readdir $dh) {
  78     # CPAN-Mini-Indexed-0.01_01.1.slv.LCK, CPAN-Mini-Indexed-0.03_01.2.slv, CPAN-Mini-Indexed-0.03_01.2.slvdv.gz, CPAN-Mini-Indexed-0.03_01.2.yml
  79     my($stem) = $dirent =~ /(.+)(?:\.slv\.LCK|\.slv|\.slvdv.gz|\.yml)$/ or next;
  80     next if $seen{$stem}++;
  81     my $troot = sprintf "%s/%s/%s", $root, substr($stem,0,1), $stem;
  82     my @trcand = grep { -e $_ } glob("$troot\{,.tar}");
  83     # if (-e "$troot.tar") {
  84     if (@trcand) {
  85         my $trcand = scalar @trcand;
  86         # warn "  has $trcand tarballs or something: @trcand\n";
  87         next DIRENT;
  88     }
  89     my @cand = grep { -e $_ } glob("$workdir/$stem\{.slv.LCK,.slv,.slvdv.gz,.yml}");
  90     unless (@cand) {
  91         warn "Warning: no cand for $stem, skipping";
  92         next DIRENT;
  93     }
  94     if (map { /[\*\?]/ } @cand) {
  95         die "Illegal filename with glob character discovered: @cand";
  96     }
  97     # system "ls -l @cand";
  98     my @ages = sort { $a <=> $b } map { -M $_ } grep { !/\.slv\.LCK$/ } @cand;
  99     unless (@ages){
 100         @ages = sort { $a <=> $b } map { -M $_ } @cand;
 101     }
 102     if ($ages[0] < $Opt{minage}) {
 103         # warn "  is younger than $Opt{minage} days ($ages[0])\n";
 104         next DIRENT;
 105     }
 106     warn "$stem\n";
 107     warn "  about to unlink @cand\n";
 108     unlink @cand or die "Could not unlink: $!";
 109     system df => $root;
 110     last if $Opt{max} && ++$i >= $Opt{max};
 111 }
 112
 113 # Local Variables:
 114 # mode: cperl
 115 # cperl-indent-level: 4
 116 # End: