Home > Perl > Perlでメールアドレスを抽出

Perlでメールアドレスを抽出

  • 2008-04-21 (月) 18:13
  • Perl

携帯端末のメールアドレスは個人が自由に設定できます。ピリオドを2つ続けたり、@の直前がピリオドで終わっているアドレスはRFCに準拠していません。していないと言っても、ドコモのアドレスは設定できてしまうので、メールアドレスを抽出する場合、次の正規表現でメールアドレスを抽出します。


#!/usr/bin/perl
my $myaddr = '<omakase blog> omakase@xxx.co.jp';
my $esc = '\\\\';
my $Period = '\.';
my $space = '\040';
my $OpenBR = '\[';
my $CloseBR = '\]';
my $NonASCII = '\x80-\xff';
my $ctrl = '\000-\037';
my $CRlist = '\n\015';
my $qtext = qq/[^$esc$NonASCII$CRlist\"]/;
my $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/;
my $quoted_pair = qq<${esc}[^$NonASCII]>;
my $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/;
my $atom = qq<$atom_char+(?!$atom_char)>;
my $quoted_str = qq<\"$qtext*(?:$quoted_pair$qtext*)*\">;
my $word = qq<(?:$atom|$quoted_str)>;
my $domain_ref = $atom;
my $domain_lit = qq<$OpenBR(?:$dtext|$quoted_pair)*$CloseBR>;
my $sub_domain = qq<(?:$domain_ref|$domain_lit)>;
my $domain = qq<$sub_domain(?:$Period$sub_domain)+>;
my $local_part = qq<$word(?:$Period+$word)*(?:$Period+)?>;
my $addr_spec = qq<$local_part\@$domain>;
my $mail_regex = $addr_spec;
if($myaddr =~ m/($mail_regex)/o){
print $1."\n";
}
exit;

Comments:0

Comment Form
Remember personal info

Trackback+Pingback:0

TrackBack URL for this entry
http://blog.ispace.co.jp/149/trackback/
Listed below are links to weblogs that reference
Perlでメールアドレスを抽出 from おまかせブログ2.0

Home > Perl > Perlでメールアドレスを抽出

おまかせSearch
おまかせブログ 人気記事
おまかせFeeds
おまかせブログ Meta
おまかせLinks
おまかせPR
CoRichブログランキング
ブログランキング
blogram投票ボタン
This Page Counter: 7,473

Page Top