File Coverage

lib/Number/MuPhone.pm
Criterion Covered Total %
statement 107 115 93.0
branch 39 52 75.0
condition 6 14 42.8
subroutine 20 20 100.0
pod 2 3 66.6
total 174 204 85.2


line stmt bran cond sub pod time code
1             package Number::MuPhone;
2 1     1   71219 use strict;
  1         2  
  1         29  
3 1     1   5 use warnings;
  1         1  
  1         22  
4 1     1   12 use v5.020;
  1         15  
5 1     1   619 use Moo;
  1         11740  
  1         4  
6 1     1   2146 use Types::Standard qw( Maybe Str );
  1         78979  
  1         10  
7              
8             $Number::MuPhone::VERSION = '1.02';
9              
10             our $MUPHONE_BASE_DIR = $ENV{MUPHONE_BASE_DIR} || $ENV{HOME}.'/.muphone';
11             our $EXTENSION_REGEX = qr/(?:\*|extension|ext|x)/;
12             our $DIAL_PAUSE = ',,,';
13              
14             # if custom data module exists, load it, else use distribution default
15             # (which will most likely be out of date)
16             our $MUPHONE_DATA;
17             my $data_module_path = "$MUPHONE_BASE_DIR/lib/NumberMuPhoneData.pm";
18             if (-f $data_module_path) {
19             require $data_module_path;
20             }
21             else {
22             require Number::MuPhone::Data;
23             }
24             # Let's import the var shortcut to save typing
25             Number::MuPhone::Data->import('$MUPHONE_DATA');
26              
27             ################################################################################
28              
29             =head1 NAME
30              
31             Number::MuPhone - parsing and displaying phone numbers in pure Perl
32              
33             NOTE: this is a full rewrite and is not backwards compatible with earlier
34             versions of this module.
35              
36             =head1 DESCRIPTION
37              
38             Parse, validate (loosely in some cases) and display phone numbers as expected.
39              
40             This has stripped down functionality compared to libphonenumber, but it is
41             also Pure Perl (TM), is simpler to use, and contains the core functionality
42             needed by common use cases.
43              
44             If you have functionality requests, please let me know: L
45              
46             All number regexes are derived from the XML file supplied by:
47              
48             L
49              
50              
51             =head1 BASIC USAGE
52              
53             Instantiate an instance using one of the following syntaxes
54              
55             # single arg: E.123 formatted number, scalar shortcut
56             my $num = Number::MuPhone->new('+1 203 503 1199');
57              
58             # single arg: E.123 formatted number, hashref format
59             my $num = Number::MuPhone->new({
60             number => '+1 203 503 1199'
61             });
62              
63             # double arg, number and country - number can be in local or E.123 format, scalar args
64             my $num = Number::MuPhone->new('+1 203 503 1199','US");
65             my $num = Number::MuPhone->new('(203) 503-1199','US');
66              
67             # double arg, number and country - number can be in local or E.123 format, hashref args
68             my $num = Number::MuPhone->new({
69             number => '+1 203 503 1199'
70             country => 'US',
71             });
72             my $num = Number::MuPhone->new({
73             number => '(203) 503-1199'
74             country => 'US',
75             });
76              
77             # after instantiation, check all is well before using the object
78             if ($num->error) {
79             # process the error
80             }
81              
82              
83             =head1 ATTRIBUTES
84              
85             =cut
86              
87             around BUILDARGS => sub {
88             my ( $orig, $class, @args ) = @_;
89              
90             # args are probably a hashref - { number => $number, country => 'US' }
91             # but can use a shortcut, if preferred
92             # ($number, 'US')
93              
94             if (ref $args[0] ne 'HASH' and @args>2) {
95             die "Bad args - must be a hashref of name args or (\$num,\$country_code)";
96             }
97              
98             if (!ref $args[0]) {
99             $args[0] = { number => $args[0] };
100              
101             $args[0]->{country} = pop @args
102             if $args[1];
103             }
104              
105             return $class->$orig(@args);
106             };
107              
108             sub BUILD {
109 17     17 0 1753 my ($self,$arg) = @_;
110              
111             # extract number and extension, determine countrycode from number,
112             # strip off possible national/international dial prefix
113             # and store attributes as needed
114 17         40 $self->_process_raw_number;
115              
116             }
117              
118             =head2 number
119              
120             The raw number sent in at instantiation - not needed (outside of logging, maybe)
121              
122             =cut
123              
124             has number => (
125             isa => Str,
126             is => 'ro',
127             required => 1,
128             );
129              
130             =head2 extension
131              
132             Extenstion number (digits only)
133              
134             =cut
135              
136             has extension => (
137             is => 'rw',
138             default => ''
139             );
140              
141             =head2 country
142              
143             The 2 character country code sent in instantiation, or inferred from an E.123 number
144              
145             =cut
146              
147             # 2 char country code - either explicitly sent, to inferred from the number / config
148             has country => (
149             isa => Maybe[Str],
150             is => 'rw',
151             lazy => 1,
152             );
153              
154             =head2 error
155              
156             If the args don't lead to a valid number at instantiation, this error will be set
157              
158             =cut
159              
160             has error => (
161             isa => Str,
162             is => 'rw',
163             default => '',
164             );
165              
166             =head2 country_name
167              
168             Full text name of country (may be inaccurate for single arg instantiation - see below)
169              
170             =cut
171              
172             has country_name => (
173             is => 'lazy',
174             );
175             sub _build_country_name {
176 3     3   4274 my $self = shift;
177 3         49 return $MUPHONE_DATA->{territories}->{ $self->country }->{TerritoryName};
178             }
179              
180             =head2 country_code
181              
182             1-3 digit country code
183              
184             =cut
185              
186             has country_code => (
187             is => 'lazy',
188             );
189             sub _build_country_code {
190 6     6   1137 my $self = shift;
191 6         93 return $MUPHONE_DATA->{territories}->{ $self->country }->{countryCode};
192             }
193              
194             =head2 national_dial
195              
196             How you would dial this number within the country (including national dial code)
197              
198             =cut
199              
200             has national_dial => (
201             is => 'lazy',
202             );
203             sub _build_national_dial {
204 4     4   32 my $self = shift;
205 4 100       44 my $dial_prefix = $self->_national_prefix_optional_when_formatting
206             ? ''
207             : $self->_national_dial_prefix;
208              
209 4         77 return $dial_prefix.$self->_cleaned_number.$self->_extension_dial;
210             }
211              
212             =head2 national_display
213              
214             Display this number in the national number format
215              
216             =cut
217              
218             # How do you display the number when you're in the country?
219             # this default should work for most countries
220             has national_display => (
221             is => 'ro',
222             lazy => 1,
223             default => sub {
224             my $self = shift;
225             my $dial_prefix = $self->_national_prefix_optional_when_formatting
226             ? ''
227             : $self->_national_dial_prefix;
228              
229             return $dial_prefix.$self->_formatted_number.$self->_extension_display;
230             }
231             );
232              
233             =head2 international_display
234              
235             Display this number in the international number format (E.123)
236              
237             =cut
238              
239             has international_display => (
240             is => 'ro',
241             lazy => 1,
242             default => sub {
243             my $self = shift;
244             return '+'.$self->country_code.' '.$self->_formatted_number.$self->_extension_display;
245             }
246             );
247              
248             =head2 e164
249              
250             The number in E.164 format (+$COUNTRY_CODE$NUMBER[;ext=$EXTENSION])
251              
252             =cut
253              
254             has e164 => (
255             is => 'lazy',
256             );
257             sub _build_e164 {
258 3     3   1745 my $self = shift;
259 3 100       15 my $ext = $self->extension
260             ? ";ext=".$self->extension
261             : '';
262 3         50 return $self->e164_no_ext.$ext;
263             }
264              
265             =head2 e164_no_ext
266              
267             The number in E.164 format, but with no extension (+$COUNTRY_CODE$NUMBER)
268              
269             =cut
270              
271             has e164_no_ext => (
272             is => 'lazy',
273             );
274             sub _build_e164_no_ext {
275 3     3   1761 my $self = shift;
276 3         46 return '+'.$self->country_code.$self->_cleaned_number;
277             }
278              
279             # number with international and national dial codes, and all non digits removed
280             has _cleaned_number => (
281             is => 'rw',
282             default => '',
283             );
284              
285             # basic validation of a number via this regex
286             has _national_number_regex => (
287             is => 'lazy',
288             );
289             sub _build__national_number_regex {
290 14     14   101 my $self = shift;
291 14         208 my $regex_string = $MUPHONE_DATA->{territories}->{ $self->country }->{generalDesc}->{nationalNumberPattern};
292 14         249 return qr/^$regex_string$/;
293             }
294              
295             # Display number without international or nation dial prefixes
296             # built by _process_raw_number
297             has _formatted_number => (
298             is => 'rw',
299             );
300              
301             # Boolean used to help determine how to display a number
302             # built in sub _process_raw_number
303             has _national_prefix_optional_when_formatting => (
304             is => 'rw',
305             );
306              
307             # add pause to extension to create dial
308             has _extension_dial => (
309             is => 'lazy',
310             );
311             sub _build__extension_dial {
312 4     4   30 my $self = shift;
313 4 100       38 return $self->extension
314             ? $DIAL_PAUSE.$self->extension
315             : '';
316             }
317              
318             # prefix you dial when dialing the _cleaned_number within the country
319             has _national_dial_prefix => (
320             is => 'lazy',
321             );
322             sub _build__national_dial_prefix {
323 8     8   2668 my $self = shift;
324 8         126 $MUPHONE_DATA->{territories}->{ $self->country }->{nationalPrefix};
325             }
326              
327             # how to display the extension text + number (currently only in English)
328             has _extension_display => (
329             is => 'lazy',
330             );
331             sub _build__extension_display {
332 10     10   1201 my $self = shift;
333 10 100       81 my $ext =
334             return $self->extension
335             ? ' '.$self->_extension_text.' '.$self->extension
336             : '';
337             }
338              
339             # text to display befor an extension
340             has _extension_text => (
341             is => 'ro',
342             default => 'ext',
343             );
344              
345             # helper method to get the country for a number, country, or object
346             sub _get_country_from {
347 15     15   22 my ($self,$str_or_obj) = @_;
348              
349             # $str_or_arg should be
350             # - Number::MuPhone instance
351             # - E.123 formatted number
352             # - 2 char country code
353              
354             # muphone num
355 15 100       67 if (ref $str_or_obj eq 'Number::MuPhone') {
    50          
    50          
356 8         184 return $str_or_obj->country;
357             }
358             # E.123
359             elsif ($str_or_obj =~ /^\s\+/) {
360 0         0 my $num = Number::MuPhone->new($str_or_obj);
361 0         0 return $num->country;
362             }
363             # it should be a country
364             elsif ( $str_or_obj =~ /^[A-Z]{2}$/ ) {
365 7         15 return $str_or_obj;
366             }
367             else {
368 0         0 die "Not a country, E.123 num, or MuPhone object: $str_or_obj";
369             }
370             }
371              
372             =head1 METHODS
373              
374             =head2 dial_from
375              
376             How to dial the number from the number/country sent in as an arg. eg
377              
378             my $uk_num1 = Number::MuPhone->new({ country => 'GB', number => '01929 552699' });
379             my $uk_num2 = Number::MuPhone->new({ country => 'GB', number => '01929 552698' });
380             my $us_num = Number::MuPhone->new({ country => 'US', number => '203 503 1234' });
381              
382             # these all have the same output (01929552699)
383             my $dial_from_uk = $uk_num1->dial_from($uk_num2);
384             my $dial_from_uk = $uk_num1->dial_from('GB');
385             my $dial_from_uk = $uk_num1->dial_from('+441929 552698');
386              
387             # similarly, dialling the number from the US (011441929552699)
388             my $dial_from_us = $uk_num1->dial_from($us_num);
389             my $dial_from_us = $uk_num1->dial_from('US');
390             my $dial_from_us = $uk_num1->dial_from('+1 203 503 1234');
391              
392             =cut
393              
394             sub dial_from {
395 7     7 1 2672 my ($self,$str_or_obj) = @_;
396 7   33     17 $str_or_obj||=$self;
397 7         13 my $from_country = $self->_get_country_from($str_or_obj);
398 7 100       146 if ( $from_country eq $self->country ) {
399 4         80 return $self->national_dial;
400             }
401             else {
402             return $MUPHONE_DATA->{territories}->{ $from_country }->{internationalPrefix}
403 3         65 .$self->country_code
404             .$self->_cleaned_number;
405             }
406             }
407              
408             =head2 display_from
409              
410             How to display the number for the number/country sent in as an arg. eg
411              
412             my $uk_num1 = Number::MuPhone->new({ country => 'GB', number => '01929 552699' });
413             my $uk_num2 = Number::MuPhone->new({ country => 'GB', number => '01929 552698' });
414             my $us_num = Number::MuPhone->new({ country => 'US', number => '203 503 1234' });
415              
416             # these all have the same output (01929 552699)
417             my $display_from_uk = $uk_num1->display_from($uk_num2);
418             my $display_from_uk = $uk_num1->display_from('GB');
419             my $display_from_uk = $uk_num1->display_from('+441929 552698');
420              
421             # similarly, dialling the number from the US (01144 1929 552699)
422             my $display_from_us = $uk_num1->display_from($us_num);
423             my $display_from_us = $uk_num1->display_from('US');
424             my $display_from_us = $uk_num1->display_from('+1 203 503 1234');
425              
426             =cut
427              
428             sub display_from {
429 8     8 1 2444 my ($self,$str_or_obj) = @_;
430 8   33     18 $str_or_obj||=$self;
431 8         19 my $from_country = $self->_get_country_from($str_or_obj);
432 8 100       167 if ( $from_country eq $self->country ) {
433 4         80 return $self->national_display;
434             }
435             else {
436             # (DIAL PREFIX) (COUNTRY CODE) (FORMATTED NUMBER) [ (EXTENSION) ]
437             return $MUPHONE_DATA->{territories}->{ $from_country }->{internationalPrefix}
438 4         85 .$self->country_code.' '
439             .$self->_formatted_number.$self->_extension_display;
440             }
441             }
442              
443              
444             # PRIVATE METHODS
445              
446             # splits off optional extension, and cleans both up for storage
447             # only place where we set error
448             sub _process_raw_number {
449 17     17   22 my $self = shift;
450              
451 17         116 my ($raw_num,$ext) = split $EXTENSION_REGEX, $self->number;
452 17   100     73 $ext||='';
453 17         25 $ext =~ s/\D//g;
454 17         40 $self->extension($ext);
455              
456             # if number begins with a '+' we can determine country from E.123 number
457 17 100       278 if ($raw_num =~ /^\s*\+/) {
    50          
458 4         10 $self->_process_from_e123($raw_num);
459             }
460             # if we have a country set, clean up raw number (ie, strip national dial code, if set)
461             elsif (my $country = $self->country) {
462 13         121 $raw_num =~ s/\D//g;
463 13         33 my $national_prefix = $MUPHONE_DATA->{territories}->{ $country }->{nationalPrefix};
464 13 50       28 if ( defined $national_prefix ) {
465 13         78 $raw_num =~ s/^$national_prefix//;
466             }
467 13         37 $self->_cleaned_number( $raw_num );
468             }
469              
470             # if no country set by the time we get here, we need to set error and bail
471 17         272 my $country = $self->country;
472 17 50       99 unless ( $country ) {
473 0         0 $self->error("Country not supplied, and I can't determine it from the number");
474 0         0 return;
475             }
476              
477             # Number must match the national number pattern, if exists
478 17         32 my $cleaned_num = $self->_cleaned_number;
479 17 50 33     75 if ( $MUPHONE_DATA->{territories}->{ $country }->{generalDesc}
480             && $MUPHONE_DATA->{territories}->{ $country }->{generalDesc}->{nationalNumberPattern} ) {
481              
482 17         169 my $regex = qr/^(?:$MUPHONE_DATA->{territories}->{ $country }->{generalDesc}->{nationalNumberPattern})$/;
483 17 100       117 unless ( $cleaned_num =~ $regex ) {
484 3         58 $self->error("Number ($cleaned_num) is not valid for country ($country)");
485 3         100 return;
486             }
487             }
488              
489             # confirm cleaned number is a valid number for the country
490 14 50       248 unless ( $self->_cleaned_number =~ $self->_national_number_regex ) {
491 0         0 $self->error("Number $raw_num is not valid for country ".$self->country);
492             }
493              
494             # don't create formatted number if we have an error
495 14 50       285 $self->error and return;
496              
497             # if no number formats, just set to the cleaned number
498 14         284 my $number_formats = $MUPHONE_DATA->{territories}->{ $self->country }->{availableFormats}->{numberFormat};
499              
500 14         79 my $num = $self->_cleaned_number;
501 14         16 my $national_prefix_optional=0;
502              
503             # iterate through the available formats until you get a match
504             # (if not set, we default to cleaned number
505 14         29 FORMAT: foreach my $format_hash (@$number_formats) {
506             # not all countries have leading digit mappings
507 49 50       100 if (my $leading_digits = $format_hash->{leadingDigits}) {
508 49 100       708 next FORMAT unless ( $num =~ /^(?:$leading_digits)/ );
509             }
510              
511 14         203 my $pattern = qr/^$format_hash->{pattern}$/;
512 14 50       91 next FORMAT unless ( $num =~ $pattern );
513              
514 14         22 my $format = $format_hash->{format};
515              
516 14         36 my $regex_statement = "\$num =~ s/$pattern/$format/;";
517             ## no critic
518 14         1198 eval $regex_statement;
519             ## use critic
520 14 50       59 if ($@) {
521 0         0 $self->error("Can't format number($num) with regex($regex_statement): $@");
522 0         0 last FORMAT;
523             }
524              
525             $national_prefix_optional = $format_hash->{nationalPrefixOptionalWhenFormatting}
526 14 100       36 ? 1 : 0;
527 14         38 last FORMAT;
528             }
529              
530 14         61 $self->_formatted_number($num);
531 14         92 $self->_national_prefix_optional_when_formatting($national_prefix_optional);
532              
533             }
534              
535             # number starts with a + ? Great, we should be able to work it out.
536             sub _process_from_e123 {
537 4     4   7 my ($self,$num) = @_;
538              
539 4         20 $num =~ s/\D//g;
540              
541 4         9 my $countries = [];
542              
543             # grab from country lookup - country code is 1-3 digits long
544 4         8 my @prefixes = map { substr($num, 0, $_) } 1..3;
  12         27  
545 4         8 PREFIX: foreach my $idd (@prefixes) {
546             # we found a match
547 6 100       18 if ($countries = $MUPHONE_DATA->{idd_codes}->{$idd}) {
548             # so strip off the IDD from the number
549 4         54 $num =~ s/^$idd//;
550 4         13 last PREFIX;
551             }
552             }
553              
554             # now find out which country the number matches
555             # (for IDD codes with multiple countries, this may not be correct, but should be
556             # good enough for this use case - just don't rely on the country
557             # TODO - maybe iterate through all regexes by number type to confirm validity?
558             # generalDesc regex is too loose for (eg) US/CA
559             # to implement this, we'd need to keep the various number type regexes around
560             # Suggest look at adding in next update
561 4         4 my $country;
562 4         7 COUNTRY: foreach my $country (@$countries) {
563             my $national_number_format_regex = $MUPHONE_DATA->{territories}->{$country}->{generalDesc} && $MUPHONE_DATA->{territories}->{$country}->{generalDesc}->{nationalNumberPattern}
564 58 50 33     1184 ? qr/^$MUPHONE_DATA->{territories}->{$country}->{generalDesc}->{nationalNumberPattern}$/
565             : '';
566 58 50       165 $national_number_format_regex
567             or next COUNTRY;
568              
569 58 100       287 $num =~ $national_number_format_regex
570             or next COUNTRY;
571              
572 6         145 $self->country($country);
573 6         203 $self->_cleaned_number($num);
574             }
575              
576             }
577              
578             =head1 A WARNING ABOUT INFERRED COUNTRIES
579              
580             If you instantiate an object with an E.123 formatted number, the inferred country will be
581             the 'main' country for that number. This is because Number::MuPhone is currently using the
582             loosest regex available to validate a number for a country (this may change soon). This
583             affects these country codes:
584              
585             Code Main Country
586             ==== ============
587             1 US
588             44 GB
589             212 EH
590             61 CC
591             590 MF
592             7 KZ
593             599 BQ
594             47 SJ
595             262 YT
596              
597             As far as functionality is concerned, you should see no difference, unless you want to use
598             the country() attribute. To avoid this, instantiate with both number and country.
599              
600             =head1 KEEPING UP TO DATE WITH CHANGES IN THE SOURCE XML FILE
601              
602             The data used to validate and format the phone numbers comes from Google's libphonenumber:
603              
604             L
605              
606             This distribution should come with a reasonably recent copy of the libphonenumber source XML,
607             but you can also set up a cron to update your source data weekly, to ensure you don't have
608             problems with new area codes as they get added (this happens probably more often than you think).
609              
610             By default, C's update script (perl-muphone-build-data) stores this data in the
611             ~/.muphone directory, but you can overload this by setting the C environment
612             variable. Wherever you choose, it must be writeable by the user, and remember to expose the same
613             C var to any scripts using C (if needed).
614              
615             When run, the following files are created in the C<~/.muphone> or C<$ENV{MUPHONE_BASE_DIR}> dirs as appropriate
616              
617             ./etc/PhoneNumberMetadata.xml # the libphonenumber source XML file
618             ./lib/NumberMuPhoneData.pm # the generated Number::MuPhone::Data
619             ./t/check_data_module.t # a little sanity script that runs after creating the data file
620              
621             Currently, the extractor script only grabs the data we need, and removes spacing, to keep the size down.
622              
623             If you want to examine all available data, set C<$DEBUG=1> (add in padding, switch commas to =>) and set
624             C<$STRIP_SUPERFLUOUS_DATA=0> in the script and run it again. then look at the generated C
625              
626             =head2 Initial run
627              
628             Optionally, set the C environment variable to point to your config directory (must be writeable).
629             Otherwise, C<~/.muphone> will get used (default).
630              
631             As the appropriate user, run:
632              
633             perl-muphone-build-data
634              
635             Confirm the tests pass and the files are created (if no error output, tests passed, and all should be good).
636              
637             =head2 Set up the cron to run weekly to update the data
638              
639             # using default data dir (~/.muphone)
640             0 5 * * 1 /usr/local/bin/perl-muphone-build-data
641              
642             # using user specific data dir
643             0 5 * * 1 MUPHONE_BASE_DIR=/path/to/config /usr/local/bin/perl-muphone-build-data
644              
645             =head2 Dockerfile config
646              
647             Similarly, add the C script to your Dockerfile, as appropriate. If you're using
648             Kubernetes, this might be enough, but for longer running Docker instances, you might want to
649             consider setting up the cronjob within the image too.
650              
651             If anyone has best practice recommendations for this, let me know and I'll update the POD :D
652              
653             =cut
654              
655              
656             1;