Index: openacs-4/packages/xowf/tcl/xowf-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/xowf-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/xowf/tcl/xowf-procs.tcl 27 Apr 2015 15:28:22 -0000 1.3 +++ openacs-4/packages/xowf/tcl/xowf-procs.tcl 7 Aug 2017 23:48:30 -0000 1.4 @@ -128,7 +128,7 @@ return [list form_id $(item_id) name $(prefix):$(stripped_name)] } - Context instproc default_form_loader {form_name} { + Context instproc default_load_form_id {form_name} { #my msg "resolving $form_name in state [my current_state] via default form loader" set form_id 0 if {$form_name ne ""} { @@ -139,8 +139,42 @@ } return $form_id } + ::nsf::method::property Context default_load_form_id returns integer + Context instproc create_auto_form {object} { + # + # Create a form on the fly. The created form can be influenced by + # "auto_form_template" and "auto_form_constraints". + # + set vars [dict keys [$object set instance_attributes]] + if {[my exists auto_form_template]} { + set template [my set auto_form_template] + my log "USE autoform template" + } elseif {[llength $vars] == 0} { + #set template "AUTO form, no instance variables defined,
@_text@" + set template "@_text@" + } else { + set template "@[join $vars @,@]@
@_text@" + } + #my log "USE auto-form template=$template, vars=$vars IA=[$object set instance_attributes], V=[$object info vars] auto [expr {[my exists autoname] ? [my set autoname] : "f"}]" + if {[my exists auto_form_constraints]} { + set fc [my set auto_form_constraints] + } else { + set fc "" + } + set package_id [$object package_id] + return [::xowiki::Form new -destroy_on_cleanup \ + -package_id $package_id \ + -parent_id [$package_id folder_id] \ + -name "Auto-Form" \ + -anon_instances [expr {[my exists autoname] ? [my set autoname] : "f"}] \ + -form {} \ + -text [list $template text/html] \ + -form_constraints $fc] + } + + Context instproc form_object {object} { set parent_id [$object parent_id] # After this method is activated, the form object of the form of @@ -151,6 +185,8 @@ # object name of the form in the context. # if {[my exists form_id]} {return [my set form_id]} + + set package_id [$object package_id] # # We have to load the form, maybe via a form loader. If the # form_loader is set and the method exists, then use the form @@ -161,82 +197,76 @@ # TODO why no procsearch instead of "info methods"? if {$loader eq "" || [my info methods $loader] eq ""} { - set form_id [my default_form_loader [[my current_state] form]] + set form_id [my default_load_form_id [[my current_state] form]] + if {$form_id == 0} { + # + # When no form was found by the form loader ($form_id == 0) we + # create automatically a form. + # + set form_object [my create_auto_form $object] + } } else { #my msg "using custom form loader $loader for [my form]" - set form_id [my $loader [my form]] + set form_object [my $loader [my form]] } + + # + # At this place, the variable "form_id" might contain an id + # (integer) or an object, provided by the custom file loader. + # #my msg form_id=$form_id - set package_id [$object package_id] - # When no form was found by the form loader ($form_id == 0) we - # create a form on the fly. The created form can be influenced by - # "auto_form_template" and "auto_form_constraints". - if {$form_id == 0} { - set vars [dict keys [$object set instance_attributes]] - if {[my exists auto_form_template]} { - set template [my set auto_form_template] - my log "USE autoform template" - } elseif {[llength $vars] == 0} { - #set template "AUTO form, no instance variables defined,
@_text@" - set template "@_text@" - } else { - set template "@[join $vars @,@]@
@_text@" - } - #my log "USE auto-form template=$template, vars=$vars IA=[$object set instance_attributes], V=[$object info vars] auto [expr {[my exists autoname] ? [my set autoname] : "f"}]" - - if {[my exists auto_form_constraints]} { - set fc [my set auto_form_constraints] - } else { - set fc "" - } - set form_id [::xowiki::Form new -destroy_on_cleanup \ - -package_id $package_id \ - -parent_id [$package_id folder_id] \ - -name "Auto-Form" \ - -anon_instances [expr {[my exists autoname] ? [my set autoname] : "f"}] \ - -form {} \ - -text [list $template text/html] \ - -form_constraints $fc] - } else { - # Be sure, to instantiate the form object + if {![info exists form_object] + && [string is integer -strict $form_id] + && $form_id > 0 + } { + # just load the object conditionally if {![my isobject ::$form_id]} { ::xo::db::CrClass get_instance_from_db -item_id $form_id } - #my msg form_id=$form_id,[$form_id info class] - - set form_id ::$form_id - if {[$form_id info class] eq "::xowiki::Form"} { - # The item returned from the form loadeder was a form, - # everything is fine. - } elseif {[$form_id info class] eq "::xowiki::FormPage"} { - # We got an FormPage. This formpage might be already a pseudo - # form (containing property "form"). In this case, we are done as well. - - if {[$form_id property form] eq ""} { - # The FormPage contains no form, so try to provide one. We - # obtain the content by rendering the page_content. In some - # cases it might be more efficient to obtain the content - # from property "_text", but this might lead to unexpected - # cases where the formpage uses _text for partial - # information. - set text [$form_id render_content] - $form_id set_property -new 1 form "
$text
" - #my msg "_text=[$form_id property _text]" - } - } elseif {[$form_id info class] eq "::xowiki::Page"} { - #my msg "creating form" - set form_id [::xowiki::Form new -destroy_on_cleanup \ - -package_id $package_id \ - -parent_id [$package_id folder_id] \ - -name "Auto-Form" \ - -anon_instances [expr {[my exists autoname] ? [my set autoname] : "f"}] \ - -form "
[$form_id get_html_from_content [$form_id text]]
" \ - -text "" \ - -form_constraints ""] + set form_object ::$form_id + } + + if {[$form_object istype "::xowiki::Form"]} { + # + # The item returned from the form loader was a form, + # everything is fine. + # + } elseif {[$form_object istype "::xowiki::FormPage"]} { + # + # We got a FormPage. This FormPage might be a pseudo form (a + # FormPage containing the property "form"). If not, add a "form" + # property from the rendered content. + # + if {[$form_object property form] eq ""} { + # + # The FormPage contains no form, so try to provide one. We + # obtain the content by rendering the page_content. In some + # cases it might be more efficient to obtain the content + # from property "_text", but this might lead to unexpected + # cases where the formpage uses _text for partial + # information. + # + set text [$form_object render_content] + $form_object set_property -new 1 form "
$text
" + #my msg "_text=[$form_object property _text]" } + } elseif {[$form_object info class] eq "::xowiki::Page"} { + # + # The $form_object is in reality an xowiki Page, make it look + # like a form (with form buttons). + # + set form_object [::xowiki::Form new -destroy_on_cleanup \ + -package_id $package_id \ + -parent_id [$package_id folder_id] \ + -name "Auto-Form" \ + -anon_instances [expr {[my exists autoname] ? [my set autoname] : "f"}] \ + -form "
[$form_object get_html_from_content [$form_id text]]
" \ + -text "" \ + -form_constraints ""] } - my set form_id $form_id + + my set form_id $form_object } Context instproc init {} { @@ -430,8 +460,8 @@ } foreach role [$s set handled_roles] { set role_ctx [self]-$role - #my msg exists?role=$role->[self]-$role->[info command [self]-$role] - if {[info command ${role_ctx}::[$s name]] ne ""} { + #my msg exists?role=$role->[self]-$role->[info commands [self]-$role] + if {[info commands ${role_ctx}::[$s name]] ne ""} { foreach a [${role_ctx}::[$s name] get_actions] { append result [my draw_transition $s ${role_ctx}::$a "$role:"] } @@ -460,7 +490,7 @@ if {[catch {exec $dot -Tpng $fn -o $path/$ofn} errorMsg]} { my msg "Error during execution of $dot: $errorMsg" } - file delete $fn + file delete -- $fn return "\n" } @@ -694,6 +724,7 @@ #{label "#xowf.form-button-[namespace tail [self]]#"} Class create Action -superclass WorkflowConstruct -parameter { {next_state ""} + {payload ""} {roles all} {state_safe false} {title} @@ -789,7 +820,7 @@ } WorkflowPage ad_instproc is_wf_instance {} { - Check, if the current page is a workflow instance (page, refering to a workflow) + Check, if the current page is a workflow instance (page, referring to a workflow) } { # we cannot call get_template_object here, because this will lead # to a recursive loop. @@ -923,11 +954,21 @@ set helpText [$f help_text] if {$helpText ne ""} { - set divNode [$dom_doc createElement div] - $divNode setAttribute class [$f form_widget_CSSclass] - $divNode appendChild [$dom_doc createTextNode $helpText] - [$n parentNode] insertBefore $divNode [$n nextSibling] - util_user_message -message "field [$f name], value [$f value]: $helpText" + #set divNode [$dom_doc createElement div] + #$divNode setAttribute class [$f form_widget_CSSclass] + #$divNode appendChild [$dom_doc createTextNode $helpText] + #[$n parentNode] insertBefore $divNode [$n nextSibling] + + #set spanNode [$dom_doc createElement span] + #$spanNode setAttribute class "glyphicon glyphicon-ok [$f form_widget_CSSclass]" + #[$n parentNode] insertBefore $spanNode [$n nextSibling] + + set parentNode [$n parentNode] + set oldClass [$parentNode getAttribute class ""] + $parentNode setAttribute class "selection [$f form_widget_CSSclass]" + $parentNode setAttribute title $helpText + + #util_user_message -message "field [$f name], value [$f value]: $helpText" } } } @@ -956,7 +997,7 @@ catch {ds_comment $msg} } - WorkflowPage ad_instproc edit args { + WorkflowPage ad_instproc www-edit args { Hook for editing workflow pages } { if {[my is_wf_instance]} { @@ -967,7 +1008,7 @@ next } - WorkflowPage ad_instproc view {{content ""}} { + WorkflowPage ad_instproc www-view {{content ""}} { Provide additional view modes: - edit: instead of viewing a page, it is opened in edit mode - view_user_input: show user the provided input @@ -992,13 +1033,13 @@ switch -- $method { view_user_input { #my msg "calling edit with disable_input_fields=1" - return [my edit -disable_input_fields 1] + return [my www-edit -disable_input_fields 1] #return [$package_id call [self] edit [list -disable_input_fields 1]] } view_user_input_with_feedback { my set __feedback_mode 1 #my msg "calling edit with disable_input_fields=1" - return [my edit -disable_input_fields 1] + return [my www-edit -disable_input_fields 1] #return [$package_id call [self] edit [list -disable_input_fields 1]] } default { @@ -1096,18 +1137,35 @@ } #set next_state [$action_command get_next_state] # Activate action - if {[catch {$action_command activate [self]} errorMsg]} { - ns_log notice "ACTIVATE [my name] error =>$errorMsg" - set error "error in action '$action' of workflow instance [my name]\ - of workflow [[my page_template] name]:" - if {[[my package_id] exists __batch_mode]} { - [my package_id] set __evaluation_error "$error\n\n$::errorInfo" - incr validation_errors + set err [catch {$action_command activate [self]} errorMsg] + if {$err} { + # + # Save error code in variable errorCode, since the + # tcl-maintained value is volatile + set errorCode $::errorCode + + ns_log notice "ACTIVATE [my name] error => $errorMsg // $errorCode" + # + # Check, if we were called from "ad_script_abort" (intentional abortion) + # + if {[ad_exception $errorCode] eq "ad_script_abort"} { + # + # This was an intentional abortion, no need to complain to the + # error.log or other reporting paths. + # } else { - my msg -html 1 "$error 
$::errorInfo
" + set error "error in action '$action' of workflow instance [my name]\ + of workflow [[my page_template] name]:" + if {[[my package_id] exists __batch_mode]} { + [my package_id] set __evaluation_error "$error\n\n$::errorInfo" + incr validation_errors + } else { + my msg -html 1 "$error 
$::errorInfo
" + } + ad_log error "--WF: evaluation $error\n$::errorInfo" } - ns_log error "--WF: evaluation $error\n$::errorInfo" return "" + } else { # We moved get_next_state here to allow an action to infuence the # conditions in the activation method. @@ -1220,7 +1278,7 @@ # We do not want to save the workflow definition in every workflow # instance. # - return [dict remove [my instance_attributes] workflow_definition] + return [dict remove ${:instance_attributes} workflow_definition] } WorkflowPage instproc save_in_hstore {} { @@ -1269,7 +1327,17 @@ } } - WorkflowPage instproc create-or-use args { + WorkflowPage instproc create-or-use_view {-package_id:required -parent_id:required name } { + # the link should be able to view return_url and template_file + return [$package_id returnredirect [$package_id pretty_link -parent_id $parent_id $lang:$stripped_name]] + } + + WorkflowPage instproc www-create-or-use { + {-parent_id 0} + {-view_method edit} + {-name ""} + {-nls_language ""} + } { #my msg "instance = [my is_wf_instance], wf=[my is_wf]" if {[my is_wf]} { my instvar package_id @@ -1282,34 +1350,67 @@ # set ctx [::xowf::Context require [self]] my activate $ctx allocate + + # + # After allocate, the payload might contain "name", "parent_id" + # or "m". Using the payload dict has the advantage that it does + # not touch the instance variables. + # + set payload [${ctx}::allocate payload] + set m "" + foreach p {name parent_id m} { + if {[dict exists $payload $p]} { + set $p [dict get $payload $p] + } + } + # + # If these values are not set, try to obtain it the old-fashioned way. + # + if {$parent_id == 0} { + set parent_id [my query_parameter "parent_id" [[my package_id] folder_id]] + } + if {$name eq ""} { + set name [my property name ""] + } + + # # Check, if allocate has provided a name: - set name [my property name ""] + # if {$name ne ""} { # Ok, a name was provided. Check if an instance with this name # exists in the current folder. set default_lang [my lang] - set parent_id [my query_parameter "parent_id" [$package_id folder_id]] $package_id get_lang_and_name -default_lang $default_lang -name $name lang stripped_name set id [::xo::db::CrClass lookup -name $lang:$stripped_name -parent_id $parent_id] - #my msg "lookup of $lang:$stripped_name returned $id, default-lang([my name])=$default_lang [my nls_language]" + #my log "after allocate lookup of $lang:$stripped_name returned $id, default-lang([my name])=$default_lang [my nls_language]" if {$id != 0} { - # The instance exists already - return [$package_id returnredirect \ - [export_vars -base [$package_id pretty_link -parent_id $parent_id $lang:$stripped_name] \ - [list return_url template_file]]] + # + # The instance exists already. Either use method "m" (if + # provided) or redirect to the item. + # + if {$m eq ""} { + return [$package_id returnredirect \ + [export_vars -no_base_encode -base [$package_id pretty_link -parent_id $parent_id $lang:$stripped_name] \ + [list return_url template_file]]] + } else { + set item [::xo::db::CrClass get_instance_from_db -item_id $id] + # missing: policy check. + return [$item $m] + } } else { if {$lang ne $default_lang} { set nls_language [my get_nls_language_from_lang $lang] } else { set nls_language [my nls_language] } #my msg "We want to create $lang:$stripped_name" - return [next -name $lang:$stripped_name -nls_language $nls_language] + set name $lang:$stripped_name } } } - next + # method "m" is ignored, always edit + next -parent_id $parent_id -view_method $view_method -name $name -nls_language $nls_language } WorkflowPage instproc initialize_loaded_object {} { @@ -1614,7 +1715,7 @@ } WorkflowPage ad_instproc schedule_job {-time:required -party_id cmd} { - Schedule the specified tcl command for the the current package + Schedule the specified Tcl command for the the current package instance at the given time. } { my instvar package_id @@ -1751,12 +1852,12 @@ set page [$package_id resolve_request -path $object_name method] if {$page eq ""} { set errorMsg cannot resolve '$object_name' in package [$package_id package_url] - my log "Error: $errorMsg" + ad_log error $errorMsg ns_return 406 text/plain "Error: $errorMsg" } elseif {[catch {set msg [$page call_action \ -action $action \ -attributes $attributes]} errorMsg]} { - my log "Error: $uri $action $attributes resulted in\n$errorMsg\n$::errorInfo" + ad_log error "$uri $action $attributes resulted in $errorMsg" ns_return 406 text/plain "Error: $errorMsg\n" } else { ns_return 200 text/plain "Success: $msg\n"