File Coverage

blib/lib/String/Validator/Phone/NANP.pm
Criterion Covered Total %
statement 82 82 100.0
branch 14 14 100.0
condition n/a
subroutine 18 18 100.0
pod 9 9 100.0
total 123 123 100.0


line stmt bran cond sub pod time code
1             package String::Validator::Phone::NANP;
2             $String::Validator::Phone::NANP::VERSION = '2.00';
3 7     7   450503 use 5.008;
  7         93  
4 7     7   46 use strict;
  7         13  
  7         159  
5 7     7   38 use warnings;
  7         14  
  7         302  
6 7     7   3541 use String::Validator::Common 1.90;
  7         294338  
  7         220  
7 7     7   4004 use Number::Phone ;
  7         50870  
  7         36  
8              
9             # ABSTRACT: Validate North American Phone Numbers
10              
11              
12             my $phonenanp_messages = {
13             phonenanp_not10 => sub {
14             my $D = shift; # num1, num2, len
15             return "Not a 10 digit Area-Number $D->{num1} .. $D->{num2} = $D->{len}.";
16             },
17             phonenanp_badarea => 'Invalid Number, perhaps non-existent Area Code',
18             };
19              
20             sub new {
21 7     7 1 5854 my $class = shift ;
22 7         31 my $self = { @_ } ;
23 7     7   738 use base ( 'String::Validator::Common' ) ;
  7         19  
  7         5603  
24 7 100       38 unless ( defined $self->{ alphanum } ) { $self->{ alphanum } = 0 } ;
  2         6  
25             # disable length checking.
26 7         24 $self->{ min_len } = 0 ; $self->{ max_len } = 0 ;
  7         21  
27 7         19 bless $self, $class ;
28             $self->{messages}
29             = String::Validator::Common::_Messages(
30 7         86 $phonenanp_messages, $self->{language}, $self->{custom_messages} );
31 7         323 return $self ;
32             }
33              
34             # Private method to change to area-exchange-num format.
35              
36             sub _clean {
37 56     56   15022 my $num = uc( shift @_ ) ;
38 56         197 my $alphanum = shift @_ ;
39 56 100       144 if ( $alphanum ) {
40 32         194 $num =~ s/\W//g ;
41 32         85 $num =~ tr/ABCDEFGHIJKLMNOPQRSTUVWXYZ/22233344455566677778889999/ ;
42             }
43 24         156 else { $num =~ s/\D//g ; }
44 56         146 $num =~ s/^1// ;
45 56         150 my $area = substr( $num, 0, 3, '' ) ;
46 56         121 my $exch = substr( $num, 0, 3, '' ) ;
47 56         225 return qq /$area-$exch-$num/ ;
48             }
49              
50             # North American Numbers have a length of 10.
51             # Returns 1 if this is true 0 and increases err if not.
52             sub _must_be10 {
53 56     56   15398 my $self = shift ;
54 56         97 my $num = shift ;
55 56         104 my $num2 = $num ;
56 56         265 $num2 =~ s/\W//g ;
57 56         115 my $l = length $num2 ;
58 56 100       140 if ( 10 == $l ) { return 1 }
  42         134  
59             else { $self->IncreaseErr(
60 14         82 $self->{messages}{phonenanp_not10}->({
61             num1 => $num, num2 => $num2, len => $l }));
62             }
63 14         144 return 0 ;
64             }
65              
66             sub _Init {
67 25     25   175 my $self = shift ;
68 25         59 $self->{ error } = 0 ;
69 25         78 for ( qw / string original international errstring areacode exchange local /) {
70 175         414 $self->{ $_ } = '' ; }
71             } ;
72              
73             sub Check {
74 25     25 1 33455 my ( $self, $string1, $string2 ) = @_ ;
75 25 100       126 if ( $self->Start( $string1, $string2 ) ) {
76 1         28 return $self->{ error } }
77 24         328 $self->{ string } = &_clean( $string1, $self->{alphanum} ) ;
78 24 100       87 unless( $self->_must_be10( $self->{ string } ) ) {
79 5         17 $self->{ string } = '' ; return $self->{ error } }
  5         24  
80 19         47 $self->{ original } = $string1 ;
81             #Number::Phone requires a leading 1.;
82             ( $self->{ areacode }, $self->{ exchange }, $self->{ local } ) =
83 19         87 split /\-/, $self->{ string };
84 19         64 $self->{ international } = '1-' . $self->{ string } ;
85 19         107 my $Phone = Number::Phone->new( $self->{ international } ) ;
86 19 100       1213965 unless ( $Phone ) {
87 3         48 $self->IncreaseErr( $self->{messages}{phonenanp_badarea} ) }
88 19         208 return $self->{ error } ;
89             }
90              
91             # sub String # is inherited from String::Validator::Common.
92              
93 5     5 1 1012 sub Original { my $self = shift ; return $self->{ original } ; } ;
  5         37  
94              
95             sub Areacode {
96 8     8 1 18 my $self = shift ;
97 8         35 return ( $self->{ areacode } ) ;
98             }
99              
100             sub Exchange {
101 9     9 1 651 my $self = shift ;
102 9         41 return ( $self->{ exchange } ) ;
103             }
104              
105             sub Local {
106 8     8 1 17 my $self = shift ;
107 8         32 return ( $self->{ local } ) ;
108             }
109              
110 5     5 1 1895 sub International { my $self = shift ; return $self->{ international } }
  5         28  
111              
112             sub Parens {
113 4     4 1 12 my $self = shift ;
114 4         14 my $area = $self->Areacode() ;
115 4         12 my $exchange = $self->Exchange() ;
116 4         15 my $local = $self->Local() ;
117 4         26 return "($area) $exchange-$local" ;
118             }
119              
120             sub Number_Phone {
121 7     7 1 813 my $self = shift ;
122 7 100       26 unless( $self->{ international } ) { return 0 } ;
  1         10  
123 6         20 return Number::Phone->new( $self->{ international } ) ;
124             }
125              
126              
127             1; # End of String::Validator::Phone::NANP
128              
129             __END__