root/Mail-Address-MobileJp/trunk/lib/Mail/Address/MobileJp.pm

Revision 1902 (checked in by miyagawa, 14 years ago)

0.06 add wm.pdx.ne.jp for WILLCOM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Mail::Address::MobileJp;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.06';
6
7 BEGIN {
8     require Exporter;
9     @Mail::Address::MobileJp::ISA    = qw(Exporter);
10     @Mail::Address::MobileJp::EXPORT = qw(is_mobile_jp is_imode is_vodafone is_ezweb is_softbank);
11 }
12
13 # This regex is generated using http://www.mag2.com/faq/mobile.htm
14
15 my $regex_mobile = qr@^(?:
16 dct\.dion\.ne\.jp|
17 tct\.dion\.ne\.jp|
18 hct\.dion\.ne\.jp|
19 kct\.dion\.ne\.jp|
20 cct\.dion\.ne\.jp|
21 sct\.dion\.ne\.jp|
22 qct\.dion\.ne\.jp|
23 oct\.dion\.ne\.jp|
24 email\.sky\.tdp\.ne\.jp|
25 email\.sky\.kdp\.ne\.jp|
26 email\.sky\.cdp\.ne\.jp|
27 sky\.tu\-ka\.ne\.jp|
28 cara\.tu\-ka\.ne\.jp|
29 sky\.tkk\.ne\.jp|
30 .*\.sky\.tkk\.ne\.jp|
31 sky\.tkc\.ne\.jp|
32 .*\.sky\.tkc\.ne\.jp|
33 email\.sky\.dtg\.ne\.jp|
34 em\.nttpnet\.ne\.jp|
35 .*\.em\.nttpnet\.ne\.jp|
36 cmchuo\.nttpnet\.ne\.jp|
37 cmhokkaido\.nttpnet\.ne\.jp|
38 cmtohoku\.nttpnet\.ne\.jp|
39 cmtokai\.nttpnet\.ne\.jp|
40 cmkansai\.nttpnet\.ne\.jp|
41 cmchugoku\.nttpnet\.ne\.jp|
42 cmshikoku\.nttpnet\.ne\.jp|
43 cmkyusyu\.nttpnet\.ne\.jp|
44 pdx\.ne\.jp|
45 d.\.pdx\.ne\.jp|
46 wm\.pdx\.ne\.jp|
47 phone\.ne\.jp|
48 .*\.mozio\.ne\.jp|
49 page\.docomonet\.or\.jp|
50 page\.ttm\.ne\.jp|
51 pho\.ne\.jp|
52 moco\.ne\.jp|
53 emcm\.ne\.jp|
54 p1\.foomoon\.com|
55 mnx\.ne\.jp|
56 .*\.mnx\.ne\.jp|
57 ez.\.ido\.ne\.jp|
58 cmail\.ido\.ne\.jp|
59 .*\.i\-get\.ne\.jp
60 )$@x; # end of qr@@
61
62 my $regex_imode = qr@^(?:
63 docomo\.ne\.jp
64 )$@x; # end of qr@@
65
66 my $regex_vodafone = qr@^(?:
67 jp\-[dhtckrnsq]\.ne\.jp|
68 [dhtckrnsq]\.vodafone\.ne\.jp
69 )$@x; # end of qr@@
70
71 my $regexp_softbank = qr@^softbank\.ne\.jp$@;
72
73 my $regex_ezweb = qr@^(?:
74 ezweb\.ne\.jp|
75 .*\.ezweb\.ne\.jp
76 )$@x; # end of qr@@
77
78
79 sub is_imode {
80     my $domain = _domain(shift);
81     return $domain && $domain =~ /$regex_imode/o;
82 }
83
84 sub is_vodafone {
85     my $domain = _domain(shift);
86     return $domain && $domain =~ /$regex_vodafone/o;
87 }
88
89 sub is_softbank {
90     my $domain = _domain(shift);
91     return $domain && $domain =~ /$regexp_softbank/o;
92 }
93
94 sub is_ezweb {
95     my $domain = _domain(shift);
96     return $domain && $domain =~ /$regex_ezweb/o;
97 }
98
99 sub is_mobile_jp {
100     my $domain = _domain(shift);
101     return $domain && $domain =~ /(?:$regex_imode|$regex_vodafone|$regex_ezweb|$regex_mobile|$regexp_softbank)/o;
102 }
103
104 sub _domain {
105     my $stuff = shift;
106     if (ref($stuff) && $stuff->isa('Mail::Address')) {
107         return $stuff->host;
108     }
109     my $i = rindex($stuff, '@');
110     return $i >= 0 ? substr($stuff, $i + 1) : undef;
111 }
112
113 1;
114 __END__
115
116 =head1 NAME
117
118 Mail::Address::MobileJp - mobile email address in Japan
119
120 =head1 SYNOPSIS
121
122   use Mail::Address::MobileJp;
123
124   my $email = '123456789@docomo.ne.jp';
125   if (is_mobile_jp($email)) {
126       print "$email is mobile email in Japan";
127   }
128
129   # extract mobile email address from an array of addresses
130   my @mobile = grep { is_mobile_jp($_) } @addr;
131
132 =head1 DESCRIPTION
133
134 Mail::Address::MobileJp is an utility to detect an email address is
135 mobile (cellurar) email address or not.
136
137 This module should be updated heavily :)
138
139 =head1 FUNCTION
140
141 This module exports following function(s).
142
143 =over 4
144
145 =item is_mobile_jp
146
147   $bool = is_mobile_jp($email);
148
149 returns whether C<$email> is a mobile email address or not. C<$email>
150 can be an email string or Mail::Address object.
151
152 =item is_imode
153
154   $bool = is_imode($email);
155
156 returns whether C<$email> is a i-mode email address or not. C<$email>
157 can be an email string or Mail::Address object.
158
159 =item is_vodafone
160
161   $bool = is_vodafone($email);
162
163 returns whether C<$email> is a vodafone(j-sky) email address or not. C<$email>
164 can be an email string or Mail::Address object.
165
166 =item is_ezweb
167
168   $bool = is_ezweb($email);
169
170 returns whether C<$email> is a ezweb email address or not. C<$email>
171 can be an email string or Mail::Address object.
172
173 =item is_softbank
174
175   $bool = is_softbank($email);
176
177 returns whether C<$email> is a softbank email address or not. C<$email>
178 can be an email string or Mail::Address object.
179
180 =back
181
182 =head1 AUTHOR
183
184 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
185
186 This library is free software; you can redistribute it and/or modify
187 it under the same terms as Perl itself.
188
189 =head1 SEE ALSO
190
191 L<Mail::Address>, http://www.mag2.com/faq/mobile.htm
192
193 =cut
Note: See TracBrowser for help on using the browser.