package Mail::Abuse::Processor::Explain;

require 5.005_62;

use Carp;
use strict;
use warnings;

use POSIX qw(strftime);

use base 'Mail::Abuse::Processor';

				# The code below should be in a single line

our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf " %d."."%03d" x $#r, @r };

=pod

=head1 NAME

Mail::Abuse::Processor::Explain - Explain a Mail::Abuse::Report

=head1 SYNOPSIS

  use Mail::Abuse::Processor::Explain;

  use Mail::Abuse::Report;
  my $p = new Mail::Abuse::Processor::Explain;
  my $report = new Mail::Abuse::Report (processors => [ $p ]);

  # ... other pieces of code that configure the report ...

=head1 DESCRIPTION

This class outputs an abuse report and information about the incidents
that were extracted, to STDOUT. It is useful when using this framework
as part of a filter that preprocesses messages before handing them to
other systems.

The following functions are implemented.

=over

=item C<process($report)>

Takes a C<Mail::Abuse::Report> object as an argument and performs the
processing action required.

=cut

sub _dump($$$$$);

sub _dump($$$$$)
{
    my $fh	= shift;	# File handle to write output to
    my $r	= shift;	# Handle to the incident
    my $indent	= shift;	# Current indent level
    my $parent	= shift;	# The name of what is being printed
    my $r_data	= shift;	# The datum returned by the handler

    if (ref $r_data eq 'ARRAY')
    {
	print $fh '| ' x ($indent - 1), "+-$parent\n";
	for my $k (0 .. $#{$r_data})
	{
	    _dump($fh, $r, $indent + 1, $parent . '.[' . $k .']',
		  $r_data->[$k]);
	}
    }
    elsif (ref $r_data eq 'HASH')
    {
	print $fh '| ' x ($indent - 1), "+-$parent\n";
	for my $k (sort keys %$r_data)
	{
	    _dump($fh, $r, $indent + 1, $parent . '.{' . $k .'}',
		  $r_data->{$k});
	}
    }
    else
    {
	print $fh '| ' x ($indent - 1), "+-$parent=$r_data\n";
    }
}

sub process
{
    my $self	= shift;
    my $rep	= shift;

    # If no work is required, simply leave quickly
    return if @{$rep->incidents} == 0;

    # Where to send the explanations...
    my $fh = \*STDOUT;

    # Print a nice header
    my $PACKAGE = __PACKAGE__;
    print $fh qq{
#================================================================
#Incident explanation by $PACKAGE
}
    ;
    print $fh q{#$Id: Explain.pm,v 1.2 2004/11/21 02:44:14 lem Exp $
#================================================================

}
    ;

    # Iterate through all the incidents
    for my $r (sort { $a->ip <=> $b->ip 
			  or $a->time <=> $b->time 
			  or $a->type cmp $b->type } 
	       @{$rep->incidents})
    {
	print $fh "# ", $r->ip, " ", strftime("%B %d, %H:%M:%S %Y (%z)", 
					      localtime($r->time)), "\n";
	for my $method (sort $r->items)
	{
	    next if grep { $method eq $_ } qw/ip time data/;
	    no strict 'refs';
	    _dump($fh, $r, 1, $method, $r->$method);
	}
    }

    # Output a trailer and introduce the report text
    print $fh q{

#================================================================
#No more incidents to explain. The recovered report body follows.
#================================================================

};

    print $fh $rep->normalized ? ${$rep->body} : ${$rep->text};
}

__END__

=pod

=back

=head2 EXPORT

None by default.


=head1 HISTORY

$Log: Explain.pm,v $
Revision 1.2  2004/11/21 02:44:14  lem
Field tested

Revision 1.1  2004/11/21 02:15:02  lem
Testing version


=head1 LICENSE AND WARRANTY

This code and all accompanying software comes with NO WARRANTY. You
use it at your own risk.

This code and all accompanying software can be used freely under the
same terms as Perl itself.

=head1 AUTHOR

Luis E. Muñoz <luismunoz@cpan.org>

=head1 SEE ALSO

perl(1).

=cut