1 # $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/SendEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
2 # Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com>
3 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
4 # Released under the terms of version 2 of the GNU Public License
6 package RT::Action::SendEmail;
7 require RT::Action::Generic;
9 @ISA = qw(RT::Action::Generic);
14 RT::Action::SendEmail - An Action which users can use to send mail
15 or can subclassed for more specialized mail sending behavior.
16 RT::Action::AutoReply is a good example subclass.
21 require RT::Action::SendEmail;
22 @ISA = qw(RT::Action::SendEmail);
27 Basically, you create another module RT::Action::YourAction which ISA
28 RT::Action::SendEmail.
30 If you want to set the recipients of the mail to something other than
31 the addresses mentioned in the To, Cc, Bcc and headers in
32 the template, you should subclass RT::Action::SendEmail and override
33 either the SetRecipients method or the SetTo, SetCc, etc methods (see
34 the comments for the SetRecipients sub).
39 ok (require RT::TestHarness);
40 ok (require RT::Action::SendEmail);
47 Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
55 # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
58 # We use _Init from RT::Action
62 #Do what we need to do and send it out.
67 # If there are no recipients, don't try to send the message.
68 # If the transaction has content and has the header RT-Squelch-Replies-To
70 if (defined $self->TransactionObj->Message->First()) {
71 my $headers = $self->TransactionObj->Message->First->Headers();
73 if ($headers =~ /^RT-Squelch-Replies-To: (.*?)$/si) {
74 my @blacklist = split(/,/,$1);
76 # Cycle through the people we're sending to and pull out anyone on the
79 foreach my $person_to_yank (@blacklist) {
80 $person_to_yank =~ s/\s//g;
81 @{$self->{'To'}} = grep (!/^$person_to_yank$/, @{$self->{'To'}});
82 @{$self->{'Cc'}} = grep (!/^$person_to_yank$/, @{$self->{'Cc'}});
83 @{$self->{'Bcc'}} = grep (!/^$person_to_yank$/, @{$self->{'Bcc'}});
88 # Go add all the Tos, Ccs and Bccs that we need to to the message to
89 # make it happy, but only if we actually have values in those arrays.
91 $self->SetHeader('To', join(',', @{$self->{'To'}}))
92 if (@{$self->{'To'}});
93 $self->SetHeader('Cc', join(',' , @{$self->{'Cc'}}))
94 if (@{$self->{'Cc'}});
95 $self->SetHeader('Bcc', join(',', @{$self->{'Bcc'}}))
96 if (@{$self->{'Bcc'}});;
98 my $MIMEObj = $self->TemplateObj->MIMEObj;
101 $MIMEObj->make_singlepart;
104 #If we don't have any recipients to send to, don't send a message;
105 unless ($MIMEObj->head->get('To') ||
106 $MIMEObj->head->get('Cc') ||
107 $MIMEObj->head->get('Bcc') ) {
108 $RT::Logger->debug("$self: No recipients found. Not sending.\n");
112 # PseudoTo (fake to headers) shouldn't get matched for message recipients.
113 # If we don't have any 'To' header, drop in the pseudo-to header.
115 $self->SetHeader('To', join(',', @{$self->{'PseudoTo'}}))
116 if ( (@{$self->{'PseudoTo'}}) and (! $MIMEObj->head->get('To')));
118 if ($RT::MailCommand eq 'sendmailpipe') {
119 open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0);
120 print MAIL $MIMEObj->as_string;
124 unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) {
125 $RT::Logger->crit("$self: Could not send mail for ".
126 $self->TransactionObj . "\n");
141 # This actually populates the MIME::Entity fields in the Template Object
143 unless ($self->TemplateObj) {
144 $RT::Logger->warning("No template object handed to $self\n");
147 unless ($self->TransactionObj) {
148 $RT::Logger->warning("No transaction object handed to $self\n");
152 unless ($self->TicketObj) {
153 $RT::Logger->warning("No ticket object handed to $self\n");
158 $self->TemplateObj->Parse(Argument => $self->Argument,
159 TicketObj => $self->TicketObj,
160 TransactionObj => $self->TransactionObj);
166 $self->SetSubjectToken();
168 $self->SetRecipients();
170 $self->SetReturnAddress();
172 $self->SetRTSpecialHeaders();
182 # {{{ Deal with message headers (Set* subs, designed for easy overriding)
184 # {{{ sub SetRTSpecialHeaders
186 # This routine adds all the random headers that RT wants in a mail message
187 # that don't matter much to anybody else.
189 sub SetRTSpecialHeaders {
192 $self->SetReferences();
194 $self->SetMessageID();
196 $self->SetPrecedence();
198 $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname);
199 $self->SetHeader('RT-Ticket', $RT::rtname. " #".$self->TicketObj->id());
201 ('Managed-by',"RT $RT::VERSION (http://bestpractical.com/rt/)");
203 $self->SetHeader('RT-Originator', $self->TransactionObj->CreatorObj->EmailAddress);
210 # {{{ sub SetReferences
214 # This routine will set the References: and In-Reply-To headers,
215 # autopopulating it with all the correspondence on this ticket so
216 # far. This should make RT responses threadable.
223 # TODO: this one is broken. What is this email really a reply to?
224 # If it's a reply to an incoming message, we'll need to use the
225 # actual message-id from the appropriate Attachment object. For
226 # incoming mails, we would like to preserve the In-Reply-To and/or
230 ('In-Reply-To', "<rt-".$self->TicketObj->id().
231 "\@".$RT::rtname.">");
234 # TODO We should always add References headers for all message-ids
235 # of previous messages related to this ticket.
240 # {{{ sub SetMessageID
242 # Without this one, threading won't work very nice in email agents.
243 # Anyway, I'm not really sure it's that healthy if we need to send
244 # several separate/different emails about the same transaction.
249 # TODO this one might be sort of broken. If we have several scrips +++
250 # sending several emails to several different persons, we need to
251 # pull out different message-ids. I'd suggest message ids like
252 # "rt-ticket#-transaction#-scrip#-receipient#"
255 ('Message-ID', "<rt-".$self->TicketObj->id().
257 $self->TransactionObj->id()."." .rand(20) . "\@".$RT::Organization.">")
258 unless $self->TemplateObj->MIMEObj->head->get('Message-ID');
266 # {{{ sub SetReturnAddress
268 sub SetReturnAddress {
271 my %args = ( is_comment => 0,
275 # $args{is_comment} should be set if the comment address is to be used.
278 if ($args{'is_comment'}) {
279 $replyto = $self->TicketObj->QueueObj->CommentAddress ||
283 $replyto = $self->TicketObj->QueueObj->CorrespondAddress ||
284 $RT::CorrespondAddress;
287 unless ($self->TemplateObj->MIMEObj->head->get('From')) {
288 my $friendly_name=$self->TransactionObj->CreatorObj->RealName;
290 if ($friendly_name =~ /^\S+\@\S+$/) { # A "bare" mail address
291 $friendly_name =~ s/"/\\"/g;
292 $friendly_name = qq|"$friendly_name"|;
296 # TODO: this "via RT" should really be site-configurable.
297 $self->SetHeader('From', "\"$friendly_name via RT\" <$replyto>");
300 unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) {
301 $self->SetHeader('Reply-To', "$replyto");
317 $self->TemplateObj->MIMEObj->head->fold_length($field,10000);
318 $self->TemplateObj->MIMEObj->head->add($field, $val);
319 return $self->TemplateObj->MIMEObj->head->get($field);
324 # {{{ sub SetRecipients
328 Dummy method to be overriden by subclasses which want to set the recipients.
343 my $addresses = shift;
344 return $self->SetHeader('To',$addresses);
351 Takes a string that is the addresses you want to Cc
357 my $addresses = shift;
359 return $self->SetHeader('Cc', $addresses);
367 Takes a string that is the addresses you want to Bcc
372 my $addresses = shift;
374 return $self->SetHeader('Bcc', $addresses);
379 # {{{ sub SetPrecedence
384 unless ($self->TemplateObj->MIMEObj->head->get("Precedence")) {
385 $self->SetHeader('Precedence', "bulk");
395 This routine sets the subject. it does not add the rt tag. that gets done elsewhere
396 If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get
397 the transaction's subject.
403 unless ($self->TemplateObj->MIMEObj->head->get('Subject')) {
404 my $message=$self->TransactionObj->Message;
405 my $ticket=$self->TicketObj->Id;
409 if ($self->{'Subject'}) {
410 $subject = $self->{'Subject'};
412 elsif (($message->First()) &&
413 ($message->First->Headers)) {
414 $header = $message->First->Headers();
415 $header =~ s/\n\s+/ /g;
416 if ( $header =~ /^Subject: (.*?)$/m ) {
420 $subject = $self->TicketObj->Subject();
425 $subject = $self->TicketObj->Subject();
428 $subject =~ s/(\r\n|\n|\s)/ /gi;
431 $self->SetHeader('Subject',$subject);
438 # {{{ sub SetSubjectToken
440 =head2 SetSubjectToken
442 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
446 sub SetSubjectToken {
448 my $tag = "[$RT::rtname #".$self->TicketObj->id."]";
449 my $sub = $self->TemplateObj->MIMEObj->head->get('Subject');
450 unless ($sub =~ /\Q$tag\E/) {
451 $sub =~ s/(\r\n|\n|\s)/ /gi;
453 $self->TemplateObj->MIMEObj->head->replace('Subject', "$tag $sub");