Index: openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl,v diff -u -r1.44 -r1.44.2.1 --- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 27 Apr 2015 15:28:16 -0000 1.44 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 17 Aug 2015 16:43:54 -0000 1.44.2.1 @@ -356,10 +356,7 @@ Test the auth::password::change proc. } { aa_stub acs_mail_lite::send { - acs_mail_lite::send__arg_parser - - global ns_sendmail_to - set ns_sendmail_to $to_addr + set ::ns_sendmail_to $to_addr } aa_run_with_teardown \ @@ -376,8 +373,7 @@ -secret_answer "no_answer"] set user_id $user_info(user_id) - global ns_sendmail_to - set ns_sendmail_to {ns_sendmail_UNCALLED} + set ::ns_sendmail_to {ns_sendmail_UNCALLED} parameter::set_value -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -value 1 aa_true "Send email" [parameter::get -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -default 1] @@ -394,8 +390,8 @@ "ok" # Check that user gets email about changed password - aa_equals "Email sent to user" $ns_sendmail_to $email - set ns_sendmail_to {} + aa_equals "Email sent to user" $::ns_sendmail_to $email + set ::ns_sendmail_to {} # check that the new password is actually set correctly set password_correct_p [ad_check_password $user_id $new_password] @@ -731,19 +727,15 @@ Test acs-kernel.EmailAccountOwnerOnPasswordChangeP parameter } { aa_stub acs_mail_lite::send { - acs_mail_lite::send__arg_parser - - global ns_sendmail_to - set ns_sendmail_to $to_addr + set ::ns_sendmail_to $to_addr } aa_run_with_teardown \ -rollback \ -test_code { parameter::set_value -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -value 1 - global ns_sendmail_to - set ns_sendmail_to {} + set ::ns_sendmail_to {} # Create a dummy local user set username [ad_generate_random_string] @@ -779,8 +771,8 @@ } # Check that we get email - aa_equals "Email sent to user" $ns_sendmail_to $email - set ns_sendmail_to {ns_sendmail_UNCALLED} + aa_equals "Email sent to user" $::ns_sendmail_to $email + set ::ns_sendmail_to {ns_sendmail_UNCALLED} # Set parameter to false parameter::set_value -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -value 0 @@ -795,7 +787,7 @@ aa_equals "Password change OK" $result(password_status) "ok" # Check that we do not get an email - aa_equals "Email NOT sent to user" $ns_sendmail_to {ns_sendmail_UNCALLED} + aa_equals "Email NOT sent to user" $::ns_sendmail_to {ns_sendmail_UNCALLED} ad_parameter_cache -delete [ad_acs_kernel_id] EmailAccountOwnerOnPasswordChangeP } Index: openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl,v diff -u -r1.20 -r1.20.2.1 --- openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl 27 Oct 2014 16:39:02 -0000 1.20 +++ openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl 17 Aug 2015 16:43:54 -0000 1.20.2.1 @@ -501,7 +501,6 @@ Test IMS Enterprise 1.1 batch sync with the XML document from the specification. } { aa_stub acs_sc::invoke { - acs_sc::invoke__arg_parser if { $contract eq "auth_sync_retrieve" && $operation eq "GetDocument" } { array set result { @@ -684,7 +683,6 @@ Test IMS Enterprise 1.1 batch sync with a constructed document which actually works } { aa_stub acs_sc::invoke { - acs_sc::invoke__arg_parser if { $contract eq "auth_sync_retrieve" && $operation eq "GetDocument" } { array set result { Index: openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl,v diff -u -r1.40 -r1.40.2.1 --- openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl 27 Jun 2015 17:13:45 -0000 1.40 +++ openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl 17 Aug 2015 16:43:54 -0000 1.40.2.1 @@ -1,4 +1,3 @@ - ############################################################################## # # Copyright 2001, OpenACS, Peter Harper. @@ -7,7 +6,6 @@ # ############################################################################## - ad_library { Procs to support the acs-automated-testing package. @@ -34,6 +32,61 @@ } } +proc aa_proc_copy {proc_name_old proc_name_new {new_body ""}} { + # + # This is a single proc handling all stub management requirements + # from aa-testing. Since the arglist nsf::procs is not simply "args" + # (like for proc based ad_procs), but the real argument/parameter + # list, we address these differences here for all needed cases. + # + if {[info proc $proc_name_old] ne ""} { + # + # We copy a regular Tcl proc + # + set args {} + foreach arg [info args $proc_name_old] { + if { [info default $proc_name_old $arg default_value] } { + lappend args [list $arg $default_value] + } else { + lappend args $arg + } + } + set old_body [info body $proc_name_old] + if {$new_body eq ""} { + set new_body $old_body + } + set arg_parser "[namespace tail $proc_name_old]__arg_parser" + # + # In case a arg-parser was used in the old body, but is + # missing in the new version, add it automatically to the new + # body. + # + if {[string match *$arg_parser* $old_body]} { + if {![string match *$arg_parser* $new_body]} { + set new_body $arg_parser\n$new_body + #ns_log notice "... auto added arg_parser for '$proc_name_new' ====> new_body $new_body" + } + } + ::proc $proc_name_new $args $new_body + } elseif {$::acs::useNsfProc && [info commands $proc_name_old] ne ""} { + # + # We copy a nsf::proc + # + # Use an absolute name to reference to a nsf::proc + # unambiguously + # + set proc_name [namespace which $proc_name_old] + if {$new_body eq ""} { + set new_body [::nsf::cmd::info body $proc_name] + } + nsf::proc -ad $proc_name_new \ + [::nsf::cmd::info parameter $proc_name] \ + $new_body + } else { + error "no such proc $proc_name_old" + } +} + ad_proc -public aa_stub { proc_name new_body @@ -58,21 +111,11 @@ # if {$proc_name ni $aa_stub_names} { lappend aa_stub_names $proc_name - proc ${proc_name}_unstubbed [info args $proc_name] [info body $proc_name] + aa_proc_copy $proc_name ${proc_name}_unstubbed } set aa_stub_sequence($proc_name) 1 - set args [list] - set counter 0 - foreach arg [info args $proc_name] { - if { [info default $proc_name $arg default_value] } { - lappend args [list $arg $default_value] - } else { - lappend args $arg - } - } - - proc $proc_name $args " + aa_proc_copy $proc_name $proc_name " global aa_stub_sequence global aa_testcase_id set sequence_id \$aa_stub_sequence\($proc_name\) @@ -85,9 +128,9 @@ # File wide stub. # if {![nsv_exists aa_file_wide_stubs [info script]]} { - nsv_set aa_file_wide_stubs "[info script]" {} + nsv_set aa_file_wide_stubs [info script] {} } - nsv_lappend aa_file_wide_stubs "[info script]" [list $proc_name $new_body] + nsv_lappend aa_file_wide_stubs [info script] [list $proc_name $new_body] } } @@ -97,17 +140,7 @@ @author Peter Harper @creation-date 24 July 2001 } { - set args [list] - set counter 0 - foreach arg [info args $proc_name] { - if { [info default $proc_name $arg default_value] } { - lappend args [list $arg $default_value] - } else { - lappend args $arg - } - } - - proc $proc_name $args [info body ${proc_name}_unstubbed] + aa_proc_copy ${proc_name}_unstubbed $proc_name return } @@ -316,14 +349,14 @@
  • security_risk: May introduce a security risk.
  • populator: Creates sample data for future use.
  • production_safe: Can be used on a live production site, ie for sanity checking or keepalive purposes. Implies: no risk of adding or deleting data; no risk of crashing; minimal cpu/db/net load. - + @param error_level Force all test failures to this error level. One of - + @param bugs A list of integers correspending to openacs.org bug numbers which relate to this test case. @param procs A list of OpenACS procs which are tested by this case. @@ -1104,8 +1137,8 @@ # TODO: Not working set service(admin_login_url) [export_vars -base $service(url)register/ { - { email $service(adminemail) } - { password $service(adminpassword) } + { email $service(adminemail) } + { password $service(adminpassword) } }] set service(auto_test_url) "$service(url)test/admin" set service(rebuild_cmd) "sh [file join $service(script_path) recreate.sh]" @@ -1126,7 +1159,7 @@ db_foreach result_counts { select result, - count(*) as result_count + count(*) as result_count from aa_test_results group by result } { @@ -1139,7 +1172,7 @@ db_foreach failure_counts { select testcase_id, - count(*) as failure_count + count(*) as failure_count from aa_test_results where result = 'fail' group by testcase_id @@ -1174,7 +1207,7 @@ set file_path "$report_dir/${hostname}-${server}-testreport.xml" set xml_doc [get_test_doc] - + if { [catch {template::util::write_file $file_path $xml_doc} errmsg] } { ns_log Error "Failed to write xml test report to path $file_path - $errmsg" } @@ -1219,15 +1252,15 @@ ad_proc -public aa_get_first_url { {-package_key:required} } { - Procedure for geting the url of a mounted package with the package_key. It uses the first instance that it founds. This is usefull for tclwebtest tests. + Procedure for geting the url of a mounted package with the package_key. It uses the first instance that it founds. This is usefull for tclwebtest tests. } { if {![db_0or1row first_url { *SQL* }]} { site_node::instantiate_and_mount -package_key $package_key - db_1row first_url {*SQL*} -} + db_1row first_url {*SQL*} + } - return $url + return $url } @@ -1243,9 +1276,9 @@ @param explanation An explanation accompanying the response. } { if {$response} { - aa_log_result "pass" $explanation + aa_log_result "pass" $explanation } else { - aa_log_result "fail" $explanation + aa_log_result "fail" $explanation } } @@ -1265,7 +1298,7 @@ # request. return $_acs_automated_testing_selenium_init } - + set server_url [parameter::get_from_package_key \ -package_key acs-automated-testing \ -parameter "SeleniumRcServer" \ @@ -1295,3 +1328,10 @@ "Init Class for Selenium Remote Control" \ {aa_selenium_init} \ {catch {Se stop} errmsg} + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/acs-bootstrap-installer/acs-bootstrap-installer.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/acs-bootstrap-installer.info,v diff -u -r1.39 -r1.39.2.1 --- openacs-4/packages/acs-bootstrap-installer/acs-bootstrap-installer.info 21 May 2015 10:00:20 -0000 1.39 +++ openacs-4/packages/acs-bootstrap-installer/acs-bootstrap-installer.info 17 Aug 2015 16:43:54 -0000 1.39.2.1 @@ -9,16 +9,16 @@ f t - + Don Baccus Bootstraps an OpenACS installation. - 2013-09-08 + 2015-08-17 OpenACS This package bootstraps OpenACS. If the core packages have not yet been installed, it calls the installer which leads the user through the steps necessary to do so. It also checks that the installation meets the requirements for a successful install of OpenACS. GPL 3 - + Index: openacs-4/packages/acs-bootstrap-installer/installer/tcl/0-acs-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/installer/tcl/0-acs-init.tcl,v diff -u -r1.2 -r1.2.2.1 --- openacs-4/packages/acs-bootstrap-installer/installer/tcl/0-acs-init.tcl 27 Oct 2014 16:39:04 -0000 1.2 +++ openacs-4/packages/acs-bootstrap-installer/installer/tcl/0-acs-init.tcl 17 Aug 2015 16:43:55 -0000 1.2.2.1 @@ -7,11 +7,15 @@ # # $Id$ -# handling NaviServer deprecated ns_info subcommands. namespace eval acs { + # + # Handling NaviServer deprecated ns_info subcommands. + # set ::acs::pageroot [expr {[catch {ns_server pagedir}] ? [ns_info pageroot] : [ns_server pagedir]}] - set ::acs::tcllib [expr {[catch {ns_server tcllib}] ? [ns_info tcllib] : [ns_server tcllib]}] - set ::acs::rootdir [file dirname [string trimright $::acs::tcllib "/"]] + set ::acs::tcllib [expr {[catch {ns_server tcllib}] ? [ns_info tcllib] : [ns_server tcllib]}] + set ::acs::rootdir [file dirname [string trimright $::acs::tcllib "/"]] + # + set ::acs::useNsfProc [expr {[info commands ::nsf::proc] ne ""}] } # Determine the OpenACS root directory, which is the directory right above the 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.42 -r1.42.2.1 --- openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 27 Oct 2014 16:39:06 -0000 1.42 +++ openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 17 Aug 2015 16:43:55 -0000 1.42.2.1 @@ -6,22 +6,21 @@ nsv_array set proc_doc [list] nsv_array set proc_source_file [list] + +# +# Safetybelt for ::acs::useNsfProc for upgrade phase +# +if {![info exists ::acs::useNsfProc]} { + ns_log notice "use fallback value for ::acs::useNsfProc" + set ::acs::useNsfProc 0 +} + proc number_p { str } { - return [regexp {^[-+]?[0-9]*(.[0-9]+)?$} $str] + return [regexp {^[-+]?[0-9]*(.[0-9]+)?$} $str] - # Note that this will return true for empty string! - # TODO: Presumably this is by design? Probably better to use - # ad_var_type_check_number_p anyway. - # - # Note that ACS 3.2 defined number_p like this: - # - # if { $var eq "" } { - # return 0 - # } else { - # return [regexp {^-?[0-9]*\.?[0-9]*$} $var match] - # } - # - # --atp@piskorski.com, 2003/03/16 21:09 EST + # Note that this will return true for empty string! + # + # TODO: Why not use Tcl's "string is double" ? } proc empty_string_p { query_string } { @@ -175,7 +174,10 @@ set n_args_remaining [expr { [llength $args] - $i }] if {$callback eq ""} { - # We are creating a normal proc so the proc name is an argument + # + # We are creating an ordinary proc so the proc name is an + # argument + # if { $n_args_remaining < 3 || $n_args_remaining > 4} { return -code error "Wrong number of arguments passed to ad_proc" } @@ -184,13 +186,17 @@ set proc_name [lindex $args $i] } else { if {$impl ne "" } { - # We are creating an implementation... + # + # We are creating a callback implementation + # if {$n_args_remaining != 3} { return -code error "ad_proc callback implementation must have: arguments (can be empty) docs code_body" } } if {$impl eq ""} { - # We are creating an callback contract... + # + # We are creating a contract for a callback + # if {!( $n_args_remaining == 3 || $n_args_remaining == 2 ) } { return -code error "ad_proc callback contract must have: arguments docs \[empty_code_body\]" } elseif {$n_args_remaining == 3 @@ -242,8 +248,7 @@ if { $callback ne "" } { # Do a namespace eval of each namespace to ensure it exists - set namespaces [split $proc_name ::] - set namespaces [lrange $namespaces 0 end-1] + set namespaces [lrange [split $proc_name ::] 0 end-1] set curr_ns "" foreach ns $namespaces { @@ -265,8 +270,7 @@ } set code_block [lindex $args end] - if {$callback ne "" - && $impl ne "" } { + if {$callback ne "" && $impl ne "" } { if {[info exists doc_elements(see)]} { lappend doc_elements(see) "callback::${callback}::contract" } else { @@ -428,7 +432,9 @@ return } else { # we are creating a callback so create an empty body - set code_block { # this is a callback contract which only invokes its arg parser for input validation } + set code_block { + # this is a callback contract which only invokes its arg parser for input validation + } } } @@ -438,6 +444,7 @@ } if { $callback ne "" && $impl ne "" } { + 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 @@ -448,12 +455,55 @@ # We are creating a callback implementation so we invoke the # arg parser of the contract proc - uplevel [::list proc $proc_name_as_passed args " ::callback::${callback}::contract__arg_parser\n${log_code}$code_block"] + + if {$::acs::useNsfProc} { + uplevel [::list proc $proc_name_as_passed args \ + " ::callback::${callback}::contract__arg_parser {*}\$args\n${log_code}$code_block"] + } else { + uplevel [::list proc $proc_name_as_passed args \ + " ::callback::${callback}::contract__arg_parser\n${log_code}$code_block"] + } + } elseif { $callback eq "" && [llength $switches] == 0 } { + # + # Nothing special is used in the argument definiton, create a + # plain proc + # uplevel [::list proc $proc_name_as_passed $arg_list "${log_code}$code_block"] + } else { - set parser_code " ::upvar args args\n" + # + # Default case, plain Tcl can't handle these cases + # + if {$::acs::useNsfProc} { + # + # nsf::proc can handle these cases. Just in case of the + # callback implementations we have to provide an + # arg_parser of the contract, since OpenACS uses always + # the argument definition of the contract to pass + # arguments in the implementation (which can be very + # confusing). + # + if {$callback ne ""} { + uplevel [::list ::nsf::proc -ad ::callback::${callback}::contract__arg_parser $arg_list { + foreach _ [info vars] { + uplevel [::list set $_ [set $_]] + } + }] + } + #ns_log notice "---- define nsf::proc for [::list proc $proc_name_as_passed $arg_list $code_block]" + uplevel [::list ::nsf::proc -ad $proc_name_as_passed $arg_list ${log_code}$code_block] + return + } + + # + # There is no nsf::proc available. Define for every remaining + # function two procs, one for argument parsing, and one for + # the invocation. The latter one is defined with "args" and + # calls as first step the argument parser. + # + set parser_code " ::upvar args args\n" foreach { name value } [array get default_values] { append parser_code " ::upvar $name val ; ::set val [::list $value]\n" } @@ -508,6 +558,12 @@ ns_write "PARSER CODE:\n\n$parser_code\n\n" } + # + # old style proc + # for a function foo, define "foo $args" and "foo__arg_parser" + # + #ns_log notice "=== old style proc $proc_name_as_passed" + uplevel [::list proc ${proc_name_as_passed}__arg_parser {} $parser_code] uplevel [::list proc $proc_name_as_passed args " ${proc_name_as_passed}__arg_parser\n${log_code}$code_block"] } @@ -788,7 +844,7 @@ set base ::callback::${callback}::impl foreach procname [lsort [info commands ${base}::$impl]] { - set c [catch {::uplevel 1 $procname $args} ret] + set c [catch {::uplevel 1 [::list $procname {*}$args]} ret] switch -exact $c { 0 { # code ok if { $ret ne "" } { 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.43 -r1.43.2.1 --- openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 21 May 2015 10:00:21 -0000 1.43 +++ openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 17 Aug 2015 16:43:55 -0000 1.43.2.1 @@ -602,7 +602,7 @@ acs-bootstrap-installer package (rather than a full tar file install as in eralier versions). - Caveat: don't modify these files in your local installation, addin + Caveat: don't modify these files in your local installation, adding extra files to $::acs::rootdir/tcl is fine. } { set source $::acs::rootdir/packages/acs-bootstrap-installer/installer/tcl 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.43 -r1.43.2.1 --- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 27 Oct 2014 16:39:06 -0000 1.43 +++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 17 Aug 2015 16:43:55 -0000 1.43.2.1 @@ -236,7 +236,14 @@ } } +# small compatibility function to avoid existence checks at runtime +if {[info commands ::nsf::strip_proc_name] eq ""} { + namespace eval ::nsf { + proc ::nsf::strip_proc_name {name} {return $name} + } +} + ad_proc -public db_qd_get_fullname {local_name {added_stack_num 1}} { Find the fully qualified name of the query } { @@ -252,7 +259,7 @@ # (eg. from bootstrap.tcl), in which case we return what we # were given if { [catch {string trimleft [info level [expr {-1 - $added_stack_num}]] ::} proc_name] } { - return $local_name + return [::nsf::strip_proc_name $local_name] } # If util_memoize, we have to go back up one in the stack @@ -261,6 +268,7 @@ set proc_name [info level [expr {-2 - $added_stack_num}]] } + set proc_name [::nsf::strip_proc_name $proc_name] set list_of_source_procs {ns_sourceproc apm_source template::adp_parse template::frm_page_handler rp_handle_tcl_request} # We check if we're running the special ns_ proc that tells us Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v diff -u -r1.41 -r1.41.2.1 --- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 27 Oct 2014 16:40:10 -0000 1.41 +++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 17 Aug 2015 16:43:55 -0000 1.41.2.1 @@ -1019,7 +1019,12 @@ aa_register_case \ -cats {api smoke} \ - -procs {parameter::get parameter::get_from_package_key parameter::set_default parameter::set_default parameter::set_value parameter::set_from_package_key parameter::set_global_value parameter::get_global_value} \ + -procs { + parameter::get parameter::get_from_package_key + parameter::set_default parameter::set_default + parameter::set_value parameter::set_from_package_key + parameter::set_global_value parameter::get_global_value + } \ parameter__check_procs { Test the parameter::* procs @@ -1036,7 +1041,7 @@ apm_parameter_register -parameter_id $parameter_id -scope global x_test_x "" acs-tcl 0 number parameter::set_global_value -package_key acs-tcl -parameter x_test_x -value 3 aa_equals "check global parameter value set/get" \ - [parameter::get_global_value -package_key acs-tcl -parameter x_test_x]\ + [parameter::get_global_value -package_key acs-tcl -parameter x_test_x] \ "3" apm_parameter_unregister $parameter_id @@ -1046,18 +1051,17 @@ where ap.package_key = apt.package_key and apt.singleton_p ='t' - and ap.package_key <> 'acs-kernel' + and ap.package_key <> 'acs-kernel' and ap.package_key <> 'search' }] { lassign $tuple parameter_name package_key default_value parameter_id set value [random] if {$parameter_name ne "PasswordExpirationDays" && $value > 0.7} { - set package_id [apm_package_id_from_key $package_key] + set package_id [apm_package_id_from_key $package_key] set actual_value [db_string real_value { select apm_parameter_values.attr_value - from - apm_parameter_values + from apm_parameter_values where apm_parameter_values.package_id = :package_id and apm_parameter_values.parameter_id = :parameter_id }] Index: openacs-4/tcl/0-acs-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/tcl/0-acs-init.tcl,v diff -u -r1.7 -r1.7.2.1 --- openacs-4/tcl/0-acs-init.tcl 27 Oct 2014 16:42:09 -0000 1.7 +++ openacs-4/tcl/0-acs-init.tcl 17 Aug 2015 16:43:55 -0000 1.7.2.1 @@ -7,11 +7,15 @@ # # $Id$ -# handling NaviServer deprecated ns_info subcommands. namespace eval acs { + # + # Handling NaviServer deprecated ns_info subcommands. + # set ::acs::pageroot [expr {[catch {ns_server pagedir}] ? [ns_info pageroot] : [ns_server pagedir]}] - set ::acs::tcllib [expr {[catch {ns_server tcllib}] ? [ns_info tcllib] : [ns_server tcllib]}] - set ::acs::rootdir [file dirname [string trimright $::acs::tcllib "/"]] + set ::acs::tcllib [expr {[catch {ns_server tcllib}] ? [ns_info tcllib] : [ns_server tcllib]}] + set ::acs::rootdir [file dirname [string trimright $::acs::tcllib "/"]] + # + set ::acs::useNsfProc [expr {[info commands ::nsf::proc] ne ""}] } # Determine the OpenACS root directory, which is the directory right above the