Index: openacs-4/packages/xotcl-core/xotcl-core.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v diff -u -N -r1.106.2.46 -r1.106.2.47 --- openacs-4/packages/xotcl-core/xotcl-core.info 7 Nov 2022 13:34:34 -0000 1.106.2.46 +++ openacs-4/packages/xotcl-core/xotcl-core.info 8 Nov 2022 13:24:15 -0000 1.106.2.47 @@ -10,7 +10,7 @@ t xotcl - + Gustaf Neumann XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes) 2021-09-16 @@ -42,7 +42,7 @@ BSD-Style 2 - + Index: openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl,v diff -u -N -r1.41.2.53 -r1.41.2.54 --- openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl 8 Nov 2022 12:47:43 -0000 1.41.2.53 +++ openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl 8 Nov 2022 13:24:15 -0000 1.41.2.54 @@ -807,31 +807,9 @@ } ::xo::Package instproc get_parameter {attribute {default ""}} { - # set package_id ${:id} - # set parameter_obj [::xo::parameter get_parameter_object \ - # -parameter_name $attribute \ - # -package_id $package_id \ - # -retry false] - # set success 0 - - # if {$parameter_obj ne "" && [$parameter_obj set scope] ne "global"} { - # set value [$parameter_obj get -package_id $package_id] - # #ns_log notice "core: get_param for $attribute after GET: [$parameter_obj serialize] -> '$value'" - # #if {$value ne "" || [$parameter_obj set __success]} {return $value} - # # - # # The returned '$value' might be a value set for the actual - # # package instance, or the default for the package_parameter as - # # defined by the package parameter definition in the XML file. If - # # the value was not specified explicitly, and the provided - # # default for this command is not empty, return the provided - # # default. - # # - # if {![$parameter_obj set __success] && $value eq "" && $default ne ""} { - # return $default - # } else { - # return $value - # } - # } + # + # Get value from package parameter (per-instance) + # set value [::parameter::get -package_id ${:id} -parameter $attribute -default $default] if {$value ne $default} { return $value Index: openacs-4/packages/xotcl-core/tcl/context-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/context-procs.tcl,v diff -u -N -r1.75.2.36 -r1.75.2.37 --- openacs-4/packages/xotcl-core/tcl/context-procs.tcl 20 Aug 2022 15:19:52 -0000 1.75.2.36 +++ openacs-4/packages/xotcl-core/tcl/context-procs.tcl 8 Nov 2022 13:24:15 -0000 1.75.2.37 @@ -634,7 +634,7 @@ method raises an exception with "ad_return_complaint" and aborts the script. - @param __spec has the formname or name:valueConstraints + @param __spec has the formname or name:value_constraint @param default default value @return actual value of the query parameter } { @@ -655,33 +655,8 @@ # cases, where multiplicity is specified. This means effectively # that the default multiplicity is "0..1". # - if {[info exists constraint] - && ([string first . $constraint] > -1 || $value ne "") - } { - try { - # - # Use parseargs with "-asdict" option when it is available, - # since it does not globber the variable namespace. For legacy - # applications, lets hope that no query parameter named - # "__name" is used with a value constraint. - # - if {[::acs::icanuse "nsf::parseargs -asdict"]} { - set value [dict get \ - [nsf::parseargs -asdict ${__name}:$constraint [list $value]] \ - $__name] - } else { - nsf::parseargs ${__name}:$constraint [list $value] - set value [set $__name] - } - } on error {errorMsg} { - #ns_log notice ".... nsf::parseargs error '$errorMsg'" - if {[ns_conn isconnected] && ![info exists ::aa_test_noabort]} { - ad_return_complaint 1 [ns_quotehtml $errorMsg] - ad_script_abort - } else { - throw $::errorInfo $errorMsg - } - } + if {[info exists constraint]} { + xo::validate_parameter_constraints $__name $constraint $value } return $value } @@ -749,6 +724,54 @@ return $query } + ad_proc ::xo::validate_parameter_constraints {name constraint value} { + + Validate the provided value against the constraints. In case of + failure, return with ad_return_complaint when there is an + connection, otherwise raise an error. + + } { + # + # If we have a value-constraint, we check for empty values only in + # cases, where multiplicity is specified. This means effectively + # that the default multiplicity is "0..1". + # + if {[string first . $constraint] > -1 || $value ne ""} { + try { + # + # Use parseargs with "-asdict" option when it is available, + # since it does not globber the variable namespace. For legacy + # applications, lets hope that no query parameter named + # "__name" is used with a value constraint. + # + if {[::acs::icanuse "nsf::parseargs -asdict"]} { + # + # Newer versions will use this branch + # + set value [dict get \ + [nsf::parseargs -asdict ${name}:$constraint [list $value]] \ + $name] + } else { + # + # This is the legacy branch. nsf::parseargs might clobber + # "name", therefore save it in an highly unlikely variable + # name. + # + set { name } $name + nsf::parseargs ${name}:$constraint [list $value] + set value [set ${ name }] + } + } on error {errorMsg} { + #ns_log notice ".... nsf::parseargs error '$errorMsg'" + if {[ns_conn isconnected] && ![info exists ::aa_test_noabort]} { + ad_return_complaint 1 [ns_quotehtml $errorMsg] + ad_script_abort + } else { + throw $::errorInfo $errorMsg + } + } + } + } } ::xo::library source_dependent Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -N -r1.180.2.106 -r1.180.2.107 --- openacs-4/packages/xowiki/xowiki.info 22 Aug 2022 17:06:40 -0000 1.180.2.106 +++ openacs-4/packages/xowiki/xowiki.info 8 Nov 2022 13:24:14 -0000 1.180.2.107 @@ -10,7 +10,7 @@ t xowiki - + Gustaf Neumann A xotcl-based enterprise wiki system with multiple object types 2021-09-15 @@ -55,8 +55,8 @@ BSD-Style 2 - - + + Index: openacs-4/packages/xowiki/tcl/folder-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/folder-procs.tcl,v diff -u -N -r1.55.2.56 -r1.55.2.57 --- openacs-4/packages/xowiki/tcl/folder-procs.tcl 24 Aug 2022 16:00:51 -0000 1.55.2.56 +++ openacs-4/packages/xowiki/tcl/folder-procs.tcl 8 Nov 2022 13:24:14 -0000 1.55.2.57 @@ -269,7 +269,7 @@ #:msg "FOLDERS [$page name] package_id $package_id current_folder ${:current_folder} [${:current_folder} name]" - if {[::$package_id get_parameter "MenuBar" 0]} { + if {[::$package_id get_parameter MenuBar:boolean 0]} { # # We want a menubar. Create a menubar object, which might be Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v diff -u -N -r1.284.2.228 -r1.284.2.229 --- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 25 Oct 2022 11:10:00 -0000 1.284.2.228 +++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 8 Nov 2022 13:24:14 -0000 1.284.2.229 @@ -2086,7 +2086,7 @@ # When production_mode is set, make sure, the new file object # is not in a published state. # - if {[::$package_id get_parameter production_mode 0]} { + if {[::$package_id get_parameter production_mode:boolean 0]} { $file_object publish_status "production" } $file_object save_new {*}$save_flag Index: openacs-4/packages/xowiki/tcl/menu-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/menu-procs.tcl,v diff -u -N -r1.19.2.20 -r1.19.2.21 --- openacs-4/packages/xowiki/tcl/menu-procs.tcl 22 Aug 2022 17:06:40 -0000 1.19.2.20 +++ openacs-4/packages/xowiki/tcl/menu-procs.tcl 8 Nov 2022 13:24:14 -0000 1.19.2.21 @@ -259,7 +259,7 @@ :add_menu_item -name Package.Startpage -item [list url $folder_link] :add_menu_item -name Package.Toc -item [list url $index_link] - if {[::$package_id get_parameter "with_notifications" 1]} { + if {[::$package_id get_parameter with_notifications:boolean 1]} { if {[::xo::cc user_id] != 0} { # # notifications require login @@ -320,7 +320,7 @@ :add_menu_item -name New.File -item [list url $new_file_link] :add_menu_item -name New.Folder -item [list url $new_folder_link] - if {[::$package_id get_parameter "MenuBarSymLinks" 0]} { + if {[::$package_id get_parameter MenuBarSymLinks:boolean 0]} { # # Symlinks are configured # Index: openacs-4/packages/xowiki/tcl/package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v diff -u -N -r1.332.2.124 -r1.332.2.125 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 11 Oct 2022 13:20:49 -0000 1.332.2.124 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 8 Nov 2022 13:24:14 -0000 1.332.2.125 @@ -441,14 +441,14 @@ } regsub -all -- {[\#/\\:]} $suffix _ suffix # if subst_blank_in_name is turned on, turn spaces into _ - if {[:get_parameter subst_blank_in_name 1]} { + if {[:get_parameter subst_blank_in_name:boolean 1]} { regsub -all -- { +} $suffix "_" suffix } return [:join_name -prefix $prefix -name $suffix] } Package instproc default_locale {} { - if {[:get_parameter use_connection_locale 0]} { + if {[:get_parameter use_connection_locale:boolean 0]} { # we return the connection locale (if not connected the system locale) set locale [::xo::cc locale] } else { @@ -956,21 +956,35 @@ attribute {default ""} } { - resolves configurable parameters according to the following precedence: + Resolves configurable parameters according to the following precedence: (1) values specifically set per page {{set-parameter ...}} (2) query parameter (3) form fields from the parameter_page FormPage (4) standard OpenACS package parameter + + The specified attribute can be of the form "name:value_constraint" } { + set attribute_name $attribute + set attribute_constraint "" + regexp {^([^:]+):(.*)$} $attribute . attribute_name attribute_constraint + if {$nocache} { set value "" } else { - set value [::xo::cc get_parameter $attribute] + # + # Cached values, or values programmatically set + # + set value [::xo::cc get_parameter $attribute_name] } + if {$check_query_parameter && $value eq ""} { + # + # Query parameter handle already the notation with + # "name:valueconstraint" + # set value [string trim [:query_parameter $attribute]] } - if {$value eq "" && $attribute ne "parameter_page"} { + if {$value eq "" && $attribute_name ne "parameter_page"} { # # Try to get the parameter from the parameter_page. We have to # be very cautious here to avoid recursive calls (e.g. when @@ -979,11 +993,11 @@ # set value [:get_parameter_from_parameter_page \ -parameter_page_name [:get_parameter parameter_page ""] \ - $attribute] + $attribute_name] } if {$value eq ""} { - set value [next $attribute $default] + set value [next $attribute_name $default] } if {$type ne ""} { # @@ -999,6 +1013,9 @@ default {error "requested type unknown: $type"} } } + if {$value ne "" && $attribute_constraint ne ""} { + xo::validate_parameter_constraints $attribute_name $attribute_constraint $value + } #:log " $attribute returns '$value'" return $value } @@ -1190,7 +1207,7 @@ Package instproc show_page_order {} { - return [:get_parameter display_page_order 1] + return [:get_parameter display_page_order:boolean 1] } # @@ -2479,7 +2496,7 @@ -add_revision $add_revision] if {[info exists via_url] && [:exists_query_parameter "return_url"]} { - :returnredirect [:query_parameter "return_url" [ad_urlencode_folder_path ${:package_url}]] + :returnredirect [:query_parameter "return_url:localurl" [ad_urlencode_folder_path ${:package_url}]] } else { return $page } @@ -2924,7 +2941,7 @@ } { set object_type [:query_parameter object_type:class "::xowiki::Page"] - set autoname [:get_parameter autoname 0] + set autoname [:get_parameter autoname:boolean 0] set parent_id [${:id} query_parameter parent_id:cr_item_of_package,arg=${:id}] if {$parent_id eq ""} { set parent_id [${:id} form_parameter folder_id ${:folder_id}] @@ -3116,7 +3133,7 @@ [_ xowiki.error-delete_entries_first [list count $count]]] } } - if {[:get_parameter "with_general_comments" 0]} { + if {[:get_parameter with_general_comments:boolean 0]} { # # We have general comments. In a first step, we have to delete # these, before we are able to delete the item. Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -N -r1.542.2.165 -r1.542.2.166 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 11 Oct 2022 13:20:50 -0000 1.542.2.165 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 8 Nov 2022 13:24:14 -0000 1.542.2.166 @@ -1603,7 +1603,7 @@ :instvar name item_id package_id parent_id publish_status \ page_template instance_attributes assignee state - set useHstore [::$package_id get_parameter use_hstore 0] + set useHstore [::$package_id get_parameter use_hstore:boolean 0] set updateVars {name = :name, package_id = :package_id, parent_id = :parent_id, publish_status = :publish_status, page_template = :page_template, assignee = :assignee, @@ -1668,7 +1668,7 @@ } elseif { $colName eq "instance_attributes" && [::xo::dc has_hstore] - && [::${:package_id} get_parameter use_hstore 0] + && [::${:package_id} get_parameter use_hstore:boolean 0] } { ::xowiki::update_item_index -item_id ${:item_id} -hstore_attributes $value } @@ -3008,7 +3008,7 @@ } set tags "" - if {[::$package_id get_parameter "with_tags" 1] && + if {[::$package_id get_parameter with_tags:boolean 1] && ![:exists_query_parameter no_tags] && [::xo::cc user_id] != 0 } { @@ -3021,20 +3021,20 @@ set tag_content "" } - if {[::$package_id get_parameter "with_digg" 0] && [info exists url]} { + if {[::$package_id get_parameter with_digg:boolean 0] && [info exists url]} { if {![info exists description]} {set description [:get_description $content]} append footer "
" \ [:include [list digg -description $description -url $url]] "
\n" } - if {[::$package_id get_parameter "with_delicious" 0] && [info exists url]} { + if {[::$package_id get_parameter with_delicious:boolean 0] && [info exists url]} { if {![info exists description]} {set description [:get_description $content]} append footer "
" \ [:include [list delicious -description $description -url $url -tags $tags]] \ "
\n" } - if {[::$package_id get_parameter "with_yahoo_publisher" 0] && [info exists package_url]} { + if {[::$package_id get_parameter with_yahoo_publisher:boolean 0] && [info exists package_url]} { set publisher [::$package_id get_parameter "my_yahoo_publisher" \ [::xo::get_user_name [::xo::cc user_id]]] append footer \ @@ -3045,11 +3045,11 @@ "\n" } - if {[::$package_id get_parameter "show_page_references" 1]} { + if {[::$package_id get_parameter show_page_references:boolean 1]} { append footer [:include my-references] } - if {[::$package_id get_parameter "show_per_object_categories" 1]} { + if {[::$package_id get_parameter show_per_object_categories:boolean 1]} { set html [:include my-categories] if {$html ne ""} { append footer $html
@@ -3059,7 +3059,7 @@ append footer $tag_content - if {[::$package_id get_parameter "with_general_comments" 0] && + if {[::$package_id get_parameter with_general_comments:boolean 0] && ![:exists_query_parameter no_gc]} { append footer [:include my-general-comments] } @@ -3137,7 +3137,7 @@ # if {$with_footer && [::xo::cc get_parameter content-type text/html] eq "text/html"} { append content "
" - if {![info exists :__no_footer] && ![::xo::cc get_parameter __no_footer 0]} { + if {![info exists :__no_footer] && ![::xo::cc get_parameter __no_footer:boolean 0]} { append content [:footer] } append content "
\n" @@ -4689,7 +4689,7 @@ array set wc $h_where array set uc $h_unless set use_hstore [expr {[::xo::dc has_hstore] && - [::$package_id get_parameter use_hstore 0] + [::$package_id get_parameter use_hstore:boolean 0] }] # # Deactivating hstore optimization for now, must be further @@ -5459,7 +5459,7 @@ # #ns_log notice "----- save_data: old_name $old_name, is_new_entry [:is_new_entry $old_name] name <${:name}>" if {[:is_new_entry $old_name]} { - if {![::$package_id get_parameter production_mode 0]} { + if {![::$package_id get_parameter production_mode:boolean 0]} { set :publish_status "ready" } } Index: openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl,v diff -u -N -r1.57.2.35 -r1.57.2.36 --- openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl 11 Oct 2022 13:20:50 -0000 1.57.2.35 +++ openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl 8 Nov 2022 13:24:14 -0000 1.57.2.36 @@ -37,7 +37,7 @@ # ::xotcl::Object create tidy tidy proc clean {text} { - if {[[::xo::cc package_id] get_parameter tidy 0] + if {[[::xo::cc package_id] get_parameter tidy:boolean 0] && [info commands ::util::which] ne ""} { set tidycmd [::util::which tidy] if {$tidycmd ne ""} { @@ -139,7 +139,7 @@ # ::xotcl::Object create virus virus proc check {fns} { - if {[[::xo::cc package_id] get_parameter clamav 1] + if {[[::xo::cc package_id] get_parameter:boolean clamav 1] && [info commands ::util::which] ne ""} { set clamscanCmd [::util::which clamdscan] foreach fn $fns { @@ -220,7 +220,7 @@ ::xo::Package initialize -url /xowiki ::xowiki::hstore::update_hstore $package_id } { - if {![::xo::dc has_hstore] && [::$package_id get_parameter use_hstore 0] } { + if {![::xo::dc has_hstore] && [::$package_id get_parameter use_hstore:boolean 0] } { return 0 } @@ -276,7 +276,7 @@ ns_log notice "$package_id: ::xo::Package require took [expr {$t1-$t0}]ms" set t0 $t1 - if {![::xo::dc has_hstore] && [::$package_id get_parameter use_hstore 0] } { + if {![::xo::dc has_hstore] && [::$package_id get_parameter use_hstore:boolean 0] } { return 0 } @@ -318,7 +318,7 @@ #::xo::db::select_driver DB foreach package_id [lsort [::xowiki::Package instances -closure true]] { ::xo::Package require $package_id - if {[::$package_id get_parameter use_hstore 0] == 0} { + if {[::$package_id get_parameter use_hstore:boolean 0] == 0} { continue } ad_try { Index: openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl,v diff -u -N -r1.368.2.135 -r1.368.2.136 --- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 17 Oct 2022 14:24:11 -0000 1.368.2.135 +++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 8 Nov 2022 13:24:14 -0000 1.368.2.136 @@ -1974,7 +1974,7 @@ set view_link [::$page_package_id make_link [self] view return_url] set notification_subscribe_link "" - if {[::$context_package_id get_parameter "with_notifications" 1]} { + if {[::$context_package_id get_parameter with_notifications:boolean 1]} { if {[::xo::cc user_id] != 0} { # # Notifications are only be displayed for logged-in users. @@ -2007,20 +2007,20 @@ # # These variables can be influenced via set-parameter. # - set autoname [::$page_package_id get_parameter autoname 0] + set autoname [::$page_package_id get_parameter autoname:boolean 0] # # Setup top includeletes and footers. # set footer [:htmlFooter -content $content] set top_includelets "" - set vp [string trim [::$context_package_id get_parameter "top_includelet" ""]] + set vp [string trim [::$context_package_id get_parameter top_includelet ""]] if {$vp ne "" && $vp ne "none"} { set top_includelets [:include $vp] } - if {[::$context_package_id get_parameter "MenuBar" 0]} { + if {[::$context_package_id get_parameter MenuBar:boolean 0]} { # # When a "MenuBar" is used, it might contain folder-specific # content. Therefore, we have to compute the tree. The resulting @@ -2042,15 +2042,15 @@ } } - if {[::$context_package_id get_parameter "with_user_tracking" 1]} { + if {[::$context_package_id get_parameter with_user_tracking:boolean 1]} { :record_last_visited } # # Deal with the views package (many thanks to Malte for this # snippet!) # - if {[::$context_package_id get_parameter with_views_package_if_available 1] + if {[::$context_package_id get_parameter with_views_package_if_available:boolean 1] && [info commands ::views::record_view] ne ""} { views::record_view -object_id ${:item_id} -viewer_id [::xo::cc user_id] array set views_data [views::get -object_id ${:item_id}] @@ -2062,7 +2062,7 @@ #:log "--after notifications [info exists notification_image]" - set master [::$context_package_id get_parameter "master" 1] + set master [::$context_package_id get_parameter master:boolean 1] if {![string is boolean -strict $master]} { ad_return_complaint 1 "value of master is not boolean" ad_script_abort @@ -2078,7 +2078,7 @@ # We could offer a user to translate the current page to his preferred language # # set create_in_req_locale_link "" - # if {[::$context_package_id get_parameter use_connection_locale 0]} { + # if {[::$context_package_id get_parameter use_connection_locale:boolean 0]} { # $context_package_id get_lang_and_name -path [::$context_package_id set object] req_lang req_local_name # set default_lang [::$page_package_id default_language] # if {$req_lang ne $default_lang} { @@ -2093,7 +2093,7 @@ # } #:log "--after context delete_link=$delete_link " - #set template [::$context_package_id get_parameter "template" ""] + #set template [::$context_package_id get_parameter template ""] set template "" set page [self]