svn commit: rev 6297 - incubator/spamassassin/trunk/t

[fe...@apache.org]

Author: felicity
Date: Sun Jan 25 19:27:09 2004
New Revision: 6297

Modified:
   incubator/spamassassin/trunk/t/rule_tests.t
Log:
bug 2963: make rule_tests work with the new mime parser.  also make sure the tests run against the test configs and don't read the site or user prefs files.

Modified: incubator/spamassassin/trunk/t/rule_tests.t
==============================================================================
--- incubator/spamassassin/trunk/t/rule_tests.t	(original)
+++ incubator/spamassassin/trunk/t/rule_tests.t	Sun Jan 25 19:27:09 2004
@@ -18,19 +18,23 @@
 use strict;
 use Test;
 use Mail::SpamAssassin;
-use Data::Dumper; $Data::Dumper::Indent=1;
+use Mail::SpamAssassin::MsgParser;
+#use Data::Dumper; $Data::Dumper::Indent=1;
 use vars qw($num_tests);
 
 $num_tests = 1;
 
 my $sa = Mail::SpamAssassin->new({
-    rules_filename => "$prefix/rules",
+    rules_filename => "$prefix/t/log/test_rules_copy",
+    site_rules_filename => "$prefix/t/log/test_default.cf",
+    userprefs_filename  => "$prefix/masses/spamassassin/user_prefs",
+    local_tests_only    => 1,
+    debug             => 0,
+    dont_copy_prefs   => 1,
 });
 
 $sa->init(0); # parse rules
 
-my $mail = SATest::Message->new();
-
 foreach my $symbol ($sa->{conf}->regression_tests()) {
     foreach my $test ($sa->{conf}->regression_tests($symbol)) {
         my $test_type = $sa->{conf}->{test_types}->{$symbol};
@@ -48,30 +52,37 @@
     foreach my $test ($sa->{conf}->regression_tests($symbol)) {
         my ($ok_or_fail, $string) = @$test;
         # warn("got test_type: $test_type\n");
-        $mail->reset;
-
-        my $msg = Mail::SpamAssassin::PerMsgStatus->new($sa, $mail);
-        my $conf = $msg->{conf};
-
-        # set all scores to 0 so that by default no tests run
-        foreach my $symbol (keys %{$conf->{scores}}) {
-            $conf->{scores}->{$symbol} = 0;
-        }
-
-        my $test_type = $conf->{test_types}->{$symbol};
+        my $test_type = $sa->{conf}->{test_types}->{$symbol};
         next unless defined($test_type);        # score, but no test
 
+	my $mail;
+
         if ($test_type == Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS ||
             $test_type == Mail::SpamAssassin::Conf::TYPE_HEAD_EVALS)
         {
-            my $test_string = $conf->{head_tests}->{$symbol} || $conf->{head_evals}->{$symbol};
+            my $test_string = $sa->{conf}->{head_tests}->{$symbol} || $sa->{conf}->{head_evals}->{$symbol};
             my ($header_name) = $test_string =~ /^(\S+)/;
             # warn("got header name: $header_name - setting to: $string\n");
-            $mail->set_header($header_name => $string);
+	    $mail = Mail::SpamAssassin::MsgParser->parse(["${header_name}: $string\n","\n","\n"]);
         }
         else {
             # warn("setting body: $string\n");
-            $mail->set_body($string);
+	    my $type = "text/plain";
+
+	    # the test strings are too short for the built-in heuristic to pick up
+	    # whether or not the message is html.  so we kind of fudge it here...
+	    if ( $string =~ /<[^>]*>/ ) {
+	      $type = "text/html";
+	    }
+	    $mail = Mail::SpamAssassin::MsgParser->parse(["Content-type: $type\n","\n","$string\n"]);
+        }
+
+        my $msg = Mail::SpamAssassin::PerMsgStatus->new($sa, $mail);
+        my $conf = $msg->{conf};
+
+        # set all scores to 0 so that by default no tests run
+        foreach my $symbol (keys %{$conf->{scores}}) {
+            $conf->{scores}->{$symbol} = 0;
         }
 
 	# Make sure that this test will run
@@ -85,63 +96,3 @@
                 "Test for '$symbol' (type: $test_type) against '$string'" );
     }
 }
-
-package SATest::Message;
-
-sub new {
-    my $class = shift;
-    return bless {headers => {}, body => []}, $class;
-}
-
-sub reset {
-    my $self = shift;
-    $self->{headers} = {};
-    $self->{body} = [];
-}
-
-sub set_header {
-    my $self = shift;
-    my ($header, $value) = @_;
-    # single values because thats all this test harness needs
-    $self->{headers}->{$header} = $value;
-}
-
-sub get_header {
-    my $self = shift;
-    my ($header) = @_;
-    # warn("get_header: $header\n");
-    if (exists $self->{headers}->{$header}) {
-        return $self->{headers}->{$header};
-    }
-    else {
-        return '';
-    }
-}
-
-sub delete_header {
-    my $self = shift;
-    my ($header) = @_;
-    delete $self->{headers}->{$header};
-}
-
-sub get_all_headers {
-    my $self = shift;
-    my @lines;
-    foreach my $header (keys %{$self->{headers}}) {
-        push @lines, "$header: $self->{headers}->{$header}";
-        $lines[-1] .= "\n" unless $lines[-1] =~ /\n$/s;
-    }
-    return wantarray ? @lines : join('', @lines);
-}
-
-sub get_body {
-    my $self = shift;
-    return $self->{body};
-}
-
-sub set_body {
-    my $self = shift;
-    my @lines = @_;
-    $self->{body} = \@lines;
-}
-