felicity at apache
Jan 25, 2004, 8:27 PM
Post #1 of 1
(109 views)
Permalink
|
|
svn commit: rev 6297 - incubator/spamassassin/trunk/t
|
|
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;
-}
-
|
