#!/usr/bin/perl
#
# usage: t.rules/run [--verbose] [--tests=BOUNCE_MESSAGE,FOO,BAR] [file ...]
#
# TODO: Generate TAP output

use strict;
use warnings;

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'},
);

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;
if (@ARGV) {
  foreach my $f (@ARGV) {
    test_msg($f, $1);
  }
} 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/*>) {
      next if ($f =~ /\.cf$/i);
      (-f $f) and test_msg($f);
    }
  }
}

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

sub test_msg {
  my ($f) = @_;
  ($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) {
      pass($rule, $f, "$testsline");
    } else {
      fail($rule, $f, "want=n got=y: $testsline");
    }
  } else {
    if ($want_hit) {
      fail($rule, $f, "want=y got=n: $testsline");
    } else {
      pass($rule, $f, "$testsline");
    }
  }
}

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

sub fail {
  my ($rule, $f, $err) = @_;
  print "NOT ok on $f for $rule: $err\n";
  $testsfailed++;
}

sub pass {
  my ($rule, $f, $err) = @_;
  if (!$verbose) {
    print "ok on $f\n"
  } else {
    print "ok on $f for $rule: $err\n"
  }
}

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

sub create_spamtest {
  $spamtest->finish() if $spamtest;
  $spamtest = new Mail::SpamAssassin(
    {
      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();
}

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