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 2014/01/08 22:09:48 UTC
svn commit: r1556639 - in /tcl/rivet/trunk: ChangeLog
rivet/packages/dio/aida.tcl rivet/packages/dio/sql.tcl
Author: mxmanghi
Date: Wed Jan 8 21:09:48 2014
New Revision: 1556639
URL: http://svn.apache.org/r1556639
Log:
* rivet/packages/dio/aida.tcl: adding aida.tcl experimental file
for a DIO compatible interface to TDBC.
* rivet/packages/dio/sql.tcl: now able to produce same basic SQL queries
::DIO::Database class is doing now
Added:
tcl/rivet/trunk/rivet/packages/dio/aida.tcl
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/rivet/packages/dio/sql.tcl
Modified: tcl/rivet/trunk/ChangeLog
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/ChangeLog?rev=1556639&r1=1556638&r2=1556639&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Wed Jan 8 21:09:48 2014
@@ -1,3 +1,9 @@
+2014-01-08 Massimo Manghi <mx...@apache.org>
+ * rivet/packages/dio/aida.tcl: adding aida.tcl experimental file
+ for a DIO compatible interface to TDBC.
+ * rivet/packages/dio/sql.tcl: now able to produce same basic SQL queries
+ ::DIO::Database class is doing now
+
2013-12-19 Massimo Manghi <mx...@apache.org>
* rivet/packages/dio/dio_Postgresql.tcl: reindented and tabs converted to spaces
* rivet/packages/dio/sql.tcl: class DIO::Sql now returning basic SELECT SQL statements
Added: tcl/rivet/trunk/rivet/packages/dio/aida.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/aida.tcl?rev=1556639&view=auto
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/aida.tcl (added)
+++ tcl/rivet/trunk/rivet/packages/dio/aida.tcl Wed Jan 8 21:09:48 2014
@@ -0,0 +1,106 @@
+# aida.tcl -- agnostic interface to TDBC
+
+# Copyright 2002-2004 The Apache Software Foundation
+
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+
+# http://www.apache.org/licenses/LICENSE-2.0
+
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# $Id: aida.tcl 1552005 2013-12-18 16:27:15Z mxmanghi $
+
+package require Tcl 8.6
+package require Itcl
+
+source [file join [file dirname [info script]] sql.tcl]
+
+namespace eval ::aida {
+
+proc handle {interface args} {
+ set obj \#auto
+ set first [lindex $args 0]
+ if {![lempty $first] && [string index $first 0] != "-"} {
+
+ set args [lassign $args obj]
+
+ }
+
+ #uplevel \#0 package require dio_$interface
+ #return [uplevel \#0 ::DIO::$interface $obj $args]
+ return [uplevel \#0 ::aida::Aida [Sql $interface] $interface $obj $args]
+}
+
+# -- aida database interface class
+
+::itcl::class Aida {
+
+ constructor { sqlobj args } {
+ set sql $sqlobj
+ eval $this configure $args
+ }
+
+ destructor {
+ close
+ }
+
+ protected method result {backend args}
+ public method quote {string} {}
+ protected method build_select_query {args} { }
+ protected method build_insert_query {arrayName fields {myTable ""}} {}
+ protected method build_update_query {arrayName fields {myTable ""}} {}
+ protected method lassign_array {list arrayName args} {}
+
+ private variable sql
+}
+
+ # -- result
+ #
+ # returns a return object
+ #
+
+ ::itcl::class Result {args} {
+
+ public variable resultid ""
+ public variable fields ""
+ public variable rowid 0
+ public variable numrows 0
+ public variable error 0
+ public variable errorcode 0
+ public variable errorinfo ""
+ public variable autocache 1
+
+ constructor {args} {
+ eval configure $args
+ }
+
+ destructor { }
+
+ method destroy {} {
+ ::itcl::delete object $this
+ }
+
+ protected method configure_variable {varName string}
+
+ }
+
+ #
+ # configure_variable - given a variable name and a string, if the
+ # string is empty return the variable name, otherwise set the
+ # variable to the string.
+ #
+ ::itcl::body Result::configure_variable {varName string} {
+ if {[lempty $string]} { return [$this cget -$varName] }
+ $this configure -$varName $string
+ }
+
+
+}
+
+
Modified: tcl/rivet/trunk/rivet/packages/dio/sql.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/sql.tcl?rev=1556639&r1=1556638&r2=1556639&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/sql.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/sql.tcl Wed Jan 8 21:09:48 2014
@@ -1,9 +1,4 @@
# sql.tcl -- SQL code generator
-#
-# This class provides a way to abstract to some extent the
-# SQL code generation. It's supposed to provide a bridge to
-# different implementation in various backends for specific
-# functionalities
# Copyright 2002-2004 The Apache Software Foundation
@@ -19,10 +14,21 @@
# See the License for the specific language governing permissions and
# limitations under the License.
+# This class provides a way to abstract to some extent the
+# SQL code generation. It's supposed to provide a bridge to
+# different implementation in various backends for specific
+# functionalities
+#
+# $Id$
+
+
# $Id$
package require Itcl
+###
+catch { ::itcl::delete class ::DIO::Sql }
+###
namespace eval ::DIO {
proc generator {backend} {
@@ -31,22 +37,121 @@ namespace eval ::DIO {
::itcl::class Sql {
+ public variable backend
+ public variable what
+ public variable table
+
constructor { backend } {
}
- public method build_select_query {table args}
+ private method where_clause {where_arguments}
+
+ public method build_select_query {table row_d}
public method quote {field_value}
- protected method fieldValue {table_name field_name val} {
+ protected method field_value {table_name field_name val} {
return "'[quote $val]'"
}
- public variable backend
- public variable what
- public variable table
+ public method build_insert_query {table row_d}
+ public method build_update_query {table row_d}
+
}
+ # -- build_insert_query
+ #
+ #
+
+ ::itcl::body Sql::build_insert_query {table row_d} {
+
+ set vars [dict keys $row_d]
+ foreach field $vars {
+
+ lappend vals [$this field_value $table $field [dict get $row_d $field]]
+
+ }
+
+ return "INSERT INTO $table ([join $vars {,}]) VALUES ([join $vals {,}])"
+ }
+
+ # -- build_update_query
+ #
+ #
+
+ ::itcl::body Sql::build_update_query {table row_d} {
+
+ foreach field [dict keys $row_d] {
+ lappend rowfields "$field=[field_value $table $field [dict get $row_d $field]]"
+ }
+
+ return "UPDATE $table SET [join $rowfields {,}]"
+ }
+
+
+ # build_where_clause
+ #
+ #
+ ::itcl::body Sql::where_clause {where_expr} {
+
+ set sql ""
+ for {set i 0} {$i < [llength [dict keys $where_expr]]} {incr i} {
+
+ set d [dict get $where_expr $i]
+
+ set col [dict get $d column]
+ set op [dict get $d operator]
+ if {$i > 0} {
+
+ append sql " [dict get $d logical]"
+
+ }
+ switch $op {
+
+ "eq" {
+ set sqlop "="
+ }
+ "ne" {
+ set sqlop "!="
+ }
+ "lt" {
+ set sqlop "<"
+ }
+ "gt" {
+ set sqlop ">"
+ }
+ "le" {
+ set sqlop "<="
+ }
+ "ge" {
+ set sqlop ">="
+ }
+ "notnull" {
+
+ append sql " $col IS NOT NULL"
+ continue
+
+ }
+ "null" {
+ append sql " $col IS NULL"
+ continue
+
+ }
+
+ }
+
+ set predicate [dict get $d predicate]
+ if {[::string first {%} $predicate] != -1} {
+ append sql " $col LIKE [$this field_value $table $col [[string range $predicate 1 end]]"
+ } else {
+ append sql " $col$sqlop[$this field_value $table $col $predicate]"
+ }
+ }
+
+ return $sql
+ }
+
+
#
# quote - given a string, return the same string with any single
# quote characters preceded by a backslash
@@ -62,12 +167,12 @@ namespace eval ::DIO {
# some key-value pairs that cause the where clause to be
# generated accordingly
- ::itcl::body Sql::build_select_query {table args} {
+ ::itcl::body Sql::build_select_query {from_table args} {
set bool AND
set first 1
set req ""
- set myTable $table
+ set table $from_table
set what "*"
set parser_st state0
@@ -95,7 +200,7 @@ namespace eval ::DIO {
"-table" {
# -table -- identify which table the query is about
- set myTable [lindex $args [incr i]]
+ set table [lindex $args [incr i]]
}
"-select" {
# -select -
@@ -191,50 +296,8 @@ namespace eval ::DIO {
}
}
- set sql "SELECT $what from $myTable WHERE"
-
- for {set i 0} {$i < [llength [dict keys $where_expr]]} {incr i} {
-
- set d [dict get $where_expr $i]
-
- set col [dict get $d column]
- set op [dict get $d operator]
- if {$i > 0} {
+ set sql "SELECT $what from $table WHERE[$this where_clause $where_expr]"
- append sql " [dict get $d logical]"
-
- }
- switch $op {
-
- "eq" {
- set sqlop "="
- }
- "ne" {
- set sqlop "!="
- }
- "lt" {
- set sqlop "<"
- }
- "gt" {
- set sqlop ">"
- }
- "notnull" {
-
- append sql " $col IS NOT NULL"
- continue
- }
- "null" {
- append sql " $col IS NULL"
- continue
-
- }
-
- }
-
- append sql " $col $sqlop [dict get $d predicate]"
-
-
- }
return $sql
}
}
---------------------------------------------------------------------
To unsubscribe, e-mail: site-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: site-cvs-help@tcl.apache.org