diff options
Diffstat (limited to 'rt/lib/RT/Action')
-rwxr-xr-x | rt/lib/RT/Action/Autoreply.pm | 40 | ||||
-rwxr-xr-x | rt/lib/RT/Action/Generic.pm | 56 | ||||
-rwxr-xr-x | rt/lib/RT/Action/Notify.pm | 83 | ||||
-rwxr-xr-x | rt/lib/RT/Action/NotifyAsComment.pm | 34 | ||||
-rw-r--r-- | rt/lib/RT/Action/OpenDependent.pm | 55 | ||||
-rw-r--r-- | rt/lib/RT/Action/ResolveMembers.pm | 35 | ||||
-rwxr-xr-x | rt/lib/RT/Action/SendEmail.pm | 699 | ||||
-rwxr-xr-x | rt/lib/RT/Action/SendPasswordEmail.pm | 170 | ||||
-rw-r--r-- | rt/lib/RT/Action/StallDependent.pm | 68 |
9 files changed, 575 insertions, 665 deletions
diff --git a/rt/lib/RT/Action/Autoreply.pm b/rt/lib/RT/Action/Autoreply.pm index 81f7bddfa..624888e94 100755 --- a/rt/lib/RT/Action/Autoreply.pm +++ b/rt/lib/RT/Action/Autoreply.pm @@ -1,31 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Autoreply.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + package RT::Action::Autoreply; require RT::Action::SendEmail; - -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::SendEmail); @@ -41,7 +17,7 @@ Sets the recipients of this message to this ticket's Requestor. sub SetRecipients { my $self=shift; - push(@{$self->{'To'}}, $self->TicketObj->Requestors->MemberEmailAddresses); + push(@{$self->{'To'}}, @{$self->TicketObj->Requestors->Emails}); return(1); } @@ -63,7 +39,6 @@ sub SetReturnAddress { @_ ); - my $replyto; if ($args{'is_comment'}) { $replyto = $self->TicketObj->QueueObj->CommentAddress || $RT::CommentAddress; @@ -74,9 +49,7 @@ sub SetReturnAddress { } unless ($self->TemplateObj->MIMEObj->head->get('From')) { - my $friendly_name = $self->TicketObj->QueueObj->Description || - $self->TicketObj->QueueObj->Name; - $friendly_name =~ s/"/\\"/g; + my $friendly_name=$self->TicketObj->QueueObj->Name; $self->SetHeader('From', "\"$friendly_name\" <$replyto>"); } @@ -88,9 +61,4 @@ sub SetReturnAddress { # }}} -eval "require RT::Action::Autoreply_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Autoreply_Vendor.pm}); -eval "require RT::Action::Autoreply_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Autoreply_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/Generic.pm b/rt/lib/RT/Action/Generic.pm index 007d299c7..ecfd4ab1a 100755 --- a/rt/lib/RT/Action/Generic.pm +++ b/rt/lib/RT/Action/Generic.pm @@ -1,26 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Generic.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + =head1 NAME RT::Action::Generic - a generic baseclass for RT Actions @@ -35,6 +16,7 @@ =begin testing +ok (require RT::TestHarness); ok (require RT::Action::Generic); =end testing @@ -43,8 +25,6 @@ ok (require RT::Action::Generic); package RT::Action::Generic; -use strict; - # {{{ sub new sub new { my $proto = shift; @@ -56,13 +36,6 @@ sub new { } # }}} -# {{{ sub new -sub loc { - my $self = shift; - return $self->{'ScripObj'}->loc(@_); -} -# }}} - # {{{ sub _Init sub _Init { my $self = shift; @@ -114,13 +87,6 @@ sub TemplateObj { } # }}} -# {{{ sub ScripObj -sub ScripObj { - my $self = shift; - return($self->{'ScripObj'}); -} -# }}} - # {{{ sub Type sub Type { my $self = shift; @@ -136,7 +102,7 @@ sub Type { # {{{ sub Commit sub Commit { my $self = shift; - return(0, $self->loc("Commit Stubbed")); + return(0,"Commit Stubbed"); } # }}} @@ -146,7 +112,7 @@ sub Commit { # {{{ sub Describe sub Describe { my $self = shift; - return $self->loc("No description for [_1]", ref $self); + return ("No description for " . ref $self); } # }}} @@ -156,7 +122,7 @@ sub Describe { # {{{ sub Prepare sub Prepare { my $self = shift; - return (0, $self->loc("Prepare Stubbed")); + return (0,"Prepare Stubbed"); } # }}} @@ -186,10 +152,4 @@ sub DESTROY { } # }}} - -eval "require RT::Action::Generic_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Generic_Vendor.pm}); -eval "require RT::Action::Generic_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Generic_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/Notify.pm b/rt/lib/RT/Action/Notify.pm index 1e4e4c073..6dca4fd41 100755 --- a/rt/lib/RT/Action/Notify.pm +++ b/rt/lib/RT/Action/Notify.pm @@ -1,31 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Notify.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + package RT::Action::Notify; require RT::Action::SendEmail; - -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::SendEmail); # {{{ sub SetRecipients @@ -33,14 +9,14 @@ use vars qw/@ISA/; =head2 SetRecipients Sets the recipients of this meesage to Owner, Requestor, AdminCc, Cc or All. -Explicitly B<does not> notify the creator of the transaction by default +Explicitly B<does not> notify the creator of the transaction. =cut sub SetRecipients { my $self = shift; - my $arg = $self->Argument; + $arg = $self->Argument; $arg =~ s/\bAll\b/Owner,Requestor,AdminCc,Cc/; @@ -48,14 +24,14 @@ sub SetRecipients { if ($arg =~ /\bOtherRecipients\b/) { - if ($self->TransactionObj->Attachments->First) { - push (@Cc, $self->TransactionObj->Attachments->First->GetHeader('RT-Send-Cc')); - push (@Bcc, $self->TransactionObj->Attachments->First->GetHeader('RT-Send-Bcc')); + if ($self->TransactionObj->Message->First) { + push (@Cc, $self->TransactionObj->Message->First->GetHeader('RT-Send-Cc')); + push (@Bcc, $self->TransactionObj->Message->First->GetHeader('RT-Send-Bcc')); } } if ( $arg =~ /\bRequestor\b/ ) { - push ( @To, $self->TicketObj->Requestors->MemberEmailAddresses ); + push ( @To, @{ $self->TicketObj->Requestors->Emails } ); } @@ -64,12 +40,12 @@ sub SetRecipients { #If we have a To, make the Ccs, Ccs, otherwise, promote them to To if (@To) { - push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); - push ( @Cc, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); + push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); + push ( @Cc, @{ $self->TicketObj->QueueObj->Cc->Emails } ); } else { - push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); - push ( @To, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); + push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); + push ( @To, @{ $self->TicketObj->QueueObj->Cc->Emails } ); } } @@ -89,16 +65,15 @@ sub SetRecipients { } if ( $arg =~ /\bAdminCc\b/ ) { - push ( @Bcc, $self->TicketObj->AdminCc->MemberEmailAddresses ); - push ( @Bcc, $self->TicketObj->QueueObj->AdminCc->MemberEmailAddresses ); + push ( @Bcc, @{ $self->TicketObj->AdminCc->Emails } ); + push ( @Bcc, @{ $self->TicketObj->QueueObj->AdminCc->Emails } ); } if ($RT::UseFriendlyToLine) { unless (@To) { - push ( - @PseudoTo, - sprintf($RT::FriendlyToLineFormat, $arg, $self->TicketObj->id), - ); + push ( @PseudoTo, + "\"$arg of $RT::rtname Ticket #" + . $self->TicketObj->id . "\":;" ); } } @@ -106,17 +81,14 @@ sub SetRecipients { #Strip the sender out of the To, Cc and AdminCc and set the # recipients fields used to build the message by the superclass. - # unless a flag is set - if ($RT::NotifyActor) { - @{ $self->{'To'} } = @To; - @{ $self->{'Cc'} } = @Cc; - @{ $self->{'Bcc'} } = @Bcc; - } - else { - @{ $self->{'To'} } = grep ( !/^$creator$/, @To ); - @{ $self->{'Cc'} } = grep ( !/^$creator$/, @Cc ); - @{ $self->{'Bcc'} } = grep ( !/^$creator$/, @Bcc ); - } + + $RT::Logger->debug("$self: To is ".join(",",@To)); + $RT::Logger->debug("$self: Cc is ".join(",",@Cc)); + $RT::Logger->debug("$self: Bcc is ".join(",",@Bcc)); + + @{ $self->{'To'} } = grep ( !/^$creator$/, @To ); + @{ $self->{'Cc'} } = grep ( !/^$creator$/, @Cc ); + @{ $self->{'Bcc'} } = grep ( !/^$creator$/, @Bcc ); @{ $self->{'PseudoTo'} } = @PseudoTo; return (1); @@ -124,9 +96,4 @@ sub SetRecipients { # }}} -eval "require RT::Action::Notify_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Notify_Vendor.pm}); -eval "require RT::Action::Notify_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Notify_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/NotifyAsComment.pm b/rt/lib/RT/Action/NotifyAsComment.pm index 210e4ab15..c72bfff13 100755 --- a/rt/lib/RT/Action/NotifyAsComment.pm +++ b/rt/lib/RT/Action/NotifyAsComment.pm @@ -1,31 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/NotifyAsComment.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + package RT::Action::NotifyAsComment; require RT::Action::Notify; - -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::Notify); @@ -45,11 +21,5 @@ sub SetReturnAddress { return($self->SUPER::SetReturnAddress(is_comment => 1)); } - -eval "require RT::Action::NotifyAsComment_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyAsComment_Vendor.pm}); -eval "require RT::Action::NotifyAsComment_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyAsComment_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/OpenDependent.pm b/rt/lib/RT/Action/OpenDependent.pm new file mode 100644 index 000000000..b271e4709 --- /dev/null +++ b/rt/lib/RT/Action/OpenDependent.pm @@ -0,0 +1,55 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Attic/OpenDependent.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# This Action will open the BASE if a dependent is resolved. + +package RT::Action::OpenDependent; +require RT::Action::Generic; +require RT::Links; +@ISA=qw(RT::Action::Generic); + +#Do what we need to do and send it out. + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return (ref $self . " will stall a [local] BASE if it's open and a dependency link is created."); +} +# }}} + + +# {{{ sub Prepare +sub Prepare { + # nothing to prepare + return 1; +} +# }}} + +sub Commit { + my $self = shift; + + my $Links=RT::Links->new($RT::SystemUser); + $Links->Limit(FIELD => 'Type', VALUE => 'DependsOn'); + $Links->Limit(FIELD => 'Target', VALUE => $self->TicketObj->id); + + while (my $Link=$Links->Next()) { + next unless $Link->BaseIsLocal; + my $base=RT::Ticket->new($self->TicketObj->CurrentUser); + # Todo: Only work if Base is a plain ticket num: + $base->Load($Link->Base); + $base->Open if $base->Status eq 'stalled'; + } +} + + +# Applicability checked in Commit. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + 1; + return 1; +} +# }}} + +1; diff --git a/rt/lib/RT/Action/ResolveMembers.pm b/rt/lib/RT/Action/ResolveMembers.pm index 02ff3a58c..00547ebe8 100644 --- a/rt/lib/RT/Action/ResolveMembers.pm +++ b/rt/lib/RT/Action/ResolveMembers.pm @@ -1,34 +1,8 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK # This Action will resolve all members of a resolved group ticket package RT::Action::ResolveMembers; require RT::Action::Generic; require RT::Links; - -use strict; -use vars qw/@ISA/; @ISA=qw(RT::Action::Generic); #Do what we need to do and send it out. @@ -38,7 +12,7 @@ use vars qw/@ISA/; # {{{ sub Describe sub Describe { my $self = shift; - return $self->loc("[_1] will resolve all members of a resolved group ticket.", ref $self); + return (ref $self . " will resolve all members of a resolved group ticket."); } # }}} @@ -59,7 +33,7 @@ sub Commit { while (my $Link=$Links->Next()) { # Todo: Try to deal with remote URIs as well - next unless $Link->BaseURI->IsLocal; + next unless $Link->BaseIsLocal; my $base=RT::Ticket->new($self->TicketObj->CurrentUser); # Todo: Only work if Base is a plain ticket num: $base->Load($Link->Base); @@ -79,10 +53,5 @@ sub IsApplicable { } # }}} -eval "require RT::Action::ResolveMembers_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/ResolveMembers_Vendor.pm}); -eval "require RT::Action::ResolveMembers_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/ResolveMembers_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index dac8fc8e7..e3abb1154 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -1,44 +1,20 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $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; -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::Generic); -use MIME::Words qw(encode_mimeword); - -use RT::EmailParser; =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. + 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 @@ -60,6 +36,7 @@ the comments for the SetRecipients sub). =begin testing +ok (require RT::TestHarness); ok (require RT::Action::SendEmail); =end testing @@ -77,266 +54,158 @@ perl(1). # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) -# {{{ sub _Init +# {{{ sub _Init # We use _Init from RT::Action # }}} -# {{{ sub Commit +# {{{ sub Commit #Do what we need to do and send it out. -sub Commit { +sub Commit { my $self = shift; - - my $MIMEObj = $self->TemplateObj->MIMEObj; - my $msgid = $MIMEObj->head->get('Message-Id'); - chomp $msgid; - $RT::Logger->info($msgid." #".$self->TicketObj->id."/".$self->TransactionObj->id." - Scrip ". $self->ScripObj->id ." ".$self->ScripObj->Description); #send the email - - # Weed out any RT addresses. We really don't want to talk to ourselves! - @{$self->{'To'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'To'}}); - @{$self->{'Cc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Cc'}}); - @{$self->{'Bcc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Bcc'}}); + # 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->Attachments->First() ) { - - my $squelch = $self->TransactionObj->Attachments->First->GetHeader( 'RT-Squelch-Replies-To'); - - if ($squelch) { - my @blacklist = split ( /,/, $squelch ); - - # 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'} } ); - } - } + + 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 + + # 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; + - $self->SetHeader( 'To', join ( ',', @{ $self->{'To'} } ) ) - if ( $self->{'To'} && @{ $self->{'To'} } ); - $self->SetHeader( 'Cc', join ( ',', @{ $self->{'Cc'} } ) ) - if ( $self->{'Cc'} && @{ $self->{'Cc'} } ); - $self->SetHeader( 'Bcc', join ( ',', @{ $self->{'Bcc'} } ) ) - if ( $self->{'Cc'} && @{ $self->{'Bcc'} } ); - - - $self->SetHeader('MIME-Version', '1.0'); - - # try to convert message body from utf-8 to $RT::EmailOutputEncoding - $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' ); - - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' ); - $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' ); - - - # Build up a MIME::Entity that looks like the original message. - - my $do_attach = $self->TemplateObj->MIMEObj->head->get('RT-Attach-Message'); - - if ($do_attach) { - $self->TemplateObj->MIMEObj->head->delete('RT-Attach-Message'); - - my $attachments = RT::Attachments->new($RT::SystemUser); - $attachments->Limit( FIELD => 'TransactionId', - VALUE => $self->TransactionObj->Id ); - $attachments->OrderBy('id'); - - my $transaction_content_obj = $self->TransactionObj->ContentObj; - - # attach any of this transaction's attachments - while ( my $attach = $attachments->Next ) { - - # Don't attach anything blank - next unless ( $attach->ContentLength ); - - # We want to make sure that we don't include the attachment that's being sued as the "Content" of this message" - next - if ( $transaction_content_obj - && $transaction_content_obj->Id == $attach->Id - && $transaction_content_obj->ContentType =~ qr{text/plain}i - ); - $MIMEObj->make_multipart('mixed'); - $MIMEObj->attach( Type => $attach->ContentType, - Charset => $attach->OriginalEncoding, - Data => $attach->OriginalContent, - Filename => $self->MIMEEncodeString( $attach->Filename, $RT::EmailOutputEncoding ), - Encoding => '-SUGGEST'); - } - - } - - - my $retval = $self->SendMessage($MIMEObj); - - - return ($retval); -} - -# }}} - -# {{{ 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"); - - } - - my ( $result, $message ) = $self->TemplateObj->Parse( - Argument => $self->Argument, - TicketObj => $self->TicketObj, - TransactionObj => $self->TransactionObj - ); - if ($result) { - - # Header - $self->SetSubject(); - $self->SetSubjectToken(); - $self->SetRecipients(); - $self->SetReturnAddress(); - $self->SetRTSpecialHeaders(); - if ($RT::EmailOutputEncoding) { - - # l10n related header - $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding ); - } - } - - return $result; - -} - -# }}} - -# }}} - -# {{{ SendMessage -=head2 SendMessage MIMEObj - -sends the message using RT's preferred API. -TODO: Break this out to a seperate module - -=cut - -sub SendMessage { - my $self = shift; - my $MIMEObj = shift; - - my $msgid = $MIMEObj->head->get('Message-Id'); - - + $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->info($msgid. " No recipients found. Not sending.\n"); - return (1); + 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'} && ( @{ $self->{'PseudoTo'} } ) - and ( !$MIMEObj->head->get('To') ) ); - if ( $RT::MailCommand eq 'sendmailpipe' ) { - eval { - open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" ); - print MAIL $MIMEObj->as_string; - close(MAIL); - }; - if ($@) { - $RT::Logger->crit($msgid. "Could not send mail. -".$@ ); - } + $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 { - my @mailer_args = ($RT::MailCommand); - local $ENV{MAILADDRESS}; - - if ( $RT::MailCommand eq 'sendmail' ) { - push @mailer_args, $RT::SendmailArguments; - } - elsif ( $RT::MailCommand eq 'smtp' ) { - $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From'); - push @mailer_args, (Server => $RT::SMTPServer); - push @mailer_args, (Debug => $RT::SMTPDebug); - } - else { - push @mailer_args, $RT::MailParams; + unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) { + $RT::Logger->crit("$self: Could not send mail for ". + $self->TransactionObj . "\n"); + return(0); } - - unless ( $MIMEObj->send( @mailer_args ) ) { - $RT::Logger->crit($msgid. "Could not send mail." ); - return (0); - } } + + return (1); + +} +# }}} +# {{{ sub Prepare - my $success = ($msgid. " sent To: ".$MIMEObj->head->get('To') . " Cc: ".$MIMEObj->head->get('Cc') . " Bcc: ".$MIMEObj->head->get('Bcc')); - $success =~ s/\n//gi; - $RT::Logger->info($success); +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(); - return (1); + $self->SetRTSpecialHeaders(); + + return 1; + } # }}} +# }}} + # {{{ Deal with message headers (Set* subs, designed for easy overriding) # {{{ sub SetRTSpecialHeaders -=head2 SetRTSpecialHeaders - -This routine adds all the random headers that RT wants in a mail message -that don't matter much to anybody else. - -=cut +# 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://www.bestpractical.com/rt/)" ); + $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(); + +} - $self->SetHeader( 'RT-Originator', - $self->TransactionObj->CreatorObj->EmailAddress ); - return (); -} # {{{ sub SetReferences @@ -349,126 +218,105 @@ sub SetRTSpecialHeaders { =cut sub SetReferences { - my $self = shift; + 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. - # 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.">"); - $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. + # TODO We should always add References headers for all message-ids + # of previous messages related to this ticket. } # }}} # {{{ sub SetMessageID -=head2 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. - -=cut +# 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; + 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-" - . $RT::VERSION ."-" - . $self->TicketObj->id() . "-" - . $self->TransactionObj->id() . "." - . rand(20) . "\@" - . $RT::Organization . ">" ) + # 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 - -=head2 SetReturnAddress is_comment => BOOLEAN - -Calculate and set From and Reply-To headers based on the is_comment flag. +# }}} -=cut +# {{{ 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') ) { - if ($RT::UseFriendlyFromLine) { - my $friendly_name = $self->TransactionObj->CreatorObj->RealName; - if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string - $friendly_name = $1; - } - - $friendly_name =~ s/"/\\"/g; - $self->SetHeader( 'From', - sprintf($RT::FriendlyFromLineFormat, - $self->MIMEEncodeString( $friendly_name, $RT::EmailOutputEncoding ), $replyto), - ); - } - else { - $self->SetHeader( 'From', $replyto ); - } - } - - unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { - $self->SetHeader( 'Reply-To', "$replyto" ); - } - + 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 -=head2 SetHeader FIELD, VALUE - -Set the FIELD of the current MIME object into VALUE. - -=cut - 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->replace( $field, $val ); - return $self->TemplateObj->MIMEObj->head->get($field); + 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); } # }}} @@ -483,29 +331,21 @@ Dummy method to be overriden by subclasses which want to set the recipients. sub SetRecipients { my $self = shift; - return (); + return(); } # }}} # {{{ sub SetTo -=head2 SetTo - -Takes a string that is the addresses you want to send mail to - -=cut - sub SetTo { - my $self = shift; + my $self=shift; my $addresses = shift; - return $self->SetHeader( 'To', $addresses ); + return $self->SetHeader('To',$addresses); } - # }}} # {{{ sub SetCc - =head2 SetCc Takes a string that is the addresses you want to Cc @@ -513,12 +353,11 @@ Takes a string that is the addresses you want to Cc =cut sub SetCc { - my $self = shift; + my $self=shift; my $addresses = shift; - return $self->SetHeader( 'Cc', $addresses ); + return $self->SetHeader('Cc', $addresses); } - # }}} # {{{ sub SetBcc @@ -528,24 +367,23 @@ sub SetCc { Takes a string that is the addresses you want to Bcc =cut - sub SetBcc { - my $self = shift; + my $self=shift; my $addresses = shift; - return $self->SetHeader( 'Bcc', $addresses ); + return $self->SetHeader('Bcc', $addresses); } # }}} -# {{{ sub SetPrecedence +# {{{ sub SetPrecedence sub SetPrecedence { - my $self = shift; + my $self = shift; - unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ) { - $self->SetHeader( 'Precedence', "bulk" ); - } + unless ($self->TemplateObj->MIMEObj->head->get("Precedence")) { + $self->SetHeader('Precedence', "bulk"); + } } # }}} @@ -561,125 +399,70 @@ the transaction's subject. =cut sub SetSubject { - my $self = shift; + 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; - unless ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { - my $message = $self->TransactionObj->Attachments; - my $ticket = $self->TicketObj->Id; - - if ( $self->{'Subject'} ) { - $subject = $self->{'Subject'}; - } - elsif ( ( $message->First() ) - && ( $message->First->Headers ) ) { - my $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 ); - + chomp $subject; + $self->SetHeader('Subject',$subject); + } - return ($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. + 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" ); - } + 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"); + } } # }}} # }}} -# {{{ - -=head2 SetHeaderAsEncoding($field_name, $charset_encoding) - -This routine converts the field into specified charset encoding. - -=cut - -sub SetHeaderAsEncoding { - my $self = shift; - my ( $field, $enc ) = ( shift, shift ); - - if ($field eq 'From' and $RT::SMTPFrom) { - $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom ); - return; - } - - my $value = $self->TemplateObj->MIMEObj->head->get($field); - - # don't bother if it's us-ascii - - # See RT::I18N, 'NOTES: Why Encode::_utf8_off before Encode::from_to' - - $value = $self->MIMEEncodeString($value, $enc); - - $self->TemplateObj->MIMEObj->head->replace( $field, $value ); - - -} -# }}} - -# {{{ MIMENcodeString - -=head2 MIMEEncodeString STRING ENCODING - -Takes a string and a possible encoding and returns the string wrapped in MIME goo. - -=cut - -sub MIMEEncodeString { - my $self = shift; - my $value = shift; - my $enc = shift; +__END__ - chomp $value; - return ($value) unless $value =~ /[^\x20-\x7e]/; - - $value =~ s/\s*$//; - Encode::_utf8_off($value); - my $res = Encode::from_to( $value, "utf-8", $enc ); - $value = encode_mimeword( $value, 'B', $enc ); -} +# {{{ POD # }}} -eval "require RT::Action::SendEmail_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm}); -eval "require RT::Action::SendEmail_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/SendPasswordEmail.pm b/rt/lib/RT/Action/SendPasswordEmail.pm new file mode 100755 index 000000000..91bb3c1cb --- /dev/null +++ b/rt/lib/RT/Action/SendPasswordEmail.pm @@ -0,0 +1,170 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Attic/SendPasswordEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License + +package RT::Action::SendPasswordEmail; +require RT::Action::Generic; + +@ISA = qw(RT::Action::Generic); + + +=head1 NAME + + RT::Action::SendGenericEmail - An Action which users can use to send mail + or can subclassed for more specialized mail sending behavior. + + + +=head1 SYNOPSIS + + require RT::Action::SendPasswordEmail; + + +=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::SendPasswordEmail); + +=end testing + + +=head1 AUTHOR + +Jesse Vincent <jesse@bestpractical.com> + +=head1 SEE ALSO + +perl(1). + +=cut + +# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) + +# {{{ sub Commit + +#Do what we need to do and send it out. + +sub Commit { + my $self = shift; + #send the email + + + + + + 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')) { + $RT::Logger->debug("$self: No recipients found. Not sending.\n"); + return(1); + } + + 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->TemplateObj->MIMEObj->head->get('Reply-To')) { + $self->SetHeader('Reply-To',$RT::CorrespondAddress ); + } + + + $self->SetHeader('Precedence', "bulk"); + $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname); + $self->SetHeader + ('Managed-by',"Request Tracker $RT::VERSION (http://www.fsck.com/projects/rt/)"); + + $self->TemplateObj->Parse(Argument => $self->Argument); + + + return 1; +} + +# }}} + +# }}} + + +# {{{ sub SetTo + +=head2 SetTo EMAIL + +Sets this message's "To" field to EMAIL + +=cut + +sub SetTo { + my $self = shift; + my $to = shift; + $self->SetHeader('To',$to); +} + +# }}} + +# {{{ 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); +} + +# }}} + + + +__END__ + +# {{{ POD + +# }}} + +1; + diff --git a/rt/lib/RT/Action/StallDependent.pm b/rt/lib/RT/Action/StallDependent.pm new file mode 100644 index 000000000..09d3448a8 --- /dev/null +++ b/rt/lib/RT/Action/StallDependent.pm @@ -0,0 +1,68 @@ +# This Action will stall the BASE if a dependency or membership link +# (according to argument) is created and if BASE is open. + +# TODO: Rename this .pm + +package RT::Action::StallDependent; +require RT::Action::Generic; +@ISA=qw|RT::Action::Generic|; + +# {{{ sub Describe +sub Describe { + my $self = shift; + return (ref $self . " will stall a [local] BASE if it's dependent [or member] of a linked up request."); +} +# }}} + + +# {{{ sub Prepare +sub Prepare { + # nothing to prepare + return 1; +} +# }}} + +sub Commit { + my $self = shift; + # Find all Dependent + my $arg=$self->Argument || "DependsOn"; + unless ($self->TransactionObj->Data =~ /^([^ ]+) $arg /) { + warn; return 0; + } + my $base_id=$1; + my $base; + if ($1 eq "THIS") { + $base=$self->TicketObj; + } else { + $base_id=&RT::Link::_IsLocal(undef, $base_id) || return 0; + $base=RT::Ticket->new($self->TicketObj->CurrentUser); + $base->Load($base_id); + } + $base->Stall if $base->Status eq 'open'; + return 0; +} + + +# {{{ sub IsApplicable + +# Only applicable if: +# 1. the link action is a dependency +# 2. BASE is a local ticket + +sub IsApplicable { + my $self = shift; + + my $arg=$self->Argument || "DependsOn"; + + # 1: + $self->TransactionObj->Data =~ /^([^ ]*) $arg / || return 0; + + # 2: + # (dirty!) + &RT::Link::_IsLocal(undef,$1) || return 0; + + return 1; +} +# }}} + +1; |