[rt-users] Owner Correspondence Scrip

Bruce Campbell bruce_campbell at ripe.net
Tue May 21 15:30:44 EDT 2002


On Tue, 21 May 2002, Bruce Campbell wrote:

> On Fri, 17 May 2002, Derek D. Martin wrote:
>
> > On Fri, May 17, 2002 at 10:07:49AM -0700, Robin Lee Powell wrote:
> > > > Am I the only one that cares about this?
> > >
> > > No, but I think you're the only one who cares as much as you do.
> > >
> > > I think you're gonna have to go into the code.
> >
> > Ucky.  It's not that I mind digging in the code. I just don't have
> > the time.  :(
>
> http://www.amsterdamned.org/~bc/rt/BC_SendEmail.pm

And as Derek has pointed out in private mail, I'm being unnecessarily
obscure ;)

Attached is BC_SendEmail, BC_Notify.pm and a script to insert a new
ScripAction into the database called 'BC_NotifyAdminCcs'.  Note that I can
only warrent that BC_SendEmail works with sendmailpipe as the MailCommand
in config.pm .

BC_Notify checks for a config.pm frob named 'SendBackToOriginator', where
a value of '0' gives the RT default behaviour, and a value of '1' gives
the requested behaviour (if you use BC_NotifyAdminCcs below).

To use, copy BC_SendEmail.pm and BC_Notify.pm into your lib/RT/Action
directory.  Change the 'use lib' lines in BC_NotifyAdminCcs.pl to reflect
your own installation and run it to add a ScripAction to your database
named 'BC_NotifyAdminCcs'.

( what, you ran it without checking it?  sheesh )

Then, you can go through the WebUI and replace the Scrip for your queue
reading:

	OnCorrespond NotifyAdminCcs with Template Correspondence
and
	OnCreate NotifyAdminCcs with Template Correspondence

with

	OnCorrespond BC_NotifyAdminCcs with template OrigCorrespondence
and
	OnCreate BC_NotifyAdminCcs with template OrigCorrespondence

Note that you will need to create the template named 'OrigCorrespondence'
first.  Mine reads somewhat like:

--
{ $Transaction->Message->First->NiceHeaders() }

{ $Transaction->Content() }
{ my $have_first = 0; my $retval= undef; my $Attachments =
$Transaction->Attachments; while( my $Attachment = $Attachments->Next ){
next if( $Attachment->id == $Transaction->Message->First->id); if(
$Attachment->Content eq $Transaction->Content ){ $have_first = 1 if(
$have_first == 0 ); next if( $have_first <= 1 ); } $retval = "\nURLs to
Attached parts:\n" if( ! defined( $retval ) ); $retval .=  " " .
$RT::WebURL . "Ticket/Attachment/" . $Transaction->id . "/" .
$Attachment->id . "\n"; } $retval; }
--

This results in mails like:

	Date: Tue, 21 May 2002 21:24:10 +0200 (CEST)
	From: Bruce Campbell <bruce_campbell at ripe.net>
	Reply-To: myqueue at ripe.net
	To: myqueue at ripe.net
	Subject: [ripe.net #46104] testing attachments

	some text

	URLs to Attached parts:
	   http://rt2.ripe.net/Ticket/Attachment/176966/131187

( The last two lines only appear if an attachment was present )

Even if I send it to the queue (wait, I just did ;) ), I get it back as
part of being an AdminCc on that queue.  Other aspects is that I see the
original email address

If you like, you could change the insert script to be other than a
replacement for NotifyAdminCcs, however I personally haven't done that (we
present a certain interface to the outside, and easily exposing our direct
email addresses isn't included), but it should work.

Hopefully all of the above helps, and I'm heading home ;)


-- 
                             Bruce Campbell                            RIPE
                   Systems/Network Engineer                             NCC
                 www.ripe.net - PGP562C8B1B                      Operations
-------------- next part --------------
#$Header: /home/rt2/lib/RT/Action/RCS/BC_Notify.pm,v 1.1 2002/02/18 17:33:36 rt2 Exp rt2 $

package RT::Action::BC_Notify;
require RT::Action::BC_SendEmail;
@ISA = qw(RT::Action::BC_SendEmail);


# {{{ sub SetRecipients

=head2 SetRecipients

Sets the recipients of this message to Owner, Requestor, AdminCc, Cc or All. 
Checks the value of $RT::SendBackToOriginator to see whether we should
notify the AdminCc Originator of the message (do you want your correspondence
mail back or not).

=cut


sub SetRecipients {
    my $self=shift;

    $arg=$self->Argument;

    $arg =~ s/\bAll\b/Owner,Requestor,AdminCc,Cc/;
    
    my (@To, @PseudoTo, @Cc, @Bcc);

    if ($arg =~ /\bRequestor\b/) {
	push(@To, @{$self->TicketObj->Requestors->Emails});
    }
        
    if ($arg =~ /\bCc\b/) {
	#If we have a To, make the Ccs, Ccs, otherwise, promote them to To
	if (@To) {
	    push(@Cc, @{$self->TicketObj->Cc->Emails});
	    push(@Cc, @{$self->TicketObj->QueueObj->Cc->Emails});
	} else {
	    push(@Cc, @{$self->TicketObj->CcAsString});
	    push(@To, @{$self->TicketObj->QueueObj->Cc->Emails});
	}
    }
    
    if ( ($arg =~ /\bOwner\b/) && 
	 ($self->TicketObj->OwnerObj->id != $RT::Nobody->id) ) {
	# If we're not sending to Ccs or requestors, 
	# then the Owner can be the To.
	if (@To) {
	    push(@Bcc, $self->TicketObj->OwnerObj->EmailAddress);
	}
	else {
	    push(@To, $self->TicketObj->OwnerObj->EmailAddress);
	}
	
    }
    
    if ($arg =~ /\bAdminCc\b/) {
        push(@Bcc, @{$self->TicketObj->AdminCc->Emails});
	push(@Bcc, @{$self->TicketObj->QueueObj->AdminCc->Emails});
    }

    if ($RT::UseFriendlyToLine) {    
    	unless (@To) {
	    push (@PseudoTo,  "'$arg of $RT::rtname Ticket #".$self->TicketObj->id."':;");
	}
    } 
    
    my $creator = $self->TransactionObj->CreatorObj->EmailAddress();
      
    #Strip the sender out of the To, Cc and AdminCc and set the 
    # recipients fields used to build the message by the superclass.
    my $striporiginator = 1;
    if( defined( $RT::SendBackToOriginator ) ){
        if( $RT::SendBackToOriginator == 1 ){
            $striporiginator = 0;
        }
    }

    # Assign the variables.
    @{$self->{'To'}} = @To;
    @{$self->{'Cc'}} = @Cc;
    @{$self->{'Bcc'}} = @Bcc;
    if( $striporiginator == 1 ){
	$RT::Logger->debug("$self: Stripping Originator from To, Cc and Bcc" );
        @{$self->{'To'}} = grep (!/^$creator$/, @To);
        @{$self->{'Cc'}} = grep (!/^$creator$/, @Cc);
        @{$self->{'Bcc'}} = grep (!/^$creator$/, @Bcc);
    }
    @{$self->{'PseudoTo'}} = @PseudoTo;    
    return(1);

}

# }}}

1;
-------------- next part --------------
# $Header: /home/rt2/lib/RT/Action/RCS/BC_SendEmail.pm,v 1.1 2002/02/18 17:33:36 rt2 Exp rt2 $
# Copyright 2000  Jesse Vincent <jesse at fsck.com> and Tobias Brox <tobix at cpan.org>
# Released under the terms of the GNU Public License

package RT::Action::BC_SendEmail;
require RT::Action::Generic;

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


=head1 NAME

  RT::Action::BC_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::BC_SendEmail;
  @ISA  = qw(RT::Action::BC_SendEmail);


=head1 DESCRIPTION

Basically, you create another module RT::Action::YourAction which ISA
RT::Action::BC_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::BC_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::BC_SendEmail);

=end testing


=head1 AUTHOR

Jesse Vincent <jesse at fsck.com> and Tobias Brox <tobix at cpan.org>

=head1 SEE ALSO

perl(1).

=cut

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

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

# {{{ sub Generate_Mail 
# Generate the mail, don't send it.
# This function gets used by Preview and Commit.
sub Generate_Mail  {
    my $self = shift;
    #generate 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();

	my $strippeople = 1;

	if( defined( $RT::SendBackToOriginator ) ){
	    if( $RT::SendBackToOriginator == 1 ){
		$strippeople = 0;
		$RT::Logger->debug("$self: Will include Originator in Receipients if required.\n");
	    }
	}

	if ( ($headers =~ /^RT-Squelch-Replies-To: (.*?)$/si ) && ( $strippeople == 1 ) ) {
	    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;
		$RT::Logger->debug("$self: Removing $person_to_yank from Receipients (Transaction Originator?).\n");
		@{$self->{'To'}} = grep (!/^$person_to_yank$/, @{$self->{'To'}}) if( defined( $self->{'To'} ) );
		@{$self->{'Cc'}} = grep (!/^$person_to_yank$/, @{$self->{'Cc'}}) if( defined( $self->{'Cc'} ) );
		@{$self->{'Bcc'}} = grep (!/^$person_to_yank$/, @{$self->{'Bcc'}}) if( defined( $self->{'Bcc'} ) );
		@{$self->{'Envelope-To'}} = grep (!/^$person_to_yank$/, @{$self->{'Envelope-To'}}) if( defined( $self->{'Envelope-To'} ) );
	    }
	}
    }
    
    # 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.

    # Build the Envelope-To header, but only if this header is not already
    # defined.
   
    my $build_env_to = 1;
    $build_env_to = undef if( defined( $self->{'Envelope-To'} ) ); 

    if ( defined( @{$self->{'To'}} ) ){
        $self->SetHeader('To', join(',', @{$self->{'To'}}));
        splice( @{$self->{'Envelope-To'}}, @{$self->{'Envelope-To'}}, 0, @{$self->{'To'}} ) if( $build_env_to );
    }
    if ( defined( @{$self->{'Cc'}} ) ){
        $self->SetHeader('Cc', join(',' , @{$self->{'Cc'}}));
        splice( @{$self->{'Envelope-To'}}, @{$self->{'Envelope-To'}}, 0, @{$self->{'Cc'}} ) if( $build_env_to );
    }
    if ( defined( @{$self->{'Bcc'}} ) ){
        $self->SetHeader('Bcc', join(',', @{$self->{'Bcc'}}));
        splice( @{$self->{'Envelope-To'}}, @{$self->{'Envelope-To'}}, 0, @{$self->{'Bcc'}} ) if( $build_env_to );
    }

    # Set up the Envelope-To header (by now its defined)
    if ( defined( @{$self->{'Envelope-To'}} ) ){
        $self->SetHeader('Envelope-To', join(',', @{$self->{'Envelope-To'}})) 
    }

    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') || 
	    $MIMEObj->head->get('Envelope-To') ){
	$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')));


    return(1, $MIMEObj );
} 
# }}}

# {{{ sub Preview
# Call Generate_Mail and then return what we'd pass to sendmail.
sub Preview {

    my $self = shift;

    my ( $retval, $MIMEObj ) = $self->Generate_Mail( @_ );

    if( $retval && $MIMEObj ){

        return( $retval, $MIMEObj->as_string );

    }else{

        return( 0, "Generate_Mail returned nothing" );

    }
}
# }}}
    

# {{{ sub Commit
# Call Generate_Mail and then send the Email.
sub Commit {

    my $self = shift;

    my ( $retval, $MIMEObj ) = $self->Generate_Mail( @_ );

    if( $retval && $MIMEObj ){

	# Pull the Envelope-To header for who gets it.
	my @receipients_raw = ();
	@receipients_raw = $MIMEObj->head->get_all('Envelope-To');
	if( (scalar @receipients_raw ) <= 0 || ( ( scalar @receipients_raw ) == 1 && $receipients_raw[0] =~ /^\s*$/ ) ){
	    foreach my $this_header( 'To', 'Cc', 'Bcc' ){
		# Add this_header to the list of receipients
		my @tmp_result = $MIMEObj->head->get_all($this_header);
		foreach my $poppy( @tmp_result ){
		    $RT::Logger->debug("$self: Found X $poppy X in $this_header\n");
		    push @receipients_raw, $poppy;
		}
	    }
	    # splice( @receipients_raw, @receipients_raw, 0, @{$MIMEObj->head->get_all('To')} );
	    # splice( @receipients_raw, @receipients_raw, 0, @{$MIMEObj->head->get_all('Cc')} );
	    # splice( @receipients_raw, @receipients_raw, 0, @{$MIMEObj->head->get_all('Bcc')} );
	}else{
	    $RT::Logger->debug("$self: Envelope-To was defined as " . $MIMEObj->head->get('Envelope-To') . "\n" );
	}

	my @receipients = ();
	if( (scalar @receipients_raw) > 0 ){
	    # Delete the Envelope-To header - it doesn't go out.
	    # ( purely used as a mechanism for having the 'To', 'Cc' headers
	    #   different from who we're actually sending it to. )
	    $MIMEObj->head->delete('Envelope-To');

	    # For each record in @receipients_raw, use Mail::Address to get
	    # the actual address.  Don't want to be messing with fancy names.
	    use Mail::Address;

	    # Only put each address in once.
	    my %tmp_uniq_cache = ();

	    foreach my $rec ( @receipients_raw ){
		$RT::Logger->debug("$self: value from receipients_raw is $rec\n");
	        my @tmp_addrs = Mail::Address->parse( $rec );
	        foreach my $tmp_addr ( @tmp_addrs ){
		    my $tmp_result = $tmp_addr->address;
		    chomp $tmp_result;
		    $tmp_result =~ s/^\s*//g;
		    $tmp_result =~ s/\s*$//g;
		    $tmp_uniq_cache{"$tmp_result"}++;
		    if( $tmp_uniq_cache{"$tmp_result"} == 1 ){
 		        push @receipients, $tmp_result;
		    }else{
			$RT::Logger->debug("$self: Will not add $tmp_result to receipient list multiple times\n");
		    }
		}
	    }
	} 

	if( (scalar @receipients) <= 0 ){
	    # This bit of code should never be executed.
	    $RT::Logger->debug("$self: No recipients found in Commit(). Not sending.\n");
	    return(0);
	}   # We don't need to uniq the list, as we've done that previously.
	 else{
	    foreach my $val ( @receipients ){
		$RT::Logger->debug("$self: Will attempt to send to $val\n");
	    }
	}

	$RT::Logger->debug("$self: About to send.  Message will be:\n" . $MIMEObj->as_string . "\n--END OF MESSAGE\n");

	# if ($RT::MailCommand eq 'smtp' || 1 == 1 ){
	if ($RT::MailCommand eq 'smtp' ){
	    $RT::Logger->debug("$self: Attempting sending via smtp\n");

	    # This is overly complex because I'm trying to catch too many
	    # possible error conditions.  Should put this in a seperate
	    # subroutine.

	    my @done_so_far = ();

	    # How many addresses should we try to send at once?
	    my $max_in_one_try = ${$RT::SMTPOptions{"max_rcpt_to"}};

	    my $retries_so_far = 0;

	    my $max_retries = ${$RT::SMTPOptions{"retries"}};
	    $RT::Logger->debug("$self: max_retries is $max_retries\n");

	    while( ( ( scalar @done_so_far ) <= ( scalar @receipients ) ) && ( ( scalar @receipients ) > 0 ) && ( $retries_so_far < $max_retries ) ){

		$RT::Logger->debug("$self: On Retry $retries_so_far\n") if( $retries_so_far > 0 );
		my @these_servers = split( /,\s+/, ${$RT::SMTPOptions{"serverlist"}} );

		# Ramp down the max_in_one_try in case thats a problem.
		$max_in_one_try = int( $max_in_one_try / 2 ) if( $retries_so_far > 1 );

		$max_in_one_try = 1 if( $max_in_one_try < 1 || $retries_so_far > 2 );

		$RT::Logger->debug("$self: Going to send to $max_in_one_try receipients\n");
		$RT::Logger->crit("$self: Going to send to $max_in_one_try receipient.  Check MTA\n") if( $max_in_one_try == 1 );

		foreach my $this_host ( @these_servers ){
	   
		    # build an acceptable list of receipients from whats left.
		    my $loop = 0;
		    my @these_receipients = ();
		    while( ( $loop < $max_in_one_try ) && ( $loop < ( scalar @receipients ) ) ){
			$these_receipients[$loop] = $receipients[$loop];
		        $RT::Logger->debug("$self: Queuing for $these_receipients[$loop] via $this_host\n");
			$loop++;
		    }

		    my $this_host_ok = 1;
		    while( $this_host_ok > 0 && ( scalar @these_receipients ) > 0 ){

	    		my @sent_to = $MIMEObj->smtpsend(   'Host' => $this_host ,
						'Hello' => $RT::rtname,
						'To' => @these_receipients );

			# Work out who got 'em.
			foreach my $this_addr( @sent_to ){
			    $RT::Logger->debug("$self: Sent to $this_addr via $this_host\n");
			    next if( ! defined( $this_addr ) );
			    next if( $this_addr =~ /^\s*$/ );
			    # Find this address in the original receipients
			    # then remove it from @receipients, then add it
			    # to @done_so_far.
			    push @done_so_far, $this_addr;
			    my $this_loop = 0;
			    while( $this_loop < scalar @these_receipients ){
				if( lc( $this_addr ) eq lc( $these_receipients[$this_loop] ) ){
				    splice( @these_receipients, $this_loop, 1 );
				    last;
				}else{
				    $this_loop++;
				}
			    }
			    $this_loop = 0;
			    while( $this_loop < scalar @receipients ){
				if( lc( $this_addr ) eq lc( $receipients[$this_loop] ) ){
				    splice( @these_receipients, $this_loop, 1 );
				    last;
				}else{
				    $this_loop++;
				}
			    }
			}

			# We keep trying this host until we get an empty string
			# back. 
			if( ( scalar @sent_to ) == 0 ){
			    $this_host_ok=0;
			}
		    }
		}
		# If we didn't send to all of them on this run.
		if( ( scalar @receipients ) > 0 ){
		    # We need to try again.
		    $retries_so_far++;
		}
	    }
	    # Now what?
	    if( ( scalar @receipients ) > 0 ){
		# Oh dear.
		$RT::Logger->crit("$self: Sending via smtp completed with " . scalar @receipients . " receipients still to go.  This is bad.\n" );
		# XXXX - About here we invoke ScripPending.
	    }else{
		$RT::Logger->debug("$self: Sending via smtp completed successfully, sent to " . scalar @done_so_far . " receipients.\n" );
	    }
        }elsif ($RT::MailCommand eq 'sendmailpipe' ) {
	    # Build a command up with all of the real receipients.
	    my $cmd = $RT::SendmailPath . " " . $RT::SendmailArguments . " " . join(' ', @receipients );
	    if( $cmd =~ m/-t/ ){
		$RT::Logger->debug("$self: -t in RT::SendmailArguments removed.\n");
	        $cmd =~ s/\-t//g;
	    }
	    $RT::Logger->debug("$self: Attempting to send via $RT::MailCommand and $cmd\n");
	    # open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0);
	    open (MAIL, "|$cmd") || return(0);
	    print MAIL $MIMEObj->as_string;
	    close(MAIL);
        }elsif ($RT::MailCommand eq 'sendmail') {
	    my $mailparams = $RT::MailParams . " " . join(' ', @receipients);
	    if( $mailparams =~ m/-t/ ){
		$RT::Logger->debug("$self: -t in RT::MailParams removed.\n");
	        $mailparams =~ s/\-t//g;
            }
	    if( ! defined( $ENV{PERL_MAILERS} ) && defined( $RT::PrivateSendmail ) && defined( $RT::SendmailPath ) ){
		# Set up the environment - see Mail::Mailers.
		$ENV{PERL_MAILERS} = "sendmail:" . $RT::PrivateSendmail . ";" . $RT::SendmailPath . ":";
		$RT::Logger->debug("$self: Setting ENV PERL_MAILERS to be " . $ENV{"PERL_MAILERS"} . "\n" );
	    }
	    # unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) {
	    $RT::Logger->debug("$self: Attempting to send via $RT::MailCommand and $mailparams\n");
	    unless ($MIMEObj->send($RT::MailCommand, $mailparams)) {
	        $RT::Logger->crit("$self: Could not send mail for ".
			          $self->TransactionObj . "\n");
	        return(0);
	    }
        }else{
	    $RT::Logger->crit("$self: RT::MailCommand has nonsense in it.  Should be one of smtp, sendmailpipe or sendmail (cases-sensitive).  This message not sent.\n");
	    return(0);
	}
        return (1);
    }else{
        return (0);
    }
    
}
# }}}

# {{{ 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',"Request Tracker $RT::VERSION (http://www.fsck.com/projects/rt/)");
   
    # We shouldn't give out people's personal email addresses.
    # If they're priv'd, give their User number. 
    # if( $self->TransactionObj->CreatorObj->IsPrivileged ){
    if( $self->TransactionObj->CreatorObj->Privileged > 0 ){
        $self->SetHeader('RT-Originator', "RT::User " . $self->TransactionObj->CreatorObj->id );
    }else{
        $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 $RT::rtname should be replaced by $RT::hostname to form valid
  # message-ids (ref rfc822)

  # 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#"

  # TODO $RT::rtname should be replaced by $RT::hostname to form valid
  # message-ids (ref rfc822)
  
  $self->SetHeader
    ('Message-ID', "<rt-".$self->TicketObj->id().
     "-".
     $self->TransactionObj->id()."." .rand(20) . "\@".$RT::rtname.">")
      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;
      # 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;

  $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;

    # Should we de-re this here?
    if( $subject =~ /re:/i ){
        $subject =~ s/re:\s*//gi;
        $subject =~ s/^/Re: /g;
    }

    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;
    $sub = $tag . " " . $sub;
    if( $subject =~ /re:/i ){
        $subject =~ s/re:\s*//gi;
        $subject =~ s/^/Re: /g;
    }
    $self->TemplateObj->MIMEObj->head->replace('Subject', "$sub");
  }
}

# }}}

# }}}

__END__

# {{{ POD

# }}}

1;

-------------- next part --------------
#!/usr/bin/perl -w
#

package RT;
use strict;
use vars qw($VERSION $Handle $Nobody $SystemUser $item);

use lib "/home/rt2/lib";
use lib "/home/rt2/etc";

#This drags in  RT's config.pm
use config;
use Carp;

use RT::Handle;
use RT::User;
use RT::CurrentUser;

#connect to the db
$RT::Handle = new RT::Handle($RT::DatabaseType);
$RT::Handle->Connect();


#Put together a current user object so we can create a User object
my $CurrentUser = new RT::CurrentUser();


#now that we bootstrapped that little bit, we can use the standard RT cli
# helpers  to do what we need

use RT::Interface::CLI  qw(CleanEnv LoadConfig DBConnect 
			   GetCurrentUser GetMessageContent);

#Clean out all the nasties from the environment
CleanEnv();

#Load etc/config.pm and drop privs
LoadConfig();

#Connect to the database and get RT::SystemUser and RT::Nobody loaded
DBConnect();


$CurrentUser->LoadByName('RT_System');

# {{{ ScripActions

my @ScripActions = (
		       {
			Name => 'BC_NotifyAdminCcs',
			Description =>  'BCs version of Sends mail to the administrative Ccs',
			ExecModule => 'BC_Notify',
			Argument =>  'AdminCc',
		       },
		       
		       
		      );

# }}}
print "Creating ScripActions...";

use RT::ScripAction;
for $item (@ScripActions) {
    my $new_entry = new RT::ScripAction($CurrentUser);
    my $return = $new_entry->Create(%$item);
    print $return.".";
}

print "done.\n";

$RT::Handle->Disconnect();


1;



More information about the rt-users mailing list