rt/lib/RT/Scrip_Overlay.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/copyleft/gpl.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48 =head1 NAME
  49
  50   RT::Scrip - an RT Scrip object
  51
  52 =head1 SYNOPSIS
  53
  54   use RT::Scrip;
  55
  56 =head1 DESCRIPTION
  57
  58
  59 =head1 METHODS
  60
  61 =begin testing
  62
  63 ok (require RT::Scrip);
  64
  65
  66 my $q = RT::Queue->new($RT::SystemUser);
  67 $q->Create(Name => 'ScripTest');
  68 ok($q->Id, "Created a scriptest queue");
  69
  70 my $s1 = RT::Scrip->new($RT::SystemUser);
  71 my ($val, $msg) =$s1->Create( Queue => $q->Id,
  72              ScripAction => 'User Defined',
  73              ScripCondition => 'User Defined',
  74              CustomIsApplicableCode => 'if ($self->TicketObj->Subject =~ /fire/) { return (1);} else { return(0)}',
  75              CustomPrepareCode => 'return 1',
  76              CustomCommitCode => '$self->TicketObj->SetPriority("87");',
  77              Template => 'Blank'
  78     );
  79 ok($val,$msg);
  80
  81 my $ticket = RT::Ticket->new($RT::SystemUser);
  82 my ($tv,$ttv,$tm) = $ticket->Create(Queue => $q->Id,
  83                                     Subject => "hair on fire",
  84                                     );
  85 ok($tv, $tm);
  86
  87 ok ($ticket->Priority == '87', "Ticket priority is set right");
  88
  89
  90 my $ticket2 = RT::Ticket->new($RT::SystemUser);
  91 my ($t2v,$t2tv,$t2m) = $ticket2->Create(Queue => $q->Id,
  92                                     Subject => "hair in water",
  93                                     );
  94 ok($t2v, $t2m);
  95
  96 ok ($ticket2->Priority != '87', "Ticket priority is set right");
  97
  98
  99 =end testing
 100
 101 =cut
 102
 103
 104 package RT::Scrip;
 105
 106 use strict;
 107 no warnings qw(redefine);
 108
 109 # {{{ sub Create
 110
 111 =head2 Create
 112
 113 Creates a new entry in the Scrips table. Takes a paramhash with:
 114
 115         Queue                  => 0,
 116         Description            => undef,
 117         Template               => undef,
 118         ScripAction            => undef,
 119         ScripCondition         => undef,
 120         CustomPrepareCode      => undef,
 121         CustomCommitCode       => undef,
 122         CustomIsApplicableCode => undef,
 123
 124
 125
 126
 127 Returns (retval, msg);
 128 retval is 0 for failure or scrip id.  msg is a textual description of what happened.
 129
 130 =cut
 131
 132 sub Create {
 133     my $self = shift;
 134     my %args = (
 135         Queue                  => 0,
 136         Template               => 0,                     # name or id
 137         ScripAction            => 0,                     # name or id
 138         ScripCondition         => 0,                     # name or id
 139         Stage                  => 'TransactionCreate',
 140         Description            => undef,
 141         CustomPrepareCode      => undef,
 142         CustomCommitCode       => undef,
 143         CustomIsApplicableCode => undef,
 144         @_
 145     );
 146
 147     unless ( $args{'Queue'} ) {
 148         unless ( $self->CurrentUser->HasRight( Object => $RT::System,
 149                                                Right  => 'ModifyScrips' )
 150           ) {
 151             return ( 0, $self->loc('Permission Denied') );
 152         }
 153         $args{'Queue'} = 0;    # avoid undef sneaking in
 154     }
 155     else {
 156         my $QueueObj = RT::Queue->new( $self->CurrentUser );
 157         $QueueObj->Load( $args{'Queue'} );
 158         unless ( $QueueObj->id ) {
 159             return ( 0, $self->loc('Invalid queue') );
 160         }
 161         unless ( $QueueObj->CurrentUserHasRight('ModifyScrips') ) {
 162             return ( 0, $self->loc('Permission Denied') );
 163         }
 164         $args{'Queue'} = $QueueObj->id();
 165     }
 166
 167     #TODO +++ validate input
 168
 169     require RT::ScripAction;
 170     return ( 0, $self->loc("Action is mandatory argument") )
 171         unless $args{'ScripAction'};
 172     my $action = RT::ScripAction->new( $self->CurrentUser );
 173     $action->Load( $args{'ScripAction'} );
 174     return ( 0, $self->loc( "Action [_1] not found", $args{'ScripAction'} ) )
 175         unless $action->Id;
 176
 177     require RT::Template;
 178     return ( 0, $self->loc("Template is mandatory argument") )
 179         unless $args{'Template'};
 180     my $template = RT::Template->new( $self->CurrentUser );
 181     $template->Load( $args{'Template'} );
 182     return ( 0, $self->loc('Template not found') )
 183         unless $template->Id;
 184
 185     require RT::ScripCondition;
 186     return ( 0, $self->loc("Condition is mandatory argument") )
 187         unless $args{'ScripCondition'};
 188     my $condition = RT::ScripCondition->new( $self->CurrentUser );
 189     $condition->Load( $args{'ScripCondition'} );
 190     return ( 0, $self->loc('Condition not found') )
 191         unless $condition->Id;
 192
 193     my ( $id, $msg ) = $self->SUPER::Create(
 194         Queue                  => $args{'Queue'},
 195         Template               => $template->Id,
 196         ScripCondition         => $condition->id,
 197         Stage                  => $args{'Stage'},
 198         ScripAction            => $action->Id,
 199         Description            => $args{'Description'},
 200         CustomPrepareCode      => $args{'CustomPrepareCode'},
 201         CustomCommitCode       => $args{'CustomCommitCode'},
 202         CustomIsApplicableCode => $args{'CustomIsApplicableCode'},
 203     );
 204     if ( $id ) {
 205         return ( $id, $self->loc('Scrip Created') );
 206     }
 207     else {
 208         return ( $id, $msg );
 209     }
 210 }
 211
 212 # }}}
 213
 214 # {{{ sub Delete
 215
 216 =head2 Delete
 217
 218 Delete this object
 219
 220 =cut
 221
 222 sub Delete {
 223     my $self = shift;
 224
 225     unless ( $self->CurrentUserHasRight('ModifyScrips') ) {
 226         return ( 0, $self->loc('Permission Denied') );
 227     }
 228
 229     return ( $self->SUPER::Delete(@_) );
 230 }
 231
 232 # }}}
 233
 234 # {{{ sub QueueObj
 235
 236 =head2 QueueObj
 237
 238 Retuns an RT::Queue object with this Scrip\'s queue
 239
 240 =cut
 241
 242 sub QueueObj {
 243     my $self = shift;
 244
 245     if ( !$self->{'QueueObj'} ) {
 246         require RT::Queue;
 247         $self->{'QueueObj'} = RT::Queue->new( $self->CurrentUser );
 248         $self->{'QueueObj'}->Load( $self->__Value('Queue') );
 249     }
 250     return ( $self->{'QueueObj'} );
 251 }
 252
 253 # }}}
 254
 255 # {{{ sub ActionObj
 256
 257 =head2 ActionObj
 258
 259 Retuns an RT::Action object with this Scrip\'s Action
 260
 261 =cut
 262
 263 sub ActionObj {
 264     my $self = shift;
 265
 266     unless ( defined $self->{'ScripActionObj'} ) {
 267         require RT::ScripAction;
 268
 269         $self->{'ScripActionObj'} = RT::ScripAction->new( $self->CurrentUser );
 270
 271         #TODO: why are we loading Actions with templates like this.
 272         # two separate methods might make more sense
 273         $self->{'ScripActionObj'}->Load( $self->ScripAction, $self->Template );
 274     }
 275     return ( $self->{'ScripActionObj'} );
 276 }
 277
 278 # }}}
 279
 280 # {{{ sub ConditionObj
 281
 282 =head2 ConditionObj
 283
 284 Retuns an RT::ScripCondition object with this Scrip's IsApplicable
 285
 286 =cut
 287
 288 sub ConditionObj {
 289     my $self = shift;
 290
 291     unless ( defined $self->{'ScripConditionObj'} ) {
 292         require RT::ScripCondition;
 293         $self->{'ScripConditionObj'} =
 294           RT::ScripCondition->new( $self->CurrentUser );
 295         if ( $self->ScripCondition ) {
 296             $self->{'ScripConditionObj'}->Load( $self->ScripCondition );
 297         }
 298     }
 299     return ( $self->{'ScripConditionObj'} );
 300 }
 301
 302 # }}}
 303
 304 # {{{ sub TemplateObj
 305
 306 =head2 TemplateObj
 307
 308 Retuns an RT::Template object with this Scrip\'s Template
 309
 310 =cut
 311
 312 sub TemplateObj {
 313     my $self = shift;
 314
 315     unless ( defined $self->{'TemplateObj'} ) {
 316         require RT::Template;
 317         $self->{'TemplateObj'} = RT::Template->new( $self->CurrentUser );
 318         $self->{'TemplateObj'}->Load( $self->Template );
 319     }
 320     return ( $self->{'TemplateObj'} );
 321 }
 322
 323 # }}}
 324
 325 # {{{ Dealing with this instance of a scrip
 326
 327 # {{{ sub Apply
 328
 329 =head2 Apply { TicketObj => undef, TransactionObj => undef}
 330
 331 This method instantiates the ScripCondition and ScripAction objects for a
 332 single execution of this scrip. it then calls the IsApplicable method of the
 333 ScripCondition.
 334 If that succeeds, it calls the Prepare method of the
 335 ScripAction. If that succeeds, it calls the Commit method of the ScripAction.
 336
 337 Usually, the ticket and transaction objects passed to this method
 338 should be loaded by the SuperUser role
 339
 340 =cut
 341
 342
 343 # XXX TODO : This code appears to be obsoleted in favor of similar code in Scrips->Apply.
 344 # Why is this here? Is it still called?
 345
 346 sub Apply {
 347     my $self = shift;
 348     my %args = ( TicketObj      => undef,
 349                  TransactionObj => undef,
 350                  @_ );
 351
 352     $RT::Logger->debug("Now applying scrip ".$self->Id . " for transaction ".$args{'TransactionObj'}->id);
 353
 354     my $ApplicableTransactionObj = $self->IsApplicable( TicketObj      => $args{'TicketObj'},
 355                                                         TransactionObj => $args{'TransactionObj'} );
 356     unless ( $ApplicableTransactionObj ) {
 357         return undef;
 358     }
 359
 360     if ( $ApplicableTransactionObj->id != $args{'TransactionObj'}->id ) {
 361         $RT::Logger->debug("Found an applicable transaction ".$ApplicableTransactionObj->Id . " in the same batch with transaction ".$args{'TransactionObj'}->id);
 362     }
 363
 364     #If it's applicable, prepare and commit it
 365     $RT::Logger->debug("Now preparing scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
 366     unless ( $self->Prepare( TicketObj      => $args{'TicketObj'},
 367                              TransactionObj => $ApplicableTransactionObj )
 368       ) {
 369         return undef;
 370     }
 371
 372     $RT::Logger->debug("Now commiting scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
 373     unless ( $self->Commit( TicketObj => $args{'TicketObj'},
 374                             TransactionObj => $ApplicableTransactionObj)
 375       ) {
 376         return undef;
 377     }
 378
 379     $RT::Logger->debug("We actually finished scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
 380     return (1);
 381
 382 }
 383
 384 # }}}
 385
 386 # {{{ sub IsApplicable
 387
 388 =head2 IsApplicable
 389
 390 Calls the  Condition object\'s IsApplicable method
 391
 392 Upon success, returns the applicable Transaction object.
 393 Otherwise, undef is returned.
 394
 395 If the Scrip is in the TransactionCreate Stage (the usual case), only test
 396 the associated Transaction object to see if it is applicable.
 397
 398 For Scrips in the TransactionBatch Stage, test all Transaction objects
 399 created during the Ticket object's lifetime, and returns the first one
 400 that is applicable.
 401
 402 =cut
 403
 404 sub IsApplicable {
 405     my $self = shift;
 406     my %args = ( TicketObj      => undef,
 407                  TransactionObj => undef,
 408                  @_ );
 409
 410     my $return;
 411     eval {
 412
 413         my @Transactions;
 414
 415         if ( $self->Stage eq 'TransactionCreate') {
 416             # Only look at our current Transaction
 417             @Transactions = ( $args{'TransactionObj'} );
 418         }
 419         elsif ( $self->Stage eq 'TransactionBatch') {
 420             # Look at all Transactions in this Batch
 421             @Transactions = @{ $args{'TicketObj'}->TransactionBatch || [] };
 422         }
 423         else {
 424             $RT::Logger->error( "Unknown Scrip stage:" . $self->Stage );
 425             return (undef);
 426         }
 427         my $ConditionObj = $self->ConditionObj;
 428         foreach my $TransactionObj ( @Transactions ) {
 429             # in TxnBatch stage we can select scrips that are not applicable to all txns
 430             my $txn_type = $TransactionObj->Type;
 431             next unless( $ConditionObj->ApplicableTransTypes =~ /(?:^|,)(?:Any|\Q$txn_type\E)(?:,|$)/i );
 432             # Load the scrip's Condition object
 433             $ConditionObj->LoadCondition(
 434                 ScripObj       => $self,
 435                 TicketObj      => $args{'TicketObj'},
 436                 TransactionObj => $TransactionObj,
 437             );
 438
 439             if ( $ConditionObj->IsApplicable() ) {
 440                 # We found an application Transaction -- return it
 441                 $return = $TransactionObj;
 442                 last;
 443             }
 444         }
 445     };
 446     if ($@) {
 447         $RT::Logger->error( "Scrip IsApplicable " . $self->Id . " died. - " . $@ );
 448         return (undef);
 449     }
 450
 451             return ($return);
 452
 453 }
 454
 455 # }}}
 456
 457 # {{{ SUb Prepare
 458
 459 =head2 Prepare
 460
 461 Calls the action object's prepare method
 462
 463 =cut
 464
 465 sub Prepare {
 466     my $self = shift;
 467     my %args = ( TicketObj      => undef,
 468                  TransactionObj => undef,
 469                  @_ );
 470
 471     my $return;
 472     eval {
 473         $self->ActionObj->LoadAction( ScripObj       => $self,
 474                                       TicketObj      => $args{'TicketObj'},
 475                                       TransactionObj => $args{'TransactionObj'},
 476         );
 477
 478         $return = $self->ActionObj->Prepare();
 479     };
 480     if ($@) {
 481         $RT::Logger->error( "Scrip Prepare " . $self->Id . " died. - " . $@ );
 482         return (undef);
 483     }
 484         unless ($return) {
 485         }
 486         return ($return);
 487 }
 488
 489 # }}}
 490
 491 # {{{ sub Commit
 492
 493 =head2 Commit
 494
 495 Calls the action object's commit method
 496
 497 =cut
 498
 499 sub Commit {
 500     my $self = shift;
 501     my %args = ( TicketObj      => undef,
 502                  TransactionObj => undef,
 503                  @_ );
 504
 505     my $return;
 506     eval {
 507         $return = $self->ActionObj->Commit();
 508     };
 509
 510 #Searchbuilder caching isn't perfectly coherent. got to reload the ticket object, since it
 511 # may have changed
 512     $args{'TicketObj'}->Load( $args{'TicketObj'}->Id );
 513
 514     if ($@) {
 515         $RT::Logger->error( "Scrip Commit " . $self->Id . " died. - " . $@ );
 516         return (undef);
 517     }
 518
 519     # Not destroying or weakening hte Action and Condition here could cause a
 520     # leak
 521
 522     return ($return);
 523 }
 524
 525 # }}}
 526
 527 # }}}
 528
 529 # {{{ ACL related methods
 530
 531 # {{{ sub _Set
 532
 533 # does an acl check and then passes off the call
 534 sub _Set {
 535     my $self = shift;
 536
 537     unless ( $self->CurrentUserHasRight('ModifyScrips') ) {
 538         $RT::Logger->debug(
 539                  "CurrentUser can't modify Scrips for " . $self->Queue . "\n" );
 540         return ( 0, $self->loc('Permission Denied') );
 541     }
 542     return $self->__Set(@_);
 543 }
 544
 545 # }}}
 546
 547 # {{{ sub _Value
 548 # does an acl check and then passes off the call
 549 sub _Value {
 550     my $self = shift;
 551
 552     unless ( $self->CurrentUserHasRight('ShowScrips') ) {
 553         $RT::Logger->debug( "CurrentUser can't modify Scrips for "
 554                             . $self->__Value('Queue')
 555                             . "\n" );
 556         return (undef);
 557     }
 558
 559     return $self->__Value(@_);
 560 }
 561
 562 # }}}
 563
 564 # {{{ sub CurrentUserHasRight
 565
 566 =head2 CurrentUserHasRight
 567
 568 Helper menthod for HasRight. Presets Principal to CurrentUser then
 569 calls HasRight.
 570
 571 =cut
 572
 573 sub CurrentUserHasRight {
 574     my $self  = shift;
 575     my $right = shift;
 576     return ( $self->HasRight( Principal => $self->CurrentUser->UserObj,
 577                               Right     => $right ) );
 578
 579 }
 580
 581 # }}}
 582
 583 # {{{ sub HasRight
 584
 585 =head2 HasRight
 586
 587 Takes a param-hash consisting of "Right" and "Principal"  Principal is
 588 an RT::User object or an RT::CurrentUser object. "Right" is a textual
 589 Right string that applies to Scrips.
 590
 591 =cut
 592
 593 sub HasRight {
 594     my $self = shift;
 595     my %args = ( Right     => undef,
 596                  Principal => undef,
 597                  @_ );
 598
 599     if ( $self->SUPER::_Value('Queue') ) {
 600         return $args{'Principal'}->HasRight(
 601             Right  => $args{'Right'},
 602             Object => $self->QueueObj
 603         );
 604     }
 605     else {
 606         return $args{'Principal'}->HasRight(
 607             Object => $RT::System,
 608             Right  => $args{'Right'},
 609         );
 610     }
 611 }
 612
 613 # }}}
 614
 615 # }}}
 616
 617 1;
 618