File Coverage

blib/lib/Text/SpamAssassin.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	18	88.8

package Text::SpamAssassin;
BEGIN {
  $Text::SpamAssassin::VERSION = '2.001';
}

use 5.006;
use strict;
use warnings;

use Mail::SpamAssassin;
use Mail::Address;
use Mail::Header;
use Mail::Internet;
use POSIX qw(strftime);
use Data::Random qw(rand_chars);

BEGIN {
    if ($Mail::SpamAssassin::VERSION < 3) {
        require Mail::SpamAssassin::NoMailAudit;
    }
}

sub new {
    my ($class, %opts) = @_;

    my $self = bless {}, $class;
    $self->reset;

    $self->{analyzer} = Mail::SpamAssassin->new($opts{sa_options});
    $self->{analyzer}->compile_now if not $opts{lazy};

    return $self;
}

sub DESTROY {
    my ($self) = @_;

    local $@;
    eval { $self->{analyzer}->finish };
}

sub reset {
    my ($self) = @_;

    $self->reset_metadata;
    $self->reset_headers;

    return $self;
}

sub reset_metadata {
    my ($self) = @_;

    $self->{metadata} = {};

    return $self;
}

sub reset_headers {
    my ($self) = @_;

    $self->{header} = {};

    return $self;
}

sub set_metadata {
    my ($self, $key, $value) = @_;

    if (defined $value) {
        $self->{metadata}{lc $key} = $value;
    }
    else {
        delete $self->{metadata}{lc $key};
    }

    return $self;
}

sub set_header {
    my ($self, $key, $value) = @_;

    $value = [ $value ] if not ref $value;

    if (defined $value) {
        $self->{header}{lc $key} = $value;
    }
    else {
        delete $self->{header}{lc $key};
    }

    return $self;
}

sub set_text {
    my ($self, @text) = @_;

    $self->{text} = join '', @text;
    delete $self->{html};

    return $self;
}

sub set_html {
    my ($self, @html) = @_;

    $self->{html} = join '', @html;
    delete $self->{text};

    return $self;
}

sub analyze {
    my ($self) = @_;

    my $msg = $self->_generate_message;
    my $status = $self->{analyzer}->check($msg);
    $msg->finish;

    if (! $status) {
        return {
            verdict => 'UNKNOWN',
            score   => 0,
            rules   => '',
        };
    }

    my $result = {
        verdict => $status->is_spam ? 'SUSPICIOUS' : 'OK',
        score   => $status->get_hits,
        rules   => $status->get_names_of_tests_hit,
    };

    $status->finish;

    return $result;
}

sub _generate_header {
    my ($self) = @_;

    my $h = Mail::Header->new;

    for my $key ( keys %{$self->{headers}} ) {
        $h->add($key, $_) for @{$self->{headers}{$key}};
    }

    my $set = sub {
        my ($key, $value) = @_;
        $h->get($key) or $h->add($key, $value);
    };

    $set->('To' => q{[e-mail]});
    $set->('From' => Mail::Address->new(
        $self->{metadata}{author} || q{Anonymous Coward},
        $self->{metadata}{email}  || q{[e-mail]},
    )->format);
    $set->('Subject' => $self->{metadata}{subject} || q{Eponymous});

    $set->('Date' => strftime("%a, %d %b %Y %H:%M:%S %z", localtime));

    $set->('Received' => sprintf (
        q{from %s ([%s]) by localhost (Postfix) with SMTP id %s for ; %s},
        $self->{metadata}{ip} || q{127.0.0.1},
        $self->{metadata}{ip} || q{127.0.0.1},
        (join '', rand_chars(set => 'alphanumeric', size => 10)),
        strftime("%a, %d %b %Y %H:%M:%S %z", localtime),
    ));

    $set->('Message-Id', sprintf (
        q{<%s@%s.example.com>},
        (join '', rand_chars(set => 'alphanumeric', size => 32)),
        (join '', rand_chars(set => 'alphanumeric', size => 10)),
    ));

    $set->('MIME-Version', q{1.0});
    $set->('Content-Transfer-Encoding', q{8bit});

    if ( $self->{html} ) {
        $set->('Content-Type', q{text/html; charset="us-ascii"});
    }
    else {
        $set->('Content-Type', q{text/plain; charset="us-ascii"});
    }

    return $h;
}

sub _generate_body {
    my ($self) = @_;

    my @lines;

    if ( $self->{text} ) {
        @lines = (
            (map { "$_: $self->{metadata}{$_}" } sort keys %{$self->{metadata}}),
            (keys %{$self->{metadata}} ? q{} : ()),
            $self->{text},
        );
    }

    elsif ( $self->{html} ) {
        @lines = (
            q{},
            q{Anazlyzed comment},
            (map { "$_: $self->{metadata}{$_}" } sort keys %{$self->{metadata}}),
            q{},
            $self->{html},
            q{},
        );
    }

    return join "\n", @lines;
}

sub _generate_message {
    my ($self) = @_;

    my $msg = Mail::Internet->new(
        Header => $self->_generate_header,
        Body   => [$self->_generate_body],
    );

    if ($Mail::SpamAssassin::VERSION < 3) {
        return Mail::SpamAssassin::NoMailAudit->new(
            data => [ split(/\n/, $msg->as_string) ],
        );
    }

    return Mail::SpamAssassin::Message->new({
        message => $msg->as_string,
    });
}

1;

__END__