view release on metacpan or  search on metacpan

lib/App/SpamcupNG/Summary.pm  view on Meta::CPAN

use warnings;
use strict;
use parent qw(Class::Accessor);
use Hash::Util 'lock_keys';
use Carp 'confess';
use Set::Tiny 0.04;

use App::SpamcupNG::Summary::Receiver;

our $VERSION = '0.020'; # VERSION

=pod

=head1 NAME

App::SpamcupNG::Summary - class to summarise SPAM report data

=head1 SYNOPSIS

    use App::SpamcupNG::Summary;
    my $summary = App::SpamcupNG::Summary->new;
    $summary->set_age(16);

=head1 DESCRIPTION

This class is used internally to store SPAM report data that can latter be
saved to generate reports.

This class is also based on L<Class::Accessor> and uses
C<follow_best_practice>.

=head1 ATTRIBUTES

=over

=item tracking_id: the SPAM report unique tracking ID.

=item mailer: the e-mail header C<X-Mailer>, if available. Might be C<undef>.

=item content_type: the e-mail header C<Content-Type>, if available. Might be C<undef>.

=item age: the time elapsed since the SPAM e-mail was received.

=item age_unit: the time elapsed unit since the SPAM e-mail was received.

=item contacts: an array reference with the "best contacts" found in the report.

=item receivers: an array reference with L<App::SpamcupNG::Summary::Receiver> instances.

=back

Sometimes the C<receivers> addresses will not real ones, but "counters" that
will not be used for the report, but only for Spamcop statistics.

=cut

__PACKAGE__->follow_best_practice;
my $fields = Set::Tiny->new(
    (
        'tracking_id', 'mailer',   'content_type', 'age',
        'age_unit',    'contacts', 'receivers',    'charset'
    )
);
my $ro_fields = Set::Tiny->new(qw(receivers));

__PACKAGE__->mk_accessors( ( $fields->difference($ro_fields) )->members );
__PACKAGE__->mk_ro_accessors( $ro_fields->members );

=head1 METHODS

=head2 new

Creates a new instance. No parameter is required or expected.

=cut

sub new {
    my ( $class, $attribs_ref ) = @_;
    my $self = {
        tracking_id  => undef,
        mailer       => undef,
        content_type => undef,
        age          => undef,
        age_unit     => undef,
        contacts     => undef,
        receivers    => undef,
        charset      => undef
    };
    bless $self, $class;
    lock_keys( %{$self} );
    return $self;
}

=head2 as_text

Returns the summary attributes as strings, separated by commas.

If some of attributes are C<undef>, the string C<not avaialable> will be used
instead.

=cut

sub as_text {
    my $self = shift;
    my @simple;

 # Set::Tiny->members is not ordered and we need that to have deterministic text
    my @fields  = sort( $fields->members );
    my $complex = Set::Tiny->new(qw(contacts receivers age));

    foreach my $field (@fields) {
        next if ( $complex->has( ($field) ) );
        push( @simple, $field );
    }

    my @dump = map { $_ . '=' . ( $self->{$_} || $self->na ) } @simple;

    # age can be zero
    if ( defined( $self->{age} ) ) {
        push( @dump, 'age=' . $self->{age} );
    }
    else {
        push( @dump, 'age=' . $self->na );
    }

    foreach my $key (qw(receivers contacts)) {
        if ( $self->{$key} ) {

            if ( $key eq 'contacts' ) {
                push( @dump,
                    ( "$key=(" . join( ';', @{ $self->{$key} } ) . ')' ) );
                next;
            }

            push( @dump, $self->_receivers_as_text );

        }
        else {
            push( @dump, "$key=()" );
        }
    }

    return join( ',', @dump );
}

=head2 tracking_url