diff --git a/ChangeLog b/ChangeLog
index a57edd5c..831d7b78 100755
--- a/ChangeLog
+++ b/ChangeLog
@@ -863,14 +863,14 @@ Added Oracle Database Metrics based on Ashmon by Kyle Hailey, used with permissi
---------------------------------------------------------------------
-Version 3.2 2019
+Version 3.2 Jul 2019
Bug fixes
[#132] Running buildschema in CLI for TPC-H has incorrect VU count
[#133] Use all warehouses omits warehouse 1 and fails if more VUsers than warehouses
[#134] Buildschema in CLI errors if 1 virtual user and more than 1 warehouse
-[GH#58] Bug when building TPC-C and TPC-H on Azure
+[TPC-Council#58] Bug when building TPC-C and TPC-H on Azure
Updated time profiler to report percentile values at 10 second intervals
@@ -881,3 +881,18 @@ Updated hammerdbcli to enable autostart with script
Added PostgreSQL v11+ compatible Stored Procedures to use instead of Functions
Added HTTP Web Service interface
+
+---------------------------------------------------------------------
+
+Version 3.3 Oct 2019
+
+Updated Binaries to:
+
+tcl8.6.9, tk8.6.9, thread2.8.4, oratcl4.6, mysqltcl3.052, pgtcl2.1.1, db2tcl2.0.0, redis 0.1
+
+Issues
+
+TPC-Council#44 Event driven virtual user and connection scaling with promise package
+TPC-Council#72 HammerDb crashes in tclodbc - converted SQL Server TPC-C/TPC-H build and driver to tdbc::odbc
+TPC-Council#75 TPC-H cannot be executed for AWS RDS Oracle
+
diff --git a/agent/agent b/agent/agent
index 044caf94..2acb672e 100755
--- a/agent/agent
+++ b/agent/agent
@@ -40,7 +40,7 @@ namespace import comm::*
interp recursionlimit {} 3000
global agentlist S iswin
set iswin "false"
-set version 3.2
+set version 3.3
if {$tcl_platform(platform) == "windows"} {
package require twapi
diff --git a/config/database.xml b/config/database.xml
index ba216c6e..517d3616 100755
--- a/config/database.xml
+++ b/config/database.xml
@@ -13,9 +13,9 @@
MSSQLServer
SQL Server
mssqls
- tclodbc 2.5.2
+ tdbc::odbc 1.1.0
TPC-C TPC-H
- database odbc
+ odbc execute paramtype prepare connection allrows
Db2
diff --git a/config/db2.xml b/config/db2.xml
index 8d8c9973..44d770dc 100755
--- a/config/db2.xml
+++ b/config/db2.xml
@@ -26,6 +26,10 @@
0
false
false
+ false
+ 10
+ false
+ 1000
diff --git a/config/mssqlserver.xml b/config/mssqlserver.xml
index 816c5b46..3159aaab 100755
--- a/config/mssqlserver.xml
+++ b/config/mssqlserver.xml
@@ -32,6 +32,10 @@
5
false
false
+ false
+ 10
+ false
+ 1000
diff --git a/config/mysql.xml b/config/mysql.xml
index 4ff41957..880ff281 100755
--- a/config/mysql.xml
+++ b/config/mysql.xml
@@ -23,6 +23,10 @@
5
false
false
+ false
+ 10
+ false
+ 1000
diff --git a/config/oracle.xml b/config/oracle.xml
index 34368a2b..a52ef088 100755
--- a/config/oracle.xml
+++ b/config/oracle.xml
@@ -29,6 +29,10 @@
5
false
false
+ false
+ 10
+ false
+ 1000
diff --git a/config/postgresql.xml b/config/postgresql.xml
index 763bce4d..f5ae1314 100755
--- a/config/postgresql.xml
+++ b/config/postgresql.xml
@@ -28,6 +28,10 @@
5
false
false
+ false
+ 10
+ false
+ 1000
diff --git a/config/redis.xml b/config/redis.xml
index 6fafd1ef..b3198b58 100755
--- a/config/redis.xml
+++ b/config/redis.xml
@@ -19,6 +19,10 @@
5
false
false
+ false
+ 10
+ false
+ 1000
diff --git a/hammerdb b/hammerdb
index 921530d6..d6ceaf1b 100755
--- a/hammerdb
+++ b/hammerdb
@@ -27,7 +27,7 @@ exit
# License along with this program; If not, see
########################################################################
global hdb_version
-set hdb_version "v3.2"
+set hdb_version "v3.3"
set mainGeometry +10+10
set UserDefaultDir [ file dirname [ info script ] ]
::tcl::tm::path add "$UserDefaultDir/modules"
diff --git a/hammerdbcli b/hammerdbcli
index cb9641c3..af94c481 100755
--- a/hammerdbcli
+++ b/hammerdbcli
@@ -25,7 +25,7 @@ exec ./bin/tclsh8.6 "$0" ${1+"$@"}
# License along with this program; If not, see
########################################################################
global hdb_version
-set hdb_version "v3.2"
+set hdb_version "v3.3"
puts "HammerDB CLI $hdb_version"
puts "Copyright (C) 2003-2019 Steve Shaw"
puts "Type \"help\" for a list of commands"
diff --git a/hammerdbws b/hammerdbws
index df123fe3..895afcc9 100755
--- a/hammerdbws
+++ b/hammerdbws
@@ -8,7 +8,7 @@ export PATH=./bin:$PATH
exec ./bin/tclsh8.6 "$0" ${1+"$@"}
########################################################################
# HammerDB
-# Copyright (C) 2003-2018 Steve Shaw
+# Copyright (C) 2003-2019 Steve Shaw
# Author contact information at: http://www.hammerdb.com
#
# This program is free software; you can redistribute it and/or
@@ -25,7 +25,7 @@ exec ./bin/tclsh8.6 "$0" ${1+"$@"}
# License along with this program; If not, see
########################################################################
global hdb_version
-set hdb_version "v3.2"
+set hdb_version "v3.3"
puts "HammerDB Web Service $hdb_version"
puts "Copyright (C) 2003-2019 Steve Shaw"
puts "Type \"help\" for a list of commands"
diff --git a/modules/promise-1.1.0.tm b/modules/promise-1.1.0.tm
new file mode 100755
index 00000000..46ae4a84
--- /dev/null
+++ b/modules/promise-1.1.0.tm
@@ -0,0 +1,1298 @@
+# Copyright (c) 2015, Ashok P. Nadkarni
+# All rights reserved.
+
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+package require Tcl 8.6
+
+namespace eval promise {
+ proc version {} { return 1.1.0 }
+}
+
+proc promise::lambda {params body args} {
+ # Creates an anonymous procedure and returns a command prefix for it.
+ # params - parameter definitions for the procedure
+ # body - body of the procedures
+ # args - additional arguments to be passed to the procedure when it
+ # is invoked
+ #
+ # This is just a convenience command since anonymous procedures are
+ # commonly useful with promises. The lambda package from tcllib
+ # is identical in function.
+
+ return [list ::apply [list $params $body] {*}$args]
+}
+
+catch {promise::Promise destroy}
+oo::class create promise::Promise {
+
+ # The promise state can be one of
+ # PENDING - Initial state where it has not yet been assigned a
+ # value or error
+ # FULFILLED - The promise has been assigned a value
+ # REJECTED - The promise has been assigned an error
+ # CHAINED - The promise is attached to another promise
+ variable _state
+
+ # Stores data that is accessed through the setdata/getdata methods.
+ # The Promise class itself does not use this.
+ variable _clientdata
+
+ # The promise value once it is fulfilled or rejected. In the latter
+ # case, it should be an the error message
+ variable _value
+
+ # The error dictionary in case promise is rejected
+ variable _edict
+
+ # Reactions to be notified when the promise is rejected. Each element
+ # in this list is a pair consisting of the fulfilment reaction
+ # and the rejection reaction. Either element of the pair could be
+ # empty signifying no reaction for that case. The list is populated
+ # via the then method.
+ variable _reactions
+
+ # Reference counting to free up promises since Tcl does not have
+ # garbage collection for objects. Garbage collection via reference
+ # counting only takes place after at least one done/then reaction
+ # is placed on the event queue, not before. Else promises that
+ # are immediately resolved on construction would be freed right
+ # away before the application even gets a chance to call done/then.
+ variable _do_gc
+ variable _nrefs
+
+ # If no reject reactions are registered, then the Tcl bgerror
+ # handler is invoked. But don't want to do this more than once
+ # so track it
+ variable _bgerror_done
+
+ constructor {cmd} {
+ # Create a promise for the asynchronous operation to be initiated
+ # by $cmd.
+ # cmd - a command prefix that should initiate an asynchronous
+ # operation.
+ # The command prefix $cmd is passed an additional argument - the
+ # name of this Promise object. It should arrange for one of the
+ # object's settle methods [fulfill], [chain] or
+ # [reject] to be called when the operation completes.
+
+ set _state PENDING
+ set _reactions [list ]
+ set _do_gc 0
+ set _bgerror_done 0
+ set _nrefs 0
+ array set _clientdata {}
+
+ # Errors in the construction command are returned via
+ # the standard mechanism of reject.
+ #
+ if {[catch {
+ # For some special cases, $cmd may be "" if the async operation
+ # is initiated outside the constructor. This is not a good
+ # thing because the error in the initiator will not be
+ # trapped via the standard promise error catching mechanism
+ # but that's the application's problem (actually pgeturl also
+ # uses this).
+ if {[llength $cmd]} {
+ uplevel #0 [linsert $cmd end [self]]
+ }
+ } msg edict]} {
+ my reject $msg $edict
+ }
+ }
+
+ destructor {
+ # Destroys the object.
+ #
+ # This method should not be generally called directly as [Promise]
+ # objects are garbage collected either automatically or via the [ref]
+ # and [unref] methods.
+ }
+
+ method state {} {
+ # Returns the current state of the promise.
+ #
+ # The promise state may be one of the values 'PENDING',
+ # 'FULFILLED', 'REJECTED' or 'CHAINED'
+ return $_state
+ }
+
+ method getdata {key} {
+ # Returns data previously stored through the setdata method.
+ # key - key whose associated values is to be returned.
+ # An error will be raised if no value is associated with the key.
+ return $_clientdata($key)
+ }
+
+ method setdata {key value} {
+ # Sets a value to be associated with a key.
+ # key - the lookup key
+ # value - the value to be associated with the key
+ # A promise internally maintains a dictionary whose values can
+ # be accessed with the [getdata] and [setdata] methods. This
+ # dictionary is not used by the Promise class itself but is meant
+ # to be used by promise library specializations or applications.
+ # Callers need to take care that keys used for a particular
+ # promise are sufficiently distinguishable so as to not clash.
+ #
+ # Returns the value stored with the key.
+ set _clientdata($key) $value
+ }
+
+ method value {} {
+ # Returns the settled value for the promise.
+ #
+ # The returned value may be the fulfilled value or the rejected
+ # value depending on whether the associated operation was successfully
+ # completed or failed.
+ #
+ # An error is raised if the promise is not settled yet.
+ if {$_state ni {FULFILLED REJECTED}} {
+ error "Value is not set."
+ }
+ return $_value
+ }
+
+ method ref {} {
+ # Increments the reference count for the object.
+ incr _nrefs
+ }
+
+ method unref {} {
+ # Decrements the reference count for the object.
+ #
+ # The object may have been destroyed when the call returns.
+ incr _nrefs -1
+ my GC
+ }
+
+ method nrefs {} {
+ # Returns the current reference count.
+ #
+ # Use for debugging only! Note, internal references are not included.
+ return $_nrefs
+ }
+
+ method GC {} {
+ if {$_nrefs <= 0 && $_do_gc && [llength $_reactions] == 0} {
+ my destroy
+ }
+ }
+
+ method FulfillAttached {value} {
+ if {$_state ne "CHAINED"} {
+ return
+ }
+ set _value $value
+ set _state FULFILLED
+ my ScheduleReactions
+ return
+ }
+
+ method RejectAttached {reason edict} {
+ if {$_state ne "CHAINED"} {
+ return
+ }
+ set _value $reason
+ set _edict $edict
+ set _state REJECTED
+ my ScheduleReactions
+ return
+ }
+
+ # Method to invoke to fulfil a promise with a value or another promise.
+ method fulfill {value} {
+ # Fulfills the promise.
+ # value - the value with which the promise is fulfilled
+ #
+ # Returns '0' if promise had already been settled and '1' if
+ # it was fulfilled by the current call.
+
+ #ruff
+ # If the promise has already been settled, the method has no effect.
+ if {$_state ne "PENDING"} {
+ return 0; # Already settled
+ }
+
+ #ruff
+ # Otherwise, it is transitioned to the 'FULFILLED' state with
+ # the value specified by $value. If there are any fulfillment
+ # reactions registered by the [done] or [then] methods, they
+ # are scheduled to be run.
+ set _value $value
+ set _state FULFILLED
+ my ScheduleReactions
+ return 1
+ }
+
+ # Method to invoke to fulfil a promise with a value or another promise.
+ method chain {promise} {
+ # Chains the promise to another promise.
+ # promise - the [Promise] object to which this promise is to
+ # be chained
+ #
+ # Returns '0' if promise had already been settled and '1' otherwise.
+
+ #ruff
+ # If the promise on which this method is called
+ # has already been settled, the method has no effect.
+ if {$_state ne "PENDING"} {
+ return 0;
+ }
+
+ #ruff
+ # Otherwise, it is chained to $promise so that it reflects that
+ # other promise's state.
+ if {[catch {
+ $promise done [namespace code {my FulfillAttached}] [namespace code {my RejectAttached}]
+ } msg edict]} {
+ my reject $msg $edict
+ } else {
+ set _state CHAINED
+ }
+
+ return 1
+ }
+
+ method reject {reason {edict {}}} {
+ # Rejects the promise.
+ # reason - a message string describing the reason for the rejection.
+ # edict - a Tcl error dictionary
+ #
+ # The $reason and $edict values are passed on to the rejection
+ # reactions. By convention, these should be of the form returned
+ # by the `catch` or `try` commands in case of errors.
+ #
+ # Returns '0' if promise had already been settled and '1' if
+ # it was rejected by the current call.
+
+ #ruff
+ # If the promise has already been settled, the method has no effect.
+ if {$_state ne "PENDING"} {
+ return 0; # Already settled
+ }
+
+ #ruff
+ # Otherwise, it is transitioned to the 'REJECTED' state. If
+ # there are any reject reactions registered by the [done] or
+ # [then] methods, they are scheduled to be run.
+
+ set _value $reason
+ #ruff
+ # If $edict is not specified, or specified as an empty string,
+ # a suitable error dictionary is constructed in its place
+ # to be passed to the reaction.
+ if {$edict eq ""} {
+ catch {throw {PROMISE REJECTED} $reason} - edict
+ }
+ set _edict $edict
+ set _state REJECTED
+ my ScheduleReactions
+ return 1
+ }
+
+ # Internal method to queue all registered reactions based on
+ # whether the promise is succesfully fulfilled or not
+ method ScheduleReactions {} {
+ if {$_state ni {FULFILLED REJECTED} || [llength $_reactions] == 0 } {
+ # Promise is not settled or no reactions registered
+ return
+ }
+
+ # Note on garbage collection: garbage collection is to be enabled if
+ # at least one FULFILLED or REJECTED reaction is registered.
+ # Also if the promise is REJECTED but no rejection handlers are run
+ # we also schedule a background error.
+ # In all cases, CLEANUP reactions do not count.
+ foreach reaction $_reactions {
+ foreach type {FULFILLED REJECTED} {
+ if {[dict exists $reaction $type]} {
+ set _do_gc 1
+ if {$type eq $_state} {
+ set cmd [dict get $reaction $type]
+ if {[llength $cmd]} {
+ if {$type eq "FULFILLED"} {
+ lappend cmd $_value
+ } else {
+ lappend cmd $_value $_edict
+ }
+ set ran_reaction($type) 1
+ # Enqueue the reaction via the event loop
+ after 0 [list after idle $cmd]
+ }
+ }
+ }
+ }
+ if {[dict exists $reaction CLEANUP]} {
+ set cmd [dict get $reaction CLEANUP]
+ if {[llength $cmd]} {
+ # Enqueue the cleaner via the event loop passing the
+ # *state* as well as the value
+ if {$_state eq "REJECTED"} {
+ lappend cmd $_state $_value $_edict
+ } else {
+ lappend cmd $_state $_value
+ }
+ after 0 [list after idle $cmd]
+ # Note we do not set _do_gc if we only run cleaners
+ }
+ }
+ }
+ set _reactions [list ]
+
+ # Check for need to background error (see comments above)
+ if {$_state eq "REJECTED" && $_do_gc && ! [info exists ran_reaction(REJECTED)] && ! $_bgerror_done} {
+ # TBD - should we also check _nrefs before backgrounding error?
+
+ # Wrap in catch in case $_edict does not follow error conventions
+ # or is not even a dictionary
+ if {[catch {
+ dict get $_edict -level
+ dict get $_edict -code
+ }]} {
+ catch {throw {PROMISE REJECT} $_value} - edict
+ } else {
+ set edict $_edict
+ }
+ # TBD - how exactly is level to be handled?
+ # If -level is not 0, bgerror barfs because it treates
+ # it as TCL_RETURN no matter was -code is
+ dict set edict -level 0
+ after idle [interp bgerror {}] [list $_value $edict]
+ set _bgerror_done 1
+ }
+
+ my GC
+ return
+ }
+
+ method RegisterReactions {args} {
+ # Registers the specified reactions.
+ # args - dictionary keyed by 'CLEANUP', 'FULFILLED', 'REJECTED'
+ # with values being the corresponding reaction callback
+
+ lappend _reactions $args
+ my ScheduleReactions
+ return
+ }
+
+ method done {{on_fulfill {}} {on_reject {}}} {
+ # Registers reactions to be run when the promise is settled.
+ # on_fulfill - command prefix for the reaction to run
+ # if the promise is fulfilled.
+ # reaction is registered.
+ # on_reject - command prefix for the reaction to run
+ # if the promise is rejected.
+ # Reactions are called with an additional argument which is
+ # the value with which the promise was settled.
+ #
+ # The command may be called multiple times to register multiple
+ # reactions to be run at promise settlement. If the promise was
+ # already settled at the time the call was made, the reactions
+ # are invoked immediately. In all cases, reactions are not called
+ # directly, but are invoked by scheduling through the event loop.
+ #
+ # The method triggers garbage collection of the object if the
+ # promise has been settled and any registered reactions have been
+ # scheduled. Applications can hold on to the object through
+ # appropriate use of the [ref] and [unref] methods.
+ #
+ # Note that both $on_fulfill and $on_reject may be specified
+ # as empty strings if no further action needs to be taken on
+ # settlement of the promise. If the promise is rejected, and
+ # no rejection reactions are registered, the error is reported
+ # via the Tcl 'interp bgerror' facility.
+
+ # TBD - as per the Promise/A+ spec, errors in done should generate
+ # a background error (unlike then).
+
+ my RegisterReactions FULFILLED $on_fulfill REJECTED $on_reject
+
+ #ruff
+ # The method does not return a value.
+ return
+ }
+
+ method then {on_fulfill {on_reject {}}} {
+ # Registers reactions to be run when the promise is settled
+ # and returns a new [Promise] object that will be settled by the
+ # reactions.
+ # on_fulfill - command prefix for the reaction to run
+ # if the promise is fulfilled. If an empty string, no fulfill
+ # reaction is registered.
+ # on_reject - command prefix for the reaction to run
+ # if the promise is rejected. If unspecified or an empty string,
+ # no reject reaction is registered.
+ # Both reactions are called with an additional argument which is
+ # the value with which the promise was settled.
+ #
+ # The command may be called multiple times to register multiple
+ # reactions to be run at promise settlement. If the promise was
+ # already settled at the time the call was made, the reactions
+ # are invoked immediately. In all cases, reactions are not called
+ # directly, but are invoked by scheduling through the event loop.
+ #
+ # If the reaction that is invoked runs without error, its return
+ # value fulfills the new promise returned by the 'then' method.
+ # If it raises an exception, the new promise will be rejected
+ # with the error message and dictionary from the exception.
+ #
+ # Alternatively, the reactions can explicitly invoke commands
+ # [then_fulfill], [then_reject] or [then_chain] to
+ # resolve the returned promise. In this case, the return value
+ # (including exceptions) from the reactions are ignored.
+ #
+ # If 'on_fulfill' (or 'on_reject') is an empty string (or unspecified),
+ # the new promise is created and fulfilled (or rejected) with
+ # the same value that would have been passed in to the reactions.
+ #
+ # The method triggers garbage collection of the object if the
+ # promise has been settled and registered reactions have been
+ # scheduled. Applications can hold on to the object through
+ # appropriate use of the [ref] and [unref] methods.
+ #
+ # Returns a new promise that is settled by the registered reactions.
+
+ set then_promise [[self class] new ""]
+ my RegisterReactions \
+ FULFILLED [list ::promise::_then_reaction $then_promise FULFILLED $on_fulfill] \
+ REJECTED [list ::promise::_then_reaction $then_promise REJECTED $on_reject]
+ return $then_promise
+ }
+
+ # This could be a forward, but then we cannot document it via ruff!
+ method catch {on_reject} {
+ # Registers reactions to be run when the promise is rejected.
+ # on_reject - command prefix for the reaction
+ # reaction to run if the promise is rejected. If unspecified
+ # or an empty string, no reject reaction is registered. The
+ # reaction is called with an additional argument which is the
+ # value with which the promise was settled.
+ # This method is just a wrapper around [then] with the
+ # 'on_fulfill' parameter defaulting to an empty string. See
+ # the description of that method for details.
+ return [my then "" $on_reject]
+ }
+
+ method cleanup {cleaner} {
+ # Registers a reaction to be executed for running cleanup
+ # code when the promise is settled.
+ # cleaner - command prefix to run on settlement
+ # This method is intended to run a clean up script
+ # when a promise is settled. Its primary use is to avoid duplication
+ # of code in the `then` and `catch` handlers for a promise.
+ # It may also be called multiple times
+ # to clean up intermediate steps when promises are chained.
+ #
+ # The method returns a new promise that will be settled
+ # as per the following rules.
+ # - if the cleaner runs without errors, the returned promise
+ # will reflect the settlement of the promise on which this
+ # method is called.
+ # - if the cleaner raises an exception, the returned promise
+ # is rejected with a value consisting of the error message
+ # and dictionary pair.
+ #
+ # Returns a new promise that is settled based on the cleaner
+ set cleaner_promise [[self class] new ""]
+ my RegisterReactions CLEANUP [list ::promise::_cleanup_reaction $cleaner_promise $cleaner]
+ return $cleaner_promise
+ }
+}
+
+proc promise::_then_reaction {target_promise status cmd value {edict {}}} {
+ # Run the specified command and fulfill/reject the target promise
+ # accordingly. If the command is empty, the passed-in value is passed
+ # on to the target promise.
+
+ # IMPORTANT!!!!
+ # MUST BE CALLED FROM EVENT LOOP AT so info level must be 1. Else
+ # promise::then_fulfill/then_reject/then_chain will not work
+ # Also, Do NOT change the param name target_promise without changing
+ # those procs.
+ # Oh what a hack to get around lack of closures. Alternative would have
+ # been to pass an additional parameter (target_promise)
+ # to the application code but then that script would have had to
+ # carry that around.
+
+ if {[info level] != 1} {
+ error "Internal error: _then_reaction not at level 1"
+ }
+
+ if {[llength $cmd] == 0} {
+ switch -exact -- $status {
+ FULFILLED { $target_promise fulfill $value }
+ REJECTED { $target_promise reject $value $edict}
+ CHAINED -
+ PENDING -
+ default {
+ $target_promise reject "Internal error: invalid status $state"
+ }
+ }
+ } else {
+ # Invoke the real reaction code and fulfill/reject the target promise.
+ # Note the reaction code may have called one of the promise::then_*
+ # commands itself and reactions run resulting in the object being
+ # freed. Hence resolve using the safe* variants
+ # TBD - ideally we would like to execute at global level. However
+ # the then_* commands retrieve target_promise from level 1 (here)
+ # which they cannot if uplevel #0 is done. So directly invoke.
+ if {$status eq "REJECTED"} {
+ lappend cmd $value $edict
+ } else {
+ lappend cmd $value
+ }
+ if {[catch $cmd reaction_value reaction_edict]} {
+ safe_reject $target_promise $reaction_value $reaction_edict
+ } else {
+ safe_fulfill $target_promise $reaction_value
+ }
+ }
+ return
+}
+
+proc promise::_cleanup_reaction {target_promise cleaner state value {edict {}}} {
+ # Run the specified cleaner and fulfill/reject the target promise
+ # accordingly. If the cleaner executes without error, the original
+ # value and state is passed on. If the cleaner executes with error
+ # the promise is rejected.
+
+ if {[llength $cleaner] == 0} {
+ switch -exact -- $state {
+ FULFILLED { $target_promise fulfill $value }
+ REJECTED { $target_promise reject $value $edict }
+ CHAINED -
+ PENDING -
+ default {
+ $target_promise reject "Internal error: invalid state $state"
+ }
+ }
+ } else {
+ if {[catch {uplevel #0 $cleaner} err edict]} {
+ # Cleaner failed. Reject the target promise
+ $target_promise reject $err $edict
+ } else {
+ # Cleaner completed without errors, pass on the original value
+ if {$state eq "FULFILLED"} {
+ $target_promise fulfill $value
+ } else {
+ $target_promise reject $value $edict
+ }
+ }
+ }
+ return
+}
+
+proc promise::then_fulfill {value} {
+ # Fulfills the promise returned by a [then] method call from
+ # within its reaction.
+ # value - the value with which to fulfill the promise
+ #
+ # The [Promise.then] method is a mechanism to chain asynchronous
+ # reactions by registering them on a promise. It returns a new
+ # promise which is settled by the return value from the reaction,
+ # or by the reaction calling one of three commands - 'then_fulfill',
+ # [then_reject] or [then_chain]. Calling 'then_fulfill' fulfills
+ # the promise returned by the 'then' method that queued the currently
+ # running reaction.
+ #
+ # It is an error to call this command from outside a reaction
+ # that was queued via the [then] method on a promise.
+
+ # TBD - what if someone calls this from within a uplevel #0 ? The
+ # upvar will be all wrong
+ upvar #1 target_promise target_promise
+ if {![info exists target_promise]} {
+ set msg "promise::then_fulfill called in invalid context."
+ throw [list PROMISE THEN FULFILL NOTARGET $msg] $msg
+ }
+ $target_promise fulfill $value
+}
+
+proc promise::then_chain {promise} {
+ # Chains the promise returned by a [then] method call to
+ # another promise.
+ # promise - the promise to which the promise returned by [then] is
+ # to be chained
+ #
+ # The [Promise.then] method is a mechanism to chain asynchronous
+ # reactions by registering them on a promise. It returns a new
+ # promise which is settled by the return value from the reaction,
+ # or by the reaction calling one of three commands - [then_fulfill],
+ # 'then_reject' or [then_chain]. Calling 'then_chain' chains
+ # the promise returned by the 'then' method that queued the currently
+ # running reaction to $promise so that the former will be settled
+ # based on the latter.
+ #
+ # It is an error to call this command from outside a reaction
+ # that was queued via the [then] method on a promise.
+ upvar #1 target_promise target_promise
+ if {![info exists target_promise]} {
+ set msg "promise::then_chain called in invalid context."
+ throw [list PROMISE THEN FULFILL NOTARGET $msg] $msg
+ }
+ $target_promise chain $promise
+}
+
+proc promise::then_reject {reason edict} {
+ # Rejects the promise returned by a [then] method call from
+ # within its reaction.
+ # reason - a message string describing the reason for the rejection.
+ # edict - a Tcl error dictionary
+ # The [Promise.then] method is a mechanism to chain asynchronous
+ # reactions by registering them on a promise. It returns a new
+ # promise which is settled by the return value from the reaction,
+ # or by the reaction calling one of three commands - [then_fulfill],
+ # 'then_reject' or [then_chain]. Calling 'then_reject' rejects
+ # the promise returned by the 'then' method that queued the currently
+ # running reaction.
+ #
+ # It is an error to call this command from outside a reaction
+ # that was queued via the [then] method on a promise.
+ upvar #1 target_promise target_promise
+ if {![info exists target_promise]} {
+ set msg "promise::then_reject called in invalid context."
+ throw [list PROMISE THEN FULFILL NOTARGET $msg] $msg
+ }
+ $target_promise reject $reason $edict
+}
+
+proc promise::all {promises} {
+ # Returns a promise that fulfills or rejects when all promises
+ # in the $promises argument have fulfilled or any one has rejected.
+ # promises - a list of Promise objects
+ # If any of $promises rejects, then the promise returned by the
+ # command will reject with the same value. Otherwise, the promise
+ # will fulfill when all promises have fulfilled.
+ # The resolved value will be a list of the resolved
+ # values of the contained promises.
+
+ set all_promise [Promise new [lambda {promises prom} {
+ set npromises [llength $promises]
+ if {$npromises == 0} {
+ $prom fulfill {}
+ return
+ }
+
+ # Ask each promise to update us when resolved.
+ foreach promise $promises {
+ $promise done \
+ [list ::promise::_all_helper $prom $promise FULFILLED] \
+ [list ::promise::_all_helper $prom $promise REJECTED]
+ }
+
+ # We keep track of state with a dictionary that will be
+ # stored in $prom with the following keys:
+ # PROMISES - the list of promises in the order passed
+ # PENDING_COUNT - count of unresolved promises
+ # RESULTS - dictionary keyed by promise and containing resolved value
+ set all_state [list PROMISES $promises PENDING_COUNT $npromises RESULTS {}]
+
+ $prom setdata ALLPROMISES $all_state
+ } $promises]]
+
+ return $all_promise
+}
+
+proc promise::all* args {
+ # Returns a promise that fulfills or rejects when all promises
+ # in the $args argument have fulfilled or any one has rejected.
+ # args - list of Promise objects
+ # This command is identical to the all command except that it takes
+ # multiple arguments, each of which is a Promise object. See [all]
+ # for a description.
+ return [all $args]
+}
+
+# Callback for promise::all.
+# all_promise - the "master" promise returned by the all call.
+# done_promise - the promise whose callback is being serviced.
+# resolution - whether the current promise was resolved with "FULFILLED"
+# or "REJECTED"
+# value - the value of the currently fulfilled promise or error description
+# in case rejected
+# edict - error dictionary (if promise was rejected)
+proc promise::_all_helper {all_promise done_promise resolution value {edict {}}} {
+ if {![info object isa object $all_promise]} {
+ # The object has been deleted. Naught to do
+ return
+ }
+ if {[$all_promise state] ne "PENDING"} {
+ # Already settled. This can happen when a tracked promise is
+ # rejected and another tracked promise gets settled afterwards.
+ return
+ }
+ if {$resolution eq "REJECTED"} {
+ # This promise failed. Immediately reject the master promise
+ # TBD - can we somehow indicate which promise failed ?
+ $all_promise reject $value $edict
+ return
+ }
+
+ # Update the state of the resolved tracked promise
+ set all_state [$all_promise getdata ALLPROMISES]
+ dict set all_state RESULTS $done_promise $value
+ dict incr all_state PENDING_COUNT -1
+ $all_promise setdata ALLPROMISES $all_state
+
+ # If all promises resolved, resolve the all promise
+ if {[dict get $all_state PENDING_COUNT] == 0} {
+ set values {}
+ foreach prom [dict get $all_state PROMISES] {
+ lappend values [dict get $all_state RESULTS $prom]
+ }
+ $all_promise fulfill $values
+ }
+ return
+}
+
+proc promise::race {promises} {
+ # Returns a promise that fulfills or rejects when any promise
+ # in the $promises argument is fulfilled or rejected.
+ # promises - a list of Promise objects
+ # The returned promise will fulfill and reject with the same value
+ # as the first promise in $promises that fulfills or rejects.
+ set race_promise [Promise new [lambda {promises prom} {
+ if {[llength $promises] == 0} {
+ catch {throw {PROMISE RACE EMPTYSET} "No promises specified."} reason edict
+ $prom reject $reason $edict
+ return
+ }
+ # Use safe_*, do not directly call methods since $prom may be
+ # gc'ed once settled
+ foreach promise $promises {
+ $promise done [list ::promise::safe_fulfill $prom ] [list ::promise::safe_reject $prom]
+ }
+ } $promises]]
+
+ return $race_promise
+}
+
+proc promise::race* {args} {
+ # Returns a promise that fulfills or rejects when any promise
+ # in the passed arguments is fulfilled or rejected.
+ # args - list of Promise objects
+ # This command is identical to the 'race' command except that it takes
+ # multiple arguments, each of which is a Promise object. See [race]
+ # for a description.
+ return [race $args]
+}
+
+proc promise::await {prom} {
+ # Waits for a promise to be settled and returns its resolved value.
+ # prom - the promise that is to be waited on
+ # This command may only be used from within a procedure constructed
+ # with the [async] command or any code invoked from it.
+ #
+ # Returns the resolved value of $prom if it is fulfilled or raises an error
+ # if it is rejected.
+ set coro [info coroutine]
+ if {$coro eq ""} {
+ throw {PROMISE AWAIT NOTCORO} "await called from outside a coroutine"
+ }
+ $prom done [list $coro success] [list $coro fail]
+ lassign [yieldto return -level 0] status val ropts
+ if {$status eq "success"} {
+ return $val
+ } else {
+ return -options $ropts $val
+ }
+}
+
+proc promise::async {name paramdefs body} {
+ # Defines an procedure that will run a script asynchronously as a coroutine.
+ # name - name of the procedure
+ # paramdefs - the parameter definitions to the procedure in the same
+ # form as passed to the standard 'proc' command
+ # body - the script to be executed
+ #
+ # When the defined procedure $name is called, it runs the supplied $body
+ # within a new coroutine. The return value from the $name procedure call
+ # will be a promise that will be fulfilled when the coroutine completes
+ # normally or rejected if it completes with an error.
+ #
+ # Note that the passed $body argument is not the body of the
+ # the procedure $name. Rather it is run as an anonymous procedure in
+ # the coroutine but in the same namespace context as $name. Thus the
+ # caller or the $body script must not make any assumptions about
+ # relative stack levels, use of 'uplevel' etc.
+ #
+ # The primary purpose of this command is to make it easy, in
+ # conjunction with the [await] command, to wrap a sequence of asynchronous
+ # operations as a single computational unit.
+ #
+ # Returns a promise that will be settled with the result of the script.
+ if {![string equal -length 2 "$name" "::"]} {
+ set ns [uplevel 1 namespace current]
+ set name ${ns}::$name
+ } else {
+ set ns ::
+ }
+ set tmpl {
+ proc %NAME% {%PARAMDEFS%} {
+ set p [promise::Promise new [promise::lambda {real_args prom} {
+ coroutine ::promise::async#[info cmdcount] {*}[promise::lambda {p args} {
+ upvar #1 _current_async_promise current_p
+ set current_p $p
+ set status [catch [list apply [list {%PARAMDEFS%} {%BODY%} %NS%] {*}$args] res ropts]
+ if {$status == 0} {
+ $p fulfill $res
+ } else {
+ $p reject $res $ropts
+ }
+ } $prom {*}$real_args]
+ } [lrange [info level 0] 1 end]]]
+ return $p
+ }
+ }
+ eval [string map [list %NAME% $name \
+ %PARAMDEFS% $paramdefs \
+ %BODY% $body \
+ %NS% $ns] $tmpl]
+}
+
+proc promise::async_fulfill {val} {
+ # Fulfills a promise for an async procedure with the specified value.
+ # val - the value with which to fulfill the promise
+ # This command must only be called with the context of an [async]
+ # procedure.
+ #
+ # Returns an empty string.
+ upvar #1 _current_async_promise current_p
+ if {![info exists current_p]} {
+ error "async_fulfill called from outside an async context."
+ }
+ $current_p fulfill $val
+ return
+}
+
+proc promise::async_reject {val {edict {}}} {
+ # Rejects a promise for an async procedure with the specified value.
+ # val - the value with which to reject the promise
+ # edict - error dictionary for rejection
+ # This command must only be called with the context of an [async]
+ # procedure.
+ #
+ # Returns an empty string.
+ upvar #1 _current_async_promise current_p
+ if {![info exists current_p]} {
+ error "async_reject called from outside an async context."
+ }
+ $current_p reject $val $edict
+ return
+}
+
+proc promise::async_chain {prom} {
+ # Chains a promise for an async procedure to the specified promise.
+ # prom - the promise to which the async promise is to be linked.
+ # This command must only be called with the context of an [async]
+ # procedure.
+ #
+ # Returns an empty string.
+ upvar #1 _current_async_promise current_p
+ if {![info exists current_p]} {
+ error "async_chain called from outside an async context."
+ }
+ $current_p chain $prom
+ return
+}
+
+proc promise::pfulfilled {value} {
+ # Returns a new promise that is already fulfilled with the specified value.
+ # value - the value with which to fulfill the created promise
+ return [Promise new [lambda {value prom} {
+ $prom fulfill $value
+ } $value]]
+}
+
+proc promise::prejected {value {edict {}}} {
+ # Returns a new promise that is already rejected.
+ # value - the value with which to reject the promise
+ # edict - error dictionary for rejection
+ # By convention, $value should be of the format returned by
+ # [rejection].
+ return [Promise new [lambda {value edict prom} {
+ $prom reject $value $edict
+ } $value $edict]]
+}
+
+proc promise::eventloop {prom} {
+ # Waits in the eventloop until the specified promise is settled.
+ # prom - the promise to be waited on
+ # The command enters the event loop in similar fashion to the
+ # Tcl [vwait] command except that instead of waiting on a variable
+ # the command waits for the specified promise to be settled. As such
+ # it has the same caveats as the vwait command in terms of care
+ # being taken in nested calls etc.
+ #
+ # The primary use of the command is at the top level of a script
+ # to wait for one or more promise based tasks to be completed. Again,
+ # similar to the vwait forever idiom.
+ #
+ #
+ # Returns the resolved value of $prom if it is fulfilled or raises an error
+ # if it is rejected.
+
+ set varname [namespace current]::_pwait_[info cmdcount]
+ $prom done \
+ [lambda {varname result} {
+ set $varname [list success $result]
+ } $varname] \
+ [lambda {varname error ropts} {
+ set $varname [list fail $error $ropts]
+ } $varname]
+ vwait $varname
+ lassign [set $varname] status result ropts
+ if {$status eq "success"} {
+ return $result
+ } else {
+ return -options $ropts $result
+ }
+}
+
+proc promise::pgeturl {url args} {
+ # Returns a promise that will be fulfilled when the a URL is fetched.
+ # url - the URL to fetch
+ # args - arguments to pass to the [http::geturl] command
+ # This command invokes the asynchronous form of the [http::geturl] command
+ # of the 'http' package. If the operation completes with a status of
+ # 'ok', the returned promise is fulfilled with the contents of the
+ # http state array (see the documentation of [http::geturl]). If the
+ # the status is anything else, the promise is rejected with
+ # the 'reason' parameter to the reaction containing the error message
+ # and the 'edict' parameter containing the Tcl error dictionary
+ # with an additional key 'http_state', containing the
+ # contents of the http state array.
+
+ uplevel #0 {package require http}
+ proc pgeturl {url args} {
+ set prom [Promise new [lambda {http_args prom} {
+ http::geturl {*}$http_args -command [promise::lambda {prom tok} {
+ upvar #0 $tok http_state
+ if {$http_state(status) eq "ok"} {
+ $prom fulfill [array get http_state]
+ } else {
+ if {[info exists http_state(error)]} {
+ set msg [lindex $http_state(error) 0]
+ }
+ if {![info exists msg] || $msg eq ""} {
+ set msg "Error retrieving URL."
+ }
+ catch {throw {PROMISE PGETURL} $msg} msg edict
+ dict set edict http_state [array get http_state]
+ $prom reject $msg $edict
+ }
+ http::cleanup $tok
+ } $prom]
+ } [linsert $args 0 $url]]]
+ return $prom
+ }
+ tailcall pgeturl $url {*}$args
+}
+
+proc promise::ptimer {millisecs {value "Timer expired."}} {
+ # Returns a promise that will be fulfilled when the specified time has
+ # elapsed.
+ # millisecs - time interval in milliseconds
+ # value - the value with which the promise is to be fulfilled
+ # In case of errors (e.g. if $milliseconds is not an integer), the
+ # promise is rejected with the 'reason' parameter set to an error
+ # message and the 'edict' parameter set to a Tcl error dictionary.
+ #
+ # Also see [ptimeout] which is similar but rejects the promise instead
+ # of fulfilling it.
+
+ return [Promise new [lambda {millisecs value prom} {
+ if {![string is integer -strict $millisecs]} {
+ # We don't allow "idle", "cancel" etc. as an argument to after
+ throw {PROMISE TIMER INVALID} "Invalid timeout value \"$millisecs\"."
+ }
+ after $millisecs [list promise::safe_fulfill $prom $value]
+ } $millisecs $value]]
+}
+
+proc promise::ptimeout {millisecs {value "Operation timed out."}} {
+ # Returns a promise that will be rejected when the specified time has
+ # elapsed.
+ # millisecs - time interval in milliseconds
+ # value - the value with which the promise is to be rejected
+ # In case of errors (e.g. if $milliseconds is not an integer), the
+ # promise is rejected with the 'reason' parameter set to $value
+ # and the 'edict' parameter set to a Tcl error dictionary.
+ #
+ # Also see [ptimer] which is similar but fulfills the promise instead
+ # of rejecting it.
+
+ return [Promise new [lambda {millisecs value prom} {
+ if {![string is integer -strict $millisecs]} {
+ # We don't want to accept "idle", "cancel" etc. for after
+ throw {PROMISE TIMER INVALID} "Invalid timeout value \"$millisecs\"."
+ }
+ after $millisecs [::promise::lambda {prom msg} {
+ catch {throw {PROMISE TIMER EXPIRED} $msg} msg edict
+ ::promise::safe_reject $prom $msg $edict
+ } $prom $value]
+ } $millisecs $value]]
+}
+
+proc promise::pconnect {args} {
+ # Returns a promise that will be fulfilled when the a socket connection
+ # is completed.
+ # args - arguments to be passed to the Tcl 'socket' command
+ # This is a wrapper for the async version of the Tcl 'socket' command.
+ # If the connection completes, the promise is fulfilled with the
+ # socket handle.
+ # In case of errors (e.g. if the address cannot be fulfilled), the
+ # promise is rejected with the 'reason' parameter containing the
+ # error message and the 'edict' parameter containing the Tcl error
+ # dictionary.
+ #
+ return [Promise new [lambda {so_args prom} {
+ set so [socket -async {*}$so_args]
+ fileevent $so writable [promise::lambda {prom so} {
+ fileevent $so writable {}
+ set err [chan configure $so -error]
+ if {$err eq ""} {
+ $prom fulfill $so
+ } else {
+ catch {throw {PROMISE PCONNECT FAIL} $err} err edict
+ $prom reject $err $edict
+ }
+ } $prom $so]
+ } $args]]
+}
+
+proc promise::_read_channel {prom chan data} {
+ set newdata [read $chan]
+ if {[string length $newdata] || ![eof $chan]} {
+ append data $newdata
+ fileevent $chan readable [list [namespace current]::_read_channel $prom $chan $data]
+ return
+ }
+
+ # EOF
+ set code [catch {
+ # Need to make the channel blocking else no error is returned
+ # on the close
+ fileevent $chan readable {}
+ fconfigure $chan -blocking 1
+ close $chan
+ } result edict]
+ if {$code} {
+ safe_reject $prom $result $edict
+ } else {
+ safe_fulfill $prom $data
+ }
+}
+
+proc promise::pexec {args} {
+ # Runs an external program and returns a promise for its output.
+ # args - program and its arguments as passed to the Tcl 'open' call
+ # for creating pipes
+ # If the program runs without errors, the promise is fulfilled by its
+ # standard output content. Otherwise
+ # promise is rejected.
+ #
+ # Returns a promise that will be settled by the result of the program
+ return [Promise new [lambda {open_args prom} {
+ set chan [open |$open_args r]
+ fconfigure $chan -blocking 0
+ fileevent $chan readable [list promise::_read_channel $prom $chan ""]
+ } $args]]
+}
+
+proc promise::safe_fulfill {prom value} {
+ # Fulfills the specified promise.
+ # prom - the [Promise] object to be fulfilled
+ # value - the fulfillment value
+ # This is a convenience command that checks if $prom still exists
+ # and if so fulfills it with $value.
+ #
+ # Returns 0 if the promise does not exist any more, else the return
+ # value from its [fulfill] method.
+ if {![info object isa object $prom]} {
+ # The object has been deleted. Naught to do
+ return 0
+ }
+ return [$prom fulfill $value]
+}
+
+proc promise::safe_reject {prom value {edict {}}} {
+ # Rejects the specified promise.
+ # prom - the [Promise] object to be fulfilled
+ # value - see [Promise.reject]
+ # edict - see [Promise.reject]
+ # This is a convenience command that checks if $prom still exists
+ # and if so rejects it with the specified arguments.
+ #
+ # Returns 0 if the promise does not exist any more, else the return
+ # value from its [reject] method.
+ if {![info object isa object $prom]} {
+ # The object has been deleted. Naught to do
+ return
+ }
+ $prom reject $value $edict
+}
+
+proc promise::ptask {script} {
+ # Creates a new Tcl thread to run the specified script and returns
+ # a promise for the script results.
+ # script - script to run in the thread
+ # Returns a promise that will be settled by the result of the script
+ #
+ # The `ptask` command runs the specified script in a new Tcl
+ # thread. The promise returned from this command will be fulfilled
+ # with the result of the script if it completes
+ # successfully. Otherwise, the promise will be rejected with an
+ # with the 'reason' parameter containing the error message
+ # and the 'edict' parameter containing the Tcl error dictionary
+ # from the script failure.
+ #
+ # Note that $script is a standalone script in that it is executed
+ # in a new thread with a virgin Tcl interpreter. Any packages used
+ # by $script have to be explicitly loaded, variables defined in the
+ # the current interpreter will not be available in $script and so on.
+ #
+ # The command requires the Thread package to be loaded.
+
+ uplevel #0 package require Thread
+ proc [namespace current]::ptask script {
+ return [Promise new [lambda {script prom} {
+ set thread_script [string map [list %PROM% $prom %TID% [thread::id] %SCRIPT% $script] {
+ set retcode [catch {%SCRIPT%} result edict]
+ if {$retcode == 0 || $retcode == 2} {
+ # ok or return
+ set response [list ::promise::safe_fulfill %PROM% $result]
+ } else {
+ set response [list ::promise::safe_reject %PROM% $result $edict]
+ }
+ thread::send -async %TID% $response
+ }]
+ thread::create $thread_script
+ } $script]]
+ }
+ tailcall [namespace current]::ptask $script
+}
+
+proc promise::pworker {tpool script} {
+ # Runs a script in a worker thread from a thread pool and
+ # returns a promise for the same.
+ # tpool - thread pool identifier
+ # script - script to run in the worker thread
+ # Returns a promise that will be settled by the result of the script
+ #
+ # The Thread package allows creation of a thread pool with the
+ # 'tpool create' command. The `pworker` command runs the specified
+ # script in a worker thread from a thread pool. The promise
+ # returned from this command will be fulfilled with the result of
+ # the script if it completes successfully.
+ # Otherwise, the promise will be rejected with an
+ # with the 'reason' parameter containing the error message
+ # and the 'edict' parameter containing the Tcl error dictionary
+ # from the script failure.
+ #
+ # Note that $script is a standalone script in that it is executed
+ # in a new thread with a virgin Tcl interpreter. Any packages used
+ # by $script have to be explicitly loaded, variables defined in the
+ # the current interpreter will not be available in $script and so on.
+
+ # No need for package require Thread since if tpool is passed to
+ # us, Thread must already be loaded
+ return [Promise new [lambda {tpool script prom} {
+ set thread_script [string map [list %PROM% $prom %TID% [thread::id] %SCRIPT% $script] {
+ set retcode [catch {%SCRIPT%} result edict]
+ if {$retcode == 0 || $retcode == 2} {
+ set response [list ::promise::safe_fulfill %PROM% $result]
+ } else {
+ set response [list ::promise::safe_reject %PROM% $result $edict]
+ }
+ thread::send -async %TID% $response
+ }]
+ tpool::post -detached -nowait $tpool $thread_script
+ } $tpool $script]]
+}
+
+if {0} {
+ package require http
+ proc checkurl {url} {
+ set prom [promise::Promise new [promise::lambda {url prom} {
+ http::geturl $url -method HEAD -command [promise::lambda {prom tok} {
+ upvar #0 $tok http_state
+ $prom fulfill [list $http_state(url) $http_state(status)]
+ ::http::cleanup $tok
+ } $prom]
+ } $url]]
+ return $prom
+ }
+
+ proc checkurls {urls} {
+ return [promise::all [lmap url $urls {checkurl $url}]]
+ }
+
+ [promise::all [
+ list [
+ promise::ptask {expr 1+1}
+ ] [
+ promise::ptask {expr 2+2}
+ ]
+ ]] done [promise::lambda val {puts [tcl::mathop::* {*}$val]}]
+}
+
+package provide promise [promise::version]
+
+if {[info exists ::argv0] &&
+ [file tail [info script]] eq [file tail $::argv0]} {
+ set filename [file tail [info script]]
+ if {[llength $::argv] == 0} {
+ puts "Usage: [file tail [info nameofexecutable]] $::argv0 dist|install|tm|version"
+ exit 1
+ }
+ switch -glob -- [lindex $::argv 0] {
+ ver* { puts [promise::version] }
+ tm -
+ dist* {
+ if {[file extension $filename] ne ".tm"} {
+ set dir [file join [file dirname [info script]] .. build]
+ file mkdir $dir
+ file copy -force [info script] [file join $dir [file rootname $filename]-[promise::version].tm]
+ } else {
+ error "Cannot create distribution from a .tm file"
+ }
+ }
+ install {
+ set dir [file join [tcl::pkgconfig get libdir,runtime] tcl8 8.6]
+ if {[file extension $filename] eq ".tm"} {
+ # We already are a .tm with version number
+ set target $filename
+ } else {
+ set target [file rootname $filename]-[promise::version].tm
+ }
+ file copy -force [info script] [file join $dir $target]
+ }
+ default {
+ puts stderr "Unknown option/command \"[lindex $::argv 0]\""
+ exit 1
+ }
+ }
+}
diff --git a/modules/tpcccommon-1.0.tm b/modules/tpcccommon-1.0.tm
index 91b8b7e1..a400bc78 100755
--- a/modules/tpcccommon-1.0.tm
+++ b/modules/tpcccommon-1.0.tm
@@ -1,6 +1,6 @@
package provide tpcccommon 1.0
namespace eval tpcccommon {
-namespace export chk_thread RandomNumber NURand Lastname MakeAlphaString Makezip MakeAddress MakeNumberString findchunk findvuposition randname keytime thinktime
+namespace export chk_thread RandomNumber NURand Lastname MakeAlphaString Makezip MakeAddress MakeNumberString findchunk findvuposition randname keytime thinktime async_keytime async_thinktime async_time
#gettimestamp not included as uses different formats per database
#TPCC BUILD PROCEDURES
proc chk_thread {} {
@@ -120,4 +120,31 @@ set thinkingtime [ expr {abs(round(log(rand()) * $thinking))} ]
after [ expr {$thinkingtime * 1000} ]
return
}
+#ASYNCH TIME
+proc async_time { ast } {
+promise::await [promise::ptimer $ast]
+ }
+#ASYNCH KEYING TIME
+proc async_keytime { keyt clientname callingproc async_verbose } {
+if { $async_verbose } {
+set TIME_start [clock clicks -milliseconds]
+async_time [ expr $keyt * 1000 ]
+set TIME_taken [expr ([clock clicks -milliseconds] - $TIME_start) /1000 ]
+puts "keytime:$callingproc:$clientname:$TIME_taken secs"
+ } else {
+async_time [ expr $keyt * 1000 ]
+ }
+}
+#ASYNCH THINK TIME
+proc async_thinktime { thkt clientname callingproc async_verbose } {
+set as_thkt [ expr {abs(round(log(rand()) * $thkt))} ]
+if { $async_verbose } {
+set TIME_start [clock clicks -milliseconds]
+async_time [ expr $as_thkt * 1000 ]
+set TIME_taken [expr ([clock clicks -milliseconds] - $TIME_start) /1000 ]
+puts "thinktime:$callingproc:$clientname:$TIME_taken secs"
+ } else {
+async_time [ expr $as_thkt * 1000 ]
+ }
+ }
}
diff --git a/readme b/readme
index df89259f..16a235bd 100755
--- a/readme
+++ b/readme
@@ -1,3 +1,3 @@
-HammerDB v3.2
+HammerDB v3.3
Copyright (C) 2003-2019 Steve Shaw
Contact information and documentation at: http://www.hammerdb.com
diff --git a/src/db2/db2oltp.tcl b/src/db2/db2oltp.tcl
index 10b45c80..b385177c 100755
--- a/src/db2/db2oltp.tcl
+++ b/src/db2/db2oltp.tcl
@@ -1247,9 +1247,10 @@ set db2_monreport 0
ed_edit_clear
.ed_mainFrame.notebook select .ed_mainFrame.mainwin
set _ED(packagekeyname) "Db2 TPC-C Timed"
+if { !$db2_async_scale } {
+#REGULAR TIMED SCRIPT
.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
-#THIS SCRIPT TO BE RUN WITH VIRTUAL USER OUTPUT ENABLED
-##EDITABLE OPTIONS##################################################
+#EDITABLE OPTIONS##################################################
set library $library ;# Db2 Library
set total_iterations $db2_total_iterations ;# Number of transactions before logging off
set RAISEERROR \"$db2_raiseerror\" ;# Exit script on Db2 (true or false)
@@ -1563,7 +1564,7 @@ set w_id [ RandomNumber 1 $w_id_input ]
set stmnt_handle2 [ db2_select_direct $db_handle "select max(d_id) from district" ]
set d_id_input [ db2_fetchrow $stmnt_handle2 ]
set stock_level_d_id [ RandomNumber 1 $d_id_input ]
-puts "Processing $total_iterations transactions without output suppressed..."
+puts "Processing $total_iterations transactions with output suppressed..."
set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
for {set it 0} {$it < $total_iterations} {incr it} {
if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
@@ -1606,4 +1607,408 @@ db2_finish $select_handle_dl
db2_disconnect $db_handle
}
}}
+} else {
+#ASYNCHRONOUS TIMED SCRIPT
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
+#EDITABLE OPTIONS##################################################
+set library $library ;# Db2 Library
+set total_iterations $db2_total_iterations ;# Number of transactions before logging off
+set RAISEERROR \"$db2_raiseerror\" ;# Exit script on Db2 (true or false)
+set KEYANDTHINK \"$db2_keyandthink\" ;# Time for user thinking and keying (true or false)
+set rampup $db2_rampup; # Rampup time in minutes before first Transaction Count is taken
+set duration $db2_duration; # Duration in minutes before second Transaction Count is taken
+set monreportinterval $db2_monreport; #Portion of duration to capture monreport
+set mode \"$opmode\" ;# HammerDB operational mode
+set user \"$db2_user\" ;# Db2 user
+set password \"$db2_pass\" ;# Password for the Db2 user
+set dbname \"$db2_dbase\" ;#Database containing the TPC Schema
+set async_client $db2_async_client;# Number of asynchronous clients per Vuser
+set async_verbose $db2_async_verbose;# Report activity of asynchronous clients
+set async_delay $db2_async_delay;# Delay in ms between logins of asynchronous clients
+#EDITABLE OPTIONS##################################################
+"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end {#LOAD LIBRARIES AND MODULES
+if [catch {package require $library} message] { error "Failed to load $library - $message" }
+if [catch {::tcl::tm::path add modules} ] { error "Failed to find modules directory" }
+if [catch {package require tpcccommon} ] { error "Failed to load tpcc common functions" } else { namespace import tpcccommon::* }
+if [catch {package require promise } message] { error "Failed to load promise package for asynchronous clients" }
+
+if { [ chk_thread ] eq "FALSE" } {
+error "Db2 Timed Script must be run in Thread Enabled Interpreter"
+}
+
+#Db2 CONNECTION
+proc ConnectToDb2 { dbname user password } {
+puts "Connecting to database $dbname"
+if {[catch {set db_handle [db2_connect $dbname $user $password]} message]} {
+error $message
+ } else {
+puts "Connection established"
+return $db_handle
+}}
+set rema [ lassign [ findvuposition ] myposition totalvirtualusers ]
+switch $myposition {
+1 {
+if { $mode eq "Local" || $mode eq "Master" } {
+set db_handle [ ConnectToDb2 $dbname $user $password ]
+set ramptime 0
+puts "Beginning rampup time of $rampup minutes"
+set rampup [ expr $rampup*60000 ]
+while {$ramptime != $rampup} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set ramptime [ expr $ramptime+6000 ]
+if { ![ expr {$ramptime % 60000} ] } {
+puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Rampup complete, Taking start Transaction Count."
+set stmnt_handle1 [ db2_select_direct $db_handle "select total_app_commits + total_app_rollbacks from sysibmadm.mon_db_summary" ]
+set start_trans [ db2_fetchrow $stmnt_handle1 ]
+db2_finish $stmnt_handle1
+set stmnt_handle2 [ db2_select_direct $db_handle "select sum(d_next_o_id) from district" ]
+set start_nopm [ db2_fetchrow $stmnt_handle2 ]
+db2_finish $stmnt_handle2
+set durmin $duration
+set testtime 0
+set doingmonreport "false"
+if { $monreportinterval > 0 } {
+if { $monreportinterval >= $duration } {
+set monreportinterval 0
+puts "Timing test period of $duration in minutes"
+ } else {
+set doingmonreport "true"
+set monreportsecs [ expr $monreportinterval * 60 ]
+set duration [ expr $duration - $monreportinterval ]
+puts "Capturing MONREPORT DBSUMMARY for $monreportsecs seconds (This Virtual User cannot be terminated while capturing report)"
+set monreport_handle [ db2_select_direct $db_handle "call monreport.dbsummary($monreportsecs)" ]
+while {[set line [db2_fetchrow $monreport_handle]] != ""} {
+append monreport [ join $line ]
+append monreport "\\n"
+}
+db2_finish $monreport_handle
+puts "MONREPORT duration complete"
+puts "Timing remaining test period of $duration in minutes"
+}}
+set duration [ expr $duration*60000 ]
+while {$testtime != $duration} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set testtime [ expr $testtime+6000 ]
+if { ![ expr {$testtime % 60000} ] } {
+puts -nonewline "[ expr $testtime / 60000 ] ...,"
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Test complete, Taking end Transaction Count."
+set stmnt_handle3 [ db2_select_direct $db_handle "select total_app_commits + total_app_rollbacks from sysibmadm.mon_db_summary" ]
+set end_trans [ db2_fetchrow $stmnt_handle3 ]
+db2_finish $stmnt_handle3
+set stmnt_handle4 [ db2_select_direct $db_handle "select sum(d_next_o_id) from district" ]
+set end_nopm [ db2_fetchrow $stmnt_handle4 ]
+db2_finish $stmnt_handle4
+set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm Db2 TPM at $nopm NOPM"
+if { $doingmonreport eq "true" } {
+puts "---MONREPORT OUTPUT---"
+puts $monreport
+ }
+tsv::set application abort 1
+if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
+db2_disconnect $db_handle
+ } else {
+puts "Operating in Slave Mode, No Snapshots taken..."
+ }
+ }
+default {
+#TIMESTAMP
+proc gettimestamp { } {
+set tstamp [ clock format [ clock seconds ] -format %Y%m%d%H%M%S ]
+return $tstamp
+}
+#Db2 CONNECTION
+proc ConnectToDb2Asynch { dbname user password RAISEERROR clientname async_verbose } {
+puts "Connecting to database $dbname"
+if {[catch {set db_handle [db2_connect $dbname $user $password]} message]} {
+if { $RAISEERROR } {
+puts "$clientname:login failed:$message"
+return "$clientname:login failed:$message"
+ }
+ } else {
+if { $async_verbose } { puts "Connected $clientname:$db_handle" }
+return $db_handle
+}}
+#NEW ORDER
+proc neword { set_handle_no stmnt_handle_no select_handle_no no_w_id w_id_input RAISEERROR clientname } {
+#2.4.1.2 select district id randomly from home warehouse where d_w_id = d_id
+set no_d_id [ RandomNumber 1 10 ]
+#2.4.1.2 Customer id randomly selected where c_d_id = d_id and c_w_id = w_id
+set no_c_id [ RandomNumber 1 3000 ]
+#2.4.1.3 Items in the order randomly selected from 5 to 15
+set ol_cnt [ RandomNumber 5 15 ]
+#2.4.1.6 order entry date O_ENTRY_D generated by SUT
+set date [ gettimestamp ]
+db2_exec_prepared $set_handle_no
+if {[ catch {db2_bind_exec $stmnt_handle_no "$no_w_id $w_id_input $no_d_id $no_c_id $ol_cnt $date"} message]} {
+if {$RAISEERROR} {
+error "New Order in $clientname : $message"
+ } else {
+puts "New Order in $clientname : $message"
+ }
+ } else {
+set stmnt_fetch [ db2_select_prepared $select_handle_no ]
+ }
+}
+#PAYMENT
+proc payment { set_handle_py stmnt_handle_py select_handle_py p_w_id w_id_input RAISEERROR clientname } {
+#2.5.1.1 The home warehouse id remains the same for each terminal
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set p_d_id [ RandomNumber 1 10 ]
+#2.5.1.2 customer selected 60% of time by name and 40% of time by number
+set x [ RandomNumber 1 100 ]
+set y [ RandomNumber 1 100 ]
+if { $x <= 85 } {
+set p_c_d_id $p_d_id
+set p_c_w_id $p_w_id
+} else {
+#use a remote warehouse
+set p_c_d_id [ RandomNumber 1 10 ]
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+while { ($p_c_w_id == $p_w_id) && ($w_id_input != 1) } {
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+ }
+}
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set p_c_id [ RandomNumber 1 3000 ]
+if { $y <= 60 } {
+#use customer name
+#C_LAST is generated
+set byname 1
+ } else {
+#use customer number
+set byname 0
+set name NULL
+ }
+#2.5.1.3 random amount from 1 to 5000
+set p_h_amount [ RandomNumber 1 5000 ]
+#2.5.1.4 date selected from SUT
+set h_date [ gettimestamp ]
+#2.5.2.1 Payment Transaction
+#change following to correct values
+db2_bind_exec $set_handle_py "$p_c_id $name"
+if {[ catch {db2_bind_exec $stmnt_handle_py "$p_w_id $p_d_id $p_c_w_id $p_c_d_id $byname $p_h_amount $h_date"} message]} {
+if {$RAISEERROR} {
+error "Payment in $clientname : $message"
+ } else {
+puts "Payment in $clientname : $message"
+ }
+ } else {
+set stmnt_fetch [ db2_select_prepared $select_handle_py ]
+ }
+}
+#ORDER_STATUS
+proc ostat { set_handle_os stmnt_handle_os select_handle_os w_id RAISEERROR clientname } {
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set d_id [ RandomNumber 1 10 ]
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set c_id [ RandomNumber 1 3000 ]
+set y [ RandomNumber 1 100 ]
+if { $y <= 60 } {
+set byname 1
+ } else {
+set byname 0
+set name NULL
+}
+db2_bind_exec $set_handle_os "$c_id $name"
+if {[ catch {db2_bind_exec $stmnt_handle_os "$w_id $d_id $byname"} message]} {
+ if {$RAISEERROR} {
+error "Order Status in $clientname : $message"
+ } else {
+puts "Order Status in $clientname : $message"
+ }
+ } else {
+set stmnt_fetch [ db2_select_prepared $select_handle_os ]
+ }
+}
+#DELIVERY
+proc delivery { stmnt_handle_dl select_handle_dl w_id RAISEERROR clientname } {
+set carrier_id [ RandomNumber 1 10 ]
+set date [ gettimestamp ]
+if {[ catch {db2_bind_exec $stmnt_handle_dl "$w_id $carrier_id $date"} message]} {
+ if {$RAISEERROR} {
+error "Delivery in $clientname : $message"
+ } else {
+puts "Delivery in $clientname : $message"
+ }
+ } else {
+set stmnt_fetch [ db2_select_prepared $select_handle_dl ]
+ }
+}
+#STOCK LEVEL
+proc slev { stmnt_handle_sl select_handle_sl w_id stock_level_d_id RAISEERROR clientname } {
+set threshold [ RandomNumber 10 20 ]
+if {[ catch {db2_bind_exec $stmnt_handle_sl "$w_id $stock_level_d_id $threshold"} message]} {
+ if {$RAISEERROR} {
+error "Stock Level in $clientname : $message"
+ } else {
+puts "Stock Level in $clientname : $message"
+ }
+ } else {
+set stmnt_fetch [ db2_select_prepared $select_handle_sl ]
+ }
+}
+
+proc prep_statement { db_handle handle_st } {
+set dummy "SYSIBM.SYSDUMMY1"
+switch $handle_st {
+stmnt_handle_sl {
+set stmnt_handle_sl [ db2_prepare $db_handle "CALL SLEV(?,?,?,stock_count)" ]
+return $stmnt_handle_sl
+}
+stmnt_handle_dl {
+set stmnt_handle_dl [ db2_prepare $db_handle "CALL DELIVERY(?,?,TIMESTAMP_FORMAT(?,'YYYYMMDDHH24MISS'),deliv_data)" ]
+return $stmnt_handle_dl
+}
+stmnt_handle_os {
+set stmnt_handle_os [ db2_prepare $db_handle "CALL OSTAT (?,?,os_c_id,?,os_c_last,os_c_first,os_c_middle,os_c_balance,os_o_id,os_entdate,os_o_carrier_id)" ]
+return $stmnt_handle_os
+ }
+stmnt_handle_py {
+set stmnt_handle_py [ db2_prepare $db_handle "CALL PAYMENT (?,?,?,?,p_c_id,?,?,p_c_last,p_w_street_1,p_w_street_2,p_w_city,p_w_state,p_w_zip,p_d_street_1,p_d_street_2,p_d_city,p_d_state,p_d_zip,p_c_first,p_c_middle,p_c_street_1,p_c_street_2,p_c_city,p_c_state,p_c_zip,p_c_phone,p_c_since,p_c_credit,p_c_credit_lim,p_c_discount,p_c_balance,p_c_data,TIMESTAMP_FORMAT(?,'YYYYMMDDHH24MISS'))" ]
+return $stmnt_handle_py
+ }
+stmnt_handle_no {
+set stmnt_handle_no [ db2_prepare $db_handle "CALL NEWORD (?,?,?,?,?,no_c_discount,no_c_last,no_c_credit,no_d_tax,no_w_tax,no_d_next_o_id,TIMESTAMP_FORMAT(?,'YYYYMMDDHH24MISS'))" ]
+return $stmnt_handle_no
+ }
+ }
+}
+
+proc prep_select { db_handle handle_se } {
+set dummy "SYSIBM.SYSDUMMY1"
+switch $handle_se {
+select_handle_sl {
+set select_handle_sl [ db2_prepare $db_handle "select stock_count from $dummy" ]
+return $select_handle_sl
+ }
+select_handle_dl {
+set select_handle_dl [ db2_prepare $db_handle "select * from UNNEST(deliv_data)" ]
+return $select_handle_dl
+ }
+select_handle_os {
+set select_handle_os [ db2_prepare $db_handle "select os_c_id, os_c_last, os_c_first,os_c_middle,os_c_balance,os_o_id,VARCHAR_FORMAT(os_entdate, 'YYYY-MM-DD HH24:MI:SS'),os_o_carrier_id from $dummy" ]
+return $select_handle_os
+ }
+select_handle_py {
+set select_handle_py [ db2_prepare $db_handle "select p_c_id,p_c_last,p_w_street_1,p_w_street_2,p_w_city,p_w_state,p_w_zip,p_d_street_1,p_d_street_2,p_d_city,p_d_state,p_d_zip,p_c_first,p_c_middle,p_c_street_1,p_c_street_2,p_c_city,p_c_state,p_c_zip,p_c_phone,VARCHAR_FORMAT(p_c_since, 'YYYY-MM-DD HH24:MI:SS'),p_c_credit,p_c_credit_lim,p_c_discount,p_c_balance,p_c_data from $dummy" ]
+return $select_handle_py
+ }
+select_handle_no {
+set select_handle_no [ db2_prepare $db_handle "select no_c_discount, no_c_last, no_c_credit, no_d_tax, no_w_tax, no_d_next_o_id from $dummy" ]
+return $select_handle_no
+ }
+ }
+}
+
+proc prep_set_db2_global_var { db_handle handle_gv } {
+switch $handle_gv {
+set_handle_os {
+set set_handle_os [ db2_prepare $db_handle "SET (os_c_id,os_c_last)=(?,?)" ]
+return $set_handle_os
+}
+set_handle_py {
+set set_handle_py [ db2_prepare $db_handle "SET (p_c_id,p_c_last,p_c_credit,p_c_balance)=(?,?,'0',0.0)" ]
+return $set_handle_py
+}
+set_handle_no {
+set set_handle_no [ db2_prepare $db_handle "SET (no_d_next_o_id)=(0)" ]
+return $set_handle_no
+ }
+ }
+}
+
+#RUN TPC-C
+promise::async simulate_client { clientname total_iterations user password dbname RAISEERROR KEYANDTHINK async_verbose async_delay } {
+set acno [ expr [ string trimleft [ lindex [ split $clientname ":" ] 1 ] ac ] * $async_delay ]
+if { $async_verbose } { puts "Delaying login of $clientname for $acno ms" }
+async_time $acno
+if { [ tsv::get application abort ] } { return "$clientname:abort before login" }
+if { $async_verbose } { puts "Logging in $clientname" }
+set db_handle [ ConnectToDb2Asynch $dbname $user $password $RAISEERROR $clientname $async_verbose ]
+foreach handle_gv {set_handle_os set_handle_py set_handle_no} {set $handle_gv [ prep_set_db2_global_var $db_handle $handle_gv ]}
+foreach handle_st {stmnt_handle_dl stmnt_handle_sl stmnt_handle_os stmnt_handle_py stmnt_handle_no} {set $handle_st [ prep_statement $db_handle $handle_st ]}
+foreach handle_se {select_handle_sl select_handle_dl select_handle_os select_handle_py select_handle_no} {set $handle_se [ prep_select $db_handle $handle_se ]}
+set stmnt_handle1 [ db2_select_direct $db_handle "select max(w_id) from warehouse" ]
+set w_id_input [ db2_fetchrow $stmnt_handle1 ]
+#2.4.1.1 set warehouse_id stays constant for a given terminal
+set w_id [ RandomNumber 1 $w_id_input ]
+set stmnt_handle2 [ db2_select_direct $db_handle "select max(d_id) from district" ]
+set d_id_input [ db2_fetchrow $stmnt_handle2 ]
+set stock_level_d_id [ RandomNumber 1 $d_id_input ]
+puts "Processing $total_iterations transactions with output suppressed..."
+set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
+for {set it 0} {$it < $total_iterations} {incr it} {
+if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
+set choice [ RandomNumber 1 23 ]
+if {$choice <= 10} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:neword" }
+if { $KEYANDTHINK } { async_keytime 18 $clientname neword $async_verbose }
+neword $set_handle_no $stmnt_handle_no $select_handle_no $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname neword $async_verbose }
+} elseif {$choice <= 20} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:payment" }
+if { $KEYANDTHINK } { async_keytime 3 $clientname payment $async_verbose }
+payment $set_handle_py $stmnt_handle_py $select_handle_py $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname payment $async_verbose }
+} elseif {$choice <= 21} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:delivery" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname delivery $async_verbose }
+delivery $stmnt_handle_dl $select_handle_dl $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 10 $clientname delivery $async_verbose }
+} elseif {$choice <= 22} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:slev" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname slev $async_verbose }
+slev $stmnt_handle_sl $select_handle_sl $w_id $stock_level_d_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname slev $async_verbose }
+} elseif {$choice <= 23} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:ostat" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname ostat $async_verbose }
+ostat $set_handle_os $stmnt_handle_os $select_handle_os $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname ostat $async_verbose }
+ }
+ }
+db2_finish $set_handle_os
+db2_finish $set_handle_py
+db2_finish $set_handle_no
+db2_finish $stmnt_handle_sl
+db2_finish $stmnt_handle_dl
+db2_finish $stmnt_handle_os
+db2_finish $stmnt_handle_py
+db2_finish $stmnt_handle_no
+db2_finish $select_handle_sl
+db2_finish $select_handle_os
+db2_finish $select_handle_py
+db2_finish $select_handle_no
+db2_finish $select_handle_dl
+db2_disconnect $db_handle
+if { $async_verbose } { puts "$clientname:complete" }
+return $clientname:complete
+ }
+for {set ac 1} {$ac <= $async_client} {incr ac} {
+set clientdesc "vuser$myposition:ac$ac"
+lappend clientlist $clientdesc
+lappend clients [simulate_client $clientdesc $total_iterations $user $password $dbname $RAISEERROR $KEYANDTHINK $async_verbose $async_delay]
+ }
+puts "Started asynchronous clients:$clientlist"
+set acprom [ promise::eventloop [ promise::all $clients ] ]
+puts "All asynchronous clients complete"
+if { $async_verbose } {
+foreach client $acprom { puts $client }
+ }
+ }
+}}
+}
}
diff --git a/src/db2/db2opt.tcl b/src/db2/db2opt.tcl
index e8c2a235..b69afd8a 100755
--- a/src/db2/db2opt.tcl
+++ b/src/db2/db2opt.tcl
@@ -120,7 +120,7 @@ upvar #0 configdb2 configdb2
setlocaltpccvars $configdb2
#set matching fields in dialog to temporary dict
variable db2fields
-set db2fields [ dict create connection {db2_def_user {} db2_def_pass {} db2_def_dbase {}} tpcc {db2_user {.tpc.f1.e1 get} db2_pass {.tpc.f1.e2 get} db2_dbase {.tpc.f1.e3 get} db2_def_tab {.tpc.f1.e4 get} db2_tab_list {.tpc.f1.e5 get} db2_total_iterations {.tpc.f1.e14 get} db2_rampup {.tpc.f1.e17 get} db2_duration {.tpc.f1.e18 get} db2_monreport {.tpc.f1.e19 get} db2_count_ware $db2_count_ware db2_num_vu $db2_num_vu db2_partition $db2_partition db2_driver $db2_driver db2_raiseerror $db2_raiseerror db2_keyandthink $db2_keyandthink db2_allwarehouse $db2_allwarehouse db2_timeprofile $db2_timeprofile} ]
+set db2fields [ dict create connection {db2_def_user {} db2_def_pass {} db2_def_dbase {}} tpcc {db2_user {.tpc.f1.e1 get} db2_pass {.tpc.f1.e2 get} db2_dbase {.tpc.f1.e3 get} db2_def_tab {.tpc.f1.e4 get} db2_tab_list {.tpc.f1.e5 get} db2_total_iterations {.tpc.f1.e14 get} db2_rampup {.tpc.f1.e17 get} db2_duration {.tpc.f1.e18 get} db2_monreport {.tpc.f1.e19 get} db2_async_client {.tpc.f1.e23 get} db2_async_delay {.tpc.f1.e24 get} db2_count_ware $db2_count_ware db2_num_vu $db2_num_vu db2_partition $db2_partition db2_driver $db2_driver db2_raiseerror $db2_raiseerror db2_keyandthink $db2_keyandthink db2_allwarehouse $db2_allwarehouse db2_timeprofile $db2_timeprofile db2_async_scale $db2_async_scale db2_async_verbose $db2_async_verbose} ]
set whlist [ get_warehouse_list_for_spinbox ]
catch "destroy .tpc"
ttk::toplevel .tpc
@@ -263,6 +263,10 @@ set db2_timeprofile "false"
.tpc.f1.e19 configure -state disabled
.tpc.f1.e20 configure -state disabled
.tpc.f1.e21 configure -state disabled
+.tpc.f1.e22 configure -state disabled
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
if {$db2_monreport >= $db2_duration} {
set db2_monreport 0
}
@@ -276,6 +280,10 @@ bind .tpc.f1.r2 {
.tpc.f1.e19 configure -state normal
.tpc.f1.e20 configure -state normal
.tpc.f1.e21 configure -state normal
+.tpc.f1.e22 configure -state normal
+.tpc.f1.e23 configure -state normal
+.tpc.f1.e24 configure -state normal
+.tpc.f1.e25 configure -state normal
if {$db2_monreport >= $db2_duration} {
set db2_monreport 0
}
@@ -296,6 +304,17 @@ ttk::checkbutton $Name -text "" -variable db2_raiseerror -onvalue "true" -offval
ttk::label $Prompt -text "Keying and Thinking Time :"
set Name $Parent.f1.e16
ttk::checkbutton $Name -text "" -variable db2_keyandthink -onvalue "true" -offvalue "false"
+bind .tpc.f1.e16 {
+if { $db2_driver eq "timed" } {
+if { $db2_keyandthink eq "true" } {
+set db2_async_scale "false"
+set db2_async_verbose "false"
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
+ }
+ }
+}
grid $Prompt -column 0 -row 16 -sticky e
grid $Name -column 1 -row 16 -sticky w
set Name $Parent.f1.e17
@@ -346,6 +365,59 @@ ttk::checkbutton $Name -text "" -variable db2_timeprofile -onvalue "true" -offva
if {$db2_driver == "test" } {
$Name configure -state disabled
}
+ set Name $Parent.f1.e22
+ set Prompt $Parent.f1.p22
+ ttk::label $Prompt -text "Asynchronous Scaling :"
+ttk::checkbutton $Name -text "" -variable db2_async_scale -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 22 -sticky e
+ grid $Name -column 1 -row 22 -sticky ew
+if {$db2_driver == "test" } {
+ set db2_async_scale "false"
+ $Name configure -state disabled
+ }
+bind .tpc.f1.e22 {
+if { $db2_async_scale eq "true" } {
+set db2_async_verbose "false"
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
+ } else {
+if { $db2_driver eq "timed" } {
+set db2_keyandthink "true"
+.tpc.f1.e23 configure -state normal
+.tpc.f1.e24 configure -state normal
+.tpc.f1.e25 configure -state normal
+ }
+ }
+}
+set Name $Parent.f1.e23
+ set Prompt $Parent.f1.p23
+ ttk::label $Prompt -text "Asynch Clients per Virtual User :"
+ ttk::entry $Name -width 30 -textvariable db2_async_client
+ grid $Prompt -column 0 -row 23 -sticky e
+ grid $Name -column 1 -row 23 -sticky ew
+if {$db2_driver == "test" || $db2_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+set Name $Parent.f1.e24
+ set Prompt $Parent.f1.p24
+ ttk::label $Prompt -text "Asynch Client Login Delay :"
+ ttk::entry $Name -width 30 -textvariable db2_async_delay
+ grid $Prompt -column 0 -row 24 -sticky e
+ grid $Name -column 1 -row 24 -sticky ew
+if {$db2_driver == "test" || $db2_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+ set Name $Parent.f1.e25
+ set Prompt $Parent.f1.p25
+ ttk::label $Prompt -text "Asynchronous Verbose :"
+ttk::checkbutton $Name -text "" -variable db2_async_verbose -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 25 -sticky e
+ grid $Name -column 1 -row 25 -sticky ew
+if {$db2_driver == "test" || $db2_async_scale == "false" } {
+ set db2_async_verbose "false"
+ $Name configure -state disabled
+ }
}
#This is the Cancel button variables stay as before
set Name $Parent.b2
diff --git a/src/generic/gencli.tcl b/src/generic/gencli.tcl
index c29fe34f..32ef5fc3 100755
--- a/src/generic/gencli.tcl
+++ b/src/generic/gencli.tcl
@@ -1,7 +1,6 @@
set opmode "Local"
set table "notable"
set suppo 1
-set optlog 0
set _ED(package) ""
set _ED(packagekeyname) ""
namespace eval ttk {
@@ -1010,29 +1009,36 @@ proc loadtpcc {} {
upvar #0 dbdict dbdict
global _ED rdbms lprefix
set _ED(packagekeyname) "TPC-C"
+ed_status_message -show "TPC-C Driver Script"
foreach { key } [ dict keys $dbdict ] {
-if { [ dict get $dbdict $key name ] eq $rdbms } {
+if { [ dict get $dbdict $key name ] eq $rdbms } {
set dictname config$key
upvar #0 $dictname $dictname
set prefix [ dict get $dbdict $key prefix ]
set drivername [ concat [subst {$prefix}]_driver ]
set drivertype [ dict get [ set $dictname ] tpcc $drivername ]
-if { $drivertype eq "test" } { set lprefix "load" } else { set lprefix "loadtimed" }
+if { $drivertype eq "test" } { set lprefix "load" } else { set lprefix "loadtimed" }
set command [ concat [subst {$lprefix$prefix}]tpcc ]
eval $command
set allw [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *allwarehouse ]
if { $allw != "" } {
set db_allwarehouse [ dict get [ set $dictname ] tpcc $allw ]
-if { $db_allwarehouse } { shared_tpcc_functions "allwarehouse" }
- }
+set asyscl [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *async_scale ]
+if { $asyscl != "" } {
+set db_async_scale [ dict get [ set $dictname ] tpcc $asyscl ]
+ } else {
+set db_async_scale "false"
+ }
+if { $db_allwarehouse } { shared_tpcc_functions "allwarehouse" $db_async_scale }
+ }
set timep [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *timeprofile ]
if { $timep != "" } {
set db_timeprofile [ dict get [ set $dictname ] tpcc $timep ]
-if { $db_timeprofile } { shared_tpcc_functions "timeprofile" }
- }
+if { $db_timeprofile } { shared_tpcc_functions "timeprofile" "false" }
+ }
break
}
- }
+ }
}
proc loadtpch {} {
diff --git a/src/generic/gened.tcl b/src/generic/gened.tcl
index 2ac3eeaa..f5db43f7 100755
--- a/src/generic/gened.tcl
+++ b/src/generic/gened.tcl
@@ -3079,16 +3079,22 @@ eval $command
set allw [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *allwarehouse ]
if { $allw != "" } {
set db_allwarehouse [ dict get [ set $dictname ] tpcc $allw ]
-if { $db_allwarehouse } { shared_tpcc_functions "allwarehouse" }
+set asyscl [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *async_scale ]
+if { $asyscl != "" } {
+set db_async_scale [ dict get [ set $dictname ] tpcc $asyscl ]
+ } else {
+set db_async_scale "false"
+ }
+if { $db_allwarehouse } { shared_tpcc_functions "allwarehouse" $db_async_scale }
}
set timep [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *timeprofile ]
if { $timep != "" } {
set db_timeprofile [ dict get [ set $dictname ] tpcc $timep ]
-if { $db_timeprofile } { shared_tpcc_functions "timeprofile" }
+if { $db_timeprofile } { shared_tpcc_functions "timeprofile" "false" }
}
break
}
- }
+ }
applyctexthighlight .ed_mainFrame.mainwin.textFrame.left.text
}
diff --git a/src/generic/genmetrics.tcl b/src/generic/genmetrics.tcl
index 7b6adfe7..2d6895c1 100755
--- a/src/generic/genmetrics.tcl
+++ b/src/generic/genmetrics.tcl
@@ -46,6 +46,8 @@ set S(bar,height) 87
set S(col,padding) 24
set S(padding) 3
set S(border) 5
+#Remove descriptive name from CPU so does not overrun buffer
+regsub -all {Platinum|Gold|Silver|Bronze} $cpu_model "" cpu_model
set cnvpth $metframe.f
foreach wind "$metframe.f $metframe.sv $cnvpth.c" {
catch { destroy $wind }
diff --git a/src/generic/gentpcc.tcl b/src/generic/gentpcc.tcl
index bb23db99..ee27553f 100755
--- a/src/generic/gentpcc.tcl
+++ b/src/generic/gentpcc.tcl
@@ -1,4 +1,4 @@
-proc shared_tpcc_functions { tpccfunc } {
+proc shared_tpcc_functions { tpccfunc db_async_scale } {
switch $tpccfunc {
allwarehouse {
#set additional text for all warehouses
@@ -31,6 +31,8 @@ set allwt(3) {if { $allwarehouses == "true" } {
set w_id [lindex $myWarehouses [expr [RandomNumber 1 $myWhCount] -1]]
}
}
+set allwt(4) {global allwarehouses myposition totalvirtualusers
+}
#search for insert points and insert functions
set allwi(1) [.ed_mainFrame.mainwin.textFrame.left.text search -backwards "#EDITABLE OPTIONS##################################################" end ]
.ed_mainFrame.mainwin.textFrame.left.text fastinsert $allwi(1) $allwt(1)
@@ -38,6 +40,12 @@ set allwi(2) [.ed_mainFrame.mainwin.textFrame.left.text search -forwards "#2.4.1
.ed_mainFrame.mainwin.textFrame.left.text fastinsert $allwi(2) $allwt(2)
set allwi(3) [.ed_mainFrame.mainwin.textFrame.left.text search -forwards "set choice" $allwi(2) ]
.ed_mainFrame.mainwin.textFrame.left.text fastinsert $allwi(3) $allwt(3)
+if { $db_async_scale } {
+set allwi(4) [.ed_mainFrame.mainwin.textFrame.left.text search -forwards "#EDITABLE OPTIONS##################################################" end ]
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert $allwi(4)+1l $allwt(4)
+set allwi(5) [.ed_mainFrame.mainwin.textFrame.left.text search -backwards "promise::async" end ]
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert $allwi(5)+1l $allwt(4)
+ }
}
timeprofile {
#set additional text for all warehouses
diff --git a/src/generic/genws.tcl b/src/generic/genws.tcl
index bad1601c..25bb2555 100755
--- a/src/generic/genws.tcl
+++ b/src/generic/genws.tcl
@@ -293,29 +293,36 @@ proc loadtpcc {} {
upvar #0 dbdict dbdict
global _ED rdbms lprefix
set _ED(packagekeyname) "TPC-C"
+ed_status_message -show "TPC-C Driver Script"
foreach { key } [ dict keys $dbdict ] {
-if { [ dict get $dbdict $key name ] eq $rdbms } {
+if { [ dict get $dbdict $key name ] eq $rdbms } {
set dictname config$key
upvar #0 $dictname $dictname
set prefix [ dict get $dbdict $key prefix ]
set drivername [ concat [subst {$prefix}]_driver ]
set drivertype [ dict get [ set $dictname ] tpcc $drivername ]
-if { $drivertype eq "test" } { set lprefix "load" } else { set lprefix "loadtimed" }
+if { $drivertype eq "test" } { set lprefix "load" } else { set lprefix "loadtimed" }
set command [ concat [subst {$lprefix$prefix}]tpcc ]
eval $command
set allw [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *allwarehouse ]
if { $allw != "" } {
set db_allwarehouse [ dict get [ set $dictname ] tpcc $allw ]
-if { $db_allwarehouse } { shared_tpcc_functions "allwarehouse" }
- }
+set asyscl [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *async_scale ]
+if { $asyscl != "" } {
+set db_async_scale [ dict get [ set $dictname ] tpcc $asyscl ]
+ } else {
+set db_async_scale "false"
+ }
+if { $db_allwarehouse } { shared_tpcc_functions "allwarehouse" $db_async_scale }
+ }
set timep [ lsearch -inline [ dict get [ set $dictname ] tpcc ] *timeprofile ]
if { $timep != "" } {
set db_timeprofile [ dict get [ set $dictname ] tpcc $timep ]
-if { $db_timeprofile } { shared_tpcc_functions "timeprofile" }
- }
+if { $db_timeprofile } { shared_tpcc_functions "timeprofile" "false" }
+ }
break
}
- }
+ }
}
proc loadtpch {} {
@@ -433,7 +440,7 @@ get http://localhost:8080/print?dict / http://localhost:8080/dict
GET script: Show the loaded script.
get http://localhost:8080/print?script / http://localhost:8080/script
-{\"script\": \"#!\/usr\/local\/bin\/tclsh8.6\n#TIMED AWR SNAPSHOT DRIVER SCRIPT##################################\n#THIS SCRIPT TO BE RUN WITH VIRTUAL USER OUTPUT ENABLED\n#EDITABLE OPTIONS##################################################\nset library Oratcl ;# Oracle OCI Library\nset total_iterations 1000000 ;# Number of transactions before logging off\nset RAISEERROR \\"false\\" ;# Exit script on Oracle error (true or false)\nset KEYANDTHINK \\"false\\" ;# Time for user thinking and keying (true or false)\nset CHECKPOINT \\"false\\" ;# Perform Oracle checkpoint when complete (true or false)\nset rampup 2; # Rampup time in minutes before first snapshot is taken\nset duration 5; # Duration in minutes before second AWR snapshot is taken\nset mode \\"Local\\" ;# HammerDB operational mode\nset timesten \\"false\\" ;# Database is TimesTen\nset systemconnect system\/manager@oracle ;# Oracle connect string for system user\nset connect tpcc\/new_password@oracle ;# Oracle connect string for tpc-c user\n#EDITABLE OPTIONS##################################################\n#LOAD LIBRARIES AND MODULES …. \n\"}
+{\"script\": \"#!\/usr\/local\/bin\/tclsh8.6\n#EDITABLE OPTIONS##################################################\nset library Oratcl ;# Oracle OCI Library\nset total_iterations 1000000 ;# Number of transactions before logging off\nset RAISEERROR \\"false\\" ;# Exit script on Oracle error (true or false)\nset KEYANDTHINK \\"false\\" ;# Time for user thinking and keying (true or false)\nset CHECKPOINT \\"false\\" ;# Perform Oracle checkpoint when complete (true or false)\nset rampup 2; # Rampup time in minutes before first snapshot is taken\nset duration 5; # Duration in minutes before second AWR snapshot is taken\nset mode \\"Local\\" ;# HammerDB operational mode\nset timesten \\"false\\" ;# Database is TimesTen\nset systemconnect system\/manager@oracle ;# Oracle connect string for system user\nset connect tpcc\/new_password@oracle ;# Oracle connect string for tpc-c user\n#EDITABLE OPTIONS##################################################\n#LOAD LIBRARIES AND MODULES …. \n\"}
GET vuconf: Show the virtual user configuration.
get http://localhost:8080/print?vuconf / http://localhost:8080/vuconf
diff --git a/src/mssqlserver/mssqlsolap.tcl b/src/mssqlserver/mssqlsolap.tcl
index 8684dca9..22aefb0d 100755
--- a/src/mssqlserver/mssqlsolap.tcl
+++ b/src/mssqlserver/mssqlsolap.tcl
@@ -3,7 +3,7 @@ global maxvuser suppo ntimes threadscreated _ED
upvar #0 dbdict dbdict
if {[dict exists $dbdict mssqlserver library ]} {
set library [ dict get $dbdict mssqlserver library ]
-} else { set library "tclodbc 2.5.2" }
+} else { set library "tdbc::odbc 1.0.6" }
if { [ llength $library ] > 1 } {
set version [ lindex $library 1 ]
set library [ lindex $library 0 ]
@@ -41,12 +41,12 @@ if [catch {package require tpchcommon} ] { error "Failed to load tpch common fun
proc UpdateStatistics { odbc db azure } {
puts "UPDATING SCHEMA STATISTICS"
if {!$azure} {
-odbc "EXEC sp_updatestats"
+$odbc evaldirect "EXEC sp_updatestats"
} else {
set sql(1) "USE $db"
set sql(2) "EXEC sp_updatestats"
for { set i 1 } { $i <= 2 } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
}
return
@@ -55,10 +55,12 @@ return
proc CreateDatabase { odbc db azure } {
set table_count 0
puts "CHECKING IF DATABASE $db EXISTS"
-set db_exists [ odbc "IF DB_ID('$db') is not null SELECT 1 AS res ELSE SELECT 0 AS res" ]
+set rows [ odbc allrows "IF DB_ID('$db') is not null SELECT 1 AS res ELSE SELECT 0 AS res" ]
+set db_exists [ lindex {*}$rows 1 ]
if { $db_exists } {
-if {!$azure} {odbc "use $db"}
-set table_count [ odbc "select COUNT(*) from sys.tables" ]
+if {!$azure} {$odbc evaldirect "use $db"}
+set rows [ odbc allrows "select COUNT(*) from sys.tables" ]
+set table_count [ lindex {*}$rows 1 ]
if { $table_count == 0 } {
puts "Empty database $db exists"
puts "Using existing empty Database $db for Schema build"
@@ -68,7 +70,7 @@ error "Database $db exists but is not empty, specify a new or empty database nam
}
} else {
puts "CREATING DATABASE $db"
-odbc "create database $db"
+$odbc evaldirect "create database $db"
}
}
@@ -94,7 +96,7 @@ set sql(7) "create table dbo.supplier( s_suppkey int not null, s_nationkey int n
set sql(8) "create table dbo.orders( o_orderdate date null, o_orderkey bigint not null, o_custkey bigint not null, o_orderpriority char(15) null, o_shippriority int null, o_clerk char(15) null, o_orderstatus char(1) null, o_totalprice money null, o_comment varchar(79) null)"
}
for { set i 1 } { $i <= 8 } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
return
}
@@ -173,7 +175,7 @@ set sql(33) "alter table dbo.supplier check constraint supplier_nation_fk"
set sql(34) "alter table dbo.orders check constraint order_customer_fk"
}
for { set i 1 } { $i <= 34 } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
return
}
@@ -183,9 +185,8 @@ for { set i 1 } { $i <= 5 } {incr i} {
set code [ expr {$i - 1} ]
set text [ lindex [ lindex [ get_dists regions ] [ expr {$i - 1} ] ] 0 ]
set comment [ TEXT_1 72 ]
-odbc "INSERT INTO region (r_regionkey,r_name,r_comment) VALUES ('$code' , '$text' , '$comment')"
+$odbc evaldirect "INSERT INTO region (r_regionkey,r_name,r_comment) VALUES ('$code' , '$text' , '$comment')"
}
-odbc commit
}
proc mk_nation { odbc } {
@@ -201,9 +202,8 @@ switch $nind {
10 - 11 - 13 - 20 { set join 4 }
}
set comment [ TEXT_1 72 ]
-odbc "INSERT INTO nation (n_nationkey, n_name, n_regionkey, n_comment) VALUES ('$code' , '$text' , '$join' , '$comment')"
+$odbc evaldirect "INSERT INTO nation (n_nationkey, n_name, n_regionkey, n_comment) VALUES ('$code' , '$text' , '$join' , '$comment')"
}
-odbc commit
}
proc mk_supp { odbc start_rows end_rows } {
@@ -235,8 +235,7 @@ set comment [ string replace $comment $st $fi $BBB_COMMEND ]
append supp_val_list ('$suppkey', '$nation_code', '$comment', '$name', '$address', '$phone', '$acctbal')
incr bld_cnt
if { ![ expr {$i % 2} ] || $i eq $end_rows } {
-odbc "INSERT INTO supplier (s_suppkey, s_nationkey, s_comment, s_name, s_address, s_phone, s_acctbal) VALUES $supp_val_list"
- odbc commit
+$odbc evaldirect "INSERT INTO supplier (s_suppkey, s_nationkey, s_comment, s_name, s_address, s_phone, s_acctbal) VALUES $supp_val_list"
set bld_cnt 1
unset supp_val_list
} else {
@@ -246,7 +245,6 @@ if { ![ expr {$i % 10000} ] } {
puts "Loading SUPPLIER...$i"
}
}
- odbc commit
puts "SUPPLIER Done Rows $start_rows..$end_rows"
return
}
@@ -265,8 +263,7 @@ set comment [ TEXT_1 73 ]
append cust_val_list ('$custkey', '$mktsegment', '$nation_code', '$name', '$address', '$phone', '$acctbal', '$comment')
incr bld_cnt
if { ![ expr {$i % 2} ] || $i eq $end_rows } {
-odbc "INSERT INTO customer (c_custkey, c_mktsegment, c_nationkey, c_name, c_address, c_phone, c_acctbal, c_comment) values $cust_val_list"
- odbc commit
+$odbc evaldirect "INSERT INTO customer (c_custkey, c_mktsegment, c_nationkey, c_name, c_address, c_phone, c_acctbal, c_comment) values $cust_val_list"
set bld_cnt 1
unset cust_val_list
} else {
@@ -276,12 +273,11 @@ if { ![ expr {$i % 10000} ] } {
puts "Loading CUSTOMER...$i"
}
}
-odbc commit
puts "CUSTOMER Done Rows $start_rows..$end_rows"
return
}
-proc mk_part { mysql_handler start_rows end_rows scale_factor } {
+proc mk_part { odbc start_rows end_rows scale_factor } {
set bld_cnt 1
for { set i $start_rows } { $i <= $end_rows } { incr i } {
set partkey $i
@@ -314,9 +310,8 @@ append psupp_val_list ,
incr bld_cnt
# end of psupp loop
if { ![ expr {$i % 2} ] || $i eq $end_rows } {
-odbc "INSERT INTO part (p_partkey, p_type, p_size, p_brand, p_name, p_container, p_mfgr, p_retailprice, p_comment) VALUES $part_val_list"
-odbc "INSERT INTO partsupp (ps_partkey, ps_suppkey, ps_supplycost, ps_availqty, ps_comment) VALUES $psupp_val_list"
- odbc commit
+$odbc evaldirect "INSERT INTO part (p_partkey, p_type, p_size, p_brand, p_name, p_container, p_mfgr, p_retailprice, p_comment) VALUES $part_val_list"
+$odbc evaldirect "INSERT INTO partsupp (ps_partkey, ps_suppkey, ps_supplycost, ps_availqty, ps_comment) VALUES $psupp_val_list"
set bld_cnt 1
unset part_val_list
unset psupp_val_list
@@ -328,12 +323,11 @@ if { ![ expr {$i % 10000} ] } {
puts "Loading PART/PARTSUPP...$i"
}
}
-odbc commit
puts "PART and PARTSUPP Done Rows $start_rows..$end_rows"
return
}
-proc mk_order { mysql_handler start_rows end_rows upd_num scale_factor } {
+proc mk_order { odbc start_rows end_rows upd_num scale_factor } {
set bld_cnt 1
set refresh 100
set delta 1
@@ -411,9 +405,8 @@ if { $ocnt == $lcnt } { set orderstatus "F" }
append order_val_list ('$date', '$okey', '$custkey', '$opriority', '$spriority', '$clerk', '$orderstatus', '$totalprice', '$comment')
incr bld_cnt
if { ![ expr {$i % 2} ] || $i eq $end_rows } {
-odbc "INSERT INTO lineitem (l_shipdate, l_orderkey, l_discount, l_extendedprice, l_suppkey, l_quantity, l_returnflag, l_partkey, l_linestatus, l_tax, l_commitdate, l_receiptdate, l_shipmode, l_linenumber, l_shipinstruct, l_comment) VALUES $lineit_val_list"
-odbc "INSERT INTO orders (o_orderdate, o_orderkey, o_custkey, o_orderpriority, o_shippriority, o_clerk, o_orderstatus, o_totalprice, o_comment) VALUES $order_val_list"
- odbc commit
+$odbc evaldirect "INSERT INTO lineitem (l_shipdate, l_orderkey, l_discount, l_extendedprice, l_suppkey, l_quantity, l_returnflag, l_partkey, l_linestatus, l_tax, l_commitdate, l_receiptdate, l_shipmode, l_linenumber, l_shipinstruct, l_comment) VALUES $lineit_val_list"
+$odbc evaldirect "INSERT INTO orders (o_orderdate, o_orderkey, o_custkey, o_orderpriority, o_shippriority, o_clerk, o_orderstatus, o_totalprice, o_comment) VALUES $order_val_list"
set bld_cnt 1
unset lineit_val_list
unset order_val_list
@@ -425,7 +418,6 @@ if { ![ expr {$i % 10000} ] } {
puts "Loading ORDERS/LINEITEM...$i"
}
}
-odbc commit
puts "ORDERS and LINEITEM Done Rows $start_rows..$end_rows"
return
}
@@ -498,13 +490,11 @@ set num_vu 1
}
if { $threaded eq "SINGLE-THREADED" || $threaded eq "MULTI-THREADED" && $myposition eq 1 } {
puts "CREATING [ string toupper $db ] SCHEMA"
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
CreateDatabase odbc $db $azure
-if {!$azure} {odbc "use $db"}
+if {!$azure} {odbc evaldirect "use $db"}
CreateTables odbc $colstore
}
if { $threaded eq "MULTI-THREADED" } {
@@ -555,13 +545,11 @@ return
}
after 5000
}
-if [catch {database connect odbc $connection} message ] {
-puts stderr "error, the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
-if {!$azure} {odbc "use $db"}
-odbc set autocommit off
+if {!$azure} {odbc evaldirect "use $db"}
+odbc evaldirect "set implicit_transactions OFF"
}
if { [ expr $myposition - 1 ] > $max_threads } { puts "No Data to Create"; return }
if { [ expr $num_vu + 1 ] > $max_threads } { set num_vu $max_threads }
@@ -595,7 +583,7 @@ if { $threaded eq "SINGLE-THREADED" || $threaded eq "MULTI-THREADED" && $myposit
CreateIndexes odbc $maxdop $colstore
UpdateStatistics odbc $db $azure
puts "[ string toupper $db ] SCHEMA COMPLETE"
-odbc disconnect
+odbc close
return
}
}
@@ -609,7 +597,7 @@ global _ED
upvar #0 dbdict dbdict
if {[dict exists $dbdict mssqlserver library ]} {
set library [ dict get $dbdict mssqlserver library ]
-} else { set library "tclodbc 2.5.2" }
+} else { set library "tdbc::odbc 1.0.6" }
if { [ llength $library ] > 1 } {
set version [ lindex $library 1 ]
set library [ lindex $library 0 ]
@@ -671,14 +659,14 @@ return $connection
}
proc standsql { odbc sql RAISEERROR } {
-if {[ catch {set sql_output [odbc $sql ]} message]} {
+if {[ catch {set rows [$odbc allrows $sql ]} message]} {
if { $RAISEERROR } {
error "Query Error :$message"
} else {
puts "$message"
}
} else {
-return $sql_output
+return $rows
}
}
#########################
@@ -734,7 +722,7 @@ if { $ocnt == $lcnt } { set orderstatus "F" }
if { $REFRESH_VERBOSE } {
puts "Refresh Insert Orderkey $okey..."
}
-odbc "INSERT INTO orders (o_orderdate, o_orderkey, o_custkey, o_orderpriority, o_shippriority, o_clerk, o_orderstatus, o_totalprice, o_comment) VALUES ('$date', '$okey', '$custkey', '$opriority', '$spriority', '$clerk', '$orderstatus', '$totalprice', '$comment')"
+$odbc evaldirect "INSERT INTO orders (o_orderdate, o_orderkey, o_custkey, o_orderpriority, o_shippriority, o_clerk, o_orderstatus, o_totalprice, o_comment) VALUES ('$date', '$okey', '$custkey', '$opriority', '$spriority', '$clerk', '$orderstatus', '$totalprice', '$comment')"
#Lineitem Loop
for { set l 0 } { $l < $lcnt } {incr l} {
set lokey $okey
@@ -767,13 +755,11 @@ if { [ julian $s_date ] <= 95168 } {
incr ocnt
set lstatus "F"
} else { set lstatus "O" }
-odbc "INSERT INTO lineitem (l_shipdate, l_orderkey, l_discount, l_extendedprice, l_suppkey, l_quantity, l_returnflag, l_partkey, l_linestatus, l_tax, l_commitdate, l_receiptdate, l_shipmode, l_linenumber, l_shipinstruct, l_comment) VALUES ('$lsdate','$lokey', '$ldiscount', '$leprice', '$lsuppkey', '$lquantity', '$lrflag', '$lpartkey', '$lstatus', '$ltax', '$lcdate', '$lrdate', '$lsmode', '$llcnt', '$linstruct', '$lcomment')"
+odbc evaldirect "INSERT INTO lineitem (l_shipdate, l_orderkey, l_discount, l_extendedprice, l_suppkey, l_quantity, l_returnflag, l_partkey, l_linestatus, l_tax, l_commitdate, l_receiptdate, l_shipmode, l_linenumber, l_shipinstruct, l_comment) VALUES ('$lsdate','$lokey', '$ldiscount', '$leprice', '$lsuppkey', '$lquantity', '$lrflag', '$lpartkey', '$lstatus', '$ltax', '$lcdate', '$lrdate', '$lsmode', '$llcnt', '$linstruct', '$lcomment')"
}
if { ![ expr {$i % 1000} ] } {
-odbc commit
}
}
-odbc commit
}
proc del_order_ref { odbc upd_num scale_factor trickle_refresh REFRESH_VERBOSE } {
@@ -793,28 +779,23 @@ set okey [ mk_sparse $i $upd_num ]
} else {
set okey [ mk_sparse $i [ expr {$upd_num / (10000 / $refresh)} ] ]
}
-odbc "DELETE FROM lineitem WHERE l_orderkey = $okey"
-odbc "DELETE FROM orders WHERE o_orderkey = $okey"
+$odbc evaldirect "DELETE FROM lineitem WHERE l_orderkey = $okey"
+$odbc evaldirect "DELETE FROM orders WHERE o_orderkey = $okey"
if { $REFRESH_VERBOSE } {
puts "Refresh Delete Orderkey $okey..."
}
if { ![ expr {$i % 1000} ] } {
-odbc commit
}
-}
-odbc commit
+ }
}
proc do_refresh { server port scale_factor odbc_driver authentication uid pwd tcp azure database update_sets trickle_refresh REFRESH_VERBOSE RF_SET } {
set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $database ]
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
-} else {
-database connect odbc $connection
-if {!$azure} {odbc "use $database"}
-odbc set autocommit off
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
+ } else {
+if {!$azure} {odbc evaldirect "use $database"}
+odbc evaldirect "set implicit_transactions OFF"
}
set upd_num 1
for { set set_counter 1 } {$set_counter <= $update_sets } {incr set_counter} {
@@ -842,8 +823,7 @@ puts "Completed update set(s) $set_counter in $rvaltot seconds"
incr upd_num
}
puts "Completed $update_sets update set(s)"
-odbc commit
-odbc disconnect
+odbc close
}
#########################
#TPCH QUERY GENERATION
@@ -1068,14 +1048,11 @@ return $q2sub
#TPCH QUERY SETS PROCEDURE
proc do_tpch { server port scale_factor odbc_driver authentication uid pwd tcp azure db RAISEERROR VERBOSE maxdop total_querysets myposition } {
set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $db ]
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
-} else {
-database connect odbc $connection
-if {!$azure} {odbc "use $db"}
-odbc set autocommit off
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
+ } else {
+if {!$azure} {odbc evaldirect "use $db"}
+odbc evaldirect "set implicit_transactions OFF"
}
for {set it 0} {$it < $total_querysets} {incr it} {
if { [ tsv::get application abort ] } { break }
@@ -1111,7 +1088,7 @@ puts "query $qos completed in $value seconds"
set q15c 0
while {$q15c <= [expr $q15length - 1] } {
if { $q15c != 1 } {
-if {[ catch {set sql_output [odbc $dssquery($qos,$q15c)]} message]} {
+if {[ catch {set sql_output [odbc evaldirect $dssquery($qos,$q15c)]} message]} {
if { $RAISEERROR } {
error "Query Error :$message"
} else {
@@ -1135,8 +1112,7 @@ set wall [ expr $end - $start ]
set qsets [ expr $it + 1 ]
puts "Completed $qsets query set(s) in $wall seconds"
}
-odbc commit
-odbc disconnect
+odbc close
}
#########################
#RUN TPC-H
diff --git a/src/mssqlserver/mssqlsoltp.tcl b/src/mssqlserver/mssqlsoltp.tcl
index b264f59c..0af72603 100755
--- a/src/mssqlserver/mssqlsoltp.tcl
+++ b/src/mssqlserver/mssqlsoltp.tcl
@@ -3,7 +3,7 @@ global maxvuser suppo ntimes threadscreated _ED
upvar #0 dbdict dbdict
if {[dict exists $dbdict mssqlserver library ]} {
set library [ dict get $dbdict mssqlserver library ]
-} else { set library "tclodbc 2.5.2" }
+} else { set library "tdbc::odbc 1.0.6" }
if { [ llength $library ] > 1 } {
set version [ lindex $library 1 ]
set library [ lindex $library 0 ]
@@ -1439,7 +1439,7 @@ COMMIT TRANSACTION;
END}
}
for { set i 1 } { $i <= 5 } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
return
}
@@ -1448,12 +1448,12 @@ return
proc UpdateStatistics { odbc db azure } {
puts "UPDATING SCHEMA STATISTICS"
if {!$azure} {
-odbc "EXEC sp_updatestats"
+$odbc evaldirect "EXEC sp_updatestats"
} else {
set sql(1) "USE $db"
set sql(2) "EXEC sp_updatestats"
for { set i 1 } { $i <= 2 } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
}
return
@@ -1462,25 +1462,31 @@ return
proc CreateDatabase { odbc db imdb azure } {
set table_count 0
puts "CHECKING IF DATABASE $db EXISTS"
-set db_exists [ odbc "IF DB_ID('$db') is not null SELECT 1 AS res ELSE SELECT 0 AS res" ]
+set rows [ $odbc allrows "IF DB_ID('$db') is not null SELECT 1 AS res ELSE SELECT 0 AS res" ]
+set db_exists [ lindex {*}$rows 1 ]
if { $db_exists } {
-if {!$azure} {odbc "use $db"}
-set table_count [ odbc "select COUNT(*) from sys.tables" ]
+if {!$azure} {$odbc evaldirect "use $db"}
+set rows [ $odbc allrows "select COUNT(*) from sys.tables" ]
+set table_count [ lindex {*}$rows 1 ]
if { $table_count == 0 } {
puts "Empty database $db exists"
if { $imdb } {
-odbc "ALTER DATABASE $db SET AUTO_CREATE_STATISTICS OFF"
-odbc "ALTER DATABASE $db SET AUTO_UPDATE_STATISTICS OFF"
-set imdb_fg [ odbc {SELECT TOP 1 1 FROM sys.filegroups FG JOIN sys.database_files F ON FG.data_space_id = F.data_space_id WHERE FG.type = 'FX' AND F.type = 2} ]
+$odbc evaldirect "ALTER DATABASE $db SET AUTO_CREATE_STATISTICS OFF"
+$odbc evaldirect "ALTER DATABASE $db SET AUTO_UPDATE_STATISTICS OFF"
+set rows [ $odbc allrows {SELECT TOP 1 1 FROM sys.filegroups FG JOIN sys.database_files F ON FG.data_space_id = F.data_space_id WHERE FG.type = 'FX' AND F.type = 2} ]
+set imdb_fg [ lindex {*}$rows 1 ]
if { $imdb_fg eq "1" } {
-set elevatetosnap [ odbc "SELECT is_memory_optimized_elevate_to_snapshot_on FROM sys.databases WHERE name = '$db'" ]
+set rows [ $odbc allrows "SELECT is_memory_optimized_elevate_to_snapshot_on FROM sys.databases WHERE name = '$db'" ]
+set elevatetosnap [ lindex {*}$rows 1 ]
if { $elevatetosnap eq "1" } {
puts "Using existing Memory Optimized Database $db with ELEVATE_TO_SNAPSHOT for Schema build"
} else {
puts "Existing Memory Optimized Database $db exists, setting ELEVATE_TO_SNAPSHOT"
+unset -nocomplain rows
unset -nocomplain elevatetosnap
-odbc "ALTER DATABASE $db SET MEMORY_OPTIMIZED_ELEVATE_TO_SNAPSHOT = ON"
-set elevatetosnap [ odbc "SELECT is_memory_optimized_elevate_to_snapshot_on FROM sys.databases WHERE name = '$db'" ]
+$odbc evaldirect "ALTER DATABASE $db SET MEMORY_OPTIMIZED_ELEVATE_TO_SNAPSHOT = ON"
+set rows [ $odbc allrows "SELECT is_memory_optimized_elevate_to_snapshot_on FROM sys.databases WHERE name = '$db'" ]
+set elevatetosnap [ lindex {*}$rows 1 ]
if { $elevatetosnap eq "1" } {
puts "Success: Set ELEVATE_TO_SNAPSHOT for Database $db"
} else {
@@ -1505,7 +1511,7 @@ puts "In Memory Database chosen but $db does not exist"
error "Database $db must be pre-created in a MEMORY_OPTIMIZED_DATA filegroup and empty, to specify an In-Memory build"
} else {
puts "CREATING DATABASE $db"
-odbc "create database $db"
+$odbc evaldirect "create database $db"
}
}
}
@@ -1555,7 +1561,7 @@ set sql(19) {ALTER TABLE [dbo].[district] ADD CONSTRAINT [DF__DISTRICT__paddin_
set sql(20) {ALTER TABLE [dbo].[warehouse] ADD CONSTRAINT [DF__WAREHOUSE__paddi__14270015] DEFAULT (replicate('x',(4000))) FOR [padding]}
}
for { set i 1 } { $i <= $stmnt_cnt } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
return
}
@@ -1574,7 +1580,7 @@ set sql(6) {CREATE NONCLUSTERED INDEX [d_details] ON [dbo].[district] ( [d_id] A
set sql(7) {CREATE NONCLUSTERED INDEX [orders_i2] ON [dbo].[orders] ( [o_w_id] ASC, [o_d_id] ASC, [o_c_id] ASC, [o_id] ASC)WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, SORT_IN_TEMPDB = OFF, DROP_EXISTING = OFF, ONLINE = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = OFF)}
set sql(8) {CREATE UNIQUE NONCLUSTERED INDEX [w_details] ON [dbo].[warehouse] ( [w_id] ASC) INCLUDE ([w_tax], [w_name], [w_street_1], [w_street_2], [w_city], [w_state], [w_zip], [padding]) WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, SORT_IN_TEMPDB = OFF, IGNORE_DUP_KEY = OFF, DROP_EXISTING = OFF, ONLINE = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = OFF)}
for { set i 1 } { $i <= 8 } { incr i } {
-odbc $sql($i)
+$odbc evaldirect $sql($i)
}
}
return
@@ -1624,9 +1630,8 @@ append h_val_list ,
}
incr bld_cnt
if { ![ expr {$c_id % 2} ] } {
-odbc "insert into customer (c_id, c_d_id, c_w_id, c_first, c_middle, c_last, c_street_1, c_street_2, c_city, c_state, c_zip, c_phone, c_since, c_credit, c_credit_lim, c_discount, c_balance, c_data, c_ytd_payment, c_payment_cnt, c_delivery_cnt) values $c_val_list"
-odbc "insert into history (h_c_id, h_c_d_id, h_c_w_id, h_w_id, h_d_id, h_date, h_amount, h_data) values $h_val_list"
- odbc commit
+$odbc evaldirect "insert into customer (c_id, c_d_id, c_w_id, c_first, c_middle, c_last, c_street_1, c_street_2, c_city, c_state, c_zip, c_phone, c_since, c_credit, c_credit_lim, c_discount, c_balance, c_data, c_ytd_payment, c_payment_cnt, c_delivery_cnt) values $c_val_list"
+$odbc evaldirect "insert into history (h_c_id, h_c_d_id, h_c_w_id, h_w_id, h_d_id, h_date, h_amount, h_data) values $h_val_list"
set bld_cnt 1
unset c_val_list
unset h_val_list
@@ -1699,19 +1704,17 @@ incr bld_cnt
if { ![ expr {$o_id % 1000} ] } {
puts "...$o_id"
}
-odbc "insert into orders (o_id, o_c_id, o_d_id, o_w_id, o_entry_d, o_carrier_id, o_ol_cnt, o_all_local) values $o_val_list"
+$odbc evaldirect "insert into orders (o_id, o_c_id, o_d_id, o_w_id, o_entry_d, o_carrier_id, o_ol_cnt, o_all_local) values $o_val_list"
if { $o_id > 2100 } {
-odbc "insert into new_order (no_o_id, no_d_id, no_w_id) values $no_val_list"
+$odbc evaldirect "insert into new_order (no_o_id, no_d_id, no_w_id) values $no_val_list"
}
-odbc "insert into order_line (ol_o_id, ol_d_id, ol_w_id, ol_number, ol_i_id, ol_supply_w_id, ol_quantity, ol_amount, ol_dist_info, ol_delivery_d) values $ol_val_list"
- odbc commit
+$odbc evaldirect "insert into order_line (ol_o_id, ol_d_id, ol_w_id, ol_number, ol_i_id, ol_supply_w_id, ol_quantity, ol_amount, ol_dist_info, ol_delivery_d) values $ol_val_list"
set bld_cnt 1
unset o_val_list
unset -nocomplain no_val_list
unset ol_val_list
}
}
- odbc commit
puts "Orders Done"
return
}
@@ -1740,12 +1743,11 @@ set last [ expr {$first + 8} ]
set i_data [ string replace $i_data $first $last "original" ]
}
}
- odbc "insert into item (i_id, i_im_id, i_name, i_price, i_data) VALUES ('$i_id', '$i_im_id', '$i_name', '$i_price', '$i_data')"
+ $odbc evaldirect "insert into item (i_id, i_im_id, i_name, i_price, i_data) VALUES ('$i_id', '$i_im_id', '$i_name', '$i_price', '$i_data')"
if { ![ expr {$i_id % 50000} ] } {
puts "Loading Items - $i_id"
}
}
- odbc commit
puts "Item done"
return
}
@@ -1789,8 +1791,7 @@ append val_list ,
}
incr bld_cnt
if { ![ expr {$s_i_id % 2} ] } {
-odbc "insert into stock (s_i_id, s_w_id, s_quantity, s_dist_01, s_dist_02, s_dist_03, s_dist_04, s_dist_05, s_dist_06, s_dist_07, s_dist_08, s_dist_09, s_dist_10, s_data, s_ytd, s_order_cnt, s_remote_cnt) values $val_list"
- odbc commit
+$odbc evaldirect "insert into stock (s_i_id, s_w_id, s_quantity, s_dist_01, s_dist_02, s_dist_03, s_dist_04, s_dist_05, s_dist_06, s_dist_07, s_dist_08, s_dist_09, s_dist_10, s_data, s_ytd, s_order_cnt, s_remote_cnt) values $val_list"
set bld_cnt 1
unset val_list
}
@@ -1798,7 +1799,6 @@ odbc "insert into stock (s_i_id, s_w_id, s_quantity, s_dist_01, s_dist_02, s_dis
puts "Loading Stock - $s_i_id"
}
}
- odbc commit
puts "Stock done"
return
}
@@ -1815,9 +1815,8 @@ set d_name [ MakeAlphaString 6 10 $globArray $chalen ]
set d_add [ MakeAddress $globArray $chalen ]
set d_tax_ran [ RandomNumber 10 20 ]
set d_tax [ string replace [ format "%.2f" [ expr {$d_tax_ran / 100.0} ] ] 0 0 "" ]
-odbc "insert into district (d_id, d_w_id, d_name, d_street_1, d_street_2, d_city, d_state, d_zip, d_tax, d_ytd, d_next_o_id) values ('$d_id', '$d_w_id', '$d_name', '[ lindex $d_add 0 ]', '[ lindex $d_add 1 ]', '[ lindex $d_add 2 ]', '[ lindex $d_add 3 ]', '[ lindex $d_add 4 ]', '$d_tax', '$d_ytd', '$d_next_o_id')"
+$odbc evaldirect "insert into district (d_id, d_w_id, d_name, d_street_1, d_street_2, d_city, d_state, d_zip, d_tax, d_ytd, d_next_o_id) values ('$d_id', '$d_w_id', '$d_name', '[ lindex $d_add 0 ]', '[ lindex $d_add 1 ]', '[ lindex $d_add 2 ]', '[ lindex $d_add 3 ]', '[ lindex $d_add 4 ]', '$d_tax', '$d_ytd', '$d_next_o_id')"
}
- odbc commit
puts "District done"
return
}
@@ -1832,30 +1831,27 @@ set w_name [ MakeAlphaString 6 10 $globArray $chalen ]
set add [ MakeAddress $globArray $chalen ]
set w_tax_ran [ RandomNumber 10 20 ]
set w_tax [ string replace [ format "%.2f" [ expr {$w_tax_ran / 100.0} ] ] 0 0 "" ]
-odbc "insert into warehouse (w_id, w_name, w_street_1, w_street_2, w_city, w_state, w_zip, w_tax, w_ytd) values ('$w_id', '$w_name', '[ lindex $add 0 ]', '[ lindex $add 1 ]', '[ lindex $add 2 ]' , '[ lindex $add 3 ]', '[ lindex $add 4 ]', '$w_tax', '$w_ytd')"
- Stock odbc $w_id $MAXITEMS
- District odbc $w_id $DIST_PER_WARE
- odbc commit
+$odbc evaldirect "insert into warehouse (w_id, w_name, w_street_1, w_street_2, w_city, w_state, w_zip, w_tax, w_ytd) values ('$w_id', '$w_name', '[ lindex $add 0 ]', '[ lindex $add 1 ]', '[ lindex $add 2 ]' , '[ lindex $add 3 ]', '[ lindex $add 4 ]', '$w_tax', '$w_ytd')"
+ Stock $odbc $w_id $MAXITEMS
+ District $odbc $w_id $DIST_PER_WARE
}
}
proc LoadCust { odbc ware_start count_ware CUST_PER_DIST DIST_PER_WARE } {
for {set w_id $ware_start} {$w_id <= $count_ware } {incr w_id } {
for {set d_id 1} {$d_id <= $DIST_PER_WARE } {incr d_id } {
- Customer odbc $d_id $w_id $CUST_PER_DIST
+ Customer $odbc $d_id $w_id $CUST_PER_DIST
}
}
- odbc commit
return
}
proc LoadOrd { odbc ware_start count_ware MAXITEMS ORD_PER_DIST DIST_PER_WARE } {
for {set w_id $ware_start} {$w_id <= $count_ware } {incr w_id } {
for {set d_id 1} {$d_id <= $DIST_PER_WARE } {incr d_id } {
- Orders odbc $d_id $w_id $MAXITEMS $ORD_PER_DIST
+ Orders $odbc $d_id $w_id $MAXITEMS $ORD_PER_DIST
}
}
- odbc commit
return
}
@@ -1907,13 +1903,11 @@ set num_vu 1
}
if { $threaded eq "SINGLE-THREADED" || $threaded eq "MULTI-THREADED" && $myposition eq 1 } {
puts "CREATING [ string toupper $db ] SCHEMA"
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
CreateDatabase odbc $db $imdb $azure
-if {!$azure} {odbc "use $db"}
+if {!$azure} {odbc evaldirect "use $db"}
CreateTables odbc $imdb $count_ware $bucket_factor $durability
}
if { $threaded eq "MULTI-THREADED" } {
@@ -1952,13 +1946,11 @@ return
}
after 5000
}
-if [catch {database connect odbc $connection} message ] {
-puts stderr "error, the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
-if {!$azure} {odbc "use $db"}
-odbc set autocommit off
+if {!$azure} {odbc evaldirect "use $db"}
+odbc evaldirect "set implicit_transactions OFF"
}
set remb [ lassign [ findchunk $num_vu $count_ware $myposition ] chunk mystart myend ]
puts "Loading $chunk Warehouses start:$mystart end:$myend"
@@ -1972,7 +1964,6 @@ LoadWare odbc $mystart $myend $MAXITEMS $DIST_PER_WARE
LoadCust odbc $mystart $myend $CUST_PER_DIST $DIST_PER_WARE
LoadOrd odbc $mystart $myend $MAXITEMS $ORD_PER_DIST $DIST_PER_WARE
puts "End:[ clock format [ clock seconds ] ]"
-odbc commit
if { $threaded eq "MULTI-THREADED" } {
tsv::lreplace common thrdlst $myposition $myposition done
}
@@ -1982,7 +1973,7 @@ CreateIndexes odbc $imdb
CreateStoredProcs odbc $imdb
UpdateStatistics odbc $db $azure
puts "[ string toupper $db ] SCHEMA COMPLETE"
-odbc disconnect
+odbc close
return
}
}
@@ -1996,7 +1987,7 @@ global _ED
upvar #0 dbdict dbdict
if {[dict exists $dbdict mssqlserver library ]} {
set library [ dict get $dbdict mssqlserver library ]
-} else { set library "tclodbc 2.5.2" }
+} else { set library "tdbc::odbc 1.0.6" }
if { [ llength $library ] > 1 } {
set version [ lindex $library 1 ]
set library [ lindex $library 0 ]
@@ -2065,20 +2056,27 @@ set no_c_id [ RandomNumber 1 3000 ]
set ol_cnt [ RandomNumber 5 15 ]
#2.4.1.6 order entry date O_ENTRY_D generated by SUT
set date [ gettimestamp ]
-if {[ catch {neword_st execute [ list $no_w_id $w_id_input $no_d_id $no_c_id $ol_cnt $date ]} message]} {
+if {[catch {set resultset [ $neword_st execute [ list no_w_id $no_w_id w_id_input $w_id_input no_d_id $no_d_id no_c_id $no_c_id ol_cnt $ol_cnt date $date ]]} message ]} {
+ if { $RAISEERROR } {
+error "New Order Bind/Exec : $message"
+ } else {
+puts "New Order Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set norows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "New Order : $message"
+error "New Order Fetch : $message"
} else {
-puts $message
-} } else {
-neword_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
+puts "New Order Fetch : $message"
+ }} else {
+regsub -all {[\s]+} [ join $norows ] {} norowsstr
+puts $norowsstr
+catch {$resultset close}
}
-puts [ join $oput ]
-}
-odbc commit
+ }
}
+
#PAYMENT
proc payment { payment_st p_w_id w_id_input RAISEERROR } {
#2.5.1.1 The home warehouse id remains the same for each terminal
@@ -2115,20 +2113,27 @@ set p_h_amount [ RandomNumber 1 5000 ]
#2.5.1.4 date selected from SUT
set h_date [ gettimestamp ]
#2.5.2.1 Payment Transaction
-if {[ catch {payment_st execute [ list $p_w_id $p_d_id $p_c_w_id $p_c_d_id $p_c_id $byname $p_h_amount $name $h_date ]} message]} {
+if {[catch {set resultset [ $payment_st execute [ list p_w_id $p_w_id p_d_id $p_d_id p_c_w_id $p_c_w_id p_c_d_id $p_c_d_id p_c_id $p_c_id byname $byname p_h_amount $p_h_amount name $name h_date $h_date ] ]} message ]} {
+ if { $RAISEERROR } {
+error "Payment Bind/Exec : $message"
+ } else {
+puts "Payment Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set pyrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "Payment : $message"
+error "Payment Fetch : $message"
} else {
-puts $message
-} } else {
-payment_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
+puts "Payment Fetch : $message"
+ }} else {
+regsub -all {[\s]+} [ join $pyrows ] {} pyrowsstr
+puts $pyrowsstr
+catch {$resultset close}
}
-puts [ join $oput ]
-}
-odbc commit
+ }
}
+
#ORDER_STATUS
proc ostat { ostat_st w_id RAISEERROR } {
#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
@@ -2143,96 +2148,143 @@ set byname 1
set byname 0
set name {}
}
-if {[ catch {ostat_st execute [ list $w_id $d_id $c_id $byname $name ]} message]} {
+if {[catch {set resultset [ $ostat_st execute [ list os_w_id $w_id os_d_id $d_id os_c_id $c_id byname $byname os_c_last $name ]]} message ]} {
+ if { $RAISEERROR } {
+error "Order Status Bind/Exec : $message"
+ } else {
+puts "Order Status Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set osrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "Order Status : $message"
+error "Order Status Fetch : $message"
} else {
-puts $message
-} } else {
-ostat_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
+puts "Order Status Fetch : $message"
+ }} else {
+regsub -all {[\s]+} [ join $osrows ] {} osrowsstr
+puts $osrowsstr
+catch {$resultset close}
}
-puts [ join $oput ]
-}
-odbc commit
+ }
}
+
#DELIVERY
proc delivery { delivery_st w_id RAISEERROR } {
set carrier_id [ RandomNumber 1 10 ]
set date [ gettimestamp ]
-if {[ catch {delivery_st execute [ list $w_id $carrier_id $date ]} message]} {
+if {[catch {set resultset [ $delivery_st execute [ list d_w_id $w_id d_o_carrier_id $carrier_id timestamp $date ]]} message ]} {
+ if { $RAISEERROR } {
+error "Delivery Bind/Exec : $message"
+ } else {
+puts "Delivery Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set dlrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "Delivery : $message"
+error "Delivery Fetch : $message"
} else {
-puts $message
-} } else {
-delivery_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
+puts "Delivery Fetch : $message"
+ }} else {
+regsub -all {[\s]+} [ join $dlrows ] {} dlrowsstr
+puts $dlrowsstr
+catch {$resultset close}
}
-puts [ join $oput ]
-}
-odbc commit
+ }
}
+
#STOCK LEVEL
proc slev { slev_st w_id stock_level_d_id RAISEERROR } {
set threshold [ RandomNumber 10 20 ]
-if {[ catch {slev_st execute [ list $w_id $stock_level_d_id $threshold ]} message]} {
-if { $RAISEERROR } {
+if {[catch {set resultset [ $slev_st execute [ list st_w_id $w_id st_d_id $stock_level_d_id threshold $threshold ]]} message ]} {
+ if { $RAISEERROR } {
error "Stock Level : $message"
} else {
-puts $message
-} } else {
-slev_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
+puts "Stock Level : $message"
}
-puts [ join $oput ]
-}
-odbc commit
+ } else {
+if {[catch {set slrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "Stock Level Fetch : $message"
+ } else {
+puts "Stock Level Fetch : $message"
+ }} else {
+regsub -all {[\s]+} [ join $slrows ] {} slrowsstr
+puts $slrowsstr
+catch {$resultset close}
+ }
+ }
}
+
proc prep_statement { odbc statement_st } {
switch $statement_st {
slev_st {
-odbc statement slev_st "EXEC slev @st_w_id = ?, @st_d_id = ?, @threshold = ?" {INTEGER INTEGER INTEGER}
-return slev_st
- }
+set slev_st [ $odbc prepare "EXEC slev @st_w_id = :st_w_id, @st_d_id = :st_d_id, @threshold = :threshold" ]
+$slev_st paramtype st_w_id in integer 10 0
+$slev_st paramtype st_d_id in integer 10 0
+$slev_st paramtype threshold in integer 10 0
+return $slev_st
+}
+
delivery_st {
-odbc statement delivery_st "EXEC delivery @d_w_id = ?, @d_o_carrier_id = ?, @timestamp = ?" {INTEGER INTEGER TIMESTAMP}
-return delivery_st
+set delivery_st [ $odbc prepare "EXEC delivery @d_w_id = :d_w_id, @d_o_carrier_id = :d_o_carrier_id, @timestamp = :timestamp" ]
+$delivery_st paramtype d_w_id in integer 10 0
+$delivery_st paramtype d_o_carrier_id in integer 10 0
+$delivery_st paramtype timestamp in timestamp 19 0
+return $delivery_st
}
ostat_st {
-odbc statement ostat_st "EXEC ostat @os_w_id = ?, @os_d_id = ?, @os_c_id = ?, @byname = ?, @os_c_last = ?" {INTEGER INTEGER INTEGER INTEGER {CHAR 16}}
-return ostat_st
+set ostat_st [ $odbc prepare "EXEC ostat @os_w_id = :os_w_id, @os_d_id = :os_d_id, @os_c_id = :os_c_id, @byname = :byname, @os_c_last = :os_c_last" ]
+$ostat_st paramtype os_w_id in integer 10 0
+$ostat_st paramtype os_d_id in integer 10 0
+$ostat_st paramtype os_c_id in integer 10 0
+$ostat_st paramtype byname in integer 10 0
+$ostat_st paramtype os_c_last in char 20 0
+return $ostat_st
}
payment_st {
-odbc statement payment_st "EXEC payment @p_w_id = ?, @p_d_id = ?, @p_c_w_id = ?, @p_c_d_id = ?, @p_c_id = ?, @byname = ?, @p_h_amount = ?, @p_c_last = ?, @TIMESTAMP =?" {INTEGER INTEGER INTEGER INTEGER INTEGER INTEGER INTEGER {CHAR 16} TIMESTAMP}
-return payment_st
+set payment_st [ $odbc prepare "EXEC payment @p_w_id = :p_w_id, @p_d_id = :p_d_id, @p_c_w_id = :p_c_w_id, @p_c_d_id = :p_c_d_id, @p_c_id = :p_c_id, @byname = :byname, @p_h_amount = :p_h_amount, @p_c_last = :name, @TIMESTAMP =:h_date" ]
+$payment_st paramtype p_w_id in integer 10 0
+$payment_st paramtype p_d_id in integer 10 0
+$payment_st paramtype p_c_w_id in integer 10 0
+$payment_st paramtype p_c_d_id in integer 10 0
+$payment_st paramtype p_c_id in integer 10 0
+$payment_st paramtype byname in integer 10 0
+$payment_st paramtype p_h_amount in numeric 6 2
+$payment_st paramtype name in char 16 0
+$payment_st paramtype h_date in timestamp 19 0
+return $payment_st
}
neword_st {
-odbc statement neword_st "EXEC neword @no_w_id = ?, @no_max_w_id = ?, @no_d_id = ?, @no_c_id = ?, @no_o_ol_cnt = ?, @TIMESTAMP = ?" {INTEGER INTEGER INTEGER INTEGER INTEGER TIMESTAMP}
-return neword_st
+set neword_st [ $odbc prepare "EXEC neword @no_w_id = :no_w_id, @no_max_w_id = :w_id_input, @no_d_id = :no_d_id, @no_c_id = :no_c_id, @no_o_ol_cnt = :ol_cnt, @TIMESTAMP = :date" ]
+$neword_st paramtype no_w_id in integer 10 0
+$neword_st paramtype w_id_input in integer 10 0
+$neword_st paramtype no_d_id in integer 10 0
+$neword_st paramtype no_c_id in integer 10 0
+$neword_st paramtype ol_cnt integer 10 0
+$neword_st paramtype date in timestamp 19 0
+return $neword_st
}
}
}
#RUN TPC-C
set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $database ]
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
-database connect odbc $connection
-if {!$azure} {odbc "use $database"}
-odbc set autocommit off
+if {!$azure} { odbc evaldirect "use $database" }
+odbc evaldirect "set implicit_transactions OFF"
}
foreach st {neword_st payment_st ostat_st delivery_st slev_st} { set $st [ prep_statement odbc $st ] }
-set w_id_input [ odbc "select max(w_id) from warehouse" ]
+set rows [ odbc allrows "select max(w_id) from warehouse" ]
+set w_id_input [ lindex {*}$rows 1 ]
#2.4.1.1 set warehouse_id stays constant for a given terminal
set w_id [ RandomNumber 1 $w_id_input ]
-set d_id_input [ odbc "select max(d_id) from district" ]
+set rows [ odbc allrows "select max(d_id) from district" ]
+set d_id_input [ lindex {*}$rows 1 ]
set stock_level_d_id [ RandomNumber 1 $d_id_input ]
puts "Processing $total_iterations transactions without output suppressed..."
set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
@@ -2242,37 +2294,36 @@ set choice [ RandomNumber 1 23 ]
if {$choice <= 10} {
puts "new order"
if { $KEYANDTHINK } { keytime 18 }
-neword neword_st $w_id $w_id_input $RAISEERROR
+neword $neword_st $w_id $w_id_input $RAISEERROR
if { $KEYANDTHINK } { thinktime 12 }
} elseif {$choice <= 20} {
puts "payment"
if { $KEYANDTHINK } { keytime 3 }
-payment payment_st $w_id $w_id_input $RAISEERROR
+payment $payment_st $w_id $w_id_input $RAISEERROR
if { $KEYANDTHINK } { thinktime 12 }
} elseif {$choice <= 21} {
puts "delivery"
if { $KEYANDTHINK } { keytime 2 }
-delivery delivery_st $w_id $RAISEERROR
+delivery $delivery_st $w_id $RAISEERROR
if { $KEYANDTHINK } { thinktime 10 }
} elseif {$choice <= 22} {
puts "stock level"
if { $KEYANDTHINK } { keytime 2 }
-slev slev_st $w_id $stock_level_d_id $RAISEERROR
+slev $slev_st $w_id $stock_level_d_id $RAISEERROR
if { $KEYANDTHINK } { thinktime 5 }
} elseif {$choice <= 23} {
puts "order status"
if { $KEYANDTHINK } { keytime 2 }
-ostat ostat_st $w_id $RAISEERROR
+ostat $ostat_st $w_id $RAISEERROR
if { $KEYANDTHINK } { thinktime 5 }
}
}
-odbc commit
-neword_st drop
-payment_st drop
-delivery_st drop
-slev_st drop
-ostat_st drop
-odbc disconnect}
+$neword_st close
+$payment_st close
+$delivery_st close
+$slev_st close
+$ostat_st close
+odbc close}
}
proc loadtimedmssqlstpcc { } {
@@ -2280,7 +2331,7 @@ global opmode _ED
upvar #0 dbdict dbdict
if {[dict exists $dbdict mssqlserver library ]} {
set library [ dict get $dbdict mssqlserver library ]
-} else { set library "tclodbc 2.5.2" }
+} else { set library "tdbc::odbc 1.0.6" }
if { [ llength $library ] > 1 } {
set version [ lindex $library 1 ]
set library [ lindex $library 0 ]
@@ -2296,6 +2347,8 @@ set mssqls_authentication $mssqls_linux_authent
ed_edit_clear
.ed_mainFrame.notebook select .ed_mainFrame.mainwin
set _ED(packagekeyname) "SQL Server TPC-C"
+if { !$mssqls_async_scale } {
+#REGULAR TIMED SCRIPT
.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
#EDITABLE OPTIONS##################################################
set library $library ;# SQL Server Library
@@ -2348,14 +2401,10 @@ switch $myposition {
1 {
if { $mode eq "Local" || $mode eq "Master" } {
set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $database ]
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
-database connect odbc $connection
-if {!$azure} {odbc "use $database"}
-odbc set autocommit on
+if {!$azure} { odbc evaldirect "use $database" }
}
set ramptime 0
puts "Beginning rampup time of $rampup minutes"
@@ -2369,13 +2418,17 @@ puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
}
if { [ tsv::get application abort ] } { break }
puts "Rampup complete, Taking start Transaction Count."
-if {[catch {set start_nopm [ odbc "select sum(d_next_o_id) from district" ]}]} {
-puts stderr {error, failed to query district table}
-return
+if {[catch {set rows [ odbc allrows "select sum(d_next_o_id) from district" ]} message ]} {
+error "Failed to query district table : $message"
+} else {
+set start_nopm [ lindex {*}$rows 1 ]
+unset -nocomplain rows
}
-if {[catch {set start_trans [ odbc "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]}]} {
-puts stderr {error, failed to query transaction statistics}
-return
+if {[catch {set rows [ odbc allrows "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]} message ]} {
+error "Failed to query transaction statistics : $message"
+} else {
+set start_trans [ lindex {*}$rows 1 ]
+unset -nocomplain rows
}
puts "Timing test period of $duration in minutes"
set testtime 0
@@ -2390,23 +2443,27 @@ puts -nonewline "[ expr $testtime / 60000 ] ...,"
}
if { [ tsv::get application abort ] } { break }
puts "Test complete, Taking end Transaction Count."
-if {[catch {set end_nopm [ odbc "select sum(d_next_o_id) from district" ]}]} {
-puts stderr {error, failed to query district table}
-return
+if {[catch {set rows [ odbc allrows "select sum(d_next_o_id) from district" ]} message ]} {
+error "Failed to query district table : $message"
+} else {
+set end_nopm [ lindex {*}$rows 1 ]
+unset -nocomplain rows
}
-if {[catch {set end_trans [ odbc "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]}]} {
-puts stderr {error, failed to query transaction statistics}
-return
+if {[catch {set rows [ odbc allrows "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]} message ]} {
+error "Failed to query transaction statistics : $message"
+} else {
+set end_trans [ lindex {*}$rows 1 ]
+unset -nocomplain rows
}
if { [ string is entier -strict $end_trans ] && [ string is entier -strict $start_trans ] } {
if { $start_trans < $end_trans } {
set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
} else {
-puts "Error: SQL Server returned end transaction count data greater than start data"
+puts "Warning: SQL Server returned end transaction count data greater than start data"
set tpm 0
}
} else {
-puts "Error: SQL Server returned non-numeric transaction count data"
+puts "Warning: SQL Server returned non-numeric transaction count data"
set tpm 0
}
set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
@@ -2416,15 +2473,13 @@ tsv::set application abort 1
if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
if { $CHECKPOINT } {
puts "Checkpoint"
-if [catch {odbc "checkpoint"} message ] {
-puts stderr {error, failed to execute checkpoint}
-error message
-return
- }
+if [catch {odbc evaldirect "checkpoint"} message ] {
+error "Failed to execute checkpoint : $message"
+ } else {
puts "Checkpoint Complete"
}
-odbc commit
-odbc disconnect
+ }
+odbc close
} else {
puts "Operating in Slave Mode, No Snapshots taken..."
}
@@ -2445,20 +2500,25 @@ set no_c_id [ RandomNumber 1 3000 ]
set ol_cnt [ RandomNumber 5 15 ]
#2.4.1.6 order entry date O_ENTRY_D generated by SUT
set date [ gettimestamp ]
-if {[ catch {neword_st execute [ list $no_w_id $w_id_input $no_d_id $no_c_id $ol_cnt $date ]} message]} {
+if {[catch {set resultset [ $neword_st execute [ list no_w_id $no_w_id w_id_input $w_id_input no_d_id $no_d_id no_c_id $no_c_id ol_cnt $ol_cnt date $date ]]} message ]} {
+ if { $RAISEERROR } {
+error "New Order Bind/Exec : $message"
+ } else {
+puts "New Order Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set norows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "New Order : $message"
+error "New Order Fetch : $message"
} else {
-puts $message
-} } else {
-neword_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
-}
-;
-}
-odbc commit
+puts "New Order Fetch : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
}
+
#PAYMENT
proc payment { payment_st p_w_id w_id_input RAISEERROR } {
#2.5.1.1 The home warehouse id remains the same for each terminal
@@ -2495,20 +2555,25 @@ set p_h_amount [ RandomNumber 1 5000 ]
#2.5.1.4 date selected from SUT
set h_date [ gettimestamp ]
#2.5.2.1 Payment Transaction
-if {[ catch {payment_st execute [ list $p_w_id $p_d_id $p_c_w_id $p_c_d_id $p_c_id $byname $p_h_amount $name $h_date ]} message]} {
+if {[catch {set resultset [ $payment_st execute [ list p_w_id $p_w_id p_d_id $p_d_id p_c_w_id $p_c_w_id p_c_d_id $p_c_d_id p_c_id $p_c_id byname $byname p_h_amount $p_h_amount name $name h_date $h_date ] ]} message ]} {
+ if { $RAISEERROR } {
+error "Payment Bind/Exec : $message"
+ } else {
+puts "Payment Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set pyrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "Payment : $message"
+error "Payment Fetch : $message"
} else {
-puts $message
-} } else {
-payment_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
-}
-;
-}
-odbc commit
+puts "Payment Fetch : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
}
+
#ORDER_STATUS
proc ostat { ostat_st w_id RAISEERROR } {
#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
@@ -2523,96 +2588,137 @@ set byname 1
set byname 0
set name {}
}
-if {[ catch {ostat_st execute [ list $w_id $d_id $c_id $byname $name ]} message]} {
+if {[catch {set resultset [ $ostat_st execute [ list os_w_id $w_id os_d_id $d_id os_c_id $c_id byname $byname os_c_last $name ]]} message ]} {
+ if { $RAISEERROR } {
+error "Order Status Bind/Exec : $message"
+ } else {
+puts "Order Status Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set osrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "Order Status : $message"
+error "Order Status Fetch : $message"
} else {
-puts $message
-} } else {
-ostat_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
-}
-;
-}
-odbc commit
+puts "Order Status Fetch : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
}
+
#DELIVERY
proc delivery { delivery_st w_id RAISEERROR } {
set carrier_id [ RandomNumber 1 10 ]
set date [ gettimestamp ]
-if {[ catch {delivery_st execute [ list $w_id $carrier_id $date ]} message]} {
+if {[catch {set resultset [ $delivery_st execute [ list d_w_id $w_id d_o_carrier_id $carrier_id timestamp $date ]]} message ]} {
+ if { $RAISEERROR } {
+error "Delivery Bind/Exec : $message"
+ } else {
+puts "Delivery Bind/Exec : $message"
+ }
+ } else {
+if {[catch {set dlrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
if { $RAISEERROR } {
-error "Delivery : $message"
+error "Delivery Fetch : $message"
} else {
-puts $message
-} } else {
-delivery_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
-}
-;
-}
-odbc commit
+puts "Delivery Fetch : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
}
+
#STOCK LEVEL
proc slev { slev_st w_id stock_level_d_id RAISEERROR } {
set threshold [ RandomNumber 10 20 ]
-if {[ catch {slev_st execute [ list $w_id $stock_level_d_id $threshold ]} message]} {
-if { $RAISEERROR } {
+if {[catch {set resultset [ $slev_st execute [ list st_w_id $w_id st_d_id $stock_level_d_id threshold $threshold ]]} message ]} {
+ if { $RAISEERROR } {
error "Stock Level : $message"
} else {
-puts $message
-} } else {
-slev_st fetch op_params
-foreach or [array names op_params] {
-lappend oput $op_params($or)
+puts "Stock Level : $message"
}
-;
-}
-odbc commit
+ } else {
+if {[catch {set slrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "Stock Level Fetch : $message"
+ } else {
+puts "Stock Level Fetch : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
}
+
proc prep_statement { odbc statement_st } {
switch $statement_st {
slev_st {
-odbc statement slev_st "EXEC slev @st_w_id = ?, @st_d_id = ?, @threshold = ?" {INTEGER INTEGER INTEGER}
-return slev_st
- }
+set slev_st [ $odbc prepare "EXEC slev @st_w_id = :st_w_id, @st_d_id = :st_d_id, @threshold = :threshold" ]
+$slev_st paramtype st_w_id in integer 10 0
+$slev_st paramtype st_d_id in integer 10 0
+$slev_st paramtype threshold in integer 10 0
+return $slev_st
+}
+
delivery_st {
-odbc statement delivery_st "EXEC delivery @d_w_id = ?, @d_o_carrier_id = ?, @timestamp = ?" {INTEGER INTEGER TIMESTAMP}
-return delivery_st
+set delivery_st [ $odbc prepare "EXEC delivery @d_w_id = :d_w_id, @d_o_carrier_id = :d_o_carrier_id, @timestamp = :timestamp" ]
+$delivery_st paramtype d_w_id in integer 10 0
+$delivery_st paramtype d_o_carrier_id in integer 10 0
+$delivery_st paramtype timestamp in timestamp 19 0
+return $delivery_st
}
ostat_st {
-odbc statement ostat_st "EXEC ostat @os_w_id = ?, @os_d_id = ?, @os_c_id = ?, @byname = ?, @os_c_last = ?" {INTEGER INTEGER INTEGER INTEGER {CHAR 16}}
-return ostat_st
+set ostat_st [ $odbc prepare "EXEC ostat @os_w_id = :os_w_id, @os_d_id = :os_d_id, @os_c_id = :os_c_id, @byname = :byname, @os_c_last = :os_c_last" ]
+$ostat_st paramtype os_w_id in integer 10 0
+$ostat_st paramtype os_d_id in integer 10 0
+$ostat_st paramtype os_c_id in integer 10 0
+$ostat_st paramtype byname in integer 10 0
+$ostat_st paramtype os_c_last in char 20 0
+return $ostat_st
}
payment_st {
-odbc statement payment_st "EXEC payment @p_w_id = ?, @p_d_id = ?, @p_c_w_id = ?, @p_c_d_id = ?, @p_c_id = ?, @byname = ?, @p_h_amount = ?, @p_c_last = ?, @TIMESTAMP =?" {INTEGER INTEGER INTEGER INTEGER INTEGER INTEGER INTEGER {CHAR 16} TIMESTAMP}
-return payment_st
+set payment_st [ $odbc prepare "EXEC payment @p_w_id = :p_w_id, @p_d_id = :p_d_id, @p_c_w_id = :p_c_w_id, @p_c_d_id = :p_c_d_id, @p_c_id = :p_c_id, @byname = :byname, @p_h_amount = :p_h_amount, @p_c_last = :name, @TIMESTAMP =:h_date" ]
+$payment_st paramtype p_w_id in integer 10 0
+$payment_st paramtype p_d_id in integer 10 0
+$payment_st paramtype p_c_w_id in integer 10 0
+$payment_st paramtype p_c_d_id in integer 10 0
+$payment_st paramtype p_c_id in integer 10 0
+$payment_st paramtype byname in integer 10 0
+$payment_st paramtype p_h_amount in numeric 6 2
+$payment_st paramtype name in char 16 0
+$payment_st paramtype h_date in timestamp 19 0
+return $payment_st
}
neword_st {
-odbc statement neword_st "EXEC neword @no_w_id = ?, @no_max_w_id = ?, @no_d_id = ?, @no_c_id = ?, @no_o_ol_cnt = ?, @TIMESTAMP = ?" {INTEGER INTEGER INTEGER INTEGER INTEGER TIMESTAMP}
-return neword_st
+set neword_st [ $odbc prepare "EXEC neword @no_w_id = :no_w_id, @no_max_w_id = :w_id_input, @no_d_id = :no_d_id, @no_c_id = :no_c_id, @no_o_ol_cnt = :ol_cnt, @TIMESTAMP = :date" ]
+$neword_st paramtype no_w_id in integer 10 0
+$neword_st paramtype w_id_input in integer 10 0
+$neword_st paramtype no_d_id in integer 10 0
+$neword_st paramtype no_c_id in integer 10 0
+$neword_st paramtype ol_cnt integer 10 0
+$neword_st paramtype date in timestamp 19 0
+return $neword_st
}
}
}
#RUN TPC-C
set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $database ]
-if [catch {database connect odbc $connection} message ] {
-puts stderr "Error: the database connection to $connection could not be established"
-error $message
-return
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
} else {
-database connect odbc $connection
-if {!$azure} {odbc "use $database"}
-odbc set autocommit off
+if {!$azure} { odbc evaldirect "use $database" }
+odbc evaldirect "set implicit_transactions OFF"
}
foreach st {neword_st payment_st ostat_st delivery_st slev_st} { set $st [ prep_statement odbc $st ] }
-set w_id_input [ odbc "select max(w_id) from warehouse" ]
+set rows [ odbc allrows "select max(w_id) from warehouse" ]
+set w_id_input [ lindex {*}$rows 1 ]
#2.4.1.1 set warehouse_id stays constant for a given terminal
set w_id [ RandomNumber 1 $w_id_input ]
-set d_id_input [ odbc "select max(d_id) from district" ]
+set rows [ odbc allrows "select max(d_id) from district" ]
+set d_id_input [ lindex {*}$rows 1 ]
set stock_level_d_id [ RandomNumber 1 $d_id_input ]
puts "Processing $total_iterations transactions with output suppressed..."
set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
@@ -2621,33 +2727,474 @@ if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application ab
set choice [ RandomNumber 1 23 ]
if {$choice <= 10} {
if { $KEYANDTHINK } { keytime 18 }
-neword neword_st $w_id $w_id_input $RAISEERROR
+neword $neword_st $w_id $w_id_input $RAISEERROR
if { $KEYANDTHINK } { thinktime 12 }
} elseif {$choice <= 20} {
if { $KEYANDTHINK } { keytime 3 }
-payment payment_st $w_id $w_id_input $RAISEERROR
+payment $payment_st $w_id $w_id_input $RAISEERROR
if { $KEYANDTHINK } { thinktime 12 }
} elseif {$choice <= 21} {
if { $KEYANDTHINK } { keytime 2 }
-delivery delivery_st $w_id $RAISEERROR
+delivery $delivery_st $w_id $RAISEERROR
if { $KEYANDTHINK } { thinktime 10 }
} elseif {$choice <= 22} {
if { $KEYANDTHINK } { keytime 2 }
-slev slev_st $w_id $stock_level_d_id $RAISEERROR
+slev $slev_st $w_id $stock_level_d_id $RAISEERROR
if { $KEYANDTHINK } { thinktime 5 }
} elseif {$choice <= 23} {
if { $KEYANDTHINK } { keytime 2 }
-ostat ostat_st $w_id $RAISEERROR
+ostat $ostat_st $w_id $RAISEERROR
if { $KEYANDTHINK } { thinktime 5 }
}
}
-odbc commit
-neword_st drop
-payment_st drop
-delivery_st drop
-slev_st drop
-ostat_st drop
-odbc disconnect
- }
+$neword_st close
+$payment_st close
+$delivery_st close
+$slev_st close
+$ostat_st close
+odbc close
+ }
}}
+} else {
+#ASYNCHRONOUS TIMED SCRIPT
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
+#EDITABLE OPTIONS##################################################
+set library $library ;# SQL Server Library
+set version $version ;# SQL Server Library Version
+set total_iterations $mssqls_total_iterations;# Number of transactions before logging off
+set RAISEERROR \"$mssqls_raiseerror\" ;# Exit script on SQL Server error (true or false)
+set KEYANDTHINK \"$mssqls_keyandthink\" ;# Time for user thinking and keying (true or false)
+set CHECKPOINT \"$mssqls_checkpoint\" ;# Perform SQL Server checkpoint when complete (true or false)
+set rampup $mssqls_rampup; # Rampup time in minutes before first Transaction Count is taken
+set duration $mssqls_duration; # Duration in minutes before second Transaction Count is taken
+set mode \"$opmode\" ;# HammerDB operational mode
+set authentication \"$mssqls_authentication\";# Authentication Mode (WINDOWS or SQL)
+set server \{$mssqls_server\};# Microsoft SQL Server Database Server
+set port \"$mssqls_port\";# Microsoft SQL Server Port
+set odbc_driver \{$mssqls_odbc_driver\};# ODBC Driver
+set uid \"$mssqls_uid\";#User ID for SQL Server Authentication
+set pwd \"$mssqls_pass\";#Password for SQL Server Authentication
+set tcp \"$mssqls_tcp\";#Specify TCP Protocol
+set azure \"$mssqls_azure\";#Azure Type Connection
+set database \"$mssqls_dbase\";# Database containing the TPC Schema
+set async_client $mssqls_async_client;# Number of asynchronous clients per Vuser
+set async_verbose $mssqls_async_verbose;# Report activity of asynchronous clients
+set async_delay $mssqls_async_delay;# Delay in ms between logins of asynchronous clients
+#EDITABLE OPTIONS##################################################
+"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end {#LOAD LIBRARIES AND MODULES
+if [catch {package require $library $version} message] { error "Failed to load $library - $message" }
+if [catch {::tcl::tm::path add modules} ] { error "Failed to find modules directory" }
+if [catch {package require tpcccommon} ] { error "Failed to load tpcc common functions" } else { namespace import tpcccommon::* }
+if [catch {package require promise } message] { error "Failed to load promise package for asynchronous clients" }
+
+if { [ chk_thread ] eq "FALSE" } {
+error "SQL Server Timed Script must be run in Thread Enabled Interpreter"
+}
+
+proc connect_string { server port odbc_driver authentication uid pwd tcp azure db } {
+if { $tcp eq "true" } { set server tcp:$server,$port }
+if {[ string toupper $authentication ] eq "WINDOWS" } {
+set connection "DRIVER=$odbc_driver;SERVER=$server;TRUSTED_CONNECTION=YES"
+} else {
+if {[ string toupper $authentication ] eq "SQL" } {
+set connection "DRIVER=$odbc_driver;SERVER=$server;UID=$uid;PWD=$pwd"
+ } else {
+puts stderr "Error: neither WINDOWS or SQL Authentication has been specified"
+set connection "DRIVER=$odbc_driver;SERVER=$server"
+ }
+}
+if { $azure eq "true" } { append connection ";" "DATABASE=$db" }
+return $connection
+}
+
+set rema [ lassign [ findvuposition ] myposition totalvirtualusers ]
+switch $myposition {
+1 {
+if { $mode eq "Local" || $mode eq "Master" } {
+set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $database ]
+if [catch {tdbc::odbc::connection create odbc $connection} message ] {
+error "Connection to $connection could not be established : $message"
+} else {
+if {!$azure} { odbc evaldirect "use $database" }
+}
+set ramptime 0
+puts "Beginning rampup time of $rampup minutes"
+set rampup [ expr $rampup*60000 ]
+while {$ramptime != $rampup} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set ramptime [ expr $ramptime+6000 ]
+if { ![ expr {$ramptime % 60000} ] } {
+puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Rampup complete, Taking start Transaction Count."
+if {[catch {set rows [ odbc allrows "select sum(d_next_o_id) from district" ]} message ]} {
+error "Failed to query district table : $message"
+} else {
+set start_nopm [ lindex {*}$rows 1 ]
+unset -nocomplain rows
+}
+if {[catch {set rows [ odbc allrows "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]} message ]} {
+error "Failed to query transaction statistics : $message"
+} else {
+set start_trans [ lindex {*}$rows 1 ]
+unset -nocomplain rows
+}
+puts "Timing test period of $duration in minutes"
+set testtime 0
+set durmin $duration
+set duration [ expr $duration*60000 ]
+while {$testtime != $duration} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set testtime [ expr $testtime+6000 ]
+if { ![ expr {$testtime % 60000} ] } {
+puts -nonewline "[ expr $testtime / 60000 ] ...,"
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Test complete, Taking end Transaction Count."
+if {[catch {set rows [ odbc allrows "select sum(d_next_o_id) from district" ]} message ]} {
+error "Failed to query district table : $message"
+} else {
+set end_nopm [ lindex {*}$rows 1 ]
+unset -nocomplain rows
+}
+if {[catch {set rows [ odbc allrows "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]} message ]} {
+error "Failed to query transaction statistics : $message"
+} else {
+set end_trans [ lindex {*}$rows 1 ]
+unset -nocomplain rows
+}
+if { [ string is entier -strict $end_trans ] && [ string is entier -strict $start_trans ] } {
+if { $start_trans < $end_trans } {
+set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
+ } else {
+puts "Warning: SQL Server returned end transaction count data greater than start data"
+set tpm 0
+ }
+} else {
+puts "Warning: SQL Server returned non-numeric transaction count data"
+set tpm 0
+ }
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm SQL Server TPM at $nopm NOPM"
+tsv::set application abort 1
+if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
+if { $CHECKPOINT } {
+puts "Checkpoint"
+if [catch {odbc evaldirect "checkpoint"} message ] {
+error "Failed to execute checkpoint : $message"
+ } else {
+puts "Checkpoint Complete"
+ }
+ }
+odbc close
+ } else {
+puts "Operating in Slave Mode, No Snapshots taken..."
+ }
+ }
+default {
+#TIMESTAMP
+proc gettimestamp { } {
+set tstamp [ clock format [ clock seconds ] -format "%Y-%m-%d %H:%M:%S" ]
+return $tstamp
+}
+#NEW ORDER
+proc neword { neword_st no_w_id w_id_input RAISEERROR clientname } {
+#2.4.1.2 select district id randomly from home warehouse where d_w_id = d_id
+set no_d_id [ RandomNumber 1 10 ]
+#2.4.1.2 Customer id randomly selected where c_d_id = d_id and c_w_id = w_id
+set no_c_id [ RandomNumber 1 3000 ]
+#2.4.1.3 Items in the order randomly selected from 5 to 15
+set ol_cnt [ RandomNumber 5 15 ]
+#2.4.1.6 order entry date O_ENTRY_D generated by SUT
+set date [ gettimestamp ]
+if {[catch {set resultset [ $neword_st execute [ list no_w_id $no_w_id w_id_input $w_id_input no_d_id $no_d_id no_c_id $no_c_id ol_cnt $ol_cnt date $date ]]} message ]} {
+ if { $RAISEERROR } {
+error "New Order Bind/Exec in $clientname : $message"
+ } else {
+puts "New Order Bind/Exec in $clientname : $message"
+ }
+ } else {
+if {[catch {set norows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "New Order Fetch in $clientname : $message"
+ } else {
+puts "New Order Fetch in $clientname : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
+}
+
+#PAYMENT
+proc payment { payment_st p_w_id w_id_input RAISEERROR clientname } {
+#2.5.1.1 The home warehouse id remains the same for each terminal
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set p_d_id [ RandomNumber 1 10 ]
+#2.5.1.2 customer selected 60% of time by name and 40% of time by number
+set x [ RandomNumber 1 100 ]
+set y [ RandomNumber 1 100 ]
+if { $x <= 85 } {
+set p_c_d_id $p_d_id
+set p_c_w_id $p_w_id
+} else {
+#use a remote warehouse
+set p_c_d_id [ RandomNumber 1 10 ]
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+while { ($p_c_w_id == $p_w_id) && ($w_id_input != 1) } {
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+ }
+}
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set p_c_id [ RandomNumber 1 3000 ]
+if { $y <= 60 } {
+#use customer name
+#C_LAST is generated
+set byname 1
+ } else {
+#use customer number
+set byname 0
+set name {}
+ }
+#2.5.1.3 random amount from 1 to 5000
+set p_h_amount [ RandomNumber 1 5000 ]
+#2.5.1.4 date selected from SUT
+set h_date [ gettimestamp ]
+#2.5.2.1 Payment Transaction
+if {[catch {set resultset [ $payment_st execute [ list p_w_id $p_w_id p_d_id $p_d_id p_c_w_id $p_c_w_id p_c_d_id $p_c_d_id p_c_id $p_c_id byname $byname p_h_amount $p_h_amount name $name h_date $h_date ] ]} message ]} {
+ if { $RAISEERROR } {
+error "Payment Bind/Exec in $clientname : $message"
+ } else {
+puts "Payment Bind/Exec in $clientname : $message"
+ }
+ } else {
+if {[catch {set pyrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "Payment Fetch in $clientname : $message"
+ } else {
+puts "Payment Fetch in $clientname : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
+}
+
+#ORDER_STATUS
+proc ostat { ostat_st w_id RAISEERROR clientname } {
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set d_id [ RandomNumber 1 10 ]
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set c_id [ RandomNumber 1 3000 ]
+set y [ RandomNumber 1 100 ]
+if { $y <= 60 } {
+set byname 1
+ } else {
+set byname 0
+set name {}
+}
+if {[catch {set resultset [ $ostat_st execute [ list os_w_id $w_id os_d_id $d_id os_c_id $c_id byname $byname os_c_last $name ]]} message ]} {
+ if { $RAISEERROR } {
+error "Order Status Bind/Exec in $clientname : $message"
+ } else {
+puts "Order Status Bind/Exec in $clientname : $message"
+ }
+ } else {
+if {[catch {set osrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "Order Status Fetch in $clientname : $message"
+ } else {
+puts "Order Status Fetch in $clientname : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
+}
+
+#DELIVERY
+proc delivery { delivery_st w_id RAISEERROR clientname } {
+set carrier_id [ RandomNumber 1 10 ]
+set date [ gettimestamp ]
+if {[catch {set resultset [ $delivery_st execute [ list d_w_id $w_id d_o_carrier_id $carrier_id timestamp $date ]]} message ]} {
+ if { $RAISEERROR } {
+error "Delivery Bind/Exec in $clientname : $message"
+ } else {
+puts "Delivery Bind/Exec in $clientname : $message"
+ }
+ } else {
+if {[catch {set dlrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "Delivery Fetch in $clientname : $message"
+ } else {
+puts "Delivery Fetch in $clientname : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
+}
+
+#STOCK LEVEL
+proc slev { slev_st w_id stock_level_d_id RAISEERROR clientname } {
+set threshold [ RandomNumber 10 20 ]
+if {[catch {set resultset [ $slev_st execute [ list st_w_id $w_id st_d_id $stock_level_d_id threshold $threshold ]]} message ]} {
+ if { $RAISEERROR } {
+error "Stock Level in $clientname : $message"
+ } else {
+puts "Stock Level in $clientname : $message"
+ }
+ } else {
+if {[catch {set slrows [ $resultset allrows ]} message ]} {
+catch {$resultset close}
+if { $RAISEERROR } {
+error "Stock Level Fetch in $clientname : $message"
+ } else {
+puts "Stock Level Fetch in $clientname : $message"
+ }} else {
+catch {$resultset close}
+ }
+ }
+}
+
+proc prep_statement { odbc statement_st } {
+switch $statement_st {
+slev_st {
+set slev_st [ $odbc prepare "EXEC slev @st_w_id = :st_w_id, @st_d_id = :st_d_id, @threshold = :threshold" ]
+$slev_st paramtype st_w_id in integer 10 0
+$slev_st paramtype st_d_id in integer 10 0
+$slev_st paramtype threshold in integer 10 0
+return $slev_st
+}
+
+delivery_st {
+set delivery_st [ $odbc prepare "EXEC delivery @d_w_id = :d_w_id, @d_o_carrier_id = :d_o_carrier_id, @timestamp = :timestamp" ]
+$delivery_st paramtype d_w_id in integer 10 0
+$delivery_st paramtype d_o_carrier_id in integer 10 0
+$delivery_st paramtype timestamp in timestamp 19 0
+return $delivery_st
+ }
+ostat_st {
+set ostat_st [ $odbc prepare "EXEC ostat @os_w_id = :os_w_id, @os_d_id = :os_d_id, @os_c_id = :os_c_id, @byname = :byname, @os_c_last = :os_c_last" ]
+$ostat_st paramtype os_w_id in integer 10 0
+$ostat_st paramtype os_d_id in integer 10 0
+$ostat_st paramtype os_c_id in integer 10 0
+$ostat_st paramtype byname in integer 10 0
+$ostat_st paramtype os_c_last in char 20 0
+return $ostat_st
+ }
+payment_st {
+set payment_st [ $odbc prepare "EXEC payment @p_w_id = :p_w_id, @p_d_id = :p_d_id, @p_c_w_id = :p_c_w_id, @p_c_d_id = :p_c_d_id, @p_c_id = :p_c_id, @byname = :byname, @p_h_amount = :p_h_amount, @p_c_last = :name, @TIMESTAMP =:h_date" ]
+$payment_st paramtype p_w_id in integer 10 0
+$payment_st paramtype p_d_id in integer 10 0
+$payment_st paramtype p_c_w_id in integer 10 0
+$payment_st paramtype p_c_d_id in integer 10 0
+$payment_st paramtype p_c_id in integer 10 0
+$payment_st paramtype byname in integer 10 0
+$payment_st paramtype p_h_amount in numeric 6 2
+$payment_st paramtype name in char 16 0
+$payment_st paramtype h_date in timestamp 19 0
+return $payment_st
+ }
+neword_st {
+set neword_st [ $odbc prepare "EXEC neword @no_w_id = :no_w_id, @no_max_w_id = :w_id_input, @no_d_id = :no_d_id, @no_c_id = :no_c_id, @no_o_ol_cnt = :ol_cnt, @TIMESTAMP = :date" ]
+$neword_st paramtype no_w_id in integer 10 0
+$neword_st paramtype w_id_input in integer 10 0
+$neword_st paramtype no_d_id in integer 10 0
+$neword_st paramtype no_c_id in integer 10 0
+$neword_st paramtype ol_cnt integer 10 0
+$neword_st paramtype date in timestamp 19 0
+return $neword_st
+ }
+ }
+}
+
+#RUN TPC-C
+promise::async simulate_client { clientname total_iterations connection RAISEERROR KEYANDTHINK database azure async_verbose async_delay } {
+set acno [ expr [ string trimleft [ lindex [ split $clientname ":" ] 1 ] ac ] * $async_delay ]
+if { $async_verbose } { puts "Delaying login of $clientname for $acno ms" }
+async_time $acno
+if { [ tsv::get application abort ] } { return "$clientname:abort before login" }
+if { $async_verbose } { puts "Logging in $clientname" }
+if [catch {tdbc::odbc::connection create odbc-$acno $connection} message ] {
+if { $RAISEERROR } {
+puts "$clientname:login failed:$message"
+return "$clientname:login failed:$message"
+ }
+ } else {
+if { $async_verbose } { puts "Connected $clientname:$connection" }
+if {!$azure} { odbc-$acno evaldirect "use $database" }
+odbc-$acno evaldirect "set implicit_transactions OFF"
+ }
+foreach st {neword_st payment_st ostat_st delivery_st slev_st} { set $st [ prep_statement odbc-$acno $st ] }
+set rows [ odbc-$acno allrows "select max(w_id) from warehouse" ]
+set w_id_input [ lindex {*}$rows 1 ]
+#2.4.1.1 set warehouse_id stays constant for a given terminal
+set w_id [ RandomNumber 1 $w_id_input ]
+set rows [ odbc-$acno allrows "select max(d_id) from district" ]
+set d_id_input [ lindex {*}$rows 1 ]
+set stock_level_d_id [ RandomNumber 1 $d_id_input ]
+if { $async_verbose } { puts "Processing $total_iterations transactions with output suppressed..." }
+set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
+for {set it 0} {$it < $total_iterations} {incr it} {
+if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
+set choice [ RandomNumber 1 23 ]
+if {$choice <= 10} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:neword" }
+if { $KEYANDTHINK } { async_keytime 18 $clientname neword $async_verbose }
+neword $neword_st $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname neword $async_verbose }
+} elseif {$choice <= 20} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:payment" }
+if { $KEYANDTHINK } { async_keytime 3 $clientname payment $async_verbose }
+payment $payment_st $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname payment $async_verbose }
+} elseif {$choice <= 21} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:delivery" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname delivery $async_verbose }
+delivery $delivery_st $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 10 $clientname delivery $async_verbose }
+} elseif {$choice <= 22} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:slev" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname slev $async_verbose }
+slev $slev_st $w_id $stock_level_d_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname slev $async_verbose }
+} elseif {$choice <= 23} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:ostat" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname ostat $async_verbose }
+ostat $ostat_st $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname ostat $async_verbose }
+ }
+}
+$neword_st close
+$payment_st close
+$delivery_st close
+$slev_st close
+$ostat_st close
+odbc-$acno close
+if { $async_verbose } { puts "$clientname:complete" }
+return $clientname:complete
+ }
+set connection [ connect_string $server $port $odbc_driver $authentication $uid $pwd $tcp $azure $database ]
+for {set ac 1} {$ac <= $async_client} {incr ac} {
+set clientdesc "vuser$myposition:ac$ac"
+lappend clientlist $clientdesc
+lappend clients [simulate_client $clientdesc $total_iterations $connection $RAISEERROR $KEYANDTHINK $database $azure $async_verbose $async_delay]
+ }
+puts "Started asynchronous clients:$clientlist"
+set acprom [ promise::eventloop [ promise::all $clients ] ]
+puts "All asynchronous clients complete"
+if { $async_verbose } {
+foreach client $acprom { puts $client }
+ }
+ }
+}}
+}
}
diff --git a/src/mssqlserver/mssqlsopt.tcl b/src/mssqlserver/mssqlsopt.tcl
index b9a454f8..a59259c2 100755
--- a/src/mssqlserver/mssqlsopt.tcl
+++ b/src/mssqlserver/mssqlsopt.tcl
@@ -173,7 +173,7 @@ upvar #0 icons icons
upvar #0 configmssqlserver configmssqlserver
#set variables to values in dict
setlocaltpccvars $configmssqlserver
-set tpccfields [ dict create tpcc {mssqls_dbase {.tpc.f1.e6 get} mssqls_bucket {.tpc.f1.e8 get} mssqls_total_iterations {.tpc.f1.e14 get} mssqls_rampup {.tpc.f1.e18 get} mssqls_duration {.tpc.f1.e19 get} mssqls_imdb $mssqls_imdb mssqls_durability $mssqls_durability mssqls_count_ware $mssqls_count_ware mssqls_num_vu $mssqls_num_vu mssqls_driver $mssqls_driver mssqls_raiseerror $mssqls_raiseerror mssqls_keyandthink $mssqls_keyandthink mssqls_checkpoint $mssqls_checkpoint mssqls_allwarehouse $mssqls_allwarehouse mssqls_timeprofile $mssqls_timeprofile} ]
+set tpccfields [ dict create tpcc {mssqls_dbase {.tpc.f1.e6 get} mssqls_bucket {.tpc.f1.e8 get} mssqls_total_iterations {.tpc.f1.e14 get} mssqls_rampup {.tpc.f1.e18 get} mssqls_duration {.tpc.f1.e19 get} mssqls_async_client {.tpc.f1.e23 get} mssqls_async_delay {.tpc.f1.e24 get} mssqls_imdb $mssqls_imdb mssqls_durability $mssqls_durability mssqls_count_ware $mssqls_count_ware mssqls_num_vu $mssqls_num_vu mssqls_driver $mssqls_driver mssqls_raiseerror $mssqls_raiseerror mssqls_keyandthink $mssqls_keyandthink mssqls_checkpoint $mssqls_checkpoint mssqls_allwarehouse $mssqls_allwarehouse mssqls_timeprofile $mssqls_timeprofile mssqls_async_scale $mssqls_async_scale mssqls_async_verbose $mssqls_async_verbose} ]
if {![string match windows $::tcl_platform(platform)]} {
set platform "lin"
set mssqlsconn [ dict create connection { mssqls_linux_server {.tpc.f1.e1 get} mssqls_port {.tpc.f1.e2 get} mssqls_linux_odbc {.tpc.f1.e3 get} mssqls_uid {.tpc.f1.e4 get} mssqls_pass {.tpc.f1.e5 get} mssqls_tcp $mssqls_tcp mssqls_azure $mssqls_azure mssqls_linux_authent $mssqls_linux_authent} ]
@@ -399,11 +399,17 @@ bind .tpc.f1.r3 {
set mssqls_checkpoint "false"
set mssqls_allwarehouse "false"
set mssqls_timeprofile "false"
+set mssqls_async_scale "false"
+set mssqls_async_verbose "false"
.tpc.f1.e17 configure -state disabled
.tpc.f1.e18 configure -state disabled
.tpc.f1.e19 configure -state disabled
.tpc.f1.e20 configure -state disabled
.tpc.f1.e21 configure -state disabled
+.tpc.f1.e22 configure -state disabled
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
}
set Name $Parent.f1.r4
ttk::radiobutton $Name -value "timed" -text "Timed Driver Script" -variable mssqls_driver
@@ -414,6 +420,12 @@ bind .tpc.f1.r4 {
.tpc.f1.e19 configure -state normal
.tpc.f1.e20 configure -state normal
.tpc.f1.e21 configure -state normal
+.tpc.f1.e22 configure -state normal
+if { $mssqls_async_scale eq "true" } {
+.tpc.f1.e23 configure -state normal
+.tpc.f1.e24 configure -state normal
+.tpc.f1.e25 configure -state normal
+ }
}
set Name $Parent.f1.e14
set Prompt $Parent.f1.p14
@@ -431,6 +443,17 @@ ttk::checkbutton $Name -text "" -variable mssqls_raiseerror -onvalue "true" -off
ttk::label $Prompt -text "Keying and Thinking Time :"
set Name $Parent.f1.e16
ttk::checkbutton $Name -text "" -variable mssqls_keyandthink -onvalue "true" -offvalue "false"
+bind .tpc.f1.e16 {
+if { $mssqls_driver eq "timed" } {
+if { $mssqls_keyandthink eq "true" } {
+set mssqls_async_scale "false"
+set mssqls_async_verbose "false"
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
+ }
+ }
+}
grid $Prompt -column 0 -row 22 -sticky e
grid $Name -column 1 -row 22 -sticky w
set Prompt $Parent.f1.p17
@@ -478,6 +501,59 @@ ttk::checkbutton $Name -text "" -variable mssqls_timeprofile -onvalue "true" -of
if {$mssqls_driver == "test" } {
$Name configure -state disabled
}
+ set Name $Parent.f1.e22
+ set Prompt $Parent.f1.p22
+ ttk::label $Prompt -text "Asynchronous Scaling :"
+ttk::checkbutton $Name -text "" -variable mssqls_async_scale -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 28 -sticky e
+ grid $Name -column 1 -row 28 -sticky ew
+if {$mssqls_driver == "test" } {
+ set mssqls_async_scale "false"
+ $Name configure -state disabled
+ }
+bind .tpc.f1.e22 {
+if { $mssqls_async_scale eq "true" } {
+set mssqls_async_verbose "false"
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
+ } else {
+if { $mssqls_driver eq "timed" } {
+set mssqls_keyandthink "true"
+.tpc.f1.e23 configure -state normal
+.tpc.f1.e24 configure -state normal
+.tpc.f1.e25 configure -state normal
+ }
+ }
+}
+set Name $Parent.f1.e23
+ set Prompt $Parent.f1.p23
+ ttk::label $Prompt -text "Asynch Clients per Virtual User :"
+ ttk::entry $Name -width 30 -textvariable mssqls_async_client
+ grid $Prompt -column 0 -row 29 -sticky e
+ grid $Name -column 1 -row 29 -sticky ew
+if {$mssqls_driver == "test" || $mssqls_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+set Name $Parent.f1.e24
+ set Prompt $Parent.f1.p24
+ ttk::label $Prompt -text "Asynch Client Login Delay :"
+ ttk::entry $Name -width 30 -textvariable mssqls_async_delay
+ grid $Prompt -column 0 -row 30 -sticky e
+ grid $Name -column 1 -row 30 -sticky ew
+if {$mssqls_driver == "test" || $mssqls_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+ set Name $Parent.f1.e25
+ set Prompt $Parent.f1.p25
+ ttk::label $Prompt -text "Asynchronous Verbose :"
+ttk::checkbutton $Name -text "" -variable mssqls_async_verbose -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 31 -sticky e
+ grid $Name -column 1 -row 31 -sticky ew
+if {$mssqls_driver == "test" || $mssqls_async_scale == "false" } {
+ set mssqls_async_verbose "false"
+ $Name configure -state disabled
+ }
}
#This is the Cancel button variables stay as before
set Name $Parent.b2
diff --git a/src/mssqlserver/mssqlsotc.tcl b/src/mssqlserver/mssqlsotc.tcl
index 5d4b5662..b5351106 100755
--- a/src/mssqlserver/mssqlsotc.tcl
+++ b/src/mssqlserver/mssqlsotc.tcl
@@ -3,7 +3,7 @@ global tc_threadID
upvar #0 dbdict dbdict
if {[dict exists $dbdict mssqlserver library ]} {
set library [ dict get $dbdict mssqlserver library ]
-} else { set library "tclodbc 2.5.2" }
+} else { set library "tdbc::odbc 1.0.6" }
if { [ llength $library ] > 1 } {
set version [ lindex $library 1 ]
set library [ lindex $library 0 ]
@@ -59,7 +59,7 @@ return
namespace import tcountcommon::*
}
set connection [ connect_string $mssqls_server $mssqls_port $mssqls_odbc_driver $mssqls_authentication $mssqls_uid $mssqls_pass $mssqls_tcp $mssqls_azure $db ]
-if {[catch {database connect tc_odbc $connection} message ]} {
+if [catch {tdbc::odbc::connection create tc_odbc $connection} message ] {
tsv::set application tc_errmsg "connection failed $message"
eval [subst {thread::send $MASTER show_tc_errmsg}]
thread::release
@@ -69,12 +69,13 @@ return
while { $timeout eq 0 } {
set timeout [ tsv::get application timeout ]
if { $timeout != 0 } { break }
-if {[catch {set tc_trans [ tc_odbc "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]} message]} {
+if {[catch {set rows [ tc_odbc allrows "select cntr_value from sys.dm_os_performance_counters where counter_name = 'Batch Requests/sec'" ]} message]} {
tsv::set application tc_errmsg "sql failed $message"
eval [subst {thread::send $MASTER show_tc_errmsg}]
-catch { tc_odbc disconnect }
+catch { tc_odbc close }
break
} else {
+set tc_trans [ lindex {*}$rows 1 ]
if { $bm eq "TPC-C" || $bm eq "TPC-H" } {
if { [ string is entier -strict $tc_trans ] } {
set outc $tc_trans
diff --git a/src/mysql/mysqloltp.tcl b/src/mysql/mysqloltp.tcl
index 5465eb05..7782c563 100755
--- a/src/mysql/mysqloltp.tcl
+++ b/src/mysql/mysqloltp.tcl
@@ -1229,8 +1229,9 @@ setlocaltpccvars $configmysql
ed_edit_clear
.ed_mainFrame.notebook select .ed_mainFrame.mainwin
set _ED(packagekeyname) "MySQL TPC-C Timed"
+if { !$mysql_async_scale } {
+#REGULAR TIMED SCRIPT
.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
-#THIS SCRIPT TO BE RUN WITH VIRTUAL USER OUTPUT ENABLED
#EDITABLE OPTIONS##################################################
set library $library ;# MySQL Library
global mysqlstatus
@@ -1499,4 +1500,315 @@ if { $KEYANDTHINK } { thinktime 5 }
mysqlclose $mysql_handler
}
}}
+} else {
+#ASYNCHRONOUS TIMED SCRIPT
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
+#EDITABLE OPTIONS##################################################
+set library $library ;# MySQL Library
+global mysqlstatus
+set total_iterations $mysql_total_iterations ;# Number of transactions before logging off
+set RAISEERROR \"$mysql_raiseerror\" ;# Exit script on MySQL error (true or false)
+set KEYANDTHINK \"$mysql_keyandthink\" ;# Time for user thinking and keying (true or false)
+set rampup $mysql_rampup; # Rampup time in minutes before first Transaction Count is taken
+set duration $mysql_duration; # Duration in minutes before second Transaction Count is taken
+set mode \"$opmode\" ;# HammerDB operational mode
+set host \"$mysql_host\" ;# Address of the server hosting MySQL
+set port \"$mysql_port\" ;# Port of the MySQL Server, defaults to 3306
+set user \"$mysql_user\" ;# MySQL user
+set password \"$mysql_pass\" ;# Password for the MySQL user
+set db \"$mysql_dbase\" ;# Database containing the TPC Schema
+set async_client $mysql_async_client;# Number of asynchronous clients per Vuser
+set async_verbose $mysql_async_verbose;# Report activity of asynchronous clients
+set async_delay $mysql_async_delay;# Delay in ms between logins of asynchronous clients
+#EDITABLE OPTIONS##################################################
+"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end {#LOAD LIBRARIES AND MODULES
+if [catch {package require $library} message] { error "Failed to load $library - $message" }
+if [catch {::tcl::tm::path add modules} ] { error "Failed to find modules directory" }
+if [catch {package require tpcccommon} ] { error "Failed to load tpcc common functions" } else { namespace import tpcccommon::* }
+if [catch {package require promise } message] { error "Failed to load promise package for asynchronous clients" }
+
+if { [ chk_thread ] eq "FALSE" } {
+error "MYSQL Timed Script must be run in Thread Enabled Interpreter"
+}
+set rema [ lassign [ findvuposition ] myposition totalvirtualusers ]
+switch $myposition {
+1 {
+if { $mode eq "Local" || $mode eq "Master" } {
+if [catch {mysqlconnect -host $host -port $port -user $user -password $password} mysql_handler] {
+puts "the database connection to $host could not be established"
+error $mysqlstatus(message)
+ } else {
+mysqluse $mysql_handler $db
+mysql::autocommit $mysql_handler 1
+}
+set ramptime 0
+puts "Beginning rampup time of $rampup minutes"
+set rampup [ expr $rampup*60000 ]
+while {$ramptime != $rampup} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set ramptime [ expr $ramptime+6000 ]
+if { ![ expr {$ramptime % 60000} ] } {
+puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Rampup complete, Taking start Transaction Count."
+if {[catch {set handler_stat [ list [ mysql::sel $mysql_handler "show global status where Variable_name = 'Com_commit' or Variable_name = 'Com_rollback'" -list ] ]}]} {
+puts stderr {error, failed to query transaction statistics}
+return
+} else {
+regexp {\{\{Com_commit\ ([0-9]+)\}\ \{Com_rollback\ ([0-9]+)\}\}} $handler_stat all com_comm com_roll
+set start_trans [ expr $com_comm + $com_roll ]
+ }
+if {[catch {set start_nopm [ list [ mysql::sel $mysql_handler "select sum(d_next_o_id) from district" -list ] ]}]} {
+puts stderr {error, failed to query district table}
+return
+}
+puts "Timing test period of $duration in minutes"
+set testtime 0
+set durmin $duration
+set duration [ expr $duration*60000 ]
+while {$testtime != $duration} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set testtime [ expr $testtime+6000 ]
+if { ![ expr {$testtime % 60000} ] } {
+puts -nonewline "[ expr $testtime / 60000 ] ...,"
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Test complete, Taking end Transaction Count."
+if {[catch {set handler_stat [ list [ mysql::sel $mysql_handler "show global status where Variable_name = 'Com_commit' or Variable_name = 'Com_rollback'" -list ] ]}]} {
+puts stderr {error, failed to query transaction statistics}
+return
+} else {
+regexp {\{\{Com_commit\ ([0-9]+)\}\ \{Com_rollback\ ([0-9]+)\}\}} $handler_stat all com_comm com_roll
+set end_trans [ expr $com_comm + $com_roll ]
+ }
+if {[catch {set end_nopm [ list [ mysql::sel $mysql_handler "select sum(d_next_o_id) from district" -list ] ]}]} {
+puts stderr {error, failed to query district table}
+return
+}
+set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm MySQL TPM at $nopm NOPM"
+tsv::set application abort 1
+if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
+catch { mysqlclose $mysql_handler }
+ } else {
+puts "Operating in Slave Mode, No Snapshots taken..."
+ }
+ }
+default {
+#TIMESTAMP
+proc gettimestamp { } {
+set tstamp [ clock format [ clock seconds ] -format %Y%m%d%H%M%S ]
+return $tstamp
+}
+#NEW ORDER
+proc neword { mysql_handler no_w_id w_id_input RAISEERROR clientname } {
+global mysqlstatus
+#open new order cursor
+#2.4.1.2 select district id randomly from home warehouse where d_w_id = d_id
+set no_d_id [ RandomNumber 1 10 ]
+#2.4.1.2 Customer id randomly selected where c_d_id = d_id and c_w_id = w_id
+set no_c_id [ RandomNumber 1 3000 ]
+#2.4.1.3 Items in the order randomly selected from 5 to 15
+set ol_cnt [ RandomNumber 5 15 ]
+#2.4.1.6 order entry date O_ENTRY_D generated by SUT
+set date [ gettimestamp ]
+mysqlexec $mysql_handler "set @next_o_id = 0"
+catch { mysqlexec $mysql_handler "CALL NEWORD($no_w_id,$w_id_input,$no_d_id,$no_c_id,$ol_cnt,@disc,@last,@credit,@dtax,@wtax,@next_o_id,$date)" }
+if { $mysqlstatus(code) } {
+if { $RAISEERROR } {
+error "New Order in $clientname : $mysqlstatus(message)"
+ } else {
+puts "New Order in $clientname : $mysqlstatus(message)"
+ }
+ } else {
+;
+ }
+}
+#PAYMENT
+proc payment { mysql_handler p_w_id w_id_input RAISEERROR clientname } {
+global mysqlstatus
+#2.5.1.1 The home warehouse id remains the same for each terminal
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set p_d_id [ RandomNumber 1 10 ]
+#2.5.1.2 customer selected 60% of time by name and 40% of time by number
+set x [ RandomNumber 1 100 ]
+set y [ RandomNumber 1 100 ]
+if { $x <= 85 } {
+set p_c_d_id $p_d_id
+set p_c_w_id $p_w_id
+} else {
+#use a remote warehouse
+set p_c_d_id [ RandomNumber 1 10 ]
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+while { ($p_c_w_id == $p_w_id) && ($w_id_input != 1) } {
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+ }
+}
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set p_c_id [ RandomNumber 1 3000 ]
+if { $y <= 60 } {
+#use customer name
+#C_LAST is generated
+set byname 1
+ } else {
+#use customer number
+set byname 0
+set name {}
+ }
+#2.5.1.3 random amount from 1 to 5000
+set p_h_amount [ RandomNumber 1 5000 ]
+#2.5.1.4 date selected from SUT
+set h_date [ gettimestamp ]
+#2.5.2.1 Payment Transaction
+mysqlexec $mysql_handler "set @p_c_id = $p_c_id, @p_c_last = '$name', @p_c_credit = 0, @p_c_balance = 0"
+catch { mysqlexec $mysql_handler "CALL PAYMENT($p_w_id,$p_d_id,$p_c_w_id,$p_c_d_id,@p_c_id,$byname,$p_h_amount,@p_c_last,@p_w_street_1,@p_w_street_2,@p_w_city,@p_w_state,@p_w_zip,@p_d_street_1,@p_d_street_2,@p_d_city,@p_d_state,@p_d_zip,@p_c_first,@p_c_middle,@p_c_street_1,@p_c_street_2,@p_c_city,@p_c_state,@p_c_zip,@p_c_phone,@p_c_since,@p_c_credit,@p_c_credit_lim,@p_c_discount,@p_c_balance,@p_c_data,$h_date)"}
+if { $mysqlstatus(code) } {
+if { $RAISEERROR } {
+error "Payment in $clientname : $mysqlstatus(message)"
+ } else {
+puts "Payment in $clientname : $mysqlstatus(message)"
+ }
+ } else {
+;
+ }
+}
+#ORDER_STATUS
+proc ostat { mysql_handler w_id RAISEERROR clientname } {
+global mysqlstatus
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set d_id [ RandomNumber 1 10 ]
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set c_id [ RandomNumber 1 3000 ]
+set y [ RandomNumber 1 100 ]
+if { $y <= 60 } {
+set byname 1
+ } else {
+set byname 0
+set name {}
+}
+mysqlexec $mysql_handler "set @os_c_id = $c_id, @os_c_last = '$name'"
+catch { mysqlexec $mysql_handler "CALL OSTAT($w_id,$d_id,@os_c_id,$byname,@os_c_last,@os_c_first,@os_c_middle,@os_c_balance,@os_o_id,@os_entdate,@os_o_carrier_id)"}
+if { $mysqlstatus(code) } {
+if { $RAISEERROR } {
+error "Order Status in $clientname : $mysqlstatus(message)"
+ } else {
+puts "Order Status in $clientname : $mysqlstatus(message)"
+ }
+ } else {
+;
+ }
+}
+#DELIVERY
+proc delivery { mysql_handler w_id RAISEERROR clientname } {
+global mysqlstatus
+set carrier_id [ RandomNumber 1 10 ]
+set date [ gettimestamp ]
+catch { mysqlexec $mysql_handler "CALL DELIVERY($w_id,$carrier_id,$date)"}
+if { $mysqlstatus(code) } {
+if { $RAISEERROR } {
+error "Delivery in $clientname : $mysqlstatus(message)"
+ } else {
+puts "Delivery in $clientname : $mysqlstatus(message)"
+ }
+ } else {
+;
+ }
+}
+#STOCK LEVEL
+proc slev { mysql_handler w_id stock_level_d_id RAISEERROR clientname } {
+global mysqlstatus
+set threshold [ RandomNumber 10 20 ]
+mysqlexec $mysql_handler "CALL SLEV($w_id,$stock_level_d_id,$threshold)"
+if { $mysqlstatus(code) } {
+if { $RAISEERROR } {
+error "Stock Level in $clientname : $mysqlstatus(message)"
+ } else {
+puts "Stock Level in $clientname : $mysqlstatus(message)"
+ }
+ } else {
+;
+ }
+}
+
+#RUN TPC-C
+promise::async simulate_client { clientname total_iterations host port user password RAISEERROR KEYANDTHINK db async_verbose async_delay } {
+global mysqlstatus
+set acno [ expr [ string trimleft [ lindex [ split $clientname ":" ] 1 ] ac ] * $async_delay ]
+if { $async_verbose } { puts "Delaying login of $clientname for $acno ms" }
+async_time $acno
+if { [ tsv::get application abort ] } { return "$clientname:abort before login" }
+if { $async_verbose } { puts "Logging in $clientname" }
+if [catch {mysqlconnect -host $host -port $port -user $user -password $password} mysql_handler] {
+if { $RAISEERROR } {
+puts "$clientname:login failed:$mysqlstatus(message)"
+return "$clientname:login failed:$mysqlstatus(message)"
+ }
+ } else {
+if { $async_verbose } { puts "Connected $clientname:$mysql_handler" }
+mysqluse $mysql_handler $db
+mysql::autocommit $mysql_handler 0
+ }
+set w_id_input [ list [ mysql::sel $mysql_handler "select max(w_id) from warehouse" -list ] ]
+#2.4.1.1 set warehouse_id stays constant for a given terminal
+set w_id [ RandomNumber 1 $w_id_input ]
+set d_id_input [ list [ mysql::sel $mysql_handler "select max(d_id) from district" -list ] ]
+set stock_level_d_id [ RandomNumber 1 $d_id_input ]
+puts "Processing $total_iterations transactions with output suppressed..."
+set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
+for {set it 0} {$it < $total_iterations} {incr it} {
+if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
+set choice [ RandomNumber 1 23 ]
+if {$choice <= 10} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:neword" }
+if { $KEYANDTHINK } { async_keytime 18 $clientname neword $async_verbose }
+neword $mysql_handler $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname neword $async_verbose }
+} elseif {$choice <= 20} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:payment" }
+if { $KEYANDTHINK } { async_keytime 3 $clientname payment $async_verbose }
+payment $mysql_handler $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname payment $async_verbose }
+} elseif {$choice <= 21} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:delivery" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname delivery $async_verbose }
+delivery $mysql_handler $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 10 $clientname delivery $async_verbose }
+} elseif {$choice <= 22} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:slev" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname slev $async_verbose }
+slev $mysql_handler $w_id $stock_level_d_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname slev $async_verbose }
+} elseif {$choice <= 23} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:ostat" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname ostat $async_verbose }
+ostat $mysql_handler $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname ostat $async_verbose }
+ }
+ }
+mysqlclose $mysql_handler
+if { $async_verbose } { puts "$clientname:complete" }
+return $clientname:complete
+ }
+for {set ac 1} {$ac <= $async_client} {incr ac} {
+set clientdesc "vuser$myposition:ac$ac"
+lappend clientlist $clientdesc
+lappend clients [simulate_client $clientdesc $total_iterations $host $port $user $password $RAISEERROR $KEYANDTHINK $db $async_verbose $async_delay]
+ }
+puts "Started asynchronous clients:$clientlist"
+set acprom [ promise::eventloop [ promise::all $clients ] ]
+puts "All asynchronous clients complete"
+if { $async_verbose } {
+foreach client $acprom { puts $client }
+ }
+ }
+}}
+}
}
diff --git a/src/mysql/mysqlopt.tcl b/src/mysql/mysqlopt.tcl
index 0a8b7522..090b8570 100755
--- a/src/mysql/mysqlopt.tcl
+++ b/src/mysql/mysqlopt.tcl
@@ -123,7 +123,7 @@ upvar #0 configmysql configmysql
setlocaltpccvars $configmysql
#set matching fields in dialog to temporary dict
variable myfields
-set myfields [ dict create connection {mysql_host {.tpc.f1.e1 get} mysql_port {.tpc.f1.e2 get}} tpcc {mysql_user {.tpc.f1.e3 get} mysql_pass {.tpc.f1.e4 get} mysql_dbase {.tpc.f1.e5 get} mysql_storage_engine {.tpc.f1.e6 get} mysql_total_iterations {.tpc.f1.e14 get} mysql_rampup {.tpc.f1.e17 get} mysql_duration {.tpc.f1.e18 get} mysql_count_ware $mysql_count_ware mysql_num_vu $mysql_num_vu mysql_partition $mysql_partition mysql_driver $mysql_driver mysql_raiseerror $mysql_raiseerror mysql_keyandthink $mysql_keyandthink mysql_allwarehouse $mysql_allwarehouse mysql_timeprofile $mysql_timeprofile} ]
+set myfields [ dict create connection {mysql_host {.tpc.f1.e1 get} mysql_port {.tpc.f1.e2 get}} tpcc {mysql_user {.tpc.f1.e3 get} mysql_pass {.tpc.f1.e4 get} mysql_dbase {.tpc.f1.e5 get} mysql_storage_engine {.tpc.f1.e6 get} mysql_total_iterations {.tpc.f1.e14 get} mysql_rampup {.tpc.f1.e17 get} mysql_duration {.tpc.f1.e18 get} mysql_async_client {.tpc.f1.e22 get} mysql_async_delay {.tpc.f1.e23 get} mysql_count_ware $mysql_count_ware mysql_num_vu $mysql_num_vu mysql_partition $mysql_partition mysql_driver $mysql_driver mysql_raiseerror $mysql_raiseerror mysql_keyandthink $mysql_keyandthink mysql_allwarehouse $mysql_allwarehouse mysql_timeprofile $mysql_timeprofile mysql_async_scale $mysql_async_scale mysql_async_verbose $mysql_async_verbose} ]
set whlist [ get_warehouse_list_for_spinbox ]
catch "destroy .tpc"
ttk::toplevel .tpc
@@ -251,6 +251,10 @@ set mysql_timeprofile "false"
.tpc.f1.e18 configure -state disabled
.tpc.f1.e19 configure -state disabled
.tpc.f1.e20 configure -state disabled
+.tpc.f1.e21 configure -state disabled
+.tpc.f1.e22 configure -state disabled
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
}
set Name $Parent.f1.r2
ttk::radiobutton $Name -value "timed" -text "Timed Driver Script" -variable mysql_driver
@@ -260,6 +264,10 @@ bind .tpc.f1.r2 {
.tpc.f1.e18 configure -state normal
.tpc.f1.e19 configure -state normal
.tpc.f1.e20 configure -state normal
+.tpc.f1.e21 configure -state normal
+.tpc.f1.e22 configure -state normal
+.tpc.f1.e23 configure -state normal
+.tpc.f1.e24 configure -state normal
}
set Name $Parent.f1.e14
set Prompt $Parent.f1.p14
@@ -277,6 +285,17 @@ ttk::checkbutton $Name -text "" -variable mysql_raiseerror -onvalue "true" -offv
ttk::label $Prompt -text "Keying and Thinking Time :"
set Name $Parent.f1.e16
ttk::checkbutton $Name -text "" -variable mysql_keyandthink -onvalue "true" -offvalue "false"
+bind .tpc.f1.e16 {
+if { $mysql_driver eq "timed" } {
+if { $mysql_keyandthink eq "true" } {
+set mysql_async_scale "false"
+set mysql_async_verbose "false"
+.tpc.f1.e22 configure -state disabled
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+ }
+ }
+}
grid $Prompt -column 0 -row 16 -sticky e
grid $Name -column 1 -row 16 -sticky w
set Name $Parent.f1.e17
@@ -315,6 +334,59 @@ ttk::checkbutton $Name -text "" -variable mysql_timeprofile -onvalue "true" -off
if {$mysql_driver == "test" } {
$Name configure -state disabled
}
+ set Name $Parent.f1.e21
+ set Prompt $Parent.f1.p21
+ ttk::label $Prompt -text "Asynchronous Scaling :"
+ttk::checkbutton $Name -text "" -variable mysql_async_scale -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 21 -sticky e
+ grid $Name -column 1 -row 21 -sticky ew
+if {$mysql_driver == "test" } {
+ set mysql_async_scale "false"
+ $Name configure -state disabled
+ }
+bind .tpc.f1.e21 {
+if { $mysql_async_scale eq "true" } {
+set mysql_async_verbose "false"
+.tpc.f1.e22 configure -state disabled
+.tpc.f1.e23 configure -state disabled
+.tpc.f1.e24 configure -state disabled
+ } else {
+if { $mysql_driver eq "timed" } {
+set mysql_keyandthink "true"
+.tpc.f1.e22 configure -state normal
+.tpc.f1.e23 configure -state normal
+.tpc.f1.e24 configure -state normal
+ }
+ }
+}
+set Name $Parent.f1.e22
+ set Prompt $Parent.f1.p22
+ ttk::label $Prompt -text "Asynch Clients per Virtual User :"
+ ttk::entry $Name -width 30 -textvariable mysql_async_client
+ grid $Prompt -column 0 -row 22 -sticky e
+ grid $Name -column 1 -row 22 -sticky ew
+if {$mysql_driver == "test" || $mysql_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+set Name $Parent.f1.e23
+ set Prompt $Parent.f1.p23
+ ttk::label $Prompt -text "Asynch Client Login Delay :"
+ ttk::entry $Name -width 30 -textvariable mysql_async_delay
+ grid $Prompt -column 0 -row 23 -sticky e
+ grid $Name -column 1 -row 23 -sticky ew
+if {$mysql_driver == "test" || $mysql_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+ set Name $Parent.f1.e24
+ set Prompt $Parent.f1.p24
+ ttk::label $Prompt -text "Asynchronous Verbose :"
+ttk::checkbutton $Name -text "" -variable mysql_async_verbose -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 24 -sticky e
+ grid $Name -column 1 -row 24 -sticky ew
+if {$mysql_driver == "test" || $mysql_async_scale == "false" } {
+ set mysql_async_verbose "false"
+ $Name configure -state disabled
+ }
}
#This is the Cancel button variables stay as before
set Name $Parent.b2
diff --git a/src/oracle/oraolap.tcl b/src/oracle/oraolap.tcl
index e02732fb..5859afeb 100755
--- a/src/oracle/oraolap.tcl
+++ b/src/oracle/oraolap.tcl
@@ -737,7 +737,7 @@ oraclose $curn1
return
}
-proc do_tpch { system_password instance scale_fact tpch_user tpch_pass tpch_def_tab tpch_def_temp timesten num_vu } {
+proc do_tpch { system_user system_password instance scale_fact tpch_user tpch_pass tpch_def_tab tpch_def_temp timesten num_vu } {
global dist_names dist_weights weights dists weights
###############################################
#Generating following rows
@@ -792,7 +792,7 @@ puts "CREATING [ string toupper $tpch_user ] SCHEMA"
if { $timesten } {
puts "TimesTen expects the Database [ string toupper $instance ] and User [ string toupper $tpch_user ] to have been created by the instance administrator in advance and be granted create table, session, procedure (and admin for checkpoints) privileges"
} else {
-set connect system/$system_password@$instance
+set connect $system_user/$system_password@$instance
set lda [ oralogon $connect ]
SetNLS $lda
CreateUser $lda $tpch_user $tpch_pass $tpch_def_tab $tpch_def_temp
@@ -904,7 +904,7 @@ return
}
}
}
-.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "do_tpch $system_password $instance $scale_fact $tpch_user $tpch_pass $tpch_def_tab $tpch_def_temp $tpch_tt_compat $num_tpch_threads"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "do_tpch $system_user $system_password $instance $scale_fact $tpch_user $tpch_pass $tpch_def_tab $tpch_def_temp $tpch_tt_compat $num_tpch_threads"
} else { return }
}
diff --git a/src/oracle/oraoltp.tcl b/src/oracle/oraoltp.tcl
index e1bc53e2..c39b9ee6 100755
--- a/src/oracle/oraoltp.tcl
+++ b/src/oracle/oraoltp.tcl
@@ -2100,9 +2100,9 @@ setlocaltpccvars $configoracle
ed_edit_clear
.ed_mainFrame.notebook select .ed_mainFrame.mainwin
set _ED(packagekeyname) "Oracle Timed TPC-C"
+if { !$async_scale } {
+#REGULAR TIMED SCRIPT
.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
-#TIMED AWR SNAPSHOT DRIVER SCRIPT##################################
-#THIS SCRIPT TO BE RUN WITH VIRTUAL USER OUTPUT ENABLED
#EDITABLE OPTIONS##################################################
set library $library ;# Oracle OCI Library
set total_iterations $total_iterations ;# Number of transactions before logging off
@@ -2501,4 +2501,443 @@ oraclose $curn_os
oralogoff $lda
}
}}
+} else {
+#ASYNCHRONOUS TIMED SCRIPT
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
+#EDITABLE OPTIONS##################################################
+set library $library ;# Oracle OCI Library
+set total_iterations $total_iterations ;# Number of transactions before logging off
+set RAISEERROR \"$raiseerror\" ;# Exit script on Oracle error (true or false)
+set KEYANDTHINK \"true\" ;# Time for user thinking and keying (true or false)
+set CHECKPOINT \"$checkpoint\" ;# Perform Oracle checkpoint when complete (true or false)
+set rampup $rampup; # Rampup time in minutes before first snapshot is taken
+set duration $duration; # Duration in minutes before second AWR snapshot is taken
+set mode \"$opmode\" ;# HammerDB operational mode
+set timesten \"$tpcc_tt_compat\" ;# Database is TimesTen
+set systemconnect $system_user/$system_password@$instance ;# Oracle connect string for system user
+set connect $tpcc_user/$tpcc_pass@$instance ;# Oracle connect string for tpc-c user
+set async_client $async_client;# Number of asynchronous clients per Vuser
+set async_verbose $async_verbose;# Report activity of asynchronous clients
+set async_delay $async_delay;# Delay in ms between logins of asynchronous clients
+#EDITABLE OPTIONS##################################################
+"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end {#LOAD LIBRARIES AND MODULES
+if [catch {package require $library} message] { error "Failed to load $library - $message" }
+if [catch {::tcl::tm::path add modules} ] { error "Failed to find modules directory" }
+if [catch {package require tpcccommon} ] { error "Failed to load tpcc common functions" } else { namespace import tpcccommon::* }
+if [catch {package require promise } message] { error "Failed to load promise package for asynchronous clients" }
+#STANDARD SQL
+proc standsql { curn sql } {
+set ftch ""
+if {[catch {orasql $curn $sql} message]} {
+error "SQL statement failed: $sql : $message"
+} else {
+orafetch $curn -datavariable output
+while { [ oramsg $curn ] == 0 } {
+lappend ftch $output
+orafetch $curn -datavariable output
+ }
+return $ftch
+ }
+}
+#Default NLS
+proc SetNLS { lda } {
+set curn_nls [oraopen $lda ]
+set nls(1) "alter session set NLS_LANGUAGE = AMERICAN"
+set nls(2) "alter session set NLS_TERRITORY = AMERICA"
+for { set i 1 } { $i <= 2 } { incr i } {
+if {[ catch {orasql $curn_nls $nls($i)} message ] } {
+puts "$message $nls($i)"
+puts [ oramsg $curn_nls all ]
+ }
+ }
+oraclose $curn_nls
+}
+
+if { [ chk_thread ] eq "FALSE" } {
+error "AWR Snapshot Script must be run in Thread Enabled Interpreter"
+}
+set rema [ lassign [ findvuposition ] myposition totalvirtualusers ]
+if { [ string toupper $timesten ] eq "TRUE"} {
+set timesten 1
+set systemconnect $connect
+} else {
+set timesten 0
+}
+switch $myposition {
+1 {
+if { $mode eq "Local" || $mode eq "Master" } {
+set lda [oralogon $systemconnect]
+if { !$timesten } { SetNLS $lda }
+set lda1 [oralogon $connect]
+if { !$timesten } { SetNLS $lda1 }
+oraautocom $lda on
+oraautocom $lda1 on
+set curn1 [oraopen $lda ]
+set curn2 [oraopen $lda1 ]
+if { $timesten } {
+puts "For TimesTen use external ttStats utility for performance reports"
+set sql1 "select (xact_commits + xact_rollbacks) from sys.monitor"
+ } else {
+set sql1 "BEGIN dbms_workload_repository.create_snapshot(); END;"
+oraparse $curn1 $sql1
+ }
+set ramptime 0
+puts "Beginning rampup time of $rampup minutes"
+set rampup [ expr $rampup*60000 ]
+while {$ramptime != $rampup} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set ramptime [ expr $ramptime+6000 ]
+if { ![ expr {$ramptime % 60000} ] } {
+puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
+ }
+}
+if { [ tsv::get application abort ] } { break }
+if { $timesten } {
+puts "Rampup complete, Taking start Transaction Count."
+set start_trans [ standsql $curn2 $sql1 ]
+ } else {
+puts "Rampup complete, Taking start AWR snapshot."
+if {[catch {oraplexec $curn1 $sql1} message]} { error "Failed to create snapshot : $message" }
+set sql2 "SELECT INSTANCE_NUMBER, INSTANCE_NAME, DB_NAME, DBID, SNAP_ID, TO_CHAR(END_INTERVAL_TIME,'DD MON YYYY HH24:MI') FROM (SELECT DI.INSTANCE_NUMBER, DI.INSTANCE_NAME, DI.DB_NAME, DI.DBID, DS.SNAP_ID, DS.END_INTERVAL_TIME FROM DBA_HIST_SNAPSHOT DS, DBA_HIST_DATABASE_INSTANCE DI WHERE DS.DBID=DI.DBID AND DS.INSTANCE_NUMBER=DI.INSTANCE_NUMBER AND DS.STARTUP_TIME=DI.STARTUP_TIME ORDER BY DS.SNAP_ID DESC) WHERE ROWNUM=1"
+if {[catch {orasql $curn1 $sql2} message]} {
+error "SQL statement failed: $sql2 : $message"
+} else {
+orafetch $curn1 -datavariable firstsnap
+split $firstsnap " "
+puts "Start Snapshot [ lindex $firstsnap 4 ] taken at [ lindex $firstsnap 5 ] of instance [ lindex $firstsnap 1 ] ([lindex $firstsnap 0]) of database [ lindex $firstsnap 2 ] ([lindex $firstsnap 3])"
+}}
+set sql4 "select sum(d_next_o_id) from district"
+set start_nopm [ standsql $curn2 $sql4 ]
+puts "Timing test period of $duration in minutes"
+set testtime 0
+set durmin $duration
+set duration [ expr $duration*60000 ]
+while {$testtime != $duration} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set testtime [ expr $testtime+6000 ]
+if { ![ expr {$testtime % 60000} ] } {
+puts -nonewline "[ expr $testtime / 60000 ] ...,"
+ }
+}
+if { [ tsv::get application abort ] } { break }
+if { $timesten } {
+puts "Test complete, Taking end Transaction Count."
+set end_trans [ standsql $curn2 $sql1 ]
+set end_nopm [ standsql $curn2 $sql4 ]
+set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm TimesTen TPM at $nopm NOPM"
+ } else {
+puts "Test complete, Taking end AWR snapshot."
+oraparse $curn1 $sql1
+if {[catch {oraplexec $curn1 $sql1} message]} { error "Failed to create snapshot : $message" }
+if {[catch {orasql $curn1 $sql2} message]} {
+error "SQL statement failed: $sql2 : $message"
+} else {
+orafetch $curn1 -datavariable endsnap
+split $endsnap " "
+puts "End Snapshot [ lindex $endsnap 4 ] taken at [ lindex $endsnap 5 ] of instance [ lindex $endsnap 1 ] ([lindex $endsnap 0]) of database [ lindex $endsnap 2 ] ([lindex $endsnap 3])"
+puts "Test complete: view report from SNAPID [ lindex $firstsnap 4 ] to [ lindex $endsnap 4 ]"
+set sql3 "select round((sum(tps)*60)) as TPM from (select e.stat_name, (e.value - b.value) / (select avg( extract( day from (e1.end_interval_time-b1.end_interval_time) )*24*60*60+ extract( hour from (e1.end_interval_time-b1.end_interval_time) )*60*60+ extract( minute from (e1.end_interval_time-b1.end_interval_time) )*60+ extract( second from (e1.end_interval_time-b1.end_interval_time)) ) from dba_hist_snapshot b1, dba_hist_snapshot e1 where b1.snap_id = [ lindex $firstsnap 4 ] and e1.snap_id = [ lindex $endsnap 4 ] and b1.dbid = [lindex $firstsnap 3] and e1.dbid = [lindex $endsnap 3] and b1.instance_number = [lindex $firstsnap 0] and e1.instance_number = [lindex $endsnap 0] and b1.startup_time = e1.startup_time and b1.end_interval_time < e1.end_interval_time) as tps from dba_hist_sysstat b, dba_hist_sysstat e where b.snap_id = [ lindex $firstsnap 4 ] and e.snap_id = [ lindex $endsnap 4 ] and b.dbid = [lindex $firstsnap 3] and e.dbid = [lindex $endsnap 3] and b.instance_number = [lindex $firstsnap 0] and e.instance_number = [lindex $endsnap 0] and b.stat_id = e.stat_id and b.stat_name in ('user commits','user rollbacks') and e.stat_name in ('user commits','user rollbacks') order by 1 asc)"
+set tpm [ standsql $curn1 $sql3 ]
+set end_nopm [ standsql $curn2 $sql4 ]
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+set sql6 {select value from v$parameter where name = 'cluster_database'}
+oraparse $curn1 $sql6
+set israc [ standsql $curn1 $sql6 ]
+if { $israc != "FALSE" } {
+set ractpm 0
+set sql7 {select max(inst_number) from v$active_instances}
+oraparse $curn1 $sql7
+set activinst [ standsql $curn1 $sql7 ]
+for { set a 1 } { $a <= $activinst } { incr a } {
+set firstsnap [ lreplace $firstsnap 0 0 $a ]
+set endsnap [ lreplace $endsnap 0 0 $a ]
+set sqlrac "select round((sum(tps)*60)) as TPM from (select e.stat_name, (e.value - b.value) / (select avg( extract( day from (e1.end_interval_time-b1.end_interval_time) )*24*60*60+ extract( hour from (e1.end_interval_time-b1.end_interval_time) )*60*60+ extract( minute from (e1.end_interval_time-b1.end_interval_time) )*60+ extract( second from (e1.end_interval_time-b1.end_interval_time)) ) from dba_hist_snapshot b1, dba_hist_snapshot e1 where b1.snap_id = [ lindex $firstsnap 4 ] and e1.snap_id = [ lindex $endsnap 4 ] and b1.dbid = [lindex $firstsnap 3] and e1.dbid = [lindex $endsnap 3] and b1.instance_number = [lindex $firstsnap 0] and e1.instance_number = [lindex $endsnap 0] and b1.startup_time = e1.startup_time and b1.end_interval_time < e1.end_interval_time) as tps from dba_hist_sysstat b, dba_hist_sysstat e where b.snap_id = [ lindex $firstsnap 4 ] and e.snap_id = [ lindex $endsnap 4 ] and b.dbid = [lindex $firstsnap 3] and e.dbid = [lindex $endsnap 3] and b.instance_number = [lindex $firstsnap 0] and e.instance_number = [lindex $endsnap 0] and b.stat_id = e.stat_id and b.stat_name in ('user commits','user rollbacks') and e.stat_name in ('user commits','user rollbacks') order by 1 asc)"
+set ractpm [ expr $ractpm + [ standsql $curn1 $sqlrac ]]
+ }
+set tpm $ractpm
+ }
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm Oracle TPM at $nopm NOPM"
+ }
+}
+tsv::set application abort 1
+if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
+if { $CHECKPOINT } {
+puts "Checkpoint"
+if { $timesten } {
+set sql4 "call ttCkptBlocking"
+ } else {
+set sql4 "alter system checkpoint"
+if {[catch {orasql $curn1 $sql4} message]} {
+error "SQL statement failed: $sql4 : $message"
+}
+set sql5 "alter system switch logfile"
+if {[catch {orasql $curn1 $sql5} message]} {
+error "SQL statement failed: $sql5 : $message"
+ }}
+puts "Checkpoint Complete"
+ }
+oraclose $curn1
+oraclose $curn2
+oralogoff $lda
+oralogoff $lda1
+ } else {
+puts "Operating in Slave Mode, No Snapshots taken..."
+ }
+ }
+default {
+#TIMESTAMP
+proc gettimestamp { } {
+set tstamp [ clock format [ clock seconds ] -format %Y%m%d%H%M%S ]
+return $tstamp
+}
+#NEW ORDER
+proc neword { curn_no no_w_id w_id_input RAISEERROR clientname } {
+#2.4.1.2 select district id randomly from home warehouse where d_w_id = d_id
+set no_d_id [ RandomNumber 1 10 ]
+#2.4.1.2 Customer id randomly selected where c_d_id = d_id and c_w_id = w_id
+set no_c_id [ RandomNumber 1 3000 ]
+#2.4.1.3 Items in the order randomly selected from 5 to 15
+set ol_cnt [ RandomNumber 5 15 ]
+#2.4.1.6 order entry date O_ENTRY_D generated by SUT
+set date [ gettimestamp ]
+orabind $curn_no :no_w_id $no_w_id :no_max_w_id $w_id_input :no_d_id $no_d_id :no_c_id $no_c_id :no_o_ol_cnt $ol_cnt :no_c_discount {} :no_c_last {} :no_c_credit {} :no_d_tax {} :no_w_tax {} :no_d_next_o_id {0} :timestamp $date
+if {[catch {oraexec $curn_no} message]} {
+if { $RAISEERROR } {
+puts "Error in $clientname New Order : $message [ oramsg $curn_no all ]"
+ } else {
+;
+ } } else {
+orafetch $curn_no -datavariable output
+;
+ }
+}
+#PAYMENT
+proc payment { curn_py p_w_id w_id_input RAISEERROR clientname } {
+#2.5.1.1 The home warehouse id remains the same for each terminal
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set p_d_id [ RandomNumber 1 10 ]
+#2.5.1.2 customer selected 60% of time by name and 40% of time by number
+set x [ RandomNumber 1 100 ]
+set y [ RandomNumber 1 100 ]
+if { $x <= 85 } {
+set p_c_d_id $p_d_id
+set p_c_w_id $p_w_id
+} else {
+#use a remote warehouse
+set p_c_d_id [ RandomNumber 1 10 ]
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+while { ($p_c_w_id == $p_w_id) && ($w_id_input != 1) } {
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+ }
+}
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set p_c_id [ RandomNumber 1 3000 ]
+if { $y <= 60 } {
+#use customer name
+#C_LAST is generated
+set byname 1
+ } else {
+#use customer number
+set byname 0
+set name {}
+ }
+#2.5.1.3 random amount from 1 to 5000
+set p_h_amount [ RandomNumber 1 5000 ]
+#2.5.1.4 date selected from SUT
+set h_date [ gettimestamp ]
+#2.5.2.1 Payment Transaction
+#change following to correct values
+orabind $curn_py :p_w_id $p_w_id :p_d_id $p_d_id :p_c_w_id $p_c_w_id :p_c_d_id $p_c_d_id :p_c_id $p_c_id :byname $byname :p_h_amount $p_h_amount :p_c_last $name :p_w_street_1 {} :p_w_street_2 {} :p_w_city {} :p_w_state {} :p_w_zip {} :p_d_street_1 {} :p_d_street_2 {} :p_d_city {} :p_d_state {} :p_d_zip {} :p_c_first {} :p_c_middle {} :p_c_street_1 {} :p_c_street_2 {} :p_c_city {} :p_c_state {} :p_c_zip {} :p_c_phone {} :p_c_since {} :p_c_credit {0} :p_c_credit_lim {} :p_c_discount {} :p_c_balance {0} :p_c_data {} :timestamp $h_date
+if {[ catch {oraexec $curn_py} message]} {
+if { $RAISEERROR } {
+puts "Error in $clientname Payment : $message [ oramsg $curn_py all ]"
+ } else {
+;
+} } else {
+orafetch $curn_py -datavariable output
+;
+ }
+}
+#ORDER_STATUS
+proc ostat { curn_os w_id RAISEERROR clientname } {
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set d_id [ RandomNumber 1 10 ]
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set c_id [ RandomNumber 1 3000 ]
+set y [ RandomNumber 1 100 ]
+if { $y <= 60 } {
+set byname 1
+ } else {
+set byname 0
+set name {}
+}
+orabind $curn_os :os_w_id $w_id :os_d_id $d_id :os_c_id $c_id :byname $byname :os_c_last $name :os_c_first {} :os_c_middle {} :os_c_balance {0} :os_o_id {} :os_entdate {} :os_o_carrier_id {}
+if {[catch {oraexec $curn_os} message]} {
+if { $RAISEERROR } {
+puts "Error in $clientname Order Status : $message [ oramsg $curn_os all ]"
+ } else {
+;
+} } else {
+orafetch $curn_os -datavariable output
+;
+ }
+}
+#DELIVERY
+proc delivery { curn_dl w_id RAISEERROR clientname } {
+set carrier_id [ RandomNumber 1 10 ]
+set date [ gettimestamp ]
+orabind $curn_dl :d_w_id $w_id :d_o_carrier_id $carrier_id :timestamp $date
+if {[ catch {oraexec $curn_dl} message ]} {
+if { $RAISEERROR } {
+puts "Error in $clientname Delivery : $message [ oramsg $curn_dl all ]"
+ } else {
+;
+} } else {
+orafetch $curn_dl -datavariable output
+;
+ }
+}
+#STOCK LEVEL
+proc slev { curn_sl w_id stock_level_d_id RAISEERROR clientname } {
+set threshold [ RandomNumber 10 20 ]
+orabind $curn_sl :st_w_id $w_id :st_d_id $stock_level_d_id :THRESHOLD $threshold :stocklevel {}
+if {[catch {oraexec $curn_sl} message]} {
+if { $RAISEERROR } {
+puts "Error in $clientname Stock Level : $message [ oramsg $curn_sl all ]"
+ } else {
+;
+} } else {
+orafetch $curn_sl -datavariable output
+;
+ }
+}
+
+proc prep_statement { lda curn_st } {
+switch $curn_st {
+curn_sl {
+set curn_sl [oraopen $lda ]
+set sql_sl "BEGIN slev(:st_w_id,:st_d_id,:threshold,:stocklevel); END;"
+oraparse $curn_sl $sql_sl
+return $curn_sl
+ }
+curn_dl {
+set curn_dl [oraopen $lda ]
+set sql_dl "BEGIN delivery(:d_w_id,:d_o_carrier_id,TO_DATE(:timestamp,'YYYYMMDDHH24MISS')); END;"
+oraparse $curn_dl $sql_dl
+return $curn_dl
+ }
+curn_os {
+set curn_os [oraopen $lda ]
+set sql_os "BEGIN ostat(:os_w_id,:os_d_id,:os_c_id,:byname,:os_c_last,:os_c_first,:os_c_middle,:os_c_balance,:os_o_id,:os_entdate,:os_o_carrier_id); END;"
+oraparse $curn_os $sql_os
+return $curn_os
+ }
+curn_py {
+set curn_py [oraopen $lda ]
+set sql_py "BEGIN payment(:p_w_id,:p_d_id,:p_c_w_id,:p_c_d_id,:p_c_id,:byname,:p_h_amount,:p_c_last,:p_w_street_1,:p_w_street_2,:p_w_city,:p_w_state,:p_w_zip,:p_d_street_1,:p_d_street_2,:p_d_city,:p_d_state,:p_d_zip,:p_c_first,:p_c_middle,:p_c_street_1,:p_c_street_2,:p_c_city,:p_c_state,:p_c_zip,:p_c_phone,:p_c_since,:p_c_credit,:p_c_credit_lim,:p_c_discount,:p_c_balance,:p_c_data,TO_DATE(:timestamp,'YYYYMMDDHH24MISS')); END;"
+oraparse $curn_py $sql_py
+return $curn_py
+ }
+curn_no {
+set curn_no [oraopen $lda ]
+set sql_no "begin neword(:no_w_id,:no_max_w_id,:no_d_id,:no_c_id,:no_o_ol_cnt,:no_c_discount,:no_c_last,:no_c_credit,:no_d_tax,:no_w_tax,:no_d_next_o_id,TO_DATE(:timestamp,'YYYYMMDDHH24MISS')); END;"
+oraparse $curn_no $sql_no
+return $curn_no
+ }
+ }
+}
+
+#RUN TPC-C
+promise::async simulate_client { clientname total_iterations connect RAISEERROR KEYANDTHINK timesten async_verbose async_delay } {
+set acno [ expr [ string trimleft [ lindex [ split $clientname ":" ] 1 ] ac ] * $async_delay ]
+if { $async_verbose } { puts "Delaying login of $clientname for $acno ms" }
+async_time $acno
+if { [ tsv::get application abort ] } { return "$clientname:abort before login" }
+if { $async_verbose } { puts "Logging in $clientname" }
+if {[catch {set lda [oralogon $connect]} message]} {
+if { $RAISEERROR } {
+puts "$clientname:login failed:$message"
+return "$clientname:login failed:$message"
+ }
+ } else {
+if { $async_verbose } { puts "Connected $clientname:$lda" }
+ }
+if { !$timesten } { SetNLS $lda }
+oraautocom $lda on
+foreach curn_st {curn_no curn_py curn_dl curn_sl curn_os} { set $curn_st [ prep_statement $lda $curn_st ] }
+set curn1 [oraopen $lda ]
+set sql1 "select max(w_id) from warehouse"
+set w_id_input [ standsql $curn1 $sql1 ]
+#2.4.1.1 set warehouse_id stays constant for a given terminal
+set w_id [ RandomNumber 1 $w_id_input ]
+set sql2 "select max(d_id) from district"
+set d_id_input [ standsql $curn1 $sql2 ]
+set stock_level_d_id [ RandomNumber 1 $d_id_input ]
+set sql3 "BEGIN DBMS_RANDOM.initialize (val => TO_NUMBER(TO_CHAR(SYSDATE,'MMSS')) * (USERENV('SESSIONID') - TRUNC(USERENV('SESSIONID'),-5))); END;"
+oraparse $curn1 $sql3
+if {[catch {oraplexec $curn1 $sql3} message]} {
+error "Failed to initialise DBMS_RANDOM $message have you run catoctk.sql as sys?" }
+oraclose $curn1
+if { $async_verbose } { puts "Processing $total_iterations transactions with output suppressed..." }
+set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
+for {set it 0} {$it < $total_iterations} {incr it} {
+if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
+set choice [ RandomNumber 1 23 ]
+if {$choice <= 10} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:neword" }
+if { $KEYANDTHINK } { async_keytime 18 $clientname neword $async_verbose }
+neword $curn_no $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname neword $async_verbose }
+} elseif {$choice <= 20} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:payment" }
+if { $KEYANDTHINK } { async_keytime 3 $clientname payment $async_verbose }
+payment $curn_py $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname payment $async_verbose }
+} elseif {$choice <= 21} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:delivery" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname delivery $async_verbose }
+delivery $curn_dl $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 10 $clientname delivery $async_verbose }
+} elseif {$choice <= 22} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:slev" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname slev $async_verbose }
+slev $curn_sl $w_id $stock_level_d_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname slev $async_verbose }
+} elseif {$choice <= 23} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:ostat" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname ostat $async_verbose }
+ostat $curn_os $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname ostat $async_verbose }
+ }
+}
+oraclose $curn_no
+oraclose $curn_py
+oraclose $curn_dl
+oraclose $curn_sl
+oraclose $curn_os
+oralogoff $lda
+if { $async_verbose } { puts "$clientname:complete" }
+return $clientname:complete
+ }
+for {set ac 1} {$ac <= $async_client} {incr ac} {
+set clientdesc "vuser$myposition:ac$ac"
+lappend clientlist $clientdesc
+lappend clients [simulate_client $clientdesc $total_iterations $connect $RAISEERROR $KEYANDTHINK $timesten $async_verbose $async_delay]
+ }
+puts "Started asynchronous clients:$clientlist"
+set acprom [ promise::eventloop [ promise::all $clients ] ]
+puts "All asynchronous clients complete"
+if { $async_verbose } {
+foreach client $acprom { puts $client }
+ }
+ }
+}}
+}
}
diff --git a/src/oracle/oraopt.tcl b/src/oracle/oraopt.tcl
index e9c5554d..300f3693 100755
--- a/src/oracle/oraopt.tcl
+++ b/src/oracle/oraopt.tcl
@@ -139,7 +139,7 @@ upvar #0 configoracle configoracle
setlocaltpccvars $configoracle
#set matching fields in dialog to temporary dict
variable orafields
-set orafields [ dict create connection {system_user {.tpc.f1.e2 get} system_password {.tpc.f1.e3 get} instance {.tpc.f1.e1 get}} tpcc {tpcc_user {.tpc.f1.e4 get} tpcc_pass {.tpc.f1.e5 get} tpcc_def_tab {.tpc.f1.e6 get} tpcc_ol_tab {.tpc.f1.e6a get} tpcc_def_temp {.tpc.f1.e7 get} total_iterations {.tpc.f1.e17 get} rampup {.tpc.f1.e21 get} duration {.tpc.f1.e22 get} tpcc_tt_compat $tpcc_tt_compat hash_clusters $hash_clusters partition $partition count_ware $count_ware num_vu $num_vu ora_driver $ora_driver raiseerror $raiseerror keyandthink $keyandthink checkpoint $checkpoint allwarehouse $allwarehouse timeprofile $timeprofile}]
+set orafields [ dict create connection {system_user {.tpc.f1.e2 get} system_password {.tpc.f1.e3 get} instance {.tpc.f1.e1 get}} tpcc {tpcc_user {.tpc.f1.e4 get} tpcc_pass {.tpc.f1.e5 get} tpcc_def_tab {.tpc.f1.e6 get} tpcc_ol_tab {.tpc.f1.e6a get} tpcc_def_temp {.tpc.f1.e7 get} total_iterations {.tpc.f1.e17 get} rampup {.tpc.f1.e21 get} duration {.tpc.f1.e22 get} async_client {.tpc.f1.e26 get} async_delay {.tpc.f1.e27 get} tpcc_tt_compat $tpcc_tt_compat hash_clusters $hash_clusters partition $partition count_ware $count_ware num_vu $num_vu ora_driver $ora_driver raiseerror $raiseerror keyandthink $keyandthink checkpoint $checkpoint allwarehouse $allwarehouse timeprofile $timeprofile async_scale $async_scale async_verbose $async_verbose}]
set whlist [ get_warehouse_list_for_spinbox ]
catch "destroy .tpc"
ttk::toplevel .tpc
@@ -357,11 +357,17 @@ bind .tpc.f1.r1 {
set checkpoint "false"
set allwarehouse "false"
set timeprofile "false"
+set async_scale "false"
+set async_verbose "false"
.tpc.f1.e20 configure -state disabled
.tpc.f1.e21 configure -state disabled
.tpc.f1.e22 configure -state disabled
.tpc.f1.e23 configure -state disabled
.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
+.tpc.f1.e26 configure -state disabled
+.tpc.f1.e27 configure -state disabled
+.tpc.f1.e28 configure -state disabled
}
set Name $Parent.f1.r2
ttk::radiobutton $Name -value "timed" -text "Timed Driver Script" -variable ora_driver
@@ -372,6 +378,12 @@ bind .tpc.f1.r2 {
.tpc.f1.e22 configure -state normal
.tpc.f1.e23 configure -state normal
.tpc.f1.e24 configure -state normal
+.tpc.f1.e25 configure -state normal
+if { $async_scale eq "true" } {
+.tpc.f1.e26 configure -state normal
+.tpc.f1.e27 configure -state normal
+.tpc.f1.e28 configure -state normal
+ }
}
set Name $Parent.f1.e17
set Prompt $Parent.f1.p17
@@ -389,6 +401,17 @@ ttk::checkbutton $Name -text "" -variable raiseerror -onvalue "true" -offvalue "
ttk::label $Prompt -text "Keying and Thinking Time :"
set Name $Parent.f1.e19
ttk::checkbutton $Name -text "" -variable keyandthink -onvalue "true" -offvalue "false"
+bind .tpc.f1.e19 {
+if { $ora_driver eq "timed" } {
+if { $keyandthink eq "true" } {
+set async_scale "false"
+set async_verbose "false"
+.tpc.f1.e26 configure -state disabled
+.tpc.f1.e27 configure -state disabled
+.tpc.f1.e28 configure -state disabled
+ }
+ }
+}
grid $Prompt -column 0 -row 21 -sticky e
grid $Name -column 1 -row 21 -sticky w
set Prompt $Parent.f1.p20
@@ -427,7 +450,7 @@ ttk::checkbutton $Name -text "" -variable allwarehouse -onvalue "true" -offvalue
if {$ora_driver == "test" } {
$Name configure -state disabled
}
-set Name $Parent.f1.e24
+ set Name $Parent.f1.e24
set Prompt $Parent.f1.p24
ttk::label $Prompt -text "Time Profile :"
ttk::checkbutton $Name -text "" -variable timeprofile -onvalue "true" -offvalue "false"
@@ -436,6 +459,59 @@ ttk::checkbutton $Name -text "" -variable timeprofile -onvalue "true" -offvalue
if {$ora_driver == "test" } {
$Name configure -state disabled
}
+ set Name $Parent.f1.e25
+ set Prompt $Parent.f1.p25
+ ttk::label $Prompt -text "Asynchronous Scaling :"
+ttk::checkbutton $Name -text "" -variable async_scale -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 27 -sticky e
+ grid $Name -column 1 -row 27 -sticky ew
+if {$ora_driver == "test" } {
+ set async_scale "false"
+ $Name configure -state disabled
+ }
+bind .tpc.f1.e25 {
+if { $async_scale eq "true" } {
+set async_verbose "false"
+.tpc.f1.e26 configure -state disabled
+.tpc.f1.e27 configure -state disabled
+.tpc.f1.e28 configure -state disabled
+ } else {
+if { $ora_driver eq "timed" } {
+set keyandthink "true"
+.tpc.f1.e26 configure -state normal
+.tpc.f1.e27 configure -state normal
+.tpc.f1.e28 configure -state normal
+ }
+ }
+}
+set Name $Parent.f1.e26
+ set Prompt $Parent.f1.p26
+ ttk::label $Prompt -text "Asynch Clients per Virtual User :"
+ ttk::entry $Name -width 30 -textvariable async_client
+ grid $Prompt -column 0 -row 28 -sticky e
+ grid $Name -column 1 -row 28 -sticky ew
+if {$ora_driver == "test" || $async_scale == "false" } {
+ $Name configure -state disabled
+ }
+set Name $Parent.f1.e27
+ set Prompt $Parent.f1.p27
+ ttk::label $Prompt -text "Asynch Client Login Delay :"
+ ttk::entry $Name -width 30 -textvariable async_delay
+ grid $Prompt -column 0 -row 29 -sticky e
+ grid $Name -column 1 -row 29 -sticky ew
+if {$ora_driver == "test" || $async_scale == "false" } {
+ $Name configure -state disabled
+ }
+ set Name $Parent.f1.e28
+ set Prompt $Parent.f1.p28
+ ttk::label $Prompt -text "Asynchronous Verbose :"
+ttk::checkbutton $Name -text "" -variable async_verbose -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 30 -sticky e
+ grid $Name -column 1 -row 30 -sticky ew
+if {$ora_driver == "test" || $async_scale == "false" } {
+ set async_verbose "false"
+ $Name configure -state disabled
+ }
}
#This is the Cancel button variables stay as before
set Name $Parent.b2
@@ -480,7 +556,7 @@ upvar #0 configoracle configoracle
#set variables to values in dict
setlocaltpchvars $configoracle
variable orafields
-set orafields [ dict create connection {instance {.tpch.f1.e1 get} system_user {.tpch.f1.e21a get} system_password {.tpch.f1.e2 get}} tpch {tpch_user {.tpch.f1.e3 get} tpch_pass {.tpch.f1.e4 get} tpch_def_tab {.tpch.f1.e5 get} tpch_def_temp {.tpch.f1.e6 get} total_querysets {.tpch.f1.e10 get} degree_of_parallel {.tpch.f1.e13 get} update_sets {.tpch.f1.e15 get} trickle_refresh {.tpch.f1.e16 get} tpch_tt_compat $tpch_tt_compat scale_fact $scale_fact num_tpch_threads $num_tpch_threads raise_query_error $raise_query_error verbose $verbose refresh_on $refresh_on refresh_verbose $refresh_verbose cloud_query $cloud_query}]
+set orafields [ dict create connection {instance {.tpch.f1.e1 get} system_user {.tpch.f1.e1a get} system_password {.tpch.f1.e2 get}} tpch {tpch_user {.tpch.f1.e3 get} tpch_pass {.tpch.f1.e4 get} tpch_def_tab {.tpch.f1.e5 get} tpch_def_temp {.tpch.f1.e6 get} total_querysets {.tpch.f1.e10 get} degree_of_parallel {.tpch.f1.e13 get} update_sets {.tpch.f1.e15 get} trickle_refresh {.tpch.f1.e16 get} tpch_tt_compat $tpch_tt_compat scale_fact $scale_fact num_tpch_threads $num_tpch_threads raise_query_error $raise_query_error verbose $verbose refresh_on $refresh_on refresh_verbose $refresh_verbose cloud_query $cloud_query}]
catch "destroy .tpch"
ttk::toplevel .tpch
wm withdraw .tpch
diff --git a/src/postgresql/pgoltp.tcl b/src/postgresql/pgoltp.tcl
index a2d66036..d0f1262e 100755
--- a/src/postgresql/pgoltp.tcl
+++ b/src/postgresql/pgoltp.tcl
@@ -2197,8 +2197,9 @@ setlocaltpccvars $configpostgresql
ed_edit_clear
.ed_mainFrame.notebook select .ed_mainFrame.mainwin
set _ED(packagekeyname) "PostgreSQL TPC-C Timed"
+if { !$pg_async_scale } {
+#REGULAR TIMED SCRIPT
.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
-#THIS SCRIPT TO BE RUN WITH VIRTUAL USER OUTPUT ENABLED
#EDITABLE OPTIONS##################################################
set library $library ;# PostgreSQL Library
set total_iterations $pg_total_iterations ;# Number of transactions before logging off
@@ -2570,7 +2571,7 @@ pg_select $lda "select max(d_id) from district" d_id_input_arr {
set d_id_input $d_id_input_arr(max)
}
set stock_level_d_id [ RandomNumber 1 $d_id_input ]
-puts "Processing $total_iterations transactions without output suppressed..."
+puts "Processing $total_iterations transactions with output suppressed..."
set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
for {set it 0} {$it < $total_iterations} {incr it} {
if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
@@ -2600,4 +2601,465 @@ if { $KEYANDTHINK } { thinktime 5 }
pg_disconnect $lda
}
}}
+} else {
+#ASYNCHRONOUS TIMED SCRIPT
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
+#EDITABLE OPTIONS##################################################
+set library $library ;# PostgreSQL Library
+set total_iterations $pg_total_iterations ;# Number of transactions before logging off
+set RAISEERROR \"$pg_raiseerror\" ;# Exit script on PostgreSQL (true or false)
+set KEYANDTHINK \"$pg_keyandthink\" ;# Time for user thinking and keying (true or false)
+set rampup $pg_rampup; # Rampup time in minutes before first Transaction Count is taken
+set duration $pg_duration; # Duration in minutes before second Transaction Count is taken
+set mode \"$opmode\" ;# HammerDB operational mode
+set VACUUM \"$pg_vacuum\" ;# Perform checkpoint and vacuuum when complete (true or false)
+set DRITA_SNAPSHOTS \"$pg_dritasnap\";#Take DRITA Snapshots
+set ora_compatible \"$pg_oracompat\" ;#Postgres Plus Oracle Compatible Schema
+set pg_storedprocs \"$pg_storedprocs\" ;#Postgres v11 Stored Procedures
+set host \"$pg_host\" ;# Address of the server hosting PostgreSQL
+set port \"$pg_port\" ;# Port of the PostgreSQL server
+set superuser \"$pg_superuser\" ;# Superuser privilege user
+set superuser_password \"$pg_superuserpass\" ;# Password for Superuser
+set default_database \"$pg_defaultdbase\" ;# Default Database for Superuser
+set user \"$pg_user\" ;# PostgreSQL user
+set password \"$pg_pass\" ;# Password for the PostgreSQL user
+set db \"$pg_dbase\" ;# Database containing the TPC Schema
+set async_client $pg_async_client;# Number of asynchronous clients per Vuser
+set async_verbose $pg_async_verbose;# Report activity of asynchronous clients
+set async_delay $pg_async_delay;# Delay in ms between logins of asynchronous clients
+#EDITABLE OPTIONS##################################################
+"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end {#LOAD LIBRARIES AND MODULES
+if [catch {package require $library} message] { error "Failed to load $library - $message" }
+if [catch {::tcl::tm::path add modules} ] { error "Failed to find modules directory" }
+if [catch {package require tpcccommon} ] { error "Failed to load tpcc common functions" } else { namespace import tpcccommon::* }
+if [catch {package require promise } message] { error "Failed to load promise package for asynchronous clients" }
+
+if { [ chk_thread ] eq "FALSE" } {
+error "PostgreSQL Timed Script must be run in Thread Enabled Interpreter"
+}
+
+proc ConnectToPostgres { host port user password dbname } {
+global tcl_platform
+if {[catch {set lda [pg_connect -conninfo [list host = $host port = $port user = $user password = $password dbname = $dbname ]]} message]} {
+set lda "Failed" ; puts $message
+error $message
+ } else {
+if {$tcl_platform(platform) == "windows"} {
+#Workaround for Bug #95 where first connection fails on Windows
+catch {pg_disconnect $lda}
+set lda [pg_connect -conninfo [list host = $host port = $port user = $user password = $password dbname = $dbname ]]
+ }
+pg_notice_handler $lda puts
+set result [ pg_exec $lda "set CLIENT_MIN_MESSAGES TO 'ERROR'" ]
+pg_result $result -clear
+ }
+return $lda
+}
+set rema [ lassign [ findvuposition ] myposition totalvirtualusers ]
+switch $myposition {
+1 {
+if { $mode eq "Local" || $mode eq "Master" } {
+if { ($DRITA_SNAPSHOTS eq "true") || ($VACUUM eq "true") } {
+set lda [ ConnectToPostgres $host $port $superuser $superuser_password $default_database ]
+if { $lda eq "Failed" } {
+error "error, the database connection to $host could not be established"
+ }
+}
+set lda1 [ ConnectToPostgres $host $port $user $password $db ]
+if { $lda1 eq "Failed" } {
+error "error, the database connection to $host could not be established"
+ }
+set ramptime 0
+puts "Beginning rampup time of $rampup minutes"
+set rampup [ expr $rampup*60000 ]
+while {$ramptime != $rampup} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set ramptime [ expr $ramptime+6000 ]
+if { ![ expr {$ramptime % 60000} ] } {
+puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
+ }
+}
+if { [ tsv::get application abort ] } { break }
+if { $DRITA_SNAPSHOTS eq "true" } {
+puts "Rampup complete, Taking start DRITA snapshot."
+set result [pg_exec $lda "select * from edbsnap()" ]
+if {[pg_result $result -status] ni {"PGRES_TUPLES_OK" "PGRES_COMMAND_OK"}} {
+if { $RAISEERROR } {
+error "[pg_result $result -error]"
+ } else {
+puts "DRITA Snapshot Error set RAISEERROR for Details"
+ }
+ } else {
+pg_result $result -clear
+pg_select $lda {select edb_id,snap_tm from edb$snap order by edb_id desc limit 1} snap_arr {
+set firstsnap $snap_arr(edb_id)
+set first_snaptime $snap_arr(snap_tm)
+ }
+puts "Start Snapshot $firstsnap taken at $first_snaptime"
+ }
+ } else {
+puts "Rampup complete, Taking start Transaction Count."
+ }
+pg_select $lda1 "select sum(xact_commit + xact_rollback) from pg_stat_database" tx_arr {
+set start_trans $tx_arr(sum)
+ }
+pg_select $lda1 "select sum(d_next_o_id) from district" o_id_arr {
+set start_nopm $o_id_arr(sum)
+ }
+puts "Timing test period of $duration in minutes"
+set testtime 0
+set durmin $duration
+set duration [ expr $duration*60000 ]
+while {$testtime != $duration} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set testtime [ expr $testtime+6000 ]
+if { ![ expr {$testtime % 60000} ] } {
+puts -nonewline "[ expr $testtime / 60000 ] ...,"
+ }
+}
+if { [ tsv::get application abort ] } { break }
+if { $DRITA_SNAPSHOTS eq "true" } {
+puts "Test complete, Taking end DRITA snapshot."
+set result [pg_exec $lda "select * from edbsnap()" ]
+if {[pg_result $result -status] ni {"PGRES_TUPLES_OK" "PGRES_COMMAND_OK"}} {
+if { $RAISEERROR } {
+error "[pg_result $result -error]"
+ } else {
+puts "Snapshot Error set RAISEERROR for Details"
+ }
+ } else {
+pg_result $result -clear
+pg_select $lda {select edb_id,snap_tm from edb$snap order by edb_id desc limit 1} snap_arr {
+set endsnap $snap_arr(edb_id)
+set end_snaptime $snap_arr(snap_tm)
+ }
+puts "End Snapshot $endsnap taken at $end_snaptime"
+puts "Test complete: view DRITA report from SNAPID $firstsnap to $endsnap"
+ }
+ } else {
+puts "Test complete, Taking end Transaction Count."
+ }
+pg_select $lda1 "select sum(xact_commit + xact_rollback) from pg_stat_database" tx_arr {
+set end_trans $tx_arr(sum)
+ }
+pg_select $lda1 "select sum(d_next_o_id) from district" o_id_arr {
+set end_nopm $o_id_arr(sum)
+ }
+set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm PostgreSQL TPM at $nopm NOPM"
+tsv::set application abort 1
+if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
+if { $VACUUM } {
+ set RAISEERROR "true"
+puts "Checkpoint and Vacuum"
+set result [pg_exec $lda "checkpoint" ]
+if {[pg_result $result -status] ni {"PGRES_TUPLES_OK" "PGRES_COMMAND_OK"}} {
+if { $RAISEERROR } {
+error "[pg_result $result -error]"
+ } else {
+puts "Checkpoint Error set RAISEERROR for Details"
+ }
+ } else {
+pg_result $result -clear
+ }
+set result [pg_exec $lda "vacuum" ]
+if {[pg_result $result -status] ni {"PGRES_TUPLES_OK" "PGRES_COMMAND_OK"}} {
+if { $RAISEERROR } {
+error "[pg_result $result -error]"
+ } else {
+puts "Vacuum Error set RAISEERROR for Details"
+ }
+ } else {
+puts "Checkpoint and Vacuum Complete"
+pg_result $result -clear
+ }
+}
+if { ($DRITA_SNAPSHOTS eq "true") || ($VACUUM eq "true") } {
+pg_disconnect $lda
+ }
+pg_disconnect $lda1
+ } else {
+puts "Operating in Slave Mode, No Snapshots taken..."
+ }
+ }
+default {
+#TIMESTAMP
+proc gettimestamp { } {
+set tstamp [ clock format [ clock seconds ] -format %Y%m%d%H%M%S ]
+return $tstamp
+}
+proc ConnectToPostgresAsynch { host port user password dbname RAISEERROR clientname async_verbose } {
+global tcl_platform
+puts "Connecting to database $dbname"
+if {[catch {set lda [pg_connect -conninfo [list host = $host port = $port user = $user password = $password dbname = $dbname ]]} message]} {
+set lda "Failed"
+if { $RAISEERROR } {
+puts "$clientname:login failed:$message"
+return "$clientname:login failed:$message"
+ }
+ } else {
+if {$tcl_platform(platform) == "windows"} {
+#Workaround for Bug #95 where first connection fails on Windows
+catch {pg_disconnect $lda}
+if {[catch {set lda [pg_connect -conninfo [list host = $host port = $port user = $user password = $password dbname = $dbname ]]} message]} {
+set lda "Failed"
+if { $RAISEERROR } {
+puts "$clientname:login failed:$message"
+return "$clientname:login failed:$message"
+ }
+ }
+ }
+if { $async_verbose } { puts "Connected $clientname:$lda" }
+pg_notice_handler $lda puts
+set result [ pg_exec $lda "set CLIENT_MIN_MESSAGES TO 'ERROR'" ]
+pg_result $result -clear
+ }
+return $lda
+}
+#NEW ORDER
+proc neword { lda no_w_id w_id_input RAISEERROR ora_compatible pg_storedprocs clientname } {
+#2.4.1.2 select district id randomly from home warehouse where d_w_id = d_id
+set no_d_id [ RandomNumber 1 10 ]
+#2.4.1.2 Customer id randomly selected where c_d_id = d_id and c_w_id = w_id
+set no_c_id [ RandomNumber 1 3000 ]
+#2.4.1.3 Items in the order randomly selected from 5 to 15
+set ol_cnt [ RandomNumber 5 15 ]
+#2.4.1.6 order entry date O_ENTRY_D generated by SUT
+set date [ gettimestamp ]
+if { $ora_compatible eq "true" } {
+set result [pg_exec $lda "exec neword($no_w_id,$w_id_input,$no_d_id,$no_c_id,$ol_cnt,0,TO_TIMESTAMP($date,'YYYYMMDDHH24MISS'))" ]
+} else {
+if { $pg_storedprocs eq "true" } {
+set result [pg_exec $lda "call neword($no_w_id,$w_id_input,$no_d_id,$no_c_id,$ol_cnt,0.0,'','',0.0,0.0,0,TO_TIMESTAMP('$date','YYYYMMDDHH24MISS')::timestamp without time zone)" ]
+ } else {
+set result [pg_exec $lda "select neword($no_w_id,$w_id_input,$no_d_id,$no_c_id,$ol_cnt,0)" ]
+ }
+}
+if {[pg_result $result -status] != "PGRES_TUPLES_OK"} {
+if { $RAISEERROR } {
+error "New Order in $clientname : [pg_result $result -error]"
+ } else {
+puts "New Order in $clientname : [pg_result $result -error]"
+ }
+pg_result $result -clear
+ } else {
+pg_result $result -clear
+ }
+}
+#PAYMENT
+proc payment { lda p_w_id w_id_input RAISEERROR ora_compatible pg_storedprocs clientname } {
+#2.5.1.1 The home warehouse id remains the same for each terminal
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set p_d_id [ RandomNumber 1 10 ]
+#2.5.1.2 customer selected 60% of time by name and 40% of time by number
+set x [ RandomNumber 1 100 ]
+set y [ RandomNumber 1 100 ]
+if { $x <= 85 } {
+set p_c_d_id $p_d_id
+set p_c_w_id $p_w_id
+} else {
+#use a remote warehouse
+set p_c_d_id [ RandomNumber 1 10 ]
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+while { ($p_c_w_id == $p_w_id) && ($w_id_input != 1) } {
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+ }
+}
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set p_c_id [ RandomNumber 1 3000 ]
+if { $y <= 60 } {
+#use customer name
+#C_LAST is generated
+set byname 1
+ } else {
+#use customer number
+set byname 0
+set name {}
+ }
+#2.5.1.3 random amount from 1 to 5000
+set p_h_amount [ RandomNumber 1 5000 ]
+#2.5.1.4 date selected from SUT
+set h_date [ gettimestamp ]
+#2.5.2.1 Payment Transaction
+#change following to correct values
+if { $ora_compatible eq "true" } {
+set result [pg_exec $lda "exec payment($p_w_id,$p_d_id,$p_c_w_id,$p_c_d_id,$p_c_id,$byname,$p_h_amount,'$name','0',0,TO_TIMESTAMP($h_date,'YYYYMMDDHH24MISS'))" ]
+} else {
+if { $pg_storedprocs eq "true" } {
+set result [pg_exec $lda "call payment($p_w_id,$p_d_id,$p_c_w_id,$p_c_d_id,$byname,$p_h_amount,'0','$name',$p_c_id,'','','','','','','','','','','','','','','','','','',TO_TIMESTAMP('$h_date','YYYYMMDDHH24MISS')::timestamp without time zone,0.0,0.0,0.0,'',TO_TIMESTAMP('$h_date','YYYYMMDDHH24MISS')::timestamp without time zone)" ]
+ } else {
+set result [pg_exec $lda "select payment($p_w_id,$p_d_id,$p_c_w_id,$p_c_d_id,$p_c_id,$byname,$p_h_amount,'$name','0',0)" ]
+ }
+}
+if {[pg_result $result -status] != "PGRES_TUPLES_OK"} {
+if { $RAISEERROR } {
+error "Payment in $clientname : [pg_result $result -error]"
+ } else {
+puts "Payment in $clientname : [pg_result $result -error]"
+ }
+pg_result $result -clear
+ } else {
+pg_result $result -clear
+ }
+}
+#ORDER_STATUS
+proc ostat { lda w_id RAISEERROR ora_compatible pg_storedprocs clientname } {
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set d_id [ RandomNumber 1 10 ]
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set c_id [ RandomNumber 1 3000 ]
+set y [ RandomNumber 1 100 ]
+if { $y <= 60 } {
+set byname 1
+ } else {
+set byname 0
+set name {}
+}
+if { $ora_compatible eq "true" } {
+set result [pg_exec $lda "exec ostat($w_id,$d_id,$c_id,$byname,'$name')" ]
+} else {
+if { $pg_storedprocs eq "true" } {
+set date [ gettimestamp ]
+set result [pg_exec $lda "call ostat($w_id,$d_id,$c_id,$byname,'$name','','',0.0,0,TO_TIMESTAMP('$date','YYYYMMDDHH24MISS')::timestamp without time zone,0,'')" ]
+ } else {
+set result [pg_exec $lda "select * from ostat($w_id,$d_id,$c_id,$byname,'$name') as (ol_i_id NUMERIC, ol_supply_w_id NUMERIC, ol_quantity NUMERIC, ol_amount NUMERIC, ol_delivery_d TIMESTAMP, out_os_c_id INTEGER, out_os_c_last VARCHAR, os_c_first VARCHAR, os_c_middle VARCHAR, os_c_balance NUMERIC, os_o_id INTEGER, os_entdate TIMESTAMP, os_o_carrier_id INTEGER)" ]
+ }
+}
+if {[pg_result $result -status] != "PGRES_TUPLES_OK"} {
+if { $RAISEERROR } {
+error "Order Status in $clientname : [pg_result $result -error]"
+ } else {
+puts "Order Status in $clientname : [pg_result $result -error]"
+ }
+pg_result $result -clear
+ } else {
+pg_result $result -clear
+ }
+}
+#DELIVERY
+proc delivery { lda w_id RAISEERROR ora_compatible pg_storedprocs clientname } {
+set carrier_id [ RandomNumber 1 10 ]
+set date [ gettimestamp ]
+if { $ora_compatible eq "true" } {
+set result [pg_exec $lda "exec delivery($w_id,$carrier_id,TO_TIMESTAMP($date,'YYYYMMDDHH24MISS'))" ]
+} else {
+if { $pg_storedprocs eq "true" } {
+set result [pg_exec $lda "call delivery($w_id,$carrier_id,TO_TIMESTAMP('$date','YYYYMMDDHH24MISS')::timestamp without time zone)" ]
+ } else {
+set result [pg_exec $lda "select delivery($w_id,$carrier_id)" ]
+ }
+}
+if {[pg_result $result -status] ni {"PGRES_TUPLES_OK" "PGRES_COMMAND_OK"}} {
+if { $RAISEERROR } {
+error "[pg_result $result -error]"
+error "Delivery in $clientname : [pg_result $result -error]"
+ } else {
+puts "Delivery in $clientname : [pg_result $result -error]"
+ }
+pg_result $result -clear
+ } else {
+pg_result $result -clear
+ }
+}
+#STOCK LEVEL
+proc slev { lda w_id stock_level_d_id RAISEERROR ora_compatible pg_storedprocs clientname } {
+set threshold [ RandomNumber 10 20 ]
+if { $ora_compatible eq "true" } {
+set result [pg_exec $lda "exec slev($w_id,$stock_level_d_id,$threshold)" ]
+} else {
+if { $pg_storedprocs eq "true" } {
+set result [pg_exec $lda "call slev($w_id,$stock_level_d_id,$threshold,0)"]
+ } else {
+set result [pg_exec $lda "select slev($w_id,$stock_level_d_id,$threshold)" ]
+ }
+}
+if {[pg_result $result -status] ni {"PGRES_TUPLES_OK" "PGRES_COMMAND_OK"}} {
+if { $RAISEERROR } {
+error "Stock Level in $clientname : [pg_result $result -error]"
+ } else {
+puts "Stock Level in $clientname : [pg_result $result -error]"
+ }
+pg_result $result -clear
+ } else {
+pg_result $result -clear
+ }
+}
+
+#RUN TPC-C
+promise::async simulate_client { clientname total_iterations host port user password db ora_compatible pg_storedprocs RAISEERROR KEYANDTHINK async_verbose async_delay } {
+set acno [ expr [ string trimleft [ lindex [ split $clientname ":" ] 1 ] ac ] * $async_delay ]
+if { $async_verbose } { puts "Delaying login of $clientname for $acno ms" }
+async_time $acno
+if { [ tsv::get application abort ] } { return "$clientname:abort before login" }
+if { $async_verbose } { puts "Logging in $clientname" }
+
+set lda [ ConnectToPostgresAsynch $host $port $user $password $db $RAISEERROR $clientname $async_verbose ]
+if { $ora_compatible eq "true" } {
+set result [ pg_exec $lda "exec dbms_output.disable" ]
+pg_result $result -clear
+ }
+pg_select $lda "select max(w_id) from warehouse" w_id_input_arr {
+set w_id_input $w_id_input_arr(max)
+ }
+#2.4.1.1 set warehouse_id stays constant for a given terminal
+set w_id [ RandomNumber 1 $w_id_input ]
+pg_select $lda "select max(d_id) from district" d_id_input_arr {
+set d_id_input $d_id_input_arr(max)
+}
+set stock_level_d_id [ RandomNumber 1 $d_id_input ]
+puts "Processing $total_iterations transactions with output suppressed..."
+set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
+for {set it 0} {$it < $total_iterations} {incr it} {
+if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
+set choice [ RandomNumber 1 23 ]
+if {$choice <= 10} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:neword" }
+if { $KEYANDTHINK } { async_keytime 18 $clientname neword $async_verbose }
+neword $lda $w_id $w_id_input $RAISEERROR $ora_compatible $pg_storedprocs $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname neword $async_verbose }
+} elseif {$choice <= 20} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:payment" }
+if { $KEYANDTHINK } { async_keytime 3 $clientname payment $async_verbose }
+payment $lda $w_id $w_id_input $RAISEERROR $ora_compatible $pg_storedprocs $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname payment $async_verbose }
+} elseif {$choice <= 21} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:delivery" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname delivery $async_verbose }
+delivery $lda $w_id $RAISEERROR $ora_compatible $pg_storedprocs $clientname
+if { $KEYANDTHINK } { async_thinktime 10 $clientname delivery $async_verbose }
+} elseif {$choice <= 22} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:slev" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname slev $async_verbose }
+slev $lda $w_id $stock_level_d_id $RAISEERROR $ora_compatible $pg_storedprocs $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname slev $async_verbose }
+} elseif {$choice <= 23} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:ostat" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname ostat $async_verbose }
+ostat $lda $w_id $RAISEERROR $ora_compatible $pg_storedprocs $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname ostat $async_verbose }
+ }
+ }
+pg_disconnect $lda
+if { $async_verbose } { puts "$clientname:complete" }
+return $clientname:complete
+ }
+for {set ac 1} {$ac <= $async_client} {incr ac} {
+set clientdesc "vuser$myposition:ac$ac"
+lappend clientlist $clientdesc
+lappend clients [simulate_client $clientdesc $total_iterations $host $port $user $password $db $ora_compatible $pg_storedprocs $RAISEERROR $KEYANDTHINK $async_verbose $async_delay]
+ }
+puts "Started asynchronous clients:$clientlist"
+set acprom [ promise::eventloop [ promise::all $clients ] ]
+puts "All asynchronous clients complete"
+if { $async_verbose } {
+foreach client $acprom { puts $client }
+ }
+ }
+ }}
+}
}
diff --git a/src/postgresql/pgopt.tcl b/src/postgresql/pgopt.tcl
index 309e38c9..6cb41967 100755
--- a/src/postgresql/pgopt.tcl
+++ b/src/postgresql/pgopt.tcl
@@ -151,7 +151,7 @@ upvar #0 configpostgresql configpostgresql
setlocaltpccvars $configpostgresql
#set matching fields in dialog to temporary dict
variable pgfields
-set pgfields [ dict create connection {pg_host {.tpc.f1.e1 get} pg_port {.tpc.f1.e2 get}} tpcc {pg_superuser {.tpc.f1.e3 get} pg_superuserpass {.tpc.f1.e4 get} pg_defaultdbase {.tpc.f1.e5 get} pg_user {.tpc.f1.e6 get} pg_pass {.tpc.f1.e7 get} pg_dbase {.tpc.f1.e8 get} pg_total_iterations {.tpc.f1.e15 get} pg_rampup {.tpc.f1.e21 get} pg_duration {.tpc.f1.e22 get} pg_count_ware $pg_count_ware pg_vacuum $pg_vacuum pg_dritasnap $pg_dritasnap pg_oracompat $pg_oracompat pg_storedprocs $pg_storedprocs pg_num_vu $pg_num_vu pg_total_iterations $pg_total_iterations pg_raiseerror $pg_raiseerror pg_keyandthink $pg_keyandthink pg_driver $pg_driver pg_rampup $pg_rampup pg_duration $pg_duration pg_allwarehouse $pg_allwarehouse pg_timeprofile $pg_timeprofile}]
+set pgfields [ dict create connection {pg_host {.tpc.f1.e1 get} pg_port {.tpc.f1.e2 get}} tpcc {pg_superuser {.tpc.f1.e3 get} pg_superuserpass {.tpc.f1.e4 get} pg_defaultdbase {.tpc.f1.e5 get} pg_user {.tpc.f1.e6 get} pg_pass {.tpc.f1.e7 get} pg_dbase {.tpc.f1.e8 get} pg_total_iterations {.tpc.f1.e15 get} pg_rampup {.tpc.f1.e21 get} pg_duration {.tpc.f1.e22 get} pg_async_client {.tpc.f1.e26 get} pg_async_delay {.tpc.f1.e27 get} pg_count_ware $pg_count_ware pg_vacuum $pg_vacuum pg_dritasnap $pg_dritasnap pg_oracompat $pg_oracompat pg_storedprocs $pg_storedprocs pg_num_vu $pg_num_vu pg_total_iterations $pg_total_iterations pg_raiseerror $pg_raiseerror pg_keyandthink $pg_keyandthink pg_driver $pg_driver pg_rampup $pg_rampup pg_duration $pg_duration pg_allwarehouse $pg_allwarehouse pg_timeprofile $pg_timeprofile pg_async_scale $pg_async_scale pg_async_verbose $pg_async_verbose}]
set whlist [ get_warehouse_list_for_spinbox ]
if { $pg_oracompat eq "true" } {
if { $pg_port eq "5432" } { set pg_port "5444" }
@@ -259,7 +259,7 @@ if { $pg_defaultdbase eq "edb" } { set pg_defaultdbase "postgres" }
}
}
set Prompt $Parent.f1.p9a
-ttk::label $Prompt -text "PostgreSQL Stored Procedures:"
+ttk::label $Prompt -text "PostgreSQL Stored Procedures :"
set Name $Parent.f1.e9a
ttk::checkbutton $Name -text "" -variable pg_storedprocs -onvalue "true" -offvalue "false"
if {$pg_oracompat == "true" } {
@@ -319,6 +319,10 @@ set pg_timeprofile "false"
.tpc.f1.e22 configure -state disabled
.tpc.f1.e23 configure -state disabled
.tpc.f1.e24 configure -state disabled
+.tpc.f1.e25 configure -state disabled
+.tpc.f1.e26 configure -state disabled
+.tpc.f1.e27 configure -state disabled
+.tpc.f1.e28 configure -state disabled
}
set Name $Parent.f1.r2
ttk::radiobutton $Name -value "timed" -text "Timed Driver Script" -variable pg_driver
@@ -330,6 +334,10 @@ bind .tpc.f1.r2 {
.tpc.f1.e22 configure -state normal
.tpc.f1.e23 configure -state normal
.tpc.f1.e24 configure -state normal
+.tpc.f1.e25 configure -state normal
+.tpc.f1.e26 configure -state normal
+.tpc.f1.e27 configure -state normal
+.tpc.f1.e28 configure -state normal
}
set Name $Parent.f1.e15
set Prompt $Parent.f1.p15
@@ -347,6 +355,17 @@ ttk::checkbutton $Name -text "" -variable pg_raiseerror -onvalue "true" -offvalu
ttk::label $Prompt -text "Keying and Thinking Time :"
set Name $Parent.f1.e17
ttk::checkbutton $Name -text "" -variable pg_keyandthink -onvalue "true" -offvalue "false"
+bind .tpc.f1.e17 {
+if { $pg_driver eq "timed" } {
+if { $pg_keyandthink eq "true" } {
+set pg_async_scale "false"
+set pg_async_verbose "false"
+.tpc.f1.e26 configure -state disabled
+.tpc.f1.e27 configure -state disabled
+.tpc.f1.e28 configure -state disabled
+ }
+ }
+}
grid $Prompt -column 0 -row 18 -sticky e
grid $Name -column 1 -row 18 -sticky w
set Prompt $Parent.f1.p19
@@ -403,6 +422,59 @@ set Name $Parent.f1.e24
if {$pg_driver == "test" } {
$Name configure -state disabled
}
+ set Name $Parent.f1.e25
+ set Prompt $Parent.f1.p25
+ ttk::label $Prompt -text "Asynchronous Scaling :"
+ttk::checkbutton $Name -text "" -variable pg_async_scale -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 25 -sticky e
+ grid $Name -column 1 -row 25 -sticky ew
+if {$pg_driver == "test" } {
+ set pg_async_scale "false"
+ $Name configure -state disabled
+ }
+bind .tpc.f1.e25 {
+if { $pg_async_scale eq "true" } {
+set pg_async_verbose "false"
+.tpc.f1.e26 configure -state disabled
+.tpc.f1.e27 configure -state disabled
+.tpc.f1.e28 configure -state disabled
+ } else {
+if { $pg_driver eq "timed" } {
+set pg_keyandthink "true"
+.tpc.f1.e26 configure -state normal
+.tpc.f1.e27 configure -state normal
+.tpc.f1.e28 configure -state normal
+ }
+ }
+}
+set Name $Parent.f1.e26
+ set Prompt $Parent.f1.p26
+ ttk::label $Prompt -text "Asynch Clients per Virtual User :"
+ ttk::entry $Name -width 30 -textvariable pg_async_client
+ grid $Prompt -column 0 -row 26 -sticky e
+ grid $Name -column 1 -row 26 -sticky ew
+if {$pg_driver == "test" || $pg_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+set Name $Parent.f1.e27
+ set Prompt $Parent.f1.p27
+ ttk::label $Prompt -text "Asynch Client Login Delay :"
+ ttk::entry $Name -width 30 -textvariable pg_async_delay
+ grid $Prompt -column 0 -row 27 -sticky e
+ grid $Name -column 1 -row 27 -sticky ew
+if {$pg_driver == "test" || $pg_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+ set Name $Parent.f1.e28
+ set Prompt $Parent.f1.p28
+ ttk::label $Prompt -text "Asynchronous Verbose :"
+ttk::checkbutton $Name -text "" -variable pg_async_verbose -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 28 -sticky e
+ grid $Name -column 1 -row 28 -sticky ew
+if {$pg_driver == "test" || $pg_async_scale == "false" } {
+ set pg_async_verbose "false"
+ $Name configure -state disabled
+ }
}
#This is the Cancel button variables stay as before
set Name $Parent.b2
diff --git a/src/redis/redisoltp.tcl b/src/redis/redisoltp.tcl
index b1cb55c0..015ea4f7 100755
--- a/src/redis/redisoltp.tcl
+++ b/src/redis/redisoltp.tcl
@@ -718,8 +718,9 @@ setlocaltpccvars $configredis
ed_edit_clear
.ed_mainFrame.notebook select .ed_mainFrame.mainwin
set _ED(packagekeyname) "Redis TPC-C"
+if { !$redis_async_scale } {
+#REGULAR TIMED SCRIPT
.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
-#THIS SCRIPT TO BE RUN WITH VIRTUAL USER OUTPUT ENABLED
#EDITABLE OPTIONS##################################################
set library $library ;# Redis Library
set total_iterations $redis_total_iterations ;# Number of transactions before logging off
@@ -1108,4 +1109,430 @@ if { $KEYANDTHINK } { thinktime 5 }
}
$redis QUIT
}
-}}}
+}}
+} else {
+#ASYNCHRONOUS TIMED SCRIPT
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end "#!/usr/local/bin/tclsh8.6
+#EDITABLE OPTIONS##################################################
+set library $library ;# Redis Library
+set total_iterations $redis_total_iterations ;# Number of transactions before logging off
+set RAISEERROR \"$redis_raiseerror\" ;# Exit script on Redis error (true or false)
+set KEYANDTHINK \"$redis_keyandthink\" ;# Time for user thinking and keying (true or false)
+set rampup $redis_rampup; # Rampup time in minutes before first Transaction Count is taken
+set duration $redis_duration; # Duration in minutes before second Transaction Count is taken
+set mode \"$opmode\" ;# HammerDB operational mode
+set host \"$redis_host\" ;# Address of the server hosting Redis
+set port \"$redis_port\" ;# Port of the Redis Server, defaults to 6379
+set namespace \"$redis_namespace\" ;# Namespace containing the TPC Schema
+set async_client $redis_async_client;# Number of asynchronous clients per Vuser
+set async_verbose $redis_async_verbose;# Report activity of asynchronous clients
+set async_delay $redis_async_delay;# Delay in ms between logins of asynchronous clients
+#EDITABLE OPTIONS##################################################
+"
+.ed_mainFrame.mainwin.textFrame.left.text fastinsert end {#LOAD LIBRARIES AND MODULES
+if [catch {package require $library} message] { error "Failed to load $library - $message" }
+if [catch {::tcl::tm::path add modules} ] { error "Failed to find modules directory" }
+if [catch {package require tpcccommon} ] { error "Failed to load tpcc common functions" } else { namespace import tpcccommon::* }
+if [catch {package require promise } message] { error "Failed to load promise package for asynchronous clients" }
+
+if { [ chk_thread ] eq "FALSE" } {
+error "Redis Timed Script must be run in Thread Enabled Interpreter"
+}
+set rema [ lassign [ findvuposition ] myposition totalvirtualusers ]
+switch $myposition {
+1 {
+if { $mode eq "Local" || $mode eq "Master" } {
+if {[catch {set redis [redis $host $port ]}]} {
+puts stderr "Error, the connection to $host:$port could not be established"
+return
+ } else {
+if {[ $redis ping ] eq "PONG" } {
+puts "Connection made to Redis at $host:$port"
+if { [ string is integer -strict $namespace ]} {
+puts "Selecting Namespace $namespace"
+$redis SELECT $namespace
+ }
+ } else {
+puts stderr "Error, No response from redis server at $host:$port"
+ }
+ }
+set ramptime 0
+puts "Beginning rampup time of $rampup minutes"
+set rampup [ expr $rampup*60000 ]
+while {$ramptime != $rampup} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set ramptime [ expr $ramptime+6000 ]
+if { ![ expr {$ramptime % 60000} ] } {
+puts "Rampup [ expr $ramptime / 60000 ] minutes complete ..."
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Rampup complete, Taking start Transaction Count."
+set info_list [ split [ $redis info ] "\n" ]
+foreach line $info_list {
+ if {[string match {total_commands_processed:*} $line]} {
+regexp {\:([0-9]+)} $line all start_trans
+ }
+}
+set COUNT_WARE [ $redis GET COUNT_WARE ]
+set DIST_PER_WARE [ $redis GET DIST_PER_WARE ]
+set start_nopm 0
+for {set w_id 1} {$w_id <= $COUNT_WARE } {incr w_id } {
+for {set d_id 1} {$d_id <= $DIST_PER_WARE } {incr d_id } {
+incr start_nopm [ $redis HMGET DISTRICT:$w_id:$d_id D_NEXT_O_ID ]
+ }
+}
+puts "Timing test period of $duration in minutes"
+set testtime 0
+set durmin $duration
+set duration [ expr $duration*60000 ]
+while {$testtime != $duration} {
+if { [ tsv::get application abort ] } { break } else { after 6000 }
+set testtime [ expr $testtime+6000 ]
+if { ![ expr {$testtime % 60000} ] } {
+puts -nonewline "[ expr $testtime / 60000 ] ...,"
+ }
+}
+if { [ tsv::get application abort ] } { break }
+puts "Test complete, Taking end Transaction Count."
+set info_list [ split [ $redis info ] "\n" ]
+foreach line $info_list {
+ if {[string match {total_commands_processed:*} $line]} {
+regexp {\:([0-9]+)} $line all end_trans
+ }
+}
+set end_nopm 0
+for {set w_id 1} {$w_id <= $COUNT_WARE } {incr w_id } {
+for {set d_id 1} {$d_id <= $DIST_PER_WARE } {incr d_id } {
+incr end_nopm [ $redis HMGET DISTRICT:$w_id:$d_id D_NEXT_O_ID ]
+ }
+}
+set tpm [ expr {($end_trans - $start_trans)/$durmin} ]
+set nopm [ expr {($end_nopm - $start_nopm)/$durmin} ]
+puts "[ expr $totalvirtualusers - 1 ] VU \* $async_client AC \= [ expr ($totalvirtualusers - 1) * $async_client ] Active Sessions configured"
+puts "TEST RESULT : System achieved $tpm Redis TPM at $nopm NOPM"
+tsv::set application abort 1
+if { $mode eq "Master" } { eval [subst {thread::send -async $MASTER { remote_command ed_kill_vusers }}] }
+ } else {
+puts "Operating in Slave Mode, No Snapshots taken..."
+ }
+$redis QUIT
+ }
+default {
+#TIMESTAMP
+proc gettimestamp { } {
+set tstamp [ clock format [ clock seconds ] -format %Y%m%d%H%M%S ]
+return $tstamp
+}
+#NEW ORDER
+proc neword { redis no_w_id w_id_input RAISEERROR clientname } {
+set no_d_id [ RandomNumber 1 10 ]
+set no_c_id [ RandomNumber 1 3000 ]
+set ol_cnt [ RandomNumber 5 15 ]
+set date [ gettimestamp ]
+set no_o_all_local 0
+foreach { no_c_discount no_c_last no_c_credit } [ $redis HMGET CUSTOMER:$no_w_id:$no_d_id:$no_c_id C_DISCOUNT C_LAST C_CREDIT ] {}
+set no_w_tax [ $redis HMGET WAREHOUSE:$no_w_id W_TAX ]
+set no_d_tax [ $redis HMGET DISTRICT:$no_w_id:$no_d_id D_TAX ]
+set d_next_o_id [ $redis HINCRBY DISTRICT:$no_w_id:$no_d_id D_NEXT_O_ID 1 ]
+set o_id $d_next_o_id
+$redis HMSET ORDERS:$no_w_id:$no_d_id:$o_id O_ID $o_id O_C_ID $no_c_id O_D_ID $no_d_id O_W_ID $no_w_id O_ENTRY_D $date O_CARRIER_ID "" O_OL_CNT $ol_cnt NO_ALL_LOCAL $no_o_all_local
+$redis LPUSH ORDERS_OSTAT_QUERY:$no_w_id:$no_d_id:$no_c_id $o_id
+$redis HMSET NEW_ORDER:$no_w_id:$no_d_id:$o_id NO_O_ID $o_id NO_D_ID $no_d_id NO_W_ID $no_w_id
+$redis LPUSH NEW_ORDER_IDS:$no_w_id:$no_d_id $o_id
+set rbk [ RandomNumber 1 100 ]
+for {set loop_counter 1} {$loop_counter <= $ol_cnt} {incr loop_counter} {
+if { ($loop_counter eq $ol_cnt) && ($rbk eq 1) } {
+#No Rollback Support in Redis
+set no_ol_i_id 100001
+#puts "New Order:Invalid Item id:$no_ol_i_id (intentional error)"
+return
+ } else {
+set no_ol_i_id [ RandomNumber 1 100000 ]
+ }
+set x [ RandomNumber 1 100 ]
+if { $x > 1 } {
+set no_ol_supply_w_id $no_w_id
+ } else {
+set no_ol_supply_w_id $no_w_id
+set no_o_all_local 0
+while { ($no_ol_supply_w_id eq $no_w_id) && ($w_id_input != 1) } {
+set no_ol_supply_w_id [ RandomNumber 1 $w_id_input ]
+ }
+ }
+set no_ol_quantity [ RandomNumber 1 10 ]
+foreach { no_i_name no_i_price no_i_data } [ $redis HMGET ITEM:$no_ol_i_id I_NAME I_PRICE I_DATA ] {}
+foreach { no_s_quantity no_s_data no_s_dist_01 no_s_dist_02 no_s_dist_03 no_s_dist_04 no_s_dist_05 no_s_dist_06 no_s_dist_07 no_s_dist_08 no_s_dist_09 no_s_dist_10 } [ $redis HMGET STOCK:$no_ol_supply_w_id:$no_ol_i_id S_QUANTITY S_DATA S_DIST_01 S_DIST_02 S_DIST_03 S_DIST_04 S_DIST_05 S_DIST_06 S_DIST_07 S_DIST_08 S_DIST_09 S_DIST_10 ] {}
+if { $no_s_quantity > $no_ol_quantity } {
+set no_s_quantity [ expr $no_s_quantity - $no_ol_quantity ]
+ } else {
+set no_s_quantity [ expr ($no_s_quantity - $no_ol_quantity) + 91 ]
+ }
+$redis HMSET STOCK:$no_ol_supply_w_id:$no_ol_i_id S_QUANTITY $no_s_quantity
+set no_ol_amount [ expr $no_ol_quantity * $no_i_price * ( 1 + $no_w_tax + $no_d_tax ) * ( 1 - $no_c_discount ) ]
+switch $no_d_id {
+1 { set no_ol_dist_info $no_s_dist_01 }
+2 { set no_ol_dist_info $no_s_dist_02 }
+3 { set no_ol_dist_info $no_s_dist_03 }
+4 { set no_ol_dist_info $no_s_dist_04 }
+5 { set no_ol_dist_info $no_s_dist_05 }
+6 { set no_ol_dist_info $no_s_dist_06 }
+7 { set no_ol_dist_info $no_s_dist_07 }
+8 { set no_ol_dist_info $no_s_dist_08 }
+9 { set no_ol_dist_info $no_s_dist_09 }
+10 { set no_ol_dist_info $no_s_dist_10 }
+ }
+$redis HMSET ORDER_LINE:$no_w_id:$no_d_id:$o_id:$loop_counter OL_O_ID $o_id OL_D_ID $no_d_id OL_W_ID $no_w_id OL_NUMBER $loop_counter OL_I_ID $no_ol_i_id OL_SUPPLY_W_ID $no_ol_supply_w_id OL_QUANTITY $no_ol_quantity OL_AMOUNT $no_ol_amount OL_DIST_INFO $no_ol_dist_info OL_DELIVERY_D ""
+$redis LPUSH ORDER_LINE_NUMBERS:$no_w_id:$no_d_id:$o_id $loop_counter
+$redis ZADD ORDER_LINE_SLEV_QUERY:$no_w_id:$no_d_id $o_id $no_ol_i_id
+ }
+ ;
+ }
+
+#PAYMENT
+proc payment { redis p_w_id w_id_input RAISEERROR clientname } {
+#2.5.1.1 The home warehouse id remains the same for each terminal
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set p_d_id [ RandomNumber 1 10 ]
+#2.5.1.2 customer selected 60% of time by name and 40% of time by number
+set x [ RandomNumber 1 100 ]
+set y [ RandomNumber 1 100 ]
+if { $x <= 85 } {
+set p_c_d_id $p_d_id
+set p_c_w_id $p_w_id
+} else {
+#use a remote warehouse
+set p_c_d_id [ RandomNumber 1 10 ]
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+while { ($p_c_w_id == $p_w_id) && ($w_id_input != 1) } {
+set p_c_w_id [ RandomNumber 1 $w_id_input ]
+ }
+}
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set p_c_id [ RandomNumber 1 3000 ]
+if { $y <= 60 } {
+#use customer name
+#C_LAST is generated
+set byname 1
+ } else {
+#use customer number
+set byname 0
+set name {}
+ }
+#2.5.1.3 random amount from 1 to 5000
+set p_h_amount [ RandomNumber 1 5000 ]
+#2.5.1.4 date selected from SUT
+set h_date [ gettimestamp ]
+#2.5.2.1 Payment Transaction
+#From Redis 2.6 can do the following
+#$redis HINCRBYFLOAT WAREHOUSE:$p_w_id W_YTD $p_h_amount
+$redis HMSET WAREHOUSE:$p_w_id W_YTD [ expr [ $redis HMGET WAREHOUSE:$p_w_id W_YTD ] + $p_h_amount ]
+foreach { p_w_street_1 p_w_street_2 p_w_city p_w_state p_w_zip p_w_name } [ $redis HMGET WAREHOUSE:$p_w_id W_STREET_1 W_STREET_2 W_CITY W_STATE W_ZIP W_NAME ] {}
+#From Redis 2.6 can do the following
+#$redis HINCRBYFLOAT DISTRICT:$p_w_id:$p_d_id D_YTD $p_h_amount
+$redis HMSET DISTRICT:$p_w_id:$p_d_id D_YTD [ expr [ $redis HMGET DISTRICT:$p_w_id:$p_d_id D_YTD ] + $p_h_amount ]
+foreach { p_d_street_1 p_d_street_2 p_d_city p_d_state p_d_zip p_d_name } [ $redis HMGET DISTRICT:$p_w_id:$p_d_id D_STREET_1 D_STREET_2 D_CITY D_STATE D_ZIP D_NAME ] {}
+if { $byname eq 1 } {
+set namecnt [ $redis LLEN CUSTOMER_OSTAT_PMT_QUERY:$p_w_id:$p_d_id:$name ]
+set cust_last_list [ $redis LRANGE CUSTOMER_OSTAT_PMT_QUERY:$p_w_id:$p_d_id:$name 0 $namecnt ]
+if { [ expr {$namecnt % 2} ] eq 1 } {
+incr namecnt
+ }
+foreach cust_id $cust_last_list {
+set first_name [ $redis HMGET CUSTOMER:$p_w_id:$p_d_id:$cust_id C_FIRST ]
+lappend cust_first_list $first_name
+set first_to_id($first_name) $cust_id
+ }
+set cust_first_list [ lsort $cust_first_list ]
+set id_to_query $first_to_id([ lindex $cust_first_list [ expr ($namecnt/2)-1 ] ])
+foreach { p_c_first p_c_middle p_c_id p_c_street_1 p_c_street_2 p_c_city p_c_state p_c_zip p_c_phone p_c_credit p_c_credit_lim p_c_discount p_c_balance p_c_since } [ $redis HMGET CUSTOMER:$p_c_w_id:$p_c_d_id:$id_to_query C_FIRST C_MIDDLE C_ID C_STREET_1 C_STREET_2 C_CITY C_STATE C_ZIP C_PHONE C_CREDIT C_CREDIT_LIM C_DISCOUNT C_BALANCE C_SINCE ] {}
+set p_c_last $name
+ } else {
+foreach { p_c_first p_c_middle p_c_last p_c_street_1 p_c_street_2 p_c_city p_c_state p_c_zip p_c_phone p_c_credit p_c_credit_lim p_c_discount p_c_balance p_c_since } [ $redis HMGET CUSTOMER:$p_c_w_id:$p_c_d_id:$p_c_id C_FIRST C_MIDDLE C_LAST C_STREET_1 C_STREET_2 C_CITY C_STATE C_ZIP C_PHONE C_CREDIT C_CREDIT_LIM C_DISCOUNT C_BALANCE C_SINCE ] {}
+ }
+set p_c_balance [ expr $p_c_balance + $p_h_amount ]
+set p_c_data [ $redis HMGET CUSTOMER:$p_c_w_id:$p_c_d_id:$p_c_id C_DATA ]
+set tstamp [ gettimestamp ]
+if { $p_c_credit eq "BC" } {
+set h_data "$p_w_name $p_d_name"
+set p_c_new_data "$p_c_id $p_c_d_id $p_c_w_id $p_d_id $p_w_id $p_h_amount $tstamp $h_data"
+set p_c_new_data [ string range "$p_c_new_data $p_c_data" 0 [ expr 500 - [ string length $p_c_new_data ] ] ]
+$redis HMSET CUSTOMER:$p_c_w_id:$p_c_d_id:$p_c_id C_BALANCE $p_c_balance C_DATA $p_c_new_data
+ } else {
+$redis HMSET CUSTOMER:$p_c_w_id:$p_c_d_id:$p_c_id C_BALANCE $p_c_balance
+set h_data "$p_w_name $p_d_name"
+ }
+$redis HMSET HISTORY:$p_c_w_id:$p_c_d_id:$p_c_id:$tstamp H_C_ID $p_c_id H_C_D_ID $p_c_d_id H_C_W_ID $p_c_w_id H_W_ID $p_w_id H_D_ID $p_d_id H_DATE $tstamp H_AMOUNT $p_h_amount H_DATA $h_data
+ ;
+ }
+
+#ORDER_STATUS
+proc ostat { redis w_id RAISEERROR clientname } {
+#2.5.1.1 select district id randomly from home warehouse where d_w_id = d_id
+set d_id [ RandomNumber 1 10 ]
+set nrnd [ NURand 255 0 999 123 ]
+set name [ randname $nrnd ]
+set c_id [ RandomNumber 1 3000 ]
+set y [ RandomNumber 1 100 ]
+if { $y <= 60 } {
+set byname 1
+ } else {
+set byname 0
+set name {}
+}
+if { $byname eq 1 } {
+set namecnt [ $redis LLEN CUSTOMER_OSTAT_PMT_QUERY:$w_id:$d_id:$name ]
+set cust_last_list [ $redis LRANGE CUSTOMER_OSTAT_PMT_QUERY:$w_id:$d_id:$name 0 $namecnt ]
+if { [ expr {$namecnt % 2} ] eq 1 } {
+incr namecnt
+ }
+foreach cust_id $cust_last_list {
+set first_name [ $redis HMGET CUSTOMER:$w_id:$d_id:$cust_id C_FIRST ]
+lappend cust_first_list $first_name
+set first_to_id($first_name) $cust_id
+ }
+set cust_first_list [ lsort $cust_first_list ]
+set id_to_query $first_to_id([ lindex $cust_first_list [ expr ($namecnt/2)-1 ] ])
+foreach { os_c_balance os_c_first os_c_middle os_c_id } [ $redis HMGET CUSTOMER:$w_id:$d_id:$id_to_query C_BALANCE C_FIRST C_MIDDLE C_ID ] {}
+set os_c_last $name
+ } else {
+foreach { os_c_balance os_c_first os_c_middle os_c_last } [ $redis HMGET CUSTOMER:$w_id:$d_id:$c_id C_BALANCE C_FIRST C_MIDDLE C_LAST ] {}
+set os_c_id $c_id
+ }
+set o_id_len [ $redis LLEN ORDERS_OSTAT_QUERY:$w_id:$d_id:$c_id ]
+if { $o_id_len eq 0 } {
+#puts "No orders for customer"
+ } else {
+set o_id_list [ lindex [ lsort [ $redis LRANGE ORDERS_OSTAT_QUERY:$w_id:$d_id:$c_id 0 $o_id_len ] ] end ]
+foreach { o_id o_carrier_id o_entry_d } [ $redis HMGET ORDERS:$w_id:$d_id:$o_id_list O_ID O_CARRIER_ID O_ENTRY_D ] {}
+set os_cline_len [ $redis LLEN ORDER_LINE_NUMBERS:$w_id:$d_id:$o_id ]
+set os_cline_list [ lsort -integer [ $redis LRANGE ORDER_LINE_NUMBERS:$w_id:$d_id:$o_id 0 $os_cline_len ] ]
+set i 0
+foreach ol [ split $os_cline_list ] {
+foreach { ol_i_id ol_supply_w_id ol_quantity ol_amount ol_delivery_d } [ $redis HMGET ORDER_LINE:$w_id:$d_id:$o_id:$ol OL_I_ID OL_SUPPLY_W_ID OL_QUANTITY OL_AMOUNT OL_DELIVERY_D ] {}
+set os_ol_i_id($i) $ol_i_id
+set os_ol_supply_w_id($i) $ol_supply_w_id
+set os_ol_quantity($i) $ol_quantity
+set os_ol_amount($i) $ol_amount
+set os_ol_delivery_d($i) $ol_delivery_d
+incr i
+#puts "Item Status $i:$ol_i_id $ol_supply_w_id $ol_quantity $ol_amount $ol_delivery_d"
+ }
+ ;
+ }
+}
+#DELIVERY
+proc delivery { redis w_id RAISEERROR clientname } {
+set carrier_id [ RandomNumber 1 10 ]
+set date [ gettimestamp ]
+for {set loop_counter 1} {$loop_counter <= 10} {incr loop_counter} {
+set d_d_id $loop_counter
+set d_no_o_id [ $redis LPOP NEW_ORDER_IDS:$w_id:$d_d_id ]
+$redis DEL NEW_ORDER:$w_id:$d_d_id:$d_no_o_id
+set d_c_id [ $redis HMGET ORDERS:$w_id:$d_d_id:$d_no_o_id O_C_ID ]
+$redis HMSET ORDERS:$w_id:$d_d_id:$d_no_o_id O_CARRIER_ID $carrier_id
+set ol_deliv_len [ $redis LLEN ORDER_LINE_NUMBERS:$w_id:$d_d_id:$d_no_o_id ]
+set ol_deliv_list [ $redis LRANGE ORDER_LINE_NUMBERS:$w_id:$d_d_id:$d_no_o_id 0 $ol_deliv_len ]
+set d_ol_total 0
+foreach ol [ split $ol_deliv_list ] {
+set d_ol_total [expr $d_ol_total + [ $redis HMGET ORDER_LINE:$w_id:$d_d_id:$d_no_o_id:$ol OL_AMOUNT ]]
+$redis HMSET ORDER_LINE:$w_id:$d_d_id:$d_no_o_id:$ol OL_DELIVERY_D $date
+ }
+#From Redis 2.6 can do the following
+#$redis HINCRBYFLOAT CUSTOMER:$w_id:$d_d_id:$d_c_id C_BALANCE $d_ol_total
+$redis HMSET CUSTOMER:$w_id:$d_d_id:$d_c_id C_BALANCE [ expr [ $redis HMGET CUSTOMER:$w_id:$d_d_id:$d_c_id C_BALANCE ] + $d_ol_total ]
+ }
+ ;
+}
+#STOCK LEVEL
+proc slev { redis w_id stock_level_d_id RAISEERROR clientname } {
+set stock_level 0
+set threshold [ RandomNumber 10 20 ]
+set st_o_id [ $redis HMGET DISTRICT:$w_id:$stock_level_d_id D_NEXT_O_ID ]
+set item_id_list [ $redis ZRANGE ORDER_LINE_SLEV_QUERY:$w_id:$stock_level_d_id [ expr $st_o_id - 19 ] $st_o_id ]
+foreach item_id [ split [ lsort -unique $item_id_list ] ] {
+ if { [ $redis HMGET STOCK:$w_id:$item_id S_QUANTITY ] < $threshold } { incr stock_level } }
+ ;
+ }
+
+#RUN TPC-C
+promise::async simulate_client { clientname total_iterations host port namespace RAISEERROR KEYANDTHINK async_verbose async_delay } {
+set acno [ expr [ string trimleft [ lindex [ split $clientname ":" ] 1 ] ac ] * $async_delay ]
+if { $async_verbose } { puts "Delaying login of $clientname for $acno ms" }
+async_time $acno
+if { [ tsv::get application abort ] } { return "$clientname:abort before login" }
+if { $async_verbose } { puts "Logging in $clientname" }
+if {[catch {set redis [redis $host $port ]} message]} {
+if { $RAISEERROR } {
+puts "$clientname:login failed:$message"
+return "$clientname:login failed:$message"
+ }
+ } else {
+if {[ $redis ping ] eq "PONG" } {
+if { $async_verbose } { puts "Connection made to Redis at $clientname:$host:$port" }
+if { [ string is integer -strict $namespace ]} {
+if { $async_verbose } { puts "Selecting Namespace $clientname:$namespace" }
+$redis SELECT $namespace
+ }
+ } else {
+puts "$clientname:No response from redis server at $host:$port"
+return "$clientname:No response from redis server at $host:$port"
+ }
+ }
+set w_id_input [ $redis GET COUNT_WARE ]
+#2.4.1.1 set warehouse_id stays constant for a given terminal
+set w_id [ RandomNumber 1 $w_id_input ]
+set d_id_input [ $redis GET DIST_PER_WARE ]
+set stock_level_d_id [ RandomNumber 1 $d_id_input ]
+puts "Processing $total_iterations transactions with output suppressed..."
+set abchk 1; set abchk_mx 1024; set hi_t [ expr {pow([ lindex [ time {if { [ tsv::get application abort ] } { break }} ] 0 ],2)}]
+for {set it 0} {$it < $total_iterations} {incr it} {
+if { [expr {$it % $abchk}] eq 0 } { if { [ time {if { [ tsv::get application abort ] } { break }} ] > $hi_t } { set abchk [ expr {min(($abchk * 2), $abchk_mx)}]; set hi_t [ expr {$hi_t * 2} ] } }
+set choice [ RandomNumber 1 23 ]
+if {$choice <= 10} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:neword" }
+if { $KEYANDTHINK } { async_keytime 18 $clientname neword $async_verbose }
+neword $redis $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname neword $async_verbose }
+} elseif {$choice <= 20} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:payment" }
+if { $KEYANDTHINK } { async_keytime 3 $clientname payment $async_verbose }
+payment $redis $w_id $w_id_input $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 12 $clientname payment $async_verbose }
+} elseif {$choice <= 21} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:delivery" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname delivery $async_verbose }
+delivery $redis $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 10 $clientname delivery $async_verbose }
+} elseif {$choice <= 22} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:slev" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname slev $async_verbose }
+slev $redis $w_id $stock_level_d_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname slev $async_verbose }
+} elseif {$choice <= 23} {
+if { $async_verbose } { puts "$clientname:w_id:$w_id:ostat" }
+if { $KEYANDTHINK } { async_keytime 2 $clientname ostat $async_verbose }
+ostat $redis $w_id $RAISEERROR $clientname
+if { $KEYANDTHINK } { async_thinktime 5 $clientname ostat $async_verbose }
+ }
+ }
+$redis QUIT
+if { $async_verbose } { puts "$clientname:complete" }
+return $clientname:complete
+ }
+for {set ac 1} {$ac <= $async_client} {incr ac} {
+set clientdesc "vuser$myposition:ac$ac"
+lappend clientlist $clientdesc
+lappend clients [simulate_client $clientdesc $total_iterations $host $port $namespace $RAISEERROR $KEYANDTHINK $async_verbose $async_delay]
+ }
+puts "Started asynchronous clients:$clientlist"
+set acprom [ promise::eventloop [ promise::all $clients ] ]
+puts "All asynchronous clients complete"
+if { $async_verbose } {
+foreach client $acprom { puts $client }
+ }
+ }
+}}
+}
+}
diff --git a/src/redis/redisopt.tcl b/src/redis/redisopt.tcl
index 02cd41da..76f0e459 100755
--- a/src/redis/redisopt.tcl
+++ b/src/redis/redisopt.tcl
@@ -92,7 +92,7 @@ set $val [ dict get $attributes $val ]
}}}}
#set matching fields in dialog to temporary dict
variable redfields
-set redfields [ dict create connection {redis_host {.tpc.f1.e1 get} redis_port {.tpc.f1.e2 get}} tpcc {redis_namespace {.tpc.f1.e3 get} redis_total_iterations {.tpc.f1.e8 get} redis_rampup {.tpc.f1.e11 get} redis_duration {.tpc.f1.e12 get} redis_count_ware $redis_count_ware redis_num_vu $redis_num_vu redis_total_iterations $redis_total_iterations redis_raiseerror $redis_raiseerror redis_keyandthink $redis_keyandthink redis_driver $redis_driver redis_rampup $redis_rampup redis_duration $redis_duration redis_allwarehouse $redis_allwarehouse redis_timeprofile $redis_timeprofile}]
+set redfields [ dict create connection {redis_host {.tpc.f1.e1 get} redis_port {.tpc.f1.e2 get}} tpcc {redis_namespace {.tpc.f1.e3 get} redis_total_iterations {.tpc.f1.e8 get} redis_rampup {.tpc.f1.e11 get} redis_duration {.tpc.f1.e12 get} redis_async_client {.tpc.f1.e16 get} redis_async_delay {.tpc.f1.e17 get} redis_count_ware $redis_count_ware redis_num_vu $redis_num_vu redis_total_iterations $redis_total_iterations redis_raiseerror $redis_raiseerror redis_keyandthink $redis_keyandthink redis_driver $redis_driver redis_rampup $redis_rampup redis_duration $redis_duration redis_allwarehouse $redis_allwarehouse redis_timeprofile $redis_timeprofile redis_async_scale $redis_async_scale redis_async_verbose $redis_async_verbose}]
set whlist [ get_warehouse_list_for_spinbox ]
catch "destroy .tpc"
ttk::toplevel .tpc
@@ -187,6 +187,11 @@ set redis_timeprofile "false"
.tpc.f1.e12 configure -state disabled
.tpc.f1.e13 configure -state disabled
.tpc.f1.e14 configure -state disabled
+.tpc.f1.e15 configure -state disabled
+.tpc.f1.e16 configure -state disabled
+.tpc.f1.e17 configure -state disabled
+.tpc.f1.e18 configure -state disabled
+
}
set Name $Parent.f1.r2
ttk::radiobutton $Name -value "timed" -text "Timed Driver Script" -variable redis_driver
@@ -196,6 +201,10 @@ bind .tpc.f1.r2 {
.tpc.f1.e12 configure -state normal
.tpc.f1.e13 configure -state normal
.tpc.f1.e14 configure -state normal
+.tpc.f1.e15 configure -state normal
+.tpc.f1.e16 configure -state normal
+.tpc.f1.e17 configure -state normal
+.tpc.f1.e18 configure -state normal
}
set Name $Parent.f1.e8
set Prompt $Parent.f1.p8
@@ -213,6 +222,17 @@ ttk::checkbutton $Name -text "" -variable redis_raiseerror -onvalue "true" -offv
ttk::label $Prompt -text "Keying and Thinking Time :"
set Name $Parent.f1.e10
ttk::checkbutton $Name -text "" -variable redis_keyandthink -onvalue "true" -offvalue "false"
+bind .tpc.f1.e10 {
+if { $redis_driver eq "timed" } {
+if { $redis_keyandthink eq "true" } {
+set redis_async_scale "false"
+set redis_async_verbose "false"
+.tpc.f1.e16 configure -state disabled
+.tpc.f1.e17 configure -state disabled
+.tpc.f1.e18 configure -state disabled
+ }
+ }
+}
grid $Prompt -column 0 -row 11 -sticky e
grid $Name -column 1 -row 11 -sticky w
set Name $Parent.f1.e11
@@ -251,6 +271,59 @@ ttk::checkbutton $Name -text "" -variable redis_timeprofile -onvalue "true" -off
if {$redis_driver == "test" } {
$Name configure -state disabled
}
+ set Name $Parent.f1.e15
+ set Prompt $Parent.f1.p15
+ ttk::label $Prompt -text "Asynchronous Scaling :"
+ttk::checkbutton $Name -text "" -variable redis_async_scale -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 16 -sticky e
+ grid $Name -column 1 -row 16 -sticky ew
+if {$redis_driver == "test" } {
+ set redis_async_scale "false"
+ $Name configure -state disabled
+ }
+bind .tpc.f1.e15 {
+if { $redis_async_scale eq "true" } {
+set redis_async_verbose "false"
+.tpc.f1.e16 configure -state disabled
+.tpc.f1.e17 configure -state disabled
+.tpc.f1.e18 configure -state disabled
+ } else {
+if { $redis_driver eq "timed" } {
+set redis_keyandthink "true"
+.tpc.f1.e16 configure -state normal
+.tpc.f1.e17 configure -state normal
+.tpc.f1.e18 configure -state normal
+ }
+ }
+}
+ set Name $Parent.f1.e16
+ set Prompt $Parent.f1.p16
+ ttk::label $Prompt -text "Asynch Clients per Virtual User :"
+ ttk::entry $Name -width 30 -textvariable redis_async_client
+ grid $Prompt -column 0 -row 17 -sticky e
+ grid $Name -column 1 -row 17 -sticky ew
+if {$redis_driver == "test" || $redis_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+set Name $Parent.f1.e17
+ set Prompt $Parent.f1.p17
+ ttk::label $Prompt -text "Asynch Client Login Delay :"
+ ttk::entry $Name -width 30 -textvariable redis_async_delay
+ grid $Prompt -column 0 -row 18 -sticky e
+ grid $Name -column 1 -row 18 -sticky ew
+if {$redis_driver == "test" || $redis_async_scale == "false" } {
+ $Name configure -state disabled
+ }
+ set Name $Parent.f1.e18
+ set Prompt $Parent.f1.p18
+ ttk::label $Prompt -text "Asynchronous Verbose :"
+ttk::checkbutton $Name -text "" -variable redis_async_verbose -onvalue "true" -offvalue "false"
+ grid $Prompt -column 0 -row 19 -sticky e
+ grid $Name -column 1 -row 19 -sticky ew
+if {$redis_driver == "test" || $redis_async_scale == "false" } {
+ set redis_async_verbose "false"
+ $Name configure -state disabled
+ }
}
set Name $Parent.b2
ttk::button $Name -command {