← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:11 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Email/Address.pm
StatementsExecuted 64 statements in 4.38ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
232112.14ms2.14msEmail::Address::::CORE:regcomp Email::Address::CORE:regcomp (opcode)
111164µs164µsEmail::Address::::BEGIN@230 Email::Address::BEGIN@230
2725130µs30µsEmail::Address::::CORE:qr Email::Address::CORE:qr (opcode)
11120µs20µsEmail::Address::::BEGIN@361 Email::Address::BEGIN@361
11111µs22µsPerl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::::BEGIN@1Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@1
1119µs39µsEmail::Address::::BEGIN@521 Email::Address::BEGIN@521
1119µs21µsEmail::Address::::BEGIN@403 Email::Address::BEGIN@403
1118µs17µsEmail::Address::::BEGIN@465 Email::Address::BEGIN@465
1118µs19µsEmail::Address::::BEGIN@370 Email::Address::BEGIN@370
1117µs10µsPerl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::::BEGIN@2Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@2
0000s0sEmail::Address::::__ANON__[:384] Email::Address::__ANON__[:384]
0000s0sEmail::Address::::__cache_parse Email::Address::__cache_parse
0000s0sEmail::Address::::__dump Email::Address::__dump
0000s0sEmail::Address::::__get_cached_parse Email::Address::__get_cached_parse
0000s0sEmail::Address::::_enquoted_phrase Email::Address::_enquoted_phrase
0000s0sEmail::Address::::_format Email::Address::_format
0000s0sEmail::Address::::as_string Email::Address::as_string
0000s0sEmail::Address::::disable_cache Email::Address::disable_cache
0000s0sEmail::Address::::enable_cache Email::Address::enable_cache
0000s0sEmail::Address::::format Email::Address::format
0000s0sEmail::Address::::host Email::Address::host
0000s0sEmail::Address::::name Email::Address::name
0000s0sEmail::Address::::new Email::Address::new
0000s0sEmail::Address::::parse Email::Address::parse
0000s0sEmail::Address::::purge_cache Email::Address::purge_cache
0000s0sEmail::Address::::user Email::Address::user
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1219µs234µs
# spent 22µs (11+11) within Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@1 which was called: # once (11µs+11µs) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 1
use strict;
# spent 22µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@1 # spent 11µs making 1 call to strict::import
22657µs214µs
# spent 10µs (7+3) within Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@2 which was called: # once (7µs+3µs) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 2
use warnings;
# spent 10µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@2 # spent 3µs making 1 call to warnings::import
3package Email::Address;
4# ABSTRACT: RFC 2822 Address Parsing and Creation
51700ns$Email::Address::VERSION = '1.905';
61200nsour $COMMENT_NEST_LEVEL ||= 2;
71200nsour $STRINGIFY ||= 'format';
81200nsour $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 VERSION
20#pod
21#pod version 1.898
22#pod
23#pod =head1 DESCRIPTION
24#pod
25#pod This class implements a regex-based RFC 2822 parser that locates email
26#pod addresses in strings and returns a list of C<Email::Address> objects found.
27#pod Alternatively you may construct objects manually. The goal of this software is
28#pod to be correct, and very very fast.
29#pod
30#pod =cut
31
321300nsmy $CTL = q{\x00-\x1F\x7F};
331300nsmy $special = q{()<>\\[\\]:;@\\\\,."};
34
3519µs12µsmy $text = qr/[^\x0A\x0D]/;
# spent 2µs making 1 call to Email::Address::CORE:qr
36
37117µs210µsmy $quoted_pair = qr/\\$text/;
# spent 9µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
38
3914µs11µsmy $ctext = qr/(?>[^()\\]+)/;
# spent 1µs making 1 call to Email::Address::CORE:qr
4011µsmy ($ccontent, $comment) = (q{})x2;
4111µsfor (1 .. $COMMENT_NEST_LEVEL) {
42252µs440µs $ccontent = qr/$ctext|$quoted_pair|$comment/;
# spent 38µs making 2 calls to Email::Address::CORE:regcomp, avg 19µs/call # spent 2µs making 2 calls to Email::Address::CORE:qr, avg 1µs/call
43257µs443µs $comment = qr/\s*\((?:\s*$ccontent)*\s*\)\s*/;
# spent 41µs making 2 calls to Email::Address::CORE:regcomp, avg 21µs/call # spent 2µs making 2 calls to Email::Address::CORE:qr, avg 1µs/call
44}
45127µs222µsmy $cfws = qr/$comment|\s+/;
# spent 21µs making 1 call to Email::Address::CORE:regcomp # spent 900ns making 1 call to Email::Address::CORE:qr
46
4711µsmy $atext = qq/[^$CTL$special\\s]/;
48160µs254µsmy $atom = qr/$cfws*$atext+$cfws*/;
# spent 53µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
49130µs225µsmy $dot_atom_text = qr/$atext+(?:\.$atext+)*/;
# spent 24µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
50168µs261µsmy $dot_atom = qr/$cfws*$dot_atom_text$cfws*/;
# spent 60µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
51
5213µs1800nsmy $qtext = qr/[^\\"]/;
# spent 800ns making 1 call to Email::Address::CORE:qr
53114µs29µsmy $qcontent = qr/$qtext|$quoted_pair/;
# spent 8µs making 1 call to Email::Address::CORE:regcomp # spent 900ns making 1 call to Email::Address::CORE:qr
54153µs247µsmy $quoted_string = qr/$cfws*"$qcontent*"$cfws*/;
# spent 46µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
55
56195µs288µsmy $word = qr/$atom|$quoted_string/;
# spent 87µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
57
58# XXX: This ($phrase) used to just be: my $phrase = qr/$word+/; It was changed
59# to resolve bug 22991, creating a significant slowdown. Given current speed
60# problems. Once 16320 is resolved, this section should be dealt with.
61# -- rjbs, 2006-11-11
62#my $obs_phrase = qr/$word(?:$word|\.|$cfws)*/;
63
64# XXX: ...and the above solution caused endless problems (never returned) when
65# examining this address, now in a test:
66# admin+=E6=96=B0=E5=8A=A0=E5=9D=A1_Weblog-- ATAT --test.socialtext.com
67# So we disallow the hateful CFWS in this context for now. Of modern mail
68# agents, only Apple Web Mail 2.0 is known to produce obs-phrase.
69# -- rjbs, 2006-11-19
70162µs256µsmy $simple_word = qr/$atom|\.|\s*"$qcontent+"\s*/;
# spent 55µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
71163µs255µsmy $obs_phrase = qr/$simple_word+/;
# spent 54µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
72
731144µs2135µsmy $phrase = qr/$obs_phrase|(?:$word+)/;
# spent 134µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
74
751102µs295µsmy $local_part = qr/$dot_atom|$quoted_string/;
# spent 94µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
7614µs11µsmy $dtext = qr/[^\[\]\\]/;
# spent 1µs making 1 call to Email::Address::CORE:qr
77116µs210µsmy $dcontent = qr/$dtext|$quoted_pair/;
# spent 8µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
78152µs246µsmy $domain_literal = qr/$cfws*\[(?:\s*$dcontent)*\s*\]$cfws*/;
# spent 45µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
791104µs296µsmy $domain = qr/$dot_atom|$domain_literal/;
# spent 96µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
80
811200nsmy $display_name = $phrase;
82
83#pod =head2 Package Variables
84#pod
85#pod B<ACHTUNG!> Email isn't easy (if even possible) to parse with a regex, I<at
86#pod least> if you're on a C<perl> prior to 5.10.0. Providing regular expressions
87#pod for use by other programs isn't a great idea, because it makes it hard to
88#pod improve the parser without breaking the "it's a regex" feature. Using these
89#pod regular expressions is not encouraged, and methods like C<<
90#pod Email::Address->is_addr_spec >> should be provided in the future.
91#pod
92#pod Several regular expressions used in this package are useful to others.
93#pod For convenience, these variables are declared as package variables that
94#pod you may access from your program.
95#pod
96#pod These regular expressions conform to the rules specified in RFC 2822.
97#pod
98#pod You can access these variables using the full namespace. If you want
99#pod short names, define them yourself.
100#pod
101#pod my $addr_spec = $Email::Address::addr_spec;
102#pod
103#pod =over 4
104#pod
105#pod =item $Email::Address::addr_spec
106#pod
107#pod This regular expression defined what an email address is allowed to
108#pod look like.
109#pod
110#pod =item $Email::Address::angle_addr
111#pod
112#pod This regular expression defines an C<$addr_spec> wrapped in angle
113#pod brackets.
114#pod
115#pod =item $Email::Address::name_addr
116#pod
117#pod This regular expression defines what an email address can look like
118#pod with an optional preceding display name, also known as the C<phrase>.
119#pod
120#pod =item $Email::Address::mailbox
121#pod
122#pod This is the complete regular expression defining an RFC 2822 email
123#pod address with an optional preceding display name and optional
124#pod following comment.
125#pod
126#pod =back
127#pod
128#pod =cut
129
1301194µs2184µsour $addr_spec = qr/$local_part\@$domain/;
# spent 183µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
1311222µs2212µsour $angle_addr = qr/$cfws*<$addr_spec>$cfws*/;
# spent 211µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
1321355µs2343µsour $name_addr = qr/(?>$display_name?)$angle_addr/;
# spent 342µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
1331544µs2528µsour $mailbox = qr/(?:$name_addr|$addr_spec)$comment*/;
# spent 527µs making 1 call to Email::Address::CORE:regcomp # spent 1µs making 1 call to Email::Address::CORE:qr
134
135sub _PHRASE () { 0 }
136sub _ADDRESS () { 1 }
137sub _COMMENT () { 2 }
138sub _ORIGINAL () { 3 }
139sub _IN_CACHE () { 4 }
140
141sub __dump {
142 return {
143 phrase => $_[0][_PHRASE],
144 address => $_[0][_ADDRESS],
145 comment => $_[0][_COMMENT],
146 original => $_[0][_ORIGINAL],
147 }
148}
149
150#pod =head2 Class Methods
151#pod
152#pod =over
153#pod
154#pod =item parse
155#pod
156#pod my @addrs = Email::Address->parse(
157#pod q[me@local, Casey <me@local>, "Casey" <me@local> (West)]
158#pod );
159#pod
160#pod This method returns a list of C<Email::Address> objects it finds in the input
161#pod string. B<Please note> that it returns a list, and expects that it may find
162#pod multiple addresses. The behavior in scalar context is undefined.
163#pod
164#pod The specification for an email address allows for infinitely nestable comments.
165#pod That's nice in theory, but a little over done. By default this module allows
166#pod for two (C<2>) levels of nested comments. If you think you need more, modify
167#pod the C<$Email::Address::COMMENT_NEST_LEVEL> package variable to allow more.
168#pod
169#pod $Email::Address::COMMENT_NEST_LEVEL = 10; # I'm deep
170#pod
171#pod The reason for this hardly-limiting limitation is simple: efficiency.
172#pod
173#pod Long strings of whitespace can be problematic for this module to parse, a bug
174#pod which has not yet been adequately addressed. The default behavior is now to
175#pod collapse multiple spaces into a single space, which avoids this problem. To
176#pod prevent this behavior, set C<$Email::Address::COLLAPSE_SPACES> to zero. This
177#pod variable will go away when the bug is resolved properly.
178#pod
179#pod In accordance with RFC 822 and its descendants, this module demands that email
180#pod addresses be ASCII only. Any non-ASCII content in the parsed addresses will
181#pod cause the parser to return no results.
182#pod
183#pod =cut
184
1851400nsour (%PARSE_CACHE, %FORMAT_CACHE, %NAME_CACHE);
1861100nsmy $NOCACHE;
187
188sub __get_cached_parse {
189 return if $NOCACHE;
190
191 my ($class, $line) = @_;
192
193 return @{$PARSE_CACHE{$line}} if exists $PARSE_CACHE{$line};
194 return;
195}
196
197sub __cache_parse {
198 return if $NOCACHE;
199
200 my ($class, $line, $addrs) = @_;
201
202 $PARSE_CACHE{$line} = $addrs;
203}
204
205sub parse {
206 my ($class, $line) = @_;
207 return unless $line;
208
209 $line =~ s/[ \t]+/ /g if $COLLAPSE_SPACES;
210
211 if (my @cached = $class->__get_cached_parse($line)) {
212 return @cached;
213 }
214
215 my (@mailboxes) = ($line =~ /$mailbox/go);
216 my @addrs;
217 foreach (@mailboxes) {
218 my $original = $_;
219
220 my @comments = /($comment)/go;
221 s/$comment//go if @comments;
222
223 my ($user, $host, $com);
224 ($user, $host) = ($1, $2) if s/<($local_part)\@($domain)>\s*\z//o;
225 if (! defined($user) || ! defined($host)) {
226 s/($local_part)\@($domain)//o;
227 ($user, $host) = ($1, $2);
228 }
229
2302208µs24.55ms
# spent 164µs within Email::Address::BEGIN@230 which was called: # once (164µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 230
next if $user =~ /\P{ASCII}/;
# spent 4.38ms making 1 call to utf8::AUTOLOAD # spent 164µs making 1 call to Email::Address::BEGIN@230
2311303µs139µs next if $host =~ /\P{ASCII}/;
# spent 39µs making 1 call to utf8::SWASHNEW
232
233 my ($phrase) = /($display_name)/o;
234
235 for ( $phrase, $host, $user, @comments ) {
236 next unless defined $_;
237 s/^\s+//;
238 s/\s+$//;
239 $_ = undef unless length $_;
240 }
241
242 my $new_comment = join q{ }, @comments;
243 push @addrs,
244 $class->new($phrase, "$user\@$host", $new_comment, $original);
245 $addrs[-1]->[_IN_CACHE] = [ \$line, $#addrs ]
246 }
247
248 $class->__cache_parse($line, \@addrs);
249 return @addrs;
250}
251
252#pod =item new
253#pod
254#pod my $address = Email::Address->new(undef, 'casey@local');
255#pod my $address = Email::Address->new('Casey West', 'casey@local');
256#pod my $address = Email::Address->new(undef, 'casey@local', '(Casey)');
257#pod
258#pod Constructs and returns a new C<Email::Address> object. Takes four
259#pod positional arguments: phrase, email, and comment, and original string.
260#pod
261#pod The original string should only really be set using C<parse>.
262#pod
263#pod =cut
264
265sub new {
266 my ($class, $phrase, $email, $comment, $orig) = @_;
267 $phrase =~ s/\A"(.+)"\z/$1/ if $phrase;
268
269 bless [ $phrase, $email, $comment, $orig ] => $class;
270}
271
272#pod =item purge_cache
273#pod
274#pod Email::Address->purge_cache;
275#pod
276#pod One way this module stays fast is with internal caches. Caches live
277#pod in memory and there is the remote possibility that you will have a
278#pod memory problem. On the off chance that you think you're one of those
279#pod people, this class method will empty those caches.
280#pod
281#pod I've loaded over 12000 objects and not encountered a memory problem.
282#pod
283#pod =cut
284
285sub purge_cache {
286 %NAME_CACHE = ();
287 %FORMAT_CACHE = ();
288 %PARSE_CACHE = ();
289}
290
291#pod =item disable_cache
292#pod
293#pod =item enable_cache
294#pod
295#pod Email::Address->disable_cache if memory_low();
296#pod
297#pod If you'd rather not cache address parses at all, you can disable (and
298#pod re-enable) the Email::Address cache with these methods. The cache is enabled
299#pod by default.
300#pod
301#pod =cut
302
303sub disable_cache {
304 my ($class) = @_;
305 $class->purge_cache;
306 $NOCACHE = 1;
307}
308
309sub enable_cache {
310 $NOCACHE = undef;
311}
312
313#pod =back
314#pod
315#pod =head2 Instance Methods
316#pod
317#pod =over 4
318#pod
319#pod =item phrase
320#pod
321#pod my $phrase = $address->phrase;
322#pod $address->phrase( "Me oh my" );
323#pod
324#pod Accessor and mutator for the phrase portion of an address.
325#pod
326#pod =item address
327#pod
328#pod my $addr = $address->address;
329#pod $addr->address( "me@PROTECTED.com" );
330#pod
331#pod Accessor and mutator for the address portion of an address.
332#pod
333#pod =item comment
334#pod
335#pod my $comment = $address->comment;
336#pod $address->comment( "(Work address)" );
337#pod
338#pod Accessor and mutator for the comment portion of an address.
339#pod
340#pod =item original
341#pod
342#pod my $orig = $address->original;
343#pod
344#pod Accessor for the original address found when parsing, or passed
345#pod to C<new>.
346#pod
347#pod =item host
348#pod
349#pod my $host = $address->host;
350#pod
351#pod Accessor for the host portion of an address's address.
352#pod
353#pod =item user
354#pod
355#pod my $user = $address->user;
356#pod
357#pod Accessor for the user portion of an address's address.
358#pod
359#pod =cut
360
361
# spent 20µs within Email::Address::BEGIN@361 which was called: # once (20µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 386
BEGIN {
36212µs my %_INDEX = (
363 phrase => _PHRASE,
364 address => _ADDRESS,
365 comment => _COMMENT,
366 original => _ORIGINAL,
367 );
368
36916µs for my $method (keys %_INDEX) {
3702101µs231µs
# spent 19µs (8+11) within Email::Address::BEGIN@370 which was called: # once (8µs+11µs) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 370
no strict 'refs';
# spent 19µs making 1 call to Email::Address::BEGIN@370 # spent 11µs making 1 call to strict::unimport
3714700ns my $index = $_INDEX{ $method };
372 *$method = sub {
373 if ($_[1]) {
374 if ($_[0][_IN_CACHE]) {
375 my $replicant = bless [ @{$_[0]} ] => ref $_[0];
376 $PARSE_CACHE{ ${ $_[0][_IN_CACHE][0] } }[ $_[0][_IN_CACHE][1] ]
377 = $replicant;
378 $_[0][_IN_CACHE] = undef;
379 }
380 $_[0]->[ $index ] = $_[1];
381 } else {
382 $_[0]->[ $index ];
383 }
384411µs };
385 }
386173µs120µs}
# spent 20µs making 1 call to Email::Address::BEGIN@361
387
388sub host { ($_[0]->[_ADDRESS] =~ /\@($domain)/o)[0] }
389sub user { ($_[0]->[_ADDRESS] =~ /($local_part)\@/o)[0] }
390
391#pod =pod
392#pod
393#pod =item format
394#pod
395#pod my $printable = $address->format;
396#pod
397#pod Returns a properly formatted RFC 2822 address representing the
398#pod object.
399#pod
400#pod =cut
401
402sub format {
4032257µs233µs
# spent 21µs (9+12) within Email::Address::BEGIN@403 which was called: # once (9µs+12µs) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 403
my $cache_str = do { no warnings 'uninitialized'; "@{$_[0]}" };
# spent 21µs making 1 call to Email::Address::BEGIN@403 # spent 12µs making 1 call to warnings::unimport
404 return $FORMAT_CACHE{$cache_str} if exists $FORMAT_CACHE{$cache_str};
405 $FORMAT_CACHE{$cache_str} = $_[0]->_format;
406}
407
408sub _format {
409 my ($self) = @_;
410
411 unless (
412 defined $self->[_PHRASE] && length $self->[_PHRASE]
413 ||
414 defined $self->[_COMMENT] && length $self->[_COMMENT]
415 ) {
416 return defined $self->[_ADDRESS] ? $self->[_ADDRESS] : '';
417 }
418
419 my $comment = defined $self->[_COMMENT] ? $self->[_COMMENT] : '';
420 $comment = "($comment)" if length $comment and $comment !~ /\A\(.*\)\z/;
421
422 my $format = sprintf q{%s <%s> %s},
423 $self->_enquoted_phrase,
424 (defined $self->[_ADDRESS] ? $self->[_ADDRESS] : ''),
425 $comment;
426
427 $format =~ s/^\s+//;
428 $format =~ s/\s+$//;
429
430 return $format;
431}
432
433sub _enquoted_phrase {
434 my ($self) = @_;
435
436 my $phrase = $self->[_PHRASE];
437
438 return '' unless defined $phrase and length $phrase;
439
440 # if it's encoded -- rjbs, 2007-02-28
441 return $phrase if $phrase =~ /\A=\?.+\?=\z/;
442
443 $phrase =~ s/\A"(.+)"\z/$1/;
444 $phrase =~ s/([\\"])/\\$1/g;
445
446 return qq{"$phrase"};
447}
448
449#pod =item name
450#pod
451#pod my $name = $address->name;
452#pod
453#pod This method tries very hard to determine the name belonging to the address.
454#pod First the C<phrase> is checked. If that doesn't work out the C<comment>
455#pod is looked into. If that still doesn't work out, the C<user> portion of
456#pod the C<address> is returned.
457#pod
458#pod This method does B<not> try to massage any name it identifies and instead
459#pod leaves that up to someone else. Who is it to decide if someone wants their
460#pod name capitalized, or if they're Irish?
461#pod
462#pod =cut
463
464sub name {
4652204µs225µs
# spent 17µs (8+8) within Email::Address::BEGIN@465 which was called: # once (8µs+8µs) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 465
my $cache_str = do { no warnings 'uninitialized'; "@{$_[0]}" };
# spent 17µs making 1 call to Email::Address::BEGIN@465 # spent 8µs making 1 call to warnings::unimport
466 return $NAME_CACHE{$cache_str} if exists $NAME_CACHE{$cache_str};
467
468 my ($self) = @_;
469 my $name = q{};
470 if ( $name = $self->[_PHRASE] ) {
471 $name =~ s/^"//;
472 $name =~ s/"$//;
473 $name =~ s/($quoted_pair)/substr $1, -1/goe;
474 } elsif ( $name = $self->[_COMMENT] ) {
475 $name =~ s/^\(//;
476 $name =~ s/\)$//;
477 $name =~ s/($quoted_pair)/substr $1, -1/goe;
478 $name =~ s/$comment/ /go;
479 } else {
480 ($name) = $self->[_ADDRESS] =~ /($local_part)\@/o;
481 }
482 $NAME_CACHE{$cache_str} = $name;
483}
484
485#pod =back
486#pod
487#pod =head2 Overloaded Operators
488#pod
489#pod =over 4
490#pod
491#pod =item stringify
492#pod
493#pod print "I have your email address, $address.";
494#pod
495#pod Objects stringify to C<format> by default. It's possible that you don't
496#pod like that idea. Okay, then, you can change it by modifying
497#pod C<$Email:Address::STRINGIFY>. Please consider modifying this package
498#pod variable using C<local>. You might step on someone else's toes if you
499#pod don't.
500#pod
501#pod {
502#pod local $Email::Address::STRINGIFY = 'host';
503#pod print "I have your address, $address.";
504#pod # geeknest.com
505#pod }
506#pod print "I have your address, $address.";
507#pod # "Casey West" <casey@geeknest.com>
508#pod
509#pod Modifying this package variable is now deprecated. Subclassing is now the
510#pod recommended approach.
511#pod
512#pod =cut
513
514sub as_string {
515 warn 'altering $Email::Address::STRINGIFY is deprecated; subclass instead'
516 if $STRINGIFY ne 'format';
517
518 $_[0]->can($STRINGIFY)->($_[0]);
519}
520
5212112µs269µs
# spent 39µs (9+30) within Email::Address::BEGIN@521 which was called: # once (9µs+30µs) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 521
use overload '""' => 'as_string', fallback => 1;
# spent 39µs making 1 call to Email::Address::BEGIN@521 # spent 30µs making 1 call to overload::import
522
523#pod =pod
524#pod
525#pod =back
526#pod
527#pod =cut
528
529164µs1;
530
531=pod
532
533=encoding UTF-8
534
535=head1 NAME
536
537Email::Address - RFC 2822 Address Parsing and Creation
538
539=head1 VERSION
540
541version 1.905
542
543=head1 SYNOPSIS
544
545 use Email::Address;
546
547 my @addresses = Email::Address->parse($line);
548 my $address = Email::Address->new(Casey => 'casey@localhost');
549
550 print $address->format;
551
552=head1 DESCRIPTION
553
554This class implements a regex-based RFC 2822 parser that locates email
555addresses in strings and returns a list of C<Email::Address> objects found.
556Alternatively you may construct objects manually. The goal of this software is
557to be correct, and very very fast.
558
559=head2 Package Variables
560
561B<ACHTUNG!> Email isn't easy (if even possible) to parse with a regex, I<at
562least> if you're on a C<perl> prior to 5.10.0. Providing regular expressions
563for use by other programs isn't a great idea, because it makes it hard to
564improve the parser without breaking the "it's a regex" feature. Using these
565regular expressions is not encouraged, and methods like C<<
566Email::Address->is_addr_spec >> should be provided in the future.
567
568Several regular expressions used in this package are useful to others.
569For convenience, these variables are declared as package variables that
570you may access from your program.
571
572These regular expressions conform to the rules specified in RFC 2822.
573
574You can access these variables using the full namespace. If you want
575short names, define them yourself.
576
577 my $addr_spec = $Email::Address::addr_spec;
578
579=over 4
580
581=item $Email::Address::addr_spec
582
583This regular expression defined what an email address is allowed to
584look like.
585
586=item $Email::Address::angle_addr
587
588This regular expression defines an C<$addr_spec> wrapped in angle
589brackets.
590
591=item $Email::Address::name_addr
592
593This regular expression defines what an email address can look like
594with an optional preceding display name, also known as the C<phrase>.
595
596=item $Email::Address::mailbox
597
598This is the complete regular expression defining an RFC 2822 email
599address with an optional preceding display name and optional
600following comment.
601
602=back
603
604=head2 Class Methods
605
606=over
607
608=item parse
609
610 my @addrs = Email::Address->parse(
611 q[me@local, Casey <me@local>, "Casey" <me@local> (West)]
612 );
613
614This method returns a list of C<Email::Address> objects it finds in the input
615string. B<Please note> that it returns a list, and expects that it may find
616multiple addresses. The behavior in scalar context is undefined.
617
618The specification for an email address allows for infinitely nestable comments.
619That's nice in theory, but a little over done. By default this module allows
620for two (C<2>) levels of nested comments. If you think you need more, modify
621the C<$Email::Address::COMMENT_NEST_LEVEL> package variable to allow more.
622
623 $Email::Address::COMMENT_NEST_LEVEL = 10; # I'm deep
624
625The reason for this hardly-limiting limitation is simple: efficiency.
626
627Long strings of whitespace can be problematic for this module to parse, a bug
628which has not yet been adequately addressed. The default behavior is now to
629collapse multiple spaces into a single space, which avoids this problem. To
630prevent this behavior, set C<$Email::Address::COLLAPSE_SPACES> to zero. This
631variable will go away when the bug is resolved properly.
632
633In accordance with RFC 822 and its descendants, this module demands that email
634addresses be ASCII only. Any non-ASCII content in the parsed addresses will
635cause the parser to return no results.
636
637=item new
638
639 my $address = Email::Address->new(undef, 'casey@local');
640 my $address = Email::Address->new('Casey West', 'casey@local');
641 my $address = Email::Address->new(undef, 'casey@local', '(Casey)');
642
643Constructs and returns a new C<Email::Address> object. Takes four
644positional arguments: phrase, email, and comment, and original string.
645
646The original string should only really be set using C<parse>.
647
648=item purge_cache
649
650 Email::Address->purge_cache;
651
652One way this module stays fast is with internal caches. Caches live
653in memory and there is the remote possibility that you will have a
654memory problem. On the off chance that you think you're one of those
655people, this class method will empty those caches.
656
657I've loaded over 12000 objects and not encountered a memory problem.
658
659=item disable_cache
660
661=item enable_cache
662
663 Email::Address->disable_cache if memory_low();
664
665If you'd rather not cache address parses at all, you can disable (and
666re-enable) the Email::Address cache with these methods. The cache is enabled
667by default.
668
669=back
670
671=head2 Instance Methods
672
673=over 4
674
675=item phrase
676
677 my $phrase = $address->phrase;
678 $address->phrase( "Me oh my" );
679
680Accessor and mutator for the phrase portion of an address.
681
682=item address
683
684 my $addr = $address->address;
685 $addr->address( "me@PROTECTED.com" );
686
687Accessor and mutator for the address portion of an address.
688
689=item comment
690
691 my $comment = $address->comment;
692 $address->comment( "(Work address)" );
693
694Accessor and mutator for the comment portion of an address.
695
696=item original
697
698 my $orig = $address->original;
699
700Accessor for the original address found when parsing, or passed
701to C<new>.
702
703=item host
704
705 my $host = $address->host;
706
707Accessor for the host portion of an address's address.
708
709=item user
710
711 my $user = $address->user;
712
713Accessor for the user portion of an address's address.
714
715=item format
716
717 my $printable = $address->format;
718
719Returns a properly formatted RFC 2822 address representing the
720object.
721
722=item name
723
724 my $name = $address->name;
725
726This method tries very hard to determine the name belonging to the address.
727First the C<phrase> is checked. If that doesn't work out the C<comment>
728is looked into. If that still doesn't work out, the C<user> portion of
729the C<address> is returned.
730
731This method does B<not> try to massage any name it identifies and instead
732leaves that up to someone else. Who is it to decide if someone wants their
733name capitalized, or if they're Irish?
734
735=back
736
737=head2 Overloaded Operators
738
739=over 4
740
741=item stringify
742
743 print "I have your email address, $address.";
744
745Objects stringify to C<format> by default. It's possible that you don't
746like that idea. Okay, then, you can change it by modifying
747C<$Email:Address::STRINGIFY>. Please consider modifying this package
748variable using C<local>. You might step on someone else's toes if you
749don't.
750
751 {
752 local $Email::Address::STRINGIFY = 'host';
753 print "I have your address, $address.";
754 # geeknest.com
755 }
756 print "I have your address, $address.";
757 # "Casey West" <casey@geeknest.com>
758
759Modifying this package variable is now deprecated. Subclassing is now the
760recommended approach.
761
762=back
763
764=head2 Did I Mention Fast?
765
766On his 1.8GHz Apple MacBook, rjbs gets these results:
767
768 $ perl -Ilib bench/ea-vs-ma.pl bench/corpus.txt 5
769 Rate Mail::Address Email::Address
770 Mail::Address 2.59/s -- -44%
771 Email::Address 4.59/s 77% --
772
773 $ perl -Ilib bench/ea-vs-ma.pl bench/corpus.txt 25
774 Rate Mail::Address Email::Address
775 Mail::Address 2.58/s -- -67%
776 Email::Address 7.84/s 204% --
777
778 $ perl -Ilib bench/ea-vs-ma.pl bench/corpus.txt 50
779 Rate Mail::Address Email::Address
780 Mail::Address 2.57/s -- -70%
781 Email::Address 8.53/s 232% --
782
783...unfortunately, a known bug causes a loss of speed the string to parse has
784certain known characteristics, and disabling cache will also degrade
785performance.
786
787=head1 VERSION
788
789version 1.898
790
791=head1 ACKNOWLEDGEMENTS
792
793Thanks to Kevin Riggle and Tatsuhiko Miyagawa for tests for annoying
794phrase-quoting bugs!
795
796=head1 AUTHORS
797
798=over 4
799
800=item *
801
802Casey West
803
804=item *
805
806Ricardo SIGNES <rjbs@cpan.org>
807
808=back
809
810=head1 COPYRIGHT AND LICENSE
811
812This software is copyright (c) 2004 by Casey West.
813
814This is free software; you can redistribute it and/or modify it under
815the same terms as the Perl 5 programming language system itself.
816
817=cut
818
819__END__
 
# spent 30µs within Email::Address::CORE:qr which was called 27 times, avg 1µs/call: # 2 times (2µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 42, avg 1µs/call # 2 times (2µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 43, avg 1µs/call # once (2µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 35 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 39 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 132 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 70 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 54 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 75 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 133 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 48 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 130 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 56 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 131 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 73 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 50 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 76 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 49 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 77 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 78 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 37 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 71 # once (1µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 79 # once (900ns+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 45 # once (900ns+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 53 # once (800ns+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 52
sub Email::Address::CORE:qr; # opcode
# spent 2.14ms within Email::Address::CORE:regcomp which was called 23 times, avg 93µs/call: # 2 times (41µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 43, avg 21µs/call # 2 times (38µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 42, avg 19µs/call # once (527µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 133 # once (342µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 132 # once (211µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 131 # once (183µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 130 # once (134µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 73 # once (96µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 79 # once (94µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 75 # once (87µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 56 # once (60µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 50 # once (55µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 70 # once (54µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 71 # once (53µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 48 # once (46µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 54 # once (45µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 78 # once (24µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 49 # once (21µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 45 # once (9µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 37 # once (8µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 77 # once (8µs+0s) by Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars::BEGIN@16 at line 53
sub Email::Address::CORE:regcomp; # opcode
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.