| 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 = '0.002'; |
| 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<country_code> |
| 196 | |
| 197 | Always returns 40. |
| 198 | |
| 199 | =item B<regulator> |
| 200 | |
| 201 | Returns the name and URL of the regulator, ANCOM. |
| 202 | |
| 203 | =item B<areacode> |
| 204 | |
| 205 | =item B<areaname> |
| 206 | |
| 207 | =item B<operator> |
| 208 | |
| 209 | =item B<operator_ported> |
| 210 | |
| 211 | =item B<subscriber> |
| 212 | |
| 213 | =item B<format> |
| 214 | |
| 215 | =back |
| 216 | |
| 217 | Other methods: |
| 218 | |
| 219 | =over 4 |
| 220 | |
| 221 | =item B<query_portabilitate> |
| 222 | |
| 223 | Queries L<http://portabilitate.ro> to get the information for the |
| 224 | B<operator> and B<operator_ported> methods. The result is cached. |
| 225 | Note that failures (such as number invalid, no internet connection) |
| 226 | are also cached. Also note that the service rate limits |
| 227 | requests. Going over the (unspecified) rate limit causes the service |
| 228 | to ask for a captcha (which is interpreted as a failure by this |
| 229 | function). |
| 230 | |
| 231 | This method is automatically called by B<operator> and |
| 232 | B<operator_ported> the first time they are called. A possible reason |
| 233 | for calling it explicitly is refreshing the cache. |
| 234 | |
| 235 | =back |
| 236 | |
| 237 | =head1 TODO |
| 238 | |
| 239 | Only long (10 digits) numbers are supported. |
| 240 | |
| 241 | =head1 AUTHOR |
| 242 | |
| 243 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> |
| 244 | |
| 245 | =head1 COPYRIGHT AND LICENSE |
| 246 | |
| 247 | Copyright (C) 2015 by Marius Gavrilescu |
| 248 | |
| 249 | This library is free software; you can redistribute it and/or modify |
| 250 | it under the same terms as Perl itself, either Perl version 5.20.2 or, |
| 251 | at your option, any later version of Perl 5 you may have available. |
| 252 | |
| 253 | |
| 254 | =cut |