Update to support RT 4.4

Makefile.PL

@@ -4,8 +4,7 @@ RTx     'RT-Extension-ThreadByReference';
 license 'perl';
 repository 'https://github.com/akamai/rt-extension-threadbyreference';
 
-requires_rt '4.0.0';
-rt_too_new '4.4.0';
+requires_rt '4.4.0';
 
 sign;
 WriteAll;

lib/RT/Extension/ThreadByReference.pm

@@ -2,7 +2,7 @@ use strict;
 use warnings;
 package RT::Extension::ThreadByReference;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 NAME
 
@@ -20,7 +20,7 @@ to associate a message with.
 
 =head1 RT VERSION
 
-Works with RT 4.0 and greater.
+Works with RT 4.4 and greater.
 
 =head1 INSTALLATION
 
@@ -36,15 +36,14 @@ May need root permissions
 
 =item Edit your F</opt/rt4/etc/RT_SiteConfig.pm>
 
-If you are using RT 4.2 or greater, add this line:
+Add this line:
 
     Plugin('RT::Extension::ThreadByReference');
 
-For RT 4.0, add this line:
+Then make sure you load 'ThreadByReference' where you set MailPlugins.
+If you don't use this setting already, that's:
 
-    Set(@Plugins, qw(RT::Extension::ThreadByReference));
-
-or add C<RT::Extension::ThreadByReference> to your existing C<@Plugins> line.
+    Set(@MailPlugins, qw(ThreadByReference));
 
 =item Clear your mason cache
 
@@ -57,6 +56,7 @@ or add C<RT::Extension::ThreadByReference> to your existing C<@Plugins> line.
 =head1 AUTHOR
 
 Harlan Lieberman-Berg C<< <[email protected]> >>
+Brett Smith C<< <[email protected]> >>
 
 =head1 BUGS
 
@@ -71,6 +71,7 @@ or via the web at
 =head1 LICENSE
 
 Copyright (c) 2015-2016 by Akamai Technologies, Inc.
+Copyright (c) 2018 Brett Smith
 
 This software is free software; you can redistribute and/or modify it
 under the same terms as Perl itself.

lib/RT/Interface/Email/ThreadByReference.pm

@@ -3,77 +3,71 @@ package RT::Interface::Email::ThreadByReference;
 use strict;
 use warnings;
 
+use Role::Basic 'with';
+with 'RT::Interface::Email::Role';
+
 use RT::Interface::Email ();
 
-sub GetCurrentUser {
+sub BeforeDecrypt {
     $RT::Logger->debug("Entering ThreadByReference");
 
     my %args = (
 	Message       => undef,
-	RawMessageRef => undef,
-	CurrentUser   => undef,
-	AuthLevel     => undef,
-	Action        => undef,
-	Ticket        => undef,
+	RawMessage    => undef,
+	Actions       => undef,
 	Queue         => undef,
 	@_
 	);
 
-    if ($args{'Ticket'}->id) {
+    if (my $ticket_id = RT::Interface::Email::ExtractTicketId($args{'Message'})) {
 	$RT::Logger->debug(sprintf("Ticket %s already assigned.  You don't need my help!", 
-			   $args{'Ticket'}->id));
-	return ($args{'CurrentUser'}, $args{'AuthLevel'});
+			   $ticket_id));
+	return;
     }
 
-    $RT::Logger->debug(sprintf("Operating on queue %s", $args{'Queue'}));
-
-    my @messageids = FetchPossibleHeaders($args{'Message'});
+    my $head = $args{'Message'}->head();
+    my @messageids = FetchMessageReferences($head);
 
     unless (scalar @messageids >= 1) {
-	$RT::Logger->debug("Message contains no headers!");
-	return ($args{'CurrentUser'}, $args{'AuthLevel'});
+	$RT::Logger->debug("Message contains no references!");
+	return;
     }
 
     my %tickets = ();
     foreach my $messageid (@messageids) {
-	if (my $ids = MessageIdToTicket($messageid)) {
-	    foreach my $ticket ($ids) {
+	if (my @ticket_ids = MessageIdToTickets($messageid)) {
+	    foreach my $ticket (@ticket_ids) {
 		$tickets{$ticket} = undef;
 	    }
 	}
     }
 
-    my @tickets = sort(keys(%tickets));
-
-    if (scalar(@tickets) == 0) {
+    my @tickets = keys(%tickets);
+    my $ticket_count = scalar(@tickets);
+    if ($ticket_count == 0) {
 	$RT::Logger->debug("No tickets for references found.");
-	return ($args{'CurrentUser'}, $args{'AuthLevel'});
     }
-    elsif (scalar(@tickets) > 1) {
+    elsif ($ticket_count > 1) {
 	$RT::Logger->warning("Email maps to more than one ticket.");
 	$RT::Logger->warning(sprintf("Tickets: %s", @tickets));
     }
-
-    # We have the ticket.  Set it.
-    $RT::Logger->debug(sprintf("Threading email in ticket %s", $tickets[0]));
-    $args{'Ticket'}->Load($tickets[0]);
-
-    return ($args{'CurrentUser'}, $args{'AuthLevel'});
+    else {
+	$RT::Logger->debug(sprintf("Threading email in ticket %s", $tickets[0]));
+	my $subject = Encode::decode("UTF-8", $head->get('Subject') || '');
+	$head->replace('Subject', RT::Interface::Email::AddSubjectTag($subject, $tickets[0]));
+    }
 }
 
-sub FetchPossibleHeaders {
-    my $message = shift();
-
-    # The message is a MIME::Entity
-    my $head = $message->head();
+sub FetchMessageReferences {
+    my $head = shift();
 
     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 (my $refs = $head->get('References')) {
-	chomp();
+	chomp($refs);
 
 	foreach my $ref (split(/\s+/, $refs)) {
 	    $ref =~ /,?<([^>]+)>/;
@@ -90,7 +84,7 @@ sub FetchPossibleHeaders {
     return @msgids;
 }
 
-sub MessageIdToTicket {
+sub MessageIdToTickets {
     # Copied heavily from rt-references
     my $id = shift();
 
@@ -130,9 +124,14 @@ sub MessageIdToTicket {
 	VALUE => 'RT::Ticket'
 	);
 
-    my %tickets;
+    $RT::Logger->debug($attachments->BuildSelectQuery());
+    my %tickets = ();
     while (my $attach = $attachments->Next) {
-	$tickets{$attach->TransactionObj()->Ticket} = undef;
+	my $transaction = $attach->TransactionObj();
+	my $ticket_id = $transaction->Ticket();
+	$RT::Logger->debug(sprintf("Match for message <%s>: attachment %s, transaction %s, ticket %s",
+				   $id, $attach->id, $transaction->id, $ticket_id));
+	$tickets{$ticket_id} = undef;
     }
 
     return keys(%tickets);