use strict;
use warnings;

sub suite($) {
  my $languages = shift(@_);
  print(STDERR $languages, qq{\n});
  unlink(qq{out/$languages});
  my $code = 
    system(qq{perl all-pairs.pl --languages=$languages > out/$languages});
  if ($code) {die(qq{all-pairs.pl error: $code});}
  unlink(qq{out/$languages-summ});
  $code = system(qq{perl trim-all-pairs.pl < out/$languages > out/$languages-summ});
  if ($code) {die(qq{trim-all-pairs.pl error: $code});}
  open(my $summ, q{<}, qq{out/$languages-summ}) 
    or die(qq{out/$languages-summ});
  my $last_line;
  while (defined(my $line = <$summ>)) {$last_line = $line;}
  close($summ);
  print(STDERR $last_line, qq{\n});
  my $nearest;
  if ($last_line =~ m{Closest pair: (\S+) at }) {
    $nearest = $1;
  }
  return $nearest;
}

sub Slurp($) {
  my $in = shift(@_);
  my $lines = {};
  my $slurp_on = 0;
  my $sem;
  while (defined(my $line = <$in>)) {
    if ($line =~ m{</word>}) {
      $slurp_on = 0;
    } elsif ($slurp_on) {
      $lines->{$sem} .= $line;
    } elsif ($line =~ m{<word\s+sem="(.*?)"}) {
      $sem = $1;
      $slurp_on = 1;
    }
  }
  return $lines;
}

sub Merge($$$) {
  my($a_base_name, $b_base_name, $new_base_name) = @_;
  open(my $a, q{<}, qq{out/$a_base_name.xml}) or die($a_base_name);
  my $a_data = Slurp($a);
  close($a);
  open(my $b, q{<}, qq{out/$b_base_name.xml}) or die($b_base_name);
  my $new_full_name = qq{out/$new_base_name.xml};
  unlink($new_full_name);
  open(my $new, q{>}, $new_full_name);
  while (defined(my $line = <$b>)) {
    $line =~ s{<language id="(.+?)"}{<language id="$new_base_name"};
    print($new $line);
    if ($line =~ m{<word\s+sem="(.*?)"}) {
      my $sem = $1;
      print($new $a_data->{$sem}) if exists($a_data->{$sem});
    }
  }
  close($b);
  close($new);
}

sub main() {
  my $languages = 
    q{ALB,ANG,CHU,GOH,GOT,GRC,LAT,LIT,NON,SAN,SGA,HUN,FIN,CHM,YRK};
  while (1) {
    my $nearest = suite($languages);
    last unless defined($nearest);
    my($a, $b) = split(m{~}, $nearest);
    my $new = qq{$a-$b};
    Merge($a, $b, $new);
    $languages =~ s{,?$a,?}{,};
    $languages =~ s{,?$b,?}{,};
    $languages =~ s{^,}{};
    $languages =~ s{,$}{};
    $languages .= qq{,$new};
  }
}

main();