lib/Number/Phone/RO.pm

   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