+
[ns_quotehtml $examTitle]
+ [lang::util::localize $HTML]
+ }]
+ set HTML ""
+ }
+
+ if {$export} {
+ set recutil [:recutil_create \
+ -clear \
+ -exam_id [$wf parent_id] \
+ -fn [expr {$filter_submission_id eq "" ? "all.rec" : "$filter_submission_id.rec"}]
+ ]
+ } else {
+ set recutil ""
+ }
+ #ns_log notice "RENDER ANSWERS 2"
+
+ #
+ # Create zip file from file submissions
+ #
+ set create_zip_file [::xo::cc query_parameter create-file-submission-zip-file:boolean 0]
+ if {$create_zip_file} {
+ package req nx::zip
+
+ [$examWf package_id] get_lang_and_name -name [$examWf set name] lang stripped_name
+
+ if {[string equal [nx::zip::Archive info lookup parameters create name] -name]} {
+ set zipFile [nx::zip::Archive new -name [ad_sanitize_filename $stripped_name]]
+ } else {
+ set zipFile [::nx::zip::Archive new]
+ #
+ # Post-register property, since it is not yet available in
+ # this version of nx.
+ #
+ $zipFile object property name
+ $zipFile configure -name [ad_sanitize_filename $stripped_name]
+ }
+ } else {
+ set zipFile ""
+ }
+ #ns_log notice "RENDER ANSWERS 3 (submissions: [llength [$items children]])"
+
+ set file_submission_exists 0
+
+ set form_objs_exam [:QM load_question_objs $examWf [$examWf property question]]
+ set question_dict [:FL name_to_question_obj_dict $form_objs_exam]
+ #ns_log notice "passed filter_form_ids <$filter_form_ids> form_objs_exam <$form_objs_exam>"
+
+ #
+ # Iterate over the items sorted by orderby.
+ #
+ $items orderby $orderby
+ foreach submission [$items children] {
+
+ set d [:render_submission=exam_protocol \
+ -submission $submission \
+ -wf $wf \
+ -examWf $examWf \
+ -exam_question_dict $question_dict \
+ -autograde $autograde \
+ -combined_form_info $combined_form_info \
+ -filter_submission_id $filter_submission_id \
+ -filter_form_ids $filter_form_ids \
+ -grading_scheme $grading_scheme \
+ -recutil $recutil \
+ -zipFile $zipFile \
+ -revision_id $revision_id \
+ -totalPoints $totalPoints \
+ -runtime_panel_view $runtime_panel_view \
+ -with_exam_heading [expr {!$as_student}] \
+ -with_signature $withSignature]
+
+ set html [:dict_value $d HTML]
+ #ns_log notice "RENDER ANSWERS setting result"
+
+ dict set results [$submission set creation_user] [:dict_value $d results]
+
+ if {$do_stream && $html ne ""} {
+ ns_write [lang::util::localize $html]
+ } else {
+ append HTML $html
+ }
+
+ #
+ # Check if we have found a file submission
+ #
+ if {!$file_submission_exists
+ && !$export
+ && [llength [:get_non_empty_file_formfields -submission $submission]] > 0
+ } {
+ set file_submission_exists 1
+ }
+
+ }
+ #ns_log notice "RENDER ANSWERS 4"
+
+ if {$export} {
+ $recutil destroy
+ }
+
+ if {$with_grading_table && $autograde && $grading ne "none"} {
+ append HTML
[:grading_table -csv ${:grade_csv} ${:grade_dict}]
+ #
+ # The following lines are convenient for debugging
+ #
+ #set manual_gradings [$examWf property manual_gradings]
+ #set manual_gradings [:get_exam_results -obj $examWf manual_gradings]
+ #append HTML
$manual_gradings
+ #append HTML
[:exam_results -manual_gradings $manual_gradings $results]
+ }
+
+ if {$create_zip_file} {
+ $zipFile ns_returnZipFile [$zipFile cget -name].zip
+ $zipFile destroy
+ ad_script_abort
+ }
+
+ #
+ # If we have already some file submission we are showing a link
+ # for bulk-downloading the submissions
+ #
+ if {$file_submission_exists} {
+ #
+ # Avoid empty entries for query parameters
+ #
+ if {[llength $filter_form_ids] > 0} {
+ set fos $filter_form_ids
+ }
+ foreach value {revision_id filter_submission_id} var {rid id} {
+ if {[set $value] ne ""} {
+ set $var [set $value]
+ }
+ }
+ set href [$examWf pretty_link -query [export_vars {
+ {m print-answers} {create-file-submission-zip-file 1}
+ fos rid id
+ }]]
+ append HTML [ns_trim -delimiter | [subst {
+ |
+ |[::xowiki::bootstrap::icon -name download -CSSclass download-submissions]
+ |#xowf.Download_file_submissions#
+ }]]
+ }
+ #ns_log notice "RENDER ANSWERS 5"
+
+ #
+ # Store statistics only in autograding cases, and only, when it
+ # was a full evaluation of the exam. This has the advantage
+ # that we do no have to partially update the statistics. These
+ # are somewhat overly conservative assumptions for now, which
+ # might be partially relaxed in the future.
+ #
+ if {$with_grading_table
+ && !$as_student && $filter_submission_id eq "" && $creation_user eq "" && $revision_id eq ""
+ } {
+ set statistics {}
+ set ia [$examWf instance_attributes]
+ if {$autograde} {
+ foreach var {__stats_success __stats_count} key {success count} {
+ if {[$examWf exists $var]} {
+ dict set statistics $key [$examWf set $var]
+ $examWf unset $var
+ }
+ }
+ :AM set_exam_results -obj $examWf statistics $statistics
+ }
+ :AM set_exam_results -obj $examWf results $results
+ }
+
+ return [list do_stream $do_stream HTML $HTML]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: participant_result
+ #----------------------------------------------------------------------
+ :method participant_result {
+ -obj:object
+ answerObj:object
+ form_info
+ form_field_objs
+ } {
+
+ :assert_answer_instance $answerObj
+ :assert_assessment $obj
+
+ set instance_attributes [$answerObj instance_attributes]
+ set answer [list item $answerObj]
+
+ foreach f $form_field_objs {
+ set att [$f name]
+
+ if {[dict exists $instance_attributes $att]} {
+ set value [dict get $instance_attributes $att]
+ #ns_log notice "### '$att' value '$value'"
+ $answerObj combine_data_and_form_field_default 1 $f $value
+ $f set_feedback 1
+
+ #
+ # TODO: world-cloud statistics make mostly sense for the
+ # inclass quizzes, but there these require still an
+ # interface via "reporting_obj" instead of "add_statistics"
+ # (although, for the purposes of the inclass-quiz,
+ # randomization is not an issue.
+ #
+ #$f add_statistics -options {word_statistics word_cloud}
+
+ #
+ # Leave the form-field in statistics mode in a state with
+ # correct answers.
+ #
+ $f make_correct
+ #ns_log notice "FIELD $f [$f name] [$f info class] -> VALUE [$f set value]"
+ if {[$f exists correction]} {
+ set correction [$f set correction]
+ } else {
+ set correction ""
+ ns_log warning "form-field [$f name] of type [$f info class] " \
+ "does not provide variable correction via 'make_correct'"
+ }
+ lappend answer \
+ [list name $att \
+ value $value \
+ correction $correction \
+ evaluated_answer_result [$f set evaluated_answer_result]]
+ }
+ }
+ return $answer
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: answer_form_field_objs
+ #----------------------------------------------------------------------
+ :public method answer_form_field_objs {-clear:switch -wf:object -generic:switch form_info} {
+ #
+ # Instantiate the form_field objects of the provided form based on
+ # form_info.
+ #
+ set key ::__test_item_answer_form_fields
+ if {$clear} {
+ #
+ # The -clear option is needed, when there are multiple
+ # assessments protocols/tables on the same page (currently
+ # not).
+ #
+ unset -nocomplain $key
+ } else {
+ #ns_log notice "### answer_form_field_objs key exists [info exists $key]"
+ if {![info exists $key]} {
+ #ns_log notice "form_info: $form_info"
+ set fc [lsort -unique [dict get $form_info disabled_form_constraints]]
+ #ns_log notice "### FC $fc"
+ set pc_params [::xo::cc perconnection_parameter_get_all]
+ if {$generic} {
+ set fc [:replace_in_fc -fc $fc shuffle_kind none]
+ set fc [:replace_in_fc -fc $fc show_max ""]
+ }
+ set $key [$wf create_form_fields_from_form_constraints -lookup $fc]
+ ::xo::cc perconnection_parameter_set_all $pc_params
+ $wf form_field_index [set $key]
+ }
+ return [set $key]
+ }
+ }
+
+ :method "result_table per_question" {
+ {-manual_gradings "" }
+ results_dict
+ } {
+ set table [::xowiki::TableWidget new \
+ -name results \
+ -columns {
+ Field create participant -label #xowf.participant# \
+ -orderby participant
+ Field create question -label #xowf.question#
+ Field create achieved -label #xowf.Achieved_points# \
+ -orderby achieved -html {align right}
+ Field create achievable -label #xowf.Achievable_points# \
+ -orderby achievable -html {align right}
+ Field create comment -label #xowf.feedback#
+ }]
+ foreach user_id [dict keys $results_dict] {
+ set manual_grading [:dict_value $manual_gradings $user_id]
+ set participant [acs_user::get_element -user_id $user_id -element username]
+ foreach qn [dict keys [dict get $results_dict $user_id]] {
+ set achievable [dict get $results_dict $user_id $qn achievable]
+ set achieved [:dict_value [:dict_value $manual_grading $qn] achieved]
+ if {$achieved eq ""} {
+ set achieved [dict get $results_dict $user_id $qn achieved]
+ }
+ $table add \
+ -participant $participant \
+ -question [string trimright $qn _] \
+ -achievable $achievable \
+ -achieved [expr {$achieved eq "" ? "" : [format %.2f $achieved]}] \
+ -comment [:dict_value [:dict_value $manual_grading $qn] comment]
+ }
+ }
+ return $table
+ }
+
+ :method "result_table per_participant" {
+ {-manual_gradings ""}
+ {-gradingScheme}
+ {-only_grades:boolean false}
+ results_dict
+ } {
+ ns_log notice "per_participant gradingScheme $gradingScheme"
+ #
+ # In case "only_grades" is specified, hide field "achieved".
+ #
+ set fieldType [expr {$only_grades ? "HiddenField" : "Field"}]
+ set fieldTypeGrade [expr {$gradingScheme eq "::xowf::test_item::grading::none"
+ ? "HiddenField"
+ : "Field"}]
+ set grade_dict {}
+ set table \
+ [::xowiki::TableWidget new \
+ -name results \
+ -columns [subst {
+ Field create participant -label #xowf.participant# \
+ -orderby participant
+ $fieldType create achieved -label #xowf.Achieved_points# \
+ -orderby achieved -html {align right}
+ HiddenField create achievable -label #xowf.Achievable_points# \
+ -orderby achievable -html {align right}
+ $fieldType create percentage -label #xowf.Percentage# \
+ -orderby percentage -html {align right}
+ $fieldTypeGrade create grade -label #xowf.Grade# \
+ -orderby grade -html {align right}
+ }]]
+ #ns_log notice "We have in results_dict the following users: [dict keys $results_dict]"
+ foreach {user_id properties} $results_dict {
+ if {[llength $properties] == 0} {
+ #
+ # The user has not seen any exercises, probably in "initial"
+ # state, ignore it.
+ #
+ continue
+ }
+ set manual_grading [:dict_value $manual_gradings $user_id]
+ set achievedPoints 0.0
+ set achievablePoints 0.0
+ set participant [acs_user::get_element -user_id $user_id -element username]
+ foreach qn [dict keys [dict get $results_dict $user_id]] {
+ set achievable [dict get $results_dict $user_id $qn achievable]
+ #
+ # Respect manual_grading, since these are eagerly updated
+ # via exam protocol.
+ #
+ set achieved [:dict_value [:dict_value $manual_grading $qn] achieved]
+ if {$achieved eq ""} {
+ set achieved [dict get $results_dict $user_id $qn achieved]
+ }
+
+ #
+ # When a participant has not done yet this exercise, the
+ # value might be empty.
+ #
+ if {$achieved eq ""} {
+ set achieved 0
+ }
+ set achievedPoints [expr {$achievedPoints + $achieved}]
+ set achievablePoints [expr {$achievablePoints + $achievable}]
+ }
+ set gradingDict [$gradingScheme grading_dict [list achievedPoints $achievedPoints \
+ achievablePoints $achievablePoints \
+ totalPoints $achievablePoints]]
+ #ns_log notice "COMPLETED DICT $gradingDict"
+ set grade [$gradingScheme grade -achieved_points $gradingDict]
+ dict incr grade_dict $grade
+
+ set l [::xo::Table::Line new]
+ $table add \
+ -participant $participant \
+ -achievable $achievablePoints \
+ -achieved [dict get $gradingDict achievedPoints] \
+ -percentage [dict get $gradingDict percentageRounded] \
+ -grade $grade
+
+ }
+ $table set __grade_dict $grade_dict
+ return $table
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: exam_results
+ #----------------------------------------------------------------------
+ :public method exam_results {
+ {-manual_gradings "" }
+ {-gradingScheme ""}
+ {-only_grades:boolean false}
+ {-reply:switch false}
+ {-format csv}
+ {-orderby "participant,desc"}
+ results_dict
+ } {
+ #
+ # Return results either as HTML table, as HTML chart or as
+ # csv. When "reply" is set. the result is returned directly to
+ # the browser (for downloading).
+ #
+ # When "gradingScheme" is empty, this method returns the
+ # following fields:
+ #
+ # participant, question, achieved_points, achievable points, comment
+ #
+ # When the "gradingScheme" is specified the results are
+ # per-participant. In this cases, when the "gradingScheme" is
+ # "....::none", the fields are
+ #
+ # participant, achieved, percentage
+ #
+ # otherwise the grade and rounding of achieved points and
+ # percentage are exported based on the rules of the grading
+ # scheme.
+ #
+ # participant, achieved, percentage, grade
+ #
+ # When additionally "only_grades" is specified, just participant
+ # and grad are returned/exported.
+ #
+ # @param gradingScheme needed for reporting grades, can be empty
+ # @param reply when false, csv will be returned as text, when
+ # true, it will be returned as response to the
+ # browser.
+ # @param results_dict the results to format as csv, every key in
+ # the dict represents a user_id.
+ #
+ # @return csv as value or as response to the client
+ #
+ set result ""
+ if {$gradingScheme eq ""} {
+ set t [:result_table per_question \
+ -manual_gradings $manual_gradings \
+ $results_dict]
+ } else {
+ set t [:result_table per_participant \
+ -gradingScheme $gradingScheme \
+ -only_grades $only_grades \
+ -manual_gradings $manual_gradings \
+ $results_dict]
+ }
+
+ lassign [split $orderby ,] att order
+
+ $t orderby \
+ -order [expr {$order eq "asc" ? "increasing" : "decreasing"}] \
+ -type [ad_decode $att achieved real achievable real grade integer dictionary] \
+ $att
+
+ #
+ # XLS export requires OOXML
+ #
+ # See https://fossil.sowaswie.de/ooxml/index
+ #
+ if {$format eq "xls" &&
+ [::namespace which ::ooxml::xl_write] eq ""} {
+ set format csv
+ }
+
+ if {$reply} {
+ switch $format {
+ html {
+ ns_return 200 "text/html; charset=utf-8" [$t asHTML]
+ ad_script_abort
+ }
+ xls {
+ set s [::ooxml::xl_write new]
+ set sheet [$s worksheet {1}]
+ set decimal [lc_get "decimal_point"]
+ set doublestyle [$s style -numfmt [$s numberformat -decimal -format "#${decimal}##"]]
+ set stringstyle [$s style -numfmt [$s numberformat -string]]
+ set datestyle [$s style -numfmt [$s numberformat -date]]
+ set cellformat {}
+
+ #iterate cols of table
+ $s row $sheet
+ set displayColumns [lmap column [${t}::__columns children] {
+ if {[$column exists no_csv]} continue
+ if {[$column istype ::xo::Table::BulkAction]} continue
+ if {[$column istype ::xo::Table::HiddenField]} continue
+ set column
+ }]
+ foreach column $displayColumns {
+ if {[$column name] in {"achieved" "achievable" "percentage"}} {
+ lappend cellformat double
+ } else {
+ lappend cellformat string
+ }
+ set label [$column label]
+ if {[regexp {^#([a-zA-Z0-9_:-]+\.[a-zA-Z0-9_:-]+)#$} $label _ message_key]} {
+ set label [_ $message_key]
+ }
+ set value [string map {\" \\\" \n \r} $label]
+ $s cell $sheet $value
+ }
+ #iterate row content
+ foreach row [$t children] {
+ $s row $sheet
+ set i 0
+ foreach column $displayColumns {
+ set value [string map {\" \\\" \n \r} [$row set [$column set name]]]
+ set format [lindex $cellformat $i]
+ $s cell $sheet $value -style [set [set format]style]
+ incr i
+ }
+ }
+ $s write results.xlsx
+ ad_script_abort
+ }
+ default {set result [$t write_csv]}
+ }
+ } else {
+ switch $format {
+ chart {set result [:grading_table [$t set __grade_dict]]}
+ html {set result [$t asHTML]}
+ default {set result [$t format_csv]}
+ }
+ }
+ $t destroy
+ return $result
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: grading_table
+ #----------------------------------------------------------------------
+ :public method grading_table {{-csv ""} grade_dict} {
+ #
+ # Produce HTML markup based on a dict with grades as keys and
+ # counts as values.
+ #
+ set gradingTable {
}
+ append gradingTable \
+ "#xowf.Grade# # \n"
+ set nrGrades 0
+ foreach v [dict values $grade_dict] { incr nrGrades $v}
+ set grades [lsort [dict keys $grade_dict]]
+ foreach k $grades {
+ set count [dict get $grade_dict $k]
+ set countPercentage [format %.2f [expr {$count *100.0 / $nrGrades}]]
+ append gradingTable \
+ \
+ [subst {$k $count }] \
+ [subst {$countPercentage%
\n
+ }
+ append gradingTable "
\n"
+ if {$csv ne "" } {
+ append gradingTable "
$csv \n"
+ }
+
+ if {[template::head::can_resolve_urn urn:ad:js:highcharts]} {
+ #
+ # The highcharts package is available
+ #
+ template::add_body_script -src urn:ad:js:highcharts
+ set graphID pie-[incr ::__xotcl_highcharts_pie]
+ append gradingTable "
\n"
+ set data ""
+ foreach k $grades {
+ set count [dict get $grade_dict $k]
+ set countPercentage [format %.2f [expr {$count *100.0 / $nrGrades}]]
+ lappend data [subst {{name:'$k', y: $countPercentage}}]
+ }
+ set gradeLabel [_ xowf.Grade]
+ template::add_body_script -script [subst [ns_trim {
+ Highcharts.chart('$graphID', {
+ chart: {type: 'pie'},
+ plotOptions: {pie: {size: 200}, series: {dataLabels: {enabled: true, format: '$gradeLabel {point.name}: {point.y:.1f}%'} }},
+ title: {text: ''},
+ credits: {enabled: true },
+ series: \[{name: 'Percentage', data: \[ [join $data ,] \]}\]
+ });
+ }]]
+ }
+ return $gradingTable
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: results_table
+ #----------------------------------------------------------------------
+ :public method results_table {
+ -package_id:integer
+ -items:object,required
+ {-view_all_method print-answers}
+ {-with_answers:boolean true}
+ {-state done}
+ {-grading_scheme ::xowf::test_item::grading::none}
+ wf:object
+ } {
+ #
+ # Render the results in format of a table and return HTML.
+ # Currently mostly deactivated (but potentially called by
+ # online-exam.wf and topic-assignment.wf).
+ #
+
+ #set form_info [:combined_question_form -with_numbers $wf]
+ set form_info [:QM combined_question_form $wf]
+ set answer_form_field_objs [:answer_form_field_objs -wf $wf $form_info]
+ set autograde [dict get $form_info autograde]
+
+ #if {$autograde && [llength $answer_form_field_objs] > 10} {
+ # set with_answers 0
+ #}
+
+ set form_field_objs {}
+ lappend form_field_objs \
+ [$wf create_raw_form_field \
+ -name _online-exam-userName \
+ -spec text,label=#xowf.participant#]
+
+ if {$with_answers} {
+ #
+ # Create for every answer field a matching grading field
+ #
+ set ff_dict {}
+ foreach answer_field_obj $answer_form_field_objs {
+ #ns_log notice "LABEL [$answer_field_obj name] <[$answer_field_obj label]>"
+ $answer_field_obj label [string trimright [$answer_field_obj name] _]
+ $answer_field_obj mixin ::xowf::test_item::td_pretty_value
+
+ set grading_field_obj [$wf create_raw_form_field \
+ -name [$answer_field_obj name].score \
+ -spec number,label=#xowf.Grading-Score#]
+ lappend form_field_objs \
+ $answer_field_obj \
+ $grading_field_obj
+ dict set ff_dict [$answer_field_obj name] $answer_field_obj
+ dict set ff_dict [$grading_field_obj name] $grading_field_obj
+ }
+ }
+
+ # if {0 && $autograde} {
+ # lappend form_field_objs \
+ # [$wf create_raw_form_field \
+ # -name _online-exam-total-score \
+ # -spec number,label=#xowf.Total-Score#] \
+ # [$wf create_raw_form_field \
+ # -name _online-exam-grade \
+ # -spec number,label=#xowf.Grade#]
+ # }
+
+ lappend form_field_objs \
+ [$wf create_raw_form_field \
+ -name _online-exam-seconds \
+ -spec number,label=#xowf.Seconds#] \
+ [$wf create_raw_form_field \
+ -name _creation_date \
+ -spec date,label=#xowiki.Page-last_modified#]
+
+ #
+ # Check, if any of the answer form field objects is
+ # randomized. If so, it is necessary to recreate these eagerly,
+ # since the full object structure might be personalized.
+ #
+ set randomized_fields {}
+ foreach ff_obj $answer_form_field_objs {
+ if {[$ff_obj exists shuffle_kind] && [$ff_obj shuffle_kind] ne "none"} {
+ lappend randomized_fields $ff_obj
+ }
+ }
+
+ #
+ # Take "orderby" from the query parameter. If not set, order by
+ # the first field.
+ #
+ set orderby [::$package_id query_parameter orderby:token ""]
+ if {$orderby eq "" && [llength $form_field_objs] > 0} {
+ set orderby [[lindex $form_field_objs 0] name],asc
+ }
+
+ #
+ # Create table widget.
+ #
+ set table_widget [::xowiki::TableWidget create_from_form_fields \
+ -package_id $package_id \
+ -form_field_objs $form_field_objs \
+ -orderby $orderby]
+ #
+ # Extend properties of every answer with corresponding ".score"
+ # values.
+ #
+ foreach p [$items children] {
+ #
+ # If we have randomized fields, we have to
+ # recreate/reinitialize these to get proper correction
+ # markings for this user. It might be possible to optimize
+ # this, when only a few fields are randomized.
+ #
+ if {[llength $randomized_fields] > 0} {
+ #ns_log notice "WORK ON [$p creation_user] "
+ :answer_form_field_objs -clear -wf $wf $form_info
+ $wf form_field_flush_cache
+ xo::cc eval_as_user -user_id [$p creation_user] {
+ set answer_form_field_objs [:answer_form_field_objs -wf $wf $form_info]
+ }
+ }
+
+ set total_score 0
+ set total_points 0
+ foreach ff_obj $answer_form_field_objs {
+ $ff_obj object $p
+ set property [$ff_obj name]
+ $ff_obj value [$p property $property]
+
+ $ff_obj set_feedback 3
+
+ #ns_log notice "[$p creation_user] [$ff_obj name] [$p property $property] -> [$ff_obj set evaluated_answer_result]"
+ set r [expr {[$ff_obj exists grading_score] ? [$ff_obj set grading_score] : ""}]
+ #
+ # In case, we have a grading score, which is not starred, we
+ # can compute points from this.
+ #
+ if {$r ne "" && ![regexp {[*]$} $r]} {
+ #
+ # Add exercise score weighted to the total score to
+ # compute points.
+ #
+ if {[$ff_obj exists test_item_points]} {
+ #ns_log notice "[$ff_obj name]: grading_score <$r>, test_item_points <[$ff_obj set test_item_points]>"
+
+ set minutes [$ff_obj set test_item_points]
+ set total_score [expr {$total_score + ($minutes * [$ff_obj set grading_score])}]
+ set total_points [expr {$total_points + $minutes}]
+ }
+ #ns_log notice "==== [$ff_obj name] grading_score => $r"
+ } else {
+ set r [expr {[$ff_obj set evaluated_answer_result] eq "correct" ? 100.0 : 0.0}]*
+ #ns_log notice [$ff_obj serialize]
+ }
+ $p set_property -new 1 $property.score $r
+ }
+
+ set duration [:get_duration [$p get_revision_sets]]
+ $p set_property -new 1 _online-exam-seconds [dict get $duration seconds]
+
+ # if {0 && $autograde && $total_points > 0} {
+ # set final_score [expr {$total_score/$total_points}]
+ # $p set_property -new 1 _online-exam-total-score $final_score
+ #
+ # set d [list achievedPoints $total_score achievablePoints $total_points totalPoints $total_points]
+ # set grade [$grading_scheme grade -achieved_points $d]
+ # dict incr grade_count $grade
+ # $p set_property -new 1 _online-exam-grade $grade
+ # }
+ }
+
+ if {$state eq "done"} {
+ set uc {tcl {[$p state] ne "done"}}
+ } else {
+ set uc {tcl {false}}
+ }
+
+ #
+ # Render table widget with extended properties.
+ #
+ set HTML [$table_widget render_page_items_as_table \
+ -package_id $package_id \
+ -items $items \
+ -form_field_objs $form_field_objs \
+ -csv true \
+ -uc $uc \
+ -view_field _online-exam-userName \
+ -view_filter_link [$wf pretty_link -query m=$view_all_method] \
+ {*}[expr {[info exists generate] ? [list -generate $generate] : ""}] \
+ -return_url [ad_return_url] \
+ -return_url_att local_return_url \
+ ]
+ $table_widget destroy
+
+ if {0 && $autograde} {
+ set gradingTable {
}
+ append gradingTable \
+ "#xowf.Grade# # \n"
+ set nrGrades 0
+ foreach v [dict values $grade_count] { incr nrGrades $v}
+ foreach k [lsort [dict keys $grade_count]] {
+ set count [dict get $grade_count $k]
+ set countPercentage [expr {$count*100.0/$nrGrades}]
+ append gradingTable \
+ \
+ [subst {$k $count }] \
+ [subst {$countPercentage%
\n
+ }
+ append gradingTable "
\n"
+ append HTML
$gradingTable
+ }
+ return $HTML
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: participants_table
+ #----------------------------------------------------------------------
+ :public method participants_table {
+ -package_id:integer
+ -items:object,required
+ {-view_all_method print-answers}
+ {-state done}
+ wf:object
+ } {
+ #
+ # This method returns an HTML table containing a row for every
+ # participant with Name and short summary information. This
+ # table provides as well an interface for sending messages to
+ # this student.
+ #
+ set form_field_objs {}
+ lappend form_field_objs \
+ [$wf create_raw_form_field \
+ -name _online-exam-userName \
+ -spec text,label=#xowf.participant#] \
+ [$wf create_raw_form_field \
+ -name _online-exam-fullName \
+ -spec label,label=#acs-subsite.Name#,disableOutputEscaping=true] \
+ [$wf create_raw_form_field \
+ -name _state \
+ -spec text,label=#xowf.Status#] \
+ [$wf create_raw_form_field \
+ -name _online-exam-seconds \
+ -spec number,label=#xowf.Seconds#] \
+ [$wf create_raw_form_field \
+ -name _creation_date \
+ -spec date,label=#xowiki.Page-last_modified#]
+
+ #
+ # Take "orderby" from the query parameter. If not set, order by
+ # the first field.
+ #
+ set orderby [::$package_id query_parameter orderby:token ""]
+ if {$orderby eq "" && [llength $form_field_objs] > 0} {
+ set orderby [[lindex $form_field_objs 0] name],asc
+ }
+
+ #
+ # Create table widget.
+ #
+ set table_widget [::xowiki::TableWidget create_from_form_fields \
+ -package_id $package_id \
+ -form_field_objs $form_field_objs \
+ -type_map {_online-exam-seconds integer} \
+ -orderby $orderby]
+ #
+ # Extend properties of individual answers and add notification
+ # dialogs.
+ #
+ set dialogs ""
+ set user_list {}
+ foreach p [$items children] {
+
+ #foreach ff_obj $answer_form_field_objs {
+ # $ff_obj object $p
+ # set property [$ff_obj name]
+ # $ff_obj value [$p property $property]
+ #}
+
+ #
+ # Provide a notification dialog only before the student has
+ # submitted her exam and the exam is published.
+ #
+ if {[$p state] ne "done" && [$wf state] eq "published"} {
+ set dialog_info [::xowiki::includelet::personal-notification-messages \
+ modal_message_dialog -to_user_id [$p creation_user]]
+ append dialogs [dict get $dialog_info dialog] \n
+ set notification_dialog_button [dict get $dialog_info link]
+ $p set online-exam-fullName "$notification_dialog_button [$p set online-exam-fullName]"
+ lappend user_list [$p creation_user]
+ }
+
+ #
+ # Extend every answer with corresponding precomputed extra
+ # "_online-exam-*" values to ease rendering:
+ #
+ set duration [:get_duration [$p get_revision_sets]]
+ $p set_property -new 1 _online-exam-seconds [dict get $duration seconds]
+ }
+
+ ::xowiki::includelet::personal-notification-messages \
+ modal_message_dialog_register_submit \
+ -url [$wf pretty_link -query m=send-participant-message]
+
+ set bulk_notification_HTML ""
+
+ if {$state eq "done"} {
+ set uc {tcl {[$p state] ne "done"}}
+ } else {
+ set uc {tcl {false}}
+
+ if {[llength $user_list] > 0} {
+ #
+ # Provide bulk notification message dialog to send message to all users
+ #
+ set dialog_info [::xowiki::includelet::personal-notification-messages \
+ modal_message_dialog -to_user_id $user_list]
+ append dialogs [dict get $dialog_info dialog] \n
+ set notification_dialog_button [dict get $dialog_info link]
+ set bulk_notification_HTML "
$notification_dialog_button #xowiki.Send_message_to# [llength $user_list] #xowf.Participants#
"
+ }
+ }
+ #
+ # Render table widget with extended properties.
+ #
+ set HTML [$table_widget render_page_items_as_table \
+ -package_id $package_id \
+ -items $items \
+ -form_field_objs $form_field_objs \
+ -csv true \
+ -uc $uc \
+ -view_field _online-exam-userName \
+ -view_filter_link [$wf pretty_link -query m=$view_all_method] \
+ {*}[expr {[info exists generate] ? [list -generate $generate] : ""}] \
+ -return_url [ad_return_url] \
+ -return_url_att local_return_url \
+ ]
+ $table_widget destroy
+ return $dialogs$HTML$bulk_notification_HTML
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: marked_results
+ #----------------------------------------------------------------------
+ :public method marked_results {-obj:object -wf:object form_info} {
+ #
+ # Return for every participant the individual results for an exam
+ #
+ set form_field_objs [:answer_form_field_objs -wf $wf $form_info]
+
+ set items [:get_wf_instances $wf]
+ set results ""
+ foreach i [$items children] {
+ xo::cc eval_as_user -user_id [$i creation_user] {
+ set participantResult [:participant_result -obj $obj $i $form_info $form_field_objs]
+ }
+ append results $participantResult \n
+ }
+
+ #ns_log notice "=== marked_results of [llength [$items children]] items => $results"
+ return $results
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: answers_panel
+ #----------------------------------------------------------------------
+ :public method answers_panel {
+ {-polling:switch false}
+ {-heading #xowf.submitted_answers#}
+ {-submission_msg #xowf.participants_answered_question#}
+ {-manager_obj:object}
+ {-target_state ""}
+ {-wf:object}
+ {-current_question ""}
+ {-extra_text ""}
+ } {
+ #
+ # Produce HTML code for an answers panel, containing the number
+ # of participants of an e-assessment and the number of
+ # participants, who have already answered.
+ #
+ # @param polling when specified, provide live updates
+ # of the numbers via AJAX calls
+ # @param extra_text optional extra text for the panel,
+ # has to be provided with valid HTML markup.
+ #
+
+ set answers [:get_answer_attributes $wf]
+ set nrParticipants [llength $answers]
+ if {$current_question ne ""} {
+ set answered [:FL answers_for_form \
+ [$current_question name] \
+ $answers]
+ } else {
+ set answered [:get_answer_attributes -state $target_state $wf]
+ }
+ set nrAnswered [llength $answered]
+
+ set answerStatus [::xowiki::bootstrap::card \
+ -title $heading \
+ -body [subst {
$nrAnswered/$nrParticipants
+ $submission_msg
$extra_text}]]
+
+ if {$polling} {
+ #
+ # Auto refresh of number of participants and submissions when
+ # polling is on.
+ #
+ set url [$manager_obj pretty_link -query m=poll]
+ template::add_body_script -script [subst -nocommands {
+ (function poll() {
+ setTimeout(function() {
+ var xhttp = new XMLHttpRequest();
+ xhttp.open("GET", '$url', true);
+ xhttp.onreadystatechange = function() {
+ if (this.readyState == 4 && this.status == 200) {
+ var data = xhttp.responseText;
+ var el = document.querySelector('#answer-status');
+ el.innerHTML = data;
+ poll();
+ //activate links if a users started the exam
+ var answers = data.split('/');
+ if (answers.length == 2 && answers[1] > 0) {
+ var disabledLinkItems = document.querySelectorAll(".list-group-item.link-disabled");
+ disabledLinkItems.forEach(function(linkItem) {
+ linkItem.classList.remove("link-disabled");
+ });
+ }
+ }
+ };
+ xhttp.send();
+ }, 1000);
+ })();
+ }]
+ }
+
+ return $answerStatus
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: prevent_multiple_tabs
+ #----------------------------------------------------------------------
+ :public method prevent_multiple_tabs {
+ {-cookie_name multiple_tabs}
+ } {
+ #
+ # Prevent answering the same survey from multiple, concurrently
+ # open tabs.
+ #
+ template::add_body_script -script [subst {
+ var cookieLine = document.cookie.split('; ').find(row => row.startsWith('$cookie_name='));
+ var cookieValue = (cookieLine === undefined) ? 1 : parseInt(cookieLine.split('=')\[1\]) + 1;
+ // console.log("cookie $cookie_name " + cookieValue);
+ if (cookieValue > 1) {
+ alert('Already open!');
+ window.open("about:blank", "_self").close();
+ }
+ document.cookie = "$cookie_name=" + cookieValue;
+ // console.log("START finished -> " + document.cookie);
+
+ window.onunload = function () {
+ var cookieLine = document.cookie.split('; ').find(row => row.startsWith('$cookie_name='));
+ var cookieValue = (cookieLine === undefined) ? 0 : parseInt(cookieLine.split('=')\[1\]) - 1;
+ document.cookie = "$cookie_name=" + cookieValue;
+ // console.log("UNLOAD finished -> " + document.cookie);
+ };
+ }]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: countdown_timer
+ #----------------------------------------------------------------------
+ :public method countdown_timer {
+ {-target_time:required}
+ {-id:required}
+ {-audio_alarm:boolean true}
+ {-audio_alarm_cookie incass_exam_audio_alarm}
+ {-audio_alarm_times: 60,30,20,10,5,2}
+ } {
+ #
+ # Accepted formats for target_time, determined by JavaScript
+ # ISO 8601, e.g. YYYY-MM-DDTHH:mm:ss.sss"
+ #
+ # Set current time based on host time instead of new
+ # Date().getTime() to avoid surprises, in cases, the time at the
+ # client browser is set incorrectly.
+ #
+ set nowMs [clock milliseconds]
+ set nowIsoTime [clock format [expr {$nowMs/1000}] \
+ -format "%Y-%m-%dT%H:%M:%S"].[format %.3d [expr {$nowMs % 1000}]]
+
+ template::add_body_script -script [subst {
+ var countdown_target_date = new Date('$target_time').getTime();
+ var countdown_days, countdown_hours, countdown_minutes, countdown_seconds;
+ var countdown = document.getElementById('$id');
+
+ // adjust target time by the difference between the host and client time
+ countdown_target_date = countdown_target_date - (new Date('$nowIsoTime').getTime() - new Date().getTime());
+
+ setInterval(function () {
+ var current_date = new Date().getTime();
+ var absolute_seconds_left = (countdown_target_date - current_date) / 1000;
+ var seconds_left = absolute_seconds_left
+ var HTML = '';
+
+ countdown_days = parseInt(seconds_left / 86400);
+ seconds_left = seconds_left % 86400;
+ countdown_hours = parseInt(seconds_left / 3600);
+ seconds_left = seconds_left % 3600;
+ countdown_minutes = parseInt(seconds_left / 60);
+ countdown_seconds = parseInt(seconds_left % 60);
+
+ var alarmseconds = countdown.parentNode.dataset.alarmseconds;
+ if (typeof alarmseconds !== 'undefined') {
+ var full_seconds = Math.trunc(absolute_seconds_left);
+ // for testing purposes, use: (full_seconds % 5 == 0)
+ if (alarmseconds.includes(full_seconds)) {
+ beep(200);
+ }
+ }
+
+ if (seconds_left < -60) {
+ countdown.innerHTML = " [_ xowf.Countdown_timer_expired] "
+ return
+ }
+
+ if (countdown_days != 0) {
+ HTML += '' + countdown_days + ' '
+ + (countdown_days != 1 ? '[_ xowf.Days]' : '[_ xowf.Day]')
+ + ' ';
+ }
+ if (countdown_hours != 0 || countdown_days != 0) {
+ HTML += '' + countdown_hours + ' '
+ + (countdown_hours != 1 ? '[_ xowf.Hours]' : '[_ xowf.Hour]')
+ + ' ';
+ }
+ HTML += '' + countdown_minutes + ' '
+ + (countdown_minutes != 1 ? '[_ xowf.Minutes]' : '[_ xowf.Minute]')
+ + ' '
+ + '' + countdown_seconds + ' '
+ + (countdown_seconds != 1 ? '[_ xowf.Seconds]' : '[_ xowf.Second]')
+ + ' [_ xowf.remaining]' ;
+
+ countdown.innerHTML = HTML;
+ }, 1000);
+
+ var beep = (function () {
+ return function (duration, finishedCallback) {
+ var container = document.getElementById('$id').parentNode;
+
+ //console.log("beep attempt " + duration + ' ' + audioContext + ' ' + container.dataset.alarm);
+ if (typeof audioContext !== 'undefined' && (container.dataset.alarm == 'active')) {
+
+ //console.log("true beep duration " + duration + ' ' + audioContext + ' ' + audioContext.state);
+ var osc = audioContext.createOscillator();
+ osc.type = "sine";
+ osc.connect(audioContext.destination);
+ if (osc.noteOn) osc.noteOn(0); // old browsers
+ if (osc.start) osc.start(); // new browsers
+
+ setTimeout(function () {
+ if (osc.noteOff) osc.noteOff(0); // old browsers
+ if (osc.stop) osc.stop(); // new browsers
+ }, duration);
+ }
+ };
+ })();
+ }]
+
+ if {$audio_alarm} {
+ #
+ # Audio alarm handling is more tricky than expected, since
+ # modern browsers do not allow one to create an active sound
+ # context without a "user gesture" (requires e.g. a click to
+ # start).
+ #
+ # The code tries to remember the audio state between different
+ # pages, such when e.g. being in an exam, the user has to
+ # activate/deactivate the audio not on every page. However,
+ # when the user does a full reload, then the user has to
+ # activate the audio alarm again.
+ #
+ # The state is symbolized using bootstrap 3 glyphicons or
+ # bootstrap icons. The code is tested primarily with chrome.
+ #
+ template::add_body_script -script [subst {
+ var audioContext = new AudioContext();
+ var audioContext_setSate = (function (targetState) {
+ var container = document.getElementById('$id').parentNode;
+ //console.log('--- state = ' + audioContext.state + ' want ' + targetState);
+ if (targetState == 'active') {
+ var elements = container.querySelector('i');
+ var prefix = 'bi';
+ if (!elements) {
+ elements = container.querySelector('span');
+ prefix = 'glyphicon';
+ }
+ elements.classList.remove(prefix + '-volume-off');
+ elements.classList.add(prefix + '-volume-up');
+ container.dataset.alarm = 'active';
+ document.cookie = '$audio_alarm_cookie=active; sameSite=strict';
+ audioContext.resume().then(() => {console.log('Playback resumed successfully ' + targetState);});
+ } else {
+ var elements = container.querySelector('i');
+ var prefix = 'bi';
+ if (!elements) {
+ elements = container.querySelector('span');
+ prefix = 'glyphicon';
+ }
+ elements.classList.remove(prefix + '-volume-up');
+ elements.classList.add(prefix + '-volume-off');
+ container.dataset.alarm = 'inactive';
+ document.cookie = '$audio_alarm_cookie=inactive; sameSite=strict';
+ audioContext.suspend().then(() => {console.log('Playback suspended successfully ' + targetState);});
+ }
+ //console.log('setSate ' + audioContext.state + ' alarm ' + container.dataset.alarm);
+ });
+
+ var audioContext_toggle = (function (event) {
+ var container = document.getElementById('$id').parentNode;
+ //console.log('audioContext_toggle ' + audioContext.state);
+ if (container.dataset.alarm != 'active') {
+ audioContext_setSate('active');
+ beep(200);
+ } else {
+ audioContext_setSate('inactive');
+ }
+ });
+
+ var audioContext_onload = (function (event) {
+ var m = document.cookie.match('(^|;)\\s*$audio_alarm_cookie\\s*=\\s*(\[^;\]+)');
+ var cookieValue = (m ? m.pop() : 'inactive');
+
+ console.log('audioContext_onload ' + audioContext.state + ' cookie ' + cookieValue);
+ //
+ // When the current state is 'running' the behavior seems
+ // cross browser uniform, we can set it to the state we got
+ // from the cookie.
+ //
+ if (audioContext.state == 'running') {
+ audioContext_setSate(cookieValue);
+ } else {
+ //
+ // FireFox can switch to "active" after reload, while
+ // this does not work on Chrome and friends.
+ //
+ if (navigator.userAgent.toLowerCase().indexOf('firefox') > -1) {
+ audioContext_setSate(cookieValue);
+ } else {
+ audioContext_setSate('inactive');
+ }
+ }
+ });
+ console.log('onload');
+ console.log(document.getElementById('$id'));
+
+ console.log('register audiocontext_toggle');
+ document.getElementById('$id').parentNode.addEventListener('click', audioContext_toggle);
+ window.addEventListener('load', audioContext_onload);
+ }]
+
+ if {[ns_conn isconnected]} {
+ #
+ # The icon names "volume-off" and "volume-up" exist in the
+ # glyph icons and for the bootstrap icons (Bootstrap 5)
+ #
+ set alarmState [ns_getcookie $audio_alarm_cookie "inactive"]
+ set icon [expr {$alarmState eq "inactive" ? "volume-off":"volume-up"}]
+ } else {
+ set alarmState "inactive"
+ set icon "volume-off"
+ }
+ #ns_log notice "C=$alarmState"
+
+ return [subst {
+
+ }]
+ } else {
+ return [subst {
+
+ }]
+ }
+ }
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: get_exam_results
+ #----------------------------------------------------------------------
+ :public method get_exam_results {
+ -obj:object,required
+ property
+ {default ""}
+ } {
+ #
+ # Retrieve a property value from the exam statistics result
+ # page. This page is an instance of the exam statistics workflow
+ # stored as a child of the exam object.
+ #
+ # @param obj the exam object
+ # @param property the property name
+ # @param default default value when property is not found
+ #
+ set p [$obj childpage -name en:result -form inclass-exam-statistics.wf]
+ set instance_attributes [$p instance_attributes]
+ if {[dict exists $instance_attributes $property]} {
+ #ns_log notice "get_exam_results <$property> returns value from " \
+ "results page: [dict get $instance_attributes $property]"
+ return [dict get $instance_attributes $property]
+ }
+ #ns_log notice "get_exam_results <$property> returns default"
+ return $default
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Answer_manager
+ # Method: set_exam_results
+ #----------------------------------------------------------------------
+ :public method set_exam_results {
+ -obj:object,required
+ property
+ value
+ } {
+ #ns_log notice "SES '$property' bytes [string length $value]"
+ set p [$obj childpage -name en:result -form inclass-exam-statistics.wf]
+ set instance_attributes [$p instance_attributes]
+ dict set instance_attributes $property $value
+ $p update_attribute_from_slot [$p find_slot instance_attributes] ${instance_attributes}
+ #
+ # cleanup of legacy values
+ #
+ set instance_attributes [$obj instance_attributes]
+ foreach property_name [list $property __$property] {
+ if {[dict exists $instance_attributes $property_name]} {
+ ns_log notice "SES set_exam_results:" \
+ "clearing values from earlier releases for '$property_name'" \
+ "was <[dict get $instance_attributes $property_name]>"
+ dict unset instance_attributes $property_name
+ $obj set instance_attributes $instance_attributes
+ #ns_log notice "FINAL IA <$instance_attributes> for item_id [$obj item_id]" \
+ "revision_id [$obj revision_id]"
+ $obj update_attribute_from_slot [$obj find_slot instance_attributes] $instance_attributes
+ ::xo::xotcl_object_cache flush [$obj item_id]
+ ::xo::xotcl_object_cache flush [$obj revision_id]
+ }
+ }
+ }
}
+
+ AssessmentInterface {*}$register_command AM \
+ [Answer_manager create answer_manager]
}
+
+namespace eval ::xowf::test_item {
+
+ nx::Class create Question_manager -superclass AssessmentInterface {
+ #
+ # This code manages questions and the information related to a
+ # current (selected) question via qthe "position" instance
+ # attribute. It provides the following public API:
+ #
+ # - goto_page
+ # - more_ahead
+ # - pagination_actions
+ #
+ # - current_question_form
+ # - current_question_obj
+ # - current_question_name
+ # - current_question_title
+ # - nth_question_obj
+ # - nth_question_form
+ #
+ # - exam_configuration_popup
+ # - exam_configuration_modifiable_field_names
+ #
+ # - combined_question_form
+ # - question_objs
+ # - question_names
+ # - question_count
+ # - question_property
+ # - add_seeds
+ # - total_minutes
+ # - total_points
+ # - questions_without_minutes
+ # - total_minutes_for_exam
+ # - exam_target_time
+ # - exam_base_time
+ #
+ # - percent_substitute_in_form
+ # - item_substitute_markup
+ #
+ # - describe_form
+ # - question_summary
+ # - question_info_block
+ # - question_statistics_block
+ #
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: initialize
+ #----------------------------------------------------------------------
+ :public method initialize {-wfi:object} {
+ #
+ # Initialize the question manager for a certain workflow
+ # instance. This is needed for per-answer-workflow questions (as
+ # for pool questions, where different questions are taken for
+ # different users).
+ #
+
+ #ns_log notice "QM initialize wfi $wfi"
+ set isAnswerInstance [expr {[$wfi is_wf_instance] == 1 && [$wfi is_wf] == 0}]
+ if {$isAnswerInstance} {
+ #ns_log notice "QM initialize answer instance [$wfi name] // [$wfi instance_attributes]"
+ set :wfi $wfi
+ } else {
+ ns_log warning "initializing question manager for not an answer instance [$wfi name]" \
+ "// [$wfi instance_attributes]"
+ }
+ }
+
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: get_pool_replacement_candidates
+ #----------------------------------------------------------------------
+ :method get_pool_replacement_candidates {
+ {-allowed_forms en:edit-interaction.wf}
+ {-minutes}
+ {-points}
+ {-fc_dict}
+ {-lang ""}
+ pool_question_obj
+ } {
+ #
+ # When fc_dict contains no item_types, return empty and signal
+ # in the logfile.
+ #
+ set item_types [dict get $fc_dict item_types]
+ if {[llength $item_types] == 0} {
+ ad_log warning "No item types for this pool question"
+ return
+ }
+
+ #
+ # Obtain for the specs in the pool_question_obj potential
+ # replacement items.
+ #
+ set parent_id [$pool_question_obj parent_id]
+ set package_id [$pool_question_obj package_id]
+
+ #
+ # We want to select only instances of these edit workflows
+ # specified in allowed_forms.
+ #
+ set form_objs [::$package_id instantiate_forms \
+ -parent_id $parent_id \
+ -forms $allowed_forms]
+ set form_object_item_ids [lmap f $form_objs {$f item_id}]
+
+ set pattern [dict get $fc_dict pattern]
+ set folder [dict get $fc_dict folder]
+
+ set item_ref_info [::$package_id item_ref \
+ -use_package_path 0 \
+ -default_lang en \
+ -parent_id $parent_id \
+ $folder]
+ set folder_id [:dict_value $item_ref_info item_id]
+
+ #
+ # In case, all item types are selected, no additional clauses
+ # are needed.
+ #
+ if {[::xowiki::formfield::pool_question all_item_types_selected $item_types]} {
+ set w_clauses ""
+ } else {
+ set w_clauses [list "item_type = [join $item_types |]"]
+ }
+
+ #
+ # Never include PoolQuestions as a replacement for a pool
+ # question.
+ #
+ set u_clauses [list "item_type = PoolQuestion"]
+
+ #
+ # Perform language selection based on the name and combine this
+ # with the provided pattern.
+ #
+ if {$pattern eq ""} {
+ set pattern *
+ }
+ if {$lang ne ""} {
+ lappend w_clauses "_name matches ${lang}:$pattern"
+ } elseif {$pattern ne "*"} {
+ lappend w_clauses "_name matches $pattern"
+ } else {
+ #
+ # In case thjere is no pattern and no lang provided, there is
+ # no filter necessary.
+ #
+ }
+
+ # The matching of minutes and points are more complex due to
+ # mutual completion (see below).
+ #
+ #if {$minutes ne ""} {
+ # lappend w_clauses "question matches *question.minutes $minutes*"
+ #}
+
+ set filters [::xowiki::FormPage compute_filter_clauses \
+ {*}[expr {[llength $u_clauses] > 0 ? [list -unless [join $u_clauses &&]] : ""}] \
+ {*}[expr {[llength $w_clauses] ? [list -where [join $w_clauses &&]] : ""}] \
+ ]
+
+ #ns_log notice "get_pool_replacement_candidates filters $filters"
+ #ns_log notice "get_pool_replacement_candidates filters WC $w_clauses -->\n[dict get $filters wc]"
+ #ns_log notice "get_pool_replacement_candidates filters UC $u_clauses -->\n[dict get $filters uc]"
+
+ #
+ # In case the folder_id is a symbolic link to a different
+ # folder, resolve the link and reset the folder_id to the
+ # item_id of the link target.
+ #
+ # In case we have links to different packages, some more work
+ # might be required (e.g. instantiate the other package, etc.).
+ #
+ if {![nsf::is object ::$folder_id]} {
+ ::xowiki::FormPage get_instance_from_db -item_id $folder_id
+ }
+ if {[::$folder_id is_link_page]} {
+ set targetObj [::$folder_id get_target_from_link_page]
+ set folder_id [$targetObj item_id]
+ }
+
+ #
+ # TODO: one has to check the performance of the generic
+ # get_form_entries on learn with larger question pools. It would
+ # be possible to provide a quicker query based on the
+ # xowiki*item_index joined with acs-objects instead of the
+ # generic view used in get_form_entries. ... but maybe the
+ # current approach with caching is already quick enough.
+ #
+ set items [::xowiki::FormPage get_form_entries \
+ -base_item_ids ${form_object_item_ids} \
+ -form_fields {} \
+ -publish_status ready \
+ -parent_id $folder_id \
+ -package_id ${package_id} \
+ -h_where [dict get $filters wc] \
+ -h_unless [dict get $filters uc] \
+ -initialize false \
+ -from_package_ids ""]
+
+ ns_log notice "get_pool_replacement_candidates parent_id $folder_id -> [llength [$items children]]"
+
+ #
+ # Since we allow the user to specify either minutes or points,
+ # and use the specified values as defaults for the others, we
+ # have to replace the empty values with the defaults (mutual
+ # completion).
+ #
+ if {$minutes eq "" && $points ne ""} {
+ set minutes $points
+ } elseif {$minutes ne "" && $points eq ""} {
+ set points $minutes
+ }
+
+ set result ""
+ foreach item [$items children] {
+ set qn [:qualified_question_names $item]
+ set ia [$item set instance_attributes]
+ set qa [dict get $ia question]
+
+ #
+ # Replace empty values for "minutes" and "points" with the
+ # defaults before comparing.
+ #
+ set item_minutes [dict get $qa question.minutes]
+ set item_points [dict get $qa question.points]
+ if {$item_minutes eq "" && $item_points ne ""} {
+ set item_minutes $item_points
+ } elseif {$item_minutes ne "" && $item_points eq ""} {
+ set item_points $item_minutes
+ }
+ #ns_log notice "get_pool_replacement_candidates filter" \
+ "minutes '$minutes' <-> '$item_minutes'," \
+ "points '$points ' <-> '$item_points'"
+ if {$minutes ne "" && $item_minutes ne $minutes} {
+ continue
+ } elseif {$points ne "" && $item_points ne $points} {
+ continue
+ }
+
+ dict set result $qn item_id [$item item_id]
+ dict set result $qn item_type [dict get $ia item_type]
+ #dict set result $qn question_dict $qa
+ }
+
+ #ns_log notice "=============== get_pool_replacement_candidates returns $result"
+ return $result
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: get_pool_questions
+ #----------------------------------------------------------------------
+ :public method get_pool_questions {
+ {-allowed_forms en:edit-interaction.wf}
+ {-field_name ""}
+ pool_question_obj
+ exam_question_names
+ } {
+ #
+ # Obtain for the specs in the pool_question_obj potential
+ # replacement items in form of a replacement dict. For raw forms
+ # (i.e., not obtained via the renaming form-loader), we have just
+ # the plain "answer", which can be provided via the "field_name"
+ # attribute.
+ #
+ set query_dict [:fc_to_dict [$pool_question_obj property form_constraints]]
+ if {$field_name eq ""} {
+ #
+ # No field name was provided, so get the field name from the
+ # question obj.
+ #
+ set field_name [:FL form_name_based_attribute_stem [$pool_question_obj name]]
+ if {![dict exists $query_dict $field_name]} {
+ #
+ # Fall back to field_name "answer". This will be necessary,
+ # when called with question_objs not adapted by the renaming
+ # form-loader.
+ #
+ if {[dict exists $query_dict answer]} {
+ ns_log notice "get_pool_questions: fallback from field_name '$field_name' to 'answer'"
+ set field_name answer
+ }
+ }
+ } elseif {![dict exists $query_dict $field_name]} {
+ ns_log warning "QM get_pool_questions: the provided field name '$field_name'" \
+ "is not defined in the form_constraints, fall back to '[lindex [dict keys $query_dict] 0]'"
+ set field_name [lindex [dict keys $query_dict] 0]
+ }
+ set question_attributes [dict get [$pool_question_obj instance_attributes] question]
+ set minutes [dict get $question_attributes question.minutes]
+ set points [dict get $question_attributes question.points]
+
+ set fc_dict [dict get $query_dict $field_name]
+ set lang [string range [$pool_question_obj nls_language] 0 1]
+
+ append key test-item-replacement-cands \
+ - $minutes - $points - $lang - $fc_dict - [$pool_question_obj revision_id]
+ ns_log notice "get_pool_questions fetch via key: '$key'"
+
+ return [ns_cache_eval -expires 1m -- ns:memoize $key {
+ :get_pool_replacement_candidates \
+ -minutes $minutes \
+ -points $points \
+ -fc_dict $fc_dict \
+ -lang $lang \
+ $pool_question_obj
+ }]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: replace_pool_question
+ #----------------------------------------------------------------------
+ :public method replace_pool_question {
+ -position
+ -seed
+ {-allowed_forms en:edit-interaction.wf}
+ {-field_name ""}
+ -pool_question_obj
+ -exam_question_names
+ } {
+ #
+ # @return an initialized replacement form obj if this is possible
+ #
+ set field_name ""; ## rely on fallback
+ set candidate_dict [:get_pool_questions \
+ -allowed_forms $allowed_forms \
+ -field_name $field_name \
+ $pool_question_obj \
+ $exam_question_names]
+
+ set candidate_names [dict keys $candidate_dict]
+ set nrCandidates [llength $candidate_names]
+ if {$nrCandidates == 0} {
+ set h [ns_set iget [ns_conn headers] referrer]
+ set url [join [lrange [split [xo::cc url] /] 0 end-1] /]?m=edit
+ util_user_message -message "could not find a replacement item for pool question: no matching item found"
+ ad_returnredirect $url
+ ad_script_abort
+ }
+
+ #
+ # It might be the case that we select the same item for an exam
+ # twice. Therefore, we have to iterate, until we find different
+ # items.
+ #
+ expr {srand($seed)}
+ set maxiter 100
+ while {1} {
+ set i [expr {int(($nrCandidates) * rand())}]
+ set new_name [lindex $candidate_names $i]
+ #ns_log notice "replace_pool_question position $position seed $seed random_index $i"
+
+ set contained [expr {$new_name in $exam_question_names}]
+ #ns_log notice "replace_pool_question replace [$pool_question_obj name] by $new_name contained in" \
+ # "[lsort $exam_question_names] contained $contained"
+ if {!$contained || [incr maxiter -1] < 0} {
+ break
+ }
+ }
+ if {$contained} {
+ error "could not find a replacement item for [$pool_question_obj name]: only duplicate items found"
+
+ }
+ set form_obj [::xowiki::FormPage get_instance_from_db \
+ -item_id [dict get $candidate_dict $new_name item_id]]
+
+ #$form_obj initialize
+
+ # ns_log notice [$form_obj serialize]
+ return $form_obj
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: replace_pool_questions
+ #----------------------------------------------------------------------
+ :public method replace_pool_questions {
+ -answer_obj:object
+ -exam_obj:object
+ } {
+ #
+ # Replaces all pool questions for the exam by random items. In
+ # case there were replacement items, set/update the property
+ # "question" for the individual answer_obj.
+ #
+ # @param answer_obj the workflow instance of the answer workflow
+ # @param exam_obj the exam objject to which the answer_object belongs to
+ #
+ if {[$answer_obj property question] ne ""} {
+ ns_log notice "answer_obj $answer_obj has already a 'question' property" \
+ [lsort [dict keys [$answer_obj instance_attributes]]]
+ return
+ }
+ set exam_question_names [$exam_obj property question]
+ set form_objs [:load_question_objs $exam_obj $exam_question_names]
+
+ #
+ # Make sure to normalize all names to ease comparison
+ #
+ set original_question_names [:qualified_question_names $form_objs]
+
+ set replaced_form_objs {}
+ set position 0
+ set seeds [$answer_obj property seeds]
+ foreach form_obj $form_objs {
+ #ns_log notice "YYY check item_type '[$form_obj property item_type]' // [$form_obj instance_attributes]"
+ if {[$form_obj property item_type] eq "PoolQuestion"} {
+ set replaced_form_obj [:replace_pool_question \
+ -position $position \
+ -seed [lindex $seeds $position] \
+ -pool_question_obj $form_obj \
+ -exam_question_names $exam_question_names]
+ set exam_question_names [lreplace $exam_question_names $position $position \
+ [:qualified_question_names $replaced_form_obj]]
+ lappend replaced_form_objs $replaced_form_obj
+ } else {
+ lappend replaced_form_objs $form_obj
+ }
+ incr position
+ }
+ #ns_log notice "YYYY OLD NAMES [join $original_question_names { }]"
+ #ns_log notice "YYYY UPD NAMES [join $exam_question_names { }]"
+ if {![:list_equal $original_question_names $exam_question_names]} {
+ ns_log notice "YYYY store question names in user's answer workflow"
+ $answer_obj set_property -new 1 question $exam_question_names
+ #$answer_obj set_property -new 1 question_ids [lmap obj $replaced_form_objs {$obj item_id}]
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: goto_page
+ #----------------------------------------------------------------------
+ :public method goto_page {obj:object position} {
+ #ns_log notice "===== goto_page $position"
+ #
+ # Set the position (test item number) of the workflow
+ # (exam). This sets the question number shown to the user.
+ #
+ $obj set_property position $position
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: more_ahead
+ #----------------------------------------------------------------------
+ :public method more_ahead {{-position ""} obj:object} {
+ #
+ # Return true, when this is for the current user not the last
+ # question.
+ #
+ if {$position eq ""} {
+ set position [$obj property position]
+ }
+ set questions [dict get [$obj instance_attributes] question]
+ return [expr {$position + 1 < [:question_count $obj]}]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: pagination_button_css_class
+ #----------------------------------------------------------------------
+ :method pagination_button_css_class {
+ {-CSSclass "btn-sm"}
+ {-cond:boolean,required}
+ {-extra ""}
+ } {
+ if {$cond} {
+ append CSSclass " " $extra
+ }
+ return $CSSclass
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: pagination_actions
+ #----------------------------------------------------------------------
+ :public method pagination_actions {
+ -container:object
+ -question_count:integer
+ {-visited:integer,0..n {}}
+ {-flagged:integer,0..n {}}
+ -current_position:integer
+ {-CSSclass "btn-sm"}
+ } {
+ #
+ # Create actions used for pagination.
+ #
+ set actions ""
+
+ if {$question_count > 1} {
+ if {[[${:wfi} get_parent_object] property show_pagination_actions t]} {
+ set extra_css [:pagination_button_css_class \
+ -CSSclass $CSSclass \
+ -cond [expr {$current_position == 0}] \
+ -extra "disabled"]
+ ${container}::previousQuestion configure \
+ -extra_css_class $extra_css \
+ -label "
#acs-kernel.common_Previous# " \
+ -label_noquote true \
+ -wrapper_CSSclass "pagination"
+ lappend actions previousQuestion
+
+ for {set count 1} {$count <= $question_count} {incr count} {
+ set visited_css [expr {($count - 1) in $visited ? "visited" : ""}]
+ set flag_label [expr {($count - 1) in $flagged
+ ? " [::xowiki::bootstrap::icon -name flag -CSSclass text-danger]"
+ : ""}]
+ set extra_css [:pagination_button_css_class \
+ -CSSclass "$CSSclass $visited_css" \
+ -cond [expr {$current_position == $count - 1 }] \
+ -extra "active current"]
+ ${container}::Action create ${container}::q.$count \
+ -label "$count$flag_label" \
+ -label_noquote true \
+ -state_safe true \
+ -next_state working \
+ -wrapper_CSSclass "pagination" \
+ -extra_css_class $extra_css \
+ -proc activate {obj} [subst {
+ #ns_log notice "===== NAVIGATE next"
+ next
+ #ns_log notice "===== NAVIGATE goto [expr {$count - 1}]"
+ :goto_page [expr {$count - 1}]
+ }]
+ lappend actions q.$count
+ }
+ }
+ set extra_css [:pagination_button_css_class \
+ -CSSclass $CSSclass \
+ -cond [expr {$current_position+2 > $question_count}] \
+ -extra "disabled"]
+ ${container}::nextQuestion configure \
+ -extra_css_class $extra_css \
+ -label "
#acs-kernel.common_Next# " \
+ -label_noquote true \
+ -wrapper_CSSclass "pagination"
+
+ set flag_state [expr {$current_position in $flagged ? "delete" : "set"}]
+ ${container}::flag configure \
+ -label "#xowf.flag_${flag_state}#" \
+ -title "#xowf.flag_${flag_state}_title#"
+
+ lappend actions nextQuestion
+ }
+ return $actions
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: qualified_question_names
+ #----------------------------------------------------------------------
+ :method max_items {max:integer,0..1 list} {
+ if {$max ne "" && $max < [llength $list]} {
+ return [lrange $list 0 $max-1]
+ }
+ return $list
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: qualified_question_names
+ #----------------------------------------------------------------------
+ :method qualified_question_names {question_objs} {
+ #
+ # Return the question names with parent folder in form of an
+ # item-ref. We assume here, all question_objs are from the same
+ # xowf instance. We will need item-refs pointing to other
+ # instances in the future.
+ #
+ lmap question_obj $question_objs {
+ set parent_id [$question_obj parent_id]
+ if {![nsf::is object ::$parent_id]} {
+ ::xowiki::FormPage get_instance_from_db -item_id $parent_id
+ }
+ set ref [::$parent_id name]/[$question_obj name]
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: load_question_objs
+ #----------------------------------------------------------------------
+ :public method load_question_objs {obj:object names} {
+ #
+ # Load the question objects for the provided question names and
+ # return the question objs.
+ #
+
+ set parent_id [$obj parent_id]
+ #
+ # Make sure to have names pointing to a folder.
+ # In case, '$ref' refers to a site-wide page, a prefix with
+ # the parent name would not help. In these cases, we expect
+ # to have the parent obj not instantiated.
+ #
+ if {[nsf::is object ::$parent_id]} {
+ set names [lmap ref $names {
+ if {![string match "*/*" $ref]} {
+ set ref [::$parent_id name]/$ref
+ }
+ set ref
+ }]
+ }
+ #ns_log notice "XXX [$obj name] load_question_objs names = <$names>"
+ #xo::show_stack
+ set questionNames [join $names |]
+ set questionForms [::[$obj package_id] instantiate_forms \
+ -default_lang [$obj lang] \
+ -forms $questionNames]
+
+ if {[llength $questionForms] < [llength $names]} {
+ if {[llength $names] == 1} {
+ ns_log warning "load_question_objs: question '$names' could not be loaded"
+ } else {
+ set loaded [llength $questionForms]
+ set out_of [llength $names]
+ ns_log warning "load_question_objs: only $loaded out of $out_of from '$names' could be loaded"
+ }
+ }
+ return $questionForms
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: current_question_name
+ #----------------------------------------------------------------------
+ :method current_question_name {obj:object} {
+ set questions [:question_names $obj]
+ return [lindex $questions [$obj property position]]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: current_question_obj
+ #----------------------------------------------------------------------
+ :public method current_question_obj {obj:object} {
+ #
+ # Load the current question obj based on the current question
+ # name.
+ #
+ return [:load_question_objs $obj [:current_question_name $obj]]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: shuffled_index
+ #----------------------------------------------------------------------
+ :public method shuffled_index {{-shuffle_id:integer -1} obj:object position} {
+ #
+ # Return the shuffled index position, in case shuffling is turned on.
+ #
+ if {$shuffle_id > -1} {
+ #
+ # Take always all questions as the basis for randomization,
+ # also when "max_items" is set.
+ #
+ set shuffled [::xowiki::randomized_indices \
+ -seed $shuffle_id \
+ [:question_count -all $obj]]
+ set position [lindex $shuffled $position]
+ #ns_log notice "shuffled_index question_count [:question_count $obj] -> <$shuffled> -> position $position"
+ }
+ return $position
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_objs
+ #----------------------------------------------------------------------
+ :public method question_objs {{-shuffle_id:integer -1} obj:object} {
+ #
+ # For the provided assessment object, return the question
+ # objects in the right order, depending on the shuffle_id.
+ #
+ :assert_assessment $obj
+ set form_objs [:load_question_objs $obj [:question_names $obj]]
+ #ns_log notice "question_objs from $obj => $form_objs shuffle_id $shuffle_id"
+
+ 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 at most max items, when specified.
+ #
+ return [:max_items [$obj property max_items ""] $form_objs]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_names
+ #----------------------------------------------------------------------
+ :public method question_names {obj:object} {
+ #
+ # Return the names of the questions of an assessment.
+ #
+ if {[info exists :wfi]} {
+ if {![nsf::is object ${:wfi}]} {
+ ns_log notice "we cannot trust :wfi '${:wfi}', probably a leftover"
+ unset :wfi
+ }
+ }
+ if {[info exists :wfi] && [${:wfi} property question] ne ""} {
+ set names [${:wfi} property question]
+ #ns_log notice "question_names returns obj-specific [join $names]"
+ } else {
+ set names [$obj property question]
+ #ns_log notice "question_names returns wf-names ($obj property): [join $names]"
+ }
+ return $names
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_count
+ #----------------------------------------------------------------------
+ :public method question_count {{-all:switch false} obj:object} {
+ #
+ # Return the number questions in an exam. It is either the
+ # number of defined questions, or it might be restricted by the
+ # property max_items (if defined for "obj").
+ #
+ set nr_questions [llength [:question_names $obj]]
+ if {!$all} {
+ set max_items [$obj property max_items ""]
+ if {$max_items ne ""} {
+ if {$max_items < $nr_questions} {
+ set nr_questions $max_items
+ }
+ }
+ }
+ return $nr_questions
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: add_seeds
+ #----------------------------------------------------------------------
+ :public method add_seeds {-obj:object -seed:integer -number:integer} {
+ #
+ # Add property "seed" to the provided object, consisting of a
+ # list of the specified number of random values starting with a
+ # base seed. This can be used to use e.g. per user different
+ # random seeds depending on the position of an item.
+ #
+ expr {srand($seed * [clock microseconds])}
+ set seeds {}
+ for {set i 0} {$i < $number} {incr i} {
+ lappend seeds [expr {int(rand() * $seed * [clock microseconds])}]
+ }
+ $obj set_property -new 1 seeds $seeds
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: nth_question_obj
+ #----------------------------------------------------------------------
+ :public method nth_question_obj {obj:object position:integer} {
+ #
+ # Return the nth question object of an assessment (based on
+ # position).
+ #
+ :assert_assessment $obj
+ set questions [:question_names $obj]
+ set result [:load_question_objs $obj [lindex $questions $position]]
+ return $result
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: percent_substitute
+ #----------------------------------------------------------------------
+ :method percent_substitute {-verbose:switch -substvalues -seed text} {
+ set result ""
+ set start 0
+ foreach {p0 p1 p2} [regexp -all -inline -indices {%([a-zA-Z0-9_]+)[.]?([a-zA-Z0-9_]*)%} $text] {
+ lassign $p0 first last
+ set match [string range $text $first $last]
+ set m1 [string range $text {*}$p1]
+ set m2 [string range $text {*}$p2]
+ if {[dict exists $substvalues $m1]} {
+ set values [dict get $substvalues $m1]
+ if {[info exists seed]} {
+ set index [::xowiki::randomized_index -seed $seed [llength $values]]
+ #ns_log notice "XXX percent_substitute called with seed <$seed> -> index $index <[llength $values]>"
+ set value [lindex $values $index]
+ } else {
+ set value [lindex $values 0]
+ }
+ if {$m2 ne "" && [dict exists $value $m2]} {
+ set value [dict get $value $m2]
+ if {$verbose} {
+ #ns_log notice "XXX percent_substitute chooses '$value' for $m2 from <$values>"
+ }
+ }
+ set replacement $value
+ } else {
+ set replacement '$match'
+ }
+ append result \
+ [string range $text $start $first-1] \
+ $replacement
+ set start [incr last]
+ }
+ append result [string range $text $start [string length $text]]
+ return $result
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: percent_substitute_in_form
+ #----------------------------------------------------------------------
+ :public method percent_substitute_in_form {
+ -obj:object
+ -form_obj:object
+ -position:integer
+ html
+ } {
+ #
+ # Perform percent substitution in the provided HTML,
+ # form_constraints and disabled_form_constraints and return the
+ # result as a dict.
+ #
+ set form_name [$form_obj name]
+ set seed [lindex [$obj property seeds] $position]
+ set substvalues [$form_obj property substvalues]
+ #ns_log notice "CHECK-AA $form_name seed <$seed> // seeds <[$obj property seeds]> // subs '$substvalues'"
+
+ set fc [$form_obj property form_constraints]
+ set dfc [$form_obj property disabled_form_constraints]
+
+ if {$seed eq "" && $substvalues ne ""} {
+ ns_log warning "percent_substitute_in_form cannot substitute percent variables in $form_name"
+ } else {
+ if {$substvalues ne ""} {
+ set html [:percent_substitute \
+ -seed $seed \
+ -substvalues $substvalues \
+ $html]
+ set fc [:percent_substitute \
+ -seed $seed \
+ -substvalues $substvalues \
+ $fc]
+ set dfc [:percent_substitute -verbose \
+ -seed $seed \
+ -substvalues [$form_obj property substvalues] \
+ $dfc]
+ }
+ }
+ return [list form $html form_constraints $fc disabled_form_constraints $dfc]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: item_substitute_markup
+ #----------------------------------------------------------------------
+ :public method item_substitute_markup {
+ -obj:object
+ -form_obj:object
+ {-position:integer}
+ {-do_substitutions:switch 1}
+ } {
+ #
+ # Substitute everything item-specific in the text, including
+ # markup (handling e.g. images resolving in the context of the
+ # original question) and also percent-substitutions (if
+ # desired).
+ #
+ #ns_log notice "=== item_substitute_markup [$form_obj name] do percent subst (have pos [info exists position])"
+ :assert_answer_instance $obj
+
+ $obj do_substitutions $do_substitutions
+ set html [$obj substitute_markup \
+ -context_obj $form_obj \
+ [$form_obj property form]]
+ #ns_log notice "after subst [$obj serialize]\nhtml"
+ if {[info exists position]} {
+ return [:percent_substitute_in_form \
+ -obj $obj \
+ -form_obj $form_obj \
+ -position $position \
+ $html]
+ } else {
+ set fc [$form_obj property form_constraints]
+ set dfc [$form_obj property disabled_form_constraints]
+ return [list form $html form_constraints $fc disabled_form_constraints $dfc]
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: disable_text_field_feature
+ #----------------------------------------------------------------------
+ :method disable_text_field_feature {form_obj:object feature} {
+ #
+ # This function changes the form_constraints of the provided
+ # form object by adding "$feature=false" properties to textarea or
+ # text_fields entries.
+ #
+ set fc {}
+ foreach e [$form_obj property form_constraints] {
+ if {[regexp {^[^:]+_:(textarea|text_fields)} $e]} {
+ #ns_log notice "======= turn $feature off"
+ append e , $feature=false
+ }
+ lappend fc $e
+ }
+ $form_obj set_property form_constraints $fc
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: disallow_paste
+ #----------------------------------------------------------------------
+ :public method disallow_paste {form_obj:object} {
+ #
+ # This function changes the form_constraints of the provided
+ # form object by adding "paste=false" properties to textarea or
+ # text_fields entries.
+ :disable_text_field_feature $form_obj paste
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: disallow_spellcheck
+ #----------------------------------------------------------------------
+ :public method disallow_spellcheck {form_obj:object} {
+ #
+ # This function changes the form_constraints of the provided
+ # form object by adding "spellcheck=false" properties to textarea or
+ # text_fields entries.
+ #
+ :disable_text_field_feature $form_obj spellcheck
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: disallow_translation
+ #----------------------------------------------------------------------
+ :public method disallow_translation {form_obj:object} {
+ #
+ # This function disallows translation of the full page by
+ # setting the HTML5 "translate" attribute of the body to "no".
+ #
+ ::xo::Page set_property body translate no
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_randomization_ok
+ #----------------------------------------------------------------------
+ :method question_randomization_ok {form_obj} {
+ set randomizationOk 1
+ set qd [:dict_value [$form_obj instance_attributes] question]
+ if {$qd ne ""} {
+ #
+ # No question should have shuffle "always".
+ #
+ if {[:dict_value $qd question.shuffle] eq "always"} {
+ #ns_log notice "FOUND shuffle $qd"
+ set randomizationOk 0
+ }
+ }
+ return $randomizationOk
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_is_autograded
+ #----------------------------------------------------------------------
+ :method question_is_autograded {form_obj} {
+ #
+ # Return boolean information whether this question is autograded.
+ #
+
+ set formAttributes [$form_obj instance_attributes]
+ if {[dict exists $formAttributes question]} {
+ #
+ # Check autograding and randomization for exam.
+ #
+ set qd [dict get [$form_obj instance_attributes] question]
+
+ #
+ # For autoGrade, we assume currently to have either a grading,
+ # or a question, where every alternative is exactly provided.
+ #
+ if {[dict exists $qd question.grading]} {
+ #
+ # autograde ok on the item type level
+ #
+ set autoGrade 1
+
+ } elseif {[:dict_value $formAttributes auto_correct 0]} {
+ #
+ # auto_correct is in principle enabled, check details on
+ # the concrete question item.
+ #
+ set autoGrade 1
+
+ if {[:dict_value $formAttributes item_type] eq "ShortText"} {
+ #
+ # Check, if the correct_when specification of a short text
+ # question is suited for autocorrection. On the longer
+ # range, this function should be moved to a different
+ # place.
+ #
+
+ set dict [lindex [:fc_to_dict [dict get $formAttributes form_constraints]] 1]
+ foreach a [dict get $dict answer] {
+ set op ""
+ regexp {^(\S+)\s} $a . op
+ if {$op ni {eq lt le gt ge btwn AND}} {
+ ns_log notice "question_info [$form_obj name]: not suited for autoGrade: '$a' op <$op>"
+ set autoGrade 0
+ break
+ }
+ if {$op eq "AND"} {
+ foreach c [lrange $a 1 end] {
+ set op ""
+ regexp {^(\S+)\s} $c . op
+ if {$op ni {eq lt le gt ge btwn}} {
+ ns_log notice "question_info [$form_obj name]: not suited for autoGrade: AND clause '$c'"
+ set autoGrade 0
+ break
+ }
+ }
+ }
+ }
+ }
+ } elseif [dict exists $qd question.interaction question.interaction.answer] {
+ set autoGrade 1
+
+ set answer [dict get $qd question.interaction question.interaction.answer]
+ foreach k [dict keys $answer] {
+ if {![dict exists $answer $k $k.correct]} {
+ set autoGrade 0
+ }
+ }
+ } else {
+ set autoGrade 0
+ }
+ #ns_log notice "question_info [$form_obj name] [$form_obj title] autoGrade $autoGrade"
+ } else {
+ set autoGrade 0
+ }
+ ns_log notice "question_is_autograded -> $autoGrade"
+ return $autoGrade
+ }
+
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: hint_box
+ #----------------------------------------------------------------------
+ :method hint_box {-title -body {-CSSclass ""}} {
+ #
+ #
+ # @return HTML
+ #
+ set HTML ""
+ if {$body ne ""} {
+ append HTML [::xowiki::bootstrap::card \
+ -title $title \
+ -body $body \
+ -CSSclass $CSSclass]
+ }
+ return $HTML
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: hint_boxes
+ #----------------------------------------------------------------------
+ :public method hint_boxes {-question_obj:object -with_feedback:switch -with_correction_notes:switch} {
+ #
+ # Render the hint boxes (feedback and correction notes) for a
+ # question object.
+ #
+ # @return HTML
+ #
+ set HTML ""
+ if {$with_feedback} {
+ set question_data [$question_obj property question]
+ foreach feedback {feedback_correct feedback_incorrect} {
+ regsub -all _ $feedback - feedback_class
+ append HTML [:hint_box \
+ -title #xowf.General_feedback# \
+ -body [:dict_value $question_data question.$feedback ""] \
+ -CSSclass $feedback_class]
+ }
+ }
+ if {$with_correction_notes} {
+ append HTML [:hint_box \
+ -title #xowf.Correction_notes# \
+ -body [:dict_value $question_data question.correction_notes ""] \
+ -CSSclass correction-notes]
+ }
+ return $HTML
+ }
+
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_form
+ #----------------------------------------------------------------------
+ :public method aggregated_form {
+ {-titleless_form:switch false}
+ {-with_feedback:switch false}
+ {-with_correction_notes:switch false}
+ {-with_grading_box ""}
+ question_infos
+ } {
+ #
+ # Compute an aggregated form (containing potentially multiple
+ # questions) based on the chunks available in question_infos.
+ #
+ # @param with_grading_box might be: "hidden" (but included), "true", "" (omitted)
+ # @return HTML form content
+ #
+ set full_form ""
+ set count 0
+ foreach \
+ question_form [dict get $question_infos question_forms] \
+ title_info [dict get $question_infos title_infos] \
+ question_obj [dict get $question_infos question_objs] {
+ set item_type [$question_obj property item_type]
+ append full_form \
+ "
"
+
+ if {!$titleless_form} {
+ append full_form \
+ "
[dict get $title_info full_title] \n"
+ }
+ if {$with_grading_box ne ""} {
+ set question_name [:FL form_name_based_attribute_stem [$question_obj name]]
+ set hiddenCSSclass [expr {$with_grading_box eq "hidden" ? [::xowiki::CSS class d-none] : ""}]
+ if {$with_grading_box eq "hidden"} {
+ set question_name answer_$question_name
+ }
+ set data_attribute [expr {[::xowiki::CSS toolkit] eq "bootstrap5" ? "data-bs" : "data"}]
+ append full_form [subst [ns_trim -delimiter | {
+ |
+ }]]
+ }
+ append full_form \
+ $question_form \
+ [:hint_boxes \
+ -question_obj $question_obj \
+ -with_feedback=$with_feedback \
+ -with_correction_notes=$with_correction_notes] \
+
\n
+ }
+
+ regsub -all {<[/]?form>} $full_form "" full_form
+ #ns_log notice "aggregated_form: STRIP FORM xxx times from full_form"
+ return $full_form
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_info
+ #----------------------------------------------------------------------
+ :public method question_info {
+ {-numbers ""}
+ {-with_title:switch false}
+ {-with_minutes:switch false}
+ {-with_points:switch false}
+ {-titleless_form:switch false}
+ {-obj:object}
+ {-user_answers:object,0..1 ""}
+ {-no_position:switch false}
+ {-question_number_label #xowf.question#}
+ {-positions:int,0..n ""}
+ {-with_question_count_in_title:boolean false}
+ form_objs
+ } {
+ #
+ # Returns a dict containing "form", "title_infos",
+ # "form_constraints" "disabled_form_constraints"
+ # "randomization_for_exam" "autograde" and "question_objs". This
+ # information is obtained from the provided "form_objs".
+ #
+ # @return dict containing "title_infos", "form_constraints",
+ # "disabled_form_constraints", "randomization_for_exam",
+ # "autograde", "question_forms", "question_objs"
+ set full_fc {}
+ set full_disabled_fc {}
+ set title_infos {}
+ set question_forms {}
+
+ set randomizationOk 1
+ set autoGrade 1
+
+ if {[llength $positions] == 0} {
+ set position -1
+ set positions [lmap form_obj $form_objs {incr position}]
+ }
+
+ set question_count_label ""
+ if {$with_question_count_in_title} {
+ set question_count_label " / [:question_count $obj]"
+ }
+
+ foreach form_obj $form_objs number $numbers position $positions {
+ set form_obj [:FL rename_attributes $form_obj]
+ set form_title [$form_obj title]
+ set minutes [:question_property $form_obj minutes]
+ set points [:question_property $form_obj points]
+ if {$points eq ""} {
+ #ns_log notice "[$form_obj name]: NO POINTS, default to minutes $minutes"
+ set points $minutes
+ }
+ set time_budget [$obj property time_budget]
+ if {$time_budget ni {"" 100} && $minutes ne ""} {
+ set minutes [expr {$time_budget*$minutes/100.0}]
+ ns_log notice "[$form_obj name]: TIME BUDGET '$time_budget' -> minutes set to $minutes"
+ }
+ set mapping {show_points with_points show_minutes with_minutes}
+ foreach property {show_points show_minutes} {
+ if {[$obj property $property] ne ""} {
+ set [dict get $mapping $property] [$obj property $property]
+ #ns_log notice "[$form_obj name]: override flag via exam setting: '$property' -> [$obj property $property]"
+ }
+ }
+ set title ""
+ if {$number ne ""} {
+ append title "$question_number_label $number $question_count_label:"
+ }
+
+ set title_components {}
+ if {$with_title} {
+ lappend title_components [ns_quotehtml $form_title]
+ }
+ if {$with_minutes} {
+ lappend title_components [:minutes_string $form_obj]
+ }
+ if {$with_points} {
+ lappend title_components [:points_string $form_obj]
+ }
+ append title " " [join $title_components " - "]
+
+ #
+ # The flag "no_position" is just provided for the composite
+ # form, in cases where we are called at form generation time,
+ # where the position is different from the position in the
+ # exam. When the position is fixed, we do not provide it as an
+ # argument. As a consequence, the percent substitution is not
+ # performed, since it would return always very similar values
+ # based on a fixed position.
+ #
+ if {$no_position} {
+ set positionArg {}
+ } else {
+ set positionArg [list -position $position]
+ }
+ #ns_log notice "CHECK 0 user_answers <$user_answers> (obj is the inclass exam [$obj name])"
+ if {$user_answers eq ""} {
+ set user_answers $obj
+ }
+ #
+ # Resolve links in the context of the resolve_object
+ #
+ set d [:item_substitute_markup \
+ -obj $user_answers \
+ {*}$positionArg \
+ -form_obj $form_obj]
+
+ lappend question_forms [dict get $d form]
+ lappend title_infos [list full_title $title \
+ title $form_title \
+ minutes $minutes \
+ points $points \
+ number $number]
+ lappend full_fc [:add_to_fc \
+ -fc [dict get $d form_constraints] \
+ -minutes $minutes \
+ -points $points \
+ {*}$positionArg]
+
+ lappend full_disabled_fc [:add_to_fc \
+ -fc [dict get $d disabled_form_constraints] \
+ -minutes $minutes \
+ -points $points \
+ {*}$positionArg]
+
+ if {![:question_is_autograded $form_obj]} {
+ set autoGrade 0
+ }
+ if {![:question_randomization_ok $form_obj]} {
+ set randomizationOk 0
+ }
+ }
+
+ return [list \
+ title_infos $title_infos \
+ form_constraints [join [lsort -unique $full_fc] \n] \
+ disabled_form_constraints [join [lsort -unique $full_disabled_fc] \n] \
+ randomization_for_exam $randomizationOk \
+ autograde $autoGrade \
+ question_forms $question_forms \
+ question_objs $form_objs]
+ }
+
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_property
+ #----------------------------------------------------------------------
+ :public method question_property {form_obj:object attribute {default ""}} {
+ #
+ # Get an attribute of the original question
+ #
+ set question [$form_obj get_property -name question]
+ #:msg question=$question
+ if {[dict exists $question question.$attribute]} {
+ set value [dict get $question question.$attribute]
+ } else {
+ set value $default
+ }
+ return $value
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: minutes_string
+ #----------------------------------------------------------------------
+ :public method minutes_string {form_obj:object} {
+ #
+ # Get an attribute of the original question
+ #
+ set minutes [:question_property $form_obj minutes]
+ if {$minutes ne ""} {
+ set pretty_label [expr {$minutes eq "1" ? [_ xowf.Minute] : [_ xowf.Minutes]}]
+ set minutes "($minutes $pretty_label)"
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: points_string
+ #----------------------------------------------------------------------
+ :public method points_string {form_obj:object} {
+ #
+ # Get an attribute of the original question
+ #
+ set points [:question_property $form_obj points]
+ if {$points eq ""} {
+ # just for legacy, questions without points
+ set points [:question_property $form_obj minutes]
+ }
+ if {$points ne ""} {
+ set pretty_label [expr {$points eq "1" ? [_ xowf.Point] : [_ xowf.Points]}]
+ set minutes "($points $pretty_label)"
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: combined_question_form
+ #----------------------------------------------------------------------
+ :public method combined_question_form {
+ {-with_numbers:switch false}
+ {-with_title:switch false}
+ {-with_minutes:switch false}
+ {-with_points:switch false}
+ {-user_specific:switch false}
+ {-shuffle_id:integer -1}
+ {-user_answers:object,0..1 ""}
+ {-form_objs:object,0..1 ""}
+ obj:object
+ } {
+ #
+ # For the provided assessment, return a combined question_form
+ # as a single (combined) form, containing the content of all
+ # question forms. The result is a dict, containing also title
+ # information etc. depending on the provided parameters.
+ #
+ # @param shuffle_id used only for selecting form_objs
+ # @param obj is the exam
+ # @param user_answers instance of the answer-wf.
+ # Needed for user-specific percent substitutions.
+
+ #ns_log notice "combined_question_form called with user_answers <$user_answers> for $obj [$obj name]"
+ #if {$user_answers eq ""} {xo::show_stack}
+
+ set all_form_objs [:question_objs -shuffle_id $shuffle_id $obj]
+ set positions {}
+ if {[llength $form_objs] > 0} {
+ foreach form_obj $form_objs {
+ lappend positions [lsearch $all_form_objs $form_obj]
+ }
+ }
+ #ns_log notice "XXX combined_question_form fos=$form_objs all_form_objs=$all_form_objs <$positions>"
+
+ if {$user_specific} {
+ set form_objs [:max_items [$obj property max_items ""] $form_objs]
+ }
+ if {$with_numbers} {
+ set numbers ""
+ for {set i 1} {$i <= [llength $all_form_objs]} {incr i} {
+ lappend numbers $i
+ }
+ if {[llength $form_objs] > 0} {
+ set new_numbers {}
+ set new_form_objs {}
+ foreach form_obj $all_form_objs number $numbers {
+ if {$form_obj in $form_objs} {
+ lappend new_numbers $number
+ lappend new_form_objs $form_obj
+ }
+ }
+ set numbers $new_numbers
+ set form_objs $new_form_objs
+ } else {
+ set form_objs $all_form_objs
+ }
+ set extra_flags [list -numbers $numbers]
+ } else {
+ set form_objs $all_form_objs
+ set extra_flags ""
+ }
+ return [:question_info \
+ -with_title=$with_title \
+ -with_minutes=$with_minutes \
+ -with_points=$with_points \
+ {*}$extra_flags \
+ -obj $obj \
+ -user_answers $user_answers \
+ -positions $positions \
+ $form_objs]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: pretty_nr_alternatives
+ #----------------------------------------------------------------------
+ :method pretty_nr_alternatives {question_infos} {
+ set result {}
+ foreach question_info $question_infos {
+ if {$question_info ne ""} {
+ #
+ # The handled metrics are currently hardcoded here. So, we can
+ # rely on having the returned value in the message keys. The
+ # list order is important, since it determines also the ordering
+ # in the message.
+ #
+ if {[:dict_value $question_info show_max ""] ne ""} {
+ foreach key {choice_options sub_questions} {
+ if {[dict exists $question_info $key]
+ && [dict get $question_info show_max] ne [dict get $question_info $key]
+ } {
+ set new "[dict get $question_info show_max] #xowf.out_of# [dict get $question_info $key]"
+ dict set question_info question_structure $new
+ }
+ }
+ }
+ lappend result $question_info
+ }
+ }
+ return $result
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: pretty_ncorrect
+ #----------------------------------------------------------------------
+ :method pretty_ncorrect {m} {
+ return " (#xowf.Correct# $m) "
+ }
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: pretty_shuffle
+ #----------------------------------------------------------------------
+ :method pretty_shuffle {m} {
+ if {$m ne ""} {
+ return #xowf.shuffle_$m#
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: render_describe_infos
+ #----------------------------------------------------------------------
+ :method render_describe_infos {describe_infos} {
+ set msgList {}
+ foreach describe_info $describe_infos {
+ if {$describe_info ne ""} {
+ #
+ # The handled metrics are currently hardcoded here. So, we can
+ # rely on having the returned value in the message keys. The
+ # list order is important, since it determines also the ordering
+ # in the message.
+ #
+ set msg ""
+ set hasStructure [dict exists $describe_info question_structure]
+ set metrics [expr {$hasStructure ? "question_structure" : [list choice_options sub_questions]}]
+ lappend metrics nrcorrect Minutes Points shuffle available_pool_items available_pool_item_stats
+ foreach metric $metrics {
+ if {[:dict_value $describe_info $metric] ne ""} {
+ set m [dict get $describe_info $metric]
+ switch $metric {
+ nrcorrect { append msg [:pretty_ncorrect $m] }
+ shuffle { append msg "
#xowf.Shuffle#: [:pretty_shuffle $m]" }
+ default { append msg "
#xowf.$metric#: $m "}
+ }
+ }
+ }
+ #append msg "
$describe_info "
+ lappend msgList "$msg\n"
+ }
+ }
+ return $msgList
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: describe_form
+ #----------------------------------------------------------------------
+ :public method describe_form {
+ {-asHTML:switch}
+ {-field_name ""}
+ form_obj
+ } {
+ #
+ # Call for every form field of the form_obj the "describe"
+ # method and return these infos in a form of a list.
+ #
+ # @result list of dicts describing the form fields.
+ #
+ set describe_infos {}
+
+ if {[$form_obj property item_type] eq "Composite"} {
+ #
+ # In the case of a composite Composite question type, describe
+ # the components rather than the compound part (maybe, we
+ # should describe in the future also the container, but this
+ # actually less interesting).
+ #
+ set selection [dict get [$form_obj instance_attributes] \
+ question question.interaction question.interaction.selection]
+ set form_objs [[$form_obj package_id] instantiate_forms \
+ -forms [join [split $selection \n] |] \
+ -default_lang en]
+
+ set describe_infos [join [lmap form_obj_tmp $form_objs {
+ set describe_info [join [:describe_form -field_name $field_name $form_obj_tmp]]
+ list [lappend describe_info is_composite_subquestion 1]
+ }]]
+ set fc {selection:form_page}
+ } else {
+ set fc [$form_obj property form_constraints]
+ }
+
+ #
+ # We might be willing in the future to get the full set of all
+ # options, i.e. remove "show_max" constraints etc.
+ #
+ #ns_log notice DESCRIBE-BEFORE--$fc
+ #set fc [:replace_in_fc -fc $fc shuffle_kind none]
+ #set fc [:replace_in_fc -fc $fc show_max ""]
+ #ns_log notice DESCRIBE-changed
+
+ set form_fields [$form_obj create_form_fields_from_form_constraints \
+ -lookup $fc]
+ set ff_describe_infos [lmap form_field $form_fields {
+ $form_field describe -field_name $field_name
+ }]
+
+ #ns_log notice "describe_form [$form_obj name]: $question_infos"
+ set describe_infos [:pretty_nr_alternatives "$ff_describe_infos $describe_infos"]
+ if {!$asHTML} {
+ #ns_log notice "OOO [$form_obj name] early exit $describe_infos"
+ return $describe_infos
+ } else {
+ set HTML [:render_describe_infos $describe_infos]
+ return $HTML
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_configuration_render_fields
+ #----------------------------------------------------------------------
+ :method exam_configuration_render_fields {{-modifiable ""} fields} {
+ #
+ # Render the provided fields via tDOM. Non-modifiable
+ # form-fields are disabled.
+ #
+ # @param modifiable list of field names which are modifiable
+ # @return HTML
+ #
+
+ #ns_log notice "configuration_render called with modifiable <$modifiable>"
+ ::xo::require_html_procs
+
+ set content ""
+ foreach f $fields {
+ if {[$f name] ni $modifiable} {
+ $f set_disabled true
+ $f help_text ""
+ }
+ append content [tdom_render {
+ $f render
+ }]
+ }
+ return $content
+ }
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_configuration_block
+ #----------------------------------------------------------------------
+ :method exam_configuration_block {
+ {-modifiable ""}
+ -label
+ -id
+ -obj
+ -form_constraints
+ field_names
+ } {
+ set fields [$obj create_form_fields_from_names -lookup -set_values \
+ -form_constraints $form_constraints \
+ $field_names]
+ set data_attribute [expr {[::xowiki::CSS toolkit] eq "bootstrap5" ? "data-bs" : "data"}]
+ return [subst {
+
+ [::xowiki::bootstrap::icon -name chevron-down] $label
+
+ [:exam_configuration_render_fields -modifiable $modifiable $fields]
+
+ }]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_configuration_modifiable_field_names
+ #----------------------------------------------------------------------
+ :public method exam_configuration_modifiable_field_names {obj} {
+ #
+ # Return the names of the modifiable field names in the current
+ # state. The state is in essence defined on whether or not
+ # students have started to work on this exam. This method can be
+ # used to correct small things, even when the students are
+ # already working on the exam.
+ #
+ set modifiable {
+ allow_paste allow_spellcheck allow_translation
+ show_minutes show_points show_ip
+ countdown_audio_alarm grading
+ }
+ set wf [:AM get_answer_wf $obj]
+ if {![:AM student_submissions_exist $wf]} {
+ lappend modifiable {*}{
+ shuffle_items max_items
+ time_budget synchronized time_window
+ proctoring proctoring_options proctoring_record signature show_pagination_actions
+ }
+ }
+ return $modifiable
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_configuration_popup
+ #----------------------------------------------------------------------
+ :public method exam_configuration_popup {obj} {
+ #
+ # Render the exam configuration popup, add it as a
+ # content_header (to avoid putting it to the main workflow form,
+ # since nested FORMS are not allowed) and return the rendering
+ # of the button for popping-ip the configuration modal.
+ #
+ # @return HTML
+
+ set modifiable [:exam_configuration_modifiable_field_names $obj]
+ #ns_log notice "exam_configuration_popup modifiable '$modifiable'"
+
+ set fcrepo [$obj get_fc_repository]
+ set content ""
+ append content \
+ [:exam_configuration_block \
+ -modifiable $modifiable \
+ -label #xowf.Question_management# \
+ -id config-question \
+ -form_constraints $fcrepo \
+ -obj $obj {
+ shuffle_items max_items
+ allow_paste allow_spellcheck allow_translation
+ show_minutes show_points show_ip
+ }] \
+ [:exam_configuration_block \
+ -modifiable $modifiable \
+ -label #xowf.Time_management# \
+ -id config-time \
+ -form_constraints $fcrepo \
+ -obj $obj {
+ time_budget synchronized time_window countdown_audio_alarm
+ }] \
+ [:exam_configuration_block \
+ -modifiable $modifiable \
+ -label #xowf.Security# \
+ -id config-security \
+ -form_constraints $fcrepo \
+ -obj $obj {
+ proctoring proctoring_options proctoring_record signature iprange
+ }] \
+ [:exam_configuration_render_fields -modifiable $modifiable \
+ [$obj create_form_fields_from_names -lookup -set_values \
+ -form_constraints $fcrepo \
+ {grading}]]
+
+ ::template::add_body_script -script [ns_trim -delimiter | [subst -novariables {
+ |$(document).ready(function() {
+ | $('.modal .confirm').on('click', function(ev) {
+ | //
+ | // Submit button of the configuration dialog was pressed.
+ | //
+ | var data = new FormData(document.getElementById('configuration-form'));
+ | console.log(data);
+ | var xhttp = new XMLHttpRequest();
+ | xhttp.open('POST', '[$obj pretty_link -query m=update-config]', true);
+ | xhttp.onload = function () {
+ | if (this.readyState == 4) {
+ | if (this.status == 200) {
+ | var text = this.responseText;
+ | console.log('sent OK ok ' + text);
+ | //window.location.reload(true);
+ | } else {
+ | console.log('sent NOT ok');
+ | }
+ | }
+ | };
+ | xhttp.send(data);
+ | });
+ |});
+ }]]
+
+
+ $obj content_header_append \
+ [::xowiki::bootstrap::modal_dialog \
+ -id configuration-modal \
+ -title "#xowf.Configuration#:
" \
+ -body $content]
+
+ return \
+ [::xowiki::bootstrap::modal_dialog_popup_button \
+ -target configuration-modal \
+ -label [::xowiki::bootstrap::icon -name cog -style "float: right;"] \
+ -title #xowf.Configuration_button_title# \
+ -CSSclass configuration-button]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_summary
+ #----------------------------------------------------------------------
+ :public method question_summary {obj} {
+ #
+ # Provide a summary of all questions of an exam.
+ #
+ set results [:AM get_exam_results -obj $obj results]
+ if {$results ne ""} {
+ #https://localhost:8443/xowf/online-exam/inclass-exam1?per-question=1&m=print-statistics&format=csv&onlygrades=0
+ set href [$obj pretty_link -query m=exam-results&format=csv&per-question=1]
+ set results_summary [subst {
+
#xowf.export_results#:
+
+ }]
+ } else {
+ set results_summary ""
+ }
+
+ set return_url [::xo::cc query_parameter local_return_url:localurl [$obj pretty_link]]
+ return [ns_trim -delimiter | [subst {
+ | [:question_info_block $obj]
+ | $results_summary
+ |
#xowiki.back#
+ }]]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_info_block
+ #----------------------------------------------------------------------
+ :public method question_info_block {obj} {
+ #
+ # Provide question info block.
+ #
+ set HTML [:question_overview_block $obj]
+ append HTML [:question_statistics_block $obj]
+
+ return $HTML
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: question_statistics_block
+ #----------------------------------------------------------------------
+ :public method question_statistics_block {obj} {
+ #
+ # When we have results, we can provide statistics
+ #
+ set HTML ""
+ if {[$obj state] in {done submission_review}} {
+
+ template::head::add_link -rel stylesheet -href /resources/xowf/test-item.css
+ set combined_form_info [:combined_question_form -with_numbers $obj]
+
+ #
+ # Get the form-field objects with all alternatives (use flag
+ # "-generic")
+ #
+ set form_field_objs [:AM answer_form_field_objs \
+ -generic \
+ -wf [:AM get_answer_wf $obj] \
+ $combined_form_info]
+ #
+ # Get the persisted statistics from the workflow
+ # instance. These statistics are computed when the exam
+ # protocol is rendered.
+ #
+ set statistics [:AM get_exam_results -obj $obj statistics]
+ if {$statistics ne ""} {
+ foreach var {success_statistics count_statistics} key {success count} {
+ if {[dict exists $statistics $key]} {
+ set $var [dict get $statistics $key]
+ } else {
+ set $var ""
+ }
+ }
+
+ #
+ # Merge the statistics into the generic form-fields such we
+ # can use the usual form-field based rendering.
+ #
+ foreach form_field_obj $form_field_objs {
+ #
+ # The linkage between the statistics and the form-fields
+ # is performed via the form-field names. Note that in
+ # cases, where multiple folders are used as a source, the
+ # names have to be disambiguated.
+ #
+ set name [$form_field_obj name]
+ set result_statistics ""
+ if {[dict exists $success_statistics $name]} {
+ set result_statistics [dict get $success_statistics $name]
+ }
+ if {[dict exists $count_statistics $name]} {
+ #ns_log notice "statistics question_info_block $name count '[dict get $count_statistics $name]'"
+ dict set result_statistics count [dict get $count_statistics $name]
+ $form_field_obj set result_statistics $result_statistics
+ }
+ }
+ }
+
+ #
+ # Substitute form-field place-holders ion the combined form.
+ #
+ set combined_form [:aggregated_form $combined_form_info]
+ set form [$obj regsub_eval \
+ [template::adp_variable_regexp] $combined_form \
+ {$obj form_field_as_html -mode display "\\\1" "\2" $form_field_objs}]
+
+ append HTML $form
+ }
+ return $HTML
+ }
+
+ :method question_overview_block {obj} {
+ set href [$obj pretty_link -query m=print-answers]
+
+ set form_objs [:question_objs $obj]
+
+ set chunks {}
+ foreach form_obj $form_objs {
+ foreach chunk [:describe_form $form_obj] {
+ set structure ""
+ foreach att {
+ question_structure choice_options sub_questions
+ } {
+ if {[dict exists $chunk $att]} {
+ append structure [dict get $chunk $att]
+ break
+ }
+ }
+ if {[dict exists $chunk available_pool_items]} {
+ append structure \
+ " " [dict get $chunk available_pool_items] " " #xowf.questions# \
+ " " ([dict get $chunk available_pool_item_stats])
+ }
+ if {[dict exists $chunk nrcorrect]} {
+ append structure " " [:pretty_ncorrect [dict get $chunk nrcorrect]]
+ }
+ if {[dict exists $chunk is_composite_subquestion]} {
+ dict set chunk title_value " [ns_quotehtml [dict get $chunk question_title]]"
+ } else {
+ if {[$obj state] in {done submission_review}
+ && ![dict exists $chunk available_pool_items]
+ } {
+ dict set chunk title_value [subst {
+
[ns_quotehtml [$form_obj title]]
+ }]
+ } else {
+ dict set chunk title_value [ns_quotehtml [$form_obj title]]
+ }
+ }
+ dict set chunk structure $structure
+ lappend chunks $chunk
+ }
+ }
+
+ set body [ns_trim -delimiter | {
+ |
+ |
+ | #xowf.question_structure#
+ | #xowf.Minutes#
+ | #xowf.Points#
+ | #xowf.Shuffle#
+ |
+ }]
+
+ foreach chunk $chunks {
+ append body [subst [ns_trim -delimiter | {
+ |
+ | [:dict_value $chunk title_value]
+ | [:dict_value $chunk type]: [:dict_value $chunk structure]
+ | [:dict_value $chunk Minutes]
+ | [:dict_value $chunk Points]
+ | [:pretty_shuffle [:dict_value $chunk shuffle]]
+ | [:dict_value $chunk grading]
+ |
+ }]]
+ }
+ append body [ns_trim -delimiter | {
+ |
+ }]
+
+ return [::xowiki::bootstrap::card \
+ -title #xowf.question_summary# \
+ -body $body]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_info_block
+ #----------------------------------------------------------------------
+ :public method exam_info_block {-combined_form_info obj} {
+ #
+ # Provide a summative overview of an exam.
+ #
+ if {![info exists combined_form_info]} {
+ set combined_form_info [:combined_question_form -with_numbers $obj]
+ }
+ set proctoring [$obj property proctoring 0]
+ set synchronized [$obj property synchronized 0]
+ set allow_paste [$obj property allow_paste 1]
+ set max_items [$obj property max_items ""]
+ set time_window [$obj property time_window ""]
+ set allow_spellcheck [$obj property allow_spellcheck true]
+ set allow_translation [$obj property allow_translation false]
+
+ append text [subst {
+ [expr {$synchronized ? "" : "Non-"}]Synchronized Exam
+ [expr {$proctoring ? " with Proctoring" : ""}]
+
}]
+ set question_objs [dict get $combined_form_info question_objs]
+ set nrQuestions [llength [:question_names $obj]]
+ set randomizationOk [dict get $combined_form_info randomization_for_exam]
+ set autograde [dict get $combined_form_info autograde]
+
+ set revision_sets [$obj get_revision_sets]
+ set published_periods [:AM state_periods $revision_sets -state published]
+ set review_periods [:AM state_periods $revision_sets -state submission_review]
+ set total_minutes [:total_minutes -max_items $max_items $combined_form_info]
+ set total_points [:total_points -max_items $max_items $combined_form_info]
+ set questions_without_minutes [:questions_without_minutes -max_items $max_items $combined_form_info]
+ set max_items_msg ""
+
+ if {$max_items ne ""} {
+ set all_minutes [lmap t [dict get $combined_form_info title_infos] {
+ dict get $t minutes
+ }]
+ if {[llength [lsort -unique $all_minutes]] != 1} {
+ set max_items_msg [_ xowf.Max_items_not_ok_duration [list n $max_items]]
+ } elseif {$max_items > [llength $all_minutes]} {
+ set max_items_msg [_ xowf.Max_items_not_ok_number [list n $max_items]]
+ } else {
+ set max_items_msg [_ xowf.Max_items_ok [list n $max_items]]
+ }
+ }
+
+ set time_window_msg ""
+ if {$time_window ne ""} {
+ set dtstart [dict get $time_window time_window.dtstart]
+ if {$dtstart ne ""} {
+ regsub -all T $dtstart " " dtstart
+ set dtend [dict get $time_window time_window.dtend]
+ set time_window_msg
[_ xowf.Automatically_published_from_to [list from $dtstart to $dtend]]
+ set time_window_msg "
Automatische Freischaltung der Prüfung von $dtstart bis $dtend"
+ }
+ }
+ set question_hint_html ""
+ if {$questions_without_minutes > 0} {
+ append question_hint_html \
+ " ($questions_without_minutes #xowf.without_minutes#)"
+ }
+
+ append text [subst {
+
+ [expr {$max_items_msg ne "" ? "$max_items_msg" : ""}]
+ $nrQuestions [expr {$nrQuestions == 1 ? "#xowf.question#" : "#xowf.questions#"}]$question_hint_html,
+ $total_minutes #xowf.Minutes#, $total_points #xowf.Points#
+ }]
+ return "
$text
"
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: total
+ #----------------------------------------------------------------------
+ :method total {-property:required title_infos} {
+ #
+ # Sum up the values of the provided property from title_infos
+ #
+ set total 0
+ foreach title_info $title_infos {
+ if {[dict exists $title_info $property]} {
+ set value [dict get $title_info $property]
+ if {$value eq ""} {
+ ns_log notice "missing property '$property' in '$title_info'"
+ set value 0
+ }
+ set total [expr {$total + $value}]
+ }
+ }
+ return $total
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: title_infos
+ #----------------------------------------------------------------------
+ :method title_infos {{-max_items:integer,0..1 ""} form_info} {
+ #
+ # When max_items is nonempty, return the title infos of all
+ # items. Otherwise, just the specified number of items.
+ #
+ return [:max_items $max_items [dict get $form_info title_infos]]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: total_minutes
+ #----------------------------------------------------------------------
+ :public method total_minutes {{-max_items:integer,0..1 ""} form_info} {
+ #
+ # Compute the duration of an exam based on the form_info dict.
+ #
+ return [:total -property minutes [:title_infos -max_items $max_items $form_info]]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: total_points
+ #----------------------------------------------------------------------
+ :public method total_points {{-max_items:integer,0..1 ""} form_info} {
+ #
+ # Compute the maximum achievable points of an exam based on the
+ # form_info dict.
+ #
+ return [:total -property points [:title_infos -max_items $max_items $form_info]]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: questions_without_minutes
+ #----------------------------------------------------------------------
+ :public method questions_without_minutes {{-max_items:integer,0..1 ""} form_info} {
+ #
+ # Compute the number of questions without provided time
+ #
+ set number 0
+ foreach title_info [:title_infos -max_items $max_items $form_info] {
+ if {[dict exists $title_info minutes]} {
+ set value [dict get $title_info minutes]
+ if {$value eq ""} {
+ set value 0
+ }
+ if {$value == 0} {
+ incr number
+ }
+ }
+ }
+ return $number
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: total_minutes_for_exam
+ #----------------------------------------------------------------------
+ :public method total_minutes_for_exam {-manager:object} {
+ #
+ # Compute the total time of an exam, based on the minutes
+ # provided by the single questions.
+ #
+ set max_items [$manager property max_items ""]
+ set combined_form_info [:combined_question_form $manager]
+ set total_minutes [:total_minutes \
+ -max_items $max_items \
+ $combined_form_info]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_target_time
+ #----------------------------------------------------------------------
+ :public method exam_target_time {-manager:object -base_time} {
+ #
+ # Calculate the exam target time (finishing time) based on the
+ # duration of the exam plus the provided base_time (which is in
+ # the format returned by SQL)
+ #
+ # @param manager exam workflow
+ # @param base_time time in SQL format
+ #
+ set total_minutes [:total_minutes_for_exam -manager $manager]
+
+ # Use "try" for backward compatibility, versions before
+ # factional seconds. TODO: remove me.
+ try {
+ set base_clock [clock scan [::xo::db::tcl_date $base_time tz secfrac]]
+ if {[string length $secfrac] > 3} {
+ set secfrac [string range $secfrac 0 2]
+ }
+ } on error {errorMsg} {
+ set base_clock [clock scan [::xo::db::tcl_date $base_time tz]]
+ set secfrac 0
+ }
+ set target_time [clock format [expr {int($base_clock + $total_minutes * 60)}] \
+ -format %Y-%m-%dT%H:%M:%S]
+ #ns_log notice "exam_target_time $base_time base clock $base_clock + total_minutes $total_minutes = ${target_time}.$secfrac"
+ return ${target_time}.$secfrac
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: exam_base_time
+ #----------------------------------------------------------------------
+ :public method exam_base_time {-manager:object -answer_obj:object} {
+ #
+ # Calculate the exam base time for a student. This is the time
+ # reference, when the timer starts. Depending on whether the
+ # exam is synchronous, the time start is either the time when
+ # the exam is opened, or when the student starts the exam.
+ #
+ # @return time string as returned from the database
+ #
+ if {[$manager property synchronized 0]} {
+ set parent_obj [::xowiki::FormPage get_instance_from_db -item_id [$answer_obj parent_id]]
+ set base_time [$parent_obj last_modified]
+ } else {
+ set base_time [$answer_obj creation_date]
+ }
+ return $base_time
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: current_question_form
+ #----------------------------------------------------------------------
+ :public method current_question_form {
+ {-with_numbers:switch false}
+ {-with_title:switch false}
+ obj:object
+ } {
+ #
+ # Return the current form object of the provided assessment.
+ #
+ return [:nth_question_form -with_numbers=$with_numbers -with_title=$with_title $obj]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: nth_question_form
+ #----------------------------------------------------------------------
+ :public method nth_question_form {
+ {-position:integer}
+ {-item_nr:integer}
+ {-with_numbers:switch false}
+ {-with_title:switch false}
+ {-titleless_form:switch false}
+ {-with_minutes:switch false}
+ obj:object
+ } {
+ #
+ # Return the question_info of the nth form (question) of the
+ # assessment. The information added to the title can be
+ # optionally included as expressed by the non-positional
+ # parameters.
+ #
+ if {![info exists position]} {
+ set position [$obj property position]
+ }
+ if {![info exists item_nr]} {
+ set item_nr $position
+ }
+ set form_objs [:nth_question_obj $obj $position]
+ if {$with_numbers} {
+ set number [expr {$item_nr + 1}]
+ set extra_flags [list -numbers $number]
+ } else {
+ set extra_flags ""
+ }
+ return [:question_info \
+ -with_title=$with_title \
+ -titleless_form=$titleless_form \
+ -with_minutes=$with_minutes \
+ -with_question_count_in_title true \
+ {*}$extra_flags \
+ -obj $obj \
+ $form_objs]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: current_question_number
+ #----------------------------------------------------------------------
+ :public method current_question_number {obj:object} {
+ #
+ # Translate the position of an object into its question number
+ # (as e.g. used by current_question_title).
+ #
+ return [expr {[$obj property position] + 1}]
+ }
+
+ #----------------------------------------------------------------------
+ # Class: Question_manager
+ # Method: current_question_title
+ #----------------------------------------------------------------------
+ :public method current_question_title {{-with_numbers:switch false} obj:object} {
+ #
+ # In case, with_numbers is provided, return a internationalized
+ # title for the question, such as "Question 1".
+ #
+ if {$with_numbers} {
+ return "#xowf.question# [:current_question_number $obj]"
+ }
+ }
+ }
+ set qm [Question_manager create question_manager]
+ AssessmentInterface {*}$register_command QM $qm
+ ::xowiki::formfield::TestItemField instforward QM $qm
+}
+
+namespace eval ::xowiki::formfield {
+ #
+ # The following "describe" function should be moved to a more
+ # generic place, probably to the formfield procs in xowiki (to the
+ # relevant formfield classes). It is just kept here for the time
+ # being, until we have a better understanding what's needed in
+ # detail.
+ #
+ ::xowiki::formfield::FormField instproc describe {{-field_name ""}} {
+ set d ""
+ #
+ # The dict keys of the result should correspond as far as possible
+ # to message keys to ease multi-language communication.
+ #
+ set qa [${:object} property question]
+ #ns_log notice "FormField describe gets question attributes <$qa> from ${:object}"
+
+ foreach {key name} {
+ question.minutes Minutes
+ question.points Points
+ question.grading grading
+ question.show_max show_max
+ } {
+ if {[dict exists $qa $key]} {
+ dict set d $name [dict get $qa $key]
+ }
+ }
+ switch [:info class] {
+ ::xowiki::formfield::radio -
+ ::xowiki::formfield::checkbox {
+ # mc and sc interaction
+ set type [expr {[:info class] eq "::xowiki::formfield::checkbox" ? "MC" : "SC"}]
+ #
+ # The factual (displayed) answer is in ${:answer}, but we want
+ # to see the list of possibilities, so use the data from the
+ # original spec.
+ #
+ foreach s [split ${:spec} ,] {
+ if {[regexp {^answer=(.*)$} $s . answer]} {
+ break
+ }
+ }
+ dict set d choice_options [llength ${answer}]
+ dict set d nrcorrect [llength [lsearch -exact -all ${answer} t]]
+ dict set d shuffle ${:shuffle_kind}
+ #dict set d all [:serialize]
+ }
+ ::xowiki::formfield::text_fields {
+ set type ShortText
+ # short text interaction
+ #
+ # The factual (displayed) answer is in ${:answer}, but we want
+ # to see the list of possibilities, so use the data from the
+ # original spec (here in $options)
+ #
+ foreach s [split ${:spec} ,] {
+ #ns_log warning "s=$s"
+ if {[regexp {^options=(.*)$} $s . options]} {
+ break
+ }
+ }
+ dict set d all ${:spec}
+ dict set d sub_questions [llength ${options}]
+ dict set d shuffle ${:shuffle_kind}
+ }
+ ::xowiki::formfield::textarea {
+ set type Text
+ }
+ ::xowiki::formfield::pool_question_placeholder {
+ set type PoolQuestion
+ set item_dict [:QM get_pool_questions \
+ -field_name $field_name ${:object} ""]
+
+ set counts ""
+ foreach {key value} $item_dict {
+ dict incr counts [dict get $item_dict $key item_type]
+ }
+
+ dict set d available_pool_items [dict size $item_dict]
+ dict set d available_pool_item_stats $counts
+ }
+ ::xowiki::formfield::reorder_box {
+ set type Reorder
+ }
+ ::xowiki::formfield::file {
+ set type Upload
+ }
+ ::xowiki::formfield::form_page {
+ set type Composite
+ }
+
+ default {
+ set type [:info class]
+ ns_log warning "describe: class [:info class] not handled"
+ }
+ }
+ dict set d type $type
+ #ns_log notice "describe [:info class] [${:object} name] -> $d"
+ dict set d question_title [${:object} title]
+
+ return $d
+ }
+}
+
+namespace eval ::xowf::test_item {
+ #
+ # Define handling of form-field "td_pretty_value". This class is
+ # used as a mixin class in the result table renderer.
+ #
+ ::xotcl::Class create ::xowf::test_item::td_pretty_value \
+ -superclass ::xowiki::formfield::FormField
+
+ ::xowf::test_item::td_pretty_value instproc pretty_value {value} {
+ #
+ # In case the form_field_class has a "td_pretty_value" defined,
+ # return its value. This is e.g. useful, when we have shuffled
+ # fields, which are different per user. When we initiate the field
+ # we would see just see the subset of fields for this user, but in
+ # the tabular view, it is required to see in one columns all fields.
+ #
+ #ns_log notice "${:name} pretty_value [:info precedence] // [:istype ::xowiki::formfield::text_fields]"
+ if {[:procsearch td_pretty_value] ne ""} {
+ set v [:td_pretty_value $value]
+ } else {
+ set v [next]
+ }
+ return $v
+ }
+}
+
+namespace eval ::xowiki {
+ ::xowiki::MenuBar instproc config=test-items {
+ {-bind_vars {}}
+ -current_page:required
+ -package_id:required
+ -folder_link:required
+ -return_url
+ } {
+ :config=default \
+ -bind_vars $bind_vars \
+ -current_page $current_page \
+ -package_id $package_id \
+ -folder_link $folder_link \
+ -return_url $return_url
+
+ return {
+ {clear_menu -menu New}
+
+ {entry -name New.Item.TextInteraction -form en:edit-interaction.wf -query p.item_type=Text}
+ {entry -name New.Item.ShortTextInteraction -form en:edit-interaction.wf -query p.item_type=ShortText}
+ {entry -name New.Item.SCInteraction -form en:edit-interaction.wf -query p.item_type=SC}
+ {entry -name New.Item.MCInteraction -form en:edit-interaction.wf -query p.item_type=MC}
+ {entry -name New.Item.ReorderInteraction -form en:edit-interaction.wf -query p.item_type=Reorder}
+ {entry -name New.Item.UploadInteraction -form en:edit-interaction.wf -query p.item_type=Upload}
+ {entry -name New.Item.CompositeInteraction -form en:edit-interaction.wf -query p.item_type=Composite}
+ {entry -name New.Item.PoolQuestionInteraction -form en:edit-interaction.wf -query p.item_type=PoolQuestion}
+
+ {entry -name New.Grading.Scheme -form en:edit-grading-scheme.wf}
+
+ {entry -name New.App.OnlineExam -form en:online-exam.wf -disabled true}
+ {entry -name New.App.InclassQuiz -form en:inclass-quiz.wf -disabled true}
+ {entry -name New.App.InclassExam -form en:inclass-exam.wf -query p.realexam=1}
+
+ }
+ }
+
+ ::xowiki::MenuBar instproc config=test-item-exams {
+ {-bind_vars {}}
+ -current_page:required
+ -package_id:required
+ -folder_link:required
+ -return_url
+ } {
+ :config=default \
+ -bind_vars $bind_vars \
+ -current_page $current_page \
+ -package_id $package_id \
+ -folder_link $folder_link \
+ -return_url $return_url
+
+ # {entry -name New.Item.ExamFolder -form en:Folder.form -query p.configure=exam_folder}
+
+ return {
+ {clear_menu -menu New}
+ {entry -name New.Item.ExamFolder -form en:folder.form -query p.source=ExamFolder&publish_status=ready}
+ }
+ }
+
+}
+
+# namespace eval ::xowf {
+# ::xowf::WorkflowPage instproc configure_page=exam_folder {name} {
+# ns_log notice "configure_page=exam_folder called on [self] ${:name} ($name) [:info precedence] ia <${:instance_attributes}> "
+# ns_log notice [:serialize]
+# dict set :instance_attributes extra_menu_entries {{config -use test-items}}
+# }
+# }
+
+namespace eval ::xowf {
+ ::xowf::WorkflowPage ad_instproc render_thumbnails {upload_info} {
+
+ Renderer of the thumbnail file(s)
+
+ @param upload_info dict containing the "file_object" and "file_name"
+ @return HTML content
+ } {
+ dict with upload_info {
+ set parent_id ${:item_id}
+ set feedbackFiles [xo::dc list_of_lists . {
+ select item_id, name from cr_items where parent_id = :parent_id
+ }]
+ if {[regexp {^([^/]+)/} $file_name . qn]} {
+ set HTML [:QM render_feedback_files \
+ -question_name $qn \
+ -feedbackFiles $feedbackFiles]
+ } else {
+ set HTML "$file_name created"
+ }
+ }
+ return $HTML
+ }
+}
+
+namespace eval ::xowf::test_item {
+ #
+ # Copy the default policy (policy1) from xowiki and add elements for
+ # FormPages as needed by the demo workflows:
+ #
+ # - online-exam.wf, online-exam-answer.wf
+ # - inclass-quiz.wf, inclass-quiz-answer.wf
+ #
+ ::xowiki::policy1 copy ::xowf::test_item::test-item-policy-publish
+ ::xowiki::policy1 copy ::xowf::test_item::test-item-policy-answer
+ ::xowiki::policy1 copy ::xowf::test_item::test-item-policy-edit
+
+ #
+ # Add policy rules as used in the demo workflows. We are permissive
+ # for student actions and require admin right for teacher
+ # activities.
+ #
+ #
+ # Policy for lecturers (creating and publishing of exams)
+ #
+ test-item-policy-publish contains {
+ Class create FormPage -array set require_permission {
+ answer {{item_id read}}
+ view-my-exam {{item_id read}}
+ proctor-answer {{item_id read}}
+ proctor {{item_id read}}
+ poll-open {{item_id read}}
+ view admin
+ poll admin
+ send-participant-message admin
+ grade-single-item admin
+ edit admin
+ exam-results admin
+ question-summary admin
+ question-list admin
+ print-answers admin
+ proctoring-display admin
+ print-answer-table admin
+ print-participants admin
+ delete admin
+ qrcode admin
+ make-live-revision admin
+ }
+ }
+
+ #
+ # Policy for editing test items.
+ #
+ test-item-policy-edit contains {
+ Class create FormPage -array set require_permission {
+ revisions admin
+ diff admin
+ } -set default_permission {{package_id admin}}
+ }
+
+ #
+ # Policy for answering test items.
+ #
+ test-item-policy-answer contains {
+ Class create Package -array set require_permission {
+ create-from-prototype admin
+ }
+ Class create FormPage -array set require_permission {
+ poll {{item_id read}}
+ edit creator
+ message-poll {{item_id read}}
+ message-dismiss {{item_id read}}
+ }
+ }
+
+
+ #ns_log notice [::xowf::test_item::test-item-policy1 serialize]
+ #ns_log notice ===================================
+
+}
+::xo::library source_dependent
+
+
#
# Local variables:
# mode: tcl
# tcl-indent-level: 2
+# eval: (setq tcl-type-alist (remove* "method" tcl-type-alist :test 'equal :key 'car))
# indent-tabs-mode: nil
# End: