line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Number::Phone::JP; |
2
|
|
|
|
|
|
|
|
3
|
22
|
|
|
22
|
|
281188
|
use strict; |
|
22
|
|
|
|
|
50
|
|
|
22
|
|
|
|
|
8542
|
|
4
|
22
|
|
|
22
|
|
105
|
use warnings; |
|
22
|
|
|
|
|
61
|
|
|
22
|
|
|
|
|
667
|
|
5
|
22
|
|
|
22
|
|
417
|
use 5.008_001; |
|
22
|
|
|
|
|
69
|
|
6
|
22
|
|
|
22
|
|
24784
|
use parent qw(Number::Phone); |
|
22
|
|
|
|
|
6374
|
|
|
22
|
|
|
|
|
100
|
|
7
|
22
|
|
|
22
|
|
615655
|
use Carp; |
|
22
|
|
|
|
|
45
|
|
|
22
|
|
|
|
|
1315
|
|
8
|
22
|
|
|
22
|
|
8711
|
use UNIVERSAL::require; |
|
22
|
|
|
|
|
31030
|
|
|
22
|
|
|
|
|
190
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.20190401'; |
11
|
|
|
|
|
|
|
our %TEL_TABLE = (); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub import { |
14
|
89
|
|
|
89
|
|
35584
|
my $self = shift; |
15
|
89
|
|
|
|
|
2382
|
%TEL_TABLE = (); |
16
|
89
|
100
|
|
|
|
540
|
if (@_) { |
17
|
14
|
|
|
|
|
34
|
for my $subclass (@_) { |
18
|
15
|
|
|
|
|
39
|
my $package = _table_class_name($subclass); |
19
|
15
|
50
|
|
|
|
100
|
$package->require or croak $@; |
20
|
|
|
|
|
|
|
{ |
21
|
22
|
|
|
22
|
|
1959
|
no strict 'refs'; |
|
22
|
|
|
|
|
46
|
|
|
22
|
|
|
|
|
13790
|
|
|
15
|
|
|
|
|
181
|
|
22
|
15
|
|
|
|
|
29
|
while (my($k, $v) = each %{"$package\::TEL_TABLE"}) { |
|
461
|
|
|
|
|
1185
|
|
23
|
446
|
100
|
|
|
|
615
|
if ($TEL_TABLE{$k}) { |
24
|
|
|
|
|
|
|
$TEL_TABLE{$k} = |
25
|
1
|
|
|
|
|
3
|
'(?:' . $TEL_TABLE{$k} . '|' . $v . ')'; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
else { |
28
|
445
|
|
|
|
|
716
|
$TEL_TABLE{$k} = $v; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
else { |
35
|
75
|
|
|
|
|
3584
|
require Number::Phone::JP::Table; |
36
|
75
|
|
|
|
|
253
|
import Number::Phone::JP::Table; |
37
|
|
|
|
|
|
|
} |
38
|
89
|
|
|
|
|
3618
|
return $self; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub new { |
42
|
82
|
|
|
82
|
1
|
16537
|
my $class = shift; |
43
|
82
|
|
|
|
|
172
|
my $self = bless {}, $class; |
44
|
82
|
100
|
|
|
|
395
|
$self->set_number(@_) if @_; |
45
|
82
|
|
|
|
|
364
|
return $self; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub set_number { |
49
|
66219
|
|
|
66219
|
1
|
380275
|
my $self = shift; |
50
|
66219
|
|
|
|
|
98428
|
my $number = shift; |
51
|
66219
|
50
|
|
|
|
446186
|
if (ref($number) eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
52
|
0
|
|
|
|
|
0
|
$self->_prefix = shift @$number; |
53
|
0
|
|
|
|
|
0
|
(my $num = join('', @$number)) =~ s/\D+//g; |
54
|
0
|
|
|
|
|
0
|
$self->_number = $num; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
elsif (defined $_[0]) { |
57
|
0
|
|
|
|
|
0
|
$self->_prefix = $number; |
58
|
0
|
|
|
|
|
0
|
(my $num = join('', @_)) =~ s/\D+//g; |
59
|
0
|
|
|
|
|
0
|
$self->_number = $num; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
elsif ($number =~ /^\D*(0\d+)\D(.+)$/) { |
62
|
66152
|
|
|
|
|
163891
|
my $pref = $1; |
63
|
66152
|
|
|
|
|
133229
|
my $num = $2; |
64
|
66152
|
|
|
|
|
137609
|
$pref =~ s/\D+//g; |
65
|
66152
|
|
|
|
|
88453
|
$num =~ s/\D+//g; |
66
|
66152
|
|
|
|
|
152519
|
$self->_prefix = $pref; |
67
|
66152
|
|
|
|
|
118501
|
$self->_number = $num; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
elsif ($number =~ s/^\+81//) { |
70
|
67
|
|
|
|
|
139
|
$self->_prefix = (); |
71
|
67
|
|
|
|
|
120
|
$self->_number = (); |
72
|
67
|
|
|
|
|
158
|
for (my $i = 1; $i < length $number; $i++) { |
73
|
597
|
|
|
|
|
782
|
my $pref = substr $number, 0, $i; |
74
|
597
|
100
|
|
|
|
1617
|
if ($TEL_TABLE{$pref}) { |
75
|
79
|
|
|
|
|
144
|
$self->_prefix = "0$pref"; |
76
|
79
|
|
|
|
|
137
|
$self->_number = substr $number, $i; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
else { |
81
|
0
|
|
|
|
|
0
|
carp "The number is invalid telephone number."; |
82
|
0
|
|
|
|
|
0
|
$self->_prefix = (); |
83
|
0
|
|
|
|
|
0
|
$self->_number = (); |
84
|
|
|
|
|
|
|
} |
85
|
66219
|
|
|
|
|
242610
|
return $self; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub is_valid_number { |
89
|
66163
|
|
|
66163
|
1
|
97976
|
my $self = shift; |
90
|
66163
|
50
|
33
|
|
|
101699
|
unless ($self->_prefix || $self->_number) { |
91
|
0
|
|
|
|
|
0
|
carp "Any number was not set"; |
92
|
0
|
|
|
|
|
0
|
return; |
93
|
|
|
|
|
|
|
} |
94
|
66163
|
|
|
|
|
101653
|
my $pref = $self->_prefix; |
95
|
66163
|
50
|
|
|
|
249914
|
return unless $pref =~ s/^0//; |
96
|
66163
|
|
|
|
|
151205
|
my $re = $TEL_TABLE{$pref}; |
97
|
66163
|
100
|
|
|
|
125981
|
return unless defined $re; |
98
|
65944
|
|
|
|
|
127111
|
return $self->_number =~ /^$re$/; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
198749
|
|
|
198749
|
|
406722
|
sub _prefix : lvalue { shift->{_prefix} } |
102
|
132255
|
|
|
132255
|
|
784862
|
sub _number : lvalue { shift->{_number} } |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
{ |
105
|
22
|
|
|
22
|
|
188
|
no warnings 'once'; |
|
22
|
|
|
|
|
50
|
|
|
22
|
|
|
|
|
3002
|
|
106
|
|
|
|
|
|
|
*is_valid = \&is_valid_number; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub _table_class_name { |
110
|
127
|
|
|
127
|
|
184
|
my $subclass = shift; |
111
|
127
|
|
|
|
|
666
|
return sprintf('%s::Table::%s', __PACKAGE__, ucfirst(lc($subclass))); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub _is_this_type { |
115
|
110
|
|
|
110
|
|
168
|
my($self, $type) = @_; |
116
|
110
|
|
|
|
|
457
|
my $package = _table_class_name($type); |
117
|
110
|
|
|
|
|
429
|
$package->require; |
118
|
110
|
|
|
|
|
3126
|
my $pref = $self->_prefix; |
119
|
110
|
|
|
|
|
284
|
$pref =~ s/^0//; |
120
|
22
|
|
|
22
|
|
141
|
no strict 'refs'; |
|
22
|
|
|
|
|
62
|
|
|
22
|
|
|
|
|
3070
|
|
121
|
110
|
|
|
|
|
155
|
return exists ${"$package\::TEL_TABLE"}{$pref}; |
|
110
|
|
|
|
|
581
|
|
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub is_mobile { |
125
|
22
|
|
|
22
|
1
|
32
|
my $self = shift; |
126
|
22
|
|
|
|
|
48
|
my $result = $self->_is_this_type('mobile'); |
127
|
22
|
100
|
|
|
|
95
|
return $result unless $result; |
128
|
4
|
|
|
|
|
9
|
my $pref = $self->_prefix; |
129
|
4
|
|
|
|
|
12
|
$pref =~ s/^0//; |
130
|
4
|
100
|
|
|
|
16
|
return $result if $pref ne '70'; |
131
|
2
|
|
|
|
|
6
|
my $package = _table_class_name('mobile'); |
132
|
22
|
|
|
22
|
|
151
|
no strict 'refs'; |
|
22
|
|
|
|
|
51
|
|
|
22
|
|
|
|
|
10944
|
|
133
|
2
|
|
|
|
|
4
|
my $re = ${"$package\::TEL_TABLE"}{$pref}; |
|
2
|
|
|
|
|
9
|
|
134
|
2
|
|
|
|
|
5
|
return $self->_number =~ /^$re$/; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
22
|
|
|
22
|
1
|
53
|
sub is_pager { return shift->_is_this_type('pager') } |
138
|
22
|
|
|
22
|
1
|
48
|
sub is_ipphone { return shift->_is_this_type('ipphone') } |
139
|
22
|
|
|
22
|
1
|
46
|
sub is_tollfree { return shift->_is_this_type('freedial') } |
140
|
22
|
|
|
22
|
1
|
53
|
sub is_specialrate { return shift->_is_this_type('q2') } |
141
|
|
|
|
|
|
|
|
142
|
1
|
|
|
1
|
1
|
11
|
sub is_allocated { undef } |
143
|
1
|
|
|
1
|
1
|
283
|
sub is_in_use { undef } |
144
|
1
|
|
|
1
|
1
|
264
|
sub is_geographic { undef } |
145
|
1
|
|
|
1
|
1
|
260
|
sub is_fixed_line { undef } |
146
|
1
|
|
|
1
|
1
|
257
|
sub is_isdn { undef } |
147
|
1
|
|
|
1
|
1
|
257
|
sub is_adult { undef } |
148
|
1
|
|
|
1
|
1
|
260
|
sub is_personal { undef } |
149
|
1
|
|
|
1
|
1
|
256
|
sub is_corporate { undef } |
150
|
1
|
|
|
1
|
1
|
257
|
sub is_government { undef } |
151
|
1
|
|
|
1
|
1
|
277
|
sub is_international { undef } |
152
|
1
|
|
|
1
|
1
|
258
|
sub is_network_service { undef } |
153
|
|
|
|
|
|
|
|
154
|
22
|
|
|
22
|
1
|
62
|
sub country_code { return 81 } |
155
|
|
|
|
|
|
|
|
156
|
1
|
|
|
1
|
1
|
256
|
sub regulator { undef } |
157
|
1
|
|
|
1
|
1
|
256
|
sub areacode { undef } |
158
|
1
|
|
|
1
|
1
|
256
|
sub areaname { undef } |
159
|
1
|
|
|
1
|
1
|
258
|
sub location { undef } |
160
|
1
|
|
|
1
|
1
|
294
|
sub subscriber { undef } |
161
|
1
|
|
|
1
|
1
|
258
|
sub operator { undef } |
162
|
1
|
|
|
1
|
1
|
256
|
sub type { undef } |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub format { |
165
|
11
|
|
|
11
|
1
|
18
|
my $self = shift; |
166
|
11
|
|
|
|
|
23
|
my $pref = $self->_prefix; |
167
|
11
|
|
|
|
|
45
|
$pref =~ s/^0//; |
168
|
11
|
|
|
|
|
29
|
return sprintf '+%s %s %s', $self->country_code, $pref, $self->_number; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
1
|
|
|
1
|
1
|
258
|
sub country { undef } |
172
|
1
|
|
|
1
|
1
|
256
|
sub translates_to { undef } |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
1; |
175
|
|
|
|
|
|
|
__END__ |