File Coverage

blib/lib/Mail/Message/Field/Structured.pm
Criterion Covered Total %
statement 79 85 92.9
branch 22 26 84.6
condition 12 14 85.7
subroutine 14 15 93.3
pod 8 9 88.8
total 135 149 90.6


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::Field::Structured;
10 21     21   2613 use vars '$VERSION';
  21         54  
  21         1208  
11             $VERSION = '3.011';
12              
13 21     21   140 use base 'Mail::Message::Field::Full';
  21         83  
  21         5921  
14              
15 21     21   240 use strict;
  21         65  
  21         638  
16 21     21   135 use warnings;
  21         56  
  21         790  
17              
18 21     21   10917 use Mail::Message::Field::Attribute;
  21         65  
  21         843  
19 21     21   172 use Storable 'dclone';
  21         51  
  21         21125  
20              
21              
22             sub init($)
23 105     105 0 411 { my ($self, $args) = @_;
24 105         976 $self->{MMFS_attrs} = {};
25 105         318 $self->{MMFS_datum} = $args->{datum};
26              
27 105         575 $self->SUPER::init($args);
28              
29 105   50     524 my $attr = $args->{attributes} || [];
30 105 50       451 $attr = [ %$attr ] if ref $attr eq 'HASH';
31              
32 105         369 while(@$attr)
33 0         0 { my $name = shift @$attr;
34 0 0       0 if(ref $name) { $self->attribute($name) }
  0         0  
35 0         0 else { $self->attribute($name, shift @$attr) }
36             }
37              
38 105         742 $self;
39             }
40              
41 177     177 1 11017 sub clone() { dclone(shift) }
42              
43             #------------------------------------------
44              
45              
46             sub attribute($;$)
47 285     285 1 2711 { my ($self, $attr) = (shift, shift);
48 285         411 my $name;
49 285 100       814 if(ref $attr) { $name = $attr->name }
  67 100       204  
50 178         830 elsif( !@_ ) { return $self->{MMFS_attrs}{lc $attr} }
51             else
52 40         72 { $name = $attr;
53 40         140 $attr = Mail::Message::Field::Attribute->new($name, @_);
54             }
55              
56 107         220 delete $self->{MMFF_body};
57 107         445 $self->{MMFS_attrs}{$name} = $attr;
58             }
59              
60              
61 2     2 1 7 sub attributes() { values %{shift->{MMFS_attrs}} }
  2         14  
62 7     7 1 32 sub beautify() { delete shift->{MMFF_body} }
63              
64              
65 0     0 1 0 sub attrPairs() { map +($_->name, $_->value), shift->attributes }
66              
67             #-------------------------
68              
69              
70             sub parse($)
71 73     73 1 206 { my ($self, $string) = @_;
72              
73             # remove FWS, even within quoted strings
74 73         516 $string =~ s/\r?\n\s?/ /gs;
75 73         417 $string =~ s/ +$//;
76              
77 73         186 my $datum = '';
78 73   100     487 while(length $string && substr($string, 0, 1) ne ';')
79 75         337 { (undef, $string) = $self->consumeComment($string);
80 75 100       719 $datum .= $1 if $string =~ s/^([^;(]+)//;
81             }
82 73         207 $self->{MMFS_datum} = $datum;
83              
84 73         139 my $found = '';
85 73         315 while($string =~ m/\S/)
86 137         247 { my $len = length $string;
87              
88 137 100 100     697 if($string =~ s/^\s*\;\s*// && length $found)
89 5         20 { my ($name) = $found =~ m/^([^*]+)\*/;
90 5 100 100     33 if($name && (my $cont = $self->attribute($name)))
91 1         4 { $cont->addComponent($found); # continuation
92             }
93             else
94 4         20 { my $attr = Mail::Message::Field::Attribute->new($found);
95 4         13 $self->attribute($attr);
96             }
97 5         11 $found = '';
98             }
99              
100 137         437 (undef, $string) = $self->consumeComment($string);
101 137         277 $string =~ s/^\n//;
102 137         515 (my $text, $string) = $self->consumePhrase($string);
103 137 100       426 $found .= $text if defined $text;
104              
105 137 50       510 if(length($string) == $len)
106             { # nothing consumed, remove character to avoid endless loop
107 0         0 $string =~ s/^\s*\S//;
108             }
109             }
110              
111 73 100       209 if(length $found)
112 65         174 { my ($name) = $found =~ m/^([^*]+)\*/;
113 65 100 66     218 if($name && (my $cont = $self->attribute($name)))
114 2         6 { $cont->addComponent($found); # continuation
115             }
116             else
117 63         366 { my $attr = Mail::Message::Field::Attribute->new($found);
118 63         206 $self->attribute($attr);
119             }
120             }
121              
122 73         204 1;
123             }
124              
125             sub produceBody()
126 46     46 1 616 { my $self = shift;
127 46         100 my $attrs = $self->{MMFS_attrs};
128 46         99 my $datum = $self->{MMFS_datum};
129              
130             join '; '
131             , (defined $datum ? $datum : '')
132 46 100       279 , map {$_->string} @{$attrs}{sort keys %$attrs};
  44         179  
  46         172  
133             }
134              
135              
136             sub datum(@)
137 2     2 1 580 { my $self = shift;
138 2 100       14 @_ or return $self->{MMFS_datum};
139 1         3 delete $self->{MMFF_body};
140 1         7 $self->{MMFS_datum} = shift;
141             }
142              
143             1;