/[wait]/branches/WAIT_1_9/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

Annotation of /branches/WAIT_1_9/lib/WAIT/Query/Wais.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 84 - (hide annotations)
Mon May 24 13:00:31 2004 UTC (20 years ago) by unknown
File size: 14147 byte(s)
This commit was manufactured by cvs2svn to create branch 'WAIT_1_9'.
1 ulpfr 10
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 ulpfr 19 ;# Last Modified On: Sun Nov 22 18:44:28 1998
9 ulpfr 10 ;# 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 ulpfr 19 warn "yyerror: @_ $.\n";
391 ulpfr 10 }
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 ulpfr 19 warn "yylex($token=$verbose$val)\n";
415 ulpfr 10 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;

Properties

Name Value
cvs2svn:cvs-rev 1.1.1.2

  ViewVC Help
Powered by ViewVC 1.1.26