torrus add router / interface, RT#10574
[freeside.git] / rt / lib / RT / Scrip_Overlay.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2
3 # COPYRIGHT:
4
5 # This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.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
49 =head1 NAME
50
51   RT::Scrip - an RT Scrip object
52
53 =head1 SYNOPSIS
54
55   use RT::Scrip;
56
57 =head1 DESCRIPTION
58
59
60 =head1 METHODS
61
62
63 =cut
64
65
66 package RT::Scrip;
67
68 use strict;
69 no warnings qw(redefine);
70
71 # {{{ sub Create
72
73 =head2 Create
74
75 Creates a new entry in the Scrips table. Takes a paramhash with:
76
77         Queue                  => 0,
78         Description            => undef,
79         Template               => undef,
80         ScripAction            => undef,
81         ScripCondition         => undef,
82         CustomPrepareCode      => undef,
83         CustomCommitCode       => undef,
84         CustomIsApplicableCode => undef,
85
86
87
88
89 Returns (retval, msg);
90 retval is 0 for failure or scrip id.  msg is a textual description of what happened.
91
92 =cut
93
94 sub Create {
95     my $self = shift;
96     my %args = (
97         Queue                  => 0,
98         Template               => 0,                     # name or id
99         ScripAction            => 0,                     # name or id
100         ScripCondition         => 0,                     # name or id
101         Stage                  => 'TransactionCreate',
102         Description            => undef,
103         CustomPrepareCode      => undef,
104         CustomCommitCode       => undef,
105         CustomIsApplicableCode => undef,
106         ConditionRules         => undef,
107         ActionRules            => undef,
108         @_
109     );
110
111     unless ( $args{'Queue'} ) {
112         unless ( $self->CurrentUser->HasRight( Object => $RT::System,
113                                                Right  => 'ModifyScrips' ) )
114         {
115             return ( 0, $self->loc('Permission Denied') );
116         }
117         $args{'Queue'} = 0;    # avoid undef sneaking in
118     }
119     else {
120         my $QueueObj = RT::Queue->new( $self->CurrentUser );
121         $QueueObj->Load( $args{'Queue'} );
122         unless ( $QueueObj->id ) {
123             return ( 0, $self->loc('Invalid queue') );
124         }
125         unless ( $QueueObj->CurrentUserHasRight('ModifyScrips') ) {
126             return ( 0, $self->loc('Permission Denied') );
127         }
128         $args{'Queue'} = $QueueObj->id;
129     }
130
131     #TODO +++ validate input
132
133     require RT::ScripAction;
134     return ( 0, $self->loc("Action is mandatory argument") )
135         unless $args{'ScripAction'};
136     my $action = RT::ScripAction->new( $self->CurrentUser );
137     $action->Load( $args{'ScripAction'} );
138     return ( 0, $self->loc( "Action '[_1]' not found", $args{'ScripAction'} ) ) 
139         unless $action->Id;
140
141     require RT::Template;
142     return ( 0, $self->loc("Template is mandatory argument") )
143         unless $args{'Template'};
144     my $template = RT::Template->new( $self->CurrentUser );
145     $template->Load( $args{'Template'} );
146     return ( 0, $self->loc( "Template '[_1]' not found", $args{'Template'} ) )
147         unless $template->Id;
148
149     require RT::ScripCondition;
150     return ( 0, $self->loc("Condition is mandatory argument") )
151         unless $args{'ScripCondition'};
152     my $condition = RT::ScripCondition->new( $self->CurrentUser );
153     $condition->Load( $args{'ScripCondition'} );
154     return ( 0, $self->loc( "Condition '[_1]' not found", $args{'ScripCondition'} ) )
155         unless $condition->Id;
156
157     my ( $id, $msg ) = $self->SUPER::Create(
158         Queue                  => $args{'Queue'},
159         Template               => $template->Id,
160         ScripCondition         => $condition->id,
161         Stage                  => $args{'Stage'},
162         ScripAction            => $action->Id,
163         Description            => $args{'Description'},
164         CustomPrepareCode      => $args{'CustomPrepareCode'},
165         CustomCommitCode       => $args{'CustomCommitCode'},
166         CustomIsApplicableCode => $args{'CustomIsApplicableCode'},
167         ConditionRules         => $args{'ConditionRules'},
168         ActionRules            => $args{'ActionRules'},
169     );
170     if ( $id ) {
171         return ( $id, $self->loc('Scrip Created') );
172     }
173     else {
174         return ( $id, $msg );
175     }
176 }
177
178 # }}}
179
180 # {{{ sub Delete
181
182 =head2 Delete
183
184 Delete this object
185
186 =cut
187
188 sub Delete {
189     my $self = shift;
190
191     unless ( $self->CurrentUserHasRight('ModifyScrips') ) {
192         return ( 0, $self->loc('Permission Denied') );
193     }
194
195     return ( $self->SUPER::Delete(@_) );
196 }
197
198 # }}}
199
200 # {{{ sub QueueObj
201
202 =head2 QueueObj
203
204 Retuns an RT::Queue object with this Scrip\'s queue
205
206 =cut
207
208 sub QueueObj {
209     my $self = shift;
210
211     if ( !$self->{'QueueObj'} ) {
212         require RT::Queue;
213         $self->{'QueueObj'} = RT::Queue->new( $self->CurrentUser );
214         $self->{'QueueObj'}->Load( $self->__Value('Queue') );
215     }
216     return ( $self->{'QueueObj'} );
217 }
218
219 # }}}
220
221 # {{{ sub ActionObj
222
223 =head2 ActionObj
224
225 Retuns an RT::Action object with this Scrip\'s Action
226
227 =cut
228
229 sub ActionObj {
230     my $self = shift;
231
232     unless ( defined $self->{'ScripActionObj'} ) {
233         require RT::ScripAction;
234
235         $self->{'ScripActionObj'} = RT::ScripAction->new( $self->CurrentUser );
236
237         #TODO: why are we loading Actions with templates like this.
238         # two separate methods might make more sense
239         $self->{'ScripActionObj'}->Load( $self->ScripAction, $self->Template );
240     }
241     return ( $self->{'ScripActionObj'} );
242 }
243
244 # }}}
245
246 # {{{ sub ConditionObj
247
248 =head2 ConditionObj
249
250 Retuns an L<RT::ScripCondition> object with this Scrip's IsApplicable
251
252 =cut
253
254 sub ConditionObj {
255     my $self = shift;
256
257     my $res = RT::ScripCondition->new( $self->CurrentUser );
258     $res->Load( $self->ScripCondition );
259     return $res;
260 }
261
262 # }}}
263
264 =head2 LoadModules
265
266 Loads scrip's condition and action modules.
267
268 =cut
269
270 sub LoadModules {
271     my $self = shift;
272
273     $self->ConditionObj->LoadCondition;
274     $self->ActionObj->LoadAction;
275 }
276
277 # {{{ sub TemplateObj
278
279 =head2 TemplateObj
280
281 Retuns an RT::Template object with this Scrip\'s Template
282
283 =cut
284
285 sub TemplateObj {
286     my $self = shift;
287
288     unless ( defined $self->{'TemplateObj'} ) {
289         require RT::Template;
290         $self->{'TemplateObj'} = RT::Template->new( $self->CurrentUser );
291         $self->{'TemplateObj'}->Load( $self->Template );
292     }
293     return ( $self->{'TemplateObj'} );
294 }
295
296 # }}}
297
298 # {{{ Dealing with this instance of a scrip
299
300 # {{{ sub Apply
301
302 =head2 Apply { TicketObj => undef, TransactionObj => undef}
303
304 This method instantiates the ScripCondition and ScripAction objects for a
305 single execution of this scrip. it then calls the IsApplicable method of the 
306 ScripCondition.
307 If that succeeds, it calls the Prepare method of the
308 ScripAction. If that succeeds, it calls the Commit method of the ScripAction.
309
310 Usually, the ticket and transaction objects passed to this method
311 should be loaded by the SuperUser role
312
313 =cut
314
315
316 # XXX TODO : This code appears to be obsoleted in favor of similar code in Scrips->Apply.
317 # Why is this here? Is it still called?
318
319 sub Apply {
320     my $self = shift;
321     my %args = ( TicketObj      => undef,
322                  TransactionObj => undef,
323                  @_ );
324
325     $RT::Logger->debug("Now applying scrip ".$self->Id . " for transaction ".$args{'TransactionObj'}->id);
326
327     my $ApplicableTransactionObj = $self->IsApplicable( TicketObj      => $args{'TicketObj'},
328                                                         TransactionObj => $args{'TransactionObj'} );
329     unless ( $ApplicableTransactionObj ) {
330         return undef;
331     }
332
333     if ( $ApplicableTransactionObj->id != $args{'TransactionObj'}->id ) {
334         $RT::Logger->debug("Found an applicable transaction ".$ApplicableTransactionObj->Id . " in the same batch with transaction ".$args{'TransactionObj'}->id);
335     }
336
337     #If it's applicable, prepare and commit it
338     $RT::Logger->debug("Now preparing scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
339     unless ( $self->Prepare( TicketObj      => $args{'TicketObj'},
340                              TransactionObj => $ApplicableTransactionObj )
341       ) {
342         return undef;
343     }
344
345     $RT::Logger->debug("Now commiting scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
346     unless ( $self->Commit( TicketObj => $args{'TicketObj'},
347                             TransactionObj => $ApplicableTransactionObj)
348       ) {
349         return undef;
350     }
351
352     $RT::Logger->debug("We actually finished scrip ".$self->Id . " for transaction ".$ApplicableTransactionObj->id);
353     return (1);
354
355 }
356
357 # }}}
358
359 # {{{ sub IsApplicable
360
361 =head2 IsApplicable
362
363 Calls the  Condition object\'s IsApplicable method
364
365 Upon success, returns the applicable Transaction object.
366 Otherwise, undef is returned.
367
368 If the Scrip is in the TransactionCreate Stage (the usual case), only test
369 the associated Transaction object to see if it is applicable.
370
371 For Scrips in the TransactionBatch Stage, test all Transaction objects
372 created during the Ticket object's lifetime, and returns the first one
373 that is applicable.
374
375 =cut
376
377 sub IsApplicable {
378     my $self = shift;
379     my %args = ( TicketObj      => undef,
380                  TransactionObj => undef,
381                  @_ );
382
383     my $return;
384     eval {
385
386         my @Transactions;
387
388         if ( $self->Stage eq 'TransactionCreate') {
389             # Only look at our current Transaction
390             @Transactions = ( $args{'TransactionObj'} );
391         }
392         elsif ( $self->Stage eq 'TransactionBatch') {
393             # Look at all Transactions in this Batch
394             @Transactions = @{ $args{'TicketObj'}->TransactionBatch || [] };
395         }
396         else {
397             $RT::Logger->error( "Unknown Scrip stage:" . $self->Stage );
398             return (undef);
399         }
400         my $ConditionObj = $self->ConditionObj;
401         foreach my $TransactionObj ( @Transactions ) {
402             # in TxnBatch stage we can select scrips that are not applicable to all txns
403             my $txn_type = $TransactionObj->Type;
404             next unless( $ConditionObj->ApplicableTransTypes =~ /(?:^|,)(?:Any|\Q$txn_type\E)(?:,|$)/i );
405             # Load the scrip's Condition object
406             $ConditionObj->LoadCondition(
407                 ScripObj       => $self,
408                 TicketObj      => $args{'TicketObj'},
409                 TransactionObj => $TransactionObj,
410             );
411
412             if ( $ConditionObj->IsApplicable() ) {
413                 # We found an application Transaction -- return it
414                 $return = $TransactionObj;
415                 last;
416             }
417         }
418     };
419
420     if ($@) {
421         $RT::Logger->error( "Scrip IsApplicable " . $self->Id . " died. - " . $@ );
422         return (undef);
423     }
424
425             return ($return);
426
427 }
428
429 # }}}
430
431 # {{{ SUb Prepare
432
433 =head2 Prepare
434
435 Calls the action object's prepare method
436
437 =cut
438
439 sub Prepare {
440     my $self = shift;
441     my %args = ( TicketObj      => undef,
442                  TransactionObj => undef,
443                  @_ );
444
445     my $return;
446     eval {
447         $self->ActionObj->LoadAction( ScripObj       => $self,
448                                       TicketObj      => $args{'TicketObj'},
449                                       TransactionObj => $args{'TransactionObj'},
450         );
451
452         $return = $self->ActionObj->Prepare();
453     };
454     if ($@) {
455         $RT::Logger->error( "Scrip Prepare " . $self->Id . " died. - " . $@ );
456         return (undef);
457     }
458         unless ($return) {
459         }
460         return ($return);
461 }
462
463 # }}}
464
465 # {{{ sub Commit
466
467 =head2 Commit
468
469 Calls the action object's commit method
470
471 =cut
472
473 sub Commit {
474     my $self = shift;
475     my %args = ( TicketObj      => undef,
476                  TransactionObj => undef,
477                  @_ );
478
479     my $return;
480     eval {
481         $return = $self->ActionObj->Commit();
482     };
483
484 #Searchbuilder caching isn't perfectly coherent. got to reload the ticket object, since it
485 # may have changed
486     $args{'TicketObj'}->Load( $args{'TicketObj'}->Id );
487
488     if ($@) {
489         $RT::Logger->error( "Scrip Commit " . $self->Id . " died. - " . $@ );
490         return (undef);
491     }
492
493     # Not destroying or weakening hte Action and Condition here could cause a
494     # leak
495
496     return ($return);
497 }
498
499 # }}}
500
501 # }}}
502
503 # {{{ ACL related methods
504
505 # {{{ sub _Set
506
507 # does an acl check and then passes off the call
508 sub _Set {
509     my $self = shift;
510
511     unless ( $self->CurrentUserHasRight('ModifyScrips') ) {
512         $RT::Logger->debug(
513                  "CurrentUser can't modify Scrips for " . $self->Queue . "\n" );
514         return ( 0, $self->loc('Permission Denied') );
515     }
516     return $self->__Set(@_);
517 }
518
519 # }}}
520
521 # {{{ sub _Value
522 # does an acl check and then passes off the call
523 sub _Value {
524     my $self = shift;
525
526     unless ( $self->CurrentUserHasRight('ShowScrips') ) {
527         $RT::Logger->debug( "CurrentUser can't modify Scrips for "
528                             . $self->__Value('Queue')
529                             . "\n" );
530         return (undef);
531     }
532
533     return $self->__Value(@_);
534 }
535
536 # }}}
537
538 # {{{ sub CurrentUserHasRight
539
540 =head2 CurrentUserHasRight
541
542 Helper menthod for HasRight. Presets Principal to CurrentUser then 
543 calls HasRight.
544
545 =cut
546
547 sub CurrentUserHasRight {
548     my $self  = shift;
549     my $right = shift;
550     return ( $self->HasRight( Principal => $self->CurrentUser->UserObj,
551                               Right     => $right ) );
552
553 }
554
555 # }}}
556
557 # {{{ sub HasRight
558
559 =head2 HasRight
560
561 Takes a param-hash consisting of "Right" and "Principal"  Principal is 
562 an RT::User object or an RT::CurrentUser object. "Right" is a textual
563 Right string that applies to Scrips.
564
565 =cut
566
567 sub HasRight {
568     my $self = shift;
569     my %args = ( Right     => undef,
570                  Principal => undef,
571                  @_ );
572
573     if ( $self->SUPER::_Value('Queue') ) {
574         return $args{'Principal'}->HasRight(
575             Right  => $args{'Right'},
576             Object => $self->QueueObj
577         );
578     }
579     else {
580         return $args{'Principal'}->HasRight(
581             Object => $RT::System,
582             Right  => $args{'Right'},
583         );
584     }
585 }
586
587 # }}}
588
589 # }}}
590
591 1;
592