Index: openacs-4/packages/xowf/xowf.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/xowf.info,v diff -u -r1.12.2.6 -r1.12.2.7 --- openacs-4/packages/xowf/xowf.info 25 Nov 2019 14:51:46 -0000 1.12.2.6 +++ openacs-4/packages/xowf/xowf.info 25 Jan 2020 13:40:39 -0000 1.12.2.7 @@ -10,15 +10,15 @@ t xowf - + Gustaf Neumann XoWiki Content Flow - an XoWiki based workflow system implementing state-based behavior of wiki pages and forms 2017-08-06 WU Vienna 2 - - + + Index: openacs-4/packages/xowf/lib/online-exam-answer.wf =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/lib/online-exam-answer.wf,v diff -u -r1.2.2.13 -r1.2.2.14 --- openacs-4/packages/xowf/lib/online-exam-answer.wf 13 Dec 2019 17:56:28 -0000 1.2.2.13 +++ openacs-4/packages/xowf/lib/online-exam-answer.wf 25 Jan 2020 13:40:39 -0000 1.2.2.14 @@ -182,11 +182,18 @@ set position [$obj property position] set parent_id [$obj parent_id] - #:msg "waiting_form_loader $form_title [$obj instance_attributes]" + #:msg "working_form_loader [$obj instance_attributes]" set parent_obj [::xo::db::CrClass get_instance_from_db -item_id $parent_id] set parent_state [$parent_obj state] # + # In case shuffling is required, fetch via the shuffled position. + # + set shuffle_id [expr {[$parent_obj property shuffle_items 0] ? [$obj creation_user] : -1}] + set position [::xowf::test_item::question_manager shuffled_index \ + -shuffle_id $shuffle_id \ + $parent_obj $position] + # # Load the form. # set form_obj [::xowf::test_item::question_manager nth_question_obj $parent_obj $position] @@ -201,22 +208,27 @@ # # Update the title of the page # - :set_title $obj -for_question -with_minutes + :set_title $obj -position $position -for_question -with_minutes return $form_obj } # # Set "title" with question/user/IP information. # -:proc set_title {obj {-for_question:switch false} {-with_minutes:switch false}} { +:proc set_title { + obj + -position:integer + {-for_question:switch false} + {-with_minutes:switch false} +} { set parent_obj [::xo::db::CrClass get_instance_from_db -item_id [$obj parent_id]] if {$for_question && [$obj state] eq "working"} { set form_info [::xowf::test_item::question_manager nth_question_form \ -with_numbers \ -with_title \ -with_minutes=$with_minutes \ - -position [$obj property position] \ + -position $position \ $parent_obj] set titleString [dict get $form_info title_infos full_title] set title [list [string trim $titleString]] @@ -236,13 +248,15 @@ # :proc summary_form {ctx form_title} { set obj [$ctx object] + set parent_obj [::xo::db::CrClass get_instance_from_db -item_id [$obj parent_id]] #:msg "summary_form_loader $form_title [$obj instance_attributes]" - set parent_obj [::xo::db::CrClass get_instance_from_db -item_id [$obj parent_id]] + set shuffle_id [expr {[$parent_obj property shuffle_items 0] ? [$obj creation_user] : -1}] set form_info [::xowf::test_item::question_manager combined_question_form \ -with_numbers \ -with_title \ -with_minutes \ + -shuffle_id $shuffle_id \ $parent_obj] set summary_form [dict get $form_info form] Index: openacs-4/packages/xowf/tcl/test-item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/test-item-procs.tcl,v diff -u -r1.7.2.17 -r1.7.2.18 --- openacs-4/packages/xowf/tcl/test-item-procs.tcl 17 Jan 2020 12:46:27 -0000 1.7.2.17 +++ openacs-4/packages/xowf/tcl/test-item-procs.tcl 25 Jan 2020 13:40:39 -0000 1.7.2.18 @@ -973,7 +973,7 @@ } :public object method get_form_object {{-set_title:boolean true} ctx:object form_name} { - #:msg "renaming_form_loader for form_name <$form_name>" + #ns_log notice "renaming_form_loader get_form_object for form_name <$form_name>" set form_id [$ctx default_load_form_id $form_name] set obj [$ctx object] set form_obj [::xo::db::CrClass get_instance_from_db -item_id $form_id] @@ -1288,6 +1288,7 @@ -package_id [$obj package_id] \ -default_lang [$obj lang] \ -forms $questionNames] + #ns_log notice "load_question_objs called with $obj $names -> $questionForms" return $questionForms } @@ -1300,16 +1301,46 @@ return [:load_question_objs $obj [:current_question_name $obj]] } - :public object method question_objs {obj:object} { - return [:load_question_objs $obj [$obj property question]] + + :public object method shuffled_question_objs {obj:object shuffle_id} { + set form_objs [:question_objs $obj] + set result {} + foreach i [::xowiki::randomized_indices -seed $shuffle_id [llength $form_objs]] { + lappend result [lindex $form_objs $i] + } + return $result } + + :public object method shuffled_index {{-shuffle_id:integer -1} obj:object position} { + if {$shuffle_id > -1} { + set form_objs [:question_objs $obj] + set shuffled [::xowiki::randomized_indices -seed $shuffle_id [llength $form_objs]] + set position [lindex $shuffled $position] + } + return $position + } + + :public object method question_objs {{-shuffle_id:integer -1} obj:object} { + set form_objs [:load_question_objs $obj [$obj property question]] + if {$shuffle_id > -1} { + set result {} + foreach i [::xowiki::randomized_indices -seed $shuffle_id [llength $form_objs]] { + lappend result [lindex $form_objs $i] + } + set form_objs $result + } + return $form_objs + } + :public object method question_names {obj:object} { return [$obj property question] } :public object method nth_question_obj {obj:object position:integer} { set questions [dict get [$obj instance_attributes] question] - return [:load_question_objs $obj [lindex $questions $position]] + set result [:load_question_objs $obj [lindex $questions $position]] + #ns_log notice "nth_question_obj called with $position -> $result" + return $result } :object method question_info { @@ -1384,9 +1415,10 @@ {-with_numbers:switch false} {-with_title:switch false} {-with_minutes:switch false} + {-shuffle_id:integer -1} obj:object } { - set form_objs [:question_objs $obj] + set form_objs [:question_objs -shuffle_id $shuffle_id $obj] if {$with_numbers} { set numbers "" for {set i 1} {$i <= [llength $form_objs]} {incr i} { Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -r1.180.2.29 -r1.180.2.30 --- openacs-4/packages/xowiki/xowiki.info 19 Jan 2020 21:07:06 -0000 1.180.2.29 +++ openacs-4/packages/xowiki/xowiki.info 25 Jan 2020 13:40:39 -0000 1.180.2.30 @@ -10,7 +10,7 @@ t xowiki - + Gustaf Neumann A xotcl-based enterprise wiki system with multiple object types 2017-08-06 @@ -55,7 +55,7 @@ BSD-Style 2 - + Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v diff -u -r1.284.2.68 -r1.284.2.69 --- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 19 Jan 2020 21:07:06 -0000 1.284.2.68 +++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 25 Jan 2020 13:40:39 -0000 1.284.2.69 @@ -3261,24 +3261,10 @@ # then the shuffling is stable for this seed. # if {${:shuffle_kind} ne "always"} { - - #ns_log notice "===================== randomized_indices ${:shuffle_kind} [${:object} item_id]" - expr {srand([xo::cc user_id])} + set shuffled [::xowiki::randomized_indices -seed [xo::cc user_id] $length] + } else { + set shuffled [::xowiki::randomized_indices $length] } - # - # Produce shuffled indices between 0 and length-1. - # - set indices {} - for {set i 0} {$i < $length} {incr i} { - lappend indices $i - } - set shuffled {} - incr length - for {} {$length > 1} {incr length -1} { - set i [expr {int(($length-1) * rand())}] - lappend shuffled [lindex $indices $i] - set indices [lreplace $indices $i $i] - } return $shuffled } Index: openacs-4/packages/xowiki/tcl/package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v diff -u -r1.332.2.43 -r1.332.2.44 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 26 Nov 2019 21:53:52 -0000 1.332.2.43 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 25 Jan 2020 13:40:39 -0000 1.332.2.44 @@ -455,15 +455,17 @@ Generate a (minimal) link to a wiki page with the specified name. Practically all links in the xowiki systems are generated through - this function. The function returns the URL path urlencoded, + this method. The method returns the URL path urlencoded, unless path_encode is set to false. @param anchor anchor to be added to the link + @param query query parameters to be added literally to the resulting URL @param absolute make an absolute link (including protocol and host) @param lang use the specified 2 character language code (rather than computing the value) @param download create download link (without m=download) @param parent_id parent_id @param name name of the wiki page + @param path_encode control URL encoding of the path segmemts } { #:msg "input name=$name, lang=$lang parent_id=$parent_id" Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -r1.542.2.64 -r1.542.2.65 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 20 Jan 2020 11:42:29 -0000 1.542.2.64 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 25 Jan 2020 13:40:39 -0000 1.542.2.65 @@ -2316,7 +2316,7 @@ Page instforward item_ref {%my package_id} %proc - Page ad_instproc -private pretty_link { + Page ad_instproc pretty_link { {-anchor ""} {-query ""} {-absolute:boolean false} @@ -2325,8 +2325,22 @@ {-download false} {-path_encode:boolean true} } { - @see ::xowiki::Package instproc pretty_link + This method is a convenience stub for Package->pretty_link + and can be overloaded for different pages types. + + Note that it is necessary to initialize the package before this + method can be used. + + @param anchor anchor to be added to the link + @param query query parameters to be added literally to the resulting URL + @param absolute make an absolute link (including protocol and host) + @param lang use the specified 2 character language code (rather than computing the value) + @param download create download link (without m=download) + @param path_encode control encoding of the url path. Returns the URL path urlencoded, + unless path_encode is set to false. + @return the pretty_link for the current page + @see ::xowiki::Package instproc pretty_link } { ${:package_id} pretty_link -parent_id ${:parent_id} \ -anchor $anchor -query $query -absolute $absolute -siteurl $siteurl \ Index: openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl,v diff -u -r1.57.2.10 -r1.57.2.11 --- openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl 22 Nov 2019 16:15:25 -0000 1.57.2.10 +++ openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl 25 Jan 2020 13:40:39 -0000 1.57.2.11 @@ -54,6 +54,35 @@ return $text } + ad_proc randomized_indices {-seed length} { + # + # Produce a list of "length" random numbers between 0 and + # length-1. + # + } { + # In case, the seed is specified, set the seed to this value to + # achieve e.g. a stable bat random order for a user. + # + if {[info exists seed]} { + expr {srand($seed)} + } + # + # Produce shuffled indices between 0 and length-1. + # + set indices {} + for {set i 0} {$i < $length} {incr i} { + lappend indices $i + } + set shuffled {} + incr length + for {} {$length > 1} {incr length -1} { + set i [expr {int(($length-1) * rand())}] + lappend shuffled [lindex $indices $i] + set indices [lreplace $indices $i $i] + } + return $shuffled + } + # # # Helper for virus checks