RFC821.pl

$esc         = '\\\\';               $Period      = '\.';
$space       = '\040';               $tab         = '\t';
$OpenBR      = '\[';                 $CloseBR     = '\]';
$OpenParen   = '\(';                 $CloseParen  = '\)';
$NonASCII    = '\x80-\xff';          $ctrl        = '\000-\037';
$CRlist      = '\n\015';
$qtext       = qq/[^$esc$NonASCII$CRlist\"]/;
$dtext       = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/;
$quoted_pair = qq<${esc}[^$NonASCII]>;
$ctext       = qq<[^$esc$NonASCII$CRlist()]>;
$Cnested     = qq<$OpenParen$ctext*(?:$quoted_pair$ctext*)*$CloseParen>;
$comment     =
    qq<$OpenParen$ctext*(?:(?:$quoted_pair|$Cnested)$ctext*)*$CloseParen>;
$X           = qq<[$space$tab]*(?:${comment}[$space$tab]*)*>;
$atom_char   = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/;
$atom        = qq<$atom_char+(?!$atom_char)>;
$quoted_str  = qq<\"$qtext*(?:$quoted_pair$qtext*)*\">;
$word        = qq<(?:$atom|$quoted_str)>;
$domain_ref  = $atom;
$domain_lit  = qq<$OpenBR(?:$dtext|$quoted_pair)*$CloseBR>;
$sub_domain  = qq<(?:$domain_ref|$domain_lit)$X>;
$domain      = qq<$sub_domain(?:$Period$X$sub_domain)*>;
$route       = qq<\@$X$domain(?:,$X\@$X$domain)*:$X>;
$local_part  = qq<$word$X(?:$Period$X$word$X)*>;
$addr_spec   = qq<$local_part\@$X$domain>;
$route_addr  = qq[<$X(?:$route)?$addr_spec>];
$phrase_ctrl = '\000-\010\012-\037';
$phrase_char =
   qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/;
$phrase      =
    qq<$word$phrase_char*(?:(?:$comment|$quoted_str)$phrase_char*)*>;
$mailbox     = qq<$X(?:$addr_spec|$phrase$route_addr)>;

my $mail_regex = $mailbox;

$email = q/abc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/"abc.def"@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/"abc./."\n".q/ def"@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/"abc"."def"@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/'abc.def'@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/'abc./."\n".q/ def'@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/'foo'.'bar'@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/(abc)abc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/(abc) abc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/<abc.def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/<abc/."\n".q/ .def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/<abc"def"ghi@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/foo bar <abc.def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/'foo bar' <abc.def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/"foo bar" <abc.def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@[example.com]/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@[exa  mple.com]/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@[exa/."\n".q/mple.com]/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@[example."hoge".com]/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/,abc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/;abc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc..def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def.@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/.abc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/⛄bc.def@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@localhost/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@e.c/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@e.co/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@-.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/abc.def@203.0.113.1/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/ABC.DEF@example.com/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/"<script>" <abc.def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";
$email = q/'<script>' <abc.def@example.com>/;
print $email if $email =~ /\A$mail_regex\z/o;
print "\n";