Index: openacs-4/packages/bug-tracker/lib/nav-bar.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/bug-tracker/lib/nav-bar.tcl,v diff -u -N -r1.16 -r1.17 --- openacs-4/packages/bug-tracker/lib/nav-bar.tcl 27 Jun 2015 19:59:33 -0000 1.16 +++ openacs-4/packages/bug-tracker/lib/nav-bar.tcl 24 Apr 2018 16:13:07 -0000 1.17 @@ -16,7 +16,7 @@ -object_id $package_id \ -privilege admin] -if { [ad_conn untrusted_user_id] == 0 } { +if { [ad_conn untrusted_user_id] == 0 } { set create_p 1 } else { set create_p [permission::permission_p \ @@ -27,9 +27,7 @@ bug_tracker::get_pretty_names -array pretty_names -set notification_url [lindex $notification_link 0] -set notification_label [lindex $notification_link 1] -set notification_title [lindex $notification_link 2] +lassign $notification_link notification_url notification_label notification_title # Paches enabled for this project? set patches_p [bug_tracker::patches_p] @@ -73,11 +71,11 @@ if { $patches_p } { multirow append links "[bug_tracker::conn Patches]" \ - [export_vars -no_empty \ - -base "[ad_conn package_url]patch-list" { - { status open } - { apply_to_version "[bug_tracker::conn current_version_id]" } - }] + [export_vars -no_empty \ + -base "[ad_conn package_url]patch-list" { + { status open } + { apply_to_version "[bug_tracker::conn current_version_id]" } + }] if { $create_p } { multirow append links "[_ bug-tracker.New] [bug_tracker::conn Patches]" "[ad_conn package_url]patch-add" Index: openacs-4/packages/bug-tracker/tcl/bug-tracker-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/bug-tracker/tcl/bug-tracker-procs.tcl,v diff -u -N -r1.54 -r1.55 --- openacs-4/packages/bug-tracker/tcl/bug-tracker-procs.tcl 8 Apr 2018 05:29:43 -0000 1.54 +++ openacs-4/packages/bug-tracker/tcl/bug-tracker-procs.tcl 24 Apr 2018 16:13:07 -0000 1.55 @@ -32,16 +32,16 @@ return $bt_conn($var) } else { switch -- $var { - bug - bugs - Bug - Bugs - + bug - bugs - Bug - Bugs - component - components - Component - Components - patch - patches - Patch - Patches { if { ![info exists bt_conn($var)] } { get_pretty_names -array bt_conn } return $bt_conn($var) } - project_name - project_description - - project_root_keyword_id - project_folder_id - + project_name - project_description - + project_root_keyword_id - project_folder_id - current_version_id - current_version_name { array set info [get_project_info] foreach name [array names info] { @@ -60,9 +60,9 @@ return $bt_conn($var) } } - component_id - - filter - filter_human_readable - - filter_where_clauses - + component_id - + filter - filter_human_readable - + filter_where_clauses - filter_order_by_clause - filter_from_bug_clause { return {} } @@ -79,7 +79,7 @@ } } -ad_proc bug_tracker::get_pretty_names { +ad_proc bug_tracker::get_pretty_names { -array:required {-package_id ""} } { @@ -112,11 +112,11 @@ } -ad_proc bug_tracker::get_page_variables { +ad_proc bug_tracker::get_page_variables { {extra_spec ""} } { Adds the bug listing filter variables for use in the page contract. - + ad_page_contract { doc } [bug_tracker::get_page_variables { foo:integer { bar "" } }] } { set filter_vars { @@ -125,7 +125,7 @@ f_fix_for_version:integer,optional f_component:integer,optional orderby:token,optional - project_id:naturalnum,optional + project_id:naturalnum,optional {format:word "table"} } foreach { parent_id parent_heading } [bug_tracker::category_types] { @@ -138,7 +138,7 @@ return [concat $filter_vars $extra_spec] } -ad_proc bug_tracker::get_export_variables { +ad_proc bug_tracker::get_export_variables { {-package_id ""} {extra_vars ""} } { @@ -170,14 +170,14 @@ ##### # # Cached project info procs -# +# ##### ad_proc bug_tracker::get_project_info_internal { package_id } { db_1row project_info {} -column_array result - + return [array get result] } @@ -208,22 +208,22 @@ if { $package_id eq "" } { set package_id [ad_conn package_id] } - + db_dml project_name_update {} - + # Flush cache util_memoize_flush [list bug_tracker::get_project_info_internal $package_id]] } - + ##### # # Stats procs # ##### - + ad_proc -public bug_tracker::bugs_exist_p { {-package_id {}} } { @@ -235,7 +235,7 @@ return [util_memoize [list bug_tracker::bugs_exist_p_not_cached -package_id $package_id]] } - + ad_proc -public bug_tracker::bugs_exist_p_set_true { {-package_id {}} } { @@ -247,17 +247,17 @@ return [util_memoize_seed [list bug_tracker::bugs_exist_p_not_cached -package_id $package_id] 1] } - + ad_proc -public bug_tracker::bugs_exist_p_not_cached { -package_id:required } { Returns whether any bugs exist in a project. Not cached. } { return [db_string select_bugs_exist_p {} -default 0] } - - - + + + ##### # # Cached user prefs procs @@ -313,8 +313,8 @@ util_memoize_flush [list bug_tracker::get_user_prefs_internal $package_id $user_id] } - - + + ##### # # Status @@ -349,7 +349,7 @@ } workflow::state::fsm::get -state_id $state_id -array state - + return $state(pretty_name) } @@ -369,7 +369,7 @@ array set status_codes { open bug-tracker.Open accepted bug-tracker.Accepted - refused bug-tracker.Refused + refused bug-tracker.Refused deleted bug-tracker.Deleted } if { [info exists status_codes($status)] } { @@ -454,11 +454,8 @@ -keyword_id:required } { foreach elm [get_keywords -package_id $package_id] { - set child_id [lindex $elm 0] - set child_heading [lindex $elm 1] - set parent_id [lindex $elm 2] - set parent_heading [lindex $elm 3] - + lassign $elm child_id child_heading parent_id parent_heading + if { $child_id == $keyword_id } { return $child_heading } elseif { $parent_id == $keyword_id } { @@ -475,21 +472,18 @@ } { array set heading [list] set parent_ids [list] - + set last_parent_id {} foreach elm [get_keywords -package_id $package_id] { - set child_id [lindex $elm 0] - set child_heading [lindex $elm 1] - set parent_id [lindex $elm 2] - set parent_heading [lindex $elm 3] - + lassign $elm child_id child_heading parent_id parent_heading + if { $parent_id != $last_parent_id } { set heading($parent_id) $parent_heading lappend parent_ids $parent_id set last_parent_id $parent_id } } - + set result [list] foreach parent_id $parent_ids { lappend result $parent_id $heading($parent_id) @@ -541,10 +535,8 @@ } { set options [list] foreach elm [get_keywords -package_id $package_id] { - set elm_child_id [lindex $elm 0] - set elm_child_heading [lindex $elm 1] - set elm_parent_id [lindex $elm 2] - + lassign $elm elm_child_id elm_child_heading elm_parent_id + if { $elm_parent_id == $parent_id } { lappend options [list $elm_child_heading $elm_child_id] } @@ -594,14 +586,14 @@ set package_id [ad_conn package_id] } - db_dml delete_existing { + db_dml delete_existing { delete - from bt_default_keywords - where project_id = :package_id + from bt_default_keywords + where project_id = :package_id and parent_id = :parent_id } - - db_dml insert_new { + + db_dml insert_new { insert into bt_default_keywords (project_id, parent_id, keyword_id) values (:package_id, :parent_id, :keyword_id) } @@ -625,7 +617,7 @@ {-package_id ""} {-parent_id:required} } { - Flush the cache for + Flush the cache for } { if { $package_id eq "" } { set package_id [ad_conn package_id] @@ -641,7 +633,7 @@ } { Get the default keyword for a given type (parent), not cached. } { - return [db_string default { + return [db_string default { select keyword_id from bt_default_keywords where project_id = :package_id @@ -666,7 +658,7 @@ "[_ bug-tracker.Prio_Norm_Cat]" \ "[_ bug-tracker.Prio_Low_Cat]" \ ] \ - "[_ bug-tracker.Severity]" [list \ + "[_ bug-tracker.Severity]" [list \ "[_ bug-tracker.Sev_Critical_Cat]" \ "[_ bug-tracker.Sev_Major_Cat]" \ "[_ bug-tracker.Sev_Normal_Cat]" \ @@ -700,30 +692,30 @@ TicketPrettyPlural "tickets" ComponentPrettyName "area" ComponentPrettyPlural "areas" - PatchesP "0" + PatchesP "0" VersionsP "0" RelatedFilesP "1" } \ ] \ [_ bug-tracker.Support_Center] [list \ - categories [list \ - "[_ bug-tracker.Message_Type]" [list \ + categories [list \ + "[_ bug-tracker.Message_Type]" [list \ "[_ bug-tracker.Support_Problem]" \ "[_ bug-tracker.Support_Suggestion]" \ "[_ bug-tracker.Support_Error]" \ ] \ - "[_ bug-tracker.Priority]" [list \ - "[_ bug-tracker.Prio_High_Cat]" \ - "[_ bug-tracker.Prio_Norm_Cat]" \ - "[_ bug-tracker.Prio_Low_Cat]" \ - ] \ + "[_ bug-tracker.Priority]" [list \ + "[_ bug-tracker.Prio_High_Cat]" \ + "[_ bug-tracker.Prio_Norm_Cat]" \ + "[_ bug-tracker.Prio_Low_Cat]" \ + ] \ ] \ parameters { TicketPrettyName "message" TicketPrettyPlural "messages" ComponentPrettyName "area" ComponentPrettyPlural "areas" - PatchesP "0" + PatchesP "0" VersionsP "0" RelatedFilesP "1" } \ @@ -753,7 +745,7 @@ -spec:required } { @param spec is an array-list of { Type1 { cat1 cat2 cat3 } Type2 { cat1 cat2 cat3 } } - Default category within type is denoted by letting the name start with a *, + Default category within type is denoted by letting the name start with a *, which is removed before creating the keyword. } { set root_keyword_id [bug_tracker::conn project_root_keyword_id -package_id $package_id] @@ -762,25 +754,25 @@ set category_type_id [content::keyword::get_keyword_id \ -parent_id $root_keyword_id \ -heading $category_type] - + if { $category_type_id eq "" } { set category_type_id [content::keyword::new \ -parent_id $root_keyword_id \ -heading $category_type] } - + foreach category $categories { if {[string index $category 0] eq "*"} { set default_p 1 set category [string range $category 1 end] } else { set default_p 0 - } - + } + set category_id [content::keyword::get_keyword_id \ -parent_id $category_type_id \ -heading $category] - + if { $category_id eq "" } { set category_id [content::keyword::new \ -parent_id $category_type_id \ @@ -846,33 +838,33 @@ -include_undecided:boolean } { Returns an option list containing all users that have submitted or assigned to a bug. - Used for the add bug form. Added because the workflow api requires a case_id. + Used for the add bug form. Added because the workflow api requires a case_id. (an item to evaluate is refactoring workflow to provide an assignee widget without a case_id) } { - + set assignee_list [db_list_of_lists assignees {}] if { $include_unknown_p } { set assignee_list [concat { { "Unknown" "" } } $assignee_list] - } - + } + if { $include_undecided_p } { set assignee_list [concat { { "Undecided" "" } } $assignee_list] - } - + } + return $assignee_list } ad_proc bug_tracker::versions_p { {-package_id ""} -} { +} { Is the versions feature turned on? } { if { $package_id eq "" } { set package_id [ad_conn package_id] } - + return [parameter::get -package_id $package_id -parameter "VersionsP" -default 1] } @@ -886,7 +878,7 @@ package_id } { set versions_list [db_list_of_lists versions {}] - + return $versions_list } @@ -900,8 +892,7 @@ return {} } foreach elm [version_get_options -package_id $package_id] { - set name [lindex $elm 0] - set id [lindex $elm 1] + lassign $elm name id if {$id eq $version_id} { return $name } @@ -956,8 +947,8 @@ if { $include_unknown_p } { set components_list [concat [list [list "[_ bug-tracker.Unknown]" {} ]] $components_list] - } - + } + return $components_list } @@ -1084,37 +1075,37 @@ if { $package_id eq "" } { set package_id [ad_conn package_id] } - + set user_id [ad_conn user_id] - + # This picks out users who are already assigned to some bug in this set sql { - select first_names || ' ' || last_name || ' (' || email || ')' as name, + select first_names || ' ' || last_name || ' (' || email || ')' as name, user_id from cc_users where user_id in ( select maintainer from bt_projects where project_id = :package_id - + union - + select maintainer from bt_versions where project_id = :package_id - + union - + select maintainer from bt_components where project_id = :package_id ) or user_id = :user_id order by name } - + set users_list [db_list_of_lists users $sql] - + set users_list [concat [list [list [_ bug-tracker.Unassigned] "" ]] $users_list] lappend users_list [list [_ bug-tracker.Search] ":search:"] @@ -1128,7 +1119,7 @@ # ##### -ad_proc bug_tracker::patches_p {} { +ad_proc bug_tracker::patches_p {} { Is the patch submission feature turned on? } { return [parameter::get -package_id [ad_conn package_id] -parameter "PatchesP" -default 1] @@ -1163,11 +1154,11 @@ set workflow_id [bug_tracker::bug::get_instance_workflow_id] set initial_state [workflow::fsm::get_initial_state -workflow_id $workflow_id] - set open_clause "\n and exists (select 1 - from workflow_cases cas, - workflow_case_fsm cfsm - where cas.case_id = cfsm.case_id - and cas.object_id = b.bug_id + set open_clause "\n and exists (select 1 + from workflow_cases cas, + workflow_case_fsm cfsm + where cas.case_id = cfsm.case_id + and cas.object_id = b.bug_id and cfsm.current_state = :initial_state)" } else { set open_clause "" @@ -1191,11 +1182,10 @@ if { [llength $bug_list] == 0} { return "" } else { - + foreach bug_item $bug_list { - set bug_number [lindex $bug_item 1] - set bug_summary [lindex $bug_item 0] + lassign $bug_item bug_summary bug_number set unmap_url [export_vars -base unmap-patch-from-bug -url { patch_number bug_number } ] if { $write_or_submitter_p } { @@ -1204,12 +1194,12 @@ set unmap_link "" } lappend bug_link_list "$bug_summary $unmap_link" - } + } if { [llength $bug_link_list] != 0 } { set bugs_string [join $bug_link_list "
"] } else { - set bugs_name [bug_tracker::conn bugs] + set bugs_name [bug_tracker::conn bugs] set bugs_string [_ bug-tracker.No_Bugs] } @@ -1227,17 +1217,17 @@ open { set status_where_clause "and bt_patches.status = :show_patch_status" } - default { + default { set status_where_clause "" } } db_foreach get_patches_for_bug {} { - + set status_indicator [ad_decode $show_patch_status "all" "($status)" ""] lappend patch_list "[ns_quotehtml $summary] $status_indicator" - } if_no_rows { - set patches_name [bug_tracker::conn patches] + } if_no_rows { + set patches_name [bug_tracker::conn patches] set patches_string [_ bug-tracker.No_patches] } @@ -1252,7 +1242,7 @@ {-patch_number:required} } { set package_id [ad_conn package_id] - return [db_string patch_submitter_id {}] + return [db_string patch_submitter_id {}] } ad_proc bug_tracker::update_patch_status { @@ -1264,10 +1254,10 @@ } ad_proc bug_tracker::get_uploaded_patch_file_content { - + } { set patch_file [ns_queryget patch_file] - + if { $patch_file eq "" } { # No patch file was uploaded return "" @@ -1323,22 +1313,22 @@ } { if {![db_0or1row already_there {select 1 from bt_projects where project_id = :project_id} ] } { - if {[db_0or1row instance_info { *SQL* } ]} { - set folder_id [content::folder::new -name "bug_tracker_$project_id" \ + if {[db_0or1row instance_info { *SQL* } ]} { + set folder_id [content::folder::new -name "bug_tracker_$project_id" \ -package_id $project_id \ -parent_id $project_id \ -context_id $project_id] - content::folder::register_content_type -folder_id $folder_id -content_type {bt_bug_revision} -include_subtypes t + content::folder::register_content_type -folder_id $folder_id -content_type {bt_bug_revision} -include_subtypes t content::folder::register_content_type -folder_id $folder_id -content_type "content_revision" content::folder::register_content_type -folder_id $folder_id -content_type "image" - - set keyword_id [content::keyword::new -heading "$instance_name"] - - # Inserts into bt_projects - set component_id [db_nextval acs_object_id_seq] - db_dml bt_projects_insert {} - db_dml bt_components_insert {} - } + + set keyword_id [content::keyword::new -heading "$instance_name"] + + # Inserts into bt_projects + set component_id [db_nextval acs_object_id_seq] + db_dml bt_projects_insert {} + db_dml bt_components_insert {} + } } } @@ -1369,7 +1359,7 @@ -package_id $package_id \ -user_id $user_id \ -admin_p $admin_p \ - -user_bugs_only_p $user_bugs_only_p]] + -user_bugs_only_p $user_bugs_only_p]] } ad_proc bug_tracker::assignee_get_filter_data_not_cached { @@ -1453,7 +1443,7 @@ # ##### -ad_proc bug_tracker::related_files_p {} { +ad_proc bug_tracker::related_files_p {} { Is the related files submission feature turned on? } { return [parameter::get -package_id [ad_conn package_id] -parameter "RelatedFilesP" -default 1] @@ -1477,24 +1467,24 @@ set new_version_url [export_vars -base "related-file-update" {bug_id related_object_id return_url}] if { ( $related_creation_user == $user_id ) || $admin_p } { set extra_actions [subst { | - [_ bug-tracker.upload_new_version] | - [_ bug-tracker.delete] - }] + [_ bug-tracker.upload_new_version] | + [_ bug-tracker.delete] + }] } else { set extra_actions "" } lappend related_files_list [subst {$related_title - [_ bug-tracker.download] | - [_ bug-tracker.properties]$extra_actions - }] - } if_no_rows { + [_ bug-tracker.download] | + [_ bug-tracker.properties]$extra_actions + }] + } if_no_rows { set related_files_string [_ bug-tracker.No_related_files] } - + if { [llength $related_files_list] != 0 } { set related_files_string [join $related_files_list "
"] } - + return $related_files_string } @@ -1504,7 +1494,7 @@ # ##### -ad_proc bug_tracker::related_files_p {} { +ad_proc bug_tracker::related_files_p {} { Is the related files submission feature turned on? } { return [parameter::get -package_id [ad_conn package_id] -parameter "RelatedFilesP" -default 1] @@ -1528,24 +1518,24 @@ set new_version_url [export_vars -base "related-file-update" {bug_id related_object_id return_url}] if { ( $related_creation_user == $user_id ) || $admin_p } { set extra_actions [subst { | - upload new version | - delete - }] + upload new version | + delete + }] } else { set extra_actions "" } lappend related_files_list [subst {$related_title - download | - properties$extra_actions - }] - } if_no_rows { + download | + properties$extra_actions + }] + } if_no_rows { set related_files_string [_ bug-tracker.No_related_files] } - + if { [llength $related_files_list] != 0 } { set related_files_string [join $related_files_list "
"] } - + return $related_files_string } @@ -1571,18 +1561,18 @@ set all_users [db_list get_all_users {}] if {$all_bugs_p} { set bug_ids [db_list get_all_bugs {}] - foreach user_id $all_users { - foreach bug_id $bug_ids { - bug_tracker::inherit -bug_id $bug_id -party_id $user_id - } - } + foreach user_id $all_users { + foreach bug_id $bug_ids { + bug_tracker::inherit -bug_id $bug_id -party_id $user_id + } + } } elseif {$user_bugs_p} { foreach user_id $all_users { set bug_ids [db_list get_user_bugs {}] foreach bug_id $bug_ids { bug_tracker::grant_direct_read_permission -bug_id $bug_id -party_id $user_id } - } + } } } Index: openacs-4/packages/general-comments/www/file-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/general-comments/www/file-add-2.tcl,v diff -u -N -r1.9 -r1.10 --- openacs-4/packages/general-comments/www/file-add-2.tcl 7 Aug 2017 23:48:12 -0000 1.9 +++ openacs-4/packages/general-comments/www/file-add-2.tcl 24 Apr 2018 16:13:07 -0000 1.10 @@ -23,7 +23,7 @@ allow_file_attachments { set allow_files_p [parameter::get -parameter AllowFileAttachmentsP -default {t}] if { $allow_files_p != "t" } { - ad_complain "[_ general-comments.lt_Attaching_files_to_co]" + ad_complain "[_ general-comments.lt_Attaching_files_to_co]" } } check_file_size { @@ -66,11 +66,10 @@ catch { set what_aolserver_told_us [ns_gifsize $tmp_filename] } } -# the AOLserver jpegsize command has some bugs where the height comes -# through as 1 or 2 +# the AOLserver jpegsize command has some bugs where the height comes +# through as 1 or 2 if { $what_aolserver_told_us ne "" && [lindex $what_aolserver_told_us 0] > 10 && [lindex $what_aolserver_told_us 1] > 10 } { - set original_width [lindex $what_aolserver_told_us 0] - set original_height [lindex $what_aolserver_told_us 1] + lassign $what_aolserver_told_us original_width original_height } else { set original_width "" set original_height "" @@ -116,12 +115,12 @@ end; } } - + db_1row get_revision { select content_item.get_latest_revision(:attach_id) as revision_id from dual } - + # db_dml set_content { # update cr_revisions # set content = empty_blob() Index: openacs-4/packages/xml-rpc/tcl/xml-rpc-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xml-rpc/tcl/xml-rpc-procs.tcl,v diff -u -N -r1.12 -r1.13 --- openacs-4/packages/xml-rpc/tcl/xml-rpc-procs.tcl 31 Jan 2018 21:03:19 -0000 1.12 +++ openacs-4/packages/xml-rpc/tcl/xml-rpc-procs.tcl 24 Apr 2018 16:13:07 -0000 1.13 @@ -5,9 +5,9 @@ Steve Ball and help from Aaron Swartz and Jerry Asher.

- Modified by Vinod Kurup to + Modified by Vinod Kurup to

    -
  1. Use the xml abstraction procs in +
  2. Use the xml abstraction procs in packages/acs-tcl/tcl/30-xml-utils-procs.tcl (which use tDom now)
  3. Fit in OpenACS 5 framework
@@ -31,7 +31,7 @@ # ok to use this since this is a singleton package. return [apm_package_url_from_key xml-rpc] } - + ad_proc -public xmlrpc::enabled_p {} { @return whether the server is enabled } { @@ -47,7 +47,7 @@ } ad_proc -private xmlrpc::get_content {} { - There's no [ns_conn content] so this is a hack to get the content of the + There's no [ns_conn content] so this is a hack to get the content of the XML-RPC request. Taken from ns_xmlrpc. @return string - the XML request @@ -60,7 +60,7 @@ # set text [ns_getcontent -as_file false -binary false] } else { - + # (taken from aol30/modules/tcl/form.tcl) # Spool content into a temporary read/write file. # ns_openexcl can fail, since tmpnam is known not to @@ -116,7 +116,7 @@ " - + # now re-parse and then re-extract to make sure it's well formed set doc [xml_parse -persist $result] if { [catch {xml_doc_render $doc} result] } { @@ -133,9 +133,9 @@

Register a proc to be available via XML-RPC. proc_name is the name of a proc that is defined in the usual OpenACS way (i.e. ad_proc). - The proc_name is added to the xmlrpc_procs nsv array with a - value of 1. When an XML-RPC call comes in, this array is searched to see - if the proc_name has been registered. Currently, the presence of + The proc_name is added to the xmlrpc_procs nsv array with a + value of 1. When an XML-RPC call comes in, this array is searched to see + if the proc_name has been registered. Currently, the presence of proc_name in the nsv is enough to indicate that the proc can be called via XML-RPC. At some point we may allow administrators to disable procs, so we could set the value associated @@ -152,17 +152,17 @@ ad_proc -private xmlrpc::decode_value { node } { - Unpack the data in a value element. Most value elements will have a - subnode describing the datatype (e.g <string> or <int>). If no + Unpack the data in a value element. Most value elements will have a + subnode describing the datatype (e.g <string> or <int>). If no subnode is present, then we should assume the value is a string. @param node <value> node that we're decoding - @return Returns the contents of the <value> node. If the value is - a <struct> then returns the data in a TCL array. If the value is an + @return Returns the contents of the <value> node. If the value is + a <struct> then returns the data in a TCL array. If the value is an <array> then returns the data in a TCL list. } { set result "" - if {[llength [xml_node_get_children $node]]} { + if {[llength [xml_node_get_children $node]]} { # subnode is specified set subnode [xml_node_get_first_child $node] set datatype [xml_node_get_name $subnode] @@ -175,15 +175,15 @@ base64 { set result [xml_node_get_content $subnode] } - + boolean { set result [string is true [xml_node_get_content $subnode]] } dateTime.iso8601 { set result [clock scan [xml_node_get_content $subnode]] } - + struct { foreach member \ [xml_node_get_children_by_name $subnode member] { @@ -205,7 +205,7 @@ lappend result [xmlrpc::decode_value $entry] } } - + default { # we received a tag which is not a recognized datatype. ns_log notice xmlrpc::decode_value ignored type: $datatype @@ -245,13 +245,13 @@ arglist } {

- Construct an XML-RPC element. arglist is a 2-element list - which is converted to XML. The first element of arglist is + Construct an XML-RPC element. arglist is a 2-element list + which is converted to XML. The first element of arglist is the datatype and the second element is the value.

- Example: + Example: 
-    set arglist {-int 33} 
+    set arglist {-int 33}
     set result [xmlrpc::construct {} $arglist]
     set result ==> <i4>33</i4>
@@ -261,15 +261,15 @@ arrays and structs. In addition, structs and arrays can contain each other.

- Array example: + Array example: 
     set arglist {-array {
-        {-int 6682} 
-        {-boolean 0} 
-        {-text Iowa} 
-        {-double 8931.33333333} 
+        {-int 6682}
+        {-boolean 0}
+        {-text Iowa}
+        {-double 8931.33333333}
         {-date {Fri Jan 01 05:41:30 EST 1904}}}}
- 
+
     set result [xmlrpc::construct {} $arglist]
     set result ==>  <array>
                     <data>
@@ -297,10 +297,10 @@
     Struct Example:
     
     set arglist {-struct {
-        ctLeftAngleBrackets {-int 5} 
-        ctRightAngleBrackets {-int 6} 
-        ctAmpersands {-int 7} 
-        ctApostrophes {-int 0} 
+        ctLeftAngleBrackets {-int 5}
+        ctRightAngleBrackets {-int 6}
+        ctAmpersands {-int 7}
+        ctApostrophes {-int 0}
         ctQuotes {-int 3}}}
 
     set result [xmlrpc::construct {} $arglist]
@@ -356,9 +356,9 @@
     set result ""
     # list of valid options
     set options_list [list "-string" "-text" "-i4" "-int" "-integer" \
-			  "-boolean" "-double" "-date" "-binary" "-base64" \
-			  "-variable" "-structvariable" "-struct" \
-			  "-array" "-keyvalue"]
+        "-boolean" "-double" "-date" "-binary" "-base64" \
+        "-variable" "-structvariable" "-struct" \
+        "-array" "-keyvalue"]
 
     # if no valid option is specified, treat it as string
     if {[lsearch $options_list [lindex $arglist 0]] == -1} {
@@ -371,7 +371,7 @@
         return -code error \
                 "no value for option \"[lindex $arglist end]\""
     }
-    
+
     foreach {option value} $arglist {
         switch -- $option {
             -string -
@@ -411,13 +411,13 @@
                     return -code error \
                         "value \"$value\" for option \"$option\" is not a valid date ($datevalue)"
                 }
-                
+
                 set value "$datevalue"
                 append result [xmlrpc::create_context $context $value]
             }
 
             -binary -
-            -base64 {                
+            -base64 {
                 # it is up to the application to do the encoding
                 # before the data gets here
                 set value "$value"
@@ -432,10 +432,10 @@
                 append data ""
                 append result [xmlrpc::create_context $context $data]
             }
-            
+
             -struct -
             -keyvalue {
-                set data "" 
+                set data ""
                 foreach {name mvalue} $value {
                     append data "[ns_quotehtml $name]"
                     append data [xmlrpc::construct value $mvalue]
@@ -452,7 +452,7 @@
             }
         }
     }
-    
+
     return $result
 }
 
@@ -461,14 +461,14 @@
     value
 } {
     Return the value wrapped in appropriate context tags. If context is
-    a list of items, then the result will be wrapped in multiple tags. 
+    a list of items, then the result will be wrapped in multiple tags.
     Example:
     
     xmlrpc::create_context {param value} 78
     returns ==> "78"
     

 
-    @param context context to create 
+    @param context context to create
     @param value character data
     @return string with value wrapped in context tags
 } {
@@ -531,12 +531,12 @@
     -content
 } {
     The proc util_httppost doesn't work for our needs. We need to send
-    Content-type of text/xml and we need to send a Host header. So, roll 
+    Content-type of text/xml and we need to send a Host header. So, roll
     our own XML-RPC HTTP POST. Wait - lars-blogger sends out XML-RPC pings
     to weblogs.com. I'll steal the POST code from there and simplify that
     call.
-    
-    @author Vinod Kurup    
+
+    @author Vinod Kurup
 } {
     if {[incr depth] > 10} {
         return -code error "xmlrpc::httppost: Recursive redirection: $url"
@@ -550,9 +550,7 @@
     ns_set put $req_hdrs "Content-length" [string length $content]
 
     set http [ns_httpopen POST $url $req_hdrs 30 $content]
-    set rfd [lindex $http 0]
-    set wfd [lindex $http 1]
-    set rpset [lindex $http 2]
+    lassign $http rfd wfd rpset
 
     flush $wfd
     close $wfd
@@ -590,15 +588,15 @@
             global errorInfo
             return -code error -errorinfo $errorInfo $errMsg
         }
-    }    
+    }
     return $page
 }
 
 ad_proc -private xmlrpc::parse_response {xml} {
     Parse the response from a XML-RPC call.
 
     @param xml the XML response
-    @return result 
+    @return result
 } {
     set doc [xml_parse -persist $xml]
     set root [xml_doc_get_first_node $doc]
@@ -608,7 +606,7 @@
         xml_doc_free $doc
         return -code error "xmlrpc::parse_response: invalid server response - root node is not methodResponse. it's $root_name"
     }
-    
+
     set node [xml_node_get_first_child $root]
     switch -- [xml_node_get_name $node] {
         params {
@@ -660,7 +658,7 @@
         ns_log error "xmlrpc::invoke fault $result"
         return $result
     }
-    
+
     ns_log debug "xmlrpc::invoke REQUEST: $xml"
     if {[catch {set doc [xml_parse -persist $xml]} err_msg]} {
         set result [xmlrpc::fault 1 "error parsing request: $err_msg"]
@@ -676,17 +674,17 @@
 
         set arguments [list]
         set params [xml_node_get_children_by_name $data params]
-	if {$params ne ""} {
-	  foreach parameter [xml_node_get_children_by_name $params param] {
-            lappend arguments \
-                [xmlrpc::decode_value [xml_node_get_first_child $parameter]]
-	  }
-	}
+        if {$params ne ""} {
+            foreach parameter [xml_node_get_children_by_name $params param] {
+                lappend arguments \
+                    [xmlrpc::decode_value [xml_node_get_first_child $parameter]]
+            }
+        }
 
         set errno [catch {xmlrpc::invoke_method $method_name $arguments} result]
         if { $errno } {
             set result [xmlrpc::fault $errno $result]
-	    global errorInfo
+            global errorInfo
             ns_log error "xmlrpc_invoke: error in xmlrpc method REQUEST: $xml RESULT: $result\n$errorInfo"
         } else {
             # success
@@ -695,7 +693,7 @@
         }
     }
     if {[info exists doc]} {
-	xml_doc_free $doc
+        xml_doc_free $doc
     }
 
     return $result