callback::acs_mail_lite::incoming_email::impl::bug-tracker (private)

 callback::acs_mail_lite::incoming_email::impl::bug-tracker \
    -array array [ -package_id package_id ]

Defined in packages/bug-tracker/tcl/bug-tracker-callback-procs.tcl

a callback that posts a new ticket to a bug-tracker instance

Switches:
-array (required)
-package_id (optional)
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 ad_html_to_text ad_html_to_text (public) bug_tracker::bug::new bug_tracker::bug::new (public) bug_tracker::category_types bug_tracker::category_types (public) bug_tracker::components_get_options bug_tracker::components_get_options (public) bug_tracker::get_default_keyword bug_tracker::get_default_keyword (public) callback::acs_mail_lite::incoming_email::impl::bug-tracker callback::acs_mail_lite::incoming_email::impl::bug-tracker callback::acs_mail_lite::incoming_email::impl::bug-tracker->ad_html_to_text callback::acs_mail_lite::incoming_email::impl::bug-tracker->bug_tracker::bug::new callback::acs_mail_lite::incoming_email::impl::bug-tracker->bug_tracker::category_types callback::acs_mail_lite::incoming_email::impl::bug-tracker->bug_tracker::components_get_options callback::acs_mail_lite::incoming_email::impl::bug-tracker->bug_tracker::get_default_keyword

Testcases:
No testcase defined.
Source code:
    ::callback::acs_mail_lite::incoming_email::contract__arg_parser {*}$args

    upvar $array email

    ns_log Debug "acs_mail_lite::incoming_email -impl bug-tracker called. Recipient $email(to)"

    set regexp_str "^notification-bug-(\[0-9a-zA-Z\]+)\@"

    # check the format and extract necessary info
    if {![regexp $regexp_str $email(to) match email_post_id]} {
        set regexp_str "^tt-(\[0-9a-zA-Z\]+)\@"
        if {![regexp $regexp_str $email(to) match email_post_id]} {
            return ""
        }
    }

    set package_key bug-tracker

    set package_id_list [db_list get_package_ids {}]

    if {[llength $package_id_list] > 1} {
        ns_log Error "acs_mail_lite::incoming_email -impl bug-tracker found two bug tracker instances that has EmailPostID ${email_post_id}.  These are ${package_id_list}.  Bug entry creation failed."
        return ""
    } elseif {[llength $package_id_list] == 0} {
        ns_log Warning "acs_mail_lite::incoming_email -impl bug-tracker did not find any bug tracker instance with EmailPostID ${email_post_id}.  Bug entry creation failed."
        return ""
    } else {
        set package_id [lindex $package_id_list 0]

        set user_id [party::get_by_email -email $email(from)]
        if {$user_id eq ""} {
            # spam control
            return ""
        } elseif {![permission::permission_p -party_id $user_id -object_id $package_id -privilege create -no_login]} {
            # no rights
            return ""
        }

        template::util::list_of_lists_to_array $email(bodies) email_body

        if {[info exists email_body(text/html)] && $email_body(text/html) ne ""} {
            set body [ad_html_to_text -- $email_body(text/html)]
        } else {
            set body $email_body(text/plain)
        }

        # default mostly to blanks
        # improve on this later if we want to include
        # bug settings on the email

        set bug_id [db_nextval acs_object_id_seq]
        set components_list [bug_tracker::components_get_options -package_id $package_id]
        if {[llength $components_list] == 0} {
            set component_id {}
        } else {
            set component_id [lindex $components_list 0 1]
        }
        set found_in_version {}
        if {[llength $email(subject)] == 1} {
            set summary [lindex $email(subject) 0]
        } else {
            set summary $email(subject)
        }
        set keyword_ids {}
        foreach {category_id category_name} [bug_tracker::category_types -package_id $package_id] {
            lappend keyword_ids [bug_tracker::get_default_keyword -package_id $package_id -parent_id $category_id]
        }
        set fix_for_version {}
        set assign_to ""

ns_log notice "=== tcl/bug-tracker-callback-procs.tcl calls bug_tracker::bug::new  -bug_id $bug_id "
        bug_tracker::bug::new  -bug_id $bug_id  -package_id $package_id  -component_id $component_id  -found_in_version $found_in_version  -summary $summary  -description $body  -desc_format text/plain  -keyword_ids $keyword_ids  -fix_for_version $fix_for_version  -assign_to $assign_to  -user_id $user_id
    }
XQL Not present:
PostgreSQL, Oracle
Generic XQL file:
<fullquery name="callback::acs_mail_lite::incoming_email::impl::bug-tracker.get_package_ids">
    <querytext>
        select v.package_id
        from apm_parameters p,
             apm_parameter_values v
        where p.package_key = :package_key
              and p.parameter_name = 'EmailPostID'
              and p.parameter_id = v.parameter_id
              and v.attr_value = :email_post_id
    </querytext>
</fullquery>
packages/bug-tracker/tcl/bug-tracker-callback-procs.xql

[ hide source ] | [ make this the default ]
Show another procedure: