← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:12 2021

Filename/usr/local/lib/perl5/site_perl/MIME/Head.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMIME::Head::::BEGIN@113MIME::Head::BEGIN@113
0000s0sMIME::Head::::BEGIN@114MIME::Head::BEGIN@114
0000s0sMIME::Head::::BEGIN@117MIME::Head::BEGIN@117
0000s0sMIME::Head::::BEGIN@120MIME::Head::BEGIN@120
0000s0sMIME::Head::::BEGIN@121MIME::Head::BEGIN@121
0000s0sMIME::Head::::BEGIN@124MIME::Head::BEGIN@124
0000s0sMIME::Head::::BEGIN@125MIME::Head::BEGIN@125
0000s0sMIME::Head::::BEGIN@126MIME::Head::BEGIN@126
0000s0sMIME::Head::::BEGIN@127MIME::Head::BEGIN@127
0000s0sMIME::Head::::BEGIN@128MIME::Head::BEGIN@128
0000s0sMIME::Head::::BEGIN@129MIME::Head::BEGIN@129
0000s0sMIME::Head::::BEGIN@144MIME::Head::BEGIN@144
0000s0sMIME::Head::::BEGIN@3MIME::Head::BEGIN@3
0000s0sMIME::Head::::as_stringMIME::Head::as_string
0000s0sMIME::Head::::copyMIME::Head::copy
0000s0sMIME::Head::::decodeMIME::Head::decode
0000s0sMIME::Head::::existsMIME::Head::exists
0000s0sMIME::Head::::fieldsMIME::Head::fields
0000s0sMIME::Head::::from_fileMIME::Head::from_file
0000s0sMIME::Head::::get_allMIME::Head::get_all
0000s0sMIME::Head::::mime_attrMIME::Head::mime_attr
0000s0sMIME::Head::::mime_encodingMIME::Head::mime_encoding
0000s0sMIME::Head::::mime_typeMIME::Head::mime_type
0000s0sMIME::Head::::multipart_boundaryMIME::Head::multipart_boundary
0000s0sMIME::Head::::newMIME::Head::new
0000s0sMIME::Head::::original_textMIME::Head::original_text
0000s0sMIME::Head::::paramsMIME::Head::params
0000s0sMIME::Head::::printMIME::Head::print
0000s0sMIME::Head::::readMIME::Head::read
0000s0sMIME::Head::::recommended_filenameMIME::Head::recommended_filename
0000s0sMIME::Head::::setMIME::Head::set
0000s0sMIME::Head::::stringifyMIME::Head::stringify
0000s0sMIME::Head::::tweak_FROM_parsingMIME::Head::tweak_FROM_parsing
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package MIME::Head;
2
3use MIME::WordDecoder;
4=head1 NAME
5
6MIME::Head - MIME message header (a subclass of Mail::Header)
7
8
9=head1 SYNOPSIS
10
11Before reading further, you should see L<MIME::Tools> to make sure that
12you understand where this module fits into the grand scheme of things.
13Go on, do it now. I'll wait.
14
15Ready? Ok...
16
17=head2 Construction
18
19 ### Create a new, empty header, and populate it manually:
20 $head = MIME::Head->new;
21 $head->replace('content-type', 'text/plain; charset=US-ASCII');
22 $head->replace('content-length', $len);
23
24 ### Parse a new header from a filehandle:
25 $head = MIME::Head->read(\*STDIN);
26
27 ### Parse a new header from a file, or a readable pipe:
28 $testhead = MIME::Head->from_file("/tmp/test.hdr");
29 $a_b_head = MIME::Head->from_file("cat a.hdr b.hdr |");
30
31
32=head2 Output
33
34 ### Output to filehandle:
35 $head->print(\*STDOUT);
36
37 ### Output as string:
38 print STDOUT $head->as_string;
39 print STDOUT $head->stringify;
40
41
42=head2 Getting field contents
43
44 ### Is this a reply?
45 $is_reply = 1 if ($head->get('Subject') =~ /^Re: /);
46
47 ### Get receipt information:
48 print "Last received from: ", $head->get('Received', 0);
49 @all_received = $head->get('Received');
50
51 ### Print the subject, or the empty string if none:
52 print "Subject: ", $head->get('Subject',0);
53
54 ### Too many hops? Count 'em and see!
55 if ($head->count('Received') > 5) { ...
56
57 ### Test whether a given field exists
58 warn "missing subject!" if (! $head->count('subject'));
59
60
61=head2 Setting field contents
62
63 ### Declare this to be an HTML header:
64 $head->replace('Content-type', 'text/html');
65
66
67=head2 Manipulating field contents
68
69 ### Get rid of internal newlines in fields:
70 $head->unfold;
71
72 ### Decode any Q- or B-encoded-text in fields (DEPRECATED):
73 $head->decode;
74
75
76=head2 Getting high-level MIME information
77
78 ### Get/set a given MIME attribute:
79 unless ($charset = $head->mime_attr('content-type.charset')) {
80 $head->mime_attr("content-type.charset" => "US-ASCII");
81 }
82
83 ### The content type (e.g., "text/html"):
84 $mime_type = $head->mime_type;
85
86 ### The content transfer encoding (e.g., "quoted-printable"):
87 $mime_encoding = $head->mime_encoding;
88
89 ### The recommended name when extracted:
90 $file_name = $head->recommended_filename;
91
92 ### The boundary text, for multipart messages:
93 $boundary = $head->multipart_boundary;
94
95
96=head1 DESCRIPTION
97
98A class for parsing in and manipulating RFC-822 message headers, with
99some methods geared towards standard (and not so standard) MIME fields
100as specified in the various I<Multipurpose Internet Mail Extensions>
101RFCs (starting with RFC 2045)
102
103
104=head1 PUBLIC INTERFACE
105
106=cut
107
108#------------------------------
109
110require 5.002;
111
112### Pragmas:
113use strict;
114use vars qw($VERSION @ISA @EXPORT_OK);
115
116### System modules:
117use IO::File;
118
119### Other modules:
120use Mail::Header 1.09 ();
121use Mail::Field 1.05 ();
122
123### Kit modules:
124use MIME::Words qw(:all);
125use MIME::Tools qw(:config :msgs);
126use MIME::Field::ParamVal;
127use MIME::Field::ConTraEnc;
128use MIME::Field::ContDisp;
129use MIME::Field::ContType;
130
131@ISA = qw(Mail::Header);
132
133
134#------------------------------
135#
136# Public globals...
137#
138#------------------------------
139
140### The package version, both in 1.23 style *and* usable by MakeMaker:
141$VERSION = "5.509";
142
143### Sanity (we put this test after our own version, for CPAN::):
144use Mail::Header 1.06 ();
145
146
147#------------------------------
148
149=head2 Creation, input, and output
150
151=over 4
152
153=cut
154
155#------------------------------
156
157
158#------------------------------
159
160=item new [ARG],[OPTIONS]
161
162I<Class method, inherited.>
163Creates a new header object. Arguments are the same as those in the
164superclass.
165
166=cut
167
168sub new {
169 my $class = shift;
170 bless Mail::Header->new(@_), $class;
171}
172
173#------------------------------
174
175=item from_file EXPR,OPTIONS
176
177I<Class or instance method>.
178For convenience, you can use this to parse a header object in from EXPR,
179which may actually be any expression that can be sent to open() so as to
180return a readable filehandle. The "file" will be opened, read, and then
181closed:
182
183 ### Create a new header by parsing in a file:
184 my $head = MIME::Head->from_file("/tmp/test.hdr");
185
186Since this method can function as either a class constructor I<or>
187an instance initializer, the above is exactly equivalent to:
188
189 ### Create a new header by parsing in a file:
190 my $head = MIME::Head->new->from_file("/tmp/test.hdr");
191
192On success, the object will be returned; on failure, the undefined value.
193
194The OPTIONS are the same as in new(), and are passed into new()
195if this is invoked as a class method.
196
197B<Note:> This is really just a convenience front-end onto C<read()>,
198provided mostly for backwards-compatibility with MIME-parser 1.0.
199
200=cut
201
202sub from_file {
203 my ($self, $file, @opts) = @_; ### at this point, $self is inst. or class!
204 my $class = ref($self) ? ref($self) : $self;
205
206 ### Parse:
207 my $fh = IO::File->new($file, '<') or return error("open $file: $!");
208 $fh->binmode() or return error("binmode $file: $!"); # we expect to have \r\n at line ends, and want to keep 'em.
209 $self = $class->new($fh, @opts); ### now, $self is instance or undef
210 $fh->close or return error("close $file: $!");
211 $self;
212}
213
214#------------------------------
215
216=item read FILEHANDLE
217
218I<Instance (or class) method.>
219This initializes a header object by reading it in from a FILEHANDLE,
220until the terminating blank line is encountered.
221A syntax error or end-of-stream will also halt processing.
222
223Supply this routine with a reference to a filehandle glob; e.g., C<\*STDIN>:
224
225 ### Create a new header by parsing in STDIN:
226 $head->read(\*STDIN);
227
228On success, the self object will be returned; on failure, a false value.
229
230B<Note:> in the MIME world, it is perfectly legal for a header to be
231empty, consisting of nothing but the terminating blank line. Thus,
232we can't just use the formula that "no tags equals error".
233
234B<Warning:> as of the time of this writing, Mail::Header::read did not flag
235either syntax errors or unexpected end-of-file conditions (an EOF
236before the terminating blank line). MIME::ParserBase takes this
237into account.
238
239=cut
240
241sub read {
242 my $self = shift; ### either instance or class!
243 ref($self) or $self = $self->new; ### if used as class method, make new
244 $self->SUPER::read(@_);
245}
246
- -
249#------------------------------
250
251=back
252
253=head2 Getting/setting fields
254
255The following are methods related to retrieving and modifying the header
256fields. Some are inherited from Mail::Header, but I've kept the
257documentation around for convenience.
258
259=over 4
260
261=cut
262
263#------------------------------
264
265
266#------------------------------
267
268=item add TAG,TEXT,[INDEX]
269
270I<Instance method, inherited.>
271Add a new occurrence of the field named TAG, given by TEXT:
272
273 ### Add the trace information:
274 $head->add('Received',
275 'from eryq.pr.mcs.net by gonzo.net with smtp');
276
277Normally, the new occurrence will be I<appended> to the existing
278occurrences. However, if the optional INDEX argument is 0, then the
279new occurrence will be I<prepended>. If you want to be I<explicit>
280about appending, specify an INDEX of -1.
281
282B<Warning>: this method always adds new occurrences; it doesn't overwrite
283any existing occurrences... so if you just want to I<change> the value
284of a field (creating it if necessary), then you probably B<don't> want to use
285this method: consider using C<replace()> instead.
286
287=cut
288
289### Inherited.
290
291#------------------------------
292#
293# copy
294#
295# Instance method, DEPRECATED.
296# Duplicate the object.
297#
298sub copy {
299 usage "deprecated: use dup() instead.";
300 shift->dup(@_);
301}
302
303#------------------------------
304
305=item count TAG
306
307I<Instance method, inherited.>
308Returns the number of occurrences of a field; in a boolean context, this
309tells you whether a given field exists:
310
311 ### Was a "Subject:" field given?
312 $subject_was_given = $head->count('subject');
313
314The TAG is treated in a case-insensitive manner.
315This method returns some false value if the field doesn't exist,
316and some true value if it does.
317
318=cut
319
320### Inherited.
321
322
323#------------------------------
324
325=item decode [FORCE]
326
327I<Instance method, DEPRECATED.>
328Go through all the header fields, looking for RFC 1522 / RFC 2047 style
329"Q" (quoted-printable, sort of) or "B" (base64) encoding, and decode
330them in-place. Fellow Americans, you probably don't know what the hell
331I'm talking about. Europeans, Russians, et al, you probably do.
332C<:-)>.
333
334B<This method has been deprecated.>
335See L<MIME::Parser/decode_headers> for the full reasons.
336If you absolutely must use it and don't like the warning, then
337provide a FORCE:
338
339 "I_NEED_TO_FIX_THIS"
340 Just shut up and do it. Not recommended.
341 Provided only for those who need to keep old scripts functioning.
342
343 "I_KNOW_WHAT_I_AM_DOING"
344 Just shut up and do it. Not recommended.
345 Provided for those who REALLY know what they are doing.
346
347B<What this method does.>
348For an example, let's consider a valid email header you might get:
349
350 From: =?US-ASCII?Q?Keith_Moore?= <moore@cs.utk.edu>
351 To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <keld@dkuug.dk>
352 CC: =?ISO-8859-1?Q?Andr=E9_?= Pirard <PIRARD@vm1.ulg.ac.be>
353 Subject: =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
354 =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
355 =?US-ASCII?Q?.._cool!?=
356
357That basically decodes to (sorry, I can only approximate the
358Latin characters with 7 bit sequences /o and 'e):
359
360 From: Keith Moore <moore@cs.utk.edu>
361 To: Keld J/orn Simonsen <keld@dkuug.dk>
362 CC: Andr'e Pirard <PIRARD@vm1.ulg.ac.be>
363 Subject: If you can read this you understand the example... cool!
364
365B<Note:> currently, the decodings are done without regard to the
366character set: thus, the Q-encoding C<=F8> is simply translated to the
367octet (hexadecimal C<F8>), period. For piece-by-piece decoding
368of a given field, you want the array context of
369C<MIME::Words::decode_mimewords()>.
370
371B<Warning:> the CRLF+SPACE separator that splits up long encoded words
372into shorter sequences (see the Subject: example above) gets lost
373when the field is unfolded, and so decoding after unfolding causes
374a spurious space to be left in the field.
375I<THEREFORE: if you're going to decode, do so BEFORE unfolding!>
376
377This method returns the self object.
378
379I<Thanks to Kent Boortz for providing the idea, and the baseline
380RFC-1522-decoding code.>
381
382=cut
383
384sub decode {
385 my $self = shift;
386
387 ### Warn if necessary:
388 my $force = shift || 0;
389 unless (($force eq "I_NEED_TO_FIX_THIS") ||
390 ($force eq "I_KNOW_WHAT_I_AM_DOING")) {
391 usage "decode is deprecated for safety";
392 }
393
394 my ($tag, $i, @decoded);
395 foreach $tag ($self->tags) {
396 @decoded = map { scalar(decode_mimewords($_, Field=>$tag))
397 } $self->get_all($tag);
398 for ($i = 0; $i < @decoded; $i++) {
399 $self->replace($tag, $decoded[$i], $i);
400 }
401 }
402 $self->{MH_Decoded} = 1;
403 $self;
404}
405
406#------------------------------
407
408=item delete TAG,[INDEX]
409
410I<Instance method, inherited.>
411Delete all occurrences of the field named TAG.
412
413 ### Remove some MIME information:
414 $head->delete('MIME-Version');
415 $head->delete('Content-type');
416
417=cut
418
419### Inherited
420
421
422#------------------------------
423#
424# exists
425#
426sub exists {
427 usage "deprecated; use count() instead";
428 shift->count(@_);
429}
430
431#------------------------------
432#
433# fields
434#
435sub fields {
436 usage "deprecated: use tags() instead",
437 shift->tags(@_);
438}
439
440#------------------------------
441
442=item get TAG,[INDEX]
443
444I<Instance method, inherited.>
445Get the contents of field TAG.
446
447If a B<numeric INDEX> is given, returns the occurrence at that index,
448or undef if not present:
449
450 ### Print the first and last 'Received:' entries (explicitly):
451 print "First, or most recent: ", $head->get('received', 0);
452 print "Last, or least recent: ", $head->get('received',-1);
453
454If B<no INDEX> is given, but invoked in a B<scalar> context, then
455INDEX simply defaults to 0:
456
457 ### Get the first 'Received:' entry (implicitly):
458 my $most_recent = $head->get('received');
459
460If B<no INDEX> is given, and invoked in an B<array> context, then
461I<all> occurrences of the field are returned:
462
463 ### Get all 'Received:' entries:
464 my @all_received = $head->get('received');
465
466B<NOTE>: The header(s) returned may end with a newline. If you don't
467want this, then B<chomp> the return value.
468
469=cut
470
471### Inherited.
472
473
474#------------------------------
475
476=item get_all FIELD
477
478I<Instance method.>
479Returns the list of I<all> occurrences of the field, or the
480empty list if the field is not present:
481
482 ### How did it get here?
483 @history = $head->get_all('Received');
484
485B<Note:> I had originally experimented with having C<get()> return all
486occurrences when invoked in an array context... but that causes a lot of
487accidents when you get careless and do stuff like this:
488
489 print "\u$field: ", $head->get($field);
490
491It also made the intuitive behaviour unclear if the INDEX argument
492was given in an array context. So I opted for an explicit approach
493to asking for all occurrences.
494
495=cut
496
497sub get_all {
498 my ($self, $tag) = @_;
499 $self->count($tag) or return (); ### empty if doesn't exist
500 ($self->get($tag));
501}
502
503#------------------------------
504#
505# original_text
506#
507# Instance method, DEPRECATED.
508# Return an approximation of the original text.
509#
510sub original_text {
511 usage "deprecated: use stringify() instead";
512 shift->stringify(@_);
513}
514
515#------------------------------
516
517=item print [OUTSTREAM]
518
519I<Instance method, override.>
520Print the header out to the given OUTSTREAM, or the currently-selected
521filehandle if none. The OUTSTREAM may be a filehandle, or any object
522that responds to a print() message.
523
524The override actually lets you print to any object that responds to
525a print() method. This is vital for outputting MIME entities to scalars.
526
527Also, it defaults to the I<currently-selected> filehandle if none is given
528(not STDOUT!), so I<please> supply a filehandle to prevent confusion.
529
530=cut
531
532sub print {
533 my ($self, $fh) = @_;
534 $fh ||= select;
535 $fh->print($self->as_string);
536}
537
538#------------------------------
539#
540# set TAG,TEXT
541#
542# Instance method, DEPRECATED.
543# Set the field named TAG to [the single occurrence given by the TEXT.
544#
545sub set {
546 my $self = shift;
547 usage "deprecated: use the replace() method instead.";
548 $self->replace(@_);
549}
550
551#------------------------------
552
553=item stringify
554
555I<Instance method.>
556Return the header as a string. You can also invoke it as C<as_string>.
557
558If you set the variable $MIME::Entity::BOUNDARY_DELIMITER to a string,
559that string will be used as line-end delimiter. If it is not set,
560the line ending will be a newline character (\n)
561
562=cut
563
564sub stringify {
565 my $self = shift; ### build clean header, and output...
566 my @header = grep {defined($_) ? $_ : ()} @{$self->header};
567 my $header_delimiter = $MIME::Entity::BOUNDARY_DELIMITER || "\n";
568 join "", map { /\n$/ ? substr($_, 0, -1) . $header_delimiter : $_ . $header_delimiter } @header;
569}
570sub as_string { shift->stringify(@_) }
571
572#------------------------------
573
574=item unfold [FIELD]
575
576I<Instance method, inherited.>
577Unfold (remove newlines in) the text of all occurrences of the given FIELD.
578If the FIELD is omitted, I<all> fields are unfolded.
579Returns the "self" object.
580
581=cut
582
583### Inherited
584
585
586#------------------------------
587
588=back
589
590=head2 MIME-specific methods
591
592All of the following methods extract information from the following fields:
593
594 Content-type
595 Content-transfer-encoding
596 Content-disposition
597
598Be aware that they do not just return the raw contents of those fields,
599and in some cases they will fill in sensible (I hope) default values.
600Use C<get()> or C<mime_attr()> if you need to grab and process the
601raw field text.
602
603B<Note:> some of these methods are provided both as a convenience and
604for backwards-compatibility only, while others (like
605recommended_filename()) I<really do have to be in MIME::Head to work
606properly,> since they look for their value in more than one field.
607However, if you know that a value is restricted to a single
608field, you should really use the Mail::Field interface to get it.
609
610=over 4
611
612=cut
613
614#------------------------------
615
616
617#------------------------------
618#
619# params TAG
620#
621# Instance method, DEPRECATED.
622# Extract parameter info from a structured field, and return
623# it as a hash reference. Provided for 1.0 compatibility only!
624# Use the new MIME::Field interface classes (subclasses of Mail::Field).
625
626sub params {
627 my ($self, $tag) = @_;
628 usage "deprecated: use the MIME::Field interface classes from now on!";
629 return MIME::Field::ParamVal->parse_params($self->get($tag,0));
630}
631
632#------------------------------
633
634=item mime_attr ATTR,[VALUE]
635
636A quick-and-easy interface to set/get the attributes in structured
637MIME fields:
638
639 $head->mime_attr("content-type" => "text/html");
640 $head->mime_attr("content-type.charset" => "US-ASCII");
641 $head->mime_attr("content-type.name" => "homepage.html");
642
643This would cause the final output to look something like this:
644
645 Content-type: text/html; charset=US-ASCII; name="homepage.html"
646
647Note that the special empty sub-field tag indicates the anonymous
648first sub-field.
649
650B<Giving VALUE as undefined> will cause the contents of the named subfield
651to be deleted:
652
653 $head->mime_attr("content-type.charset" => undef);
654
655B<Supplying no VALUE argument> just returns the attribute's value,
656or undefined if it isn't there:
657
658 $type = $head->mime_attr("content-type"); ### text/html
659 $name = $head->mime_attr("content-type.name"); ### homepage.html
660
661In all cases, the new/current value is returned.
662
663=cut
664
665sub mime_attr {
666 my ($self, $attr, $value) = @_;
667
668 ### Break attribute name up:
669 my ($tag, $subtag) = split /\./, $attr;
670 $subtag ||= '_';
671
672 ### Set or get?
673 my $field = MIME::Field::ParamVal->parse($self->get($tag, 0));
674 if (@_ > 2) { ### set it:
675 $field->param($subtag, $value); ### set subfield
676 $self->replace($tag, $field->stringify); ### replace!
677 return $value;
678 }
679 else { ### get it:
680 return $field->param($subtag);
681 }
682}
683
684#------------------------------
685
686=item mime_encoding
687
688I<Instance method.>
689Try I<real hard> to determine the content transfer encoding
690(e.g., C<"base64">, C<"binary">), which is returned in all-lowercase.
691
692If no encoding could be found, the default of C<"7bit"> is returned
693I quote from RFC 2045 section 6.1:
694
695 This is the default value -- that is, "Content-Transfer-Encoding: 7BIT"
696 is assumed if the Content-Transfer-Encoding header field is not present.
697
698I do one other form of fixup: "7_bit", "7-bit", and "7 bit" are
699corrected to "7bit"; likewise for "8bit".
700
701=cut
702
703sub mime_encoding {
704 my $self = shift;
705 my $enc = lc($self->mime_attr('content-transfer-encoding') || '7bit');
706 $enc =~ s{^([78])[ _-]bit\Z}{$1bit};
707 $enc;
708}
709
710#------------------------------
711
712=item mime_type [DEFAULT]
713
714I<Instance method.>
715Try C<real hard> to determine the content type (e.g., C<"text/plain">,
716C<"image/gif">, C<"x-weird-type">, which is returned in all-lowercase.
717"Real hard" means that if no content type could be found, the default
718(usually C<"text/plain">) is returned. From RFC 2045 section 5.2:
719
720 Default RFC 822 messages without a MIME Content-Type header are
721 taken by this protocol to be plain text in the US-ASCII character
722 set, which can be explicitly specified as:
723
724 Content-type: text/plain; charset=us-ascii
725
726 This default is assumed if no Content-Type header field is specified.
727
728Unless this is a part of a "multipart/digest", in which case
729"message/rfc822" is the default. Note that you can also I<set> the
730default, but you shouldn't: normally only the MIME parser uses this
731feature.
732
733=cut
734
735sub mime_type {
736 my ($self, $default) = @_;
737 $self->{MIH_DefaultType} = $default if @_ > 1;
738 my $s = $self->mime_attr('content-type') ||
739 $self->{MIH_DefaultType} ||
740 'text/plain';
741 # avoid [perl #87336] bug, lc laundering tainted data
742 return lc($s) if $] <= 5.008 || $] >= 5.014;
743 $s =~ tr/A-Z/a-z/;
744 $s;
745}
746
747#------------------------------
748
749=item multipart_boundary
750
751I<Instance method.>
752If this is a header for a multipart message, return the
753"encapsulation boundary" used to separate the parts. The boundary
754is returned exactly as given in the C<Content-type:> field; that
755is, the leading double-hyphen (C<-->) is I<not> prepended.
756
757Well, I<almost> exactly... this passage from RFC 2046 dictates
758that we remove any trailing spaces:
759
760 If a boundary appears to end with white space, the white space
761 must be presumed to have been added by a gateway, and must be deleted.
762
763Returns undef (B<not> the empty string) if either the message is not
764multipart or if there is no specified boundary.
765
766=cut
767
768sub multipart_boundary {
769 my $self = shift;
770 my $value = $self->mime_attr('content-type.boundary');
771 (!defined($value)) ? undef : $value;
772}
773
774#------------------------------
775
776=item recommended_filename
777
778I<Instance method.>
779Return the recommended external filename. This is used when
780extracting the data from the MIME stream. The filename is always
781returned as a string in Perl's internal format (the UTF8 flag may be on!)
782
783Returns undef if no filename could be suggested.
784
785=cut
786
787sub recommended_filename
788{
789 my $self = shift;
790
791 # Try these headers in order, taking the first defined,
792 # non-blank one we find.
793 my $wd = supported MIME::WordDecoder 'UTF-8';
794 foreach my $attr_name ( qw( content-disposition.filename content-type.name ) ) {
795 my $value = $self->mime_attr( $attr_name );
796 if ( defined $value
797 && $value ne ''
798 && $value =~ /\S/ ) {
799 return $wd->decode($value);
800 }
801 }
802
803 return undef;
804}
805
806#------------------------------
807
808=back
809
810=cut
811
812
813#------------------------------
814#
815# tweak_FROM_parsing
816#
817# DEPRECATED. Use the inherited mail_from() class method now.
818
819sub tweak_FROM_parsing {
820 my $self = shift;
821 usage "deprecated. Use mail_from() instead.";
822 $self->mail_from(@_);
823}
824
825
826__END__