File Coverage

blib/lib/Mail/Message/Head/FieldGroup.pm
Criterion Covered Total %
statement 28 74 37.8
branch 3 16 18.7
condition 1 11 9.0
subroutine 7 23 30.4
pod 18 19 94.7
total 57 143 39.8


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 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::Head::FieldGroup;
10 5     5   3408 use vars '$VERSION';
  5         10  
  5         258  
11             $VERSION = '3.013';
12              
13 5     5   31 use base 'Mail::Reporter';
  5         13  
  5         874  
14              
15 5     5   32 use strict;
  5         10  
  5         111  
16 5     5   25 use warnings;
  5         10  
  5         5062  
17              
18              
19             sub new(@)
20 6     6 1 857 { my $class = shift;
21              
22 6         10 my @fields;
23 6         36 push @fields, shift while ref $_[0];
24              
25 6         26 $class->SUPER::new(@_, fields => \@fields);
26             }
27              
28             sub init($$)
29 6     6 0 10 { my ($self, $args) = @_;
30 6         20 $self->SUPER::init($args);
31              
32             my $head = $self->{MMHF_head}
33 6   33     30 = $args->{head} || Mail::Message::Head::Partial->new;
34              
35             $self->add($_) # add specified object fields
36 6         13 foreach @{$args->{fields}};
  6         22  
37              
38             $self->add($_, delete $args->{$_}) # add key-value paired fields
39 6         55 foreach grep m/^[A-Z]/, keys %$args;
40              
41 6 50       22 $self->{MMHF_version} = $args->{version} if defined $args->{version};
42 6 50       16 $self->{MMHF_software} = $args->{software} if defined $args->{software};
43 6 50       15 $self->{MMHF_type} = $args->{type} if defined $args->{type};
44              
45 6         11 $self->{MMHF_fns} = [];
46 6         14 $self;
47             }
48              
49             #------------------------------------------
50              
51              
52 0     0 1 0 sub implementedTypes() { shift->notImplemented }
53              
54             #------------------------------------------
55              
56              
57 0     0 1 0 sub from($) { shift->notImplemented }
58              
59             #------------------------------------------
60              
61              
62             sub clone()
63 0     0 1 0 { my $self = shift;
64 0         0 my $clone = bless %$self, ref $self;
65 0         0 $clone->{MMHF_fns} = [ $self->fieldNames ];
66 0         0 $clone;
67             }
68              
69             #------------------------------------------
70              
71              
72 51     51 1 147 sub head() { shift->{MMHF_head} }
73              
74             #------------------------------------------
75              
76              
77             sub attach($)
78 0     0 1   { my ($self, $head) = @_;
79 0           $head->add($_->clone) for $self->fields;
80 0           $self;
81             }
82              
83             #------------------------------------------
84              
85              
86             sub delete()
87 0     0 1   { my $self = shift;
88 0           my $head = $self->head;
89 0           $head->removeField($_) foreach $self->fields;
90 0           $self;
91             }
92              
93             #------------------------------------------
94              
95              
96             sub add(@)
97 0     0 1   { my $self = shift;
98 0 0         my $field = $self->head->add(@_) or return ();
99 0           push @{$self->{MMHF_fns}}, $field->name;
  0            
100 0           $self;
101             }
102              
103             #------------------------------------------
104              
105              
106             sub fields()
107 0     0 1   { my $self = shift;
108 0           my $head = $self->head;
109 0           map { $head->get($_) } $self->fieldNames;
  0            
110             }
111              
112             #------------------------------------------
113              
114              
115 0     0 1   sub fieldNames() { @{shift->{MMHF_fns}} }
  0            
116              
117             #------------------------------------------
118              
119              
120             sub addFields(@)
121 0     0 1   { my $self = shift;
122 0           my $head = $self->head;
123              
124 0           push @{$self->{MMHF_fns}}, @_;
  0            
125 0           @_;
126             }
127              
128             #------------------------------------------
129              
130              
131 0     0 1   sub version() { shift->{MMHF_version} }
132              
133             #------------------------------------------
134              
135              
136 0     0 1   sub software() { shift->{MMHF_software} }
137              
138             #------------------------------------------
139              
140              
141 0     0 1   sub type() { shift->{MMHF_type} }
142              
143             #------------------------------------------
144              
145              
146             sub detected($$$)
147 0     0 1   { my $self = shift;
148 0           @$self{ qw/MMHF_type MMHF_software MMHF_version/ } = @_;
149             }
150              
151             #------------------------------------------
152              
153              
154 0     0 1   sub collectFields(;$) { shift->notImplemented }
155              
156             #------------------------------------------
157              
158              
159             sub print(;$)
160 0     0 1   { my $self = shift;
161 0   0       my $out = shift || select;
162 0           $_->print($out) foreach $self->fields;
163             }
164              
165             #------------------------------------------
166              
167              
168             sub details()
169 0     0 1   { my $self = shift;
170 0   0       my $type = $self->type || 'Unknown';
171              
172 0           my $software = $self->software;
173 0 0 0       undef $software if defined($software) && $type eq $software;
174 0           my $version = $self->version;
175 0 0         my $release
    0          
    0          
176             = defined $software
177             ? (defined $version ? " ($software $version)" : " ($software)")
178             : (defined $version ? " ($version)" : '');
179              
180 0           my $fields = scalar $self->fields;
181 0           "$type $release, $fields fields";
182             }
183              
184             #------------------------------------------
185              
186             1;