Index: openacs-4/packages/q-forms/README.md =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/README.md,v diff -u -r1.1 -r1.2 --- openacs-4/packages/q-forms/README.md 14 Nov 2014 18:27:52 -0000 1.1 +++ openacs-4/packages/q-forms/README.md 2 Jan 2017 10:30:48 -0000 1.2 @@ -28,7 +28,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or + the Free Software Foundation, either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, @@ -57,6 +57,8 @@ Optional automatic hash generation helps secure form transactions and ignores multiple posts caused from mouse double-clicks and browsing page history. +This extra secure feature also prevents tampering of hidden form values. + Multiple values of same key can be combined as a list (instead of producing a form post error). Index: openacs-4/packages/q-forms/q-forms.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/q-forms.info,v diff -u -r1.3 -r1.4 --- openacs-4/packages/q-forms/q-forms.info 3 May 2015 08:49:12 -0000 1.3 +++ openacs-4/packages/q-forms/q-forms.info 2 Jan 2017 10:30:48 -0000 1.4 @@ -1,4 +1,4 @@ - +`^ @@ -9,14 +9,16 @@ f f - + Benjamin Brink OpenACS Community Provides code for building forms dynamically in tcl - Provides qf_* form bulding and interpreting procedures, especially designed for building forms dynamically. + Provides qf_* form bulding and interpreting procedures, especially designed for building forms dynamically in tcl. 1 + GNU Gpl 2.0 or higher + GPL2 - + Index: openacs-4/packages/q-forms/tcl/form-helper-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/tcl/form-helper-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/q-forms/tcl/form-helper-procs.tcl 3 May 2015 08:49:12 -0000 1.3 +++ openacs-4/packages/q-forms/tcl/form-helper-procs.tcl 2 Jan 2017 10:30:48 -0000 1.4 @@ -2,7 +2,11 @@ procedures for helping render form data or presentation for form data @creation-date 15 May 2012 - @cs-id $Id: + @Copyright (c) 2012-5 Benjamin Brink + @license GNU General Public License 2, see project home or http://www.gnu.org/licenses/gpl.html + @project home: http://github.com/tekbasse/q-forms + @address: po box 20, Marylhurst, OR 97036-0020 usa + @email: tekbasse@yahoo.com to vertically align textarea label, add to css: @@ -13,8 +17,137 @@ } +ad_proc -public qf_lists_to_vars { + values_list + keys_list + {only_these_keys_list ""} +} { + Returns variables assigned to the values in values_list, paired by index. + For example the fourth index of keys_list is assigned the value of the + fourth index of values_list. + If values_list is shorter, the orphaned keys are assigned an empty string. + If keys_list is shorter, excess values are returned as a list. + If only_these_keys_list is not empty, only these keys will be converted. + Anything in only_these_keys_list that is not in keys_list is ignored. +} { + set remainder_list [list ] + set values_list_len [llength $values_list] + set keys_list_len [llength $keys_list] + if { $values_list_len > $keys_list_len } { + set remainder_list [lrange $values_list $keys_list_len end] + set values_list [lrange $values_list 0 ${keys_list_len}-1] + } + if { $only_these_keys_list eq "" } { + set i 0 + foreach key $keys_list { + upvar 1 $key val_${key} + set val_${key} [lindex $values_list $i] + incr i + } + } else { + # fkey = filtered key + set otk_list [split $only_these_keys_list] + foreach fkey $otk_list { + set i [lsearch -exact $keys_list $fkey] + if { $i > -1 } { + upvar 1 $fkey val_${fkey} + set val_${fkey} [lindex $values_list $i] + } + } + } + return $remainder_list +} + +ad_proc -public qf_lists_to_array { + array_name + values_list + keys_list +} { + Returns an array with elements in key_list assigned to the values in values_list, paired by list index. + For example the fourth index of keys_list is an element assigned the value of the + fourth index of values_list. + If values_list is shorter, the orphaned keys are assigned an empty string. + If keys_list is shorter, excess values are returned as a list. +} { + upvar 1 $array_name name_arr + set remainder_list [list ] + set values_list_len [llength $values_list] + set keys_list_len [llength $keys_list] + if { $values_list_len > $keys_list_len } { + set remainder_list [lrange $values_list $keys_list_len end] + set values_list [lrange $values_list 0 ${keys_list_len}-1] + } + set i 0 + foreach key $keys_list { + set name_arr(${key}) [lindex $values_list $i] + incr i + } + return $remainder_list +} + + +ad_proc -public qf_array_to_vars { + array_name + keys_list +} { + Returns variables assigned to the values in array(variable) for variables named in keys_list. + This returns a selection of array values, not all elements as done by template::util::array_to_vars + If a key doesn't exist, the variable is created and assigned the empty string. +} { + upvar 1 $array_name an_arr + foreach key $keys_list { + if { [info exists an_arr(${key}) ] } { + uplevel [list set $key $an_arr(${key}) ] + } else { + uplevel [list set $key ""] + } + } + return 1 +} + + +ad_proc -public qss_table_cols_filter { + table_lists + col_names + {blank_missing_cols_p "0"} +} { + Excludes all columns not referenced by name. + Columns are ordered in order of names. + If column not found in table and blank_missing_cols_p is 1, + an empty column is included in returned table. + Otherwise, column is not included in table. +} { + set col_names_list [split $col_names] + + # create an index list of column titles + set titles_list [lindex $table_lists 0] + set cols_idx_list [list ] + foreach name $col_names_list { + set col_name [string trim $name] + set col_idx [lsearch -exact $col_name $titles_list] + if { $col_idx > -1 || $blank_missing_cols_p } { + lappend cols_idx_list $col_idx + } + } + # build new table with column titles index + set new_table_lists [list ] + foreach row_list $table_lists { + set new_row_list [list ] + foreach col_idx $cols_idx_list { + if { $col_idx > -1 } { + set col_value [lindex $row_list $col_idx] + } else { + set col_value "" + } + lappend new_row_list $col_value + } + lappend new_table_lists $new_row_list + } + return $new_table_lists +} + ad_proc -public qss_txt_to_tcl_list_of_lists { textarea linebreak @@ -254,6 +387,7 @@ set rows_count 1 set bguess 1 } + ns_log Notice "qss_txt_table_stats linebreak '${linebreak_char}' delim '${delimiter}' rows '${rows_count}' columns '${bguess}'" set return_list [list $linebreak_char $delimiter $rows_count $bguess] # ns_log Notice "qss_txt_table_stats: return_list $return_list" return $return_list @@ -286,7 +420,7 @@ #setup repeat pattern for formatting rows, if last formatting row is not blank set repeat_last_row_p 0 if { [llength [lindex $td_attribute_lists end] ] > 0 } { - # this feature only comes into play if td_attrubte_lists is not as long as table_list_of_lists + # this feature only comes into play if td_attribute_lists is not as long as table_list_of_lists set repeat_last_row_p 1 set repeat_row [expr { [llength $td_attribute_lists] - 1 } ] } @@ -426,6 +560,16 @@ return $is_natural } +ad_proc -public qf_is_integer { + value +} { + answers question: is value an integer? + returns 0 or 1 +} { + set is_integer [regexp {^(0*)(([\-]?[1-9][0-9]*|0))$} $value match zeros value] + return $is_integer +} + ad_proc -public qf_remove_from_list { value value_list } { @@ -910,10 +1054,48 @@ ad_proc -public qf_unquote { value } { - unquotes html similar to ad_unquotehtml except language keys, so that they are not rendered. Useful when creating forms with existing input values. + unquotes html similar to ad_unquotehtml except language keys, + so that they are not rendered. + Useful when creating forms with existing input values. + Does not unqoute square brackets. } { - set value_quoted [ad_unquotehtml $value] - regsub -all -- {\#} $value_quoted {\#} value_quoted - return $value_quoted + # following from ad_unquotehtml + set value_unquoted [string map {& & > > < < " \" " \" ' '} $value] + regsub -all -- {\#} $value_unquoted {\#} value_unquoted + return $value_unquoted } +# tcl now has: +# string is true -strict $value +# string is false -strict $value +# in openacs api: template::util::is_true, but that looks like an wip since description does not fit actual. + +ad_proc -public qf_is_true { + value + {default "0"} +} { + Intreprets value as a boolean. If value is ambiguous, defaults to the value of default, usually 0. +} { + set test1 [string is true -strict $value] + set test2 [string is false -strict $value] + if { $test1 == $test2 } { + set interp_p $default + } else { + set interp_p $test1 + } + return $interp_p +} + +ad_proc -public qf_is_even { + number +} { + Returns 1 if number is even, otherwise returns 0. Works for base 1 to 16 (hexidecimal). +} { + set even_p 0 + set last_digit [string range $number end end] + set even_digits_list [list 0 2 4 6 8 a c e A C E] + if { $last_digit in $even_digits_list } { + set even_p 1 + } + return $even_p +} Index: openacs-4/packages/q-forms/tcl/form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/tcl/form-procs.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/q-forms/tcl/form-procs.tcl 8 Apr 2015 08:34:36 -0000 1.2 +++ openacs-4/packages/q-forms/tcl/form-procs.tcl 2 Jan 2017 10:30:48 -0000 1.3 @@ -2,9 +2,17 @@ routines for creating, managing input via html forms @creation-date 21 Nov 2010 - @cs-id $Id: + @Copyright (c) 2010-5 Benjamin Brink + @license GNU General Public License 2, see project home or http://www.gnu.org/licenses/gpl.html + @project home: http://github.com/tekbasse/q-forms + @address: po box 20, Marylhurst, OR 97036-0020 usa + @email: tekbasse@yahoo.com } +#agenda: +##code a proc called qf_bypass that does like qf_input hidden with sec_hash +## but emits no html tag to the form. + # use _ to clear a new default # use upvar to grab previous defaults and re-use (with qf_input only) # main namespace vars: @@ -14,6 +22,7 @@ # __form_ids_fieldset_open_list = list that contains form ids where a fieldset tag is open # __form_arr contains an array of forms. Each form built as a string by appending tags, indexed by form_id, for example __form_arr($id) # __qf_arr contains last attribute values of a tag (for all forms), indexed by {tag}_attribute, __form_last_id is in __qf_arr(form_id) +# __qf_hc_arr contains sh_key_id for each form_id # a blank id passed in anything other than qf_form assumes the current (most recent used form_id) # to fix: id for nonform tag should not be same as form_id. use an attribute "form_id" for assigning tags to specific forms. @@ -33,6 +42,9 @@ } { creates the form key for a more secure form transaction. Returns the security hash. See also qf_submit_key_accepted_p } { + upvar 1 __qf_hc_arr __qf_hc_arr + upvar 1 attributes_arr attributes_arr + # This proc is inspired from sec_random_token if { $instance_id eq "" } { # set instance_id package_id @@ -68,9 +80,11 @@ } append sec_hash_string $start_clicks $session_id $secure_p $client_ip $action_url $time_sec $key_id set sec_hash [ns_sha1 $sec_hash_string] + set sh_key_id [db_nextval qf_id_seq] db_dml qf_form_key_create {insert into qf_key_map - (instance_id,rendered_timestamp,sec_hash,key_id,session_id,action_url,secure_conn_p,client_ip) - values (:instance_id,:time_sec,:sec_hash,:key_id,:session_id,:action_url,:secure_p,:client_ip) } + (instance_id,sh_key_id,rendered_timestamp,sec_hash,key_id,session_id,action_url,secure_conn_p,client_ip) + values (:instance_id,:sh_key_id,:time_sec,:sec_hash,:key_id,:session_id,:action_url,:secure_p,:client_ip) } + set __qf_hc_arr($attributes_arr(form_id)) $sh_key_id return $sec_hash } @@ -80,6 +94,8 @@ } { Checks the form key against existing ones. Returns 1 if matches and unexpired, otherwise returns 0. } { + # sh_key_id is passed to qf_get_inputs_as_array to collect hidden name value pairs. + upvar 1 sh_key_id sh_key_id # This proc is inspired from sec_random_token if { $instance_id eq "" } { # set instance_id package_id @@ -104,19 +120,24 @@ } # the key_id is used to help generate unpredictable hashes, but isn't used at this level of input validation set accepted_p [db_0or1row qf_form_key_check_hash { - select session_id as session_id_i, action_url as action_url_i, secure_conn_p as secure_conn_p_i, client_ip as client_ip_i from qf_key_map - where instance_id =:instance_id and sec_hash =:sec_hash and submit_timestamp is null } ] + select session_id as session_id_i, action_url as action_url_i, secure_conn_p as secure_conn_p_i, client_ip as client_ip_i, sh_key_id + from qf_key_map + where instance_id=:instance_id + and sec_hash=:sec_hash + and submit_timestamp is null } ] if { !$accepted_p } { # there is nothing to compare. log current values: - ns_log Warning "qf_submit_key_accepted_p: is false. action_url '$action_url' sec_hash '$sec_hash'" + ns_log Warning "qf_submit_key_accepted_p.115: is false. action_url '${action_url}' sec_hash '${sec_hash}'" if { $connected_p } { - ns_log Warning "qf_submit_key_accepted_p: session_id '$session_id' secure_p '$secure_p' client_ip '$client_ip'" + ns_log Warning "qf_submit_key_accepted_p.117: session_id '${session_id}' secure_p '${secure_p}' client_ip '${client_ip}'" } } else { # Mark the key expired set submit_timestamp [ns_time] - db_dml qf_form_key_expire { update qf_key_map - set submit_timestamp = :submit_timestamp where instance_id =:instance_id and sec_hash =:sec_hash and submit_timestamp is null } + db_dml qf_form_key_expire { update qf_key_map set submit_timestamp=:submit_timestamp + where instance_id =:instance_id + and sec_hash=:sec_hash + and submit_timestamp is null } } return $accepted_p } @@ -143,7 +164,8 @@ set arg_arr(multiple_key_as_list) 0 set arg_arr(hash_check) 0 set arg_full_list [list duplicate_key_check multiple_key_as_list hash_check] - #set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 ] + #set arg_list \[list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 \] + set instance_id [ad_conn package_id] # collect args if { [llength $arg1] > 1 && $value1 eq "" } { set arg_list $arg1 @@ -160,10 +182,10 @@ foreach {name value} $arg_list { set attribute_index [lsearch -exact $arg_full_list $name] if { $attribute_index > -1 } { - set arg_arr($name) $value + set arg_arr(${name}) $value } else { if { $name ne "" } { - ns_log Error "qf_get_inputs_as_array: '${name}' is not a valid name for use with args." + ns_log Error "qf_get_inputs_as_array.170: '${name}' is not a valid name for use with args." } } } @@ -176,21 +198,21 @@ } else { set __form_size [ns_set size $__form] } - #ns_log Notice "qf_get_inputs_as_array: formsize $__form_size" + #ns_log Notice "qf_get_inputs_as_array.183: formsize $__form_size" for { set __form_counter_i 0 } { $__form_counter_i < $__form_size } { incr __form_counter_i } { regexp -nocase -- {^[a-z][a-z0-9_\.\:\(\)]*} [ns_set key $__form $__form_counter_i] __form_key # Why doesn't work for regexp -nocase -- {^[a-z][a-z0-9_\.\:\(\)]*$ } ? set __form_key_exists [info exists __form_key] - # ns_log Notice "qf_get_inputs_as_array: __form_key_exists = ${__form_key_exists}" + # ns_log Notice "qf_get_inputs_as_array.189: __form_key_exists = ${__form_key_exists}" # no inserting tcl commands etc! if { $__form_key_exists == 0 || ( $__form_key_exists == 1 && [string length $__form_key] == 0 ) } { # let's make this an error for now, so we log any attempts - # ns_log Notice "qf_get_inputs_as_array: __form_key_exists ${__form_key_exists} length __form_key [string length ${__form_key}]" - # ns_log Notice "qf_get_inputs_as_array(ref156: attempt to insert unallowed characters to user input '{__form_key}' as '[ns_set key $__form $__form_counter_i]' for counter ${__form_counter_i}." + # ns_log Notice "qf_get_inputs_as_array.194: __form_key_exists ${__form_key_exists} length __form_key \[string length ${__form_key}\]" + # ns_log Notice "qf_get_inputs_as_array.196: attempt to insert unallowed characters to user input '{__form_key}' as '\[ns_set key $__form $__form_counter_i\]' for counter ${__form_counter_i}." if { $__form_counter_i > 0 } { - ns_log Notice "qf_get_inputs_as_array: attempt to insert unallowed characters to user input '{__form_key}'." + ns_log Notice "qf_get_inputs_as_array.197: attempt to insert unallowed characters to user input '{__form_key}'." } } else { set __form_key [ad_quotehtml $__form_key] @@ -202,52 +224,109 @@ set __form_input_exists 1 # check for duplicate key? - if { $arg_arr(duplicate_key_check) && [info exists __form_buffer_arr($__form_key) ] } { - if { $__form_input ne $__form_buffer_arr($__form_key) } { + if { $arg_arr(duplicate_key_check) && [info exists __form_buffer_arr(${__form_key}) ] } { + if { $__form_input ne $__form_buffer_arr(${__form_key}) } { # which one is correct? log error - ns_log Error "qf_get_form_input: form input error. duplcate key provided for ${__form_key}" + ns_log Error "qf_get_form_input.212: form input error. duplcate key provided for '${__form_key}'" ad_script_abort # set __form_input_exists to -1 instead of ad_script_abort? } else { - ns_log Warning "qf_get_form_input: notice, form has a duplicate key with multiple values containing same info.." + ns_log Warning "qf_get_form_input.216: notice, form has a duplicate key with multiple values containing same info.." } } elseif { $arg_arr(multiple_key_as_list) } { - ns_log Notice "qf_get_inputs_as_array: A key has been posted with multible values. Values assigned to the key as a list." - if { [llength $__form_buffer_arr($__form_key)] > 1 } { + ns_log Notice "qf_get_inputs_as_array.219: A key has been posted with multible values. Values assigned to the key as a list." + if { [llength $__form_buffer_arr(${__form_key})] > 1 } { # value is a list, lappend - lappend __form_buffer_arr($__form_key) $__form_input + lappend __form_buffer_arr(${__form_key}) $__form_input } else { # convert the key value to a list - set __value_one $__form_buffer_arr($__form_key) - unset __form_buffer_arr($__form_key) - set __form_buffer_arr($__form_key) [list $__value_one $__form_input] + set __value_one $__form_buffer_arr(${__form_key}) + unset __form_buffer_arr(${__form_key}) + set __form_buffer_arr(${__form_key}) [list $__value_one $__form_input] } } else { - set __form_buffer_arr($__form_key) $__form_input - # ns_log Debug "qf_get_inputs_as_array: set ${form_array_name}($__form_key) '${__form_input}'." + set __form_buffer_arr(${__form_key}) $__form_input + # ns_log Debug "qf_get_inputs_as_array.231: set ${form_array_name}($__form_key) '${__form_input}'." } # next key-value pair } + } - if { $arg_arr(hash_check) } { - if { [info exists __form_buffer_arr(qf_security_hash) ] } { - set accepted_p [qf_submit_key_accepted_p $__form_buffer_arr(qf_security_hash) ] - if { $accepted_p } { - unset __form_buffer_arr(qf_security_hash) - array set __form_input_arr [array get __form_buffer_arr] - return $__form_input_exists + if { $__form_input_exists } { + if { $arg_arr(hash_check) } { + if { [info exists __form_buffer_arr(qf_security_hash) ] } { + set accepted_p [qf_submit_key_accepted_p $__form_buffer_arr(qf_security_hash) ] + if { $accepted_p } { + + # Are there any hidden name pairs to grab from db? + set name_value_lists [db_list_of_lists qf_name_value_pairs_r {select arg_name,arg_value + from qf_name_value_pairs + where instance_id=:instance_id + and sh_key_id=:sh_key_id} ] + # clear any external input and warn if it is different + foreach pair_list $name_value_lists { + set __form_key [lindex $pair_list 0] + set __form_input [lindex $pair_list 1] + if { [info exists __form_buffer_arr(${__form_key}) ] } { + set test [ad_unquotehtml $__form_buffer_arr(${__form_key})] + if { $test ne $__form_input } { + ns_log Warning "qf_get_inputs_as_array.12000: input of type 'hidden' from form does not match for name '${__form_key}'. Internal used. internal '${__form_input}' from form '${test}'" + array unset __form_buffer_arr $__form_key + } + } + } + foreach pair_list $name_value_lists { + set __form_key [lindex $pair_list 0] + set __form_input [lindex $pair_list 1] + # For consistency, this is a repeat of external form logic checks above. + + # check for duplicate key? + if { $arg_arr(duplicate_key_check) && [info exists __form_buffer_arr(${__form_key}) ] } { + if { $__form_input ne $__form_buffer_arr(${__form_key}) } { + # which one is correct? log error + ns_log Error "qf_get_form_input.312: form input error. duplcate key provided for '${__form_key}'" + ad_script_abort + # set __form_input_exists to -1 instead of ad_script_abort? + } else { + ns_log Warning "qf_get_form_input.316: notice, form has a duplicate key with multiple values containing same info.." + } + } elseif { $arg_arr(multiple_key_as_list) } { + ns_log Notice "qf_get_inputs_as_array.319: A key has been posted with multible values. Values assigned to the key as a list." + if { [llength $__form_buffer_arr(${__form_key})] > 1 } { + # value is a list, lappend + lappend __form_buffer_arr(${__form_key}) $__form_input + } else { + # convert the key value to a list + set __value_one $__form_buffer_arr(${__form_key}) + unset __form_buffer_arr(${__form_key}) + set __form_buffer_arr(${__form_key}) [list $__value_one $__form_input] + } + } else { + set __form_buffer_arr(${__form_key}) $__form_input + # ns_log Debug "qf_get_inputs_as_array.231: set ${form_array_name}($__form_key) '${__form_input}'." + } + + # next key-value pair + } + + unset __form_buffer_arr(qf_security_hash) + array set __form_input_arr [array get __form_buffer_arr] + return $__form_input_exists + } else { + ns_log Notice "qf_get_inputs_as_array.346: hash_check with form input of '$__form_buffer_arr(qf_security_hash)' did not match." + return 0 + } } else { - ns_log Notice "qf_get_inputs_as_array: hash_check with form input of '$__form_buffer_arr(qf_security_hash)' did not match." + set accepted_p 0 + ns_log Notice "qf_get_inputs_as_array.351: hash_check requires qf_security_hash, but was not included with form input." return 0 } } else { - set accepted_p 0 - ns_log Notice "qf_get_inputs_as_array: hash_check requires qf_security_hash, but was not included with form input." - return 0 + array set __form_input_arr [array get __form_buffer_arr] + return $__form_input_exists } } else { - array set __form_input_arr [array get __form_buffer_arr] return $__form_input_exists } } @@ -270,16 +349,37 @@ {value1 ""} args } { - Initiates a form with form tag and supplied attributes. Returns an id. A clumsy url based id is provided if not passed (not recommended). + Initiates a form with form tag and supplied attributes. + Returns an id. + A clumsy url-based id is provided if not passed (not recommended). If hash_check passed, creates a hash to be checked on submit for server-client transaction continuity. + 
+    To create a form that uploads a file, set attribute enctype to "multipart/form-data", set method to "post".
+    Also, create an input tag with type attribute  set to "file" to choose a file to upload, 
+    and set name attribute to name of file as it will be received at the server along with
+    other input from the form.
+
+    In the following example, name is set to "clientfile".
+    
+    After the form has been submitted, data can be retreived via ns_queryget (or qf_get_inputs_as_array ):
+
+    set uploaded_filename \[ns_queryget clientfile \]
+
+    set file_pathname_on_server \[ns_queryget clientfile.tmpfile \]
+

+ For more info, see Naviserver documentation for ns_queryget

+ + @see qf_get_inputs_as_array } { # use upvar to set form content, set/change defaults # __qf_arr contains last attribute values of tag, indexed by {tag}_attribute, __form_last_id is in __qf_arr(form_id) + # __qf_hc_arr(form_id) contains value of hash_check. upvar 1 __form_ids_list __form_ids_list upvar 1 __form_arr __form_arr upvar 1 __form_ids_open_list __form_ids_open_list upvar 1 __qf_remember_attributes __qf_remember_attributes upvar 1 __qf_arr __qf_arr + upvar 1 __qf_hc_arr __qf_hc_arr # collect args if { [llength $arg1] > 1 && $value1 eq "" } { @@ -294,26 +394,31 @@ set arg_list [list ] } - set attributes_tag_list [list action class id method name style target title] + set attributes_tag_list [list action class id method name style target title encytype] set attributes_full_list $attributes_tag_list lappend attributes_full_list form_id hash_check key_id set attributes_list [list] foreach {attribute value} $arg_list { set attribute_index [lsearch -exact $attributes_full_list $attribute] if { $attribute_index > -1 } { - set attributes_arr($attribute) $value + set attributes_arr(${attribute}) $value if { [lsearch -exact $attributes_tag_list $attribute] > -1 } { lappend attributes_list $attribute } } else { - ns_log Error "qf_form: '${attribute}' is not a valid attribute." + ns_log Error "qf_form.337: '${attribute}' is not a valid attribute." } } if { ![info exists attributes_arr(method)] } { set attributes_arr(method) "post" lappend attributes_list "method" } + if { ![info exists attributes_arr(enctype)] && $attributes_arr(method) eq "post" } { + set attributes_arr(enctype) "application/x-www-form-urlencoded" + lappend attributes_list "enctype" + } + # if html5 should we default novalidate to novalidate? No for now. if { ![info exists __qf_remember_attributes] } { @@ -328,8 +433,8 @@ # use previous tag attribute values? if { $__qf_remember_attributes } { foreach attribute $attributes_list { - if { $attribute ne "id" && ![info exists attributes_arr($attribute)] && [info exists __qf_arr(form_$attribute)] } { - set attributes_arr($attribute) $__qf_arr(form_$attribute) + if { $attribute ne "id" && ![info exists attributes_arr(${attribute})] && [info exists __qf_arr(form_${attribute})] } { + set attributes_arr(${attribute}) $__qf_arr(form_${attribute}) } } } @@ -339,28 +444,30 @@ set id_exists [info exists attributes_arr(id) ] if { $id_exists == 0 || ( $id_exists == 1 && $attributes_arr(id) eq "" ) } { regsub {/} [ad_conn url] {-} form_key - append form_key "-[llength $__form_ids_list]" + append form_key "-[llength ${__form_ids_list}]" } else { # since a FORM id has to be unique, lets use it set form_key $attributes_arr(id) } set attributes_arr(form_id) $form_key - ns_log Notice "qf_form: generating form_id $attributes_arr(form_id)" + ns_log Notice "qf_form.380: generating form_id $attributes_arr(form_id)" } # prepare attributes to process set tag_attributes_list [list] foreach attribute $attributes_list { - set __qf_arr(form_$attribute) $attributes_arr($attribute) + set __qf_arr(form_${attribute}) $attributes_arr(${attribute}) # if a form tag requires an attribute, the following test needs to be forced true - if { $attributes_arr($attribute) ne "" } { - lappend tag_attributes_list $attribute $attributes_arr($attribute) + if { $attributes_arr(${attribute}) ne "" } { + lappend tag_attributes_list $attribute $attributes_arr(${attribute}) } } - set tag_html "" + set tag_html "" # set results __form_arr - append __form_arr($attributes_arr(form_id)) "$tag_html\n" + append __form_arr($attributes_arr(form_id)) ${tag_html} "\n" if { [lsearch $__form_ids_list $attributes_arr(form_id)] == -1 } { lappend __form_ids_list $attributes_arr(form_id) @@ -374,9 +481,15 @@ if { ![info exists attributes_arr(key_id) ] } { set attributes_arr(key_id) "" } - set tag_html "