Index: openacs-4/packages/survey/lib/portlet.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/lib/portlet.tcl,v diff -u -r1.2 -r1.2.6.1 --- openacs-4/packages/survey/lib/portlet.tcl 6 Nov 2013 07:33:53 -0000 1.2 +++ openacs-4/packages/survey/lib/portlet.tcl 9 Feb 2020 16:10:31 -0000 1.2.6.1 @@ -49,3 +49,9 @@ } ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/tcl/survey-notification-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/tcl/survey-notification-procs.tcl,v diff -u -r1.2.22.2 -r1.2.22.3 --- openacs-4/packages/survey/tcl/survey-notification-procs.tcl 17 Dec 2019 16:28:44 -0000 1.2.22.2 +++ openacs-4/packages/survey/tcl/survey-notification-procs.tcl 9 Feb 2020 16:10:31 -0000 1.2.22.3 @@ -27,3 +27,9 @@ This proc is an empty stub } { } + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/tcl/survey-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/tcl/survey-procs.tcl,v diff -u -r1.14.2.2 -r1.14.2.3 --- openacs-4/packages/survey/tcl/survey-procs.tcl 17 Dec 2019 16:28:44 -0000 1.14.2.2 +++ openacs-4/packages/survey/tcl/survey-procs.tcl 9 Feb 2020 16:10:31 -0000 1.14.2.3 @@ -1,5 +1,3 @@ -# /tcl/survey-procs.tcl - ad_library { Support procs for simple survey module, most important being @@ -49,28 +47,28 @@ upvar survey_info survey_info if {$survey_id eq ""} { - db_1row lookup_survey_id "" + db_1row lookup_survey_id "" } db_1row get_info_by_survey_id "" -column_array survey_info if {![info exists survey_info(survey_id)]} { - # survey doesn't exist, caller has to handle this in their - # own way - return + # survey doesn't exist, caller has to handle this in their + # own way + return } # If it's a single-section survey, look up the section_id if {$section_id eq "" && $survey_info(single_section_p) == "t"} { - db_1row lookup_single_section_id "" - set survey_info(section_id) $section_id + db_1row lookup_single_section_id "" + set survey_info(section_id) $section_id } # some useful stats about the survey, dotLRN specific for sloanspace if {[apm_package_installed_p dotlrn]} { - set community_id [dotlrn_community::get_community_id_from_url] - set survey_info(eligible) [db_string n_eligible {}] - set survey_info(completed) [db_string n_completed {}] - set survey_info(not_completed) [expr {$survey_info(eligible) - $survey_info(completed)}] + set community_id [dotlrn_community::get_community_id_from_url] + set survey_info(eligible) [db_string n_eligible {}] + set survey_info(completed) [db_string n_completed {}] + set survey_info(not_completed) [expr {$survey_info(eligible) - $survey_info(completed)}] } } @@ -93,182 +91,182 @@ The form variable is of the form \"response_to_question.\$question_id } { if {$response_id ne ""} { - set edit_previous_response_p "t" + set edit_previous_response_p "t" } else { - set edit_previous_response_p "f" + set edit_previous_response_p "f" } set element_name "response_to_question.$question_id" db_1row survey_question_properties "" if {$required_p == "t"} { - set html "*" + set html "*" } else { - set html " " + set html " " } append html $question_text if { $presentation_alignment eq "below" } { - append html "
" + append html "
" } else { - append html " " + append html " " } set user_value "" if {$edit_previous_response_p == "t"} { - set user_id [ad_conn user_id] + set user_id [ad_conn user_id] - set count 0 - db_foreach prev_response_query {} { - incr count + set count 0 + db_foreach prev_response_query {} { + incr count - if {$presentation_type eq "checkbox"} { - 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 "" + if {$presentation_type eq "checkbox"} { + 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 "" - } + } } switch -- $presentation_type { "upload_file" { - if {$edit_previous_response_p == "t"} { - set user_value $attachment_answer - } - append html "" - } + if {$edit_previous_response_p == "t"} { + set user_value $attachment_answer + } + append html "" + } - "textbox" { - if {$edit_previous_response_p == "t"} { - if {$abstract_data_type eq "number" || $abstract_data_type eq "integer"} { - set user_value $number_answer - } else { - set user_value $varchar_answer - } - } + "textbox" { + if {$edit_previous_response_p == "t"} { + if {$abstract_data_type eq "number" || $abstract_data_type eq "integer"} { + set user_value $number_answer + } else { + set user_value $varchar_answer + } + } - append html [subst {}] - } + append html [subst {}] + } - "textarea" { - if {$edit_previous_response_p == "t"} { - set user_value $clob_answer - } + "textarea" { + if {$edit_previous_response_p == "t"} { + set user_value $clob_answer + } - set presentation_options [ad_decode $presentation_options "large" "rows=20 cols=65" "medium" "rows=15 cols=55" "rows=8 cols=35"] - append html "" - } + set presentation_options [ad_decode $presentation_options "large" "rows=20 cols=65" "medium" "rows=15 cols=55" "rows=8 cols=35"] + append html "" + } - "date" { - if {$edit_previous_response_p == "t"} { - set user_value $date_answer - } - append html [ad_dateentrywidget $element_name $user_value] - } + "date" { + if {$edit_previous_response_p == "t"} { + set user_value $date_answer + } + append html [ad_dateentrywidget $element_name $user_value] + } - "select" { - if { $abstract_data_type eq "boolean" } { - if {$edit_previous_response_p == "t"} { - set user_value $boolean_answer - } + "select" { + if { $abstract_data_type eq "boolean" } { + if {$edit_previous_response_p == "t"} { + set user_value $boolean_answer + } - if {$presentation_options ne ""} { - 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" - } + if {$presentation_options ne ""} { + 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" + } - append html " " - } else { - if {$edit_previous_response_p == "t"} { - set user_value $choice_id - } + } else { + if {$edit_previous_response_p == "t"} { + set user_value $choice_id + } # at some point, we may want to add a UI option for the admin # to specify multiple or not for select - append html " + \n" + db_foreach question_choices "" { - if { $user_value == $choice_id } { - append html "\n" - } else { - append html "\n" - } - } - append html "" - } - } + if { $user_value == $choice_id } { + append html "\n" + } else { + append html "\n" + } + } + append html "" + } + } - "radio" { - if { $abstract_data_type eq "boolean" } { - if {$edit_previous_response_p == "t"} { - set user_value $boolean_answer - } - if {$presentation_options ne ""} { - 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" - } + "radio" { + if { $abstract_data_type eq "boolean" } { + if {$edit_previous_response_p == "t"} { + set user_value $boolean_answer + } + if {$presentation_options ne ""} { + 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 choices [list " $choice_t" \ - " $choice_f"] - } else { - if {$edit_previous_response_p == "t"} { - set user_value $choice_id - } + set choices [list " $choice_t" \ + " $choice_f"] + } else { + if {$edit_previous_response_p == "t"} { + set user_value $choice_id + } - set choices {} - db_foreach question_choices_2 "" { - if { $user_value == $choice_id } { - lappend choices " $label" - } else { - lappend choices " $label" - } - } - } - if { $presentation_alignment eq "beside" } { - append html [join $choices " "] - } else { - append html "

\n[join $choices "
\n"]\n

" - } - } + set choices {} + db_foreach question_choices_2 "" { + if { $user_value == $choice_id } { + lappend choices " $label" + } else { + lappend choices " $label" + } + } + } + if { $presentation_alignment eq "beside" } { + append html [join $choices " "] + } else { + append html "

\n[join $choices "
\n"]\n

" + } + } - "checkbox" { - set choices {} - db_foreach question_choices_3 "" { - if { [info exists selected_choices($choice_id)] } { - lappend choices " $label" - } else { - lappend choices " $label" - } - } - if { $presentation_alignment eq "beside" } { - append html [join $choices " "] - } else { - append html "

\n[join $choices "
\n"]\n

" - } - } + "checkbox" { + set choices {} + db_foreach question_choices_3 "" { + if { [info exists selected_choices($choice_id)] } { + lappend choices " $label" + } else { + lappend choices " $label" + } + } + if { $presentation_alignment eq "beside" } { + append html [join $choices " "] + } else { + append html "

\n[join $choices "
\n"]\n

" + } + } } return $html @@ -313,49 +311,49 @@ db_foreach summary "" { - if {$question_id == $question_id_previous} { - continue - } + if {$question_id == $question_id_previous} { + continue + } - if {$html_p} { - append return_string "# $sort_order: $question_text

" - append return_string [ad_enhanced_text_to_html "$clob_answer $number_answer $varchar_answer $date_answer"] - } else { - append return_string "$sort_order: " - append return_string [ad_html_to_text -- $question_text] - append return_string "\n\n" - append return_string [ad_html_to_text -- [ad_enhanced_text_to_html "$clob_answer $number_answer $varchar_answer $date_answer"]] - } + if {$html_p} { + append return_string "# $sort_order: $question_text

" + append return_string [ad_enhanced_text_to_html "$clob_answer $number_answer $varchar_answer $date_answer"] + } else { + append return_string "$sort_order: " + append return_string [ad_html_to_text -- $question_text] + append return_string "\n\n" + append return_string [ad_html_to_text -- [ad_enhanced_text_to_html "$clob_answer $number_answer $varchar_answer $date_answer"]] + } - if {$attachment_answer ne ""} { - set package_id [ad_conn package_id] - set filename [db_string get_filename {}] - set href [export_vars \ - -base [site_node::get_url_from_object_id -object_id $package_id]/view-attachment \ - {response_id question_id}] - append return_string [subst { - [_ survey.Uploaded_file] - "$filename" - }] - } + if {$attachment_answer ne ""} { + set package_id [ad_conn package_id] + set filename [db_string get_filename {}] + set href [export_vars \ + -base [site_node::get_url_from_object_id -object_id $package_id]/view-attachment \ + {response_id question_id}] + append return_string [subst { + [_ survey.Uploaded_file] + "$filename" + }] + } - if {$choice_id != 0 && $choice_id ne "" && $question_id != $question_id_previous} { - set label_list [db_list survey_label_list ""] - append return_string [join $label_list ", "] - } + if {$choice_id != 0 && $choice_id ne "" && $question_id != $question_id_previous} { + set label_list [db_list survey_label_list ""] + append return_string [join $label_list ", "] + } - if {$boolean_answer ne ""} { - append return_string [survey::decode_boolean_answer -response $boolean_answer -question_id $question_id] + if {$boolean_answer ne ""} { + append return_string [survey::decode_boolean_answer -response $boolean_answer -question_id $question_id] - } + } - if {$html_p} { - append return_string "

" - } else { - append return_string "\n\n" - } + if {$html_p} { + append return_string "

" + } else { + append return_string "\n\n" + } - set question_id_previous $question_id + set question_id_previous $question_id } return $return_string @@ -424,23 +422,23 @@ set user_id [ad_conn user_id] db_1row get_question_details {} if {$new_section_id ne ""} { - set section_id $new_section_id + set section_id $new_section_id } set old_question_id $question_id if {$new_section_id eq ""} { - set after $sort_order - set new_sort_order [expr {$after + 1}] - db_dml renumber_sort_orders {} + set after $sort_order + set new_sort_order [expr {$after + 1}] + db_dml renumber_sort_orders {} } else { - set new_sort_order $sort_order + set new_sort_order $sort_order } set new_question_id [db_exec_plsql create_question {}] db_dml insert_question_text {} db_foreach get_survey_question_choices {} { - set new_choice_id [db_string get_choice_id {}] - db_dml insert_survey_question_choice {} + set new_choice_id [db_string get_choice_id {}] + db_dml insert_survey_question_choice {} } @@ -473,12 +471,12 @@ } { if {$package_id eq ""} { - set package_id [ad_conn package_id] + set package_id [ad_conn package_id] } db_1row get_survey_info {} if {$new_name ne ""} { - set name $new_name + set name $new_name } set user_id [ad_conn user_id] set new_survey_id [db_exec_plsql survey_create {} ] @@ -487,15 +485,15 @@ foreach section_id $sections_list { - set new_section_id [db_exec_plsql section_create {}] - set new_section_ids($section_id) $new_section_id - if {$description ne ""} { - db_dml set_section_description {} - } + set new_section_id [db_exec_plsql section_create {}] + set new_section_ids($section_id) $new_section_id + if {$description ne ""} { + db_dml set_section_description {} + } } db_foreach get_questions {} { - survey::copy_question -new_section_id $new_section_ids($section_id) -question_id $question_id + survey::copy_question -new_section_id $new_section_ids($section_id) -question_id $question_id } return $new_survey_id @@ -536,19 +534,19 @@ } if {$dotlrn_installed_p} { - set package_id [ad_conn package_id] - set community_id [dotlrn_community::get_community_id] - set segment_id [dotlrn_community::get_rel_segment_id -community_id $community_id -rel_type "dotlrn_member_rel"] - set community_name [dotlrn_community::get_community_name $community_id] - set community_url "[parameter::get -package_id [ad_acs_kernel_id] -parameter SystemURL][dotlrn_community::get_community_url $community_id]" + set package_id [ad_conn package_id] + set community_id [dotlrn_community::get_community_id] + set segment_id [dotlrn_community::get_rel_segment_id -community_id $community_id -rel_type "dotlrn_member_rel"] + set community_name [dotlrn_community::get_community_name $community_id] + set community_url "[parameter::get -package_id [ad_acs_kernel_id] -parameter SystemURL][dotlrn_community::get_community_url $community_id]" } db_1row get_response_info {} set notif_text "" set notif_html "" if {$dotlrn_installed_p} { - append notif_text "\nGroup: $community_name" + append notif_text "\nGroup: $community_name" append notif_html "Group: $community_name
" } @@ -564,8 +562,8 @@ if {$edit_p} { - append notif_text "\n[_ survey.Edited] " - append notif_html "
[_ survey.Edited]  " + append notif_text "\n[_ survey.Edited] " + append notif_html "
[_ survey.Edited]  " } append notif_text "[_ survey.lt_Response_on_response_]\n\n" @@ -577,26 +575,26 @@ # add summary info for sloanspace if {$dotlrn_installed_p} { db_foreach get_questions {} { - # only doing the summary for HTML version because - # all the links make the text version a mess - set href [export_vars -base $community_url/survey/admin/view-text-responses {question_id}] - append notif_html [subst { - $sort_order. - $question_text - - [_ survey.View_responses_1]
- }] + # only doing the summary for HTML version because + # all the links make the text version a mess + set href [export_vars -base $community_url/survey/admin/view-text-responses {question_id}] + append notif_html [subst { + $sort_order. + $question_text - + [_ survey.View_responses_1]
+ }] } } append notif_html "

" notification::new \ - -type_id [notification::type::get_type_id \ - -short_name survey_response_notif] \ - -object_id $survey_id \ - -response_id $survey_id \ - -notif_subject $subject \ - -notif_text $notif_text \ + -type_id [notification::type::get_type_id \ + -short_name survey_response_notif] \ + -object_id $survey_id \ + -response_id $survey_id \ + -notif_subject $subject \ + -notif_text $notif_text \ -notif_html $notif_html } @@ -631,18 +629,24 @@ } { set presentation_options [db_string get_presentation_options {}] if {$presentation_options eq ""} { - set presentation_options "True/False" + set presentation_options "True/False" } if {$response ne ""} { - set options_list [split $presentation_options "/"] + set options_list [split $presentation_options "/"] - if {$response=="t"} { - set response [lindex $options_list 0] - } else { - set response [lindex $options_list 1] - } + if {$response=="t"} { + set response [lindex $options_list 0] + } else { + set response [lindex $options_list 1] + } } return $response } + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/index.tcl,v diff -u -r1.5 -r1.5.2.1 --- openacs-4/packages/survey/www/index.tcl 31 Jan 2018 21:18:47 -0000 1.5 +++ openacs-4/packages/survey/www/index.tcl 9 Feb 2020 16:10:31 -0000 1.5.2.1 @@ -24,3 +24,9 @@ ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/one-respondent.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/one-respondent.tcl,v diff -u -r1.11.2.1 -r1.11.2.2 --- openacs-4/packages/survey/www/one-respondent.tcl 17 Dec 2019 16:28:44 -0000 1.11.2.1 +++ openacs-4/packages/survey/www/one-respondent.tcl 9 Feb 2020 16:10:31 -0000 1.11.2.2 @@ -18,10 +18,10 @@ } -validate { survey_exists -requires {survey_id} { - if {![db_0or1row survey_exists {}]} { - ad_complain "[_ survey.lt_Survey_section_id_does]" - } - } + if {![db_0or1row survey_exists {}]} { + ad_complain "[_ survey.lt_Survey_section_id_does]" + } + } } -properties { survey_name:onerow description:onerow @@ -46,9 +46,15 @@ } db_multirow -extend {answer_summary pretty_submission_date respond_url} responses responses_select {} { - set answer_summary [survey_answer_summary_display $response_id 1] + set answer_summary [survey_answer_summary_display $response_id 1] set pretty_submission_date [lc_time_fmt $pretty_submission_date_ansi %x] set respond_url [export_vars -base respond {survey_id response_id}] } ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/one-survey.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/one-survey.tcl,v diff -u -r1.6 -r1.6.2.1 --- openacs-4/packages/survey/www/one-survey.tcl 31 Jan 2018 21:18:47 -0000 1.6 +++ openacs-4/packages/survey/www/one-survey.tcl 9 Feb 2020 16:10:31 -0000 1.6.2.1 @@ -25,3 +25,9 @@ ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/process-response.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/process-response.tcl,v diff -u -r1.17.2.2 -r1.17.2.3 --- openacs-4/packages/survey/www/process-response.tcl 17 Dec 2019 16:28:44 -0000 1.17.2.2 +++ openacs-4/packages/survey/www/process-response.tcl 9 Feb 2020 16:10:31 -0000 1.17.2.3 @@ -2,13 +2,13 @@ Insert user response into database. This page receives an input for each question named - response_to_question.$question_id + response_to_question.$question_id @param section_id survey user is responding to @param return_url optional redirect address - @param group_id + @param group_id @param response_to_question since form variables are now named as response_to_question.$question_id, this is actually array holding user responses to all survey questions. - + @author jsc@arsdigita.com @author nstrug@arsdigita.com @date 28th September 2000 @@ -24,114 +24,114 @@ } -validate { section_exists -requires { section_id } { - if {![db_0or1row section_exists {}]} { - ad_complain "[_ survey.lt_Section_section_id_do]" - } + if {![db_0or1row section_exists {}]} { + ad_complain "[_ survey.lt_Section_section_id_do]" + } } check_questions -requires { section_id } { - set question_info_list [db_list_of_lists survey_question_info_list { - select question_id, question_text, abstract_data_type, presentation_type, required_p - from survey_questions - where section_id = :section_id - and active_p = 't' - order by sort_order - }] - - ## Validate input. - - set questions_with_missing_responses [list] - - foreach question $question_info_list { - set question_id [lindex $question 0] - set question_text [lindex $question 1] - set abstract_data_type [lindex $question 2] - set required_p [lindex $question 4] - - # Need to clean-up after mess with :array,multiple flags - # in ad_page_contract. Because :multiple flag will sorround empty - # strings and all multiword values with one level of curly braces {} - # we need to get rid of them for almost any abstract_data_type - # except 'choice', where this is intended behavior. Why bother - # with :multiple flag at all? Because otherwise we would lost all - # but first value for 'choice' abstract_data_type - see ad_page_contract - # doc and code for more info. - # - if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { - if {$abstract_data_type ne "choice"} { - set response_to_question($question_id) [join $response_to_question($question_id)] - } else { - if { [lindex $response_to_question($question_id) 0 ] eq "" } { - set response_to_question($question_id) "" - } - } - } - - if { $abstract_data_type eq "date" } { - foreach {name value} [ns_set array [ns_getform]] { - if {[regexp "^response_to_question\[.\]$question_id\[.\](.*)\$" $name _ part]} { - set date_value($part) $value - } - } - set ok [ad_page_contract_filter_proc_date "date" date_value] - if {$ok} { - set response_to_question($question_id) [ns_buildsqldate $date_value(month) \ - $date_value(day) \ - $date_value(year)] - } else { - ad_complain "Please make sure your dates are valid." - } - } - - - if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + set question_info_list [db_list_of_lists survey_question_info_list { + select question_id, question_text, abstract_data_type, presentation_type, required_p + from survey_questions + where section_id = :section_id + and active_p = 't' + order by sort_order + }] - set response_value [string trim $response_to_question($question_id)] - } elseif {$required_p == "t"} { - lappend questions_with_missing_responses $question_text - continue - } else { - set response_to_question($question_id) "" - set response_value "" - } - - if {$response_value ne ""} { - if { $abstract_data_type eq "number" } { - if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } { - - ad_complain "[_ survey.lt_The_response_to_ques_n]" - continue - } - } elseif { $abstract_data_type eq "integer" } { - if { ![regexp {^[0-9]+$} $response_value] } { - - ad_complain "[_ survey.lt_The_response_to_ques_i]" - continue - } - } - } - - if { $abstract_data_type eq "blob" } { + ## Validate input. + + set questions_with_missing_responses [list] + + foreach question $question_info_list { + set question_id [lindex $question 0] + set question_text [lindex $question 1] + set abstract_data_type [lindex $question 2] + set required_p [lindex $question 4] + + # Need to clean-up after mess with :array,multiple flags + # in ad_page_contract. Because :multiple flag will sorround empty + # strings and all multiword values with one level of curly braces {} + # we need to get rid of them for almost any abstract_data_type + # except 'choice', where this is intended behavior. Why bother + # with :multiple flag at all? Because otherwise we would lost all + # but first value for 'choice' abstract_data_type - see ad_page_contract + # doc and code for more info. + # + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + if {$abstract_data_type ne "choice"} { + set response_to_question($question_id) [join $response_to_question($question_id)] + } else { + if { [lindex $response_to_question($question_id) 0 ] eq "" } { + set response_to_question($question_id) "" + } + } + } + + if { $abstract_data_type eq "date" } { + foreach {name value} [ns_set array [ns_getform]] { + if {[regexp "^response_to_question\[.\]$question_id\[.\](.*)\$" $name _ part]} { + set date_value($part) $value + } + } + set ok [ad_page_contract_filter_proc_date "date" date_value] + if {$ok} { + set response_to_question($question_id) [ns_buildsqldate $date_value(month) \ + $date_value(day) \ + $date_value(year)] + } else { + ad_complain "Please make sure your dates are valid." + } + } + + + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + + set response_value [string trim $response_to_question($question_id)] + } elseif {$required_p == "t"} { + lappend questions_with_missing_responses $question_text + continue + } else { + set response_to_question($question_id) "" + set response_value "" + } + + if {$response_value ne ""} { + if { $abstract_data_type eq "number" } { + if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } { + + ad_complain "[_ survey.lt_The_response_to_ques_n]" + continue + } + } elseif { $abstract_data_type eq "integer" } { + if { ![regexp {^[0-9]+$} $response_value] } { + + ad_complain "[_ survey.lt_The_response_to_ques_i]" + continue + } + } + } + + if { $abstract_data_type eq "blob" } { set tmp_filename $response_to_question($question_id.tmpfile) - set n_bytes [file size $tmp_filename] - if { $n_bytes == 0 && $required_p == "t" } { - - ad_complain "[_ survey.lt_Your_file_is_zero-len]" - } - } - - } - - if { [llength $questions_with_missing_responses] > 0 } { - ad_complain "[_ survey.lt_You_didnt_respond_to_]" - foreach skipped_question $questions_with_missing_responses { - ad_complain $skipped_question - } - return 0 - } else { - return 1 - } + set n_bytes [file size $tmp_filename] + if { $n_bytes == 0 && $required_p == "t" } { + + ad_complain "[_ survey.lt_Your_file_is_zero-len]" + } + } + + } + + if { [llength $questions_with_missing_responses] > 0 } { + ad_complain "[_ survey.lt_You_didnt_respond_to_]" + foreach skipped_question $questions_with_missing_responses { + ad_complain $skipped_question + } + return 0 + } else { + return 1 + } } } -properties { @@ -162,95 +162,95 @@ set creation_ip [ad_conn peeraddr] if {$initial_response_id==0} { - set initial_response_id "" + set initial_response_id "" } db_transaction { - db_exec_plsql create_response {} + db_exec_plsql create_response {} - set question_info_list [db_list_of_lists survey_question_info_list { - select question_id, question_text, abstract_data_type, presentation_type, required_p - from survey_questions - where section_id = :section_id - and active_p = 't' - order by sort_order }] + set question_info_list [db_list_of_lists survey_question_info_list { + select question_id, question_text, abstract_data_type, presentation_type, required_p + from survey_questions + where section_id = :section_id + and active_p = 't' + order by sort_order }] - foreach question $question_info_list { - set question_id [lindex $question 0] - set question_text [lindex $question 1] - set abstract_data_type [lindex $question 2] - set presentation_type [lindex $question 3] + foreach question $question_info_list { + set question_id [lindex $question 0] + set question_text [lindex $question 1] + set abstract_data_type [lindex $question 2] + set presentation_type [lindex $question 3] - set response_value [string trim $response_to_question($question_id)] + set response_value [string trim $response_to_question($question_id)] - switch -- $abstract_data_type { - "choice" { - if { $presentation_type eq "checkbox" } { - # Deal with multiple responses. - set checked_responses $response_to_question($question_id) - foreach response_value $checked_responses { - if { $response_value eq "" } { - set response_value [db_null] - } + switch -- $abstract_data_type { + "choice" { + if { $presentation_type eq "checkbox" } { + # Deal with multiple responses. + set checked_responses $response_to_question($question_id) + foreach response_value $checked_responses { + if { $response_value eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_checkbox_insert "insert into survey_question_responses (response_id, question_id, choice_id) + db_dml survey_question_response_checkbox_insert "insert into survey_question_responses (response_id, question_id, choice_id) values (:response_id, :question_id, :response_value)" - } - } else { - if { $response_value eq "" || [lindex $response_value 0] eq "" } { - set response_value [db_null] - } + } + } else { + if { $response_value eq "" || [lindex $response_value 0] eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_choice_insert "insert into survey_question_responses (response_id, question_id, choice_id) + db_dml survey_question_response_choice_insert "insert into survey_question_responses (response_id, question_id, choice_id) values (:response_id, :question_id, :response_value)" - } - } - "shorttext" { - db_dml survey_question_choice_shorttext_insert "insert into survey_question_responses (response_id, question_id, varchar_answer) + } + } + "shorttext" { + db_dml survey_question_choice_shorttext_insert "insert into survey_question_responses (response_id, question_id, varchar_answer) values (:response_id, :question_id, :response_value)" - } - "boolean" { - if { $response_value eq "" } { - set response_value [db_null] - } + } + "boolean" { + if { $response_value eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_boolean_insert "insert into survey_question_responses (response_id, question_id, boolean_answer) + db_dml survey_question_response_boolean_insert "insert into survey_question_responses (response_id, question_id, boolean_answer) values (:response_id, :question_id, :response_value)" - } - "integer" - - "number" { - if { $response_value eq "" } { - set response_value [db_null] - } - db_dml survey_question_response_integer_insert "insert into survey_question_responses (response_id, question_id, number_answer) + } + "integer" - + "number" { + if { $response_value eq "" } { + set response_value [db_null] + } + db_dml survey_question_response_integer_insert "insert into survey_question_responses (response_id, question_id, number_answer) values (:response_id, :question_id, :response_value)" - } - "text" { - if { $response_value eq "" } { - set response_value [db_null] - } + } + "text" { + if { $response_value eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_text_insert " + db_dml survey_question_response_text_insert " insert into survey_question_responses (response_id, question_id, clob_answer) values (:response_id, :question_id, empty_clob()) returning clob_answer into :1" -clobs [list $response_value] - } - "date" { + } + "date" { if { $response_value eq "" } { set response_value [db_null] } - db_dml survey_question_response_date_insert "insert into survey_question_responses (response_id, question_id, date_answer) + db_dml survey_question_response_date_insert "insert into survey_question_responses (response_id, question_id, date_answer) values (:response_id, :question_id, :response_value)" - } + } "blob" { if { $response_value ne "" } { # this stuff only makes sense to do if we know the file exists - set tmp_filename $response_to_question($question_id.tmpfile) + set tmp_filename $response_to_question($question_id.tmpfile) set file_extension [string tolower [file extension $response_value]] # remove the first . from the file extension @@ -278,10 +278,10 @@ values (:response_id, :question_id, :revision_id )" - } + } } } - } + } } } @@ -295,8 +295,14 @@ } else { set context [_ survey.lt_Response_Submitted_for] ad_return_template -} - +} + + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/respond.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/respond.tcl,v diff -u -r1.13.2.1 -r1.13.2.2 --- openacs-4/packages/survey/www/respond.tcl 17 Dec 2019 16:28:44 -0000 1.13.2.1 +++ openacs-4/packages/survey/www/respond.tcl 9 Feb 2020 16:10:31 -0000 1.13.2.2 @@ -10,17 +10,17 @@ @cvs-id $Id$ } { - + survey_id:naturalnum,notnull {section_id:naturalnum,notnull 0} {response_id:naturalnum,notnull 0} return_url:localurl,optional } -validate { survey_exists -requires {survey_id} { - if {![db_0or1row survey_exists {}]} { - ad_complain "[_ survey.lt_Survey_survey_id_do_no]" - } + if {![db_0or1row survey_exists {}]} { + ad_complain "[_ survey.lt_Survey_survey_id_do_no]" + } set user_id [auth::require_login] set number_of_responses [db_string count_responses {}] survey::get_info -survey_id $survey_id @@ -37,13 +37,13 @@ if {$description_html_p != "t"} { set description [ad_text_to_html -- $description] - } + } if {($single_response_p=="t" && $editable_p=="f" && $number_of_responses>0) || ($single_response_p=="t" && $editable_p=="t" && $number_of_responses>0 && $response_id==0)} { - ad_complain "[_ survey.lt_You_have_already_comp]" - } elseif {$response_id>0 && $editable_p=="f"} { - ad_complain "[_ survey.lt_This_survey_is_not_ed]" - } + ad_complain "[_ survey.lt_You_have_already_comp]" + } elseif {$response_id>0 && $editable_p=="f"} { + ad_complain "[_ survey.lt_This_survey_is_not_ed]" + } } } -properties { @@ -62,21 +62,21 @@ set button_label "[_ survey.Submit_response]" if {$editable_p == "t"} { if {$response_id > 0} { - set button_label "[_ survey.lt_Modify_previous_respo]" - db_1row get_initial_response "" + set button_label "[_ survey.lt_Modify_previous_respo]" + db_1row get_initial_response "" } } # build a list containing the HTML (generated with survey::display_question) for each question set rownum 0 # for double-click protection -set new_response_id [db_nextval acs_object_id_seq] +set new_response_id [db_nextval acs_object_id_seq] set questions {} db_foreach survey_sections {} { db_foreach question_ids_select {} { - lappend questions [survey::display_question $question_id $response_id] + lappend questions [survey::display_question $question_id $response_id] } # return_url is used for infoshare - if it is set @@ -85,9 +85,15 @@ # after the survey is completed # if {![info exists return_url]} { - set return_url {} + set return_url {} } } set form_vars [export_vars -form {section_id survey_id new_response_id}] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/view-attachment.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/view-attachment.tcl,v diff -u -r1.4.4.1 -r1.4.4.2 --- openacs-4/packages/survey/www/view-attachment.tcl 16 Dec 2019 17:14:38 -0000 1.4.4.1 +++ openacs-4/packages/survey/www/view-attachment.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.2 @@ -2,11 +2,11 @@ View the attachment contents of a given response. This page has been modified to use the CR for attachment storage dave@thedesignexperience.org - + @param response_id id of complete survey response submitted by user @param question_id id of question for which this file was submitted as an answer - + @author jbank@arsdigita.com @author nstrug@arsdigita.com @date 28th September 2000 @@ -18,11 +18,11 @@ } -validate { attachment_exists -requires {response_id question_id} { - db_1row get_file_info {} + db_1row get_file_info {} - if { $file_type eq "" } { - ad_complain "[_ survey.lt_Couldnt_find_attachment]" - } + if { $file_type eq "" } { + ad_complain "[_ survey.lt_Couldnt_find_attachment]" + } } } @@ -31,3 +31,9 @@ cr_write_content -revision_id $revision_id + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/description-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/description-edit.tcl,v diff -u -r1.8.4.1 -r1.8.4.2 --- openacs-4/packages/survey/www/admin/description-edit.tcl 17 Dec 2019 16:28:44 -0000 1.8.4.1 +++ openacs-4/packages/survey/www/admin/description-edit.tcl 9 Feb 2020 16:10:31 -0000 1.8.4.2 @@ -4,7 +4,7 @@ @param section_id integer denoting survey whose description we're changing - @author Jin Choi (jsc@arsdigita.com) + @author Jin Choi (jsc@arsdigita.com) @author nstrug@arsdigita.com @date February 16, 2000 @cvs-id $Id$ @@ -19,31 +19,31 @@ survey_id:key {description:text(textarea) {label "[_ survey.Survey_Description]"} {html {rows 10 cols 65}}} {desc_html:text(radio) {label "[_ survey.lt_The_Above_Description]"} - {options {{"[_ survey.Preformatted_Text]" "pre"} - {"HTML" "html"} {"[_ survey.Plain_Text]" "plain"}}}} + {options {{"[_ survey.Preformatted_Text]" "pre"} + {"HTML" "html"} {"[_ survey.Plain_Text]" "plain"}}}} } -edit_request { survey::get_info -survey_id $survey_id set survey_name $survey_info(name) set description $survey_info(description) set description_html_p $survey_info(description_html_p) set desc_html "" if {$description_html_p=="t"} { - set desc_html "html" + set desc_html "html" } else { - set desc_html "plain" + set desc_html "plain" } ad_set_form_values desc_html description - + } -validate { {description {[string length $description] <= 4000} "[_ survey.lt_Description_must_be_l]" } } -} -edit_data { +} -edit_data { if {$desc_html=="pre" || $desc_html=="html"} { - set description_html_p t + set description_html_p t } else { - set description_html_p f + set description_html_p f } db_dml survey_update_description "" @@ -54,3 +54,9 @@ set context [list [list [export_vars -base one {survey_id}] $survey_info(name)] "[_ survey.Edit_Description]"] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/index.tcl,v diff -u -r1.3 -r1.3.6.1 --- openacs-4/packages/survey/www/admin/index.tcl 6 Nov 2013 07:33:54 -0000 1.3 +++ openacs-4/packages/survey/www/admin/index.tcl 9 Feb 2020 16:10:31 -0000 1.3.6.1 @@ -20,3 +20,9 @@ db_multirow surveys select_surveys {} ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/modify-responses-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/modify-responses-2.tcl,v diff -u -r1.4.4.1 -r1.4.4.2 --- openacs-4/packages/survey/www/admin/modify-responses-2.tcl 17 Dec 2019 16:28:44 -0000 1.4.4.1 +++ openacs-4/packages/survey/www/admin/modify-responses-2.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.2 @@ -21,24 +21,24 @@ permission::require_permission -object_id $section_id -privilege survey_modify_question db_transaction { - + set i 0 foreach choice_id $choice_id_list { - set trimmed_response [string trim [lindex $responses $i]] - db_dml update_survey_question_choice "update survey_question_choices + set trimmed_response [string trim [lindex $responses $i]] + db_dml update_survey_question_choice "update survey_question_choices set label = :trimmed_response where choice_id = :choice_id" - foreach variable_id $variable_id_list { - set score_list $scores($variable_id) - set score [lindex $score_list $i] - db_dml update_survey_scores "update survey_choice_scores + foreach variable_id $variable_id_list { + set score_list $scores($variable_id) + set score [lindex $score_list $i] + db_dml update_survey_scores "update survey_choice_scores set score = :score where choice_id = :choice_id and variable_id = :variable_id" - } + } - incr i + incr i } } @@ -48,4 +48,10 @@ set survey_id $survey_info(survey_id) ad_returnredirect [export_vars -base one {survey_id}] - + + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/modify-responses.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/modify-responses.tcl,v diff -u -r1.5.4.1 -r1.5.4.2 --- openacs-4/packages/survey/www/admin/modify-responses.tcl 17 Dec 2019 16:28:44 -0000 1.5.4.1 +++ openacs-4/packages/survey/www/admin/modify-responses.tcl 9 Feb 2020 16:10:31 -0000 1.5.4.2 @@ -55,7 +55,7 @@ and survey_choice_scores.variable_id = survey_variables.variable_id order by variable_name" { - append table_html "" + append table_html "" } append table_html "\n" @@ -84,3 +84,9 @@ }] ad_return_template generic + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/name-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/name-edit.tcl,v diff -u -r1.8.4.1 -r1.8.4.2 --- openacs-4/packages/survey/www/admin/name-edit.tcl 17 Dec 2019 16:28:44 -0000 1.8.4.1 +++ openacs-4/packages/survey/www/admin/name-edit.tcl 9 Feb 2020 16:10:31 -0000 1.8.4.2 @@ -4,7 +4,7 @@ @param section_id integer denoting survey whose description we're changing - @author Jin Choi (jsc@arsdigita.com) + @author Jin Choi (jsc@arsdigita.com) @author nstrug@arsdigita.com @date February 16, 2000 @cvs-id $Id$ @@ -23,12 +23,12 @@ ad_form -name edit-name -form { survey_id:key {name:text(text) {label "[_ survey.Survey_Name_1]"} {html {size 80}}} - {description:text(textarea) {label "[_ survey.Description_1]"} - {html {rows 10 cols 65}}} - {description_html_p:text(radio) {label "[_ survey.lt_The_Above_Description]"} - {options {{"[_ survey.Preformatted_Text]" "f"} - {"HTML" "t"} }} - {value "pre"}} + {description:text(textarea) {label "[_ survey.Description_1]"} + {html {rows 10 cols 65}}} + {description_html_p:text(radio) {label "[_ survey.lt_The_Above_Description]"} + {options {{"[_ survey.Preformatted_Text]" "f"} + {"HTML" "t"} }} + {value "pre"}} } -validate { {name {[string length $name] <= 4000} @@ -50,3 +50,9 @@ ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/one-respondent.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/one-respondent.tcl,v diff -u -r1.9.2.1 -r1.9.2.2 --- openacs-4/packages/survey/www/admin/one-respondent.tcl 17 Dec 2019 16:28:44 -0000 1.9.2.1 +++ openacs-4/packages/survey/www/admin/one-respondent.tcl 9 Feb 2020 16:10:31 -0000 1.9.2.2 @@ -13,7 +13,7 @@ user_id:naturalnum,notnull survey_id:naturalnum,notnull -} +} permission::require_permission -object_id $survey_id -privilege survey_admin_survey @@ -26,16 +26,16 @@ if {$description_html_p != "t"} { set description [ad_text_to_html -- $description] -} +} -# survey_name and description are now set +# survey_name and description are now set set user_exists_p [db_0or1row user_name_from_id "select first_names, last_name from persons where person_id = :user_id" ] if { !$user_exists_p } { ad_return_error \ - "[_ survey.Not_Found]" \ - "[_ survey.Could_not_find_user] #$user_id" + "[_ survey.Not_Found]" \ + "[_ survey.Could_not_find_user] #$user_id" ad_script_abort } @@ -48,3 +48,9 @@ } ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/one.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/one.tcl,v diff -u -r1.13.2.1 -r1.13.2.2 --- openacs-4/packages/survey/www/admin/one.tcl 17 Dec 2019 16:28:44 -0000 1.13.2.1 +++ openacs-4/packages/survey/www/admin/one.tcl 9 Feb 2020 16:10:31 -0000 1.13.2.2 @@ -26,17 +26,17 @@ ad_script_abort } -if {$survey_info(description_html_p) == "f"} { - set survey_info(description) [ad_text_to_html -- $survey_info(description)] +if {$survey_info(description_html_p) == "f"} { + set survey_info(description) [ad_text_to_html -- $survey_info(description)] } # get users and # who responded etc... if {[apm_package_installed_p dotlrn]} { set community_id [dotlrn_community::get_community_id_from_url] - set n_eligible [db_string n_eligible { - select count(*) from dotlrn_member_rels_full - where rel_type='dotlrn_member_rel' - and community_id=:community_id}] + set n_eligible [db_string n_eligible { + select count(*) from dotlrn_member_rels_full + where rel_type='dotlrn_member_rel' + and community_id=:community_id}] } set return_html "" @@ -65,7 +65,7 @@ set survey_display_types [survey::display_types] -# Questions summary. +# Questions summary. # We need to get the questions for ALL sections. set context [list $survey_info(name)] @@ -93,3 +93,9 @@ ] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/process-response.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/process-response.tcl,v diff -u -r1.7.2.2 -r1.7.2.3 --- openacs-4/packages/survey/www/admin/process-response.tcl 17 Dec 2019 16:28:44 -0000 1.7.2.2 +++ openacs-4/packages/survey/www/admin/process-response.tcl 9 Feb 2020 16:10:31 -0000 1.7.2.3 @@ -2,14 +2,14 @@ Insert user response into database. This page receives an input for each question named - response_to_question.$question_id + response_to_question.$question_id Adapted from www/process-response.tcl @param section_id survey user is responding to @param return_url optional redirect address - @param group_id + @param group_id @param response_to_question since form variables are now named as response_to_question.$question_id, this is actually array holding user responses to all survey questions. - + @param edited_response_id id of the response we are editing @author teadams@alum.mit.edu @date 1 April 2003 @@ -25,123 +25,123 @@ } -validate { section_exists -requires { section_id } { - if {![db_0or1row section_exists {}]} { - ad_complain "Section $section_id does not exist" - } + if {![db_0or1row section_exists {}]} { + ad_complain "Section $section_id does not exist" + } } check_questions -requires { section_id } { - set question_info_list [db_list_of_lists survey_question_info_list { - select question_id, question_text, abstract_data_type, presentation_type, required_p - from survey_questions - where section_id = :section_id - and active_p = 't' - order by sort_order - }] - - ## Validate input. - - set questions_with_missing_responses [list] + set question_info_list [db_list_of_lists survey_question_info_list { + select question_id, question_text, abstract_data_type, presentation_type, required_p + from survey_questions + where section_id = :section_id + and active_p = 't' + order by sort_order + }] - foreach question $question_info_list { - set question_id [lindex $question 0] - set question_text [lindex $question 1] - set abstract_data_type [lindex $question 2] - set required_p [lindex $question 4] - - # Need to clean-up after mess with :array,multiple flags - # in ad_page_contract. Because :multiple flag will sorround empty - # strings and all multiword values with one level of curly braces {} - # we need to get rid of them for almost any abstract_data_type - # except 'choice', where this is intended behavior. Why bother - # with :multiple flag at all? Because otherwise we would lost all - # but first value for 'choice' abstract_data_type - see ad_page_contract - # doc and code for more info. - # - if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { - if {$abstract_data_type ne "choice"} { - set response_to_question($question_id) [join $response_to_question($question_id)] - } else { - if { [lindex $response_to_question($question_id) 0 ] eq "" } { - set response_to_question($question_id) "" - } - } - } - - if { $abstract_data_type eq "date" } { - foreach {name value} [ns_set array [ns_getform]] { - if {[regexp "^response_to_question\[.\]$question_id\[.\](.*)\$" $name _ part]} { - set date_value($part) $value - } - } - set ok [ad_page_contract_filter_proc_date "date" date_value] - if {$ok} { - set response_to_question($question_id) [ns_buildsqldate $date_value(month) \ - $date_value(day) \ - $date_value(year)] - } else { - ad_complain "Please make sure your dates are valid." - } - } - - if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { - set response_value [string trim $response_to_question($question_id)] - } elseif {$required_p == "t"} { - - # When the administrator edits a survey, the file is not - # prefilled into the form like the rest of the fields. - # If the question is a file_upload and we are editing, - # it is not required to enter a file. Instead, the - # file from the prior response will be used. + ## Validate input. - if { $abstract_data_type ne "blob" || $initial_response_id eq ""} { - lappend questions_with_missing_responses $question_text - continue - } - - } else { - set response_to_question($question_id) "" - set response_value "" - } - - if {$response_value ne ""} { - if { $abstract_data_type eq "number" } { - if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } { - - ad_complain "The response to \"$question_text\" must be a number. Your answer was \"$response_value\"." - continue - } - } elseif { $abstract_data_type eq "integer" } { - if { ![regexp {^[0-9]+$} $response_value] } { - - ad_complain "The response to \"$question_text\" must be an integer. Your answer was \"$response_value\"." - continue - } - } - } - - if { $abstract_data_type eq "blob" } { + set questions_with_missing_responses [list] + + foreach question $question_info_list { + set question_id [lindex $question 0] + set question_text [lindex $question 1] + set abstract_data_type [lindex $question 2] + set required_p [lindex $question 4] + + # Need to clean-up after mess with :array,multiple flags + # in ad_page_contract. Because :multiple flag will sorround empty + # strings and all multiword values with one level of curly braces {} + # we need to get rid of them for almost any abstract_data_type + # except 'choice', where this is intended behavior. Why bother + # with :multiple flag at all? Because otherwise we would lost all + # but first value for 'choice' abstract_data_type - see ad_page_contract + # doc and code for more info. + # + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + if {$abstract_data_type ne "choice"} { + set response_to_question($question_id) [join $response_to_question($question_id)] + } else { + if { [lindex $response_to_question($question_id) 0 ] eq "" } { + set response_to_question($question_id) "" + } + } + } + + if { $abstract_data_type eq "date" } { + foreach {name value} [ns_set array [ns_getform]] { + if {[regexp "^response_to_question\[.\]$question_id\[.\](.*)\$" $name _ part]} { + set date_value($part) $value + } + } + set ok [ad_page_contract_filter_proc_date "date" date_value] + if {$ok} { + set response_to_question($question_id) [ns_buildsqldate $date_value(month) \ + $date_value(day) \ + $date_value(year)] + } else { + ad_complain "Please make sure your dates are valid." + } + } + + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + set response_value [string trim $response_to_question($question_id)] + } elseif {$required_p == "t"} { + + # When the administrator edits a survey, the file is not + # prefilled into the form like the rest of the fields. + # If the question is a file_upload and we are editing, + # it is not required to enter a file. Instead, the + # file from the prior response will be used. + + if { $abstract_data_type ne "blob" || $initial_response_id eq ""} { + lappend questions_with_missing_responses $question_text + continue + } + + } else { + set response_to_question($question_id) "" + set response_value "" + } + + if {$response_value ne ""} { + if { $abstract_data_type eq "number" } { + if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } { + + ad_complain "The response to \"$question_text\" must be a number. Your answer was \"$response_value\"." + continue + } + } elseif { $abstract_data_type eq "integer" } { + if { ![regexp {^[0-9]+$} $response_value] } { + + ad_complain "The response to \"$question_text\" must be an integer. Your answer was \"$response_value\"." + continue + } + } + } + + if { $abstract_data_type eq "blob" } { set tmp_filename $response_to_question($question_id.tmpfile) - set n_bytes [file size $tmp_filename] - if { $n_bytes == 0 && $required_p == "t" && - $initial_response_id eq ""} { - - ad_complain "Your file is zero-length. Either you attempted to upload a zero length file, a file which does not exist, or something went wrong during the transfer." - } - } - - } - - if { [llength $questions_with_missing_responses] > 0 } { - ad_complain "You didn't respond to all required sections. You skipped:" - foreach skipped_question $questions_with_missing_responses { - ad_complain $skipped_question - } - return 0 - } else { - return 1 - } + set n_bytes [file size $tmp_filename] + if { $n_bytes == 0 && $required_p == "t" && + $initial_response_id eq ""} { + + ad_complain "Your file is zero-length. Either you attempted to upload a zero length file, a file which does not exist, or something went wrong during the transfer." + } + } + + } + + if { [llength $questions_with_missing_responses] > 0 } { + ad_complain "You didn't respond to all required sections. You skipped:" + foreach skipped_question $questions_with_missing_responses { + ad_complain $skipped_question + } + return 0 + } else { + return 1 + } } } -properties { @@ -165,17 +165,17 @@ # moved to respond.tcl for double-click protection # set response_id [db_nextval acs_object_id_seq] -# teadams - +# teadams - # From what I can tell, editing a response creates -# a new response in the database, complete with a +# a new response in the database, complete with a # a response_id that is unique from the initial response. -# +# # Said another way, get_response_count would return # no rows if it were a new or edited response because # a new id is generated in respond.tcl. # The creator of the first version. -# +# if {$initial_response_id==0} { set initial_response_id "" @@ -192,90 +192,90 @@ db_transaction { - db_exec_plsql create_response {} + db_exec_plsql create_response {} - set question_info_list [db_list_of_lists survey_question_info_list { - select question_id, question_text, abstract_data_type, presentation_type, required_p - from survey_questions - where section_id = :section_id - and active_p = 't' - order by sort_order }] + set question_info_list [db_list_of_lists survey_question_info_list { + select question_id, question_text, abstract_data_type, presentation_type, required_p + from survey_questions + where section_id = :section_id + and active_p = 't' + order by sort_order }] - foreach question $question_info_list { - set question_id [lindex $question 0] - set question_text [lindex $question 1] - set abstract_data_type [lindex $question 2] - set presentation_type [lindex $question 3] + foreach question $question_info_list { + set question_id [lindex $question 0] + set question_text [lindex $question 1] + set abstract_data_type [lindex $question 2] + set presentation_type [lindex $question 3] - set response_value [string trim $response_to_question($question_id)] + set response_value [string trim $response_to_question($question_id)] - switch -- $abstract_data_type { - "choice" { - if { $presentation_type eq "checkbox" } { - # Deal with multiple responses. - set checked_responses $response_to_question($question_id) - foreach response_value $checked_responses { - if { $response_value eq "" } { - set response_value [db_null] - } + switch -- $abstract_data_type { + "choice" { + if { $presentation_type eq "checkbox" } { + # Deal with multiple responses. + set checked_responses $response_to_question($question_id) + foreach response_value $checked_responses { + if { $response_value eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_checkbox_insert "insert into survey_question_responses (response_id, question_id, choice_id) + db_dml survey_question_response_checkbox_insert "insert into survey_question_responses (response_id, question_id, choice_id) values (:response_id, :question_id, :response_value)" - } - } else { - if { $response_value eq "" || [lindex $response_value 0] eq "" } { - set response_value [db_null] - } + } + } else { + if { $response_value eq "" || [lindex $response_value 0] eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_choice_insert "insert into survey_question_responses (response_id, question_id, choice_id) + db_dml survey_question_response_choice_insert "insert into survey_question_responses (response_id, question_id, choice_id) values (:response_id, :question_id, :response_value)" - } - } - "shorttext" { - db_dml survey_question_choice_shorttext_insert "insert into survey_question_responses (response_id, question_id, varchar_answer) + } + } + "shorttext" { + db_dml survey_question_choice_shorttext_insert "insert into survey_question_responses (response_id, question_id, varchar_answer) values (:response_id, :question_id, :response_value)" - } - "boolean" { - if { $response_value eq "" } { - set response_value [db_null] - } + } + "boolean" { + if { $response_value eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_boolean_insert "insert into survey_question_responses (response_id, question_id, boolean_answer) + db_dml survey_question_response_boolean_insert "insert into survey_question_responses (response_id, question_id, boolean_answer) values (:response_id, :question_id, :response_value)" - } - "integer" - - "number" { - if { $response_value eq "" } { - set response_value [db_null] - } - db_dml survey_question_response_integer_insert "insert into survey_question_responses (response_id, question_id, number_answer) + } + "integer" - + "number" { + if { $response_value eq "" } { + set response_value [db_null] + } + db_dml survey_question_response_integer_insert "insert into survey_question_responses (response_id, question_id, number_answer) values (:response_id, :question_id, :response_value)" - } - "text" { - if { $response_value eq "" } { - set response_value [db_null] - } + } + "text" { + if { $response_value eq "" } { + set response_value [db_null] + } - db_dml survey_question_response_text_insert " + db_dml survey_question_response_text_insert " insert into survey_question_responses (response_id, question_id, clob_answer) values (:response_id, :question_id, empty_clob()) returning clob_answer into :1" -clobs [list $response_value] - } - "date" { + } + "date" { if { $response_value eq "" } { set response_value [db_null] } - db_dml survey_question_response_date_insert "insert into survey_question_responses (response_id, question_id, date_answer) + db_dml survey_question_response_date_insert "insert into survey_question_responses (response_id, question_id, date_answer) values (:response_id, :question_id, :response_value)" - } + } "blob" { if { $response_value ne "" } { # this stuff only makes sense to do if we know the file exists - set tmp_filename $response_to_question($question_id.tmpfile) + set tmp_filename $response_to_question($question_id.tmpfile) set file_extension [string tolower [file extension $response_value]] # remove the first . from the file extension @@ -300,23 +300,23 @@ # we are linking the file item_id to the survey_question_response attachment_answer field now db_dml survey_question_response_file_attachment_insert "" } - } else { - # There was no response. + } else { + # There was no response. - if {$initial_response_id ne ""} { - # There was a prior response - # Get the revision_id for this question from the - # prior question. - - if {[db_0or1row survey_prior_attachment_response {}]} { - set revision_id $attachment_answer - db_dml survey_question_response_file_attachment_insert "" - } + if {$initial_response_id ne ""} { + # There was a prior response + # Get the revision_id for this question from the + # prior question. - } - - } - } + if {[db_0or1row survey_prior_attachment_response {}]} { + set revision_id $attachment_answer + db_dml survey_question_response_file_attachment_insert "" + } + + } + + } + } } } } @@ -329,5 +329,11 @@ } else { set context "Response Submitted for $survey_name" ad_return_template -} - +} + + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-active-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-active-toggle.tcl,v diff -u -r1.4.4.1 -r1.4.4.2 --- openacs-4/packages/survey/www/admin/question-active-toggle.tcl 17 Dec 2019 16:28:44 -0000 1.4.4.1 +++ openacs-4/packages/survey/www/admin/question-active-toggle.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.2 @@ -25,3 +25,9 @@ set survey_id $survey_info(survey_id) ad_returnredirect [export_vars -base one {survey_id}] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-add-2.tcl,v diff -u -r1.8.4.1 -r1.8.4.2 --- openacs-4/packages/survey/www/admin/question-add-2.tcl 17 Dec 2019 16:28:44 -0000 1.8.4.1 +++ openacs-4/packages/survey/www/admin/question-add-2.tcl 9 Feb 2020 16:10:31 -0000 1.8.4.2 @@ -71,7 +71,7 @@ # if { $presentation_type eq "upload_file" } { # # incr exception_count # # append exception_text "

  • The presentation type: upload file is not supported at this time." - + # } # if { $exception_count > 0 } { @@ -91,18 +91,18 @@ set variable_id_list [list] db_foreach select_variable_names "" { - lappend variable_id_list $variable_id - append response_fields "$variable_name" + lappend variable_id_list $variable_id + append response_fields "$variable_name" } append response_fields "\n" for {set response 0} {$response < $n_responses} {incr response} { - append response_fields "" - for {set variable 0} {$variable < $n_variables} {incr variable} { - append response_fields "" - } - append response_fields "\n" + append response_fields "" + for {set variable 0} {$variable < $n_variables} {incr variable} { + append response_fields "" + } + append response_fields "\n" } append response_fields "\n" @@ -115,64 +115,64 @@ # Display presentation options for sizing text input fields and textareas. switch -- $presentation_type { - "textbox" { + "textbox" { - ad_form -extend -name create-question-2 -form { - {textbox_size:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {label "[_ survey.Size]"}} - {abstract_data_type:text(select) {label "[_ survey.Type_of_Response]"} - {options {{"[_ survey.Short_Text]" shorttext} {[_ survey.Text] text} {[_ survey.Boolean] boolean} {[_ survey.Number] number} {[_ survey.Integer] integer}}} - } + ad_form -extend -name create-question-2 -form { + {textbox_size:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {label "[_ survey.Size]"}} + {abstract_data_type:text(select) {label "[_ survey.Type_of_Response]"} + {options {{"[_ survey.Short_Text]" shorttext} {[_ survey.Text] text} {[_ survey.Boolean] boolean} {[_ survey.Number] number} {[_ survey.Integer] integer}}} + } - } - } - "textarea" { - ad_form -extend -name create-question-2 -form { - {textarea_size:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {label "[_ survey.Size]"}} - {abstract_data_type:text(hidden) {value "text"}} + } + } + "textarea" { + ad_form -extend -name create-question-2 -form { + {textarea_size:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {label "[_ survey.Size]"}} + {abstract_data_type:text(hidden) {value "text"}} - } - } + } + } } } # Let user enter valid responses for selections, radio buttons, and check boxes. set response_fields "" switch -- $presentation_type { - "radio" - - "select" { + "radio" - + "select" { - ad_form -extend -name create-question-2 -form { - {abstract_data_type:text(radio) - {label "[_ survey.Type_of_Response]"} {value "choice"} - {options {{"[_ survey.True_or_False]" boolean} {"[_ survey.Yes_or_No]" yn} {"[_ survey.Multiple_Choice]" choice}}}} - {valid_responses:text(textarea) - {label "[_ survey.lt_For_Multiple_Choicebr]"} - {html {rows 10 cols 50}}} - } - } - - "checkbox" { - ad_form -extend -name create-question-2 -form { - {valid_responses:text(textarea) {label "[_ survey.lt_Valid_Resposnes_enter]"} {html {rows 10 cols 50}}} - {abstract_data_type:text(hidden) {value "choice"}} - } - } + ad_form -extend -name create-question-2 -form { + {abstract_data_type:text(radio) + {label "[_ survey.Type_of_Response]"} {value "choice"} + {options {{"[_ survey.True_or_False]" boolean} {"[_ survey.Yes_or_No]" yn} {"[_ survey.Multiple_Choice]" choice}}}} + {valid_responses:text(textarea) + {label "[_ survey.lt_For_Multiple_Choicebr]"} + {html {rows 10 cols 50}}} + } + } + "checkbox" { + ad_form -extend -name create-question-2 -form { + {valid_responses:text(textarea) {label "[_ survey.lt_Valid_Resposnes_enter]"} {html {rows 10 cols 50}}} + {abstract_data_type:text(hidden) {value "choice"}} + } + } - - "date" { - ad_form -extend -name create-question-2 -form { - {abstract_data_type:text(hidden) {value date}} - } - } - "upload_file" { - ad_form -extend -name create-question-2 -form { - {abstract_data_type:text(hidden) {value blob}} - } - } + "date" { + + ad_form -extend -name create-question-2 -form { + {abstract_data_type:text(hidden) {value date}} + } + + } + "upload_file" { + ad_form -extend -name create-question-2 -form { + {abstract_data_type:text(hidden) {value blob}} + } + } } ad_form -extend -name create-question-2 -form { @@ -181,3 +181,9 @@ set context [list [list [export_vars -base one {survey_id}] $survey_info(name)] "[_ survey.Add_A_Question]"] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-add-3.tcl,v diff -u -r1.9.4.1 -r1.9.4.2 --- openacs-4/packages/survey/www/admin/question-add-3.tcl 17 Dec 2019 16:28:44 -0000 1.9.4.1 +++ openacs-4/packages/survey/www/admin/question-add-3.tcl 9 Feb 2020 16:10:31 -0000 1.9.4.2 @@ -28,8 +28,8 @@ presentation_alignment type:notnull {valid_responses ""} - {textbox_size ""} - {textarea_size: "medium"} + {textbox_size ""} + {textarea_size: "medium"} {required_p:boolean t} {active_p:boolean t} {responses:multiple ""} @@ -83,66 +83,66 @@ # Generate presentation_options. set presentation_options "" if { $presentation_type eq "textbox" } { - if { ([info exists textbox_size] && $textbox_size ne "") } { - # Will be "small", "medium", or "large". - set presentation_options $textbox_size - } + if { ([info exists textbox_size] && $textbox_size ne "") } { + # Will be "small", "medium", or "large". + set presentation_options $textbox_size + } } elseif { $presentation_type eq "textarea" } { - if { ([info exists textarea_size] && $textarea_size ne "") } { - # Will be "small", "medium", or "large". - set presentation_options $textarea_size - } + if { ([info exists textarea_size] && $textarea_size ne "") } { + # Will be "small", "medium", or "large". + set presentation_options $textarea_size + } } elseif { $abstract_data_type eq "yn" } { - set abstract_data_type "boolean" - set presentation_options "[_ survey.YesNo]" + set abstract_data_type "boolean" + set presentation_options "[_ survey.YesNo]" } elseif { $abstract_data_type eq "boolean" } { - set presentation_options "[_ survey.TrueFalse]" + set presentation_options "[_ survey.TrueFalse]" } db_transaction { - if { ([info exists after] && $after ne "") } { - # We're inserting between existing questions; move everybody down. - set sort_order [expr { $after + 1 }] - db_dml renumber_sort_orders {} - } else { - set sort_order [db_string max_question {}] - if { $sort_order eq ""} { - set sort_order 1 - } - } + if { ([info exists after] && $after ne "") } { + # We're inserting between existing questions; move everybody down. + set sort_order [expr { $after + 1 }] + db_dml renumber_sort_orders {} + } else { + set sort_order [db_string max_question {}] + if { $sort_order eq ""} { + set sort_order 1 + } + } - db_exec_plsql create_question {} + db_exec_plsql create_question {} - db_dml add_question_text {} + 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 eq "checkbox" || $presentation_type eq "radio" || $presentation_type eq "select" } { if { $abstract_data_type eq "choice" } { - set responses [split $valid_responses "\n"] - set count 0 - foreach response $responses { - set trimmed_response [string trim $response] - if { $trimmed_response eq "" } { - # skip empty lines - continue - } - ### added this next line to - set choice_id [db_string get_choice_id "select survey_choice_id_sequence.nextval as choice_id from dual"] - db_dml insert_survey_question_choice "insert into survey_question_choices (choice_id, question_id, label, sort_order) + set responses [split $valid_responses "\n"] + set count 0 + foreach response $responses { + set trimmed_response [string trim $response] + if { $trimmed_response eq "" } { + # skip empty lines + continue + } + ### added this next line to + set choice_id [db_string get_choice_id "select survey_choice_id_sequence.nextval as choice_id from dual"] + db_dml insert_survey_question_choice "insert into survey_question_choices (choice_id, question_id, label, sort_order) values (survey_choice_id_sequence.nextval, :question_id, :trimmed_response, :count)" - incr count - } - } + incr count + } + } } } on_error { db_release_unused_handles ad_return_error "[_ survey.Database_Error]" "
    $errmsg
    " ad_script_abort - + } @@ -155,3 +155,9 @@ + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-add.tcl,v diff -u -r1.8.4.2 -r1.8.4.3 --- openacs-4/packages/survey/www/admin/question-add.tcl 17 Dec 2019 16:28:44 -0000 1.8.4.2 +++ openacs-4/packages/survey/www/admin/question-add.tcl 9 Feb 2020 16:10:31 -0000 1.8.4.3 @@ -12,7 +12,7 @@ } { section_id:naturalnum,notnull {after:integer ""} - + } set package_id [ad_conn package_id] @@ -24,31 +24,31 @@ ad_form -name create_question -action question-add-2 -export { after } -form { question_id:key {section_id:text(hidden) {value $section_id}} - {question_text:text(textarea) {label "[_ survey.Question]"} {html {rows 5 cols 70}}} + {question_text:text(textarea) {label "[_ survey.Question]"} {html {rows 5 cols 70}}} } ad_form -extend -name create_question -form { {presentation_type:text(select) - {label "[_ survey.Presentation_Type]"} - {options {{ "[_ survey.lt_One_Line_Answer_Text_]" "textbox" } - { "[_ survey.lt_Essay_Answer_Text_Are]" "textarea" } - { "[_ survey.lt_Multiple_Choice_Drop_]" "select" } - { "[_ survey.lt_Multiple_Choice_Radio]" "radio" } - { "[_ survey.lt_Multiple_Choice_Check]" "checkbox" } - { "[_ survey.Date]" "date" } - { "[_ survey.File_Attachment]" "upload_file" } } } } -} - - + {label "[_ survey.Presentation_Type]"} + {options {{ "[_ survey.lt_One_Line_Answer_Text_]" "textbox" } + { "[_ survey.lt_Essay_Answer_Text_Are]" "textarea" } + { "[_ survey.lt_Multiple_Choice_Drop_]" "select" } + { "[_ survey.lt_Multiple_Choice_Radio]" "radio" } + { "[_ survey.lt_Multiple_Choice_Check]" "checkbox" } + { "[_ survey.Date]" "date" } + { "[_ survey.File_Attachment]" "upload_file" } } } } +} + + survey::get_info -section_id $section_id set survey_id $survey_info(survey_id) set context [list [list [export_vars -base one {survey_id}] $survey_info(name)] "[_ survey.Add_A_Question]"] if {[parameter::get -parameter allow_question_deactivation_p] == 1} { ad_form -extend -name create_question -form { {active:text(radio) {label "[_ survey.Active]"} {options {{[_ survey.Yes] t} {[_ survey.No] f}}} {value t}} - } + } } else { ad_form -extend -name create_question -form { {active:text(hidden) {value t}} @@ -57,9 +57,15 @@ ad_form -extend -name create_question -form { {required_p:text(radio) {label "[_ survey.Required]"} {options {{"[_ survey.Yes]" t} {"[_ survey.No]" f}}} {value t}} } - + ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-copy.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-copy.tcl,v diff -u -r1.4.4.1 -r1.4.4.2 --- openacs-4/packages/survey/www/admin/question-copy.tcl 17 Dec 2019 16:28:44 -0000 1.4.4.1 +++ openacs-4/packages/survey/www/admin/question-copy.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.2 @@ -19,3 +19,9 @@ incr sort_order ad_returnredirect "[export_vars -base one survey_id]&#$sort_order" + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-delete.tcl,v diff -u -r1.8.4.1 -r1.8.4.2 --- openacs-4/packages/survey/www/admin/question-delete.tcl 17 Dec 2019 16:28:44 -0000 1.8.4.1 +++ openacs-4/packages/survey/www/admin/question-delete.tcl 9 Feb 2020 16:10:31 -0000 1.8.4.2 @@ -1,4 +1,3 @@ -# /www/survsimp/admin/question-delete.tcl ad_page_contract { Delete a question from a survey @@ -32,52 +31,60 @@ if {$n_responses > 0} { if {$n_responses >1} { - set response_text "[_ survey.responses]" + set response_text "[_ survey.responses]" } else { - set response_text "[_ survey.response]" + set response_text "[_ survey.response]" } ad_form -extend -name confirm_delete -form { - {warning:text(inform) {value "[_ survey.lt_This_question_has_n]"} - {label "[_ survey.Warning]"}} + {warning:text(inform) {value "[_ survey.lt_This_question_has_n]"} + {label "[_ survey.Warning]"}} } - + } ad_form -extend -name confirm_delete -form { {confirmation:text(radio) {label " "} - {options - {{"[_ survey.Continue_with_Delete]" t } - {"[_ survey.lt_Cancel_and_return_to_]" f }} } - {value f}} - } -select_query_name {get_question_details} -on_submit { - if {$confirmation} { - db_transaction { + {options + {{"[_ survey.Continue_with_Delete]" t } + {"[_ survey.lt_Cancel_and_return_to_]" f }} + } + {value f} + } +} -select_query_name {get_question_details} -on_submit { + if {$confirmation} { + db_transaction { - db_dml survey_question_responses_delete {} - db_dml survey_question_choices_delete {} - db_exec_plsql survey_delete_question {} + db_dml survey_question_responses_delete {} + db_dml survey_question_choices_delete {} + db_exec_plsql survey_delete_question {} - if {$sort_order ne ""} { - db_dml survey_renumber_questions {} - } - } on_error { - - ad_return_error [_ survey.Database_Error] "[_ survey.lt_There_was_an_error_wh] - 
    -		$errmsg
-
    -

    [_ survey.lt_Please_go_back_using_] - " + if {$sort_order ne ""} { + db_dml survey_renumber_questions {} + } + } on_error { + + ad_return_error [_ survey.Database_Error] "[_ survey.lt_There_was_an_error_wh] + 

    +                $errmsg
+
    +

    [_ survey.lt_Please_go_back_using_] + " ad_script_abort - } + } - db_release_unused_handles - set sort_order [expr {$sort_order -1}] - } + db_release_unused_handles + set sort_order [expr {$sort_order -1}] + } ad_returnredirect "[export_vars -base one {survey_id}]&#$sort_order" ad_script_abort } set context [_ survey.Delete_Question] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-modify-text.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-modify-text.tcl,v diff -u -r1.7.4.1 -r1.7.4.2 --- openacs-4/packages/survey/www/admin/question-modify-text.tcl 17 Dec 2019 16:28:44 -0000 1.7.4.1 +++ openacs-4/packages/survey/www/admin/question-modify-text.tcl 9 Feb 2020 16:10:31 -0000 1.7.4.2 @@ -38,3 +38,9 @@ set context [list [list [export_vars -base one {survey_id}] $survey_info(name)] "[_ survey.lt_Modify_a_Questions_Te]"] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-modify.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-modify.tcl,v diff -u -r1.6.4.1 -r1.6.4.2 --- openacs-4/packages/survey/www/admin/question-modify.tcl 17 Dec 2019 16:28:44 -0000 1.6.4.1 +++ openacs-4/packages/survey/www/admin/question-modify.tcl 9 Feb 2020 16:10:31 -0000 1.6.4.2 @@ -31,14 +31,14 @@ if {$n_responses > 0} { if {$n_responses >1} { - set isare "[_ survey.are]" - set resp "[_ survey.responses]" + set isare "[_ survey.are]" + set resp "[_ survey.responses]" } else { - set isare "[_ survey.is]" - set resp "[_ survey.response]" + set isare "[_ survey.is]" + set resp "[_ survey.response]" } ad_form -extend -name modify_question -form { - {warning:text(inform) {label "[_ survey.Warning]"} {value "[_ survey.lt_There_isare_n_resp]"}} + {warning:text(inform) {label "[_ survey.Warning]"} {value "[_ survey.lt_There_isare_n_resp]"}} } } ad_form -extend -name modify_question -export {sort_order} -form { @@ -60,7 +60,7 @@ {required_p:text(radio) {label "[_ survey.Required]"} {options {{"[_ survey.Yes]" t} {"[_ survey.No]" f}}}} {section_id:text(hidden) {value $section_id}} {survey_id:text(hidden) {value $survey_id}} -} +} db_1row presentation {} @@ -69,19 +69,19 @@ set valid_responses_list [db_list survey_question_valid_responses {}] set response_list "" foreach response $valid_responses_list { - append valid_responses "$response\n" + append valid_responses "$response\n" } ad_form -extend -name modify_question -form { {valid_responses:text(textarea) {label "[_ survey.lt_For_Multiple_Choicebr]"} {html {rows 10 cols 50}} {value $valid_responses}} - } -} + } +} if {$presentation_type eq "textarea" || $presentation_type eq "textbox"} { ad_form -extend -name modify_question -form { - {presentation_options:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {value $presentation_options} {label "[string totitle $presentation_type] [_ survey.Size]"}} + {presentation_options:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {value $presentation_options} {label "[string totitle $presentation_type] [_ survey.Size]"}} } } @@ -109,7 +109,7 @@ lappend response_list [list "$trimmed_response" "$count"] incr count } - + set choice_id_to_update_list [db_list get_choice_id {}] set choice_count 0 foreach one_response $response_list { @@ -133,9 +133,9 @@ } - + ad_returnredirect "one?survey_id=$survey_id&#${sort_order}" ad_script_abort } @@ -144,3 +144,9 @@ set context [_ survey.Modify_Question] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-required-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-required-toggle.tcl,v diff -u -r1.5.4.1 -r1.5.4.2 --- openacs-4/packages/survey/www/admin/question-required-toggle.tcl 17 Dec 2019 16:28:44 -0000 1.5.4.1 +++ openacs-4/packages/survey/www/admin/question-required-toggle.tcl 9 Feb 2020 16:10:31 -0000 1.5.4.2 @@ -30,3 +30,9 @@ set survey_id $survey_info(survey_id) ad_returnredirect [export_vars -base one {survey_id}] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/question-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-swap.tcl,v diff -u -r1.5 -r1.5.4.1 --- openacs-4/packages/survey/www/admin/question-swap.tcl 27 Oct 2014 16:41:58 -0000 1.5 +++ openacs-4/packages/survey/www/admin/question-swap.tcl 9 Feb 2020 16:10:31 -0000 1.5.4.1 @@ -41,3 +41,9 @@ } ad_returnredirect "one?survey_id=$survey_id&#${sort_order}" + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/respond.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/respond.tcl,v diff -u -r1.8.2.2 -r1.8.2.3 --- openacs-4/packages/survey/www/admin/respond.tcl 17 Dec 2019 16:28:44 -0000 1.8.2.2 +++ openacs-4/packages/survey/www/admin/respond.tcl 9 Feb 2020 16:10:31 -0000 1.8.2.3 @@ -1,13 +1,13 @@ ad_page_contract { - Display the questionnaire prefilled with responses for one survey submission. + Display the questionnaire prefilled with responses for one survey submission. Allows administrator to edit the answers to a survey. Adapted from www/respond.tcl @param user_id user whose response we're viewing @param survey_id survey we're viewing @param response_id response we are editing - @param return_url url to redirect to after submission + @param return_url url to redirect to after submission @author teadams@alum.mit @date March 27, 2003 @cvs-id $Id$ @@ -16,14 +16,14 @@ user_id:naturalnum,notnull survey_id:naturalnum,notnull {section_id:naturalnum,notnull 0} - {response_id:naturalnum,notnull 0} + {response_id:naturalnum,notnull 0} return_url:localurl,optional } -validate { survey_exists -requires {survey_id} { - if {![db_0or1row survey_exists {}]} { - ad_complain "Survey $survey_id does not exist" - } + if {![db_0or1row survey_exists {}]} { + ad_complain "Survey $survey_id does not exist" + } } } -properties { @@ -46,14 +46,14 @@ set type $survey_info(type) set display_type $survey_info(display_type) -# survey_name and description are now set +# survey_name and description are now set set user_exists_p [db_0or1row user_name_from_id "select first_names, last_name from persons where person_id = :user_id" ] if { !$user_exists_p } { ad_return_error \ - "Not Found" \ - "Could not find user #$user_id" + "Not Found" \ + "Could not find user #$user_id" ad_script_abort } @@ -71,26 +71,32 @@ # build a list containing the HTML (generated with survey::display_question) for each question set rownum 0 # for double-click protection -set new_response_id [db_nextval acs_object_id_seq] +set new_response_id [db_nextval acs_object_id_seq] set questions {} db_foreach survey_sections {} { db_foreach question_ids_select {} { - lappend questions [survey::display_question $question_id $response_id] + lappend questions [survey::display_question $question_id $response_id] } - # survey will return to survey_url if it exists + # survey will return to survey_url if it exists # rather than executing the survey associated with the logic # after the survey is completed - + if {![info exists return_url]} { - set return_url {} + set return_url {} } } set edited_response_id $response_id -set form_vars [export_vars -form {section_id survey_id new_response_id user_id edited_response_id}] +set form_vars [export_vars -form {section_id survey_id new_response_id user_id edited_response_id}] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/respondents.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/respondents.tcl,v diff -u -r1.12.2.1 -r1.12.2.2 --- openacs-4/packages/survey/www/admin/respondents.tcl 17 Dec 2019 16:28:44 -0000 1.12.2.1 +++ openacs-4/packages/survey/www/admin/respondents.tcl 9 Feb 2020 16:10:31 -0000 1.12.2.2 @@ -59,3 +59,9 @@ } ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/response-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-delete.tcl,v diff -u -r1.6 -r1.6.4.1 --- openacs-4/packages/survey/www/admin/response-delete.tcl 27 Jun 2015 20:46:15 -0000 1.6 +++ openacs-4/packages/survey/www/admin/response-delete.tcl 9 Feb 2020 16:10:31 -0000 1.6.4.1 @@ -23,17 +23,24 @@ {warning:text(inform) {value "[_ survey.lt_Completely_delete [list user_name_var user_name response_date_var response_date]]"} {label "[_ survey.Warning]"}} {confirmation:text(radio) {label " "} - {options - {{"[_ survey.Continue_with_Delete]" t } - {"[_ survey.lt_Cancel_and_return_to_]" f }} } - {value f} + {options + {{"[_ survey.Continue_with_Delete]" t } + {"[_ survey.lt_Cancel_and_return_to_]" f }} + } + {value f} } } -on_submit { if {$confirmation} { - db_exec_plsql delete_response {} - } + db_exec_plsql delete_response {} + } ad_returnredirect [export_vars -base one-respondent {survey_id user_id}] } set context [_ survey.Delete_Response] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/response-drill-down.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-drill-down.tcl,v diff -u -r1.7.2.1 -r1.7.2.2 --- openacs-4/packages/survey/www/admin/response-drill-down.tcl 17 Dec 2019 16:28:44 -0000 1.7.2.1 +++ openacs-4/packages/survey/www/admin/response-drill-down.tcl 9 Feb 2020 16:10:31 -0000 1.7.2.2 @@ -55,3 +55,9 @@ "[_ survey.One_Response]"] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/response-editable-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-editable-toggle.tcl,v diff -u -r1.4 -r1.4.4.1 --- openacs-4/packages/survey/www/admin/response-editable-toggle.tcl 27 Jun 2015 20:46:16 -0000 1.4 +++ openacs-4/packages/survey/www/admin/response-editable-toggle.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.1 @@ -20,3 +20,9 @@ db_release_unused_handles ad_returnredirect [export_vars -base one {survey_id}] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/response-limit-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-limit-toggle.tcl,v diff -u -r1.5 -r1.5.4.1 --- openacs-4/packages/survey/www/admin/response-limit-toggle.tcl 27 Jun 2015 20:46:16 -0000 1.5 +++ openacs-4/packages/survey/www/admin/response-limit-toggle.tcl 9 Feb 2020 16:10:31 -0000 1.5.4.1 @@ -19,3 +19,9 @@ db_release_unused_handles ad_returnredirect [export_vars -base one {survey_id}] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/responses-export.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/responses-export.tcl,v diff -u -r1.13.4.2 -r1.13.4.3 --- openacs-4/packages/survey/www/admin/responses-export.tcl 17 Dec 2019 16:28:44 -0000 1.13.4.2 +++ openacs-4/packages/survey/www/admin/responses-export.tcl 9 Feb 2020 16:10:31 -0000 1.13.4.3 @@ -40,31 +40,31 @@ append headline "\"" set question_data_type($question_id) $abstract_data_type switch -- $abstract_data_type { - "date" { - set question_column($question_id) "date_answer" - } - "text" { - set question_column($question_id) "clob_answer" - } - "shorttext" { - set question_column($question_id) "varchar_answer" - } - "boolean" { - set question_column($question_id) "boolean_answer" - } - "integer" - - "number" { - set question_column($question_id) "number_answer" - } - "choice" { - set question_column($question_id) "label" - } - "blob" { - set question_column($question_id) "attachment_answer" - } - default { - set question_column($question_id) "varchar_answer" - } + "date" { + set question_column($question_id) "date_answer" + } + "text" { + set question_column($question_id) "clob_answer" + } + "shorttext" { + set question_column($question_id) "varchar_answer" + } + "boolean" { + set question_column($question_id) "boolean_answer" + } + "integer" - + "number" { + set question_column($question_id) "number_answer" + } + "choice" { + set question_column($question_id) "label" + } + "blob" { + set question_column($question_id) "attachment_answer" + } + default { + set question_column($question_id) "varchar_answer" + } } } @@ -83,55 +83,55 @@ db_foreach get_all_survey_question_responses "" { if { $response_id != $current_response_id } { - if { $current_question_id ne "" } { - append current_response ",\"[join $current_question_list ","]\"" - } + if { $current_question_id ne "" } { + append current_response ",\"[join $current_question_list ","]\"" + } - if { $current_response_id ne "" } { - append csv_export "$current_response \r\n" - } - set current_response_id $response_id + if { $current_response_id ne "" } { + append csv_export "$current_response \r\n" + } + set current_response_id $response_id - set creation_date_ansi [lc_time_system_to_conn $creation_date_ansi] - set creation_date_pretty [lc_time_fmt $creation_date_ansi "%x %X"] - set one_response [list $email $first_names $last_name $user_id $creation_date_pretty $response_id] - regsub -all {"} $one_response {""} one_response - set current_response "\"[join $one_response {","}]\"" + set creation_date_ansi [lc_time_system_to_conn $creation_date_ansi] + set creation_date_pretty [lc_time_fmt $creation_date_ansi "%x %X"] + set one_response [list $email $first_names $last_name $user_id $creation_date_pretty $response_id] + regsub -all {"} $one_response {""} one_response + set current_response "\"[join $one_response {","}]\"" - set current_question_id "" - set current_question_list [list] + set current_question_id "" + set current_question_list [list] } set response_value [set $question_column($question_id)] # Properly escape double quotes to make Excel & co happy regsub -all {"} $response_value {""} response_value - + # Remove any CR or LF characters that may be present in text fields regsub -all {[\r\n]} $response_value {} response_value if { $question_id != $current_question_id } { - if { $current_question_id ne "" } { - append current_response ",\"[join $current_question_list ","]\"" - } - set current_question_id $question_id - set current_question_list [list] + if { $current_question_id ne "" } { + append current_response ",\"[join $current_question_list ","]\"" + } + set current_question_id $question_id + set current_question_list [list] } # decode boolean answers - if {$question_data_type($question_id)=="boolean"} { - set response_value [survey::decode_boolean_answer -response $response_value -question_id $question_id] - } - if {$question_data_type($question_id)=="blob"} { - set response_value [db_string get_filename {} -default ""] - } + if {$question_data_type($question_id)=="boolean"} { + set response_value [survey::decode_boolean_answer -response $response_value -question_id $question_id] + } + if {$question_data_type($question_id)=="blob"} { + set response_value [db_string get_filename {} -default ""] + } lappend current_question_list $response_value - - incr r - if {$r>99} { - ns_write "${csv_export}" - set csv_export "" - set r 0 - } + incr r + if {$r>99} { + ns_write "${csv_export}" + set csv_export "" + set r 0 + } + } if { $current_question_id ne "" } { @@ -141,8 +141,14 @@ append csv_export "$current_response\r\n" } if {$csv_export eq ""} { - set csv_export "\r\n" + set csv_export "\r\n" } ns_write $csv_export ns_conn close + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/responses.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/responses.tcl,v diff -u -r1.8.4.1 -r1.8.4.2 --- openacs-4/packages/survey/www/admin/responses.tcl 17 Dec 2019 16:28:44 -0000 1.8.4.1 +++ openacs-4/packages/survey/www/admin/responses.tcl 9 Feb 2020 16:10:31 -0000 1.8.4.2 @@ -29,7 +29,7 @@ set return_html "" # mbryzek - 3/27/2000 -# We need a way to limit the summary page to 1 response from +# We need a way to limit the summary page to 1 response from # each user. We use views to select out only the latest response # from any given user @@ -41,46 +41,46 @@

    " switch -- $abstract_data_type { - "date" - - "text" - - "shorttext" { - set href [export_vars -base view-text-responses {question_id}] - append results [subst {

    [_ survey.View_responses]
    \n}] - } - - "boolean" { + "date" - + "text" - + "shorttext" { + set href [export_vars -base view-text-responses {question_id}] + append results [subst {
    [_ survey.View_responses]
    \n}] + } - db_foreach survey_boolean_summary "" { - append results "[survey::decode_boolean_answer -response $boolean_answer -question_id $question_id]: $n_responses
    \n" - } - } - "integer" - - "number" { - db_foreach survey_number_summary "" { + "boolean" { + + db_foreach survey_boolean_summary "" { + append results "[survey::decode_boolean_answer -response $boolean_answer -question_id $question_id]: $n_responses
    \n" + } + } + "integer" - + "number" { + db_foreach survey_number_summary "" { append results "$number_answer: $n_responses
    \n" } - db_1row survey_number_average "" - append results "

    [_ survey.Mean] $mean
    [_ survey.Standard_Dev]: $standard_deviation
    \n" - + db_1row survey_number_average "" + append results "

    [_ survey.Mean] $mean
    [_ survey.Standard_Dev]: $standard_deviation
    \n" + } - "choice" { - db_foreach survey_section_question_choices "" { - set href [export_vars -base response-drill-down {question_id choice_id}] - append results [subst {$label: $n_responses
    \n}] - } - } - "blob" { - db_foreach survey_attachment_summary {} { - set href [export_vars -base ../view-attachment {response_id question_id}] - append results [subst {$title
    }] - } - } + "choice" { + db_foreach survey_section_question_choices "" { + set href [export_vars -base response-drill-down {question_id choice_id}] + append results [subst {$label: $n_responses
    \n}] + } + } + "blob" { + db_foreach survey_attachment_summary {} { + set href [export_vars -base ../view-attachment {response_id question_id}] + append results [subst {$title
    }] + } + } } append results "

    \n" } - + set n_responses [db_string survey_number_responses {} ] if { $n_responses == 1 } { @@ -92,3 +92,9 @@ set context [list [list [export_vars -base one {survey_id}] $survey_info(name)] "[_ survey.Responses]"] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/send-mail.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/send-mail.tcl,v diff -u -r1.7.4.1 -r1.7.4.2 --- openacs-4/packages/survey/www/admin/send-mail.tcl 17 Dec 2019 16:28:44 -0000 1.7.4.1 +++ openacs-4/packages/survey/www/admin/send-mail.tcl 9 Feb 2020 16:10:31 -0000 1.7.4.2 @@ -4,14 +4,14 @@ a survey to various groups @param survey_id - + @author dave@thedesignexperience.org @date July 29, 2002 @cvs-id $Id: } { survey_id:naturalnum,notnull {package_id:naturalnum,notnull 0} - {to "responded"} + {to "responded"} } set package_id [ad_conn package_id] @@ -33,32 +33,32 @@ set n_responses [db_string n_responses {}] if {$n_responses > 0} { - ad_form -name send-mail -form { - {to:text(radio) {options { - {"[_ survey.lt_Everyone_eligible_to_]" "all"} - {"[_ survey.lt_Everyone_who_has_alre]" "responded"} - {"[_ survey.lt_Everyone_who_has_not_]" "not_responded"}}} - {label "[_ survey.Send_mail_to]"} - {value $to} - } - } + ad_form -name send-mail -form { + {to:text(radio) {options { + {"[_ survey.lt_Everyone_eligible_to_]" "all"} + {"[_ survey.lt_Everyone_who_has_alre]" "responded"} + {"[_ survey.lt_Everyone_who_has_not_]" "not_responded"}}} + {label "[_ survey.Send_mail_to]"} + {value $to} + } + } } else { - ad_form -name send-mail -form { - {to:text(radio) {options { - {"[_ survey.lt_Everyone_eligible_to_]" "all"} - {"[_ survey.lt_Everyone_who_has_not_]" "not_responded"}}} - {label "[_ survey.Send_mail_to]"} - {value $to} - } - } + ad_form -name send-mail -form { + {to:text(radio) {options { + {"[_ survey.lt_Everyone_eligible_to_]" "all"} + {"[_ survey.lt_Everyone_who_has_not_]" "not_responded"}}} + {label "[_ survey.Send_mail_to]"} + {value $to} + } + } } } else { ad_form -name send-mail -form { - {to:text(radio) {options { - {"[_ survey.lt_Everyone_who_has_alre]" "all"}}} - {value "all"} - {label "[_ survey.Send_mail_to]"} - } + {to:text(radio) {options { + {"[_ survey.lt_Everyone_who_has_alre]" "all"}}} + {value "all"} + {label "[_ survey.Send_mail_to]"} + } } } @@ -73,27 +73,27 @@ if {$dotlrn_installed_p} { switch $to { - all { - set query [db_map dotlrn_all] - } - - responded { - set query [db_map dotlrn_responded] - } - - not_responded { - set query [db_map dotlrn_not_responded] - } + all { + set query [db_map dotlrn_all] + } + + responded { + set query [db_map dotlrn_responded] + } + + not_responded { + set query [db_map dotlrn_not_responded] + } } } else { set query [db_map responded] } ns_log notice "DAVE-SURVEY: $query" - bulk_mail::new \ - -package_id $package_id \ - -from_addr $sender_email \ - -subject $subject \ + bulk_mail::new \ + -package_id $package_id \ + -from_addr $sender_email \ + -subject $subject \ -message $message \ -query $query ad_returnredirect "one?survey_id=$survey_id" @@ -103,3 +103,9 @@ set context [_ survey.Send_Mail] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/site-wide-survey.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/site-wide-survey.tcl,v diff -u -r1.1 -r1.1.26.1 --- openacs-4/packages/survey/www/admin/site-wide-survey.tcl 16 Sep 2002 00:00:25 -0000 1.1 +++ openacs-4/packages/survey/www/admin/site-wide-survey.tcl 9 Feb 2020 16:10:31 -0000 1.1.26.1 @@ -9,17 +9,22 @@ permission::require_permission -party_id $user_id -object_id 0 -privilege admin db_multirow surveys get_surveys { - select s.survey_id, s.name, s.editable_p, s.single_response_p, - s.package_id, + select s.survey_id, s.name, s.editable_p, s.single_response_p, + s.package_id, acs_object.name(apm_package.parent_id(s.package_id)) as parent_name, - (select site_node.url(site_nodes.node_id) - from site_nodes - where site_nodes.object_id = s.package_id) as url - from surveys s - where enabled_p='t' - order by + (select site_node.url(site_nodes.node_id) + from site_nodes + where site_nodes.object_id = s.package_id) as url + from surveys s + where enabled_p='t' + order by parent_name, upper(s.name) } -ad_return_template \ No newline at end of file +ad_return_template +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-category-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-category-add.tcl,v diff -u -r1.4.4.1 -r1.4.4.2 --- openacs-4/packages/survey/www/admin/survey-category-add.tcl 17 Dec 2019 16:28:44 -0000 1.4.4.1 +++ openacs-4/packages/survey/www/admin/survey-category-add.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.2 @@ -42,3 +42,9 @@ set survey_id $survey_info(survey_id) ad_returnredirect [export_vars -base one {survey_id}] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-copy.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-copy.tcl,v diff -u -r1.7.4.2 -r1.7.4.3 --- openacs-4/packages/survey/www/admin/survey-copy.tcl 17 Dec 2019 16:28:44 -0000 1.7.4.2 +++ openacs-4/packages/survey/www/admin/survey-copy.tcl 9 Feb 2020 16:10:31 -0000 1.7.4.3 @@ -38,3 +38,9 @@ set context "[_ survey.Copy] $title_name" ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-create-choice.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-create-choice.tcl,v diff -u -r1.4 -r1.4.4.1 --- openacs-4/packages/survey/www/admin/survey-create-choice.tcl 27 Oct 2014 16:41:58 -0000 1.4 +++ openacs-4/packages/survey/www/admin/survey-create-choice.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.1 @@ -31,3 +31,9 @@ ad_return_template generic + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-create-confirm.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-create-confirm.tcl,v diff -u -r1.5 -r1.5.2.1 --- openacs-4/packages/survey/www/admin/survey-create-confirm.tcl 30 Sep 2017 18:12:53 -0000 1.5 +++ openacs-4/packages/survey/www/admin/survey-create-confirm.tcl 9 Feb 2020 16:10:31 -0000 1.5.2.1 @@ -4,3 +4,9 @@ set description [ns_quotehtml $description] } + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-create.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-create.tcl,v diff -u -r1.9 -r1.9.4.1 --- openacs-4/packages/survey/www/admin/survey-create.tcl 27 Oct 2014 16:41:58 -0000 1.9 +++ openacs-4/packages/survey/www/admin/survey-create.tcl 9 Feb 2020 16:10:31 -0000 1.9.4.1 @@ -34,45 +34,45 @@ {name:text(text) {label "[_ survey.Survey_Name_1]"} {html {size 55}}} {description:text(textarea) {label "[_ survey.Description_1]"} {html {rows 10 cols 40}}} {desc_html:text(radio) {label "[_ survey.lt_The_Above_Description]"} - {options {{"[_ survey.Preformatted_Text]" "pre"} - {"HTML" "html"} }} - {value "pre"} + {options {{"[_ survey.Preformatted_Text]" "pre"} + {"HTML" "html"} }} + {value "pre"} } - -} -validate { + +} -validate { {name {[string length $name] <= 4000} "[_ survey.lt_Survey_Name_must_be_4]" } {description {[string length $description] <= 4000} "[_ survey.lt_Survey_Name_must_be_4]" } {survey_id {[db_string count_surveys "select count(survey_id) from surveys where survey_id=:survey_id"] < 1} "[_ survey.oops]" } - + } -new_data { - + if {$desc_html eq "html" } { - set description_html_p "t" + set description_html_p "t" } else { - set description_html_p "f" + set description_html_p "f" } if {[parameter::get -package_id $package_id -parameter survey_enabled_default_p -default 0]} { - set enabled_p "t" + set enabled_p "t" } else { - set enabled_p "f" + set enabled_p "f" } db_transaction { - db_exec_plsql create_survey "" + db_exec_plsql create_survey "" - # survey type-specific inserts + # survey type-specific inserts - # create new section here. the questions go in the section - # section_id is null to create a new section - # we might want to specify a section_id later for - # multiple section surveys - set section_id "" - set section_id [db_exec_plsql create_section ""] + # create new section here. the questions go in the section + # section_id is null to create a new section + # we might want to specify a section_id later for + # multiple section surveys + set section_id "" + set section_id [db_exec_plsql create_section ""] } ad_returnredirect "question-add?section_id=$section_id" ad_script_abort @@ -87,3 +87,9 @@ ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-delete.tcl,v diff -u -r1.7.4.1 -r1.7.4.2 --- openacs-4/packages/survey/www/admin/survey-delete.tcl 17 Dec 2019 16:28:44 -0000 1.7.4.1 +++ openacs-4/packages/survey/www/admin/survey-delete.tcl 9 Feb 2020 16:10:31 -0000 1.7.4.2 @@ -25,21 +25,28 @@ {survey_id:text(hidden) {value $survey_id}} {warning:text(inform) {label "[_ survey.Warning_1]"} {value "[_ survey.lt_Deleting_this_surve]"}} {confirmation:text(radio) {label " "} - {options - {{"[_ survey.Continue_with_Delete]" t } - {"[_ survey.lt_Cancel_and_return_to__1]" f }} } - {value f} + {options + {{"[_ survey.Continue_with_Delete]" t } + {"[_ survey.lt_Cancel_and_return_to__1]" f }} + } + {value f} } } -on_submit { if {$confirmation} { - db_exec_plsql delete_survey {} - ad_returnredirect "." + db_exec_plsql delete_survey {} + ad_returnredirect "." ad_script_abort } else { - ad_returnredirect [export_vars -base one survey_id] + ad_returnredirect [export_vars -base one survey_id] ad_script_abort } } set context [_ survey.Delete_Survey] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl,v diff -u -r1.4.4.1 -r1.4.4.2 --- openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl 17 Dec 2019 16:28:44 -0000 1.4.4.1 +++ openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl 9 Feb 2020 16:10:31 -0000 1.4.4.2 @@ -18,3 +18,9 @@ db_release_unused_handles ad_returnredirect [export_vars -base one {survey_id}] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-preview.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-preview.tcl,v diff -u -r1.10.2.1 -r1.10.2.2 --- openacs-4/packages/survey/www/admin/survey-preview.tcl 17 Dec 2019 16:28:44 -0000 1.10.2.1 +++ openacs-4/packages/survey/www/admin/survey-preview.tcl 9 Feb 2020 16:10:31 -0000 1.10.2.2 @@ -10,16 +10,16 @@ @cvs-id $Id$ } { - + survey_id:naturalnum,notnull {section_id:naturalnum ""} return_url:localurl,optional } -validate { survey_exists -requires {survey_id} { - if {![db_0or1row survey_exists {}]} { - ad_complain "[_ survey.lt_Survey_survey_id_does]" - } + if {![db_0or1row survey_exists {}]} { + ad_complain "[_ survey.lt_Survey_survey_id_does]" + } } } -properties { @@ -44,20 +44,20 @@ if {$description_html_p != "t"} { set description [ad_text_to_html -- $description] - } - + } + set context [list "[_ survey.Preview] $name"] # build a list containing the HTML (generated with survey::display_question) for each question set rownum 0 - + set questions {} db_foreach survey_sections {} { db_foreach question_ids_select {} { - lappend questions [survey::display_question $question_id] + lappend questions [survey::display_question $question_id] } @@ -67,3 +67,9 @@ set form_vars [export_vars -form {section_id survey_id}] ad_return_template + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/survey-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-toggle.tcl,v diff -u -r1.5 -r1.5.4.1 --- openacs-4/packages/survey/www/admin/survey-toggle.tcl 14 Jun 2015 00:49:36 -0000 1.5 +++ openacs-4/packages/survey/www/admin/survey-toggle.tcl 9 Feb 2020 16:10:31 -0000 1.5.4.1 @@ -27,3 +27,9 @@ ad_returnredirect "$target" + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/user-responses-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/user-responses-delete.tcl,v diff -u -r1.7 -r1.7.4.1 --- openacs-4/packages/survey/www/admin/user-responses-delete.tcl 27 Jun 2015 20:46:16 -0000 1.7 +++ openacs-4/packages/survey/www/admin/user-responses-delete.tcl 9 Feb 2020 16:10:31 -0000 1.7.4.1 @@ -23,22 +23,29 @@ {user_id:text(hidden) {value $user_id}} {warning:text(inform) {label "[_ survey.Warning_1]"} {value "[_ survey.lt_This_will_remove_respo]"}} {confirmation:text(radio) {label " "} - {options - {{"[_ survey.Continue_with_Delete]" t } - {"[_ survey.lt_Cancel_and_return_to_]" f }} } - {value f} + {options + {{"[_ survey.Continue_with_Delete]" t } + {"[_ survey.lt_Cancel_and_return_to_]" f }} + } + {value f} } } -on_submit { if {$confirmation} { - template::multirow foreach responses { - if {$initial_response_id eq ""} { - db_exec_plsql delete_response {} - } - } - } + template::multirow foreach responses { + if {$initial_response_id eq ""} { + db_exec_plsql delete_response {} + } + } + } ad_returnredirect [export_vars -base one-respondent {survey_id user_id}] ad_script_abort } set context [_ survey.Delete_Response] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/survey/www/admin/view-text-responses.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/view-text-responses.tcl,v diff -u -r1.6.4.1 -r1.6.4.2 --- openacs-4/packages/survey/www/admin/view-text-responses.tcl 17 Dec 2019 16:28:44 -0000 1.6.4.1 +++ openacs-4/packages/survey/www/admin/view-text-responses.tcl 9 Feb 2020 16:10:31 -0000 1.6.4.2 @@ -41,3 +41,9 @@ db_multirow responses all_responses_to_question {} set context [list [list [export_vars -base one {survey_id}] $survey_info(name)] "[_ survey.lt_Responses_to_Question]"] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/tsearch2-driver/tcl/test/tsearch2-driver-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/tsearch2-driver/tcl/test/tsearch2-driver-procs.tcl,v diff -u -r1.5.2.2 -r1.5.2.3 --- openacs-4/packages/tsearch2-driver/tcl/test/tsearch2-driver-procs.tcl 4 Feb 2020 08:52:53 -0000 1.5.2.2 +++ openacs-4/packages/tsearch2-driver/tcl/test/tsearch2-driver-procs.tcl 9 Feb 2020 16:12:41 -0000 1.5.2.3 @@ -75,3 +75,9 @@ } } + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowiki/resources/templates/error-template.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/resources/templates/error-template.tcl,v diff -u -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/xowiki/resources/templates/error-template.tcl 3 Dec 2019 14:21:06 -0000 1.1.2.1 +++ openacs-4/packages/xowiki/resources/templates/error-template.tcl 9 Feb 2020 16:12:41 -0000 1.1.2.2 @@ -1,3 +1,9 @@ template::head::add_css \ -href urn:ad:css:xowiki-[::xowiki::Package preferredCSSToolkit] + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowiki-portlet/www/xowiki-portlet.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki-portlet/www/xowiki-portlet.tcl,v diff -u -r1.1 -r1.1.6.1 --- openacs-4/packages/xowiki-portlet/www/xowiki-portlet.tcl 31 Jan 2007 10:52:48 -0000 1.1 +++ openacs-4/packages/xowiki-portlet/www/xowiki-portlet.tcl 9 Feb 2020 16:12:41 -0000 1.1.6.1 @@ -1,2 +1,8 @@ array set config $cf regsub {/[^/]+$} [ad_conn url] "/xowiki/$config(page_name)" url + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: