This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch master
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
The following commit(s) were added to refs/heads/master by this push:
new 147450a Support for connector specific client options. Add form 2.2
package
147450a is described below
commit 147450a97bda8a265ca7c28f5f64c9644c4615c1
Author: Massimo Manghi <mxman...@apache.org>
AuthorDate: Thu Nov 19 17:23:30 2020 +0100
Support for connector specific client options. Add form 2.2 package
---
ChangeLog | 36 ++-
rivet/packages/dio/dio.tcl | 8 +-
rivet/packages/dio/dio_Mysql.tcl | 35 ++-
rivet/packages/form/form22.tcl | 621 +++++++++++++++++++++++++++++++++++++++
4 files changed, 681 insertions(+), 19 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 648e67e..df3bedd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,11 @@
+2020-11-19 Massimo Manghi <mxman...@apache.org>
+ * rivet/rivet/packages/dio/dio.tcl,dio_Mysql.tcl: adding support for
+ connector specific client arguments
+
2020-11-02 Massimo Manghi <mxman...@apache.org>
- * doc/xml/directives.xml: SingleThreadExit entry re-elaborated
- * tests/runtest.tcl: Document new command line options
- * README: Removed obsolete warning about scgi scripts
+ * doc/xml/directives.xml: SingleThreadExit entry re-elaborated
+ * tests/runtest.tcl: Document new command line options
+ * README: Removed obsolete warning about scgi scripts
2020-10-04 Massimo Manghi <mxman...@apache.org>
* src/mod_rivet_ng/mod_rivet.c: forcing variable assignment in condition
@@ -38,25 +42,25 @@
* test/apachetest/apachetest.tcl,test/runtests.tcl: add support for
testing with various MPMs and bridges
2020-02-03 Massimo Manghi <mxman...@apache.org>
- * src/request/: Update obsolete copyright statements
- * src/mod_rivet_ng/rivetCore.c: update comments to upload command
- * tests: changed upload file test
+ * src/request/: Update obsolete copyright statements
+ * src/mod_rivet_ng/rivetCore.c: update comments to upload command
+ * tests: changed upload file test
2020-04-02 Massimo Manghi <mxman...@apache.org>
- * doc/xml/formbroker.xml: fixed examples
- * src/mod_rivet_ng/rivet_lazy_mpm.c: resolved access to shared counter
- that was causing segfaults when child process was terminated
+ * doc/xml/formbroker.xml: fixed examples
+ * src/mod_rivet_ng/rivet_lazy_mpm.c: resolved access to shared counter
+ that was causing segfaults when child process was terminated
2020-01-19 Massimo Manghi <mxman...@apache.org>
- * doc/xml/commands.xml: remove entry for command incr0 (dropped in 3.0)
+ * doc/xml/commands.xml: remove entry for command incr0 (dropped in 3.0)
2019-12-30 Massimo Manghi <mxman...@apache.org>
- * src/mod_rivet_ng/rivetCore.c: fixed bug in 'upload filename' that
- caused segfaults instead of Tcl errors when called without arguments
- * src/request/: Adding latest Copyright statements to files in this
- directory
- * tests/upload.rvt,upload.test: revised upload tests (need expansion
- to test multiple uploads)
+ * src/mod_rivet_ng/rivetCore.c: fixed bug in 'upload filename' that
+ caused segfaults instead of Tcl errors when called without arguments
+ * src/request/: Adding latest Copyright statements to files in this
+ directory
+ * tests/upload.rvt,upload.test: revised upload tests (need expansion
+ to test multiple uploads)
2019-12-12 Massimo Manghi <mxman...@apache.org>
* src/mod_rivet_ng/apache_config.c: copying also upload_files_to_var in
diff --git a/rivet/packages/dio/dio.tcl b/rivet/packages/dio/dio.tcl
index 2906a96..4aaa476 100644
--- a/rivet/packages/dio/dio.tcl
+++ b/rivet/packages/dio/dio.tcl
@@ -617,7 +617,7 @@ proc handle {interface args} {
method exec {args} {}
method nextkey {args} {}
method lastkey {args} {}
- method now {} {}
+ method now {} {}
##
## Functions to get and set public variables.
@@ -648,6 +648,12 @@ proc handle {interface args} {
public variable host ""
public variable port ""
+ protected method handle_client_arguments {cargs} { }
+
+ public variable clientargs "" {
+ handle_client_arguments $clientargs
+ }
+
public variable keyfield "" {
if {[llength $keyfield] > 1 && $autokey} {
return -code error "Cannot have autokey and multiple keyfields"
diff --git a/rivet/packages/dio/dio_Mysql.tcl b/rivet/packages/dio/dio_Mysql.tcl
index d9a85ad..aa1ca05 100644
--- a/rivet/packages/dio/dio_Mysql.tcl
+++ b/rivet/packages/dio/dio_Mysql.tcl
@@ -19,7 +19,7 @@
# $Id$
-package provide dio_Mysql 0.3
+package provide dio_Mysql 0.4
namespace eval DIO {
::itcl::class Mysql {
@@ -28,7 +28,7 @@ namespace eval DIO {
constructor {args} {eval configure $args} {
if { [catch {package require Mysqltcl}] \
&& [catch {package require mysqltcl}] \
- && [catch {package require mysql} ] } {
+ && [catch {package require mysql}] } {
return -code error "No MySQL Tcl package available"
}
@@ -53,6 +53,14 @@ namespace eval DIO {
if {![::rivet::lempty $pass]} { lappend command -password $pass }
if {![::rivet::lempty $port]} { lappend command -port $port }
if {![::rivet::lempty $host]} { lappend command -host $host }
+ #if {![::rivet::lempty $encoding]} { lappend command -encoding
$encoding }
+
+ if {$clientargs != ""} {
+ set command [lappend command {*}$clientargs]
+ }
+
+ #puts stderr "evaluating $command"
+
if {[catch $command error]} { return -code error $error }
set conn $error
@@ -198,6 +206,29 @@ namespace eval DIO {
}
}
+ protected method handle_client_arguments {cargs} {
+
+ # we assign only the accepted options
+
+ set clientargs {}
+
+ foreach {a v} $cargs {
+
+ if {($a == "-encoding") || \
+ ($a == "-localfiles") || \
+ ($a == "-ssl") || \
+ ($a == "-sslkey") || \
+ ($a == "-sslcert") || \
+ ($a == "-sslca") || \
+ ($a == "-sslcapath") || \
+ ($a == "-sslcipher") || \
+ ($a == "-socket")} {
+ lappend clientargs $a $v
+ }
+
+ }
+ }
+
public variable interface "Mysql"
private variable conn
diff --git a/rivet/packages/form/form22.tcl b/rivet/packages/form/form22.tcl
new file mode 100644
index 0000000..eb472c8
--- /dev/null
+++ b/rivet/packages/form/form22.tcl
@@ -0,0 +1,621 @@
+# form.tcl -- generate forms automatically.
+
+# Copyright 2002-2004 The Apache Software Foundation
+
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+
+# http://www.apache.org/licenses/LICENSE-2.0
+
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+package require Itcl
+package provide form 2.2
+
+# Rivet form class
+#
+#
+
+::itcl::class form {
+
+ constructor {args} {
+ # set the form method to be a post and the action to be
+ # a refetching of the current page
+ set arguments(method) post
+ set arguments(action) [::rivet::env DOCUMENT_URI]
+
+ # use $this for the type for form-global stuff like form arguments
+ import_data form $this arguments $args
+
+ if {[info exists arguments(defaults)]} {
+ # make the public variable contain the name of the array
+ # we are sucking default values out of
+ set defaults $arguments(defaults)
+
+ upvar 1 $arguments(defaults) callerDefaults
+ array set DefaultValues [array get callerDefaults]
+ unset arguments(defaults)
+ } else {
+ array set DefaultValues {}
+ }
+ }
+
+ destructor {
+
+ }
+
+ method destroy {} {
+ ::itcl::delete object $this
+ }
+
+ #
+ # import_data -- given a field type, field name, name of an array, and a
+ # list of key-value pairs, prepend any default key-value pairs,
+ # then store the resulting key-value pairs in the named array
+ #
+ protected method import_data {type name arrayName list} {
+ upvar 1 $arrayName data
+
+ # we now guarantee an array, though empty, will exist
+
+ array set data {}
+
+ #
+ # If there are elements in the defaultArgs array for the
+ # specified type, combine them with the list of key-value
+ # pairs, putting the DefaultArgs values first so the
+ # key-value pairs from list can possibly override them.
+ #
+ if {[info exists DefaultArgs($type)]} {
+ set list [concat $DefaultArgs($type) $list]
+ }
+
+ #
+ # if we don't have an even number of key-value pairs,
+ # that just ain't right
+ #
+ if {[llength $list] % 2} {
+ return -code error "Unmatched key-value pairs"
+ }
+
+ #
+ # for each key-value pair in the list, strip the first
+ # dash character from the key part and map it to lower
+ # case, then use that as the key for the passed-in
+ # array and store the corresonding value in there
+ #
+ # we also prep and return the list of key-value pairs, normalized
+ # with the lowercase thing
+ #
+ set return ""
+ foreach {var val} $list {
+ set var [string range [string tolower $var] 1 end]
+
+ if {$var == "prefix"} {
+ set prefix $val
+ continue
+ }
+
+ set data($var) $val
+ if {($var == "values") || ($var == "labels")} { continue }
+
+ lappend return -$var $val
+ }
+ return $return
+ }
+
+ #
+ # argstring - given an array name, construct a string of the
+ # style key1="data1" key2="data2" etc for each key value pair in the
+ # array
+ #
+ protected method argstring {arrayName} {
+ upvar 1 $arrayName data
+ set string ""
+ foreach arg [lsort [array names data]] {
+ append string " $arg=\"$data($arg)\""
+ }
+ return $string
+ }
+
+ #
+ # default_value ?-list? ?--? name ?value?
+ #
+ # If value is not given, returns a default value
+ # for that name if one exists, else an empty list.
+ #
+ # if a name and a value are given, the default value is set to that
+ # name (and the new default value is returned).
+ #
+ # The default value is a list if "-list" is given.
+
+ method default_value {args} {
+ # Command line
+ if {[lindex $args 0] eq "-list"} {
+ set isList 1
+ set args [lrange $args 1 end]
+ }
+ if {[lindex $args 0] eq "--"} {
+ set args [lrange $args 1 end]
+ }
+ switch -exact -- [llength $args] {
+ 1 { # Return default value
+ lassign $args name
+ if {default_exists $name]} {
+ if {[info exists isList]} {
+ return [default_list_get $name]
+ } else {
+ return [default_value_get $name]
+ }
+ } else {
+ return
+ }
+ }
+ 2 { # Set default value
+ lassign $args name value
+ set DefaultValues($name) $value
+ if {[info exists isList]} {
+ set DefaultValues(__$name) 1
+ } else {
+ unset -nocomplain DefaultValues(__$name)
+ }
+ }
+ default { error "wrong argument count" }
+ }
+ }
+
+ #
+ # default_exists - return true, if a default value exists
+ protected method default_exists {name} {
+ return [info exists DefaultValues($name)]
+ }
+
+ #
+ # default_list_get - get the default value as a list
+ # return with error if there is no default value
+ protected method default_list_get {name} {
+ if {[info exists DefaultValues(__$name)]} {
+ return $DefaultValues($name)
+ } else {
+ return [list $DefaultValues($name)]
+ }
+ }
+ #
+ # default_value_get - get the default value as a value
+ # return with error if there is no default value
+ protected method default_value_get {name} {
+ if {[info exists DefaultValues(__$name)]} {
+ return [lindex $DefaultValues($name) 0]
+ } else {
+ return $DefaultValues($name)
+ }
+ }
+ #
+ # default_value_exists - return true, if the given value exists in the
+ # default list
+ protected method default_value_exists {name value} {
+ if { ! [info exists DefaultValues($name)] } {
+ return 0
+ }
+ if {[info exists DefaultValues(__$name)]} {
+ return [expr {$value in $DefaultValues($name)}]
+ }
+ return [expr {$value eq $DefaultValues($name)}]
+ }
+
+ #
+ # default_args - given a type and a variable number of arguments,
+ # if there are no arguments other than the type, return the
+ # element of that name from the DefaultArgs array, if that element
+ # exists, else return an empty list.
+ #
+ # if a name and a value are given, sets the DefaultArgs to the variable
+ # list of arguments.
+ #
+ method default_args {type args} {
+
+ # if only one argument was specified
+ if {[::rivet::lempty $args]} {
+ if {![info exists DefaultArgs($type)]} { return }
+ return $DefaultArgs($type)
+ }
+
+ # make sure we have an even number of key-value pairs
+ if {[llength $args] % 2} {
+ return -code error "Unmatched key-value pairs"
+ }
+
+ # set the DefaultArgs for the specified type
+ return [set DefaultArgs($type) $args]
+ }
+
+ #
+ # start - generate the <form> with all of its arguments
+ #
+ method start {{args ""}} {
+ if {![::rivet::lempty $args]} {
+ # replicated in constructor
+ import_data form $this arguments $args
+ }
+ $this emit_html "<form [argstring arguments]>"
+ }
+
+ #
+ # end - generate the </form>
+ #
+ method end {} {
+ $this emit_html "</form>"
+ }
+
+ #
+ # field - emit a field of the given field type and name, including
+ # any default key-value pairs defined for this field type and
+ # optional key-value pairs included with the statement
+ #
+ method field {type name args} {
+
+ # import any default key-value pairs, then any specified in this
+ # field declaration
+ import_data $type $name data $args
+
+ switch -- $type {
+ "radio" -
+ "checkbox" {
+
+ # if there's a label then prepare to output it.
+ if {[info exists data(label)]} {
+ set label "<label"
+ # if there's no id defined, generate something unique so
we can reference it.
+ if { ![info exists data(id)] } {
+ set data(id) "${prefix}_[incr auto_cnt]"
+ append label { for="} $data(id) {"}
+ } else {
+ append label { for="} $data(id) {"}
+ }
+ append label ">" $data(label) "</label>"
+ }
+
+ # if there is a default value for this field
+ # and it matches the value we have for it, make
+ # the field show up as selected (checked)
+ # Alternatively, select a checkbox, if it has no value but a
+ # default value with arbitrary value.
+ if { [info exists data(value)]
+ && [default_value_exists $name $data(value)]
+ || ![info exists data(value)]
+ && $type eq "checkbox"
+ && [info exists DefaultValues($name)]
+ } {
+ set data(checked) "checked"
+ }
+ }
+ }
+ # For non multi-choice widgets: set default value if there is no value
+ # given
+ if { ! [info exists data(value)]
+ && [default_exists $name]
+ && $type ni {"select" "radio" "checkbox"}
+ } {
+ set data(value) [default_value_get $name]
+ }
+
+ # generate the field definition
+ set string "<input type=\"$type\" name=\"$name\" [argstring data] />"
+ if {[info exists label]} {
+ append string $label
+ }
+
+ # ...and emit it
+ $this emit_html $string
+
+ }
+
+ #
+ # text -- emit an HTML "text" field
+ #
+ method text {name args} {
+ field text $name {*}$args
+ }
+
+ #
+ # password -- emit an HTML "password" field
+ #
+ method password {name args} {
+ field password $name {*}$args
+ }
+
+ #
+ # hidden -- emit an HTML "hidden" field
+ #
+ method hidden {name args} {
+ field hidden $name {*}$args
+ }
+
+ #
+ # submit -- emit an HTML "submit" field
+ #
+ method submit {name args} {
+ field submit $name {*}$args
+ }
+
+ #
+ # button -- emit an HTML "button" field
+ #
+ method button {name args} {
+ field button $name {*}$args
+ }
+
+ #
+ # reset -- emit an HTML "reset" button
+ #
+ method reset {name args} {
+ field reset $name {*}$args
+ }
+
+ #
+ # image -- emit an HTML image field
+ #
+ method image {name args} {
+ field image $name {*}$args
+ }
+
+ #
+ # checkbox -- emit an HTML "checkbox" form field
+ #
+ method checkbox {name args} {
+ field checkbox $name {*}$args
+ }
+
+ #
+ # radio -- emit an HTML "radiobutton" form field
+ #
+ method radio {name args} {
+ field radio $name {*}$args
+ }
+
+ #
+ # color -- emit an HTML 5 "color" form field
+ #
+ method color {name args} {
+ field color $name {*}$args
+ }
+
+ #
+ # date -- emit an HTML 5 "date" form field
+ #
+ method date {name args} {
+ field date $name {*}$args
+ }
+
+ #
+ # datetime -- emit an HTML 5 "datetime" form field
+ #
+ method datetime {name args} {
+ field datetime $name {*}$args
+ }
+
+ #
+ # datetime_local -- emit an HTML 5 "datetime-local" form field
+ #
+ method datetime_local {name args} {
+ field datetime-local $name {*}$args
+ }
+
+ #
+ # email -- emit an HTML 5 "email" form field
+ #
+ method email {name args} {
+ field email $name {*}$args
+ }
+
+ #
+ # file -- emit an HTML 5 "file" form field
+ #
+ method file {name args} {
+ field file $name {*}$args
+ }
+
+ #
+ # month -- emit an HTML 5 "month" form field
+ #
+ method month {name args} {
+ field month $name {*}$args
+ }
+
+ #
+ # number -- emit an HTML 5 "number" form field
+ #
+ method number {name args} {
+ field number $name {*}$args
+ }
+
+ #
+ # range -- emit an HTML 5 "range" form field
+ #
+ method range {name args} {
+ field range $name {*}$args
+ }
+
+ #
+ # search -- emit an HTML 5 "search" form field
+ #
+ method search {name args} {
+ field search $name {*}$args
+ }
+
+ #
+ # tel -- emit an HTML 5 "tel" form field
+ #
+ method tel {name args} {
+ field tel $name {*}$args
+ }
+
+ #
+ # time -- emit an HTML 5 "time" form field
+ #
+ method time {name args} {
+ field time $name {*}$args
+ }
+
+ #
+ # url -- emit an HTML 5 "url" form field
+ #
+ method url {name args} {
+ field url $name {*}$args
+ }
+
+ #
+ # week -- emit an HTML 5 "week" form field
+ #
+ method week {name args} {
+ field week $name {*}$args
+ }
+
+ #
+ # radiobuttons --
+ #
+ method radiobuttons {name args} {
+ set data(values) [list]
+ set data(labels) [list]
+
+ set list [import_data radiobuttons $name data $args]
+
+ if {[::rivet::lempty $data(labels)]} {
+ set data(labels) $data(values)
+ }
+
+ foreach label $data(labels) value $data(values) {
+ radio $name {*}$list -label $label -value $value
+ }
+ }
+
+ #
+ # checkboxes --
+ #
+ method checkboxes {name args} {
+ set data(values) [list]
+ set data(labels) [list]
+
+ set list [import_data checkboxes $name data $args]
+
+ if {[::rivet::lempty $data(labels)]} {
+ set data(labels) $data(values)
+ }
+
+ foreach label $data(labels) value $data(values) {
+ checkbox $name {*}$list -label $label -value $value
+ }
+ }
+
+ #
+ # select -- generate a selector
+ #
+ # part of the key value pairs can include -values with a list,
+ # and -labels with a list and it'll populate the <option>
+ # elements with them. if one matches the default value,
+ # it'll select it too.
+ #
+ method select {name args} {
+ # start with empty values and labels so they'll exist even if not set
+ set data(values) [list]
+ set data(labels) [list]
+
+ # import any default data and key-value pairs from the method args
+ import_data select $name data $args
+
+ # pull the values and labels into scalar variables and remove them
+ # from the data array
+ set values $data(values)
+ set labels $data(labels)
+ unset data(values) data(labels)
+
+ # get the list of default values
+
+ if {[default_exists $name]} {
+ set default_list [default_list_get $name]
+ }
+
+ # if there is a value set in the value field of the data array,
+ # use that instead (that way if we're putting up a form with
+ # data already, the data'll show up)
+ # This data is a list for multiple forms
+ if {[info exists data(value)]} {
+ if {[info exists data(multiple)]} {
+ set default_list $data(value)
+ } else {
+ set default_list [list $data(value)]
+ }
+ unset data(value)
+ }
+
+ #
+ # if there are no separate labels defined, use the list of
+ # values for the labels
+ #
+ if {[::rivet::lempty $labels]} {
+ set labels $values
+ }
+
+ # emit the selector with each label-value pair
+ # we adopt the style imposed by the ::rivet::xml command generating
+ # the innermost elements and then wrapping them up with the 'select'
tag
+ set options_list {}
+ foreach label $labels value $values {
+ if {[info exists default_list] && $value in $default_list } {
+ lappend options_list [::rivet::xml $label [list option value
$value selected selected]]
+ } else {
+ lappend options_list [::rivet::xml $label [list option value
$value]]
+ }
+ }
+ puts [::rivet::xml [join $options_list "\n"] [list select name $name
{*}[array get data]]]
+ }
+
+ #
+ # textarea -- emit an HTML "textarea" form field
+ #
+ method textarea {name args} {
+ import_data textarea $name data $args
+ set value ""
+ if {[info exists data(value)]} {
+ set value $data(value)
+ unset data(value)
+ } elseif {[default_exists $name]} {
+ set value [default_value_get $name]
+ }
+ $this emit_html "<textarea name=\"$name\" [argstring
data]>$value</textarea>"
+ }
+
+ private method emit_html {html_fragment} {
+
+ if {$emit} {
+ puts $html_fragment
+ } else {
+ return $html_fragment
+ }
+
+ }
+
+ #
+ # defaults -- when set, the value is the name of an array to suck
+ # the key-value pairs out of and copy them into DefaultValues
+ #
+ public variable defaults "" {
+ upvar 1 $defaults array
+ array set DefaultValues [array get array]
+ }
+
+ private variable DefaultValues
+ private variable DefaultArgs
+
+ private variable arguments
+ private variable auto_cnt 0
+ public variable prefix autogen
+ public variable emit true { set noemit [expr !$emit] }
+ public variable noemit false { set emit [expr !$noemit] }
+
+} ; ## ::itcl::class form
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscr...@tcl.apache.org
For additional commands, e-mail: commits-h...@tcl.apache.org
