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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
# -*- perl -*-
# t/001_load.t - check module loading and create testing directory
use Test::More tests => 14;
use strict;
use lib qw(lib);
BEGIN { use_ok( 'Net::Sieve::Script' ); }
my $test_script='require "fileinto";
# Place all these in the "Test" folder
if header :contains "Subject" "[Test] test" {
fileinto "Test";
}';
my $object = Net::Sieve::Script->new ();
isa_ok ($object, 'Net::Sieve::Script');
use_ok( 'Net::Sieve::Script::Rule' );
use_ok( 'Net::Sieve::Script::Condition' );
use_ok( 'Net::Sieve::Script::Action' );
$object = Net::Sieve::Script->new ($test_script);
isa_ok ($object, 'Net::Sieve::Script');
is ($object->raw, $test_script, "set in raw for simple script");
#print length($object->raw);
is( $object->require,'"fileinto"',"match require in simple script");
my $test_script2='#require ["fileinto","reject","vacation","imapflags","relational","comparator-i;ascii-numeric","regex","notify"];
require ["fileinto","regex"];
if header :contains "Received" "compilerlist@example.com"
{
fileinto "mlists.compiler";
# stop;
}
if header :regex :comparator "i;ascii-casemap" "Subject" "^Release notice:"
{
fileinto "releases";
stop;
}
if allof (header :regex :comparator "i;ascii-casemap" "Subject" "^Output file listing from [a-z]*backup$",
header :regex :comparator "i;ascii-casemap" "From" "^BackupUser")
{
fileinto "Backup listings";
stop;
}
if Header :is "Subject" "Daily virus scan reminder"
{
discard;
stop;
}
if not exists ["From","Date"] {
discard;
}';
my $test_script3 = '
# Example Sieve Filter
require ["fileinto", "reject"];
#
if size :over 1M
{
reject text:
Please do not send me large attachments.
Put your file on a server and send me the URL.
Thank you.
.... Fred
.
;
stop;
}
#
# Handle messages from known mailing lists
# Move messages from IETF filter discussion list to filter folder
#
if header :is "Sender" "owner-ietf-mta-filters@imc.org"
{
fileinto "filter"; # move to "filter" folder
}
#
# Keep all messages to or from people in my company
#
elsif address :domain :is ["From", "To"] "example.com"
{
keep; # keep in "In" folder
}
#
# Try and catch unsolicited email. If a message is not to me,
# or it contains a subject known to be spam, file it away.
#
elsif anyof (not address :all :contains
["To", "Cc", "Bcc"] "me@example.com",
header :matches "subject"
["*make*money*fast*", "*university*dipl*mas*"])
{
# If message header does not contain my address,
# it s from a list.
fileinto "spam"; # move to "spam" folder
}
else
{
# Move all other (non-company) mail to "personal"
# folder.
fileinto "personal";
}
';
$object->raw($test_script3);
is ($object->raw, $test_script3, "set raw script3");
#read rules from raw
$object->read_rules();
is( $object->require,'["fileinto", "reject"]',"match require in script3");
is ($object->_strip,$object->_strip($object->write_script), "parse raw script3");
#set new rules without raw
$object->read_rules($test_script2);
is( $object->require,'["fileinto","reject","vacation","imapflags","relational","comparator-i;ascii-numeric","regex","notify"]',"match original require for script2");
my $res_script = $object->write_script;
is ( $object->require, '["fileinto", "regex"]', "new require for script2");
is (lc($object->_strip($test_script2)),lc($object->_strip($res_script)), "parse script2 ( no raw, test case in keywords )");
#open F, "t/loud.txt";
#my @test_loud = <F>;
#close F;
#print @test_loud;
#$object->raw(join "\n",@test_loud);
#$object->read_rules();
#print $object->write_script;
#is ($object->_strip,$object->_strip($object->write_script), "parse raw script3");
#print $object->write_script;
#TODO test $object->swap_rules(1,5);
#TODO test $object->remove_rule(3);
#TODO test $object->del_rule(3);
|
