File Coverage

blib/lib/Number/Phone/Normalize.pm

Criterion	Covered	Total	%
statement	122	125	97.6
branch	62	74	83.7
condition	33	39	84.6
subroutine	22	22	100.0
pod	15	15	100.0
total	254	275	92.3

package Number::Phone::Normalize;

use strict;
use warnings;

use Carp;
use Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(phone_intl phone_local);

our $VERSION = '0.220';

sub _kill_vanity {
  my $number = shift;
  $number =~ s/[abc]/2/gi;
  $number =~ s/[def]/3/gi;
  $number =~ s/[ghi]/4/gi;
  $number =~ s/[jkl]/5/gi;
  $number =~ s/[mno]/6/gi;
  $number =~ s/[pqrs]/7/gi;
  $number =~ s/[tuv]/8/gi;
  $number =~ s/[wxyz]/9/gi;
  return $number;
}

sub _remove_prefix {
  my ($number,$prefix) = @_;
  $number = _kill_vanity($number); $number =~ s/[^0-9]//g;
  $prefix = _kill_vanity($prefix); $prefix =~ s/[^0-9]//g;

  if ($number =~ m/^$prefix/) {
    for(my $i=0;$i
      $_[0] =~ s/^[^0-9A-Z]*[0-9A-Z][^0-9A-Z]*//i;
    }
    return $_[0];
  } else {
    return undef;
  }
}

sub new {
  my($class,%param) = @_;
  my $self = bless {}, ref($class) || $class;

  %{$self} = %{$class} if (ref $class);

  foreach(keys %param)
  {
    if(my $accessor = $self->can($_))
    {
      &$accessor($self,$param{$_})
    }else{
      croak "Invalid parameter: $_";
    }
  }

  return $self;
}

sub _self {
  my($self,%param) = @_;

  return new(__PACKAGE__,%param) unless ref($self);
  return $self->new(%param) if %param;
  return $self;
}

sub intl {
  my ($self,$number,%param) = @_;
  $self = _self($self,%param);

  my $has_prefix = ($number =~ m/^[^A-Z0-9]*\+/i);

  $number = _kill_vanity $number unless $self->VanityOK;

  $number =~ s/[^0-9A-Z]+/ /gi;		# Normalize Punctuation
  $number =~ s/^ *(.*?) *$/$1/;		# Remove leading/trailing Whitespace

  return '+'.$number if $has_prefix;	# Number was alreads in int'l format
  return undef unless $number;		# no significant digits

  my $nn;

  if($nn = _remove_prefix($number,$self->IntlPrefix)) {
    return '+'.$nn;
  }
  elsif(($nn = _remove_prefix($number,$self->LDPrefix)) && defined $self->CountryCode) {
    return '+'.($self->CountryCode).' '.$nn;
  }
  elsif(defined $self->CountryCode && defined $self->AreaCode) {
    return '+'.($self->CountryCode).' '.($self->AreaCode).' '.$number;
  }
  return undef;
}

sub local {
  my ($self,$number,%param) = @_;
  $self = _self($self,%param);

  my $has_prefix = ($number =~ m/^[^A-Z0-9 ]*\+/i);

  $number = _kill_vanity $number unless $self->VanityOK;
  $number =~ s/[^0-9A-Z]+/ /gi;		# Normalize Punctuation
  $number =~ s/^ *(.*?) *$/$1/;		# Remove leading/trailing Whitespace

  return undef unless $number ne '';	# no significant digits

  my $nn;

  if($has_prefix) {
    #
    # Number is in international format
    #
    if(defined $self->CountryCodeOut && defined $self->AreaCodeOut && (!$self->AlwaysLD)
        && ($nn = _remove_prefix($number,($self->CountryCodeOut).($self->AreaCodeOut)))) {
      return $nn;
    }
    elsif($self->CountryCodeOut
        && ($nn = _remove_prefix($number,$self->CountryCodeOut))) {
      return ($self->LDPrefixOut).$nn;
    }
    else {
      return ($self->IntlPrefixOut).$number
    }
  } else {
    #
    # Number is in local format

    @_ = ($self, $self->intl($number));
    goto &local unless !defined $_[1];

    if(defined $self->AreaCodeOut && (!$self->AlwaysLD)
        && ($nn = _remove_prefix($number,($self->LDPrefix).($self->AreaCodeOut)))) {
      return $nn;
    }
    elsif(($nn = _remove_prefix($number,($self->LDPrefix)))) {
      return ($self->LDPrefixOut).$nn;
    }
    elsif(defined $self->AreaCode && defined $self->AreaCodeOut
        && $self->AreaCode ne $self->AreaCodeOut) {
      return ($self->LDPrefixOut).($self->AreaCode).' '.$number
    }
    elsif($self->AlwaysLD && defined $self->AreaCodeOut)
    {
      return ($self->LDPrefixOut).($self->AreaCodeOut).' '.$number
    }
    else
    {
      return $number;
    }
  }
}

sub IntlPrefix {
  my $self = shift;
  my $old_value = defined $self->{'IntlPrefix'} ? $self->{'IntlPrefix'} : '00';
  $self->{'IntlPrefix'} = shift if @_;
  return $old_value;
}

sub LDPrefix {
  my $self = shift;
  my $old_value = defined $self->{'LDPrefix'} ? $self->{'LDPrefix'} : '0';
  $self->{'LDPrefix'} = shift if @_;
  return $old_value;
}

sub IntlPrefixOut {
  my $self = shift;
  my $old_value = defined $self->{'IntlPrefixOut'} ? $self->{'IntlPrefixOut'} : $self->IntlPrefix;
  $self->{'IntlPrefixOut'} = shift if @_;
  return $old_value;
}

sub LDPrefixOut {
  my $self = shift;
  my $old_value = defined $self->{'LDPrefixOut'} ? $self->{'LDPrefixOut'} : $self->LDPrefix;
  $self->{'LDPrefixOut'} = shift if @_;
  return $old_value;
}

sub CountryCode {
  my $self = shift;
  my $old_value = $self->{'CountryCode'};
  $self->{'CountryCode'} = shift if @_;
  return $old_value;
}

sub AreaCode {
  my $self = shift;
  my $old_value = $self->{'AreaCode'};
  $self->{'AreaCode'} = shift if @_;
  return $old_value;
}

sub CountryCodeOut {
  my $self = shift;
  my $old_value = defined $self->{'CountryCodeOut'} ? $self->{'CountryCodeOut'} : $self->CountryCode;
  $self->{'CountryCodeOut'} = shift if @_;
  return $old_value;
}

sub AreaCodeOut {
  my $self = shift;
  my $old_value = $self->{'AreaCodeOut'} ? $self->{'AreaCodeOut'} : $self->AreaCode;
  $self->{'AreaCodeOut'} = shift if @_;
  return $old_value;
}

sub VanityOK {
  my $self = shift;
  my $old_value = $self->{'VanityOK'};
  $self->{'VanityOK'} = shift if @_;
  return $old_value;
}

sub AlwaysLD {
  my $self = shift;
  my $old_value = $self->{'AlwaysLD'} && defined $self->AreaCodeOut;
  $self->{'AlwaysLD'} = shift if @_;
  return $old_value;
}

sub phone_intl { unshift @_, undef; goto &intl; }
sub phone_local { unshift @_, undef; goto &local; }

1;

__END__