File Coverage

blib/lib/Mail/Message/Field/Flex.pm
Criterion Covered Total %
statement 45 49 91.8
branch 17 20 85.0
condition 3 6 50.0
subroutine 12 14 85.7
pod 8 9 88.8
total 85 98 86.7


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::Flex;
10 3     3   4393 use vars '$VERSION';
  3         5  
  3         140  
11             $VERSION = '3.012';
12              
13 3     3   16 use base 'Mail::Message::Field';
  3         5  
  3         571  
14              
15 3     3   23 use strict;
  3         5  
  3         70  
16 3     3   14 use warnings;
  3         6  
  3         92  
17              
18 3     3   12 use Carp;
  3         6  
  3         1765  
19              
20              
21             sub new($;$$@)
22 18     18 1 2298 { my $class = shift;
23             my $args = @_ <= 2 || ! ref $_[-1] ? {}
24 18 50 66     79 : ref $_[-1] eq 'ARRAY' ? { @{pop @_} }
  1 100       3  
25             : pop @_;
26              
27 18 100       73 my ($name, $body) = $class->consume(@_==1 ? (shift) : (shift, shift));
28 18 50       38 return () unless defined $body;
29              
30             # Attributes preferably stored in array to protect order.
31 18         26 my $attr = $args->{attributes};
32 18 50 33     38 $attr = [ %$attr ] if defined $attr && ref $attr eq 'HASH';
33 18         28 push @$attr, @_;
34              
35 18         71 $class->SUPER::new(%$args, name => $name, body => $body,
36             attributes => $attr);
37             }
38              
39             sub init($)
40 18     18 0 36 { my ($self, $args) = @_;
41              
42 18         116 @$self{ qw/MMFF_name MMFF_body/ } = @$args{ qw/name body/ };
43              
44             $self->comment($args->{comment})
45 18 100       65 if exists $args->{comment};
46              
47 18         35 my $attr = $args->{attributes};
48 18         38 $self->attribute(shift @$attr, shift @$attr)
49             while @$attr;
50              
51 18         109 $self;
52             }
53              
54             #------------------------------------------
55              
56             sub clone()
57 0     0 1 0 { my $self = shift;
58 0         0 (ref $self)->new($self->Name, $self->body);
59             }
60              
61             #------------------------------------------
62              
63             sub length()
64 0     0 1 0 { my $self = shift;
65 0         0 length($self->{MMFF_name}) + 1 + length($self->{MMFF_body});
66             }
67              
68             #------------------------------------------
69              
70 27     27 1 98 sub name() { lc shift->{MMFF_name}}
71              
72             #------------------------------------------
73              
74 5     5 1 14 sub Name() { shift->{MMFF_name}}
75              
76             #------------------------------------------
77              
78             sub folded(;$)
79 8     8 1 13 { my $self = shift;
80             return $self->{MMFF_name}.':'.$self->{MMFF_body}
81 8 100       36 unless wantarray;
82              
83 2         6 my @lines = $self->foldedBody;
84 2         7 my $first = $self->{MMFF_name}. ':'. shift @lines;
85 2         6 ($first, @lines);
86             }
87              
88             #------------------------------------------
89              
90             sub unfoldedBody($;@)
91 38     38 1 1523 { my $self = shift;
92 38 100       75 $self->{MMFF_body} = $self->fold($self->{MMFF_name}, @_)
93             if @_;
94              
95 38         95 $self->unfold($self->{MMFF_body});
96             }
97              
98             #------------------------------------------
99              
100             sub foldedBody($)
101 13     13 1 25 { my ($self, $body) = @_;
102 13 100       27 if(@_==2) { $self->{MMFF_body} = $body }
  3         6  
103 10         16 else { $body = $self->{MMFF_body} }
104              
105 13 100       44 wantarray ? (split /^/, $body) : $body;
106             }
107              
108             #------------------------------------------
109              
110             1;