File Coverage

blib/lib/Mail/Message/Head/Partial.pm
Criterion Covered Total %
statement 29 72 40.2
branch 2 20 10.0
condition 2 6 33.3
subroutine 7 11 63.6
pod 6 6 100.0
total 46 115 40.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::Head::Partial;
10 35     35   210 use vars '$VERSION';
  35         65  
  35         1777  
11             $VERSION = '3.012';
12              
13 35     35   265 use base 'Mail::Message::Head::Complete';
  35         113  
  35         3701  
14              
15 35     35   449 use strict;
  35         101  
  35         691  
16 35     35   185 use warnings;
  35         74  
  35         1119  
17              
18 35     35   223 use Scalar::Util 'weaken';
  35         100  
  35         21341  
19              
20              
21             sub removeFields(@)
22 85     85 1 167 { my $self = shift;
23 85         678 my $known = $self->{MMH_fields};
24              
25 85         192 foreach my $match (@_)
26             {
27 168 100       380 if(ref $match)
28 84   66     806 { $_ =~ $match && delete $known->{$_} foreach keys %$known }
29 84         256 else { delete $known->{lc $match} }
30             }
31              
32 85         282 $self->cleanupOrderedFields;
33             }
34              
35              
36             sub removeFieldsExcept(@)
37 0     0 1 0 { my $self = shift;
38 0         0 my $known = $self->{MMH_fields};
39 0         0 my %remove = map { ($_ => 1) } keys %$known;
  0         0  
40              
41 0         0 foreach my $match (@_)
42 0 0       0 { if(ref $match)
43 0   0     0 { $_ =~ $match && delete $remove{$_} foreach keys %remove;
44             }
45 0         0 else { delete $remove{lc $match} }
46             }
47              
48 0         0 delete @$known{ keys %remove };
49              
50 0         0 $self->cleanupOrderedFields;
51             }
52              
53              
54             sub removeResentGroups()
55 0     0 1 0 { my $self = shift;
56 0         0 require Mail::Message::Head::ResentGroup;
57              
58 0         0 my $known = $self->{MMH_fields};
59 0         0 my $found = 0;
60 0         0 foreach my $name (keys %$known)
61 0 0       0 { next unless Mail::Message::Head::ResentGroup
62             ->isResentGroupFieldName($name);
63 0         0 delete $known->{$name};
64 0         0 $found++;
65             }
66              
67 0         0 $self->cleanupOrderedFields;
68 0 0       0 $self->modified(1) if $found;
69 0         0 $found;
70             }
71              
72              
73             sub removeListGroup()
74 0     0 1 0 { my $self = shift;
75 0         0 require Mail::Message::Head::ListGroup;
76              
77 0         0 my $known = $self->{MMH_fields};
78 0         0 my $found = 0;
79 0         0 foreach my $name (keys %$known)
80 0 0       0 { next unless Mail::Message::Head::ListGroup->isListGroupFieldName($name);
81 0         0 delete $known->{$name};
82 0         0 $found++;
83             }
84              
85 0 0       0 $self->cleanupOrderedFields if $found;
86 0 0       0 $self->modified(1) if $found;
87 0         0 $found;
88             }
89              
90              
91             sub removeSpamGroups()
92 0     0 1 0 { my $self = shift;
93 0         0 require Mail::Message::Head::SpamGroup;
94              
95 0         0 my $known = $self->{MMH_fields};
96 0         0 my $found = 0;
97 0         0 foreach my $name (keys %$known)
98 0 0       0 { next unless Mail::Message::Head::SpamGroup->isSpamGroupFieldName($name);
99 0         0 delete $known->{$name};
100 0         0 $found++;
101             }
102              
103 0 0       0 $self->cleanupOrderedFields if $found;
104 0 0       0 $self->modified(1) if $found;
105 0         0 $found;
106             }
107              
108              
109             sub cleanupOrderedFields()
110 85     85 1 148 { my $self = shift;
111 85         141 my @take = grep { defined $_ } @{$self->{MMH_order}};
  252         523  
  85         215  
112 85         425 weaken($_) foreach @take;
113 85         231 $self->{MMH_order} = \@take;
114 85         203 $self;
115             }
116              
117             #------------------------------------------
118              
119              
120             1;