sub is_valid_email ($) { my ($addr) = @_; my $atext = qr/[A-Za-z0-9\!\#\$\%\&\'\*\+\-\/\=\?\^\_\`\{\|\+\~]/; my $dot_atom_text = qr/$atext+(\.$atext+)*/; my $no_ws_ctl_char = qr/[\x01-\x08\x0b\x0c\x0e-\x1f\x7f]/; my $qtext_char = qr/([\x21\x23-\x5b\x5d-\x7e]|$no_ws_ctl_char)/; my $text = qr/[\x01-\x09\x0b\x0c\x0e-\x7f]/; my $qtext = qr/($qtext_char|\\$text)*/; my $quoted_string = qr/"$qtext"/; my $quotedpair = qr/\\$text/; my $dtext = qr/[\x21-\x5a\x5e-\x7e\x01-\x08\x0b\x0c\x0e-\x1f\x7f]/; my $dcontent = qr/($dtext|$quotedpair)/; my $domain_literal = qr/\[(${dcontent})*\]/; if ( $addr =~ /^($dot_atom_text|$quoted_string)\@($dot_atom_text|$domain_literal)$/ ) { return 1; } else { return 0; } }
Tuesday, June 17, 2008
Perl subroutine to validate e-mail addresses
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment