Mail::Abuse::Report - Process an abuse report

Mail-Abuse documentation Contained in the Mail-Abuse distribution.

Index

Code Index:

NAME

Top

Mail::Abuse::Report - Process an abuse report

SYNOPSIS

Top

  use Mail::Abuse::Report;

  my $r = new Mail::Abuse::Report
    (
     -text		=> \$report_text,
     -reader		=> $reader,
     -filters		=> [ $f1, $f2, ... ],
     -parsers		=> [ $i1, $i2, ... ],
     -processors	=> [ $p1, $p2, ... ],
     -debug		=> 1,
     -config		=> $config_file,
     );

DESCRIPTION

Top

This class encapsulates an abuse report and provides methods to automate tasks such as extracting individual incidents from it, filtering the incidents, etc.

Each of the methods are described in detail, below:

->new(%args)

Creates a new Mail::Abuse::Report object. It accepts the following arguments:

-text

Specifies the text that will be used to fill the report with. This is incompatible with -reader, so choose one and stick to it. Defaults to undef.

-reader

Specifies the object (tipically a member of Mail::Abuse::Reader) that will be used to fetch the text of the next report. This is incompatible with -text, so pick one and stick to it. Defaults to undef.

-filters

A reference to a list of objects that can filter incidents. Normally, objects based on Mail::Abuse::Filter. Defaults to no filters.

-parsers

A reference to a list of objects that can parse incidents out of the report text. Normally, objects based on Mail::Abuse::Incident. Defaults to no parsers.

-processors

A reference to a list of objects that can process the incidents on the report, normally objects based on the Mail::Abuse::Processor class. Defaults to no processors.

-debug

A true value causes diagnostic messages to be sent via warn().

-config

Specifies the name of the config file to fetch configuration items from. Can be left unspecified.

->next()

When the object has a reader, fetches the next report text, parses it with the incidents and filters the incidents and processes them with the supplied processors.

Returns the report object if succesful or false otherwise.

If no reader has been supplied to the report object, the same text will be analyzed over and over again.

->flush()

Discards all non-essential information from the object. It is meant to be called before reusing the object to process a new report.

This method is automatically called by ->next.

Also, a number of acccessor methods are defined as follows:

->filters

When invoked without arguments, returns a reference to the list of filters (Mail::Abuse::Filter objects) attached to this abuse report. Calling the accessor with a list of objects will replace whatever was the prior list.

The list can be manipulated, affecting the object directly.

->incidents

When invoked without arguments, returns a reference to the list of incidents extracted from this report (Mail::Abuse::Incident objects). Calling the accessor with a reference to a list of objects will replace whatever was the prior list.

The list can be manipulated, affecting the object directly.

->parsers

When invoked without arguments, returns a reference to the list of parsers that are used in this report (Mail::Abuse::Incident objects). Calling the accessor with a reference to a list of objects will replace whatever was the prior list.

The list can be manipulated, affecting the object directly.

->processors

When invoked without arguments, returns a reference to the list of processors attached to this report (Mail::Abuse::Processor objects). Calling the accessor with a reference to a list of objects will replace whatever was the prior list.

The list can be manipulated, affecting the object directly.

->text

Accepts a reference to a scalar containing the text of the report.

Returns a reference to the text of the report.

If the text is altered, you should call ->flush() to avoid insanity.

->reader

If passed a reader object, it will replace the one used for initialization. Otherwise, will return the reader object passed to ->new.

->config

Returns a reference to a hash containing the configuration information read-in by this report. It can be replaced by simply supplying a new reference to a configuration hash.

->debug

Returns the debug level of the object. When set to true, debug information is issued through warn.

EXPORT

None by default.

HISTORY

Top

0.01

Original version; created by h2xs 1.2 with options

  -ACOXcfkn
	Mail::Abuse
	-v
	0.01

LICENSE AND WARRANTY

Top

This code is distributed under the same terms as Perl itself, providing the exact same warranty.

LICENSE AND WARRANTY

Top

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.

LICENSE AND WARRANTY

Top

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.

AUTHOR

Top

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

SEE ALSO

Top

perl(1).

Mail-Abuse documentation Contained in the Mail-Abuse distribution. 
package Mail::Abuse::Report;

require 5.005_62;

use Carp;
use strict;
use warnings;
use IO::File;
# use Config::Auto;
use Params::Validate qw(:all);
				# The code below should be in a single line

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

				# Keys that we keep after a flush
our @Keep = qw/
    text
    debug
    config
    reader
    filters
    parsers
    processors
/;


sub new
{
    my $type	= shift;
    my $class	= ref($type) || $type || 'Mail::Abuse::Report';

    croak "Invalid call to Mail::Abuse::Report::new"
	unless $class;

    my %self = validate_with
	(
	 params		=> \@_,
	 ignore_case	=> 1,
	 strip_leading	=> '-',
	 spec		=>
	 {
	     text =>
	     {
		 type		=> SCALARREF,
		 default	=> undef,
	     },
    
	     reader =>
	     {
		 type		=> OBJECT,
		 can		=> [ qw(read) ],
		 default	=> undef,
	     },

	     filters =>
	     {
		 type		=> ARRAYREF,
		 default	=> [],
	     },

	     parsers =>
	     {
		 type		=> ARRAYREF,
		 default	=> [],
	     },

	     processors =>
	     {
		 type		=> ARRAYREF,
		 default	=> [],
	     },

	     debug =>
	     {
		 type		=> SCALAR,
		 default	=> 0,
	     },

	     config =>
	     {
		 type		=> SCALAR,
		 default	=> undef,
		 callbacks	=>
		 {
		     'config file must be readable' => sub
		     {
			 defined $_[0] and -f $_[0];
		     },
		 },
	     },
	 },
	 );

    my $self = \%self;

    bless $self, $class;

    $self->load_config or return;

    $self->incidents([]);

    return $self;

}

sub load_config
{
    my $self = shift;
    my $config = $self->config;
    warn "M::A::Report: reading config" if $self->debug;
#    eval { $self->config(Config::Auto::parse($config, format => 'colon')) };
    $self->config({});

    my $fh = new IO::File $config;
    
    unless ($fh)
    {
	warn "M::A::Report: Failed to open $config: $!\n";
	return;
    }

    while (<$fh>)
    {
	chomp;
	s/\#.*$//g;
	next unless /^([^:]+):\s*(.*)$/;
	$self->config->{lc $1} = $2;
    }
    
    $fh->close;

    warn "Config read: $@\n" if $self->debug;
    return if $@;
    return $self;
}


sub next
{
    my $self = shift;

    $self->flush;
    
    if ($self->reader)
    {
	warn "Reading from reader object\n" if $self->debug;
	return unless $self->reader->read($self);
    }

    return unless $self->text;

    for my $i (@{$self->parsers})
    {
	warn "Parsing with parser $i\n" if $self->debug;
	my @incidents = $i->parse($self);
	warn scalar @incidents, " incidents found\n" if $self->debug;
	next unless @incidents;

	warn "init incidents: ", join(',', map { ref $_ } @incidents), "\n"
	    if $self->debug;
	
	for my $f (@{$self->filters})
	{
	    warn "Filtering with filter $f\n" if $self->debug;
	    @incidents = grep { $f->criteria($self, $_) } @incidents;
	    warn scalar @incidents, " incidents left\n" if $self->debug;
	}
	
	warn scalar @incidents, " final incidents left\n" if $self->debug;
	push @{$self->incidents}, @incidents;
    }

				# At this point, the incidents are
				# properly registered within the
				# object, so we can safely process
				# them

    for my $p (@{$self->processors})
    {
	warn "Processing with $p\n" if $self->debug;
	$p->process($self);
    }

    return $self;
}


sub flush
{
    my $self = shift;

    warn "M::A::Report->flush" if $self->debug;

    for my $k (keys %$self)
    {
	next if grep { $k eq $_ } @Keep;
	warn "flush key $k\n" if $self->debug;;
	delete $self->{$k};
    }

    $self->incidents([]);

    return $self;
}


sub AUTOLOAD 
{
    no strict "refs";
    use vars qw($AUTOLOAD);
    my $method = $AUTOLOAD;
    $method =~ s/^.*:://;
    *$method = sub 
    { 
	my $self = shift;
	my $ret = $self->{$method};
	if (@_)
	{
	    $ret = $self->{$method};
	    $self->{$method} = shift;
	}
	return $ret;
    };
    goto \&$method;
}

1;

__END__