File Coverage

blib/lib/Mail/Message/Head/Partial.pm
Criterion Covered Total %
statement 28 70 40.0
branch 2 20 10.0
condition 2 6 33.3
subroutine 7 11 63.6
pod 6 6 100.0
total 45 113 39.8


line stmt bran cond sub pod time code
1             # This code is part of Perl distribution Mail-Message version 4.04.
2             # The POD got stripped from this file by OODoc version 3.06.
3             # For contributors see file ChangeLog.
4              
5             # This software is copyright (c) 2001-2026 by Mark Overmeer.
6              
7             # This is free software; you can redistribute it and/or modify it under
8             # the same terms as the Perl 5 programming language system itself.
9             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
10              
11              
12             package Mail::Message::Head::Partial;{
13             our $VERSION = '4.04';
14             }
15              
16 40     40   278 use parent 'Mail::Message::Head::Complete';
  40         282  
  40         350  
17              
18 40     40   3775 use strict;
  40         214  
  40         1290  
19 40     40   293 use warnings;
  40         190  
  40         2980  
20              
21 40     40   349 use Log::Report 'mail-message', import => [ qw// ];
  40         113  
  40         363  
22              
23 40     40   6675 use Scalar::Util qw/weaken/;
  40         162  
  40         34570  
24              
25             #--------------------
26              
27             sub removeFields(@)
28 89     89 1 166 { my $self = shift;
29 89         795 my $known = $self->{MMH_fields};
30              
31 89         241 foreach my $match (@_)
32             {
33 176 100       423 if(ref $match)
34 88   66     1197 { $_ =~ $match && delete $known->{$_} for keys %$known }
35 88         266 else { delete $known->{lc $match} }
36             }
37              
38 89         306 $self->cleanupOrderedFields;
39             }
40              
41              
42             sub removeFieldsExcept(@)
43 0     0 1 0 { my $self = shift;
44 0         0 my $known = $self->{MMH_fields};
45 0         0 my %remove = map +($_ => 1), keys %$known;
46              
47 0         0 foreach my $match (@_)
48 0 0       0 { if(ref $match)
49 0   0     0 { $_ =~ $match && delete $remove{$_} for keys %remove }
50 0         0 else { delete $remove{lc $match} }
51             }
52              
53 0         0 delete @$known{ keys %remove };
54 0         0 $self->cleanupOrderedFields;
55             }
56              
57              
58             sub removeResentGroups()
59 0     0 1 0 { my $self = shift;
60 0         0 require Mail::Message::Head::ResentGroup;
61              
62 0         0 my $known = $self->{MMH_fields};
63 0         0 my $found = 0;
64 0         0 foreach my $name (keys %$known)
65 0 0       0 { Mail::Message::Head::ResentGroup->isResentGroupFieldName($name) or next;
66 0         0 delete $known->{$name};
67 0         0 $found++;
68             }
69              
70 0         0 $self->cleanupOrderedFields;
71 0 0       0 $self->modified(1) if $found;
72 0         0 $found;
73             }
74              
75              
76             sub removeListGroup()
77 0     0 1 0 { my $self = shift;
78 0         0 require Mail::Message::Head::ListGroup;
79              
80 0         0 my $known = $self->{MMH_fields};
81 0         0 my $found = 0;
82 0         0 foreach my $name (keys %$known)
83 0 0       0 { Mail::Message::Head::ListGroup->isListGroupFieldName($name) or next;
84 0         0 delete $known->{$name};
85 0         0 $found++;
86             }
87              
88 0 0       0 $self->cleanupOrderedFields if $found;
89 0 0       0 $self->modified(1) if $found;
90 0         0 $found;
91             }
92              
93              
94             sub removeSpamGroups()
95 0     0 1 0 { my $self = shift;
96 0         0 require Mail::Message::Head::SpamGroup;
97              
98 0         0 my $known = $self->{MMH_fields};
99 0         0 my $found = 0;
100 0         0 foreach my $name (keys %$known)
101 0 0       0 { Mail::Message::Head::SpamGroup->isSpamGroupFieldName($name) or next;
102 0         0 delete $known->{$name};
103 0         0 $found++;
104             }
105              
106 0 0       0 $self->cleanupOrderedFields if $found;
107 0 0       0 $self->modified(1) if $found;
108 0         0 $found;
109             }
110              
111              
112             sub cleanupOrderedFields()
113 89     89 1 153 { my $self = shift;
114 89         230 my @take = grep defined, @{$self->{MMH_order}};
  89         437  
115 89         361 weaken($_) for @take;
116 89         286 $self->{MMH_order} = \@take;
117 89         287 $self;
118             }
119              
120             #--------------------
121              
122             1;