package CountryCodes; use strict; use Exporter; use base qw(Exporter); use vars qw( @EXPORT @EXPORT_OK ); @EXPORT = qw( is_country_code pull_country_code ); @EXPORT_OK = qw( initialize_from_net ); use Carp; ### Initialization my @Icodes = qw( 1 20 212 213 216 218 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 260 261 262 263 264 265 266 267 268 269 27 290 291 297 298 299 30 31 32 33 34 350 351 352 353 354 355 356 357 358 359 36 370 371 372 373 374 375 376 377 378 380 381 385 386 387 389 39 40 41 420 421 423 43 44 45 46 47 48 49 500 501 502 503 504 505 506 507 508 509 51 52 53 54 55 56 57 58 590 591 592 593 594 595 596 597 598 599 60 61 62 63 64 65 66 670 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 7 808 81 82 84 850 852 853 855 856 86 870 871 872 873 874 878 880 881 886 90 91 92 93 94 95 960 961 962 963 964 965 966 967 968 970 971 972 973 974 975 976 977 98 992 993 994 995 996 998 ); my $Fresh_Codes_url = 'http://kropla.com/dialcode.htm'; my(%Icodes, %Icodes_by_length, %Icodes_huff); initialize(); sub initialize { # Set up data structures -- handy when we want to update with # fresh codes off the Net. if (@_) { @Icodes = @_; } %Icodes = %Icodes_by_length = %Icodes_huff = (); grep(++$Icodes{$_}, @Icodes); foreach my $code (@Icodes) { my $l = length $code; $Icodes_by_length{$l} ||= []; push(@{$Icodes_by_length{$l}}, $code); } foreach my $l (keys %Icodes_by_length) { @{$Icodes_by_length{$l}} = sort @{$Icodes_by_length{$l}}; } foreach my $code (@Icodes) { my @digits = split(//, $code); my $str = join('}{', @digits); eval "++\$Icodes_huff{$str}"; } } ### Accessors sub is_country_code { my $code = shift; return unless $code; $Icodes{$code}; } sub country_codes_of_length { my $l = shift; return unless $Icodes_by_length{$l}; @{$Icodes_by_length{$l}}; } sub random_country_code_of_length { my $l = shift; return unless $Icodes_by_length{$l}; $Icodes_by_length{$l}[rand(scalar @{$Icodes_by_length{$l}})]; } sub pull_country_code { # Given a string of digits, pull a matching country code # from the beginning and return the resulting code and # remaining digits. my $number = shift; return unless $number; croak "Non numeric data\n" unless $number =~ /^\d+$/; my @digits = reverse split(//,$number); my @pulled; my $ptr = \%Icodes_huff; while (@digits) { $_ = pop @digits; last unless $ptr->{$_}; push(@pulled, $_); $ptr = $ptr->{$_}; last unless ref $ptr; } my $cc = join('', @pulled); my $left = join('', reverse @digits); return $number unless $left =~ /\d/; return($left, $cc); } ### Get new country codes from the Net sub initialize_from_net { # earlier versions of TE will not work for this site require LWP::Simple; eval "use HTML::TableExtract 1.08"; die "Oops: $@\n" if $@; my $html = LWP::Simple::get($Fresh_Codes_url); my $te = HTML::TableExtract->new ( headers => ['Country\s+Code', 'Country\s+Name'], br_translate => 1, ); $te->parse($html); my(@ccodes, %seen); foreach my $row ($te->rows) { my($cruft, $country) = @$row; my($code) = $cruft =~ /^\s*(\d+)/; next unless defined $code; next if length $code > 3; next if $seen{$code}; push(@ccodes, $code); ++$seen{$code}; } initialize(sort @ccodes); } 1;