This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch 3.2
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
The following commit(s) were added to refs/heads/3.2 by this push:
new a3ffa4c Fix misplaced comment block in DIO formatters
a3ffa4c is described below
commit a3ffa4c7b8795bb39d0a153164f95d6e5c78b0b6
Author: Massimo Manghi <[email protected]>
AuthorDate: Sun Nov 2 18:21:58 2025 +0100
Fix misplaced comment block in DIO formatters
---
ChangeLog | 6 +++
rivet/packages/dio/dio.tcl | 2 +-
rivet/packages/dio/formatters.tcl | 25 ++++++-----
rivet/packages/session/session-class.tcl | 75 +++++++++++++++++---------------
4 files changed, 59 insertions(+), 49 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index fa3e1bf..e8bd36d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2025-11-01 Massimo Manghi <[email protected]>
+ * rivet/packages/dio/formatters.tcl: fixed misplaced comment that
+ let a switch...case constuct fail
+ * rivet/packages/session/session-class.tcl: place messages to debug
+ session update times computations
+
2025-10-26 Massimo Manghi <[email protected]>
* rivet/packages/dio/dio_Tdbc.tcl: version number updated to 1.2.5
diff --git a/rivet/packages/dio/dio.tcl b/rivet/packages/dio/dio.tcl
index 2a874e4..3ffb1c3 100644
--- a/rivet/packages/dio/dio.tcl
+++ b/rivet/packages/dio/dio.tcl
@@ -16,7 +16,7 @@
catch {package require Tclx}
package require Itcl
-package require dio::formatters
+package require dio::formatters 1.1
# Command ::rivet::lempty is extensively used within this class but it's
# defined only when we run DIO from mod_rivet. For convenience we load it
diff --git a/rivet/packages/dio/formatters.tcl
b/rivet/packages/dio/formatters.tcl
index 871b328..7fa7d89 100644
--- a/rivet/packages/dio/formatters.tcl
+++ b/rivet/packages/dio/formatters.tcl
@@ -62,6 +62,7 @@ namespace eval ::DIO::formatters {
if {[catch {
set field_value [$this $field_type $field_name $val
$convert_to]
} e einfo]} {
+ puts "<pre>Error: $e, $einfo</pre>"
set field_value "'[quote $val]'"
}
@@ -162,7 +163,6 @@ namespace eval ::DIO::formatters {
}
public method NOW {field_name val convert_to} {
- switch $convert_to {
# we try to be coherent with the original purpose of this method
whose
# goal is to provide a uniform way to handle timestamps.
@@ -171,6 +171,7 @@ namespace eval ::DIO::formatters {
# can be done and session expirations are computed consistently.
# (Bug #53703)
+ switch $convert_to {
SECS {
if {[::string compare $val "now"] == 0} {
# set secs [clock seconds]
@@ -205,26 +206,26 @@ namespace eval ::DIO::formatters {
set my_val [clock format $secs -format {%Y-%m-%d}]
return "'$my_val'"
}
+
public method DATETIME {field_name val convert_to} {
set secs [clock scan $val]
set my_val [clock format $secs -format {%Y-%m-%d %T}]
return "'$my_val'"
}
+
public method NOW {field_name val convert_to} {
- switch $convert_to {
- # we try to be coherent with the original purpose of this
method whose
- # goal is to provide a uniform way to handle timestamps.
- # E.g.: Package session expects this case to return a
timestamp in seconds
- # so that differences with timestamps returned by [clock
seconds]
- # can be done and session expirations are computed
consistently.
- # (Bug #53703)
+ # we try to be coherent with the original purpose of this method
whose
+ # goal is to provide a uniform way to handle timestamps.
+ # E.g.: Package session expects this case to return a timestamp in
seconds
+ # so that differences with timestamps returned by [clock seconds]
+ # can be done and session expirations are computed consistently.
+ # (Bug #53703)
+
+ switch $convert_to {
SECS {
if {[::string compare $val "now"] == 0} {
-# set secs [clock seconds]
-# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
-# return $my_val
return [clock seconds]
} else {
return "extract(epoch from $field_name)"
@@ -287,4 +288,4 @@ namespace eval ::DIO::formatters {
}; ## namespace eval DIO
-package provide dio::formatters 1.0
+package provide dio::formatters 1.1
diff --git a/rivet/packages/session/session-class.tcl
b/rivet/packages/session/session-class.tcl
index f3ffebd..29d546c 100644
--- a/rivet/packages/session/session-class.tcl
+++ b/rivet/packages/session/session-class.tcl
@@ -17,7 +17,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-package provide Session 1.0.1
+package provide Session 1.1
package require Itcl
::itcl::class Session {
@@ -104,7 +104,7 @@ package require Itcl
constructor {args} {
eval configure $args
- $dioObject registerSpecialField $sessionTable session_update_time NOW
+ $dioObject registerSpecialField $sessionTable session_update_time NOW
$dioObject registerSpecialField $sessionTable session_start_time NOW
}
@@ -164,6 +164,8 @@ package require Itcl
method do_garbage_collection {} {
debug "do_garbage_collection: performing garbage collection"
# set result [$dioObject exec "delete from $sessionTable where timestamp
'now' - session_update_time > interval '$gcMaxLifetime seconds';"]
+ #
+ debug "do_garbage_collection: t1: [$dioObject makeDBFieldValue
$sessionTable session_update_time now SECS] t2: [$dioObject makeDBFieldValue
$sessionTable session_update_time {} SECS]"
set del_cmd "delete from $sessionTable where "
append del_cmd [$dioObject makeDBFieldValue $sessionTable
session_update_time now SECS]
append del_cmd " - [$dioObject makeDBFieldValue $sessionTable
session_update_time {} SECS]"
@@ -180,6 +182,8 @@ package require Itcl
# performed.
#
method consider_garbage_collection {} {
+ debug "consider_garbage_collection: probability: $gcProbability"
+
if {rand() <= $gcProbability / 100.0} {
do_garbage_collection
}
@@ -192,10 +196,10 @@ package require Itcl
#
method set_session_cookie {value} {
::rivet::cookie set $cookieName $value \
- -path $cookiePath \
- -minutes $cookieLifetime \
- -secure $cookieSecure \
- -HttpOnly $cookieHttpOnly
+ -path $cookiePath \
+ -minutes $cookieLifetime \
+ -secure $cookieSecure \
+ -HttpOnly $cookieHttpOnly
}
#
@@ -304,20 +308,21 @@ package require Itcl
# store the data in the rivet session cache
#
method store {packageName key data} {
- set a(session_id) [id]
- set a(package_) $packageName
- set a(key_) $key
+ set a(session_id) [id]
+ set a(package_) $packageName
+ set a(key_) $key
- regsub -all {\\} $data {\\\\} data
- set a(data) $data
+ regsub -all {\\} $data {\\\\} data
+ set a(data) $data
- debug "store session data, package_ '$packageName', key_ '$key', data
'$data'"
- set kf [list session_id package_ key_]
+ debug "store session data, package_ '$packageName', key_ '$key', data
'$data'"
+ set kf [list session_id package_ key_]
- if {![$dioObject store a -table $sessionCacheTable -keyfield $kf]} {
- debug "Failed to store $sessionCacheTable '$kf'"
- error [$dioObject errorinfo]
- }
+ if {![$dioObject store a -table $sessionCacheTable -keyfield $kf]} {
+ debug "Failed to store $sessionCacheTable '$kf'"
+ #parray a
+ error [$dioObject errorinfo]
+ }
}
#
@@ -325,23 +330,23 @@ package require Itcl
# for this session
#
method fetch {packageName key} {
- set kf [list session_id package_ key_]
-
- set a(session_id) [id]
- set a(package_) $packageName
- set a(key_) $key
-
- set key [$dioObject makekey a $kf]
- if {![$dioObject fetch $key a -table $sessionCacheTable -keyfield
$kf]} {
- status [$dioObject errorinfo]
- debug "error: [$dioObject errorinfo]"
- debug "fetch session data failed, package_ '$packageName', key_
'$key', error '[$dioObject errorinfo]'"
- return ""
- }
+ set kf [list session_id package_ key_]
+
+ set a(session_id) [id]
+ set a(package_) $packageName
+ set a(key_) $key
+
+ set key [$dioObject makekey a $kf]
+ if {![$dioObject fetch $key a -table $sessionCacheTable -keyfield $kf]}
{
+ status [$dioObject errorinfo]
+ debug "error: [$dioObject errorinfo]"
+ debug "fetch session data failed, package_ '$packageName', key_
'$key', error '[$dioObject errorinfo]'"
+ return ""
+ }
- debug "fetch session data succeeded, package_ '$packageName', key_
'$key', result '$a(data)'"
+ debug "fetch session data succeeded, package_ '$packageName', key_
'$key', result '$a(data)'"
- return $a(data)
+ return $a(data)
}
#
@@ -494,11 +499,9 @@ package require Itcl
#
method debug {message} {
if {$debugMode} {
- $this debug_output "$this (debug) $message" $debugFile
+ puts $debugFile "$this (debug) $message<br>"
flush $debugFile
}
}
-
- method debug_output {msg args} { puts [lindex $args 0] "$msg <br>" }
-
}
+
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
