[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