[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";
+}