build-data.realwork

#!/usr/local/bin/perl

# THIS SHELL 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.

# The numbering scheme goes like so:
#
# 1: geographic
# 2: geographic
# 3: non-geographic
# 500: free (grandfathered)
# 55: corporate
# 56: location-independent electronic comms (voip)
# 70: personal numbering
# 71: mobile
# 72: mobile
# 73: mobile
# 74: mobile
# 75: mobile
# 76: paging # yuck, hole in middle of mobile range
# 77: mobile
# 78: mobile
# 79: mobile
# 80: free to caller
# 820: internet for schools
# 84: special
# 87: special
# 90: special
# 91: special
# 92: special
# 98: special

use strict;
use warnings;

use lib 'lib';

use Text::CSV_XS;
use Digest::MD5 'md5_base64';
use Data::Dumper;
use Number::Phone::UK::DBM::Deep;

my $dbm = Number::Phone::UK::DBM::Deep->new('temp.db');

my $csv = Text::CSV_XS->new({
    binary => 1
});

open(MODULE, '>Data.pm') || die("Can't write Data.pm\n");

print MODULE "package Number::Phone::UK::Data;\n\n";
print MODULE "# automatically generated file, don't edit\n\n";
print MODULE "our \$VERSION = 1.".join("", (gmtime())[5] + 1900, sprintf('%02d', (gmtime())[4] + 1), map { sprintf('%02d', $_) } (gmtime())[3, 2, 1, 0]).";\n\n";
print MODULE q{
    use Number::Phone::UK::DBM::Deep;

    our $db = Number::Phone::UK::DBM::Deep->new(fh => *DATA);
    if ($db->error()) {
        die "DBM::Deep error: " . $db->error();
    }
    
    1;
    __DATA__
};

my @geo_prefices = my @free_prefices = my @network_svc_prefices = my @corporate_prefices = my @personal_prefices = my @pager_prefices = my @mobile_prefices = my @special_prefices = my @adult_prefices = my @ip_prefices = my %areanames = ();

open(SABC, 'sabc.txt') || die("Can't read sabc.txt\n");

while(my $line = <SABC>) {
    $line =~ s/£/UKP/g;
    $csv->parse($line) || die("Bad CSV line in sabc.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[3] =~ /(unassigned|not to be used|expansion$)/i || $fields[2] eq 'Not Designated');

    push @geo_prefices, $fields[0] if($fields[0] =~ /^[12]/);

    if($fields[2] eq 'Designated' && $fields[3] !~ /^Geographic - unassigned/) {
        $areanames{$fields[0]} = $fields[3];
    }
}
close(SABC);

my @telco_length_data = ();
open(S1, 's1_code.txt') || die("Can't open s1_code.txt\n");
while(my $line = <S1>) {
    $line =~ s/£/UKP/g;
    $csv->parse($line) || die("Bad CSV line in s1_code.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[3] ne 'Allocated');
    
    my $retard = join('',@fields[0,1,2]);
    my $telco = $fields[5];
    my $format = $fields[6];

    # ick, temporary fix for OFCOM brokenness
    if($format eq "F-Digit '6'") {
        $format = '4+6';
        warn("Using temporary fix for OFCOM brokenness re F-digit\n");
    }

    push @telco_length_data, [$retard, $telco, $format];
}
close(S1);
open(S3, 's3_code.txt') || die("Can't open s3_code.txt\n");
while(my $line = <S3>) {
    $line =~ s/£/UKP/g;
    $csv->parse($line) || die("Bad CSV line in s3_code.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[3] ne 'Allocated');
    
    my $retard = join('',@fields[0 .. 2]);
    my $telco = $fields[5];
    my $format = '10 digit numbers';

    push @telco_length_data, [$retard, $telco, $format];

}
close(S3);
open(S8, 's8_code.txt') || die("Can't open s8_code.txt\n");
while(my $line = <S8>) {
    $line =~ s/£/UKP/g;
    $line =~ s/,,/,"",/g;
    $line =~ s/,$/,""/;
    $csv->parse($line) || die("Bad CSV line in s8_code.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[3] !~ /^Allocated( \(Closed Range\)| for Migration only)?$/);
    
    my $retard = join('',@fields[0,1,2]);
    my $telco = $fields[6];
    my $service = $fields[7];
    my $format = $fields[8];

    if($service =~ /(Emergency Services|Internet for Schools|(Internal|Inbound) Routing|Broadband Services)/i) {
        push @network_svc_prefices, $retard;
    }

    if($retard =~ /^80/) { push @free_prefices, $retard }
     elsif($retard eq '500') { push @free_prefices, $retard }
     elsif($service  =~ /^(PRS|Special Services)/i) {
        push @special_prefices, $fields[0];
    }
    push @telco_length_data, [$retard, $telco, $format];
}
close(S8);
open(S5, 's5_code.txt') || die("Can't open s5_code.txt\n");
while(my $line = <S5>) {
    $line =~ s/£/UKP/g;
    $csv->parse($line) || die("Bad CSV line in s5_code.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[2] ne 'Allocated');
    
    my $retard = join('',@fields[0, 1]);
    my $telco = $fields[4];
    my $format = $fields[5];

    push @corporate_prefices, $retard if($retard =~ /^55/i);
    push @ip_prefices, $retard if($retard =~ /^56/i);

    push @telco_length_data, [$retard, $telco, $format];
}
close(S5);
open(S7, 's7_code.txt') || die("Can't open s7_code.txt\n");
while(my $line = <S7>) {
    $line =~ s/£/UKP/g;
    $csv->parse($line) || die("Bad CSV line in s7_code.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[2] ne 'Allocated');
    
    (my $retard = join('',@fields[0, 1])) =~ s/\D//g; # there's spaces in OFCOM's data!
    my $telco = $fields[4];
    my $format = $fields[6] || '10 digit numbers';

    push @telco_length_data, [$retard, $telco, $format];
    if($fields[5] eq 'Mobile services') {
        push @mobile_prefices, $retard;
    } elsif($fields[5] eq 'Radiopaging') {
        push @pager_prefices, $retard;
    } elsif($fields[5] eq 'Personal Numbers') {
        push @personal_prefices, $retard;
    } 
}
close(S7);
open(S9, 's9_code.txt') || die("Can't open s9_code.txt\n");
while(my $line = <S9>) {
    $line =~ s/£/UKP/g;
    $csv->parse($line) || die("Bad CSV line in s9_code.txt\n\n$line\n\n");
    my @fields = $csv->fields();
    next if($fields[2] ne 'Allocated');
    
    my $retard = join('',@fields[0, 1]);
    my $telco = $fields[5];
    my $type   = $fields[6];
    my $format = $fields[7];

    push @adult_prefices, $retard if($type =~ /(sexual entertainment|sexual nature)/i);
    push @special_prefices, $fields[0];
    push @telco_length_data, [$retard, $telco, $format];
}
close(S9);

$dbm->{geo_prefices}         = { map { ($_, 1) } @geo_prefices };
$dbm->{network_svc_prefices} = { map { ($_, 1) } @network_svc_prefices };
$dbm->{free_prefices}        = { map { ($_, 1) } @free_prefices };
$dbm->{corporate_prefices}   = { map { ($_, 1) } @corporate_prefices };
$dbm->{personal_prefices}    = { map { ($_, 1) } @personal_prefices };
$dbm->{pager_prefices}       = { map { ($_, 1) } @pager_prefices };
$dbm->{mobile_prefices}      = { map { ($_, 1) } @mobile_prefices };
$dbm->{special_prefices}     = { map { ($_, 1) } @special_prefices };
$dbm->{adult_prefices}       = { map { ($_, 1) } @adult_prefices };
$dbm->{ip_prefices}          = { map { ($_, 1) } @ip_prefices };
$dbm->{areanames}            = { map {
    # s/\\/\\\\/g;
    # s/"/\\"/g;
    s/( National Dialling)//ig;
    # s/^(.*)$/"$1"/ if(/\D/);
    $_;
} %areanames };

my %telco_format_cache = ();
my %telco_and_length = ();
foreach my $datum (@telco_length_data) {
    my($retard, $telco, $format) = @{$datum};
    if($format eq 'N/A' || $format eq '(0)+10' || $format =~ /^10 digit number/i) {
        $format = '0+10';
    } elsif($format =~ /^7 digit number/i) {
        $format = '0+7';
    } elsif($format =~ /^9 +digit number/i) {
        $format = '0+9';
    } elsif($format eq 'RTO') {
        $format = '?';
    } elsif($format eq '') {
        warn "Empty format: $format (r: $retard; t: $telco)\n"
            if($retard !~ /^[789]/);
    } elsif($format eq 'Mixed 4+5 & 4+6') {
        $format = '4+5/6';
    } elsif(
        $format ne '2+8' &&
        $format ne '2+8' &&
        $format ne '3+7' &&
        # $format ne '4+4' &&
        $format ne '4+6' &&
        $format ne '4+5' &&
        $format ne '5+4' &&
        $format ne '5+5' &&
        $format ne 'Mixed 4+5 & 4+6'
    ) {
        warn "Unknown format: $format (r: $retard; t: $telco)\n";
    }

    my $cache_key = md5_base64($telco.'_'.$format);
    $telco_format_cache{$cache_key} = {
        telco => $telco,
        format => $format
    };

    $telco_and_length{$retard} = $cache_key;
}

$dbm->{telco_format} = \%telco_format_cache;
$dbm->{telco_and_length} = \%telco_and_length;

$dbm->optimize();