File Coverage

blib/lib/Mail/Box/Message.pm
Criterion Covered Total %
statement 57 62 91.9
branch 17 24 70.8
condition 7 15 46.6
subroutine 15 16 93.7
pod 8 10 80.0
total 104 127 81.8


line stmt bran cond sub pod time code
1             # Copyrights 2001-2019 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::Message;
10 34     34   194 use vars '$VERSION';
  34         52  
  34         1431  
11             $VERSION = '3.008';
12              
13 34     34   189 use base 'Mail::Message';
  34         49  
  34         15119  
14              
15 34     34   2953827 use strict;
  34         74  
  34         572  
16 34     34   147 use warnings;
  34         62  
  34         757  
17              
18 34     34   153 use Scalar::Util 'weaken';
  34         90  
  34         18100  
19              
20              
21             sub init($)
22 2041     2041 0 3464 { my ($self, $args) = @_;
23 2041         5186 $self->SUPER::init($args);
24              
25 2041         48968 $self->{MBM_body_type} = $args->{body_type};
26 2041         4460 $self->{MBM_folder} = $args->{folder};
27 2041         4887 weaken($self->{MBM_folder});
28              
29 2041 50       4511 return $self if $self->isDummy;
30 2041         3228 $self;
31             }
32              
33             sub head(;$)
34 19238     19238 1 118493 { my $self = shift;
35 19238 100       37935 return $self->SUPER::head unless @_;
36              
37 2337         2745 my $new = shift;
38 2337         4140 my $old = $self->head;
39 2337         11874 $self->SUPER::head($new);
40              
41 2337 50 66     360101 return unless defined $new || defined $old;
42              
43 2337 100       5087 my $folder = $self->folder
44             or return $new;
45              
46 1600 100 66     18634 if(!defined $new && defined $old && !$old->isDelayed)
    50 66        
      33        
47 55         110 { $folder->messageId($self->messageId, undef);
48 55         113 $folder->toBeUnthreaded($self);
49             }
50             elsif(defined $new && !$new->isDelayed)
51 1545         3754 { $folder->messageId($self->messageId, $self);
52 1545         3865 $folder->toBeThreaded($self);
53             }
54              
55 1600 100       3802 $new || $old;
56             }
57              
58             #-------------------------------------------
59              
60              
61             sub folder(;$)
62 2840     2840 1 4354 { my $self = shift;
63 2840 100       5025 if(@_)
64 142         221 { $self->{MBM_folder} = shift;
65 142         373 weaken($self->{MBM_folder});
66 142         371 $self->modified(1);
67             }
68 2840         11441 $self->{MBM_folder};
69             }
70              
71              
72             sub seqnr(;$)
73 2420     2420 1 5017 { my $self = shift;
74 2420 100       5880 @_ ? $self->{MBM_seqnr} = shift : $self->{MBM_seqnr};
75             }
76              
77              
78             sub copyTo($@)
79 129     129 1 206 { my ($self, $folder) = (shift, shift);
80 129         305 $folder->addMessage($self->clone(@_));
81             }
82              
83              
84             sub moveTo($@)
85 0     0 1 0 { my ($self, $folder, %args) = @_;
86              
87             $args{share} = 1
88 0 0 0     0 unless exists $args{share} || exists $args{shallow_body};
89              
90 0         0 my $added = $self->copyTo($folder, %args);
91 0         0 $self->label(deleted => 1);
92 0         0 $added;
93             }
94              
95             #-------------------------------------------
96              
97              
98             sub readBody($$;$)
99 1572     1572 1 2714603 { my ($self, $parser, $head, $getbodytype) = @_;
100              
101 1572 50       3565 unless($getbodytype)
102 1572         2460 { my $folder = $self->{MBM_folder};
103 1572 50   1662   6761 $getbodytype = sub {$folder->determineBodyType(@_)} if defined $folder;
  1662         212527  
104             }
105              
106 1572         4216 $self->SUPER::readBody($parser, $head, $getbodytype);
107             }
108              
109              
110 28     28 1 49 sub diskDelete() { shift }
111              
112             sub forceLoad() { # compatibility
113 1     1 0 3 my $self = shift;
114 1         7 $self->loadBody(@_);
115 1         7 $self;
116             }
117              
118             #-------------------------------------------
119              
120              
121             sub destruct()
122 55     55 1 13845 { require Mail::Box::Message::Destructed;
123 55         154 Mail::Box::Message::Destructed->coerce(shift);
124             }
125              
126             1;