[Bps-public-commit] email-address-list branch, master, updated. 9bf352154206c4272a357cf241de42b1761cbf09
Ruslan Zakirov
ruz at bestpractical.com
Thu Nov 8 07:46:05 EST 2012
The branch, master has been updated
via 9bf352154206c4272a357cf241de42b1761cbf09 (commit)
from ea723c9fd26b08fcb837a7b019643627092d99be (commit)
Summary of changes:
lib/Email/Address/List.pm | 29 +++++++++-------
t/data/RFC5233.single.obs.json | 26 ++++++++++++++
t/data/RFC5233.single.valid.json | 2 +-
t/generate.pl | 74 ++++++++++++++++++++++------------------
4 files changed, 84 insertions(+), 47 deletions(-)
create mode 100644 t/data/RFC5233.single.obs.json
- Log -----------------------------------------------------------------
commit 9bf352154206c4272a357cf241de42b1761cbf09
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 8 16:45:18 2012 +0400
more on obsolete syntax
diff --git a/lib/Email/Address/List.pm b/lib/Email/Address/List.pm
index c68861e..6d2078f 100644
--- a/lib/Email/Address/List.pm
+++ b/lib/Email/Address/List.pm
@@ -17,7 +17,7 @@ previous prefixed with Resent- (eg Resent-From) headers.
=head1 REASONING
L<Email::Address> is good at parsing addresses out of any text
-even mentioned headers and this module uses mailbox regexp
+even mentioned headers and this module is derived work
from Email::Address.
=cut
@@ -123,13 +123,20 @@ $CRE{'addr_spec'} = qr/
($RE{'cfws'}*)
\@$CRE{'domain'}
/x;
-$RE{'angle_addr'} = qr/$RE{'cfws'}*<$RE{'addr_spec'}>$RE{'cfws'}*/;
+$RE{'obs-route'} = qr/
+ (?:$RE{'cfws'}|,)*
+ \@$RE{'domain'}
+ (?:,$RE{'cfws'}?(?:\@$RE{'domain'})?)*
+ :
+/x;
+$RE{'angle_addr'} = qr/$RE{'cfws'}* < $RE{'obs-route'}? $RE{'addr_spec'} > $RE{'cfws'}*/x;
+
$RE{'name_addr'} = qr/$RE{'display_name'}?$RE{'angle_addr'}/;
$RE{'mailbox'} = qr/(?:$RE{'name_addr'}|$RE{'addr_spec'})$RE{'comment'}*/;
$CRE{'mailbox'} = qr/
(?:
- ($RE{'display_name'})?($RE{'cfws'}*)<($RE{'addr_spec'})>($RE{'cfws'}*)
+ ($RE{'display_name'})?($RE{'cfws'}*)< $RE{'obs-route'}? ($RE{'addr_spec'})>($RE{'cfws'}*)
|($RE{'addr_spec'})
)($RE{'comment'}*)
/x;
@@ -182,10 +189,9 @@ sub parse {
# if we got here then something unknown on our way
# try to recorver
- if ( $line =~ s/^(.+?)\s*(?=(;)|($RE{'display_name'}:)|,|$RE{'mailbox'}|$)//o ) {
+ if ( $line =~ s/^(.+?)\s*(?=(;)|,|$)//o ) {
push @res, { type => 'unknown', value => $1 };
if ($2) { $in_group = 1 }
- if ($3) { $in_group = 0 }
}
}
return @res;
@@ -206,14 +212,11 @@ sub _process_mailbox {
$phrase .= ' ' if $lcomment =~ /^\s|\s$/ && $phrase !~ /\s$/;
push @comments, $lcomment;
if (defined $text) {
- my @tmp = $text =~ /$CRE{'atom'}/go;
- while ( my ($lcomment, $text, $rcomment) = splice @tmp, 0, 3 ) {
- $phrase .= ' ' if $lcomment =~ /^\s|\s$/ && $phrase !~ /\s$/;
- push @comments, $lcomment;
- $phrase .= $text;
- $phrase .= ' ' if $rcomment =~ /^\s|\s$/ && $phrase !~ /\s$/;
- push @comments, $rcomment;
- }
+ $text =~ s{($RE{'comment'})}{
+ push @comments, $1; $comments[-1]=~ /^\s|\s$/? ' ':''
+ }xgeo;
+ $text =~ s/\s+/ /g;
+ $phrase .= $text;
} else {
$quoted =~ s/\\(.)/$1/g;
$phrase .= $quoted;
diff --git a/t/data/RFC5233.single.obs.json b/t/data/RFC5233.single.obs.json
new file mode 100644
index 0000000..1d6f980
--- /dev/null
+++ b/t/data/RFC5233.single.obs.json
@@ -0,0 +1,26 @@
+[
+ {
+ "domain" : "example.com",
+ "address" : "john.q.public at example.com",
+ "mailbox" : "Joe Q. Public <john.q.public at example.com>",
+ "comments" : [],
+ "description" : "Appendix A.6.1. Obsolete Addressing",
+ "display-name" : "Joe Q. Public"
+ },
+ {
+ "domain" : "example.net",
+ "address" : "mary at example.net",
+ "mailbox" : "Mary Smith <@node.test:mary at example.net>",
+ "comments" : [],
+ "description" : "Appendix A.6.1. Obsolete Addressing",
+ "display-name" : "Mary Smith"
+ },
+ {
+ "domain" : "example.net",
+ "address" : "mary at example.net",
+ "mailbox" : "Mary Smith\n \n <mary at example.net>",
+ "comments" : [],
+ "description" : "Appendix A.6.3. Obsolete White Space and Comments",
+ "display-name" : "Mary Smith"
+ }
+]
diff --git a/t/data/RFC5233.single.valid.json b/t/data/RFC5233.single.valid.json
index 5070a8e..219ceeb 100644
--- a/t/data/RFC5233.single.valid.json
+++ b/t/data/RFC5233.single.valid.json
@@ -109,6 +109,6 @@
"mailbox" : "Foo B. Baz <fbaz at x.example.com>",
"comments" : [],
"description" : "display-name with obs-phrase (with dots)",
- "display-name" : "Foo B Baz"
+ "display-name" : "Foo B. Baz"
}
]
diff --git a/t/generate.pl b/t/generate.pl
index 0e9d9ca..b986a19 100644
--- a/t/generate.pl
+++ b/t/generate.pl
@@ -2,38 +2,46 @@ use strict; use warnings; use autodie; use lib 'lib/';
use Email::Address::List;
my $file = 't/data/RFC5233.single.valid.txt';
-
-open my $fh, '<', $file;
-my @list = split /(?:\r*\n){2,}/, do { local $/; <$fh> };
-close $fh;
-
-my %CRE = %Email::Address::List::CRE;
-
-foreach my $e (splice @list) {
- my ($desc, $mailbox) = split /\r*\n/, $e, 2;
- $desc =~ s/^#\s*//;
-
- my %res = (
- description => $desc,
- mailbox => $mailbox,
- );
-
- my @parse;
- die "Failed to parse $mailbox"
- unless @parse = ($mailbox =~ /^($CRE{'mailbox'})$/);
-
- my (undef, $display_name, $local_part, $domain, @comments)
- = Email::Address::List->_process_mailbox( @parse );
-
- $res{'display-name'} = $display_name;
- $res{'address'} = "$local_part\@$domain";
- $res{'domain'} = $domain;
- $res{'comments'} = \@comments;
- push @list, \%res;
+foreach my $file (qw(t/data/RFC5233.single.valid.txt t/data/RFC5233.single.obs.txt)) {
+ process_file($file);
}
-use JSON;
-$file =~ s/txt$/json/;
-open $fh, '>', $file;
-print $fh JSON->new->pretty->encode(\@list);
-close $fh;
\ No newline at end of file
+sub process_file {
+ my $file = shift;
+ open my $fh, '<', $file;
+ my @list = split /(?:\r*\n){2,}/, do { local $/; <$fh> };
+ close $fh;
+
+ my %CRE = %Email::Address::List::CRE;
+
+ foreach my $e (splice @list) {
+ my ($desc, $mailbox) = split /\r*\n/, $e, 2;
+ $desc =~ s/^#\s*//;
+
+ my %res = (
+ description => $desc,
+ mailbox => $mailbox,
+ );
+
+ my @parse;
+ unless ( @parse = ($mailbox =~ /^($CRE{'mailbox'})$/) ) {
+ warn "Failed to parse $mailbox";
+ next;
+ }
+
+ my (undef, $display_name, $local_part, $domain, @comments)
+ = Email::Address::List->_process_mailbox( @parse );
+
+ $res{'display-name'} = $display_name;
+ $res{'address'} = "$local_part\@$domain";
+ $res{'domain'} = $domain;
+ $res{'comments'} = \@comments;
+ push @list, \%res;
+ }
+
+ use JSON;
+ $file =~ s/txt$/json/;
+ open $fh, '>', $file;
+ print $fh JSON->new->pretty->encode(\@list);
+ close $fh;
+}
\ No newline at end of file
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list