# Ticket tracker definitions # ticket-defs.tcl by hqm@arsdigita.com June 1999 util_report_library_entry ################################################################ # Reference to "customer" in various functions refer to any user who is not in # the ticket admin group. This is based on a "customer support" # model for the usage of ticket tracker. proc ticket_getdbhandle {} { return [ns_db gethandle main] } proc ticket_system_name {} { return "[ad_system_name] Ticket Tracker" } proc ticket_reply_email_addr {} { return [ad_parameter TicketReplyEmail "ticket"] } # Customers are allowed to create new tickets in the system? # Defaults to yes. proc ticket_customers_can_create_new_tickets {} { if {[string compare [ad_parameter CustomerCanCreateNewTickets "ticket"] "0"] == 0} { return 0 } else { return 1 } } # returns 1 if current user is in admin group for ticket module proc ticket_user_admin_p {db} { set user_id [ad_verify_and_get_user_id] return [ad_administration_group_member $db ticket "" $user_id] } # return the GID of the ticket admin group proc ticket_admin_group {db} { return [ad_administration_group_id $db "ticket" ""] } ns_share -init {set ad_ticket_filters_installed 0} ad_ticket_filters_installed if {!$ad_ticket_filters_installed} { set ad_ticket_filters_installed 1 ns_register_filter preauth HEAD /ticket/admin/* ticket_security_checks_admin ns_register_filter preauth HEAD /ticket/* ticket_security_checks ns_register_filter preauth GET /ticket/admin/* ticket_security_checks_admin ns_register_filter preauth GET /ticket/* ticket_security_checks ns_register_filter preauth POST /ticket/admin/* ticket_security_checks_admin ns_register_filter preauth POST /ticket/* ticket_security_checks } # Check for the user cookie, redirect if not found. proc ticket_security_checks {args why} { uplevel { set user_id [ad_verify_and_get_user_id] if {$user_id == 0} { ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" return filter_return } return filter_ok } } # Checks if user is logged in, AND is a member of the ticket admin group proc ticket_security_checks_admin {args why} { set user_id [ad_verify_and_get_user_id] if {$user_id == 0} { ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" return filter_return } set db [ns_db gethandle subquery] if {![ticket_user_admin_p $db]} { ad_return_error "Access Denied" "Your account does not have access to this page." return filter_return } ns_db releasehandle $db return filter_ok } # return id of the default admin user (system admin) proc default_ticket_admin_user {db} { set admins [database_to_tcl_list $db "select ugm.user_id from user_group_map ugm where ugm.group_id = [ticket_admin_group $db]"] return [lindex $admins 0] } # The id of the project in which unprivileged user's tickets are created. proc get_default_customer_project_id {db} { return [get_project_named $db "Tech Support" 1] } # A single project is designated where RMA tickets get put proc get_project_named {db title {create 0}} { set id_list [database_to_tcl_list $db "select project_id from ticket_projects where lower(title) = '[string tolower $title]'"] if {[llength $id_list] < 1} { if {$create} { set new_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"] ns_db dml $db "insert into ticket_projects (project_id, customer_id, title, start_date) VALUES ($new_id, [default_ticket_admin_user $db], '$title', sysdate())" set id_list [list $new_id] } else { error "get_project_named: Could not find project named $title" } } return [lindex $id_list 0] } proc ticket_picklist_field_names {} { set names {} foreach entry [ticket_picklist_data] { lappend names [lindex $entry 0] } return $names } # returns the field name of a picklist entry proc ticket_picklist_entry_field_name {entry} { return [lindex $entry 0] } # returns the field name of a picklist entry proc ticket_picklist_entry_pretty_name {entry} { return [lindex $entry 1] } proc ticket_picklist_entry_column_name {entry} { return [lindex $entry 3] } # Get the meta-data for a field_name: # returns an entry from the picklist data list as defined above. proc ticket_picklist_field_info {field_name} { foreach entry [ticket_picklist_data] { set fn [lindex $entry 0] if {$field_name == $fn} { return $entry } } return {} } # Returns the HTML needed to input a picklist value proc ticket_picklist_html_fragment { field_name {default_value ""} } { set entry [ticket_picklist_field_info $field_name] set widget_type [lindex $entry 2] set pretty_name [lindex $entry 1] set optional [lindex $entry 4] switch $widget_type { "picklist_single_select" { return "$pretty_name[picklist_html_select_list $field_name $default_value]" } "text" { return "$pretty_name" } default { return "Cannot find widget type meta-data for field $field_name !" } } } proc picklist_html_select_list { field { default_value ""} } { append result "\n" return $result } ################################################################ # Ticket types list proc ticket_types {} { return { "Defect" "Enhancement Request" } } proc ticket_date_format {} { return "'Month dd, yyyy'" } proc ticket_status_types {} { return {"open" "waiting assignment" "need clarification" "development" "fixed waiting approval" "deferred" "closed" "reopened"} } proc ticket_severity_types {} { return [ad_parameter SeverityList "ticket"] } proc_doc severity_decode_list {} "produce a sort order on severity types for SQL query" { set i 0 foreach item [ticket_severity_types] { append str ",'$item',$i" incr i } return $str } # returns the default value of ticket_isseus.public_p for the ticket type. proc ticket_default_visibility { ticket_type } { switch $ticket_type { "Ticket" { return "t" } "Service Ticket" { return "t" } "Bug" { return "f" } "Feature Request" { return "t" } default { return "t" } } } # If any_p is 1, include a blank "any" item in the menu. proc ticket_html_select_ticket_type { { default_value "Ticket"} {any_p 0} } { if {$any_p} { set types [concat {""} [ticket_types]] } else { set types [ticket_types] } foreach item $types { if { $default_value == $item } { append result "\n" } else { append result "\n" } } return $result } proc ticket_type_html_for_select_menu {} { foreach item [ticket_types] { append result "\n" } return $result } proc ticket_project_select_menu { db } { set selection [ns_db select $db "select * from ticket_projects order by title asc"] set result "" while { [ns_db getrow $db $selection] } { set_variables_after_query append result "\n" } return $result } # Do user1 and user2 share a common group? proc common_group_p { db user1 user2 } { set selection [ns_db select $db "select group_id from users, user_group_map ug where ug.user_id = $user1 and users.user_id = $user1 intersect select group_id from users, user_group_map ug where ug.user_id = $user2 and users.user_id = $user2" ] set hits 0 while { [ns_db getrow $db $selection] } { set hits 1 ns_db flush $db break } return $hits } proc ticket_notification_checkbox { var val desc} { if {[string compare $val "t"] == 0} { return " $desc" } else { return " $desc" } } ################################################################ proc ticket_get_group_id {db user_id} { set groups [database_to_tcl_list $db "select group_id from user_group_map where user_id =$user_id"] return [lindex $groups 0] } ################################################################ ## Ticket search utilities # date entry widget that allows nulls proc ticket_dateentrywidget_with_nulls {column { value 0 } } { ns_share NS if { $value == 0 } { # no default, so use today set value [lindex [split [ns_localsqltimestamp] " "] 0] } set date_parts [split $value "-"] if { $value == "" } { set month "" set day "" set year "" } else { set date_parts [split $value "-"] set month [lindex $date_parts 1] set year [lindex $date_parts 0] set day [lindex $date_parts 2] } set output "  " return $output } proc_doc ticket_search_fragments {} "Returns the standard seach form for tickets." { uplevel { return "
Query String:
Ticket Title:
Creator First Name (or Email): Last Name:
Assigned To (First Name or Email): Last Name:
Closed By (First Name or Email): Last Name:
Contact Name:
Contact Info:
Ticket ID#:
Ticket Type:Ticket Status:Project:Priority:Severity:
Creation Date:
Greater than or equal to: [ticket_dateentrywidget_with_nulls creation_start [export_var creation_start]] Month-dd-yyyy
Less than or equal to: [ticket_dateentrywidget_with_nulls creation_end [export_var creation_end]] Month-dd-yyyy
Modification Date:
Greater than or equal to: [ticket_dateentrywidget_with_nulls modification_start [export_var modification_start]] Month-dd-yyyy
Less than or equal to: [ticket_dateentrywidget_with_nulls modification_end [export_var modification_end]] Month-dd-yyyy
Close Date:
Greater than or equal to: [ticket_dateentrywidget_with_nulls close_start [export_var close_start]] Month-dd-yyyy
Less than or equal to: [ticket_dateentrywidget_with_nulls close_end [export_var close_end]] Month-dd-yyyy
" } } proc_doc ticket_search_combine_and_build_error_list {} "For use with the ticket search. Combines date form fields and builds error list (exception_count, exception_text) for processing a search form." { uplevel { if [catch { ns_dbformvalue [ns_conn form] creation_start date creation_start} errmsg ] { incr exception_count append exception_text "
  • Invalid date for beginning creation date." } if [catch { ns_dbformvalue [ns_conn form] creation_end date creation_end} errmsg ] { incr exception_count append exception_text "
  • Invalid date for ending creation date." } if [catch { ns_dbformvalue [ns_conn form] modification_start date modification_start} errmsg ] { incr exception_count append exception_text "
  • Invalid date for beginning modification date." } if [catch { ns_dbformvalue [ns_conn form] modification_end date modification_end} errmsg ] { incr exception_count append exception_text "
  • Invalid date for ending modification date." } if [catch { ns_dbformvalue [ns_conn form] close_start date close_start} errmsg ] { incr exception_count append exception_text "
  • Invalid date for beginning close date." } if [catch { ns_dbformvalue [ns_conn form] close_end date close_end} errmsg ] { incr exception_count append exception_text "
  • Invalid date for ending close date." } } } proc_doc ticket_search_build_where_clause_and_description {} "For use with ticket search. Build search_clause_list (where clauses), search_description_items (search criteria in English)." { uplevel { set search_description_items [list] set search_clause_list [list] # build a simple boolean expression set text_query "" set text_query_explanation "" if { [info exists query_string_1] && ![empty_string_p $query_string_1] } { append text_query "upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_1%')" append text_query_explanation "Ticket contains \"$query_string_1\"" } if { [info exists conjunct_1] && [info exists conjunct_2] && ![empty_string_p $conjunct_1] && ![empty_string_p $query_string_2] } { if { $conjunct_1 == "and" } { append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_2%')" append text_query_explanation "and \"$query_string_2\"" } elseif { $conjunct_1 == "or" } { append text_query "or upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_2%')" append text_query_explanation "or \"$query_string_2\"" } elseif { $conjunct_1 == "and_not" } { append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) not like upper('%$QQquery_string_2%')" append text_query_explanation "and not \"$query_string_2\"" } } if { [info exists conjunct_2] && [info exists query_string_3] && ![empty_string_p $conjunct_2] && ![empty_string_p $query_string_3] } { if { $conjunct_2 == "and" } { append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_3%')" append text_query_explanation "and \"$query_string_3\"" } elseif { $conjunct_2 == "or" } { append text_query "or upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_3%')" append text_query_explanation "or \"$query_string_3\"" } elseif { $conjunct_2 == "and_not" } { append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) not like upper('%$QQquery_string_3%')" append text_query_explanation "and not \"$query_string_3\"" } } if {![empty_string_p $text_query]} { lappend search_clause_list "( $text_query )" lappend search_description_items $text_query_explanation } # build a simple boolean expression for title query set text_query "" set text_query_explanation "" if { [info exists title_string_1] && ![empty_string_p $title_string_1] } { append text_query "upper(one_line) like upper('%$QQtitle_string_1%')" append text_query_explanation "Ticket title contains \"$title_string_1\"" } if { [info exists title_conjunct_1] && [info exists title_string_2] && ![empty_string_p $title_conjunct_1] && ![empty_string_p $title_string_2] } { if { $title_conjunct_1 == "and" } { append text_query "and upper(one_line) like upper('%$QQtitle_string_2%')" append text_query_explanation "and \"$title_string_2\"" } elseif { $title_conjunct_1 == "or" } { append text_query "or upper(one_line) like upper('%$QQtitle_string_2%')" append text_query_explanation "or \"$title_string_2\"" } elseif { $title_conjunct_1 == "and_not" } { append text_query "and upper(one_line) not like upper('%$QQtitle_string_2%')" append text_query_explanation "and not \"$title_string_2\"" } } if { [info exists title_conjunct_2] && [info exists title_string_3] && ![empty_string_p $title_conjunct_2] && ![empty_string_p $title_string_3] } { if { $title_conjunct_2 == "and" } { append text_query "and upper(one_line) like upper('%$QQtitle_string_3%')" append text_query_explanation "and \"$title_string_3\"" } elseif { $title_conjunct_2 == "or" } { append text_query "or upper(one_line) like upper('%$QQtitle_string_3%')" append text_query_explanation "or \"$title_string_3\"" } elseif { $title_conjunct_2 == "and_not" } { append text_query "and upper(one_line) not like upper('%$QQtitle_string_3%')" append text_query_explanation "and not \"$title_string_3\"" } } if {![empty_string_p $text_query]} { lappend search_clause_list "( $text_query )" lappend search_description_items $text_query_explanation } # search by creator first name if { [info exists creator_fname] && ![empty_string_p $creator_fname] } { lappend search_clause_list "(lower(users.email) like '[string tolower [DoubleApos $creator_fname]]%' or lower(users.first_names) like '[string tolower [DoubleApos $creator_fname]]%')" lappend search_description_items "Creator first name or email starts with \"$creator_fname\"" } # search by creator last name if { [info exists creator_lname] && ![empty_string_p $creator_lname] } { lappend search_clause_list "(lower(users.last_name) like '[string tolower [DoubleApos $creator_lname]]%')" lappend search_description_items "Creator last name starts with \"$creator_lname\"" } # search by closer first name if { [info exists closer_fname] && ![empty_string_p $closer_fname] } { lappend search_clause_list "(lower(closer.email) like '[string tolower [DoubleApos $closer_fname]]%' or lower(closer.first_names) like '[string tolower [DoubleApos $closer_fname]]%')" lappend search_description_items "Closer first name or email starts with \"$closer_fname\"" } # search by closer last name if { [info exists closer_lname] && ![empty_string_p $closer_lname] } { lappend search_clause_list "(lower(closer.last_name) like '[string tolower [DoubleApos $closer_lname]]%')" lappend search_description_items "Closer last name starts with \"$closer_lname\"" } # search by assignee first name if { [info exists assigned_fname] && ![empty_string_p $assigned_fname] } { lappend search_description_items "Assigned first name or email starts with \"$assigned_fname\"" } # search by assignee last name if { [info exists assigned_lname] && ![empty_string_p $assigned_lname] } { lappend search_description_items "Assigned last name starts with \"$assigned_lname\"" } if { [info exists contact_name] && ![empty_string_p $contact_name] } { lappend search_clause_list "(lower(contact_name) like '%[string tolower [DoubleApos $contact_name]]%')" lappend search_description_items "Contact name contains \"$contact_name\"" } if { [info exists contact_info] && ![empty_string_p $contact_info] } { lappend search_clause_list "(lower(contact_info1) like '%[string tolower [DoubleApos $contact_info]]%')" lappend search_description_items "Contact info contains \"$contact_info\"" } # ticket id if { [info exists ticket_id] && ![empty_string_p $ticket_id] } { lappend search_clause_list "msg_id = $ticket_id" lappend search_description_items "Ticket # equals \"'[DoubleApos $ticket_id]'\"" } # ticket type if { [info exists ticket_type] && ![empty_string_p $ticket_type]} { set ticket_types [util_GetCheckboxValues [ns_getform] ticket_type] if {$ticket_types != 0} { foreach _tt $ticket_types { lappend ticket_type_list "ticket_type = '[DoubleApos $_tt]'" } lappend search_clause_list "([join $ticket_type_list { or }])" lappend search_description_items "Ticket type is one of [join $ticket_types {, }]" } } # ticket status if { [info exists status] && ![empty_string_p $status]} { set ticket_states [util_GetCheckboxValues [ns_getform] status] if {$ticket_states != 0} { foreach _tt $ticket_states { lappend ticket_status_list "status = '[DoubleApos $_tt]'" } lappend search_clause_list "([join $ticket_status_list { or }])" lappend search_description_items "Ticket status is one of [join $ticket_states {, }]" } } # project id if { [info exists project_id] && ![empty_string_p $project_id]} { set project_id_list [util_GetCheckboxValues [ns_getform] project_id] if {$project_id_list != 0} { foreach _tt $project_id_list { lappend ticket_project_id_list "ticket_issues.project_id = '[DoubleApos $_tt]'" } lappend search_clause_list "([join $ticket_project_id_list { or }])" lappend search_description_items "Ticket project_id is one of [join $project_id_list {, }]" } } # priority if { [info exists priority] && ![empty_string_p $priority]} { set priorities [util_GetCheckboxValues [ns_getform] priority] if {$priorities != 0} { foreach _tt $priorities { lappend ticket_priority_list "ticket_issues.priority = '[DoubleApos $_tt]'" } lappend search_clause_list "([join $ticket_priority_list { or }])" lappend search_description_items "Ticket priority is one of [join $priorities {, }]" } } # severity if { [info exists severity] && ![empty_string_p $severity]} { set severity_list [util_GetCheckboxValues [ns_getform] severity] if {$severity_list != 0} { foreach _tt $severity_list { lappend ticket_severity_list "ticket_issues.severity = '[DoubleApos $_tt]'" } lappend search_clause_list "([join $ticket_severity_list { or }])" lappend search_description_items "Ticket severity is one of [join $severity_list {, }]" } } # Creation date if { [info exists creation_start ] && ![empty_string_p $creation_start] } { lappend search_clause_list "trunc(posting_time) >= '$creation_start'" lappend search_description_items "Creation date after \"$creation_start\"" } if { [info exists creation_end ] && ![empty_string_p $creation_end] } { lappend search_clause_list "trunc(posting_time) <= '$creation_end'" lappend search_description_items "Creation date before \"$creation_end\"" } # Modification date if { [info exists modification_start ] && ![empty_string_p $modification_start] } { lappend search_clause_list "trunc(modification_time) >= '$modification_start'" lappend search_description_items "Modification date after \"$modification_start\"" } if { [info exists modification_end ] && ![empty_string_p $modification_end] } { lappend search_clause_list "trunc(modification_time) <= '$modification_end'" lappend search_description_items "Modification date before \"$modification_end\"" } # Close date if { [info exists close_start ] && ![empty_string_p $close_start] } { lappend search_clause_list "trunc(close_date) >= '$close_start'" lappend search_description_items "Close date after \"$close_start\"" } if { [info exists close_end ] && ![empty_string_p $close_end] } { lappend search_clause_list "trunc(close_date) <= '$close_end'" lappend search_description_items "Close date before \"$close_end\"" } } } ################################################################ ################################################################ # Send notification email # # Send email, with message regarding a ticket, to interested parties. # This includes any users assigned to the ticket, as well as # optionally the ticket author. proc send_ticket_change_notification {db msg_id message user_id notify_creator_p} { set ticket_email [ticket_reply_email_addr] set extra_headers [ns_set create] ns_set update $extra_headers "Reply-to" $ticket_email set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id, notify_p from ticket_issues, ticket_projects where ticket_issues.project_id = ticket_projects.project_id and msg_id = $msg_id"] set_variables_after_query set selection [ns_db 1row $db "select first_names || ' ' || last_name as poster_name, email as poster_email from users where user_id=$user_id"] set_variables_after_query set selection [ns_db select $db "select email as notify_email from users, ticket_assignments where project_id = $project_id and users.user_id = ticket_assignments.user_id and active_p = 't'"] # set url "[ns_conn location]/ticket" # cant use ns_conn in scheduled proc! JCD set url "[ad_url]/ticket" set msg_subject "New response to $one_line in project $title (TR#$msg_id)" set msg_content "Submitted By: $poster_name Description: $message Please use the URL below to manage this issue: $url/issue-view.tcl?msg_id=$msg_id " while { [ns_db getrow $db $selection] } { set_variables_after_query ns_sendmail $notify_email $poster_email $msg_subject $msg_content $extra_headers } # find the email address of the creator of the ticket if {$notify_creator_p == "t"} { set selection [ns_db 1row $db "select users.email as creator_email from users, ticket_issues where users.user_id=ticket_issues.user_id and msg_id = $msg_id"] set_variables_after_query ns_sendmail $creator_email $poster_email $msg_subject $msg_content $extra_headers } } proc min { n1 n2 } { if {$n1 < $n2} { return $n1 } else { return $n2 } } ################################################################ # util for sorting by fields in ticket listing proc toggle_order {field order_by} { if [string match "*desc" $order_by] { return $field } else { return "$field+desc" } } # Format an integer as a blank if it is zero (to clean up large tables) proc blank_zero {n} { if {$n == 0} { return "" } else { return $n } } ################################################3333 # # picklist stuff # default to returning a single custom data field for the "software build" proc ticket_picklist_data {} { set val [ad_parameter_all_values_as_list PicklistData ticket] if { [empty_string_p $val] || [llength $val] == 0 } { return {{build "Build" text data4 25}} } else { return $val } } # Util for displaying controls on ticket personal home page # # Displays a list of vars with a single one removed # proc ticket_control_vars {varname toggle_val vars msg {url ""}} { if {[empty_string_p $url]} { set url "index.tcl" } # Create a list of $vars with $var removed set lpos [lsearch $vars $varname] set _ctrl_vars [lreplace $vars $lpos $lpos] upvar $varname var if { [info exists var] && $var == $toggle_val } { return "$msg" } else { return "$msg\n" } } ################################################3333 # # Set a daemon to nag users who have open tickets which are # past their deadlines proc notify_overdue_tickets {} { # days between notifcations set nag_period 7 # We do *not* want bounced messages going to the ticket handler script set maintainer_email [ad_system_owner] set url "[ad_url]/ticket" set db_pools [ns_db gethandle subquery 2] set db [lindex $db_pools 0] set db2 [lindex $db_pools 1] set notified_msg_ids {} # loop over each user who has any assigned tickets, # finding all past-deadline tickets set selection [ns_db select $db "select distinct ua.user_id, ua.email from users_alertable ua, ticket_issue_assignments, users_preferences where ticket_issue_assignments.user_id = ua.user_id and ua.user_id = users_preferences.user_id and users_preferences.dont_spam_me_p = 'f' and ticket_issue_assignments.active_p = 't'"] if {[empty_string_p $selection]} { return } while { [ns_db getrow $db $selection] } { # For each user, find all past-due tickets, and make a summary message set msgs "" set_variables_after_query set sub_selection [ns_db select $db2 "select ti.msg_id, ti.one_line as summary, to_char(ti.modification_time, 'mm/dd/yy') as modification, to_char(ti.posting_time, 'mm/dd/yy') as creation, to_char(ti.deadline, 'mm/dd/yy') as deadline from ticket_issues ti, ticket_issue_assignments ta where ti.msg_id = ta.msg_id and ta.user_id = $user_id and ta.active_p = 't' and close_date is null and (last_notification is null or (sysdate() - last_notification) > 7) and deadline is not null and deadline < sysdate()"] while { [ns_db getrow $db2 $sub_selection] } { set_variables_after_subquery append msgs "Issue #$msg_id $summary\ndeadline was $deadline, created $creation, last modified $modification\n$url/issue-view.tcl?msg_id=$msg_id\n\n" lappend notified_msg_ids $msg_id } if {$msgs != ""} { set msgbody "The following issues assigned to you are still open and past their deadline:" append msgbody "\n\n$msgs" set extra_headers [ns_set create] ns_set update $extra_headers "Reply-to" $maintainer_email ns_sendmail $email $maintainer_email \ "Notification: Past due issues assigned to you" \ $msgbody $extra_headers ns_log Notice "sending ticket deadline alert email to $user_id $email" } } # update timestamp for these messages as having been notified if {[llength $notified_msg_ids] > 0} { ns_db dml $db "update ticket_issues set last_notification = sysdate() where msg_id in ([join $notified_msg_ids {,}])" } } ################################################################ # Scan for messages past deadline, and send alerts, once per day # # Notifications will only be sent once a week (as specified above) # for a given ticket and user, but the queue is scanned daily for # past-deadline tickets. ns_share -init {set overdue_ticket_alerts_installed 0} overdue_ticket_alerts_installed if {!$overdue_ticket_alerts_installed} { set overdue_ticket_alerts_installed 1 ns_log Notice "Scheduling notify_overdue_tickets" ns_schedule_daily -thread 3 30 notify_overdue_tickets } ################################################################ # Email queue handler # We depend on there being a default system user, in case we cannot # deduce the user_id from the incoming email message. # # We also use (or create) a project named "incoming" to exist so we can # place new issues there. # proc ticket_process_message {db message} { # We do *not* want bounced messages going to the ticket handler script set maintainer_email [ad_system_owner] # "medium" priority set default_priority 2 # extract the headers set from_addr "" set date "" set subject "" set msgbody "" set msg_id "" set reply_to "" # We want to grab headers for # Date: Thu, 11 Mar 1999 01:42:24 -0500 # From: Henry Minsky # Subject: Re: test message set parsed_msg [parse_email_message $message] set msgbody [ns_set iget $parsed_msg "message_body"] set from_header [ns_set iget $parsed_msg "from"] set subject_header [ns_set iget $parsed_msg "subject"] set date_header [ns_set iget $parsed_msg "date"] set reply_to [ns_set iget $parsed_msg "reply-to"] # look for address of form "From: foo@bar.com if {![regexp -nocase "(\[A-Za-z0-9._/%&!-\]+@\[A-Za-z0-9.-\]+)" $from_header from_line from_addr]} { regexp -nocase "(\[^<\]*)<(\[A-Za-z0-9._/%&!-\]+@\[A-Za-z0-9.-\]+)" $from_header from_line from_name from_addr } if {[empty_string_p $from_addr]} { ns_log Notice "process_ticket_message could not parse from_addr from incoming message header: |$from_header| message=|$message|" return } set subject $subject_header set subject_line "Subject: $subject_header" # Try to parse out a message id of the form "(TR#XXX)" regexp {TR#([0-9]*)} $subject_header match msg_id set date_line "Date: $date_header" # Make a cleaner looking mail message, just reconstruct a couple of the headers append msgtext "From: $from_header\n" if {![empty_string_p $reply_to]} { append msgtext "Reply-to: $reply_to\n" } append msgtext "$subject_line\n" append msgtext "$date_line\n" append msgtext "\n$msgbody" # We try to look up a user, based on their email address set user_id [database_to_tcl_string_or_null $db "select user_id from users where lower(email) = '[string tolower $from_addr]'"] # We need to have some default user_id we can use as the author of a ticket # if we can't guess the user id from the email message. # Here we try to find a "system" user: if {[empty_string_p $user_id]} { set user_id [default_ticket_admin_user $db] ns_log Notice "Could not find registered user $from_addr, using user_id=$user_id" } if {[empty_string_p $user_id]} { ns_sendmail [ad_system_owner] [ticket_reply_email_addr] "Could not find a good user id to use." "Could not deduce user id from email address, and could not find a default system user\n$msgbody" return } # Try to find a group associated with this user, to tag the # ticket with. set group_id_list [database_to_tcl_list $db "select umap.group_id from user_group_map umap, user_groups ug where umap.user_id = $user_id and ug.group_id = umap.group_id"] # we'll take the first group we find set group_id [lindex $group_id_list 0] set url "[ad_url]/ticket" # If msg_id is empty, then assume user is posting a new ticket. # Otherwise try to add this as a response to the existing ticket. set new_msg_p 0 if {[empty_string_p $msg_id]} { # We are creating a new ticket set new_msg_p 1 # Get or create the project named "incoming", to hold the new ticket set default_project_id [get_default_incoming_email_project_id $db] set message_in_html "
    [clean_up_html $msgtext]
    " set indexed_stuff "$subject $msgtext $from_addr" # Create a new ticket set new_id [database_to_tcl_string $db "select ticket_issue_id_sequence.nextval from dual"] ns_log Notice "creating new ticket id $new_id for message $message_in_html" ns_ora clob_dml $db "insert into ticket_issues (msg_id,project_id,user_id,group_id,status, ticket_type, severity, one_line,message,indexed_stuff,posting_time,priority, notify_p, deadline) values ($new_id,$default_project_id,$user_id,'$group_id','open', 'Ticket', 'normal','[DoubleApos $subject]',empty_clob(),empty_clob(),sysdate(),$default_priority,'t', '') returning message, indexed_stuff into :1, :2" $message_in_html $indexed_stuff } else { set selection [ns_db 0or1row $db "select one_line, title, ticket_issues.project_id, notify_p from ticket_issues, ticket_projects where ticket_issues.project_id = ticket_projects.project_id and msg_id = $msg_id"] if {[empty_string_p $selection]} { set new_msg_p 1 } else { set_variables_after_query set message_in_html "
    \n[clean_up_html $msgtext]\n
    " ns_log Notice "adding response for msg_id $msg_id: $message_in_html" set new_response_id [database_to_tcl_string $db "select ticket_response_id_sequence.nextval from dual"] ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values ($new_response_id,$msg_id,$user_id,empty_clob(),sysdate()) returning message into :1" $message_in_html ns_db dml $db "begin ticket_update_for_response($new_response_id); end;" } } # If this is a new ticket, send email to the originator with a URL # containing the new ticket number, so they can follow changes from the web, # and send notification to project members who are signed up for notification. # # else this is a followup, so notify assigned project members that a # followup has come in to an existing ticket. if {$new_msg_p} { set extra_headers [ns_set create] ns_set update $extra_headers "Reply-to" [ticket_reply_email_addr] ns_sendmail $from_addr $maintainer_email "$subject (TR\#$new_id)" "Submitted By: $from_addr Thank you for entering a new ticket. Description: $msgtext Please use $url/issue-view.tcl?msg_id=$new_id to manage this issue." $extra_headers } else { if { $notify_p == "t" } { set extra_headers [ns_set create] ns_set update $extra_headers "Reply-to" [ticket_reply_email_addr] set selection [ns_db 1row $db "select first_names || '' || last_name as poster_name, email as poster_email from users where user_id=$user_id"] set_variables_after_query set selection [ns_db select $db "select email as notify_email from users, ticket_assignments where project_id = $project_id and users.user_id = ticket_assignments.user_id and active_p = 't'"] while { [ns_db getrow $db $selection] } { set_variables_after_query ns_sendmail $notify_email $maintainer_email "New response to $one_line in project $title (TR\#$msg_id)" "Submitted By: $from_addr Description: $msgtext Please use $url/issue-view.tcl?msg_id=$msg_id to manage this issue." $extra_headers } } } } # Try to find or create a project named "Incoming", in which to create new # issues which are not responses to an existing ticket. proc get_default_incoming_email_project_id {db} { return [get_project_named $db "Incoming" 1] } # Attempt to find a default system user - looks for the user_id of the # system maintainer # returned by [ad_system_owner] proc find_default_system_user {db} { set user_id "" set selection [ns_db select $db "select user_id from users where email = '[ad_system_owner]'"] while { [ns_db getrow $db $selection] } { set_variables_after_query } return $user_id } # Update the last_modified field on a ticket. This must be done # before other things are modified in a ticket, because the # audit trail trigger in PL/SQL looks at the last_modified_by # field in order to know to whom to attribute changes in other # ticket fields to. proc update_last_modified_info {db msg_id} { # get current user's email, to export as the "last modified by" value set email [database_to_tcl_string $db "select email from users where user_id=[ad_get_user_id]"] ns_db dml $db "update ticket_issues set last_modified_by = '[DoubleApos $email]' where msg_id = $msg_id" } ################################################################## # # interface to the ad-new-stuff.tcl system ns_share ad_new_stuff_module_list if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list [ticket_system_name] 0] == -1 } { lappend ad_new_stuff_module_list [list [ticket_system_name] ticket_new_stuff] } proc_doc ticket_new_stuff {db since_when only_from_new_users_p purpose} "Only produces a report for the site administrator; the assumption is that random users won't want to see trouble tickets" { if { $purpose != "site_admin" } { return "" } if { $only_from_new_users_p == "t" } { set users_table "users_new" } else { set users_table "users" } set query "select ti.msg_id, ti.one_line, ut.email from ticket_issues ti, $users_table ut where posting_time > '$since_when' and ti.user_id = ut.user_id " set result_items "" set selection [ns_db select $db $query] while { [ns_db getrow $db $selection] } { set_variables_after_query append result_items "
  • $one_line (from $email)" } if { ![empty_string_p $result_items] } { return "\n" } else { return "" } } ################################################################## # # interface to the ad-user-contributions-summary.tcl system ns_share ad_user_contributions_summary_proc_list if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list [ticket_system_name] 0] == -1 } { lappend ad_user_contributions_summary_proc_list [list [ticket_system_name] ticket_user_contributions 0] } proc_doc ticket_user_contributions {db user_id purpose} {Returns list items, one for each bboard posting} { if { $purpose != "site_admin" } { return [list] } set selection [ns_db 0or1row $db "select count(tia.msg_id) as total, sum(case when status = 'closed' then 1 else 0 end) as closed, sum(case when status = 'closed' then 0 when status = 'deferred' then 0 when status = NULL then 0 else 1 end) as open, sum(case when status = 'deferred' then 1 else 0 end) as deferred, max(modification_time) as lastmod, min(posting_time) as oldest, sum(ticket_one_if_high_priority(priority, status)) as high_pri, sum(ticket_one_if_blocker(severity, status)) as blocker from ticket_issues ti, ticket_issue_assignments tia where tia.user_id = $user_id and ti.msg_id = tia.msg_id"] if { [empty_string_p $selection] } { return [list] } set_variables_after_query if { $total == 0 } { return [list] } set items "
  • Total tickets: $total ($closed closed; $open open; $deferred deferred)
  • Last modification: [util_AnsiDatetoPrettyDate $lastmod]
  • Oldest: [util_AnsiDatetoPrettyDate $oldest]

    Details: view the tickets\n" return [list 0 [ticket_system_name] "

    "] } util_report_successful_library_load