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-2022 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 31     31   5194 use vars '$VERSION';
  31         57  
  31         1581  
11             $VERSION = '3.012';
12              
13 31     31   170 use base 'Mail::Message::Body';
  31         53  
  31         11022  
14              
15 31     31   303 use strict;
  31         533  
  31         751  
16 31     31   162 use warnings;
  31         322  
  31         996  
17              
18 31     31   2699 use Mail::Box::Parser;
  31         65  
  31         688  
19 31     31   14927 use IO::Lines;
  31         140909  
  31         1406  
20              
21 31     31   251 use Carp;
  31         61  
  31         22014  
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       3 ref $fh eq 'Mail::Box::FastScalar' ? $fh->getlines : [ $fh->getlines ];
45 1         257 $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 149     149   334 { my ($self, $lines) = @_;
56 149 100       442 $lines = [ split /^/, $lines->[0] ] # body passed in one string.
57             if @$lines==1;
58              
59 149         321 $self->{MMBL_array} = $lines;
60 149         405 $self;
61             }
62              
63             #------------------------------------------
64              
65             sub clone()
66 9     9 1 15 { my $self = shift;
67 9         22 ref($self)->new(data => [ $self->lines ], based_on => $self);
68             }
69              
70             #------------------------------------------
71              
72 113     113 1 4888 sub nrLines() { scalar @{shift->{MMBL_array}} }
  113         397  
73              
74             #------------------------------------------
75             # Optimized to be computed only once.
76              
77             sub size()
78 109     109 1 168 { my $self = shift;
79 109 100       391 return $self->{MMBL_size} if exists $self->{MMBL_size};
80              
81 54         92 my $size = 0;
82 54         90 $size += length $_ foreach @{$self->{MMBL_array}};
  54         188  
83 54         175 $self->{MMBL_size} = $size;
84             }
85              
86             #------------------------------------------
87              
88 87     87 1 1085 sub string() { join '', @{shift->{MMBL_array}} }
  87         874  
89              
90             #------------------------------------------
91              
92 85 100   85 1 4962 sub lines() { wantarray ? @{shift->{MMBL_array}} : shift->{MMBL_array} }
  55         274  
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 82 { my $self = shift;
102 30   33     64 my $fh = shift || select;
103 30 50       140 if(ref $fh eq 'GLOB') { print $fh @{$self->{MMBL_array}} }
  0         0  
  0         0  
104 30         40 else { $fh->print(@{$self->{MMBL_array}}) }
  30         81  
105 30         331 $self;
106             }
107              
108             #------------------------------------------
109              
110             sub read($$;$@)
111 13     13 1 34 { my ($self, $parser, $head, $bodytype) = splice @_, 0, 4;
112 13         45 my ($begin, $end, $lines) = $parser->bodyAsList(@_);
113 13 50       32 $lines or return undef;
114              
115 13         58 $self->fileLocation($begin, $end);
116 13         22 $self->{MMBL_array} = $lines;
117 13         42 $self;
118             }
119              
120             #------------------------------------------
121              
122             sub endsOnNewline()
123 30     30 1 87 { my $last = shift->{MMBL_array}[-1];
124 30 50       228 !defined $last || $last =~ m/\n$/;
125             }
126              
127             #------------------------------------------
128              
129             1;