You are viewing a plain text version of this content. The canonical link for it is here.
Posted to site-cvs@tcl.apache.org by mx...@apache.org on 2013/12/18 17:27:15 UTC
svn commit: r1552005 - in /tcl/rivet/trunk: ChangeLog
rivet/packages/dio/dio.tcl rivet/packages/dio/sql.tcl
Author: mxmanghi
Date: Wed Dec 18 16:27:15 2013
New Revision: 1552005
URL: http://svn.apache.org/r1552005
Log:
* rivet/packages/dio/sql.tcl: further developments. Class Sql is now able
to build an abstract representation of a SELECT query
* rivet/packages/dio/dio.tcl: typo in a comment
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/rivet/packages/dio/dio.tcl
tcl/rivet/trunk/rivet/packages/dio/sql.tcl
Modified: tcl/rivet/trunk/ChangeLog
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/ChangeLog?rev=1552005&r1=1552004&r2=1552005&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Wed Dec 18 16:27:15 2013
@@ -1,3 +1,8 @@
+2013-12-18 Massimo Manghi <mx...@apache.org>
+ * rivet/packages/dio/sql.tcl: further developments. Class Sql is now able
+ to build an abstract representation of a SELECT query
+ * rivet/packages/dio/dio.tcl: typo in a comment
+
2013-12-16 Massimo Manghi <mx...@apache.org>
* rivet/packages/dio/sql.tcl: trying to redesign rivet in order to comply with
Tdbc and aiming at making DIO a pure interface to Tdbc dropping the
Modified: tcl/rivet/trunk/rivet/packages/dio/dio.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/dio.tcl?rev=1552005&r1=1552004&r2=1552005&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/dio.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/dio.tcl Wed Dec 18 16:27:15 2013
@@ -555,7 +555,7 @@ proc handle {interface args} {
}
#
- # keys - return all keys in a tbale
+ # keys - return all keys in a table
#
method keys {args} {
table_check $args
Modified: tcl/rivet/trunk/rivet/packages/dio/sql.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/sql.tcl?rev=1552005&r1=1552004&r2=1552005&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/sql.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/sql.tcl Wed Dec 18 16:27:15 2013
@@ -43,6 +43,8 @@ namespace eval ::DIO {
}
public variable backend
+ public variable what
+ public variable table
}
#
@@ -62,99 +64,134 @@ namespace eval ::DIO {
::itcl::body Sql::build_select_query {table args} {
- set bool AND
- set first 1
- set req ""
+ set bool AND
+ set first 1
+ set req ""
set myTable $table
- set what "*"
+ set what "*"
+
+ set parser_st state0
+ set condition_count 0
+ set where_expr [dict create]
# for each argument passed us...
# (we go by integers because we mess with the index based on
# what we find)
-
+ #puts "args: $args"
for {set i 0} {$i < [llength $args]} {incr i} {
# fetch the argument we're currently processing
set elem [lindex $args $i]
+ #puts "cycle: $i (elem: $elem, status: $parser_st, first: $first)"
+
+ switch $parser_st {
+ state0 {
+
+ switch -- [::string tolower $elem] {
+
+ # -table and -select don't drive the parser state machine
+ # and whatever they have as arguments on the command
+ # line they're set
+
+ "-table" {
+ # -table -- identify which table the query is about
+ set myTable [lindex $args [incr i]]
+ }
+ "-select" {
+ # -select -
+ set what [lindex $args [incr i]]
+ }
+ "-or" -
+ "-and" {
+ if {$first} {
+ return -code error "$elem can not be the first element of a where clause"
+ } else {
+ incr condition_count
+ dict set where_expr $condition_count logical [string range $elem 1 end]
+ set parser_st where_op
+ }
+ }
+ default {
+
+ if {[::string index $elem 0] == "-"} {
+ if {!$first} {
+ incr condition_count
+ }
+ dict set where_expr $condition_count column [string range $elem 1 end]
+ set first 0
+ set parser_st where_op
+ } else {
- switch -- [::string tolower $elem] {
- "-and" {
- # -and -- switch to AND-style processing
- set bool AND
- }
+ return -code error "Error: expected -<column_name>"
+ }
- "-or" {
- # -or -- switch to OR-style processing
- set bool OR
- }
+ }
- "-table" {
- # -table -- identify which table the query is about
- set myTable [lindex $args [incr i]]
- }
+ }
- "-select" {
- # -select -
- set what [lindex $args [incr i]]
}
- default {
- # it wasn't -and, -or, -table, or -select...
+ where_op {
+
+ switch -- [string tolower $elem] {
+
+ "-lt" -
+ "-gt" -
+ "-ne" -
+ "-eq" {
+
+ dict set where_expr $condition_count operator [string range $elem 1 end]
+ set parser_st cond_predicate
+
+ }
+
+ "-null" -
+ "-notnull" {
+
+ dict set where_expr $condition_count operator [string range $elem 1 end]
+ set parser_st state0
+
+ }
- # if the first character of the element is a dash,
- # it's a field name and a value
+ default {
+ if {[::string index $elem 0] == "-"} {
+ dict set where_expr $condition_count column [string range $elem 1 end]
+ } else {
+ dict set where_expr $condition_count operator "eq"
+ dict set where_expr $condition_count predicate $elem
+ set parser_st state0
+ }
+ }
+
+ }
+ }
- if {[::string index $elem 0] == "-"} {
+ cond_predicate {
+
+ switch -- [string tolower $elem] {
- set field [::string range $elem 1 end]
- set elem [lindex $args [incr i]]
-
- # if it's the first field being processed, append
- # WHERE to the SQL request we're generating
- if {$first} {
- append req " WHERE"
- set first 0
- } else {
- # it's not the first variable in the comparison
- # expression, so append the boolean state, either
- # AND or OR
- append req " $bool"
- }
-
- # convert any asterisks to percent signs in the
- # value field
- regsub -all {\*} $elem {%} elem
-
- # if there is a percent sign in the value
- # field now (having been there originally or
- # mapped in there a moment ago), the SQL aspect
- # is appended with a "field LIKE value"
-
- if {[::string first {%} $elem] != -1} {
- append req " $field LIKE [fieldValue $myTable $field $elem]"
- } elseif {[::string equal $elem "-null"]} {
- append req " $field IS NULL"
- } elseif {[::string equal $elem "-notnull"]} {
- append req " $field IS NOT NULL"
- } elseif {[regexp {^([<>]) *([0-9.]*)$} $elem _ fn val]} {
- # value starts with <, or >, then space,
- # and a something
- append req " $field$fn$val"
- } elseif {[regexp {^([<>]=) *([0-9.]*)$} $elem _ fn val]} {
- # value starts with <= or >=, space, and something.
- append req " $field$fn$val"
- } else {
- # otherwise it's a straight key=value comparison
- append req " $field=[fieldValue $myTable $field $elem]"
+ "-expr" {
+ dict set where_expr $condition_count predicate [lindex $args [incr i]]
}
+ default {
+
+ # convert any asterisks to percent signs in the
+ # value field
+ regsub -all {\*} $elem {%} elem
+
+
+ dict set where_expr $condition_count predicate $elem
- continue
+ }
}
- append req " $elem"
+ set parser_st state0
+ }
+ default {
+ return -code error "invalid parser status"
}
}
}
- return "select $what from $myTable $req"
+ return $where_expr
}
}
---------------------------------------------------------------------
To unsubscribe, e-mail: site-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: site-cvs-help@tcl.apache.org