bin/cnntp-cleanup-reports.pl

   1 #!/usr/bin/perl
   2
   3 use Sys::Hostname;
   4 die "not yet ported to ds8143" if hostname eq "ds8143";
   5
   6 # use 5.010;
   7 use strict;
   8 use warnings;
   9
  10 =head1 NAME
  11
  12
  13
  14 =head1 SYNOPSIS
  15
  16
  17
  18 =head1 OPTIONS
  19
  20 =over 8
  21
  22 =cut
  23
  24 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  25
  26 =item B<--dir=s>
  27
  28 defaults to C</home/ftp/cpantesters/reports>
  29
  30 =item B<--help|h!>
  31
  32 This help
  33
  34 =item B<--interactive|i!>
  35
  36 Defaults to true. If set to false (--nointeractive or --noi), you can
  37 remove hundreds of thousands of file without being asked a single
  38 question.
  39
  40 =item B<--numversions=i>
  41
  42 Defaults to 2 which means look at the two most recent versions for
  43 whatever we're doing. Everything older is discarded considered
  44 outdated.
  45
  46 =back
  47
  48 =head1 DESCRIPTION
  49
  50 Walk through all distro-directories we have and remove outdated ones.
  51
  52 Born as a copy of smokehistory.pl
  53
  54 =cut
  55
  56
  57 use FindBin;
  58 use lib "$FindBin::Bin/../lib";
  59 BEGIN {
  60     push @INC, qw(       );
  61 }
  62
  63 use Dumpvalue;
  64 use File::Basename qw(dirname);
  65 use File::Path qw(mkpath rmtree);
  66 use File::Spec;
  67 use File::Temp;
  68 use Getopt::Long;
  69 use Hash::Util qw(lock_keys);
  70 use List::MoreUtils qw(uniq);
  71 use List::Util qw(first);
  72 use Term::Prompt qw(prompt);
  73 use Text::Format;
  74 use YAML::Syck;
  75 use version;
  76
  77 our %Opt;
  78 lock_keys %Opt, map { /([^=!\|]+)/ } @opt;
  79 GetOptions(\%Opt,
  80            @opt,
  81           ) or pod2usage(1);
  82 $Opt{dir} ||= "/home/ftp/cpantesters/reports";
  83 $Opt{interactive} = 1 unless defined $Opt{interactive};
  84 $Opt{numversions} ||= 2;
  85
  86 opendir my $dh, $Opt{dir} or die;
  87 my %S; # for the summary at the end
  88 my $tf = Text::Format->new(firstIndent=>0);
  89 $|=1;
  90 LETTERDIR: for my $dirent (sort readdir $dh) { # A B C
  91     next unless $dirent =~ /^[A-Za-z]$/;
  92     opendir my $dh2, "$Opt{dir}/$dirent" or die;
  93     my %vdistro;
  94  DISTRO: for my $dirent2 (readdir $dh2) { # Dpchrist-ExtUtils-MakeMaker-1.015
  95         next if $dirent2 =~ /^\.\.?$/;
  96         my $vdistro = $dirent2;
  97         my($distro,$version,$mod) = $vdistro =~ /(\S+)-(v?\d+(?:[\.\d]*[^-]*))(-(?:TRIAL|withoutworldwriteables|fix))?$/;
  98         unless (defined $version) {
  99             # Angel102
 100             ($distro,$version) = $vdistro =~ /(\D+)(\d+)/;
 101         }
 102         unless (defined $version){
 103             die "could not parse version from $vdistro";
 104         }
 105         $version=~s/[^\d\.]+$//;
 106         1 while $version=~s/([\d\.])[^\d\.]+.*/$1/;
 107         $version=~s/\.$//;
 108         # print "DEBUG: parse version[$version] of distro[$distro](vdistro[$vdistro])\n";
 109         my $numversion = eval {version->new($version)->numify};
 110         if (not defined $numversion) {
 111             die "ERROR: Could not parse version[$version] of distro[$distro](vdistro[$vdistro]): $@";
 112         } elsif ($@) {
 113             die "Panic: we have a \$\@[$@] but a numversion[$numversion] too";
 114         }
 115         $vdistro{$distro}{$numversion} = $vdistro;
 116     }
 117     for my $distro (keys %vdistro) {
 118         my $v = $vdistro{$distro};
 119         my @vdistros_sorted_by_version = sort { $a <=> $b } keys %$v;
 120         while (@vdistros_sorted_by_version > $Opt{numversions}) {
 121             my $cldir = $v->{$vdistros_sorted_by_version[0]};
 122             my $absdir = "$Opt{dir}/$dirent/$cldir";
 123             opendir my $dh3, "$absdir/nntp-testers" or die "Could not open '$absdir/nntp-testers': $!";
 124             my @cldirent = grep { /\.gz$/ } readdir $dh3;
 125             my $report = sprintf
 126                     ("==> Having reports from
 127  %d versions of
 128  %s in directory
 129  %s (%s). The oldest of those,
 130  %s, has
 131  %d reports\n\n",
 132                      scalar @vdistros_sorted_by_version,
 133                      $distro,
 134                      $cldir, join(",",@vdistros_sorted_by_version),
 135                      $vdistros_sorted_by_version[0],
 136                      scalar @cldirent,
 137                     );
 138             print $tf->format($report);
 139             my $answer;
 140             if ($Opt{interactive}) {
 141                 $answer = lc prompt "x", "Shall I delete '$absdir'? (y/n/q)", "", "y";
 142             } else {
 143                 $answer = 'y';
 144             }
 145             if ($answer eq "q") {
 146                 last LETTERDIR;
 147             } elsif ($answer eq "n") {
 148             } elsif ($answer eq "y") {
 149                 rmtree $absdir;
 150                 if ($Opt{interactive}) {
 151                     warn sprintf "Deleted %d reports.\n", scalar @cldirent;
 152                 }
 153             }
 154             shift @vdistros_sorted_by_version;
 155         }
 156     }
 157 }
 158 warn YAML::Syck::Dump \%S;
 159
 160 # Local Variables:
 161 # mode: cperl
 162 # cperl-indent-level: 4
 163 # End: