Index: openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl 10 Jan 2007 21:21:59 -0000 1.7 +++ openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl 8 Dec 2012 18:20:35 -0000 1.8 @@ -65,7 +65,7 @@ } -validate { {proc - { ![empty_string_p [info procs ::${proc}]] } + { [info commands ::${proc} ne ""] } {The specified procedure name does not exist. Is the -procs.tcl file loaded?} } {proc Index: openacs-4/packages/acs-admin/www/install/install.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/install/install.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-admin/www/install/install.tcl 10 Jan 2007 21:22:00 -0000 1.6 +++ openacs-4/packages/acs-admin/www/install/install.tcl 8 Dec 2012 18:20:35 -0000 1.7 @@ -69,8 +69,8 @@ foreach name [lsort -ascii [array names package]] { set row $package($name) - if {[info procs apm::package_version::attributes::maturity_int_to_text] != 0} { - set maturity_text "[apm::package_version::attributes::maturity_int_to_text [lindex $row 6]]" + if {[info commands ::apm::package_version::attributes::maturity_int_to_text] ne ""} { + set maturity_text [::apm::package_version::attributes::maturity_int_to_text [lindex $row 6]] } else { set maturity_text "" } Index: openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl,v diff -u -r1.39 -r1.40 --- openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 30 Oct 2010 21:43:01 -0000 1.39 +++ openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 8 Dec 2012 18:20:36 -0000 1.40 @@ -433,7 +433,7 @@ } if { $callback ne "" && $impl ne "" } { - if { [llength [info procs "::callback::${callback}::contract__arg_parser"]] == 0 } { + if { [info commands "::callback::${callback}::contract__arg_parser"] eq "" } { # We create a dummy arg parser for the contract in case # the contract hasn't been defined yet. We need this # because the implementation doesn't tell us what the @@ -783,16 +783,15 @@ # arg validation -- ::callback::${callback}::contract is an # empty function that only runs the ad_proc generated arg parser. - if {[llength [info proc ::callback::${callback}::contract]] != 1} { + if {[info commands ::callback::${callback}::contract] eq ""} { error "Undefined callback $callback" } eval ::callback::${callback}::contract $args set returns {} set base ::callback::${callback}::impl - foreach procname [lsort [info procs ${base}::$impl]] { - + foreach procname [lsort [info commands ${base}::$impl]] { set c [catch {::uplevel 1 $procname $args} ret] switch -exact $c { 0 { # code ok Index: openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl,v diff -u -r1.34 -r1.35 --- openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 13 Feb 2009 20:28:08 -0000 1.34 +++ openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 8 Dec 2012 18:20:36 -0000 1.35 @@ -444,7 +444,7 @@ # Call db_release_unused_handles, only if the library defining it # (10-database-procs.tcl) has been sourced yet. - if { [llength [info procs db_release_unused_handles]] != 0 } { + if { [info commands db_release_unused_handles] ne ""} { db_release_unused_handles } } Index: openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl,v diff -u -r1.40 -r1.41 --- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 10 Jan 2007 21:22:03 -0000 1.40 +++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 8 Dec 2012 18:20:36 -0000 1.41 @@ -16,7 +16,7 @@ # The following code allows ad_proc to be used # here (a local workalike is declared if absent). # added 2002-09-11 Jeff Davis (davis@xarg.net) -if {{} ne [info procs ad_library] } { +if {[info commands ad_library] ne "" } { ad_library { Query Dispatching for multi-RDBMS capability @@ -26,7 +26,7 @@ } } -if { {} ne [info procs ad_proc] } { +if { [info commands ad_proc] ne ""} { set remove_ad_proc_p 0 } else { set remove_ad_proc_p 1 Index: openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl,v diff -u -r1.8 -r1.9 --- openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 13 Apr 2007 10:23:25 -0000 1.8 +++ openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 8 Dec 2012 18:20:36 -0000 1.9 @@ -199,9 +199,7 @@ } { - return [expr ![string equal \ - [namespace eval $namespace_name \ - "info procs $proc_name"] {}]] + return [expr {[namespace eval $namespace_name "info commands $proc_name"] ne ""}] } ########################################################## Index: openacs-4/packages/acs-developer-support/tcl/acs-developer-support-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-developer-support/tcl/acs-developer-support-procs.tcl,v diff -u -r1.51 -r1.52 --- openacs-4/packages/acs-developer-support/tcl/acs-developer-support-procs.tcl 22 Jan 2010 17:05:20 -0000 1.51 +++ openacs-4/packages/acs-developer-support/tcl/acs-developer-support-procs.tcl 8 Dec 2012 18:20:36 -0000 1.52 @@ -20,7 +20,7 @@ Do we have permission to view developer support stuff. } { set party_id [ds_ad_conn user_id] - if {$party_id == 0} { + if {$party_id == 0 || $party_id eq ""} { # set up a fake id in order to make user_switching mode work # with # non logged users, if not it will enter into a infinite loop @@ -64,20 +64,19 @@ ad_proc -public ds_collection_enabled_p {} { Returns whether we're collecting information about this request } { - global ad_conn - if { [info exists ad_conn(ds_collection_enabled_p)] } { - return $ad_conn(ds_collection_enabled_p) + if { [info exists ::ad_conn(ds_collection_enabled_p)] } { + return $::ad_conn(ds_collection_enabled_p) } - if { ![info exists ad_conn(request)] } { + if { ![info exists ::ad_conn(request)] } { return 0 } foreach pattern [nsv_get ds_properties enabled_ips] { if { [string match $pattern [ad_conn peeraddr]] } { - set ad_conn(ds_collection_enabled_p) 1 + set ::ad_conn(ds_collection_enabled_p) 1 return 1 } } - set ad_conn(ds_collection_enabled_p) 0 + set ::ad_conn(ds_collection_enabled_p) 0 return 0 } @@ -191,46 +190,45 @@ set out "
" if { [ds_enabled_p] && [ds_collection_enabled_p] } { - global ad_conn set ds_url [ds_support_url] - if {![empty_string_p $ds_url]} { - append out "Developer Support Home - Request Information
" + if {$ds_url ne ""} { + append out "Developer Support Home - Request Information
" } else { ns_log Error "ACS-Developer-Support: Unable to offer link to Developer Support \ because it is not mounted anywhere." } - if { [nsv_exists ds_request "$ad_conn(request).db"] } { + if { [nsv_exists ds_request $::ad_conn(request).db] } { set total 0 set counter 0 - foreach { handle command statement_name sql start end errno error } [nsv_get ds_request "$ad_conn(request).db"] { + foreach { handle command statement_name sql start end errno error } [nsv_get ds_request $::ad_conn(request).db] { incr total [expr { $end - $start }] if { [lsearch { dml exec 1row 0or1row select } [lindex $command 0]] >= 0 } { incr counter } } if { $counter > 0 } { - append out "$counter database command[ad_decode $counter 1 " taking" "s totalling"] [format "%.f" [expr { $total }]] ms
" + append out "$counter database command[ad_decode $counter 1 " taking" "s totalling"] [format {%.f} [expr { $total }]] ms
" } } - if { [nsv_exists ds_request "$ad_conn(request).conn"] } { - array set conn [nsv_get ds_request "$ad_conn(request).conn"] + if { [nsv_exists ds_request $::ad_conn(request).conn] } { + array set conn [nsv_get ds_request $::ad_conn(request).conn] if { [info exists conn(startclicks)] } { append out "Page served in [format "%.f" [expr { ([clock clicks -milliseconds] - $conn(startclicks)) }]] ms
\n" } } if { [parameter::get -package_id [ds_instance_id] -parameter ShowCommentsInlineP -default 0] } { - append out "Comments: On | Off
" - if { [nsv_exists ds_request "$ad_conn(request).comment"] } { - foreach comment [nsv_get ds_request "$ad_conn(request).comment"] { + append out "Comments: On | Off
" + if { [nsv_exists ds_request $::ad_conn(request).comment] } { + foreach comment [nsv_get ds_request $::ad_conn(request).comment] { append out "Comment: $comment
\n" } } } else { - append out "Comments: On | Off
" + append out "Comments: On | Off
" } } @@ -258,9 +256,8 @@ } { set result {} if { [ds_enabled_p] && [ds_collection_enabled_p] } { - global ad_conn - if { [nsv_exists ds_request "$ad_conn(request).conn"] } { - array set conn [nsv_get ds_request "$ad_conn(request).conn"] + if { [nsv_exists ds_request $::ad_conn(request).conn] } { + array set conn [nsv_get ds_request $::ad_conn(request).conn] if { [info exists conn(startclicks)] } { set result [format "%.f" [expr { ([clock clicks -milliseconds] - $conn(startclicks)) }]] } @@ -276,11 +273,10 @@ } { set result {} if { [ds_enabled_p] && [ds_collection_enabled_p] } { - global ad_conn - if { [nsv_exists ds_request "$ad_conn(request).db"] } { + if { [nsv_exists ds_request $::ad_conn(request).db] } { set total 0 set counter 0 - foreach { handle command statement_name sql start end errno error } [nsv_get ds_request "$ad_conn(request).db"] { + foreach { handle command statement_name sql start end errno error } [nsv_get ds_request $::ad_conn(request).db] { incr total [expr { $end - $start }] if { [lsearch { dml exec 1row 0or1row select } [lindex $command 0]] >= 0 } { incr counter @@ -322,7 +318,7 @@ # JCD: don't bind if there was an error since this can potentially mess up the traceback # making bugs much harder to track down - if { ($errno == 0 || $errno == 2) && [string equal [db_type] "postgresql"] } { + if { ($errno == 0 || $errno == 2) && [db_type] eq "postgresql" } { upvar bind bind set _errno [catch { if { [info exists bind] && [llength $bind] != 0 } { @@ -361,11 +357,10 @@ return } - global ad_conn - if { ![info exists ad_conn(request)] } { - set ad_conn(request) [nsv_incr rp_properties request_count] + if { ![info exists ::ad_conn(request)] } { + set ::ad_conn(request) [nsv_incr rp_properties request_count] } - eval [concat [list nsv_lappend ds_request "$ad_conn(request).$name"] $args] + nsv_lappend ds_request $::ad_conn(request).$name {*}$args } } @@ -435,8 +430,9 @@ set real_user_id [ds_get_real_user_id] set return_url [ad_conn url] - if { ![empty_string_p [ad_conn query]] } { - append return_url "?[ad_conn query]" + set query [ad_conn query] + if { $query ne "" } { + append return_url "?$query" } set you_are {} @@ -472,7 +468,7 @@ } set ds_url [ds_support_url] - if {![empty_string_p $ds_url]} { + if {$ds_url ne ""} { return "
$you_are $you_are_really @@ -495,10 +491,10 @@ ad_proc -private ds_ad_conn { args } { Get the "real" user id. } { - if { [llength [info proc orig_ad_conn]] == 1 } { - return [eval orig_ad_conn $args] + if {[info commands orig_ad_conn] ne ""} { + return [orig_ad_conn {*}$args] } else { - return [eval ad_conn $args] + return [ad_conn {*}$args] } } @@ -519,12 +515,12 @@ delegates to ad_conn in all other cases. } { foreach elm { user_id untrusted_user_id } { - if { [string equal [lindex $args 0] $elm] || - ([string equal [lindex $args 0] "-get"] && [string equal [lindex $args 1] $elm]) } { + if { [lindex $args 0] eq $elm || + ([lindex $args 0] eq "-get" && [lindex $args 1] eq $elm) } { return [ds_get_user_id] } } - return [eval orig_ad_conn $args] + return [orig_ad_conn {*}$args] } ad_proc -public ds_set_user_switching_enabled { enabled_p } { @@ -533,7 +529,7 @@ @author Lars Pind (lars@pinds.com) @creation-date 31 August 2000 } { - ns_log Notice "Developer-support user-switching [ad_decode $enabled_p 1 "enabled" "disabled"]" + ns_log Notice "Developer-support user-switching [ad_decode $enabled_p 1 enabled disabled]" nsv_set ds_properties user_switching_enabled_p $enabled_p } @@ -571,10 +567,9 @@ Replace the ad_get_user procs with our own versions } { if { $enabled_p } { - if { [llength [info proc orig_ad_get_user_id]] == 0 } { - #ds_comment "Enabling user-switching2" - - # let the user stay who he is now (but ignore any error trying to do so) + if { [info commands orig_ad_get_user_id] eq ""} { + #ds_comment "Enabling user-switching" + # let the user stay who he is now (but ignore any error trying to do so) catch { ad_set_client_property developer-support user_id [ad_get_user_id] } @@ -583,7 +578,7 @@ rename ad_verify_and_get_user_id orig_ad_verify_and_get_user_id proc ad_conn { args } { - eval ds_conn $args + ds_conn {*}$args } proc ad_get_user_id {} { ds_get_user_id @@ -594,7 +589,7 @@ } } else { #ds_comment "Disabling user-switching" - if { [llength [info proc orig_ad_get_user_id]] == 1 } { + if { [info commands orig_ad_get_user_id] ne ""} { rename ad_conn {} rename orig_ad_conn ad_conn @@ -637,9 +632,8 @@ Get comments for the current request } { set comments [list] - global ad_conn - if { [nsv_exists ds_request "$ad_conn(request).comment"] } { - set comments [nsv_get ds_request "$ad_conn(request).comment"] + if { [nsv_exists ds_request $::ad_conn(request).comment] } { + set comments [nsv_get ds_request $::ad_conn(request).comment] } return $comments } @@ -663,20 +657,19 @@ if {![ds_enabled_p]} { error "DS not enabled" } - global ds_profile__start_clock switch $command { start { - if { [empty_string_p $tag] } { + if { $tag eq "" } { error "Tag parameter is required" } - set ds_profile__start_clock($tag) [clock clicks -milliseconds] + set ::ds_profile__start_clock($tag) [clock clicks -milliseconds] } stop { - if { [info exists ds_profile__start_clock($tag)] - && ![empty_string_p $ds_profile__start_clock($tag)] } { + if { [info exists ::ds_profile__start_clock($tag)] + && $::ds_profile__start_clock($tag) ne "" } { ds_add prof $tag \ - [expr [clock clicks -milliseconds] - $ds_profile__start_clock($tag)] - unset ds_profile__start_clock($tag) + [expr [clock clicks -milliseconds] - $::ds_profile__start_clock($tag)] + unset ::ds_profile__start_clock($tag) } else { ns_log Warning "ds_profile stop called without a corresponding call to ds_profile start, with tag $tag" } Index: openacs-4/packages/acs-developer-support/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-developer-support/www/index.tcl,v diff -u -r1.19 -r1.20 --- openacs-4/packages/acs-developer-support/www/index.tcl 18 Nov 2012 17:17:08 -0000 1.19 +++ openacs-4/packages/acs-developer-support/www/index.tcl 8 Dec 2012 18:20:36 -0000 1.20 @@ -10,12 +10,11 @@ ds_require_permission [ad_conn package_id] "admin" -set enabled_p [nsv_get ds_properties enabled_p] -set user_switching_enabled_p [expr {[nsv_exists ds_properties user_switching_enabled_p] ? - [nsv_get ds_properties user_switching_enabled_p] : 0}] -set database_enabled_p [nsv_get ds_properties database_enabled_p] -set profiling_enabled_p [nsv_get ds_properties profiling_enabled_p] -set adp_reveal_enabled_p [nsv_get ds_properties adp_reveal_enabled_p] +set enabled_p [ds_enabled_p] +set user_switching_enabled_p [ds_user_switching_enabled_p] +set database_enabled_p [ds_database_enabled_p] +set profiling_enabled_p [ds_profiling_enabled_p] +set adp_reveal_enabled_p [ds_adp_reveal_enabled_p] set package_id [ad_conn package_id] Index: openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl,v diff -u -r1.24 -r1.25 --- openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 30 Oct 2010 21:43:01 -0000 1.24 +++ openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 8 Dec 2012 18:20:36 -0000 1.25 @@ -38,8 +38,8 @@ @author Lars Pind (lars@collaboraid.biz) @see acs_sc_call } { - if { [exists_and_not_null impl_id] } { - if { [exists_and_not_null impl] } { + if { $impl_id ne "" } { + if { $impl ne "" } { error "Cannot supply both impl and impl_id" } acs_sc::impl::get -impl_id $impl_id -array impl_info @@ -49,7 +49,7 @@ } set contract $impl_info(impl_contract_name) } - if { ![exists_and_not_null impl] || ![exists_and_not_null contract] } { + if { $impl eq "" || $contract eq "" } { error "You must supply either impl_id, or contract and impl to acs_sc::invoke" } return [acs_sc_call -error=$error_p $contract $operation $call_args $impl] @@ -254,13 +254,13 @@ } { set proc_name [acs_sc_generate_name $contract $impl $operation] - if { [llength [info procs $proc_name]] == 1 } { + if { [info commands $proc_name] ne "" } { return [ad_apply $proc_name $arguments] } else { if { $error_p } { error "Operation $operation is not implemented in '$impl' implementation of contract '$contract'" } else { - ns_log warning "ACS-SC: Function Not Found: $proc_name [info procs $proc_name]" + ns_log warning "ACS-SC: Function Not Found: $proc_name [info commands $proc_name]" } return } Index: openacs-4/packages/acs-service-contract/www/binding-display.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/www/binding-display.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-service-contract/www/binding-display.tcl 24 Apr 2008 08:02:55 -0000 1.3 +++ openacs-4/packages/acs-service-contract/www/binding-display.tcl 8 Dec 2012 18:20:36 -0000 1.4 @@ -50,7 +50,7 @@ } { if {$impl_pl eq "TCL"} { regsub {^::} $impl_alias {} impl_alias - if {[info proc ::$impl_alias] ne ""} { + if {[info commands ::$impl_alias] ne ""} { append impl_alias " {[info args ::$impl_alias]}" } elseif {[llength $impl_alias]>1 && [info command ::xotcl::Object] ne "" Index: openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl,v diff -u -r1.11 -r1.12 --- openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl 9 May 2009 22:27:53 -0000 1.11 +++ openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl 8 Dec 2012 18:20:36 -0000 1.12 @@ -57,7 +57,7 @@ 5.2.0a2 5.2.0a3 { db_transaction { db_foreach select_group_name {select group_id, group_name from groups} { - if { ![empty_string_p [info procs "::lang::util::convert_to_i18n"]] } { + if { [info commands "::lang::util::convert_to_i18n"] ne "" } { set pretty_name [lang::util::convert_to_i18n -message_key "group_title_${group_id}" -text "$group_name"] } else { set pretty_name "$group_name" @@ -80,7 +80,7 @@ 5.2.0a2 5.2.0a3 { db_transaction { db_foreach select_group_name {select group_id, group_name from groups} { - if { ![empty_string_p [info procs "::lang::util::convert_to_i18n"]] } { + if { [info commands "::lang::util::convert_to_i18n"] ne "" } { set pretty_name [lang::util::convert_to_i18n -message_key "group_title_${group_id}" -text "$group_name"] } else { set pretty_name "$group_name" Index: openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl,v diff -u -r1.10 -r1.11 --- openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl 19 Sep 2007 13:29:55 -0000 1.10 +++ openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl 8 Dec 2012 18:20:36 -0000 1.11 @@ -379,7 +379,7 @@ if {$datatype eq "enumeration"} { return 1 } - if { [empty_string_p [info procs "::template::data::validate::$datatype"]] } { + if { [info commands "::template::data::validate::$datatype"] eq "" } { return 0 } return 1 Index: openacs-4/packages/acs-subsite/tcl/group-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/group-procs.tcl,v diff -u -r1.37 -r1.38 --- openacs-4/packages/acs-subsite/tcl/group-procs.tcl 1 Dec 2009 09:24:13 -0000 1.37 +++ openacs-4/packages/acs-subsite/tcl/group-procs.tcl 8 Dec 2012 18:20:36 -0000 1.38 @@ -127,7 +127,7 @@ # (through the pretty name). We just have to change the display of # groups to the title at the appropriate places. - if { [info procs "::lang::util::convert_to_i18n"] ne "" } { + if { [info commands "::lang::util::convert_to_i18n"] ne "" } { set pretty_name [lang::util::convert_to_i18n -message_key "group_title_${group_id}" -text "$pretty_name"] }