Number::Phone::UK - UK-specific methods for Number::Phone

    use Number::Phone::UK;

    $daves_phone = Number::Phone->new('+44 1234 567890');

package Number::Phone::UK;

use strict;

use Scalar::Util 'blessed';
use Number::Phone::UK::Data;

use base 'Number::Phone';

our $VERSION = 1.554;

my $cache = {};

sub new {
    my $class = shift;
    my $number = shift;
    die("No number given to ".__PACKAGE__."->new()\n") unless($number);

    if(is_valid($number)) {
        return bless(\$number, $class);
    } else { return undef; }
}

sub is_valid {
    my $number = shift;

    # if called as an object method, it *must* be valid otherwise the
    # object would never have been instantiated.
    return 1 if(blessed($number) && $number->isa(__PACKAGE__));

    # otherwise we have to validate

    # if we've seen this number before, use cached result
    return 1 if($cache->{$number}->{is_valid});

    my $parsed_number = $number;
    $parsed_number =~ s/[^0-9+]//g;               # strip non-digits/plusses
    $parsed_number =~ s/^\+44//;                  # remove leading +44
    $parsed_number =~ s/^0//;                     # kill leading zero

    # @digits{qw(A B C D E F)} = split(//, $parsed_number, 7);

    my @retards = map { substr($parsed_number, 0, $_) } reverse 1..7;

    # and quickly check length
    $cache->{$number}->{is_valid} = (length($parsed_number) > 6 && length($parsed_number) < 11) ? 1 : 0;
    return 0 unless($cache->{$number}->{is_valid});

    $cache->{$number}->{is_geographic} =
	grep { $Number::Phone::UK::Data::db->{geo_prefices}->{$_} } @retards;
    $cache->{$number}->{is_network_service} =
	grep { $Number::Phone::UK::Data::db->{network_svc_prefices}->{$_} } @retards;
    $cache->{$number}->{is_tollfree} =
	grep { $Number::Phone::UK::Data::db->{free_prefices}->{$_} } @retards;
    $cache->{$number}->{is_corporate} =
	grep { $Number::Phone::UK::Data::db->{corporate_prefices}->{$_} } @retards;
    $cache->{$number}->{is_personal} =
	grep { $Number::Phone::UK::Data::db->{personal_prefices}->{$_} } @retards;
    $cache->{$number}->{is_pager} =
	grep { $Number::Phone::UK::Data::db->{pager_prefices}->{$_} } @retards;
    $cache->{$number}->{is_fixed_line} = 0 if(
      $cache->{$number}->{is_mobile} =
	grep { $Number::Phone::UK::Data::db->{mobile_prefices}->{$_} } @retards
    );

    $cache->{$number}->{is_specialrate} =
	grep { $Number::Phone::UK::Data::db->{special_prefices}->{$_} } @retards;
    $cache->{$number}->{is_adult} =
	grep { $Number::Phone::UK::Data::db->{adult_prefices}->{$_} } @retards;
    $cache->{$number}->{is_ipphone} =
	grep { $Number::Phone::UK::Data::db->{ip_prefices}->{$_} } @retards;
    $cache->{$number}->{is_allocated} = 
	grep { $Number::Phone::UK::Data::db->{telco_and_length}->{$_} } @retards;
    if($cache->{$number}->{is_allocated}) {
        my($telco_and_length) = map { $Number::Phone::UK::Data::db->{telco_and_length}->{$_} } grep { $Number::Phone::UK::Data::db->{telco_and_length}->{$_} } @retards;
	$cache->{$number}->{operator} = $Number::Phone::UK::Data::db->{telco_format}->{$telco_and_length}->{telco};
	$cache->{$number}->{format} = $Number::Phone::UK::Data::db->{telco_format}->{$telco_and_length}->{format};
	if($cache->{$number}->{format} ne '?') {
	    my($arealength, $subscriberlength) = split(/\+/, $cache->{$number}->{format});
            $subscriberlength =~ s/^(\d+).*/$1/; # for hateful mixed thing
	    $cache->{$number}->{areacode} = substr($parsed_number, 0, $arealength);
	    $cache->{$number}->{subscriber} = substr($parsed_number, $arealength);
            $cache->{$number}->{areaname} = (
                map {
                    $Number::Phone::UK::Data::db->{areanames}->{$_}
                } grep { $Number::Phone::UK::Data::db->{areanames}->{$_} } @retards
            )[0];
	    if(length($cache->{$number}->{subscriber}) != $subscriberlength && $cache->{$number}->{format} !~ /mixed/i) {
	        # number wrong length!
                $cache->{$number} = undef;
		return 0;
	    }
	}
    }
    return $cache->{$number}->{is_valid};
}

# now define the is_* methods that we over-ride

foreach my $is (qw(
    fixed_line geographic network_service tollfree corporate
    personal pager mobile specialrate adult allocated ipphone
)) {
    no strict 'refs';
    *{__PACKAGE__."::is_$is"} = sub {
        my $self = shift;
	$self = shift if($self eq __PACKAGE__);
	$self = __PACKAGE__->new($self)
	    unless(blessed($self) && $self->isa(__PACKAGE__));
	$cache->{${$self}}->{"is_$is"};
    }
}

# define the other methods

foreach my $method (qw(operator areacode areaname subscriber)) {
    no strict 'refs';
    *{__PACKAGE__."::$method"} = sub {
        my $self = shift;
        $self = (blessed($self) && $self->isa(__PACKAGE__)) ?
            $self :
            __PACKAGE__->new($self);
        return $cache->{${$self}}->{$method};
    }
}

sub country_code { 44; }

sub regulator { 'OFCOM, http://www.ofcom.org.uk/'; }

sub location {
    my $self = shift;
    $self = (blessed($self) && $self->isa(__PACKAGE__)) ?
        $self :
        __PACKAGE__->new($self);

    return undef unless($self->is_geographic());

    my $parsed_number = ${$self};
    $parsed_number =~ s/[^0-9+]//g;               # strip non-digits/plusses
    $parsed_number =~ s/^\+44//;                  # remove leading +44
    $parsed_number =~ s/^0//;                     # kill leading zero

    my @retards = map { substr($parsed_number, 0, $_) } reverse(1..length($parsed_number));

    eval "require Number::Phone::UK::DetailedLocations" unless($ENV{TESTINGKILLTHEWABBIT});
    require Number::Phone::UK::Exchanges if(!$Number::Phone::UK::Exchanges::db);

    foreach(@retards) {
        if(exists($Number::Phone::UK::Exchanges::db->{exchg_prefices}->{$_})) {
            return [
                $Number::Phone::UK::Exchanges::db->{exchg_positions}->{$Number::Phone::UK::Exchanges::db->{exchg_prefices}->{$_}}->{lat},
                $Number::Phone::UK::Exchanges::db->{exchg_positions}->{$Number::Phone::UK::Exchanges::db->{exchg_prefices}->{$_}}->{long}
            ];
        }
    }

    return undef;
}

sub format {
    my $self = shift;
    $self = (blessed($self) && $self->isa(__PACKAGE__)) ?
        $self :
        __PACKAGE__->new($self);
    return '+'.country_code().' '.(
	$self->areacode()      ? $self->areacode().' '.$self->subscriber() :
	!$self->is_allocated() ? substr(${$self}, 1 + length(country_code()))
	                       : $self->subscriber()
    );
}

1;