rt/lib/RT/Action/SendEmail.pm

   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
   5
   6 package RT::Action::SendEmail;
   7 require RT::Action::Generic;
   8
   9 @ISA = qw(RT::Action::Generic);
  10
  11
  12 =head1 NAME
  13
  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.
  17
  18
  19 =head1 SYNOPSIS
  20
  21   require RT::Action::SendEmail;
  22   @ISA  = qw(RT::Action::SendEmail);
  23
  24
  25 =head1 DESCRIPTION
  26
  27 Basically, you create another module RT::Action::YourAction which ISA
  28 RT::Action::SendEmail.
  29
  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).
  35
  36
  37 =begin testing
  38
  39 ok (require RT::TestHarness);
  40 ok (require RT::Action::SendEmail);
  41
  42 =end testing
  43
  44
  45 =head1 AUTHOR
  46
  47 Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
  48
  49 =head1 SEE ALSO
  50
  51 perl(1).
  52
  53 =cut
  54
  55 # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
  56
  57 # {{{ sub _Init
  58 # We use _Init from RT::Action
  59 # }}}
  60
  61 # {{{ sub Commit
  62 #Do what we need to do and send it out.
  63 sub Commit  {
  64     my $self = shift;
  65     #send the email
  66
  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
  69
  70     if (defined $self->TransactionObj->Message->First()) {
  71         my $headers = $self->TransactionObj->Message->First->Headers();
  72
  73         if ($headers =~ /^RT-Squelch-Replies-To: (.*?)$/si) {
  74             my @blacklist = split(/,/,$1);
  75
  76             # Cycle through the people we're sending to and pull out anyone on the
  77             # system blacklist
  78
  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'}});
  84             }
  85         }
  86     }
  87
  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.
  90
  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'}});;
  97
  98     my $MIMEObj = $self->TemplateObj->MIMEObj;
  99
 100
 101     $MIMEObj->make_singlepart;
 102
 103
 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");
 109         return(1);
 110     }
 111
 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.
 114
 115     $self->SetHeader('To', join(',', @{$self->{'PseudoTo'}}))
 116       if ( (@{$self->{'PseudoTo'}}) and (! $MIMEObj->head->get('To')));
 117
 118     if ($RT::MailCommand eq 'sendmailpipe') {
 119         open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0);
 120         print MAIL $MIMEObj->as_string;
 121         close(MAIL);
 122     }
 123     else {
 124         unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) {
 125             $RT::Logger->crit("$self: Could not send mail for ".
 126                               $self->TransactionObj . "\n");
 127             return(0);
 128         }
 129     }
 130
 131     return (1);
 132
 133 }
 134 # }}}
 135
 136 # {{{ sub Prepare
 137
 138 sub Prepare  {
 139   my $self = shift;
 140
 141   # This actually populates the MIME::Entity fields in the Template Object
 142
 143   unless ($self->TemplateObj) {
 144     $RT::Logger->warning("No template object handed to $self\n");
 145   }
 146
 147   unless ($self->TransactionObj) {
 148     $RT::Logger->warning("No transaction object handed to $self\n");
 149
 150   }
 151
 152   unless ($self->TicketObj) {
 153     $RT::Logger->warning("No ticket object handed to $self\n");
 154
 155   }
 156
 157
 158   $self->TemplateObj->Parse(Argument => $self->Argument,
 159                             TicketObj => $self->TicketObj,
 160                             TransactionObj => $self->TransactionObj);
 161
 162   # Header
 163
 164   $self->SetSubject();
 165
 166   $self->SetSubjectToken();
 167
 168   $self->SetRecipients();
 169
 170   $self->SetReturnAddress();
 171
 172   $self->SetRTSpecialHeaders();
 173
 174   return 1;
 175
 176 }
 177
 178 # }}}
 179
 180 # }}}
 181
 182 # {{{ Deal with message headers (Set* subs, designed for  easy overriding)
 183
 184 # {{{ sub SetRTSpecialHeaders
 185
 186 # This routine adds all the random headers that RT wants in a mail message
 187 # that don't matter much to anybody else.
 188
 189 sub SetRTSpecialHeaders {
 190     my $self = shift;
 191
 192     $self->SetReferences();
 193
 194     $self->SetMessageID();
 195
 196     $self->SetPrecedence();
 197
 198     $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname);
 199     $self->SetHeader('RT-Ticket', $RT::rtname. " #".$self->TicketObj->id());
 200     $self->SetHeader
 201       ('Managed-by',"RT $RT::VERSION (http://bestpractical.com/rt/)");
 202
 203     $self->SetHeader('RT-Originator', $self->TransactionObj->CreatorObj->EmailAddress);
 204     return();
 205
 206 }
 207
 208
 209
 210 # {{{ sub SetReferences
 211
 212 =head2 SetReferences
 213
 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.
 217
 218 =cut
 219
 220 sub SetReferences {
 221   my $self = shift;
 222
 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
 227   # References.
 228
 229   $self->SetHeader
 230     ('In-Reply-To', "<rt-".$self->TicketObj->id().
 231      "\@".$RT::rtname.">");
 232
 233
 234   # TODO We should always add References headers for all message-ids
 235   # of previous messages related to this ticket.
 236 }
 237
 238 # }}}
 239
 240 # {{{ sub SetMessageID
 241
 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.
 245
 246 sub SetMessageID {
 247   my $self = shift;
 248
 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#"
 253
 254   $self->SetHeader
 255     ('Message-ID', "<rt-".$self->TicketObj->id().
 256      "-".
 257      $self->TransactionObj->id()."." .rand(20) . "\@".$RT::Organization.">")
 258       unless $self->TemplateObj->MIMEObj->head->get('Message-ID');
 259 }
 260
 261
 262 # }}}
 263
 264 # }}}
 265
 266 # {{{ sub SetReturnAddress
 267
 268 sub SetReturnAddress {
 269
 270   my $self = shift;
 271   my %args = ( is_comment => 0,
 272                @_ );
 273
 274   # From and Reply-To
 275   # $args{is_comment} should be set if the comment address is to be used.
 276   my $replyto;
 277
 278   if ($args{'is_comment'}) {
 279       $replyto = $self->TicketObj->QueueObj->CommentAddress ||
 280                   $RT::CommentAddress;
 281   }
 282   else {
 283       $replyto = $self->TicketObj->QueueObj->CorrespondAddress ||
 284                   $RT::CorrespondAddress;
 285   }
 286
 287   unless ($self->TemplateObj->MIMEObj->head->get('From')) {
 288       my $friendly_name=$self->TransactionObj->CreatorObj->RealName;
 289
 290       if ($friendly_name =~ /^\S+\@\S+$/) { # A "bare" mail address
 291           $friendly_name =~ s/"/\\"/g;
 292           $friendly_name = qq|"$friendly_name"|;
 293       }
 294
 295
 296       # TODO: this "via RT" should really be site-configurable.
 297       $self->SetHeader('From', "\"$friendly_name via RT\" <$replyto>");
 298   }
 299
 300   unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) {
 301       $self->SetHeader('Reply-To', "$replyto");
 302   }
 303
 304 }
 305
 306 # }}}
 307
 308 # {{{ sub SetHeader
 309
 310 sub SetHeader {
 311   my $self = shift;
 312   my $field = shift;
 313   my $val = shift;
 314
 315   chomp $val;
 316   chomp $field;
 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);
 320 }
 321
 322 # }}}
 323
 324 # {{{ sub SetRecipients
 325
 326 =head2 SetRecipients
 327
 328 Dummy method to be overriden by subclasses which want to set the recipients.
 329
 330 =cut
 331
 332 sub SetRecipients {
 333     my $self = shift;
 334     return();
 335 }
 336
 337 # }}}
 338
 339 # {{{ sub SetTo
 340
 341 sub SetTo {
 342     my $self=shift;
 343     my $addresses = shift;
 344     return $self->SetHeader('To',$addresses);
 345 }
 346 # }}}
 347
 348 # {{{ sub SetCc
 349 =head2 SetCc
 350
 351 Takes a string that is the addresses you want to Cc
 352
 353 =cut
 354
 355 sub SetCc {
 356     my $self=shift;
 357     my $addresses = shift;
 358
 359     return $self->SetHeader('Cc', $addresses);
 360 }
 361 # }}}
 362
 363 # {{{ sub SetBcc
 364
 365 =head2 SetBcc
 366
 367 Takes a string that is the addresses you want to Bcc
 368
 369 =cut
 370 sub SetBcc {
 371     my $self=shift;
 372     my $addresses = shift;
 373
 374     return $self->SetHeader('Bcc', $addresses);
 375 }
 376
 377 # }}}
 378
 379 # {{{ sub SetPrecedence
 380
 381 sub SetPrecedence {
 382   my $self = shift;
 383
 384   unless ($self->TemplateObj->MIMEObj->head->get("Precedence")) {
 385     $self->SetHeader('Precedence', "bulk");
 386    }
 387 }
 388
 389 # }}}
 390
 391 # {{{ sub SetSubject
 392
 393 =head2 SetSubject
 394
 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.
 398
 399 =cut
 400
 401 sub SetSubject {
 402   my $self = shift;
 403   unless ($self->TemplateObj->MIMEObj->head->get('Subject')) {
 404     my $message=$self->TransactionObj->Message;
 405     my $ticket=$self->TicketObj->Id;
 406
 407     my $subject;
 408
 409     if ($self->{'Subject'}) {
 410       $subject = $self->{'Subject'};
 411     }
 412     elsif (($message->First()) &&
 413            ($message->First->Headers)) {
 414       $header = $message->First->Headers();
 415       $header =~ s/\n\s+/ /g;
 416       if ( $header =~ /^Subject: (.*?)$/m ) {
 417         $subject = $1;
 418       }
 419       else {
 420         $subject = $self->TicketObj->Subject();
 421       }
 422
 423     }
 424     else {
 425       $subject = $self->TicketObj->Subject();
 426     }
 427
 428     $subject =~ s/(\r\n|\n|\s)/ /gi;
 429
 430     chomp $subject;
 431     $self->SetHeader('Subject',$subject);
 432
 433     }
 434   return($subject);
 435 }
 436 # }}}
 437
 438 # {{{ sub SetSubjectToken
 439
 440 =head2 SetSubjectToken
 441
 442  This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 443
 444 =cut
 445
 446 sub SetSubjectToken {
 447   my $self=shift;
 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;
 452     chomp $sub;
 453     $self->TemplateObj->MIMEObj->head->replace('Subject', "$tag $sub");
 454   }
 455 }
 456
 457 # }}}
 458
 459 # }}}
 460
 461 __END__
 462
 463 # {{{ POD
 464
 465 # }}}
 466
 467 1;
 468