source: _old/app/src/dgp/dgc @ 57728c1

Last change on this file since 57728c1 was 57728c1, checked in by Mateusz Hromada <ruanda@…>, 15 years ago

Move old files to _old dir.

  • Property mode set to 100755
File size: 5.7 KB
RevLine 
[0214596]1#!/usr/bin/perl
2
3#package:       UAM Text Tools
4#component:     dgc (dg compiler)
5#version:       1.0
6#author:        Tomasz Obrebski
7
[19dfa5c]8# wymaga niejawnie programu canonize!!!!
[6b3be72]9use lib "/usr/local/lib/utt";
[adb4c8d]10use lib "$ENV{'HOME'}/.local/lib/utt";
[19dfa5c]11
12use strict;
[0214596]13use Getopt::Long;
14use Data::Dumper;
15use attr;
[19dfa5c]16use File::HomeDir;
17
18my $systemconfigfile='/usr/local/etc/utt/dgc.conf';
19my $userconfigfile=home()."/.utt/dgc.conf";
20
21Getopt::Long::Configure('no_ignore_case_always');
[0214596]22
23my $help=0;
24my $catfile=0;
25my $dicfile=0;
26my $gramfile=0;
[19dfa5c]27my $outputfile=0;
[0214596]28
[19dfa5c]29#read configuration files###########################
30my $file;
31foreach $file ($systemconfigfile, $userconfigfile){
32  if(open(CONFIG, $file)){
33        while (<CONFIG>) {
34                chomp;
35                s/#.*//;
36                s/^\s+//;
37                s/\s+$//;
38                next unless length;
39                my ($name, $value) = split(/\s*=\s*/, $_, 2);
[3748bd1]40                if(($name eq "categories")or($name eq "c")){
[19dfa5c]41                        $catfile=$value;
42                }
[3748bd1]43                elsif(($name eq "dictionary")or($name eq "d")){
[19dfa5c]44                        $dicfile=$value;
45                }
[3748bd1]46                elsif(($name eq "grammar")or($name eq "g")){
[19dfa5c]47                        $gramfile=$value;
48                }
49                elsif(($name eq "outputfile")or($name eq "o")){
50                        $outputfile=$value;
51                }
52                elsif(($name eq "help")or($name eq "h")){
53                        $help=1;
54                }
55
56        }
57        close CONFIG;
58  }
59}
60#########################################################
[0214596]61
62GetOptions("help|h" => \$help,
[3748bd1]63           "categories|c=s" => \$catfile,
64           "dictionary|d=s" => \$dicfile,
65           "grammar|g=s" => \$gramfile,
[19dfa5c]66           "outputfile|o=s" => \$outputfile);
[0214596]67
[3748bd1]68my $homedir = $ENV{'HOME'};
69$catfile =~ s/~/$homedir/;
70$dicfile =~ s/~/$homedir/;
71$gramfile =~ s/~/$homedir/;
72$outputfile =~ s/~/$homedir/;
73
74
[0214596]75if($help)
76{
77    print <<'END'
[19dfa5c]78Usage: dgc [OPTIONS]
[0214596]79
80Options:
[3748bd1]81   --categories -c filename     List of syntactic categories.
82   --dictionary -d filename     Dictionary.
83   --grammar -g filename        List of grammar rules.
84   --outputfile -o filename     Output file name.
[0214596]85   --help -h                    Help.
86END
87;
88    exit 0;
89}
90
91die("At least one of --cats and --dic must be given.\n") if !$catfile && !$dicfile;
92
[19dfa5c]93my $ncat=0;
94my $nrole=0;
95my $nsgl=0;
96my $nleft=0;
97my $nright=0;
98my $nreq=0;
99my $nlink=0;
[9ace5d2]100my $nflag=0;
[19dfa5c]101
[0214596]102my %cats;
103my %roles;
104my %agr;
105my %gov;
106
[19dfa5c]107if(!$outputfile) {
108        *OUTPUT = *STDOUT;
109}
110elsif($outputfile eq "-") {
111    *OUTPUT = *STDOUT;
112}
113else {
114        open(OUTPUT, ">$outputfile") or die("Can't open output file: $outputfile!");
115}
116
117
[0214596]118loadcats($catfile) if $catfile;
119extractcats($dicfile) if $dicfile;
120
121
[19dfa5c]122my $cats_re = qr/(?:$attr::cat_re\s*(?:,\s*$attr::cat_re)*)/;
[0214596]123
124# class parse_class:
125# /$attr::cat_re/g;
126
[19dfa5c]127
128if(!$gramfile) { 
129        *INPUT = *STDIN;
130}
131elsif($gramfile eq "-"){
132    *INPUT = *STDIN;
133}
134else {
135        open(INPUT, $gramfile) or die("Unable to open: $gramfile!");
136}
137
138while(<INPUT>)
[0214596]139{
[12d8443]140    s/#.*//;
141    s/^\s+//;
142    s/\s+$//;
143    if(/^AGR\s+(\S+)\s+(\S+)$/)
[0214596]144    {
145        push @{$agr{$1}}, $2;
146    }
[12d8443]147    elsif(/^GOV\s+(\S+)\s+(\S+)$/)
[0214596]148    {
149        push @{$gov{$1}}, attr::parse($2);
150    }
[12d8443]151    elsif(/^ROLE\s+\S+$/)
[0214596]152    {
153        $roles{$_}=1;
[12d8443]154        print OUTPUT "$_\n";
[0214596]155    }
[12d8443]156    elsif(/^SGL\s+\S+$/)
[0214596]157    {
158        ++$nsgl;
[12d8443]159        print OUTPUT "$_\n";
[0214596]160    }
[12d8443]161    elsif(/^REQ\s+(\S+)\s+(\S+)$/)
[0214596]162    {
[12d8443]163        print OUTPUT "#$_\n";
[0214596]164        my $cat = attr::parse $1;
165        for my $atomcat (keys %cats)
166        {
167            if(attr::match @$cat, @{$cats{$atomcat}})
168            {
[19dfa5c]169                print OUTPUT "REQ ".$atomcat." $2\n";
[0214596]170                ++$nreq;
171            }
172        }
173    }
[12d8443]174    elsif(/^LEFT\s+\S+$/)
[0214596]175    {
176        ++$nleft;
[12d8443]177        print OUTPUT "$_\n";
[0214596]178    }
[12d8443]179    elsif(/^RIGHT\s+\S+$/)
[0214596]180    {
181        ++$nright;
[12d8443]182        print OUTPUT "$_\n";
[0214596]183    }
[12d8443]184    elsif(my ($hs,$ds,$r) = /^LINK\s+($cats_re)\s+($cats_re)\s+(\S+)$/)
[0214596]185    {
[12d8443]186        print OUTPUT "#$_\n";
[19dfa5c]187        for my $h ($hs =~ /$attr::cat_re/g)
[0214596]188        {
[19dfa5c]189            for my $d ($ds =~ /$attr::cat_re/g)
[0214596]190            {
191                addlinks($h,$d,$r);
192            }
193        }
194    }
[9ace5d2]195    elsif(/^FLAG\s+\S+$/)
196    {
197        ++$nflag;
198        print OUTPUT "$_\n"
199    }
[12d8443]200    elsif(/^$/) {
201        # pomijamy puste linie oraz komentarze
202        }
203        else
[0214596]204    {
[12d8443]205        print STDERR "Illegal format: $_\n";
[0214596]206    }
207}
208
209
210sub addlinks
211{
[19dfa5c]212    my ($h,$d,$r) = @_;
[0214596]213
[19dfa5c]214    for my $a (@{$agr{$r}}) { print OUTPUT "#AGR $r $a\n"; }
215    for my $c (@{$gov{$r}}) { print OUTPUT "#GOV $r ".attr::unparse(@$c)."\n"; }
[0214596]216    my $head = attr::parse $h;
217    my $dep = attr::parse $d;
218   
219    for my $atomhead (keys %cats)
220    {
221        if(attr::match @$head, @{$cats{$atomhead}})
222        {
223          DEP:
224            for my $atomdep (keys %cats)
225            {
226                next DEP if ! attr::match @$dep, @{$cats{$atomdep}};
227               
228                for my $a (@{$agr{$r}})
229                {
230                    next DEP if ! attr::agree(@{$cats{$atomhead}},@{$cats{$atomdep}},$a);
231                }
232               
233                for my $c (@{$gov{$r}})
234                {
235                    next DEP if ! attr::match(@$c,@{$cats{$atomdep}});
236                }
237               
[19dfa5c]238                print OUTPUT "LINK ";
239                print OUTPUT $atomhead." ";
240                print OUTPUT $atomdep." $r\n";
[0214596]241                ++$nlink;
242               
243            }
244        }
245    }
246}
247
248
249printf STDERR "%6d CAT   statements\n", 0+keys(%cats);
250printf STDERR "%6d ROLE  statements\n", 0+keys(%roles);
251printf STDERR "%6d SGL   statements\n", $nsgl;
252printf STDERR "%6d REQ   statements\n", $nreq;
253printf STDERR "%6d LEFT  statements\n", $nleft;
254printf STDERR "%6d RIGHT statements\n", $nright;
255printf STDERR "%6d LINK  statements\n", $nlink;
[9ace5d2]256printf STDERR "%6d FLAG  statements\n", $nflag;
[0214596]257
258
259sub extractcats
260{
261    my $file = shift;
262    open DICFILE, "canonize $file |";
263    while(<DICFILE>)
264    {
265        while(/,([^[:space:];]+)/g)
266        {
[19dfa5c]267            my $cat=$1;
[0214596]268            next if !$cat || exists $cats{$cat};
269            $ncat++;
[19dfa5c]270            print OUTPUT "CAT $1\n";
[0214596]271            $cats{$cat}=attr::parse($cat);
272        }
273    }
274    close DICFILE;
275}
276
277
278sub loadcats
279{
280    my $file = shift;
281    open CATFILE, "canonize $file |";
282    while(<CATFILE>)
283    {
284        tr/ \t\n//d;
285        next if !$_ || exists $cats{$_};
[19dfa5c]286        print OUTPUT "CAT $_\n";
[0214596]287        ++$ncat;
288        $cats{$_}=attr::parse($_);
289    }
290    close CATFILE;
291}
[19dfa5c]292
Note: See TracBrowser for help on using the repository browser.