#!/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 # 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 \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 "\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 "\n\n\n" if ($author && $title); die "Genre fehlt ($_)\n" unless $3; $author = $1; $title = $2; $genre = $3; print "\n\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\n\n"; print "\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 "\n" if $linecnt; $linecnt++; print "\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__ #