diff options
Diffstat (limited to 'rt/lib/RT/Action')
| -rw-r--r-- | rt/lib/RT/Action/CreateTickets.pm | 14 | ||||
| -rw-r--r-- | rt/lib/RT/Action/CreateTickets.pm.orig | 1292 | ||||
| -rwxr-xr-x | rt/lib/RT/Action/SendEmail.pm | 39 | ||||
| -rwxr-xr-x | rt/lib/RT/Action/SendEmail.pm.orig | 1131 |
4 files changed, 2448 insertions, 28 deletions
diff --git a/rt/lib/RT/Action/CreateTickets.pm b/rt/lib/RT/Action/CreateTickets.pm index e3c7b53e0..542cbd27b 100644 --- a/rt/lib/RT/Action/CreateTickets.pm +++ b/rt/lib/RT/Action/CreateTickets.pm @@ -579,15 +579,11 @@ sub _ParseMultilineTemplate { my %args = (@_); my $template_id; - require Encode; - require utf8; my ( $queue, $requestor ); $RT::Logger->debug("Line: ==="); foreach my $line ( split( /\n/, $args{'Content'} ) ) { $line =~ s/\r$//; - $RT::Logger->debug( "Line: " . utf8::is_utf8($line) - ? Encode::encode_utf8($line) - : $line ); + $RT::Logger->debug( "Line: $line" ); if ( $line =~ /^===/ ) { if ( $template_id && !$queue && $args{'Queue'} ) { $self->{'templates'}->{$template_id} @@ -790,10 +786,10 @@ sub ParseLines { ); if ( $args{content} ) { - my $mimeobj = MIME::Entity->new(); - $mimeobj->build( - Type => $args{'contenttype'} || 'text/plain', - Data => $args{'content'} + my $mimeobj = MIME::Entity->build( + Type => $args{'contenttype'} || 'text/plain', + Charset => 'UTF-8', + Data => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ], ); $ticketargs{MIMEObj} = $mimeobj; $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond'; diff --git a/rt/lib/RT/Action/CreateTickets.pm.orig b/rt/lib/RT/Action/CreateTickets.pm.orig new file mode 100644 index 000000000..e3c7b53e0 --- /dev/null +++ b/rt/lib/RT/Action/CreateTickets.pm.orig @@ -0,0 +1,1292 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +package RT::Action::CreateTickets; +use base 'RT::Action'; + +use strict; +use warnings; + +use MIME::Entity; + +=head1 NAME + +RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template + +=head1 SYNOPSIS + + ===Create-Ticket: codereview + Subject: Code review for {$Tickets{'TOP'}->Subject} + Depended-On-By: TOP + Content: Someone has created a ticket. you should review and approve it, + so they can finish their work + ENDOFCONTENT + +=head1 DESCRIPTION + +The CreateTickets ScripAction allows you to create automated workflows in RT, +creating new tickets in response to actions and conditions from other +tickets. + +=head2 Format + +CreateTickets uses the RT template configured in the scrip as a template +for an ordered set of tickets to create. The basic format is as follows: + + ===Create-Ticket: identifier + Param: Value + Param2: Value + Param3: Value + Content: Blah + blah + blah + ENDOFCONTENT + ===Create-Ticket: id2 + Param: Value + Content: Blah + ENDOFCONTENT + +As shown, you can put one or more C<===Create-Ticket:> sections in +a template. Each C<===Create-Ticket:> section is evaluated as its own +L<Text::Template> object, which means that you can embed snippets +of Perl inside the L<Text::Template> using C<{}> delimiters, but that +such sections absolutely can not span a C<===Create-Ticket:> boundary. + +Note that each C<Value> must come right after the C<Param> on the same +line. The C<Content:> param can extend over multiple lines, but the text +of the first line must start right after C<Content:>. Don't try to start +your C<Content:> section with a newline. + +After each ticket is created, it's stuffed into a hash called C<%Tickets> +making it available during the creation of other tickets during the +same ScripAction. The hash key for each ticket is C<create-[identifier]>, +where C<[identifier]> is the value you put after C<===Create-Ticket:>. The hash +is prepopulated with the ticket which triggered the ScripAction as +C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand +C<TOP>. + +A simple example: + + ===Create-Ticket: codereview + Subject: Code review for {$Tickets{'TOP'}->Subject} + Depended-On-By: TOP + Content: Someone has created a ticket. you should review and approve it, + so they can finish their work + ENDOFCONTENT + +A convoluted example: + + ===Create-Ticket: approval + { # Find out who the administrators of the group called "HR" + # of which the creator of this ticket is a member + my $name = "HR"; + + my $groups = RT::Groups->new(RT->SystemUser); + $groups->LimitToUserDefinedGroups(); + $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name"); + $groups->WithMember($TransactionObj->CreatorObj->Id); + + my $groupid = $groups->First->Id; + + my $adminccs = RT::Users->new(RT->SystemUser); + $adminccs->WhoHaveRight( + Right => "AdminGroup", + Object =>$groups->First, + IncludeSystemRights => undef, + IncludeSuperusers => 0, + IncludeSubgroupMembers => 0, + ); + + our @admins; + while (my $admin = $adminccs->Next) { + push (@admins, $admin->EmailAddress); + } + } + Queue: ___Approvals + Type: approval + AdminCc: {join ("\nAdminCc: ",@admins) } + Depended-On-By: TOP + Refers-To: TOP + Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject} + Due: {time + 86400} + Content-Type: text/plain + Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject} + Blah + Blah + ENDOFCONTENT + ===Create-Ticket: two + Subject: Manager approval + Type: approval + Depended-On-By: TOP + Refers-To: {$Tickets{"create-approval"}->Id} + Queue: ___Approvals + Content-Type: text/plain + Content: Your approval is requred for this ticket, too. + ENDOFCONTENT + +As shown above, you can include a block with Perl code to set up some +values for the new tickets. If you want to access a variable in the +template section after the block, you must scope it with C<our> rather +than C<my>. Just as with other RT templates, you can also include +Perl code in the template sections using C<{}>. + +=head2 Acceptable Fields + +A complete list of acceptable fields: + + * Queue => Name or id# of a queue + Subject => A text string + ! Status => A valid status. Defaults to 'new' + Due => Dates can be specified in seconds since the epoch + to be handled literally or in a semi-free textual + format which RT will attempt to parse. + Starts => + Started => + Resolved => + Owner => Username or id of an RT user who can and should own + this ticket; forces the owner if necessary + + Requestor => Email address + + Cc => Email address + + AdminCc => Email address + + RequestorGroup => Group name + + CcGroup => Group name + + AdminCcGroup => Group name + TimeWorked => + TimeEstimated => + TimeLeft => + InitialPriority => + FinalPriority => + Type => + +! DependsOn => + +! DependedOnBy => + +! RefersTo => + +! ReferredToBy => + +! Members => + +! MemberOf => + Content => Content. Can extend to multiple lines. Everything + within a template after a Content: header is treated + as content until we hit a line containing only + ENDOFCONTENT + ContentType => the content-type of the Content field. Defaults to + 'text/plain' + UpdateType => 'correspond' or 'comment'; used in conjunction with + 'content' if this is an update. Defaults to + 'correspond' + + CustomField-<id#> => custom field value + CF-name => custom field value + CustomField-name => custom field value + +Fields marked with an C<*> are required. + +Fields marked with a C<+> may have multiple values, simply +by repeating the fieldname on a new line with an additional value. + +Fields marked with a C<!> have processing postponed until after all +tickets in the same actions are created. Except for C<Status>, those +fields can also take a ticket name within the same action (i.e. +the identifiers after C<===Create-Ticket:>), instead of raw ticket ID +numbers. + +When parsed, field names are converted to lowercase and have hyphens stripped. +C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will +all be treated as the same thing. + +=head1 METHODS + +=cut + +my %LINKTYPEMAP = ( + MemberOf => { + Type => 'MemberOf', + Mode => 'Target', + }, + Parents => { + Type => 'MemberOf', + Mode => 'Target', + }, + Members => { + Type => 'MemberOf', + Mode => 'Base', + }, + Children => { + Type => 'MemberOf', + Mode => 'Base', + }, + HasMember => { + Type => 'MemberOf', + Mode => 'Base', + }, + RefersTo => { + Type => 'RefersTo', + Mode => 'Target', + }, + ReferredToBy => { + Type => 'RefersTo', + Mode => 'Base', + }, + DependsOn => { + Type => 'DependsOn', + Mode => 'Target', + }, + DependedOnBy => { + Type => 'DependsOn', + Mode => 'Base', + }, + +); + + +#Do what we need to do and send it out. +sub Commit { + my $self = shift; + + # Create all the tickets we care about + return (1) unless $self->TicketObj->Type eq 'ticket'; + + $self->CreateByTemplate( $self->TicketObj ); + $self->UpdateByTemplate( $self->TicketObj ); + return (1); +} + + + +sub Prepare { + my $self = shift; + + unless ( $self->TemplateObj ) { + $RT::Logger->warning("No template object handed to $self"); + } + + unless ( $self->TransactionObj ) { + $RT::Logger->warning("No transaction object handed to $self"); + + } + + unless ( $self->TicketObj ) { + $RT::Logger->warning("No ticket object handed to $self"); + + } + + my $active = 0; + if ( $self->TemplateObj->Type eq 'Perl' ) { + $active = 1; + } else { + RT->Logger->info(sprintf( + "Template #%d is type %s. You most likely want to use a Perl template instead.", + $self->TemplateObj->id, $self->TemplateObj->Type + )); + } + + $self->Parse( + Content => $self->TemplateObj->Content, + _ActiveContent => $active, + ); + return 1; + +} + + + +sub CreateByTemplate { + my $self = shift; + my $top = shift; + + $RT::Logger->debug("In CreateByTemplate"); + + my @results; + + # XXX: cargo cult programming that works. i'll be back. + + local %T::Tickets = %T::Tickets; + local $T::TOP = $T::TOP; + local $T::ID = $T::ID; + $T::Tickets{'TOP'} = $T::TOP = $top if $top; + local $T::TransactionObj = $self->TransactionObj; + + my $ticketargs; + my ( @links, @postponed ); + foreach my $template_id ( @{ $self->{'create_tickets'} } ) { + $RT::Logger->debug("Workflow: processing $template_id of $T::TOP") + if $T::TOP; + + $T::ID = $template_id; + @T::AllID = @{ $self->{'create_tickets'} }; + + ( $T::Tickets{$template_id}, $ticketargs ) + = $self->ParseLines( $template_id, \@links, \@postponed ); + + # Now we have a %args to work with. + # Make sure we have at least the minimum set of + # reasonable data and do our thang + + my ( $id, $transid, $msg ) + = $T::Tickets{$template_id}->Create(%$ticketargs); + + foreach my $res ( split( '\n', $msg ) ) { + push @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': ' + . $res; + } + if ( !$id ) { + if ( $self->TicketObj ) { + $msg = "Couldn't create related ticket $template_id for " + . $self->TicketObj->Id . " " + . $msg; + } else { + $msg = "Couldn't create ticket $template_id " . $msg; + } + + $RT::Logger->error($msg); + next; + } + + $RT::Logger->debug("Assigned $template_id with $id"); + $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj ) + if $self->TicketObj + && $T::Tickets{$template_id}->can('SetOriginObj'); + + } + + $self->PostProcess( \@links, \@postponed ); + + return @results; +} + +sub UpdateByTemplate { + my $self = shift; + my $top = shift; + + # XXX: cargo cult programming that works. i'll be back. + + my @results; + local %T::Tickets = %T::Tickets; + local $T::ID = $T::ID; + + my $ticketargs; + my ( @links, @postponed ); + foreach my $template_id ( @{ $self->{'update_tickets'} } ) { + $RT::Logger->debug("Update Workflow: processing $template_id"); + + $T::ID = $template_id; + @T::AllID = @{ $self->{'update_tickets'} }; + + ( $T::Tickets{$template_id}, $ticketargs ) + = $self->ParseLines( $template_id, \@links, \@postponed ); + + # Now we have a %args to work with. + # Make sure we have at least the minimum set of + # reasonable data and do our thang + + my @attribs = qw( + Subject + FinalPriority + Priority + TimeEstimated + TimeWorked + TimeLeft + Status + Queue + Due + Starts + Started + Resolved + ); + + my $id = $template_id; + $id =~ s/update-(\d+).*/$1/; + my ($loaded, $msg) = $T::Tickets{$template_id}->LoadById($id); + + unless ( $loaded ) { + $RT::Logger->error("Couldn't update ticket $template_id: " . $msg); + push @results, $self->loc( "Couldn't load ticket '[_1]'", $id ); + next; + } + + my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} ); + + $template_id =~ m/^update-(.*)/; + my $base_id = "base-$1"; + my $base = $self->{'templates'}->{$base_id}; + if ($base) { + $base =~ s/\r//g; + $base =~ s/\n+$//; + $current =~ s/\n+$//; + + # If we have no base template, set what we can. + if ( $base ne $current ) { + push @results, + "Could not update ticket " + . $T::Tickets{$template_id}->Id + . ": Ticket has changed"; + next; + } + } + push @results, $T::Tickets{$template_id}->Update( + AttributesRef => \@attribs, + ARGSRef => $ticketargs + ); + + if ( $ticketargs->{'Owner'} ) { + ($id, $msg) = $T::Tickets{$template_id}->SetOwner($ticketargs->{'Owner'}, "Force"); + push @results, $msg unless $msg eq $self->loc("That user already owns that ticket"); + } + + push @results, + $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs ); + + push @results, + $self->UpdateCustomFields( $T::Tickets{$template_id}, $ticketargs ); + + next unless $ticketargs->{'MIMEObj'}; + if ( $ticketargs->{'UpdateType'} =~ /^(private|comment)$/i ) { + my ( $Transaction, $Description, $Object ) + = $T::Tickets{$template_id}->Comment( + BccMessageTo => $ticketargs->{'Bcc'}, + MIMEObj => $ticketargs->{'MIMEObj'}, + TimeTaken => $ticketargs->{'TimeWorked'} + ); + push( @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) + . ': ' + . $Description ); + } elsif ( $ticketargs->{'UpdateType'} =~ /^(public|response|correspond)$/i ) { + my ( $Transaction, $Description, $Object ) + = $T::Tickets{$template_id}->Correspond( + BccMessageTo => $ticketargs->{'Bcc'}, + MIMEObj => $ticketargs->{'MIMEObj'}, + TimeTaken => $ticketargs->{'TimeWorked'} + ); + push( @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) + . ': ' + . $Description ); + } else { + push( + @results, + $T::Tickets{$template_id}->loc( + "Update type was neither correspondence nor comment.") + . " " + . $T::Tickets{$template_id}->loc("Update not recorded.") + ); + } + } + + $self->PostProcess( \@links, \@postponed ); + + return @results; +} + +=head2 Parse + +Takes (in order) template content, a default queue, a default requestor, and +active (a boolean flag). + +Parses a template in the template content, defaulting queue and requestor if +unspecified in the template to the values provided as arguments. + +If the active flag is true, then we'll use L<Text::Template> to parse the +templates, allowing you to embed active Perl in your templates. + +=cut + +sub Parse { + my $self = shift; + my %args = ( + Content => undef, + Queue => undef, + Requestor => undef, + _ActiveContent => undef, + @_ + ); + + if ( $args{'_ActiveContent'} ) { + $self->{'UsePerlTextTemplate'} = 1; + } else { + + $self->{'UsePerlTextTemplate'} = 0; + } + + if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) { + $self->_ParseMultilineTemplate(%args); + } elsif ( $args{'Content'} =~ /(?:\t|,)/i ) { + $self->_ParseXSVTemplate(%args); + } else { + RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}"); + } +} + +=head2 _ParseMultilineTemplate + +Parses mulitline templates. Things like: + + ===Create-Ticket: ... + +Takes the same arguments as L</Parse>. + +=cut + +sub _ParseMultilineTemplate { + my $self = shift; + my %args = (@_); + + my $template_id; + require Encode; + require utf8; + my ( $queue, $requestor ); + $RT::Logger->debug("Line: ==="); + foreach my $line ( split( /\n/, $args{'Content'} ) ) { + $line =~ s/\r$//; + $RT::Logger->debug( "Line: " . utf8::is_utf8($line) + ? Encode::encode_utf8($line) + : $line ); + if ( $line =~ /^===/ ) { + if ( $template_id && !$queue && $args{'Queue'} ) { + $self->{'templates'}->{$template_id} + .= "Queue: $args{'Queue'}\n"; + } + if ( $template_id && !$requestor && $args{'Requestor'} ) { + $self->{'templates'}->{$template_id} + .= "Requestor: $args{'Requestor'}\n"; + } + $queue = 0; + $requestor = 0; + } + if ( $line =~ /^===Create-Ticket: (.*)$/ ) { + $template_id = "create-$1"; + $RT::Logger->debug("**** Create ticket: $template_id"); + push @{ $self->{'create_tickets'} }, $template_id; + } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) { + $template_id = "update-$1"; + $RT::Logger->debug("**** Update ticket: $template_id"); + push @{ $self->{'update_tickets'} }, $template_id; + } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) { + $template_id = "base-$1"; + $RT::Logger->debug("**** Base ticket: $template_id"); + push @{ $self->{'base_tickets'} }, $template_id; + } elsif ( $line =~ /^===#.*$/ ) { # a comment + next; + } else { + if ( $line =~ /^Queue:(.*)/i ) { + $queue = 1; + my $value = $1; + $value =~ s/^\s//; + $value =~ s/\s$//; + if ( !$value && $args{'Queue'} ) { + $value = $args{'Queue'}; + $line = "Queue: $value"; + } + } + if ( $line =~ /^Requestors?:(.*)/i ) { + $requestor = 1; + my $value = $1; + $value =~ s/^\s//; + $value =~ s/\s$//; + if ( !$value && $args{'Requestor'} ) { + $value = $args{'Requestor'}; + $line = "Requestor: $value"; + } + } + $self->{'templates'}->{$template_id} .= $line . "\n"; + } + } + if ( $template_id && !$queue && $args{'Queue'} ) { + $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n"; + } + } + +sub ParseLines { + my $self = shift; + my $template_id = shift; + my $links = shift; + my $postponed = shift; + + my $content = $self->{'templates'}->{$template_id}; + + if ( $self->{'UsePerlTextTemplate'} ) { + + $RT::Logger->debug( + "Workflow: evaluating\n$self->{templates}{$template_id}"); + + my $template = Text::Template->new( + TYPE => 'STRING', + SOURCE => $content + ); + + my $err; + $content = $template->fill_in( + PACKAGE => 'T', + BROKEN => sub { + $err = {@_}->{error}; + } + ); + + $RT::Logger->debug("Workflow: yielding $content"); + + if ($err) { + $RT::Logger->error( "Ticket creation failed: " . $err ); + while ( my ( $k, $v ) = each %T::X ) { + $RT::Logger->debug( + "Eliminating $template_id from ${k}'s parents."); + delete $v->{$template_id}; + } + next; + } + } + + my $TicketObj ||= RT::Ticket->new( $self->CurrentUser ); + + my %args; + my %original_tags; + my @lines = ( split( /\n/, $content ) ); + while ( defined( my $line = shift @lines ) ) { + if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) { + my $value = $2; + my $original_tag = $1; + my $tag = lc($original_tag); + $tag =~ s/-//g; + $tag =~ s/^(requestor|cc|admincc)s?$/$1/i; + + $original_tags{$tag} = $original_tag; + + if ( ref( $args{$tag} ) ) + { #If it's an array, we want to push the value + push @{ $args{$tag} }, $value; + } elsif ( defined( $args{$tag} ) ) + { #if we're about to get a second value, make it an array + $args{$tag} = [ $args{$tag}, $value ]; + } else { #if there's nothing there, just set the value + $args{$tag} = $value; + } + + if ( $tag =~ /^content$/i ) { #just build up the content + # convert it to an array + $args{$tag} = defined($value) ? [ $value . "\n" ] : []; + while ( defined( my $l = shift @lines ) ) { + last if ( $l =~ /^ENDOFCONTENT\s*$/ ); + push @{ $args{'content'} }, $l . "\n"; + } + } else { + # if it's not content, strip leading and trailing spaces + if ( $args{$tag} ) { + $args{$tag} =~ s/^\s+//g; + $args{$tag} =~ s/\s+$//g; + } + if ( + ($tag =~ /^(requestor|cc|admincc)(group)?$/i + or grep {lc $_ eq $tag} keys %LINKTYPEMAP) + and $args{$tag} =~ /,/ + ) { + $args{$tag} = [ split /,\s*/, $args{$tag} ]; + } + } + } + } + + foreach my $date (qw(due starts started resolved)) { + my $dateobj = RT::Date->new( $self->CurrentUser ); + next unless $args{$date}; + if ( $args{$date} =~ /^\d+$/ ) { + $dateobj->Set( Format => 'unix', Value => $args{$date} ); + } else { + eval { + $dateobj->Set( Format => 'iso', Value => $args{$date} ); + }; + if ($@ or $dateobj->Unix <= 0) { + $dateobj->Set( Format => 'unknown', Value => $args{$date} ); + } + } + $args{$date} = $dateobj->ISO; + } + + foreach my $role (qw(requestor cc admincc)) { + next unless my $value = $args{ $role . 'group' }; + + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadUserDefinedGroup( $value ); + unless ( $group->id ) { + $RT::Logger->error("Couldn't load group '$value'"); + next; + } + + $args{ $role } = $args{ $role } ? [$args{ $role }] : [] + unless ref $args{ $role }; + push @{ $args{ $role } }, $group->PrincipalObj->id; + } + + $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses + if $self->TicketObj; + + $args{'type'} ||= 'ticket'; + + my %ticketargs = ( + Queue => $args{'queue'}, + Subject => $args{'subject'}, + Status => $args{'status'} || 'new', + Due => $args{'due'}, + Starts => $args{'starts'}, + Started => $args{'started'}, + Resolved => $args{'resolved'}, + Owner => $args{'owner'}, + Requestor => $args{'requestor'}, + Cc => $args{'cc'}, + AdminCc => $args{'admincc'}, + TimeWorked => $args{'timeworked'}, + TimeEstimated => $args{'timeestimated'}, + TimeLeft => $args{'timeleft'}, + InitialPriority => $args{'initialpriority'} || 0, + FinalPriority => $args{'finalpriority'} || 0, + SquelchMailTo => $args{'squelchmailto'}, + Type => $args{'type'}, + $self->Rules + ); + + if ( $args{content} ) { + my $mimeobj = MIME::Entity->new(); + $mimeobj->build( + Type => $args{'contenttype'} || 'text/plain', + Data => $args{'content'} + ); + $ticketargs{MIMEObj} = $mimeobj; + $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond'; + } + + foreach my $tag ( keys(%args) ) { + # if the tag was added later, skip it + my $orig_tag = $original_tags{$tag} or next; + if ( $orig_tag =~ /^customfield-?(\d+)$/i ) { + $ticketargs{ "CustomField-" . $1 } = $args{$tag}; + } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) { + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} ); + $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id; + next unless $cf->id; + $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; + } elsif ($orig_tag) { + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} ); + $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id; + next unless $cf->id; + $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; + + } + } + + $self->GetDeferred( \%args, $template_id, $links, $postponed ); + + return $TicketObj, \%ticketargs; +} + + +=head2 _ParseXSVTemplate + +Parses a tab or comma delimited template. Should only ever be called by +L</Parse>. + +=cut + +sub _ParseXSVTemplate { + my $self = shift; + my %args = (@_); + + use Regexp::Common qw(delimited); + my($first, $content) = split(/\r?\n/, $args{'Content'}, 2); + + my $delimiter; + if ( $first =~ /\t/ ) { + $delimiter = "\t"; + } else { + $delimiter = ','; + } + my @fields = split( /$delimiter/, $first ); + + my $delimiter_re = qr[$delimiter]; + my $justquoted = qr[$RE{quoted}]; + + # Used to generate automatic template ids + my $autoid = 1; + + LINE: + while ($content) { + $content =~ s/^(\s*\r?\n)+//; + + # Keep track of Queue and Requestor, so we can provide defaults + my $queue; + my $requestor; + + # The template for this line + my $template; + + # What column we're on + my $i = 0; + + # If the last iteration was the end of the line + my $EOL = 0; + + # The template id + my $template_id; + + COLUMN: + while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) { + $EOL = not $2; + + # Strip off quotes, if they exist + my $value = $1; + if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) { + substr( $value, 0, 1 ) = ""; + substr( $value, -1, 1 ) = ""; + } + + # What column is this? + my $field = $fields[$i++]; + next COLUMN unless $field =~ /\S/; + $field =~ s/^\s//; + $field =~ s/\s$//; + + if ( $field =~ /^id$/i ) { + # Special case if this is the ID column + if ( $value =~ /^\d+$/ ) { + $template_id = 'update-' . $value; + push @{ $self->{'update_tickets'} }, $template_id; + } elsif ( $value =~ /^#base-(\d+)$/ ) { + $template_id = 'base-' . $1; + push @{ $self->{'base_tickets'} }, $template_id; + } elsif ( $value =~ /\S/ ) { + $template_id = 'create-' . $value; + push @{ $self->{'create_tickets'} }, $template_id; + } + } else { + # Some translations + if ( $field =~ /^Body$/i + || $field =~ /^Data$/i + || $field =~ /^Message$/i ) + { + $field = 'Content'; + } elsif ( $field =~ /^Summary$/i ) { + $field = 'Subject'; + } elsif ( $field =~ /^Queue$/i ) { + # Note that we found a queue + $queue = 1; + $value ||= $args{'Queue'}; + } elsif ( $field =~ /^Requestors?$/i ) { + $field = 'Requestor'; # Remove plural + # Note that we found a requestor + $requestor = 1; + $value ||= $args{'Requestor'}; + } + + # Tack onto the end of the template + $template .= $field . ": "; + $template .= (defined $value ? $value : ""); + $template .= "\n"; + $template .= "ENDOFCONTENT\n" + if $field =~ /^Content$/i; + } + } + + # Ignore blank lines + next unless $template; + + # If we didn't find a queue of requestor, tack on the defaults + if ( !$queue && $args{'Queue'} ) { + $template .= "Queue: $args{'Queue'}\n"; + } + if ( !$requestor && $args{'Requestor'} ) { + $template .= "Requestor: $args{'Requestor'}\n"; + } + + # If we never found an ID, come up with one + unless ($template_id) { + $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"}; + $template_id = "create-auto-$autoid"; + # Also, it's a ticket to create + push @{ $self->{'create_tickets'} }, $template_id; + } + + # Save the template we generated + $self->{'templates'}->{$template_id} = $template; + + } +} + +sub GetDeferred { + my $self = shift; + my $args = shift; + my $id = shift; + my $links = shift; + my $postponed = shift; + + # Deferred processing + push @$links, + ( + $id, + { DependsOn => $args->{'dependson'}, + DependedOnBy => $args->{'dependedonby'}, + RefersTo => $args->{'refersto'}, + ReferredToBy => $args->{'referredtoby'}, + Children => $args->{'children'}, + Parents => $args->{'parents'}, + } + ); + + push @$postponed, ( + + # Status is postponed so we don't violate dependencies + $id, { Status => $args->{'status'}, } + ); +} + +sub GetUpdateTemplate { + my $self = shift; + my $t = shift; + + my $string; + $string .= "Queue: " . $t->QueueObj->Name . "\n"; + $string .= "Subject: " . $t->Subject . "\n"; + $string .= "Status: " . $t->Status . "\n"; + $string .= "UpdateType: correspond\n"; + $string .= "Content: \n"; + $string .= "ENDOFCONTENT\n"; + $string .= "Due: " . $t->DueObj->AsString . "\n"; + $string .= "Starts: " . $t->StartsObj->AsString . "\n"; + $string .= "Started: " . $t->StartedObj->AsString . "\n"; + $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n"; + $string .= "Owner: " . $t->OwnerObj->Name . "\n"; + $string .= "Requestor: " . $t->RequestorAddresses . "\n"; + $string .= "Cc: " . $t->CcAddresses . "\n"; + $string .= "AdminCc: " . $t->AdminCcAddresses . "\n"; + $string .= "TimeWorked: " . $t->TimeWorked . "\n"; + $string .= "TimeEstimated: " . $t->TimeEstimated . "\n"; + $string .= "TimeLeft: " . $t->TimeLeft . "\n"; + $string .= "InitialPriority: " . $t->Priority . "\n"; + $string .= "FinalPriority: " . $t->FinalPriority . "\n"; + + foreach my $type ( sort keys %LINKTYPEMAP ) { + + # don't display duplicates + if ( $type eq "HasMember" + || $type eq "Members" + || $type eq "MemberOf" ) + { + next; + } + $string .= "$type: "; + + my $mode = $LINKTYPEMAP{$type}->{Mode}; + my $method = $LINKTYPEMAP{$type}->{Type}; + + my $links = ''; + while ( my $link = $t->$method->Next ) { + $links .= ", " if $links; + + my $object = $mode . "Obj"; + my $member = $link->$object; + $links .= $member->Id if $member; + } + $string .= $links; + $string .= "\n"; + } + + return $string; +} + +sub GetBaseTemplate { + my $self = shift; + my $t = shift; + + my $string; + $string .= "Queue: " . $t->Queue . "\n"; + $string .= "Subject: " . $t->Subject . "\n"; + $string .= "Status: " . $t->Status . "\n"; + $string .= "Due: " . $t->DueObj->Unix . "\n"; + $string .= "Starts: " . $t->StartsObj->Unix . "\n"; + $string .= "Started: " . $t->StartedObj->Unix . "\n"; + $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n"; + $string .= "Owner: " . $t->Owner . "\n"; + $string .= "Requestor: " . $t->RequestorAddresses . "\n"; + $string .= "Cc: " . $t->CcAddresses . "\n"; + $string .= "AdminCc: " . $t->AdminCcAddresses . "\n"; + $string .= "TimeWorked: " . $t->TimeWorked . "\n"; + $string .= "TimeEstimated: " . $t->TimeEstimated . "\n"; + $string .= "TimeLeft: " . $t->TimeLeft . "\n"; + $string .= "InitialPriority: " . $t->Priority . "\n"; + $string .= "FinalPriority: " . $t->FinalPriority . "\n"; + + return $string; +} + +sub GetCreateTemplate { + my $self = shift; + + my $string; + + $string .= "Queue: General\n"; + $string .= "Subject: \n"; + $string .= "Status: new\n"; + $string .= "Content: \n"; + $string .= "ENDOFCONTENT\n"; + $string .= "Due: \n"; + $string .= "Starts: \n"; + $string .= "Started: \n"; + $string .= "Resolved: \n"; + $string .= "Owner: \n"; + $string .= "Requestor: \n"; + $string .= "Cc: \n"; + $string .= "AdminCc:\n"; + $string .= "TimeWorked: \n"; + $string .= "TimeEstimated: \n"; + $string .= "TimeLeft: \n"; + $string .= "InitialPriority: \n"; + $string .= "FinalPriority: \n"; + + foreach my $type ( keys %LINKTYPEMAP ) { + + # don't display duplicates + if ( $type eq "HasMember" + || $type eq 'Members' + || $type eq 'MemberOf' ) + { + next; + } + $string .= "$type: \n"; + } + return $string; +} + +sub UpdateWatchers { + my $self = shift; + my $ticket = shift; + my $args = shift; + + my @results; + + foreach my $type (qw(Requestor Cc AdminCc)) { + my $method = $type . 'Addresses'; + my $oldaddr = $ticket->$method; + + # Skip unless we have a defined field + next unless defined $args->{$type}; + my $newaddr = $args->{$type}; + + my @old = split( /,\s*/, $oldaddr ); + my @new; + for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) { + # Sometimes these are email addresses, sometimes they're + # users. Try to guess which is which, as we want to deal + # with email addresses if at all possible. + if (/^\S+@\S+$/) { + push @new, $_; + } else { + # It doesn't look like an email address. Try to load it. + my $user = RT::User->new($self->CurrentUser); + $user->Load($_); + if ($user->Id) { + push @new, $user->EmailAddress; + } else { + push @new, $_; + } + } + } + + my %oldhash = map { $_ => 1 } @old; + my %newhash = map { $_ => 1 } @new; + + my @add = grep( !defined $oldhash{$_}, @new ); + my @delete = grep( !defined $newhash{$_}, @old ); + + foreach (@add) { + my ( $val, $msg ) = $ticket->AddWatcher( + Type => $type, + Email => $_ + ); + + push @results, + $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg; + } + + foreach (@delete) { + my ( $val, $msg ) = $ticket->DeleteWatcher( + Type => $type, + Email => $_ + ); + push @results, + $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg; + } + } + return @results; +} + +sub UpdateCustomFields { + my $self = shift; + my $ticket = shift; + my $args = shift; + + my @results; + foreach my $arg (keys %{$args}) { + next unless $arg =~ /^CustomField-(\d+)$/; + my $cf = $1; + + my $CustomFieldObj = RT::CustomField->new($self->CurrentUser); + $CustomFieldObj->SetContextObject( $ticket ); + $CustomFieldObj->LoadById($cf); + + my @values; + if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext + @values = ($args->{$arg}); + } else { + @values = split /\n/, $args->{$arg}; + } + + if ( ($CustomFieldObj->Type eq 'Freeform' + && ! $CustomFieldObj->SingleValue) || + $CustomFieldObj->Type =~ /text/i) { + foreach my $val (@values) { + $val =~ s/\r//g; + } + } + + foreach my $value (@values) { + next unless length($value); + my ( $val, $msg ) = $ticket->AddCustomFieldValue( + Field => $cf, + Value => $value + ); + push ( @results, $msg ); + } + } + return @results; +} + +sub PostProcess { + my $self = shift; + my $links = shift; + my $postponed = shift; + + # postprocessing: add links + + while ( my $template_id = shift(@$links) ) { + my $ticket = $T::Tickets{$template_id}; + $RT::Logger->debug( "Handling links for " . $ticket->Id ); + my %args = %{ shift(@$links) }; + + foreach my $type ( keys %LINKTYPEMAP ) { + next unless ( defined $args{$type} ); + foreach my $link ( + ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) + { + next unless $link; + + if ( $link =~ /^TOP$/i ) { + $RT::Logger->debug( "Building $type link for $link: " + . $T::Tickets{TOP}->Id ); + $link = $T::Tickets{TOP}->Id; + + } elsif ( $link !~ m/^\d+$/ ) { + my $key = "create-$link"; + if ( !exists $T::Tickets{$key} ) { + $RT::Logger->debug( + "Skipping $type link for $key (non-existent)"); + next; + } + $RT::Logger->debug( "Building $type link for $link: " + . $T::Tickets{$key}->Id ); + $link = $T::Tickets{$key}->Id; + } else { + $RT::Logger->debug("Building $type link for $link"); + } + + my ( $wval, $wmsg ) = $ticket->AddLink( + Type => $LINKTYPEMAP{$type}->{'Type'}, + $LINKTYPEMAP{$type}->{'Mode'} => $link, + Silent => 1 + ); + + $RT::Logger->warning("AddLink thru $link failed: $wmsg") + unless $wval; + + # push @non_fatal_errors, $wmsg unless ($wval); + } + + } + } + + # postponed actions -- Status only, currently + while ( my $template_id = shift(@$postponed) ) { + my $ticket = $T::Tickets{$template_id}; + $RT::Logger->debug( "Handling postponed actions for " . $ticket->id ); + my %args = %{ shift(@$postponed) }; + $ticket->SetStatus( $args{Status} ) if defined $args{Status}; + } + +} + +sub Options { + my $self = shift; + my $queues = RT::Queues->new($self->CurrentUser); + $queues->UnLimit; + my @names; + while (my $queue = $queues->Next) { + push @names, $queue->Id, $queue->Name; + } + return ( + { + 'name' => 'Queue', + 'label' => 'In queue', + 'type' => 'select', + 'options' => \@names + } + ) +} + +RT::Base->_ImportOverlays(); + +1; + diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index 0f11cc141..a483fba9f 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -258,7 +258,7 @@ sub Bcc { sub AddressesFromHeader { my $self = shift; my $field = shift; - my $header = $self->TemplateObj->MIMEObj->head->get($field); + my $header = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field)); my @addresses = Email::Address->parse($header); return (@addresses); @@ -277,7 +277,7 @@ sub SendMessage { # ability to pass @_ to a 'post' routine. my ( $self, $MIMEObj ) = @_; - my $msgid = $MIMEObj->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') ); chomp $msgid; $self->ScripActionObj->{_Message_ID}++; @@ -300,7 +300,7 @@ sub SendMessage { my $success = $msgid . " sent "; foreach (@EMAIL_RECIPIENT_HEADERS) { - my $recipients = $MIMEObj->head->get($_); + my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) ); $success .= " $_: " . $recipients if $recipients; } @@ -531,7 +531,7 @@ sub RecordOutgoingMailTransaction { $type = 'EmailRecord'; } - my $msgid = $MIMEObj->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') ); chomp $msgid; my ( $id, $msg ) = $transaction->Create( @@ -649,7 +649,7 @@ sub DeferDigestRecipients { # Have to get the list of addresses directly from the MIME header # at this point. - $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) ); foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { next unless $rcpt; my $user_obj = RT::User->new(RT->SystemUser); @@ -746,7 +746,7 @@ sub RemoveInappropriateRecipients { # If there are no recipients, don't try to send the message. # If the transaction has content and has the header RT-Squelch-Replies-To - my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') ); if ( my $attachment = $self->TransactionObj->Attachments->First ) { if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { @@ -922,7 +922,8 @@ sub GetFriendlyName { =head2 SetHeader FIELD, VALUE -Set the FIELD of the current MIME object into VALUE. +Set the FIELD of the current MIME object into VALUE, which should be in +characters, not bytes. Returns the new header, in bytes. =cut @@ -935,7 +936,7 @@ sub SetHeader { chomp $field; my $head = $self->TemplateObj->MIMEObj->head; $head->fold_length( $field, 10000 ); - $head->replace( $field, $val ); + $head->replace( $field, Encode::encode( "UTF-8", $val ) ); return $head->get($field); } @@ -976,7 +977,7 @@ sub SetSubject { $subject =~ s/(\r\n|\n|\s)/ /g; - $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + $self->SetHeader( 'Subject', $subject ); } @@ -992,11 +993,9 @@ sub SetSubjectToken { my $head = $self->TemplateObj->MIMEObj->head; $self->SetHeader( Subject => - Encode::encode_utf8( - RT::Interface::Email::AddSubjectTag( - Encode::decode_utf8( $head->get('Subject') ), - $self->TicketObj, - ), + RT::Interface::Email::AddSubjectTag( + Encode::decode( "UTF-8", $head->get('Subject') ), + $self->TicketObj, ), ); } @@ -1090,7 +1089,8 @@ sub PseudoReference { =head2 SetHeaderAsEncoding($field_name, $charset_encoding) -This routine converts the field into specified charset encoding. +This routine converts the field into specified charset encoding, then +applies the MIME-Header transfer encoding. =cut @@ -1101,12 +1101,12 @@ sub SetHeaderAsEncoding { my $head = $self->TemplateObj->MIMEObj->head; if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { - $head->replace( $field, RT->Config->Get('SMTPFrom') ); + $head->replace( $field, Encode::encode( "UTF-8", RT->Config->Get('SMTPFrom') ) ); return; } - my $value = $head->get( $field ); - $value = $self->MIMEEncodeString( $value, $enc ); + my $value = Encode::decode("UTF-8", $head->get( $field )); + $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes $head->replace( $field, $value ); } @@ -1116,7 +1116,8 @@ sub SetHeaderAsEncoding { Takes a perl string and optional encoding pass it over L<RT::Interface::Email/EncodeToMIME>. -Basicly encode a string using B encoding according to RFC2047. +Basicly encode a string using B encoding according to RFC2047, returning +bytes. =cut diff --git a/rt/lib/RT/Action/SendEmail.pm.orig b/rt/lib/RT/Action/SendEmail.pm.orig new file mode 100755 index 000000000..0f11cc141 --- /dev/null +++ b/rt/lib/RT/Action/SendEmail.pm.orig @@ -0,0 +1,1131 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +# Portions Copyright 2000 Tobias Brox <tobix@cpan.org> + +package RT::Action::SendEmail; + +use strict; +use warnings; + +use base qw(RT::Action); + +use RT::EmailParser; +use RT::Interface::Email; +use Email::Address; +our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc); + + +=head1 NAME + +RT::Action::SendEmail - An Action which users can use to send mail +or can subclassed for more specialized mail sending behavior. +RT::Action::AutoReply is a good example subclass. + +=head1 SYNOPSIS + + use base 'RT::Action::SendEmail'; + +=head1 DESCRIPTION + +Basically, you create another module RT::Action::YourAction which ISA +RT::Action::SendEmail. + +=head1 METHODS + +=head2 CleanSlate + +Cleans class-wide options, like L</AttachTickets>. + +=cut + +sub CleanSlate { + my $self = shift; + $self->AttachTickets(undef); +} + +=head2 Commit + +Sends the prepared message and writes outgoing record into DB if the feature is +activated in the config. + +=cut + +sub Commit { + my $self = shift; + + return abs $self->SendMessage( $self->TemplateObj->MIMEObj ) + unless RT->Config->Get('RecordOutgoingEmail'); + + $self->DeferDigestRecipients(); + my $message = $self->TemplateObj->MIMEObj; + + my $orig_message; + $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt( + Attachment => $self->TransactionObj->Attachments->First, + Ticket => $self->TicketObj, + ); + + my ($ret) = $self->SendMessage($message); + return abs( $ret ) if $ret <= 0; + + if ($orig_message) { + $message->attach( + Type => 'application/x-rt-original-message', + Disposition => 'inline', + Data => $orig_message->as_string, + ); + } + $self->RecordOutgoingMailTransaction($message); + $self->RecordDeferredRecipients(); + return 1; +} + +=head2 Prepare + +Builds an outgoing email we're going to send using scrip's template. + +=cut + +sub Prepare { + my $self = shift; + + my ( $result, $message ) = $self->TemplateObj->Parse( + Argument => $self->Argument, + TicketObj => $self->TicketObj, + TransactionObj => $self->TransactionObj + ); + if ( !$result ) { + return (undef); + } + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + # Header + $self->SetRTSpecialHeaders(); + + my %seen; + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + @{ $self->{$type} } + = grep defined && length && !$seen{ lc $_ }++, + @{ $self->{$type} }; + } + + $self->RemoveInappropriateRecipients(); + + # Go add all the Tos, Ccs and Bccs that we need to to the message to + # make it happy, but only if we actually have values in those arrays. + +# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc + + for my $header (@EMAIL_RECIPIENT_HEADERS) { + + $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) ) + if (!$MIMEObj->head->get($header) + && $self->{$header} + && @{ $self->{$header} } ); + } + # PseudoTo (fake to headers) shouldn't get matched for message recipients. + # If we don't have any 'To' header (but do have other recipients), drop in + # the pseudo-to header. + $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) ) + if $self->{'PseudoTo'} + && @{ $self->{'PseudoTo'} } + && !$MIMEObj->head->get('To') + && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') ); + + # We should never have to set the MIME-Version header + $self->SetHeader( 'MIME-Version', '1.0' ); + + # fsck.com #5959: Since RT sends 8bit mail, we should say so. + $self->SetHeader( 'Content-Transfer-Encoding', '8bit' ); + + # For security reasons, we only send out textual mails. + foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) { + my $type = $part->mime_type || 'text/plain'; + $type = 'text/plain' unless RT::I18N::IsTextualContentType($type); + $part->head->mime_attr( "Content-Type" => $type ); + # utf-8 here is for _FindOrGuessCharset in I18N.pm + # it's not the final charset/encoding sent + $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); + } + + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, + RT->Config->Get('EmailOutputEncoding'), + 'mime_words_ok', ); + + # Build up a MIME::Entity that looks like the original message. + $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message') + && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) ); + + $self->AddTickets; + + my $attachment = $self->TransactionObj->Attachments->First; + if ($attachment + && !( + $attachment->GetHeader('X-RT-Encrypt') + || $self->TicketObj->QueueObj->Encrypt + ) + ) + { + $attachment->SetHeader( 'X-RT-Encrypt' => 1 ) + if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq + 'Success'; + } + + return $result; +} + +=head2 To + +Returns an array of L<Email::Address> objects containing all the To: recipients for this notification + +=cut + +sub To { + my $self = shift; + return ( $self->AddressesFromHeader('To') ); +} + +=head2 Cc + +Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification + +=cut + +sub Cc { + my $self = shift; + return ( $self->AddressesFromHeader('Cc') ); +} + +=head2 Bcc + +Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification + +=cut + +sub Bcc { + my $self = shift; + return ( $self->AddressesFromHeader('Bcc') ); + +} + +sub AddressesFromHeader { + my $self = shift; + my $field = shift; + my $header = $self->TemplateObj->MIMEObj->head->get($field); + my @addresses = Email::Address->parse($header); + + return (@addresses); +} + +=head2 SendMessage MIMEObj + +sends the message using RT's preferred API. +TODO: Break this out to a separate module + +=cut + +sub SendMessage { + + # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's + # ability to pass @_ to a 'post' routine. + my ( $self, $MIMEObj ) = @_; + + my $msgid = $MIMEObj->head->get('Message-ID'); + chomp $msgid; + + $self->ScripActionObj->{_Message_ID}++; + + $RT::Logger->info( $msgid . " #" + . $self->TicketObj->id . "/" + . $self->TransactionObj->id + . " - Scrip " + . ($self->ScripObj->id || '#rule'). " " + . ( $self->ScripObj->Description || '' ) ); + + my $status = RT::Interface::Email::SendEmail( + Entity => $MIMEObj, + Ticket => $self->TicketObj, + Transaction => $self->TransactionObj, + ); + + + return $status unless ($status > 0 || exists $self->{'Deferred'}); + + my $success = $msgid . " sent "; + foreach (@EMAIL_RECIPIENT_HEADERS) { + my $recipients = $MIMEObj->head->get($_); + $success .= " $_: " . $recipients if $recipients; + } + + if( exists $self->{'Deferred'} ) { + for (qw(daily weekly susp)) { + $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } ) + if exists $self->{'Deferred'}{ $_ }; + } + } + + $success =~ s/\n//g; + + $RT::Logger->info($success); + + return (1); +} + +=head2 AddAttachments + +Takes any attachments to this transaction and attaches them to the message +we're building. + +=cut + +sub AddAttachments { + my $self = shift; + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + $MIMEObj->head->delete('RT-Attach-Message'); + + my $attachments = RT::Attachments->new( RT->SystemUser ); + $attachments->Limit( + FIELD => 'TransactionId', + VALUE => $self->TransactionObj->Id + ); + + # Don't attach anything blank + $attachments->LimitNotEmpty; + $attachments->OrderBy( FIELD => 'id' ); + + # We want to make sure that we don't include the attachment that's + # being used as the "Content" of this message" unless that attachment's + # content type is not like text/... + my $transaction_content_obj = $self->TransactionObj->ContentObj; + + if ( $transaction_content_obj + && $transaction_content_obj->ContentType =~ m{text/}i ) + { + # If this was part of a multipart/alternative, skip all of the kids + my $parent = $transaction_content_obj->ParentObj; + if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'parent', + OPERATOR => '!=', + VALUE => $parent->Id, + ); + } else { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'id', + OPERATOR => '!=', + VALUE => $transaction_content_obj->Id, + ); + } + } + + # attach any of this transaction's attachments + my $seen_attachment = 0; + while ( my $attach = $attachments->Next ) { + if ( !$seen_attachment ) { + $MIMEObj->make_multipart( 'mixed', Force => 1 ); + $seen_attachment = 1; + } + $self->AddAttachment($attach); + } +} + +=head2 AddAttachment $attachment + +Takes one attachment object of L<RT::Attachment> class and attaches it to the message +we're building. + +=cut + +sub AddAttachment { + my $self = shift; + my $attach = shift; + my $MIMEObj = shift || $self->TemplateObj->MIMEObj; + + # $attach->TransactionObj may not always be $self->TransactionObj + return unless $attach->Id + and $attach->TransactionObj->CurrentUserCanSee; + + # ->attach expects just the disposition type; extract it if we have the header + # or default to "attachment" + my $disp = ($attach->GetHeader('Content-Disposition') || '') + =~ /^\s*(inline|attachment)/i ? $1 : "attachment"; + + $MIMEObj->attach( + Type => $attach->ContentType, + Charset => $attach->OriginalEncoding, + Data => $attach->OriginalContent, + Disposition => $disp, + Filename => $self->MIMEEncodeString( $attach->Filename ), + 'RT-Attachment:' => $self->TicketObj->Id . "/" + . $self->TransactionObj->Id . "/" + . $attach->id, + Encoding => '-SUGGEST', + ); +} + +=head2 AttachTickets [@IDs] + +Returns or set list of ticket's IDs that should be attached to an outgoing message. + +B<Note> this method works as a class method and setup things global, so you have to +clean list by passing undef as argument. + +=cut + +{ + my $list = []; + + sub AttachTickets { + my $self = shift; + $list = [ grep defined, @_ ] if @_; + return @$list; + } +} + +=head2 AddTickets + +Attaches tickets to the current message, list of tickets' ids get from +L</AttachTickets> method. + +=cut + +sub AddTickets { + my $self = shift; + $self->AddTicket($_) foreach $self->AttachTickets; + return; +} + +=head2 AddTicket $ID + +Attaches a ticket with ID to the message. + +Each ticket is attached as multipart entity and all its messages and attachments +are attached as sub entities in order of creation, but only if transaction type +is Create or Correspond. + +=cut + +sub AddTicket { + my $self = shift; + my $tid = shift; + + my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj ); + my $txn_alias = $attachs->TransactionAlias; + $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' ); + $attachs->Limit( + ALIAS => $txn_alias, + FIELD => 'Type', + VALUE => 'Correspond' + ); + $attachs->LimitByTicket($tid); + $attachs->LimitNotEmpty; + $attachs->OrderBy( FIELD => 'Created' ); + + my $ticket_mime = MIME::Entity->build( + Type => 'multipart/mixed', + Top => 0, + Description => "ticket #$tid", + ); + while ( my $attachment = $attachs->Next ) { + $self->AddAttachment( $attachment, $ticket_mime ); + } + if ( $ticket_mime->parts ) { + my $email_mime = $self->TemplateObj->MIMEObj; + $email_mime->make_multipart; + $email_mime->add_part($ticket_mime); + } + return; +} + +=head2 RecordOutgoingMailTransaction MIMEObj + +Record a transaction in RT with this outgoing message for future record-keeping purposes + +=cut + +sub RecordOutgoingMailTransaction { + my $self = shift; + my $MIMEObj = shift; + + my @parts = $MIMEObj->parts; + my @attachments; + my @keep; + foreach my $part (@parts) { + my $attach = $part->head->get('RT-Attachment'); + if ($attach) { + $RT::Logger->debug( + "We found an attachment. we want to not record it."); + push @attachments, $attach; + } else { + $RT::Logger->debug("We found a part. we want to record it."); + push @keep, $part; + } + } + $MIMEObj->parts( \@keep ); + foreach my $attachment (@attachments) { + $MIMEObj->head->add( 'RT-Attachment', $attachment ); + } + + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' ); + + my $transaction + = RT::Transaction->new( $self->TransactionObj->CurrentUser ); + +# XXX: TODO -> Record attachments as references to things in the attachments table, maybe. + + my $type; + if ( $self->TransactionObj->Type eq 'Comment' ) { + $type = 'CommentEmailRecord'; + } else { + $type = 'EmailRecord'; + } + + my $msgid = $MIMEObj->head->get('Message-ID'); + chomp $msgid; + + my ( $id, $msg ) = $transaction->Create( + Ticket => $self->TicketObj->Id, + Type => $type, + Data => $msgid, + MIMEObj => $MIMEObj, + ActivateScrips => 0 + ); + + if ($id) { + $self->{'OutgoingMailTransaction'} = $id; + } else { + $RT::Logger->warning( + "Could not record outgoing message transaction: $msg"); + } + return $id; +} + +=head2 SetRTSpecialHeaders + +This routine adds all the random headers that RT wants in a mail message +that don't matter much to anybody else. + +=cut + +sub SetRTSpecialHeaders { + my $self = shift; + + $self->SetSubject(); + $self->SetSubjectToken(); + $self->SetHeaderAsEncoding( 'Subject', + RT->Config->Get('EmailOutputEncoding') ) + if ( RT->Config->Get('EmailOutputEncoding') ); + $self->SetReturnAddress(); + $self->SetReferencesHeaders(); + + unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) { + + # Get Message-ID for this txn + my $msgid = ""; + if ( my $msg = $self->TransactionObj->Message->First ) { + $msgid = $msg->GetHeader("RT-Message-ID") + || $msg->GetHeader("Message-ID"); + } + + # If there is one, and we can parse it, then base our Message-ID on it + if ( $msgid + and $msgid + =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/ + "<$1." . $self->TicketObj->id + . "-" . $self->ScripObj->id + . "-" . $self->ScripActionObj->{_Message_ID} + . "@" . RT->Config->Get('Organization') . ">"/eg + and $2 == $self->TicketObj->id + ) + { + $self->SetHeader( "Message-ID" => $msgid ); + } else { + $self->SetHeader( + 'Message-ID' => RT::Interface::Email::GenMessageId( + Ticket => $self->TicketObj, + Scrip => $self->ScripObj, + ScripAction => $self->ScripActionObj + ), + ); + } + } + + if (my $precedence = RT->Config->Get('DefaultMailPrecedence') + and !$self->TemplateObj->MIMEObj->head->get("Precedence") + ) { + $self->SetHeader( 'Precedence', $precedence ); + } + + $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') ); + $self->SetHeader( 'RT-Ticket', + RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); + $self->SetHeader( 'Managed-by', + "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); + +# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be +# refactored into user's method. + if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress + and RT->Config->Get('UseOriginatorHeader') + ) { + $self->SetHeader( 'RT-Originator', $email ); + } + +} + + +sub DeferDigestRecipients { + my $self = shift; + $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id ); + + # The digest attribute will be an array of notifications that need to + # be sent for this transaction. The array will have the following + # format for its objects. + # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc} + # -> sent -> {true|false} + # The "sent" flag will be used by the cron job to indicate that it has + # run on this transaction. + # In a perfect world we might move this hash construction to the + # extension module itself. + my $digest_hash = {}; + + foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) { + # If we have a "PseudoTo", the "To" contains it, so we don't need to access it + next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) ); + $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) ); + + # Store the 'daily digest' folk in an array. + my ( @send_now, @daily_digest, @weekly_digest, @suspended ); + + # Have to get the list of addresses directly from the MIME header + # at this point. + $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { + next unless $rcpt; + my $user_obj = RT::User->new(RT->SystemUser); + $user_obj->LoadByEmail($rcpt); + if ( ! $user_obj->id ) { + # If there's an email address in here without an associated + # RT user, pass it on through. + $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail."); + push( @send_now, $rcpt ); + next; + } + + my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || ''; + $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt"); + + if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) } + elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) } + elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) } + else { push( @send_now, $rcpt ) } + } + + # Reset the relevant mail field. + $RT::Logger->debug( "Removing deferred recipients from $mailfield: line"); + if (@send_now) { + $self->SetHeader( $mailfield, join( ', ', @send_now ) ); + } else { # No recipients! Remove the header. + $self->TemplateObj->MIMEObj->head->delete($mailfield); + } + + # Push the deferred addresses into the appropriate field in + # our attribute hash, with the appropriate mail header. + $RT::Logger->debug( + "Setting deferred recipients for attribute creation"); + $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest); + $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest); + $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended); + } + + if ( scalar keys %$digest_hash ) { + + # Save the hash so that we can add it as an attribute to the + # outgoing email transaction. + $self->{'Deferred'} = $digest_hash; + } else { + $RT::Logger->debug( "No recipients found for deferred delivery on " + . "transaction #" + . $self->TransactionObj->id ); + } +} + + + +sub RecordDeferredRecipients { + my $self = shift; + return unless exists $self->{'Deferred'}; + + my $txn_id = $self->{'OutgoingMailTransaction'}; + return unless $txn_id; + + my $txn_obj = RT::Transaction->new( $self->CurrentUser ); + $txn_obj->Load( $txn_id ); + my( $ret, $msg ) = $txn_obj->AddAttribute( + Name => 'DeferredRecipients', + Content => $self->{'Deferred'} + ); + $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) + unless $ret; + + return ($ret,$msg); +} + +=head2 SquelchMailTo + +Returns list of the addresses to squelch on this transaction. + +=cut + +sub SquelchMailTo { + my $self = shift; + return map $_->Content, $self->TransactionObj->SquelchMailTo; +} + +=head2 RemoveInappropriateRecipients + +Remove addresses that are RT addresses or that are on this transaction's blacklist + +=cut + +sub RemoveInappropriateRecipients { + my $self = shift; + + my @blacklist = (); + + # If there are no recipients, don't try to send the message. + # If the transaction has content and has the header RT-Squelch-Replies-To + + my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + if ( my $attachment = $self->TransactionObj->Attachments->First ) { + + if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { + + # What do we want to do with this? It's probably (?) a bounce + # caused by one of the watcher addresses being broken. + # Default ("true") is to redistribute, for historical reasons. + + if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) { + + # Don't send to any watchers. + @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS); + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message based on site configuration." + ); + } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq + 'privileged' ) + { + + # Only send to "privileged" watchers. + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + foreach my $addr ( @{ $self->{$type} } ) { + my $user = RT::User->new(RT->SystemUser); + $user->LoadByEmail($addr); + push @blacklist, $addr unless $user->id && $user->Privileged; + } + } + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message to unprivileged users based on site configuration." + ); + } + } + + if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) { + push @blacklist, split( /,/, $squelch ); + } + } + + # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted + push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo; + + # Cycle through the people we're sending to and pull out anyone on the + # system blacklist + + # Trim leading and trailing spaces. + @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } + Email::Address->parse( join ', ', grep defined, @blacklist ); + + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + my @addrs; + foreach my $addr ( @{ $self->{$type} } ) { + + # Weed out any RT addresses. We really don't want to talk to ourselves! + # If we get a reply back, that means it's not an RT address + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + if ( grep $addr eq $_, @blacklist ) { + $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping"); + next; + } + push @addrs, $addr; + } + foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) { + # never send email to itself + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + push @addrs, $addr; + } + @{ $self->{$type} } = @addrs; + } +} + +=head2 SetReturnAddress is_comment => BOOLEAN + +Calculate and set From and Reply-To headers based on the is_comment flag. + +=cut + +sub SetReturnAddress { + + my $self = shift; + my %args = ( + is_comment => 0, + friendly_name => undef, + @_ + ); + + # From and Reply-To + # $args{is_comment} should be set if the comment address is to be used. + my $replyto; + + if ( $args{'is_comment'} ) { + $replyto = $self->TicketObj->QueueObj->CommentAddress + || RT->Config->Get('CommentAddress'); + } else { + $replyto = $self->TicketObj->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); + } + + unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { + $self->SetFrom( %args, From => $replyto ); + } + + unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { + $self->SetHeader( 'Reply-To', "$replyto" ); + } + +} + +=head2 SetFrom ( From => emailaddress ) + +Set the From: address for outgoing email + +=cut + +sub SetFrom { + my $self = shift; + my %args = @_; + + my $from = $args{From}; + + if ( RT->Config->Get('UseFriendlyFromLine') ) { + my $friendly_name = $self->GetFriendlyName(%args); + $from = + sprintf( + RT->Config->Get('FriendlyFromLineFormat'), + $self->MIMEEncodeString( + $friendly_name, RT->Config->Get('EmailOutputEncoding') + ), + $args{From} + ); + } + + $self->SetHeader( 'From', $from ); + + #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine, + #and then Outlook prepends "rt@machine on behalf of" to the From: header + $self->SetHeader( 'Sender', $from ); +} + +=head2 GetFriendlyName + +Calculate the proper Friendly Name based on the creator of the transaction + +=cut + +sub GetFriendlyName { + my $self = shift; + my %args = ( + is_comment => 0, + friendly_name => '', + @_ + ); + my $friendly_name = $args{friendly_name}; + + unless ( $friendly_name ) { + $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName; + if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string + $friendly_name = $1; + } + } + + $friendly_name =~ s/"/\\"/g; + return $friendly_name; + +} + +=head2 SetHeader FIELD, VALUE + +Set the FIELD of the current MIME object into VALUE. + +=cut + +sub SetHeader { + my $self = shift; + my $field = shift; + my $val = shift; + + chomp $val; + chomp $field; + my $head = $self->TemplateObj->MIMEObj->head; + $head->fold_length( $field, 10000 ); + $head->replace( $field, $val ); + return $head->get($field); +} + +=head2 SetSubject + +This routine sets the subject. it does not add the rt tag. That gets done elsewhere +If subject is already defined via template, it uses that. otherwise, it tries to get +the transaction's subject. + +=cut + +sub SetSubject { + my $self = shift; + my $subject; + + if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { + return (); + } + + # don't use Transaction->Attachments because it caches + # and anything which later calls ->Attachments will be hurt + # by our RowsPerPage() call. caching is hard. + my $message = RT::Attachments->new( $self->CurrentUser ); + $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id); + $message->OrderBy( FIELD => 'id', ORDER => 'ASC' ); + $message->RowsPerPage(1); + + if ( $self->{'Subject'} ) { + $subject = $self->{'Subject'}; + } elsif ( my $first = $message->First ) { + my $tmp = $first->GetHeader('Subject'); + $subject = defined $tmp ? $tmp : $self->TicketObj->Subject; + } else { + $subject = $self->TicketObj->Subject; + } + $subject = '' unless defined $subject; + chomp $subject; + + $subject =~ s/(\r\n|\n|\s)/ /g; + + $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + +} + +=head2 SetSubjectToken + +This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. + +=cut + +sub SetSubjectToken { + my $self = shift; + + my $head = $self->TemplateObj->MIMEObj->head; + $self->SetHeader( + Subject => + Encode::encode_utf8( + RT::Interface::Email::AddSubjectTag( + Encode::decode_utf8( $head->get('Subject') ), + $self->TicketObj, + ), + ), + ); +} + +=head2 SetReferencesHeaders + +Set References and In-Reply-To headers for this message. + +=cut + +sub SetReferencesHeaders { + my $self = shift; + + my $top = $self->TransactionObj->Message->First; + unless ( $top ) { + $self->SetHeader( References => $self->PseudoReference ); + return (undef); + } + + my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' ); + my @references = split( /\s+/m, $top->GetHeader('References') || '' ); + my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' ); + + # There are two main cases -- this transaction was created with + # the RT Web UI, and hence we want to *not* append its Message-ID + # to the References and In-Reply-To. OR it came from an outside + # source, and we should treat it as per the RFC + my $org = RT->Config->Get('Organization'); + if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) { + + # Make all references which are internal be to version which we + # have sent out + + for ( @references, @in_reply_to ) { + s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/ + "<$1." . $self->TicketObj->id . + "-" . $self->ScripObj->id . + "-" . $self->ScripActionObj->{_Message_ID} . + "@" . $org . ">"/eg + } + + # In reply to whatever the internal message was in reply to + $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) ); + + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # References are unchanged from internal + } else { + + # In reply to that message + $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) ); + + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # Push that message onto the end of the references + push @references, @msgid; + } + + # Push pseudo-ref to the front + my $pseudo_ref = $self->PseudoReference; + @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references ); + + # If there are more than 10 references headers, remove all but the + # first four and the last six (Gotta keep this from growing + # forever) + splice( @references, 4, -6 ) if ( $#references >= 10 ); + + # Add on the references + $self->SetHeader( 'References', join( " ", @references ) ); + $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 ); + +} + +=head2 PseudoReference + +Returns a fake Message-ID: header for the ticket to allow a base level of threading + +=cut + +sub PseudoReference { + + my $self = shift; + my $pseudo_ref + = '<RT-Ticket-' + . $self->TicketObj->id . '@' + . RT->Config->Get('Organization') . '>'; + return $pseudo_ref; +} + +=head2 SetHeaderAsEncoding($field_name, $charset_encoding) + +This routine converts the field into specified charset encoding. + +=cut + +sub SetHeaderAsEncoding { + my $self = shift; + my ( $field, $enc ) = ( shift, shift ); + + my $head = $self->TemplateObj->MIMEObj->head; + + if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { + $head->replace( $field, RT->Config->Get('SMTPFrom') ); + return; + } + + my $value = $head->get( $field ); + $value = $self->MIMEEncodeString( $value, $enc ); + $head->replace( $field, $value ); + +} + +=head2 MIMEEncodeString + +Takes a perl string and optional encoding pass it over +L<RT::Interface::Email/EncodeToMIME>. + +Basicly encode a string using B encoding according to RFC2047. + +=cut + +sub MIMEEncodeString { + my $self = shift; + return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); +} + +RT::Base->_ImportOverlays(); + +1; + |