]>
Commit | Line | Data |
---|---|---|
1 | package Number::Phone::RO; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Number::Phone/; | |
7 | use utf8; | |
8 | use re '/s'; | |
9 | ||
10 | sub AREA_NAMES (); | |
11 | ||
12 | our $VERSION = '1.000'; | |
13 | ||
14 | our %cache; | |
15 | ||
16 | sub _normalized { | |
17 | my ($nr) = @_; | |
18 | $nr =~ y/0-9+//cd; | |
19 | $nr =~ s/^[+]40//; | |
20 | $nr =~ s/^0//; | |
21 | $nr | |
22 | } | |
23 | ||
24 | sub _analyze_number { | |
25 | my ($nr) = @_; | |
26 | my %info; | |
27 | ||
28 | return { valid => 0 } unless length $nr == 9; | |
29 | $info{valid} = 1; | |
30 | ||
31 | $info{geographic} = $nr =~ /^[23][3-6]/ ? 1 : 0; | |
32 | @info{qw/fixed_line mobile/} = (1, 0) if $nr =~ /^[23]/; | |
33 | @info{qw/fixed_line mobile/} = (0, 1) if $nr =~ /^7/; | |
34 | $info{tollfree} = $nr =~ /^800/ ? 1 : 0; | |
35 | $info{specialrate} = $nr =~ /^90/ ? 1 : 0; | |
36 | $info{adult} = 1 if $nr =~ /^906/; | |
37 | ||
38 | my $arealen = $nr =~ /^[23]1/ ? 2 : 3; | |
39 | $info{areacode} = substr $nr, 0, $arealen; | |
40 | $info{subscriber} = substr $nr, $arealen; | |
41 | ||
42 | \%info | |
43 | } | |
44 | ||
45 | sub _info { $cache{${$_[0]}} } | |
46 | ||
47 | sub new { | |
48 | my ($class, $nr) = @_; | |
49 | $nr = _normalized $nr; | |
50 | $cache{$nr} = _analyze_number $nr; | |
51 | my $self = bless \$nr, $class; | |
52 | $self->is_valid ? $self : undef | |
53 | } | |
54 | ||
55 | sub is_valid { shift->_info->{valid} } | |
56 | sub is_geographic { shift->_info->{geographic} } | |
57 | sub is_fixed_line { shift->_info->{fixed_line} } | |
58 | sub is_mobile { shift->_info->{mobile} } | |
59 | sub is_tollfree { shift->_info->{tollfree} } | |
60 | sub is_specialrate { shift->_info->{specialrate} } | |
61 | sub is_adult { shift->_info->{adult} } | |
62 | ||
63 | sub country_code { 40 } | |
64 | sub regulator { 'ANCOM, http://ancom.org.ro'} | |
65 | ||
66 | sub areacode { shift->_info->{areacode} } | |
67 | sub areaname { $_[0]->is_geographic ? AREA_NAMES->{substr $_[0]->areacode, 1} : undef } | |
68 | sub subscriber { shift->_info->{subscriber} } | |
69 | ||
70 | sub format { ## no critic (ProhibitBuiltinHomonyms) | |
71 | my ($self) = @_; | |
72 | join ' ', | |
73 | '+40', | |
74 | $self->areacode, | |
75 | (substr $self->subscriber, 0, 3), | |
76 | (substr $self->subscriber, 3); | |
77 | } | |
78 | ||
79 | sub intra_country_dial_to { "0${$_[0]}" } | |
80 | ||
81 | use HTTP::Tiny; | |
82 | ||
83 | my $ht = HTTP::Tiny->new(agent => "Number-Phone-RO/$VERSION "); | |
84 | ||
85 | sub query_portabilitate { | |
86 | my ($self) = @_; | |
87 | $self->_info->{portabilitate_queried} = 1; | |
88 | my $req = $ht->get("http://portabilitate.ro/ro-no-0$$self"); | |
89 | return unless $req->{success}; | |
90 | my ($initial_operator) = $req->{content} =~ /lnkOperatorInitial">([^<]*)</x; | |
91 | my ($current_operator) = $req->{content} =~ /lnkOperator">([^<]*)</x; | |
92 | $initial_operator //= $current_operator; | |
93 | $self->_info->{initial_operator} = $initial_operator; | |
94 | $self->_info->{current_operator} = $current_operator; | |
95 | } | |
96 | ||
97 | sub operator { | |
98 | my ($self) = @_; | |
99 | $self->query_portabilitate unless $self->_info->{portabilitate_queried}; | |
100 | $self->_info->{initial_operator} | |
101 | } | |
102 | ||
103 | sub operator_ported { | |
104 | my ($self) = @_; | |
105 | $self->query_portabilitate unless $self->_info->{portabilitate_queried}; | |
106 | $self->_info->{current_operator} | |
107 | } | |
108 | ||
109 | use constant AREA_NAMES => { | |
110 | 1 => 'București', | |
111 | 30 => 'Suceava', | |
112 | 31 => 'Botoșani', | |
113 | 32 => 'Iași', | |
114 | 33 => 'Neamț', | |
115 | 34 => 'Bacău', | |
116 | 35 => 'Vaslui', | |
117 | 36 => 'Galați', | |
118 | 37 => 'Vrancea', | |
119 | 38 => 'Buzău', | |
120 | 39 => 'Brăila', | |
121 | 40 => 'Tulcea', | |
122 | 41 => 'Constanța', | |
123 | 42 => 'Călărași', | |
124 | 43 => 'Ialomița', | |
125 | 44 => 'Prahova', | |
126 | 45 => 'Dâmbovița', | |
127 | 46 => 'Giurgiu', | |
128 | 47 => 'Teleorman', | |
129 | 48 => 'Argeș', | |
130 | 49 => 'Olt', | |
131 | 50 => 'Vâlcea', | |
132 | 51 => 'Dolj', | |
133 | 52 => 'Mehedinți', | |
134 | 53 => 'Gorj', | |
135 | 54 => 'Hunedoara', | |
136 | 55 => 'Caraș-Severin', | |
137 | 56 => 'Timiș', | |
138 | 57 => 'Arad', | |
139 | 58 => 'Alba', | |
140 | 59 => 'Bihor', | |
141 | 60 => 'Sălaj', | |
142 | 61 => 'Satu Mare', | |
143 | 62 => 'Maramureș', | |
144 | 63 => 'Bistrița-Năsăud', | |
145 | 64 => 'Cluj', | |
146 | 65 => 'Mureș', | |
147 | 66 => 'Harghita', | |
148 | 67 => 'Covasna', | |
149 | 68 => 'Brașov', | |
150 | 69 => 'Sibiu', | |
151 | }; | |
152 | ||
153 | 1; | |
154 | __END__ | |
155 | ||
156 | =encoding utf-8 | |
157 | ||
158 | =head1 NAME | |
159 | ||
160 | Number::Phone::RO - Phone number information for Romania (+40) | |
161 | ||
162 | =head1 SYNOPSIS | |
163 | ||
164 | use Number::Phone::RO; | |
165 | my $nr = Number::Phone::RO->new('+40250123456'); | |
166 | say $nr->is_geographic; # 1 | |
167 | say $nr->is_fixed_line; # 1 | |
168 | say $nr->is_mobile; # 0 | |
169 | say $nr->is_tollfree; # 0 | |
170 | say $nr->is_specialrate; # 0 | |
171 | say $nr->areacode; # 250 | |
172 | say $nr->areaname; # Vâlcea | |
173 | say $nr->subscriber; # 123456 | |
174 | say $nr->operator; # (the name of this number's original operator) | |
175 | say $nr->operator_ported; # (the name of this number's current operator) | |
176 | say $nr->format; # +40 250 123 456 | |
177 | ||
178 | =head1 DESCRIPTION | |
179 | ||
180 | See the L<Number::Phone> documentation for usage information. The | |
181 | following methods from L<Number::Phone> are overridden: | |
182 | ||
183 | =over | |
184 | ||
185 | =item B<is_geographic> | |
186 | ||
187 | =item B<is_fixed_line> | |
188 | ||
189 | =item B<is_mobile> | |
190 | ||
191 | =item B<is_tollfree> | |
192 | ||
193 | =item B<is_specialrate> | |
194 | ||
195 | =item B<is_adult> | |
196 | ||
197 | =item B<country_code> | |
198 | ||
199 | Always returns 40. | |
200 | ||
201 | =item B<regulator> | |
202 | ||
203 | Returns the name and URL of the regulator, ANCOM. | |
204 | ||
205 | =item B<areacode> | |
206 | ||
207 | =item B<areaname> | |
208 | ||
209 | =item B<operator> | |
210 | ||
211 | =item B<operator_ported> | |
212 | ||
213 | =item B<subscriber> | |
214 | ||
215 | =item B<format> | |
216 | ||
217 | =back | |
218 | ||
219 | Other methods: | |
220 | ||
221 | =over 4 | |
222 | ||
223 | =item B<query_portabilitate> | |
224 | ||
225 | Queries L<http://portabilitate.ro> to get the information for the | |
226 | B<operator> and B<operator_ported> methods. The result is cached. | |
227 | Note that failures (such as number invalid, no internet connection) | |
228 | are also cached. Also note that the service rate limits | |
229 | requests. Going over the (unspecified) rate limit causes the service | |
230 | to ask for a captcha (which is interpreted as a failure by this | |
231 | function). | |
232 | ||
233 | This method is automatically called by B<operator> and | |
234 | B<operator_ported> the first time they are called. A possible reason | |
235 | for calling it explicitly is refreshing the cache. | |
236 | ||
237 | =back | |
238 | ||
239 | =head1 TODO | |
240 | ||
241 | Only long (10 digits) numbers are supported. | |
242 | ||
243 | =head1 AUTHOR | |
244 | ||
245 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
246 | ||
247 | =head1 COPYRIGHT AND LICENSE | |
248 | ||
249 | Copyright (C) 2015-2016 by Marius Gavrilescu | |
250 | ||
251 | This library is free software; you can redistribute it and/or modify | |
252 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
253 | at your option, any later version of Perl 5 you may have available. | |
254 | ||
255 | ||
256 | =cut |