File Coverage

blib/lib/Mail/Message/Body/String.pm
Criterion Covered Total %
statement 35 58 60.3
branch 6 14 42.8
condition 1 3 33.3
subroutine 12 17 70.5
pod 9 9 100.0
total 63 101 62.3


line stmt bran cond sub pod time code
1             # This code is part of Perl distribution Mail-Message version 4.04.
2             # The POD got stripped from this file by OODoc version 3.06.
3             # For contributors see file ChangeLog.
4              
5             # This software is copyright (c) 2001-2026 by Mark Overmeer.
6              
7             # This is free software; you can redistribute it and/or modify it under
8             # the same terms as the Perl 5 programming language system itself.
9             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
10              
11              
12             package Mail::Message::Body::String;{
13             our $VERSION = '4.04';
14             }
15              
16 8     8   824 use parent 'Mail::Message::Body';
  8         18  
  8         67  
17              
18 8     8   732 use strict;
  8         19  
  8         299  
19 8     8   60 use warnings;
  8         33  
  8         680  
20              
21 8     8   50 use Log::Report 'mail-message', import => [ qw/__x fault/ ];
  8         18  
  8         80  
22              
23 8     8   1766 use Mail::Box::FastScalar ();
  8         26  
  8         8791  
24              
25             #--------------------
26              
27             # The scalar is stored as reference to avoid a copy during creation of
28             # a string object.
29              
30             sub _data_from_filename(@)
31 0     0   0 { my ($self, $filename) = @_;
32              
33 0         0 delete $self->{MMBS_nrlines};
34 0 0       0 open my $in, '<:raw', $filename
35             or fault __x"unable to read file {name} for message body scalar", name => $filename;
36              
37 0         0 my @lines = $in->getlines;
38 0         0 $in->close;
39              
40 0         0 $self->{MMBS_nrlines} = @lines;
41 0         0 $self->{MMBS_scalar} = join '', @lines;
42 0         0 $self;
43             }
44              
45             sub _data_from_filehandle(@)
46 1     1   3 { my ($self, $fh) = @_;
47 1 50       4 if(ref $fh eq 'Mail::Box::FastScalar')
48 0         0 { my $lines = $fh->getlines;
49 0         0 $self->{MMBS_nrlines} = @$lines;
50 0         0 $self->{MMBS_scalar} = join '', @$lines;
51             }
52             else
53 1         6 { my @lines = $fh->getlines;
54 1         326 $self->{MMBS_nrlines} = @lines;
55 1         6 $self->{MMBS_scalar} = join '', @lines;
56             }
57 1         5 $self;
58             }
59              
60             sub _data_from_lines(@)
61 1     1   3 { my ($self, $lines) = @_;
62 1 50       6 $self->{MMBS_nrlines} = @$lines unless @$lines==1;
63 1 50       6 $self->{MMBS_scalar} = @$lines==1 ? shift @$lines : join('', @$lines);
64 1         5 $self;
65             }
66              
67             sub clone()
68 0     0 1 0 { my $self = shift;
69 0         0 (ref $self)->new(data => $self->string, based_on => $self);
70             }
71              
72             sub nrLines()
73 2     2 1 6 { my $self = shift;
74 2 50       19 return $self->{MMBS_nrlines} if defined $self->{MMBS_nrlines};
75              
76 0         0 my $lines = $self->{MMBS_scalar} =~ tr/\n/\n/;
77 0 0       0 $lines++ if $self->{MMBS_scalar} !~ m/\n\z/;
78 0         0 $self->{MMBS_nrlines} = $lines;
79             }
80              
81 2     2 1 12 sub size() { length $_[0]->{MMBS_scalar} }
82 3     3 1 614 sub string() { $_[0]->{MMBS_scalar} }
83              
84             sub lines()
85 3     3 1 724 { my @lines = split /^/, shift->{MMBS_scalar};
86 3 100       17 wantarray ? @lines : \@lines;
87             }
88              
89 0     0 1 0 sub file() { Mail::Box::FastScalar->new(\shift->{MMBS_scalar}) }
90              
91             sub print(;$)
92 2     2 1 55 { my $self = shift;
93 2   33     11 my $fh = shift || select;
94 2         21 $fh->print($self->{MMBS_scalar});
95 2         31 $self;
96             }
97              
98             sub read($$;$@)
99 0     0 1   { my ($self, $parser, $head, $bodytype) = splice @_, 0, 4;
100 0           delete $self->{MMBS_nrlines};
101              
102 0           (my $begin, my $end, $self->{MMBS_scalar}) = $parser->bodyAsString(@_);
103 0           $self->fileLocation($begin, $end);
104              
105 0           $self;
106             }
107              
108 0     0 1   sub endsOnNewline() { $_[0]->{MMBS_scalar} =~ m/\A\z|\n\z/ }
109              
110             1;