line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Sieve::Script::Action; |
2
|
9
|
|
|
9
|
|
23591
|
use strict; |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
287
|
|
3
|
9
|
|
|
9
|
|
47
|
use warnings; |
|
9
|
|
|
|
|
16
|
|
|
9
|
|
|
|
|
336
|
|
4
|
|
|
|
|
|
|
|
5
|
9
|
|
|
9
|
|
43
|
use base qw(Class::Accessor::Fast); |
|
9
|
|
|
|
|
16
|
|
|
9
|
|
|
|
|
1549
|
|
6
|
|
|
|
|
|
|
|
7
|
9
|
|
|
9
|
|
5031
|
use vars qw($VERSION); |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
3250
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$VERSION = '0.08'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(qw(command param)); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub new |
14
|
|
|
|
|
|
|
{ |
15
|
73
|
|
|
73
|
1
|
4274
|
my ($class, $init) = @_; |
16
|
|
|
|
|
|
|
|
17
|
73
|
|
33
|
|
|
370
|
my $self = bless ({}, ref ($class) || $class); |
18
|
|
|
|
|
|
|
|
19
|
73
|
|
|
|
|
142
|
my @MATCH = qw(\s?((\".*?\"|(.*)?))); |
20
|
|
|
|
|
|
|
|
21
|
73
|
|
|
|
|
1392
|
my ($command, $param) = $init =~ m/(keep|discard|redirect|stop|reject|fileinto)@MATCH?/sgi; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# RFC 5230 |
24
|
|
|
|
|
|
|
#Usage: vacation [":days" number] [":subject" string] |
25
|
|
|
|
|
|
|
# [":from" string] [":addresses" string-list] |
26
|
|
|
|
|
|
|
# [":mime"] [":handle" string] |
27
|
|
|
|
|
|
|
#TODO make object vacation |
28
|
73
|
100
|
|
|
|
242
|
if ( $init =~ m/vacation (.*")/sgi ) { |
29
|
5
|
|
|
|
|
9
|
$command = 'vacation'; |
30
|
5
|
|
|
|
|
15
|
$param = $1; |
31
|
|
|
|
|
|
|
}; |
32
|
|
|
|
|
|
|
|
33
|
73
|
100
|
|
|
|
300
|
$self->command(lc($command)) if $command; |
34
|
73
|
100
|
|
|
|
510
|
$self->param($param) if $param ; |
35
|
|
|
|
|
|
|
|
36
|
73
|
|
|
|
|
368
|
return $self; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub equals { |
40
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
41
|
0
|
|
|
|
|
|
my $object = shift; |
42
|
|
|
|
|
|
|
|
43
|
0
|
0
|
|
|
|
|
return 0 unless (defined $object); |
44
|
0
|
0
|
|
|
|
|
return 0 unless ($object->isa('Net::Sieve::Script::Action')); |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
my @accessors = qw( param command ); |
47
|
|
|
|
|
|
|
|
48
|
0
|
|
|
|
|
|
foreach my $accessor ( @accessors ) { |
49
|
0
|
|
|
|
|
|
my $myvalue = $self->$accessor; |
50
|
0
|
|
|
|
|
|
my $theirvalue = $object->$accessor; |
51
|
0
|
0
|
|
|
|
|
if (defined $myvalue) { |
52
|
0
|
0
|
|
|
|
|
return 0 unless (defined $theirvalue); |
53
|
0
|
0
|
|
|
|
|
return 0 unless ($myvalue eq $theirvalue); |
54
|
|
|
|
|
|
|
} else { |
55
|
0
|
0
|
|
|
|
|
return 0 if (defined $theirvalue); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
0
|
|
|
|
|
|
return 1; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 NAME |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Net::Sieve::Script::Action - parse and write actions in sieve scripts |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 SYNOPSIS |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
use Net::Sieve::Script::Action; |
69
|
|
|
|
|
|
|
$action = Net::Sieve::Script::Action->new('redirect "bart@example.edu"'); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
or |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
$action = Net::Sieve::Script::Action->new(); |
74
|
|
|
|
|
|
|
$action->command('redirect'); |
75
|
|
|
|
|
|
|
$action->param('"bart@example.edu"'); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 DESCRIPTION |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Action object for L, with command and optional param. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Support RFC 5228, RFC 5230 (vacation), regex draft |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 METHODS |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 CONSTRUCTOR new |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Argument : "command param" string, |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
parse valid commands from RFCs, param are not validate. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head2 command |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
read command : C<< $action->command() >> |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
set command : C<< $action->command('stop') >> |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head2 param |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
read param : C<< $action->param() >> |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
set param : C<< $action->param(' :days 3 "I am away this week."') >> |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 equals |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
return 1 if actions are equals |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 AUTHOR |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Yves Agostini - Univ Metz - |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
L |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 COPYRIGHT |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
This program is free software; you can redistribute |
117
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
The full text of the license can be found in the |
120
|
|
|
|
|
|
|
LICENSE file included with this module. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=cut |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
return 1; |