#!/usr/local/bin/perl -w

use strict;

#$|=1;

##    Author:  parv, parv UNDERSCORE AT yahoo DOT com
##  Modified:  Mar 01 2005
##
##  License/Disclaimer:  Use as you please only when proper credit is given.
##  I am not responsible for any kind of damage; use it at your own risk.
##
##  Name:  find-procmail-err.perl
##
##  Purpose:  To find errors reported in the procmail log.  From_, Subject:, &
##  folder name (see LOGABSTRACT in procmailrc(5)) are printed to stderr.
##  Interesting messages other than as specified by $mundane_regex (to current
##  output file descriptor, (stdout is default?)).
##
##  This program is unsuited to actually debug the recipes.  To debug, consult
##  your actual recipes & full verbose procmail log.  Consult procmail mailing
##  list, and various man & web pages for more help & information.
##
##  Usage:
##    xterm -e tail -F procmail/log | find-procmail-err.perl
##
##    tail -f procmail/log | find-procmail-err.perl
##
##    find-procmail-err.perl  log_1 [ log_2 [ log_3 [...] ] ]
##
#
#  print_juicy() can optionally print line numbers of interesting lines.  See
#  parse_log() for usage.  Functioanlity exists but there is no easy/proper
#  way to specify to do that; it's hardcoded (or not).
#
#  Currently only 60 or less characters are printed (see progress()) of From_,
#  Subject:, and folder name.  It should/would be controlled by some sort of
#  option.


#  Returns a regex which describes what to skip from the log adjust regex as
#  desired.
sub tell_skip_regex
{
  #  Compile only once the regex to skip uninteresting messages.
  return \qr{ ^ (?:
                 procmail: \s+
                 (?:
                   #  Process id/message number (?) followed by date.
                   \[ \d+ \]
                   |
                   #  Various non-consequential messages as far as _finding_
                   #  an error is concerned.
                   (?:
                     Assigning | Unlocking | Locking
                     | Opening | Acquiring | Executing
                     | Score: | Matched
                     | Match \s on
                     | No \s match \s on
                     | Non-zero \s exitcode \s \(1\) .+ \"formail
                   )
                 )
                 #  Skip From_, Subject: & Folder:, too, as these
                 #  lines are handled  by progress() -- it's a toss up.
                 | From \s | \s [sS]ubject: | \s{2} Folder:
               )
           }x;
}

#  Choose between STDIN or file names given as command line arguments STDIN is
#  ignored if any argument exists.
handle_input( \@ARGV );

INIT
{ our %months;
  @months{ (0..11) } =
    qw(jan feb mar apr may jun jul aug sep oct nov dec);

  our $update_sec = 60 * 6;

  sub time_update
  { my ($second , $min , $hour , $day , $mon ) =
      (localtime)[0..4];

    my $old_FH = select;
    select (STDERR);

    printf "\n----\n  %s %02d %02d%02d.%02d\n----\n"
    , $months{$mon}
    , $day , $hour , $min , $second
    ;

    select($old_FH);
    sleep $update_sec;
    time_update();
  }
}

time_update;

#  Process STDIN or files in @ARGV.
sub handle_input
{
  my $files = shift;

  #  ----
  #  Mind that any options, if added, should be popped from @ARGV or adjust
  #  the below code accordingly
  #  ----

  #  Read STDIN if no arguments specified
  parse_log(\*STDIN) unless scalar(@{ $files });

  #  Ignore STDIN, go thru each file argument given
  foreach my $file (@{ $files })
  { unless ( open (LOG, "<", $file) )
    { warn " cannot open $file: $!\n";
      next;
    }
    parse_log(\*LOG);
    close (LOG) || die " cannot close $file: $!\n";
  }
}


sub  parse_log
{ my $fh = shift;
  while ( defined(my $line = <$fh>) )
  {
    #print_juicy( \$line, $., my $parse_mode = 'tail' )
    print_juicy( \$line ) && next;
    progress( \$line );
  }
}


#  Only errors/warnings will be printed (like "Skipped", "Invalid regex",
#  etc.) depending on the $regex (reference) passed
sub print_juicy
{ #  $line_num & $mode are optional
  my ($line, $line_num, $mode) = @_;

  my $skip_regex = tell_skip_regex();

  return 0 if $$line =~ m/$$skip_regex/;

  unless (   $line_num && $line_num =~ m/\d+/
          && $mode =~ m/^(?:n(?:orm)?|c(?:at)?)/
         )
  { print $$line, "\n";
    return 1;
  }

  printf "\n>> line: %5d <<\n%s\n", ($line_num, $$line);
  return 1;
}


#  Print From_, Subject:, & folder information -- right justified & of
#  $output_len long -- from the procmail log output by virtue of "LOGABSTRACT
#  = all" setting.
#
#  Information is printed to STDERR to show if anything being delivered;
#  provides a way to see or avoid this progress-o-meter
#
sub progress
{
  my $line = $_[0];

  #  For aesthetic purpose, add an extra newline after the "Folder" output.
  my $folder_line = qr/^  Folder:\s+/;

  #  Complie regexes.
  my @track = ( qr{ ^ From \s (\S+) }x ,
                qr{ ^ \s Subject: \s (.+) }xi ,
                #qr{ ${folder_line} (\S+) }x
                qr{ ${folder_line} (.+) \s+ \d+ $ }x
              );

  #  Length of the output string.
  #  ----
  #  60 is the xterm width, in pixels,  which almost takes over my 1024 pixels
  #  wide monitor w/ another 80-pixel wide xterm.
  #  ----
  my $output_len = 80;

  for my $track ( @track )
  {
    if ( $$line =~ m/$track/ )
    {
      #  Save current output file descriptor (ofd).
      my $old_FH = select;

      #  Select stderr for any further output.
      select (STDERR);

      #  Print a regex match right justfied of $output_len length.
      my $tmp = $1;
      $tmp =~ s/\s{2,}/ /g;
      $tmp =~ s/(?: ^ \s+ | \s+ $)//x;

      printf "%${output_len}.${output_len}s\n", $tmp;

      #  Pretty up the ouptut (if current line is a folder name).
      print "\n" if $$line =~ m/$folder_line/;

      #  Restore the ofd.
      select $old_FH;

      return 1;
    }
  }

  return 0;
}