t.rules/run

#!/usr/bin/perl

use strict;
use warnings;

sub usage {
  die "
usage: t.rules/run [options] [file_or_dir ...]

options:
--verbose       Verbose output
--tests=BOUNCE_MESSAGE,FOO,BAR   
                Select tests to run, instead of selecting from
                the specified files/dirs
  ";
}

use Test::More qw(no_plan);
use Getopt::Long;
Getopt::Long::Configure(
  qw(bundling no_getopt_compat
    permute no_auto_abbrev no_ignore_case)
);

my %opt = (
);

GetOptions(
  'tests|t=s' => \$opt{'tests'},
  'verbose|v' => \$opt{'verbose'},
  'debug|D' => \$opt{'debug'},
) or usage();

my $spamtest;
my $lastconfigtext = '';
my $configtext = '';

use lib 'lib';
use lib 'blib/lib';
use Mail::SpamAssassin;
create_spamtest();

my $verbose = $opt{'verbose'};
$opt{'tests'} ||= join " ", <t.rules/*>;
my $testsfailed = 0;
$| = 1;

if (@ARGV) {
  foreach my $f (@ARGV) {
    if (-d $f) {    # recurse down 1 level
      $f =~ s/\/+$//;
      foreach my $subf (<$f/*>) {
        test_msg($subf);
      }
    } else {        # files directly
      test_msg($f);
    }
  }
} else {
  main();
}

$spamtest->finish();
exit $testsfailed;

# ---------------------------------------------------------------------------

sub main {
  foreach my $rule (split(/[\s,]/, $opt{'tests'})) {
    $rule =~ s/^t.rules\///;
    chomp $rule;

    my $ruledir="t.rules/$rule";
    next unless -d $ruledir;

    warn "\nRunning tests for $rule:\n" if $verbose;
    foreach my $f (<$ruledir/*>) {
      (-f $f) and test_msg($f);
    }
  }
}

# ---------------------------------------------------------------------------

sub test_msg {
  my ($f) = @_;
  return if ($f =~ /\.cf$/i);
  $f =~ s,//+,/,gs;             # multiple slashes are ok
  ($f =~ /\/([^\/]+)\/[^\/]+$/) or warn "cannot find rule in '$f'";
  my $rule = $1;

  # if the filename starts with "fp", we want a _miss_ for the named rule
  my $want_hit = 1;
  if ($f =~ /\/fp/i) {
    $want_hit = 0;
  }

  $configtext = '';
  if (-f "$f.cf") {
    open (CF, "<$f.cf") or warn "cannot open $f.cf";
    $configtext = join("", <CF>);
    close CF;
  }
  recreate_spamtest_if_config_differs();

  open (STDIN, "<$f") or warn "cannot open $f";
  my $mail = $spamtest->parse();
  my $status = $spamtest->check($mail);
  my $testsline = $status->get_names_of_tests_hit().",".$status->get_names_of_subtests_hit();
  $mail->finish();
  $status->finish();
  close STDIN;

  if ($testsline =~ /(?:[ ,]|^)\Q$rule\E(?:[ ,]|$)/) {
    if ($want_hit) {
      mypass($rule, $f, "$testsline");
    } else {
      myfail($rule, $f, "want=n got=y: $testsline");
    }
  } else {
    if ($want_hit) {
      myfail($rule, $f, "want=y got=n: $testsline");
    } else {
      mypass($rule, $f, "$testsline");
    }
  }
}

# ---------------------------------------------------------------------------

sub myfail {
  my ($rule, $f, $err) = @_;
  ok 0, "$f for $rule: $err";
  $testsfailed++;
}

sub mypass {
  my ($rule, $f, $err) = @_;
  if (!$verbose) {
    ok 1, $f;
  } else {
    ok 1, "$f for $rule: $err";
  }
}

# ---------------------------------------------------------------------------

sub create_spamtest {
  $spamtest->finish() if $spamtest;
  $spamtest = Mail::SpamAssassin->new(
    {
      rules_filename      => 'rules',
      site_rules_filename => 'rules/local.cf',
      userprefs_filename  => '',
      local_tests_only    => 1,
      debug               => $opt{debug},
      dont_copy_prefs     => 1,
      post_config_text    => "use_learner 0\nuse_auto_whitelist 0\n".$configtext,
      require_rules       => 1,
    }
  );
  $spamtest->init(1);
}

sub recreate_spamtest_if_config_differs {
  if ($configtext eq $lastconfigtext) {
    return;
  }
  $lastconfigtext = $configtext;
  create_spamtest();
}

# ---------------------------------------------------------------------------