Index: openacs.org-dev/packages/acs-tcl/tcl/deprecated-utilities-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs.org-dev/packages/acs-tcl/tcl/deprecated-utilities-procs.tcl,v diff -u -r1.1.1.1 -r1.1.1.2 --- openacs.org-dev/packages/acs-tcl/tcl/deprecated-utilities-procs.tcl 9 Jul 2002 17:34:59 -0000 1.1.1.1 +++ openacs.org-dev/packages/acs-tcl/tcl/deprecated-utilities-procs.tcl 8 Oct 2002 15:46:50 -0000 1.1.1.2 @@ -4,14 +4,326 @@ deprecated @author yon [yon@arsdigita.com] - @date 9 Jul 2000 + @creation-date 9 Jul 2000 @cvs-id $Id$ } -proc nmc_GetNewIDNumber {id_name} { +ad_proc -deprecated -warn nmc_IllustraDatetoPrettyDate {sql_date} { + to be removed. +} { + regexp {(.*)-(.*)-(.*)$} $sql_date match year month day + set allthemonths {January February March April May June July August September October November December} + + # we have to trim the leading zero because Tcl has such a + # brain damaged model of numbers and decided that "09-1" + # was "8.0" + + set trimmed_month [string trimleft $month 0] + set pretty_month [lindex $allthemonths [expr $trimmed_month - 1]] + + return "$pretty_month $day, $year" + +} + +ad_proc -deprecated -warn util_prepare_update {table_name primary_key_name primary_key_value form} { + to be removed. +} { + + set form_size [ns_set size $form] + set form_counter_i 0 + set column_list [db_columns $table_name] + set bind_vars [ad_tcl_list_list_to_ns_set [list [list $primary_key_name $primary_key_value]]] + + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + + if { ($form_var_name != $primary_key_name) && ([lsearch $column_list $form_var_name] != -1) } { + + ad_tcl_list_list_to_ns_set -set_id $bind_vars [list [list $form_var_name $value]] + lappend the_sets "$form_var_name = :$form_var_name" + + } + + incr form_counter_i + } + + return [list "update $table_name\nset [join $the_sets ",\n"] \n where $primary_key_name = :$primary_key_name" $bind_vars] + +} + +ad_proc -deprecated -warn util_prepare_update_multi_key {table_name primary_key_name_list primary_key_value_list form} { + to be removed. +} { + + set form_size [ns_set size $form] + set form_counter_i 0 + set bind_vars [ns_set create] + + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + + if { [lsearch -exact $primary_key_name_list $form_var_name] == -1 } { + + # this is not one of the keys + ad_tcl_list_list_to_ns_set -set_id $bind_vars [list [list $form_var_name $value]] + lappend the_sets "$form_var_name = :$form_var_name" + + } + + incr form_counter_i + } + + for {set i 0} {$i<[llength $primary_key_name_list]} {incr i} { + + set this_key_name [lindex $primary_key_name_list $i] + set this_key_value [lindex $primary_key_value_list $i] + + ad_tcl_list_list_to_ns_set -set_id $bind_vars [list [list $this_key_name $this_key_value]] + lappend key_eqns "$this_key_name = :$this_key_name" + + } + + return [list "update $table_name\nset [join $the_sets ",\n"] \n where [join $key_eqns " AND "]" $bind_vars] +} + +ad_proc -deprecated -warn util_prepare_insert {table_name form} { + to be removed. +} { + + set form_size [ns_set size $form] + set form_counter_i 0 + set bind_vars [ns_set create] + + while { $form_counter_i < $form_size } { + + ns_set update $bind_vars [ns_set key $form $form_counter_i] [string trim [ns_set value $form $form_counter_i]] + incr form_counter_i + + } + + return [list "insert into $table_name\n([join [ad_ns_set_keys $bind_vars] ", "])\n values ([join [ad_ns_set_keys -colon $bind_vars] ", "])" $bind_vars] +} + +ad_proc -deprecated -warn util_PrettySex {m_or_f { default "default" }} { + to be removed. +} { + if { $m_or_f == "M" || $m_or_f == "m" } { + return "Male" + } elseif { $m_or_f == "F" || $m_or_f == "f" } { + return "Female" + } else { + # Note that we can't compare default to the empty string as in + # many cases, we are going want the default to be the empty + # string + if { [string compare $default "default"] == 0 } { + return "Unknown (\"$m_or_f\")" + } else { + return $default + } + } +} + +ad_proc -deprecated -warn util_PrettySexManWoman {m_or_f { default "default"} } { + to be removed. +} { + if { $m_or_f == "M" || $m_or_f == "m" } { + return "Man" + } elseif { $m_or_f == "F" || $m_or_f == "f" } { + return "Woman" + } else { + # Note that we can't compare default to the empty string as in + # many cases, we are going want the default to be the empty + # string + if { [string compare $default "default"] == 0 } { + return "Person of Unknown Sex" + } else { + return $default + } + } +} + +ad_proc -deprecated -warn merge_form_with_ns_set {form set_id} { + to be removed. +} { + + for {set i 0} {$i<[ns_set size $set_id]} {incr i} { + set form [ns_formvalueput $form [ns_set key $set_id $i] [ns_set value $set_id $i]] + } + + return $form + +} + + +# Perform the dml statements in sql_list in a transaction. +# Aborts the transaction and returns an error message if +# an error occurred for any of the statements, otherwise +# returns null string. -jsc +ad_proc -deprecated -warn do_dml_transactions {dml_stmt_list} { + to be removed. +} { db_transaction { + foreach dml_stmt $dml_stmt_list { + if { [catch {db_dml $dml_stmt} errmsg] } { + db_abort_transaction + return $errmsg + } + } + } + return "" +} + + +# Perform body within a database transaction. +# Execute on_error if there was some error caught +# within body, with errmsg bound. +# This procedure will clobber errmsg in the caller. +# -jsc +ad_proc -deprecated -warn with_transaction {body on_error} { + to be removed. +} { + upvar errmsg errmsg + global errorInfo errorCode + if { [catch {db_transaction { uplevel $body }} errmsg] } { + db_abort_transaction + set code [catch {uplevel $on_error} string] + # Return out of the caller appropriately. + if { $code == 1 } { + return -code error -errorinfo $errorInfo -errorcode $errorCode $string + } elseif { $code == 2 } { + return -code return $string + } elseif { $code == 3 } { + return -code break + } elseif { $code == 4 } { + return -code continue + } elseif { $code > 4 } { + return -code $code $string + } + } +} + + +ad_proc -deprecated -warn string_contains_p {small_string big_string} { + Returns 1 if the BIG_STRING contains the SMALL_STRING, 0 otherwise; syntactic sugar for string first != -1 + + to be removed. +} { + if { [string first $small_string $big_string] == -1 } { + return 0 + } else { + return 1 + } +} + +ad_proc -deprecated -warn remove_whitespace {input_string} { + to be removed. +} { + if [regsub -all "\[\015\012\t \]" $input_string "" output_string] { + return $output_string + } else { + return $input_string + } +} + +ad_proc -deprecated -warn util_just_the_digits {input_string} { + to be removed. +} { + if [regsub -all {[^0-9]} $input_string "" output_string] { + return $output_string + } else { + return $input_string + } +} + +ad_proc -deprecated -warn leap_year_p {year} { + to be removed. +} { + expr ( $year % 4 == 0 ) && ( ( $year % 100 != 0 ) || ( $year % 400 == 0 ) ) +} + + +ad_proc -deprecated -warn set_csv_variables_after_query {} { + + You can call this after an ns_db getrow or ns_db 1row to set local + Tcl variables to values from the database. You get $foo, $EQfoo + (the same thing but with double quotes escaped), and $QEQQ + (same thing as $EQfoo but with double quotes around the entire + she-bang). +

+ to be removed. +} { + uplevel { + set set_variables_after_query_i 0 + set set_variables_after_query_limit [ns_set size $selection] + while {$set_variables_after_query_i<$set_variables_after_query_limit} { + set [ns_set key $selection $set_variables_after_query_i] [ns_set value $selection $set_variables_after_query_i] + set EQ[ns_set key $selection $set_variables_after_query_i] [util_escape_quotes_for_csv [string trim [ns_set value $selection $set_variables_after_query_i]]] + set QEQQ[ns_set key $selection $set_variables_after_query_i] "\"[util_escape_quotes_for_csv [string trim [ns_set value $selection $set_variables_after_query_i]]]\"" + incr set_variables_after_query_i + } + } +} + +# should remove since openacs does not work on anything other than 3+ +# since it requires tcl8 +ad_proc -deprecated -warn util_aolserver_2_p {} { + to be removed. +} { + if {[string index [ns_info version] 0] == "2"} { + return 1 + } else { + return 0 + } +} + +ad_proc -deprecated -warn ad_chdir_and_exec { dir arg_list } { + chdirs to $dir and executes the command in $arg_list. We'll probably want to improve this to be thread-safe. + to be removed. +} { + cd $dir + eval exec $arg_list +} + +ad_proc -deprecated -warn post_args_to_query_string {} { + to be removed. +} { + set arg_form [ns_getform] + set query_return [list] + if {$arg_form!=""} { + + set form_counter_i 0 + while {$form_counter_i<[ns_set size $arg_form]} { + lappend query_return "[ns_set key $arg_form $form_counter_i]=[ns_urlencode [ns_set value $arg_form $form_counter_i]]" + incr form_counter_i + } + set query_return [join $query_return "&"] + } + return $query_return +} + + +ad_proc -deprecated -warn get_referrer_and_query_string {} { + to be removed. +} { + if {[ad_conn method]!="GET"} { + set query_return [post_args_to_query_string] + return "[get_referrer]?${query_return}" + } else { + return [get_referrer] + } +} + +ad_proc -deprecated -warn nmc_GetNewIDNumber {id_name} { + to be removed. +} { + + db_transaction { db_dml id_number_update "update id_numbers set :id_name = :id_name + 1" set id_number [db_string nmc_getnewidnumber "select unique :id_name from id_numbers"] return $id_number @@ -46,7 +358,9 @@ # database columns or in parent programs # -proc set_variables_after_query {} { +ad_proc -deprecated -warn set_variables_after_query {} { + to be removed. +} { uplevel { set set_variables_after_query_i 0 set set_variables_after_query_limit [ns_set size $selection] @@ -59,7 +373,9 @@ # as above, but you must use sub_selection -proc set_variables_after_subquery {} { +ad_proc -deprecated -warn set_variables_after_subquery {} { + to be removed. +} { uplevel { set set_variables_after_query_i 0 set set_variables_after_query_limit [ns_set size $sub_selection] @@ -74,7 +390,9 @@ #1. specify the name of the "selection" variable #2. append a prefix to all the named variables -proc set_variables_after_query_not_selection {selection_variable {name_prefix ""}} { +ad_proc -deprecated -warn set_variables_after_query_not_selection {selection_variable {name_prefix ""}} { + to be removed. +} { set set_variables_after_query_i 0 set set_variables_after_query_limit [ns_set size $selection_variable] while {$set_variables_after_query_i<$set_variables_after_query_limit} { @@ -90,15 +408,19 @@ # and returns the result (only works when you are after a single row/column # intersection) -proc database_to_tcl_string {db sql} { +ad_proc -deprecated -warn database_to_tcl_string {db sql} { + to be removed. +} { set selection [ns_db 1row $db $sql] return [ns_set value $selection 0] } -proc database_to_tcl_string_or_null {db sql {null_value ""}} { +ad_proc -deprecated -warn database_to_tcl_string_or_null {db sql {null_value ""}} { + to be removed. +} { set selection [ns_db 0or1row $db $sql] if { $selection != "" } { return [ns_set value $selection 0] @@ -110,7 +432,9 @@ #for commands like set full_name ["select first_name, last_name..."] -proc database_cols_to_tcl_string {db sql} { +ad_proc -deprecated -warn database_cols_to_tcl_string {db sql} { + to be removed. +} { set string_to_return "" set selection [ns_db 1row $db $sql] set size [ns_set size $selection] @@ -122,7 +446,11 @@ return [string trim $string_to_return] } -proc_doc database_to_tcl_list {db sql} {takes a query like "select product_id from foobar" and returns all the ids as a Tcl list} { +ad_proc -deprecated -warn database_to_tcl_list {db sql} { + takes a query like "select product_id from foobar" and returns all the ids as a Tcl list + + to be removed. +} { set selection [ns_db select $db $sql] set list_to_return [list] while {[ns_db getrow $db $selection]} { @@ -131,7 +459,13 @@ return $list_to_return } -proc_doc database_to_tcl_list_list {db sql} "Returns a list of Tcl lists, with each sublist containing the columns returned by the database; if no rows are returned by the database, returns the empty list (empty string in Tcl 7.x and 8.x)" { +ad_proc -deprecated -warn database_to_tcl_list_list {db sql} { + Returns a list of Tcl lists, with each sublist containing the columns + returned by the database; if no rows are returned by the database, + returns the empty list (empty string in Tcl 7.x and 8.x) + + to be removed. +} { set selection [ns_db select $db $sql] set list_to_return [list] while {[ns_db getrow $db $selection]} { @@ -147,7 +481,13 @@ return $list_to_return } -proc_doc database_1row_to_tcl_list {db sql} "Returns the column values from one row in the database as a Tcl list. If there isn't exactly one row from this query, throws an error." { +ad_proc -deprecated -warn database_1row_to_tcl_list {db sql} { + Returns the column values from one row in the database as + a Tcl list. If there isn't exactly one row from this query, + throws an error. + + to be removed. +} { set selection [ns_db 1row $db $sql] set list_to_return [list] set size [ns_set size $selection] @@ -163,7 +503,9 @@ # column_list is a list of column names optionally followed by " desc". # Returns a new list with sort_column as the first element, followed # by the columns in column_list excluding any beginning with sort_column. -proc sortable_table_new_sort_order {column_list sort_column} { +ad_proc -deprecated -warn sortable_table_new_sort_order {column_list sort_column} { + to be removed. +} { set new_order [list $sort_column] # Relies on string representation of lists. [lindex "colname desc" 0] @@ -177,7 +519,10 @@ return $new_order } -proc_doc sortable_table {db select_string display_spec vars_to_export sort_var current_sort_order {table_length ""} {extra_table_parameters ""} {stripe_color_list ""} {max_results ""} {header_font_params ""} {row_font_params ""}} {Procedure to format a database query as a table that can be sorted by clicking on the headers. +ad_proc -deprecated -warn sortable_table {db select_string display_spec vars_to_export sort_var current_sort_order {table_length ""} {extra_table_parameters ""} {stripe_color_list ""} {max_results ""} {header_font_params ""} {row_font_params ""}} { + to be removed. +

+Procedure to format a database query as a table that can be sorted by clicking on the headers. Arguments are: