File Coverage

blib/lib/MIME/Head.pm
Criterion Covered Total %
statement 106 121 87.6
branch 19 28 67.8
condition 15 23 65.2
subroutine 27 33 81.8
pod 14 20 70.0
total 181 225 80.4


line stmt bran cond sub pod time code
1             package MIME::Head;
2              
3 20     20   143916 use MIME::WordDecoder;
  20         53  
  20         1270  
4             =head1 NAME
5              
6             MIME::Head - MIME message header (a subclass of Mail::Header)
7              
8              
9             =head1 SYNOPSIS
10              
11             Before reading further, you should see L to make sure that
12             you understand where this module fits into the grand scheme of things.
13             Go on, do it now. I'll wait.
14              
15             Ready? 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              
98             A class for parsing in and manipulating RFC-822 message headers, with
99             some methods geared towards standard (and not so standard) MIME fields
100             as specified in the various I
101             RFCs (starting with RFC 2045)
102              
103              
104             =head1 PUBLIC INTERFACE
105              
106             =cut
107              
108             #------------------------------
109              
110             require 5.002;
111              
112             ### Pragmas:
113 20     20   97 use strict;
  20         21  
  20         414  
114 20     20   58 use vars qw($VERSION @ISA @EXPORT_OK);
  20         25  
  20         848  
115              
116             ### System modules:
117 20     20   1325 use IO::File;
  20         18471  
  20         2245  
118              
119             ### Other modules:
120 20     20   7113 use Mail::Header 1.09 ();
  20         56344  
  20         512  
121 20     20   6441 use Mail::Field 1.05 ();
  20         34507  
  20         444  
122              
123             ### Kit modules:
124 20     20   98 use MIME::Words qw(:all);
  20         21  
  20         2346  
125 20     20   1313 use MIME::Tools qw(:config :msgs);
  20         24  
  20         1993  
126 20     20   7371 use MIME::Field::ParamVal;
  20         41  
  20         145  
127 20     20   16313 use MIME::Field::ConTraEnc;
  20         40  
  20         87  
128 20     20   15100 use MIME::Field::ContDisp;
  20         34  
  20         111  
129 20     20   14849 use MIME::Field::ContType;
  20         38  
  20         71  
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.508";
142              
143             ### Sanity (we put this test after our own version, for CPAN::):
144 20     20   9425 use Mail::Header 1.06 ();
  20         268  
  20         18872  
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              
162             I
163             Creates a new header object. Arguments are the same as those in the
164             superclass.
165              
166             =cut
167              
168             sub new {
169 427     427 1 1494 my $class = shift;
170 427         1082 bless Mail::Header->new(@_), $class;
171             }
172              
173             #------------------------------
174              
175             =item from_file EXPR,OPTIONS
176              
177             I.
178             For convenience, you can use this to parse a header object in from EXPR,
179             which may actually be any expression that can be sent to open() so as to
180             return a readable filehandle. The "file" will be opened, read, and then
181             closed:
182              
183             ### Create a new header by parsing in a file:
184             my $head = MIME::Head->from_file("/tmp/test.hdr");
185              
186             Since this method can function as either a class constructor I
187             an 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              
192             On success, the object will be returned; on failure, the undefined value.
193              
194             The OPTIONS are the same as in new(), and are passed into new()
195             if this is invoked as a class method.
196              
197             B This is really just a convenience front-end onto C,
198             provided mostly for backwards-compatibility with MIME-parser 1.0.
199              
200             =cut
201              
202             sub from_file {
203 6     6 1 1984 my ($self, $file, @opts) = @_; ### at this point, $self is inst. or class!
204 6 100       14 my $class = ref($self) ? ref($self) : $self;
205              
206             ### Parse:
207 6 100       27 my $fh = IO::File->new($file, '<') or return error("open $file: $!");
208 5 50       317 $fh->binmode() or return error("binmode $file: $!"); # we expect to have \r\n at line ends, and want to keep 'em.
209 5         50 $self = $class->new($fh, @opts); ### now, $self is instance or undef
210 5 50       2747 $fh->close or return error("close $file: $!");
211 5         72 $self;
212             }
213              
214             #------------------------------
215              
216             =item read FILEHANDLE
217              
218             I
219             This initializes a header object by reading it in from a FILEHANDLE,
220             until the terminating blank line is encountered.
221             A syntax error or end-of-stream will also halt processing.
222              
223             Supply 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              
228             On success, the self object will be returned; on failure, a false value.
229              
230             B in the MIME world, it is perfectly legal for a header to be
231             empty, consisting of nothing but the terminating blank line. Thus,
232             we can't just use the formula that "no tags equals error".
233              
234             B as of the time of this writing, Mail::Header::read did not flag
235             either syntax errors or unexpected end-of-file conditions (an EOF
236             before the terminating blank line). MIME::ParserBase takes this
237             into account.
238              
239             =cut
240              
241             sub read {
242 167     167 1 195 my $self = shift; ### either instance or class!
243 167 50       332 ref($self) or $self = $self->new; ### if used as class method, make new
244 167         511 $self->SUPER::read(@_);
245             }
246              
247              
248              
249             #------------------------------
250              
251             =back
252              
253             =head2 Getting/setting fields
254              
255             The following are methods related to retrieving and modifying the header
256             fields. Some are inherited from Mail::Header, but I've kept the
257             documentation around for convenience.
258              
259             =over 4
260              
261             =cut
262              
263             #------------------------------
264              
265              
266             #------------------------------
267              
268             =item add TAG,TEXT,[INDEX]
269              
270             I
271             Add 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              
277             Normally, the new occurrence will be I to the existing
278             occurrences. However, if the optional INDEX argument is 0, then the
279             new occurrence will be I. If you want to be I
280             about appending, specify an INDEX of -1.
281              
282             B: this method always adds new occurrences; it doesn't overwrite
283             any existing occurrences... so if you just want to I the value
284             of a field (creating it if necessary), then you probably B want to use
285             this method: consider using C instead.
286              
287             =cut
288              
289             ### Inherited.
290              
291             #------------------------------
292             #
293             # copy
294             #
295             # Instance method, DEPRECATED.
296             # Duplicate the object.
297             #
298             sub copy {
299 0     0 0 0 usage "deprecated: use dup() instead.";
300 0         0 shift->dup(@_);
301             }
302              
303             #------------------------------
304              
305             =item count TAG
306              
307             I
308             Returns the number of occurrences of a field; in a boolean context, this
309             tells you whether a given field exists:
310              
311             ### Was a "Subject:" field given?
312             $subject_was_given = $head->count('subject');
313              
314             The TAG is treated in a case-insensitive manner.
315             This method returns some false value if the field doesn't exist,
316             and some true value if it does.
317              
318             =cut
319              
320             ### Inherited.
321              
322              
323             #------------------------------
324              
325             =item decode [FORCE]
326              
327             I
328             Go through all the header fields, looking for RFC 1522 / RFC 2047 style
329             "Q" (quoted-printable, sort of) or "B" (base64) encoding, and decode
330             them in-place. Fellow Americans, you probably don't know what the hell
331             I'm talking about. Europeans, Russians, et al, you probably do.
332             C<:-)>.
333              
334             B
335             See L for the full reasons.
336             If you absolutely must use it and don't like the warning, then
337             provide 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              
347             B
348             For an example, let's consider a valid email header you might get:
349              
350             From: =?US-ASCII?Q?Keith_Moore?=
351             To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?=
352             CC: =?ISO-8859-1?Q?Andr=E9_?= Pirard
353             Subject: =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
354             =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
355             =?US-ASCII?Q?.._cool!?=
356              
357             That basically decodes to (sorry, I can only approximate the
358             Latin characters with 7 bit sequences /o and 'e):
359              
360             From: Keith Moore
361             To: Keld J/orn Simonsen
362             CC: Andr'e Pirard
363             Subject: If you can read this you understand the example... cool!
364              
365             B currently, the decodings are done without regard to the
366             character set: thus, the Q-encoding C<=F8> is simply translated to the
367             octet (hexadecimal C), period. For piece-by-piece decoding
368             of a given field, you want the array context of
369             C.
370              
371             B the CRLF+SPACE separator that splits up long encoded words
372             into shorter sequences (see the Subject: example above) gets lost
373             when the field is unfolded, and so decoding after unfolding causes
374             a spurious space to be left in the field.
375             I
376              
377             This method returns the self object.
378              
379             I
380             RFC-1522-decoding code.>
381              
382             =cut
383              
384             sub decode {
385 2     2 1 464 my $self = shift;
386              
387             ### Warn if necessary:
388 2   50     9 my $force = shift || 0;
389 2 50 33     10 unless (($force eq "I_NEED_TO_FIX_THIS") ||
390             ($force eq "I_KNOW_WHAT_I_AM_DOING")) {
391 2         5 usage "decode is deprecated for safety";
392             }
393              
394 2         2 my ($tag, $i, @decoded);
395 2         7 foreach $tag ($self->tags) {
396 20         1231 @decoded = map { scalar(decode_mimewords($_, Field=>$tag))
  20         342  
397             } $self->get_all($tag);
398 20         34 for ($i = 0; $i < @decoded; $i++) {
399 20         43 $self->replace($tag, $decoded[$i], $i);
400             }
401             }
402 2         136 $self->{MH_Decoded} = 1;
403 2         4 $self;
404             }
405              
406             #------------------------------
407              
408             =item delete TAG,[INDEX]
409              
410             I
411             Delete 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             #
426             sub exists {
427 0     0 0 0 usage "deprecated; use count() instead";
428 0         0 shift->count(@_);
429             }
430              
431             #------------------------------
432             #
433             # fields
434             #
435             sub fields {
436 0     0 1 0 usage "deprecated: use tags() instead",
437             shift->tags(@_);
438             }
439              
440             #------------------------------
441              
442             =item get TAG,[INDEX]
443              
444             I
445             Get the contents of field TAG.
446              
447             If a B is given, returns the occurrence at that index,
448             or 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              
454             If B is given, but invoked in a B context, then
455             INDEX simply defaults to 0:
456              
457             ### Get the first 'Received:' entry (implicitly):
458             my $most_recent = $head->get('received');
459              
460             If B is given, and invoked in an B context, then
461             I occurrences of the field are returned:
462              
463             ### Get all 'Received:' entries:
464             my @all_received = $head->get('received');
465              
466             B: The header(s) returned may end with a newline. If you don't
467             want this, then B the return value.
468              
469             =cut
470              
471             ### Inherited.
472              
473              
474             #------------------------------
475              
476             =item get_all FIELD
477              
478             I
479             Returns the list of I occurrences of the field, or the
480             empty list if the field is not present:
481              
482             ### How did it get here?
483             @history = $head->get_all('Received');
484              
485             B I had originally experimented with having C return all
486             occurrences when invoked in an array context... but that causes a lot of
487             accidents when you get careless and do stuff like this:
488              
489             print "\u$field: ", $head->get($field);
490              
491             It also made the intuitive behaviour unclear if the INDEX argument
492             was given in an array context. So I opted for an explicit approach
493             to asking for all occurrences.
494              
495             =cut
496              
497             sub get_all {
498 21     21 1 316 my ($self, $tag) = @_;
499 21 50       33 $self->count($tag) or return (); ### empty if doesn't exist
500 21         265 ($self->get($tag));
501             }
502              
503             #------------------------------
504             #
505             # original_text
506             #
507             # Instance method, DEPRECATED.
508             # Return an approximation of the original text.
509             #
510             sub original_text {
511 0     0 0 0 usage "deprecated: use stringify() instead";
512 0         0 shift->stringify(@_);
513             }
514              
515             #------------------------------
516              
517             =item print [OUTSTREAM]
518              
519             I
520             Print the header out to the given OUTSTREAM, or the currently-selected
521             filehandle if none. The OUTSTREAM may be a filehandle, or any object
522             that responds to a print() message.
523              
524             The override actually lets you print to any object that responds to
525             a print() method. This is vital for outputting MIME entities to scalars.
526              
527             Also, it defaults to the I filehandle if none is given
528             (not STDOUT!), so I supply a filehandle to prevent confusion.
529              
530             =cut
531              
532             sub print {
533 69     69 1 2101 my ($self, $fh) = @_;
534 69   33     206 $fh ||= select;
535 69         123 $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             #
545             sub set {
546 0     0 0 0 my $self = shift;
547 0         0 usage "deprecated: use the replace() method instead.";
548 0         0 $self->replace(@_);
549             }
550              
551             #------------------------------
552              
553             =item stringify
554              
555             I
556             Return the header as a string. You can also invoke it as C.
557              
558             =cut
559              
560             sub stringify {
561 72     72 1 730 my $self = shift; ### build clean header, and output...
562 72 50       64 my @header = grep {defined($_) ? $_ : ()} @{$self->header};
  376         1763  
  72         175  
563 72 50       113 join "", map { /\n$/ ? $_ : "$_\n" } @header;
  376         948  
564             }
565 69     69 1 108 sub as_string { shift->stringify(@_) }
566              
567             #------------------------------
568              
569             =item unfold [FIELD]
570              
571             I
572             Unfold (remove newlines in) the text of all occurrences of the given FIELD.
573             If the FIELD is omitted, I fields are unfolded.
574             Returns the "self" object.
575              
576             =cut
577              
578             ### Inherited
579              
580              
581             #------------------------------
582              
583             =back
584              
585             =head2 MIME-specific methods
586              
587             All of the following methods extract information from the following fields:
588              
589             Content-type
590             Content-transfer-encoding
591             Content-disposition
592              
593             Be aware that they do not just return the raw contents of those fields,
594             and in some cases they will fill in sensible (I hope) default values.
595             Use C or C if you need to grab and process the
596             raw field text.
597              
598             B some of these methods are provided both as a convenience and
599             for backwards-compatibility only, while others (like
600             recommended_filename()) I
601             properly,> since they look for their value in more than one field.
602             However, if you know that a value is restricted to a single
603             field, you should really use the Mail::Field interface to get it.
604              
605             =over 4
606              
607             =cut
608              
609             #------------------------------
610              
611              
612             #------------------------------
613             #
614             # params TAG
615             #
616             # Instance method, DEPRECATED.
617             # Extract parameter info from a structured field, and return
618             # it as a hash reference. Provided for 1.0 compatibility only!
619             # Use the new MIME::Field interface classes (subclasses of Mail::Field).
620              
621             sub params {
622 1     1 0 2181 my ($self, $tag) = @_;
623 1         4 usage "deprecated: use the MIME::Field interface classes from now on!";
624 1         3 return MIME::Field::ParamVal->parse_params($self->get($tag,0));
625             }
626              
627             #------------------------------
628              
629             =item mime_attr ATTR,[VALUE]
630              
631             A quick-and-easy interface to set/get the attributes in structured
632             MIME fields:
633              
634             $head->mime_attr("content-type" => "text/html");
635             $head->mime_attr("content-type.charset" => "US-ASCII");
636             $head->mime_attr("content-type.name" => "homepage.html");
637              
638             This would cause the final output to look something like this:
639              
640             Content-type: text/html; charset=US-ASCII; name="homepage.html"
641              
642             Note that the special empty sub-field tag indicates the anonymous
643             first sub-field.
644              
645             B will cause the contents of the named subfield
646             to be deleted:
647              
648             $head->mime_attr("content-type.charset" => undef);
649              
650             B just returns the attribute's value,
651             or undefined if it isn't there:
652              
653             $type = $head->mime_attr("content-type"); ### text/html
654             $name = $head->mime_attr("content-type.name"); ### homepage.html
655              
656             In all cases, the new/current value is returned.
657              
658             =cut
659              
660             sub mime_attr {
661 1613     1613 1 1913 my ($self, $attr, $value) = @_;
662              
663             ### Break attribute name up:
664 1613         2633 my ($tag, $subtag) = split /\./, $attr;
665 1613   100     4175 $subtag ||= '_';
666              
667             ### Set or get?
668 1613         3144 my $field = MIME::Field::ParamVal->parse($self->get($tag, 0));
669 1613 100       2920 if (@_ > 2) { ### set it:
670 9         20 $field->param($subtag, $value); ### set subfield
671 9         22 $self->replace($tag, $field->stringify); ### replace!
672 9         891 return $value;
673             }
674             else { ### get it:
675 1604         2839 return $field->param($subtag);
676             }
677             }
678              
679             #------------------------------
680              
681             =item mime_encoding
682              
683             I
684             Try I to determine the content transfer encoding
685             (e.g., C<"base64">, C<"binary">), which is returned in all-lowercase.
686              
687             If no encoding could be found, the default of C<"7bit"> is returned
688             I quote from RFC 2045 section 6.1:
689              
690             This is the default value -- that is, "Content-Transfer-Encoding: 7BIT"
691             is assumed if the Content-Transfer-Encoding header field is not present.
692              
693             I do one other form of fixup: "7_bit", "7-bit", and "7 bit" are
694             corrected to "7bit"; likewise for "8bit".
695              
696             =cut
697              
698             sub mime_encoding {
699 288     288 1 1259 my $self = shift;
700 288   100     368 my $enc = lc($self->mime_attr('content-transfer-encoding') || '7bit');
701 288         310 $enc =~ s{^([78])[ _-]bit\Z}{$1bit};
702 288         604 $enc;
703             }
704              
705             #------------------------------
706              
707             =item mime_type [DEFAULT]
708              
709             I
710             Try C to determine the content type (e.g., C<"text/plain">,
711             C<"image/gif">, C<"x-weird-type">, which is returned in all-lowercase.
712             "Real hard" means that if no content type could be found, the default
713             (usually C<"text/plain">) is returned. From RFC 2045 section 5.2:
714              
715             Default RFC 822 messages without a MIME Content-Type header are
716             taken by this protocol to be plain text in the US-ASCII character
717             set, which can be explicitly specified as:
718              
719             Content-type: text/plain; charset=us-ascii
720              
721             This default is assumed if no Content-Type header field is specified.
722              
723             Unless this is a part of a "multipart/digest", in which case
724             "message/rfc822" is the default. Note that you can also I the
725             default, but you shouldn't: normally only the MIME parser uses this
726             feature.
727              
728             =cut
729              
730             sub mime_type {
731 859     859 1 5791 my ($self, $default) = @_;
732 859 100       1297 $self->{MIH_DefaultType} = $default if @_ > 1;
733             my $s = $self->mime_attr('content-type') ||
734             $self->{MIH_DefaultType} ||
735 859   100     1145 'text/plain';
736             # avoid [perl #87336] bug, lc laundering tainted data
737 859 50 33     5040 return lc($s) if $] <= 5.008 || $] >= 5.014;
738 0         0 $s =~ tr/A-Z/a-z/;
739 0         0 $s;
740             }
741              
742             #------------------------------
743              
744             =item multipart_boundary
745              
746             I
747             If this is a header for a multipart message, return the
748             "encapsulation boundary" used to separate the parts. The boundary
749             is returned exactly as given in the C field; that
750             is, the leading double-hyphen (C<-->) is I prepended.
751              
752             Well, I exactly... this passage from RFC 2046 dictates
753             that we remove any trailing spaces:
754              
755             If a boundary appears to end with white space, the white space
756             must be presumed to have been added by a gateway, and must be deleted.
757              
758             Returns undef (B the empty string) if either the message is not
759             multipart or if there is no specified boundary.
760              
761             =cut
762              
763             sub multipart_boundary {
764 72     72 1 280 my $self = shift;
765 72         117 my $value = $self->mime_attr('content-type.boundary');
766 72 50       211 (!defined($value)) ? undef : $value;
767             }
768              
769             #------------------------------
770              
771             =item recommended_filename
772              
773             I
774             Return the recommended external filename. This is used when
775             extracting the data from the MIME stream. The filename is always
776             returned as a string in Perl's internal format (the UTF8 flag may be on!)
777              
778             Returns undef if no filename could be suggested.
779              
780             =cut
781              
782             sub recommended_filename
783             {
784 187     187 1 545 my $self = shift;
785              
786             # Try these headers in order, taking the first defined,
787             # non-blank one we find.
788 187         566 my $wd = supported MIME::WordDecoder 'UTF-8';
789 187         232 foreach my $attr_name ( qw( content-disposition.filename content-type.name ) ) {
790 321         468 my $value = $self->mime_attr( $attr_name );
791 321 100 66     1177 if ( defined $value
      100        
792             && $value ne ''
793             && $value =~ /\S/ ) {
794 76         223 return $wd->decode($value);
795             }
796             }
797              
798 111         191 return undef;
799             }
800              
801             #------------------------------
802              
803             =back
804              
805             =cut
806              
807              
808             #------------------------------
809             #
810             # tweak_FROM_parsing
811             #
812             # DEPRECATED. Use the inherited mail_from() class method now.
813              
814             sub tweak_FROM_parsing {
815 0     0 0   my $self = shift;
816 0           usage "deprecated. Use mail_from() instead.";
817 0           $self->mail_from(@_);
818             }
819              
820              
821             __END__