#!/usr/bin/perl -w 

# Was macht das Programm?
#
# lese text.tagged (ItalAnt-Korpus) ein und füge
# Mehrwortterme aus Datei hinzu!

# -rwxr-x---   1 fitschen corpora     6846 Jul  4  2000 mwl-hinzu.perl

# Aufruf: mwl-hinzu.perl -m mall...  text.tagged

# Arne Fitschen, IMS, \today

##MWL: >>°_lem=venire°a°capo°,111,3,0,6,0,13<<
##  viene°_lem=venire,111,3,0,6,0,11 (>>viene<< >>venire,111,3,0,6,0,11<<)
##  a°_lem=a,56,0,0,0,0,11 (>>a<< >>a,56,0,0,0,0,11<<)
##  capo°_lem=capo,20,0,4,6,0,11 (>>capo<< >>capo,20,0,4,6,0,11<<)


#################################################################
## 1. Optionen einlesen
#################################################################

use Getopt::Std;
getopts('hHvdm:'); # help, verbose, dos, mwl
use vars qw($opt_H $opt_h $opt_v $opt_d $opt_g $opt_m ); # grosses Tagset

if ($opt_v){
  print STDERR "Programm $0 mit Option \"-v\" gestartet...\n";
}

#################################################################
## MWL einlesen bei -m
#################################################################

$mwl_cnt = 0;
$all_cnt = 0;
if ($opt_m){
  open(MWL, $opt_m) || die "Geht nicht, $opt_m -- $!";
  while(<MWL>){
    if (/^\s*$|\$\$\$/){ # Leerzeilen: Trenner
      $gesamt = "";
      $einzel = "";
      next;
    }
    else { # Bestandteile
      $all_cnt++;
      if (/±n/){ }
      else { 
	chomp;
	$mwl_cnt++; 
	($einzel, $gesamt) = /^([^ ]+)\s+([^ ]+)\s*$/;
	@feld = split(/\+/, $einzel);
	print "\nMWL: >>$gesamt<<\n" if $opt_d;

	$zahl = 0;
	$all = ""; # setzt MWL aus words zusammen
	grep {
	  $zahl++;
	  ($l, $r) = /([^°]+)°?_lem=(.*)/;
	  die "Schlecht: $_\n" unless ($l && $r);
	  print "  $_ (>>$l<< >>$r<<)\n" if $opt_d; 

	  $all .= $l."___";
	} @feld; 
	$mwls{$all} = $zahl;
	$mwl_kompl{$all} = $gesamt;
	print "MWL >>$all<< $zahl Bestandteile komplett >>$gesamt<<\n" if $opt_d;
      }
    }
  }
  close MWL;
  print STDERR "$mwl_cnt adjazente Mehrwortterme (von $all_cnt) gelesen.\n";
}

#################################################################
## init
#################################################################

$coll_lem = ""; # MWL-Lemma
$coll_pos = ""; # MWL-POS

#################################################################
## main
#################################################################

@alles = (<>); # alles einlesen

$index = 0;
$ende = (scalar @alles) -1;
$MAX = 9;

while($index < ($ende - $MAX)){ # Feld durchlaufen mit 10er-Fenster

  $fenster = "";
  print "Fenster von $index bis ", $index + $MAX, "...\n" if $opt_d;
  for ( $i=$index; $i < $index + $MAX; $i++ ){
    $akt = $alles[$i];
    chomp $akt;

    ## zunächst: 2 Felder hinzufügen für coll_lem und coll_pos!
    $akt .= "\t--\t--" 
      unless ($akt =~ /^<.*>$/ || $akt =~ /--\t--$/); 
      # wenn nicht SGML oder schon ersetzt!! 
    print "Neu: >>$akt<<\n" if $opt_d;
    $alles[$i] = "$akt\n";

#    $satznr = $1 if $akt =~ /^<s (\d+)/;
    $akt =~ s/^([^\s]+).*/$1/; # alles vor erstem white space ist gut
    $fenster .= $akt."___";
  }

  ## Hashabgleich
  if ($res = &check($fenster)){ # MWL gefunden?
    print "Gefunden mit $res\n" if $opt_d;
    $len = $mwls{$res};

    $ges = $mwl_kompl{$res};
    $ges =~ /^._\(?lem=(.*?),?([\d;]+,[\d;]+,[\d;]+,[\d;]+,[\d;]+,[\d;]+)/;
    die "Schade: $ges" unless ($1 && $2);
    
    $coll_lem = $1;
    $coll_pos = $2;

    for ($k = $index; $k < $index+$len; $k++){
      print "An $alles[$k] $coll_lem eintragen...\n" if $opt_d;
      $tmp = $alles[$k];
      print "Tmp ist >>$tmp<<\n" if $opt_d;
      chomp $tmp;
      $tmp =~ s/--\t--$/$coll_lem\t$coll_pos/;
      $alles[$k] = "$tmp\n";
      print "Ersetzt durch >>$tmp<<\n" if $opt_d;
    }
    print "\n\n" if $opt_d;
    
    $index += $len; # soviel Felder überspringen, später einfügen...
  }

  else { # Versuch im nächsten Wort
    $index++; # ein Wort weiter...
  }

} #end while

grep { print } @alles;

#################################################################
## subs
#################################################################

sub check {

  local $str = shift;

  while ($str =~ /(.*___)[^_]+___$/){
    $rest = $1;
    
    print "Test auf >>$str<<\nRest >>$rest<<\n\n" if $opt_d;
    
    if (exists($mwls{$str})){
      print "Treffer!! >>$fenster<<, >>$str<< (Bestandteile $mwls{$str})\n" 
	if $opt_d;
      return $str; # laengste MWL gefunden!
    }
    $str = $rest;
  }
  return "";
}


sub austausch {
  
  local $num = shift;
  local $ret = "";

  local %cool = 
    ('20', 'n c', 
     '21', 'n p', 
     '26', 'adj', 
     '30', 'pd dem s', 
     '31', 'pd dem w', 
     '32', 'pd ind', 
     '33', 'pd pos s', 
     '34', 'pd pos w', 
     '35', 'pd int', 
     '36', 'pd rel', 
     '37', 'pd per s n', 
     '38', 'pd per s o', 
     '39', 'pd per w o', 
     '40', 'pd exc', 
     '41', 'pd.per.w.no', 
     '45', 'adv g', 
     '46', 'adv p', 
     '47', 'adv.cnt', 
     '50', 'conj c', 
     '51', 'conj s', 
     '56', 'adp pre', 
     '57', 'adp post', 
     '60', 'art d', 
     '61', 'art i', 
     '64', 'num c', 
     '65', 'num o', 
     '68', 'intj', 
     '70', 'punct f', 
     '71', 'punct nf', 
     '75', 'r frg', 
     '76', 'r abb', 
     '77', 'r for', 
     '78', 'r epe', 
     '111', 'v m f ind pr', 
     '112', 'v m f ind if', 
     '113', 'v m f ind pt', 
     '114', 'v m f ind ft', 
     '115', 'v m f sub pr', 
     '116', 'v m f sub if', 
     '117', 'v m f cnd pr', 
     '118', 'v m f imp pr', 
     '121', 'v m n inf pr', 
     '122', 'v m n par pr', 
     '123', 'v m n par pt', 
     '124', 'v m n ger pr', 
     '211', 'v a f ind pr', 
     '212', 'v a f ind if', 
     '213', 'v a f ind pt', 
     '214', 'v a f ind ft', 
     '215', 'v a f sub pr', 
     '216', 'v a f sub if', 
     '217', 'v a f con pr', 
     '218', 'v a f imp pr', 
     '221', 'v a n inf pr', 
     '222', 'v a n par pr', 
     '223', 'v a n par pt', 
     '224', 'v a n ger pr', 
     '311', 'v m f ind pr', 
     '312', 'v m f ind pr', 
     '313', 'v m f ind pr', 
     '314', 'v m f ind pr', 
     '315', 'v m f ind pr', 
     '316', 'v m f ind pr', 
     '317', 'v m f ind pr', 
     '318', 'v m f ind pr', 
     '321', 'v m f ind pr', 
     '322', 'v m f ind pr', 
     '323', 'v m f ind pt', 
     '324', 'v m f ind pr');

  if ($num =~ /^\d+$/){ 
    if ($num == 0){
      $ret = "zero";
    }
    else {
      die "Schade: Geht1 nicht mit $num ($_)\n" unless $cool{$num};
      $ret = $cool{$num};
      $ret =~ s/ /./g;
    }
    $ret = "|".$ret."|"; # für "contains"-Abfrage in CQP!
    return $ret;
  }
  else {print STDERR 
    @f2 = ();
    local @feld = split(/\|/, $num);

    grep {
      if ($_ == 0){
	push(@f2, "zero");
      }
      else {
	die "Schade: Geht2 nicht mit $num ($_)\n" unless $cool{$_};
	push(@f2, $cool{$_});
      }
    } @feld;
    
    $ret = join("|", @f2);
    $ret =~ s/ /./g;
    $ret = "|".$ret."|"; # für "contains"-Abfrage in CQP!
    return $ret;
  }
}


__END__