File Coverage

blib/lib/Mail/Message/Body/Lines.pm
Criterion Covered Total %
statement 56 70 80.0
branch 10 16 62.5
condition 1 3 33.3
subroutine 17 20 85.0
pod 9 9 100.0
total 93 118 78.8


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-Message. 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::Message::Body::Lines;
10 34     34   5145 use vars '$VERSION';
  34         76  
  34         1943  
11             $VERSION = '3.013';
12              
13 34     34   216 use base 'Mail::Message::Body';
  34         100  
  34         12989  
14              
15 34     34   323 use strict;
  34         113  
  34         862  
16 34     34   197 use warnings;
  34         625  
  34         1228  
17              
18 34     34   4287 use Mail::Box::Parser;
  34         412  
  34         1038  
19 34     34   17474 use IO::Lines;
  34         178328  
  34         1673  
20              
21 34     34   247 use Carp;
  34         80  
  34         28859  
22              
23              
24             sub _data_from_filename(@)
25 0     0   0 { my ($self, $filename) = @_;
26              
27 0         0 local *IN;
28              
29 0 0       0 unless(open IN, '<', $filename)
30 0         0 { $self->log(ERROR =>
31             "Unable to read file $filename for message body lines: $!");
32 0         0 return;
33             }
34              
35 0         0 $self->{MMBL_array} = [ ];
36              
37 0         0 close IN;
38 0         0 $self;
39             }
40              
41             sub _data_from_filehandle(@)
42 1     1   3 { my ($self, $fh) = @_;
43             $self->{MMBL_array} =
44 1 50       6 ref $fh eq 'Mail::Box::FastScalar' ? $fh->getlines : [ $fh->getlines ];
45 1         300 $self
46             }
47              
48             sub _data_from_glob(@)
49 0     0   0 { my ($self, $fh) = @_;
50 0         0 $self->{MMBL_array} = [ <$fh> ];
51 0         0 $self;
52             }
53              
54             sub _data_from_lines(@)
55 179     179   388 { my ($self, $lines) = @_;
56 179 100       591 $lines = [ split /^/, $lines->[0] ] # body passed in one string.
57             if @$lines==1;
58              
59 179         396 $self->{MMBL_array} = $lines;
60 179         499 $self;
61             }
62              
63             #------------------------------------------
64              
65             sub clone()
66 13     13 1 32 { my $self = shift;
67 13         36 ref($self)->new(data => [ $self->lines ], based_on => $self);
68             }
69              
70             #------------------------------------------
71              
72 129     129 1 6700 sub nrLines() { scalar @{shift->{MMBL_array}} }
  129         475  
73              
74             #------------------------------------------
75             # Optimized to be computed only once.
76              
77             sub size()
78 123     123 1 187 { my $self = shift;
79 123 100       404 return $self->{MMBL_size} if exists $self->{MMBL_size};
80              
81 60         98 my $size = 0;
82 60         91 $size += length $_ foreach @{$self->{MMBL_array}};
  60         203  
83 60         179 $self->{MMBL_size} = $size;
84             }
85              
86             #------------------------------------------
87              
88 127     127 1 1057 sub string() { join '', @{shift->{MMBL_array}} }
  127         1132  
89              
90             #------------------------------------------
91              
92 90 100   90 1 7383 sub lines() { wantarray ? @{shift->{MMBL_array}} : shift->{MMBL_array} }
  59         311  
93              
94             #------------------------------------------
95              
96 0     0 1 0 sub file() { IO::Lines->new(shift->{MMBL_array}) }
97              
98             #------------------------------------------
99              
100             sub print(;$)
101 30     30 1 109 { my $self = shift;
102 30   33     69 my $fh = shift || select;
103 30 50       154 if(ref $fh eq 'GLOB') { print $fh @{$self->{MMBL_array}} }
  0         0  
  0         0  
104 30         45 else { $fh->print(@{$self->{MMBL_array}}) }
  30         101  
105 30         368 $self;
106             }
107              
108             #------------------------------------------
109              
110             sub read($$;$@)
111 32     32 1 99 { my ($self, $parser, $head, $bodytype) = splice @_, 0, 4;
112 32         107 my ($begin, $end, $lines) = $parser->bodyAsList(@_);
113 32 50       77 $lines or return undef;
114              
115 32         139 $self->fileLocation($begin, $end);
116 32         63 $self->{MMBL_array} = $lines;
117 32         127 $self;
118             }
119              
120             #------------------------------------------
121              
122             sub endsOnNewline()
123 36     36 1 79 { my $last = shift->{MMBL_array}[-1];
124 36 50       319 !defined $last || $last =~ m/\n$/;
125             }
126              
127             #------------------------------------------
128              
129             1;