public-inbox.git  about / heads / tags
an "archives first" approach to mailing lists
blob 65ba36a95e2f6b8c6731a023a57f2df5f7440d77 1934 bytes (raw)
$ git show HEAD:lib/PublicInbox/AddressPP.pm	# shows this blob on the CLI

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
# 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
# We favor Email::Address::XS for conformance if available

sub emails {
	($_[0] =~ /([\w\.\+=\?"\(\)\-!#\$%&'\*\/\^\`\|\{\}~]+\@[\w\.\-\(\)]+)
		(?:\s[^>]*)?>?\s*(?:\(.*?\))?(?:,\s*|\z)/gx)
}

sub names {
	# split by address and post-address comment
	my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
			$_[0]);
	my @ret;
	for (my $i = 0; $i <= $#p;) {
		my $phrase = $p[$i++];
		$phrase =~ tr/\r\n\t / /s;
		$phrase =~ s/\A['"\s]*//;
		$phrase =~ s/['"\s]*\z//;
		my $user = $p[$i++] // '';
		my $comment = $p[$i++] // '';
		if ($phrase =~ /\S/) {
			$phrase =~ s/\@\S+\z//;
			push @ret, $phrase;
		} elsif ($comment =~ /\A\((.*?)\)\z/) {
			push @ret, $1;
		} else {
			push @ret, $user;
		}
	}
	@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;

git clone https://public-inbox.org/public-inbox.git
git clone http://7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion/public-inbox.git