Index: openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl 19 Jan 2018 13:40:40 -0000 1.17
+++ openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl 8 May 2018 22:37:18 -0000 1.18
@@ -1,5 +1,5 @@
ad_page_contract {
- Adds a dependency to a version of a package.
+ Adds a dependency to a version of a package.
@author Bryan Quinn
@creation-date 17 April 2000
@cvs-id $Id$
@@ -12,41 +12,40 @@
}
set service [split $service ";"]
-set package_key [lindex $service 0]
-set version_name [lindex $service 1]
+lassign $service package_key version_name
apm_package_install_spec $version_id
db_transaction {
switch -- $dependency_type {
- require {
- apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name
+ require {
+ apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name
apm_build_one_package_relationships $our_package_key
- }
+ }
extend {
- apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name
+ apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name
apm_build_one_package_relationships $our_package_key
apm_copy_inherited_params $our_package_key [list $package_key $version_name]
- }
+ }
embed {
- apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name
+ apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name
apm_build_one_package_relationships $our_package_key
apm_copy_inherited_params $our_package_key [list $package_key $version_name]
- }
+ }
- default {
- ad_return_complaint 1 "Entry error: Allowable dependencies are required, extends and embeds."
- }
+ default {
+ ad_return_complaint 1 "Entry error: Allowable dependencies are required, extends and embeds."
+ }
}
} on_error {
if { ![db_string apm_dependency_doubleclick_check {
- select count(*) from apm_package_dependencies
- where dependency_id = :dependency_id
+ select count(*) from apm_package_dependencies
+ where dependency_id = :dependency_id
} -default 0] } {
- ad_return_complaint 1 "The database returned the following error:
- <blockquote><pre>[ns_quotehtml $errmsg]</pre></blockquote>"
+ ad_return_complaint 1 "The database returned the following error:
+ <blockquote><pre>[ns_quotehtml $errmsg]</pre></blockquote>"
}
}
Index: openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl 7 Aug 2017 23:47:45 -0000 1.6
+++ openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl 8 May 2018 22:37:18 -0000 1.7
@@ -4,9 +4,9 @@
@author Peter Marklund (peter@collaboraid.biz)
@creation-date 8 October 2002
- @cvs-id $Id$
+ @cvs-id $Id$
} {
- version_id:naturalnum,notnull
+ version_id:naturalnum,notnull
{files:multiple}
{file_action:multiple}
}
@@ -39,8 +39,7 @@
set full_file_name "$::acs::rootdir/$file"
set adp_report_list [lang::util::replace_adp_text_with_message_tags "$::acs::rootdir/$file" report]
-set adp_replace_list [lindex $adp_report_list 0]
-set adp_no_replace_list [lindex $adp_report_list 1]
+lassign $adp_report_list adp_replace_list adp_no_replace_list
if { [llength $adp_replace_list] == 0 } {
# There are no replacements to choose keys for so go straight to the processing result page
Index: openacs-4/packages/acs-authentication/lib/local-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/lib/local-search.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-authentication/lib/local-search.tcl 26 Apr 2018 08:56:37 -0000 1.4
+++ openacs-4/packages/acs-authentication/lib/local-search.tcl 8 May 2018 22:37:18 -0000 1.5
@@ -66,8 +66,7 @@
}
set orderby_list [split $orderby ,]
-set orderby_column [lindex $orderby_list 0]
-set direction [lindex $orderby_list 1]
+lassign $orderby_list orderby_column direction
set direction [string map {asc -increasing desc -decreasing} $direction]
if {$orderby_column ne ""} {
template::multirow -ulevel 2 -local sort users $direction $orderby_column
Index: openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl 7 Aug 2017 23:47:46 -0000 1.9
+++ openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl 8 May 2018 22:37:18 -0000 1.10
@@ -141,9 +141,7 @@
}
set dbversion_list [split $dbversion .]
- set dbversion_major [lindex $dbversion_list 0]
- set dbversion_minor [lindex $dbversion_list 1]
- set dbversion_patch [lindex $dbversion_list 2]
+ lassign $dbversion_list dbversion_major dbversion_minor dbversion_patch
set dbversion_total [expr {($dbversion_major * 1000000) + ($dbversion_minor * 1000) + ($dbversion_patch)}]
# Check for Oracle 8.1.6 and before running on Linux. If so, we've got to tell the user
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.53 -r1.54
--- openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 1 May 2018 09:06:57 -0000 1.53
+++ openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 8 May 2018 22:37:18 -0000 1.54
@@ -361,8 +361,7 @@
foreach arg $effective_arg_list {
if { [llength $arg] == 2 } {
set default_p 1
- set default_value [lindex $arg 1]
- set arg [lindex $arg 0]
+ lassign $arg arg default_value
} else {
if { [llength $arg] != 1 } {
return -code error "Invalid element \"$arg\" in argument list"
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.45 -r1.46
--- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 25 Apr 2018 19:23:25 -0000 1.45
+++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 8 May 2018 22:37:18 -0000 1.46
@@ -530,8 +530,7 @@
break
}
- set one_query [lindex $result 0]
- set parsing_state [lindex $result 1]
+ lassign $result one_query parsing_state
# db_qd_log QDDebug "loaded one query - [db_fullquery_get_name $one_query]"
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.16 -r1.17
--- openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 1 May 2018 08:31:43 -0000 1.16
+++ openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 8 May 2018 22:37:18 -0000 1.17
@@ -1,37 +1,37 @@
namespace eval publish {
- variable item_id_stack
+ variable item_id_stack
variable revision_html
namespace eval handle {}
}
ad_proc -public publish::get_page_root {} {
- Get the page root. All items will be published to the
+ Get the page root. All items will be published to the
filesystem with their URLs relative to this root.
The page root is controlled by the PageRoot parameter in CMS.
A relative path is relative to $::acs::pageroot
The default is $::acs::pageroot
-
+
@return The page root
-
+
@see publish::get_template_root
@see publish::get_publish_roots
} {
# LARS TODO: This parameter doesn't exist, it's a remnant from the CMS package
set root_path [parameter::get \
-package_id [ad_conn package_id] \
-parameter PageRoot]
-
+
if { [string index $root_path 0] ne "/" } {
# Relative path, prepend server_root
set root_path "$::acs::pageroot/$root_path"
}
-
+
return [ns_normalizepath $root_path]
-
+
}
@@ -41,22 +41,22 @@
which should be a space-separated list of all the roots. Relative paths
are relative to publish::get_page_root.
The default is [list [publish::get_page_root]]
-
+
@return A list of all the publish roots
-
+
@see publish::get_template_root
@see publish::get_page_root
-
+
} {
# LARS TODO: This parameter doesn't exist, it's a remnant from the CMS package
set root_paths [parameter::get \
-package_id [ad_conn package_id] \
-parameter PublishRoots]
-
+
if { [llength $root_paths] == 0 } {
set root_paths [list [get_page_root]]
}
-
+
# Resolve relative paths
set page_root [publish::get_page_root]
set absolute_paths [list]
@@ -67,19 +67,19 @@
lappend absolute_paths $path
}
}
-
+
return $absolute_paths
}
ad_proc -public publish::mkdirs { path } {
Create all the directories necessary to save the specified file
-
+
@param path The path to the file that is about to be saved
} {
set index [string last "/" $path]
if { $index != -1 } {
file mkdir [string range $path 0 $index-1]
- }
+ }
}
###############################################
@@ -90,25 +90,25 @@
ad_proc -private publish::push_id { item_id {revision_id ""}} {
@private push_id
-
+
Push an item id on top of stack. This proc is used
to store state between <tt>child</tt>, <tt>relation</tt>
and <tt>content</tt> tags.
-
- @param item_id
+
+ @param item_id
The id to be put on stack
-
- @param revision_id {default ""}
+
+ @param revision_id {default ""}
The id of the revision to use. If missing, live
revision will most likely be used
-
- @see publish::pop_id
+
+ @see publish::pop_id
@see publish::get_main_item_id
@see publish::get_main_revision_id
} {
- variable item_id_stack
- variable revision_html
+ variable item_id_stack
+ variable revision_html
if { [template::util::is_nil item_id] } {
error "Null id pushed on stack in publish::push_id"
@@ -121,7 +121,7 @@
if { [info exists ::content::item_id] } {
set old_item_id $::content::item_id
}
-
+
if { [info exists ::content::revision_id] } {
set old_revision_id $::content::revision_id
}
@@ -151,34 +151,33 @@
ad_proc -private publish::pop_id {} {
@private pop_id
-
+
Pop the item_id and the revision_id off the top of the stack.
Clear the temporary item cache if the stack becomes empty.
-
+
@return The popped item id, or the empty string if the string is
already empty
-
- @see publish::push_id
+
+ @see publish::push_id
@see publish::get_main_item_id
@see publish::get_main_revision_id
} {
- variable item_id_stack
+ variable item_id_stack
set pair [lindex $item_id_stack 0]
if { [template::util::is_nil pair] } {
#error "Item id stack is empty in publish::pop_id"
}
-
+
set item_id_stack [lrange $item_id_stack 1 end]
# If the stack is now empty, clear the cache
if { [template::util::is_nil item_id_stack] } {
array unset revision_html
}
- set ::content::item_id [lindex $pair 0]
- set ::content::revision_id [lindex $pair 1]
+ lassign $pair ::content::item_id ::content::revision_id
return $::content::item_id
}
@@ -187,14 +186,14 @@
ad_proc -public publish::proc_exists { namespace_name proc_name } {
@public proc_exists
-
+
Determine if a procedure exists in the given namespace
-
+
@param namespace_name The fully qualified namespace name,
such as "template::util"
-
+
@param proc_name The proc name, such as "is_nil"
-
+
@return 1 if the proc exists in the given namespace, 0 otherwise
} {
@@ -208,61 +207,61 @@
#
-ad_proc -public publish::handle_binary_file {
- item_id revision_id_ref url_ref error_ref args
+ad_proc -public publish::handle_binary_file {
+ item_id revision_id_ref url_ref error_ref args
} {
@public handle_binary_file
-
+
Helper procedure for writing handlers for binary files.
It will write the blob of the item to the filesystem,
but only if -embed is specified. Then, it will attempt to
merge the image with its template. <br>
This proc accepts exactly the same options a typical handler.
-
- @param item_id
+
+ @param item_id
The id of the item to handle
-
- @param revision_id_ref {<i>required</i>}
+
+ @param revision_id_ref {<i>required</i>}
The name of the variable in the calling frame that will
receive the revision_id whose content blob was written
- to the filesystem.
-
- @param url_ref
+ to the filesystem.
+
+ @param url_ref
The name of the variable in the calling frame that will
receive the relative URL of the file in the file system
which contains the content blob
-
- @param error_ref
+
+ @param error_ref
The name of the variable in the calling frame that will
receive an error message. If no error has occurred, this
variable will be set to the empty string ""
-
- @option embed
+
+ @option embed
Signifies that the content should be embedded directly in
- the parent item. <tt>-embed</tt> is <b>required</b> for this
+ the parent item. <tt>-embed</tt> is <b>required</b> for this
proc, since it makes no sense to handle the binary file
in any other way.
-
+
@option revision_id {default The live revision for the item}
The revision whose content is to be used
-
- @option no_merge
+
+ @option no_merge
If present, do NOT merge with the template, in order to
- prevent infinite recursion in the <content> tag. In
+ prevent infinite recursion in the <content> tag. In
this case, the proc will return the empty string ""
-
- @return The HTML resulting from merging the item with its
+
+ @return The HTML resulting from merging the item with its
template, or "" if no template exists or the <tt>-no_merge</tt>
flag was specified
-
- @see publish::handle::image
+ @see publish::handle::image
+
} {
template::util::get_opts $args
- upvar $error_ref error_msg
+ upvar $error_ref error_msg
upvar $url_ref file_url
upvar $revision_id_ref revision_id
set error_msg ""
@@ -272,14 +271,14 @@
} else {
set revision_id $opts(revision_id)
}
-
+
# If the embed tag is true, return the html. Otherwise,
# just write the image to the filesystem
if { [info exists opts(embed)] } {
set file_url [publish::write_content $revision_id \
-item_id $item_id -root_path [publish::get_publish_roots]]
-
+
# If write_content aborted, give up
if { [template::util::is_nil file_url] } {
set error_msg "No URL found for revision $revision_id, item $item_id"
@@ -293,8 +292,8 @@
return $html
}
- return ""
-
+ return ""
+
} else {
set error_msg "No embed specified for handle_binary_file, aborting"
return ""
@@ -305,14 +304,14 @@
ad_proc -private publish::html_args { argv } {
@private html_args
-
+
Concatenate a list of name-value pairs as returned by
<tt>set_to_pairs</tt> into a list of "name=value" pairs
-
+
@param argv The list of name-value pairs
-
+
@return An HTML string in format "name=value name=value ..."
-
+
@see publish::set_to_pairs
} {
@@ -321,7 +320,7 @@
foreach { name value } $argv {
append extra_html "$name=\"$value\" "
}
- }
+ }
return $extra_html
}
@@ -330,21 +329,21 @@
ad_proc -public publish::item_include_tag { item_id {extra_args {}} } {
@public item_include_tag
-
+
Create an include tag to include an item, in the form
<blockquote><tt>
- include src=/foo/bar/baz item_id=<i>item_id</i>
+ include src=/foo/bar/baz item_id=<i>item_id</i>
param=value param=value ...
</tt></blockquote>
-
+
@param item_id The item id
-
+
@param extra_args {}
A list of extra parameters to be passed to the <tt>include</tt>
tag, in form {name value name value ...}
-
+
@return The HTML for the include tag
-
+
@see content::item::get_virtual_path
@see publish::html_args
@@ -361,12 +360,12 @@
The basic image handler. Writes the image blob to the filesystem,
then either merges with the template or provides a default <img>
- tag. Uses the title for alt text if no alt text is specified
+ tag. Uses the title for alt text if no alt text is specified
externally.
} {
template::util::get_opts $args
-
+
# LARS TODO: Added -no_merge, verify how this is supposed to work
set html [publish::handle_binary_file \
$item_id revision_id url error_msg {*}$args -no_merge]
@@ -405,36 +404,36 @@
}
append html " $extra_html"
-
+
# Append the alt text if needed
if { !$have_alt } {
append html " alt=\"$image_alt\""
}
-
+
append html ">"
return $html
}
-ad_proc -private publish::merge_with_template { item_id args } {
+ad_proc -private publish::merge_with_template { item_id args } {
@private merge_with_template
-
+
Merge the item with its template and return the resulting HTML. This proc
is similar to <tt>content::init</tt>
-
+
@param item_id The item id
-
- @option revision_id {default The live revision}
+
+ @option revision_id {default The live revision}
The revision which is to be used when rendering the item
-
+
@option html
Extra HTML parameters to be passed to the ADP parser, in format
{name value name value ...}
-
+
@return The rendered HTML, or the empty string on failure
-
+
@see publish::handle_item
} {
@@ -450,12 +449,12 @@
set revision_id [::content::item::get_live_revision -item_id $item_id]
}
- # Get the template
+ # Get the template
set ::content::template_url [::content::item::get_template -item_id $item_id -use_context public]
- if {$::content::template_url eq {}} {
+ if {$::content::template_url eq {}} {
ns_log Warning "publish::merge_with_template: no template for item $item_id"
- return ""
+ return ""
}
ns_log debug "publish::merge_with_template: template for item $item_id is $::content::template_url"
@@ -479,9 +478,9 @@
return $html
}
-
+
ad_proc -public publish::handle::text { item_id args } {
Return the text body of the item
@@ -494,7 +493,7 @@
set revision_id [::content::item::get_live_revision -item_id $item_id]
} else {
set revision_id $opts(revision_id)
- }
+ }
if { [info exists opts(embed)] } {
# Render the child item and embed it in the code
@@ -508,7 +507,7 @@
# Query for values from a previous revision
set html [db_string get_previous_content ""]
}
- }
+ }
} else {
# Just create an include tag
@@ -519,9 +518,9 @@
} else {
set extra_args ""
}
-
+
set html [publish::item_include_tag $item_id $extra_args]
- }
+ }
return $html
}
@@ -530,37 +529,36 @@
ad_proc -public publish::get_mime_handler { mime_type } {
@public get_mime_handler
-
+
Return the name of a proc that should be used to render items with
the given mime-type.
The mime type handlers should all follow the naming convention
-
+
<blockquote>
<tt>proc publish::handle::<i>mime_prefix</i>::<i>mime_suffix</i></tt>
</blockquote>
-
+
If the specific mime handler could not be found, <tt>get_mime_handler</tt>
looks for a generic procedure with the name
-
+
<blockquote>
<tt>proc publish::handle::<i>mime_prefix</i></tt>
</blockquote>
-
- If the generic mime handler does not exist either,
+
+ If the generic mime handler does not exist either,
<tt>get_mime_handler</tt> returns ""
-
- @param mime_type
+
+ @param mime_type
The full mime type, such as "text/html" or "image/jpg"
-
+
@return The name of the proc which should be used to handle the mime-type,
or an empty string on failure.
-
+
@see publish::handle_item
} {
set mime_pair [split $mime_type "/"]
- set mime_prefix [lindex $mime_pair 0]
- set mime_suffix [lindex $mime_pair 1]
+ lassign $mime_pair mime_prefix mime_suffix
# Look for the specific handler
if { [proc_exists "::publish::handle::${mime_prefix}" $mime_suffix] } {
@@ -580,13 +578,13 @@
ad_proc -private publish::get_main_item_id {} {
@private get_main_item_id
-
+
Get the main item id from the top of the stack
-
+
@return the main item id
-
- @see publish::pop_id
- @see publish::push_id
+
+ @see publish::pop_id
+ @see publish::push_id
@see publish::get_main_revision_id
} {
@@ -604,13 +602,13 @@
ad_proc -private publish::get_main_revision_id {} {
@private get_main_revision_id
-
+
Get the main item revision from the top of the stack
-
+
@return the main item id
-
- @see publish::pop_id
- @see publish::push_id
+
+ @see publish::pop_id
+ @see publish::push_id
@see publish::get_main_item_id
} {
@@ -630,27 +628,27 @@
@private handle_item
Render an item either by looking it up in the temporary cache,
- or by using the appropriate mime handler. Once the item is rendered, it
+ or by using the appropriate mime handler. Once the item is rendered, it
is stored in the temporary cache under a key which combines the item_id,
any extra HTML parameters, and a flag which specifies whether the item
was merged with its template. <br>
This proc takes the same arguments as the individual mime handlers.
@param item_id The id of the item to be rendered
- @option revision_id {default The live revision}
+ @option revision_id {default The live revision}
The revision which is to be used when rendering the item
- @option no_merge
+ @option no_merge
Indicates that the item should NOT be merged with its
template. This option is used to avoid infinite recursion.
- @option refresh
+ @option refresh
Re-render the item even if it exists in the cache.
Use with caution - circular dependencies may cause infinite recursion
if this option is specified
- @option embed
+ @option embed
Signifies that the content should be statically embedded directly in
the HTML. If this option is not specified, the item may
be dynamically referenced, f.ex. using the <tt><include></tt>
@@ -697,8 +695,8 @@
}
# Pull the item out of the cache
- if { ![info exists opts(refresh)]
- && [info exists revision_html($revision_key)]
+ if { ![info exists opts(refresh)]
+ && [info exists revision_html($revision_key)]
} {
ns_log debug "publish::handle_item: Fetching $item_id from cache"
return $revision_html($revision_key)
@@ -736,18 +734,18 @@
ad_proc -public publish::get_html_body { html } {
@public get_html_body
-
+
Strip the <body> tags from the HTML, leaving just the body itself.
Useful for including templates in each other.
-
- @param html
+
+ @param html
The html to be processed
-
+
@return Everything between the <body> and the </body> tags
if they exist; the unchanged HTML if they do not
} {
-
+
if { [regexp -nocase {<body[^>]*>(.*)</body>} $html match body_text] } {
return $body_text
} else {
@@ -756,47 +754,47 @@
}
-ad_proc -public publish::render_subitem {
+ad_proc -public publish::render_subitem {
main_item_id relation_type relation_tag \
index is_embed extra_args {is_merge t}
} {
@private render_subitem
-
+
Render a child/related item and return the resulting HTML, stripping
off the headers.
-
+
@param main_item_id The id of the parent item
-
- @param relation_type
- Either <tt>child</tt> or <tt>relation</tt>.
+
+ @param relation_type
+ Either <tt>child</tt> or <tt>relation</tt>.
Determines which tables are searched for subitems.
-
- @param relation_tag
+
+ @param relation_tag
The relation tag to look for
-
- @param index
+
+ @param index
The relative index of the subitem. The subitem with
lowest <tt>order_n</tt> has index 1, the second lowest <tt>order_n</tt>
has index 2, and so on.
-
- @param is_embed
+
+ @param is_embed
If "t", the child item may be embedded directly
in the HTML. Otherwise, it may be dynamically included. The proc
does not process this parameter directly, but passes it to
<tt>handle_item</tt>
-
- @param extra_args
+
+ @param extra_args
Any additional HTML arguments to be used when
rendering the item, in form {name value name value ...}
-
- @param is_merge {default t}
+
+ @param is_merge {default t}
If "t", <tt>merge_with_template</tt> may
be used to render the subitem. Otherwise, <tt>merge_with_template</tt>
should not be used, in order to prevent infinite recursion.
-
+
@return The rendered HTML for the child item
-
+
@see publish::merge_with_template
@see publish::handle_item
@@ -862,14 +860,14 @@
ad_proc -private publish::process_tag { relation_type params } {
@private process_tag
-
+
Process a <tt>child</tt> or <tt>relation</tt> tag. This is
a helper proc for the tags, which acts as a wrapper for
<tt>render_subitem</tt>.
-
+
@param relation_type Either <tt>child</tt> or <tt>relation</tt>
@param params The ns_set id for extra HTML parameters
-
+
@see publish::render_subitem
} {
@@ -879,7 +877,7 @@
set embed [ns_set find $params embed]
if { $embed != -1 } { set embed t } else { set embed f }
set parent_item_id [ns_set iget $params parent_item_id]
-
+
# Concatenate all other keys into the extra arguments list
set extra_args [publish::set_to_pairs $params \
{tag index embed parent_item_id}]
@@ -893,23 +891,23 @@
append command " $relation_type $tag $index $embed"
append command " \{$extra_args\}"
- template::adp_append_code "append __adp_output \[$command\]"
+ template::adp_append_code "append __adp_output \[$command\]"
}
ad_proc -private publish::foreach_publish_path { url code {root_path ""} } {
@private foreach_publish_path
-
+
Execute some Tcl code for each root path in the PublishRoots
parameter
-
+
@param url Relative URL to append to the roots
@param code Execute this code
@param root_path {default The empty string}
Use this root path instead of the paths specified in the INI
file
-
+
@see publish::get_publish_roots
} {
@@ -926,23 +924,23 @@
foreach root_path $paths {
ns_log debug "publish::foreach_publish_path: root_path: $root_path"
set current_page_root $root_path
- set filename [ns_normalizepath "/$root_path/$url"]
+ set filename [ns_normalizepath "/$root_path/$url"]
uplevel $code
}
}
-
-ad_proc -private publish::write_multiple_blobs {
- url revision_id {root_path ""}
+
+ad_proc -private publish::write_multiple_blobs {
+ url revision_id {root_path ""}
} {
@private write_multiple_blobs
-
+
Write the content of some revision to multiple publishing roots.
-
+
@param db A valid database handle
@param url Relative URL of the file to write
- @param revision_id Write the blob for this revision
-
+ @param revision_id Write the blob for this revision
+
@see publish::get_publish_roots
@see publish::write_multiple_files
@@ -951,31 +949,31 @@
mkdirs $filename
db_1row get_storage_type "
- select storage_type
- from cr_items
- where item_id = (select item_id
- from cr_revisions
+ select storage_type
+ from cr_items
+ where item_id = (select item_id
+ from cr_revisions
where revision_id = :revision_id)"
db_blob_get_file wmb_get_blob_file "
select content from cr_revisions where revision_id = $revision_id
" -file $filename
-
+
ns_chmod $filename 0764
ns_log debug "publish::write_multiple_blobs: Wrote revision $revision_id to $filename"
} $root_path
}
-
+
ad_proc -private publish::write_multiple_files { url text {root_path ""}} {
- @private write_multiple_files
-
+ @private write_multiple_files
+
Write a relative URL to the multiple publishing roots.
-
+
@param url Relative URL of the file to write
@param text A string of text to be written to the URL
-
+
@see template::util::write_file
@see publish::get_publish_roots
@see publish::write_multiple_blobs
@@ -994,34 +992,34 @@
ad_proc -public publish::write_content { revision_id args } {
@public write_content
-
- Write the content (blob) of a revision into a binary file in the
+
+ Write the content (blob) of a revision into a binary file in the
filesystem. The file will be published at the relative URL under
- each publish root listed under the PublishRoots parameter in the
+ each publish root listed under the PublishRoots parameter in the
server's INI file (the value returnded by publish::get_page_root is
used as the default). The file extension will be based on the
revision's mime-type. <br>
- For example, an revision whose mime-type is "image/jpeg"
- for an item at "Sitemap/foo/bar" may be written as
+ For example, an revision whose mime-type is "image/jpeg"
+ for an item at "Sitemap/foo/bar" may be written as
/web/your_server_name/www/foo/bar.jpg
-
- @param revision_id
+
+ @param revision_id
The id of the revision to write
-
- @option item_id {default The item_id of the revision}
+
+ @option item_id {default The item_id of the revision}
Specifies the item to which this revision belongs (mereley
for optimization purposes)
-
- @option text
+
+ @option text
If specified, indicates that the content of the
revision is readable text (clob), not a binary file
-
+
@option root_path {default All paths in the PublishPaths parameter}
Write the content to this path only.
-
+
@return The relative URL of the file that was written, or an empty
string on failure
-
+
@see content::get_content_value
@see publish::get_publish_roots
@@ -1040,16 +1038,16 @@
# Get the item id if none specified
if { ![info exists opts(item_id)] } {
set item_id [db_string get_one_revision ""]
-
+
if { [template::util::is_nil item_id] } {
ns_log warning "publish::write_content: No such revision $revision_id"
return ""
}
} else {
set item_id $opts(item_id)
}
-
-
+
+
#set file_url [item::get_extended_url $item_id -revision_id $revision_id]
set base_path [content::item::get_virtual_path -item_id $item_id]
content::item::get -item_id $item_id -array_name item_info
@@ -1092,7 +1090,7 @@
ns_log warning "publish::write_content: No content supplied for revision $revision_id"
return ""
}
-
+
# Write the blob
write_multiple_blobs $file_url $revision_id $root_path
}
Index: openacs-4/packages/acs-developer-support/www/request-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-developer-support/www/request-info.tcl,v
diff -u -r1.22 -r1.23
--- openacs-4/packages/acs-developer-support/www/request-info.tcl 7 Aug 2017 23:47:56 -0000 1.22
+++ openacs-4/packages/acs-developer-support/www/request-info.tcl 8 May 2018 22:37:18 -0000 1.23
@@ -141,8 +141,7 @@
}
}
registered_proc {
- set proc [lindex $info 2]
- set args [lindex $info 3]
+ lassign $info . . proc args
append body "Called registered procedure: <b>$proc</b> [ns_quotehtml $args] for ($method $path) - $duration\n"
if {$action eq "error"} {
append body "<ul><li>returned error: <pre>[ns_quotehtml $error]</pre></ul>\n"
Index: openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl,v
diff -u -r1.52 -r1.53
--- openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 25 Apr 2018 19:23:25 -0000 1.52
+++ openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 8 May 2018 22:37:18 -0000 1.53
@@ -20,42 +20,42 @@
namespace eval lang::util {}
ad_proc -public lang::util::lang_sort {
- field
+ field
{locale ""}
-} {
+} {
Each locale can have a different alphabetical sort order. You can test
this proc with the following data:
<pre>
insert into lang_testsort values ('lama');
insert into lang_testsort values ('lhasa');
insert into lang_testsort values ('llama');
- insert into lang_testsort values ('lzim');
+ insert into lang_testsort values ('lzim');
</pre>
@author Jeff Davis (davis@xarg.net)
@param field Name of Oracle column
- @param locale Locale for sorting.
+ @param locale Locale for sorting.
If locale is unspecified just return the column name
@return Language aware version of field for Oracle <em>ORDER BY</em> clause.
} {
- # Use west european for english since I think that will fold
+ # Use west european for english since I think that will fold
# cedilla etc into reasonable values...
set lang(en) "XWest_european"
set lang(de) "XGerman_din"
- set lang(fr) "XFrench"
- set lang(es) "XSpanish"
-
+ set lang(fr) "XFrench"
+ set lang(es) "XSpanish"
+
if { $locale eq "" || ![info exists lang($locale)] } {
return $field
- } else {
+ } else {
return "NLSSORT($field,'NLS_SORT = $lang($locale)')"
}
}
ad_proc -private lang::util::get_hash_indices { multilingual_string } {
- Returns a list of two element lists containing
+ Returns a list of two element lists containing
the start and end indices of a #message_key# match in the multilingual string.
This proc is used by the localize proc.
@@ -88,15 +88,15 @@
Given the contents of an adp file return the indices of the
start and end chars of embedded message keys on the syntax:
- <#package_key.message_key Some en_US text#>
+ <#package_key.message_key Some en_US text#>
- @author Peter marklund (peter@collaboraid.biz)
+ @author Peter marklund (peter@collaboraid.biz)
} {
return [lang::util::get_regexp_indices $adp_file_string [message_tag_regexp]]
}
-
+
ad_proc -private lang::util::get_regexp_indices { multilingual_string regexp_pattern } {
- Returns a list of two element lists containing
+ Returns a list of two element lists containing
the start and end indices of what is captured by the first parenthesis in the
given regexp pattern in the multilingual string. The
regexp pattern must follow the syntax of the expression argument to the Tcl regexp command.
@@ -112,33 +112,32 @@
set offset_string $multilingual_string
set indices_list {}
- while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } {
-
- set start_idx [lindex $key_match_idx 0]
- set end_idx [lindex $key_match_idx 1]
+ while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } {
+ lassign $key_match_idx start_idx end_idx
+
lappend indices_list [list [expr {$multilingual_string_offset + $start_idx}] \
[expr {$multilingual_string_offset + $end_idx}]]
-
+
set new_offset [expr {$end_idx + 1}]
set multilingual_string_offset [expr {$multilingual_string_offset + $new_offset}]
set offset_string [string range $offset_string $new_offset end]
}
-
+
return $indices_list
-}
+}
-ad_proc lang::util::replace_temporary_tags_with_lookups {
- file_list
+ad_proc lang::util::replace_temporary_tags_with_lookups {
+ file_list
} {
Modify the given ADP or Tcl files by replacing occurencies of message keys
with message lookups (i.e. <span>#</span>package_key.message_key# for ADP files
and [_ "package_key.message_key"] for Tcl files) and create entries in the
catalog file for each of these keys. If the short hand form <#_ Some en_US text#>
is used then the key will be autogenerated based on the text.
Returns the number of replacements done. This procedure only
- reads from and writes to the catalog file specified (the en_US catalog
- file per default) of the package that the files belong to, the database
+ reads from and writes to the catalog file specified (the en_US catalog
+ file per default) of the package that the files belong to, the database
is not accessed in any way.
@param file_list A list of paths to adp or Tcl files to do replacements in. The
@@ -154,21 +153,21 @@
}
# Get package_key
- set first_file [lindex $file_list 0]
+ set first_file [lindex $file_list 0]
if { ![regexp {/?packages/([^/]+)/} $first_file match package_key] } {
error "lang::util::replace_temporary_tags_with_lookups: Could not extract package_key from file $first_file"
}
# Always create new keys in en_US
set locale "en_US"
-
+
# Read messages from any existing catalog file
set catalog_file_path [lang::catalog::get_catalog_file_path \
-package_key $package_key \
-locale $locale]
if { [file exists $catalog_file_path] } {
set catalog_file_contents [lang::catalog::read_file $catalog_file_path]
- array set catalog_array [lang::catalog::parse $catalog_file_contents]
+ array set catalog_array [lang::catalog::parse $catalog_file_contents]
array set messages_array $catalog_array(messages)
} else {
array set messages_array {}
@@ -178,7 +177,7 @@
set number_of_replacements "0"
# Loop over and process each file
- foreach file $file_list {
+ foreach file $file_list {
ns_log debug "lang::util::replace_temporary_tags_with_lookups: processing file $file"
set full_file_path "$::acs::rootdir/$file"
@@ -201,10 +200,9 @@
incr number_of_replacements
- set tag_start_idx [lindex $index_pair 0]
- set tag_end_idx [lindex $index_pair 1]
+ lassign $index_pair tag_start_idx tag_end_idx
set message_tag "[string range $file_contents $tag_start_idx $tag_end_idx]"
-
+
# Extract the message key and the text from the message tag
# The regexp on the message tag string should never fail as the message tag
# was extracted with a known regexp
@@ -235,7 +233,7 @@
if { [info exists messages_array($unique_key)] } {
# The key already exists
-
+
if {$messages_array($unique_key) eq $new_text} {
# New and old texts are identical - don't add the key
ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - \
@@ -262,14 +260,14 @@
} else {
ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - Will be adding \
new key $unique_key to catalog file for package $package_key]
- }
+ }
set messages_array($unique_key) $new_text
# We are done
break
}
-
+
incr key_comp_counter
}
@@ -280,7 +278,7 @@
$modified_file_contents \
"#${package_key}.${unique_key}#" \
modified_file_contents
- }
+ }
{^tcl$} {
regsub [message_tag_regexp] \
$modified_file_contents \
@@ -311,7 +309,7 @@
}
return $number_of_replacements
-}
+}
ad_proc -public lang::util::localize {
string_with_hashes
@@ -330,12 +328,12 @@
return $string_with_hashes
}
- if {$locale eq ""} {
- set locale [ad_conn locale]
- }
+ if {$locale eq ""} {
+ set locale [ad_conn locale]
+ }
set indices_list [get_hash_indices $string_with_hashes]
-
+
set subst_string ""
set start_idx 0
foreach item_idx $indices_list {
@@ -346,23 +344,23 @@
# Attempt a message lookup
set message_value [lang::message::lookup $locale $message_key "" "" 2]
-
+
# Replace the string
# LARS: We don't use regsub here, because regsub interprets certain characters
# in the replacement string specially.
append subst_string [string range $string_with_hashes $start_idx [lindex $item_idx 0]-1]
append subst_string $message_value
set start_idx [expr {[lindex $item_idx 1] + 1}]
- }
+ }
append subst_string [string range $string_with_hashes $start_idx end]
-
+
return $subst_string
}
-ad_proc -public lang::util::charset_for_locale {
- locale
+ad_proc -public lang::util::charset_for_locale {
+ locale
} {
Returns the MIME charset name corresponding to a locale.
@@ -376,25 +374,25 @@
set $key [db_string -cache_key ad_lang_mime_charset_$locale charset_for_locale {}]
}
-ad_proc -private lang::util::default_locale_from_lang_not_cached {
+ad_proc -private lang::util::default_locale_from_lang_not_cached {
language
} {
Returns the default locale for a language. Not cached.
-
+
@author Henry Minsky (hqm@mit.edu)
@param language Name of a language, using a two or three letter ISO code
@return Default locale
-
+
@see lang::util::default_locale_from_lang
} {
# LARS:
# Note that this query does not use bind variables, because these cause the query to not
- # match any rows in Oracle when the language key is less than 3 characters,
+ # match any rows in Oracle when the language key is less than 3 characters,
# because the column is a char(3), not a varchar2(3).
return [db_string default_locale_from_lang {} -default ""]
}
-ad_proc -public lang::util::default_locale_from_lang {
+ad_proc -public lang::util::default_locale_from_lang {
language
} {
Returns an enabled default locale for a language. If a language
@@ -408,8 +406,8 @@
return [util_memoize [list lang::util::default_locale_from_lang_not_cached $language]]
}
-ad_proc -public lang::util::nls_language_from_language {
- language
+ad_proc -public lang::util::nls_language_from_language {
+ language
} {
Returns the nls_language name for a language
@@ -437,14 +435,14 @@
Suggest a key for given text.
} {
regsub -all " " $text "_" key
-
+
# Do not allow . in the key as dot is used as a separator to qualify a key
# with the package key. The prepending with package key is done at a later
# stage
regsub -all {[^-a-zA-Z0-9_]} $key "" key
-
+
# is this key too long?
-
+
if { [string length $key] > 20 } {
set key "lt_[string range $key 0 20]"
}
@@ -466,7 +464,7 @@
while {[regsub -all [template::adp_variable_regexp] $text {\1%\2%} text]} {}
while {[regsub -all [template::adp_variable_regexp_noquote] $text {\1%\2;noquote%} text]} {}
- return $text
+ return $text
}
ad_proc -private lang::util::convert_percentage_signs_to_adp_variables { text } {
@@ -492,11 +490,11 @@
return $text
}
-ad_proc -public lang::util::replace_adp_text_with_message_tags {
+ad_proc -public lang::util::replace_adp_text_with_message_tags {
file_name
mode
{keys {}}
-
+
} {
Prepares an .adp-file for localization by inserting temporary hash-tags
around text strings that looks like unlocalized plain text. Needless to say
@@ -526,7 +524,7 @@
@author Jeff Davis
} {
- set state text
+ set state text
set out {}
set report {}
@@ -542,14 +540,14 @@
#ns_write "input== s=[string range $s 0 600]\n"
set x {}
- while {$s ne "" && $n < 1000} {
- if { $state eq "text" } {
+ while {$s ne "" && $n < 1000} {
+ if { $state eq "text" } {
# clip non tag stuff
- if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} {
+ if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} {
set text $s
set s {}
- }
+ }
# Remove parts from the text that we know are not translatable
# such as adp variables, message key lookups, and
@@ -572,14 +570,14 @@
if { $mode eq "report" } {
# create a key for the text
-
+
set key [suggest_key $text]
lappend report [list $key "<code>[string range [remove_gt_lt $out$lead] end-20 end]<b><span style=\"background:yellow\">$text</span></b>[string range [remove_gt_lt $lag$s] 0 20]</code>" ]
- } else {
+ } else {
# Write mode
if { [llength $keys] != 0} {
- # Use keys supplied
+ # Use keys supplied
if { [lindex $keys $n] ne "" } {
# Use supplied key
set write_key [lindex $keys $n]
@@ -589,7 +587,7 @@
}
} else {
# No keys supplied - autogenerate a key
- set write_key [suggest_key $text]
+ set write_key [suggest_key $text]
}
if { $write_key ne "" } {
@@ -601,12 +599,12 @@
# Leave the text untouched
lappend garbage "<code>[string range [remove_gt_lt $out$lead] end-20 end]<b><span style=\"background:yellow\">$text </span></b>[string range [remove_gt_lt $lag$s] 0 20]</code>"
append out "$lead$text$lag"
- }
+ }
}
incr n
- } else {
+ } else {
# this was not something we should localize
append out $text
@@ -620,18 +618,18 @@
regsub -all "\n" $text "" short_text
set short_text [string range $short_text 0 40]
-
+
lappend garbage "<code>$short_text</code>"
}
}
- set state tag
+ set state tag
- } elseif { $state eq "tag"} {
- if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
+ } elseif { $state eq "tag"} {
+ if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
set s {}
- }
+ }
append out $tag
set state text
@@ -643,7 +641,7 @@
# backup original file - fail silently if backup already exists
if { [catch {file copy -- $file_name $file_name.orig}] } { }
-
+
set fp [open $file_name "w"]
puts $fp $out
close $fp
@@ -655,10 +653,10 @@
ad_proc -public lang::util::translator_mode_p {} {
Whether translator mode is enabled for this session or
- not. Translator mode will cause all non-translated messages to appear as a
+ not. Translator mode will cause all non-translated messages to appear as a
link to a page where the message can be translated, instead of the default
"not translated" message.
-
+
@author Lars Pind (lars@collaboraid.biz)
@creation-date October 24, 2002
@@ -790,14 +788,14 @@
} else {
set message_key "${prefix}_[lang::util::suggest_key $text]"
}
- }
-
+ }
+
# Register the language keys
lang::message::register en_US $package_key $message_key $text
if {$locale ne ""} {
lang::message::register $locale $package_key $message_key $text
}
-
+
return "#${package_key}.${message_key}#"
} else {
return "$text"
@@ -850,7 +848,7 @@
return $edit_url
}
-ad_proc -public lang::util::iso6392_from_language {
+ad_proc -public lang::util::iso6392_from_language {
-language:required
} {
@@ -871,14 +869,14 @@
} elseif { $lang_len eq 3 } {
# input is iso-639-2 language code
# we check in the table in case the language code is wrong
-
+
set iso6392_code [db_string get_iso2_code_from_iso2 {} -default ""]
}
return $iso6392_code
}
-ad_proc -public lang::util::iso6392_from_locale {
+ad_proc -public lang::util::iso6392_from_locale {
-locale:required
} {
@@ -894,7 +892,7 @@
return [lang::util::iso6392_from_language -language $language]
}
-ad_proc -public lang::util::language_label {
+ad_proc -public lang::util::language_label {
-language:required
} {
@@ -915,7 +913,7 @@
} elseif { $lang_len eq 3 } {
# input is iso-639-2 language code
# we check in the table in case the language code is wrong
-
+
set lang_label [db_string get_label_from_iso2 {} -default ""]
}
Index: openacs-4/packages/acs-lang/www/admin/lookup.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/lookup.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-lang/www/admin/lookup.tcl 7 Aug 2017 23:47:57 -0000 1.3
+++ openacs-4/packages/acs-lang/www/admin/lookup.tcl 8 May 2018 22:37:18 -0000 1.4
@@ -13,11 +13,11 @@
{help_text "[_ acs-lang.Include_package_key_as]"}
{html {size 50}}
}
- {locale:text
+ {locale:text
{label "[_ acs-lang.Locale]"}
{help_text "[_ acs-lang.Can_be_two_character]"}
}
-} -on_submit {
+} -on_submit {
if {[catch {
# No substitution
set message [lang::message::lookup $locale $key]
@@ -26,10 +26,9 @@
ad_log error $errmsg
ad_script_abort
}
-
+
set keyv [split $key "."]
- set package_key [lindex $keyv 0]
- set message_key [lindex $keyv 1]
+ lassign $keyv package_key message_key
set edit_url [export_vars -base edit-localized-message { package_key locale message_key {return_url [ad_return_url]} }]
Index: openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl 20 Feb 2018 09:07:27 -0000 1.4
+++ openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl 8 May 2018 22:37:18 -0000 1.5
@@ -72,9 +72,7 @@
Quote mailbox with curly braces like: {{mailbox.host}mailbox.name} "
set mb_list [acs_mail_lite::imap_mailbox_split $mb]
if { [llength $mb_list] eq 3 } {
- set ho [lindex $mb_list 0]
- set na [lindex $mb_list 1]
- set ssl_p [lindex $mb_list 2]
+ lassign $mb_list ho na ssl_p
ns_log Notice "acs_mail_lite::imap_conn_set.479: \
Used alternate parsing. host '${ho}' mailbox.name '${na}' ssl_p '${ssl_p}'"
} else {
@@ -251,9 +249,7 @@
set id [lindex $s_list 0]
if { $id eq $conn_id } {
set prior_conn_exists_p 1
- set opentime [lindex $s_list 1]
- set accesstime [lindex $s_list 2]
- set mailbox [lindex $s_list 3]
+ lassign $s_list . opentime accesstime mailbox
}
incr i
}
Index: openacs-4/packages/acs-subsite/tcl/package-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/package-procs.tcl,v
diff -u -r1.33 -r1.34
--- openacs-4/packages/acs-subsite/tcl/package-procs.tcl 25 Apr 2018 19:23:26 -0000 1.33
+++ openacs-4/packages/acs-subsite/tcl/package-procs.tcl 8 May 2018 22:37:18 -0000 1.34
@@ -473,9 +473,7 @@
set primary_keys [list "${table_name}.${id_column}"]
foreach row [package_object_attribute_list -start_with $start_with $object_type] {
- set table [lindex $row 1]
- set column [lindex $row 2]
- set object_column [lindex $row 8]
+ lassign $row . table column . . . . . object_column
if {[string tolower $column] eq "object_id"} {
# We already have object_id... skip this column
Index: openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/00-database-procs.tcl,v
diff -u -r1.98 -r1.99
--- openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 25 Apr 2018 19:23:26 -0000 1.98
+++ openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 8 May 2018 22:37:18 -0000 1.99
@@ -1365,8 +1365,7 @@
} {
return -code error "Expected if_no_rows as second-to-last argument"
}
- set code_block [lindex $args 0]
- set if_no_rows_code_block [lindex $args 2]
+ lassign $args code_block . if_no_rows_code_block
} else {
return -code error "Expected 1 or 3 arguments after switches"
}
@@ -1760,8 +1759,7 @@
} {
return -code error "Expected if_no_rows as second-to-last argument"
}
- set code_block [lindex $args 0]
- set if_no_rows_code_block [lindex $args 2]
+ lassign $args code_block . if_no_rows_code_block
} else {
return -code error "Expected 1 or 3 arguments after switches"
}
Index: openacs-4/packages/acs-tcl/tcl/pools-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/pools-init.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-tcl/tcl/pools-init.tcl 7 Aug 2017 23:47:59 -0000 1.7
+++ openacs-4/packages/acs-tcl/tcl/pools-init.tcl 8 May 2018 22:37:18 -0000 1.8
@@ -1,50 +1,49 @@
if {[ns_info version] eq "4.5"} {
set cfgsection "ns/server/[ns_info server]"
-
+
set minthreads [ns_config $cfgsection minthreads 5]
set maxthreads [ns_config $cfgsection maxthreads 10]
- set maxconns [ns_config $cfgsection maxconnections 100]
- set timeout [ns_config $cfgsection threadtimeout 120]
+ set maxconns [ns_config $cfgsection maxconnections 100]
+ set timeout [ns_config $cfgsection threadtimeout 120]
ns_pools set default -minthreads $minthreads -maxthreads $maxthreads -maxconns $maxconns -timeout $timeout
-
+
ns_log Notice "Default Pool: [ns_pools get default]"
-
+
# Setup optional threadpools
-
+
set poolSection $cfgsection/pools
-
+
set poolSet [ns_configsection $poolSection]
-
+
if {"$poolSet" ne ""} {
-
- set poolSize [ns_set size $poolSet]
- for {set i 0} {$i < $poolSize} {incr i} {
- set poolName [ns_set key $poolSet $i]
- set poolDescription [ns_set value $poolSet $i]
- set poolConfigSection "ns/server/[ns_info server]/pool/$poolName"
- set poolConfigSet [ns_configsection $poolConfigSection]
- if {"$poolConfigSet" eq ""} {
- continue
- }
- set poolMinthreads [ns_config $poolConfigSection minthreads $minthreads]
- set poolMaxthreads [ns_config $poolConfigSection maxthreads $maxthreads]
- set poolMaxconns [ns_config $poolConfigSection maxconnections $maxconns]
- set poolTimeout [ns_config $poolConfigSection threadtimeout $timeout]
-
- ns_pools set $poolName -minthreads $poolMinthreads -maxthreads $poolMaxthreads -maxconns $poolMaxconns -timeout $poolTimeout
- ns_log Notice "$poolName Pool: [ns_pools get $poolName]"
- set poolConfigSize [ns_set size $poolConfigSet]
- for {set j 0} {$j < $poolConfigSize} {incr j} {
- if {[string tolower [ns_set key $poolConfigSet $j]] eq "map"} &
- #123;
- set mapList [split [ns_set value $poolConfigSet $j]]
- set poolMethod [lindex $mapList 0]
- set poolPattern [lindex $mapList 1]
- ns_pools register $poolName [ns_info server] $poolMethod $poolPattern
- ns_log Notice "ns_pools registered $poolName [ns_info server] $poolMethod $poolPattern"
- }
- }
+
+ set poolSize [ns_set size $poolSet]
+ for {set i 0} {$i < $poolSize} {incr i} {
+ set poolName [ns_set key $poolSet $i]
+ set poolDescription [ns_set value $poolSet $i]
+ set poolConfigSection "ns/server/[ns_info server]/pool/$poolName"
+ set poolConfigSet [ns_configsection $poolConfigSection]
+ if {"$poolConfigSet" eq ""} {
+ continue
+ }
+ set poolMinthreads [ns_config $poolConfigSection minthreads $minthreads]
+ set poolMaxthreads [ns_config $poolConfigSection maxthreads $maxthreads]
+ set poolMaxconns [ns_config $poolConfigSection maxconnections $maxconns]
+ set poolTimeout [ns_config $poolConfigSection threadtimeout $timeout]
+
+ ns_pools set $poolName -minthreads $poolMinthreads -maxthreads $poolMaxthreads -maxconns $poolMaxconns -timeout $poolTimeout
+ ns_log Notice "$poolName Pool: [ns_pools get $poolName]"
+ set poolConfigSize [ns_set size $poolConfigSet]
+ for {set j 0} {$j < $poolConfigSize} {incr j} {
+ if {[string tolower [ns_set key $poolConfigSet $j]] eq "map"} &
+ #123;
+ set mapList [split [ns_set value $poolConfigSet $j]]
+ lassign $mapList poolMethod poolPattern
+ ns_pools register $poolName [ns_info server] $poolMethod $poolPattern
+ ns_log Notice "ns_pools registered $poolName [ns_info server] $poolMethod $poolPattern"
+ }
+ }
}
}