#!/usr/bin/env perl
use 5.016;
use warnings;
use Cwd qw(realpath);
use File::Spec::Functions qw(catfile splitpath updir);
use Unicode::UCD qw(prop_aliases);
my (%MA, %WS);
# TODO: fetch the data files on-demand and don't store them.
# http://www.unicode.org/Public/security/latest/confusables.txt
# http://www.unicode.org/Public/security/latest/confusablesWholeScript.txt
parse_confusable_file();
parse_ws_confusable_file();
write_file();
exit;
sub parse_confusable_file {
    my $file = catfile(
        (splitpath(realpath __FILE__))[0, 1], updir,
        qw(data confusables.txt)
    );
    open my $fh, '<', $file or die "$file: $!";
    while (<$fh>) {
        my ($source, $target) = /^([0-9A-F]+) ;\t((?:[0-9A-F]+ )+);\tMA\t/;
        next unless defined $source and defined $target;
        $target =~ s{([0-9A-F]+) }{ '\x{' . $1 . '}' }eg;
        $MA{ '\x{' . $source . '}' } = $target;
    }
    close $fh;
    die "$file: no confusables found" unless %MA;
}
sub parse_ws_confusable_file {
    my $file = catfile(
        (splitpath(realpath __FILE__))[0, 1], updir,
        qw(data confusablesWholeScript.txt)
    );
    open my $fh, '<', $file or die "$file: $!";
    while (<$fh>) {
        my ($lo, $hi, $source, $target) = m{
            ^ ([0-9A-F]+) (?:\.\. ([0-9A-F]+) )? \ +;\ (\w+);\ (\w+);\ A\ \#
        }x;
        next unless defined $source;
        for ($source, $target) {
            my @alias = prop_aliases($_) or die "unknown script: $_" ;
            $_ = $alias[1];
        }
        $hi //= $lo;
        $WS{$source}{$target}{sprintf "%04X", $_} = \1
            for hex $lo .. hex $hi;
    }
    close $fh;
    die "$file: no confusables found" unless %WS;
}
sub write_file {
    my $file = catfile(
        (splitpath(realpath __FILE__))[0, 1], updir,
        qw(lib Unicode Security Confusables.pm)
    );
    open my $fh, '>', $file or die "$file: $!";
    (my $header =<< "    __HEADER__") =~ s/^ +//gm;
        use strict;
        use warnings;
        =pod This data is auto-generated by scripts/generate-map.pl
        =cut
        %Unicode::Security::MA = (
    __HEADER__
    print $fh $header;
    for my $source (sort keys %MA) {
        printf $fh qq(    "%s" => "%s",\n), $source, $MA{$source};
    }
    print $fh ");\n";
    # TODO: compress the lists by converting to character ranges.
    print $fh qq<\n\%Unicode::Security::WS = (\n>;
    for my $source (sort keys %WS) {
        print $fh qq(    '$source' => {\n);
        for my $target (sort keys %{$WS{$source}}) {
            my @c = map { qq("\\x{$_}") } keys %{$WS{$source}{$target}};
            printf $fh qq(        '%s' => { %s },\n), $target,
                1 == @c
                    ? "$c[0] => \\1"
                    : 'map { $_ => \1 } ' . join(', ', @c);
        }
        print $fh qq(    },\n);
    }
    print $fh ");\n\n1;";
    close $fh;
}