[interchange-cvs] interchange - heins modified 7 files

interchange-cvs at icdevgroup.org interchange-cvs at icdevgroup.org
Sun Jul 6 01:38:00 EDT 2003


User:      heins
Date:      2003-07-06 04:38:28 GMT
Modified:  .        MANIFEST
Modified:  dist/test catalog.cfg
Modified:  dist/test/products tests.asc
Modified:  lib/Vend Scan.pm
Modified:  lib/Vend/Table Common.pm DBI.pm
Added:     lib/Vend SQL_Parser.pm
Log:
* Add Vend::SQL_Parser module, eliminating need for SQL::Statement.

* Improved tolerance for re-routing queries with table-only option.

* Parses more SQL -- now can use IN and BETWEEN and translate those
  to IC search specs.

* Handles complex parenthisized queries properly.

* Reads LIMIT N and translates to mv_matchlimit.

* Tests added to regression tests to check parser.

Revision  Changes    Path
2.114     +2 -0      interchange/MANIFEST


rev 2.114, prev_rev 2.113
Index: MANIFEST
===================================================================
RCS file: /var/cvs/interchange/MANIFEST,v
retrieving revision 2.113
retrieving revision 2.114
diff -u -r2.113 -r2.114
--- MANIFEST	3 Jul 2003 15:11:49 -0000	2.113
+++ MANIFEST	6 Jul 2003 04:38:28 -0000	2.114
@@ -39,6 +39,7 @@
 code/SystemTag/counter.coretag
 code/SystemTag/currency.coretag
 code/SystemTag/data.coretag
+code/SystemTag/debug.coretag
 code/SystemTag/default.coretag
 code/SystemTag/deliver.coretag
 code/SystemTag/description.coretag
@@ -1281,6 +1282,7 @@
 lib/Vend/RefSearch.pm
 lib/Vend/SOAP.pm
 lib/Vend/SOAP/Transport.pm
+lib/Vend/SQL_Parser.pm
 lib/Vend/Scan.pm
 lib/Vend/Search.pm
 lib/Vend/Server.pm



2.6       +2 -0      interchange/dist/test/catalog.cfg


rev 2.6, prev_rev 2.5
Index: catalog.cfg
===================================================================
RCS file: /var/cvs/interchange/dist/test/catalog.cfg,v
retrieving revision 2.5
retrieving revision 2.6
diff -u -r2.5 -r2.6
--- catalog.cfg	5 Apr 2003 03:38:36 -0000	2.5
+++ catalog.cfg	6 Jul 2003 04:38:28 -0000	2.6
@@ -5,6 +5,8 @@
 Database             products2 DELIMITER     PIPE
 Database             tests     tests.asc     %%
 Database             sqltest   sqltest.asc   dbi:mysql:test
+Database             nonsql    nonsql.asc    TAB
+Database             nonsql    AUTO_NUMBER	 00
 Database             inventory inventory.asc CSV
 Database             inventory AUTO_EXPORT   1
 Database             mv_metadata   mv_metadata.asc   TAB



2.9       +46 -10    interchange/dist/test/products/tests.asc


rev 2.9, prev_rev 2.8
Index: tests.asc
===================================================================
RCS file: /var/cvs/interchange/dist/test/products/tests.asc,v
retrieving revision 2.8
retrieving revision 2.9
diff -u -r2.8 -r2.9
--- tests.asc	5 Apr 2003 03:38:36 -0000	2.8
+++ tests.asc	6 Jul 2003 04:38:28 -0000	2.9
@@ -257,7 +257,7 @@
 %%%
 000020
 %%
-[sql query="select artist from products where category like 'Americana'"][sql-param artist] [/sql]
+[sql query="select artist from products where category like 'Americana'" tolerant-like=1][sql-param artist] [/sql]
 %%
 Grant Wood The Art Store Jean Langan
 %%
@@ -269,7 +269,7 @@
 %%%
 000021
 %%
-[sql query="select * from products where category like 'Americana'"][sql-field artist] [/sql]
+[sql query="select * from products where category like '%Americana%'"][sql-field artist] [/sql]
 %%
 Grant Wood The Art Store Jean Langan
 %%
@@ -2161,20 +2161,56 @@
 %%
 Test FileControl ic_userdb acl
 %%%
-999999
+000142
 %%
-[the test] [perl]
-# Make this come out right
-return 'The expected result as a regex.';
-[/perl]
+[loop
+	lr=1
+	list="
+select code from products where category = 'Renaissance'
+select code from products where category ='Renaissance' order by code
+select code from  products where category='Renaissance' order by code
+select code from  products where category ='Renaissance' order by code
+select code from  products where category in ('Renaissance', 'Accessory') order by code
+select code from  products where category between ('C', 'S') order by category,code
+"][query list=1 sql="[loop-code]"][sql-code] [/query][/loop]
+%%
+^\s*00-0011 00-0011 00-0011 00-0011 00-0011 00-0011a 19-202 00-341 00-342 00-0011\s*$
+%%
+ERROR
+%%
+
+%%
+Some SQL select query tests
+%%%
+000143
 %%
-The expected result as a regex.
+[unlink-file name="products/nonsql.autonumber" prefix="products/"]
+[unlink-file name="tmp/cnt"]
+[flag type=write table=nonsql]
+BEGIN [loop
+	lr=1
+	list="
+insert into nonsql (val1,val2) values ('[counter tmp/cnt]', '[counter tmp/cnt]')
+insert into nonsql values ('[counter tmp/cnt]', '[counter tmp/cnt]', '[counter tmp/cnt]')
+insert into nonsql values ('[counter tmp/cnt]', '[counter tmp/cnt]', '[counter tmp/cnt]')
+select * from nonsql order by code
+update nonsql set val1 = 'updated' where code = '3'
+select val1 from nonsql order by code
+update nonsql set val1 = 'all_updated'
+select val1 from nonsql order by code
+delete from nonsql order by code limit 1
+select * from nonsql order by code
+delete from nonsql
+select * from nonsql
+"][query list=1 sql="[loop-code]"][sql-code] [/query][/loop]
 %%
-The NOT expected result.
+BEGIN\s+1 1 1 01 3 6 1 1 updated 7 3 all_updated all_updated all_updated 1 3 6 2\s*$
+%%
+ERROR
 %%
 
 %%
-Skeleton test.
+Some SQL select query tests
 %%%
 999999
 %%



2.20      +45 -67    interchange/lib/Vend/Scan.pm


rev 2.20, prev_rev 2.19
Index: Scan.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Scan.pm,v
retrieving revision 2.19
retrieving revision 2.20
diff -u -r2.19 -r2.20
--- Scan.pm	18 Jun 2003 17:34:44 -0000	2.19
+++ Scan.pm	6 Jul 2003 04:38:28 -0000	2.20
@@ -1,6 +1,6 @@
 # Vend::Scan - Prepare searches for Interchange
 #
-# $Id: Scan.pm,v 2.19 2003/06/18 17:34:44 jon Exp $
+# $Id: Scan.pm,v 2.20 2003/07/06 04:38:28 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -30,11 +30,12 @@
 			perform_search
 			);
 
-$VERSION = substr(q$Revision: 2.19 $, 10);
+$VERSION = substr(q$Revision: 2.20 $, 10);
 
 use strict;
 use Vend::Util;
 use Vend::File;
+use Vend::SQL_Parser;
 use Vend::Interpolate;
 use Vend::Data qw(product_code_exists_ref column_index);
 use Vend::TextSearch;
@@ -552,7 +553,7 @@
 	eval { require SQL::Statement; };
 }
 
-my %scalar = (qw/ st 1 ra 1 co 1 os 1/);
+my %scalar = (qw/ st 1 ra 1 co 1 os 1 sr 1 ml 1/);
 
 sub push_spec {
 	my ($parm, $val, $ary, $hash) = @_;
@@ -588,23 +589,21 @@
 # END GLIMPSE
 	}
 
-	die "SQL is not enabled for Interchange. Get the SQL::Statement module.\n"
-		unless defined &SQL::Statement::new;
-
-	my $parser = SQL::Parser->new('Ansi');
+#	die "SQL is not enabled for Interchange. Get the SQL::Statement module.\n"
+#		unless defined &SQL::Statement::new;
 
 	# Strip possible leading stuff
 	$text =~ s/^\s*sq\s*=//;
 	my $stmt;
 	eval {
-		$stmt = SQL::Statement->new($text, $parser);
+		$stmt = Vend::SQL_Parser->new($text, $ref);
 	};
 	if($@ and $text =~ s/^\s*sq\s*=(.*)//m) {
 #::logDebug("failed first query, error=$@");
 		my $query = $1;
 		push @$ary, $text if $ary;
 		eval {
-			$stmt = SQL::Statement->new($query, $parser);
+			$stmt = Vend::SQL_Parser->new($text, $ref);
 		};
 	}
 	if($@) {
@@ -616,11 +615,18 @@
 	my $nuhash;
 	my $codename;
 
+#::logDebug("SQL statement=" . ::uneval($stmt));
+
 	my $update = $stmt->command();
+#::logDebug("SQL command=$update");
 	undef $update if $update eq 'SELECT';
 
 	for($stmt->tables()) {
 		my $t = $_->name();
+		if($ref->{table_only}) {
+			return $t;
+		}
+#::logDebug("found table=$t");
 
 		my $codename;
 		my $db = Vend::Data::database_exists_ref($t);
@@ -644,89 +650,61 @@
 
 	$text =~ /\bselect\s+distinct\s+/i and push_spec( 'un', 'yes', $ary, $hash);
 
+	if(my $l = $stmt->limit()) {
+#::logDebug("found limit=" . $l->limit());
+		push_spec('ml', $l->limit(), $ary, $hash);
+		if(my $fm = $l->offset()) {
+#::logDebug("found offset=$fm");
+			push_spec('fm', $fm, $ary, $hash);
+		}
+	}
+
 	for($stmt->columns()) {
 		my $name = $_->name();
+#::logDebug("found column=$name");
 		push_spec('rf', $name, $ary, $hash);
 		last if $name eq '*';
 #::logDebug("column name=" . $_->name() . " table=" . $_->table());
 	}
 
+	for my $v ($stmt->params()) {
+		my $val = $v->value();
+		my $type = $v->type();
+#::logDebug(qq{found value="$val" type=$type});
+		push_spec('vv', $val, $ary, $hash);
+		push_spec('vt', $type, $ary, $hash);
+	}
+
 	my @order;
 
 	@order = $stmt->order();
 	for(@order) {
 		my $c = $_->column();
+#::logDebug("found order column=$c");
 		push_spec('tf', $c, $ary, $hash);
 		my $d = $_->desc() ? 'fr' : 'f';
+#::logDebug("found order sense=$d");
 		push_spec('to', $d, $ary, $hash);
 	}
 
-	my $where;
+	push_spec('un', 1, $ary, $hash) if $stmt->distinct();
+#::logDebug("ary spec to this point=" . ::uneval($ary));
+#::logDebug("hash spec to this point=" . ::uneval($hash));
 	my @where;
-	my $numeric;
 	@where = $stmt->where();
-# Account for undocumented behavior in SQL::Statement
-# Fix by Kestutis Lasys
-	if(CORE::ref $where[0]) {
-	  my $or;
-	  push_spec('co', 'yes', $ary, $hash);
-	  do {
-	  	my $where = shift @where;
-		my $op = $where->op();
-		my $col = $where->arg1();
-		my $spec = $where->arg2();
-#::logDebug("where=$where op=$op arg1=$col arg2=$spec");
-		OP: {
-			if($op eq 'OR') {
-				push_spec( 'os', 'yes', $ary, $hash)     unless $or++;
-				push(@where, $where->arg1() , $where->arg2());
-			}
-			elsif($op eq 'AND') {
-				push(@where, $where->arg1() , $where->arg2());
-			}
-			else {
-
-				my ($col, $spec);
-
-				# Search spec is a variable if a ref
-				$spec = $where->arg2();
-#::logDebug("where col=$col spec=$spec");
-				$spec = $ref->{$spec->name()}		if ref $spec;
-
-				last OP unless defined $spec;
-
-				# Column name is a variable if a string
-				$col = $where->arg1();
-				$col = ref $col ? $col->name() : $::Values->{$col};
-
-				last OP unless $col;
-
-				$numeric = (defined $nuhash)
-							? (exists $nuhash->{$col})
-							: (
-								$spec =~ /^-?\d+\.?\d*$/
-								and
-								$spec !~ /^0\d+$/			 );
-
-#::logDebug("where col=$col spec=$spec");
-
-#::logDebug("numeric for $col=$numeric");
-				push_spec('nu', ($numeric || 0),      $ary, $hash); 
-				push_spec('se', $spec,                $ary, $hash);
-				push_spec('op', $op,                  $ary, $hash);
-				push_spec('sf', $col,                 $ary, $hash);
-				push_spec('ne', ($where->neg() || 0), $ary, $hash);
-
-				
-			}
+#::logDebug("where returned=" . ::uneval(\@where));
+	if(@where) {
+		for(@where) {
+			push_spec( @$_, $ary, $hash );
 		}
-	  } while @where;
-
 	}
 	else {
 		push_spec('ra', 'yes', $ary, $hash);
 	}
 	
+	if($hash->{sg} and ! $hash->{sr}) {
+		delete $hash->{sg};
+	}
 #::logDebug("sql_statement output=" . Vend::Util::uneval($hash)) if $hash;
 	return ($hash, $stmt) if $hash;
 



2.1                  interchange/lib/Vend/SQL_Parser.pm


rev 2.1, prev_rev 2.0



2.29      +17 -7     interchange/lib/Vend/Table/Common.pm


rev 2.29, prev_rev 2.28
Index: Common.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/Common.pm,v
retrieving revision 2.28
retrieving revision 2.29
diff -u -r2.28 -r2.29
--- Common.pm	18 Jun 2003 17:34:46 -0000	2.28
+++ Common.pm	6 Jul 2003 04:38:28 -0000	2.29
@@ -1,6 +1,6 @@
 # Vend::Table::Common - Common access methods for Interchange databases
 #
-# $Id: Common.pm,v 2.28 2003/06/18 17:34:46 jon Exp $
+# $Id: Common.pm,v 2.29 2003/07/06 04:38:28 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -23,7 +23,7 @@
 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
 # MA  02111-1307  USA.
 
-$VERSION = substr(q$Revision: 2.28 $, 10);
+$VERSION = substr(q$Revision: 2.29 $, 10);
 use strict;
 
 package Vend::Table::Common;
@@ -712,7 +712,7 @@
 	}
 	else {
 		eval {
-			($spec, $stmt) = Vend::Scan::sql_statement($query, $ref);
+			($spec, $stmt) = Vend::Scan::sql_statement($query, $opt);
 		};
 		if($@) {
 			my $msg = ::errmsg("SQL query failed: %s\nquery was: %s", $@, $query);
@@ -754,23 +754,33 @@
 
 eval {
 
+	my @vals;
 	if($stmt->command() ne 'SELECT') {
 		if(defined $s and $s->[$CONFIG]{Read_only}) {
 			die ("Attempt to write read-only database $s->[$CONFIG]{name}");
 		}
 		$update = $stmt->command();
+		@vals = $stmt->row_values();
+#::logDebug("row_values returned=" . ::uneval(\@vals));
 	}
-	my @vals = $stmt->row_values();
-	
+
+
 	@na = @{$spec->{rf}}     if $spec->{rf};
 
-	$spec->{ml} = $opt->{ml} || '1000';
+	$spec->{ml} = $opt->{ml} if $opt->{ml};
+	$spec->{ml} ||= '1000';
 	$spec->{fn} = [$s->columns];
 
 	my $sub;
 
 	if($update eq 'INSERT') {
-		@update_fields = $spec->{rf} ? @{$spec->{rf}} : @{$spec->{fn}};
+		if(! $spec->{rf} or  $spec->{rf}[0] eq '*') {
+			@update_fields = @{$spec->{fn}};
+		}
+		else {
+			@update_fields = @{$spec->{rf}};
+		}
+#::logDebug("update fields: " . uneval(\@update_fields));
 		@na = $codename;
 		$sub = $s->row_settor(@update_fields);
 	}



2.49      +19 -8     interchange/lib/Vend/Table/DBI.pm


rev 2.49, prev_rev 2.48
Index: DBI.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/DBI.pm,v
retrieving revision 2.48
retrieving revision 2.49
diff -u -r2.48 -r2.49
--- DBI.pm	18 Jun 2003 17:34:46 -0000	2.48
+++ DBI.pm	6 Jul 2003 04:38:28 -0000	2.49
@@ -1,6 +1,6 @@
 # Vend::Table::DBI - Access a table stored in an DBI/DBD database
 #
-# $Id: DBI.pm,v 2.48 2003/06/18 17:34:46 jon Exp $
+# $Id: DBI.pm,v 2.49 2003/07/06 04:38:28 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -21,7 +21,7 @@
 # MA  02111-1307  USA.
 
 package Vend::Table::DBI;
-$VERSION = substr(q$Revision: 2.48 $, 10);
+$VERSION = substr(q$Revision: 2.49 $, 10);
 
 use strict;
 
@@ -1952,18 +1952,29 @@
 			return undef if $opt->{no_requery};
 
 			# Do nothing but log to debug and fall through to MVSEARCH
+			my $trytab;
+			my $newdb;
 			eval {
-				($spec, $stmt) = Vend::Scan::sql_statement($query, $ref);
-				my @additions = grep length($_) == 2, keys %$opt;
-				if(@additions) {
-					@{$spec}{@additions} = @{$opt}{@additions};
-				}
+				$trytab = Vend::Scan::sql_statement($query, { table_only => 1 } );
+				$newdb = Vend::Data::database_exists_ref($trytab);
 			};
 			if($@) {
 				my $msg = ::errmsg(
 						qq{Query rerouted from table %s failed: %s\nQuery was: %s},
-						$s->[$TABLE],
+						$trytab,
 						$@,
+						$query,
+					);
+				Carp::croak($msg) if $Vend::Try;
+				::logError($msg);
+				return undef;
+			}
+			if($newdb) {
+				return $newdb->query($opt, $text, @arg);
+			}
+			else {
+				my $msg = ::errmsg(
+						qq{Unable to find base table in query: %s},
 						$query,
 					);
 				Carp::croak($msg) if $Vend::Try;







More information about the interchange-cvs mailing list