#!perl

# Usage - $0 <remap file>
#  e.g. - indic indic.txt
# The input file should be a subset of the Unicode data file containing
# the blocks of interest.
#
# The remap file should have lines of the form
# "\u0D01>\u0D02;"
# including the quotes.  These will be interpreted as saying that the
# undefined code point U+D01 (derived via mapping from InterIndic)
# can be remapped to U+D02.
# 
# The purpose of this script is to process the Indic script data into
# a form usable by the IndicTransliterator, that is, the Indic-Indic
# transliterator.  The transliterator needs two things: A mapping of
# the code points in common, and a list of the exceptions.

# Assume we are located in icu4j/src/com/ibm/tools/translit/.
# We want the Unicode DB in icu4j/src/data/unicode/.
$UNICODE_DB = "../../../../data/unicode/UnicodeData.txt";
$EXCEPTIONS_FILE = shift;

# Assume we are located in icu4j/src/com/ibm/tools/translit/.
# We want to output files to icu4j/src/com/ibm/text/resources/.
# Output directory
$OUTDIR = "../../text/resources";

# The template file should contain java code that can be used
# to generate RuleBasedTransliterator resource files.  The template
# should contain the following embedded symbols, which this script
# will replace:
# $TOOL - name of generating tool
# $DATE - date of generation
# $SCRIPTFROM - name of source script
# $SCRIPTTO - name of target script
# $RULES - rules
$RBT_TEMPLATE = 'rbtTemplate.txt';

# Name of this tool in generated RBT files
$RBT_GEN_TOOL = 'icu4j/src/com/ibm/tools/translit/indic.pl';

$DUMP = 0; # If 1, dump out internal data

$DO_HEURISTIC_REMAP = 0; # If 1, do automatic heuristic remapping
$DO_DECOMP_REMAP = 0; # If 1, do decomp remapping

open(UNICODE_DB);
while (<UNICODE_DB>) {
    next if (m|^0[0-8]|); # Skip up to Devanagari block (0900)
    last if (m|^0D[8-F]|i); # Bail out after Malayam block (0D00)
    # 0D39;MALAYALAM LETTER HA;Lo;0;L;;;;;N;;;;;
    my @data = split(/;/);
    my $fullCode = hex($data[0]); # e.g., 0x093F
    my $code = $fullCode & 0x7F; # e.g., 0x3F
    my ($script, $name) = ($data[1] =~ /(\w+)\s+(.+)/);
    die "Can't parse $_" unless ($name);
    # e.g., $code/$script/$name = 3F/MALAYALAM/VOWEL SIGN I

    # Titlecase the script
    $script = ucfirst(lc($script));

    # Fix a couple inconsistencies in the 3.0 data
    # REVISIT: Is this okay to do?
    if ($DO_HEURISTIC_REMAP) {
        if ($script eq 'Gujarati' && $code >= 5 && $code <= 0x14) {
            $name =~ s/^VOWEL/LETTER/;
        }
    }

    # Keep track of all script names we encounter.  We also note the
    # base of the block.
    my $base = $fullCode & ~0x7F; # e.g., 0x900;
    if (exists $SCRIPT_TO_BASE{$script}) {
        die "Script base mismatch for $script: $base vs. $SCRIPT_TO_BASE{$script}"
            if ($SCRIPT_TO_BASE{$script} ne $base);
    } else {
        $SCRIPT_TO_BASE{$script} = $base;
    }

    # Build up a mapping by name.  For each name, keep a hash keyed by
    # code point.  For each code point, keep an array of script names.
    # Also keep a total use count for each name.
    push @{$NAME_CODE_TO_SCRIPTS{$name}{$code}}, $script;
    ++$NAME_CODE_TO_SCRIPTS{$name}{count};

    # Build a map that looks like this:
    # $SCRIPT_NAME_TO_CODE{<script>}{<name>} = <code>
    # or undef if there is no mapping.
    $SCRIPT_NAME_TO_CODE{$script}{$name} = $code;

    # Build a map that looks like this:
    $SCRIPT_CODE_TO_NAME{$script}{$code} = $name;

    # And a map from the fullCode point to the name
    $FULLCODE_TO_NAME{$fullCode} = $name;

    # Map code (0..7F) to name.  This is usually a 1-1 mapping, but
    # is 1-n in a few cases.
    if (exists $CODE_TO_NAME{$code}) {
        if ($name ne $CODE_TO_NAME{$code}) {
            # For multiple names on a code offset, use the format
            # (a/b), (a/b/c), etc.
            local $_ = $CODE_TO_NAME{$code};
            if (m|^\(|) {
                if (!m|[\(\)/]$name[\(\)/]|) {
                    s|\)$|/$name\)|;
                }
            } else {
                $_ = "($_/$name)";
            }
            $CODE_TO_NAME{$code} = $_;
        }
    } else {
        $CODE_TO_NAME{$code} = $name;
    }
}
close(UNICODE_DB);

# Read and parse the manual remapping file.  This contains lines
# of the form:

# |"\u0956>\u0948;"  // AI Length Mark -> Devanagari Vowel Sign AI 

# The left hand side contains a non-existent full code value.  It
# should be a single value.  The right hand side contains one or more
# real full code values.  The idea is that when a mapping from another
# script ends up at the non-existent code point on the left, the
# sequence on the right should be substituted.  In this example,
# Devanagari has no AI Length Mark.  So, if transliterating from
# Oriya, then the character 0B56 (Oriya AI Length Mark) will remap to
# the non-existent 0956, and that remaps to 0948, our chosen
# Devanagari equivalent.  For our purposes, the left hand side should
# be taken to mean its equivalent point in the InterIndic range.  In
# this example, what it really says is E056>0948 in the
# InterIndic-Devanagari transliterator.

if ($EXCEPTIONS_FILE) {
    open(EXCEPTIONS_FILE) or die;
    while (<EXCEPTIONS_FILE>) {
        if (m|^\s*\"([^\"]*?)\"|) {
            my $line = $_;
            $_ = $1;
            if (/^(.*)>(.*);$/) {
                my ($rawFrom, $rawTo) = ($1, $2);
                my @from = parseUnicodeEscape($rawFrom);
                my @to = parseUnicodeEscape($rawTo);
                my $from = hexArray(@from);
                # Some entries look like this:
                # |"\u0955>\u0955;"
                # these do nothing; ignore them.
                if (intArraysEqual(\@from, \@to)) {
                    #print STDERR "Ignoring NOOP remap of $from\n";
                } elsif (exists $EXCEPTIONS{$from}) {
                    print STDERR "ERROR in $EXCEPTIONS_FILE - Duplicate remap entries for $from\n";
                } elsif (scalar @from > 1) {
                    print STDERR "ERROR in $EXCEPTIONS_FILE - Ignoring multichar remap: ", hexArray(@from), "->", hexArray(@to), "\n";                    
                } else {
                    # Check this for validity.  Full code on the left
                    # should NOT exist.  Full code seq on the right should.
                    if (exists $FULLCODE_TO_NAME{$from[0]}) {
                        print STDERR "ERROR in $EXCEPTIONS_FILE - Invalid remap; left side defined: ", hexArray(@from), "->", hexArray(@to), "\n";
                    } elsif (grep(! exists $FULLCODE_TO_NAME{$_}, @to)) {
                        print STDERR "ERROR in $EXCEPTIONS_FILE - Invalid remap; right side undefined: ", hexArray(@from), "->", hexArray(@to), "\n";
                    } else {
                        $EXCEPTIONS{$from[0]} = \@to;
                    }
                }
            } else { die "ERROR in $EXCEPTIONS_FILE - Can't parse \"$_\" in line $line"; }
        }
    }
    close(EXCEPTIONS_FILE);
    print STDERR "$EXCEPTIONS_FILE: Loaded ", scalar keys %EXCEPTIONS, " remappings\n";
}

if ($DO_DECOMP_REMAP) {
    # Read the NamesList.txt file.  This contains decomposition data.
    # Gather these into %DECOMP, which maps a name to n1.n2..., where n1
    # etc. are decomposed names.  E.g. $DECOMP{'LETTER RRA'} -> 'LETTER
    # RA.SIGN NUKTA'.  There may be different mappings in different script
    # blocks (LETTER RRA is mapped differently in Devanagari and Bengali),
    # in which case the name goes into %DECOMP_MISMATCH, and is removed
    # from %DECOMP.
    $NAMES = "NamesList.txt";
    open(NAMES);
    while (<NAMES>) {
        # Skip to start of DEVANAGARI block
        last if (/^\@\@\s+0900/);
    }
    while (<NAMES>) {
        # Continue until start of SINHALA block
        last if (/^\@\@\s+0D80/);
        if (/^([0-9A-Z]{4})/i) {
            $code = $1;
        } elsif (/^\s+:\s*(.+)/) {
            # We've found a mapping of the form:
            # 0929    DEVANAGARI LETTER NNNA
            #     * for transcribing Dravidian alveolar n
            #     : 0928 093C
            my $from = $FULLCODE_TO_NAME{hex($code)};
            my @to = map($FULLCODE_TO_NAME{hex($_)}, split(/\s+/, $1));
            if (exists $DECOMP{$from}) {
                my $aref = $DECOMP{$from};
                if (join(".", @$aref) ne join(".", @to)) {
                    print STDERR "ERROR: Decomp mismatch for $from\n";
                    print STDERR "     : $from = ", join(".", @$aref), "\n";
                    print STDERR "     : $from = ", join(".", @to), "\n";
                    $DECOMP_MISMATCH{$from} = 1;
                }
            } else {
                $DECOMP{$from} = \@to;
            }
        }
    }
    close(NAMES);
    # Remove mismatches
    foreach (keys %DECOMP_MISMATCH) {
        delete $DECOMP{$_};
    }
    if ($DUMP) {
        foreach (keys %DECOMP) {
            print "$_ = ", join(" + ", @{$DECOMP{$_}}), "\n";
        }
    }
}

# Count the total number of scripts

$SCRIPT_COUNT = scalar keys %SCRIPT_TO_BASE;
#print join("\n", sort keys %SCRIPT_TO_BASE), "\n";

# Dump out the %NAME_CODE_TO_SCRIPTS map.

if ($DUMP) {
    print "\nBY NAME:\n";
    foreach my $pass ((1, 2)) {
        print "\nBY NAME - SINGLETONS:\n" if ($pass eq 2);
        foreach my $name (sort keys %NAME_CODE_TO_SCRIPTS) {
            if ($pass eq 1) {
                next if (1 >= $NAME_CODE_TO_SCRIPTS{$name}{count});
            } else {
                next if (1 < $NAME_CODE_TO_SCRIPTS{$name}{count});
            }
            print "$name:";
            my $href = $NAME_CODE_TO_SCRIPTS{$name};
            foreach my $code (sort {$a <=> $b} keys %$href) {
                next if ($code eq 'count');
                my $aref = $href->{$code};
                print " ", hex2($code), " (", formatScriptList($aref), ")";
            }
            print "\n";
        }
    }
}

# Create some transliterators, based on the scripts and the %NAME_CODE_TO_SCRIPTS
# map.  Only use %NAME_CODE_TO_SCRIPTS entries with a count of 2 or more, that is,
# names that occur in two or more scripts.  For those scripts where
# the names occur, map both up to the InterIndic range, and down to
# the target script.

$INTERINDIC = 0xE000;
$INTERINDIC_EXTRA = 0xE080;
$INTERINDIC_EXTRA_NEXT = $INTERINDIC_EXTRA;

# For each script, create a hash.  The hash has a key for each
# code point, either within its block, or in the InterIndic block.
# the value of the key is the mapping.

# The script hashes are named %DEVANAGARI, etc., and referenced
# with symbolic refs.

@REMAP = ('s/\bSHORT\s+//i',
          's/\bCANDRA\s+//i',
          's/\bQA$/KA/i',
          's/\bKHHA$/KHA/i',
          's/\bGHHA$/GA/i',
          's/\bZA$/JA/i',
          's/\bFA$/PHA/i',
          's/\bVA$/BA/i',
          's/\bNNNA$/NA/i',
          's/\bRRA$/RA/i',
          's/\bLLLA$/LLA/i',
          's/\bLLLA$/LA/i',
          's/\bLLA$/LA/i',
          's/^A(.) LENGTH MARK$/VOWEL SIGN A$1/i',
          's/CANDRABINDU/BINDI/i',
          's/BINDI/CANDRABINDU/i',
          );

# Do this so we see zero counts:
foreach my $remap (@REMAP) { $REMAP{$remap} = 0; }

# This loop iterates over the names in the NAME_CODE_TO_SCRIPTS hash.
# These names are things like "LETTER NNNA".  For each name, it then
# creates script mappings up to the InterIndic area, and back down
# to the script areas.  If a name maps to more than one offset,
# then it uses the InterIndic extra range.  Either way, it picks
# a single InterIndic point, either an offset point or something in
# the extra range, and maps up and down from that point.
foreach my $name (sort keys %NAME_CODE_TO_SCRIPTS) {
    next if (1 >= $NAME_CODE_TO_SCRIPTS{$name}{count});
    my $href = $NAME_CODE_TO_SCRIPTS{$name};
    # Count the number of different codes assigned to this name.
    # Usually 1, but 2 for a handful of names.
    my $codeCount = (keys %{$NAME_CODE_TO_SCRIPTS{$name}}) - 1; # less 1: {count}
    # If $codeCount is 1, then map directly up to the $INTERINDIC
    # base.  If $codeCount is 2, then map into unused spots starting
    # at $INTERINDIC_EXTRA.
    my $interIndicCode;
    if ($codeCount > 1) {
        # Map into the InterIndic extra range
        $interIndicCode = $INTERINDIC_EXTRA_NEXT++;
    }
    my %seen;
    foreach my $code (sort {$a ne 'count' && $b ne 'count' && $a <=> $b} keys %$href) {
        next if ($code eq 'count');
        my $aref = $href->{$code}; # Ref to array of scripts
        if ($codeCount == 1) {
            # Map directly
            $interIndicCode = $INTERINDIC + $code;
        }
        # Keep track of the names of the extra InterIndic points
        $INTERINDIC_NAME_TO_FULLCODE{$name} = $interIndicCode;

        foreach my $scr (@$aref) {
            $seen{$scr} = 1;
            my $fullCode = $SCRIPT_TO_BASE{$scr} + $code;
            $ {$scr}{$fullCode} = hex4($interIndicCode) . "; // $name";
            $ {$scr}{$interIndicCode} = hex4($fullCode) . "; // $name";
        }
    }
    # Now handle InterIndic->Script unmapped points.  For each name,
    # some of the scripts will be left out -- will have no mappings
    # to that name.  For these scripts, we can either leave them
    # unmapped (so the InterIndic->Local mapping is empty), or
    # try to remap.
 unmappedScript:
    foreach my $scr (keys %SCRIPT_TO_BASE) {
        next if ($seen{$scr});

        if ($DO_HEURISTIC_REMAP) {
            # Try to remap through the known equivalences in our
            # remapping table
            foreach my $remapRE (@REMAP) {
                local $_ = $name;
                if (eval($remapRE)) {
                    if (exists $SCRIPT_NAME_TO_CODE{$scr}{$_}) {
                        $ {$scr}{$interIndicCode} =
                            hex4($SCRIPT_TO_BASE{$scr} + $SCRIPT_NAME_TO_CODE{$scr}{$_}) .
                                "; // REMAP: $name -> $_";
                        ++$REMAP{$remapRE};
                        next unmappedScript;
                    }
                }
            }
        }

        # Try to remap through the file.  This contains remappings of
        # the form 0991->0993.  That is, it contains local remappings
        # that we can substitute and try again with.
        #|GURMUKHI-InterIndic ------------------------------
        #|// 0A02>; // UNMAPPED INTERNAL: SIGN BINDI
        #|InterIndic-GURMUKHI ------------------------------
        #|// E001>; // UNMAPPED EXTERNAL: SIGN CANDRABINDU
        #|"\u0A01>\u0A02;"
        # In this example, the remapping tells us that the non-existent
        # character A01 should be considered equivalent to the real
        # character A02.
        # We implement this by adding two mappings; one from
        # the InterIndic equivalent of A01, that is, E001, to A02,
        # and one from A02, which otherwise has no mapping, to E001.
        if ($EXCEPTIONS_FILE && $interIndicCode < $INTERINDIC_EXTRA) {
            # Try to map this InterIndic character back to a the spot
            # it would occupy in this script if it had a mapping.
            my $code = $interIndicCode & 0x7F;
            my $pseudoFullCode = $SCRIPT_TO_BASE{$scr} + $code;
            if (exists $EXCEPTIONS{$pseudoFullCode}) {
                my $fullCodeArray = $EXCEPTIONS{$pseudoFullCode};
                my $comment;
                foreach my $c (@$fullCodeArray) {
                    $comment .= "." if ($comment);
                    $comment .= $FULLCODE_TO_NAME{$c};
                }
                $comment = "; // REMAP ($EXCEPTIONS_FILE): " .
                    hex4($pseudoFullCode) . ">" . hexArray(@$fullCodeArray) . " = " .
                    $CODE_TO_NAME{$code} . ">" . $comment;
                $ {$scr}{$interIndicCode} = hexArray(@$fullCodeArray) . $comment;
                if (scalar @$fullCodeArray == 1) {
                    if (exists $ {$scr}{$fullCodeArray->[0]}) {
                        # There's already a proper mapping; no need to fill
                        # in reverse
                    } else {
                        $ {$scr}{$fullCodeArray->[0]} = hex4($interIndicCode) . $comment;
                    }
                }
                next unmappedScript;
            }
        }

        $SCRIPT_FULLCODE_TO_IS_UNMAPPED{$scr}{$interIndicCode} = 1;
        local $_ = "; // UNMAPPED InterIndic-$scr: $name";
        if (exists $SCRIPT_CODE_TO_NAME{$scr}{$interIndicCode & 0x7F}) {
            my $fullCode = $SCRIPT_TO_BASE{$scr} + ($interIndicCode & 0x7F);
            $_ .= " (" . hex4($fullCode) . " = " . $FULLCODE_TO_NAME{$fullCode} . ")";
        }
        $ {$scr}{$interIndicCode} = $_;
    }
}

# Add in unmapped entries for each script
foreach my $scr (keys %SCRIPT_TO_BASE) {
    my $base = $SCRIPT_TO_BASE{$scr};
 unmappedInt:
    foreach my $code (keys %{$SCRIPT_CODE_TO_NAME{$scr}}) {
        my $fullCode = $code + $base;
        next if (exists $ {$scr}{$fullCode});
        my $name = $SCRIPT_CODE_TO_NAME{$scr}{$code};

        if ($DO_HEURISTIC_REMAP) {
            foreach my $remapRE (@REMAP) {
                local $_ = $name;
                if (eval($remapRE)) {
                    if (exists $INTERINDIC_NAME_TO_FULLCODE{$_}) {
                        $ {$scr}{$fullCode} =
                            hex4($INTERINDIC_NAME_TO_FULLCODE{$_}) .
                                "; // REMAP: $name -> $_";
                        ++$REMAP{$remapRE};
                        next unmappedInt;
                    }
                }
            }
        }

        # Now try the decomp table
        if ($DO_DECOMP_REMAP && exists $DECOMP{$name}) {
            my $x;
            my $cmt = "; // DECOMP: $name -> ";
            foreach my $n (@{$DECOMP{$name}}) {
                if (exists $SCRIPT_NAME_TO_CODE{$scr}{$n}) {
                    $x .= hex4($SCRIPT_TO_BASE{$scr} + $SCRIPT_NAME_TO_CODE{$scr}{$n});
                    $cmt .= $n . " + ";
                } else {
                    $cmt = 0;
                    last;
                }
            }
            if ($cmt) {
                $ {$scr}{$fullCode} = $x . $cmt;
                next unmappedInt;
            }
        }

        $SCRIPT_FULLCODE_TO_IS_UNMAPPED{$scr}{$fullCode} = 1;
        $ {$scr}{$fullCode} = "; // UNMAPPED $scr-InterIndic: $name";
    }
}

# GUR
# E00B>; // UNMAPPED EXTERNAL: LETTER VOCALIC R "\u0A0B>\u0A30\u0A3F;"
# E00C>; // UNMAPPED EXTERNAL: LETTER VOCALIC L "\u0A0C>\u0A07;"
# E00D>; // UNMAPPED EXTERNAL: LETTER CANDRA E "\u0A0D>\u0A10;"
# E011>; // UNMAPPED EXTERNAL: LETTER CANDRA O "\u0A11>\u0A14;"
# E037>; // UNMAPPED EXTERNAL: LETTER SSA "\u0A37>\u0A36;"
# E045>; // UNMAPPED EXTERNAL: VOWEL SIGN CANDRA E "\u0A45>\u0A48;"
# E049>; // UNMAPPED EXTERNAL: VOWEL SIGN CANDRA O "\u0A49>\u0A4C;"
# Fix QA too

# Dump out script maps
foreach my $scr (sort keys %SCRIPT_TO_BASE) {
    ## next unless ($scr eq 'TELUGU'); # Debugging
    my @rules;
    my $flag = 1;
    foreach my $fullCode (sort {$a <=> $b} keys %{$scr}) {
        if ($flag && $fullCode >= $INTERINDIC) {
            # We have the complete <scr>-InterIndic rules; dump
            # them out.
            generateRBT($scr, "InterIndic", \@rules, $OUTDIR);
            @rules = ();
            $flag = 0;
        }
        if (exists $SCRIPT_FULLCODE_TO_IS_UNMAPPED{$scr}{$fullCode}) {
            push @rules, "// " . hex4($fullCode) . ">" . $ {$scr}{$fullCode};
        } else {
            push @rules, hex4($fullCode) . ">" . $ {$scr}{$fullCode};
        }
    }
    # Now generate the InterIndic-<scr> rules.
    generateRBT("InterIndic", $scr, \@rules, $OUTDIR);

#    print "$scr-InterIndic ------------------------------\n";
#    my $flag = 1;
#    foreach my $fullCode (sort {$a <=> $b} keys %{$scr}) {
#        if ($flag && $fullCode >= $INTERINDIC) {
#            print "InterIndic-$scr ------------------------------\n";
#            $flag = 0;
#        }
#        if (exists $SCRIPT_FULLCODE_TO_IS_UNMAPPED{$scr}{$fullCode}) {
#            print "// ", hex4($fullCode), ">", $ {$scr}{$fullCode}, "\n";
#        } else {
#            print hex4($fullCode), ">", $ {$scr}{$fullCode}, "\n";
#        }
#    }
}

# List successful remappings
if ($DO_HEURISTIC_REMAP) {
    foreach my $remap (sort keys %REMAP) {
        print STDERR "REMAP ", $REMAP{$remap}, " x $remap\n";
    }
}

#----------------------------------------------------------------------
# SUBROUTINES

# Return a listing of an array of scripts
# Param: array ref
sub formatScriptList {
    my $aref = shift;
    if ($SCRIPT_COUNT == @$aref) {
        return "all";
    } elsif (($SCRIPT_COUNT - 3) <= @$aref) {
        my $s = "all but";
        my %temp;
        foreach (@$aref) { $temp{$_} = 1; }
        foreach (sort keys %SCRIPT_TO_BASE) {
            $s .= " $_" unless exists $temp{$_};
        }
        return $s;
    } else {
        return join(" ", @$aref);
    }
}

# Format as %02X hex
sub hex2 {
    sprintf("%02X", $_[0]);
}

# Format as %04X hex
sub hex4 {
    sprintf("\\u%04X", $_[0]);
}

# Format an array as %04X hex, delimited by "."s
sub hexArray {
    join("", map { hex4($_); } @_);
}

# Parse a string of the form "\u0D01" to an array of integers.
# Must ONLY contain escapes.
# Return the array.
sub parseUnicodeEscape {
    local $_ = shift;
    my $orig = $_;
    my @result;
    while (length($_)) {
        if (/^\\u([0-9a-f]{4})(.*)/i) {
            push @result, hex($1);
            $_ = $2;
        } else {
            die "Can't parse Unicode escape $orig\n";
        }
    }
    if (0 == @result) {
        die "Can't parse Unicode escape $orig\n";        
    }
    @result;
}

# Return 1 if the two arrays of ints are equal.
# Param: ref to array of ints
# Param: ref to array of ints
sub intArraysEqual {
    my $a = shift;
    my $b = shift;
    if (scalar @$a == scalar @$b) {
        for (my $i=0; $i<@$a; ++$i) {
            if ($a->[$i] != $b->[$i]) {
                return 0;
            }
        }
        return 1;
    }
    return 0;
}

# Given a rule, possibly with trailing // comment,
# quote the rule part and add a trailing "+" after
# it.
sub quoteRule {
    my $cmt;
    $cmt = $1 if (s|(\s*//.*)||); # isolate trailing // comment
    s/^(.*;)/\"$1\"+/;
    s/$/$cmt/;
    $_;
}

# Given the name of the source script, name of the target script,
# and array of rule strings, return a string containing the source
# for a RuleBasedTransliterator file.
# Param: source script name
# Param: target script name
# Param: ref to array of rules.  These rules are unquoted, without
#  concatenators between them, but do have trailing ';' separators.
# Param: name of output directory
sub generateRBT {
    # $TOOL - name of generating tool
    # $DATE - date of generation
    # $SCRIPTFROM - name of source script
    # $SCRIPTTO - name of target script
    # $RULES - rules
    my ($source, $target, $rules, $outdir) = @_;
    my $text;
    $outdir =~ s|[/\\]$||; # Delete trailing / or \
    my $OUT = "$outdir/TransliterationRule_${source}_$target.java";
    open(RBT_TEMPLATE) or die;
    open(OUT, ">$OUT") or die;
    while (<RBT_TEMPLATE>) {
        while (/\$([A-Za-z0-9]+)/) {
            my $tag = $1;
            my $sub;
            if ($tag eq 'TOOL') {
                $sub = $RBT_GEN_TOOL;
            } elsif ($tag eq 'DATE') {
                $sub = localtime;
            } elsif ($tag eq 'SCRIPTFROM') {
                $sub = $source;
            } elsif ($tag eq 'SCRIPTTO') {
                $sub = $target;
            } elsif ($tag eq 'RULES') {
                # Get any whitespace-only indent off the front of this tag
                my $indent;
                $indent = $1 if (/^(\s+)\$$tag/);

                # The rules in the array are not quoted.  We need to quote
                # them and add '+' operators between them.  We do NOT need
                # to add ';' separators.  We DO need to separate trailing
                # // comments and handle them.
                $sub = join("\n$indent", map(&quoteRule, @$rules)) .
                    "\n$indent\"\"";
            } else {
                print STDERR "ERROR in $RBT_TEMPLATE: Unknown tag $tag\n";
                $sub = "[ERROR:Unknown tag \$$tag]";
            }
            s/\$$tag/$sub/;
        }
        print OUT;
    }
    close(OUT);
    close(RBT_TEMPLATE);
    print STDERR "Written: $OUT\n";
}

__END__