r62018 - in /branches/upstream/libemail-address-perl/current: Changes META.yml README lib/Email/Address.pm t/tests.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Wed Aug 25 12:22:18 UTC 2010
Author: ansgar-guest
Date: Wed Aug 25 12:22:08 2010
New Revision: 62018
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62018
Log:
[svn-upgrade] new version libemail-address-perl (1.890)
Modified:
branches/upstream/libemail-address-perl/current/Changes
branches/upstream/libemail-address-perl/current/META.yml
branches/upstream/libemail-address-perl/current/README
branches/upstream/libemail-address-perl/current/lib/Email/Address.pm
branches/upstream/libemail-address-perl/current/t/tests.t
Modified: branches/upstream/libemail-address-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libemail-address-perl/current/Changes?rev=62018&op=diff
==============================================================================
--- branches/upstream/libemail-address-perl/current/Changes (original)
+++ branches/upstream/libemail-address-perl/current/Changes Wed Aug 25 12:22:08 2010
@@ -1,4 +1,7 @@
Release history for Email-Address
+
+1.890 2010-08-22
+ allow domainless addresses (if requested) (thanks, Alex Vandiver)
1.889 2007-12-19
even if the phrase needed quoting, do not return quoted phrase from
Modified: branches/upstream/libemail-address-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libemail-address-perl/current/META.yml?rev=62018&op=diff
==============================================================================
--- branches/upstream/libemail-address-perl/current/META.yml (original)
+++ branches/upstream/libemail-address-perl/current/META.yml Wed Aug 25 12:22:08 2010
@@ -1,14 +1,22 @@
--- #YAML:1.0
-name: Email-Address
-version: 1.889
-abstract: RFC 2822 Address Parsing
-license: perl
-author:
+name: Email-Address
+version: 1.890
+abstract: RFC 2822 Address Parsing
+author:
- Casey West <casey at geeknest.com>
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- Test::More: 0.47
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Test::More: 0.47
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libemail-address-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libemail-address-perl/current/README?rev=62018&op=diff
==============================================================================
--- branches/upstream/libemail-address-perl/current/README (original)
+++ branches/upstream/libemail-address-perl/current/README Wed Aug 25 12:22:08 2010
@@ -1,5 +1,5 @@
NAME
- Email::Address - RFC 2822 Address Parsing and Creation
+ Email::Address 1.890 - RFC 2822 Address Parsing and Creation
SYNOPSIS
use Email::Address;
Modified: branches/upstream/libemail-address-perl/current/lib/Email/Address.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libemail-address-perl/current/lib/Email/Address.pm?rev=62018&op=diff
==============================================================================
--- branches/upstream/libemail-address-perl/current/lib/Email/Address.pm (original)
+++ branches/upstream/libemail-address-perl/current/lib/Email/Address.pm Wed Aug 25 12:22:08 2010
@@ -1,19 +1,16 @@
package Email::Address;
use strict;
-## no critic RequireUseWarnings
-# support pre-5.6
-
-use vars qw[$VERSION $COMMENT_NEST_LEVEL $STRINGIFY
- $COLLAPSE_SPACES
- %PARSE_CACHE %FORMAT_CACHE %NAME_CACHE
- $addr_spec $angle_addr $name_addr $mailbox];
+#use warnings;
my $NOCACHE;
-
-$VERSION = '1.889';
-$COMMENT_NEST_LEVEL ||= 2;
-$STRINGIFY ||= 'format';
-$COLLAPSE_SPACES = 1 unless defined $COLLAPSE_SPACES; # who wants //=? me!
+my %PARSE_CACHE;
+my %FORMAT_CACHE;
+my %NAME_CACHE;
+
+our $VERSION = '1.890';
+our $COMMENT_NEST_LEVEL ||= 2;
+our $STRINGIFY ||= 'format';
+our $COLLAPSE_SPACES = 1 unless defined $COLLAPSE_SPACES; # who wants //=? me!
=head1 NAME
@@ -30,15 +27,13 @@
=head1 VERSION
-version 1.886
-
- $Id: Address.pm 881 2007-12-19 22:08:35Z rjbs at cpan.org $
+version 1.890
=head1 DESCRIPTION
This class implements a regex-based RFC 2822 parser that locates email
addresses in strings and returns a list of C<Email::Address> objects found.
-Alternatley you may construct objects manually. The goal of this software is to
+Alternately you may construct objects manually. The goal of this software is to
be correct, and very very fast.
=cut
@@ -73,16 +68,18 @@
# to resolve bug 22991, creating a significant slowdown. Given current speed
# problems. Once 16320 is resolved, this section should be dealt with.
# -- rjbs, 2006-11-11
-#my $obs_phrase = qr/$word(?:$word|\.|$cfws)*/;
-
-# XXX: ...and the above solution caused endless problems (never returned) when
+#
+# XXX: ...and the first solution caused endless problems (never returned) when
# examining this address, now in a test:
# admin+=E6=96=B0=E5=8A=A0=E5=9D=A1_Weblog-- ATAT --test.socialtext.com
# So we disallow the hateful CFWS in this context for now. Of modern mail
# agents, only Apple Web Mail 2.0 is known to produce obs-phrase.
# -- rjbs, 2006-11-19
+my $obs_phrase;
+ $obs_phrase = qr/$word(?:$word|\.|$cfws)*/;
+
my $simple_word = qr/$atom|\.|\s*"$qcontent+"\s*/;
-my $obs_phrase = qr/$simple_word+/;
+ $obs_phrase = qr/$simple_word+/;
my $phrase = qr/$obs_phrase|(?:$word+)/;
@@ -134,10 +131,19 @@
=cut
-$addr_spec = qr/$local_part\@$domain/;
-$angle_addr = qr/$cfws*<$addr_spec>$cfws*/;
-$name_addr = qr/$display_name?$angle_addr/;
-$mailbox = qr/(?:$name_addr|$addr_spec)$comment*/;
+our $addr_spec = qr/(?:$local_part\@$domain|$local_part)/;
+our $angle_addr = qr/$cfws*<$addr_spec>$cfws*/;
+our $name_addr = qr/$display_name?$angle_addr/;
+our $mailbox = qr/(?:$name_addr|$addr_spec)/;
+
+our $addr_spec_CRE = qr/(?|($local_part)\@($domain)|($local_part)())/;
+our $angle_addr_CRE = qr/$cfws*<$addr_spec_CRE>$cfws*/;
+our $name_addr_CRE = qr/($display_name)?$angle_addr_CRE/;
+
+our $mailbox_list = qr/($mailbox)(?:,($mailbox))*/;
+our $group = qr/$display_name\:/;
+our $address = qr/$mailbox|$group/;
+our $address_list = qr/($address)(?:,($address))*/;
sub _PHRASE () { 0 }
sub _ADDRESS () { 1 }
@@ -175,6 +181,18 @@
prevent this behavior, set C<$Email::Address::COLLAPSE_SPACES> to zero. This
variable will go away when the bug is resolved properly.
+=item parse_allow_domainless
+
+ my @addrs = Email::Address->parse_allow_domainless(
+ q[me, Casey <me>, "Casey" <me> (West)]
+ );
+
+This method returns a list of C<Email::Address> objects it finds in
+the input string; it differs from :</parse> in that it allows
+"domainless" addresses, which lack an at-sign and domain name. The
+domain of the addresses is presumed to be assumable by the calling
+code.
+
=cut
sub __get_cached_parse {
@@ -194,48 +212,77 @@
$PARSE_CACHE{$line} = $addrs;
}
-sub parse {
- my ($class, $line) = @_;
+my $lead_tail_cfws = qr/(?:\A$cfws|$cfws\z)/;
+
+sub __parse {
+ my ($class, $line, $domainless) = @_;
return unless $line;
$line =~ s/[ \t]+/ /g if $COLLAPSE_SPACES;
- if (my @cached = $class->__get_cached_parse($line)) {
+ my $key = "$domainless,$line";
+ if (my @cached = $class->__get_cached_parse($key)) {
return @cached;
}
- my (@mailboxes) = ($line =~ /$mailbox/go);
+ $line =~ /\A($mailbox)/go;
+ my @mailboxes = $1;
+ push @mailboxes, $line =~ /\G,\s*($mailbox)/go;
+
my @addrs;
- foreach (@mailboxes) {
- my $original = $_;
-
+ MBOX: foreach (grep { defined } @mailboxes) {
+ # Strip comments. Email address comments are the bane of every email
+ # address handler's day. -- rjbs, 2008-01-02
my @comments = /($comment)/go;
s/$comment//go if @comments;
- my ($user, $host, $com);
- ($user, $host) = ($1, $2) if s/<($local_part)\@($domain)>//o;
- if (! defined($user) || ! defined($host)) {
- s/($local_part)\@($domain)//o;
- ($user, $host) = ($1, $2);
+ my ($phrase, $local_part, $domain);
+
+ if (/\A$addr_spec_CRE\z/o) {
+ $phrase = '';
+ $local_part = $1;
+ $domain = $2;
+ } elsif (/\A$name_addr_CRE\z/o) {
+ $phrase = defined $1 ? $1 : '';
+ $local_part = $2;
+ $domain = $3;
+ } else {
+ die "can't decypher $_";
}
-
- my ($phrase) = /($display_name)/o;
-
- for ( $phrase, $host, $user, @comments ) {
- next unless defined $_;
- s/^\s+//;
- s/\s+$//;
- $_ = undef unless length $_;
- }
-
- my $new_comment = join q{ }, @comments;
- push @addrs,
- $class->new($phrase, "$user\@$host", $new_comment, $original);
- $addrs[-1]->[_IN_CACHE] = [ \$line, $#addrs ]
+ last unless $domain or $domainless;
+
+ $phrase =~ s/$lead_tail_cfws//go;
+ $local_part =~ s/$lead_tail_cfws//go;
+
+ my $original = $_;
+
+ my $all_comments = join q{ }, @comments;
+ $all_comments =~ s/(?:\A\s+|\s+\z)//go;
+
+ push @addrs, $class->new(
+ $phrase,
+ $domain ? "$local_part\@$domain" : $local_part,
+ $all_comments,
+ $original,
+ );
+
+ $addrs[-1]->[_IN_CACHE] = [ \$key, $#addrs ]
}
- $class->__cache_parse($line, \@addrs);
+ $class->__cache_parse($key, \@addrs);
return @addrs;
+}
+
+sub parse {
+ my $self = shift;
+ my ($line) = @_;
+ return $self->__parse($line, 0);
+}
+
+sub parse_allow_domainless {
+ my $self = shift;
+ my ($line) = @_;
+ return $self->__parse($line, 1);
}
=pod
@@ -464,7 +511,7 @@
$name =~ s/($quoted_pair)/substr $1, -1/goe;
$name =~ s/$comment/ /go;
} else {
- ($name) = $self->[_ADDRESS] =~ /($local_part)\@/o;
+ ($name) = $self->[_ADDRESS] =~ /($local_part)(?:\@|\Z)/o;
}
$NAME_CACHE{"@{$_[0]}"} = $name;
}
Modified: branches/upstream/libemail-address-perl/current/t/tests.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libemail-address-perl/current/t/tests.t?rev=62018&op=diff
==============================================================================
--- branches/upstream/libemail-address-perl/current/t/tests.t (original)
+++ branches/upstream/libemail-address-perl/current/t/tests.t Wed Aug 25 12:22:08 2010
@@ -678,7 +678,7 @@
'"<advocacy-- ATAT --p.example.org>" <advocacy-- ATAT --p.example.org>',
[
[
- 'advocacy',
+ '<advocacy-- ATAT --p.example.org>',
'advocacy-- ATAT --p.example.org',
undef
]
@@ -1584,16 +1584,16 @@
]
]
],
- [
- 'Jason W. May <jmay-- ATAT --x.example.com>',
- [
- [
- 'Jason W. May',
- 'jmay-- ATAT --x.example.com',
- undef
- ]
- ]
- ],
+ [
+ 'Jason W. May <jmay-- ATAT --x.example.com>',
+ [
+ [
+ 'Jason W. May',
+ 'jmay-- ATAT --x.example.com',
+ undef
+ ]
+ ]
+ ],
[
'"Jason W. May" <jmay-- ATAT --x.example.com>, advocacy-- ATAT --p.example.org',
[
@@ -1618,29 +1618,103 @@
undef,
],
],
- ]
+ ],
+);
+
+my @domain_list = (@list,
+ [
+ 'jibsheet',
+ [],
+ ],
+ [
+ 'alexmv at example.com, jibsheet, jesse at example.com',
+ [
+ [
+ undef,
+ 'alexmv-- ATAT --example.com',
+ undef,
+ ],
+ ],
+ ],
+);
+
+my @domainless_list = (@list,
+ [
+ 'falcone',
+ [
+ [
+ undef,
+ 'falcone',
+ undef
+ ],
+ ]
+ ],
+ [
+ 'falcone, alexmv',
+ [
+ [
+ undef,
+ 'falcone',
+ undef
+ ],
+ [
+ undef,
+ 'alexmv',
+ undef
+ ],
+ ]
+ ],
+ [
+ 'alexmv at example.com, jibsheet, jesse at example.com',
+ [
+ [
+ undef,
+ 'alexmv-- ATAT --example.com',
+ undef,
+ ],
+ [
+ undef,
+ 'jibsheet',
+ undef,
+ ],
+ [
+ undef,
+ 'jesse-- ATAT --example.com',
+ undef,
+ ],
+ ],
+ ],
);
my $tests = 1;
-$tests += @{ $_->[1] } * 5 for @list;
+ $tests += 1 + @{ $_->[1] } * 5 for @domain_list;
+ $tests += 1 + @{ $_->[1] } * 5 for @domainless_list;
plan tests => $tests;
use_ok 'Email::Address';
-for (@list) {
- $_->[0] =~ s/-- ATAT --/@/g;
- my @addrs = Email::Address->parse($_->[0]);
- my @tests =
- map { Email::Address->new(map { $_ ? do {s/-- ATAT --/@/g; $_} : $_ } @$_) }
- @{$_->[1]};
+for ([parse => \@domain_list], [parse_allow_domainless => \@domainless_list]) {
+ my ($method,$list) = @$_;
+ for (@$list) {
+ my ($string, $expect) = @$_;
- foreach (@addrs) {
- isa_ok($_, 'Email::Address');
- my $test = shift @tests;
- is($_->format, $test->format, "format: " . $test->format);
- is($_->as_string, $test->format, "format: " . $test->format);
- is("$_", $test->format, "stringify: $_");
- is($_->name, $test->name, "name: " . $test->name);
- }
+ $string =~ s/-- ATAT --/@/g;
+ my @addrs = Email::Address->$method($string);
+
+ is(@addrs, @$expect, "got correct number of results from $method {$string}");
+
+ my @tests = map {
+ Email::Address->new(map { s/-- ATAT --/@/g if $_; $_ } @$_) }
+ @$expect;
+
+ foreach (@addrs) {
+ isa_ok($_, 'Email::Address');
+ my $test = shift @tests;
+ is($_->format, $test->format, "format: " . $test->format);
+ is($_->as_string, $test->format, "format: " . $test->format);
+ is("$_", $test->format, "stringify: $_");
+ is($_->name, $test->name, "name: " . $test->name);
+ }
+ }
}
More information about the Pkg-perl-cvs-commits
mailing list