#!/usr/bin/perl5 -w 

# Was macht das Programm?
#
# lese ItalAnt-Korpus ein und mache daraus ein CQP-Korpus

# Aufruf: Aufbereitung.perl [-g] probe-tg

# Arne Fitschen, IMS, \today


# <per> etc. weglassen!!!  4.7.2000 TODO

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

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


if ($opt_h || $opt_H) {  
  
  print "\nAufruf: $0 <Optionen> <Eingabe?>\n\n";
  print "\n\nOptionen:\n";

  exit 0;
}

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

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

$author = "";  # Werk/Autor
$title = "";   # auch
$genre = "";
$type = "";
$linecnt = 0;
$page = 0;
$par = 0;
$chapter = "";
#$year = 0;
$satz = 0;

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

print "<s $satz>\n";

while(<>){

  ## allgemeine Vorbehandlung
  next if /^\s*$/; # Leerzeilen raus
  chop;            # Zeilenumbruch raus
  s/\015//g;       # DOS newlines raus     
#  s/\237/�/g;      # kommt 10* vor
  
  if (/\@([^\@]+)\@+([^\@]+)\@+(.*)/){
    print "</genr>\n</title>\n</author>\n" if ($author && $title);
    die "Genre fehlt ($_)\n" unless $3;
    $author = $1;
    $title  = $2;
    $genre = $3;
    print "<author $author>\n<title $title>\n<genr $genre>\n";
  }

  else {

    @zeile = split(' ', $_);
    if (/lemm?=/ && !(/\$\d/)){ # sonst nur Marker!
      &write_ln;
    }
    else {
      print STDERR "ZEILE $_\n" if $opt_d;
    }
    
    ## Jede Zeile bearbeiten
    grep {
      
      ## 1. Verse/Prose/Rubrica
      if (/^\&([VPR])_lemm?=(pro|ver|rubri)/){ # Verse/Prose-Umgebung
	print "</type>\n" if $type; # immer schlie�en, nicht am Anfang
	$type = $1;
	print "<type verse>\n" if $type eq "V";
	print "<type prose>\n" if $type eq "P";
	print "<type rubrica>\n" if $type eq "R";
      }
      
      ## 2. Seitenzahlen
      elsif (/\$(\d+[abcd]?)\$/){ # Seitenzahl
	print "</page>\n" if $page; # immer schlie�en, nicht am Anfang
	$page = $1;
	print "<page $page>\n";
      }
      
      ## 3. Paragraph
      ## OLD	elsif (/\%(\d+)/ || /\#\[([^\]]+)\]\@/){
      ## OLD	elsif ( /\#([0-9abc\*]+)\@/ ){
      elsif ( /\#([0-9abc\-\*]+)\@/ ){
	print "</par>\n" if $par;
	$par = $1;
	print "<par $par>\n";
	
	## Zeilennummer ausgeben und 
	## Zeile r�cksetzen!
	&write_ln;
	$linecnt = 0;
      }
      
      ## 4. Chapter etc.
      elsif ( /\%(\d+[a-z]?)/ ){
	print "</chapter>\n" if $chapter;
	$chapter = $1;
	print "<chapter $chapter>\n";
      }
      
      ## 5. Chapter etc.
      elsif (/\%(II?)par(.*)/){
	print "</par>\n" if $par;
	print "</chapter>\n" if $chapter;
	$chapter = $1;
	$par = $2;
	print "<chapter $chapter>\n<par $par>";
      }
      
      ## 6. Line
## OLD  elsif (/\237\/(P\d+)\237/){
      elsif (/�\/([PV]\d+)�/){
	print "</line>\n" if $linecnt;
	$linecnt = $1;
	print "<line $linecnt>\n";
      }
      
      ## 7. nextline ignorieren
      elsif (/\&\|/){
	print STDERR "&| ignoriert ($_)\n" if $opt_d;
      }
      
      else {
	
	## Rest aufteilen und ausgeben
	if (/_/){ # Wort_PosLemma
	  ($wort,$rest) = /^([^_]+)_(.*)/;
	  print STDERR "Nanu? >>$_<<\n" unless $wort;
	  &ausgeben($wort, $rest) if $rest;
	  if ($rest =~ /70,/){ # Satzbeginn!
	    print STDERR "Satz: $_\n" if $opt_d;
	    $satz++;
	    print "</s>\n<s $satz>\n";
	  }
	}
	else {
	  print "$_\tUNDEF\tUNDEF\tUNDEF\tUNDEF\tUNDEF\tUNDEF\tUNDEF\tUNDEF\n";
	}
      }
    } @zeile;
  }
} #end while


## SGML-Tags schlie�en
print "</line>\n";
print "</chapter>\n" if $chapter;
#print "</year>\n" if $year;
print "</page>\n";
print "</type>\n";
print "</par>\n" if $par;
print "</genr>\n</title>\n</author>\n";
print "</s>\n";

print "Programm $0 beendet\n" if $opt_v;


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

sub ausgeben {
  
  local $word = shift;
  local $_ = shift;

  $msform = $word;
  $philform = $word;
  $corr = "n"; # word corrected?

  ## 1. word aufteilen nach word/msform/philform
# Modifiche e parti aggiunte 01/12/2008
# trova char + &[(| + char + &])| + char
  if ($word =~ /^([^\&]+)\&\[([^\&]+)\&\](.*)/){
    $msform = $1.$3 if $3;
    $msform = $1 unless $3;
    $philform =~ s/\&//g;
    $word =~ s/(\&\[|\&\])//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
  if ($word =~ /^([^\&]+)\&\(([^\&]+)\&\)(.*)/){
    $msform = $1.$3 if $3;
    $msform = $1 unless $3;
    $philform =~ s/\&//g;
    $word =~ s/(\&\(|\&\))//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }  
  if ($word =~ /^([^\&]+)\&\¦([^\&]+)\&\¦(.*)/){
    $msform = $1.$3 if $3;
    $msform = $1 unless $3;
    $philform =~ s/\&//g;
    $word =~ s/\&\¦//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
# trova &[(| + char + &])|
  if ($word =~ /^\&\[([^\&]+)\&\]$/){
    $msform = "--";
    $philform =~ s/\&//g;
    $word =~ s/(\&\[|\&\])//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
  if ($word =~ /^\&\¦([^\&]+)\&\¦$/){
    $msform = "--";
    $philform =~ s/\&//g;
    $word =~ s/(\&\¦|\&\¦)//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
# trova &[(| + char + &])| + char + &[(| + char + &])| + char
 if ($word =~ /^\&\[([^\&]+)\&\]([^\&]+)\&\[([^\&]+)\&\](.*)/){
    $msform = $2.$4;
    $philform =~ s/\&//g;
    $word =~ s/(\&\[|\&\])//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
# trova &[(| + char + &])| + char
 if ($word =~ /^\&\[([^\&]+)\&\](.*)/){
    $msform = $2;
    $philform =~ s/\&//g;
    $word =~ s/(\&\[|\&\])//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
  if ($word =~ /^\&\(([^\&]+)\&\)(.*)/){
    $msform = $2;
    $philform =~ s/\&//g;
    $word =~ s/(\&\(|\&\))//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }  
  if ($word =~ /^\&\¦([^\&]+)\&\¦(.*)/){
    $msform = $2;
    $philform =~ s/\&//g;
    $word =~ s/\&\¦//g;
    $word = "EMPTY" unless $word; # falls leer sonst!
    $corr = "y";
    print STDERR "Wort >$word< ms >$msform< phil >$philform<\n" if $opt_d;
  }
  ## 2. Rest aufteilen
  if (/\(/){
    print STDERR "kompliziert...>>$_<<\n" if $opt_d;
    ##altro   kompliziert...>>(lem=altro,26,0,4,6,8,0);(lem=altro,30,0,4,6,0,0);(lem=altro,32,0,4,6,0,0)<<

    local $lem = "";
    local $pos = "";
    local $cat = "";
    
    while($_){
      ($eins,$zwei) = /^\(([^\)]+)\)\;(.*)/; 
      print STDERR "Eins $eins<< Zwei $zwei<<\n" if $opt_d;
      
      if (!$eins && !$zwei){ # Abbruch, falls nur ein Element!
	$eins = $_;
	$eins =~ s/^\(//;  # runde Klammer auf weg, wenn da
 	chop $eins;        # runde Klammer zu weg
      }
      
      $_ = $zwei if $zwei;
      $_ = "" unless $zwei;
      
      $eins =~ s/lemm?=//;
#	$eins =~ /lemm?=([^\,]+),(.*)/;
      $eins =~ /([^\,]+),(.*)/;


      local $vorne = $1;
      local $hinten= $2;
      print STDERR "Komisch $. >>$vorne<< >>$hinten<< eins/zwei <<$eins<<$zwei<<\n" unless ($vorne&&$hinten);
      $lem .= "|".$vorne if $lem;
      $lem  = $vorne unless $lem;

      ## $hinten ==> $pos und $cat
      $hinten =~ /(\d+).*/;
      local $a = $1;
      $pos .= "|".$a if $pos;
      $pos  = $a unless $pos;
      $cat .= "|".$hinten if $cat;
      $cat  = $hinten unless $cat;
      
    }
    $pos = &austausch($pos);
    $cat = "|".$cat."|"; # für "contains"-Abfrage in CQP!
    $msform =~ s/\&([\[\]\(\)\¦])/$1/g; # & entfernen!
    $philform =~ s/\&([\[\]\(\)\¦])/$1/g; # & entfernen!
    print "$word\t$lem\t$pos\t$cat\t$type\t$corr\t$genre\t$msform\t$philform\n";
    
  }
  else {
    /lemm?=([^,]+),(.*)/;
    local $lem = $1;
    local $pos = $2;
    $cat = $pos;
    $pos =~ s/(\d+).*/$1/;
      
    $pos = &austausch($pos);
    $cat = "|".$cat."|"; # für "contains"-Abfrage in CQP!
    $msform =~ s/\&([\[\]\(\)\¦])/$1/g; # & entfernen!
    $philform =~ s/\&([\[\]\(\)\¦])/$1/g; # & entfernen!
    print "$word\t$lem\t$pos\t$cat\t$type\t$corr\t$genre\t$msform\t$philform\n";
  }
}
      

sub write_ln {
  
    print "</line>\n" if $linecnt;
    $linecnt++;
    print "<line $linecnt>\n";
}  


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 no', 
     '38', 'pd per s ob', 
     '39', 'pd per w ob', 
     '40', 'pd exc', 
     '41', 'pd.per.w.no', 
     '45', 'adv gn', 
     '46', 'adv pc', 
     '47', 'adv.cnt', 
     '50', 'conj co', 
     '51', 'conj sb', 
     '56', 'adp pre', 
     '57', 'adp post', 
     '60', 'art d', 
     '61', 'art i', 
     '64', 'num car', 
     '65', 'num ord', 
     '68', 'intj', 
     '70', 'punct fi', 
     '71', 'punct nfi', 
     '75', 'r frg', 
     '76', 'r abb', 
     '77', 'r for', 
     '78', 'r epe', 
     '111', 'v m f ind pr', 
     '112', 'v m f ind ipf', 
     '113', 'v m f ind pt', 
     '114', 'v m f ind ft', 
     '115', 'v m f sub pr', 
     '116', 'v m f sub ipf', 
     '117', 'v m f cnd pr', 
     '118', 'v m f imp pr', 
     '121', 'v m nf inf pr', 
     '122', 'v m nf par pr', 
     '123', 'v m nf par pt', 
     '124', 'v m nf ger pr', 
     '211', 'v a f ind pr', 
     '212', 'v a f ind ipf', 
     '213', 'v a f ind pt', 
     '214', 'v a f ind ft', 
     '215', 'v a f sub pr', 
     '216', 'v a f sub ipf', 
     '217', 'v a f cnd pr', 
     '218', 'v a f imp pr', 
     '221', 'v a nf inf pr', 
     '222', 'v a nf par pr', 
     '223', 'v a nf par pt', 
     '224', 'v a nf ger pr', 
     '311', 'v md f ind pr', 
     '312', 'v md f ind ipf', 
     '313', 'v md f ind pt', 
     '314', 'v md f ind ft', 
     '315', 'v md f sub pr', 
     '316', 'v md f sub ipf', 
     '317', 'v md f cnd pr', 
     '318', 'v md f imp pr', 
     '321', 'v md nf inf pr', 
     '322', 'v md nf par pr', 
     '323', 'v md nf par pt', 
     '324', 'v md nf ger 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__

</author>
</chapter>
</line>
</page>
</par>
</s>
</title>
</type>
#</year>
<chapter .01.rubrica>
<line 10000>