bin/mytail-f-megalogdir.pl

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 customization and extension of mytail-f.pl for megainstall log files.
   6
   7 with the ability to switch to the next file when one file is finished;
   8
   9 displaying filename and current package from time to time;
  10
  11 intelligent handling of incomplete lines
  12
  13 =cut
  14
  15 use File::Basename qw(basename);
  16 use File::Spec;
  17 use Getopt::Long;
  18 use List::Util qw(maxstr);
  19 use Time::HiRes qw(time sleep);
  20
  21 our %Opt;
  22 GetOptions(\%Opt,
  23           "debug!",
  24           ) or die;
  25
  26 my $curpos = 0;
  27 my $line;
  28 my $file = youngest();
  29 my $currentpackage;
  30 $| = 1;
  31
  32 our @sleepscala = (2,3,5,8,13,21,34);
  33 @sleepscala = (2,3,5) if $Opt{debug};
  34 my $sleepscalaindex = 0;
  35 FILE: while () {
  36     open GWFILE, $file or die "Could not open '$file': $!";
  37     my $lines = 0;
  38     while (<GWFILE>) {
  39         $lines++;
  40     }
  41     close GWFILE;
  42     my $i = 0;
  43     open GWFILE, $file or die "Could not open '$file': $!";
  44     my $lastline = "";
  45   LINE: for (;;) {
  46         warn "lines[$lines]" if $Opt{debug};
  47         my $gotone;
  48         for ($curpos = tell(GWFILE); $line = <GWFILE>; $curpos = tell(GWFILE)) {
  49             $i++;
  50             # warn "i[$i]curpos[$curpos]" if $Opt{debug};
  51             $gotone=1;
  52             if ($line =~ /^\s+CPAN\.pm:/) {
  53                 ($currentpackage) = $line =~ /^\s+CPAN\.pm: Going to build\s+(\w[^\e]+\w)(?:\e.*)\s*$/;
  54             }
  55             if ($i > $lines - 10) {
  56                 my @time = localtime;
  57                 my $localtime = sprintf "%02d:%02d:%02d", @time[2,1,0];
  58                 my $fractime = time;
  59                 $fractime =~ s/\d+\.//;
  60                 $fractime .= "0000";
  61                 my $prefix = sprintf "%5d %s.%s", $i, $localtime, substr($fractime,0,4);
  62                 if (($i % 18) == 0) {
  63                     my $filelabel = $file;
  64                     my $currentpackagelabel;
  65                     if ($currentpackage) {
  66                         $currentpackagelabel = $currentpackage;
  67                         $currentpackagelabel .= " "
  68                             while length $currentpackagelabel < length $filelabel;
  69                         $filelabel .= " "
  70                             while length $currentpackagelabel > length $filelabel;
  71                     }
  72                     if (length $lastline) {
  73                         print "\n(( $filelabel ))\n";
  74                     } else {
  75                         print "(( $filelabel ))\n";
  76                     }
  77                     if ($currentpackagelabel) {
  78                         print "(( $currentpackagelabel ))\n";
  79                     }
  80                     if ($lastline) {
  81                         print $lastline;
  82                     }
  83                 }
  84                 if (length $lastline) {
  85                     printf "\n%s %s%s", $prefix, $lastline, $line;
  86                 } else {
  87                     printf "%s %s", $prefix, $line;
  88                 }
  89                 if ($line =~ /\n/) {
  90                     $lastline = "";
  91                 } else {
  92                     $i--;
  93                     $lastline = $line;
  94                 }
  95             }
  96         }
  97         if ($gotone) {
  98             sleep 0.33;
  99             $sleepscalaindex=0;
 100         } elsif ($i < $lines) {
 101             # no sleep
 102         } else {
 103             sleep $sleepscala[$sleepscalaindex];
 104             my $youngest = youngest();
 105             if ($sleepscalaindex<$#sleepscala) {
 106                 $sleepscalaindex++;
 107                 if ($sleepscalaindex==$#sleepscala) {
 108                     printf "\nINFO: max sleepscala reached at %s\n", scalar localtime;
 109                 }
 110             } else {
 111                 printf "\rINFO: %s youngest[%s]", scalar localtime, basename $youngest;
 112             }
 113             if ($youngest ne $file) {
 114                 print "\nswitching to $youngest\n";
 115                 $file = $youngest;
 116                 next FILE;
 117             }
 118         }
 119         seek(GWFILE, $curpos, 0);  # seek to where we had been
 120     }
 121 }
 122
 123 sub youngest {
 124     my($dir,$pat) = @_;
 125     $dir ||= "/home/sand/andk-cpan-tools/logs/";
 126     $pat ||= qr/^megainstall\..*\.out$/;
 127     opendir my $dh, $dir or die "Could not opendir '$dir': $!";
 128     my $youngest = maxstr grep { $_ =~ $pat } readdir $dh;
 129     File::Spec->catfile($dir,$youngest);
 130 }