First pass at transitioning rt-references to an extension.

2015-08-11 15:52:10 -04:00 · 2015-08-11 15:52:10 -04:00 · feff9084cd
commit feff9084cd
2 changed files with 147 additions and 0 deletions
--- a/.gitignore
+++ b/.gitignore
@ -0,0 +1 @@
+*~
--- a/lib/RT/Interface/Email/TryThreading.pm
+++ b/lib/RT/Interface/Email/TryThreading.pm
@ -0,0 +1,146 @@
+package RT::Interface::Email::TryThreading;
+
+use strict;
+use warnings;
+
+use RT::Interface::Email ();
+
+=head1 NAME
+
+RT::Interface::Email::TryThreading - Use In-Reply-To and other headers to try and find a ticket
+
+=cut
+
+sub GetCurrentUser {
+    $RT::Logger->debug("Entering TryThreading");
+
+    my %args = (
+	Message       => undef,
+	RawMessageRef => undef,
+	CurrentUser   => undef,
+	AuthLevel     => undef,
+	Action        => undef,
+	Ticket        => undef,
+	Queue         => undef,
+	@_
+	);
+
+    if ($args->{'Ticket'}) {
+	$RT::Logger->debug("Ticket %s already assigned.  You don't need my help!", 
+			   $args->{'Ticket'});
+	return ($args{'CurrentUser'}, $args{'AuthLevel'});
+    }
+
+    $RT::Logger->debug("Operating on queue %s", $args{'Queue'});
+
+    my @messageids = FetchPossibleHeaders($args{'Message'});
+
+    unless (scalar @messageids >= 1) {
+	$RT::Logger->debug("Message contains no headers!");
+	return ($args{'CurrentUser'}, $args{'AuthLevel'});
+    }
+
+    my %tickets = ();
+    foreach $messageid (@messageids) {
+	if (MessageIdToTicket($messageid)) {
+	    foreach $ticket ($_) {
+		$tickets{$ticket} = undef;
+	    }
+	}
+    }
+    
+    my @tickets = sort(keys(%tickets));
+
+    if (scalar(@tickets) == 0) {
+	$RT::Logger->debug("No tickets for references found.");
+	return ($args->{'CurrentUser'}, $args{'AuthLevel'});
+    }
+    elsif (scalar(@tickets) > 1) {
+	$RT::Logger->warning("Email maps to more than one ticket.");
+	$RT::Logger->warning("Tickets: %s", @tickets);
+    }
+
+    # We have the ticket.  Set it.
+    $RT::Logger->debug("Threading email in ticket %s", $tickets[0]);
+    $args{'Ticket'}->Load($tickets[0]);
+
+    return ($args->{'CurrentUser'}, $args{'AuthLevel'});
+}
+
+sub FetchPossibleHeaders ($message) {
+    my $message = shift();
+    
+    # The message is a MIME::Entity
+    my $head = $message->head();
+
+    my @msgids = ();
+
+    # There may be multiple references
+    # In practice, In-Reply-To seems to no longer be worth parsing, as
+    # it seems to usually just be a repeat of the References.
+    if ($head->get('References')) {
+	chomp();
+
+	foreach my $ref (split("\w+", $_)) {
+	    $ref =~ /,?<([^>]+)>/;
+	    if ($1) {
+		push(@msgids, $1);
+		$RT::Logger->debug("Found reference: %s", $1);
+	    }
+	    else {
+		$RT::Logger->debug("Reference with borked syntax: %s", $ref);
+		next;
+	    }
+	}
+    }
+}
+
+sub MessageIdToTicket ($id) {
+    # Copied heavily from rt-references
+
+    my $id = shift();
+
+    my $attachments = RT::Attachments->new($RT::SystemUser);
+    $attachments->Limit(
+	FIELD => 'MessageId',
+	OPERATOR => '=',
+	VALUE => $id
+	);
+    $attachments->Limit(
+	FIELD => 'Parent',
+	OPERATOR => '=',
+	VALUE => '0'
+	);
+
+    # Link attachments to their transactions, then transactions to
+    # their tickets.
+    my $trans = $attachments->NewAlias('Transactions');
+    my $tkts = $attachments->NewAlias('Tickets');
+    
+    $attachments->Join(
+	ALIAS1 => 'main',
+	FIELD1 => 'TransactionId',
+	ALIAS2 => $trans,
+	FIELD2 => 'id'
+	);
+    $attachments->Join(
+	ALIAS1 => $trans,
+	FIELD1 => 'ObjectID',
+	ALIAS2 => $tkts,
+	FIELD2 => 'id'
+	);
+    $attachments->Limit(
+	ALIAS => $trans,
+	FIELD => 'objecttype',
+	OPERATOR => '=',
+	VALUE => 'RT::Ticket'
+	);
+
+    my %tickets;
+    while (my $attach => $attachments->Next) {
+	$tickets{$attach->TransactionObj()->Ticket} = undef;
+    }
+
+    return keys(%tickets);
+}
+1;