]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/AddressPP.pm
thread: avoid Perl5 internal scratchpad target cache
[public-inbox.git] / lib / PublicInbox / AddressPP.pm
1 # Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 package PublicInbox::AddressPP;
4 use strict;
5
6 # very loose regexes, here.  We don't need RFC-compliance,
7 # just enough to make thing sanely displayable and pass to git
8 # We favor Email::Address::XS for conformance if available
9
10 sub emails {
11         ($_[0] =~ /([\w\.\+=\?"\(\)\-!#\$%&'\*\/\^\`\|\{\}~]+\@[\w\.\-\(\)]+)
12                 (?:\s[^>]*)?>?\s*(?:\(.*?\))?(?:,\s*|\z)/gx)
13 }
14
15 sub names {
16         # split by address and post-address comment
17         my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
18                         $_[0]);
19         my @ret;
20         for (my $i = 0; $i <= $#p;) {
21                 my $phrase = $p[$i++];
22                 $phrase =~ tr/\r\n\t / /s;
23                 $phrase =~ s/\A['"\s]*//;
24                 $phrase =~ s/['"\s]*\z//;
25                 my $user = $p[$i++] // '';
26                 my $comment = $p[$i++] // '';
27                 if ($phrase =~ /\S/) {
28                         $phrase =~ s/\@\S+\z//;
29                         push @ret, $phrase;
30                 } elsif ($comment =~ /\A\((.*?)\)\z/) {
31                         push @ret, $1;
32                 } else {
33                         push @ret, $user;
34                 }
35         }
36         @ret;
37 }
38
39 sub pairs { # for JMAP, RFC 8621 section 4.1.2.3
40         my ($s) = @_;
41         [ map {
42                 my $addr = $_;
43                 if ($s =~ s/\A\s*(.*?)\s*<\Q$addr\E>\s*(.*?)\s*(?:,|\z)// ||
44                     $s =~ s/\A\s*(.*?)\s*\Q$addr\E\s*(.*?)\s*(?:,|\z)//) {
45                         my ($phrase, $comment) = ($1, $2);
46                         $phrase =~ tr/\r\n\t / /s;
47                         $phrase =~ s/\A['"\s]*//;
48                         $phrase =~ s/['"\s]*\z//;
49                         $phrase =~ s/\s*<*\s*\z//;
50                         $phrase = undef if $phrase !~ /\S/;
51                         $comment = ($comment =~ /\((.*?)\)/) ? $1 : undef;
52                         [ $phrase // $comment, $addr ]
53                 } else {
54                         ();
55                 }
56         } emails($s) ];
57 }
58
59 1;