build-data.nanp

#!/usr/local/bin/perl

# THIS SCRIPT IS NOT INTENDED FOR END USERS OR FOR PEOPLE INSTALLING
# THE MODULES, BUT FOR THE AUTHOR'S USE WHEN UPDATING THE DATA FROM OFCOM'S
# PUBLISHED DATA.

use strict;
use warnings;
use XML::XPath;
use Data::Dumper;local $Data::Dumper::Indent = 1;

use lib 'lib';
use Number::Phone::Country;

$| = 1;

open(MODULE, '>lib/Number/Phone/NANP/Data.pm') || die("Can't write lib/Number/Phone/NANP/Data.pm\n");

print MODULE "# automatically generated file, don't edit\n\n";
print MODULE q{

  # Copyright 2011 David Cantrell, derived from data from libphonenumber
  # http://code.google.com/p/libphonenumber/
  #
  # Licensed under the Apache License, Version 2.0 (the "License");
  # you may not use this file except in compliance with the License.
  # You may obtain a copy of the License at
  # 
  #     http://www.apache.org/licenses/LICENSE-2.0
  # 
  # Unless required by applicable law or agreed to in writing, software
  # distributed under the License is distributed on an "AS IS" BASIS,
  # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  # See the License for the specific language governing permissions and
  # limitations under the License.
  package Number::Phone::NANP::Data;

  use strict;
  use warnings;
  use vars qw(%areanames %fixed_line_regexes %mobile_regexes);
}.
"our \$VERSION = 1.".join("", (gmtime())[5] + 1900, sprintf('%02d', (gmtime())[4] + 1), map { sprintf('%02d', $_) } (gmtime())[3, 2, 1, 0]).";\n\n".q{

  sub _prefixes {
      my $number = shift;
      map { substr($number, 0, $_) } reverse(1..length($number));
  }

  sub areaname {
    my $number = shift;
    foreach my $prefix (_prefixes($number)) {
      if(exists($areanames{$prefix})) { return $areanames{$prefix} };
    }
    return undef;
  }
};

# Extract area names
print MODULE '%areanames = (';
open(LIBPHONENUMBERDATA, 'libphonenumber/resources/geocoding/en/1.txt') || die("Can't read libphonenumber/resources/geocoding/en/1.txt\n");
my @lines = <LIBPHONENUMBERDATA>;
close(LIBPHONENUMBERDATA);
foreach my $line (@lines) {
  chomp($line);
  next if($line =~ /^(#.*|\s+)?$/);
  my($prefix, $area) = split(/\|/, $line);
  $area = quotemeta($area);
  print MODULE "    '$prefix' => \"$area\",\n";
}
print MODULE '  );';

# despite this data being in libphonenumber, it's only useful for
# some countries. eg it looks sane for JM but not for CA
# they list +1 204 as being both fixed line and mobile. Grargh!
# # extract mobile/fixed-line prefix regexes
my $xml = XML::XPath->new(filename => 'libphonenumber/resources/PhoneNumberMetadata.xml');
my @territories = $xml->find('/phoneNumberMetadata/territories/territory')->get_nodelist();
TERRITORY: foreach my $territory (@territories) {
    next TERRITORY unless($territory->find('@countryCode').'' eq '1');
    (my $fixed  = $territory->find("fixedLine/nationalNumberPattern")->string_value()) =~ s/\s+//g;
    (my $mobile = $territory->find("mobile/nationalNumberPattern")->string_value()) =~ s/\s+//g;
    my $ISO_country_code = $territory->find('@id').'';
    if($fixed eq $mobile) {
        warn("$ISO_country_code: same regexes for fixed and mobile\n");
        next TERRITORY;
    } else {
        my @area_codes = Number::Phone::Country::_NANP_area_codes($ISO_country_code);
        foreach my $area_code (@area_codes) {
            foreach my $co (map { sprintf("%03d", $_ ) } 0 .. 999) {
                my $number = "${area_code}${co}3333";
                if($number =~ /^$fixed$/x && $number =~ /^$mobile$/x) {
                    warn("$ISO_country_code: Overlap between fixed/mobile regexes for $number\n");
                    next TERRITORY;
                }
            }
        }
    }
    print MODULE "\$fixed_line_regexes{$ISO_country_code} = '$fixed';\n";
    print MODULE "\$mobile_regexes{$ISO_country_code} = '$mobile';\n";
}

close(MODULE);