bin/recent.pl

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 recent -
   6
   7 =head1 SYNOPSIS
   8
   9  watch -t -n 20 'perl ~k/sources/CPAN/GIT/trunk/bin/recent.pl -n 25 --burn-in-protection'
  10
  11 =head1 OPTIONS
  12
  13 =over 8
  14
  15 =cut
  16
  17 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  18
  19 =item B<--help|h!>
  20
  21 This help
  22
  23 =item B<--alternative=i>
  24
  25 =item B<--allowdups!>
  26
  27 Normally we suppress Foo-3.33 when we have already seen Foo-4.44. With
  28 this option we show all versions.
  29
  30 =item B<--burn-in-protection!>
  31
  32 =item B<--linetrim=i>
  33
  34 =item B<--localroot=s>
  35
  36 Defaults to C</home/ftp/pub/PAUSE/authors>. Path to authors directory.
  37
  38 =item B<--n=i>
  39
  40 =item B<--showsize!>
  41
  42 =back
  43
  44 =head1 DESCRIPTION
  45
  46 Show most recent uploads according to the RECENT file and mark the
  47 currently processing one (according to ~/.cpan/loop-over-recent.state
  48 with a star.
  49
  50 The burn-in-protection changes something from time to time. This also
  51 cleans up STDERR remnants that otherwise might annoy the user of
  52 watch(1).
  53
  54 =cut
  55
  56 use strict;
  57 use warnings;
  58
  59 use CPAN::DistnameInfo;
  60 eval {require Time::Duration};
  61 our $HAVE_TIME_DURATION = !$@;
  62 # use YAML::Syck;
  63
  64 use Dumpvalue;
  65 use File::Basename qw(dirname);
  66 use File::Path qw(mkpath);
  67 use File::Spec;
  68 use File::Temp;
  69 use Getopt::Long;
  70 use Pod::Usage;
  71 use Hash::Util qw(lock_keys);
  72
  73 our %Opt;
  74 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  75 GetOptions(\%Opt,
  76            @opt,
  77           ) or pod2usage(1);
  78 if ($Opt{help}) {
  79     pod2usage(0);
  80 }
  81
  82 $Opt{n}||=40;
  83
  84 if (-e "/home/k/sources/rersyncrecent/lib/") {
  85   require lib;
  86   lib->import("/home/k/sources/rersyncrecent/lib/");
  87   lib->unimport(".");
  88 }
  89 use File::Rsync::Mirror::Recent;
  90
  91 my $statefile = "$ENV{HOME}/.cpan/loop-over-recent.state";
  92 my $max_epoch_worked_on = 0;
  93
  94 my $rx = qr!\.(tar.gz|tar.bz2|zip|tgz|tbz)$!; # see also loop-over...
  95
  96 if (-e $statefile) {
  97   local $/;
  98   my $state = do { open my $fh, $statefile or die "Couldn't open '$statefile': $!";
  99                    <$fh>;
 100                  };
 101   chomp $state;
 102   $state||=0;
 103   $state += 0;
 104   $max_epoch_worked_on = $state if $state;
 105 }
 106 $Opt{localroot} ||= "/home/ftp/pub/PAUSE/authors";
 107 $Opt{localroot} =~ s|/*$|/|; # ensure trailing slash
 108 my $rf = File::Rsync::Mirror::Recent->new
 109     (
 110      localroot => $Opt{localroot},
 111      local => "$Opt{localroot}RECENT.recent",
 112     );
 113 my $have_a_current = 0;
 114 my $recent_events = $rf->news(max=>10*$Opt{n});
 115 {
 116   my %seen;
 117   $recent_events = [ grep { $_->{path} =~ $rx
 118                                 && $_->{type} eq "new";
 119                           } @$recent_events ];
 120   unless ($Opt{allowdups}) {
 121     $recent_events = [ grep { my $d = CPAN::DistnameInfo->new($_->{path});
 122                               no warnings 'uninitialized';
 123                               !$seen{$d->dist}++
 124                             } @$recent_events ];
 125   }
 126   for my $re (@$recent_events) {
 127     if ($re->{epoch} == $max_epoch_worked_on) {
 128       $re->{is_current} = 1;
 129       $have_a_current = 1;
 130     }
 131   }
 132 }
 133 my $count = 0;
 134 my $intro_done = 0;
 135 ITEM: for my $i (0..$#$recent_events) {
 136   my $item = $recent_events->[$i];
 137   my $mark = "";
 138   my $epoch = $item->{epoch};
 139   unless ($intro_done++) {
 140     if ($HAVE_TIME_DURATION) {
 141       printf "   %s since latest upload\n", Time::Duration::duration(time - $epoch);
 142     } else {
 143       printf "   %7d seconds since latest upload (no Time::Duration?)\n", time - $epoch;
 144     }
 145   }
 146   if ($max_epoch_worked_on) {
 147     if ($item->{is_current}) {
 148       $mark = "*";
 149     } elsif (!$have_a_current
 150              && $max_epoch_worked_on > $item->{epoch}
 151              && $i > 0
 152              && $max_epoch_worked_on < $recent_events->[$i-1]->{epoch}) {
 153       printf "%1s %s\n", "*", scalar localtime $max_epoch_worked_on;
 154     }
 155   }
 156   my $size = "";
 157   if ($Opt{showsize}) {
 158     my $abs = $Opt{localroot} . $item->{path};
 159     $size = -s $abs ? sprintf(" %7d ",-s $abs) : "_________";
 160   }
 161   my $line = sprintf
 162       (
 163        "%1s %s %s%s\n",
 164        $mark,
 165        scalar localtime $epoch,
 166        $size,
 167        substr($item->{path},8),
 168       );
 169   if (my $trim = $Opt{linetrim}) {
 170     if (length $line > $trim) {
 171       substr($line,$trim-3) = "...\n";
 172     }
 173   }
 174   if ($Opt{"burn-in-protection"}) {
 175     chomp $line;
 176     while (rand 30 < 1) {
 177       $line = " $line";
 178     }
 179     if (length($line) > 80) {
 180       while (length($line) > 80){
 181         chop($line);
 182       }
 183       substr($line,80-1,1) = rand(30)<1 ? "_" : ">";
 184     }
 185     while (length($line) < 80){
 186       $line .= rand(30)<1 ? "_" : " ";
 187     }
 188     if (rand(30)<1) {
 189       $line =~ s/ /_/g;
 190     }
 191     $line .= "\n";
 192   }
 193   print $line;
 194   ++$count;
 195   if ($Opt{n} && $count>=$Opt{n}) {
 196     last ITEM;
 197   }
 198 }
 199 if (0 == $count) {
 200   print sprintf "  found nothing of interest in %s\n", $rf->rfile;
 201 } elsif ($Opt{"burn-in-protection"} && $count < $Opt{n}) {
 202   while ($count < $Opt{n}) {
 203     my $line = "";
 204     while (length($line) < 80){
 205       $line .= rand(30)<1 ? "_" : " ";
 206     }
 207     print "$line\n";
 208     $count++;
 209   }
 210 }
 211 __END__
 212
 213 # Local Variables:
 214 # mode: cperl
 215 # cperl-indent-level: 2
 216 # End: