tools/claws.get.tlds.pl

   1 #!/usr/bin/perl -w
   2 =pod
   3 =head1
   4
   5 claws.get.tlds.pl - IANA TLDs online list to stdout as gchar* array.
   6
   7 Copyright (c) 2015 Ricardo Mones <ricardo@mones.org>
   8
   9 This program is free software: you can redistribute it and/or modify it
  10 under the terms of the GNU General Public License as published by the
  11 Free Software Foundation, either version 3 of the License, or (at your
  12 option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License along
  20 with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 =cut
  23 use 5.012;
  24 use utf8;
  25 use LWP::Simple;
  26 use constant {
  27   URL => "https://data.iana.org/TLD/tlds-alpha-by-domain.txt"
  28 };
  29
  30 print "/*\n * This is a generated file.\n * See tools/claws.get.tlds.pl\n */\n";
  31 print "#ifndef __TLDS_H__\n#define __TLDS_H__\n\n";
  32 print "static const gchar *toplvl_domains [] = {\n\t"; # open array
  33
  34 my $payload = get URL;
  35 my @lines = split /^/, $payload;
  36 my ($i, $j) = (0, 0);
  37
  38 foreach (@lines) {
  39   ++$i;
  40   chomp;
  41   if (/^#(.*)$/) { # comments
  42     my $c = $1; $c =~ s/^\s+|\s+$//g;
  43     print "/* $c */\n\t";
  44     next;
  45   }
  46   next if (/^XN--.*$/); # IDNs not supported yet, see bug #1670
  47   my $tld = lc $_; # list comes in upper case
  48   print "\"$tld\""; ++$j;
  49   print "," unless $i >= scalar @lines;
  50   print "" . ($j % 5 == 0 or $i >= scalar @lines)? "\n": " ";
  51   print "\t" if ($j % 5 == 0 and $i < scalar @lines);
  52 }
  53
  54 print "};\n\n"; # close array
  55 print "#endif\n";