+=head2 ConditionObj
+
+Retuns an L<RT::ScripCondition> object with this Scrip's IsApplicable
+
+=cut
+
+sub ConditionObj {
+ my $self = shift;
+
+ my $res = RT::ScripCondition->new( $self->CurrentUser );
+ $res->Load( $self->ScripCondition );
+ return $res;
+}
+
+
+=head2 LoadModules
+
+Loads scrip's condition and action modules.
+
+=cut
+
+sub LoadModules {
+ my $self = shift;
+
+ $self->ConditionObj->LoadCondition;
+ $self->ActionObj->LoadAction;
+}
+
+
+=head2 TemplateObj
+
+Retuns an RT::Template object with this Scrip\'s Template
+
+=cut
+
+sub TemplateObj {
+ my $self = shift;
+
+ unless ( defined $self->{'TemplateObj'} ) {
+ require RT::Template;
+ $self->{'TemplateObj'} = RT::Template->new( $self->CurrentUser );
+ $self->{'TemplateObj'}->Load( $self->Template );
+ }
+ return ( $self->{'TemplateObj'} );
+}
+
+
+
+
+=head2 Apply { TicketObj => undef, TransactionObj => undef}
+
+This method instantiates the ScripCondition and ScripAction objects for a
+single execution of this scrip. it then calls the IsApplicable method of the
+ScripCondition.
+If that succeeds, it calls the Prepare method of the
+ScripAction. If that succeeds, it calls the Commit method of the ScripAction.
+
+Usually, the ticket and transaction objects passed to this method
+should be loaded by the SuperUser role
+
+=cut
+
+
+# XXX TODO : This code appears to be obsoleted in favor of similar code in Scrips->Apply.
+# Why is this here? Is it still called?
+
+sub Apply {
+ my $self = shift;
+ my %args = ( TicketObj => undef,
+ TransactionObj => undef,
+ @_ );
+
+ $RT::Logger->debug("Now applying scrip ".$self->Id . " for transaction ".$args{'TransactionObj'}->id);
+
+ my $ApplicableTransactionObj = $self->IsApplicable( TicketObj => $args{'TicketObj'},
+ TransactionObj => $args{'TransactionObj'} );
+ unless ( $ApplicableTransactionObj ) {
+ return undef;
+ }
+
+ if ( $ApplicableTransactionObj->id != $args{'TransactionObj'}->id ) {
+ $RT::Logger->debug("Found an applicable transaction ".$ApplicableTransactionObj->Id . " in the same batch with transaction ".$args{'TransactionObj'}->id);
+ }
+
+ #If it's applicable, prepare and commit it
+ $RT::Logger->debug("Now preparing scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
+ unless ( $self->Prepare( TicketObj => $args{'TicketObj'},
+ TransactionObj => $ApplicableTransactionObj )
+ ) {
+ return undef;
+ }
+
+ $RT::Logger->debug("Now commiting scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
+ unless ( $self->Commit( TicketObj => $args{'TicketObj'},
+ TransactionObj => $ApplicableTransactionObj)
+ ) {
+ return undef;
+ }
+
+ $RT::Logger->debug("We actually finished scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
+ return (1);
+
+}
+
+
+
+=head2 IsApplicable
+
+Calls the Condition object\'s IsApplicable method
+
+Upon success, returns the applicable Transaction object.
+Otherwise, undef is returned.
+
+If the Scrip is in the TransactionCreate Stage (the usual case), only test
+the associated Transaction object to see if it is applicable.
+
+For Scrips in the TransactionBatch Stage, test all Transaction objects
+created during the Ticket object's lifetime, and returns the first one
+that is applicable.
+
+=cut
+
+sub IsApplicable {
+ my $self = shift;
+ my %args = ( TicketObj => undef,
+ TransactionObj => undef,
+ @_ );
+
+ my $return;
+ eval {
+
+ my @Transactions;
+
+ if ( $self->Stage eq 'TransactionCreate') {
+ # Only look at our current Transaction
+ @Transactions = ( $args{'TransactionObj'} );
+ }
+ elsif ( $self->Stage eq 'TransactionBatch') {
+ # Look at all Transactions in this Batch
+ @Transactions = @{ $args{'TicketObj'}->TransactionBatch || [] };
+ }
+ else {
+ $RT::Logger->error( "Unknown Scrip stage:" . $self->Stage );
+ return (undef);
+ }
+ my $ConditionObj = $self->ConditionObj;
+ foreach my $TransactionObj ( @Transactions ) {
+ # in TxnBatch stage we can select scrips that are not applicable to all txns
+ my $txn_type = $TransactionObj->Type;
+ next unless( $ConditionObj->ApplicableTransTypes =~ /(?:^|,)(?:Any|\Q$txn_type\E)(?:,|$)/i );
+ # Load the scrip's Condition object
+ $ConditionObj->LoadCondition(
+ ScripObj => $self,
+ TicketObj => $args{'TicketObj'},
+ TransactionObj => $TransactionObj,
+ );
+
+ if ( $ConditionObj->IsApplicable() ) {
+ # We found an application Transaction -- return it
+ $return = $TransactionObj;
+ last;
+ }
+ }
+ };
+
+ if ($@) {
+ $RT::Logger->error( "Scrip IsApplicable " . $self->Id . " died. - " . $@ );
+ return (undef);
+ }
+
+ return ($return);
+
+}
+
+
+
+=head2 Prepare
+
+Calls the action object's prepare method
+
+=cut
+
+sub Prepare {
+ my $self = shift;
+ my %args = ( TicketObj => undef,
+ TransactionObj => undef,
+ @_ );
+
+ my $return;
+ eval {
+ $self->ActionObj->LoadAction( ScripObj => $self,
+ TicketObj => $args{'TicketObj'},
+ TransactionObj => $args{'TransactionObj'},
+ );
+
+ $return = $self->ActionObj->Prepare();
+ };
+ if ($@) {
+ $RT::Logger->error( "Scrip Prepare " . $self->Id . " died. - " . $@ );
+ return (undef);
+ }
+ unless ($return) {
+ }
+ return ($return);
+}
+
+
+
+=head2 Commit
+
+Calls the action object's commit method
+
+=cut
+
+sub Commit {
+ my $self = shift;
+ my %args = ( TicketObj => undef,
+ TransactionObj => undef,
+ @_ );
+
+ my $return;
+ eval {
+ $return = $self->ActionObj->Commit();
+ };
+
+#Searchbuilder caching isn't perfectly coherent. got to reload the ticket object, since it
+# may have changed
+ $args{'TicketObj'}->Load( $args{'TicketObj'}->Id );
+
+ if ($@) {
+ $RT::Logger->error( "Scrip Commit " . $self->Id . " died. - " . $@ );
+ return (undef);
+ }
+
+ # Not destroying or weakening hte Action and Condition here could cause a
+ # leak
+
+ return ($return);
+}
+
+
+
+
+
+# does an acl check and then passes off the call
+sub _Set {
+ my $self = shift;
+ my %args = (
+ Field => undef,
+ Value => undef,
+ @_,
+ );
+
+ unless ( $self->CurrentUserHasRight('ModifyScrips') ) {
+ $RT::Logger->debug(
+ "CurrentUser can't modify Scrips for " . $self->Queue . "\n" );
+ return ( 0, $self->loc('Permission Denied') );
+ }
+
+
+ if (exists $args{Value}) {
+ if ($args{Field} eq 'CustomIsApplicableCode' || $args{Field} eq 'CustomPrepareCode' || $args{Field} eq 'CustomCommitCode') {
+ unless ( $self->CurrentUser->HasRight( Object => $RT::System,
+ Right => 'ExecuteCode' ) ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+ }
+ elsif ($args{Field} eq 'Queue') {
+ if ($args{Value}) {
+ # moving to another queue
+ my $queue = RT::Queue->new( $self->CurrentUser );
+ $queue->Load($args{Value});
+ unless ($queue->Id and $queue->CurrentUserHasRight('ModifyScrips')) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+ } else {
+ # moving to global
+ unless ($self->CurrentUser->HasRight( Object => RT->System, Right => 'ModifyScrips' )) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+ }
+ }
+ elsif ($args{Field} eq 'Template') {
+ my $template = RT::Template->new( $self->CurrentUser );
+ $template->Load($args{Value});
+ unless ($template->Id and $template->CurrentUserCanRead) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+ }
+ }
+
+ return $self->SUPER::_Set(@_);
+}
+
+
+# does an acl check and then passes off the call
+sub _Value {
+ my $self = shift;
+
+ unless ( $self->CurrentUserHasRight('ShowScrips') ) {
+ $RT::Logger->debug( "CurrentUser can't modify Scrips for "
+ . $self->__Value('Queue')
+ . "\n" );
+ return (undef);
+ }
+
+ return $self->__Value(@_);
+}
+
+
+
+=head2 CurrentUserHasRight
+
+Helper menthod for HasRight. Presets Principal to CurrentUser then
+calls HasRight.
+
+=cut
+
+sub CurrentUserHasRight {
+ my $self = shift;
+ my $right = shift;
+ return ( $self->HasRight( Principal => $self->CurrentUser->UserObj,
+ Right => $right ) );
+
+}
+
+
+
+=head2 HasRight
+
+Takes a param-hash consisting of "Right" and "Principal" Principal is
+an RT::User object or an RT::CurrentUser object. "Right" is a textual
+Right string that applies to Scrips.
+
+=cut
+
+sub HasRight {
+ my $self = shift;
+ my %args = ( Right => undef,
+ Principal => undef,
+ @_ );
+
+ if ( $self->SUPER::_Value('Queue') ) {
+ return $args{'Principal'}->HasRight(
+ Right => $args{'Right'},
+ Object => $self->QueueObj
+ );
+ }
+ else {
+ return $args{'Principal'}->HasRight(
+ Object => $RT::System,
+ Right => $args{'Right'},
+ );
+ }
+}
+
+
+
+=head2 CompileCheck
+
+This routine compile-checks the custom prepare, commit, and is-applicable code
+to see if they are syntactically valid Perl. We eval them in a codeblock to
+avoid actually executing the code.
+
+If one of the fields has a compile error, only the first is reported.
+
+Returns an (ok, message) pair.
+
+=cut
+
+sub CompileCheck {
+ my $self = shift;
+
+ for my $method (qw/CustomPrepareCode CustomCommitCode CustomIsApplicableCode/) {
+ my $code = $self->$method;
+ next if !defined($code);
+
+ do {
+ no strict 'vars';
+ eval "sub { $code }";
+ };
+ next if !$@;
+
+ my $error = $@;
+ return (0, $self->loc("Couldn't compile [_1] codeblock '[_2]': [_3]", $method, $code, $error));
+ }
+}
+
+
+=head2 SetScripAction
+
+=cut
+
+sub SetScripAction {
+ my $self = shift;
+ my $value = shift;
+
+ return ( 0, $self->loc("Action is mandatory argument") ) unless $value;
+
+ require RT::ScripAction;
+ my $action = RT::ScripAction->new( $self->CurrentUser );
+ $action->Load($value);
+ return ( 0, $self->loc( "Action '[_1]' not found", $value ) )
+ unless $action->Id;
+
+ return $self->_Set( Field => 'ScripAction', Value => $action->Id );
+}
+
+=head2 SetScripCondition
+
+=cut
+
+sub SetScripCondition {
+ my $self = shift;
+ my $value = shift;
+
+ return ( 0, $self->loc("Condition is mandatory argument") )
+ unless $value;
+
+ require RT::ScripCondition;
+ my $condition = RT::ScripCondition->new( $self->CurrentUser );
+ $condition->Load($value);
+
+ return ( 0, $self->loc( "Condition '[_1]' not found", $value ) )
+ unless $condition->Id;
+
+ return $self->_Set( Field => 'ScripCondition', Value => $condition->Id );
+}
+
+=head2 SetTemplate
+
+=cut
+
+sub SetTemplate {
+ my $self = shift;
+ my $value = shift;
+
+ return ( 0, $self->loc("Template is mandatory argument") ) unless $value;
+
+ require RT::Template;
+ my $template = RT::Template->new( $self->CurrentUser );
+ $template->Load($value);
+ return ( 0, $self->loc( "Template '[_1]' not found", $value ) )
+ unless $template->Id;
+
+ return $self->_Set( Field => 'Template', Value => $template->Id );
+}
+
+1;
+
+
+
+
+
+