Locale-Codes

 view release on metacpan or  search on metacpan

internal/harvest_data  view on Meta::CPAN

%ID2Code  = ();
%Std      = ();

do_country()    if ($do_all  ||  $do_country);
do_language()   if ($do_all  ||  $do_language);
do_currency()   if ($do_all  ||  $do_currency);
do_script()     if ($do_all  ||  $do_script);
do_langext()    if ($do_all  ||  $do_langext);
do_langvar()    if ($do_all  ||  $do_langvar);
do_langfam()    if ($do_all  ||  $do_langfam);

############################################################################
# DO_COUNTRY
############################################################################

sub do_country {
   print "Country codes...\n";
   $Module   = "Country";

   _do_codeset('country','iso',  ['alpha-2','alpha-3','numeric'],
                                 ['alpha-2','alpha-3','numeric']);
   _do_codeset('country','iana', ['dom'],
                                 ['dom']);
   _do_codeset('country','un',   ['un-numeric','un-alpha-3'],
                                 ['un-numeric','un-alpha-3']);
   _do_codeset('country','genc', ['genc-alpha-2','genc-alpha-3','genc-numeric'],
                                 ['genc-alpha-2','genc-alpha-3','genc-numeric']);

   do_aliases("country");
   write_module("country");
}

########################################

#
# GENC
#
# Ignore entries that have no 2-char code.
#

{
   my $in;

   sub _init_country_genc {
      my $inst = qq{
*NOTE* The GENC codes are tricky to download for some reason.  Currently, they
are GENC 3.0 Update 11.  This is available in internal/genc-3.0.11

(Please download the data manually for GENC country codes.  This can be done
using the Chrome browser with the Table Capture (georgemike) extension enabled.

Go to the following URL:
   $country_genc_url
Click on:
   'Browse'
   'Show 100 entries'

Select any part of the table (it is not necessary to select the entire table).
Then right click and launch the table caputure workshop.  Click on the
'Edit table data before exporting' icon.  Click on the 'Delete header row'
button.  Then click on the 'Copy table to clipboard' icon and paste it into
the file.

Select any part of the table (it is not necessary to select the entire
table).  Then right click and launch the table caputure workshop.
Click on the 'Copy table to clipboard' icon and paste it into the
file.  Remove the headers (which contain '2-Char Code'), one per set of
rows copied.

*NOTE* This currently is required:
If there are more entries than will fit on a single table, repeat this
process but make sure you remove extra header lines (but do not remove the
initial header line).
};

      $in = _read_file('type'      => 'csv',
                       'manual'    => 1,
                       'inst'      => $inst,
                       'sep_char'  => "\t",
                       'as_list'   => 1,
                       'encoding'  => 'UTF-8',
                      );
      1;
   }

   sub _read_country_genc {
      while (@$in) {
         my $ele     = shift(@$in);
         my $alpha2  = $$ele{'2-Char Code'};
         next  if (! $alpha2);
         next  if ($alpha2 eq '[None]');
         my $alpha3  = $$ele{'3-Char Code'};
         my $num     = $$ele{'Numeric Code'};
         my $country = $$ele{'Name'};
         next  if ($country =~ /^entity/i);

         my($id,$i);

         if (exists $Code2ID{'alpha-2'}{lc($alpha2)}) {
            ($id,$i) = @{ $Code2ID{'alpha-2'}{lc($alpha2)} };
         }

         if (exists $Code2ID{'alpha-3'}{lc($alpha3)}) {
            if (! defined($id)) {
               print "WARNING [genc]: Code mismatch (alpha-3 defined, alpha-2 not): $country\n";
               next;
            }
            my($id2,$i2) = @{ $Code2ID{'alpha-3'}{lc($alpha3)} };
            if ($id ne $id2) {
               print "WARNING [genc]: Code mismatch (alpha-3 != alpha-2): $country\n";
               next;
            }
         }

         if (exists $Code2ID{'numeric'}{$num}) {
            if (! defined($id)) {
               print "WARNING [genc]: Code mismatch (numeric defined, alpha-2 not): $country\n";
               next;
            }
            my($id2,$i2) = @{ $Code2ID{'numeric'}{$num} };
            if ($id ne $id2) {
               print "WARNING [genc]: Code mismatch (numeric != alpha-2): $country\n";
               next;
            }
         }

internal/harvest_data  view on Meta::CPAN

            if (! defined($id)) {
               ($id,$i) = ($id2,$i2);
            } elsif ($id ne $id2) {
               print "WARNING [un]: UN/ISO code mismatch: $country\n";
               next;
            }

            my @name    = @{ $ID2Names{$id} };
            @country    = ($name[$i]);

         } elsif (defined($id)) {
            my @name    = @{ $ID2Names{$id} };
            @country    = (_country_name($country),
                           @name);
         } else {
            @country    = _country_name($country);
         }

         return ($num,$alpha,@country);
      }
   }
}

########################################

#
# ISO 3166-1
#
# The standard contains the alpha-2, alpha-3, and numeric codes.  This
# is the official source of these codes.
#
# File format:
# =================
#    Country name
#    Country french name
#    alpha-2
#    alpha-3
#    numeric
# =================
#

{
   my $in;

   sub _init_country_iso {
      my $inst = qq{
(Please download the data manually for ISO 3166 country codes.

Currently, this works in chrome with the Table Capture (georgemike)
extension enabled.

Go to the following URL:
   $country_iso_url
Click on:
   'Online Browsing Platform'
   'Officially assigned codes'
   300 results per page

Select any part of the table (it is not necessary to select the entire
table).  Then right click and launch the table caputure workshop.
Click on the 'Copy table to clipboard' icon and paste it into the
file.

If there are more entries than will fit on a single table, repeat this
process but make sure you remove extra header lines.
};

      $in = _read_file('type'        => 'csv',
                       'manual'      => 1,
                       'inst'        => $inst,
                       'sep_char'    => "\t",
                       'decode_utf8' => 0,
                       'as_list'     => 1,
                       'encoding'    => 'UTF-8',
                      );
      1;
   }

   sub _read_country_iso {
      while (@$in) {
         my $ele    = shift(@$in);
         my $name   = $$ele{'English short name'};
         my $alpha2 = lc($$ele{'Alpha-2 code'});
         my $alpha3 = lc($$ele{'Alpha-3 code'});
         my $num    = $$ele{'Numeric'};
         $name      =~ s/\(the/\(The/;
         return($alpha2,$alpha3,$num,_country_name($name));
      }
      return ();
   }
}

# This takes some common country name formats and produces common aliases.
#
sub _country_name {
   my($name) = @_;
   my @ret;

   if ($name =~ /^(.+), The (.+?) of$/     ||
       $name =~ /^(.+) \(The (.+?) of\)$/) {

      # NAME1, The NAME2 of
      # NAME1 (The NAME2 of) =>
      #   The NAME2 of NAME1
      #   NAME2 of NAME1

      my($n1,$n2) = ($1,$2);
      push(@ret,"$n1, The $n2 of",
                "$n1 (The $n2 of)",
                "$n1, $n2 of",
                "$n1 ($n2 of)",
                "The $n2 of $n1",
                "$n2 of $n1");

   } elsif ($name =~ /^(.+), (.+?) of$/  |\
            $name =~ /^(.+), \((.+?) of\)$/) {

      # NAME1, NAME2 of
      # NAME1, (NAME2 of) =>
      #   NAME2 of NAME1



( run in 1.735 second using v1.01-cache-2.11-cpan-84e82930d8c )