Index: openacs-4/packages/acs-tcl/lib/page-error.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/lib/page-error.tcl,v diff -u -r1.20 -r1.21 --- openacs-4/packages/acs-tcl/lib/page-error.tcl 17 Jan 2019 17:46:04 -0000 1.20 +++ openacs-4/packages/acs-tcl/lib/page-error.tcl 17 Jan 2019 17:51:50 -0000 1.21 @@ -1,5 +1,5 @@ ad_page_contract { - + @author Victor Guerra (guerra@galileo.edu) @creation-date 2005-02-03 @cvs-id $Id$ @@ -53,12 +53,12 @@ if { $bug_number eq "" && $send_email_p} { acs_mail_lite::send -send_immediately \ - -to_addr $send_to -from_addr $public_userm_email \ - -subject $subject \ - -body $error_desc_email + -to_addr $send_to -from_addr $public_userm_email \ + -subject $subject \ + -body $error_desc_email } set bt_instance [parameter::get -package_id [ad_acs_kernel_id] \ - -parameter BugTrackerInstance -default ""] + -parameter BugTrackerInstance -default ""] if { $bt_instance ne "" } { array set community_info [site_node::get -url "${bt_instance}/[bug_tracker::package_key]"] @@ -71,194 +71,195 @@ if {$auto_submit_p && $user_id > 0} { # Is this project using multiple versions? set versions_p [bug_tracker::versions_p] - + # Patches enabled for this project? set patches_p [bug_tracker::patches_p] - + set enabled_action_id [form get_action bug_edit] - + set exist_bug [db_string search_bug {} -default ""] if { $exist_bug eq ""} { - - # Submit the new Bug into the bug-tracker and into the - # auto_bugs table - set bug_id [db_nextval acs_object_id_seq] - - set keyword_ids [list] + + # Submit the new Bug into the bug-tracker and into the + # auto_bugs table + set bug_id [db_nextval acs_object_id_seq] + + set keyword_ids [list] foreach {category_id category_name} [bug_tracker::category_types -package_id $bt_package_id] { - lappend keyword_ids [bug_tracker::get_default_keyword -parent_id $category_id -package_id $bt_package_id] + lappend keyword_ids [bug_tracker::get_default_keyword -parent_id $category_id -package_id $bt_package_id] } - + bug_tracker::bug::new \ - -bug_id $bug_id \ - -package_id $bt_package_id \ - -component_id [bug_tracker::conn component_id] \ - -found_in_version $found_in_version \ - -summary $subject \ - -description $error_desc_email \ - -desc_format text/html \ - -keyword_ids $keyword_ids \ - -user_id $user_id - - bug_tracker::bugs_exist_p_set_true -package_id $bt_package_id + -bug_id $bug_id \ + -package_id $bt_package_id \ + -component_id [bug_tracker::conn component_id] \ + -found_in_version $found_in_version \ + -summary $subject \ + -description $error_desc_email \ + -desc_format text/html \ + -keyword_ids $keyword_ids \ + -user_id $user_id + + bug_tracker::bugs_exist_p_set_true -package_id $bt_package_id db_dml insert_auto_bug {} + } else { - - # Comment on the existing bug even if the user doesn't want to - # add commentaries. If the bug is closed or fixed we have to - # reopen the bug. + + # Comment on the existing bug even if the user doesn't want to + # add commentaries. If the bug is closed or fixed we have to + # reopen the bug. # array set row [list] - set bug_id $exist_bug - - if {$bug_number eq ""} { - db_dml increase_reported_times {} - } - - # Get the bug data - bug_tracker::bug::get -bug_id $bug_id -array bug -enabled_action_id $enabled_action_id - + set bug_id $exist_bug + + if {$bug_number eq ""} { + db_dml increase_reported_times {} + } + + # Get the bug data + bug_tracker::bug::get -bug_id $bug_id -array bug -enabled_action_id $enabled_action_id + set case_id [workflow::case::get_id \ - -object_id $bug_id \ - -workflow_short_name [bug_tracker::bug::workflow_short_name]] + -object_id $bug_id \ + -workflow_short_name [bug_tracker::bug::workflow_short_name]] foreach available_enabled_action_id [workflow::case::get_available_enabled_action_ids -case_id $case_id] { - workflow::case::enabled_action_get -enabled_action_id $available_enabled_action_id -array enabled_action - workflow::action::get -action_id $enabled_action(action_id) -array available_action - if {[string match "*Reopen*" $available_action(pretty_name)]} { - bug_tracker::bug::edit \ - -bug_id $bug_id \ - -enabled_action_id $available_enabled_action_id \ - -description " [_ acs-tcl.reopened_auto ] " \ - -desc_format text/html \ - -array row \ - -entry_id $bug(entry_id) - } - if {[string match "*Comment*" $available_action(pretty_name)]} { - set comment_action $available_enabled_action_id - } + workflow::case::enabled_action_get -enabled_action_id $available_enabled_action_id -array enabled_action + workflow::action::get -action_id $enabled_action(action_id) -array available_action + if {[string match "*Reopen*" $available_action(pretty_name)]} { + bug_tracker::bug::edit \ + -bug_id $bug_id \ + -enabled_action_id $available_enabled_action_id \ + -description " [_ acs-tcl.reopened_auto ] " \ + -desc_format text/html \ + -array row \ + -entry_id $bug(entry_id) + } + if {[string match "*Comment*" $available_action(pretty_name)]} { + set comment_action $available_enabled_action_id + } } - - bug_tracker::bug::edit \ - -bug_id $bug_id \ - -enabled_action_id $comment_action \ - -description $error_desc_email \ - -desc_format text/html \ - -array row \ - -entry_id $bug(entry_id) + + bug_tracker::bug::edit \ + -bug_id $bug_id \ + -enabled_action_id $comment_action \ + -description $error_desc_email \ + -desc_format text/html \ + -array row \ + -entry_id $bug(entry_id) } - + set case_id [workflow::case::get_id \ - -object_id $bug_id \ - -workflow_short_name [bug_tracker::bug::workflow_short_name]] + -object_id $bug_id \ + -workflow_short_name [bug_tracker::bug::workflow_short_name]] set workflow_id [bug_tracker::bug::get_instance_workflow_id -package_id $bt_package_id] - + # set enabled_action_id [form get_action bug_edit] - + # Registration required for all actions set action_id "" #if { $enabled_action_id ne "" } { # workflow::case::enabled_action_get -enabled_action_id $enabled_action_id -array enabled_action # set action_id $enabled_action(action_id) # } - + set times_rep [db_string select_times_reported {} -default 0 ] - + ad_form -name bug_edit -export {comment_action reopen_action bt_instance bt_package_id user_id bug_package_id} -form { - {bug_number_display:text(inform) - {label "[bug_tracker::conn Bug] \\\#"} - {mode display} - } - {component_id:integer(select),optional - {label "[_ bug-tracker.Component]"} - {options {[bug_tracker::components_get_options]}} - {mode display} - } - {summary:text(text) - {label "[_ bug-tracker.Summary]"} - {before_html ""} - {after_html ""} - {mode display} - {html {size 50}} - } - {pretty_state:text(inform) - {label "[_ bug-tracker.Status]"} - {before_html ""} - {after_html ""} - {mode display} - } - {resolution:text(select),optional - {label "[_ bug-tracker.Resolution]"} - {options {[bug_tracker::resolution_get_options]}} - {mode display} - } - {previus_url:text(inform) - {label "[_ acs-tcl.Previus]"} - {value $prev_url} - } - {err_url:text(inform) - {label "[_ acs-tcl.Page]"} - {value $error_url} - } - {err_file:text(inform) - {label "[_ acs-tcl.File]"} - {value $error_file} - } - {times_reported:text(inform) - {label "[_ acs-tcl.Times_reported]"} - {value $times_rep} - } + {bug_number_display:text(inform) + {label "[bug_tracker::conn Bug] \\\#"} + {mode display} + } + {component_id:integer(select),optional + {label "[_ bug-tracker.Component]"} + {options {[bug_tracker::components_get_options]}} + {mode display} + } + {summary:text(text) + {label "[_ bug-tracker.Summary]"} + {before_html ""} + {after_html ""} + {mode display} + {html {size 50}} + } + {pretty_state:text(inform) + {label "[_ bug-tracker.Status]"} + {before_html ""} + {after_html ""} + {mode display} + } + {resolution:text(select),optional + {label "[_ bug-tracker.Resolution]"} + {options {[bug_tracker::resolution_get_options]}} + {mode display} + } + {previus_url:text(inform) + {label "[_ acs-tcl.Previus]"} + {value $prev_url} + } + {err_url:text(inform) + {label "[_ acs-tcl.Page]"} + {value $error_url} + } + {err_file:text(inform) + {label "[_ acs-tcl.File]"} + {value $error_file} + } + {times_reported:text(inform) + {label "[_ acs-tcl.Times_reported]"} + {value $times_rep} + } } - + foreach {category_id category_name} [bug_tracker::category_types] { - ad_form -extend -name bug_edit -form [list \ - [list "${category_id}:integer(select)" \ - [list label $category_name] \ - [list options [bug_tracker::category_get_options -parent_id $category_id]] \ - [list mode display] \ - ] \ - ] + ad_form -extend -name bug_edit -form [list \ + [list "${category_id}:integer(select)" \ + [list label $category_name] \ + [list options [bug_tracker::category_get_options -parent_id $category_id]] \ + [list mode display] \ + ] \ + ] } - + ad_form -extend -name bug_edit -form { {found_in_version:text(select),optional {label "[_ bug-tracker.Found_in_Version]"} {options {[bug_tracker::version_get_options -include_unknown]}} {mode display} } } - + workflow::case::role::add_assignee_widgets -case_id $case_id -form_name bug_edit - + ad_form -extend -name bug_edit -form { - {user_agent:text(inform) - {label "[_ bug-tracker.User_Agent]"} - {mode display} - } - {fix_for_version:text(select),optional - {label "[_ bug-tracker.Fix_for_Version]"} - {options {[bug_tracker::version_get_options -include_undecided]}} - {mode display} - } - {fixed_in_version:text(select),optional - {label "[_ bug-tracker.Fixed_in_Version]"} - {options {[bug_tracker::version_get_options -include_undecided]}} - {mode display} + {user_agent:text(inform) + {label "[_ bug-tracker.User_Agent]"} + {mode display} } - {description:richtext(richtext),optional - {label "[_ bug-tracker.Description]"} - {html {cols 60 rows 13}} - } - {return_url:text(hidden) - {value $return_url} - } - {bug_number:key} - {entry_id:integer(hidden),optional} + {fix_for_version:text(select),optional + {label "[_ bug-tracker.Fix_for_Version]"} + {options {[bug_tracker::version_get_options -include_undecided]}} + {mode display} + } + {fixed_in_version:text(select),optional + {label "[_ bug-tracker.Fixed_in_Version]"} + {options {[bug_tracker::version_get_options -include_undecided]}} + {mode display} + } + {description:richtext(richtext),optional + {label "[_ bug-tracker.Description]"} + {html {cols 60 rows 13}} + } + {return_url:text(hidden) + {value $return_url} + } + {bug_number:key} + {entry_id:integer(hidden),optional} } -on_submit { - array set row [list] - - set description [element get_value bug_edit description] - set error_desc_html [subst { + array set row [list] + + set description [element get_value bug_edit description] + set error_desc_html [subst { --------------------------------------------------------
[_ acs-tcl.Error_Report]
--------------------------------------------------------
@@ -268,11 +269,11 @@
[_ acs-tcl.User_Name] [ns_quotehtml $user_name]
[_ acs-tcl.lt_User_Id_of_the_user_t] [ns_quotehtml $user_id]
[_ acs-tcl.Browser_of_the_user] [ns_quotehtml [ns_set get [ns_conn headers] User-Agent]] -

[_ acs-tcl.User_comments] +

[_ acs-tcl.User_comments]
[ns_quotehtml [template::util::richtext::get_property contents $description]]

}] - + foreach available_enabled_action_id [workflow::case::get_available_enabled_action_ids -case_id $case_id] { workflow::case::enabled_action_get -enabled_action_id $available_enabled_action_id -array enabled_action workflow::action::get -action_id $enabled_action(action_id) -array available_action @@ -299,18 +300,18 @@ if { ![form is_valid bug_edit] } { - + # Get the bug data bug_tracker::bug::get -bug_id $bug_id -array bug -enabled_action_id $enabled_action_id - - + + # Make list of form fields set element_names { bug_number component_id summary pretty_state resolution found_in_version user_agent fix_for_version fixed_in_version bug_number_display entry_id } - + # update the element_name list and bug array with category stuff foreach {category_id category_name} [bug_tracker::category_types] { lappend element_names $category_id @@ -325,37 +326,37 @@ [bug_tracker::get_patch_links -bug_id $bug(bug_id) -show_patch_status $show_patch_status]   \[ [_ bug-tracker.Upload_Patch] \] }] - + # Hide elements that should be hidden depending on the bug status foreach element $bug(hide_fields) { element set_properties bug_edit $element -widget hidden } - + if { !$versions_p } { foreach element { found_in_version fix_for_version fixed_in_version } { if { [info exists bug_edit:$element] } { element set_properties bug_edit $element -widget hidden } } } - + if { !$patches_p } { foreach element { patches } { if { [info exists bug_edit:$element] } { element set_properties bug_edit $element -widget hidden } } } - + # Optionally hide user agent if { !$user_agent_p } { element set_properties bug_edit user_agent -widget hidden } - - + + # Set regular element values foreach element $element_names { - + # check that the element exists if { [info exists bug_edit:$element] && [info exists bug($element)] } { if {[form is_request bug_edit] @@ -391,22 +392,19 @@ } # Set values for description field - + ad_form -name bug_history -has_submit 1 -form { {history:text(inform) {label "[_ acs-tcl.User_comments]"} {value ""} } } - + element set_properties bug_history history \ -after_html [workflow::case::get_activity_html -case_id $case_id -action_id $action_id] } +} -} - - - # Local variables: # mode: tcl # tcl-indent-level: 4 Index: openacs-4/packages/acs-tcl/tcl/admin-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/admin-procs.tcl,v diff -u -r1.29 -r1.30 --- openacs-4/packages/acs-tcl/tcl/admin-procs.tcl 17 Jan 2019 17:46:04 -0000 1.29 +++ openacs-4/packages/acs-tcl/tcl/admin-procs.tcl 17 Jan 2019 17:51:50 -0000 1.30 @@ -20,18 +20,18 @@ ad_returnredirect [security::get_secure_qualified_url [ad_return_url]] # No abort since in filter - + return "filter_return" } ad_proc -public ad_approval_system_inuse_p {} { Returns 1 if the system is configured to use and approval system. } { - if {[parameter::get -parameter RegistrationRequiresEmailVerification] && - [parameter::get -parameter RegistrationRequiresApprovalP] } { - return 1 + if {[parameter::get -parameter RegistrationRequiresEmailVerification] && + [parameter::get -parameter RegistrationRequiresApprovalP] } { + return 1 } else { - return 0 + return 0 } } @@ -50,7 +50,7 @@ curriculum_elements_completed } } - + ad_proc -private ad_user_class_description { set_id } { Takes an ns_set of key/value pairs and produces a human-readable description of the class of users specified. @@ -59,123 +59,123 @@ set pretty_description "" # turn all the parameters in the ns_set into Tcl vars - ad_ns_set_to_tcl_vars -duplicates fail $set_id - + ad_ns_set_to_tcl_vars -duplicates fail $set_id + # All the SQL statements are named after the criteria name (e.g. category_id) foreach criteria [ad_user_class_parameters] { - if { [info exists $criteria] && [set $criteria] ne "" } { + if { [info exists $criteria] && [set $criteria] ne "" } { - switch -- $criteria { - "category_id" { - set pretty_category [db_string $criteria { - select category from categories where category_id = :category_id - } ] - lappend clauses "said they were interested in $pretty_category" - } - "country_code" { - set pretty_country [db_string $criteria { - select country_name from country_codes where iso = :country_code - } ] - lappend clauses "told us that they live in $pretty_country" - } - "usps_abbrev" { - set pretty_state [db_string $criteria { - select state_name from states where usps_abbrev = :usps_abbrev - } ] - lappend clauses "told us that they live in $pretty_state" - } - "intranet_user_p" { - lappend clauses "are an employee" - } - "group_id" { - set group_name [db_string $criteria { - select group_name from groups where group_id = :group_id - } ] - lappend clauses "are a member of $group_name" - } - "last_name_starts_with" { - lappend clauses "have a last name starting with $last_name_starts_with" - } - "email_starts_with" { - lappend clauses "have an email address starting with $email_starts_with" - } - "expensive" { - lappend clauses "have accumulated unpaid charges of more than [parameter::get -parameter ExpensiveThreshold]" - } - "user_state" { - lappend clauses "have user state of $user_state" - } - "sex" { - lappend clauses "are $sex." - } - "age_above_years" { - lappend clauses "is older than $age_above_years years" - } - "age_below_years" { - lappend clauses "is younger than $age_below_years years" - } - "registration_during_month" { - set pretty_during_month [db_string $criteria { - select to_char(to_date(:registration_during_month,'YYYYMM'),'fmMonth YYYY') from dual - } ] - lappend clauses "registered during $pretty_during_month" - } - "registration_before_days" { - lappend clauses "registered over $registration_before_days days ago" - } - "registration_after_days" { - lappend clauses "registered in the last $registration_after_days days" - } - "registration_after_date" { - lappend clauses "registered on or after $registration_after_date" - } - "last_login_before_days" { - lappend clauses "have not visited the site in $last_login_before_days days" - } - "last_login_after_days" { - lappend clauses "have not visited the site in $last_login_after_days days" - } - "last_login_equals_days" { - if { $last_login_equals_days == 1 } { - lappend clauses "visited the site exactly 1 day ago" - } else { - lappend clauses "visited the site exactly $last_login_equals_days days ago" - } - } - "number_of_visits_below" { - lappend clauses "have visited less than $number_visits_below times" - } - "number_of_visits_above" { - lappend clauses "have visited more than $number_visits_above times" - } - "user_class_id" { - set pretty_class_name [db_string $criteria { - select name from user_classes where user_class_id = :user_class_id - } ] - lappend clauses "are in the user class $pretty_class_name" - } - "sql_post_select" { - lappend clauses "are returned by \"select users(*) from $sql_post_select" - } - "crm_state" { - lappend clauses "are in the customer state \"$crm_state\"" - } - "curriculum_elements_completed" { - if { $curriculum_elements_completed == 1 } { - lappend clauses "who have completed exactly $curriculum_elements_completed curriculum element" - } else { - lappend clauses "who have completed exactly $curriculum_elements_completed curriculum elements" - } - } - } - } + switch -- $criteria { + "category_id" { + set pretty_category [db_string $criteria { + select category from categories where category_id = :category_id + } ] + lappend clauses "said they were interested in $pretty_category" + } + "country_code" { + set pretty_country [db_string $criteria { + select country_name from country_codes where iso = :country_code + } ] + lappend clauses "told us that they live in $pretty_country" + } + "usps_abbrev" { + set pretty_state [db_string $criteria { + select state_name from states where usps_abbrev = :usps_abbrev + } ] + lappend clauses "told us that they live in $pretty_state" + } + "intranet_user_p" { + lappend clauses "are an employee" + } + "group_id" { + set group_name [db_string $criteria { + select group_name from groups where group_id = :group_id + } ] + lappend clauses "are a member of $group_name" + } + "last_name_starts_with" { + lappend clauses "have a last name starting with $last_name_starts_with" + } + "email_starts_with" { + lappend clauses "have an email address starting with $email_starts_with" + } + "expensive" { + lappend clauses "have accumulated unpaid charges of more than [parameter::get -parameter ExpensiveThreshold]" + } + "user_state" { + lappend clauses "have user state of $user_state" + } + "sex" { + lappend clauses "are $sex." + } + "age_above_years" { + lappend clauses "is older than $age_above_years years" + } + "age_below_years" { + lappend clauses "is younger than $age_below_years years" + } + "registration_during_month" { + set pretty_during_month [db_string $criteria { + select to_char(to_date(:registration_during_month,'YYYYMM'),'fmMonth YYYY') from dual + } ] + lappend clauses "registered during $pretty_during_month" + } + "registration_before_days" { + lappend clauses "registered over $registration_before_days days ago" + } + "registration_after_days" { + lappend clauses "registered in the last $registration_after_days days" + } + "registration_after_date" { + lappend clauses "registered on or after $registration_after_date" + } + "last_login_before_days" { + lappend clauses "have not visited the site in $last_login_before_days days" + } + "last_login_after_days" { + lappend clauses "have not visited the site in $last_login_after_days days" + } + "last_login_equals_days" { + if { $last_login_equals_days == 1 } { + lappend clauses "visited the site exactly 1 day ago" + } else { + lappend clauses "visited the site exactly $last_login_equals_days days ago" + } + } + "number_of_visits_below" { + lappend clauses "have visited less than $number_visits_below times" + } + "number_of_visits_above" { + lappend clauses "have visited more than $number_visits_above times" + } + "user_class_id" { + set pretty_class_name [db_string $criteria { + select name from user_classes where user_class_id = :user_class_id + } ] + lappend clauses "are in the user class $pretty_class_name" + } + "sql_post_select" { + lappend clauses "are returned by \"select users(*) from $sql_post_select" + } + "crm_state" { + lappend clauses "are in the customer state \"$crm_state\"" + } + "curriculum_elements_completed" { + if { $curriculum_elements_completed == 1 } { + lappend clauses "who have completed exactly $curriculum_elements_completed curriculum element" + } else { + lappend clauses "who have completed exactly $curriculum_elements_completed curriculum elements" + } + } + } + } } if { [info exists combine_method] && $combine_method eq "or" } { - set pretty_description [join $clauses " or "] + set pretty_description [join $clauses " or "] } else { - set pretty_description [join $clauses " and "] + set pretty_description [join $clauses " and "] } return $pretty_description @@ -262,9 +262,8 @@ lassign $elm url label lappend user_finite_state_links [subst {$label}] } - - return $user_finite_state_links + return $user_finite_state_links } }