File Coverage

blib/lib/Mail/Box/Dir.pm
Criterion Covered Total %
statement 72 78 92.3
branch 14 22 63.6
condition 9 17 52.9
subroutine 22 24 91.6
pod 6 7 85.7
total 123 148 83.1


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 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.03.
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::Dir;
10 14     14   1154 use vars '$VERSION';
  14         30  
  14         705  
11             $VERSION = '3.010';
12              
13 14     14   632 use base 'Mail::Box';
  14         37  
  14         4242  
14              
15 14     14   124 use strict;
  14         61  
  14         455  
16 14     14   97 use warnings;
  14         36  
  14         482  
17 14     14   4663 use filetest 'access';
  14         124  
  14         125  
18              
19 14     14   6590 use Mail::Box::Dir::Message;
  14         39  
  14         553  
20              
21 14     14   95 use Mail::Message::Body::Lines;
  14         32  
  14         318  
22 14     14   85 use Mail::Message::Body::File;
  14         93  
  14         357  
23 14     14   3193 use Mail::Message::Body::Delayed;
  14         36  
  14         365  
24 14     14   92 use Mail::Message::Body::Multipart;
  14         37  
  14         348  
25              
26 14     14   76 use Mail::Message::Head;
  14         31  
  14         324  
27 14     14   6593 use Mail::Message::Head::Delayed;
  14         38  
  14         425  
28              
29 14     14   93 use Carp;
  14         41  
  14         768  
30 14     14   82 use File::Copy;
  14         28  
  14         613  
31 14     14   72 use File::Spec;
  14         28  
  14         355  
32 14     14   92 use File::Basename;
  14         34  
  14         10147  
33              
34              
35             sub init($)
36 35     35 0 128 { my ($self, $args) = @_;
37              
38 35   50 98   311 $args->{body_type} ||= sub {'Mail::Message::Body::Lines'};
  98         268  
39              
40             return undef
41 35 50       218 unless $self->SUPER::init($args);
42              
43 35         142 my $class = ref $self;
44             my $directory = $self->{MBD_directory}
45 35   33     256 = $args->{directory} || $self->directory;
46              
47 35 100 33     688 if(-d $directory) {;}
    50          
48             elsif($args->{create} && $class->create($directory, %$args)) {;}
49             else
50 0         0 { $self->log(NOTICE => "No directory $directory for folder of $class");
51 0         0 return undef;
52             }
53              
54             # About locking
55              
56 35         199 for($args->{lock_file})
57 35 0       257 { $self->locker->filename
    50          
58             ( !defined $_ ? File::Spec->catfile($directory, '.lock') # default
59             : File::Spec->file_name_is_absolute($_) ? $_ # absolute
60             : File::Spec->catfile($directory, $_) # relative
61             );
62             }
63              
64             # Check if we can write to the folder, if we need to.
65              
66 35 50 66     131 if($self->writable && -e $directory && ! -w $directory)
      66        
67 0         0 { $self->log(WARNING=> "Folder directory $directory is write-protected.");
68 0         0 $self->{MB_access} = 'r';
69             }
70              
71 35         196 $self;
72             }
73              
74             #-------------------------------------------
75              
76             sub organization() { 'DIRECTORY' }
77              
78             #-------------------------------------------
79              
80              
81             sub directory()
82 153     153 1 255 { my $self = shift;
83              
84             $self->{MBD_directory}
85 153   66     614 ||= $self->folderToDirectory($self->name, $self->folderdir);
86             }
87              
88             #-------------------------------------------
89              
90             sub nameOfSubFolder($;$)
91 70     70 1 143 { my ($thing, $name) = (shift, shift);
92 70 50       173 my $parent = @_ ? shift : ref $thing ? $thing->directory : undef;
    100          
93 70 50       269 defined $parent ? "$parent/$name" : $name;
94             }
95              
96             #-------------------------------------------
97              
98              
99             sub folderToDirectory($$)
100 91     91 1 247 { my ($class, $name, $folderdir) = @_;
101 91 100       376 my $dir = ( $name =~ m#^=\/?(.*)# ? "$folderdir/$1" : $name);
102 91         209 $dir =~ s!/$!!;
103 91         417 $dir;
104             }
105              
106             sub storeMessage($)
107 780     780 1 1305 { my ($self, $message) = @_;
108 780         2189 $self->SUPER::storeMessage($message);
109 780 100       1613 my $fn = $message->filename or return $message;
110 738         3098 $self->{MBD_by_fn}{$fn} = $message;
111             }
112              
113              
114 0     0 1   sub messageInFile($) { $_[0]->{MBD_by_fn}{$_[1]} }
115              
116              
117 0     0 1   sub readMessageFilenames() {shift->notImplemented}
118              
119             #-------------------------------------------
120              
121             1;