#!/usr/bin/perl # require 'py-skel.pl'; $; = "\034"; %act = ( "0\$", 'shift 2', "0bool", 'goto 3', "0field", 'goto 5', "0(", 'shift 1', "0atom", 'goto 4', "1\$", 'shift 2', "1field", 'goto 5', "1atom", 'goto 4', "1(", 'shift 1', "1bool", 'goto 6', "2STRING", 'shift 7', "3End_of_Input", 'goto 36', "3&", 'shift 8', "3|", 'shift 9', "4\$default", 'reduce 4', "5GE", 'shift 11', "5<", 'shift 15', "5relop", 'goto 18', "5=", 'shift 14', "5>", 'shift 16', "5~", 'shift 17', "5IN", 'shift 10', "5LE", 'shift 12', "5NOMATCH", 'shift 13', "6&", 'shift 8', "6|", 'shift 9', "6)", 'shift 19', "7\$default", 'reduce 7', "8\$", 'shift 2', "8atom", 'goto 4', "8field", 'goto 5', "8(", 'shift 1', "8bool", 'goto 20', "9atom", 'goto 4', "9\$", 'shift 2', "9field", 'goto 5', "9bool", 'goto 21', "9(", 'shift 1', "10[", 'shift 22', "10range", 'goto 23', "11\$default", 'reduce 15', "12\$default", 'reduce 16', "13\$default", 'reduce 17', "14\$default", 'reduce 11', "15\$default", 'reduce 12', "16\$default", 'reduce 13', "17\$default", 'reduce 14', "18NUMBER", 'shift 25', "18\$", 'shift 2', "18STRING", 'shift 24', "18field", 'goto 26', "18val", 'goto 27', "19\$default", 'reduce 1', "20\$default", 'reduce 3', "20|", 'shift 9', "21\$default", 'reduce 2', "22NUMBER", 'shift 28', "22DOTS", 'shift 29', "23\$default", 'reduce 6', "24\$default", 'reduce 9', "25\$default", 'reduce 8', "26\$default", 'reduce 10', "27\$default", 'reduce 5', "28DOTS", 'shift 30', "29NUMBER", 'shift 31', "30]", 'shift 33', "30NUMBER", 'shift 32', "31]", 'shift 34', "32]", 'shift 35', "33\$default", 'reduce 19', "34\$default", 'reduce 20', "35\$default", 'reduce 18', "36End_of_Input", 'goto 37', "37\$default", 'accept', ); @length = (0, 3, 3, 3, 1, 3, 3, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 4, 4, ); @rhs = ('', 'bool', 'bool', 'bool', 'bool', 'atom', 'atom', 'field', 'val', 'val', 'val', 'relop', 'relop', 'relop', 'relop', 'relop', 'relop', 'relop', 'range', 'range', 'range', ); @rule = ( '', 'bool -> \'(\' bool \')\'', 'bool -> bool \'|\' bool', 'bool -> bool \'&\' bool', 'bool -> atom', 'atom -> field relop val', 'atom -> field IN range', 'field -> \'$\' STRING', 'val -> NUMBER', 'val -> STRING', 'val -> field', 'relop -> \'=\'', 'relop -> \'<\'', 'relop -> \'>\'', 'relop -> \'~\'', 'relop -> GE', 'relop -> LE', 'relop -> NOMATCH', 'range -> \'[\' NUMBER DOTS NUMBER \']\'', 'range -> \'[\' NUMBER DOTS \']\'', 'range -> \'[\' DOTS NUMBER \']\'', ); #' sub yylex { unless ($got_input) { @chars = split(//, $input); $got_input = 1; } return 'End_of_Input' if ($#chars == -1); local($acc) = ''; for (;;) { return 'End_of_Input' if $#chars < 0 && $acc eq ''; $yylval = $char = shift @chars; # Read a character $lachar = $chars[0]; # Look-ahead if ($acc && ($char =~ /\W/ || $char eq '')) { unshift (@chars, $char); # Too soon; unget. $yylval = $acc; $acc = ''; if ($yylval eq 'in' || $yylval eq 'IN') { return 'IN'; } elsif ($yylval =~ /^\d+$/) { return 'NUMBER'; } else { return 'STRING'; } } if ($char =~ /\s/) { shift @chars while $chars[0] =~ /\s/; next; # Ate WS; start over. } if ($char eq '<' ) { if ($lachar eq '=') { shift @chars; return 'LE'; } else { return '<'; } } elsif ($char eq '>' ) { if ($lachar eq '=') { shift @chars; return 'GE'; } else { return '>'; } } elsif ($char eq '.' ) { if ($lachar eq '.') { shift @chars; return 'DOTS'; } else { return '.'; } } elsif ($char eq '!' ) { if ($lachar eq '~') { shift @chars; return 'NOMATCH'; } else { return '!'; } } elsif ($char =~ /\W/) { return $char; # Some other symbol like ( [ | etc. } else { $acc .= $char; } } } # rule 1 # bool -> '(' bool ')' sub rule_1 { return $_[1]; } # rule 2 # bool -> bool '|' bool sub rule_2 { return &or($db->{RNSEP}, $_[0], $_[2]); } # rule 3 # bool -> bool '&' bool sub rule_3 { return &and($db->{RNSEP}, $_[0], $_[2]); } # rule 4 # bool -> atom sub rule_4 { return $_[0]; } # rule 5 # atom -> field relop val sub rule_5 { return scalar($db->basic_query(@_)); } # rule 6 # atom -> field IN range sub rule_6 { return $db->range_query($_[0], $_[2]); } # rule 7 # field -> '$' STRING sub rule_7 { local(@f) = $db->get_fieldnames(); foreach $f (@f) { return $_[1] if $_[1] eq $f; } printf STDERR "Unknown field name $_[1]. Legal fields are:\n@f\n"; exit 1; } # rule 8 # val -> NUMBER sub rule_8 { return $_[0]; } # rule 9 # val -> STRING sub rule_9 { return $_[0]; } # rule 10 # val -> field sub rule_10 { return $_[0]; } # rule 11 # relop -> '=' sub rule_11 { return $_[0]; } # rule 12 # relop -> '<' sub rule_12 { return $_[0]; } # rule 13 # relop -> '>' sub rule_13 { return $_[0]; } # rule 14 # relop -> '~' sub rule_14 { return $_[0]; } # rule 15 # relop -> GE sub rule_15 { return '>='; } # rule 16 # relop -> LE sub rule_16 { return '<='; } # rule 17 # relop -> NOMATCH sub rule_17 { return '!~'; } # rule 18 # range -> '[' NUMBER DOTS NUMBER ']' sub rule_18 { return "$_[1],$_[3]"; } # rule 19 # range -> '[' NUMBER DOTS ']' sub rule_19 { return "$_[1],"; } # rule 20 # range -> '[' DOTS NUMBER ']' sub rule_20 { return ",$_[2]"; } sub bool_query { local($be) = @_; $input = $be; $got_input = 0; unless (&yyparse == 0) { return undef; } return $db->split_record_list($values[0]); }