Index: openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl,v diff -u -r1.43 -r1.44 --- openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 25 Jul 2018 17:44:25 -0000 1.43 +++ openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 25 Jul 2018 17:49:26 -0000 1.44 @@ -5,14 +5,14 @@ @author Bryan Quinn (bquinn@arsdigita.com) @creation-date Fri Oct 6 21:46:05 2000 @cvs-id $Id$ -} +} ad_proc -private apm_mkdir {path} { Creates the directory specified by path and returns it. -} { +} { if { [catch { file mkdir $path }] } { @@ -28,20 +28,20 @@ } ad_proc -public apm_workspace_dir {} { - + Return the path to the apm-workspace, creating the directory if necessary. - + } { set path [file join $::acs::rootdir apm-workspace] if { [file isdirectory $path] } { return $path } else { return [apm_mkdir $path] } -} +} ad_proc -public apm_workspace_install_dir {} { - + Return the path to the installation directory of the apm-workspace, creating the directory if necessary. } { @@ -89,16 +89,16 @@ @see apm_file_type_names @see apm_pretty_name_for_file_type - + @author Peter Marklund } { array set file_type_names [apm_file_type_names] return [array names file_type_names] } -ad_proc -public apm_package_info_file_path { +ad_proc -public apm_package_info_file_path { {-path ""} - package_key + package_key } { Returns the path to a .info file in a package directory, or throws an @@ -129,15 +129,15 @@ set apm_file [ad_tmpnam] db_blob_get_file distribution_tar_ball_select { - select content - from cr_revisions + select content + from cr_revisions where revision_id = (select content_item.get_latest_revision(item_id) - from apm_package_versions + from apm_package_versions where version_id = :version_id) } $apm_file file mkdir $dir - # avoid chdir + # avoid chdir #ns_log notice "exec sh -c 'cd $dir ; [apm_gzip_cmd] -d -q -c $apm_file | [apm_tar_cmd] xf - 2>/dev/null'" exec [apm_gzip_cmd] -d -q -c -S .apm $apm_file | [apm_tar_cmd] -xf - -C $dir 2> [apm_dev_null] @@ -146,15 +146,15 @@ ad_proc -private apm_generate_tarball { version_id } { - + Generates a tarball for a version, placing it in the content repository. DCW - 2001-05-03, change to use the content repository for tarball storage. - + } { set package_key [apm_package_key_from_version_id $version_id] set files [apm_get_package_files -all -package_key $package_key] set tmpfile [ad_tmpnam] - + db_1row package_key_select {} # Generate a command like: @@ -172,11 +172,11 @@ lappend cmd -C "$::acs::rootdir/packages" lappend cmd "$package_key/$file" } - + lappend cmd "|" [apm_gzip_cmd] -c ">" $tmpfile {*}$cmd - # At this point, the APM tarball is sitting in $tmpfile. Save it in + # At this point, the APM tarball is sitting in $tmpfile. Save it in # the database. set creation_ip [ad_conn peeraddr] @@ -189,7 +189,7 @@ db_1row item_exists_p {} if {!$item_id} { - # content item hasen't been created yet - create one. + # content item hasen't been created yet - create one. set item_id [content::item::new \ -name $name \ -title $title \ @@ -198,12 +198,12 @@ -creation_user $user_id \ -creation_ip $creation_ip \ -is_live true] - + db_dml set_item_id {} } set revision_id [content::item::get_live_revision -item_id $item_id] - + # No live revision for this item. Possible if somebody already # generated the archive, then deleted or modified the revision # manually or by other means. We create a new live revision. @@ -227,7 +227,7 @@ ad_proc -private apm_files_load { {-force_reload:boolean 0} - {-callback apm_dummy_callback} + {-callback apm_dummy_callback} files } { @@ -260,7 +260,7 @@ apm_callback_and_log $callback "Loaded packages/$package_key/$path." unset apm_current_package_key } else { - apm_callback_and_log $callback "Unable to load packages/$package_key/$path - file is marked as contained in a package but is not present in the filesystem" + apm_callback_and_log $callback "Unable to load packages/$package_key/$path - file is marked as contained in a package but is not present in the filesystem" } } } @@ -302,7 +302,7 @@ ad_proc -public apm_file_watchable_p { path } { Given the path of a file determine if it is appropriate to be watched for reload. The file should - be db compatible with the system and be of right + be db compatible with the system and be of right type (for example contain Tcl procs or xql queries). @param The path of the file relative to server root @@ -315,7 +315,7 @@ @see apm_guess_db_type @author Peter Marklund -} { +} { # The apm_guess procs need package_key and a path relative to package root # so parse those out of the given path if { [regexp {^packages/([^/]+)/(.*)$} $path match package_key package_rel_path] } { @@ -351,7 +351,7 @@ @see apm_get_watchable_files @author Peter Marklund -} { +} { foreach rel_path [apm_get_watchable_files $package_key] { apm_file_watch $rel_path } @@ -391,7 +391,7 @@ } return $watchable_files -} +} ad_proc -private apm_system_paths {} { @@ -410,7 +410,7 @@ ad_proc -public apm_gzip_cmd {} { @return A valid command name for gzip. - + } { return gzip } @@ -419,7 +419,7 @@ ad_proc -private apm_tar_cmd {} { @return A valid command name for tar. - + } { return tar } @@ -428,7 +428,7 @@ ad_proc -private apm_dev_null {} { @return null device - + } { if {$::tcl_platform(platform) ne "windows"} { return /dev/null @@ -446,20 +446,20 @@ # reliably under windows, for unknown reasons the downloaded file is # truncated. # - # Therefore, we check first for the NaviServer built in ns_http, then + # Therefore, we check first for the NaviServer built in ns_http, then # if the optional xotcl-core components are available... # - + # 5 minutes set timeout 300 - + set httpImpls [util::http::available -url $url -spool] if {$httpImpls ne ""} { ns_log notice "we can use the http::util:: interface using the $httpImpls implementation" set result [util::http::get -url $url -timeout $timeout -spool] file rename [dict get $result file] $output_file_name } elseif {[info commands ::ns_http] ne "" && [apm_version_names_compare [ns_info patchlevel] "4.99.5"] == 1} { - # + # # ... use ns_http when we have a version with the "-file" flag ... # foreach i {1 2 3} { @@ -475,7 +475,7 @@ set url $location } } elseif {[info commands ::xo::HttpRequest] ne ""} { - # + # # ... use xo::HttpRequest... # ns_log notice "Transfer $url to $output_file_name based on ::xo::HttpRequest" @@ -520,15 +520,15 @@ {-url {}} {file_path {}} } { - + Uncompresses and loads an APM file into the filesystem. @param url If specified, will download the APM file first. - @return If successful, a path to the .info file of the package uncompressed + @return If successful, a path to the .info file of the package uncompressed into the apm-workspace directory -} { +} { # First download the apm file if a URL is provided if { $url ne "" } { set file_path [ad_tmpnam].apm @@ -538,7 +538,7 @@ The following error was returned:
" return - } + } if {![file exists $file_path]} { apm_callback_and_log $callback " @@ -561,7 +561,7 @@ ns_log Error "Error loading APM file form url $url: $errmsg\n$::errorInfo" return } - + if { [llength $files] == 0 } { apm_callback_and_log $callback "The archive does not contain any files.\n" ns_log Error "Error loading APM file form url $url: The archive does not contain any files." @@ -575,13 +575,13 @@ set components [split $file "/"] if {[lindex $components 0] ne $package_key } { - apm_callback_and_log $callback "All files in the archive must be contained in the same directory - (corresponding to the package's key). This is not the case, so the archive is not + apm_callback_and_log $callback "All files in the archive must be contained in the same directory + (corresponding to the package's key). This is not the case, so the archive is not a valid APM file.\n" ns_log Error "Error loading APM file form url $url: Invalid APM file. All files in the archive must be contained in the same directory corresponding to the package's key." return } - + if { [llength $components] == 2 && [file extension $file] eq ".info" } { if { [info exists info_file] } { apm_callback_and_log $callback "The archive contains more than one package/*/*.info file, so it is not a valid APM file.\n" @@ -593,7 +593,7 @@ } } if { ![info exists info_file] || [regexp {[^a-zA-Z0-9\-\./_]} $info_file] } { - apm_callback_and_log $callback "The archive does not contain a */*.info file, so it is not + apm_callback_and_log $callback "The archive does not contain a */*.info file, so it is not a valid APM file.\n" ns_log Error "Error loading APM file form url $url: Invalid APM file. No package .info file." return @@ -605,13 +605,13 @@ exec [apm_gzip_cmd] -d -q -c -S .apm $file_path | [apm_tar_cmd] -xf - -C $tmpdir $info_file 2> [apm_dev_null] #exec sh -c "cd $tmpdir ; [apm_gzip_cmd] -d -q -c -S .apm $file_path | [apm_tar_cmd] xf - $info_file" 2> [apm_dev_null] - + if { [catch { array set package [apm_read_package_info_file [file join $tmpdir $info_file]] } errmsg]} { file delete -force -- $tmpdir - apm_callback_and_log $callback "The archive contains an unparseable package specification file: -[ns_quotehtml $errmsg]
$info_file
. The following error was produced while trying to
+ apm_callback_and_log $callback "The archive contains an unparseable package specification file:
+ $info_file
. The following error was produced while trying to
parse it: .[ns_quotehtml $errmsg]
The package cannot be installed. @@ -625,16 +625,16 @@ set version_name $package(name) ns_log Debug "APM: Preparing to load $pretty_name $version_name" # Determine if this package version is already installed. - if {[apm_package_version_installed_p $package_key $version_name]} { + if {[apm_package_version_installed_p $package_key $version_name]} { apm_callback_and_log $callback "
$potential_decoration | $simple_headline |
$potential_decoration | $simple_headline |
db_release_unused_handles
prior to calling ns_return.
This should be used instead of ns_return
at the bottom
- of every non-templated user-viewable page.
+ of every non-templated user-viewable page.
} {
# AOLserver/NaviServer releases handles automatically since ages
@@ -549,7 +549,7 @@
Example setting a variable with extra_vars:
-
+
set return_url [ad_return_url [list some_id $some_id] [some_other_id $some_other_id]]@@ -596,9 +596,9 @@
Example:
ad_progress_bar_begin -title "Installing..." -message_1 "Please wait..." -message_2 "Will continue automatically"- +
...- +
ad_progress_bar_end -url $next_page@param title The title of the page @@ -610,7 +610,7 @@ } { db_release_unused_handles ad_http_cache_control - + ReturnHeaders ns_write [ad_parse_template \ -params [list \ @@ -628,7 +628,7 @@ Ends the progress bar by causing the browser to redirect to a new URL. @see ad_progress_bar_begin -} { +} { util_user_message -message $message_after_redirect ns_write "" ns_conn close Index: openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl,v diff -u -r1.22 -r1.23 --- openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl 25 Jul 2018 17:44:25 -0000 1.22 +++ openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl 25 Jul 2018 17:49:26 -0000 1.23 @@ -9,7 +9,7 @@ ns_section ns/server/${server}/acs ns_param WithDeprecatedCode 0 - + @cvs-id $Id$ } @@ -32,9 +32,9 @@ # # ad_set_typed_form_variable_filter /my_module/* {a_id number} {b_id word} {*_id integer} # - # For all pages under /my_module, set_form_variables would set - # $a_id only if it was number, and $b_id only if it was a 'word' - # (a string that contains only letters, numbers, dashes, and + # For all pages under /my_module, set_form_variables would set + # $a_id only if it was number, and $b_id only if it was a 'word' + # (a string that contains only letters, numbers, dashes, and # underscores), and all other variables that match the pattern # *_id would be set only if they were integers. # @@ -46,7 +46,7 @@ # return 1 if the value is a valid $type_name, or 0 otherwise. # # There's also a special datatype named 'nocheck', which will - # return success regardless of the value. (See the docs for + # return success regardless of the value. (See the docs for # ad_var_type_check_${type_name}_p to see how this might be # useful.) # @@ -74,15 +74,15 @@ return filter_ok } -ad_proc -deprecated ad_dbclick_check_dml { +ad_proc -deprecated ad_dbclick_check_dml { {-bind ""} - statement_name table_name id_column_name generated_id return_url insert_dml + statement_name table_name id_column_name generated_id return_url insert_dml } { This proc is used for pages using double click protection. table_name is table_name for which we are checking whether the double click occurred. id_column_name is the name of the id table column. generated_id is the generated id, which is supposed to have - been generated on the previous page. return_url is url to which this + been generated on the previous page. return_url is url to which this procedure will return redirect in the case of successful insertion in the database. insert_sql is the sql insert statement. if data is ok this procedure will insert data into the database in a double click @@ -94,29 +94,29 @@ if { $bind ne "" } { db_dml $statement_name $insert_dml -bind $bind } else { - db_dml $statement_name $insert_dml + db_dml $statement_name $insert_dml } } errmsg] } { # Oracle choked on the insert - + # detect double click if { [db_0or1row double_click_check " - + select 1 as one from $table_name where $id_column_name = :generated_id - + " -bind [ad_tcl_vars_to_ns_set generated_id]] } { ad_returnredirect $return_url return } - + ns_log Error "[info script] choked. Oracle returned error: $errmsg" ad_return_error "Error in insert" " - We were unable to do your insert in the database. + We were unable to do your insert in the database. Here is the error that was returned:
@@ -142,7 +142,7 @@ } elseif { $t_or_f == "f" || $t_or_f eq "F" } { return "No" } else { - # Note that we can't compare default to the empty string as in + # 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 { $default eq "default" } { @@ -153,16 +153,16 @@ } } -ad_proc -deprecated ad_export_vars { +ad_proc -deprecated ad_export_vars { -form:boolean {-exclude {}} {-override {}} {include {}} } { - Note This proc is deprecated in favor of -export_vars
. They're very similar, but + Note This proc is deprecated in favor of +export_vars
. They're very similar, butexport_vars
have a number of advantages: - +
- It can sign variables (the
:sign
flag)- It can export variables as a :multiple. @@ -174,12 +174,12 @@
- Helps export variables from one page to the next, + Helps export variables from one page to the next, either as URL variables or hidden form variables. It'll reach into arrays and grab either all values or individual values - out and export them in a way that will be consistent with the + out and export them in a way that will be consistent with the ad_page_contract :array flag. - +
Example: @@ -189,12 +189,12 @@ and it will export a variable named
order_by
with the valuedate
.- - The args is a list of variable names that you want exported. You can name + The args is a list of variable names that you want exported. You can name +
- + @author stefan.sobernig@wu.ac.at } { set trl [expr {[string match "text/*" $content_type] ? $text_translation : "binary"}] @@ -518,7 +518,7 @@ ad_proc -deprecated validate_integer {field_name string} { Throws an error if the string isn't a decimal integer; otherwise strips any leading zeros (so this won't work for octals) and returns - the result. + the result.
- a scalar variable,
foo
, -- the name of an array,
bar
, +- the name of an array,
bar
, in which case all the values in that array will get exported, or- an individual value in an array,
bar(baz)
- a list in [array get] format { name value name value ..}. @@ -210,7 +210,7 @@ @param form set this parameter if you want the variables exported as hidden form variables, as opposed to URL variables, which is the default. - @param exclude takes a list of names of variables you don't want exported, even though + @param exclude takes a list of names of variables you don't want exported, even though they might be listed in the args. The names take the same form as in the args list. @param override takes a list of the same format as args, which will get exported no matter @@ -233,7 +233,7 @@ set override_p 0 foreach argument { include override } { foreach arg [set $argument] { - if { [llength $arg] == 1 } { + if { [llength $arg] == 1 } { if { $override_p || $arg ni $exclude } { upvar $arg var if { [array exists var] } { @@ -275,13 +275,13 @@ } incr override_p } - + #################### # # Translate this into the desired output form # #################### - + if { !$form_p } { set export_list [list] foreach varname [array names export] { @@ -298,9 +298,9 @@ } } -ad_proc -deprecated export_form_vars { +ad_proc -deprecated export_form_vars { -sign:boolean - args + args } { Exports a number of variables as hidden input fields in a form. Specify a list of variable names. The proc will reach up in the caller's name space @@ -323,7 +323,7 @@ ensures that the value hasn't been tampered with at the user's end. @see export_vars -} { +} { set hidden "" foreach var_spec $args { lassign [split $var_spec ":"] var type @@ -349,7 +349,7 @@ ad_proc -deprecated export_url_vars { -sign:boolean - args + args } { export_vars is now the preferred interface. @@ -360,19 +360,19 @@
- Instead of naming a variable you can also say name=value. Note that the value here is not + Instead of naming a variable you can also say name=value. Note that the value here is not the name of a variable but the literal value you want to export e.g.,
export_url_vars [ns_urlencode foo]=[ns_urlencode $the_value]
.- For normal variables, you can say
export_url_vars foo:multiple
. In this case, - the value of foo will be treated as a Tcl list, and each value will be output separately e.g., + For normal variables, you can sayexport_url_vars foo:multiple
. In this case, + the value of foo will be treated as a Tcl list, and each value will be output separately e.g., foo=item0&foo=item1&foo=item2...- You cannot combine the foo=bar syntax with the foo:multiple syntax. Why? Because there's no way we can distinguish + You cannot combine the foo=bar syntax with the foo:multiple syntax. Why? Because there's no way we can distinguish between the :multiple being part of the value of foo or being a flag intended for export_url_vars. @param sign If this flag is set, all the variables output will be @@ -385,9 +385,9 @@ ensures that the value hasn't been tampered with at the user's end. @see export_vars -} { - set params {} - foreach var_spec $args { +} { + set params {} + 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. lassign [split $var_spec "="] var value @@ -406,7 +406,7 @@ } } default { - lappend params "[ns_urlencode $var]=[ns_urlencode $upvar_value]" + lappend params "[ns_urlencode $var]=[ns_urlencode $upvar_value]" } } if { $sign_p } { @@ -415,7 +415,7 @@ } } } - + return [join $params "&"] } @@ -450,50 +450,50 @@ (i.e., names and aliases in the sense of IANA's character sets registry) is provided by:
- +- +
- A static, built-in correspondence map: see nsd/encoding.c
- An extensible correspondence map (i.e., the ns/charsets section in config.tcl).
[ns_encodingfortype] introduces several levels of precedence when resolving the actual IANA/MIME charset and the corresponding Tcl encoding to use:
- +@@ -503,7 +503,7 @@
- The "content_type" string contains a charset specification, e.g.: "text/xml; charset=UTF-8". This spec fragment takes the highest precedence.
- +- The "content_type" string points to a "text/*" media subtype, but does not specify a charset (e.g., "text/xml"). In this case, the charset defined by ns/parameters/OutputCharset (see config.tcl) applies. If this parameter is missing, the default is "iso-8859-1" (see tcl/charsets.tcl; this follows from RFC 2616 (HTTP 1.1); Section 3.7.1).
- +- If neither case 1 or case 2 become effective, the encoding is resolved to "binary".
- +- If [ns_encodingfortype] fails to resolve any Tcl encoding name (i.e., returns an empty string), the general fallback is "iso8859-1" for text/* media subtypes and "binary" for any other. This is the case in two situations: - +
- +
- Invalid IANA/MIME charsets: The name in the "charset" parameter of the content type spec is not a valid name or alias in IANA's character sets registry (a special variant would be an empty charset value, e.g. "text/plain; charset=")
- +- Unknown IANA/MIME charsets: The name in the "charset" parameter of the content type spec does not match any known (= registered) IANA/MIME charset in the MIME/Tcl mappings.
- http://sourceforge.net/tracker/?func=detail&atid=103152&aid=932459&group_id=3152
- http://sourceforge.net/tracker/index.php?func=detail&aid=962233&group_id=3152&atid=353152
validate via ad_page_contract @@ -598,14 +598,14 @@ return $date } -ad_proc -deprecated util_ReturnMetaRefresh { - url - { seconds_delay 0 } +ad_proc -deprecated util_ReturnMetaRefresh { + url + { seconds_delay 0 } } { Ugly workaround to deal with IE5.0 bug handling - multipart/form-data using - Meta Refresh page instead of a redirect. - + multipart/form-data using + Meta Refresh page instead of a redirect. + } { ad_return_top_of_page [subst {
@@ -646,7 +646,7 @@ } { A filter that detect attempts to smuggle in SQL code through form data - variables. The use of bind variables and ad_page_contract input + variables. The use of bind variables and ad_page_contract input validation to prevent SQL smuggling is preferred. @see ad_page_contract @@ -681,7 +681,7 @@ # characters in length. # if { - [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value] + [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value] || [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value] } { # Looks like the user has added "union [all] select" to @@ -722,11 +722,11 @@ } if { - $parse_result_integer == 0 + $parse_result_integer == 0 || $parse_result_integer == -904 - || $parse_result_integer == -1789 - || $parse_result_string == 0 - || $parse_result_string == -904 + || $parse_result_integer == -1789 + || $parse_result_string == 0 + || $parse_result_string == -904 || $parse_result_string == -1789 } { # Code -904 means "invalid column", -1789 means @@ -752,28 +752,28 @@ } ad_proc -deprecated ad_present_user { - user_id + user_id name } { - This function is an alias to acs_community_member_link + This function is an alias to acs_community_member_link and receives identical parameters, but the former finds out the name of the user if a blank is passed. That's why it's marked as deprecated. @return the HTML link of the community member page of a particular user @author Unknown @author Roberto Mello - + @see acs_community_member_link } { return [acs_community_member_link -user_id $user_id -label $name] } ad_proc -deprecated ad_admin_present_user { - user_id + user_id name } { - This function is an alias to acs_community_member_admin_link + This function is an alias to acs_community_member_admin_link and receives identical parameters, but the former finds out the name of the user if a blank is passed. That's why it's marked as deprecated. @@ -790,7 +790,7 @@ ad_proc -deprecated ad_header { {-focus ""} page_title - {extra_stuff_for_document_head ""} + {extra_stuff_for_document_head ""} } { writes HEAD, TITLE, and BODY tags to start off pages in a consistent fashion @@ -802,7 +802,7 @@ ad_proc -deprecated ad_header_with_extra_stuff { {-focus ""} page_title - {extra_stuff_for_document_head ""} + {extra_stuff_for_document_head ""} {pre_content_html ""} } { This is the version of the ad_header that accepts extra stuff for the document head and pre-page content html @@ -834,11 +834,11 @@ } ad_proc -deprecated ad_footer { - {signatory ""} + {signatory ""} {suppress_curriculum_bar_p 0} } { - Writes a horizontal rule, a mailto address box - (ad_system_owner if not specified as an argument), + Writes a horizontal rule, a mailto address box + (ad_system_owner if not specified as an argument), and then closes the BODY and HTML tags @@ -847,7 +847,7 @@ global sidegraphic_displayed_p if { $signatory eq "" } { set signatory [ad_system_owner] - } + } if { [info exists sidegraphic_displayed_p] && $sidegraphic_displayed_p } { # we put in a BR CLEAR=RIGHT so that the signature will clear any side graphic # from the ad-sidegraphic.tcl package @@ -893,14 +893,14 @@ {-focus ""} page_title } { - + @see Documentation on the site master template for the proper way to standardize page headers } { return [ad_header_with_extra_stuff -focus $focus $page_title] } ad_proc -deprecated ad_admin_footer {} { - Signs pages with ad_admin_owner (usually a programmer who can fix + Signs pages with ad_admin_owner (usually a programmer who can fix bugs) rather than the signatory of the user pages @@ -918,7 +918,7 @@ " } -ad_proc -deprecated ad_get_user_info {} { +ad_proc -deprecated ad_get_user_info {} { Sets first_names, last_name, email in the environment of its caller. @return ad_return_error if user_id can't be found. @@ -951,11 +951,11 @@ {package_key ""} {default ""} } { - Package instances can have parameters associated with them. This function is used for accessing + Package instances can have parameters associated with them. This function is used for accessing and setting these values. Parameter values are stored in the database and cached within memory. New parameters can be created with the APM and values can be set using the Site Map UI.. Because parameters are specified on an instance - basis, setting the package_key parameter (preserved from the old version of this function) does not + basis, setting the package_key parameter (preserved from the old version of this function) does not affect the parameter retrieved. If the code that calls ad_parameter is being called within the scope of a running server, the package_id will be determined automatically. However, if you want to use a parameter on server startup or access an arbitrary parameter (e.g., you are writing bboard code, but @@ -968,7 +968,7 @@ @see parameter::get @param set Use this if you want to indicate a value to set the parameter to. - @param package_id Specify this if you want to manually specify what object id to use the new parameter. + @param package_id Specify this if you want to manually specify what object id to use the new parameter. @return The parameter of the object or if it doesn't exist, the default. } { if {[info exists set]} { @@ -1203,11 +1203,11 @@ ad_proc -deprecated ad_dimensional_set_variables {option_list {options_set ""}} { - set the variables defined in option_list from the form provided - (form defaults to ad_conn form) or to default value from option_list if + set the variables defined in option_list from the form provided + (form defaults to ad_conn form) or to default value from option_list if not in the form data.- You only really need to call this if you need the variables + You only really need to call this if you need the variables (for example to pick which select statement and table to actually use) } { set out {} @@ -1220,7 +1220,7 @@ set options_set [ns_getform] } - foreach option $option_list { + foreach option $option_list { # find out what the current option value is. # check if a default is set otherwise the first value is used set option_key [lindex $option 0] @@ -1234,7 +1234,7 @@ } } -ad_proc -deprecated ad_table { +ad_proc -deprecated ad_table { {-Torder_target_url {}} {-Torderby {}} {-Tasc_order_img {^}} @@ -1263,65 +1263,65 @@ DRB: New code should use the listbuilder. - Note: all the variables in this function are named Tblah since we could potentially + Note: all the variables in this function are named Tblah since we could potentially have namespace collisions
build and return an html fragment given an active query and a data definition. -
-
- sql_qry -- The query that should be executed to generate the table.
++
Datadef structure : -- sql_qry -- The query that should be executed to generate the table.
You can specify an optional -bind argument to specify a ns_set of bind variables.- Tdatadef -- the table declaration.
- { ++ { {column_id "Column_Heading" order_clause display_info} ... }-
- column_id -- what to set as orderby for sorting and also is +
- column_id -- what to set as orderby for sorting and also is the default variable for the table cell. -
- the text for the heading to be wrapped in <th> and </th> tags. - I am not entirely happy that things are wrapped automatically since you might not +
- the text for the heading to be wrapped in <th> and </th> tags. + I am not entirely happy that things are wrapped automatically since you might not want plain old th tags but I also don;t want to add another field in the structure. -
- order_clause -- the order clause for the field. If null it defaults to +
- order_clause -- the order clause for the field. If null it defaults to "column_id $order". It is also interpolated, with orderby and order defined as variables so that:
{upper(last_name) $order, upper(first_names) $order}would do the right thing. -+
the value "no_sort" should be used for columns which should not allow sorting.
the value "sort_by_pos" should be used if the columns passed in are column positions rather than column names. -
- display_info. If this is a null string you just default to generating +
- display_info. If this is a null string you just default to generating <td>column_id</td>. If it is a string in the lookup list then special formatting is applied; this is l r c tf 01 for - align=left right center, Yes/No (from tf), + align=left right center, Yes/No (from tf), Yes/No from 0/1. - +
- if the display stuff is not any of the above then it is interpolated and the results + if the display stuff is not any of the above then it is interpolated and the results returned (w/o any <td> tags put in). An example:
- set table_def { - {ffn "Full Name" + set table_def { + {ffn "Full Name" {upper(last_name) $order, upper(first_names) $order} {<td><a href="/admin/users/one?user_id=$user_id">$first_names $last_name</a></td>}} {email "e-Mail" {} {<td><a href="mailto:$email">$email</a>}} {email_bouncing_p "e-Bouncing?" {} tf} {user_state "State" {} {}} {last_visit "Last Visit" {} r} {actions "Actions" no_sort {<td> - <a href="/admin/users/basic-info-update?user_id=$user_id">Edit Info</a> | + <a href="/admin/users/basic-info-update?user_id=$user_id">Edit Info</a> | <a href="/admin/users/password-update?user_id=$user_id">New Password</a> | [ad_registration_finite_state_machine_admin_links $user_state $user_id]}} } @@ -1345,24 +1345,24 @@ set Tn_bands [llength $Tband_colors] set Tn_band_classes [llength $Tband_classes] set Tform [ad_conn form] - + # export variables from calling environment if {$Textra_vars ne ""} { foreach Tvar $Textra_vars { upvar $Tvar $Tvar } } - + # get the current ordering information set Torderbykey {::not_sorted::} set Treverse {} regexp {^([^*,]+)([*])?} $Torderby match Torderbykey Treverse if {$Treverse eq "*"} { set Torder desc - } else { + } else { set Torder asc } - + # set up the target url for new sorts if {$Torder_target_url eq ""} { set Torder_target_url [ad_conn url] @@ -1372,14 +1372,14 @@ set Texport {} } set Tsort_url "$Torder_target_url?${Texport}orderby$Tsuffix=" - + set Thtml {} set Theader {} - + # build the list of columns to display... set Tcolumn_list [ad_table_column_list $Tdatadef $Tcolumns] - - # generate the header code + + # generate the header code # append Theader "\n" if {$Theader_row_extra eq ""} { @@ -1392,9 +1392,9 @@ if { ( [ns_set find $selection [lindex $Tcol 0]] < 0 && ([lindex $Tcol 2] eq "" || [lindex $Tcol 2] ne "sort_by_pos") ) - || [lindex $Tcol 2] eq "no_sort" + || [lindex $Tcol 2] eq "no_sort" } { - + # not either a column in the select or has sort code # then just a plain text header so do not do sorty things append Theader "
\n$Ttable_break_html\n$Theader" } # first check if we are in audit mode and if the audit columns have changed set Tdisplay_changes_only 0 - if {$Taudit ne "" && $Tcount > 0} { - # check if the audit key columns changed - foreach Taudit_key $Taudit { - if {[set $Taudit_key] eq [set P$Taudit_key] } { + if {$Taudit ne "" && $Tcount > 0} { + # check if the audit key columns changed + foreach Taudit_key $Taudit { + if {[set $Taudit_key] eq [set P$Taudit_key] } { set Tdisplay_changes_only 1 } } @@ -1478,7 +1478,7 @@ } incr Tpage_count - if { $Trows_per_page && $Tpage_count >= $Trows_per_page } { + if { $Trows_per_page && $Tpage_count >= $Trows_per_page } { set Tband_color 0 set Tband_class 0 set Tband_count 0 @@ -1487,7 +1487,7 @@ } set Trow_default {} - # generate the row band color + # generate the row band color if { $Tband_count >= $Trows_per_band } { set Tband_count 0 set Tband_color [expr {($Tband_color + 1) % $Tn_bands} ] @@ -1502,15 +1502,15 @@ append Trow_default " class=\"[lindex $Tband_classes $Tband_class]\"" } - + set Trow_default "[lindex $Tcol 1] \n" @@ -1415,54 +1415,54 @@ } } append Theader "\n" - + # - # This has gotten kind of ugly. Here we are looping over the - # rows returned and then potentially a list of ns_sets which can + # This has gotten kind of ugly. Here we are looping over the + # rows returned and then potentially a list of ns_sets which can # be passed in (grrr. Richard Li needs for general protections stuff # for "fake" public record which does not exist in DB). - # - + # + set Tpost_data 0 - - while { 1 } { - if {!$Tpost_data && [ns_db getrow $Tdb $selection]} { + + while { 1 } { + if {!$Tpost_data && [ns_db getrow $Tdb $selection]} { # in all its evil majesty set_variables_after_query - } else { + } else { # move on to fake rows... incr Tpost_data - } - - if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } { + } + + if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } { # bind the Tpost_data_ns_sets row of the passed in data set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets $Tpost_data-1] - } elseif { $Tpost_data } { + } elseif { $Tpost_data } { # past the end of the fake data drop out. break } - + if { $Tmax_rows && $Tcount >= $Tmax_rows } { - if { ! $Tpost_data } { + if { ! $Tpost_data } { # we hit max count and had rows left to read... ns_db flush $Tdb } break } - - # deal with putting in the header if need + + # deal with putting in the header if need if { $Tcount == 0 } { append Thtml "$Theader" - } elseif { $Tpage_count == 0 } { + } elseif { $Tpage_count == 0 } { append Thtml "" append Thtml [subst $Trow_code] - + foreach Ti $Tcolumn_list { set Tcol [lindex $Tdatadef $Ti] # If we got some special formatting code we handle it - # single characters r l c are special for alignment + # single characters r l c are special for alignment set Tformat [lindex $Tcol 3] set Tcolumn [lindex $Tcol 0] switch -- $Tformat { @@ -1524,34 +1524,34 @@ default {set Tdisplay_field " [subst $Tformat]\n"} } - if { $Tdisplay_changes_only - && $Tdisplay_field eq $Tlast_display($Ti) } { + if { $Tdisplay_changes_only + && $Tdisplay_field eq $Tlast_display($Ti) } { set Tdisplay_field { \n" # keep the last row around so we can do fancy things. # so on next row we can say things like if $Pvar != $var not blank - if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } { + if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } { # bind the Tpost_data_ns_sets row of the passed in data set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets $Tpost_data-1] P - } else { + } else { set_variables_after_query_not_selection $selection P } } if { $Tcount > 0} { append Thtml "$Textra_rows \n" - } else { + } else { append Thtml $Tmissing_text } - } + } return $Thtml } @@ -1563,22 +1563,22 @@} - } else { + } else { set Tlast_display($Ti) $Tdisplay_field - } + } append Thtml $Tdisplay_field } append Thtml " returns a list of indexes into the columns one per column it found
- -sortable from t/f/all + -sortable from t/f/all } { set column_list {} if {$columns eq ""} { for {set i 0} {$i < [llength $datadef]} {incr i} { - if {$sortable eq "all" + if {$sortable eq "all" || ($sortable == "t" && [lindex $datadef $i 2] ne "no_sort") || ($sortable == "f" && [lindex $datadef $i 2] eq "no_sort") } { lappend column_list $i - } + } } - } else { + } else { set colnames {} - foreach col $datadef { - if {$sortable eq "all" + foreach col $datadef { + if {$sortable eq "all" || ($sortable == "t" && [lindex $col 2] ne "no_sort") || ($sortable == "f" && [lindex $col 2] eq "no_sort") } { @@ -1595,13 +1595,13 @@ } } } - + return $column_list } ad_proc -deprecated ad_sort_primary_key {orderby} { return the primary (first) key of an order spec - used by + used by } { if {[regexp {^([^*,]+)} $orderby match]} { return $match @@ -1623,42 +1623,42 @@ return 0 } } - + ad_proc -deprecated ad_table_span {str {td_html "align=\"left\""}} { - given string the function generates a row which spans the + given string the function generates a row which spans the whole table. } { return "
" } ad_proc -deprecated ad_table_form { - datadef - {type select} - {return_url {}} - {item_group {}} - {item {}} - {columns {}} + datadef + {type select} + {return_url {}} + {item_group {}} + {item {}} + {columns {}} {allowed {}} } { - builds a form for choosing the columns to display + builds a form for choosing the columns to display $str columns is a list of the currently selected columns.
- allowed is the list of all the displayable columns, if empty + allowed is the list of all the displayable columns, if empty all columns are allowed. } { - # first build a map of all available columns + # first build a map of all available columns set sel_list [ad_table_column_list $datadef $allowed] - - # build the map of currently selected columns + + # build the map of currently selected columns set sel_columns [ad_table_column_list $datadef $columns] - + set max_columns [llength $sel_list] set n_sel_columns [llength $sel_columns] set html {} if {$item eq "CreateNewCustom" } { - set item {} + set item {} } # now spit out the form fragment. if {$item ne ""} { @@ -1673,7 +1673,7 @@ append html "" } - append html "
" } - append html "