path: root/rt/lib/RT/Action/SendEmail.pm

# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/SendEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
# Copyright 1996-2002  Jesse Vincent <jesse@bestpractical.com> 
# Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
# Released under the terms of version 2 of the GNU Public License

package RT::Action::SendEmail;
require RT::Action::Generic;

@ISA = qw(RT::Action::Generic);


=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

  require RT::Action::SendEmail;
  @ISA  = qw(RT::Action::SendEmail);


=head1 DESCRIPTION

Basically, you create another module RT::Action::YourAction which ISA
RT::Action::SendEmail.

If you want to set the recipients of the mail to something other than
the addresses mentioned in the To, Cc, Bcc and headers in
the template, you should subclass RT::Action::SendEmail and override
either the SetRecipients method or the SetTo, SetCc, etc methods (see
the comments for the SetRecipients sub).


=begin testing

ok (require RT::TestHarness);
ok (require RT::Action::SendEmail);

=end testing


=head1 AUTHOR

Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>

=head1 SEE ALSO

perl(1).

=cut

# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)

# {{{ sub _Init 
# We use _Init from RT::Action
# }}}

# {{{ sub Commit 
#Do what we need to do and send it out.
sub Commit  {
    my $self = shift;
    #send the email
    
    # 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
    
    if (defined $self->TransactionObj->Message->First()) { 
	my $headers = $self->TransactionObj->Message->First->Headers();
	
	if ($headers =~ /^RT-Squelch-Replies-To: (.*?)$/si) {
	    my @blacklist = split(/,/,$1);
	    
	    # Cycle through the people we're sending to and pull out anyone on the
	    # system blacklist
	    
	    foreach my $person_to_yank (@blacklist) {
		$person_to_yank =~ s/\s//g;
		@{$self->{'To'}} = grep (!/^$person_to_yank$/, @{$self->{'To'}});
		@{$self->{'Cc'}} = grep (!/^$person_to_yank$/, @{$self->{'Cc'}});
		@{$self->{'Bcc'}} = grep (!/^$person_to_yank$/, @{$self->{'Bcc'}});
	    }
	}
    }
    
    # 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.
    
    $self->SetHeader('To', join(',', @{$self->{'To'}})) 
      if (@{$self->{'To'}});
    $self->SetHeader('Cc', join(',' , @{$self->{'Cc'}})) 
      if (@{$self->{'Cc'}});
	$self->SetHeader('Bcc', join(',', @{$self->{'Bcc'}})) 
	  if (@{$self->{'Bcc'}});;
    
    my $MIMEObj = $self->TemplateObj->MIMEObj;
    

    $MIMEObj->make_singlepart;
    
    
    #If we don't have any recipients to send to, don't send a message;
    unless ($MIMEObj->head->get('To') ||
	    $MIMEObj->head->get('Cc') || 
	    $MIMEObj->head->get('Bcc') ) {
	$RT::Logger->debug("$self: No recipients found. Not sending.\n");
	return(1);
    }

    # PseudoTo	(fake to headers) shouldn't get matched for message recipients.
    # If we don't have any 'To' header, drop in the pseudo-to header.

    $self->SetHeader('To', join(',', @{$self->{'PseudoTo'}}))
      if ( (@{$self->{'PseudoTo'}}) and (! $MIMEObj->head->get('To')));
    
    if ($RT::MailCommand eq 'sendmailpipe') {
	open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0);
	print MAIL $MIMEObj->as_string;
	close(MAIL);
    }
    else {
	unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) {
	    $RT::Logger->crit("$self: Could not send mail for ".
			      $self->TransactionObj . "\n");
	    return(0);
	}
    }
    
    return (1);
    
}
# }}}

# {{{ sub Prepare 

sub Prepare  {
  my $self = shift;
  
  # This actually populates the MIME::Entity fields in the Template Object
  
  unless ($self->TemplateObj) {
    $RT::Logger->warning("No template object handed to $self\n");
  }
  
  unless ($self->TransactionObj) {
    $RT::Logger->warning("No transaction object handed to $self\n");
    
  }
  
  unless ($self->TicketObj) {
    $RT::Logger->warning("No ticket object handed to $self\n");
      
  }
  
  
  $self->TemplateObj->Parse(Argument => $self->Argument,
			    TicketObj => $self->TicketObj, 
			    TransactionObj => $self->TransactionObj);
  
  # Header
  
  $self->SetSubject();
  
  $self->SetSubjectToken();
  
  $self->SetRecipients();  
  
  $self->SetReturnAddress();

  $self->SetRTSpecialHeaders();
  
  return 1;
  
}

# }}}

# }}}

# {{{ Deal with message headers (Set* subs, designed for  easy overriding)

# {{{ sub SetRTSpecialHeaders

# This routine adds all the random headers that RT wants in a mail message
# that don't matter much to anybody else.

sub SetRTSpecialHeaders {
    my $self = shift;
    
    $self->SetReferences();

    $self->SetMessageID();
    
    $self->SetPrecedence();

    $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname); 
    $self->SetHeader('RT-Ticket', $RT::rtname. " #".$self->TicketObj->id());
    $self->SetHeader
      ('Managed-by',"RT $RT::VERSION (http://bestpractical.com/rt/)");
    
    $self->SetHeader('RT-Originator', $self->TransactionObj->CreatorObj->EmailAddress);
    return();
    
}



# {{{ sub SetReferences

=head2 SetReferences 
  
  # This routine will set the References: and In-Reply-To headers,
# autopopulating it with all the correspondence on this ticket so
# far. This should make RT responses threadable.

=cut

sub SetReferences {
  my $self = shift;
  
  # TODO: this one is broken.  What is this email really a reply to?
  # If it's a reply to an incoming message, we'll need to use the
  # actual message-id from the appropriate Attachment object.  For
  # incoming mails, we would like to preserve the In-Reply-To and/or
  # References.

  $self->SetHeader
    ('In-Reply-To', "<rt-".$self->TicketObj->id().
     "\@".$RT::rtname.">");


  # TODO We should always add References headers for all message-ids
  # of previous messages related to this ticket.
}

# }}}

# {{{ sub SetMessageID

# Without this one, threading won't work very nice in email agents.
# Anyway, I'm not really sure it's that healthy if we need to send
# several separate/different emails about the same transaction.

sub SetMessageID {
  my $self = shift;

  # TODO this one might be sort of broken.  If we have several scrips +++
  # sending several emails to several different persons, we need to
  # pull out different message-ids.  I'd suggest message ids like
  # "rt-ticket#-transaction#-scrip#-receipient#"

  $self->SetHeader
    ('Message-ID', "<rt-".$self->TicketObj->id().
     "-".
     $self->TransactionObj->id()."." .rand(20) . "\@".$RT::Organization.">")
      unless $self->TemplateObj->MIMEObj->head->get('Message-ID');
}


# }}}

# }}}

# {{{ sub SetReturnAddress 

sub SetReturnAddress {

  my $self = shift;
  my %args = ( is_comment => 0,
	       @_ );

  # 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::CommentAddress;
  }
  else {
      $replyto = $self->TicketObj->QueueObj->CorrespondAddress ||
		  $RT::CorrespondAddress;
  }
    
  unless ($self->TemplateObj->MIMEObj->head->get('From')) {
      my $friendly_name=$self->TransactionObj->CreatorObj->RealName;

      if ($friendly_name =~ /^\S+\@\S+$/) { # A "bare" mail address
          $friendly_name =~ s/"/\\"/g;
          $friendly_name = qq|"$friendly_name"|;
      }


      # TODO: this "via RT" should really be site-configurable.
      $self->SetHeader('From', "\"$friendly_name via RT\" <$replyto>");
  }
  
  unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) {
      $self->SetHeader('Reply-To', "$replyto");
  }
  
}

# }}}

# {{{ sub SetHeader

sub SetHeader {
  my $self = shift;
  my $field = shift;
  my $val = shift;

  chomp $val;                                                                  
  chomp $field;                                                                
  $self->TemplateObj->MIMEObj->head->fold_length($field,10000);     
  $self->TemplateObj->MIMEObj->head->add($field, $val);
  return $self->TemplateObj->MIMEObj->head->get($field);
}

# }}}

# {{{ sub SetRecipients

=head2 SetRecipients

Dummy method to be overriden by subclasses which want to set the recipients.

=cut

sub SetRecipients {
    my $self = shift;
    return();
}

# }}}

# {{{ sub SetTo

sub SetTo {
    my $self=shift;
    my $addresses = shift;
    return $self->SetHeader('To',$addresses);
}
# }}}

# {{{ sub SetCc
=head2 SetCc

Takes a string that is the addresses you want to Cc

=cut

sub SetCc {
    my $self=shift;
    my $addresses = shift;

    return $self->SetHeader('Cc', $addresses);
}
# }}}

# {{{ sub SetBcc

=head2 SetBcc

Takes a string that is the addresses you want to Bcc

=cut
sub SetBcc {
    my $self=shift;
    my $addresses = shift;

    return $self->SetHeader('Bcc', $addresses);
}

# }}}

# {{{ sub SetPrecedence 

sub SetPrecedence {
  my $self = shift;

  unless ($self->TemplateObj->MIMEObj->head->get("Precedence")) { 
    $self->SetHeader('Precedence', "bulk");
   }
}

# }}}

# {{{ sub SetSubject

=head2 SetSubject

This routine sets the subject. it does not add the rt tag. that gets done elsewhere
If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get
the transaction's subject.

=cut 

sub SetSubject {
  my $self = shift;
  unless ($self->TemplateObj->MIMEObj->head->get('Subject')) {
    my $message=$self->TransactionObj->Message;
    my $ticket=$self->TicketObj->Id;
    
    my $subject;
    
    if ($self->{'Subject'}) {
      $subject = $self->{'Subject'};
    }
    elsif (($message->First()) &&
	   ($message->First->Headers)) {
      $header = $message->First->Headers();
      $header =~ s/\n\s+/ /g; 
      if ( $header =~ /^Subject: (.*?)$/m ) {
	$subject = $1;
      }
      else {
	$subject = $self->TicketObj->Subject();
      }
      
    }
    else {
      $subject = $self->TicketObj->Subject();
    }
    
    $subject =~ s/(\r\n|\n|\s)/ /gi;

    chomp $subject;
    $self->SetHeader('Subject',$subject);
    
    }
  return($subject);
}
# }}}

# {{{ sub SetSubjectToken

=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 $tag = "[$RT::rtname #".$self->TicketObj->id."]";
  my $sub = $self->TemplateObj->MIMEObj->head->get('Subject');
  unless ($sub =~ /\Q$tag\E/) {
    $sub =~ s/(\r\n|\n|\s)/ /gi;
    chomp $sub;
    $self->TemplateObj->MIMEObj->head->replace('Subject', "$tag $sub");
  }
}

# }}}

# }}}

__END__

# {{{ POD

# }}}

1;