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/04/16 22:33:41 UTC
svn commit: r1588062 - in /tcl/rivet/trunk: ChangeLog doc/xml/commands.xml
rivet/packages/dio/aida.tcl rivet/packages/dio/dio_Tdbc.tcl
rivet/packages/dio/sql.tcl
Author: mxmanghi
Date: Wed Apr 16 20:33:41 2014
New Revision: 1588062
URL: http://svn.apache.org/r1588062
Log: (empty)
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/doc/xml/commands.xml
tcl/rivet/trunk/rivet/packages/dio/aida.tcl
tcl/rivet/trunk/rivet/packages/dio/dio_Tdbc.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=1588062&r1=1588061&r2=1588062&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Wed Apr 16 20:33:41 2014
@@ -1,5 +1,7 @@
2014-04-16 Massimo Manghi <mx...@apache.org>
- * src/rivetcmds/rivetInpect.c: adding is_virtual flag to values returned by '::rivet::inspect server'
+ * 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'
2014-04-11 Massimo Manghi <mx...@apache.org>
* src/rivetcmds/rivetCore.c: misplaced check on request_rec in Rivet_InspectCmd
Modified: tcl/rivet/trunk/doc/xml/commands.xml
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/doc/xml/commands.xml?rev=1588062&r1=1588061&r2=1588062&view=diff
==============================================================================
--- tcl/rivet/trunk/doc/xml/commands.xml (original)
+++ tcl/rivet/trunk/doc/xml/commands.xml Wed Apr 16 20:33:41 2014
@@ -875,7 +875,7 @@ keyvalue_map(args) = 1 2 3 4 5</programl
into the configuration, but it can be used in any script.
</para>
<para>
- <command>::rivet::inspect</command> can be called in 4 different forms
+ <command>::rivet::inspect</command> can be called in 5 different forms
</para>
<itemizedlist mark="square">
@@ -884,7 +884,7 @@ keyvalue_map(args) = 1 2 3 4 5</programl
keys: server, dir, user. Each key is associated to a subdictionary
carrying the configuration as set for that request. In this form the command is
meant to support compatibility with previous versions of mod_rivet
- where three global array RivetUserConf was created to be internally used by command
+ where three global arrays were created to be internally used by command
<command>::rivet::debug</command>.
</listitem>
@@ -910,10 +910,11 @@ keyvalue_map(args) = 1 2 3 4 5</programl
</listitem>
<listitem>
- With one argument (one of the Rivet configuration directives listed above)
- <command>::rivet::inspect</command> returns the current value
- in the configuration record.
+ With one of the Rivet configuration directives listed above as
+ single argument <command>::rivet::inspect</command> returns the
+ current value in the configuration record.
</listitem>
+
<listitem>
Passing the argument "script" <command>::rivet::inspect</command>
returns a path to the current script in a similar way
@@ -923,6 +924,17 @@ keyvalue_map(args) = 1 2 3 4 5</programl
returns the full path.
</listitem>
+ <listitem>
+ Passing the argument "server" <command>::rivet::inspect</command>
+ returns a dictionary with these fields taken from the server record
+ descriptor
+ <itemizedlist>
+ <listitem>hostname: The server hostname </listitem>
+ <listitem>admin: The admin's contact information</listitem>
+ <listitem>errorlog: The name of the error log</listitem>
+ <listitem>server_path: Pathname for ServerPath</listitem>
+ </itemizedlist>
+ </listitem>
</itemizedlist>
</refsect1>
</refentry>
Modified: tcl/rivet/trunk/rivet/packages/dio/aida.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/aida.tcl?rev=1588062&r1=1588061&r2=1588062&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/aida.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/aida.tcl Wed Apr 16 20:33:41 2014
@@ -60,6 +60,11 @@ proc handle {interface args} {
private variable sql
}
+ ::itcl::body Aida::build_select_query {args} {
+ return [$sqlobj build_select_query {*}$args]
+ }
+
+
# -- result
#
# returns a return object
Modified: tcl/rivet/trunk/rivet/packages/dio/dio_Tdbc.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/dio_Tdbc.tcl?rev=1588062&r1=1588061&r2=1588062&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/dio_Tdbc.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/dio_Tdbc.tcl Wed Apr 16 20:33:41 2014
@@ -61,7 +61,9 @@ namespace eval DIO {
}
-# --
+# -- destructor
+#
+#
constructor {args} { eval configure $args } {
if {[catch {package require tdbc}]} {
Modified: tcl/rivet/trunk/rivet/packages/dio/sql.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/sql.tcl?rev=1588062&r1=1588061&r2=1588062&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/sql.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/sql.tcl Wed Apr 16 20:33:41 2014
@@ -164,7 +164,7 @@ namespace eval ::DIO {
# some key-value pairs that cause the where clause to be
# generated accordingly
- ::itcl::body Sql::build_select_query {from_table args} {
+ ::itcl::body Sql::build_select_query {args} {
set bool AND
set first 1
@@ -177,14 +177,14 @@ namespace eval ::DIO {
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)
+ # (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)"
+ # puts "cycle: $i (elem: $elem, status: $parser_st, first: $first)"
switch $parser_st {
state0 {
@@ -298,6 +298,172 @@ 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