File Coverage

lib/Net/Sieve/Script/Action.pm
Criterion Covered Total %
statement 22 35 62.8
branch 6 18 33.3
condition 1 3 33.3
subroutine 5 6 83.3
pod 2 2 100.0
total 36 64 56.2


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;