#!/usr/bin/perl
#
# Generation of types and lookup tables for Daitch-Mokotoff soundex.
#
# Copyright (c) 2023-2025, PostgreSQL Global Development Group
#
# This module was originally sponsored by Finance Norway /
# Trafikkforsikringsforeningen, and implemented by Dag Lem <dag@nimrod.no>
#

use strict;
use warnings FATAL => 'all';

die "Usage: $0 OUTPUT_FILE\n" if @ARGV != 1;
my $output_file = $ARGV[0];

# Open the output file
open my $OUTPUT, '>', $output_file
  or die "Could not open output file $output_file: $!\n";

# Parse code table and generate tree for letter transitions.
my %codes;
my $table = [ {}, [ [ "", "", "" ] ] ];
while (<DATA>)
{
 chomp;
 my ($letters, $codes) = split(/\s+/);
 my @codes = map { [ split(/,/) ] } split(/\|/, $codes);

 my $key = "codes_" . join("_or_", map { join("_", @$_) } @codes);
 my $val = join(
  ",\n",
  map {
   "\t{\n\t\t"
     . join(", ", map { "\"$_\"" } @$_) . "\n\t}"
  } @codes);
 $codes{$key} = $val;

 for my $letter (split(/,/, $letters))
 {
  my $ref = $table->[0];
  # Link each character to the next in the letter combination.
  my @c = split(//, $letter);
  my $last_c = pop(@c);
  for my $c (@c)
  {
   $ref->{$c} //= [ {}, undef ];
   $ref->{$c}[0] //= {};
   $ref = $ref->{$c}[0];
  }
  # The sound code for the letter combination is stored at the last character.
  $ref->{$last_c}[1] = $key;
 }
}
close(DATA);

print $OUTPUT <<EOF;
/*
 * Constants and lookup tables for Daitch-Mokotoff Soundex
 *
 * Copyright (c) 2023-2025, PostgreSQL Global Development Group
 *
 * This file is generated by daitch_mokotoff_header.pl
 */

/* Coding chart table: Soundex codes */
typedef char dm_code[2 + 1]; /* One or two sequential code digits + NUL */
typedef dm_code dm_codes[3]; /* Start of name, before a vowel, any other */

/* Coding chart table: Letter in input sequence */
struct dm_letter
{
 char  letter;   /* Present letter in sequence */
 const struct dm_letter *letters; /* List of possible successive letters */
 const dm_codes *codes;  /* Code sequence(s) for complete sequence */
};

typedef struct dm_letter dm_letter;

/* Codes for letter sequence at start of name, before a vowel, and any other. */
EOF

for my $key (sort keys %codes)
{
 print $OUTPUT "static const dm_codes $key\[2\] =\n{\n"
   . $codes{$key}
   . "\n};\n";
}

print $OUTPUT <<EOF;

/* Coding for alternative following letters in sequence. */
EOF

sub hash2code
{
 my ($ref, $letter) = @_;

 my @letters = ();

 my $h = $ref->[0];
 for my $key (sort keys %$h)
 {
  $ref = $h->{$key};
  my $children = "NULL";
  if (defined $ref->[0])
  {
   $children = "letter_$letter$key";
   hash2code($ref, "$letter$key");
  }
  my $codes = $ref->[1] // "NULL";
  push(@letters, "\t{\n\t\t'$key', $children, $codes\n\t}");
 }

 print $OUTPUT "static const dm_letter letter_$letter\[\] =\n{\n";
 for (@letters)
 {
  print $OUTPUT "$_,\n";
 }
 print $OUTPUT "\t{\n\t\t'\\0'\n\t}\n";
 print $OUTPUT "};\n";
}

hash2code($table, '');

close $OUTPUT;

# Table adapted from https://www.jewishgen.org/InfoFiles/Soundex.html
#
# The conversion from the coding chart to the table should be self
# explanatory, but note the differences stated below.
#
# X = NC (not coded)
#
# The non-ASCII letters in the coding chart are coded with substitute
# lowercase ASCII letters, which sort after the uppercase ASCII letters:
#
# Ą => a (use '[' for table lookup)
# Ę => e (use '\\' for table lookup)
# Ţ => t (use ']' for table lookup)
#
# The rule for "UE" does not correspond to the coding chart, however
# it is used by all other known implementations, including the one at
# https://www.jewishgen.org/jos/jossound.htm (try e.g. "bouey").
#
# Note that the implementation assumes that vowels are assigned code
# 0 or 1. "J" can be either a vowel or a consonant.
#

__DATA__
AI,AJ,AY    0,1,X
AU      0,7,X
a      X,X,6|X,X,X
A      0,X,X
B      7,7,7
CHS      5,54,54
CH      5,5,5|4,4,4
CK      5,5,5|45,45,45
CZ,CS,CSZ,CZS   4,4,4
C      5,5,5|4,4,4
DRZ,DRS     4,4,4
DS,DSH,DSZ    4,4,4
DZ,DZH,DZS    4,4,4
D,DT     3,3,3
EI,EJ,EY    0,1,X
EU      1,1,X
e      X,X,6|X,X,X
E      0,X,X
FB      7,7,7
F      7,7,7
G      5,5,5
H      5,5,X
IA,IE,IO,IU    1,X,X
I      0,X,X
J      1,X,X|4,4,4
KS      5,54,54
KH      5,5,5
K      5,5,5
L      8,8,8
MN      66,66,66
M      6,6,6
NM      66,66,66
N      6,6,6
OI,OJ,OY    0,1,X
O      0,X,X
P,PF,PH     7,7,7
Q      5,5,5
RZ,RS     94,94,94|4,4,4
R      9,9,9
SCHTSCH,SCHTSH,SCHTCH 2,4,4
SCH      4,4,4
SHTCH,SHCH,SHTSH  2,4,4
SHT,SCHT,SCHD   2,43,43
SH      4,4,4
STCH,STSCH,SC   2,4,4
STRZ,STRS,STSH   2,4,4
ST      2,43,43
SZCZ,SZCS    2,4,4
SZT,SHD,SZD,SD   2,43,43
SZ      4,4,4
S      4,4,4
TCH,TTCH,TTSCH   4,4,4
TH      3,3,3
TRZ,TRS     4,4,4
TSCH,TSH    4,4,4
TS,TTS,TTSZ,TC   4,4,4
TZ,TTZ,TZS,TSZ   4,4,4
t      3,3,3|4,4,4
T      3,3,3
UI,UJ,UY,UE    0,1,X
U      0,X,X
V      7,7,7
W      7,7,7
X      5,54,54
Y      1,X,X
ZDZ,ZDZH,ZHDZH   2,4,4
ZD,ZHD     2,43,43
ZH,ZS,ZSCH,ZSH   4,4,4
Z      4,4,4