view release on metacpan or  search on metacpan

lib/Mail/SpamAssassin/SimpleClient.pm  view on Meta::CPAN

use strict;
use warnings;
use 5.006;
package Mail::SpamAssassin::SimpleClient;
{
  $Mail::SpamAssassin::SimpleClient::VERSION = '0.102';
}
# ABSTRACT: easy client to SpamAssassin's spamd

use Carp ();
use Email::MIME;
use Mail::SpamAssassin::Client;
use Mail::SpamAssassin::SimpleClient::Result;


sub new {
  my ($class, $arg) = @_;
  $arg ||= {};

  $arg->{host} = 'localhost' unless defined $arg->{host};
  $arg->{port} = 783 unless defined $arg->{port};
  $arg->{timeout} = 120 unless defined $arg->{timeout};

  bless $arg => $class;
}


sub check {
  my ($self, $message) = @_;

  local $SIG{ALRM} = sub {
    Carp::croak "SpamAssassin failed to respond within $self->{timeout}s";
  };

  alarm $self->{timeout};

  # Maybe we should keep one spamc and ping each check.  Whatever, I'll deal
  # with that when it turns out to matter. -- rjbs, 2007-03-21
  my $spamc = Mail::SpamAssassin::Client->new({
    host => $self->{host},
    port => $self->{port},
    ($self->{username} ? (username => $self->{username}) : ()),
  });

  my $response = $spamc->process($message->as_string);

  alarm 0;
# X-Spam-Flag: YES
# X-Spam-Checker-Version: SpamAssassin 3.1.0 (2005-09-13) on emerald.pobox.com
# X-Spam-Status: Yes, score=1000.8 required=5.0 tests=ENGLISH_UCE_SUBJECT,GTUBE,
#   NO_REAL_NAME,NO_RECEIVED,NO_RELAYS autolearn=no version=3.1.0
# X-Spam-Level: **************************************************
# X-Spam-Report: *  1.4 NO_DNS_FOR_FROM DNS: Envelope sender has no MX or A DNS records *  0.0 MISSING_MID Missing Message-Id: header * -0.0 NO_RELAYS Informational: message was not relayed via SMTP

  # use Data::Dumper;
  # warn Dumper($response);

  my $response_email = Email::MIME->new($response->{message});

  # We can't just look for tests=\S because when the tests wrap and are
  # unfolded, a space is introduced betwen tests.
  my $status = $response_email->header('X-Spam-Status');

  $status =~ s/,\s([A-Z])/,$1/g;
  my ($tests) = $status =~ /tests=(.+?)(?:\s[a-z]|$)/;
  my ($version) = $status =~ /version=(\S+)/;

  my @tests = split /,/, $tests;

  # isspam will be True or False
  # score
  # threshold

  my (%test_score, %test_desc);

  if ($response->{isspam} eq 'True') {
    # prefer the X-Spam-Report header before checking the body
    my $report = $response_email->header('X-Spam-Report');
    if( $report ) {
        foreach my $report_part (split(/\s*\*\s*/, $report)) {
            next unless $report_part;
            my ($score, $name, $desc) = $report_part =~ /^(-?[\d.]+)\s+(\S+)\s+(.*)$/;
            $test_score{ $name } = $score;
            $test_desc{ $name } = $desc;