[rt-devel] Draft patch to add references and in-reply-to parsing

[Petter Reinholdtsen]

[Petter Reinholdtsen, 2004-01-28]
> Continuing my stumble in the dark, I came up with this patch.  I
> still can not say I understand the DBIx::SearchBuilder API, but
> based on the example from Ruslan U. Zakirov I continued by adding
> the MessageId value and the loop to extract the ticket ids.

Based on this initial try, and some clues from the thread discussing
messageid parsing in RT::Attachment, I ended up with the following
patch to get what I wanted.  This patch is tested and found to work
fine.

If the patch is acceptable, please include it in a future version of
RT.  If it isn't acceptable, please let me know what is wrong with it.

The patch is relative to todays 3.2-RELEASE branch in subversion.

Index: lib/RT/Ticket_Overlay.pm
===================================================================
--- lib/RT/Ticket_Overlay.pm	(revision 1473)
+++ lib/RT/Ticket_Overlay.pm	(working copy)
@@ -291,6 +291,67 @@
 
 # }}}
 
+# {{{ sub LoadByMessageId
+
+=head2 LoadByMessageId
+
+Given a RFC 822 message id, loads the specified ticket.  If the
+message id is assosiated with several tickets, select the smallest
+ticket id.
+
+=cut
+
+sub LoadByMessageId {
+    my $self = shift;
+    my $MessageId = shift;
+
+    my $Attachs = RT::Attachments->new($RT::SystemUser);
+    $Attachs->Limit( FIELD => 'MessageId',
+                     OPERATOR => '=',
+                     VALUE => $MessageId
+                     );
+    $Attachs->Limit( FIELD => 'ContentType',
+                     OPERATOR => '=',
+                     VALUE => 'text/plain'
+                     );
+    $Attachs->Limit( FIELD => 'ContentType',
+                     OPERATOR => '=',
+                     VALUE => 'text/html'
+                     );
+    $Attachs->Limit( FIELD => 'Parent',
+                     OPERATOR => '=',
+                     VALUE => '0'
+                     );
+    my $trs = $Attachs->NewAlias('Transactions');
+    my $tis = $Attachs->NewAlias('Tickets');
+    $Attachs->Join( ALIAS1 => 'main',
+                    FIELD1 => 'TransactionId',
+                    ALIAS2 => $trs,
+                    FIELD2 => 'id'
+                    );
+    $Attachs->Join( ALIAS1 => $trs,
+                    FIELD1 => 'Ticket',
+                    ALIAS2 => $tis,
+                    FIELD2 => 'id'
+                    );
+    my %tickets = ();
+    while (my $attachment = $Attachs->Next) {
+        $tickets{$attachment->TransactionObj()->Ticket} = 1;
+    }
+    my @ids = sort { $a <=> $b } keys %tickets;
+    if (1 < @ids) {
+        $RT::Logger->info("Message ID $MessageId maps to several tickets.",
+                          "Selecting the first.");
+    }
+    if (@ids) {
+        return $self->Load($ids[0]);
+    } else {
+        return undef;
+    }
+}
+
+# }}}
+
 # {{{ sub Create
 
 =head2 Create (ARGS)
Index: lib/RT/Attachment_Overlay.pm
===================================================================
--- lib/RT/Attachment_Overlay.pm	(revision 1473)
+++ lib/RT/Attachment_Overlay.pm	(working copy)
@@ -153,6 +153,10 @@
     defined($Subject) or $Subject = '';
     chomp($Subject);
 
+    #Get the MessageID, or undef if not available
+    my $MessageId = $Attachment->head->get( 'message-id', 0 );
+    chomp($MessageId);
+
     #Get the filename
     my $Filename = $Attachment->head->recommended_filename || eval {
 	${ $Attachment->head->{mail_hdr_hash}{'Content-Disposition'}[0] }
@@ -167,6 +171,7 @@
             Parent        => 0,
             ContentType   => $Attachment->mime_type,
             Headers => $Attachment->head->as_string,
+            MessageId     => $MessageId,
             Subject => $Subject);
 
         foreach my $part ( $Attachment->parts ) {
@@ -198,6 +203,7 @@
                                        ContentEncoding => $ContentEncoding,
                                        Parent          => $args{'Parent'},
                                        Headers       =>  $Attachment->head->as_string, 
+                                       MessageId       => $MessageId,
                                        Subject       =>  $Subject,
                                        Content         => $Body,
                                        Filename => $Filename, );
Index: lib/RT/Interface/Email.pm
===================================================================
--- lib/RT/Interface/Email.pm	(revision 1473)
+++ lib/RT/Interface/Email.pm	(working copy)
@@ -271,6 +271,59 @@
     return $CurrentUser;
 }
 # }}}	    
+
+# {{{ sub ParseReferences
+
+sub ParseReferences {
+    my $head = shift;
+
+    # Based on info from <URL:http://www.jwz.org/doc/threading.html>
+    my @msgids = ();
+
+    my $references = $head->get('References') || '';
+    chomp($references);
+    my $inreplyto  = $head->get('In-Reply-To') || '';
+    chomp($inreplyto);
+
+    push(@msgids, split(/\s+/, $references)) if ($references);
+
+    if ($inreplyto) {
+        if ($inreplyto =~ m/(<[^>]+>)/) {
+            push(@msgids, $1);
+        } else {
+            $RT::Logger->info("Gateway: Unhandled In-Reply-To ".
+                               "format: '$inreplyto'");
+        }
+    }
+
+    # Map Message-id(s) to ticket id
+    my %tickets = ();
+    my %checked;
+    my $ticket = RT::Ticket->new($RT::SystemUser);
+    for my $MessageId (@msgids) {
+        next if $checked{$MessageId}; # Already looked up this message-id
+        my $ticketid = $ticket->LoadByMessageId($MessageId);
+        $tickets{$ticketid} = 1 if defined $ticketid;
+        $checked{$MessageId} = 1;
+    }
+
+    my @ticketids = sort keys %tickets;
+
+    # If the Message-id(s) are already in the database, use their
+    # ticked-id
+    if (1 < @ticketids) {
+        $RT::Logger->debug("Gateway: Several possible tickets: " .
+                           join(",", @ticketids) );
+    }
+
+    # Just pick the first.  Not sure how we should handle several
+    # ticket ids
+    return $ticketids[0] if (@ticketids);
+}
+
+# }}}
+
+
 # {{{ ParseCcAddressesFromHead 
 
 =head2 ParseCcAddressesFromHead HASHREF
@@ -471,6 +524,9 @@
 
     $args{'ticket'} ||= $parser->ParseTicketId($Subject);
 
+    # Check references headers if subject is missing ticket info
+    $args{'ticket'} ||= ParseReferences($head);
+
     my $SystemTicket;
     my $Right = 'CreateTicket';
     if ( $args{'ticket'} ) {