bin/cleanup-error-downloads.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<--help|h!>
  27
  28 This help
  29
  30 =back
  31
  32 =head1 DESCRIPTION
  33
  34 Quick and dirty: we have plenty of files containing
  35
  36     <h1 class="pagetitle">Error</h1>
  37
  38 and/or
  39
  40     <title>CPAN Testers Reports: Error</title>
  41
  42 and/or
  43
  44     <h2>Error</h2>
  45
  46 They all simply get removed together with their headers files.
  47
  48 =cut
  49
  50
  51 use FindBin;
  52 use lib "$FindBin::Bin/../lib";
  53 BEGIN {
  54     push @INC, qw(       );
  55 }
  56
  57 use Dumpvalue;
  58 use File::Basename qw(dirname);
  59 use File::Path qw(mkpath);
  60 use File::Spec;
  61 use File::Temp;
  62 use Getopt::Long;
  63 use Hash::Util qw(lock_keys);
  64
  65 our %Opt;
  66 lock_keys %Opt, map { /([^=]+)/ } @opt;
  67 GetOptions(\%Opt,
  68            @opt,
  69           ) or pod2usage(1);
  70
  71 use File::Find;
  72 $|=1;
  73 my $i = 0;
  74 find(
  75      sub {
  76          return unless /^\d+\.gz$/;
  77          return if -s $File::Find::name > 3000;
  78          open my $fh, "-|", zcat => $File::Find::name or die "Could not open '$File::Find::name': $!";
  79          my $delete;
  80          while (<$fh>) {
  81              if (m{<h1 class="pagetitle">Error</h1>}) {
  82                  $delete++;
  83                  last;
  84              }
  85          }
  86          if ($delete) {
  87              unlink $File::Find::name or die "Could not unlink '$File::Find::name': $!";
  88              my $headers = $File::Find::name;
  89              $headers =~ s/gz$/headers/;
  90              unlink $headers or die "Could not unlink '$headers': $!";
  91              $i++;
  92              print "\r$i    ";
  93          }
  94      },
  95      "/home/ftp/cpantesters/reports"
  96 );
  97 print "\n";
  98
  99 # Local Variables:
 100 # mode: cperl
 101 # cperl-indent-level: 4
 102 # End: