about summary refs log tree commit homepage
path: root/lib/PublicInbox/AddressPP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/PublicInbox/AddressPP.pm')
-rw-r--r--lib/PublicInbox/AddressPP.pm33
1 files changed, 32 insertions, 1 deletions
diff --git a/lib/PublicInbox/AddressPP.pm b/lib/PublicInbox/AddressPP.pm
index 74a82843..65ba36a9 100644
--- a/lib/PublicInbox/AddressPP.pm
+++ b/lib/PublicInbox/AddressPP.pm
@@ -1,7 +1,8 @@
-# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 package PublicInbox::AddressPP;
 use strict;
+use v5.10.1; # TODO check regexps for unicode_strings compat
 
 # very loose regexes, here.  We don't need RFC-compliance,
 # just enough to make thing sanely displayable and pass to git
@@ -13,6 +14,7 @@ sub emails {
 }
 
 sub names {
+        # split by address and post-address comment
         my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
                         $_[0]);
         my @ret;
@@ -35,4 +37,33 @@ sub names {
         @ret;
 }
 
+sub pairs { # for JMAP, RFC 8621 section 4.1.2.3
+        my ($s) = @_;
+        [ map {
+                my $addr = $_;
+                if ($s =~ s/\A\s*(.*?)\s*<\Q$addr\E>\s*(.*?)\s*(?:,|\z)// ||
+                    $s =~ s/\A\s*(.*?)\s*\Q$addr\E\s*(.*?)\s*(?:,|\z)//) {
+                        my ($phrase, $comment) = ($1, $2);
+                        $phrase =~ tr/\r\n\t / /s;
+                        $phrase =~ s/\A['"\s]*//;
+                        $phrase =~ s/['"\s]*\z//;
+                        $phrase =~ s/\s*<*\s*\z//;
+                        $phrase = undef if $phrase !~ /\S/;
+                        $comment = ($comment =~ /\((.*?)\)/) ? $1 : undef;
+                        [ $phrase // $comment, $addr ]
+                } else {
+                        ();
+                }
+        } emails($s) ];
+}
+
+# Mail::Address->name is inconsistent with Email::Address::XS, so we're
+# doing our own thing, here:
+sub objects { map { bless $_, __PACKAGE__ } @{pairs($_[0])} }
+
+# OO API for objects() results
+sub user { (split(/@/, $_[0]->[1]))[0] }
+sub host { (split(/@/, $_[0]->[1]))[1] }
+sub name { $_[0]->[0] // user($_[0]) }
+
 1;