File Coverage

blib/lib/Mail/Address/MobileJp.pm
Criterion Covered Total %
statement 22 22 100.0
branch 4 4 100.0
condition 8 15 53.3
subroutine 8 8 100.0
pod 4 4 100.0
total 46 53 86.7


line stmt bran cond sub pod time code
1             package Mail::Address::MobileJp;
2              
3 2     2   57911 use strict;
  2         7  
  2         86  
4 2     2   12 use vars qw($VERSION);
  2         3  
  2         1571  
5             $VERSION = '0.09';
6              
7             BEGIN {
8 2     2   14 require Exporter;
9 2         43 @Mail::Address::MobileJp::ISA = qw(Exporter);
10 2         3343 @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             willcom\.com
61             )$@x; # end of qr@@
62              
63             my $regex_imode = qr@^(?:
64             docomo\.ne\.jp
65             )$@x; # end of qr@@
66              
67             my $regex_vodafone = qr@^(?:
68             jp\-[dhtckrnsq]\.ne\.jp|
69             [dhtckrnsq]\.vodafone\.ne\.jp|
70             softbank\.ne\.jp|
71             disney.ne.jp
72             )$@x; # end of qr@@
73              
74             my $regex_ezweb = qr@^(?:
75             ezweb\.ne\.jp|
76             .*\.ezweb\.ne\.jp
77             )$@x; # end of qr@@
78              
79              
80             sub is_imode {
81 1     1 1 333 my $domain = _domain(shift);
82 1   33     23 return $domain && $domain =~ /$regex_imode/o;
83             }
84              
85             sub is_vodafone {
86 6     6 1 3200 my $domain = _domain(shift);
87 6   33     67 return $domain && $domain =~ /$regex_vodafone/o;
88             }
89              
90             *is_softbank = \&is_vodafone;
91              
92             sub is_ezweb {
93 2     2 1 882 my $domain = _domain(shift);
94 2   33     28 return $domain && $domain =~ /$regex_ezweb/o;
95             }
96              
97             sub is_mobile_jp {
98 29     29 1 12256 my $domain = _domain(shift);
99 29   100     909 return $domain && $domain =~ /(?:$regex_imode|$regex_vodafone|$regex_ezweb|$regex_mobile)/o;
100             }
101              
102             sub _domain {
103 38     38   100 my $stuff = shift;
104 38 100 66     123 if (ref($stuff) && $stuff->isa('Mail::Address')) {
105 2         9 return $stuff->host;
106             }
107 36         51 my $i = rindex($stuff, '@');
108 36 100       123 return $i >= 0 ? substr($stuff, $i + 1) : undef;
109             }
110              
111             1;
112             __END__