tools/mkcountries-geonames

   1 #!/usr/bin/env perl
   2 use 5.012;
   3 use warnings;
   4
   5 my %cc;  # map of country code to info array
   6 %cc = (
   7         # exceptional reservations
   8         ac => ["Ascension Island", "c-oc Xr", undef, 'sh'],
   9         cp => ["Clipperton Island", "c-na Xr"],
  10         dg => ["Diego Garcia", "c-as Xr", undef, 'io'],
  11         ea => ["Ceuta and Melilla", "c-af Xr"],
  12         eu => ["European Union", "c-eu Xr"],
  13         fx => ["Metropolitan France", "c-eu Xr", undef, 'fr'],
  14         ic => ["Canary Islands", "c-af Xr"],
  15         su => ["former USSR", "c-eu Xr"],
  16         ta => ["Tristan da Cunha", "c-oc Xr", undef, 'sh'],
  17         uk => ["(United Kingdom)", "c-eu Xr", undef, 'gb'],
  18
  19         # indeterminate reservations
  20         dy => ["(Benin)", "c-af Xr", undef, 'bj'],
  21         ew => ["(Estonia)", "c-eu Xr", undef, 'ee'],
  22         fl => ["(Liechtenstein)", "c-eu Xr", undef, 'li'],
  23         ja => ["(Jamaica)", "c-na Xr", undef, 'jm'],
  24         lf => ["Libya Fezzan", "c-af Xr", "Fezzan", 'ly'],
  25         pi => ["(Philippines)", "c-as Xr", undef, 'ph'],
  26         ra => ["(Argentina)", "c-sa Xr", undef, 'ar'],
  27         rb => ["Bolivia/Botswana", "c-xx Xr"],
  28         rc => ["(RoC)", "c-as Xr", undef, 'tw'],
  29         rh => ["(Haiti)", "c-na Xr",undef, 'ht'],
  30         ri => ["(Indonesia)", "c-as Xr", undef, 'id'],
  31         rl => ["(Lebanon)", "c-as Xr", undef, 'lb'],
  32         rm => ["(Madagascar)", "c-af Xr", undef, 'mg'],
  33         rn => ["(Niger)", "c-af Xr",undef, 'ne'],
  34         rp => ["(Philippines)", "c-as Xr", undef, 'ph'],
  35         wg => ["(Grenada)", "c-na Xr", undef, 'gd'],
  36         wl => ["(Saint Lucia)", "c-na Xr", "(Saint Luc.)", 'lc'],
  37         wv => ["(Saint Vincent)", "c-na Xr", "(Saint Vin.)", 'vc'],
  38         yv => ["(Venezuela)", "c-sa Xr", undef, 've'],
  39
  40         # WIPO, agreed not to use
  41         ap => ["African Regional Industrial Property Organization", "Xi", "ARIPO"], # c-af
  42         bx => ["Benelux Office for Intellectual Property", "Xi", "BOIP"], # c-eu
  43         ef => ["European Community Patent Convention", "Xi", "CPC"], # c-eu
  44         em => ["European Trademark Office", "Xi", "OHIM"], # c-eu
  45         ep => ["European Patent Organization", "Xi", "EPOrg"], # c-eu
  46         ev => ["Eurasian Patent Organization", "Xi", "EAPO"], # c-as
  47         gc => ["Gulf Patent Office", "Xi", "GCCPO"], # c-as
  48         ib => ["International Bureau of WIPO", "Xi", "IB WIPO"],
  49         oa => ["African Intellectual Property Organization", "Xi", "OAPI"], # c-af
  50         wo => ["World Intellectual Property Organization", "Xi", "WIPO"],
  51 );
  52
  53 while (<>) {
  54         /^#/ and next;  # skip comments
  55         my ($iso, $name, $cont, $tld) = (split /\t/)[0, 4, 8, 9];
  56         my @info = ($name, "c-\L$cont");
  57         $info[3] = $tld if $tld =~ s/\A\.// and $tld ne lc $iso;
  58         $cc{ lc $iso } = \@info;
  59 }
  60
  61 $cc{io}->[2] = "Chagos Islands";
  62 $cc{um}->[2] = "U.S. isl.";
  63
  64 for (values %cc) {
  65         for ($_->[2] //= $_->[0]) {
  66                 s/,.*//;
  67                 s/(?<=.)\(.*\)\s*//;
  68                 s/ republic\b//gi;
  69                 s/ islands?\b//gi;
  70                 s/\bthe //g;
  71                 s/ and / & /g and s/(?<=.)[a-z ]+//g;
  72                 s/ of / /g;
  73                 s/\bsa?int /st /gi;
  74                 s/United /Un. /gi;
  75                 s/South(?:ern)? /S-/g;
  76                 s/North(?:ern)? /N-/g;
  77                 s/New /n./g;
  78                 s/(\S)(\S+)-/$1-/g;  # strip most chars preceding dash
  79                 s/(\S{4}[b-df-hj-np-tv-xz])((?<!Austr)(?!land)\w{2,})/$1./g;  # abbreviate (at consonant)
  80         }
  81 }
  82
  83 say "# automatically generated by $0";
  84 use Data::Dump 'dd';
  85 $Data::Dump::INDENT = '';
  86 dd \%cc;
  87
  88 __END__
  89
  90 =head1 NAME
  91
  92 mkcountries-geonames - Create Perl include of country info from GeoNames data
  93
  94 =head1 SYNOPSIS
  95
  96         curl http://download.geonames.org/export/dump/countryInfo.txt |
  97         tools/mkcountryinfo > countries.inc.pl
  98