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 require File::Rsync::Mirror::Recent;
  90 use CPAN::Version;
  91 unless (CPAN::Version->vge($File::Rsync::Mirror::Recent::VERSION, '0.4.5')) {
  92   warn "WARNING: loaded version '$File::Rsync::Mirror::Recent::VERSION' maybe not sufficient. Loaded from $INC{'File/Rsync/Mirror/Recent.pm'}\n";
  93 }
  94
  95 my $statefile = "$ENV{HOME}/.cpan/loop-over-recent.state";
  96 my $max_epoch_worked_on = 0;
  97
  98 my $rx = qr!\.(tar.gz|tar.bz2|zip|tgz|tbz)$!; # see also loop-over...
  99
 100 if (-e $statefile) {
 101   local $/;
 102   my $state = do { open my $fh, $statefile or die "Couldn't open '$statefile': $!";
 103                    <$fh>;
 104                  };
 105   chomp $state;
 106   $state||=0;
 107   $state += 0;
 108   $max_epoch_worked_on = $state if $state;
 109 }
 110 $Opt{localroot} ||= "/home/ftp/pub/PAUSE/authors";
 111 $Opt{localroot} =~ s|/*$|/|; # ensure trailing slash
 112 my $rf = File::Rsync::Mirror::Recent->new
 113     (
 114      localroot => $Opt{localroot},
 115      local => "$Opt{localroot}RECENT.recent",
 116     );
 117 my $have_a_current = 0;
 118 my $recent_events = $rf->news(max=>10*$Opt{n});
 119 {
 120   my %seen;
 121   $recent_events = [ grep { $_->{path} =~ $rx
 122                                 && $_->{type} eq "new";
 123                           } @$recent_events ];
 124   unless ($Opt{allowdups}) {
 125     $recent_events = [ grep { my $d = CPAN::DistnameInfo->new($_->{path});
 126                               no warnings 'uninitialized';
 127                               !$seen{$d->dist}++
 128                             } @$recent_events ];
 129   }
 130   for my $re (@$recent_events) {
 131     if ($re->{epoch} == $max_epoch_worked_on) {
 132       $re->{is_current} = 1;
 133       $have_a_current = 1;
 134     }
 135   }
 136 }
 137 my $count = 0;
 138 my $intro_done = 0;
 139 ITEM: for my $i (0..$#$recent_events) {
 140   my $item = $recent_events->[$i];
 141   my $mark = "";
 142   my $epoch = $item->{epoch};
 143   unless ($intro_done++) {
 144     if ($HAVE_TIME_DURATION) {
 145       printf "   %s since latest upload\n", Time::Duration::duration(time - $epoch);
 146     } else {
 147       printf "   %7d seconds since latest upload (no Time::Duration?)\n", time - $epoch;
 148     }
 149   }
 150   if ($max_epoch_worked_on) {
 151     if ($item->{is_current}) {
 152       $mark = "*";
 153     } elsif (!$have_a_current
 154              && $max_epoch_worked_on > $item->{epoch}
 155              && $i > 0
 156              && $max_epoch_worked_on < $recent_events->[$i-1]->{epoch}) {
 157       printf "%1s %s\n", "*", scalar localtime $max_epoch_worked_on;
 158     }
 159   }
 160   my $size = "";
 161   if ($Opt{showsize}) {
 162     my $abs = $Opt{localroot} . $item->{path};
 163     $size = -s $abs ? sprintf(" %7d ",-s $abs) : "_________";
 164   }
 165   my $line = sprintf
 166       (
 167        "%1s %s %s%s\n",
 168        $mark,
 169        scalar localtime $epoch,
 170        $size,
 171        substr($item->{path},8),
 172       );
 173   if (my $trim = $Opt{linetrim}) {
 174     if (length $line > $trim) {
 175       substr($line,$trim-3) = "...\n";
 176     }
 177   }
 178   if ($Opt{"burn-in-protection"}) {
 179     chomp $line;
 180     while (rand 30 < 1) {
 181       $line = " $line";
 182     }
 183     if (length($line) > 80) {
 184       while (length($line) > 80){
 185         chop($line);
 186       }
 187       substr($line,80-1,1) = rand(30)<1 ? "_" : ">";
 188     }
 189     while (length($line) < 80){
 190       $line .= rand(30)<1 ? "_" : " ";
 191     }
 192     if (rand(30)<1) {
 193       $line =~ s/ /_/g;
 194     }
 195     $line .= "\n";
 196   }
 197   print $line;
 198   ++$count;
 199   if ($Opt{n} && $count>=$Opt{n}) {
 200     last ITEM;
 201   }
 202 }
 203 if (0 == $count) {
 204   print sprintf "  found nothing of interest in %s\n", $rf->rfile;
 205 } elsif ($Opt{"burn-in-protection"} && $count < $Opt{n}) {
 206   while ($count < $Opt{n}) {
 207     my $line = "";
 208     while (length($line) < 80){
 209       $line .= rand(30)<1 ? "_" : " ";
 210     }
 211     print "$line\n";
 212     $count++;
 213   }
 214 }
 215 __END__
 216
 217 # Local Variables:
 218 # mode: cperl
 219 # cperl-indent-level: 2
 220 # End: