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 -r1.5 --- openacs-4/contrib/packages/survey/tcl/survey-procs.tcl 12 Mar 2004 06:35:45 -0000 1.4 +++ openacs-4/contrib/packages/survey/tcl/survey-procs.tcl 13 Jan 2005 13:54:39 -0000 1.5 @@ -112,6 +112,8 @@ if {[file exists $template_filename]} { set section_template [template::util::read_file $template_filename] uplevel [list set section_template($section_info(name)) $section_template] + ns_log notice "CM list set section_template($section_info(name)) $section_template" + # uplevel [set section_template($section_info(name)) $section_template] } # If this is a block section, generate a block question, else add questions one by one @@ -308,7 +310,7 @@ template::element::create $form $element_name \ -widget file \ -label "$question_text" \ - -required_p $required_p \ + -optional $required_p \ -value $user_value } "textbox" { @@ -319,7 +321,7 @@ -label "$question_text" \ -value $user_value \ -html $html \ - -required_p $required_p + -optional $required_p } "textarea" { set html [ad_decode $presentation_options "large" {rows 20 cols 65} "medium" {rows 15 cols 55} {rows 8 cols 35}] @@ -329,7 +331,7 @@ -label "$question_text" \ -value $user_value \ -html $html \ - -required_p $required_p + -optional $required_p } "date" { #set options {format "DD Month YYYY"} @@ -338,7 +340,7 @@ -widget date \ -label "$question_text" \ -value $user_value \ - -required_p $required_p + -optional $required_p } "select" { if { $abstract_data_type == "boolean" } { @@ -366,7 +368,7 @@ -label "$question_text" \ -value $user_value \ -options $options \ - -required_p $required_p + -optional $required_p } "radio" { set widget "text(radio)" @@ -396,7 +398,7 @@ -label "$question_text" \ -value $user_value \ -options $options \ - -required_p $required_p + -optional $required_p } "checkbox" { @@ -412,7 +414,7 @@ -label "$question_text" \ -values $user_value \ -options $options \ - -required_p $required_p + -optional $required_p } } } @@ -522,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 {} { @@ -560,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]} { @@ -981,5 +984,840 @@ ns_conn close } +ad_proc -public survey_get_section_page_numbers { + {-survey_id} + {-array} +} { + gets corresponding page numbers for sections + + @author Deds Castillo (deds@i-manila.com.ph) + @creation-date 2004-05-24 +} { + upvar $array survey_section_page_numbers + set page_list [list] + set new_page_p 0 + set current_page 1 + db_foreach get_section_pages { + select section_id, + page_break_p + from survey_sections + where survey_id = :survey_id + order by sort_key + } { + if {$new_page_p} { + incr current_page + set new_page_p 0 + } + if {[string equal $page_break_p t]} { + set new_page_p 1 + } + lappend page_list [list $section_id $current_page] + set survey_section_page_numbers($section_id) $current_page + } + + # get total and assign it to element 0 + lappend page_list [list total $current_page] + set survey_section_page_numbers(total) $current_page + + 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 + } + } + } +}