#! /usr/bin/perl -- -*- coding: utf-8; -*- # Generuje wszystkie formy wszystkich leksemów w bazie Słownika # gramatycznego języka polskiego use utf8; use strict; use Encode; use DBI; #binmode STDOUT, ":encoding(latin-2)"; binmode STDOUT, ":utf8"; binmode STDERR, ":utf8"; my $baza = 'kuznia'; my $host = 'localhost'; my $port = 5432; my $dbh = DBI->connect("dbi:Pg:dbname=$baza;host=$host;port=$port", "kuznia","kuznia", {RaiseError=>1}); my $query = $dbh->prepare(qq[ select haslo, prefiks||rdzen||zak||sufiks, l.pos, ch.charfl, tag,slownik from leksemy l join odmieniasie o using(l_id) join charfle ch on ch.id = o.charfl join leksemy_w_slownikach ls using(l_id) join wzory w on (o.w_id = w.id) join szablony_tabel s on ( w.typ=s.wtyp and o.charfl=s.charfl) join klatki k on k.st_id = s.id join zakonczenia z on (o.w_id=z.w_id and k.efobaz=z.efobaz) where slownik in ('SGJP', 'Morfologik') and wlasciciel=true and l.status<>'cand' and wariant='Morfeusz' and l.pos in ('v','subst','osc','adj','adv', 'num','advndm','burk','comp','conj','interj','prep','qub') and haslo < 'ac' union all -- wymagające gniazdowania przy hasłowaniu: adjcom, advcom: select g.haslo, prefiks||rdzen||zak||sufiks, l.pos, ch.charfl, tag,slownik from leksemy l join leksemy_w_slownikach ls using(l_id) join odsylacze on l.l_id=l_id_od join leksemy g on l_id_do=g.l_id join odmieniasie o on l.l_id=o.l_id join charfle ch on ch.id = o.charfl join wzory w on (o.w_id = w.id) join szablony_tabel s on ( w.typ=s.wtyp and o.charfl=s.charfl) join klatki k on k.st_id = s.id join zakonczenia z on (o.w_id=z.w_id and k.efobaz=z.efobaz) where slownik in ('SGJP', 'Morfologik') and wlasciciel=true and typods in ('comadv','comadj','gerver','pactver','ppasver') and wariant='Morfeusz' and l.status<>'cand' and l.pos in ('adjcom','advcom','ger','pact','ppas') and g.haslo < 'ac' -- order by slowo,l.nr,o.charfl,col,row,kskl,nrskl,morf ; ]); $query->execute(); my %adjpredykatywne = ( 'ciekaw' => 1, 'godzien' => 1, 'gotów' => 1, 'łaskaw' => 1, 'świadom' => 1, 'winien' => 1, 'zdrów' => 1, # wątpliwe: 'dłużen' => 1, 'miłościw' => 1, 'praw' => 1, 'wesół' => 1, 'żyw' => 1 ); sub morf2tag { my ($pos,$charfl,$morf,$wykladnik) = @_; # print STDERR "M '$pos','$charfl','$morf'\n"; if ($pos eq 'subst' || $pos eq 'osc') { my $tag = "subst:$morf:$charfl"; $tag = "subst:pl:nom:m1" if $tag eq "subst:pl:nom:ndepr:m1"; $tag = "depr:pl:nom:m2" if $tag eq "subst:pl:nom:depr:m1"; $tag = "subst:pl:voc:m1" if $tag eq "subst:pl:voc:ndepr:m1"; $tag = "depr:pl:voc:m2" if $tag eq "subst:pl:voc:depr:m1"; $tag =~ s/:n?uni//g; return $tag; } elsif ($pos eq 'adj' || $pos eq 'adjcom') { return $morf if $morf eq 'adja'; return $morf if $morf eq 'adjp'; if ($morf eq 'adjc') { return $morf if defined $adjpredykatywne{$wykladnik}; return "adj:sg:nom:m1.m2.m3:pos|adj:sg:acc:m3:pos"; } return "adj:$morf"; } elsif ($pos eq 'adv' || $pos eq 'advcom') { return "adv:$morf"; } elsif ($pos eq 'advndm') { return "adv"; } elsif ($pos eq 'v' ) { my $perf; if ( $charfl eq 'dk' ) { $perf ='perf' } elsif ($charfl eq 'ndk' ) { $perf = 'imperf' } else { $perf = 'imperf.perf' } $perf = 'perf' if $morf =~ /^pant/; $perf = 'imperf' if $morf =~ /^pcon/; return "$morf:$perf"; } elsif ($pos eq 'pred' || $pos eq 'ger' || $pos eq 'pact' || $pos eq 'ppas') { my $perf; if ( $charfl eq 'dk' ) { $perf ='perf' } elsif ($charfl eq 'ndk' ) { $perf = 'imperf' } else { $perf = 'imperf.perf' } $morf =~ s/::/:$perf:/; # wstawiamy aspekt do środka tagu w miejscu oznaczonym :: return "$morf"; } elsif ($pos eq 'num') { return "num:$morf"; } elsif ($pos eq 'prep' ) { return "prep:$charfl:$morf" if $morf; return "prep:$charfl"; # przypadek } elsif ($pos eq 'burk' || $pos eq 'comp' || $pos eq 'conj' || $pos eq 'interj' || $pos eq 'qub' ) { return $pos; } else { print STDERR "Nieznany pos '$pos'\n"; return "$pos:$morf:$charfl"; } } while (my @row = $query->fetchrow_array) { my($haslo, $wykladnik, $pos, $charfl, $morf,$slownik) = map decode_utf8($_), @row; next unless defined($wykladnik); # pomijamy jednoliterowe nazwy liter: next if $pos eq 'subst' && length($haslo) == 1; # to eliminuje dziwne zaimki: się, toto, niecoś, wsio, wasze, ichmość: next if $pos eq 'subst' && $morf eq 'nom'; next if $wykladnik =~ /^\+/; # odmienne postfiksy $wykladnik =~ s/\+$// if $morf eq 'adja'; $wykladnik =~ s/’/'/g; # apostrof zapisujemy w ASCII! $haslo =~ s/’/'/g; # apostrof zapisujemy w ASCII! (print STDERR "spacja w formie '$wykladnik'\n"),next if $wykladnik =~ / /; (print STDERR "plus w formie '$wykladnik' ($pos/$morf)\n"),next if $wykladnik =~ /\+/; (print STDERR "pusty wykładnik hasła '$haslo' ($morf)\n"),next unless $wykladnik; (print STDERR "puste hasło '$wykladnik'\n"),next unless $haslo; # print STDERR "H:$haslo, $wykladnik, $pos, $charfl, $morf\n"; my $tag = join '|', map morf2tag($pos,$charfl,$_,$wykladnik), split('\|',$morf); $tag = morf2tag($pos,$charfl,'',$wykladnik) unless $morf; print "$wykladnik\t$haslo\t$tag\n"; }