view release on metacpan or  search on metacpan

lib/Mail/Procmail.pm  view on Meta::CPAN

}

sub _new_fh {
    return if $] >= 5.006;	# 5.6 will take care itself
    require IO::File;
    IO::File->new();
}

################ Reporting ################

=head2 pm_report

pm_report() produces a summary report from log files from
Mail::Procmail applications.

Example:

    pm_report(logfile => "pmlog");

The report shows the deliveries, and the rules that caused the
deliveries. For example:

  393  393  deliver[203]  /home/jv/Mail/perl5-porters.spool
  370  370  deliver[203]  /home/jv/Mail/perl6-language.spool
  174  174  deliver[203]  /home/jv/Mail/perl6-internals.spool
  160   81  deliver[311]  /var/spool/mail/jv
	46  deliver[337]
	23  deliver[363]
	10  deliver[165]

The first column is the total number of deliveries for this target.
The second column is the number of deliveries triggered by the
indicated rule. If more rules apply to a target, this line is followed
by additional lines with an empty first and last column.

Attributes:

=over

=item *

logfile

The name of the logfile to process.

=back

If no logfile attribute is passed, pm_report() reads all files
supplied on the command line. This makes it straighforward to run from
the command line:

    $ perl -MMail::Procmail -e 'pm_report()' syslog/pm_logs/*

=cut

sub pm_report {

    my (%atts) = @_;
    my $logfile = delete($atts{logfile});

    local (@ARGV) = $logfile ? ($logfile) : @ARGV;

    my %tally;			# master array with data
    my $max1 = 0;		# max. delivery
    my $max2 = 0;		# max. delivery / rule
    my $max3 = 0;		# max length of rules
    my $recs = 0;		# records in file
    my $msgs = 0;		# messages
    my $dlvr = 0;		# deliveries

    while ( <> ) {
	$recs++;

	# Tally number of incoming messages.
	$msgs++, next if /^\d+\.\d+ Mail from/;

	# Skip non-deliveries.
	next unless /^\d+\.\d+ (\w+\[[^\]]+\]):\s+(.+)/;
	$dlvr++;

	# Update stats and keep track of max values.
	my $t;
	$max1 = $t if ($t = ++$tally{$2}->[0]) > $max1;
	$max2 = $t if ($t = ++$tally{$2}->[1]->{$1}) > $max2;
	$max3 = $t if ($t = length($1)) > $max3;
    }

    print STDOUT ("$recs records, $msgs messages, $dlvr deliveries.\n\n");

    # Construct format for report.
    $max1 = length($max1);
    $max2 = length($max2);
    my $fmt = "%${max1}s  %${max2}s  %-${max3}s  %s\n";

    # Sort on number of deliveries per target.
    foreach my $dest ( sort { $b->[1] <=> $a->[1] }
		          map { [ $_, $tally{$_}->[0], $tally{$_}->[1] ] }
			     keys %tally ) {
	my $first = 1;
	# Sort on deliveries per rule.
	foreach my $rule ( sort { $b->[1] <=> $a->[1] }
			      map { [ $_, $dest->[2]->{$_} ] }
			         keys %{$dest->[2]} ) {
	    printf STDOUT ($fmt,
			   ($first ? $dest->[1] : ""),
			   $rule->[1],
			   $rule->[0],
			   ($first ? $dest->[0] : ""));
	    $first = 0;
	}
    }

}

=head1 USING WITH PROCMAIL

The following lines at the start of .procmailrc will cause a copy of
each incoming message to be saved in $HOME/syslog/mail, after which
the procmail-pl is run as a TRAP program (see the procmailrc
documentation). As a result, procmail will transfer the exit status of
procmail-pl to the mail transfer agent that invoked procmail (e.g.,