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 = '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