File Coverage

blib/lib/Mail/Message/Construct/Text.pm
Criterion Covered Total %
statement 35 41 85.3
branch 14 20 70.0
condition 4 7 57.1
subroutine 7 8 87.5
pod 4 4 100.0
total 64 80 80.0


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;
10 4     4   740 use vars '$VERSION';
  4         10  
  4         238  
11             $VERSION = '3.012';
12              
13              
14 4     4   22 use strict;
  4         7  
  4         90  
15 4     4   18 use warnings;
  4         7  
  4         102  
16              
17 4     4   20 use IO::Lines;
  4         79  
  4         1583  
18              
19              
20             sub string()
21 5     5 1 465 { my $self = shift;
22 5         22 $self->head->string . $self->body->string;
23             }
24              
25             #------------------------------------------
26              
27              
28             sub lines()
29 8     8 1 13 { my $self = shift;
30 8         12 my @lines;
31 8         39 my $file = IO::Lines->new(\@lines);
32 8         408 $self->print($file);
33 8 50       47 wantarray ? @lines : \@lines;
34             }
35              
36             #------------------------------------------
37              
38              
39             sub file()
40 0     0 1 0 { my $self = shift;
41 0         0 my @lines;
42 0         0 my $file = IO::Lines->new(\@lines);
43 0         0 $self->print($file);
44 0         0 $file->seek(0,0);
45 0         0 $file;
46             }
47              
48              
49             sub printStructure(;$$)
50 6     6 1 10 { my $self = shift;
51              
52 6 50 33     18 my $indent
    100          
53             = @_==2 ? pop
54             : defined $_[0] && !ref $_[0] ? shift
55             : '';
56              
57 6 50       10 my $fh = @_ ? shift : select;
58              
59 6         7 my $buffer; # only filled if filehandle==undef
60 6 50       12 open $fh, '>:raw', \$buffer unless defined $fh;
61              
62 6   100     12 my $subject = $self->get('Subject') || '';
63 6 100       14 $subject = ": $subject" if length $subject;
64              
65 6   50     13 my $type = $self->get('Content-Type', 0) || '';
66 6         18 my $size = $self->size;
67 6 50       13 my $deleted = $self->label('deleted') ? ', deleted' : '';
68              
69 6         20 my $text = "$indent$type$subject ($size bytes$deleted)\n";
70 6 50       26 ref $fh eq 'GLOB' ? (print $fh $text) : $fh->print($text);
71              
72 6         69 my $body = $self->body;
73             my @parts
74 6 100       24 = $body->isNested ? ($body->nested)
    100          
75             : $body->isMultipart ? $body->parts
76             : ();
77              
78             $_->printStructure($fh, $indent.' ')
79 6         34 for @parts;
80              
81 6         14 $buffer;
82             }
83            
84              
85             1;