PageRenderTime 23ms CodeModel.GetById 16ms RepoModel.GetById 1ms app.codeStats 0ms

/dada/DADA/perllib/Email/Address.pm

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