[Koha-cvs] koha/misc kohaQuery2PQF.pl [dev_week]

[Joshua Ferraro]

CVSROOT:        /sources/koha
Module name:    koha
Branch:         dev_week
Changes by:     Joshua Ferraro <kados>  06/08/19 19:47:15

Added files:
        misc           : kohaQuery2PQF.pl 

Log message:
        The start of a query parser that takes incoming KohaQuery queries and
        converts them to multi-leaf nodes in PQF format

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/misc/kohaQuery2PQF.pl?cvsroot=koha&only_with_tag=dev_week&rev=1.1.2.1

Patches:
Index: kohaQuery2PQF.pl
===================================================================
RCS file: kohaQuery2PQF.pl
diff -N kohaQuery2PQF.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ kohaQuery2PQF.pl    19 Aug 2006 19:47:15 -0000      1.1.2.1
@@ -0,0 +1,86 @@
+#!/usr/bin/perl -s
+use strict;
+use Parse::RecDescent;
+$::RD_WARN   = 1;
+$::RD_ERRORS = 1;
+$::RD_HINT = 1;
+#$::RD_TRACE =1;
+#my $incoming_query = "harry and potter"; #ti=(Harry potter) not goblet";
+
+# Create and compile the source file
+#
+our %opmap = (
+       '+' => '@and',
+       '|' => '@or',
+       '-' => '@not'
+);
+
+sub transform_ops {
+       if (@_ == 1) {
+               return $_[0];
+       } elsif (@_ < 3) {
+               die "Bad juju";
+       }
+
+       my $right = pop @_;
+       my $op = pop @_;
+
+       return [ $opmap{$op} , transform_ops(@_), $right ]
+}
+
+my $parser = Parse::RecDescent->new(q(
+KohaQuery : <leftop: Elements Op Elements> {
+         $return = main::transform_ops( @{ $item[1] } );
+         }
+
+      Op :  "+" | "|"  | "-"
+
+      Elements : Qualifiers Relation Terms 
+               { $return = ['@attr', {
+                       qlist => $item[1], 
+                       relation => $item[2],
+                       value => $item[3] } ]
+               }
+                       | Qualifiers Relation "(" KohaQuery ")"
+               { $return = ['@attr', {
+                       qlist => $item[1], 
+                       relation => $item[2], 
+                       subquery => $item[4] } ]
+               }
+                       | Qualifiers "=" string "-" string
+               { $return = ['@attr', {
+                       qlist => $item[1],
+                       relation => $item[2],
+                       range => [$item[3], $item[5]] }]
+               }
+               | "(" KohaQuery ")" { $return = $item[2] }
+               | Terms
+
+         Terms: <leftop: Term Prox Term>
+#      -- Proximity of terms.
+
+         Term: string(s) { $return = join " ", @{$item[1]}; 
+               $return = qq{"$return"} if $return =~ /\s/;
+               }
+#      -- This basically means that a term may include a blank
+
+         Qualifiers: string(s /,/)
+#      -- Qualifiers is a list of strings separated by comma
+
+      Relation : "=" | ">=" | "<=" | "<>" | ">" | "<"
+
+      Prox : "%" | "!"
+#      -- Proximity operator
+#
+      string : /[A-Za-z]\w*/
+
+         ));
+
+#Test it on lines of user input
+
+while (defined (my $line = <>)) {
+       my $result = $parser->KohaQuery(\$line);
+       print "Leftover: $line\n";
+       use Data::Dumper;
+       print Dumper($result), "\n";
+}