Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl,v diff -u -r1.108.2.12 -r1.108.2.13 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 16 Oct 2013 19:49:09 -0000 1.108.2.12 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 31 Oct 2013 17:38:01 -0000 1.108.2.13 @@ -495,8 +495,7 @@ set satisfied_p 1 foreach req [concat $version(embeds) $version(extends) $version(requires)] { - set req_uri [lindex $req 0] - set req_version [lindex $req 1] + lassign $req req_uri req_version if { ![info exists provided($req_uri)] || \ [apm_version_names_compare $provided($req_uri) $req_version]== -1 } { @@ -530,8 +529,7 @@ # Record what this package provides, and remove it from the required list, if appropriate foreach prov $version(provides) { - set prov_uri [lindex $prov 0] - set prov_version [lindex $prov 1] + lassign $prov prov_uri prov_version # If what we provide is not already provided, or the alredady provided version is # less than what we provide, record this new provision if { ![info exists provided($prov_uri)] || \ @@ -578,8 +576,7 @@ # Let's see if this package provides anything we need foreach prov $version(provides) { - set prov_uri [lindex $prov 0] - set prov_version [lindex $prov 1] + lassign $prov prov_uri prov_version if { [info exists required($prov_uri)] && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 @@ -625,10 +622,8 @@ # Find unsatisfied requirements foreach req [concat $version(embeds) $version(extends) $version(requires)] { - set req_uri [lindex $req 0] - set req_version [lindex $req 1] - if { ![info exists provided($req_uri)] || \ - [apm_version_names_compare $provided($req_uri) $req_version] == -1 } { + lassign $req req_uri req_version + if { ![info exists provided($req_uri)] || [apm_version_names_compare $provided($req_uri) $req_version] == -1 } { lappend failed($package_key) [list $req_uri $req_version] if { [info exists provided($req_uri)] } { ns_log Debug "apm_dependency_check_new: Failed dependency: $package_key embeds/extends/requires $req_uri $req_version, but we only provide $provided($req_uri)" @@ -725,8 +720,7 @@ $install_spec_files] if { [lindex $dependency_results 0] == 1 } { - apm_packages_full_install -callback apm_ns_write_callback \ - [lindex $dependency_results 1] + apm_packages_full_install -callback apm_ns_write_callback [lindex $dependency_results 1] } else { foreach package_spec [lindex $dependency_results 1] { if {[string is false [pkg_info_dependency_p $package_spec]]} { @@ -1253,8 +1247,7 @@ } foreach item $data_model_files { - set file_path [lindex $item 0] - set file_type [lindex $item 1] + lassign $item file_path file_type ns_log Debug "apm_package_install_data_model: Now processing $file_path of type $file_type" if {$file_type eq "data_model_create" || $file_type eq "data_model_upgrade" } { @@ -1377,29 +1370,25 @@ foreach item $provides { - set interface_uri [lindex $item 0] - set interface_version [lindex $item 1] + lassign $item interface_uri interface_version ns_log Debug "apm_package_install_dependencies: Registering dependency $interface_uri, $interface_version for $version_id" apm_interface_add $version_id $interface_uri $interface_version } foreach item $embeds { - set dependency_uri [lindex $item 0] - set dependency_version [lindex $item 1] + lassign $item dependency_uri dependency_version ns_log Debug "apm_package_install_dependencies: Registering dependency $dependency_uri, $dependency_version for $version_id" apm_dependency_add embeds $version_id $dependency_uri $dependency_version } foreach item $extends { - set dependency_uri [lindex $item 0] - set dependency_version [lindex $item 1] + lassign $item dependency_uri dependency_version ns_log Debug "apm_package_install_dependencies: Registering dependency $dependency_uri, $dependency_version for $version_id" apm_dependency_add extends $version_id $dependency_uri $dependency_version } foreach item $requires { - set dependency_uri [lindex $item 0] - set dependency_version [lindex $item 1] + lassign $item dependency_uri dependency_version ns_log Debug "apm_package_install_dependencies: Registering dependency $dependency_uri, $dependency_version for $version_id" apm_dependency_add requires $version_id $dependency_uri $dependency_version } @@ -1429,8 +1418,7 @@ } set counter 0 foreach item $owners { - set owner_name [lindex $item 0] - set owner_uri [lindex $item 1] + lassign $item owner_name owner_uri db_dml owner_insert { insert into apm_package_owners(version_id, owner_uri, owner_name, sort_key) values(:version_id, :owner_uri, :owner_name, :counter) @@ -1792,9 +1780,7 @@ set query_file_list [list] foreach file $file_list { - set path [lindex $file 0] - set file_type [lindex $file 1] - set file_db_type [lindex $file 2] + lassign $file path file_type file_db_type ns_log Debug "apm_query_files_find: Checking \"$path\" of type \"$file_type\" and db_type \"$file_db_type\"." # DRB: we return query files which match the given database type or for which no db_type Index: openacs-4/packages/acs-tcl/tcl/http-auth-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/http-auth-procs.tcl,v diff -u -r1.2 -r1.2.6.1 --- openacs-4/packages/acs-tcl/tcl/http-auth-procs.tcl 11 Mar 2010 11:20:48 -0000 1.2 +++ openacs-4/packages/acs-tcl/tcl/http-auth-procs.tcl 31 Oct 2013 17:38:01 -0000 1.2.6.1 @@ -18,10 +18,8 @@ # get the second bit, the base64 encoded bit set up [lindex [split $a " "] 1] # after decoding, it should be user:password; get the username - set user [lindex [split [ns_uudecode $up] ":"] 0] - set password [lindex [split [ns_uudecode $up] ":"] 1] + lassign [split [ns_uudecode $up] ":"] user password ns_log debug "\nACS VERSION [ad_acs_version]" - ns_log debug "\nHTTP authentication" # check all authorities foreach authority [auth::authority::get_authority_options] { Index: openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl,v diff -u -r1.30.2.3 -r1.30.2.4 --- openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl 12 Oct 2013 13:55:18 -0000 1.30.2.3 +++ openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl 31 Oct 2013 17:38:01 -0000 1.30.2.4 @@ -124,8 +124,7 @@ template::multirow create $multirow url label foreach elm [ad_context_node_list -from_node $from_node $node_id] { - set elm_0 [lindex $elm 0] - set elm_1 [lindex $elm 1] + lassign $elm elm_0 elm_1 if { $node_id_url_end > 0 && [string match -nocase $node_id_url [string range $elm_0 0 ${node_id_url_end}-1] ] } { set elm_0 [string range $elm_0 $node_id_url_end end] } Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v diff -u -r1.65.6.9 -r1.65.6.10 --- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 12 Oct 2013 13:55:18 -0000 1.65.6.9 +++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 31 Oct 2013 17:38:01 -0000 1.65.6.10 @@ -780,8 +780,7 @@ set attr_count 0 foreach attribute $attr_list { incr attr_count - set attr_name [lindex $attribute 0] - set attr_value [lindex $attribute 1] + lassign $attribute attr_name attr_value if { ![info exists allowed_attribute($attr_name)] && ![info exists allowed_attribute(*)] } { Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v diff -u -r1.133.2.29 -r1.133.2.30 --- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 26 Oct 2013 09:24:07 -0000 1.133.2.29 +++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 31 Oct 2013 17:38:02 -0000 1.133.2.30 @@ -1037,9 +1037,7 @@ } { set hidden "" foreach var_spec $args { - set var_spec_pieces [split $var_spec ":"] - set var [lindex $var_spec_pieces 0] - set type [lindex $var_spec_pieces 1] + lassign [split $var_spec ":"] var type upvar 1 $var value if { [info exists value] } { switch $type { @@ -1168,18 +1166,13 @@ foreach var_spec $args { if { [string first "=" $var_spec] != -1 } { # There shouldn't be more than one equal sign, since the value should already be url-encoded. - set var_spec_pieces [split $var_spec "="] - set var [lindex $var_spec_pieces 0] - set value [lindex $var_spec_pieces 1] + lassign [split $var_spec "="] var value lappend params "$var=$value" if { $sign_p } { lappend params "[ns_urlencode [ns_urldecode $var]:sig]=[ns_urlencode [ad_sign [ns_urldecode $value]]]" } } else { - set var_spec_pieces [split $var_spec ":"] - set var [lindex $var_spec_pieces 0] - set type [lindex $var_spec_pieces 1] - + lassign [split $var_spec ":"] var type upvar 1 $var upvar_value if { [info exists upvar_value] } { switch $type { @@ -1324,11 +1317,9 @@ } else { set http [ns_httpopen HEAD $url "" $timeout] } - set rfd [lindex $http 0] - set wfd [lindex $http 1] + lassign $http rfd wfd headers close $rfd close $wfd - set headers [lindex $http 2] set response [ns_set name $headers] set status [lindex $response 1] ns_set free $headers @@ -1373,14 +1364,12 @@ return -code error "Invalid url \"$url\": _httpopen only supports HTTP" } set url [split $url /] - set hp [split [lindex $url 2] :] - set host [lindex $hp 0] - set port [lindex $hp 1] + lassign [split [lindex $url 2] :] host port if { [string match $port ""] } {set port 80} + set uri /[join [lrange $url 3 end] /] - set fds [ns_sockopen -nonblock $host $port] - set rfd [lindex $fds 0] - set wfd [lindex $fds 1] + lassign [ns_sockopen -nonblock $host $port] rfd wfd + if { [catch { _ns_http_puts $timeout $wfd "$method $uri HTTP/1.0\r" _ns_http_puts $timeout $wfd "Host: $host\r" @@ -1428,10 +1417,7 @@ if {[incr depth] > 10} { return -code error "util_httppost: Recursive redirection: $url" } - set http [util_httpopen POST $url "" $timeout $http_referer] - set rfd [lindex $http 0] - set wfd [lindex $http 1] - + lassign [util_httpopen POST $url "" $timeout $http_referer] rfd wfd #headers necesary for a post and the form variables _ns_http_puts $timeout $wfd "Content-type: application/x-www-form-urlencoded \r" @@ -1639,10 +1625,9 @@ return -code error "ad_httpget: Recursive redirection: $url" } - set http [ns_httpopen GET $url $headers $timeout] - set rfd [lindex $http 0] - close [lindex $http 1] - set headers [lindex $http 2] + lassign [ns_httpopen GET $url $headers $timeout] rdf wfd headers + + close $wfd set response [ns_set name $headers] set status [lindex $response 1] set last_modified [ns_set iget $headers last-modified] @@ -2072,14 +2057,8 @@ } # Grab information about the scheduled procedure. - set thread [lindex $proc_info 0] - set once [lindex $proc_info 1] - set interval [lindex $proc_info 2] - set proc [lindex $proc_info 3] - set args [lindex $proc_info 4] - set time [lindex $proc_info 5] + lassign $proc_info thread once interval proc args time . debug set count 0 - set debug [lindex $proc_info 7] ns_mutex lock [nsv_get ad_procs mutex] set procs [nsv_get ad_procs .] @@ -2215,9 +2194,7 @@ } { util_memoize_flush_regexp [list [ad_conn session_id] [ad_conn package_id]] - set url_list [split $url "?"] - set url [lindex $url_list 0] - set vars [lindex $url_list 1] + lassign [split $url "?"] url vars set excluded_vars_list "" set excluded_vars_url "" @@ -2248,9 +2225,7 @@ set saved_list "" if { $vars ne "" } { foreach item_value [split $vars "&"] { - set item_value_pair [split $item_value "="] - set item [lindex $item_value_pair 0] - set value [ns_urldecode [lindex $item_value_pair 1]] + lassign [split $item_value "="] item value if {$item ni $excluded_vars_list} { # No need to save the value if it's being passed ... if {$item in $saved_list} { @@ -2502,9 +2477,7 @@ # This is the host from the browser's HTTP request set Host [ns_set iget [ns_conn headers] Host] - set Hostv [split $Host ":"] - set Host_hostname [lindex $Hostv 0] - set Host_port [lindex $Hostv 1] + lassign [split $Host ":"] Host_hostname Host_port # suppress the configured http port when server is behind a proxy, to keep connection behind proxy set suppress_port [parameter::get -package_id [apm_package_id_from_key acs-tcl] -parameter SuppressHttpPort -default 0] @@ -3439,9 +3412,7 @@ Recursive redirection: $url" } - set http [util_httpopen POST $url $rqset $timeout $http_referer] - set rfd [lindex $http 0] - set wfd [lindex $http 1] + lassign [util_httpopen POST $url $rqset $timeout $http_referer] rfd wfd _ns_http_puts $timeout $wfd \ "Content-type: multipart/form-data; boundary=$boundary\r" @@ -4544,7 +4515,7 @@ # Remember that we've examined the file. set examined_files($file) 1 - if { $check_file_func eq "" || [eval [list $check_file_func $file]] } { + if { $check_file_func eq "" || [$check_file_func $file] } { # If it's a file, add to our list. If it's a # directory, add its contents to our list of files to # examine next time. Index: openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl,v diff -u -r1.17.2.4 -r1.17.2.5 --- openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl 2 Oct 2013 22:55:57 -0000 1.17.2.4 +++ openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl 31 Oct 2013 17:38:02 -0000 1.17.2.5 @@ -145,16 +145,12 @@ set value [lindex [split [ns_localsqltimestamp] " "] 0] } - set date_parts [split $value "-"] if { $value eq "" } { set month "" set day "" set year "" } else { - set date_parts [split $value "-"] - set month [lindex $date_parts 1] - set year [lindex $date_parts 0] - set day [lindex $date_parts 2] + lassign [split $value "-"] year month day } set output "