# 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 "
"
}
}
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 "
\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] "