#!/usr/bin/perl use strict; use Test::More; my $wsp = '[\x20\x09]'; my $vchar = '[\x21-\x7e]'; my $quoted_pair = "\\\\(?:$vchar|$wsp)"; my $qtext = '[\x21\x23-\x5b\x5d-\x7e]'; my $qcontent = "(?:$qtext|$quoted_pair)"; my $quoted_string = "\"$qcontent*\""; my $atext = '[a-zA-Z0-9!#$%&\'*+\-\/\=?^_`{|}~]'; my $dot_atom_text = "$atext+(?:[.]$atext+)*"; my $dot_atom = $dot_atom_text; my $local_part = "(?:$dot_atom|$quoted_string)"; my $domain = $dot_atom; my $addr_spec = qr{${local_part}[@]$domain}; print 'addr_spec: ' . $addr_spec, "\n"; my $dot_atom_loose = "$atext+(?:[.]|$atext)*"; my $local_part_loose = "(?:$dot_atom_loose|$quoted_string)"; my $addr_spec_loose = qr{${local_part_loose}[@]$domain}; print 'addr_spec_loose' . $addr_spec_loose, "\n"; my @valid = ( 'foo@example.com', # normal # local-part # dot-atom 'foo.hoge@example.com', 'foo.bar.baz@example.com', # quoted-string '"foo"@example.com', '"!"@example.com', # \x21 '"#"@example.com', # \x23 '"["@example.com', # \x5b '"]"@example.com', # \x5d '"["@example.com', # \x7e # quoted-pair '"\\ "@example.com', # \x20 "\"\\\x09\"\@example.com", # \x09 # php @ '"\\!"@example.com', # \x21 '"\\["@example.com', # \x7e # domain 'foo.hoge@localhost', 'foo.hoge@sub.example.com', ); my @valid_loose = ( 'foo.@docomo.ne.jp', 'foo.foo.@docomo.ne.jp', 'foo..@docomo.ne.jp', 'foo..foo@docomo.ne.jp', 'foo..foo.@docomo.ne.jp', ); my @invalid = ( '', 'foo', 'foo@', '@foo', # local-part # dot-atom '.foo@example.com', '..foo@example.com', 'foo@@example.com', 'foo[@example.com', 'foo @example.com', # quoted-string "\"\x00\"\@example.com", # \x00 # php @ '" "@example.com', # \x20 '"""@example.com', # \x22 '"\\"@example.com', # \x5c "\"\x7f\"\@example.com", # \x7f # php @ # quoted-pair "\"\\\x1f\"\@example.com", # \x1f # php @ "\"\\\x7f\"\@example.com", # \x7f # php @ # \z check "foo\@example.com\n", # php @ "foo\@example.com\nfoo\@example.com", # php @ # non-ascii "\x80\@example.com", "\"\x80\"\@example.com", "\"\\\x80\"\@example.com", # utf8 "\x100\@example.com", "\"\x100\"\@example.com", "\"\\\x100\"\@example.com", ); plan tests => (@valid + @invalid + @valid_loose) * 2; { # normal for (@valid) { ok( m{\A$addr_spec\z}o , 'normal-valid - ' . $_ ); } for (@invalid, @valid_loose) { ok( !m{\A$addr_spec\z}o, 'normal-invalid - ' . $_ ); } } { # loose for (@valid, @valid_loose) { ok( m{\A$addr_spec_loose\z}o , 'loose-valid - ' . $_ ); } for (@invalid) { ok( !m{\A$addr_spec_loose\z}o, 'loose-invalid - ' . $_ ); } }