line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2001-2020 by [Mark Overmeer]. |
2
|
|
|
|
|
|
|
# For other contributors see ChangeLog. |
3
|
|
|
|
|
|
|
# See the manual pages for details on the licensing terms. |
4
|
|
|
|
|
|
|
# Pod stripped from pm file by OODoc 2.02. |
5
|
|
|
|
|
|
|
# This code is part of distribution Mail-Box. Meta-POD processed with |
6
|
|
|
|
|
|
|
# OODoc into POD and HTML manual-pages. See README.md |
7
|
|
|
|
|
|
|
# Copyright Mark Overmeer. Licensed under the same terms as Perl itself. |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Mail::Box::Identity; |
10
|
3
|
|
|
3
|
|
22
|
use vars '$VERSION'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
164
|
|
11
|
|
|
|
|
|
|
$VERSION = '3.009'; |
12
|
|
|
|
|
|
|
|
13
|
3
|
|
|
3
|
|
26
|
use base qw/User::Identity::Item Mail::Reporter/; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
383
|
|
14
|
|
|
|
|
|
|
|
15
|
3
|
|
|
3
|
|
20
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
55
|
|
16
|
3
|
|
|
3
|
|
15
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
123
|
|
17
|
|
|
|
|
|
|
|
18
|
3
|
|
|
3
|
|
20
|
use Mail::Box::Collection; |
|
3
|
|
|
|
|
14
|
|
|
3
|
|
|
|
|
4448
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# tests in tests/52message/30collect.t |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
0
|
1
|
0
|
sub type { "mailbox" } |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub new(@) |
27
|
13
|
|
|
13
|
1
|
272
|
{ my $class = shift; |
28
|
13
|
50
|
|
|
|
36
|
unshift @_, 'name' if @_ % 2; |
29
|
13
|
|
|
|
|
46
|
$class->Mail::Reporter::new(@_); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub init($) |
33
|
13
|
|
|
13
|
0
|
95
|
{ my ($self, $args) = @_; |
34
|
|
|
|
|
|
|
|
35
|
13
|
|
|
|
|
37
|
$self->Mail::Reporter::init($args); |
36
|
13
|
|
|
|
|
127
|
$self->User::Identity::init($args); |
37
|
|
|
|
|
|
|
|
38
|
13
|
|
|
|
|
252
|
$self->{MBI_location} = delete $args->{location}; |
39
|
13
|
|
|
|
|
25
|
$self->{MBI_ftype} = delete $args->{folder_type}; |
40
|
13
|
|
|
|
|
20
|
$self->{MBI_manager} = delete $args->{manager}; |
41
|
13
|
|
50
|
|
|
58
|
$self->{MBI_subf_type} = delete $args->{subf_type}||'Mail::Box::Collection'; |
42
|
13
|
|
|
|
|
22
|
$self->{MBI_only_subs} = delete $args->{only_subs}; |
43
|
13
|
|
|
|
|
24
|
$self->{MBI_marked} = delete $args->{marked}; |
44
|
13
|
|
|
|
|
20
|
$self->{MBI_deleted} = delete $args->{deleted}; |
45
|
13
|
50
|
|
|
|
30
|
$self->{MBI_inferiors} = exists $args->{inferiors} ? $args->{inferiors} : 1; |
46
|
|
|
|
|
|
|
|
47
|
13
|
|
|
|
|
35
|
$self; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#------------------------------------------- |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub fullname(;$) |
54
|
64
|
|
|
64
|
1
|
11272
|
{ my $self = shift; |
55
|
64
|
100
|
66
|
|
|
210
|
my $delim = @_ && defined $_[0] ? shift : '/'; |
56
|
|
|
|
|
|
|
|
57
|
64
|
100
|
|
|
|
140
|
my $parent = $self->parent or return $self->name; |
58
|
42
|
|
|
|
|
2347
|
$parent->parent->fullname($delim) . $delim . $self->name; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub location(;$) |
64
|
77
|
|
|
77
|
1
|
1734
|
{ my $self = shift; |
65
|
77
|
50
|
|
|
|
140
|
return ($self->{MBI_location} = shift) if @_; |
66
|
77
|
100
|
|
|
|
212
|
return $self->{MBI_location} if defined $self->{MBI_location}; |
67
|
|
|
|
|
|
|
|
68
|
52
|
|
|
|
|
103
|
my $parent = $self->parent; |
69
|
52
|
50
|
|
|
|
248
|
unless(defined $parent) |
70
|
0
|
|
|
|
|
0
|
{ $self->log(ERROR => "Toplevel directory requires explicit location"); |
71
|
0
|
|
|
|
|
0
|
return undef; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$self->folderType |
75
|
52
|
|
|
|
|
91
|
->nameOfSubFolder($self->name, $parent->parent->location) |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub folderType() |
81
|
222
|
|
|
222
|
1
|
1226
|
{ my $self = shift; |
82
|
222
|
100
|
|
|
|
500
|
return $self->{MBI_ftype} if defined $self->{MBI_ftype}; |
83
|
|
|
|
|
|
|
|
84
|
147
|
|
|
|
|
279
|
my $parent = $self->parent; |
85
|
147
|
50
|
|
|
|
670
|
unless(defined $parent) |
86
|
0
|
|
|
|
|
0
|
{ $self->log(ERROR => "Toplevel directory requires explicit folder type"); |
87
|
0
|
|
|
|
|
0
|
return undef; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
147
|
|
|
|
|
239
|
$parent->parent->folderType; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub manager() |
96
|
1
|
|
|
1
|
1
|
2
|
{ my $self = shift; |
97
|
1
|
50
|
|
|
|
10
|
return $self->{MBI_manager} if $self->{MBI_manager}; |
98
|
0
|
0
|
|
|
|
0
|
my $parent = $self->parent or return undef; |
99
|
0
|
|
|
|
|
0
|
$self->parent->manager; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub topfolder() |
105
|
11
|
|
|
11
|
1
|
2822
|
{ my $self = shift; |
106
|
11
|
100
|
|
|
|
30
|
my $parent = $self->parent or return $self; |
107
|
7
|
|
|
|
|
431
|
$parent->parent->topfolder; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub onlySubfolders(;$) |
113
|
1
|
|
|
1
|
1
|
3
|
{ my $self = shift; |
114
|
1
|
50
|
|
|
|
6
|
return($self->{MBI_only_subs} = shift) if @_; |
115
|
1
|
50
|
|
|
|
7
|
return $self->{MBI_only_subs} if exists $self->{MBI_only_subs}; |
116
|
0
|
0
|
|
|
|
0
|
$self->parent ? 1 : ! $self->folderType->topFolderWithMessages; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub marked(;$) |
122
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
123
|
0
|
0
|
|
|
|
0
|
@_ ? ($self->{MBI_marked} = shift) : $self->{MBI_marked}; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub inferiors(;$) |
129
|
1
|
|
|
1
|
1
|
2
|
{ my $self = shift; |
130
|
1
|
50
|
|
|
|
7
|
@_ ? ($self->{MBI_inferiors} = shift) : $self->{MBI_inferiors}; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub deleted(;$) |
136
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
137
|
0
|
0
|
|
|
|
0
|
@_ ? ($self->{MBI_deleted} = shift) : $self->{MBI_deleted}; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
#------------------------------------------- |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub subfolders() |
144
|
54
|
|
|
54
|
1
|
6740
|
{ my $self = shift; |
145
|
54
|
|
|
|
|
124
|
my $subs = $self->collection('subfolders'); |
146
|
54
|
100
|
|
|
|
1387
|
return (wantarray ? $subs->roles : $subs) |
|
|
100
|
|
|
|
|
|
147
|
|
|
|
|
|
|
if defined $subs; |
148
|
|
|
|
|
|
|
|
149
|
22
|
|
|
|
|
28
|
my @subs; |
150
|
22
|
50
|
|
|
|
52
|
if(my $location = $self->location) |
151
|
22
|
|
|
|
|
48
|
{ @subs = $self->folderType->listSubFolders |
152
|
|
|
|
|
|
|
( folder => $location |
153
|
|
|
|
|
|
|
); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
else |
156
|
0
|
|
|
|
|
0
|
{ my $mgr = $self->manager; |
157
|
0
|
0
|
|
|
|
0
|
my $top = defined $mgr ? $mgr->folderdir : '.'; |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
0
|
@subs = $self->folderType->listSubFolders |
160
|
|
|
|
|
|
|
( folder => $self->fullname |
161
|
|
|
|
|
|
|
, folderdir => $top |
162
|
|
|
|
|
|
|
); |
163
|
|
|
|
|
|
|
} |
164
|
22
|
100
|
|
|
|
124
|
@subs or return (); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $subf_type |
167
|
4
|
|
50
|
|
|
17
|
= $self->{MBI_subf_type} || ref($self->parent) || 'Mail::Box::Collection'; |
168
|
|
|
|
|
|
|
|
169
|
4
|
|
|
|
|
25
|
$subs = $subf_type->new('subfolders'); |
170
|
|
|
|
|
|
|
|
171
|
4
|
|
|
|
|
20
|
$self->addCollection($subs); |
172
|
4
|
|
|
|
|
143
|
$subs->addRole(name => $_) for @subs; |
173
|
4
|
100
|
|
|
|
88
|
wantarray ? $subs->roles : $subs; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
3
|
|
|
3
|
1
|
1955
|
sub subfolderNames() { map {$_->name} shift->subfolders } |
|
8
|
|
|
|
|
62
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub folder(@) |
183
|
30
|
|
|
30
|
1
|
9046
|
{ my $self = shift; |
184
|
30
|
100
|
66
|
|
|
127
|
return $self unless @_ && defined $_[0]; |
185
|
|
|
|
|
|
|
|
186
|
22
|
100
|
|
|
|
43
|
my $subs = $self->subfolders or return undef; |
187
|
21
|
100
|
|
|
|
1045
|
my $nest = $subs->find(shift) or return undef; |
188
|
19
|
|
|
|
|
153
|
$nest->folder(@_); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub open(@) |
194
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
195
|
0
|
|
|
|
|
0
|
$self->manager->open($self->fullname, type => $self->folderType, @_); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub foreach($) |
201
|
24
|
|
|
24
|
1
|
242
|
{ my ($self, $code) = @_; |
202
|
24
|
|
|
|
|
60
|
$code->($self); |
203
|
|
|
|
|
|
|
|
204
|
24
|
100
|
|
|
|
312
|
my $subs = $self->subfolders or return (); |
205
|
8
|
|
|
|
|
394
|
$_->foreach($code) for $subs->sorted; |
206
|
8
|
|
|
|
|
21
|
$self; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub addSubfolder(@) |
212
|
1
|
|
|
1
|
0
|
2
|
{ my $self = shift; |
213
|
1
|
|
|
|
|
4
|
my $subs = $self->subfolders; |
214
|
|
|
|
|
|
|
|
215
|
1
|
50
|
|
|
|
8
|
if(defined $subs) { ; } |
|
|
50
|
|
|
|
|
|
216
|
|
|
|
|
|
|
elsif(!$self->inferiors) |
217
|
0
|
|
|
|
|
0
|
{ my $name = $self->fullname; |
218
|
0
|
|
|
|
|
0
|
$self->log(ERROR => "It is not permitted to add subfolders to $name"); |
219
|
0
|
|
|
|
|
0
|
return undef; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
else |
222
|
1
|
|
|
|
|
8
|
{ $subs = $self->{MBI_subf_type}->new('subfolders'); |
223
|
1
|
|
|
|
|
6
|
$self->addCollection($subs); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
1
|
|
|
|
|
34
|
$subs->addRole(@_); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub remove(;$) |
232
|
2
|
|
|
2
|
1
|
5
|
{ my $self = shift; |
233
|
|
|
|
|
|
|
|
234
|
2
|
|
|
|
|
8
|
my $parent = $self->parent; |
235
|
2
|
50
|
|
|
|
14
|
unless(defined $parent) |
236
|
0
|
|
|
|
|
0
|
{ $self->log(ERROR => "The toplevel folder cannot be removed this way"); |
237
|
0
|
|
|
|
|
0
|
return (); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
2
|
100
|
|
|
|
15
|
return $parent->removeRole($self->name) |
241
|
|
|
|
|
|
|
unless @_; |
242
|
|
|
|
|
|
|
|
243
|
1
|
|
|
|
|
3
|
my $name = shift; |
244
|
1
|
50
|
|
|
|
2
|
my $subs = $self->subfolders or return (); |
245
|
1
|
|
|
|
|
60
|
$subs->removeRole($name); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub rename($;$) |
251
|
1
|
|
|
1
|
1
|
404
|
{ my ($self, $folder, $newname) = @_; |
252
|
1
|
50
|
|
|
|
6
|
$newname = $self->name unless defined $newname; |
253
|
|
|
|
|
|
|
|
254
|
1
|
|
|
|
|
3
|
my $away = $self->remove; |
255
|
1
|
|
|
|
|
27
|
$away->name($newname); |
256
|
|
|
|
|
|
|
|
257
|
1
|
|
|
|
|
7
|
$folder->addSubfolder($away); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
#------------------------------------------- |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
1; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|