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
  41
  42 =cut
  43
  44
  45 use FindBin;
  46 use lib "$FindBin::Bin/../CPAN-Blame/lib";
  47
  48 use Dumpvalue;
  49 use File::Basename qw(dirname);
  50 use File::Path qw(mkpath);
  51 use File::Spec;
  52 use File::Temp;
  53 use Getopt::Long;
  54 use Pod::Usage;
  55 use Hash::Util qw(lock_keys);
  56 use CPAN::Blame::Config::Cnntp;
  57
  58 our %Opt;
  59 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  60 GetOptions(\%Opt,
  61            @opt,
  62           ) or pod2usage(1);
  63 if ($Opt{help}) {
  64     pod2usage(0);
  65 }
  66 $Opt{minage} //= 1440;
  67
  68 my $root = $CPAN::Blame::Config::Cnntp::Config->{ctgetreports_dir} || die;
  69 my $workdir = $CPAN::Blame::Config::Cnntp::Config->{solver_vardir} || die;
  70 $workdir =~ s"$"/workdir/solved";
  71 opendir my $dh, $workdir or die;
  72 my(%seen, $i);
  73 DIRENT: for my $dirent (readdir $dh) {
  74     # 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
  75     my($stem) = $dirent =~ /(.+)(?:\.slv\.LCK|\.slv|\.slvdv.gz|\.yml)$/ or next;
  76     next if $seen{$stem}++;
  77     my $troot = sprintf "%s/%s/%s", $root, substr($stem,0,1), $stem;
  78     my @trcand = grep { -e $_ } glob("$troot\{,.tar}");
  79     # if (-e "$troot.tar") {
  80     if (@trcand) {
  81         my $trcand = scalar @trcand;
  82         # warn "  has $trcand tarballs or something: @trcand\n";
  83         next DIRENT;
  84     }
  85     warn "$stem\n";
  86     my @cand = grep { -e $_ } glob("$workdir/$stem\{.slv.LCK,.slv,.slvdv.gz,.yml}");
  87     if (map { /[\*\?]/ } @cand) {
  88         die "Illegal filename with glob character discovered: @cand";
  89     }
  90     system "ls -l @cand";
  91     my @ages = sort { $a <=> $b } map { -M $_ } @cand;
  92     if ($ages[0] < $Opt{minage}) {
  93         warn "  is younger than $Opt{minage} days ($ages[0])\n";
  94         next DIRENT;
  95     }
  96     warn "  about to unlink @cand\n";
  97     unlink @cand or die "Could not unlink: $!";
  98     system df => $root;
  99     last if $Opt{max} && ++$i >= $Opt{max};
 100 }
 101
 102 # Local Variables:
 103 # mode: cperl
 104 # cperl-indent-level: 4
 105 # End: