# $Id: none yet $
#
package Number::Phone::Normalize;

use strict;
use warnings;

use Exporter;

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

our $VERSION = '0.20';

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<length($prefix);$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{
      die "error";
    }
  }

  return $self;
}

sub _self {
  my($self,%param) = @_;
  
  return new(__PACKAGE__,%param) unless ref($self);
  return $self->new(%param) if %param;
  return $self;
}

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

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;
}

1;

__END__

=head1 NAME

Number::Phone::Normalize - Normalizes format of Phone Numbers.

=head1 SYNOPSIS

  use Number::Phone::Normalize;

  print phone_intl('+1 (555)  123     4567');			# +1 555 1234567
  print phone_local('+49-89-99999999','CountryCode'=>'49');	# 089 99999999

=head1 DESCRIPTION

This module takes a phone (or E.164) number in different input formats and
outputs it in accordance to E.123 or in local formats.

=head1 Functions and Methods



=head2 phone_intl( $number, %params )

Normalizes the phone number $number and returns it in international (E.164)
format. $number can be in an international format or in a local format if the
C<CountryCode>/C<AreaCode> parameters are supplied.

If C<phone_intl> does not have enough information to build an international number
(e.g. neither C<$number> does not contain a country code and C<%param> does not
specify a default), it returns undef.

=head2 phone_local( $number, %params )

Normalizes the phone number $number and returns it in local format. $number can
be in an international format or in a local format if the C<CountryCode>/C<AreaCode>
parameters are supplied. 

If C<phone_local> does not have enough information to build an international
number (e.g. neither C<$number> does not contain a country code and C<%param>
does not specify a default), it returns undef.

=head2 Parameters

=head3 Interpreting C<$number>

These parameters specify how the input C<$number> is interpreted if it is in a
non-international format.

=head4 C<CountryCode>

The local country code. It is added to phone numbers in local format without an
country code.

=head4 C<AreaCode>

The local area code. It is added to phone numbers in local format without an
area code.

=head4 C<IntlPrefix>

The international prefix. If C<$number> starts with this prefix, the country code
and area code are taken from the number.

The default is '00' (ITU recommendation).

=head4 C<LDPrefix>

The long distance prefix. If $number starts with this prefix, the area code is
taken from $number and the country code is taken from the C<CountryCode>
parameter.

If $number starts with neither C<IntlPrefix> nor C<LDPrefix>, it is assumed to
be in local format and both country and area codes are taken from the
parameters.

The default is '0' (ITU recommendation).

=head3 Formatting output

These parameters specify how the output is formatted. Most parameters only have
an effect on output in local format.

=head4 CountryCodeOut

The local country code. If the number does not have the C<CountryCode> specified,
it is returned starting with the C<IntlPrefix>.

=head4 AreaCodeOut

The local country code. If the number does not have the C<CountryCode> specified,
it is returned starting with the C<LDPrefix>.

=head4 C<IntlPrefixOut>

The international prefix for output. If the number is not in the country
specified by C<CountryCode>, the returned number will start with this prefix.

The default is C<IntlPrefix>.

You can set this parameter to '+' in order to return numbers in international
format instead of the local format.

=head4 C<LDPrefixOut>

The long distance prefix for output. It the number is not in the area specified
by C<AreaCode> or C<AlwaysLD> is set to true, it is returned starting with C<LDPrefixOut>.

The default is LDPrefix.

=head4 C<AlwaysLD>

If set to true, the number will always be returned with an area code, even if
it is in the country and area specified by C<CountryCode> and C<AreaCode>.

=head4 C<VanityOK>

If set to true, vanity numbers will not be converted to numeric format.


=head1 METHODS

There is also an object-oriented interface.

=head2 new( %params)

Creates an object that carries default parameters:

  $nlz = Number::Phone::Normalize->new( %params );

=head2 $nlz->intl( $number [, %more_params] )

=head2 $nlz->local( $number [, %more_params] )

These functions are equivalent to C<phone_intl> and
C<phone_local> but use the C<%params> passed to C<new> as default.

I.e., the following calls:
  
  Number::Phone::Normalize->new( %p1 )->intl( $number, %p2 )
  Number::Phone::Normalize->new( %p1 )->local( $number, %p2 )

are equivalent to the follwoing:

  phone_intl( $number, %p1, %p2 );
  phone_local( $number, %p1, %p2 );

=head1 BUGS AND LIMITATIONS

The module does not support more complex dialling plans. It is
mostly intended for data input/output to and from databases, not
for actually dialling numbers.

=head1 AUTHOR/LICENSE

Copyright © 2004-2008 Claus Färber <CFAERBER@cpan.org>

It is free software; you can redistribute it and/or modify it
under the same terms as perl itself, either version 5.5.0 or, at
your option, any later version.