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

use strict;

$|=1;

##  author:  parv, parv UNDERSCORE fm AT nospammail DOT net
##
##  date:  aug 20 2002
##
##  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, and interesting messages other than as
##    specified by tell_skip_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 Subject: | \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 );


#  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 =~ /\d+/
           &&  $mode =~ /^(?: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: /;

  #  complie regexes
  my @track = ( qr{ ^ From \s (\S+) }x ,
                qr{ ^ \s Subject: \s (.+) }x ,
                qr{ ${folder_line} (\S+) }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 = 60;

  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
      printf "%${output_len}.${output_len}s\n", $1;

      #  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;
}