Index: openacs-4/contrib/packages/survey/tcl/survey-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/survey/tcl/Attic/survey-procs.tcl,v
diff -u -r1.4.2.1 -r1.4.2.2
--- openacs-4/contrib/packages/survey/tcl/survey-procs.tcl 2 Sep 2004 15:17:47 -0000 1.4.2.1
+++ openacs-4/contrib/packages/survey/tcl/survey-procs.tcl 1 Jan 2005 17:39:00 -0000 1.4.2.2
@@ -524,7 +524,7 @@
} else {
set new_sort_order $sort_order
}
-
+ set new_question_id [db_nextval acs_object_id_seq]
set new_question_id [db_exec_plsql create_question {}]
db_dml insert_question_text {}
db_foreach get_survey_question_choices {} {
@@ -562,6 +562,7 @@
foreach section_id $sections_list {
db_1row get_section_info ""
+ set new_section_id [db_nextval acs_object_id_seq]
set new_section_id [db_exec_plsql section_create {}]
set new_section_ids($section_id) $new_section_id
if {![empty_string_p $description]} {
@@ -1020,3 +1021,803 @@
return $page_list
}
+
+
+ad_proc -public survey_new {
+ {-survey_id ""}
+ -name
+ -description
+ {-description_html_p "f"}
+ {-single_response_p "f"}
+ {-editable_p "f"}
+ {-enabled_p "f"}
+ {-single_section_p "t"}
+ {-type "general"}
+ {-display_type ""}
+ {-package_id ""}
+ {-public_p "t"}
+ {-creation_user ""}
+ {-context_id ""}
+} {
+
+
+ @author Dave Bauer (dave@thedesignexperience.org)
+ @creation-date 2004-09-19
+
+ @param survey_id
+
+ @param name
+
+ @param description
+
+ @param description_html_p
+
+ @param single_response_p
+
+ @param editable_p
+
+ @param enabled_p
+
+ @param single_section_p
+
+ @param type
+
+ @param display_type
+
+ @param package_id
+
+ @param public_p
+
+ @param creation_user
+
+ @param context_id
+
+ @return
+
+ @error
+} {
+ if {[string equal "" $package_id]} {
+ if {[ad_conn -connected_p]} {
+ set package_id [ad_conn package_id]
+ } else {
+ error "package_id is required if called outside a http connection"
+ }
+ }
+ if {[string equal "" $context_id]} {
+ set context_id $package_id
+ }
+ set new_survey_id [package_exec_plsql \
+ -var_list [list \
+ [list survey_id $survey_id] \
+ [list name $name] \
+ [list description $description] \
+ [list description_html_p $description_html_p] \
+ [list single_response_p $single_response_p] \
+ [list editable_p $editable_p] \
+ [list enabled_p $enabled_p] \
+ [list single_section_p $single_section_p] \
+ [list type $type] \
+ [list display_type $display_type] \
+ [list package_id $package_id] \
+ [list public_p $public_p] \
+ [list creation_user $creation_user] \
+ [list context_id $context_id] \
+ ] "survey" "new"]
+ return $new_survey_id
+}
+
+ad_proc -public survey_section_new {
+ {-section_id ""}
+ -survey_id
+ {-name ""}
+ {-description ""}
+ {-description_html_p "f"}
+ {-sort_key 1}
+ {-branch_p "f"}
+ {-branched_p "f"}
+ {-block_section_p "f"}
+ {-page_break_p "t"}
+ {-creation_user ""}
+ {-context_id ""}
+ {-pretty_id ""}
+} {
+
+ Create a new survey_section
+
+ @author Dave Bauer (dave@thedesignexperience.org)
+ @creation-date 2004-09-19
+
+ @param section_id
+
+ @param survey_id
+
+ @param name
+
+ @param description
+
+ @param description_html_p
+
+ @param sort_key
+
+ @param branch_p
+
+ @param branched_p
+
+ @param block_section_p
+
+ @param page_break_p
+
+ @param creation_user
+
+ @param context_id
+
+ @return
+
+ @error
+} {
+ if {$context_id eq ""} {
+ set context_id $survey_id
+ }
+ return [package_exec_plsql \
+ -var_list [list \
+ [list section_id $section_id] \
+ [list survey_id $survey_id] \
+ [list name $name] \
+ [list description $description] \
+ [list description_html_p $description_html_p] \
+ [list sort_key $sort_key] \
+ [list branch_p $branch_p] \
+ [list branched_p $branched_p] \
+ [list block_section_p $block_section_p] \
+ [list page_break_p $page_break_p] \
+ [list creation_user $creation_user] \
+ [list context_id $context_id]] \
+ "survey_section" "new"]
+}
+
+ad_proc -public survey_section_copy {
+ -section_id
+ {-new_survey_id ""}
+ {-new_name ""}
+ {-new_description ""}
+ {-new_section_id ""}
+ {-creation_user ""}
+} {
+
+
+ @author Dave Bauer (dave@thedesignexperience.org)
+ @creation-date 2004-10-14
+
+ @param section_id
+
+ @param new_section_id optional
+
+ @param new_survey_id
+
+ @return
+
+ @error
+} {
+ # get original section
+ db_1row get_section "select * from survey_sections where section_id=:section_id"
+ # create new section based on original
+ # calculate new sort_key??
+ set sort_key 1
+ if {$new_survey_id ne ""} {
+ set survey_id $new_survey_id
+ }
+ if {$new_name ne ""} {
+ set name $new_name
+ }
+ if {$new_description ne ""} {
+ set description $new_description
+ }
+
+ set new_survey_id [survey_section_new \
+ -section_id $new_section_id \
+ -survey_id $survey_id \
+ -name $name \
+ -description $description \
+ -description_html_p $description_html_p \
+ -sort_key $sort_key \
+ -branch_p $branch_p \
+ -branched_p $branched_p \
+ -block_section_p $block_section_p \
+ -page_break_p $page_break_p \
+ -creation_user $creation_user \
+ -context_id $new_survey_id]
+
+ return $new_section_id
+}
+
+# procesure to handle median calculations
+
+namespace eval ::math::statistics:: {}
+
+# median
+ # Determine the median from a list of data
+ #
+ # Arguments:
+ # data (Unsorted) list of data
+ #
+ # Result:
+ # Median (either the middle value or the mean of two values in the
+ # middle)
+ #
+ # Note:
+ # Adapted from the Wiki page "Stats", code provided by JPS
+ #
+proc ::math::statistics::median { data } {
+ set org_data $data
+ set data {}
+ foreach value $org_data {
+ if { $value != {} } {
+ lappend data $value
+ }
+ }
+ set len [llength $data]
+
+ set data [lsort -real $data]
+ if { $len % 2 } {
+ lindex $data [expr {($len-1)/2}]
+ } else {
+ expr {([lindex $data [expr ($len / 2) - 1]] \
+ + [lindex $data [expr $len / 2]]) / 2.0}
+ }
+}
+
+ad_proc -public survey_question_new {
+ -question_id
+ -section_id
+ -question_text
+ {-question_html_p "f"}
+ {-presentation_options ""}
+ {-after ""}
+ -abstract_data_type
+ -presentation_type
+ -presentation_alignment
+ -valid_responses
+ -required_p
+ -active_p
+ {-creation_user ""}
+ {-pretty_id ""}
+} {
+
+ @author Dave Bauer (dave@thedesignexperience.org)
+ @creation-date 2004-10-23
+
+ @param section_id integer denoting which survey we're adding question to
+ @param question_id id of new question
+ @param after optional integer determining position of this question
+ @param question_text text of question
+ @param abstract_data_type string describing datatype we expect as answer
+ @param presentation_type string describing widget for providing answer
+ @param presentation_alignment string determining placement of answer widget relative to question text
+ @param valid_responses list containing possible choices
+ @param required_p flag telling us whether an answer to this question is mandatory
+ @param active_p flag telling us whether this question will show up at all
+
+ @return new question_id
+
+ @error
+} {
+ set summary_type ""
+ set answer_description ""
+
+ get_section_info -section_id $section_id
+ # Generate presentation_options.
+ set presentation_options ""
+ if { $presentation_type == "textbox" } {
+ if { [exists_and_not_null textbox_size] } {
+ # Will be "small", "medium", or "large".
+ set presentation_options $textbox_size
+ }
+ } elseif { $presentation_type == "textarea" } {
+ if { [exists_and_not_null textarea_size] } {
+ # Will be "small", "medium", or "large".
+ set presentation_options $textarea_size
+ }
+ } elseif { $abstract_data_type == "yn" } {
+ set abstract_data_type "boolean"
+ set presentation_options "Yes/No"
+ } elseif { $abstract_data_type == "boolean" } {
+ set presentation_options "True/False"
+ }
+
+
+ # if this is a block section, get the choices and run the block for
+ # every choice set
+ if {$section_info(block_section_p)=="t"} {
+ set all_choices_list [db_list all_choices ""]
+ } else {
+ set all_choices_list {dummy}
+ }
+
+ set count 0
+ foreach all_choices $all_choices_list {
+ # Get the canned responses for a block section if applicable
+ if {$section_info(block_section_p)=="t"} {
+ # block section, get the valid_responses
+ regsub -all "," $all_choices "\n" valid_responses
+ }
+ # If we insert multiple questions (because of block questions)
+ # generate a new question_id
+ if {$count>0} {
+ set question_id [db_nextval acs_object_id_seq]
+ }
+ incr count
+
+
+ if { [exists_and_not_null after] } {
+ # We're inserting between existing questions; move everybody down.
+ set sort_order [expr { $after + 1 }]
+ db_dml renumber_sort_orders {}
+ } else {
+ set sort_order [expr [db_string max_question {}] + 1]
+ }
+
+ db_exec_plsql create_question {}
+ db_dml add_question_text {}
+
+ # For questions where the user is selecting a canned response, insert
+ # the canned responses into survey_question_choices by parsing the valid_responses
+ # field.
+
+ if { $presentation_type == "checkbox" || $presentation_type == "radio" || $presentation_type == "select" } {
+ if { $abstract_data_type == "choice" } {
+ # this proc now accepts a list of responses
+ # TODO create proc to split responses
+ set responses [split $valid_responses "\n"]
+ set count 0
+ if {[info exists valid_responses]} {
+ foreach response $valid_responses {
+ # DB fix bug #204 need to address this in UI if necessary
+ # don't try to guess numeric value is seperated from answer by a comma
+ # foreach {response numeric_value} [split $response ","] break
+ set numeric_value ""
+ set trimmed_response [string trim $response]
+ if { [empty_string_p $trimmed_response] } {
+ # skip empty lines
+ continue
+ }
+ ### added this next line to
+ set choice_id [db_nextval survey_choice_id_sequence]
+ db_dml insert_survey_question_choice ""
+ incr count
+ }
+ }
+ }
+ }
+ }
+ return $question_id
+}
+
+ad_proc -public survey_question_update {
+ -question_id
+ -section_id
+ -question_text
+ {-question_html_p "f"}
+ {-presentation_options ""}
+ -sort_order
+ -abstract_data_type
+ -presentation_type
+ -presentation_alignment
+ -valid_responses
+ -required_p
+ -active_p
+ {-creation_user ""}
+ {-new_section ""}
+ {-block_p "f"}
+} {
+
+
+ @author Dave Bauer (dave@thedesignexperience.org)
+ @creation-date 2004-10-24
+
+
+ @param section_id integer denoting which survey we're adding question to
+ @param question_id id of new question
+ @param sort_order optional integer determining position of this question
+ @param question_text text of question
+ @param abstract_data_type string describing datatype we expect as answer
+ @param presentation_type string describing widget for providing answer
+ @param presentation_alignment string determining placement of answer widget relative to question text
+ @param valid_responses list containing possible choices
+ @param required_p flag telling us whether an answer to this question is mandatory
+ @param active_p flag telling us whether this question will show up at all
+
+ @return
+
+ @error
+} {
+
+ db_transaction {
+ if {$new_section ne ""} {
+ set anchor [db_string new_anchor ""]
+ set section_id $new_section
+ }
+
+ db_dml survey_question_update {}
+
+ # add new responses is choice type question
+
+ if {[info exists valid_responses] && $block_p=="f"} {
+# TODO DAVEB add block question to this proc as well??
+ set responses [split $valid_responses "\n"]
+ set count 0
+ set response_list ""
+ foreach response $responses {
+ set numeric_value ""
+# regexp {(.+),\s*(\d+)} $response discard response numeric_value
+ set trimmed_response [string trim $response]
+ set numeric_value [string trim $numeric_value]
+ if { [empty_string_p $trimmed_response] } {
+ # skip empty lines
+ continue
+ }
+
+ lappend response_list [list "$trimmed_response" "$count" ${numeric_value}]
+ incr count
+ }
+
+ set choice_id_to_update_list [db_list get_choice_id {}]
+ set sort_order 0
+ foreach one_response $response_list {
+ set choice_label [lindex $one_response 0]
+ set sort_order [lindex $one_response 1]
+ set numeric_value [lindex $one_response 2]
+ set choice_id_to_update [lindex $choice_id_to_update_list $sort_order]
+ if {[empty_string_p $choice_id_to_update]} {
+ set new_choice_id [db_nextval survey_choice_id_sequence]
+ db_dml insert_new_choice {}
+ } else {
+ db_dml update_new_choice {}
+ }
+ incr sort_order
+ }
+
+ while {[llength $choice_id_to_update_list] >= $sort_order} {
+ set choice_id_to_delete [lindex $choice_id_to_update_list $sort_order]
+ db_dml delete_old_choice {}
+ incr sort_order
+ }
+
+ }
+ } on_error {
+
+ db_release_unused_handles
+ ad_return_error "Database Error" "$errmsg
"
+ ad_script_abort
+
+ }
+
+}
+
+# FIXME DaveB convert this to new add to form api in survey-form-procs
+ad_proc -public survey_question_add_to_form {
+ form
+ question_id
+ {response_id ""}
+} {Adds the question to the form. the form has to be created by ad_form or with template::form::create. The form variable is of the form \"response_to_question.\$question_id} {
+
+ if {![empty_string_p $response_id]} {
+ set edit_previous_response_p "t"
+ } else {
+ set edit_previous_response_p "f"
+ }
+
+ set element_name "response_to_question.$question_id"
+
+ db_1row survey_question_properties ""
+
+ set user_value ""
+
+ if {$predefined_question_id!=[db_null]} {
+ # question is a predefined question. If it has already been answered, get the last response value from the db
+ # if it is a predefined question with action_type="db" get the value from the db instead.
+ db_1row predefined_question_data ""
+ if {$action_type == "db"} {
+ # select preselected value from the db
+ set user_id [ad_get_user_id]
+ # We have to check for date
+ if {$abstract_data_type == "date"} {
+ set user_value [db_string ignore "select to_char($column_name,'YYYY MM DD') from $table_name where $key_name=:user_id" -default ""]
+ set date_answer $user_value
+ } else {
+ set user_value [db_string ignore "select $column_name from $table_name where $key_name=:user_id" -default ""]
+ set choice_id $user_value
+ set boolean_answer $user_value
+ set clob_answer $user_value
+ set number_answer $user_value
+ set varchar_answer $user_value
+ set attachment_answer $user_value
+ }
+ } else {
+ # select preselected value from latest response
+ set user_id [ad_get_user_id]
+ if {[db_0or1row locate_predef_preselect ""]} {
+ set count 0
+ db_foreach prev_response_query_predef {} {
+ incr count
+
+ if {$presentation_type == "checkbox" || $presentation_type == "checkbox_text} {
+ set selected_choices($choice_id) "t"
+ }
+ } if_no_rows {
+ set choice_id 0
+ set boolean_answer ""
+ set clob_answer ""
+ set number_answer ""
+ set varchar_answer ""
+ set date_answer ""
+ set attachment_answer ""
+ }
+ set edit_previous_response_p "t"
+ } else {
+ set choice_id 0
+ set boolean_answer ""
+ set clob_answer ""
+ set number_answer ""
+ set varchar_answer ""
+ set date_answer ""
+ set attachment_answer ""
+ }
+ }
+ } else {
+ if {$edit_previous_response_p == "t"} {
+ set user_id [ad_get_user_id]
+
+ set count 0
+ db_foreach prev_response_query {} {
+ incr count
+
+ if {$presentation_type == "checkbox" || $presentation_type == "checkbox_text"} {
+ set selected_choices($choice_id) "t"
+ }
+ } if_no_rows {
+ set choice_id 0
+ set boolean_answer ""
+ set clob_answer ""
+ set number_answer ""
+ set varchar_answer ""
+ set date_answer ""
+ set attachment_answer ""
+ }
+ }
+ }
+
+ if {$edit_previous_response_p == "t"} {
+ switch -- $abstract_data_type {
+ "choice" {
+ if {[array exists selected_choices]} {
+ set choice_id [array names selected_choices]
+ }
+ switch -- $presentation_type {
+ "select_text" - "radio_text" - "checkbox_text" {
+ set user_value [list $choice_id $varchar_answer]
+ }
+ "select" - "radio" - "checkbox" {
+ set user_value $choice_id
+ }
+ }
+ }
+ "shorttext" {
+ set user_value $varchar_answer
+ }
+ "boolean" {
+ set user_value $boolean_answer
+ }
+ "integer" -
+ "number" {
+ set user_value $number_answer
+ }
+ "text" {
+ set user_value $clob_answer
+ }
+ "date" {
+ set user_value $date_answer
+ }
+ "blob" {
+ if {![empty_string_p $attachment_answer]} {
+ set package_id [ad_conn package_id]
+ set filename [db_string get_file_name ""]
+ regsub "_$response_id$" $filename "" filename
+ set user_value "Uploaded file: \"$filename\""
+ }
+ }
+ }
+ }
+
+ # add the form elements, depending on the presentation type
+ns_log notice "
+DB --------------------------------------------------------------------------------
+DB DAVE debugging procedure survey_question_add_to_form
+DB --------------------------------------------------------------------------------
+DB optional_p = '${optional_p}'
+DB question_id = '${question_id}'
+DB --------------------------------------------------------------------------------"
+ switch -- $presentation_type {
+ "upload_file" {
+ template::element::create $form $element_name \
+ -widget file \
+ -label "$question_text" \
+ -value $user_value
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+
+ }
+ "textbox" {
+ set html [ad_decode $presentation_options "large" {size 70} "medium" {size 40} {size 10}]
+ template::element::create $form $element_name \
+ -datatype text \
+ -widget text \
+ -label "$question_text" \
+ -value $user_value \
+ -html $html
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+
+ }
+ "textarea" {
+ set html [ad_decode $presentation_options "large" {rows 20 cols 65} "medium" {rows 15 cols 55} {rows 8 cols 35}]
+ template::element::create $form $element_name \
+ -datatype text \
+ -widget textarea \
+ -label "$question_text" \
+ -value $user_value \
+ -html $html
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+
+ }
+ "date" {
+ #set options {format "DD Month YYYY"}
+ template::element::create $form $element_name \
+ -datatype date \
+ -widget date \
+ -label "$question_text" \
+ -value $user_value
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+ }
+ "select" {
+ if { $abstract_data_type == "boolean" } {
+ if {![empty_string_p $presentation_options]} {
+ set options_list [split $presentation_options "/"]
+ set choice_t [lindex $options_list 0]
+ set choice_f [lindex $options_list 1]
+ } else {
+ set choice_t "True"
+ set choice_f "False"
+ }
+ set options "{$choice_t t} {$choice_f f}"
+ } else {
+ # at some point, we may want to add a UI option for the admin
+ # to sepcify multiple or not for select
+ set optionlist [list]
+ db_foreach question_choices "" {
+ lappend optionlist [list $label $choice_id]
+ }
+ set options $optionlist
+ }
+ template::element::create $form $element_name \
+ -datatype text \
+ -widget select \
+ -label "$question_text" \
+ -value $user_value \
+ -options $options
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+
+ }
+ "select_text" {
+ # at some point, we may want to add a UI option for the admin
+ # to sepcify multiple or not for select
+ set optionlist [list]
+ db_foreach question_choices "" {
+ lappend optionlist [list $label $choice_id]
+ }
+ set options $optionlist
+ template::element::create $form $element_name \
+ -datatype select_text \
+ -widget select_text \
+ -label "$question_text" \
+ -value $user_value \
+ -options $options
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+
+ }
+ "radio" {
+ set widget "text(radio)"
+ if { $abstract_data_type == "boolean" } {
+ if {![empty_string_p $presentation_options]} {
+ set options_list [split $presentation_options "/"]
+ set choice_t [lindex $options_list 0]
+ set choice_f [lindex $options_list 1]
+ } else {
+ set choice_t "True"
+ set choice_f "False"
+ }
+
+ set options "{$choice_t t} {$choice_f f}"
+ } else {
+ set optionlist [list]
+ db_foreach question_choices_2 "" {
+ # replace {xxx.gif} by image inclusion
+ regsub -all "\{(\[^\{\}\]*)\}" $label {
} label
+ lappend optionlist [list $label $choice_id]
+ }
+ set options $optionlist
+ }
+ template::element::create $form $element_name \
+ -datatype text \
+ -widget radio \
+ -label "$question_text" \
+ -value $user_value \
+ -options $options
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+ }
+ "radio_text" {
+ set widget "text(radio)"
+ set optionlist [list]
+ db_foreach question_choices_2 "" {
+ # replace {xxx.gif} by image inclusion
+ regsub -all "\{(\[^\{\}\]*)\}" $label {} label
+ lappend optionlist [list $label $choice_id]
+ }
+ set options $optionlist
+ template::element::create $form $element_name \
+ -datatype radio_text \
+ -widget radio_text \
+ -label "$question_text" \
+ -value $user_value \
+ -options $options
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+ }
+ "checkbox" {
+ set choices [list]
+ set optionlist [list]
+ db_foreach question_choices_3 "" {
+ lappend optionlist [list $label $choice_id]
+ }
+ set options $optionlist
+ template::element::create $form $element_name \
+ -datatype text \
+ -widget checkbox \
+ -label "$question_text" \
+ -values $user_value \
+ -options $options
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+ }
+ "checkbox_text" {
+ set choices [list]
+ set optionlist [list]
+ db_foreach question_choices_3 "" {
+ lappend optionlist [list $label $choice_id]
+ }
+ set options $optionlist
+ template::element::create $form $element_name \
+ -datatype checkbox_text \
+ -widget checkbox_text \
+ -label "$question_text" \
+ -value $user_value \
+ -options $options
+ if {$optional_p} {
+ template::element::set_properties $form $element_name -optional
+ }
+ }
+ }
+}