File Coverage

blib/lib/Email/Address.pm
Criterion Covered Total %
statement 120 136 88.2
branch 52 60 86.6
condition 16 18 88.8
subroutine 18 24 75.0
pod 9 10 90.0
total 215 248 86.6


line stmt bran cond sub pod time code
1 10     10   357574 use strict;
  10         76  
  10         259  
2 10     10   46 use warnings;
  10         14  
  10         9823  
3             package Email::Address;
4             # ABSTRACT: (DEPRECATED) RFC 2822 Address Parsing and Creation
5             $Email::Address::VERSION = '1.911';
6             our $COMMENT_NEST_LEVEL ||= 1;
7             our $STRINGIFY ||= 'format';
8             our $COLLAPSE_SPACES = 1 unless defined $COLLAPSE_SPACES; # I miss //=
9              
10             #pod =head1 SYNOPSIS
11             #pod
12             #pod use Email::Address;
13             #pod
14             #pod my @addresses = Email::Address->parse($line);
15             #pod my $address = Email::Address->new(Casey => 'casey@localhost');
16             #pod
17             #pod print $address->format;
18             #pod
19             #pod =head1 DESCRIPTION
20             #pod
21             #pod B This module has a vulnerability
22             #pod (L)
23             #pod which allows remote attackers to cause denial of service. In other words,
24             #pod sometimes it takes way too long to process certain kinds of input. Maybe
25             #pod someday this will be fixed. Until then, use
26             #pod L|Email::Address::XS> instead which has backward
27             #pod compatible API.
28             #pod
29             #pod This class implements a regex-based RFC 2822 parser that locates email
30             #pod addresses in strings and returns a list of C objects found.
31             #pod Alternatively you may construct objects manually. The goal of this software is
32             #pod to be correct, and very very fast.
33             #pod
34             #pod =cut
35              
36             my $CTL = q{\x00-\x1F\x7F};
37             my $special = q{()<>\\[\\]:;@\\\\,."};
38              
39             my $text = qr/[^\x0A\x0D]/;
40              
41             my $quoted_pair = qr/\\$text/;
42              
43             my $ctext = qr/(?>[^()\\]+)/;
44             my ($ccontent, $comment) = (q{})x2;
45             for (1 .. $COMMENT_NEST_LEVEL) {
46             $ccontent = qr/$ctext|$quoted_pair|$comment/;
47             $comment = qr/(?>\s*\((?:\s*$ccontent)*\s*\)\s*)/;
48             }
49             my $cfws = qr/$comment|(?>\s+)/;
50              
51             my $atext = qq/[^$CTL$special\\s]/;
52             my $atom = qr/(?>$cfws*$atext+$cfws*)/;
53             my $dot_atom_text = qr/(?>$atext+(?:\.$atext+)*)/;
54             my $dot_atom = qr/(?>$cfws*$dot_atom_text$cfws*)/;
55              
56             my $qtext = qr/[^\\"]/;
57             my $qcontent = qr/$qtext|$quoted_pair/;
58             my $quoted_string = qr/(?>$cfws*"$qcontent*"$cfws*)/;
59              
60             my $word = qr/$atom|$quoted_string/;
61              
62             # XXX: This ($phrase) used to just be: my $phrase = qr/$word+/; It was changed
63             # to resolve bug 22991, creating a significant slowdown. Given current speed
64             # problems. Once 16320 is resolved, this section should be dealt with.
65             # -- rjbs, 2006-11-11
66             #my $obs_phrase = qr/$word(?:$word|\.|$cfws)*/;
67              
68             # XXX: ...and the above solution caused endless problems (never returned) when
69             # examining this address, now in a test:
70             # admin+=E6=96=B0=E5=8A=A0=E5=9D=A1_Weblog-- ATAT --test.socialtext.com
71             # So we disallow the hateful CFWS in this context for now. Of modern mail
72             # agents, only Apple Web Mail 2.0 is known to produce obs-phrase.
73             # -- rjbs, 2006-11-19
74             my $simple_word = qr/(?>$atom|\.|\s*"$qcontent+"\s*)/;
75             my $obs_phrase = qr/(?>$simple_word+)/;
76              
77             my $phrase = qr/$obs_phrase|(?>$word+)/;
78              
79             my $local_part = qr/$dot_atom|$quoted_string/;
80             my $dtext = qr/[^\[\]\\]/;
81             my $dcontent = qr/$dtext|$quoted_pair/;
82             my $domain_literal = qr/(?>$cfws*\[(?:\s*$dcontent)*\s*\]$cfws*)/;
83             my $domain = qr/$dot_atom|$domain_literal/;
84              
85             my $display_name = $phrase;
86              
87             #pod =head2 Package Variables
88             #pod
89             #pod B Email isn't easy (if even possible) to parse with a regex, I
90             #pod least> if you're on a C prior to 5.10.0. Providing regular expressions
91             #pod for use by other programs isn't a great idea, because it makes it hard to
92             #pod improve the parser without breaking the "it's a regex" feature. Using these
93             #pod regular expressions is not encouraged, and methods like C<<
94             #pod Email::Address->is_addr_spec >> should be provided in the future.
95             #pod
96             #pod Several regular expressions used in this package are useful to others.
97             #pod For convenience, these variables are declared as package variables that
98             #pod you may access from your program.
99             #pod
100             #pod These regular expressions conform to the rules specified in RFC 2822.
101             #pod
102             #pod You can access these variables using the full namespace. If you want
103             #pod short names, define them yourself.
104             #pod
105             #pod my $addr_spec = $Email::Address::addr_spec;
106             #pod
107             #pod =over 4
108             #pod
109             #pod =item $Email::Address::addr_spec
110             #pod
111             #pod This regular expression defined what an email address is allowed to
112             #pod look like.
113             #pod
114             #pod =item $Email::Address::angle_addr
115             #pod
116             #pod This regular expression defines an C<$addr_spec> wrapped in angle
117             #pod brackets.
118             #pod
119             #pod =item $Email::Address::name_addr
120             #pod
121             #pod This regular expression defines what an email address can look like
122             #pod with an optional preceding display name, also known as the C.
123             #pod
124             #pod =item $Email::Address::mailbox
125             #pod
126             #pod This is the complete regular expression defining an RFC 2822 email
127             #pod address with an optional preceding display name and optional
128             #pod following comment.
129             #pod
130             #pod =back
131             #pod
132             #pod =cut
133              
134             our $addr_spec = qr/$local_part\@$domain/;
135             our $angle_addr = qr/(?>$cfws*<$addr_spec>$cfws*)/;
136             our $name_addr = qr/(?>$display_name?)$angle_addr/;
137             our $mailbox = qr/(?:$name_addr|$addr_spec)(?>$comment*)/;
138              
139             sub _PHRASE () { 0 }
140             sub _ADDRESS () { 1 }
141             sub _COMMENT () { 2 }
142             sub _ORIGINAL () { 3 }
143             sub _IN_CACHE () { 4 }
144              
145             sub __dump {
146             return {
147 0     0   0 phrase => $_[0][_PHRASE],
148             address => $_[0][_ADDRESS],
149             comment => $_[0][_COMMENT],
150             original => $_[0][_ORIGINAL],
151             }
152             }
153              
154             #pod =head2 Class Methods
155             #pod
156             #pod =over
157             #pod
158             #pod =item parse
159             #pod
160             #pod my @addrs = Email::Address->parse(
161             #pod q[me@local, Casey , "Casey" (West)]
162             #pod );
163             #pod
164             #pod B This is where that vulnerability mentioned above lies. Do not use
165             #pod this method with untrusted user input.
166             #pod
167             #pod Use method L
168             #pod instead.
169             #pod
170             #pod This method returns a list of C objects it finds in the input
171             #pod string. B that it returns a list, and expects that it may find
172             #pod multiple addresses. The behavior in scalar context is undefined.
173             #pod
174             #pod The specification for an email address allows for infinitely nestable comments.
175             #pod That's nice in theory, but a little over done. By default this module allows
176             #pod for one (C<1>) level of nested comments. If you think you need more, modify the
177             #pod C<$Email::Address::COMMENT_NEST_LEVEL> package variable to allow more.
178             #pod
179             #pod $Email::Address::COMMENT_NEST_LEVEL = 10; # I'm deep
180             #pod
181             #pod The reason for this hardly-limiting limitation is simple: efficiency.
182             #pod
183             #pod Long strings of whitespace can be problematic for this module to parse, a bug
184             #pod which has not yet been adequately addressed. The default behavior is now to
185             #pod collapse multiple spaces into a single space, which avoids this problem. To
186             #pod prevent this behavior, set C<$Email::Address::COLLAPSE_SPACES> to zero. This
187             #pod variable will go away when the bug is resolved properly.
188             #pod
189             #pod In accordance with RFC 822 and its descendants, this module demands that email
190             #pod addresses be ASCII only. Any non-ASCII content in the parsed addresses will
191             #pod cause the parser to return no results.
192             #pod
193             #pod =cut
194              
195             our (%PARSE_CACHE, %FORMAT_CACHE, %NAME_CACHE);
196             my $NOCACHE;
197              
198             sub __get_cached_parse {
199 118 50   118   251 return if $NOCACHE;
200              
201 118         229 my ($class, $line) = @_;
202              
203 118 100       334 return @{$PARSE_CACHE{$line}} if exists $PARSE_CACHE{$line};
  2         7  
204 116         337 return;
205             }
206              
207             sub __cache_parse {
208 116 50   116   241 return if $NOCACHE;
209              
210 116         215 my ($class, $line, $addrs) = @_;
211              
212 116         310 $PARSE_CACHE{$line} = $addrs;
213             }
214              
215             sub parse {
216 119     119 1 322421 my ($class, $line) = @_;
217 119 100       397 return unless $line;
218              
219 118 50       825 $line =~ s/[ \t]+/ /g if $COLLAPSE_SPACES;
220              
221 118 100       418 if (my @cached = $class->__get_cached_parse($line)) {
222 2         6 return @cached;
223             }
224              
225 116         186 my %mailboxes;
226 116         207 my $str = $line;
227 116 100       6657 $str =~ s!($name_addr(?>$comment*))!$mailboxes{pos($str)} = $1; ',' x length $1!ego
  198         678  
  198         1472  
228             if $str =~ /$angle_addr/;
229 116         3209 $str =~ s!($addr_spec(?>$comment*))!$mailboxes{pos($str)} = $1; ',' x length $1!ego;
  46         143  
  46         233  
230 116         527 my @mailboxes = map { $mailboxes{$_} } sort { $a <=> $b } keys %mailboxes;
  244         520  
  195         449  
231              
232 116         184 my @addrs;
233 116         233 foreach (@mailboxes) {
234 244         319 my $original = $_;
235              
236 244         650 my @comments = /($comment)/go;
237 244 100       456 s/$comment//go if @comments;
238              
239 244         362 my ($user, $host, $com);
240 244 100       3156 ($user, $host) = ($1, $2) if s/<($local_part)\@($domain)>\s*\z//o;
241 244 100 66     967 if (! defined($user) || ! defined($host)) {
242 46         1379 s/($local_part)\@($domain)//o;
243 46         181 ($user, $host) = ($1, $2);
244             }
245              
246 10 100   10   5072 next if $user =~ /\P{ASCII}/;
  10         124  
  10         131  
  244         576  
247 240 100       461 next if $host =~ /\P{ASCII}/;
248              
249 239         2643 my ($phrase) = /($display_name)/o;
250              
251 239         479 for ( $phrase, $host, $user, @comments ) {
252 727 100       1095 next unless defined $_;
253 651         1082 s/^\s+//;
254 651         1167 s/\s+$//;
255 651 50       1097 $_ = undef unless length $_;
256             }
257              
258 239 100       488 $phrase =~ s/\\(.)/$1/g if $phrase;
259              
260 239         382 my $new_comment = join q{ }, @comments;
261 239         766 push @addrs,
262             $class->new($phrase, "$user\@$host", $new_comment, $original);
263 239         958 $addrs[-1]->[_IN_CACHE] = [ \$line, $#addrs ]
264             }
265              
266 116         375 $class->__cache_parse($line, \@addrs);
267 116         506 return @addrs;
268             }
269              
270             #pod =item new
271             #pod
272             #pod my $address = Email::Address->new(undef, 'casey@local');
273             #pod my $address = Email::Address->new('Casey West', 'casey@local');
274             #pod my $address = Email::Address->new(undef, 'casey@local', '(Casey)');
275             #pod
276             #pod Constructs and returns a new C object. Takes four
277             #pod positional arguments: phrase, email, and comment, and original string.
278             #pod
279             #pod The original string should only really be set using C.
280             #pod
281             #pod =cut
282              
283             sub new {
284 693     693 1 259457 my ($class, $phrase, $email, $comment, $orig) = @_;
285 693 100       1799 $phrase =~ s/\A"(.+)"\z/$1/ if $phrase;
286              
287 693         2198 bless [ $phrase, $email, $comment, $orig ] => $class;
288             }
289              
290             #pod =item purge_cache
291             #pod
292             #pod Email::Address->purge_cache;
293             #pod
294             #pod One way this module stays fast is with internal caches. Caches live
295             #pod in memory and there is the remote possibility that you will have a
296             #pod memory problem. On the off chance that you think you're one of those
297             #pod people, this class method will empty those caches.
298             #pod
299             #pod I've loaded over 12000 objects and not encountered a memory problem.
300             #pod
301             #pod =cut
302              
303             sub purge_cache {
304 0     0 1 0 %NAME_CACHE = ();
305 0         0 %FORMAT_CACHE = ();
306 0         0 %PARSE_CACHE = ();
307             }
308              
309             #pod =item disable_cache
310             #pod
311             #pod =item enable_cache
312             #pod
313             #pod Email::Address->disable_cache if memory_low();
314             #pod
315             #pod If you'd rather not cache address parses at all, you can disable (and
316             #pod re-enable) the Email::Address cache with these methods. The cache is enabled
317             #pod by default.
318             #pod
319             #pod =cut
320              
321             sub disable_cache {
322 0     0 1 0 my ($class) = @_;
323 0         0 $class->purge_cache;
324 0         0 $NOCACHE = 1;
325             }
326              
327             sub enable_cache {
328 0     0 1 0 $NOCACHE = undef;
329             }
330              
331             #pod =back
332             #pod
333             #pod =head2 Instance Methods
334             #pod
335             #pod =over 4
336             #pod
337             #pod =item phrase
338             #pod
339             #pod my $phrase = $address->phrase;
340             #pod $address->phrase( "Me oh my" );
341             #pod
342             #pod Accessor and mutator for the phrase portion of an address.
343             #pod
344             #pod =item address
345             #pod
346             #pod my $addr = $address->address;
347             #pod $addr->address( "me@PROTECTED.com" );
348             #pod
349             #pod Accessor and mutator for the address portion of an address.
350             #pod
351             #pod =item comment
352             #pod
353             #pod my $comment = $address->comment;
354             #pod $address->comment( "(Work address)" );
355             #pod
356             #pod Accessor and mutator for the comment portion of an address.
357             #pod
358             #pod =item original
359             #pod
360             #pod my $orig = $address->original;
361             #pod
362             #pod Accessor for the original address found when parsing, or passed
363             #pod to C.
364             #pod
365             #pod =item host
366             #pod
367             #pod my $host = $address->host;
368             #pod
369             #pod Accessor for the host portion of an address's address.
370             #pod
371             #pod =item user
372             #pod
373             #pod my $user = $address->user;
374             #pod
375             #pod Accessor for the user portion of an address's address.
376             #pod
377             #pod =cut
378              
379             BEGIN {
380 10     10   51 my %_INDEX = (
381             phrase => _PHRASE,
382             address => _ADDRESS,
383             comment => _COMMENT,
384             original => _ORIGINAL,
385             );
386              
387 10         47 for my $method (keys %_INDEX) {
388 10     10   183296 no strict 'refs';
  10         22  
  10         1377  
389 40         65 my $index = $_INDEX{ $method };
390             *$method = sub {
391 229 100   229   145882 if ($_[1]) {
392 1 50       5 if ($_[0][_IN_CACHE]) {
393 1         2 my $replicant = bless [ @{$_[0]} ] => ref $_[0];
  1         4  
394 1         4 $PARSE_CACHE{ ${ $_[0][_IN_CACHE][0] } }[ $_[0][_IN_CACHE][1] ]
  1         3  
395             = $replicant;
396 1         3 $_[0][_IN_CACHE] = undef;
397             }
398 1         2 $_[0]->[ $index ] = $_[1];
399             } else {
400 228         829 $_[0]->[ $index ];
401             }
402 40         1033 };
403             }
404             }
405              
406 0     0 1 0 sub host { ($_[0]->[_ADDRESS] =~ /\@($domain)/o)[0] }
407 0     0 1 0 sub user { ($_[0]->[_ADDRESS] =~ /($local_part)\@/o)[0] }
408              
409             #pod =pod
410             #pod
411             #pod =item format
412             #pod
413             #pod my $printable = $address->format;
414             #pod
415             #pod Returns a properly formatted RFC 2822 address representing the
416             #pod object.
417             #pod
418             #pod =cut
419              
420             sub format {
421 10     10 1 62 my $cache_str = do { no warnings 'uninitialized'; "@{$_[0]}" };
  10     2014   19  
  10         3561  
  2014         466606  
  2014         2179  
  2014         5150  
422 2014 100       6939 return $FORMAT_CACHE{$cache_str} if exists $FORMAT_CACHE{$cache_str};
423 334         729 $FORMAT_CACHE{$cache_str} = $_[0]->_format;
424             }
425              
426             sub _format {
427 334     334   520 my ($self) = @_;
428              
429 334 100 100     1670 unless (
      100        
      100        
430             defined $self->[_PHRASE] && length $self->[_PHRASE]
431             ||
432             defined $self->[_COMMENT] && length $self->[_COMMENT]
433             ) {
434 86 100       410 return defined $self->[_ADDRESS] ? $self->[_ADDRESS] : '';
435             }
436              
437 248 100       632 my $comment = defined $self->[_COMMENT] ? $self->[_COMMENT] : '';
438 248 100 100     524 $comment = "($comment)" if length $comment and $comment !~ /\A\(.*\)\z/;
439              
440 248 50       483 my $format = sprintf q{%s <%s> %s},
441             $self->_enquoted_phrase,
442             (defined $self->[_ADDRESS] ? $self->[_ADDRESS] : ''),
443             $comment;
444              
445 248         600 $format =~ s/^\s+//;
446 248         906 $format =~ s/\s+$//;
447              
448 248         1011 return $format;
449             }
450              
451             sub _enquoted_phrase {
452 248     248   350 my ($self) = @_;
453              
454 248         379 my $phrase = $self->[_PHRASE];
455              
456 248 100 66     733 return '' unless defined $phrase and length $phrase;
457              
458             # if it's encoded -- rjbs, 2007-02-28
459 247 100       605 return $phrase if $phrase =~ /\A=\?.+\?=\z/;
460              
461 246         429 $phrase =~ s/\A"(.+)"\z/$1/;
462 246         472 $phrase =~ s/([\\"])/\\$1/g;
463              
464 246         1310 return qq{"$phrase"};
465             }
466              
467             #pod =item name
468             #pod
469             #pod my $name = $address->name;
470             #pod
471             #pod This method tries very hard to determine the name belonging to the address.
472             #pod First the C is checked. If that doesn't work out the C
473             #pod is looked into. If that still doesn't work out, the C portion of
474             #pod the C
is returned.
475             #pod
476             #pod This method does B try to massage any name it identifies and instead
477             #pod leaves that up to someone else. Who is it to decide if someone wants their
478             #pod name capitalized, or if they're Irish?
479             #pod
480             #pod =cut
481              
482             sub name {
483 10     10 1 70 my $cache_str = do { no warnings 'uninitialized'; "@{$_[0]}" };
  10     663   19  
  10         2595  
  663         806  
  663         775  
  663         1584  
484 663 100       1946 return $NAME_CACHE{$cache_str} if exists $NAME_CACHE{$cache_str};
485              
486 314         464 my ($self) = @_;
487 314         394 my $name = q{};
488 314 100       728 if ( $name = $self->[_PHRASE] ) {
    50          
489 233         416 $name =~ s/^"//;
490 233         312 $name =~ s/"$//;
491 233         398 $name =~ s/($quoted_pair)/substr $1, -1/goe;
  0         0  
492             } elsif ( $name = $self->[_COMMENT] ) {
493 0         0 $name =~ s/^\(//;
494 0         0 $name =~ s/\)$//;
495 0         0 $name =~ s/($quoted_pair)/substr $1, -1/goe;
  0         0  
496 0         0 $name =~ s/$comment/ /go;
497             } else {
498 81         833 ($name) = $self->[_ADDRESS] =~ /($local_part)\@/o;
499             }
500 314         916 $NAME_CACHE{$cache_str} = $name;
501             }
502              
503             #pod =back
504             #pod
505             #pod =head2 Overloaded Operators
506             #pod
507             #pod =over 4
508             #pod
509             #pod =item stringify
510             #pod
511             #pod print "I have your email address, $address.";
512             #pod
513             #pod Objects stringify to C by default. It's possible that you don't
514             #pod like that idea. Okay, then, you can change it by modifying
515             #pod C<$Email:Address::STRINGIFY>. Please consider modifying this package
516             #pod variable using C. You might step on someone else's toes if you
517             #pod don't.
518             #pod
519             #pod {
520             #pod local $Email::Address::STRINGIFY = 'host';
521             #pod print "I have your address, $address.";
522             #pod # geeknest.com
523             #pod }
524             #pod print "I have your address, $address.";
525             #pod # "Casey West"
526             #pod
527             #pod Modifying this package variable is now deprecated. Subclassing is now the
528             #pod recommended approach.
529             #pod
530             #pod =cut
531              
532             sub as_string {
533 669 50   669 0 3319 warn 'altering $Email::Address::STRINGIFY is deprecated; subclass instead'
534             if $STRINGIFY ne 'format';
535              
536 669         1845 $_[0]->can($STRINGIFY)->($_[0]);
537             }
538              
539 10     10   6940 use overload '""' => 'as_string', fallback => 1;
  10         5177  
  10         61  
540              
541             #pod =pod
542             #pod
543             #pod =back
544             #pod
545             #pod =cut
546              
547             1;
548              
549             =pod
550              
551             =encoding UTF-8
552              
553             =head1 NAME
554              
555             Email::Address - (DEPRECATED) RFC 2822 Address Parsing and Creation
556              
557             =head1 VERSION
558              
559             version 1.911
560              
561             =head1 SYNOPSIS
562              
563             use Email::Address;
564              
565             my @addresses = Email::Address->parse($line);
566             my $address = Email::Address->new(Casey => 'casey@localhost');
567              
568             print $address->format;
569              
570             =head1 DESCRIPTION
571              
572             B This module has a vulnerability
573             (L)
574             which allows remote attackers to cause denial of service. In other words,
575             sometimes it takes way too long to process certain kinds of input. Maybe
576             someday this will be fixed. Until then, use
577             L|Email::Address::XS> instead which has backward
578             compatible API.
579              
580             This class implements a regex-based RFC 2822 parser that locates email
581             addresses in strings and returns a list of C objects found.
582             Alternatively you may construct objects manually. The goal of this software is
583             to be correct, and very very fast.
584              
585             =head2 Package Variables
586              
587             B Email isn't easy (if even possible) to parse with a regex, I
588             least> if you're on a C prior to 5.10.0. Providing regular expressions
589             for use by other programs isn't a great idea, because it makes it hard to
590             improve the parser without breaking the "it's a regex" feature. Using these
591             regular expressions is not encouraged, and methods like C<<
592             Email::Address->is_addr_spec >> should be provided in the future.
593              
594             Several regular expressions used in this package are useful to others.
595             For convenience, these variables are declared as package variables that
596             you may access from your program.
597              
598             These regular expressions conform to the rules specified in RFC 2822.
599              
600             You can access these variables using the full namespace. If you want
601             short names, define them yourself.
602              
603             my $addr_spec = $Email::Address::addr_spec;
604              
605             =over 4
606              
607             =item $Email::Address::addr_spec
608              
609             This regular expression defined what an email address is allowed to
610             look like.
611              
612             =item $Email::Address::angle_addr
613              
614             This regular expression defines an C<$addr_spec> wrapped in angle
615             brackets.
616              
617             =item $Email::Address::name_addr
618              
619             This regular expression defines what an email address can look like
620             with an optional preceding display name, also known as the C.
621              
622             =item $Email::Address::mailbox
623              
624             This is the complete regular expression defining an RFC 2822 email
625             address with an optional preceding display name and optional
626             following comment.
627              
628             =back
629              
630             =head2 Class Methods
631              
632             =over
633              
634             =item parse
635              
636             my @addrs = Email::Address->parse(
637             q[me@local, Casey , "Casey" (West)]
638             );
639              
640             B This is where that vulnerability mentioned above lies. Do not use
641             this method with untrusted user input.
642              
643             Use method L
644             instead.
645              
646             This method returns a list of C objects it finds in the input
647             string. B that it returns a list, and expects that it may find
648             multiple addresses. The behavior in scalar context is undefined.
649              
650             The specification for an email address allows for infinitely nestable comments.
651             That's nice in theory, but a little over done. By default this module allows
652             for one (C<1>) level of nested comments. If you think you need more, modify the
653             C<$Email::Address::COMMENT_NEST_LEVEL> package variable to allow more.
654              
655             $Email::Address::COMMENT_NEST_LEVEL = 10; # I'm deep
656              
657             The reason for this hardly-limiting limitation is simple: efficiency.
658              
659             Long strings of whitespace can be problematic for this module to parse, a bug
660             which has not yet been adequately addressed. The default behavior is now to
661             collapse multiple spaces into a single space, which avoids this problem. To
662             prevent this behavior, set C<$Email::Address::COLLAPSE_SPACES> to zero. This
663             variable will go away when the bug is resolved properly.
664              
665             In accordance with RFC 822 and its descendants, this module demands that email
666             addresses be ASCII only. Any non-ASCII content in the parsed addresses will
667             cause the parser to return no results.
668              
669             =item new
670              
671             my $address = Email::Address->new(undef, 'casey@local');
672             my $address = Email::Address->new('Casey West', 'casey@local');
673             my $address = Email::Address->new(undef, 'casey@local', '(Casey)');
674              
675             Constructs and returns a new C object. Takes four
676             positional arguments: phrase, email, and comment, and original string.
677              
678             The original string should only really be set using C.
679              
680             =item purge_cache
681              
682             Email::Address->purge_cache;
683              
684             One way this module stays fast is with internal caches. Caches live
685             in memory and there is the remote possibility that you will have a
686             memory problem. On the off chance that you think you're one of those
687             people, this class method will empty those caches.
688              
689             I've loaded over 12000 objects and not encountered a memory problem.
690              
691             =item disable_cache
692              
693             =item enable_cache
694              
695             Email::Address->disable_cache if memory_low();
696              
697             If you'd rather not cache address parses at all, you can disable (and
698             re-enable) the Email::Address cache with these methods. The cache is enabled
699             by default.
700              
701             =back
702              
703             =head2 Instance Methods
704              
705             =over 4
706              
707             =item phrase
708              
709             my $phrase = $address->phrase;
710             $address->phrase( "Me oh my" );
711              
712             Accessor and mutator for the phrase portion of an address.
713              
714             =item address
715              
716             my $addr = $address->address;
717             $addr->address( "me@PROTECTED.com" );
718              
719             Accessor and mutator for the address portion of an address.
720              
721             =item comment
722              
723             my $comment = $address->comment;
724             $address->comment( "(Work address)" );
725              
726             Accessor and mutator for the comment portion of an address.
727              
728             =item original
729              
730             my $orig = $address->original;
731              
732             Accessor for the original address found when parsing, or passed
733             to C.
734              
735             =item host
736              
737             my $host = $address->host;
738              
739             Accessor for the host portion of an address's address.
740              
741             =item user
742              
743             my $user = $address->user;
744              
745             Accessor for the user portion of an address's address.
746              
747             =item format
748              
749             my $printable = $address->format;
750              
751             Returns a properly formatted RFC 2822 address representing the
752             object.
753              
754             =item name
755              
756             my $name = $address->name;
757              
758             This method tries very hard to determine the name belonging to the address.
759             First the C is checked. If that doesn't work out the C
760             is looked into. If that still doesn't work out, the C portion of
761             the C
is returned.
762              
763             This method does B try to massage any name it identifies and instead
764             leaves that up to someone else. Who is it to decide if someone wants their
765             name capitalized, or if they're Irish?
766              
767             =back
768              
769             =head2 Overloaded Operators
770              
771             =over 4
772              
773             =item stringify
774              
775             print "I have your email address, $address.";
776              
777             Objects stringify to C by default. It's possible that you don't
778             like that idea. Okay, then, you can change it by modifying
779             C<$Email:Address::STRINGIFY>. Please consider modifying this package
780             variable using C. You might step on someone else's toes if you
781             don't.
782              
783             {
784             local $Email::Address::STRINGIFY = 'host';
785             print "I have your address, $address.";
786             # geeknest.com
787             }
788             print "I have your address, $address.";
789             # "Casey West"
790              
791             Modifying this package variable is now deprecated. Subclassing is now the
792             recommended approach.
793              
794             =back
795              
796             =head2 Did I Mention Fast?
797              
798             On his 1.8GHz Apple MacBook, rjbs gets these results:
799              
800             $ perl -Ilib bench/ea-vs-ma.pl bench/corpus.txt 5
801             Rate Mail::Address Email::Address
802             Mail::Address 2.59/s -- -44%
803             Email::Address 4.59/s 77% --
804              
805             $ perl -Ilib bench/ea-vs-ma.pl bench/corpus.txt 25
806             Rate Mail::Address Email::Address
807             Mail::Address 2.58/s -- -67%
808             Email::Address 7.84/s 204% --
809              
810             $ perl -Ilib bench/ea-vs-ma.pl bench/corpus.txt 50
811             Rate Mail::Address Email::Address
812             Mail::Address 2.57/s -- -70%
813             Email::Address 8.53/s 232% --
814              
815             ...unfortunately, a known bug causes a loss of speed the string to parse has
816             certain known characteristics, and disabling cache will also degrade
817             performance.
818              
819             =head1 ACKNOWLEDGEMENTS
820              
821             Thanks to Kevin Riggle and Tatsuhiko Miyagawa for tests for annoying
822             phrase-quoting bugs!
823              
824             =head1 AUTHORS
825              
826             =over 4
827              
828             =item *
829              
830             Casey West
831              
832             =item *
833              
834             Ricardo SIGNES
835              
836             =back
837              
838             =head1 CONTRIBUTORS
839              
840             =for stopwords Alex Vandiver David Golden Steinbrunner Glenn Fowler Kevin Falcone Pali Ruslan Zakirov sunnavy William Yardley
841              
842             =over 4
843              
844             =item *
845              
846             Alex Vandiver
847              
848             =item *
849              
850             David Golden
851              
852             =item *
853              
854             David Steinbrunner
855              
856             =item *
857              
858             Glenn Fowler
859              
860             =item *
861              
862             Kevin Falcone
863              
864             =item *
865              
866             Pali
867              
868             =item *
869              
870             Ruslan Zakirov
871              
872             =item *
873              
874             sunnavy
875              
876             =item *
877              
878             William Yardley
879              
880             =back
881              
882             =head1 COPYRIGHT AND LICENSE
883              
884             This software is copyright (c) 2004 by Casey West.
885              
886             This is free software; you can redistribute it and/or modify it under
887             the same terms as the Perl 5 programming language system itself.
888              
889             =cut
890              
891             __END__