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-2021 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-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   6245 use vars '$VERSION';
  31         75  
  31         1839  
11             $VERSION = '3.011';
12              
13 31     31   198 use base 'Mail::Message::Body';
  31         65  
  31         13094  
14              
15 31     31   362 use strict;
  31         677  
  31         909  
16 31     31   186 use warnings;
  31         377  
  31         1253  
17              
18 31     31   3614 use Mail::Box::Parser;
  31         80  
  31         802  
19 31     31   19209 use IO::Lines;
  31         166591  
  31         1587  
20              
21 31     31   265 use Carp;
  31         71  
  31         25788  
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   4 { my ($self, $fh) = @_;
43             $self->{MMBL_array} =
44 1 50       6 ref $fh eq 'Mail::Box::FastScalar' ? $fh->getlines : [ $fh->getlines ];
45 1         406 $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   366 { my ($self, $lines) = @_;
56 149 100       518 $lines = [ split /^/, $lines->[0] ] # body passed in one string.
57             if @$lines==1;
58              
59 149         391 $self->{MMBL_array} = $lines;
60 149         447 $self;
61             }
62              
63             #------------------------------------------
64              
65             sub clone()
66 9     9 1 19 { my $self = shift;
67 9         35 ref($self)->new(data => [ $self->lines ], based_on => $self);
68             }
69              
70             #------------------------------------------
71              
72 113     113 1 4611 sub nrLines() { scalar @{shift->{MMBL_array}} }
  113         429  
73              
74             #------------------------------------------
75             # Optimized to be computed only once.
76              
77             sub size()
78 109     109 1 274 { my $self = shift;
79 109 100       405 return $self->{MMBL_size} if exists $self->{MMBL_size};
80              
81 54         103 my $size = 0;
82 54         95 $size += length $_ foreach @{$self->{MMBL_array}};
  54         208  
83 54         227 $self->{MMBL_size} = $size;
84             }
85              
86             #------------------------------------------
87              
88 87     87 1 701 sub string() { join '', @{shift->{MMBL_array}} }
  87         884  
89              
90             #------------------------------------------
91              
92 85 100   85 1 4920 sub lines() { wantarray ? @{shift->{MMBL_array}} : shift->{MMBL_array} }
  55         410  
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 99 { my $self = shift;
102 30   33     72 my $fh = shift || select;
103 30 50       162 if(ref $fh eq 'GLOB') { print $fh @{$self->{MMBL_array}} }
  0         0  
  0         0  
104 30         58 else { $fh->print(@{$self->{MMBL_array}}) }
  30         96  
105 30         374 $self;
106             }
107              
108             #------------------------------------------
109              
110             sub read($$;$@)
111 13     13 1 55 { my ($self, $parser, $head, $bodytype) = splice @_, 0, 4;
112 13         45 my ($begin, $end, $lines) = $parser->bodyAsList(@_);
113 13 50       26 $lines or return undef;
114              
115 13         64 $self->fileLocation($begin, $end);
116 13         25 $self->{MMBL_array} = $lines;
117 13         43 $self;
118             }
119              
120             #------------------------------------------
121              
122             sub endsOnNewline()
123 30     30 1 77 { my $last = shift->{MMBL_array}[-1];
124 30 50       247 !defined $last || $last =~ m/\n$/;
125             }
126              
127             #------------------------------------------
128              
129             1;