source: app/src/ser/ser @ 13a8a67

help
Last change on this file since 13a8a67 was e2bde98, checked in by obrebski <obrebski@…>, 16 years ago

Napawiony ser - musialem przerobic z powrotem te na system w dwoch liniach.
(Wyglada na to, ze program uruchomiony w tych nie ma lacznosci z konsola)

git-svn-id: svn://atos.wmid.amu.edu.pl/utt@20 e293616e-ec6a-49c2-aa92-f4a8b91c5d16

  • Property mode set to 100755
File size: 4.7 KB
Line 
1#!/usr/bin/perl
2
3#package:        UAM Text Tools
4#component:      ser (pattern search tool)
5#version:        1.0
6#author:         Tomasz Obrebski
7
8use strict;
9use Getopt::Long;
10use File::Temp;
11use File::HomeDir;
12
13my $LIB_DIR="/usr/local/lib/utt";
14my $systemconfigfile='/usr/local/etc/utt/ser.conf';
15#my $userconfigfile="$ENV{'HOME'}/.utt/ser.conf";
16my $userconfigfile=home()."/.utt/ser.conf";
17
18Getopt::Long::Configure('no_ignore_case_always');
19
20my $help=0;
21my $pattern=0;
22my $only_matching=0;
23my $no_markers=0;
24my $macros=0;
25my $flextemplate=0;
26my $flex=0;
27my $morfield='lem';
28
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);
40                if(($name eq "pattern")or($name eq "e")){
41                        $pattern=$value;
42                }
43                elsif($name eq "morph"){
44                        $morfield=$value;
45                }
46                elsif(($name eq "only-matching")or($name eq "m")){
47                        $only_matching=1;
48                }
49                elsif(($name eq "no-markers")or($name eq "M")){
50                        $no_markers=1;
51                }
52                elsif($name eq "macros"){
53                        $macros=$value;
54                }
55                elsif($name eq "flex-template"){
56                        $flextemplate=$value;
57                }
58                elsif($name eq "flex"){
59                        $flex=1;
60                }
61                elsif(($name eq "help")or($name eq "h")){
62                        $help=1;
63                }
64       
65        } 
66        close CONFIG;
67  }
68}
69#########################################################
70
71GetOptions("pattern|e=s" => \$pattern,
72           "morph=s" => \$morfield,
73           "only-matching|m" => \$only_matching,
74           "no-markers|M" => \$no_markers,
75           "macros=s" => \$macros,
76           "flex-template=s" => \$flextemplate,
77           "flex" => \$flex,
78           "help|h" => \$help);
79
80if($help)
81{
82    print <<'END'
83Usage: ser [OPTIONS] [file ..]
84
85Options:
86   --help -h                      Help.
87   --pattern=PATTERN -e PATTERN   Search pattern.
88   --morph=STRING                 Field containing morphological information (default 'lem').
89   --macros=FILE                  Read macrodefinitions from FILE.
90   --flex-template=FILE           Read flex code template from FILE.
91   --only-matching -m             Print only fragments matching PATTERN.
92   --no-markers -M                Do not print BOM and EOM markers [TODO].
93   --flex                         Print only the generated flex code and exit.
94END
95;
96    exit 0;
97}
98
99
100die("$0: no pattern given.\n") unless $pattern;
101
102die("$0: flex template file not found") unless
103    $flextemplate or
104    -e "$LIB_DIR/ser.l.template" and $flextemplate="$LIB_DIR/ser.l.template";
105
106die("$0: macro file not found") unless
107    $macros or
108    -e "$LIB_DIR/terms.m4" and $macros="$LIB_DIR/terms.m4";
109
110
111#$pattern =~ s/cat\(([^)]+)\)/'cat('.pre($1).')'/ge;
112# quoting escaped commas /NIE DZIA£A/
113$pattern =~ s/\\,/\\`\\`\\,''/g;
114
115# protecting backslash
116$pattern =~ s/\\/\\\\\\/g;
117
118# discarding spaces
119$pattern =~ s/\s+/\\`'/g; #`
120
121
122my $flexpattern = `echo \"$pattern\" | m4 --define=ENDOFSEGMENT=\\\\n --define=MORFIELD=$morfield $macros - 2>/dev/null`;
123
124die("Incorrect pattern (m4).") if $? >> 8;
125
126
127chomp $flexpattern;
128
129# <> expansion
130$flexpattern =~ s/<([^>]+)>/`echo $1 | tag2re`/ge;
131
132# restricting the value of the . special symbol
133$flexpattern =~ s/\./[^ \\t\\n\\r\\f]/g;
134
135# perl-like shortcuts for character classes
136# perl exact
137$flexpattern =~ s/\\s/[ \\t]/g;
138$flexpattern =~ s/\\S/[^ \\t\\n\\r\\f]/g;
139$flexpattern =~ s/\\d/[0-9]/g;
140$flexpattern =~ s/\\D/[^0-9 \\t\\n\\r\\f]/g;
141$flexpattern =~ s/\\w/[a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_]/g;
142$flexpattern =~ s/\\W/[^a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_ \\t\\n\\r\\f]/g;
143# extensions
144$flexpattern =~ s/\\l/[a-z±æê³ñ󶌿]/g; #lowercase letter
145$flexpattern =~ s/\\L/[A-Z¡ÆÊ£ÑÓŠ¬¯]/g; #upercase letter
146
147# protecting slash
148$flexpattern =~ s/\//\\\//g;
149
150my $defaultaction = ($only_matching) ? '' : 'ECHO';
151
152# docelowo posrednie pliki powinny byc w jakims tempie !!!
153
154(undef, my $tmpfile_l) = File::Temp::tempfile(SUFFIX=>'.l');
155(undef, my $tmpfile_c) = File::Temp::tempfile(SUFFIX=>'.c');
156(undef, my $tmpfile_x) = File::Temp::tempfile();
157
158# w tych `` nie dziala
159#`m4 "--define=PATTERN=$flexpattern" "--define=DEFAULTACTION=$defaultaction" $flextemplate > $tmpfile_l`;
160
161system "m4 \"--define=PATTERN=$flexpattern\" \"--define=DEFAULTACTION=$defaultaction\" $flextemplate > $tmpfile_l";
162
163if($flex)
164{
165    # w tych `` nie dziala
166    system "cat $tmpfile_l";
167#       if(open(FLEX, $tmpfile_l)) {
168#               while(<FLEX>) {
169#                       print @_;
170#               }
171#               close FLEX;
172#       }
173#       else {
174#               print "Unable to open file $tmpfile_l\n";
175#       }
176    exit(0);
177}
178
179`flex -o$tmpfile_c $tmpfile_l`;
180`cc -O3 -o $tmpfile_x $tmpfile_c -lfl`;
181#`$tmpfile_x`;
182
183system "$tmpfile_x";
184
185unlink $tmpfile_l;
186unlink $tmpfile_c;
187unlink $tmpfile_x;
Note: See TracBrowser for help on using the repository browser.