/[wait]/branches/unido/lib/WAIT/Query/Wais.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /branches/unido/lib/WAIT/Query/Wais.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 106 - (show annotations)
Tue Jul 13 12:22:09 2004 UTC (19 years, 9 months ago) by dpavlin
File size: 14147 byte(s)
Changes made by Andreas J. Koenig <andreas.koenig(at)anima.de> for Unido project

1
2 ;# -*- Mode: Perl -*-
3 ;# waisquery.y --
4 ;# ITIID : $ITI$ $Header $__Header$
5 ;# Author : Ulrich Pfeifer
6 ;# Created On : Fri Sep 13 15:54:19 1996
7 ;# Last Modified By: Ulrich Pfeifer
8 ;# Last Modified On: Sun Nov 22 18:44:28 1998
9 ;# Language : CPerl
10 ;# Update Count : 129
11 ;# Status : Unknown, Use with caution!
12 ;#
13 ;# Copyright (c) 1996-1997, Ulrich Pfeifer
14 ;#
15
16 package WAIT::Query::Wais;
17 use WAIT::Query::Base;
18 use Carp;
19 use strict;
20 use vars qw($WORD $PHONIX $SOUNDEX $ASSIGN $FLOAT $OR $AND $NOT $PROX_ORDERED
21 $PROX_UNORDERED $PROX_ATLEAST
22 $yylval $yyval $YYTABLESIZE $Table
23 %TOKEN);
24 my %VERBOSE ;
25 no strict 'vars';
26 $WORD=257;
27 $PHONIX=258;
28 $SOUNDEX=259;
29 $ASSIGN=260;
30 $FLOAT=261;
31 $OR=262;
32 $AND=263;
33 $NOT=264;
34 $PROX_ORDERED=265;
35 $PROX_UNORDERED=266;
36 $PROX_ATLEAST=267;
37 $YYERRCODE=256;
38 @yylhs = ( -1,
39 0, 2, 2, 1, 1, 3, 3, 3, 4, 4,
40 4, 4, 5, 5, 7, 5, 9, 5, 10, 5,
41 11, 5, 12, 5, 13, 13, 8, 8, 14, 14,
42 14, 15, 15, 15, 15, 16, 16, 17, 17, 6,
43 6,
44 );
45 @yylen = ( 2,
46 1, 0, 1, 1, 3, 1, 3, 3, 1, 3,
47 3, 2, 1, 3, 0, 6, 0, 4, 0, 4,
48 0, 4, 0, 7, 1, 1, 1, 3, 1, 3,
49 3, 1, 3, 3, 2, 1, 3, 1, 2, 1,
50 3,
51 );
52 @yydefred = ( 0,
53 0, 25, 26, 0, 0, 0, 0, 0, 6, 0,
54 13, 0, 0, 0, 0, 0, 0, 12, 0, 3,
55 0, 0, 0, 0, 0, 39, 0, 0, 0, 0,
56 0, 0, 14, 0, 7, 8, 10, 11, 41, 0,
57 38, 18, 20, 22, 0, 0, 0, 36, 0, 0,
58 29, 0, 0, 35, 0, 16, 0, 0, 0, 0,
59 0, 0, 37, 0, 30, 31, 33, 34, 24,
60 );
61 @yydgoto = ( 6,
62 7, 21, 8, 9, 10, 11, 28, 49, 29, 15,
63 16, 17, 12, 50, 51, 52, 13,
64 );
65 @yysindex = ( -15,
66 -61, 0, 0, -4, -15, 0, -257, -248, 0, -239,
67 0, -246, -251, 0, -9, -25, -46, 0, -35, 0,
68 -15, -15, -15, -4, -4, 0, -211, 14, -236, -199,
69 -198, -197, 0, -248, 0, 0, 0, 0, 0, -10,
70 0, 0, 0, 0, 18, 53, -10, 0, -34, -230,
71 0, -226, -186, 0, -23, 0, -10, -10, -10, 53,
72 53, -20, 0, -230, 0, 0, 0, 0, 0,
73 );
74 @yyrindex = ( 0,
75 1, 0, 0, 0, 0, 0, 57, 35, 0, 24,
76 0, 0, 12, 60, 0, 0, 0, 0, 42, 0,
77 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
78 0, 0, 0, 46, 0, 0, 0, 0, 0, 0,
79 0, 0, 0, 0, 0, 0, 0, 0, 42, -27,
80 0, -38, 0, 0, 42, 0, 0, 0, 0, 0,
81 0, 0, 0, -21, 0, 0, 0, 0, 0,
82 );
83 @yygindex = ( 0,
84 67, -45, 56, 21, 4, 9, 0, 27, 0, 0,
85 0, 0, 0, 22, -11, -29, 0,
86 );
87 $YYTABLESIZE=324;
88 @yytable = ( 14,
89 38, 32, 32, 57, 20, 33, 56, 18, 27, 57,
90 26, 40, 27, 27, 22, 23, 54, 63, 28, 28,
91 41, 2, 3, 9, 5, 24, 25, 37, 38, 47,
92 67, 68, 58, 59, 4, 5, 31, 42, 60, 61,
93 38, 38, 35, 36, 32, 5, 65, 66, 48, 39,
94 30, 40, 40, 40, 48, 48, 1, 43, 44, 45,
95 19, 53, 21, 9, 9, 48, 48, 48, 48, 48,
96 62, 19, 69, 55, 4, 4, 34, 0, 64, 0,
97 0, 2, 0, 0, 0, 5, 5, 0, 0, 0,
98 0, 23, 47, 0, 0, 0, 2, 0, 0, 15,
99 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
100 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
101 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
102 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
103 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
104 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
105 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
106 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
107 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
108 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
109 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
110 0, 0, 0, 0, 0, 0, 0, 0, 32, 32,
111 32, 0, 0, 32, 32, 32, 20, 20, 32, 27,
112 27, 27, 0, 0, 27, 28, 28, 28, 20, 27,
113 28, 1, 2, 3, 0, 28, 41, 2, 3, 0,
114 0, 4, 1, 2, 3, 0, 46, 38, 38, 38,
115 38, 0, 38, 38, 38, 38, 38, 38, 40, 40,
116 40, 0, 0, 40, 40, 40, 40, 40, 40, 0,
117 9, 9, 9, 0, 0, 9, 9, 9, 0, 0,
118 9, 4, 4, 4, 0, 0, 4, 0, 2, 2,
119 2, 4, 5, 5, 5, 0, 0, 5, 2, 41,
120 2, 3, 5, 2, 2, 2, 17, 17, 17, 0,
121 0, 0, 0, 2,
122 );
123 @yycheck = ( 61,
124 0, 40, 41, 49, 262, 41, 41, 4, 260, 55,
125 257, 0, 40, 41, 263, 264, 46, 41, 40, 41,
126 257, 258, 259, 0, 40, 265, 266, 24, 25, 40,
127 60, 61, 263, 264, 0, 40, 62, 29, 265, 266,
128 40, 41, 22, 23, 91, 0, 58, 59, 40, 261,
129 60, 40, 41, 40, 46, 47, 0, 257, 257, 257,
130 60, 44, 62, 40, 41, 57, 58, 59, 60, 61,
131 257, 5, 93, 47, 40, 41, 21, -1, 57, -1,
132 -1, 40, -1, -1, -1, 40, 41, -1, -1, -1,
133 -1, 91, 40, -1, -1, -1, 40, -1, -1, 40,
134 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
135 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
136 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
137 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
138 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
139 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
140 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
141 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
142 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
143 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
144 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
145 -1, -1, -1, -1, -1, -1, -1, -1, 257, 258,
146 259, -1, -1, 262, 263, 264, 262, 262, 267, 257,
147 258, 259, -1, -1, 262, 257, 258, 259, 262, 267,
148 262, 257, 258, 259, -1, 267, 257, 258, 259, -1,
149 -1, 267, 257, 258, 259, -1, 267, 257, 258, 259,
150 260, -1, 262, 263, 264, 265, 266, 267, 257, 258,
151 259, -1, -1, 262, 263, 264, 265, 266, 267, -1,
152 257, 258, 259, -1, -1, 262, 263, 264, -1, -1,
153 267, 257, 258, 259, -1, -1, 262, -1, 257, 258,
154 259, 267, 257, 258, 259, -1, -1, 262, 267, 257,
155 258, 259, 267, 257, 258, 259, 257, 258, 259, -1,
156 -1, -1, -1, 267,
157 );
158 $YYFINAL=6;
159
160
161
162 $YYMAXTOKEN=267;
163
164 sub yyclearin { $yychar = -1; }
165 sub yyerrok { $yyerrflag = 0; }
166 $YYSTACKSIZE = $YYSTACKSIZE || $YYMAXDEPTH || 500;
167 $YYMAXDEPTH = $YYMAXDEPTH || $YYSTACKSIZE || 500;
168 $yyss[$YYSTACKSIZE] = 0;
169 $yyvs[$YYSTACKSIZE] = 0;
170 sub YYERROR { ++$yynerrs; &yy_err_recover; }
171 sub yy_err_recover
172 {
173 if ($yyerrflag < 3)
174 {
175 $yyerrflag = 3;
176 while (1)
177 {
178 if (($yyn = $yysindex[$yyss[$yyssp]]) &&
179 ($yyn += $YYERRCODE) >= 0 &&
180 $yycheck[$yyn] == $YYERRCODE)
181 {
182
183
184
185
186 $yyss[++$yyssp] = $yystate = $yytable[$yyn];
187 $yyvs[++$yyvsp] = $yylval;
188 next yyloop;
189 }
190 else
191 {
192
193
194
195
196 return(1) if $yyssp <= 0;
197 --$yyssp;
198 --$yyvsp;
199 }
200 }
201 }
202 else
203 {
204 return (1) if $yychar == 0;
205
206 $yychar = -1;
207 next yyloop;
208 }
209 0;
210 } # yy_err_recover
211
212 sub yyparse
213 {
214
215 if ($yys = $ENV{'YYDEBUG'})
216 {
217 $yydebug = int($1) if $yys =~ /^(\d)/;
218 }
219
220
221 $yynerrs = 0;
222 $yyerrflag = 0;
223 $yychar = (-1);
224
225 $yyssp = 0;
226 $yyvsp = 0;
227 $yyss[$yyssp] = $yystate = 0;
228
229 yyloop: while(1)
230 {
231 yyreduce: {
232 last yyreduce if ($yyn = $yydefred[$yystate]);
233 if ($yychar < 0)
234 {
235 if (($yychar = &yylex) < 0) { $yychar = 0; }
236
237 }
238 if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
239 $yycheck[$yyn] == $yychar)
240 {
241
242
243
244
245 $yyss[++$yyssp] = $yystate = $yytable[$yyn];
246 $yyvs[++$yyvsp] = $yylval;
247 $yychar = (-1);
248 --$yyerrflag if $yyerrflag > 0;
249 next yyloop;
250 }
251 if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
252 $yycheck[$yyn] == $yychar)
253 {
254 $yyn = $yytable[$yyn];
255 last yyreduce;
256 }
257 if (! $yyerrflag) {
258 &yyerror('syntax error');
259 ++$yynerrs;
260 }
261 return(1) if &yy_err_recover;
262 } # yyreduce
263
264
265
266
267 $yym = $yylen[$yyn];
268 $yyval = $yyvs[$yyvsp+1-$yym];
269 switch:
270 {
271 if ($yyn == 5) {
272 { $yyval = $yyval->merge($yyvs[$yyvsp-0]);
273 last switch;
274 } }
275 if ($yyn == 7) {
276 {$yyval = new WAIT::Query::and $yyvs[$yyvsp-2], $yyvs[$yyvsp-0];
277 last switch;
278 } }
279 if ($yyn == 8) {
280 {$yyval = new WAIT::Query::not $yyvs[$yyvsp-2], $yyvs[$yyvsp-0];
281 last switch;
282 } }
283 if ($yyn == 14) {
284 { $yyval = $yyvs[$yyvsp-1];
285 last switch;
286 } }
287 if ($yyn == 15) {
288 {enter($yyvs[$yyvsp-1]);
289 last switch;
290 } }
291 if ($yyn == 16) {
292 {leave($yyvs[$yyvsp-5]); $yyval = $yyvs[$yyvsp-1];
293 last switch;
294 } }
295 if ($yyn == 17) {
296 {enter($yyvs[$yyvsp-1]);
297 last switch;
298 } }
299 if ($yyn == 18) {
300 {leave($yyvs[$yyvsp-3]); $yyval = $yyvs[$yyvsp-0];
301 last switch;
302 } }
303 if ($yyn == 19) {
304 {enter($yyvs[$yyvsp-0]);
305 last switch;
306 } }
307 if ($yyn == 20) {
308 {$yyval = intervall(undef, $yyvs[$yyvsp-0]); leave($yyvs[$yyvsp-3]);
309 last switch;
310 } }
311 if ($yyn == 21) {
312 {enter($yyvs[$yyvsp-0]);
313 last switch;
314 } }
315 if ($yyn == 22) {
316 {$yyval = intervall($yyvs[$yyvsp-0], undef); leave($yyvs[$yyvsp-3]);
317 last switch;
318 } }
319 if ($yyn == 23) {
320 {enter($yyvs[$yyvsp-0]);
321 last switch;
322 } }
323 if ($yyn == 24) {
324 {$yyval = intervall($yyvs[$yyvsp-3], $yyvs[$yyvsp-1]); leave($yyvs[$yyvsp-6]);
325 last switch;
326 } }
327 if ($yyn == 28) {
328 { $yyval = $yyval->merge($yyvs[$yyvsp-0]);
329 last switch;
330 } }
331 if ($yyn == 30) {
332 {$yyval = new WAIT::Query::and $yyvs[$yyvsp-2], $yyvs[$yyvsp-0];
333 last switch;
334 } }
335 if ($yyn == 31) {
336 {$yyval = new WAIT::Query::not $yyvs[$yyvsp-2], $yyvs[$yyvsp-0];
337 last switch;
338 } }
339 if ($yyn == 37) {
340 { $yyval = $yyvs[$yyvsp-1];
341 last switch;
342 } }
343 if ($yyn == 38) {
344 { $yyval = plain($yyvs[$yyvsp-0]);
345 last switch;
346 } }
347 if ($yyn == 39) {
348 { $yyval = plain($yyvs[$yyvsp-0]);
349 last switch;
350 } }
351 } # switch
352 $yyssp -= $yym;
353 $yystate = $yyss[$yyssp];
354 $yyvsp -= $yym;
355 $yym = $yylhs[$yyn];
356 if ($yystate == 0 && $yym == 0)
357 {
358
359
360
361
362 $yystate = $YYFINAL;
363 $yyss[++$yyssp] = $YYFINAL;
364 $yyvs[++$yyvsp] = $yyval;
365 if ($yychar < 0)
366 {
367 if (($yychar = &yylex) < 0) { $yychar = 0; }
368
369 }
370 return(0) if $yychar == 0;
371 next yyloop;
372 }
373 if (($yyn = $yygindex[$yym]) && ($yyn += $yystate) >= 0 &&
374 $yyn <= $#yycheck && $yycheck[$yyn] == $yystate)
375 {
376 $yystate = $yytable[$yyn];
377 } else {
378 $yystate = $yydgoto[$yym];
379 }
380
381
382
383
384 $yyss[++$yyssp] = $yystate;
385 $yyvs[++$yyvsp] = $yyval;
386 } # yyloop
387 } # yyparse
388 use strict;
389 sub yyerror {
390 warn "yyerror: @_ $.\n";
391 }
392
393 for (qw(and or not phonix soundex)) {
394 my $e = sprintf '$WAIT::Query::Wais::TOKEN{$_} = $%s', uc($_);
395 eval $e;
396 die $@ if $@ ne '';
397 $VERBOSE{$TOKEN{$_}} = $_;
398 }
399 $VERBOSE{$WORD} = 'WORD';
400 my $KEY = join('|', keys %TOKEN);
401
402 my $line;
403
404 sub yylex1 {
405 print "=>$line\n";
406 my $token = yylex1();
407 my $verbose;
408 my $val = (defined $yylval)?",$yylval":'';
409 if ($token < 256) {
410 $verbose = "'".chr($token)."'";
411 } else {
412 $verbose = $VERBOSE{$token};
413 }
414 warn "yylex($token=$verbose$val)\n";
415 return $token;
416 }
417
418 my $Intervall = 0;
419 sub yylex {
420 $yylval = undef;
421 $line =~ s:^\s+::;
422 if ($line =~ s:^($KEY)\b::io) {
423 return $TOKEN{$1}
424 } elsif ($line =~ s/^(\w+)\s*==?/=/io) {
425 $yylval = $1;
426 return $WORD;
427 } elsif ($line =~ s:^([=()<>])::) {
428 return ord($1);
429 } elsif ($Intervall and $line =~ s:^,::) {
430 return ord(',');
431 } elsif ($line =~ s:^\[::) {
432 $Intervall = 1;
433 return ord('[');
434 } elsif ($line =~ s:^\]::) {
435 $Intervall = 0;
436 return ord(']');
437 } elsif ($Intervall and $line =~ s:^([^,\]]+)::) {
438 $yylval = $1;
439 return $WORD;
440 } elsif ($line =~ s:^([^=\[<>()\n\r\t ]+)::) {
441 $yylval = $1;
442 return $WORD;
443 }
444 return 0;
445 }
446
447 my @FLD;
448
449 use vars qw(%FLD);
450
451 sub fields {
452 if (ref $FLD[-1]) {
453 @{$FLD[-1]}
454 } else {
455 $FLD[-1];
456 }
457 }
458
459
460 sub enter {
461 my $field = shift;
462
463 if ($FLD{$field}) {
464 push @FLD, $FLD{$field};
465 } else {
466 croak "Unknown field name: $field";
467 }
468 }
469
470 sub leave {
471 pop @FLD;
472 }
473
474 sub plain {
475 my $word = shift;
476
477 if ($word =~ s:\*$::) {
478 prefix($word);
479 } else {
480 new WAIT::Query::Base $Table, $FLD[-1], Plain => $word;
481 }
482 }
483
484 sub prefix {
485 my $word = shift;
486 my ($ff, @fld) = fields();
487 my $raw = $Table->prefix($ff, $word);
488 for $ff (@fld) {
489 my $new = $Table->prefix($ff, $word);
490 $raw->merge($new);
491 }
492 new WAIT::Query::Base ($Table, $FLD[-1], Raw => $raw);
493 }
494
495 sub intervall {
496 my ($left, $right) = @_;
497 my ($ff, @fld) = fields();
498 my $raw = $Table->intervall($ff, $left, $right);
499 for $ff (@fld) {
500 my $new = $Table->intervall($ff, $left, $right);
501 $raw->merge($new);
502 }
503 new WAIT::Query::Base ($Table, $FLD[-1], Raw => $raw);
504 }
505
506 use Text::Abbrev;
507 sub query {
508 local($Table) = shift;
509 $line = shift;
510
511 my @fields = $Table->fields;
512
513 @FLD = (\@fields); # %FLD = abbrev(@fields); # patched Text::Abbrev
514 abbrev(*FLD,@fields);
515 yyparse();
516 $yyval;
517 }
518
519 1;

  ViewVC Help
Powered by ViewVC 1.1.26