You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@tcl.apache.org by mx...@apache.org on 2025/05/09 10:36:00 UTC
(tcl-rivet) branch master updated (909661c -> 9b771be)
This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a change to branch master
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
from 909661c well forming and pretty formatting Rivet template for session demo
add 857f977 complying with Tcl9.0 requirements
add 048c869 merging branch 'master' after Rivet 3.2.0 release
add ba9f4fb Merging changes from master (after release of 3.2.1)
add 8201e58 Merge branch 'master' into tcl-novem
add d63182c merging several commits from master, unifying handling of const specifier using CONST86
add 5678b27 Merge branch 'master' into tcl-novem
add 6513179 changing CONST into const and introducing also Tcl_Size wherever required by Tcl 9.0. Implementing also close2proc as required by channel version 5
add 42a3440 merging latest development from the master branch
add f16d111 reformatting tabs and spaces
add dd8c41b Merge branch 'master' into tcl-novem
add 251be4f Merge branch 'master' into tcl-novem
add 8fca533 Merge branch 'master' into tcl-novem
add 70a8bae Merge branch 'master' into tcl-novem
add e228acc removing trailing spaces
add 3820bd1 Merge branch 'master' into tcl-novem
add 31b7550 Merge branch 'master' into tcl-novem
new 9b771be empty packages/aida to found on it a TclOO version of DIO. New version number 3.3.0
The 1 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails. The revisions
listed as "add" were already present in the repository and have only
been added to this reference.
Summary of changes:
ChangeLog | 19 ++-
VERSION | 2 +-
doc/xml/dio.xml | 3 +-
rivet/packages/aida/aida.tcl | 228 +----------------------------
rivet/packages/aida/sql.tcl | 284 +-----------------------------------
src/TclWeb.h | 2 +-
src/librivet/rivetCrypt.c | 20 +--
src/librivet/rivetList.c | 59 ++++----
src/librivet/rivetWWW.c | 22 +--
src/mod_rivet_ng/TclWebapache.c | 16 +-
src/mod_rivet_ng/mod_rivet_common.c | 5 +-
src/mod_rivet_ng/mod_rivet_common.h | 2 +-
src/mod_rivet_ng/rivetChannel.c | 39 ++---
src/mod_rivet_ng/rivetCore.c | 51 ++++---
src/mod_rivet_ng/rivetInspect.c | 2 +-
src/parser/parserPkgInit.c | 13 +-
src/parser/rivetParser.c | 2 +-
src/rivet.h | 10 +-
18 files changed, 149 insertions(+), 630 deletions(-)
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@tcl.apache.org
For additional commands, e-mail: commits-help@tcl.apache.org
(tcl-rivet) 01/01: empty packages/aida to found on it a TclOO version of DIO. New version number 3.3.0
Posted by mx...@apache.org.
This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch master
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
commit 9b771be19619b033ee9382e011303bddeb9c2f01
Author: Massimo Manghi <mx...@apache.org>
AuthorDate: Fri May 9 12:35:42 2025 +0200
empty packages/aida to found on it a TclOO version of DIO. New version number 3.3.0
---
ChangeLog | 6 +
VERSION | 2 +-
doc/xml/dio.xml | 3 +-
rivet/packages/aida/aida.tcl | 228 +---------------------------------
rivet/packages/aida/sql.tcl | 284 +------------------------------------------
5 files changed, 15 insertions(+), 508 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 752ba1a..876cc9e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2025-05-05 Massimo Manghi <mx...@apache.org>
+ * VERSION: Version 3.3.0. Merging tcl-novem into master after branching current
+ Tcl8.6 only development to branch 3.2. Development continues on a Tcl9.0 ready master branch
+ * rivet/packages/aida: reset development with the purpose of refactoring
+ DIO and rebase the code on TclOO supporting only tdbc connectors
+
2025-04-13 Massimo Manghi <mx...@apache.org>
* src/Makefile.am: wrap long definitions for improved readability
diff --git a/VERSION b/VERSION
index 406ebcb..15a2799 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-3.2.7
+3.3.0
diff --git a/doc/xml/dio.xml b/doc/xml/dio.xml
index 8220a42..5b825b0 100644
--- a/doc/xml/dio.xml
+++ b/doc/xml/dio.xml
@@ -891,7 +891,8 @@
to a list containing ordinary key-value pairs of fields
and values from the current row. This form is naturally
intepreted as dictionary where each key corresponds
- to a column.
+ to a column. The result representation produced by this
+ option is naturally equivalent to the <option>-keyvalue</option>
</para>
</listitem>
</varlistentry>
diff --git a/rivet/packages/aida/aida.tcl b/rivet/packages/aida/aida.tcl
index 4e0864b..8183b02 100644
--- a/rivet/packages/aida/aida.tcl
+++ b/rivet/packages/aida/aida.tcl
@@ -1,237 +1,19 @@
# aida.tcl -- agnostic interface to TDBC
-# Copyright 2002-2004 The Apache Software Foundation
-
+# Copyright 2024 The Apache Tcl Team
+#
# 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
-
+#
+# 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.
-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
-}
-
- ::itcl::body Aida::build_select_query {args} {
- return [$sql build_select_query {*}$args]
- }
-
-
- # -- result
- #
- # returns a return object
- #
-
- ::itcl::class Result {
-
- 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
-
- protected variable cached 0
- protected variable cacheSize 0
- protected variable cacheArray
-
- constructor {args} {
- eval configure $args
- }
-
- destructor { }
-
- method destroy {} {
- ::itcl::delete object $this
- }
- #
- # seek - set the current row ID (our internal row cursor, if you will)
- # to the specified row ID
- #
- method seek {newrowid} { set rowid $newrowid }
- protected method configure_variable {varName string}
- protected method lassign_array {list arrayName args}
- public method cache {{size "all"}}
- public method forall {type varName body}
- public method next {type {varName ""}}
- public method resultid {{string ""}} { return [configure_variable resultid $string] }
- public method fields {{string ""}} { return [configure_variable fields $string] }
- public method rowid {{string ""}} { return [configure_variable rowid $string] }
- public method numrows {{string ""}} { return [configure_variable numrows $string] }
- public method error {{string ""}} { return [configure_variable error $string] }
- public method errorcode {{string ""}} { return [configure_variable errorcode $string] }
- public method errorinfo {{string ""}} { return [configure_variable errorinfo $string] }
- public method autocache {{string ""}} { return [configure_variable autocache $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 strings
- #
- ::itcl::body Result::configure_variable {varName string} {
- if {[lempty $string]} { return [cget -$varName] }
- $this configure -$varName $string
- }
- #
- # lassign_array - given a list, an array name, and a variable number
- # of arguments consisting of variable names, assign each element in
- # the list, in turn, to elements corresponding to the variable
- # arguments, into the named array. From TclX.
- #
- ::itcl::body Result::lassign_array {list arrayName args} {
- upvar 1 $arrayName array
- foreach elem $list field $args {
- set array($field) $elem
- }
- }
-
- ::itcl::body Result::cache {{size "all"}} {
-
- set cacheSize $size
- if {$size == "all"} { set cacheSize $numrows }
-
- ## Delete the previous cache array.
- catch {unset cacheArray}
-
- set autostatus $autocache
- set currrow $rowid
- set autocache 1
- seek 0
- set i 0
- while {[$this next -list list]} {
- if {[incr i] >= $cacheSize} { break }
- }
- set autocache $autostatus
- seek $currrow
- set cached 1
-
- }
-
-
- #
- # forall -- walk the result object, executing the code body over it
- #
- ::itcl::body Result::forall {type varName body} {
- upvar 1 $varName $varName
- set currrow $rowid
- seek 0
- while {[next $type $varName]} {
- uplevel 1 $body
- }
- set rowid $currrow
- return
- }
-
- ::itcl::body Result::next {type {varName ""}} {
- set return 1
- if {![lempty $varName]} {
- upvar 1 $varName var
- set return 0
- }
-
- catch {unset var}
-
- set list ""
- ## If we have a cached result for this row, use it.
- if {[info exists cacheArray($rowid)]} {
- set list $cacheArray($rowid)
- } else {
- set list [$this nextrow]
- if {[lempty $list]} {
- if {$return} { return }
- set var ""
- return 0
- }
- if {$autocache} { set cacheArray($rowid) $list }
- }
-
- incr rowid
-
- switch -- $type {
- "-list" {
- if {$return} {
- return $list
- } else {
- set var $list
- }
- }
- "-array" {
- if {$return} {
- foreach field $fields elem $list {
- lappend var $field $elem
- }
- return $var
- } else {
- eval lassign_array [list $list] var $fields
- }
- }
- "-keyvalue" {
- foreach field $fields elem $list {
- lappend var -$field $elem
- }
- if {$return} { return $var }
- }
-
- default {
- incr rowid -1
- return -code error \
- "In-valid type: must be -list, -array or -keyvalue"
- }
- }
- return [expr [lempty $list] == 0]
- }
-
-
}
-
-
diff --git a/rivet/packages/aida/sql.tcl b/rivet/packages/aida/sql.tcl
index 385a416..ccdb5af 100644
--- a/rivet/packages/aida/sql.tcl
+++ b/rivet/packages/aida/sql.tcl
@@ -20,289 +20,7 @@
# functionalities
#
-package require Itcl
-
-###
-catch { ::itcl::delete class ::DIO::Sql }
-###
-namespace eval ::Aida {
-
- proc generator {backend} {
-
- }
-
- ::itcl::class Sql {
-
- public variable backend
- public variable what
- public variable table
-
- constructor {backend} {
-
- }
-
- private method where_clause {where_arguments}
-
- public method build_select_query {table row_d}
- public method escape_quotes {field_value}
-
- # DEPRECATED. Kept for compatibility, but it might go away
- public method quote {field_value} { return [$this escape_quotes $field_value] }
-
- protected method field_value {table_name field_name val} {
- return "'[quote $val]'"
- }
-
- 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
- }
-
-
- #
- # escape_quotes - given a string, return the same string with any single
- # quote characters preceded by a backslash
- #
- ::itcl::body Sql::escape_quotes {field_value} {
- regsub -all {'} $field_value {\'} field_value
- return $field_value
- }
-
- # build_select_query - build a select query based on given arguments,
- # which can include a table name, a select statement, switches to
- # turn on boolean AND or OR processing, and possibly
- # some key-value pairs that cause the where clause to be
- # generated accordingly
-
- ::itcl::body Sql::build_select_query {args} {
-
- set bool AND
- set first 1
- set req ""
- set table $from_table
- 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 depending 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 table [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 {
-
- return -code error "Error: expected -<column_name>"
- }
-
- }
-
- }
-
- }
-
- 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
-
- }
-
- 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
- }
- }
-
- }
- }
-
- cond_predicate {
-
- switch -- [string tolower $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
-
- }
-
- }
- set parser_st state0
- }
- default {
- return -code error "invalid parser status"
- }
- }
- }
-
- set sql "SELECT $what from $table WHERE[$this where_clause $where_expr]"
-
- return $sql
- }
-
-
-
+namespace eval ::aida {
}
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@tcl.apache.org
For additional commands, e-mail: commits-help@tcl.apache.org