Class ::xowf::test_item::Question_manager (public)

 ::nx::Class ::xowf::test_item::Question_manager[i]

Defined in packages/xowf/tcl/test-item-procs.tcl

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

Testcases:
No testcase defined.
Source code:
    #----------------------------------------------------------------------
    # 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 "<small><adp:icon name='previous'> #acs-kernel.common_Previous#</small>"  -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 "<small>#acs-kernel.common_Next# <adp:icon name='next'></small>"  -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  "<div class='test-item' data-item_type='$item_type'>"

            if {!$titleless_form} {
              append full_form  "<h4>[dict get $title_info full_title]</h4>\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" ? [::template::CSS class d-none] : ""}]
              if {$with_grading_box eq "hidden"} {
                set question_name answer_$question_name
              }
              set data_attribute [expr {[::template::CSS toolkit] eq "bootstrap5" ? "data-bs" : "data"}]
              append full_form [subst [ns_trim -delimiter | {
                |<div id='grading-box-[incr count]' class='grading-box $hiddenCSSclass'
                |     data-question_name='$question_name' data-title='[$question_obj title]'
                |     data-question_id='[$question_obj item_id]'>
                |  #xowf.Points#: <span class='points'></span>
                |  <span class='percentage'></span>
                |  <span class='feedback-label'>#xowf.feedback#: </span><span class='comment'></span>
                |  <a class='manual-grade' href='#' $data_attribute-toggle='modal'
                |    $data_attribute-target='#grading-modal'>
                |    <span class='manual-grade-edit'>[::xowiki::bootstrap::icon -name pencil]</span>
                |  </a>
                | <div class="thumbnail-files-wrapper"></div>
                |</div>
              }]]
            }
            append full_form  $question_form  [:hint_boxes  -question_obj $question_obj  -with_feedback=$with_feedback  -with_correction_notes=$with_correction_notes]  </div>\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 "<strong>#xowf.Shuffle#:</strong> [:pretty_shuffle $m]" }
                default   { append msg "<strong>#xowf.$metric#:</strong> $m "}
              }
            }
          }
          #append  msg " <pre>$describe_info</pre> "
          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]
      return [ns_trim -delimiter | [subst {
        | <p><adp:button type="button" class="btn btn-default" data-toggle="collapse" data-target="#$id">
        |      <adp:icon name='chevron-down'> $label
        |    </adp:button>
        | <div id="$id" class="collapse">
        | [:exam_configuration_render_fields -modifiable $modifiable $fields]
        |</div>
      }]]
    }

    #----------------------------------------------------------------------
    # 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#: <span id='configuration-participant'></span>"  -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 {
          <p>#xowf.export_results#: <a title="#xowf.export_results_title#" href="[ns_quotehtml $href]">
          <adp:icon name="filetype-csv" title="CSV"></a>
        }]
      } 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
        | <hr><p><a class="[::template::CSS class action]" href="[ns_quotehtml $return_url]">#xowiki.back#</a></p>
      }]]
    }

    #----------------------------------------------------------------------
    # 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 "&emsp;&emsp;[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 {
                <a href='[ns_quotehtml $href&fos=[$form_obj item_id]]'>[ns_quotehtml [$form_obj title]]</a>
              }]
            } else {
              dict set chunk title_value [ns_quotehtml [$form_obj title]]
            }
          }
          dict set chunk structure $structure
          lappend chunks $chunk
        }
      }

      set body [ns_trim -delimiter | {
        |<div class='table-responsive'><table class='question_summary table table-condensed'>
        | <tr>
        |  <th></th><th>#xowf.question_structure#</th>
        |  <th style='text-align: center;'>#xowf.Minutes#</th>
        |  <th style='text-align: center;'>#xowf.Points#</th>
        |  <th style='text-align: center;'>#xowf.Shuffle#</th>
        |  <th style='text-align: center;'></th>
        | </tr>
      }]

      foreach chunk $chunks {
        append body [subst [ns_trim -delimiter | {
          | <tr>
          |  <td>[:dict_value $chunk title_value]</td>
          |  <td>[:dict_value $chunk type]: [:dict_value $chunk structure]</td>
          |  <td style='text-align: center;'>[:dict_value $chunk Minutes]</td>
          |  <td style='text-align: center;'>[:dict_value $chunk Points]</td>
          |  <td style='text-align: center;'>[:pretty_shuffle [:dict_value $chunk shuffle]]</td>
          |  <td style='text-align: center;'>[:dict_value $chunk grading]</td>
          | </tr>
        }]]
      }
      append body [ns_trim -delimiter | {
        |</table></div>
      }]

      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 {<p>
        [expr {$synchronized ? "" : "Non-"}]Synchronized Exam
        [expr {$proctoring ? " with Proctoring" : ""}]
        </p>}]
      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 <br>[_ xowf.Automatically_published_from_to [list from $dtstart to $dtend]]
          set time_window_msg "<br>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 {
        <p>
        [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#<br>
        [expr {$total_minutes <= 1 ? "#xowf.Countdown_timer_is_not_displayed#<br>" : ""}]
        [expr {$autograde ? "#xowf.exam_review_possible#" : "#xowf.exam_review_not_possible#"}]<br>
        [expr {$randomizationOk ? "#xowf.randomization_for_exam_ok#" : "#xowf.randomization_for_exam_not_ok#"}]<br>
        [expr {$allow_paste ? "#xowf.Cut_and_paste_allowed#" : "#xowf.Cut_and_paste_not_allowed#"}]<br>
        [expr {$allow_spellcheck ? "#xowf.Spellcheck_allowed#" : "#xowf.Spellcheck_not_allowed#"}]<br>
        [expr {$allow_translation ? "#xowf.Translation_allowed#" : "#xowf.Translation_not_allowed#"}]<br>
        $time_window_msg
        [expr {[llength $published_periods] > 0 ? "<br>#xowf.inclass-exam-open#: [join $published_periods {, }]<br>" : ""}]
        [expr {[llength $review_periods] > 0 ? "#xowf.inclass-exam-review#: [join $review_periods {, }]<br>" : ""}]
        </p>
      }]
      return "<div class='exam-info-block'>$text</div>"
    }

    #----------------------------------------------------------------------
    # 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]"
      }
    }
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: