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