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 -r1.368 -r1.369 --- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 5 Feb 2019 18:16:53 -0000 1.368 +++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 3 Sep 2024 15:37:55 -0000 1.369 @@ -17,139 +17,230 @@ # # Externally callable method: bulk-delete # - Page instproc www-bulk-delete {} { + Page ad_instproc www-bulk-delete {} { + + This web-callable method performs a bulk delete based on the + object names provided by the form-variable "objects" and refresh + then the caller page. This method is e.g. called by the + folder-procs. + + By passing the "instantiate_p" one can decide whether each item + should be instantiated (useful when the delete logic from the + whole item ancestry is required), or if we will rely on the + cheaper deletion at the package level. The default is false. + + } { ::security::csrf::validate if {![:exists_form_parameter "objects"]} { :msg "nothing to delete" } - # By default we resolve object names from this object... - set parent_id ${:item_id} - set root_folder_id [${:package_id} folder_id] - if {${:parent_id} == $root_folder_id} { - # ...unless we realize this is the package index page. In this - # case we resolve based on the root folder (this happens e.g. in - # the table of contents for xowf). - set index_name [${:package_id} get_parameter index_page index] - ${:package_id} get_lang_and_name -name $index_name lang stripped_name - set index_item_id [::xo::db::CrClass lookup \ - -name ${lang}:${stripped_name} \ - -parent_id $root_folder_id] - if {${:item_id} == $index_item_id} { - set parent_id ${:parent_id} + set instantiate_p [:form_parameter instantiate_p:boolean false] + + set item_ids [:get_ids_for_bulk_actions [:form_parameter objects:int32,0..n]] + foreach item_id $item_ids { + :log "bulk-delete: DELETE item_id $item_id" + if {$instantiate_p} { + set i [::xo::db::CrClass get_instance_from_db -item_id $item_id] + $i www-delete + } else { + ${:package_id} www-delete -item_id $item_id } } - - foreach page_name [:form_parameter objects] { - set item_id [::xo::db::CrClass lookup -name $page_name -parent_id $parent_id] - :log "bulk-delete: DELETE $page_name in folder ${:name}-> $item_id" - ${:package_id} www-delete -item_id $item_id - } - ${:package_id} returnredirect . + :return_redirect_without_params } # # Externally callable method: clipboard-add # - Page instproc www-clipboard-add {} { - if {![:exists_form_parameter "objects"]} { + Page ad_instproc www-clipboard-add {} { + + This web-callable method adds elements to the clipboard based on + the names provided by the form variable "objects". The objects are + resolved below the current object, which is treated as containing + folder. + + After adding elements to the clipboard, redirect either to the + return_url of the calling page. + + } { + if {![:exists_form_parameter "objects"] && [ns_conn method] eq "POST"} { :msg "nothing to copy" } - set ids [list] - foreach page_name [:form_parameter objects] { - # the page_name is the name exactly as stored in the content repository - set item_id [::xo::db::CrClass lookup -name $page_name -parent_id ${:item_id}] - if {$item_id == 0} { - # - # When the pasted item was from a child-resources includelet - # included on e.g. a plain page. We look for a sibling. - # - set item_id [::xo::db::CrClass lookup -name $page_name -parent_id ${:parent_id}] - } - #:msg "want to copy $page_name // $item_id" - if {$item_id ne 0} {lappend ids $item_id} + + ::xowiki::clipboard add [:get_ids_for_bulk_actions [:form_parameter objects:int32,0..n]] + # + # When called via AJAX, we have reason to make a redirect. + # + if {[ns_set iget [ns_conn headers] "X-Requested-With"] eq "XMLHttpRequest"} { + ns_log notice "HEADERS: got X-Requested-With" + return OK + } else { + #ns_log notice "HEADERS: no X-Requested-With" + :return_redirect_without_params } - ::xowiki::clipboard add $ids - ${:package_id} returnredirect [:query_parameter "return_url" [::xo::cc url]] } # # Externally callable method: clipboard-clear # - Page instproc www-clipboard-clear {} { + Page ad_instproc www-clipboard-clear {} { + + This web-callable method clears the clibpboard contents. Finally + redirect either to the return_url of the calling page. + + } { ::xowiki::clipboard clear - ${:package_id} returnredirect [:query_parameter "return_url" [::xo::cc url]] + :return_redirect_without_params } # # Externally callable method: clipboard-content # - Page instproc www-clipboard-content {} { + Page ad_instproc www-clipboard-content {} { + + This web-callable method displays the content of the clipboard. + Finally redirect either to the return_url of the calling page. + + } { set clipboard [::xowiki::clipboard get] if {$clipboard eq ""} { util_user_message -message "Clipboard empty" } else { foreach item_id $clipboard { if {[::xo::db::CrClass get_instance_from_db -item_id $item_id] ne ""} { - util_user_message -message [$item_id pretty_link] + util_user_message -message [::$item_id pretty_link] } else { util_user_message -message "item $item_id deleted" } } } - ${:package_id} returnredirect [:query_parameter "return_url" [::xo::cc url]] + :return_redirect_without_params } # # Externally callable method: clipboard-copy # - Page instproc www-clipboard-copy {} { - set package_id ${:package_id} + Page ad_instproc www-clipboard-copy {} { + + This web-callable method copies the content of the clipboard to + the current folder. + + After copying the elements from the clipboard, redirect either + to the return_url of the calling page. + + } { set clipboard [::xowiki::clipboard get] set item_ids [::xowiki::exporter include_needed_objects $clipboard] set content [::xowiki::exporter marshall_all -mode copy $item_ids] + ad_try { namespace eval ::xo::import $content } on error {errMsg} { :msg "Error: $errMsg\n$::errorInfo" return } set folder_id [expr {[:is_folder_page] ? ${:item_id} : ${:parent_id}}] - set msg [$package_id import -replace 0 -create_user_ids 1 \ + set msg [::${:package_id} import -replace 0 -create_user_ids 1 \ -parent_id $folder_id -objects $item_ids] util_user_message -html -message $msg ::xowiki::clipboard clear - ::$package_id returnredirect [:query_parameter "return_url" [::xo::cc url]] + :return_redirect_without_params } # # Externally callable method: clipboard-export # - Page instproc www-clipboard-export {} { + Page ad_instproc www-clipboard-export {} { + + This web-callable method exports the content of the clipboard in + form of an xowiki dump. Then clear the clipboard and stop the + script. + + } { set clipboard [::xowiki::clipboard get] ::xowiki::exporter export $clipboard ns_conn close ::xowiki::clipboard clear ad_script_abort - #${:package_id} returnredirect [:query_parameter "return_url" [::xo::cc url]] } + Page instproc return_redirect_without_params {} { + # + # Return to [xo::cc url], the current URL without query + # parameters. + # + ::${:package_id} returnredirect \ + [:query_parameter return_url:localurl [ad_urlencode_folder_path [::xo::cc url]]] + } + # + # Externally callable method: duplicate + # + Page ad_instproc www-duplicate {} { + + This web-callable method duplicated the current object. It uses the + same mechanisms as the clipboard-copy operation. + + After adding elements to the clipboard, redirect either to the + return_url of the calling page (as handled by www-clipboard-copy) + + } { + ::xowiki::clipboard clear + ::xowiki::clipboard add [list ${:item_id}] + + if {![regexp {^(.*[-]copy-)\d+} ${:name} . stem]} { + set stem ${:name}-copy- + } + set new_name [::xowiki::autoname new -name $stem -parent_id ${:package_id}] + set old_name ${:name} + + ad_try { + set :name $new_name + # + # Call whatever clipboard-copy is doing.... + # + :www-clipboard-copy + + } finally { + # + # Restore the actual object + # + set :name $old_name + # + # To be on the save side, flush the cache + # + ::xo::xotcl_object_cache flush ${:item_id} + } + } + + # # Externally callable method: create-new # - Page instproc www-create-new { + Page ad_instproc www-create-new { {-parent_id 0} {-view_method edit} {-name ""} {-nls_language ""} {-publish_status ""} } { + + This web-callable method creates a new page, typically an instance + of a form page. The method accesses several form variables such as + "__form_redirect", "__text_to_html", "last_page_id", "name", + "nls_language", "package_id", "package_instance", "page_order", + "parent_id", "publish_status", "source_item_id", "title" + + The call redirects either to the "__form_redirect" or to the + created page. + + } { set original_package_id ${:package_id} if {[:exists_query_parameter "package_instance"]} { - set package_instance [:query_parameter "package_instance"] + set package_instance [:query_parameter package_instance:localurl] # # Initialize the target package and set the variable package_id. # @@ -159,18 +250,31 @@ -actual_query "" } on error {errorMsg} { ns_log error "Package initialize: $errorMsg\n$::errorInfo" - return [$original_package_id error_msg \ + return [::$original_package_id error_msg \ "Page '${:name}' invalid provided package instance=$package_instance

$errorMsg

"] } } # - # collect some default values from query parameters + # Collect some default values from query parameters. # - set default_variables [list] - foreach key {name title page_order last_page_id nls_language} { + set default_variables {} + # + # The value for "name" is validated later, and requires the type + # of the object. Different names are allowed for files, folders + # and other wiki pages. + # + foreach name_and_spec [list \ + name \ + title \ + page_order:graph \ + last_page_id:int32 \ + nls_language:oneof,arg=[join [lang::system::get_locales] |] \ + ] { + set p [string first : $name_and_spec] + set key [expr {$p > -1 ? [string range $name_and_spec 0 $p-1] : $name_and_spec}] if {[:exists_query_parameter $key]} { - lappend default_variables $key [:query_parameter $key] + lappend default_variables $key [:query_parameter $name_and_spec] } } @@ -182,7 +286,7 @@ # We should probably allow as well controlling auto-naming and # and prohibit empty postings. - set text_to_html [:form_parameter "__text_to_html" ""] + set text_to_html [:form_parameter __text_to_html:0..n ""] foreach key {_text _name} { if {[:exists_form_parameter $key]} { set __value [:form_parameter $key] @@ -196,7 +300,7 @@ } } - # load the instance attributes from the form parameters + # Load the instance attributes from the form parameters set instance_attributes [list] foreach {_att _value} [::xo::cc get_all_form_parameter] { if {[string match _* $_att]} continue @@ -212,19 +316,58 @@ # parent_id has priority over the other measures to obtain it. # if {$parent_id == 0} { - if {![info exists :parent_id]} {:parent_id [${:package_id} folder_id]} - set fp_parent_id [:form_parameter "parent_id" [:query_parameter "parent_id" ${:parent_id}]] + if {![info exists :parent_id]} { + set :parent_id [::${:package_id} folder_id] + } + set fp_parent_id [:form_parameter parent_id:int32 [:query_parameter parent_id:int32 ${:parent_id}]] } else { set fp_parent_id $parent_id } + # + # Allow only inserts to own package. + # + if {![::xo::db::CrClass id_belongs_to_package -item_id $fp_parent_id -package_id ${:package_id}]} { + ad_return_complaint 1 "invalid parent_id" + ad_script_abort + } + # In case the Form is inherited and package_id was not specified, we # use the actual package_id. - set fp_package_id [:form_parameter "package_id" [:query_parameter "package_id" ${:package_id}]] + set fp_package_id [:form_parameter package_id:int32 [:query_parameter package_id:int32 ${:package_id}]] + # + # Handling publish_status. When the publish_status is provided via + # query parameter, this has the highest priority. Otherwise use + # the publish_status according to the production_mode. We control + # this here explicitly, since when "name" is provided via query + # variable, the default production/ready selection fails, and we + # have to set the publish_status manually (see issue #3380). + # if {$publish_status eq ""} { - set publish_status [:query_parameter "publish_status" ""] + set publish_status [:query_parameter publish_status:wordchar ""] } + if {$publish_status eq "" && [:exists_query_parameter name]} { + if {[::${:package_id} get_parameter production_mode:boolean 0]} { + set publish_status "production" + } else { + set publish_status "ready" + } + #:log "FINAL publish_status $publish_status" + } + # + # Provide "p.source" hook to configure pages by copying variables + # from other pages (e.g. sitewide pages) + # + set source_item_id 0 + if {[:exists_query_parameter p.source]} { + set source_page [:query_parameter p.source:token] + set source_item_id [::${:package_id} lookup -use_site_wide_pages true -name $source_page] + } + if {$source_item_id == 0} { + set source_item_id [:query_parameter source_item_id:int32 ""] + } + ::xo::Package require $fp_package_id set f [:create_form_page_instance \ -name $name \ @@ -233,16 +376,31 @@ -package_id $fp_package_id \ -default_variables $default_variables \ -instance_attributes $instance_attributes \ - -source_item_id [:query_parameter source_item_id ""]] + -source_item_id $source_item_id] - if {$publish_status ne "" && $publish_status in {"production" "ready" "live" "expired"}} { + if {$publish_status ne "" + && $publish_status in {"production" "ready" "live" "expired"} + } { $f publish_status $publish_status } + # + # Provide "p.configure" hook to programmatically configure pages + # + if {[:exists_query_parameter p.configure]} { + set configure_method [:query_parameter p.configure:wordchar] + if {[$f procsearch configure_page=$configure_method] ne ""} { + #ns_log notice "call [$f procsearch configure_page=$configure_method] // [$f info class]" + $f configure_page=$configure_method $name + } else { + ns_log notice "cannot find configure_page=$configure_method on [$f info precedence]" + } + } + if {$name eq ""} { $f save_new } else { - set id [$fp_package_id lookup -parent_id $fp_parent_id -name $name] + set id [::$fp_package_id lookup -parent_id $fp_parent_id -name $name] if {$id == 0} { $f save_new } else { @@ -252,15 +410,34 @@ $f save } } + $f notification_notify - foreach var {return_url template_file title detail_link text} { - if {[:exists_query_parameter $var]} { - set $var [:query_parameter $var] + foreach name_and_spec { + return_url:localurl + template_file + title + detail_link:localurl + text + } { + set p [string first : $name_and_spec] + set key [expr {$p > -1 ? [string range $name_and_spec 0 $p-1] : $name_and_spec}] + if {[:exists_query_parameter $key]} { + set $key [:query_parameter $name_and_spec] + :log "set instance var from query param '$key' -> '[set $key]'" } } - set form_redirect [:form_parameter "__form_redirect" ""] + if {[info exists template_file]} { + # + # strip the leading "/" added by ns_normalizepath. + # + # TODO: check use-cases, with the restricted case actually still + # makes sense. + # + set template_file [$fp_package_id normalizepath $template_file] + } + set form_redirect [:form_parameter __form_redirect:0..n ""] if {$form_redirect eq ""} { set form_redirect [$f pretty_link -query [export_vars { {m $view_method} return_url template_file title detail_link text @@ -274,12 +451,17 @@ # Externally callable method: create-or-use # - Page instproc www-create-or-use { + Page ad_instproc www-create-or-use { {-parent_id 0} {-view_method edit} {-name ""} {-nls_language ""} } { + + This web-callable method calls www-create-new, unless overloaded + from some other package, as done e.g. by xowf. + + } { # can be overloaded :www-create-new \ -parent_id $parent_id -view_method $view_method \ @@ -290,7 +472,12 @@ # Externally callable method: csv-dump # - Page instproc www-csv-dump {} { + Page ad_instproc www-csv-dump {} { + + This web-callable method produces a CSV dump based on the + includelet "form-usages". + + } { if {![:is_form]} { error "not called on a form" } @@ -302,9 +489,11 @@ foreach i [$items children] {array set vars [$i set instance_attributes]} array set vars [list _name 1 _last_modified 1 _creation_user 1] set attributes [lsort -dictionary [array names vars]] - # make sure, we the includelet honors the cvs generation + # + # Make sure, we the includelet honors the CSV generation + # set includelet_key name:form-usages,form_item_ids:$form_item_id,field_names:[join $attributes " "], - ::xo::cc set queryparm(includelet_key) $includelet_key + ::xo::cc set queryparm(includelet_key) [ns_base64urlencode $includelet_key] # call the includelet :www-view [:include [list form-usages -field_names $attributes \ -extra_form_constraints _creation_user:numeric,format=%d \ @@ -314,42 +503,67 @@ # # Externally callable method: use-template # - PageInstance instproc www-use-template {} { - set package_id ${:package_id} + PageInstance ad_instproc www-use-template {} { + + This web-callable method can be used to change the "template" of a + PageInstance. The caller provides the "form" as query parameter + which should be used in future for handling the instance + parameters of the PageInstance. + + This method can be as well be used for changing the associated + workflow of a workflow instance. + + } { set formName [:query_parameter "form" ""] if {$formName eq ""} { error "no form specified" } - $package_id get_lang_and_name -default_lang [::xo::cc lang] -path $formName lang stripped_url - array set "" [$package_id item_ref -default_lang $lang -parent_id [$package_id folder_id] $formName] - if {$(item_id) == 0} { error "cannot lookup page $formName" } - ::xo::db::CrClass get_instance_from_db -item_id $(item_id) - if {[info commands ::$(item_id)] eq "" - || "::xowiki::PageTemplate" ni [$(item_id) info precedence]} { + ::${:package_id} get_lang_and_name -default_lang [::xo::cc lang] -path $formName lang stripped_url + set d [::${:package_id} item_ref -default_lang $lang -parent_id [::${:package_id} folder_id] $formName] + set item_id [dict get $d item_id] + if {$item_id == 0} { + error "cannot lookup page $formName" + } + ::xo::db::CrClass get_instance_from_db -item_id $item_id + if {![nsf::is object ::$item_id] + || "::xowiki::PageTemplate" ni [::$item_id info precedence]} { error "OK $formName is not suited to be used as template. Should be a Form!" } - if {[:page_template] == $(item_id)} { - :msg "old page_template $(item_id) is already the same as the new one" + if {${:page_template} == $item_id} { + :msg "old page_template $item_id is already the same as the new one" } else { - set msg "change template_id [:page_template] to $(item_id)" - :page_template $(item_id) + set msg "change template_id ${:page_template} to $item_id" + :page_template $item_id :save - :msg "ok $msg" + #:msg "ok $msg" } - $package_id returnredirect [::xo::cc url] + ::${:package_id} returnredirect [ad_return_url] } # # Externally callable method: delete # - Page instproc www-delete {} { + Page ad_instproc www-delete {-return_url} { + + This web-callable method deletes a page via the delete + method of the package. + + } { + set returnUrlOpt [expr {[info exists return_url] ? [list -return_url $return_url] : ""}] + # delete always via package - ${:package_id} www-delete -item_id ${:item_id} -name ${:name} + ${:package_id} www-delete -item_id ${:item_id} -name ${:name} {*}$returnUrlOpt } - PageTemplate instproc www-delete {} { + PageTemplate ad_instproc www-delete {-return_url} { + + This web-callable method deletes a page via the delete method + of the package. This method checks first, if there exists still + instances of this page (depending on it). + + } { set count [:count_usages -publish_status all] #:msg count=$count if {$count > 0} { @@ -368,23 +582,31 @@ # Externally callable method: delete-revision # - Page instproc www-delete-revision {} { + Page ad_instproc www-delete-revision {} { + + This web-callable method deletes a single revision of a Page, + which is actually performed by the "delete_revision" method of the + package, which is responsible for caching. + + Since we instantiate the Page based on the "revision_id" query + parameter, it is sufficient to delete here just based on the + current instance variable of the revision_id. + + } { set item_id ${:item_id} - set package_id ${:package_id} - ::xo::dc 1row get_revision { + ::xo::dc 1row -prepare integer get_revision { select latest_revision,live_revision from cr_items where item_id = :item_id } + # do real deletion via package - $package_id delete_revision -revision_id ${:revision_id} -item_id $item_id - # Take care about UI specific stuff.... - set redirect [:query_parameter "return_url" \ - [export_vars -base [$package_id url] {{m revisions}}]] + ${:package_id} delete_revision -revision_id ${:revision_id} -item_id $item_id + if {$live_revision == ${:revision_id}} { # latest revision might have changed by delete_revision, so we have to fetch here xo::dc 1row -prepare integer get_revision {select latest_revision from cr_items where item_id = :item_id} if {$latest_revision eq ""} { # we are out of luck, this was the final revision, delete the item - $package_id delete -name ${:name} -item_id $item_id + ${:package_id} delete -name ${:name} -item_id $item_id } else { # Fetch fresh instance from db so that we have actual values # from the latest revision for e.g. the update of the @@ -395,32 +617,39 @@ } if {$latest_revision ne ""} { # otherwise, "delete" did already the redirect - ::$package_id returnredirect [:query_parameter "return_url" \ - [export_vars -base [$package_id url] {{m revisions}}]] + ${:package_id} returnredirect [:query_parameter return_url:localurl \ + [export_vars -base [${:package_id} url] {{m revisions}}]] } } # # Externally callable method: diff # - Page instproc www-diff {} { + Page ad_instproc www-diff {} { - set compare_id [:query_parameter "compare_revision_id" 0] + This web-callable method produces a "diff" of two pages based on + the current page and the revision_id provided as query parameter + by "compare_revision_id". We can choose here between the more + fancy "::util::html_diff" and a plain text diff. The latter is + used, when the query variable "plain_text_diff" is provided, or + when the fancy diff raises an exception. + + } { + + set compare_id [:query_parameter compare_revision_id:int32 0] if {$compare_id == 0} { return "" } - ::xo::Page requireCSS urn:ad:css:xowiki + ::xo::Page requireCSS urn:ad:css:xowiki-[::xowiki::CSS toolkit] set my_page [::xowiki::Package instantiate_page_from_id -revision_id ${:revision_id}] - $my_page volatile ad_try { set html1 [$my_page render] } on error {errorMsg} { set html1 "Error rendering ${:revision_id}: $errorMsg" } - set text1 [ad_html_text_convert -from text/html -to text/plain -- $html1] set user1 [::xo::get_user_name [$my_page set creation_user]] set time1 [$my_page set creation_date] set revision_id1 [$my_page set revision_id] @@ -435,7 +664,6 @@ } on error {errorMsg} { set html2 "Error rendering $compare_id: $errorMsg" } - set text2 [ad_html_text_convert -from text/html -to text/plain -- $html2] set user2 [::xo::get_user_name [$other_page set creation_user]] set time2 [$other_page set creation_date] set revision_id2 [$other_page set revision_id] @@ -444,14 +672,27 @@ set title "Differences for ${:name}" set context [list $title] - # try util::html diff if it is available and works - ad_try { - set content [::util::html_diff -old $html2 -new $html1 -show_old_p t] - } on error {errMsg} { - # otherwise, fall back to proven text based diff - set content [::xowiki::html_diff $text2 $text1] + if {![:exists_query_parameter plain_text_diff]} { + # + # try util::html diff if it is available and works + # + ad_try { + set content [::util::html_diff -old $html2 -new $html1 -show_old_p t] + } on error {errMsg} { + ns_log notice "::util::html_diff failed on comparing page ${:name}, revisions_id ${:revision_id} and $compare_id" + } } + if {![info exists content]} { + # + # If the fist attempt failed, or the plain text based diff was + # desired, fall back to proven plain text based diff + # + set text1 [ad_html_text_convert -from text/html -to text/plain -- $html1] + set text2 [ad_html_text_convert -from text/html -to text/plain -- $html2] + set content [::xowiki::text_diff_in_html $text2 $text1] + } + ::xo::Page set_property doc title $title array set property_doc [::xo::Page get_property doc] ::xo::Page header_stuff @@ -462,16 +703,17 @@ } } - proc html_diff {doc1 doc2} { + ad_proc -private text_diff_in_html {doc1 doc2} { + + Simple plain text based diff, used as fallback. + + } { set out "" set i 0 set j 0 - #set lines1 [split $doc1 "\n"] - #set lines2 [split $doc2 "\n"] - - regsub -all \n $doc1 "
" doc1 - regsub -all \n $doc2 "
" doc2 + regsub -all \n $doc1 "
" doc1 + regsub -all \n $doc2 "
" doc2 set lines1 [split $doc1 " "] set lines2 [split $doc2 " "] @@ -507,42 +749,75 @@ #puts "\t$j\t$m" append out "$m\n" } + return $out } # # Externally callable method: download # - File instproc www-download {} { + File ad_instproc www-download {} { + + This web-callable method downloads the file content of the current + File object. The following query parameter can be used to + influence the behavior + + @query_param filename use this query parameter as filename in the content-disposition. + @query_param geometry when used on images, the images are scaled before delivery + + } { # - # determine the delivery method - # - set use_bg_delivery [expr {![catch {ns_conn contentsentlength}] && - [info commands ::bgdelivery] ne ""}] - # # The package where the object is coming from might be different # from the package on which it is delivered. Use the latter one # with the proper delivery information. + # set package_id [::xo::cc package_id] - $package_id set mime_type ${:mime_type} - $package_id set delivery \ - [expr {$use_bg_delivery ? "ad_returnfile_background" : "ns_returnfile"}] + # + # Use always ad_returnfile_background, it is clever enough to use + # the right delivery mode in case of doubt. + # if {[:exists_query_parameter filename]} { set fn [::xo::backslash_escape \" [:query_parameter filename]] ns_set put [ns_conn outputheaders] Content-Disposition "attachment;filename=\"$fn\"" } set full_file_name [:full_file_name] + + if {![ad_file exists $full_file_name]} { + # + # This should not happen on a production system. In certain + # testing setups, a system admin might not have provided the + # full content repository. We fail more gracefully in this + # case. + # + ad_log error "The file '$full_file_name' does not exist." \ + "Maybe the content repository is (partially) missing?" + + return [::${:package_id} error_msg -status_code 500 [subst { + No file for link '[ns_quotehtml [ns_conn url]]' available.
+ Please report this to the web master of this site. + }]] + } + + ::$package_id set mime_type ${:mime_type} + ::$package_id set delivery ad_returnfile_background + #:log "--F FILE=$full_file_name // ${:mime_type}" set geometry [::xo::cc query_parameter geometry ""] - if {[string match "image/*" ${:mime_type}] && $geometry ne ""} { - if {![file isdirectory /tmp/$geometry]} { - file mkdir /tmp/$geometry + if {[string match "image/*" ${:mime_type}] + && $geometry ne "" + } { + if {![regexp {^\d*x?\d*$} $geometry]} { + error "invalid geometry $geometry" } - set scaled_image /tmp/$geometry/${:revision_id} - if {![file readable $scaled_image]} { + set tmpdir [ad_tmpdir] + if {![ad_file isdirectory $tmpdir/$geometry]} { + file mkdir $tmpdir/$geometry + } + set scaled_image $tmpdir/$geometry/${:revision_id} + if {![ad_file readable $scaled_image]} { set cmd [::util::which convert] if {$cmd ne ""} { if {![catch {exec $cmd -geometry $geometry -interlace None -sharpen 1x2 \ @@ -554,7 +829,7 @@ return $scaled_image } } - set modtime [file mtime $full_file_name] + set modtime [ad_file mtime $full_file_name] set cmptime [ns_set iget [ns_conn headers] If-Modified-Since] if {$cmptime ne ""} { if {[clock scan $cmptime] >= $modtime} { @@ -563,7 +838,7 @@ # way, ... but keep things compatible for now. # ::xo::cc set status_code 304 - $package_id set delivery ns_return + ::$package_id set delivery ns_return return "" } } @@ -593,12 +868,19 @@ # Page instproc edit_set_default_values {} { - set package_id ${:package_id} # set some default values if they are provided - foreach key {name title page_order last_page_id nls_language} { - if {[$package_id exists_query_parameter $key]} { - #:log "setting [self] set $key [$package_id query_parameter $key]" - set :$key [$package_id query_parameter $key] + foreach name_and_spec [list \ + name \ + title \ + page_order:graph \ + last_page_id:int32 \ + nls_language:oneof,arg=[join [lang::system::get_locales] |] \ + ] { + set p [string first : $name_and_spec] + set key [expr {$p > -1 ? [string range $name_and_spec 0 $p-1] : $name_and_spec}] + if {[::${:package_id} exists_query_parameter $key]} { + #:log "setting [self] set $key [::${:package_id} query_parameter $key]" + set :$key [::${:package_id} query_parameter $name_and_spec] } } } @@ -626,8 +908,7 @@ # was specified. # Page instproc changed_redirect_url {} { - set package_id ${:package_id} - if {[$package_id exists_query_parameter "return_url"]} { + if {[::${:package_id} exists_query_parameter "return_url"]} { return "" } return [:pretty_link] @@ -637,19 +918,33 @@ # Externally callable method: edit # - Page instproc www-edit { + Page ad_instproc www-edit { {-new:boolean false} {-autoname:boolean false} {-validation_errors ""} } { - :instvar package_id item_id revision_id parent_id - #:log "--edit new=$new autoname=$autoname, valudation_errors=$validation_errors, parent=${:parent_id}" + This web-callable method renders a page in "edit" mode + (i.e. provide input fields). This is the old-style edit based on + the old-style xowiki-form-procs. FormPages should be used when + possible for better user experience. + + @param new is this an edit-new operation? + @param autoname value to be passed to getFormClass + @param validation_errors ignored in this class, but used for + compatibility with FormPage.www-edit + } { + # + # We have to keep the instvar for "item_id" for the time being. + # + :instvar item_id + + #:log "--edit new=$new autoname=$autoname, validation_errors=$validation_errors, parent=${:parent_id}" :edit_set_default_values set fs_folder_id [:edit_set_file_selector_folder] - if {[$package_id exists_query_parameter "return_url"]} { - set submit_link [:query_parameter "return_url" "."] + if {[::${:package_id} exists_query_parameter "return_url"]} { + set submit_link [:query_parameter return_url:localurl] set return_url $submit_link } else { # @@ -665,28 +960,36 @@ # We have to do template mangling here; ad_form_template writes # form variables into the actual parse-level, so we have to be in - # our own level in order to access an pass these. + # our own level in order to access and pass these. + # lappend ::template::parse_level [info level] set action_vars [expr {$new ? "{edit-new 1} object_type return_url" : "{m edit} return_url"}] - #:log "--formclass=[$object_type getFormClass -data [self]] ot=$object_type" + #:log "--formclass=[$object_type getFormClass -data [self]] object_type=$object_type" # # Determine the package_id of some mounted xowiki instance to find # the directory + URL, from where the scripts called from Xinha # can be used. - if {[$package_id info class] eq "::xowiki::Package"} { - # The actual instance is a plain xowiki instance, we can use it - set folder_spec [list script_dir [$package_id package_url]] + # + if {[::${:package_id} info class] eq "::xowiki::Package"} { + # + # The actual instance is a plain xowiki instance, we can use it. + # + set folder_spec [list script_dir [::${:package_id} package_url]] } else { + # # The actual instance is not a plain xowiki instance, so, we try # to find one, where the current user has at least read # permissions. This act is required for sub-packages, which # might not have the script dir. - set first_instance_id [::xowiki::Package first_instance -party_id [::xo::cc user_id] -privilege read] + # + set first_instance_id [::xowiki::Package first_instance \ + -party_id [::xo::cc user_id] \ + -privilege read] if {$first_instance_id ne ""} { ::xowiki::Package require $first_instance_id - set folder_spec [list script_dir [$first_instance_id package_url]] + set folder_spec [list script_dir [::$first_instance_id package_url]] } } @@ -695,13 +998,17 @@ } [$object_type getFormClass -data [self]] create ::xowiki::f1 -volatile \ - -action [export_vars -base [$package_id url] $action_vars] \ + -action [export_vars -base [::${:package_id} url] $action_vars] \ -data [self] \ -folderspec $folder_spec \ -submit_link $submit_link \ -autoname $autoname #:log "form created" + # + # The variable "item_id" is hard-wired in the old-style "generate" + # method. + # if {[info exists return_url]} { ::xowiki::f1 generate -export [list [list return_url $return_url]] } else { @@ -711,50 +1018,33 @@ ::xowiki::f1 instvar edit_form_page_title context formTemplate if {[info exists item_id]} { - set rev_link [$package_id make_link [self] revisions] - set view_link [$package_id make_link [self] view] + set rev_link [::${:package_id} make_link [self] revisions] + set view_link [::${:package_id} make_link [self] view] } if {[info exists last_page_id]} { - set back_link [$package_id url] + set back_link [::${:package_id} url] } - set index_link [$package_id make_link -privilege public -link "" $package_id {} {}] - ::xo::Page set_property doc title "[$package_id instance_name] - $edit_form_page_title" + set index_link [::${:package_id} make_link -privilege public ${:package_id}] + ::xo::Page set_property doc title "[::${:package_id} instance_name] - $edit_form_page_title" array set property_doc [::xo::Page get_property doc] - set edit_tmpl [$package_id get_adp_template "edit"] - set html [$package_id return_page -adp $edit_tmpl \ + set edit_tmpl [::${:package_id} get_adp_template "edit"] + + set html [::${:package_id} return_page -adp $edit_tmpl \ -form f1 \ - -variables {item_id parent_id edit_form_page_title context formTemplate - view_link back_link rev_link index_link property_doc}] + -variables { + item_id {parent_id ${:parent_id}} + edit_form_page_title context formTemplate + view_link back_link rev_link index_link property_doc + }] template::util::lpop ::template::parse_level #:log "--edit html length [string length $html]" return $html } - FormPage instproc setCSSDefaults {} { - #:log setCSSDefaults - # check empty - if {[parameter::get_global_value -package_key xowiki -parameter PreferredCSSToolkit -default bootstrap] eq "bootstrap"} { - ::xowiki::formfield::FormField parameter { - {CSSclass form-control} - {form_item_wrapper_CSSclass form-group} - {form_widget_CSSclass ""} - {form_button_CSSclass "btn btn-default"} - {form_button_wrapper_CSSclass ""} - {form_help_text_CSSclass help-block} - } - } else { - ::xowiki::formfield::FormField parameter { - {CSSclass} - {form_widget_CSSclass form-widget} - {form_item_wrapper_CSSclass form-item-wrapper} - {form_button_CSSclass ""} - {form_button_wrapper_CSSclass form-button} - {form_help_text_CSSclass form-help-text} - } - ::xowiki::Form requireFormCSS - } + FormPage instproc -deprecated setCSSDefaults {} { + ad_log warning "deprecated method setCSSDefaults was called. The call should be removed" } FormPage instproc action_url {} { @@ -764,15 +1054,33 @@ return [:pretty_link] } - FormPage instproc www-edit { + FormPage ad_instproc extra_html_fields {} { + + Should be overloaded to provide extra content to some forms. This + method can be used to add additional (e.g. hidden) HTML input + fields to form pages. Example: + + ::html::input -type hidden -name __object_name -value [::security::parameter::signed ${:name}] + + } { + return "" + } + + FormPage ad_instproc www-edit { {-validation_errors ""} {-disable_input_fields 0} - {-view true} + {-view:boolean true} } { + + This web-callable method renders a form page in "edit" mode + (i.e. provide input fields). + + The following query parameters can be used to influene the results + "return_url", "title", "detail_link", "text", and "description". + + } { #:log "edit [self args]" - set package_id ${:package_id} - :setCSSDefaults :include_header_info -prefix form_edit if {[::xo::cc mobile]} { :include_header_info -prefix mobile @@ -784,8 +1092,11 @@ #:log anon_instances=$anon_instances set field_names [:field_names -form $form] - #:msg field_names=$field_names + #:log field_names=$field_names set form_fields [:create_form_fields $field_names] + #foreach f0 $form_fields { + # ns_log notice "... created ff [$f0 name] [$f0 info class] '[$f0 value]'" + #} if {$form eq ""} { # @@ -804,10 +1115,13 @@ # - if it is required but hidden, show it anyway # (might happen, when e.g. set via @cr_fields ... hidden) set name_field [:lookup_form_field -name _name $form_fields] + if {$anon_instances} { #$name_field config_from_spec hidden } else { - if {[$name_field istype ::xowiki::formfield::hidden] && [$name_field required] == true} { + if {[$name_field istype ::xowiki::formfield::hidden] + && [$name_field required] == true + } { $name_field config_from_spec text,required $name_field type text } @@ -817,7 +1131,7 @@ # Include _text only, if explicitly needed (in form # needed(_text))". # - if {![info exists :__field_needed(_text)]} { + if {![dict exists ${:__field_needed} _text]} { #:msg "setting text hidden" set f [:lookup_form_field -name _text $form_fields] $f config_from_spec hidden @@ -828,28 +1142,33 @@ # Disable some form-fields since these are disabled in the form # as well. # - foreach name [:form_parameter __disabled_fields] { + foreach name [:form_parameter __disabled_fields:0..n] { set f [:lookup_form_field -name $name $form_fields] - $f disabled disabled + $f set_disabled true } } #:show_fields $form_fields #:log "__form_action [:form_parameter __form_action {}]" if {[:form_parameter __form_action ""] eq "save-form-data"} { - #:log "we have to validate" # - # We have to valiate and save the form data. + # We want to save the form data, so we have to validate. # + #:log "we have to validate" + # # In case we are triggered internally, we might not have a - # a connection and therefore do not valide the csrf token - if {![$package_id exists __batch_mode]} { + # a connection. Therefore, do not validate the CSRF token. + # + if {![::${:package_id} exists __batch_mode]} { security::csrf::validate } lassign [:get_form_data $form_fields] validation_errors category_ids if {$validation_errors != 0} { + # + # We have validation errors. + # #:log "$validation_errors validation errors in $form_fields" #foreach f $form_fields { :log "$f: [$f name] '[$f set value]' err: [$f error_msg] " } # @@ -858,85 +1177,98 @@ # error messages again, but we return simply the validation # problems. # - if {[$package_id exists __batch_mode]} { + if {[::${:package_id} exists __batch_mode]} { set errors [list] foreach f $form_fields { if {[$f error_msg] ne ""} { lappend errors [list field [$f name] value [$f set value] error [$f error_msg]] } } set evaluation_errors "" - if {[$package_id exists __evaluation_error]} { - set evaluation_errors "\nEvaluation error: [$package_id set __evaluation_error]" - $package_id unset __evaluation_error + if {[::${:package_id} exists __evaluation_error]} { + set evaluation_errors "\nEvaluation error: [::${:package_id} set __evaluation_error]" + ::${:package_id} unset __evaluation_error } error "[llength $errors] validation error(s): $errors $evaluation_errors" } # # Reset the name in error cases to the original one. # - set :name [:form_parameter __object_name] + set :name [:form_parameter __object_name:signed,convert] } else { # - # we have no validation errors, so we can save the content + # We have no validation errors, so we can save the content. # :save_data \ -use_given_publish_date [expr {"_publish_date" in $field_names}] \ - [::xo::cc form_parameter __object_name ""] $category_ids + [::xo::cc form_parameter __object_name:signed,convert ""] $category_ids + # # The data might have references. Perform the rendering here to compute # the references instead on every view (which would be safer, but slower). This is # roughly the counterpart to edit_data and save_data in ad_forms. # - set content [:render -update_references true] + set content [:render -update_references all] #:log "after save refs=[expr {[info exists :references]?${:references} : {NONE}}]" - set redirect_method [:form_parameter __form_redirect_method "view"] + set redirect_method [:form_parameter __form_redirect_method:wordchar "view"] #:log "redirect_method $redirect_method" if {$redirect_method eq "__none"} { return } else { - if {$redirect_method ne "view"} {set qp "?m=$redirect_method"} {set qp ""} + if {$redirect_method ne "view"} { + set qp "?m=$redirect_method" + } else { + set qp "" + } set url [:pretty_link]$qp # # The method query_parameter uses now "::xo::cc set_parameter ...." # with highest precedence # - set return_url [$package_id query_parameter return_url $url] + set return_url [::${:package_id} query_parameter return_url:localurl $url] + #:log "${:name}: url=$url, return_url=$return_url" - $package_id returnredirect $return_url + ::${:package_id} returnredirect $return_url return } } - } elseif {[:form_parameter __form_action ""] eq "view-form-data" && ![info exists :__feedback_mode]} { + } elseif {[:form_parameter __form_action ""] eq "view-form-data" + && ![info exists :__feedback_mode] + } { # # We have nothing to save (maybe everything is read-only). Check # __feedback_mode to prevent recursive loops. # - set redirect_method [:form_parameter __form_redirect_method "view"] + set redirect_method [:form_parameter __form_redirect_method:wordchar "view"] #:log "__redirect_method=$redirect_method" return [:www-view] } else { # # Build the input form and display the current values. # + #:log "form_action is something different: <[:form_parameter __form_action {}]>" if {[:is_new_entry ${:name}]} { set :creator [::xo::get_user_name [::xo::cc user_id]] - set :nls_language [ad_conn locale] + set :nls_language [::${:package_id} default_locale] } #array set __ia ${:instance_attributes} :load_values_into_form_fields $form_fields - foreach f $form_fields {set ff([$f name]) $f } + foreach f $form_fields { + set ff([$f name]) $f + } + # # For named entries, just set the entry fields to empty, # without changing the instance variables # #:log "my is_new_entry ${:name} = [:is_new_entry ${:name}]" if {[:is_new_entry ${:name}]} { + if {$anon_instances} { set basename [::xowiki::autoname basename [${:page_template} name]] set name [::xowiki::autoname new -name $basename -parent_id ${:parent_id}] @@ -948,9 +1280,10 @@ if {![$ff(_title) istype ::xowiki::formfield::hidden]} { $ff(_title) value [$ff(_title) default] } - foreach var [list title detail_link text description] { + foreach param [list title detail_link:localurl text description] { + regexp {^([^:]+):?} $param . var if {[:exists_query_parameter $var]} { - set value [:query_parameter $var] + set value [:query_parameter $param] switch -- $var { detail_link { set f [:lookup_form_field -name $var $form_fields] @@ -976,6 +1309,20 @@ :post_process_form_fields $form_fields # + # "dom parse -html" has two problems with ADP tags like "": + # a) If the tag name contains a colon or underscore, the tag is + # treated like plain text, i.e. "<" and ">" are converted into + # HTML entities. + # b) These tags have to be closed "" is invalid. + # Several existomg ADP tags have not closing tag. + # + # Therefore, we resolve the ADP tags before parsing the text by + # tdom. There should be some framework support to do this in + # general, but until we have this, resolve this problem here locally. + # + set form [::template::adp_parse_tags [:substitute_markup $form]] + + # # The following command would be correct, but does not work due to a bug in # tdom. # set form [:regsub_eval \ @@ -985,24 +1332,24 @@ # by \x03 to avoid conflict with the input and we replace these # magic chars finally with the fields resulting from tdom. - set form [:substitute_markup $form] set form [string map [list @ \x03] $form] #:msg form=$form - dom parse -simple -html $form :doc + dom parse -html -- $form :doc ${:doc} documentElement :root if {${:root} eq ""} { error "form '$form' is not valid" } - ::require_html_procs + ::xo::require_html_procs ${:root} firstChild fcn #:msg "orig fcn $fcn, root ${:root} [${:root} nodeType] [${:root} nodeName]" set formNode [lindex [${:root} selectNodes //form] 0] if {$formNode eq ""} { :msg "no form found in page [${:page_template} name]" + ns_log notice "no form found in page [${:page_template} name]\n$form" set rootNode ${:root} $rootNode firstChild fcn } else { @@ -1018,19 +1365,20 @@ # $rootNode insertBeforeFromScript { ::html::div { - ::html::input -type hidden -name __object_name -value ${:name} + ::html::input -type hidden -name __object_name -value [::security::parameter::signed ${:name}] ::html::input -type hidden -name __form_action -value save-form-data ::html::input -type hidden -name __current_revision_id -value ${:revision_id} + :extra_html_fields ::html::CSRFToken } # # Insert automatic form fields on top. # foreach att $field_names { #if {$formgiven && ![string match _* $att]} continue - if {[info exists :__field_in_form($att)]} continue + if {[dict exists ${:__field_in_form} $att]} continue set f [:lookup_form_field -name $att $form_fields] - #:log "insert auto_field $att $f" + #:log "insert auto_field $att $f ([$f info class])" $f render_item } } $fcn @@ -1057,14 +1405,6 @@ } # - # Insert unreported errors. - # - foreach f $form_fields { - if {[$f set error_msg] ne "" && ![$f exists error_reported]} { - $f render_error_msg - } - } - # # Add a submit field(s) at bottom. # :render_form_action_buttons -CSSclass [string trim "$button_class(wym) $button_class(xinha)"] @@ -1073,7 +1413,7 @@ if {$formNode ne ""} { if {[:exists_query_parameter "return_url"]} { - set return_url [:query_parameter "return_url"] + set return_url [:query_parameter return_url:localurl] } else { # # When no return_url is specified and we edit a page different @@ -1082,12 +1422,15 @@ # object after the edit. This happens if one edits e.g. a page # through a link. # - if {[::xo::cc exists invoke_object] && [::xo::cc invoke_object] ne [self]} { - #:log "=== no return_url specified, using [::xo::cc url] or [[$package_id context] url]" + if {[::xo::cc exists invoke_object] + && [::xo::cc invoke_object] ne [self] + } { + #:log "=== no return_url specified, using [::xo::cc url] or [[::${:package_id} context] url]" set return_url [::xo::cc url] + set return_url [ad_urlencode_url $return_url] } } - set m [:form_parameter __form_redirect_method "edit"] + set m [:form_parameter __form_redirect_method:wordchar "edit"] set url [export_vars -no_base_encode -base [:action_url] {m return_url}] #:log "=== setting action <$url> for form-action my-name ${:name}" $formNode setAttribute action $url method POST role form @@ -1100,7 +1443,7 @@ # # (a) Disable explicit input fields. # - foreach f $form_fields {$f disabled 1} + foreach f $form_fields {$f set_disabled true} # # (b) Disable input in HTML-specified fields. # @@ -1119,13 +1462,39 @@ set html [${:root} asHTML] set html [:regsub_eval \ - {(^|[^\\])\x03([a-zA-Z0-9_:]+)\x03} $html \ + {(^|[^\\])\x03([[:alnum:]_:]+)\x03} $html \ {:form_field_as_html -mode edit "\\\1" "\2" $form_fields}] # # Replace unbalanced @ characters. # set html [string map [list \x03 @] $html] + # + # Handle unreported errors (in the future...). Unreported errors + # might occur, when a form-field was rendered above without + # "render_item". This can happen with inline rendering of the + # input fields where validation errors occur. Inline rendering + # happens very seldom (I know not a single occurrence in the + # wild). For such cases, one should define an extra field in the + # form with an idea, reparse the tree and insert the errors + # there. But first look, if we find a single occurrence. + # + set unprocessed {} + foreach f $form_fields { + if {[$f set error_msg] ne "" + && ![$f exists error_reported] + } { + ns_log notice "form-field [$f name] has unprocessed error msg '[$f set error_msg]'" + #$f render_error_msg + lappend unprocessed [$f name] + } + } + #ns_log notice "=============== $unprocessed unprocessed error messages" + if {[llength $unprocessed] > 0} { + ad_log warning "form has [llength $unprocessed] unprocessed " \ + "error messages in fields $unprocessed" + } + #:log "calling VIEW with HTML [string length $html]" if {$view} { :www-view $html @@ -1139,46 +1508,86 @@ # Externally callable method: file-upload # - FormPage instproc www-file-upload {} { - # - # This method is typically called via drop-zone in a POST request, - # where the FormPage is a folder (which is treated as parent object). - # + FormPage ad_instproc www-file-upload {} { + + This web-callable method can be used for uploading files using the + current object as parent object for the new content. This method + is typically called via drop-zone in a POST request, where the + FormPage is a folder (which is treated as parent object) + + } { + if {[ns_conn method] ne "POST"} { error "method should be called via POST" } - set form [ns_getform] # - # Get the uploader via query parameter. We have currently the - # following uploader classes defined (see + # Get the disposition via query parameter. We have currently the + # following disposition classes defined (see # xowiki-uploader-procs.tcl) # # - ::xowiki::UploadFile # - ::xowiki::UploadPhotoForm + # - ::xowiki::UploadFileIconified # ::security::csrf::validate - set uploader [ns_set get $form uploader File] - set uploaderClass ::xowiki::UploadFile - if {[info commands ::xowiki::Upload$uploader] ne ""} { - set uploaderClass ::xowiki::Upload$uploader + + set disposition [:query_parameter disposition:wordchar File] + + # + # Filename is sanitized. If the filename contains only invalid + # characters, "ad_sanitize_filename" might return empty, and we + # complain. + # + set fileName [ad_sanitize_filename \ + [ns_queryget name [ns_queryget upload]]] + if {[string length $fileName] == 0} { + ad_return_complaint 1 [_ acs-templating.Invalid_filename] + ad_script_abort } - set uploaderObject [$uploaderClass new \ - -file_name [ns_set get $form upload] \ - -content_type [ns_set get $form upload.content-type] \ - -tmpfile [ns_set get $form upload.tmpfile] \ - -parent_object [self]] - set result [$uploaderObject store_file] - $uploaderObject destroy + + set dispositionClass ::xowiki::UploadFile + if {[info commands ::xowiki::Upload$disposition] ne ""} { + set dispositionClass ::xowiki::Upload$disposition + } + + #ns_log notice "disposition class '$dispositionClass'" + set dispositionObject [$dispositionClass new \ + -file_name $fileName \ + -content_type [ns_queryget upload.content-type] \ + -tmpfile [ns_queryget upload.tmpfile] \ + -parent_object [self]] + set result [$dispositionObject store_file] + $dispositionObject destroy ns_return [dict get $result status_code] text/plain [dict get $result message] + ad_script_abort } + FormPage ad_instproc render_thumbnails {upload_info} { + + Renderer of the thumbnail file(s). This method is a stub to be + refined (e.g. in xowf). + + @param upload_info dict containing the "file_object" and "file_name" + @return HTML content + + } { + return "[dict get $upload_info file_name] created" + } + # # Externally callable method: toggle-modebutton # - FormPage instproc www-toggle-modebutton {} { + FormPage ad_instproc www-toggle-modebutton {} { + + AJAX called function, called via POST. The function toggles the + state of a button in the backend. The client provides the name of + the button as form field named "button". If none is provided, the + button is named as default "admin" + + } { # - # This method is typically called via modebutton in a POST request via ajax; + # Check, if this function was called via POST # if {[ns_conn method] ne "POST"} { error "method should be called via POST" @@ -1189,101 +1598,139 @@ # # ::xowiki::mode::admin # - set form [ns_getform] - set button [ns_set get $form button admin] + set button [ns_queryget button admin] ::xowiki::mode::$button toggle - #${:package_id} returnredirect [ns_set get $form return_url [::xo::cc url]] ns_return 200 text/plain ok } # # Externally callable method: list # - Page instproc www-list {} { - if {[:is_form]} { + Page ad_instproc www-list {} { + + This web-callable method provides a listing of pages. + + When the query parameter "children" is used, it returns + the children of this item via the "child-resources" includelet. + + Otherwise, when this method is called on any kind of Form, it + returns the form instances via the "form-usages" includelet. + + Otherwise, when this method is called on any kind of folder pages, + it returns the elements of this folder via the "child-resources" + includelet. + + If the above fails, it redirects to the starting page. + + } { + if {[:is_form] && ![:exists_query_parameter children]} { # # The following line is here to provide a short description for # larger form-usages (a few MB) where otherwise # "ad_html_text_convert" in Page.get_description tend to use # forever (at least in Tcl 8.5) # - set :description "form-usages for ${:name} [:title]" + set :description "form-usages for ${:name} ${:title}" return [:www-view [:include [list form-usages -form_item_id ${:item_id}]]] } - if {[:is_folder_page]} { + if {[:is_folder_page] || [:exists_query_parameter children]} { return [:www-view [:include [list child-resources -publish_status all]]] } #:msg "method list undefined for this kind of object" - ${:package_id} returnredirect [::xo::cc url] + ${:package_id} returnredirect [ad_return_url] } # # Externally callable method: make-live-revision # - Page instproc www-make-live-revision {} { - set page_id [:query_parameter "revision_id"] + Page ad_instproc www-make-live-revision {} { + + This web-callable method makes the revision specified by parameter + "revision_id" the live revision, or when this is not available, + the parameter "local_return_url". + + } { + set page_id [:query_parameter revision_id] if {[string is integer -strict $page_id]} { set revision_id $page_id } else { set revision_id ${:revision_id} } #:log "--M set_live_revision $revision_id" :set_live_revision -revision_id $revision_id - ${:package_id} returnredirect [:query_parameter "return_url" \ - [export_vars -base [${:package_id} url] {{m revisions}}]] + ${:package_id} returnredirect [${:package_id} query_parameter_return_url \ + [export_vars -base [::${:package_id} url] {{m revisions}}]] } # # Externally callable method: toggle-publish-status # - # Toggle from arbitrary states to "ready" and from "ready" to - # "production". - # + Page ad_instproc www-toggle-publish-status {-return_url} { - Page instproc www-toggle-publish-status {} { + This web-callable method toggles from "production" to "ready", and + from "ready" or "archived" to "production". + + The return_url can be passed in for cases, where some proc calls + internally this function, since update_publish_status might have + to initialize some related objects, which might modify the + return_url as well (e.g., workflows with specialized return_url + handling). + + } { + if {![info exists return_url]} { + set return_url [:query_parameter return_url:localurl [ad_return_url]] + } if {${:publish_status} ne "ready"} { set new_publish_status "ready" } else { set new_publish_status "production" } :update_publish_status $new_publish_status - ${:package_id} returnredirect [:query_parameter "return_url" [ad_return_url]] + ${:package_id} returnredirect $return_url } # # Externally callable method: popular-tags # + Page ad_instproc www-popular-tags {} { - Page instproc www-popular-tags {} { - set limit [:query_parameter "limit" 20] - set weblog_page [${:package_id} get_parameter weblog_page weblog] - set href [${:package_id} pretty_link -parent_id [${:package_id} folder_id] $weblog_page]?summary=1 + AJAX called function, returns an HTML snippet with the popular + tags. + } { + set package ::${:package_id} + set limit [:query_parameter limit:int32 20] + set weblog_page [$package get_parameter weblog_page:graph weblog] + set href [$package pretty_link -parent_id [$package folder_id] $weblog_page]?summary=1 + set entries [list] xo::dc foreach get_popular_tags \ [::xo::dc select \ -vars "count(*) as nr, tag" \ -from "xowiki_tags" \ - -where "item_id = ${:item_id}" \ + -where "item_id = [ns_dbquotevalue ${:item_id}]" \ -groupby "tag" \ -orderby "nr" \ -limit $limit] { set label [ns_quotehtml "$tag ($nr)"] lappend entries "$label" } ns_return 200 text/html "[_ xowiki.popular_tags_label]: [join $entries {, }]" + ad_script_abort } # # Externally callable method: save-attributes # Page ad_instproc www-save-attributes {} { - The method save-attributes is typically callable over the - REST interface. It allows one to save attributes of a - page without adding a new revision. + + The web-callable method save-attributes is typically callable over + the REST interface. It allows one to save attributes of a page + without adding a new revision. + } { set field_names [:field_names] set form_fields [list] @@ -1303,7 +1750,7 @@ # # We have no validation errors, so we can save the content. # - set update_without_revision [${:package_id} query_parameter replace 0] + set update_without_revision [::${:package_id} query_parameter replace:boolean 0] foreach form_field $form_fields { # @@ -1339,25 +1786,103 @@ # :save_data \ -use_given_publish_date [expr {"_publish_date" in $field_names}] \ - [::xo::cc form_parameter __object_name ""] $category_ids + [::xo::cc form_parameter __object_name:signed,convert ""] $category_ids } ${:package_id} returnredirect \ - [:query_parameter "return_url" [:pretty_link]] + [:query_parameter return_url:localurl [:pretty_link]] return } else { - # todo: handle errors in a user friendly way - :log "we have $validation_errors validation_errors" + # TODO: handle errors in a user friendly way + ns_log warning "www-save-attributes: we have $validation_errors validation_errors" } ${:package_id} returnredirect \ - [:query_parameter "return_url" [:pretty_link]] + [:query_parameter return_url:localurl [:pretty_link]] } # + # Externally callable method: autosave-attribute + # + Page ad_instproc www-autosave-attribute {} { + + The web-callable method which is a simplified version of + save-attributes, but which does NOT perform input validation, + which might be a problem in case of partial input. + + } { + + set field_names [:field_names] + #ns_log notice "[self] autosave-attribute called field-names: $field_names" + set provided_form_parameters [xo::cc get_all_form_parameter] + set keys [dict keys $provided_form_parameters] + + if {[llength $keys] == 1} { + set key [lindex $keys 0] + set value [::xo::cc form_parameter $key] + ns_log notice "[self] autosave-attribute save '$key' <$value>" + set prefix "" + regexp {^([^.]+)[.]} $key . prefix + + if {$prefix ne "" && $prefix in $field_names} { + # + # We are inside a compound field, which is saved in the instance + # attributes. + # + #ns_log notice "SAVE old ia <${:instance_attributes}>" + if {[dict exists ${:instance_attributes} $prefix]} { + set innerDict [dict get ${:instance_attributes} $prefix] + } else { + set innerDict "" + } + dict set innerDict $key $value + dict set :instance_attributes $prefix $innerDict + + #ns_log notice "SAVE new ia <${:instance_attributes}>" + set s [:find_slot instance_attributes] + :update_attribute_from_slot $s ${:instance_attributes} + ns_return 200 text/plain ok + + } elseif {$prefix eq "" && $key in $field_names} { + # + # It is a plain attribute, either from the cr-attributes + # (starting with an "_") or from the instance attributes. + # + if {[string match _* $key]} { + set s [:find_slot [string range $key 1 end]] + :update_attribute_from_slot $s $value + } else { + set s [:find_slot instance_attributes] + dict set :instance_attributes $key $value + :update_attribute_from_slot $s ${:instance_attributes} + } + ns_return 200 text/plain ok + + } else { + ns_return 404 text/plain "not ok" + ns_log error "autosave attribute: unexpected field name <$key>" \ + "(prefix '$prefix'), not contained in <$field_names> " \ + "value [llength $value] bytes" + } + } else { + ns_log warning "autosave attribute: expecting a single form parameter with a prefix keys <$keys>" + ns_return 404 text/plain "not ok" + } + ns_log notice "SAVE-att DONE" + ad_script_abort + } + + + # # Externally callable method: revisions # - Page instproc www-revisions {} { - #set context [list [list [${:package_id} url] ${:name} ] [_ xotcl-core.revisions]] + Page ad_instproc www-revisions {} { + + This web-callable method lists the revisions based. The rendering + is actually performed in the cr-procs, but can overloaded per + package. + + } { + #set context [list [list [::${:package_id} url] ${:name} ] [_ xotcl-core.revisions]] #set title "[_ xotcl-core.revision_title] '${:name}'" return [:www-view [next]] } @@ -1366,28 +1891,37 @@ # Externally callable method: save-tags # - Page instproc www-save-tags {} { + Page ad_instproc www-save-tags {} { + + This web-callable method saves tags (provided via form parameter "new_tags"). + + } { ::xowiki::Page save_tags \ -user_id [::xo::cc user_id] \ -item_id ${:item_id} \ -revision_id ${:revision_id} \ -package_id ${:package_id} \ - [:form_parameter new_tags] + [:form_parameter new_tags:0..n] ::${:package_id} returnredirect \ - [:query_parameter "return_url" [${:package_id} url]] + [:query_parameter return_url:localurl [ad_return_url]] } # # Externally callable method: validate-attribute # - Page instproc www-validate-attribute {} { + Page ad_instproc www-validate-attribute {} { + + This web-callable method can be used to validate form attributes, + typically called via AJAX. + + } { set field_names [:field_names] set validation_errors 0 # - # Fet the first transmitted form field. + # Get the first transmitted form field. # foreach field_name $field_names { if {[::xo::cc exists_form_parameter $field_name]} { @@ -1404,7 +1938,9 @@ } else { set status_code 406 foreach f $form_fields { - if {[$f error_msg] ne ""} {set error [::xo::localize [$f error_msg] 1]} + if {[$f error_msg] ne ""} { + set error [::xo::localize [$f error_msg] 1] + } } } ns_return $status_code text/html $error @@ -1414,197 +1950,172 @@ # Externally callable method: view # - Page instproc www-view {{content ""}} { + Page ad_instproc www-view {{content ""}} { + + This web-callable method is called when viewing wiki content. The + method "view" is used primarily as web API call, when the xowiki + page is viewed. It is not intended for e.g. embedded wiki pages + (use includes), since it contains full framing, etc. + + In most cases, the argument "content" is not provided, and it is + computed via the "render" method of the current object. It is as + well possible to reuse the rendering logic of the method for other + pages, where some HTML content is already computed, but it should + be viewed exactly as in the page viewing cases. + + } { + #ns_log notice "www-view <$content>" + # - # The method "view" is used primarily for the toplevel call, when - # the xowiki page is viewed. It is not intended for e.g. embedded - # wiki pages (see include), since it contains full framing, etc. + # The recursion_count os maintained to avoid recursive includes + # inside a page. # ::xowiki::Page set recursion_count 0 set page_package_id ${:package_id} set context_package_id [::xo::cc package_id] + set folder_id [::$page_package_id folder_id] #:msg "page_package_id=$page_package_id, context_package_id=$context_package_id" - set template_file [:query_parameter "template_file" \ - [::$context_package_id get_parameter template_file view-default]] - - if {[:isobject ::xowiki::$template_file]} { + set template_file [ns_normalizepath [:query_parameter "template_file" \ + [::$context_package_id get_parameter template_file:graph view-default]]] + if {[nsf::is object ::xowiki::$template_file]} { $template_file before_render [self] } # # Set up template variables. # - set object_type [$page_package_id get_parameter object_type [:info class]] - set rev_link [$page_package_id make_link -with_entities 0 [self] revisions] + set object_type [::$page_package_id get_parameter object_type:graph [:info class]] + set rev_link [::$page_package_id make_link [self] revisions] - if {[$context_package_id query_parameter m ""] eq "edit"} { - set view_link [$page_package_id make_link -with_entities 0 [self] view return_url] + if {[::$context_package_id query_parameter m:token ""] eq "edit"} { + set view_link [::$page_package_id make_link [self] view return_url] set edit_link "" } else { - set edit_link [$page_package_id make_link -with_entities 0 [self] edit return_url] + set edit_link [::$page_package_id make_link [self] edit return_url] set view_link "" } - set delete_link [$page_package_id make_link -with_entities 0 [self] delete return_url] + + set delete_link [::$page_package_id make_link [self] delete return_url] if {[info exists :__link(new)]} { set new_link [set :__link(new)] } else { set new_link [:new_link $page_package_id] } - set admin_link [$context_package_id make_link -privilege admin -link admin/ $context_package_id {} {}] - set index_link [$context_package_id make_link -privilege public -link "" $context_package_id {} {}] - set toc_link [$context_package_id make_link -privilege public -link "list" $context_package_id {} {}] - set import_link [$context_package_id make_link -privilege admin -link "" $context_package_id {} {}] - set page_show_link [$page_package_id make_link -privilege admin [self] show-object return_url] - set view_link [$page_package_id make_link -with_entities 0 [self] view return_url] + set admin_link [::$context_package_id make_link -privilege admin -link admin/ ::$context_package_id] + set index_link [::$context_package_id make_link -privilege public ::$context_package_id] + 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 {[::xo::cc user_id] != 0} { ;# notifications require login + 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. + # set notifications_return_url [expr {[info exists return_url] ? $return_url : [ad_return_url]}] set notification_type [notification::type::get_type_id -short_name xowiki_notif] - set notification_text "Subscribe to [$context_package_id instance_name]" + set notification_text "Subscribe to [::$context_package_id instance_name]" set notification_subscribe_link \ - [export_vars -base /notifications/request-new \ - {{return_url $notifications_return_url} - {pretty_name $notification_text} - {type_id $notification_type} - {object_id $context_package_id}}] - set notification_image \ - "$notification_text" + [export_vars -base /notifications/request-new \ + {{return_url $notifications_return_url} + {pretty_name $notification_text} + {type_id $notification_type} + {object_id $context_package_id}}] + set notification_image "" } } - # the menubar is work in progress - set mb [$context_package_id get_parameter "MenuBar" 0] - if {$mb ne "0" && [info commands ::xowiki::MenuBar] ne ""} { - - set clipboard_size [::xowiki::clipboard size] - set clipboard_label [expr {$clipboard_size ? "Clipboard ($clipboard_size)" : "Clipboard"}] - - # - # Define standard xowiki menubar - # - set mb [::xowiki::MenuBar create ::__xowiki__MenuBar -id menubar] - $mb add_menu -name Package -label [$context_package_id instance_name] - $mb add_menu -name New -label [_ xowiki.menu-New] - $mb add_menu -name Clipboard -label $clipboard_label - $mb add_menu -name Page -label [_ xowiki.menu-Page] - $mb add_menu_item -name Package.Startpage -item [list url $index_link] - $mb add_menu_item -name Package.Toc -item [list url $toc_link] - - $mb add_menu_item -name Package.Subscribe \ - -item [list text #xowiki.subscribe# url $notification_subscribe_link] - $mb add_menu_item -name Package.Notifications \ - -item [list text #xowiki.notifications# url /notifications/manage] - $mb add_menu_item -name Package.Admin \ - -item [list text #xowiki.admin# url $admin_link] - $mb add_menu_item -name Package.ImportDump \ - -item [list url $import_link] - - $mb add_menu_item -name New.Page \ - -item [list text #xowiki.new# url $new_link] - - $mb add_menu_item -name Page.Edit \ - -item [list text #xowiki.edit# url $edit_link] - $mb add_menu_item -name Page.View \ - -item [list text #xowiki.menu-Page-View# url $view_link] - $mb add_menu_item -name Page.Delete \ - -item [list text #xowiki.delete# url $delete_link] - $mb add_menu_item -name Page.Revisions \ - -item [list text #xowiki.revisions# url $rev_link] - if {[acs_user::site_wide_admin_p]} { - $mb add_menu_item -name Page.Show \ - -item [list text "Show Object" url $page_show_link] - } - } - # # The content may be passed by other methods (e.g. edit) to # make use of the same templating machinery below. # if {$content eq ""} { - set content [:render] + set content [:content_header_get][:render] #:msg "--after render" + } else { + set content [:content_header_get]$content } + #set content [::xowiki::adp_parse_tags $content] # # 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 {$mb ne "0"} { + if {[::$context_package_id get_parameter MenuBar:boolean 0]} { # - # The following block should not be here, but in the templates. - # - set showFolders [$context_package_id get_parameter "MenuBarWithFolder" 1] - if {$showFolders} { - set folderhtml [:include {folders -style folders}] - } else { - set folderhtml "" - } + # When a "MenuBar" is used, it might contain folder-specific + # content. Therefore, we have to compute the tree. The resulting + # HTML code can be placed via adp templates differently (or it + # can be ignored). + set folderhtml [:include {folders -style folders}] + ::xo::Page set_property body folderHTML $folderhtml + # TODO: there should be no need to pass manually folderhtml, + # use the property instead + # # At this place, the menu should be complete, we can render it. # - set mbHTML [$mb render-preferred] - #append top_includelets \n "
" $mbHTML - ::xo::Page set_property body menubarHTML $mbHTML + set mb [::xowiki::MenuBar info instances -closure] + if {$mb ne ""} { + set mbHTML [$mb render-preferred] + ::xo::Page set_property body menubarHTML $mbHTML + } } - 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}] } if {[:exists_query_parameter return_url]} { - set return_url [:query_parameter return_url] + set return_url [:query_parameter return_url:localurl] } #: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 } if {$master} { set context [list ${:title}] - #:msg "$context_package_id title=[$context_package_id instance_name] - ${:title}" + #:msg "$context_package_id title=[::$context_package_id instance_name] - ${:title}" #:msg "::xo::cc package_id = [::xo::cc package_id] ::xo::cc url= [::xo::cc url] " - ::xo::Page set_property doc title "[$context_package_id instance_name] - ${:title}" + ::xo::Page set_property doc title "[::$context_package_id instance_name] - ${:title}" ::xo::Page set_property body title ${:title} # 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]} { - # $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 {[::$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} { # set l [Link create new -destroy_on_cleanup \ # -page [self] -type language -stripped_name $req_local_name \ @@ -1617,39 +2128,57 @@ # } #: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] - foreach css [$context_package_id get_parameter extra_css ""] { + foreach css [::$context_package_id get_parameter extra_css:localurl ""] { ::xo::Page requireCSS -order 10 $css } # # Refetch "template_file", since it might have been changed via - # set-parameter the cache flush (next line) is not pretty here + # set-parameter. The cache-flush (next line) is not pretty here # and should be supported from xotcl-core. # - ::xo::cc unset -nocomplain cache([list $context_package_id get_parameter template_file]) + ::xo::cc unset -nocomplain cache([list $context_package_id get_parameter template_file:graph]) set template_file [:query_parameter "template_file" \ - [::$context_package_id get_parameter template_file view-default]] + [::$context_package_id get_parameter template_file:graph view-default]] # # If the template_file does not have a path, assume it in the # standard location. # - if {![regexp {^[./]} $template_file]} { - set template_file [${:package_id} get_adp_template $template_file] + if {[string range $template_file 0 0] eq "/"} { + ns_log warning "ignore template as specified in parameter 'template_file'" \ + "on non-standard location: $template_file. The template should be" \ + " under\n/packages/[${:package_id} package_key]/resources/templates/..." + set template_file [::$context_package_id get_parameter \ + -check_query_parameter false \ + -nocache \ + template_file view-default] } + set validated_template_file [::${:package_id} get_adp_template $template_file] + if {$validated_template_file eq ""} { + ns_log error "invalid template specified in parameter 'template_file': '$template_file'" + } + set template_file $validated_template_file + # Force xowiki*.css to be loaded first(ish), so we can override + # its styling via the theme (e.g. different buttons...). This + # uses the "template::head" API directly, since resources from + # requireCSS are typically loaded later than those from the theme. + + template::head::add_css \ + -href urn:ad:css:xowiki-[::xowiki::CSS toolkit] \ + -order 0 + # - # Initialize and set the template variables, to be used by - # a. "adp_compile" / "adp_eval" - # b. "return_page" / "adp_include" + # Popular tags handling (should probably go to includelets) # - ::xo::Page requireCSS urn:ad:css:xowiki if {$footer ne ""} { template::add_body_script -script { function get_popular_tags(popular_tags_link, prefix) { - var http = getHttpObject(); + var http = new XMLHttpRequest(); http.open('GET', popular_tags_link, true); http.onreadystatechange = function() { if (http.readyState == 4) { @@ -1690,7 +2219,7 @@ } } if {$meta(keywords) eq ""} { - set meta(keywords) [$context_package_id get_parameter keywords ""] + set meta(keywords) [::$context_package_id get_parameter keywords ""] } foreach i [array names meta] { # don't set empty meta tags @@ -1700,24 +2229,30 @@ } # - # pass variables for properties doc and body - # example: ::xo::Page set_property body class "yui-skin-sam" + # Pass variables for properties doc and body. + # Example: ::xo::Page set_property body class "yui-skin-sam" # array set body [::xo::Page get_property body] array set doc [::xo::Page get_property doc] if {$page_package_id != $context_package_id} { - set page_context [$page_package_id instance_name] + set page_context [::$page_package_id instance_name] } if {$template ne ""} { + + # + # Initialize and set the template variables, to be used by + # a. "adp_compile" / "adp_eval" + # b. "return_page" / "adp_include" + # + set __including_page $page - #set __adp_stub [acs_root_dir]/packages/xowiki/www/view-default - set __adp_stub [$context_package_id get_adp_template view-default] + set __adp_stub [::$context_package_id get_adp_template view-default] set template_code [template::adp_compile -string $template] # - # make sure that and tags are processed + # Make sure that and tags are processed # append template_code { if { [info exists __adp_master] } { @@ -1734,23 +2269,24 @@ } ad_script_abort } else { - # use adp file - #:log "use adp" + # + # Use adp file. + # + #:log "use adp content=$content" set package_id $context_package_id set title ${:title} set name ${:name} set item_id ${:item_id} - $context_package_id return_page -adp $template_file -variables { + ::$context_package_id return_page -adp $template_file -variables { name title item_id context return_url content footer package_id page_package_id page_context rev_link edit_link delete_link new_link admin_link index_link view_link notification_subscribe_link notification_image top_includelets page views_data body doc - folderhtml } } } else { - set :mime_type [::xo::cc get_parameter content-type text/html] + set :mime_type [::xo::cc get_parameter content-type:graph text/html] return $content } } @@ -1768,12 +2304,12 @@ -base_item -field_names -form_constraints + {-nls_language ""} } { - array set __att [list publish_status 1] - foreach att [::xowiki::FormPage array names db_slot] {set __att($att) 1} - foreach att [list last_modified creation_user] { - set __att($att) 1 + set __att {publish_status 1} + foreach att [list last_modified creation_user {*}[::xowiki::FormPage array names db_slot]] { + dict set __att $att 1 } # set cr_field_spec [::xowiki::PageInstance get_short_spec_from_form_constraints \ @@ -1797,22 +2333,28 @@ __* {error not_allowed} _* { set varname [string range $field_name 1 end] - if {![info exists __att($varname)]} { + if {![dict exists $__att $varname]} { error "unknown attribute $field_name" } #:log "create_raw_form_field of $field_name <$cr_field_spec,$short_spec>" set f [$base_item create_raw_form_field \ + -omit_field_name_spec true \ -name $field_name \ -slot [$base_item find_slot $varname] \ - -spec $cr_field_spec,$short_spec] + -spec $cr_field_spec,$short_spec \ + -nls_language $nls_language \ + ] #:log "---> $f <[$f label]>" $f set __base_field $varname } default { set f [$base_item create_raw_form_field \ + -omit_field_name_spec true \ -name $field_name \ -slot "" \ - -spec $field_spec,$short_spec] + -spec $field_spec,$short_spec \ + -nls_language $nls_language \ + ] } } lappend form_fields $f @@ -1823,7 +2365,7 @@ Page proc find_slot {-start_class:required name} { foreach cl [list $start_class {*}[$start_class info heritage]] { set slotobj ${cl}::slot::$name - if {[:isobject $slotobj]} { + if {[nsf::is object $slotobj]} { #:msg $slotobj return $slotobj } @@ -1844,13 +2386,19 @@ {-spec ""} {-configuration ""} {-omit_field_name_spec:boolean false} + {-nls_language ""} + {-form_constraints ""} } { + #ns_log notice "... create_raw_form_field name $name spec '$spec'" set save_slot $slot if {$slot eq ""} { # We have no slot, so create a minimal slot. This should only happen for instance attributes set slot [::xo::Attribute new -pretty_name $name -datatype text -noinit] $slot destroy_on_cleanup } + if {$nls_language eq ""} { + set nls_language [:nls_language] + } set spec_list [list] if {[$slot exists spec]} {lappend spec_list [$slot set spec]} @@ -1871,9 +2419,10 @@ } else { set default "" } + #ns_log notice "... create $name with spec '[join $spec_list ,]'" set f [::xowiki::formfield::FormField new -name $name \ -id [::xowiki::Includelet html_id F.${:name}.$name] \ - -locale [:nls_language] \ + -locale $nls_language \ -label $label \ -type [expr {[$slot exists datatype] ? [$slot set datatype] : "text"}] \ -help_text [expr {[$slot exists help_text] ? [$slot set help_text] : ""}] \ @@ -1896,28 +2445,44 @@ {-spec ""} {-configuration ""} {-omit_field_name_spec:boolean false} + {-nls_language ""} + {-form_constraints ""} } { + # # For workflows, we do not want to get the form constraints of the # page itself (i.e. the property of the generic workflow form) but - # just the configured properties. Otherwise, we get for a - # wrong results for e.g. "{{form-usages -form de:Thread.wf ...}}" - # which picks up the label for the _title from the generic Workflow. + # just the configured properties. Otherwise, we get for a wrong + # results for e.g. "{{form-usages -form de:Thread.wf ...}}" which + # picks up the label for the _title from the generic Workflow. # So, when we have configured properties, we use it, use the # primitive one just on despair. Not sure, what the best solution # is,... maybe an additional flag. + # if { $omit_field_name_spec} { set short_spec "" } else { - set short_spec [:get_short_spec $name] - # :msg "[self] get_short_spec $name returns <$short_spec>" + # + # Get for the current page (self) the form-constraints and + # return the spec for the specifiled name. + # + set short_spec [:get_short_spec -form_constraints $form_constraints $name] + #:log "$name get_short_spec returns <$short_spec>" } - #:log "create form-field '$name', short_spec '$short_spec' spec '$spec', slot=$slot" + #:log "$name '$name', spec '$spec' short_spec '$short_spec', slot=$slot" set spec_list [list] + if {$spec ne ""} {lappend spec_list $spec} if {$short_spec ne ""} {lappend spec_list $short_spec} - #:log "$name: short_spec '$short_spec', spec_list 1 = '[join $spec_list ,]'" - set f [next -name $name -slot $slot -spec [join $spec_list ,] -configuration $configuration] + #:log "$name: composed spec '[join $spec_list ,]'" + + set f [next \ + -name $name \ + -slot $slot \ + -spec [join $spec_list ,] \ + -configuration $configuration \ + -nls_language $nls_language \ + ] #:log "created form-field '$name' $f [$f info class] validator=[$f validator] p=[$f info precedence]" return $f } @@ -2078,21 +2643,31 @@ $field setAttribute value $value } } - default {:log "can't handle $type so far $att=$value"} + default { + #:log "can't handle $type so far $att=$value" + } } } } FormPage ad_instproc set_form_data {form_fields} { - Store the instance attributes or default values in the form. + + Store the instance attributes or default values into the form via + set_form_value. This function iterates over the provided + form-fields and checks, if these are known fields in the current + form. These known field names are defined via the method + "field_names" that extracts these names from a form. + + If one wants to load all values from an FormPage into the provided + form-fields, use method "load_values_into_form_fields" instead. + } { - ::require_html_procs + ::xo::require_html_procs - #array set __ia ${:instance_attributes} foreach f $form_fields { set att [$f name] # just handle fields of the form entry - if {![info exists :__field_in_form($att)]} continue + if {![dict exists ${:__field_in_form} $att]} continue #:msg "set form_value to form-field $att [dict exists ${:instance_attributes} $att]" if {[dict exists ${:instance_attributes} $att]} { #:msg "my set_form_value from ia $att '[dict get ${:instance_attributes} $att]', external='[$f convert_to_external [dict get ${:instance_attributes} $att]]' f.value=[$f value]" @@ -2139,104 +2714,153 @@ specified, all form parameters are used. } { + #:log "===== Page get_form_data" + set validation_errors 0 set category_ids [list] array set containers [list] - set cc [${:package_id} context] + set cc [::${:package_id} context] if {![info exists field_names]} { - set field_names [$cc array names form_parameter] - #:log "form-params=[$cc array get form_parameter]" + # + # Field names might come directly from the POST request payload + # and need to be validated: enforce that field names are made + # only by alphanumeric characters and dots, with the exception + # of file related fields, where either .tmpfile or .content-type + # will be appended. + # + #:log "===== Page get_form_data RAW field_names from form data: [$cc array names form_parameter *_.*]" + + set field_names [list] + foreach att [$cc array names form_parameter] { + if {[regexp {^[\w.]+(\.(tmpfile|content-type))?$} $att]} { + lappend field_names $att + } else { + # + # We might decide to return a 403 here instead... + # + ad_log warning "Page get_form_data: field name '$att' was skipped. Received field names: [$cc array names form_parameter]" + } + } } + #:msg "fields $field_names // $form_fields" #foreach f $form_fields { :msg "... $f [$f name]" } # - # We have a form and get all form input from the fields of the - # from into form field objects. + # We have the form data and get all form_parameters into the + # form-field objects. # foreach att $field_names { #:msg "getting att=$att" set processed($att) 1 switch -glob -- $att { __category_* { set f [:lookup_form_field -name $att $form_fields] - set value [$f value [$cc form_parameter $att]] - foreach v $value {lappend category_ids $v} + if {![$f is_disabled]} { + set value [$f value [$cc form_parameter $att]] + foreach v $value {lappend category_ids $v} + } } __* { - # other internal variables (like __object_name) are ignored + # + # Other internal variables (like __object_name) are ignored + # } _* { - # instance attribute fields - set f [:lookup_form_field -name $att $form_fields] - set value [$f value [string trim [$cc form_parameter $att]]] - set varname [string range $att 1 end] - # get rid of strange utf-8 characters hex C2AD (firefox bug?) - # ns_log notice "FORM_DATA var=$varname, value='$value' s=$s" - if {$varname eq "text"} {regsub -all "­" $value "" value} - #ns_log notice "FORM_DATA var=$varname, value='$value'" - if {![string match "*.*" $att]} {set :$varname $value} + # + # CR fields + # + set f [:lookup_form_field -name $att $form_fields] + if {![$f is_disabled]} { + set value [$f value [string trim [$cc form_parameter $att]]] + set varname [string range $att 1 end] + if {[string first . $att] == -1} { + set :$varname $value + } + } } default { - # user form content fields + # + # Application form content fields. + # if {[regexp {^(.+)[.](tmpfile|content-type)} $att _ file field]} { + # + # File related fields. + # set f [:lookup_form_field -name $file $form_fields] - $f $field [string trim [$cc form_parameter $att]] + if {![$f is_disabled]} { + $f $field [string trim [$cc form_parameter $att]] + } #:msg "[$f name]: [list $f $field [string trim [$cc form_parameter $att]]]" + } else { - set f [:lookup_form_field -name $att $form_fields] - set value [$f value [string trim [$cc form_parameter $att]]] - #:msg "value of $att ($f) = '$value' exists=[$cc exists_form_parameter $att]" - if {![string match "*.*" $att]} {dict set :instance_attributes $att $value} - if {[$f exists is_category_field]} {foreach v $value {lappend category_ids $v}} + # + # Fields related to instance variables. + # + #:log "===== Page get_form_data calls lookup_form_field -name $att" + set f [:lookup_form_field -name $att $form_fields] + if {![$f is_disabled]} { + set value [$f value [string trim [$cc form_parameter $att]]] + #:log "===== Page get_form_data calls lookup_form_field -name $att -> $f -> '$value'" + if {[string first . $att] == -1} { + # + # If the field is not a compound field, put the received + # value into the instance attributes. The containerized + # input values from compound fields are processed below. + # + dict set :instance_attributes $att $value + } + if {[$f exists is_category_field]} { + foreach v $value { + lappend category_ids $v + } + } + } } } } - if {[string match "*.*" $att]} { + if {[string first . $att] > -1} { lassign [split $att .] container component lappend containers($container) $component } } - #:msg "containers = [array names containers]" - #:msg "ia=[array get __ia]" # - # In a second iteration, combine the values from the components - # of a container to the value of the container. + # The first round was a processing based on the transmitted input + # fields of the forms. Now we use the formfields to complete the + # data and to validate it. # - foreach c [array names containers] { - switch -glob -- $c { - __* {} - _* { - set f [:lookup_form_field -name $c $form_fields] - set processed($c) 1 - set :[string range $c 1 end] [$f value] - } - default { - set f [:lookup_form_field -name $c $form_fields] - set processed($c) 1 - #:msg "container $c: compute value of $c [$f info class]" - dict set :instance_attributes $c [$f value] - #:msg "container $c: is set to '[dict get ${:instance_attributes} $c]'" - } + set leaf_components {} + set container_fields {} + foreach f $form_fields { + if {[$f istype ::xowiki::formfield::CompoundField]} { + #ns_log notice "TOP call leaf_components for [$f info class]" + lappend leaf_components {*}[$f leaf_components] + lappend container_fields $f + set processed([$f name]) 1 } } + #ns_log notice "PROCESSED <[lsort [array names processed]]>" + #ns_log notice "LEAF COMPONENTS <[lsort [lmap f $leaf_components {$f name}]]>" + #ns_log notice "FORM_FIELDS [lsort [lmap f $form_fields {$f name}]]" + #ns_log notice "CONTAINER [lsort [array names containers]] + [lsort [lmap f $container_fields {$f name}]]" + # - # The first round was a processing based on the transmitted input - # fields of the forms. Now we use the formfields to complete the - # data and to validate it. + # Certain HTML form field types are not transmitted by the browser + # (e.g. unchecked checkboxes). Therefore, we have not processed + # these fields above and have to do it now. # - foreach f $form_fields { - #:msg "validate $f [$f name] [info exists processed([$f name])]" + foreach f [concat $form_fields $leaf_components] { + #:log "check processed $f [$f name] [info exists processed([$f name])] disabled=[$f is_disabled]" set att [$f name] - # Certain form field types (e.g. checkboxes) are not transmitted, if not - # checked. Therefore, we have not processed these fields above and - # have to do it now. + if {![info exists processed($att)] + && ![$f exists is_repeat_template] + && ![$f is_disabled] + } { + #ns_log notice "==== form field $att [$f info class] not yet processed" - if {![info exists processed($att)]} { - #:msg "form field $att not yet processed" switch -glob -- $att { __* { # other internal variables (like __object_name) are ignored @@ -2247,70 +2871,107 @@ set default "" if {[info exists :$varname]} {set default [set :$varname]} set v [$f value_if_nothing_is_returned_from_form $default] + #ns_log notice "===== value_if_nothing_is_returned_from_form [$f name] '$default' => '$v' (type=[$f info class])" set value [$f value $v] if {$v ne $default} { - if {![string match "*.*" $att]} {set :$varname $value} + if {[string first . $att] == -1} { + set :$varname $value + } } } default { # user form content fields set default "" + # # The reason, why we set in the next line the default to # the old value is due to "show-solution" in the qti # use-case. Maybe one should alter this use-case to # simplify the semantics here. - if {[dict exists ${:instance_attributes} $att]} {set default [dict get ${:instance_attributes} $att]} + # + if {[dict exists ${:instance_attributes} $att]} { + set default [dict get ${:instance_attributes} $att] + } set v [$f value_if_nothing_is_returned_from_form $default] - #:msg "value_if_nothing_is_returned_from_form '$default' => '$v' (type=[$f info class])" + #ns_log notice "===== value_if_nothing_is_returned_from_form [$f name] '$default' => '$v' (type=[$f info class])" + set value [$f value $v] - if {![string match "*.*" $att]} {dict set :instance_attributes $att $value} + if {[string first . $att] == -1} { + dict set :instance_attributes $att $value + } } } } + } + # + # In the third iteration, combine the values from the components + # of a container to the value of the container. + # + foreach f $container_fields { + set name [$f name] + #:log "container $name: compute value for [$f info class]" + if {![$f is_disabled]} { + dict set :instance_attributes $name [$f value] + #:log "container $name: is set to '[dict get ${:instance_attributes} $name]'" + } elseif {[dict exists ${:instance_attributes} $name]} { + $f value [dict get ${:instance_attributes} $name] + } + } + + # + # Finally run the validator on the top-level fields + # + foreach f [concat $form_fields] { # - # Run validators + # Run validator on every field # + #:log "validate [$f name] ([$f info class]) with value '[$f value]'" set validation_error [$f validate [self]] if {$validation_error ne ""} { #:log "validation of $f [$f name] with value '[$f value]' returns '$validation_error'" $f error_msg $validation_error incr validation_errors } } + #:msg "validation returns $validation_errors errors" set current_revision_id [$cc form_parameter __current_revision_id ""] - if {$validation_errors == 0 && $current_revision_id ne "" && $current_revision_id != ${:revision_id}} { + if {$validation_errors == 0 + && $current_revision_id ne "" + && $current_revision_id != ${:revision_id} + } { set validation_errors [:mutual_overwrite_occurred] + ad_log warning "mutual_overwrite occurred, current_revision_id <$current_revision_id> my ${:revision_id}" } if {[:validate=form_input_fields $form_fields] == 0} { incr validation_errors + #:log "validation error due validate=form_input_fields" } if {$validation_errors == 0} { # # Postprocess based on form fields based on form-fields methods. # foreach f $form_fields { - $f convert_to_internal + if {![$f is_disabled]} { + $f convert_to_internal + } } } else { :log validation_errors=$validation_errors - - # There were validation erros. Reset the value for form-fields - # of type "file" to avoid confusions, since a file-name was - # provided, but the file was not uploaded due to the validation - # error. If we would not reset the value, the provided name - # would cause an interpretation of an uploaded empty file. Maybe - # a new method "reset-to-default" would be a good idea. + # + # There were validation errors. Reset the value of form-fields + # which have to be reset on validation errors due to browser + # semantics. + # foreach f $form_fields { - if {[$f type] eq "file"} { - $f set value "" - } + $f reset_on_validation_error } } + #:log "=== get_form_data has validation_errors $validation_errors, instance_attributes: ${:instance_attributes}" + return [list $validation_errors [lsort -unique $category_ids]] } @@ -2322,8 +2983,8 @@ if {!$found} { set f [:create_raw_form_field -name $name -slot [:find_slot $name]] } + #:log "found $name in $form_fields -> $found [$f info class]" - #:msg "$found $name mode=$mode type=[$f set type] value=[$f value] disa=[$f exists disabled] display_field=[$f display_field]" if {$mode eq "edit" || [$f display_field]} { set html [$f asHTML] } else { @@ -2366,14 +3027,16 @@ } FormPage instproc create_form_fields {field_names} { - set form_fields [:create_category_fields] + set form_fields [:create_category_fields] foreach att $field_names { if {[string match "__*" $att]} continue if {[:form_field_exists $att]} { - #ns_log notice "... found [set $key] for $key" + #ns_log notice "... found form-field $att" lappend form_fields [:lookup_form_field -name $att {}] + } else { + #ns_log notice "... create form-field for $att" lappend form_fields [:create_form_field \ -cr_field_spec [:get_short_spec @cr_fields] \ -field_spec [:get_short_spec @fields] $att] @@ -2383,54 +3046,78 @@ } FormPage instproc field_names {{-form ""}} { + #ns_log notice "=== field_names form <$form>" + # + # Ge the field-names mentioned in form (the provided form has + # always highest precedence). + # lassign [:field_names_from_form -form $form] form_vars needed_attributes - #:msg "form=$form, form_vars=$form_vars needed_attributes=$needed_attributes" - array unset :__field_in_form - array unset :__field_needed - if {$form_vars} {foreach v $needed_attributes {set :__field_in_form($v) 1}} - foreach v $needed_attributes {set :__field_needed($v) 1} + # + # In case, we have no form, get the field-names from the form + # constraints. + # + if {[llength $needed_attributes] == 0} { + set needed_attributes [:field_names_from_form_constraints] + } + #:log "form=$form, form_vars=$form_vars needed_attributes=$needed_attributes" + set :__field_in_form "" + set :__field_needed "" + if {$form_vars} { + foreach v $needed_attributes { + dict set :__field_in_form $v 1 + } + } + foreach v $needed_attributes { + dict set :__field_needed $v 1 + } + # - # Remove the fields already included in auto_fields form the needed_attributes. - # The final list field_names determines the order of the fields in the form. + # Remove the fields already included in auto_fields from the needed_attributes. + # The final list "field_names" determines the order of the fields in the form. # set auto_fields [list _name _page_order _title _creator _assignee _text _description _nls_language] set reduced_attributes $needed_attributes foreach f $auto_fields { set p [lsearch -exact $reduced_attributes $f] if {$p > -1} { - #if {$form_vars} { - #set auto_field_in_form($f) 1 - #} set reduced_attributes [lreplace $reduced_attributes $p $p] } } #:msg reduced_attributes(after)=$reduced_attributes - #:msg fields_from_form=[array names :__field_in_form] + #:msg fields_from_form=[dict keys ${:__field_in_form}] - set field_names [list _name] - if {[${:package_id} show_page_order]} { lappend field_names _page_order } + set field_names _name + if {[::${:package_id} show_page_order]} { + lappend field_names _page_order + } lappend field_names _title _creator _assignee - foreach fn $reduced_attributes { lappend field_names $fn } - foreach fn [list _text _description _nls_language] { lappend field_names $fn } + foreach fn $reduced_attributes { + lappend field_names $fn + } + foreach fn {_text _description _nls_language} { + lappend field_names $fn + } #:msg final-field_names=$field_names return $field_names } Page instproc field_names {{-form ""}} { - array set dont_modify [list item_id 1 revision_id 1 object_id 1 object_title 1 page_id 1 name 1] + array set dont_modify {item_id 1 revision_id 1 object_id 1 object_title 1 page_id 1 name 1} set field_names [list] foreach field_name [[:info class] array names db_slot] { - if {[info exists dont_modify($field_name)]} continue + if {[info exists dont_modify($field_name)]} { + continue + } lappend field_names _$field_name } #:msg field_names=$field_names return $field_names } FormPage instproc post_process_form_fields {form_fields} { - # We offer here the possibility to iterate over the form fields before it + # We offer here the possibility to iterate over the form fields # before they are rendered } @@ -2440,38 +3127,79 @@ # is presented; can be overloaded } - FormPage instproc load_values_into_form_fields {form_fields} { + FormPage ad_instproc combine_data_and_form_field_default {is_new form_field data_value} { + + Combine the value of the form field (e.g. determined by the + default) with the value in the instance attributes. This function + decides, whether it should honor the data value or the form field + value for e.g. rendering forms. + + @param is_new is this a new entry? + @param form_field object id of the form field + @param data_value the data from the instance attributes. + } { + set form_field_value [$form_field value] + if {$is_new && $form_field_value ne "" && $data_value eq ""} { + # + # On fresh entries, take the default value in case the old + # value is blank. + # + } else { + # + # Reset for form field value to the external + # representation of the data value. + # + $form_field value [$form_field convert_to_external $data_value] + } + #ns_log notice "combine_data_and_form_field_default $is_new form_field [$form_field name] data_value <$data_value> final <[$form_field value]>" + } + + + FormPage ad_instproc load_values_into_form_fields {form_fields} { + + Load either the instance variables or the instance attributes into + the provided form-fields. The function sets the values based on + the default values and the values for the current object. + + } { + set is_new [:is_new_entry ${:name}] + foreach f $form_fields { set att [$f name] switch -glob $att { __* {} _* { set varname [string range $att 1 end] - $f value [$f convert_to_external [set :$varname]] + :combine_data_and_form_field_default $is_new $f [set :$varname] } default { + #:log "load_values_into_form_field $att" \ + "exists [dict exists ${:instance_attributes} $att]" \ + "in [dict keys ${:instance_attributes}]" if {[dict exists ${:instance_attributes} $att]} { - #:msg "setting $f ([$f info class]) value [dict get ${:instance_attributes} $att]" - $f value [$f convert_to_external [dict get ${:instance_attributes} $att]] + :combine_data_and_form_field_default $is_new $f [dict get ${:instance_attributes} $att] } } } } } FormPage instproc render_form_action_buttons {{-CSSclass ""}} { - set f [::xowiki::formfield::submit_button new -destroy_on_cleanup \ + set f [::xowiki::formfield::submit_button new \ -name __form_button_ok \ - -CSSclass $CSSclass] + -CSSclass $CSSclass \ + -destroy_on_cleanup ] - ::html::div -class [$f form_button_wrapper_CSSclass] { - $f render_input - } + ::html::div [expr {[$f exists form_button_wrapper_CSSclass] + ? [list class [$f form_button_wrapper_CSSclass]] + : {} }] { + $f render_input + } } FormPage instproc form_fields_sanity_check {form_fields} { foreach f $form_fields { - if {[$f exists disabled]} { + if {[$f is_disabled]} { # don't mark disabled fields as required if {[$f required]} { $f required false