Description: |
From_, Subject:, and 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.
it is also available from...
http://www103.pair.com/parv/comp/src/perl/find-procmail-err.perl
|
#!/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 debu
+g,
## consult your actual recipes & full verbose procmail log. consul
+t
## 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()) o
+f
# 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 rege
+x",
# 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;
}
|