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

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

is_vodafone and is_softbank is now aliased

  • 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.07';
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 ^softbank\.ne\.jp
70 )$@x; # end of qr@@
71
72 my $regex_ezweb = qr@^(?:
73 ezweb\.ne\.jp|
74 .*\.ezweb\.ne\.jp
75 )$@x; # end of qr@@
76
77
78 sub is_imode {
79     my $domain = _domain(shift);
80     return $domain && $domain =~ /$regex_imode/o;
81 }
82
83 sub is_vodafone {
84     my $domain = _domain(shift);
85     return $domain && $domain =~ /$regex_vodafone/o;
86 }
87
88 *is_softbank = \&is_vodafone;
89
90 sub is_ezweb {
91     my $domain = _domain(shift);
92     return $domain && $domain =~ /$regex_ezweb/o;
93 }
94
95 sub is_mobile_jp {
96     my $domain = _domain(shift);
97     return $domain && $domain =~ /(?:$regex_imode|$regex_vodafone|$regex_ezweb|$regex_mobile)/o;
98 }
99
100 sub _domain {
101     my $stuff = shift;
102     if (ref($stuff) && $stuff->isa('Mail::Address')) {
103         return $stuff->host;
104     }
105     my $i = rindex($stuff, '@');
106     return $i >= 0 ? substr($stuff, $i + 1) : undef;
107 }
108
109 1;
110 __END__
111
112 =head1 NAME
113
114 Mail::Address::MobileJp - mobile email address in Japan
115
116 =head1 SYNOPSIS
117
118   use Mail::Address::MobileJp;
119
120   my $email = '123456789@docomo.ne.jp';
121   if (is_mobile_jp($email)) {
122       print "$email is mobile email in Japan";
123   }
124
125   # extract mobile email address from an array of addresses
126   my @mobile = grep { is_mobile_jp($_) } @addr;
127
128 =head1 DESCRIPTION
129
130 Mail::Address::MobileJp is an utility to detect an email address is
131 mobile (cellurar) email address or not.
132
133 This module should be updated heavily :)
134
135 =head1 FUNCTION
136
137 This module exports following function(s).
138
139 =over 4
140
141 =item is_mobile_jp
142
143   $bool = is_mobile_jp($email);
144
145 returns whether C<$email> is a mobile email address or not. C<$email>
146 can be an email string or Mail::Address object.
147
148 =item is_imode
149
150   $bool = is_imode($email);
151
152 returns whether C<$email> is a i-mode email address or not. C<$email>
153 can be an email string or Mail::Address object.
154
155 =item is_vodafone
156
157   $bool = is_vodafone($email);
158
159 returns whether C<$email> is a vodafone(j-sky) email address or not. C<$email>
160 can be an email string or Mail::Address object.
161
162 =item is_ezweb
163
164   $bool = is_ezweb($email);
165
166 returns whether C<$email> is a ezweb email address or not. C<$email>
167 can be an email string or Mail::Address object.
168
169 =item is_softbank
170
171   $bool = is_softbank($email);
172
173 returns whether C<$email> is a softbank email address or not. C<$email>
174 can be an email string or Mail::Address object.
175
176 =back
177
178 =head1 AUTHOR
179
180 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
181
182 This library is free software; you can redistribute it and/or modify
183 it under the same terms as Perl itself.
184
185 =head1 SEE ALSO
186
187 L<Mail::Address>, http://www.mag2.com/faq/mobile.htm
188
189 =cut
Note: See TracBrowser for help on using the browser.