File Coverage

blib/lib/Mail/Message/Replace/MailHeader.pm
Criterion Covered Total %
statement 16 99 16.1
branch 0 36 0.0
condition 0 14 0.0
subroutine 6 30 20.0
pod 22 23 95.6
total 44 202 21.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::Replace::MailHeader;
10 1     1   1795 use vars '$VERSION';
  1         2  
  1         45  
11             $VERSION = '3.012';
12              
13 1     1   5 use base 'Mail::Message::Head::Complete';
  1         1  
  1         80  
14              
15 1     1   6 use strict;
  1         1  
  1         16  
16 1     1   3 use warnings;
  1         2  
  1         1052  
17              
18              
19             sub new(@)
20 0     0 1   { my $class = shift;
21 0 0         unshift @_, 'raw_data' if @_ % 2;
22 0           $class->SUPER::new(@_);
23             }
24              
25             sub init($)
26 0     0 0   { my ($self, $args) = @_;
27 0 0         defined $self->SUPER::init($args) or return;
28              
29 0   0       $self->modify ($args->{Modify} || $args->{Reformat} || 0);
30 0   0       $self->fold_length($args->{FoldLength} || 79);
31 0   0       $self->mail_from ($args->{MailFrom} || 'KEEP');
32 0           $self;
33             }
34              
35              
36             sub delete($;$)
37 0     0 1   { my ($self, $tag) = (shift, shift);
38 0 0         return $self->delete($tag) unless @_;
39              
40 0           my $index = shift;
41 0           my @fields = $self->get($tag);
42 0           my ($field) = splice @fields, $index, 1;
43 0           $self->reset($tag, @fields);
44 0           $field;
45             }
46              
47              
48             sub add($$)
49 0     0 1   { my $self = shift;
50 0           my $field = $self->add(shift);
51 0           $field->unfoldedBody;
52             }
53              
54              
55             sub replace($$;$)
56 0     0 1   { my ($self, $tag, $line, $index) = @_;
57 0 0 0       $line =~ s/^([^:]+)\:\s*// && ($tag = $1) unless defined $tag;
58              
59 0           my $field = Mail::Message::Field::Fast->new($tag, $line);
60 0           my @fields = $self->get($tag);
61 0   0       $fields[ $index||0 ] = $field;
62 0           $self->reset($tag, @fields);
63              
64 0           $field;
65             }
66              
67              
68             sub get($;$)
69 0     0 1   { my $head = shift->head;
70 0           my @ret = map { $head->get(@_) } @_;
  0            
71              
72 0 0         if(wantarray) { return @ret ? map({$_->unfoldedBody} @ret) : () }
  0 0          
  0            
73 0 0         else { return @ret ? $ret[0]->unfoldedBody : undef }
74             }
75              
76              
77             sub modify(;$)
78 0     0 1   { my $self = shift;
79 0 0         @_ ? ($self->{MH_refold} = shift) : $self->{MH_refold};
80             }
81              
82              
83             sub mail_from(;$)
84 0     0 1   { my $self = shift;
85 0 0         return $self->{MH_mail_from} unless @_;
86              
87 0           my $choice = uc(shift);
88 0 0         die "bad Mail-From choice: '$choice'"
89             unless $choice =~ /^(IGNORE|ERROR|COERCE|KEEP)$/;
90              
91 0           $self->{MH_mail_from} = $choice;
92             }
93              
94              
95             sub fold(;$)
96 0     0 1   { my $self = shift;
97 0 0         my $wrap = @_ ? shift : $self->fold_length;
98 0           $_->setWrapLength($wrap) foreach $self->orderedFields;
99 0           $self;
100             }
101              
102              
103             sub unfold(;$)
104 0     0 1   { my $self = shift;
105 0 0         my @fields = @_ ? $self->get(shift) : $self->orderedFields;
106 0           $_->setWrapLength(100_000) foreach @fields; # blunt approach
107 0           $self;
108             }
109              
110              
111             sub extract($)
112 0     0 1   { my ($self, $lines) = @_;
113              
114 0           my $parser = Mail::Box::Parser::Perl->new
115             ( filename => 'extract from array'
116             , data => $lines
117             , trusted => 1
118             );
119              
120 0           $self->read($parser);
121 0           $parser->close;
122              
123             # Remove header from array
124 0   0       shift @$lines while @$lines && $lines->[0] != m/^[\r\n]+/;
125 0 0         shift @$lines if @$lines;
126 0           $self;
127             }
128              
129              
130             sub read($)
131 0     0 1   { my ($self, $file) = @_;
132 0           my $parser = Mail::Box::Parser::Perl->new
133             ( filename => ('from file-handle '.ref $file)
134             , file => $file
135             , trusted => 1
136             );
137 0           $self->read($parser);
138 0           $parser->close;
139 0           $self;
140             }
141              
142              
143 0     0 1   sub empty() { shift->removeFields( m/^/ ) }
144              
145              
146             sub header(;$)
147 0     0 1   { my $self = shift;
148 0 0         $self->extract(shift) if @_;
149 0 0         $self->fold if $self->modify;
150 0           [ $self->orderedFields ];
151             }
152              
153              
154 0     0 1   sub header_hashref($) { die "Don't use header_hashref!!!" }
155              
156              
157 0     0 1   sub combine($;$) { die "Don't use combine()!!!" }
158              
159              
160 0     0 1   sub exists() { shift->count }
161              
162              
163 0     0 1   sub as_string() { shift->string }
164              
165              
166             sub fold_length(;$$)
167 0     0 1   { my $self = shift;
168 0 0         return $self->{MH_wrap} unless @_;
169              
170 0           my $old = $self->{MH_wrap};
171 0           my $wrap = $self->{MH_wrap} = shift;
172 0 0         $self->fold($wrap) if $self->modify;
173 0           $old;
174             }
175              
176              
177 0     0 1   sub tags() { shift->names }
178              
179              
180 0     0 1   sub dup() { shift->clone }
181              
182              
183 0     0 1   sub cleanup() { shift }
184              
185              
186             BEGIN
187 1     1   7 { no warnings;
  1         2  
  1         59  
188             *Mail::Header::new =
189 0     0     sub { my $class = shift;
190 0           Mail::Message::Replace::MailHeader->new(@_);
191             }
192 1     1   70 }
193              
194              
195              
196             sub isa($)
197 0     0 1   { my ($thing, $class) = @_;
198 0 0         return 1 if $class eq 'Mail::Mailer';
199 0           $thing->SUPER::isa($class);
200             }
201              
202              
203             1;
204              
205