r62021 - in /trunk/libemail-address-perl: ./ debian/ debian/patches/ debian/source/ lib/Email/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Wed Aug 25 12:43:24 UTC 2010
Author: ansgar-guest
Date: Wed Aug 25 12:43:16 2010
New Revision: 62021
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62021
Log:
* New upstream release.
* Use debhelper compat level 8.
* Install ./bench as examples instead of documentation.
* debian/control: Add "Perl module" to short description.
* Convert debian/copyright to proposed machine readable format.
* Use source format 3.0 (quilt).
* Bump Standards-Version to 3.9.1.
* Add myself to Uploaders.
Added:
trunk/libemail-address-perl/debian/libemail-address-perl.examples
trunk/libemail-address-perl/debian/patches/
trunk/libemail-address-perl/debian/patches/series
trunk/libemail-address-perl/debian/patches/spelling.patch
trunk/libemail-address-perl/debian/source/
trunk/libemail-address-perl/debian/source/format
Modified:
trunk/libemail-address-perl/Changes
trunk/libemail-address-perl/META.yml
trunk/libemail-address-perl/README
trunk/libemail-address-perl/debian/changelog
trunk/libemail-address-perl/debian/compat
trunk/libemail-address-perl/debian/control
trunk/libemail-address-perl/debian/copyright
trunk/libemail-address-perl/debian/rules
trunk/libemail-address-perl/lib/Email/Address.pm
trunk/libemail-address-perl/t/tests.t
Modified: trunk/libemail-address-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/Changes?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/Changes (original)
+++ trunk/libemail-address-perl/Changes Wed Aug 25 12:43:16 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: trunk/libemail-address-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/META.yml?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/META.yml (original)
+++ trunk/libemail-address-perl/META.yml Wed Aug 25 12:43:16 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: trunk/libemail-address-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/README?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/README (original)
+++ trunk/libemail-address-perl/README Wed Aug 25 12:43:16 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: trunk/libemail-address-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/changelog?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/debian/changelog (original)
+++ trunk/libemail-address-perl/debian/changelog Wed Aug 25 12:43:16 2010
@@ -1,18 +1,26 @@
-libemail-address-perl (1.889-3) UNRELEASED; urgency=low
+libemail-address-perl (1.890-1) unstable; urgency=low
[ gregor herrmann ]
* debian/control: Changed: Switched Vcs-Browser field to ViewSVN
(source stanza).
* debian/control: Added: ${misc:Depends} to Depends: field.
+ * Add a lintian override for an intentionally duplicated word in the long
+ description.
[ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- [ gregor herrmann ]
- * Add a lintian override for an intentionally duplicated word in the long
- description.
+ [ Ansgar Burchardt ]
+ * New upstream release.
+ * Use debhelper compat level 8.
+ * Install ./bench as examples instead of documentation.
+ * debian/control: Add "Perl module" to short description.
+ * Convert debian/copyright to proposed machine readable format.
+ * Use source format 3.0 (quilt).
+ * Bump Standards-Version to 3.9.1.
+ * Add myself to Uploaders.
- -- gregor herrmann <gregoa at debian.org> Sun, 16 Nov 2008 20:42:15 +0100
+ -- Ansgar Burchardt <ansgar at 43-1.org> Wed, 25 Aug 2010 21:41:04 +0900
libemail-address-perl (1.889-2) unstable; urgency=low
Modified: trunk/libemail-address-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/compat?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/debian/compat (original)
+++ trunk/libemail-address-perl/debian/compat Wed Aug 25 12:43:16 2010
@@ -1,1 +1,1 @@
-6
+8
Modified: trunk/libemail-address-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/control?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/debian/control (original)
+++ trunk/libemail-address-perl/debian/control Wed Aug 25 12:43:16 2010
@@ -1,20 +1,21 @@
Source: libemail-address-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 6)
-Build-Depends-Indep: perl (>= 5.8.0),
+Build-Depends: debhelper (>= 8)
+Build-Depends-Indep: perl,
libtest-pod-perl, libtest-pod-coverage-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Ernesto Hernández-Novich (USB) <emhn at usb.ve>
+Uploaders: Ernesto Hernández-Novich (USB) <emhn at usb.ve>,
+ Ansgar Burchardt <ansgar at 43-1.org>
Homepage: http://search.cpan.org/dist/Email-Address/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libemail-address-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libemail-address-perl/
-Standards-Version: 3.7.3
+Standards-Version: 3.9.1
Package: libemail-address-perl
Architecture: all
Depends: ${misc:Depends}, ${perl:Depends}
-Description: RFC 2822 Address Parsing and Creation
+Description: Perl module for RFC 2822 address parsing and creation
Email::Address implements a complete RFC 2822 parser that locates email
addresses in strings and returns a list of Email::Address objects
found. Alternatley you may construct objects manually. The goal
Modified: trunk/libemail-address-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/copyright?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/debian/copyright (original)
+++ trunk/libemail-address-perl/debian/copyright Wed Aug 25 12:43:16 2010
@@ -1,22 +1,30 @@
-This package was debianized by Ernesto Hernández-Novich <emhn at telcel.net.ve>
-on Sun, 04 Dec 2005 11:12:51 -0400
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
+Maintainer: Ricardo SIGNES <rjbs at cpan.org>
+Source: http://search.cpan.org/dist/Email-Address/
+Name: Email-Address
-It was downloaded from http://search.cpan.org/dist/Email-Address/
+Copyright: 2004, Casey West <casey at geeknest.com>
+License: Artistic or GPL-1+
-Upstream Author:
+Files: debian/*
+Copyright:
+ 2005-2008, Ernesto Hernández-Novich (USB) <emhn at usb.ve>
+ 2007, gregor herrmann <gregoa at debian.org>
+ 2010, Ansgar Burchardt <ansgar at 43-1.org>
+License: Artistic or GPL-1+
-Casey West, <casey at geeknest.com>
+License: Artistic
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the Artistic License, which comes with Perl.
+ .
+ On Debian GNU/Linux systems, the complete text of the Artistic License
+ can be found in `/usr/share/common-licenses/Artistic'.
-Copyright:
-
-Copyright (c) 2004 Casey West. All rights reserved.
-
-This module is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-Perl is distributed under your choice of the GNU General Public License or
-the Artistic License.
-
-The complete text of the GNU General Public License can be found in
-/usr/share/common-licenses/GPL and the Artistic Licence can be found
-in /usr/share/common-licenses/Artistic.
+License: GPL-1+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+ .
+ On Debian GNU/Linux systems, the complete text of version 1 of the GNU
+ General Public License can be found in `/usr/share/common-licenses/GPL-1'.
Added: trunk/libemail-address-perl/debian/libemail-address-perl.examples
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/libemail-address-perl.examples?rev=62021&op=file
==============================================================================
--- trunk/libemail-address-perl/debian/libemail-address-perl.examples (added)
+++ trunk/libemail-address-perl/debian/libemail-address-perl.examples Wed Aug 25 12:43:16 2010
@@ -1,0 +1,1 @@
+bench
Added: trunk/libemail-address-perl/debian/patches/series
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/patches/series?rev=62021&op=file
==============================================================================
--- trunk/libemail-address-perl/debian/patches/series (added)
+++ trunk/libemail-address-perl/debian/patches/series Wed Aug 25 12:43:16 2010
@@ -1,0 +1,1 @@
+spelling.patch
Added: trunk/libemail-address-perl/debian/patches/spelling.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/patches/spelling.patch?rev=62021&op=file
==============================================================================
--- trunk/libemail-address-perl/debian/patches/spelling.patch (added)
+++ trunk/libemail-address-perl/debian/patches/spelling.patch Wed Aug 25 12:43:16 2010
@@ -1,0 +1,32 @@
+From: Ansgar Burchardt <ansgar at 43-1.org>
+Date: Wed, 25 Aug 2010 21:39:19 +0900
+Origin: vendor
+Forwarded: https://rt.cpan.org/Ticket/Display.html?id=60727
+Subject: Fix spelling errors
+
+--- libemail-address-perl.orig/lib/Email/Address.pm
++++ libemail-address-perl/lib/Email/Address.pm
+@@ -119,12 +119,12 @@
+ =item $Email::Address::name_addr
+
+ This regular expression defines what an email address can look like
+-with an optional preceeding display name, also known as the C<phrase>.
++with an optional preceding display name, also known as the C<phrase>.
+
+ =item $Email::Address::mailbox
+
+ This is the complete regular expression defining an RFC 2822 emial
+-address with an optional preceeding display name and optional
++address with an optional preceding display name and optional
+ following comment.
+
+ =back
+@@ -334,7 +334,7 @@
+
+ Email::Address->disable_cache if memory_low();
+
+-If you'd rather not cache address parses at all, you can disable (and reenable) the Email::Address cache with these methods. The cache is enabled by default.
++If you'd rather not cache address parses at all, you can disable (and re-enable) the Email::Address cache with these methods. The cache is enabled by default.
+
+ =cut
+
Modified: trunk/libemail-address-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/rules?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/debian/rules (original)
+++ trunk/libemail-address-perl/debian/rules Wed Aug 25 12:43:16 2010
@@ -1,65 +1,4 @@
#!/usr/bin/make -f
-# This debian/rules file is provided as a template for normal perl
-# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
-# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
-# be used freely wherever it is useful.
-# Uncomment this to turn on verbose mode.
-#export DH_VERBOSE=1
-
-# If set to a true value then MakeMaker's prompt function will
-# always return the default without waiting for user input.
-export PERL_MM_USE_DEFAULT=1
-
-PACKAGE=$(shell dh_listpackages)
-
-ifndef PERL
-PERL = /usr/bin/perl
-endif
-
-TMP =$(CURDIR)/debian/$(PACKAGE)
-
-build: build-stamp
-build-stamp:
- dh_testdir
- $(PERL) Makefile.PL INSTALLDIRS=vendor
- $(MAKE)
- $(MAKE) test
- touch build-stamp
-
-clean:
- dh_testdir
- dh_testroot
- dh_clean build-stamp install-stamp
- [ ! -f Makefile ] || $(MAKE) realclean
-
-install: install-stamp
-install-stamp: build-stamp
- dh_testdir
- dh_testroot
- dh_clean -k
- $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
- [ ! -d $(TMP)/usr/lib/perl5 ] || rmdir --ignore-fail-on-non-empty --parents --verbose $(TMP)/usr/lib/perl5
- touch install-stamp
-
-binary-arch:
-# We have nothing to do by default.
-
-binary-indep: build install
- dh_testdir
- dh_testroot
- dh_installdocs bench
- dh_installchangelogs Changes
- dh_perl
- dh_compress
- dh_fixperms
- dh_installdeb
- dh_gencontrol
- dh_md5sums
- dh_builddeb
-
-source diff:
- @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false
-
-binary: binary-indep binary-arch
-.PHONY: build clean binary-indep binary-arch binary
+%:
+ dh $@
Added: trunk/libemail-address-perl/debian/source/format
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/debian/source/format?rev=62021&op=file
==============================================================================
--- trunk/libemail-address-perl/debian/source/format (added)
+++ trunk/libemail-address-perl/debian/source/format Wed Aug 25 12:43:16 2010
@@ -1,0 +1,1 @@
+3.0 (quilt)
Modified: trunk/libemail-address-perl/lib/Email/Address.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/lib/Email/Address.pm?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/lib/Email/Address.pm (original)
+++ trunk/libemail-address-perl/lib/Email/Address.pm Wed Aug 25 12:43:16 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: trunk/libemail-address-perl/t/tests.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-address-perl/t/tests.t?rev=62021&op=diff
==============================================================================
--- trunk/libemail-address-perl/t/tests.t (original)
+++ trunk/libemail-address-perl/t/tests.t Wed Aug 25 12:43:16 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