#!/usr/bin/env perl
  #===============================================================================
  # Copyright (c) 2017  Johns Hopkins University (Author: Jan "Yenda" Trmal <jtrmal@gmail.com>)
  #
  # Licensed under the Apache License, Version 2.0 (the "License");
  # you may not use this file except in compliance with the License.
  # You may obtain a copy of the License at
  #
  #  http://www.apache.org/licenses/LICENSE-2.0
  #
  # THIS CODE IS PROVIDED *AS IS* BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  # KIND, EITHER EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION ANY IMPLIED
  # WARRANTIES OR CONDITIONS OF TITLE, FITNESS FOR A PARTICULAR PURPOSE,
  # MERCHANTABLITY OR NON-INFRINGEMENT.
  # See the Apache 2 License for the specific language governing permissions and
  # limitations under the License.
  #===============================================================================
  
  use strict;
  use warnings;
  use utf8;
  
  require HTML::Parser or die "This script needs HTML::Parser from CPAN";
  HTML::Parser->import();
  
  binmode(STDOUT, ":utf8");
  
  sub  trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
  
  sub parse_sgml_tag {
    my $tag = shift(@_);
    my %ret;
    
    if ($tag !~ /=/) {
      return %ret;
    }
    
    $tag =~ s/<[a-zA-Z]+ //;
    $tag =~ s/> *$//;
    #print $tag . "
  ";
  
    my @key_value_pairs = split / *,? +/, $tag;
    for my $entry(@key_value_pairs) {
      (my $key, my $value) = split '=', $entry, 2;
      $ret{$key}=$value;
    }
    return %ret;
  }
  
  if (@ARGV != 1) {
    print STDERR "$0: This script needs exactly one parameter (list of SGML files)
  ";
    print STDERR "  Usage: $0 <transripts>
  ";
    print STDERR "  where
  ";
    print STDERR "    <transcripts> is a file containing the official SGML format
  ";
    print STDERR "      transcripts. The files are parsed and the parsed representation
  ";
    print STDERR "      is dumped to STDOUT (one utterance + the additional data fields
  ";
    print STDERR "      per line (we dump all the fields, but not all fields are used
  ";
    print STDERR "      in the recipe).
  ";
    die;
  }
  my $filelist=$ARGV[0];
  
  my $p = HTML::Parser->new();
  
  my @files=();
  open(F, '<', $filelist) or die "Could not open file $filelist: $?
  ";
  while(<F>) {
    chomp;
    push @files, $_;
  }
  
  foreach my $file (@files) {
    my $reporter="";
    my $start = -1;
    my $end = -1;
    my $turn_start = -1;
    my $turn_end = -1;
    my $turn_speaker;
    my $turn_dialect = "unknown";
    my $turn_sex;
    my $section_start = -1;
    my $section_end = -1;
    my $filename = "";
    my $seq = 0;
    my @text = ();
    my $time;
    my @tagqueue;
  
    my $sgml_file = `basename $file`;
    $sgml_file = trim $sgml_file;
    $sgml_file =~ s/\.sgm$//g;
  
    open(my $f, '<:encoding(iso-8859-1)', $file) or die "Could not open file $file: $?
  ";
  
    while(my $line = <$f>) {
      chomp $line;
      $line = trim $line;
      next unless $line;
  
      if ($line =~ /<episode/) {
        my %tags = parse_sgml_tag $line;
        $filename = $tags{'filename'};
        $filename =~ s/"//g;
  
        print STDERR "$0: WARNING: SGML filename does not match episode filename $filename in file $file
  ";
        #print "BS: $line
  ";
        push @tagqueue, ["episode", \%tags];
        ;
      } elsif ($line =~ /<\/episode/) {
        my $p = pop @tagqueue;
        $line =~ s/<\/(.*)( +.*)?>/$1/g;
        die "Unaligned tags: " . $p->[0] . " vs $line" if $p->[0] ne $line;
        #print "ES: $line
  ";
        ;
      } elsif ($line =~ /<section/) {
        my %tags = parse_sgml_tag $line;
        $section_start = $tags{'startTime'};
        $section_end = $tags{'endTime'};
        #print "BS: $line
  ";
        push @tagqueue, ["section", \%tags];
        ;
      } elsif ($line =~ /<\/section/) {
        my $p = pop @tagqueue;
        $line =~ s/<\/(.*)( +.*)?>/$1/g;
        die "Unaligned tags: " . $p->[0] . " vs $line" if $p->[0] ne $line;
        #print "ES: $line
  ";
        ;
      } elsif ($line =~ /<turn/) { 
        #print "BT: $line
  ";
        my %tags = parse_sgml_tag $line;
        $turn_speaker = $tags{'speaker'};
        $turn_start = $tags{'startTime'};
        $turn_end = $tags{'endTime'};
        $turn_dialect = $tags{'dialect'} if $tags{'dialect'};
        $turn_sex = $tags{'sex'};
        push @tagqueue, ["turn", \%tags];
        ;
      } elsif ($line =~ /<\/turn/) {
        my $p = pop @tagqueue;
        $line =~ s/<\/(.*)( +.*)?>/$1/g;
        die "Unaligned tags: " . $p->[0] . " vs $line" if $p->[0] ne $line;
  
        #print join(" ", @text) . "
  " if @text > 0;
        my $new_time = $turn_end;
        if (@text > 0) {
          print "$sgml_file $filename $turn_speaker $turn_dialect $turn_sex $time $new_time ";
          print join(" ", @text) . "
  ";
        }
        @text = ();
        $time = 0;
        $turn_speaker = "XXX";
        $turn_start = "XXX";
        $turn_end = "XXX";
        $turn_dialect = "XXX";
        $turn_sex = "XXX";
        #print "ET: $line
  ";
        ;
      } elsif ($line =~ /<time/) {
        my %tags = parse_sgml_tag $line;
        my $new_time = $tags{'sec'};
        if (@text > 0) {
          print "$sgml_file $filename $turn_speaker $turn_dialect $turn_sex $time $new_time ";
          print join(" ", @text) . "
  ";
        }
        @text = ();
        $time = $new_time;
        ;
      } elsif ($line =~ /<\/time/) {
        #print $line;
        ;
      } elsif ($line =~ /<foreign/) {
        $line = trim $line;
        push @text, $line;
      } elsif ($line =~ /<\/foreign/) {
        $line = trim $line;
        push @text, $line;
        ;
      } elsif ($line =~ /<unclear/) {
        $line = trim $line;
        push @text, $line;
      } elsif ($line =~ /<\/unclear/) {
        $line = trim $line;
        push @text, $line;
        ;
      } elsif ($line =~ /<[^\/]/) {
        parse_sgml_tag $line;
        print STDERR "$0: INFO: Unknown tag $line in file $file
  ";
      } elsif ($line =~ /<\//) {
        ;
      } else {
        $line = trim $line;
        push @text, $line if $line;
        ;
      }
  
    }
    close($f);
  }