File Coverage

blib/lib/Mail/Box/Identity.pm
Criterion Covered Total %
statement 97 119 81.5
branch 43 68 63.2
condition 6 10 60.0
subroutine 21 25 84.0
pod 18 20 90.0
total 185 242 76.4


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