File Coverage

blib/lib/Mail/Message/Field/Fast.pm
Criterion Covered Total %
statement 41 44 93.1
branch 14 16 87.5
condition 1 3 33.3
subroutine 12 13 92.3
pod 9 9 100.0
total 77 85 90.5


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::Field::Fast;
10 40     40   3407 use vars '$VERSION';
  40         1475  
  40         3639  
11             $VERSION = '3.012';
12              
13 40     40   1624 use base 'Mail::Message::Field';
  40         1557  
  40         14009  
14              
15 40     40   314 use strict;
  40         100  
  40         868  
16 40     40   184 use warnings;
  40         71  
  40         18859  
17              
18              
19             #------------------------------------------
20             #
21             # The DATA is stored as: [ NAME, FOLDED-BODY ]
22             # The body is kept in a folded fashion, where each line starts with
23             # a single blank.
24              
25              
26             sub new($;$@)
27 759     759 1 13634 { my $class = shift;
28              
29 759 100       2317 my ($name, $body) = $class->consume(@_==1 ? (shift) : (shift, shift));
30 759 50       1530 return () unless defined $body;
31              
32 759         1628 my $self = bless [$name, $body], $class;
33              
34             # Attributes
35 759 100       1476 $self->comment(shift) if @_==1; # one attribute line
36 759         1473 $self->attribute(shift, shift) while @_ > 1; # attribute pairs
37              
38 759         2225 $self;
39             }
40              
41             sub clone()
42 1314     1314 1 1687 { my $self = shift;
43 1314         4283 bless [ @$self ], ref $self;
44             }
45              
46             sub length()
47 0     0 1 0 { my $self = shift;
48 0         0 length($self->[0]) + 1 + length($self->[1]);
49             }
50              
51 1512     1512 1 4734 sub name() { lc shift->[0] }
52 16     16 1 52 sub Name() { shift->[0] }
53              
54             sub folded()
55 245     245 1 370 { my $self = shift;
56 245 100       1221 return $self->[0].':'.$self->[1]
57             unless wantarray;
58              
59 52         91 my @lines = $self->foldedBody;
60 52         117 my $first = $self->[0]. ':'. shift @lines;
61 52         133 ($first, @lines);
62             }
63              
64             sub unfoldedBody($;@)
65 1592     1592 1 3573 { my $self = shift;
66              
67 1592 100       3027 $self->[1] = $self->fold($self->[0], @_)
68             if @_;
69              
70 1592         3356 $self->unfold($self->[1]);
71             }
72              
73             sub foldedBody($)
74 193     193 1 324 { my ($self, $body) = @_;
75 193 100       328 if(@_==2) { $self->[1] = $body }
  4         7  
76 189         381 else { $body = $self->[1] }
77            
78 193 100       530 wantarray ? (split m/^/, $body) : $body;
79             }
80              
81             # For performance reasons only
82             sub print(;$)
83 107     107 1 373 { my $self = shift;
84 107   33     179 my $fh = shift || select;
85 107 50       421 if(ref $fh eq 'GLOB') { print $fh $self->[0].':'.$self->[1] }
  0         0  
86 107         276 else { $fh->print($self->[0].':'.$self->[1]) }
87 107         1052 $self;
88             }
89              
90             1;