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/05/22 16:19:10 UTC
svn commit: r1596885 - in /tcl/rivet/trunk: ChangeLog
rivet/packages/dio/aida.tcl rivet/packages/dio/sql.tcl
Author: mxmanghi
Date: Thu May 22 14:19:10 2014
New Revision: 1596885
URL: http://svn.apache.org/r1596885
Log:
* rive/packages/dio/aida.sql: redifining responsability of class Aida (not to be officially released)
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/rivet/packages/dio/aida.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=1596885&r1=1596884&r2=1596885&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Thu May 22 14:19:10 2014
@@ -1,3 +1,6 @@
+2014-05-22 Massimo Manghi <mx...@apache.org>
+ * rive/packages/dio/aida.sql: redifining responsability of class Aida (not to be officially released)
+
2014-04-17 Massimo Manghi <mx...@apache.org>
* src/: reintegrating modularization branch. Now every subsystem mod_rivet is made of (module,
channel, parser, commands, request multipart handling) can be developed separately
@@ -7,10 +10,10 @@
2014-04-16 Massimo Manghi <mx...@apache.org>
* rivet/packages/dio/aida.tcl,dio_Tdbc.tcl,sql.tcl: more methods implemented in aida.tcl
- * doc/xml/commands.xml: new for '::rivet::inspect server' documented
- * src/rivetcmds/rivetInspect.c: adding is_virtual flag to values returned by '::rivet::inspect server'
+ * doc/xml/commands.xml: new form '::rivet::inspect server' documented
+ * src/rivetcmds/rivetInspect.c: adding is_virtual flag to dictionary returned by '::rivet::inspect server'
* branches/modular: merging latest changes in trunk
- * trunk/src/rivetcmds/rivetInpect.c: adding is_virtual flag to values returned by '::rivet::inspect server'
+ * trunk/src/rivetcmds/rivetInpect.c: adding is_virtual flag to dictionary returned by '::rivet::inspect server'
2014-04-11 Massimo Manghi <mx...@apache.org>
* src/rivetcmds/rivetCore.c: misplaced check on request_rec in Rivet_InspectCmd
@@ -51,7 +54,7 @@
* configure.ac, VERSION: version number bumped to 2.1.5
2014-03-16 Massimo Manghi <mx...@apache.org>
- * doc/images/Rivetlogo_small.png: removed because already in doc/ and dupicate to home.png
+ * doc/images/Rivetlogo_small.png: removed because already in doc/ and duplicate to home.png
2014-02-28 Massimo Manghi <mx...@apache.org>
* doc/xml/upgrading.xml: Adding Karl's note about upgrading from NeoWebScript
Modified: tcl/rivet/trunk/rivet/packages/dio/aida.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/aida.tcl?rev=1596885&r1=1596884&r2=1596885&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/aida.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/aida.tcl Thu May 22 14:19:10 2014
@@ -70,7 +70,7 @@ proc handle {interface args} {
# returns a return object
#
- ::itcl::class Result {args} {
+ ::itcl::class Result {
public variable resultid ""
public variable fields ""
@@ -81,6 +81,10 @@ proc handle {interface args} {
public variable errorinfo ""
public variable autocache 1
+ protected variable cached 0
+ protected variable cacheSize 0
+ protected variable cacheArray
+
constructor {args} {
eval configure $args
}
@@ -90,20 +94,144 @@ proc handle {interface args} {
method destroy {} {
::itcl::delete object $this
}
-
- protected method configure_variable {varName string}
-
+ #
+ # 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 string.
+ # variable to the strings
#
::itcl::body Result::configure_variable {varName string} {
- if {[lempty $string]} { return [$this cget -$varName] }
+ 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]
+ }
}
Modified: tcl/rivet/trunk/rivet/packages/dio/sql.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/sql.tcl?rev=1596885&r1=1596884&r2=1596885&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/sql.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/sql.tcl Thu May 22 14:19:10 2014
@@ -26,7 +26,7 @@ package require Itcl
###
catch { ::itcl::delete class ::DIO::Sql }
###
-namespace eval ::DIO {
+namespace eval ::Aida {
proc generator {backend} {
@@ -299,168 +299,6 @@ namespace eval ::DIO {
return $sql
}
- ::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]
- }
---------------------------------------------------------------------
To unsubscribe, e-mail: site-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: site-cvs-help@tcl.apache.org