[interchange-cvs] interchange - heins modified 8 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Sun Jul 6 14:06:00 EDT 2003
User: heins
Date: 2003-07-06 17:06:10 GMT
Modified: lib/Vend DbSearch.pm SQL_Parser.pm Scan.pm Search.pm
Modified: lib/Vend/Table DB_File.pm GDBM.pm SDBM.pm Shadow.pm
Log:
* Fix several deficiencies in SQL parsing.
-- Recognize IS [NOT] NULL and map to a search for the
empty string.
-- Allow verbatim passing of field names for GDBM types, allowing
"select Variable from variable where Variable = ''" which
would not work before.
-- Add VERBATIM_FIELDS definition to database types which need it.
-- Add support for "select sometable as foo, othertable bar where ..."
so that queries using it can be rerouted properly.
-- Always set mv_min_string = 0, so we don't have to do anything
special for "where column = ''" and such.
Revision Changes Path
2.19 +4 -2 interchange/lib/Vend/DbSearch.pm
rev 2.19, prev_rev 2.18
Index: DbSearch.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/DbSearch.pm,v
retrieving revision 2.18
retrieving revision 2.19
diff -u -r2.18 -r2.19
--- DbSearch.pm 18 Jun 2003 17:34:44 -0000 2.18
+++ DbSearch.pm 6 Jul 2003 17:06:09 -0000 2.19
@@ -1,6 +1,6 @@
# Vend::DbSearch - Search indexes with Interchange
#
-# $Id: DbSearch.pm,v 2.18 2003/06/18 17:34:44 jon Exp $
+# $Id: DbSearch.pm,v 2.19 2003/07/06 17:06:09 mheins Exp $
#
# Adapted for use with Interchange from Search::TextSearch
#
@@ -27,7 +27,7 @@
@ISA = qw(Vend::Search);
-$VERSION = substr(q$Revision: 2.18 $, 10);
+$VERSION = substr(q$Revision: 2.19 $, 10);
use Search::Dict;
use strict;
@@ -149,9 +149,11 @@
my (@fn) = $dbref->columns();
+#::logDebug("specs=" . ::uneval($s->{mv_searchspec}));
@specs = @{$s->{mv_searchspec}};
@pats = $s->spec_check(@specs);
+#::logDebug("specs now=" . ::uneval(\@pats));
if ($s->{mv_coordinate}) {
undef $f;
2.2 +62 -22 interchange/lib/Vend/SQL_Parser.pm
rev 2.2, prev_rev 2.1
Index: SQL_Parser.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/SQL_Parser.pm,v
retrieving revision 2.1
retrieving revision 2.2
diff -u -r2.1 -r2.2
--- SQL_Parser.pm 6 Jul 2003 04:38:28 -0000 2.1
+++ SQL_Parser.pm 6 Jul 2003 17:06:10 -0000 2.2
@@ -1,6 +1,6 @@
# Vend::SQL_Parser - Interchange SQL parser class
#
-# $Id: SQL_Parser.pm,v 2.1 2003/07/06 04:38:28 mheins Exp $
+# $Id: SQL_Parser.pm,v 2.2 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1997-2002 Red Hat, Inc.
@@ -40,7 +40,7 @@
use Vend::Util;
use Text::ParseWords;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.1 $, 10);
+$VERSION = substr(q$Revision: 2.2 $, 10);
sub new {
my $class = shift;
@@ -135,6 +135,20 @@
return shift->{command};
}
+my @stopphrase = (
+ 'where',
+ 'order by',
+ 'group by',
+ 'having',
+ 'limit',
+);
+
+for(@stopphrase) {
+ s/\s+/\\s+/g;
+}
+
+my $stopregex = join "|", @stopphrase;
+
sub tables {
my $s = shift;
return @{$s->{tables}} if $s->{tables};
@@ -153,12 +167,17 @@
push @try, grep /\S/, split /\s*,\s*/, $tab;
}
elsif($s->{command} eq 'SELECT') {
- $st =~ s/(.*?)\s+from\s+(\w+(?:\s*,\s*\w+)*)//is;
+ $st =~ s/(.*?)\s+from\s+//;
$s->{raw_columns} = $1;
- my $tabtry = $2;
+ my @t = Text::ParseWords::quotewords('\s*,\s*', 0, $st);
+ my $last;
+ for (@t) {
+ $last++ if s/\s+$stopregex\s+.*//is;
+ push @try, $_;
+ last if $last;
+ }
$s->{raw_columns} =~ s/^\s*distinct\s+//i
and $s->{distinct} = 1;
- push @try, grep /\S/, split /\s*,\s*/, $tabtry;
}
elsif ($s->{command} eq 'UPDATE') {
$st =~ s/(\w+(?:\s*,\s*\w+)*)\s+set\s+//is;
@@ -175,8 +194,6 @@
my $found;
for(@try) {
- /\W+/ and
- return $s->errdie("Improper table '%s'", $_);
$found = Vend::SQL_Parser::Table->new( name => $_ );
push @tab, $found;
}
@@ -185,7 +202,6 @@
unless $found;;
$s->{tables} = \@tab;
-
return @tab;
}
@@ -245,6 +261,7 @@
'>=' => 'ge',
'like' => 1,
'in' => 1,
+ 'is' => 'eq',
'between' => 1,
);
@@ -258,6 +275,7 @@
);
sub find_param_or_col {
+ my $s = shift;
my $raw = shift;
my $rhs = shift;
@@ -292,11 +310,12 @@
}
else {
$type = 'reference';
- $val = lc $val;
+ $val = lc $val unless $s->{verbatim_fields};
}
}
else {
- $val = lc $raw;
+ $val = $raw;
+ $val = lc $val unless $s->{verbatim_fields};
$type = 'reference';
}
return($val, $type);
@@ -392,7 +411,7 @@
if(s/^(not)$//i) {
if($lhs) {
die "syntax error: negation where rhs expected"
- if $op;
+ unless $op and $op eq 'is';
$neg = 1;
}
else {
@@ -418,7 +437,7 @@
unshift @things, $2;
#::logDebug("found merged operator $things[0]");
}
- my ($val, $type) = find_param_or_col($_);
+ my ($val, $type) = $s->find_param_or_col($_);
if($type eq 'literal') {
die "syntax error: literal on left-hand side";
}
@@ -445,7 +464,7 @@
elsif( ref($rhs) eq 'ARRAY') {
next if $_ eq ',';
#::logDebug("rhs=array, val=$_");
- my ($val, $type) = find_param_or_col($_, 1);
+ my ($val, $type) = $s->find_param_or_col($_, 1);
$rhs_type ||= $type;
push @$rhs, $val;
if($op eq 'between' and scalar(@$rhs) == 2) {
@@ -455,7 +474,7 @@
}
else {
#::logDebug("rhs=non_array, val=$_");
- ($rhs, $rhs_type) = find_param_or_col($_, 1);
+ ($rhs, $rhs_type) = $s->find_param_or_col($_, 1);
$rhs_done = 1;
#::logDebug("rhs now=" . ::uneval($rhs));
}
@@ -466,6 +485,9 @@
$statement++;
push @out, $close if $close;
my $sub = $s->{regex_percent} || '.*';
+ if($op eq 'is') {
+ $rhs = '' if $rhs eq 'NULL';
+ }
$number = $rhs_type eq 'number' ? 1 : 0;
if($op eq 'between') {
@@ -567,9 +589,7 @@
}
}
- if( ($statement + $extra_statement) > 1) {
- unshift @stack, [ 'co', '1' ];
- }
+ unshift @stack, [ 'co', '1' ];
if($statement > 1) {
unshift @stack, ["sr", join(" ", @out)];
}
@@ -728,6 +748,16 @@
return @out;
}
+sub verbatim_fields {
+ my $s = shift;
+ my $val = shift;
+ if(defined $val) {
+ $s->{verbatim_fields} = $val;
+ }
+#::logDebug("verbatim_fields returning $s->{verbatim_fields}");
+ return $s->{verbatim_fields};
+}
+
1;
package Vend::SQL_Parser::Table;
@@ -736,11 +766,20 @@
return shift->{name};
}
+sub alias {
+ return shift->{alias};
+}
+
sub new {
my $class = shift;
my $self = { @_ };
die "No table name!" unless $self->{name};
- $self->{name} = lc $self->{name};
+ $self->{name} =~ s/\s+(?:as\s+)?(.*)//is
+ and do {
+ $self->{alias} = $1;
+ $self->{alias} =~ s/\s+$//;
+ $self->{alias} =~ s/^(["'])(.*)\1$/$2/s;
+ };
return bless $self, $class;
}
@@ -778,13 +817,13 @@
}
}
else {
- $name = lc $raw;
+ $name = $raw;
}
if($name !~ /^\w+$/ and $name ne '*') {
die ::errmsg("Bad column name (from %s): '%s'", $raw, $name);
}
- $self->{name} = lc $name;
+ $self->{name} = lc $name unless $self->{verbatim_fields};
return bless $self, $class;
}
@@ -855,13 +894,14 @@
}
}
else {
- $name = lc $raw;
+ $name = $raw;
}
if($name !~ /^\w+$/) {
die ::errmsg("Bad column name (from %s): '%s'", $raw, $name);
}
- $self->{name} = lc $name;
+ $name = lc $name;
+ $self->{name} = $name;
return bless $self, $class;
}
2.22 +8 -4 interchange/lib/Vend/Scan.pm
rev 2.22, prev_rev 2.21
Index: Scan.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Scan.pm,v
retrieving revision 2.21
retrieving revision 2.22
diff -u -r2.21 -r2.22
--- Scan.pm 6 Jul 2003 04:46:02 -0000 2.21
+++ Scan.pm 6 Jul 2003 17:06:10 -0000 2.22
@@ -1,6 +1,6 @@
# Vend::Scan - Prepare searches for Interchange
#
-# $Id: Scan.pm,v 2.21 2003/07/06 04:46:02 mheins Exp $
+# $Id: Scan.pm,v 2.22 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -30,7 +30,7 @@
perform_search
);
-$VERSION = substr(q$Revision: 2.21 $, 10);
+$VERSION = substr(q$Revision: 2.22 $, 10);
use strict;
use Vend::Util;
@@ -549,7 +549,7 @@
}
-my %scalar = (qw/ st 1 ra 1 co 1 os 1 sr 1 ml 1/);
+my %scalar = (qw/ st 1 ra 1 co 1 os 1 sr 1 ml 1 ms 1/);
sub push_spec {
my ($parm, $val, $ary, $hash) = @_;
@@ -627,6 +627,8 @@
$codename = $db->config('KEY') || 'code';
$nuhash = $db->config('NUMERIC') || undef;
push_spec( 'fi', $db->config('file'), $ary, $hash);
+ $stmt->verbatim_fields(1)
+ if $db->config('VERBATIM_FIELDS');
}
# GLIMPSE
elsif ("\L$t" eq 'glimpse') {
@@ -687,6 +689,8 @@
@where = $stmt->where();
#::logDebug("where returned=" . ::uneval(\@where));
if(@where) {
+ ## In a SQL query, we never want to drop out on empty string
+ push_spec('ms', 0, $ary, $hash);
for(@where) {
push_spec( @$_, $ary, $hash );
}
@@ -698,7 +702,7 @@
if($hash->{sg} and ! $hash->{sr}) {
delete $hash->{sg};
}
-#::logDebug("sql_statement output=" . Vend::Util::uneval($hash)) if $hash;
+#::logDebug("sql_statement output=" . Vend::Util::uneval_it($hash)) if $hash;
return ($hash, $stmt) if $hash;
my $string = join "\n", @$ary;
2.19 +4 -2 interchange/lib/Vend/Search.pm
rev 2.19, prev_rev 2.18
Index: Search.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Search.pm,v
retrieving revision 2.18
retrieving revision 2.19
diff -u -r2.18 -r2.19
--- Search.pm 25 Jun 2003 16:38:17 -0000 2.18
+++ Search.pm 6 Jul 2003 17:06:10 -0000 2.19
@@ -1,6 +1,6 @@
# Vend::Search - Base class for search engines
#
-# $Id: Search.pm,v 2.18 2003/06/25 16:38:17 mheins Exp $
+# $Id: Search.pm,v 2.19 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -22,7 +22,7 @@
package Vend::Search;
-$VERSION = substr(q$Revision: 2.18 $, 10);
+$VERSION = substr(q$Revision: 2.19 $, 10);
use strict;
use vars qw($VERSION);
@@ -684,6 +684,7 @@
#::logDebug("Begin=" . join ",", @begin);
#::logDebug("Group=" . join ",", @group);
#::logDebug("Ors=" . join ",", @{$s->{mv_orsearch}});
+#::logDebug("Field count=$field_count");
my @code;
my $candidate = '';
my ($i, $start, $term, $like);
@@ -742,6 +743,7 @@
}
my $grp = $group[$i] || 0;
my $frag = qq{$negates[$i]\$fields[$i] $start$specs[$i]$term};
+#::logDebug("Code fragment is q!$frag!");
unless ($code[$grp]) {
$code[$grp] = [ $frag ];
}
2.7 +4 -2 interchange/lib/Vend/Table/DB_File.pm
rev 2.7, prev_rev 2.6
Index: DB_File.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/DB_File.pm,v
retrieving revision 2.6
retrieving revision 2.7
diff -u -r2.6 -r2.7
--- DB_File.pm 18 Jun 2003 17:34:46 -0000 2.6
+++ DB_File.pm 6 Jul 2003 17:06:10 -0000 2.7
@@ -1,6 +1,6 @@
# Vend::Table::DB_File - Access an Interchange table stored in a DB file hash
#
-# $Id: DB_File.pm,v 2.6 2003/06/18 17:34:46 jon Exp $
+# $Id: DB_File.pm,v 2.7 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -31,7 +31,7 @@
use Vend::Table::Common;
@ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.6 $, 10);
+$VERSION = substr(q$Revision: 2.7 $, 10);
sub create {
my ($class, $config, $columns, $filename) = @_;
@@ -117,6 +117,8 @@
unless $dbm;
my $columns = [split(/\t/, $tie->{'c'})];
+
+ $config->{VERBATIM_FIELDS} = 1 unless defined $config->{VERBATIM_FIELDS};
my $column_index = Vend::Table::Common::create_columns($columns, $config);
2.7 +5 -2 interchange/lib/Vend/Table/GDBM.pm
rev 2.7, prev_rev 2.6
Index: GDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/GDBM.pm,v
retrieving revision 2.6
retrieving revision 2.7
diff -u -r2.6 -r2.7
--- GDBM.pm 18 Jun 2003 17:34:46 -0000 2.6
+++ GDBM.pm 6 Jul 2003 17:06:10 -0000 2.7
@@ -1,6 +1,6 @@
# Vend::Table::GDBM - Access an Interchange table stored in a GDBM file
#
-# $Id: GDBM.pm,v 2.6 2003/06/18 17:34:46 jon Exp $
+# $Id: GDBM.pm,v 2.7 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -30,7 +30,7 @@
use Vend::Table::Common;
@ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.6 $, 10);
+$VERSION = substr(q$Revision: 2.7 $, 10);
sub new {
my ($class, $obj) = @_;
@@ -119,6 +119,9 @@
unless $dbm;
my $columns = [split(/\t/, $tie->{'c'})];
+
+ $config->{VERBATIM_FIELDS} = 1 unless defined $config->{VERBATIM_FIELDS};
+
my $column_index = Vend::Table::Common::create_columns($columns, $config);
my $s = [
2.7 +5 -3 interchange/lib/Vend/Table/SDBM.pm
rev 2.7, prev_rev 2.6
Index: SDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/SDBM.pm,v
retrieving revision 2.6
retrieving revision 2.7
diff -u -r2.6 -r2.7
--- SDBM.pm 18 Jun 2003 17:34:46 -0000 2.6
+++ SDBM.pm 6 Jul 2003 17:06:10 -0000 2.7
@@ -1,6 +1,6 @@
# Vend::Table::SDBM - Access an Interchange table stored in Perl's internal SDBM
#
-# $Id: SDBM.pm,v 2.6 2003/06/18 17:34:46 jon Exp $
+# $Id: SDBM.pm,v 2.7 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -24,7 +24,7 @@
# MA 02111-1307 USA.
package Vend::Table::SDBM;
-$VERSION = substr(q$Revision: 2.6 $, 10);
+$VERSION = substr(q$Revision: 2.7 $, 10);
use strict;
use Fcntl;
use SDBM_File;
@@ -32,7 +32,7 @@
use Vend::Table::Common;
@ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.6 $, 10);
+$VERSION = substr(q$Revision: 2.7 $, 10);
sub create {
my ($class, $config, $columns, $filename) = @_;
@@ -123,6 +123,8 @@
or die "Could not open '$filename': $!";
my $columns = [split(/\t/, $tie->{'c'})];
+
+ $config->{VERBATIM_FIELDS} = 1 unless defined $config->{VERBATIM_FIELDS};
my $column_index = Vend::Table::Common::create_columns($columns, $config);
1.40 +3 -3 interchange/lib/Vend/Table/Shadow.pm
rev 1.40, prev_rev 1.39
Index: Shadow.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/Shadow.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- Shadow.pm 6 Jul 2003 04:46:02 -0000 1.39
+++ Shadow.pm 6 Jul 2003 17:06:10 -0000 1.40
@@ -1,6 +1,6 @@
# Vend::Table::Shadow - Access a virtual "Shadow" table
#
-# $Id: Shadow.pm,v 1.39 2003/07/06 04:46:02 mheins Exp $
+# $Id: Shadow.pm,v 1.40 2003/07/06 17:06:10 mheins Exp $
#
# Copyright (C) 2002-2003 Stefan Hornburg (Racke) <racke at linuxia.de>
#
@@ -20,7 +20,7 @@
# MA 02111-1307 USA.
package Vend::Table::Shadow;
-$VERSION = substr(q$Revision: 1.39 $, 10);
+$VERSION = substr(q$Revision: 1.40 $, 10);
# CREDITS
#
@@ -425,7 +425,7 @@
my ($stmt);
eval {
- $stmt = Vend::SQL_Parser->new($query, $parser);
+ $stmt = Vend::SQL_Parser->new($query);
};
if ($@) {
More information about the interchange-cvs
mailing list