1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
# -*- Mode: cperl -*-
use Test::More tests => 40;
use strict;
use warnings;
my ($tmpdir, %conf);
BEGIN {
$tmpdir = "/tmp/spamcat.t.$$";
%conf = (dbpath => "$tmpdir/spamcat.sqlite3",
default_count => 20,
domains => ['spamcat.example.com', 'spamcat2.example.com']);
system("rm -rf $tmpdir") == 0
or die "Couldn't remove $tmpdir: $!\n";
mkdir $tmpdir;
system("sqlite3 $conf{dbpath} < config/create-tables.sql") == 0
or die "Couldn't create $conf{dbpath}: $!\n";
}
END {
system "rm -rf $tmpdir";
}
require_ok 'SpamCat';
ok(SpamCat->can('new'), 'Has constructor');
my $sch = SpamCat->new(%conf);
ok(defined $sch, 'Constructor returns instance');
ok(SpamCat->can('decrement_count'), 'Has count decrementor');
is($sch->decrement_count('foo'), 19,
'Default count for new sender');
is($sch->decrement_count('foo'), 18, 'Existing sender decrements');
ok(SpamCat->can('get_count'), 'Has count getter');
is($sch->get_count('foo'), 18, 'Returns existing sender count');
ok(!defined $sch->get_count('doesntexist'),
'Non-existant sender has undefined count');
ok(SpamCat->can('set_count'), 'Has count setter');
is($sch->set_count('bar', 10), 10, 'Setting count returns existing count');
is($sch->set_count('bar', 1), 1, 'Updating existing count to 1 returns 1');
is($sch->decrement_count('bar'), 0, 'Decrementing count from 1 returns 0');
is($sch->decrement_count('bar'), 0, 'Decrementing count from 0 returns 0');
ok(SpamCat->can('parse_to'));
my @addrs;
@addrs = $sch->parse_to('foo@bar.com');
is($addrs[0], 'foo@bar.com');
@addrs = $sch->parse_to('"FooBar" <foo@bar.com>');
is($addrs[0], 'foo@bar.com');
@addrs = $sch->parse_to('"Foo@Bar" <baz@pham.com>');
is($addrs[0], 'baz@pham.com');
@addrs = $sch->parse_to('"Foo@Bar" <baz@pham.com>', '"a@b <one@two.com>"');
is($addrs[0], 'baz@pham.com');
is($addrs[1], 'one@two.com');
ok(SpamCat->can('filter'), 'Has filter method');
test_file('foo');
test_file('foo2');
test_file('multiple');
test_file('wrongdomain');
test_file('nosubj');
test_file('bar');
$sch->set_count('always-allowed', -1);
test_file('always-allowed', 1);
ok(SpamCat->can('get_table'));
my @rows = @{$sch->get_table()};
is($#rows, 4);
@rows = sort { $a->{sender} cmp $b->{sender} } @rows;
is($rows[0]->{sender}, 'always-allowed');
is($rows[0]->{count}, -1);
is($rows[1]->{sender}, 'bar');
is($rows[1]->{count}, 0);
is($rows[2]->{sender}, 'foo');
is($rows[2]->{count}, 15);
is($rows[3]->{sender}, 'name1');
is($rows[3]->{count}, 19);
is($rows[4]->{sender}, 'nosubj');
is($rows[4]->{count}, 19);
sub test_file {
my ($filen) = @_;
my $input = IO::File->new("<t/fixtures/$filen") ||
die "Couldn't open $filen: $!\n";
my $inputfd = fileno($input);
open STDIN, ">&$inputfd" || die "Couldn't open $inputfd: $!\n";
open STDOUT, ">$tmpdir/$filen" || die "Couldn't open $tmpdir/$filen: $!\n";
$sch->filter();
local $/;
my $fh = IO::File->new("<$tmpdir/$filen") ||
die "Couldn't open $tmpdir/$filen for reading: $!\n";
my $got = <$fh>;
$fh->close;
$fh = IO::File->new("<t/fixtures/$filen.expected") ||
die "Couldn't open t/fixtures/$filen.expected for reading: $!\n";
my $expected = <$fh>;
$fh->close;
is($got, $expected) || diag("Test for $filen output failed.");
}
|
