c905282584ee87ae28607a70cb8672bdbcab5a11
[usit-rt.git] / lib / RT / Lifecycle.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
6 #                                          <sales@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 use strict;
50 use warnings;
51
52
53 package RT::Lifecycle;
54
55 our %LIFECYCLES;
56 our %LIFECYCLES_CACHE;
57 __PACKAGE__->RegisterRights;
58
59 # cache structure:
60 #    {
61 #        '' => { # all valid statuses
62 #            '' => [...],
63 #            initial => [...],
64 #            active => [...],
65 #            inactive => [...],
66 #        },
67 #        lifecycle_x => {
68 #            '' => [...], # all valid in lifecycle
69 #            initial => [...],
70 #            active => [...],
71 #            inactive => [...],
72 #            transitions => {
73 #               status_x => [status_next1, status_next2,...],
74 #            },
75 #            rights => {
76 #               'status_y -> status_y' => 'right',
77 #               ....
78 #            }
79 #            actions => [
80 #               { from => 'a', to => 'b', label => '...', update => '...' },
81 #               ....
82 #            ]
83 #        }
84 #    }
85
86 =head1 NAME
87
88 RT::Lifecycle - class to access and manipulate lifecycles
89
90 =head1 DESCRIPTION
91
92 A lifecycle is a list of statuses that a ticket can have. There are three
93 groups of statuses: initial, active and inactive. A lifecycle also defines
94 possible transitions between statuses. For example, in the 'default' lifecycle,
95 you may only change status from 'stalled' to 'open'.
96
97 It is also possible to define user-interface labels and the action a user
98 should perform during a transition. For example, the "open -> stalled"
99 transition would have a 'Stall' label and the action would be Comment. The
100 action only defines what form is showed to the user, but actually performing
101 the action is not required. The user can leave the comment box empty yet still
102 Stall a ticket. Finally, the user can also just use the Basics or Jumbo form to
103 change the status with the usual dropdown.
104
105 =head1 METHODS
106
107 =head2 new
108
109 Simple constructor, takes no arguments.
110
111 =cut
112
113 sub new {
114     my $proto = shift;
115     my $self = bless {}, ref($proto) || $proto;
116
117     $self->FillCache unless keys %LIFECYCLES_CACHE;
118
119     return $self;
120 }
121
122 =head2 Load
123
124 Takes a name of the lifecycle and loads it. If name is empty or undefined then
125 loads the global lifecycle with statuses from all named lifecycles.
126
127 Can be called as class method, returns a new object, for example:
128
129     my $lifecycle = RT::Lifecycle->Load('default');
130
131 =cut
132
133 sub Load {
134     my $self = shift;
135     my $name = shift || '';
136     return $self->new->Load( $name, @_ )
137         unless ref $self;
138
139     return unless exists $LIFECYCLES_CACHE{ $name };
140
141     $self->{'name'} = $name;
142     $self->{'data'} = $LIFECYCLES_CACHE{ $name };
143
144     return $self;
145 }
146
147 =head2 List
148
149 Returns sorted list of the lifecycles' names.
150
151 =cut
152
153 sub List {
154     my $self = shift;
155
156     $self->FillCache unless keys %LIFECYCLES_CACHE;
157
158     return sort grep length && $_ ne '__maps__', keys %LIFECYCLES_CACHE;
159 }
160
161 =head2 Name
162
163 Returns name of the laoded lifecycle.
164
165 =cut
166
167 sub Name { return $_[0]->{'name'} }
168
169 =head2 Queues
170
171 Returns L<RT::Queues> collection with queues that use this lifecycle.
172
173 =cut
174
175 sub Queues {
176     my $self = shift;
177     require RT::Queues;
178     my $queues = RT::Queues->new( RT->SystemUser );
179     $queues->Limit( FIELD => 'Lifecycle', VALUE => $self->Name );
180     return $queues;
181 }
182
183 =head2 Getting statuses and validating.
184
185 Methods to get statuses in different sets or validating them.
186
187 =head3 Valid
188
189 Returns an array of all valid statuses for the current lifecycle.
190 Statuses are not sorted alphabetically, instead initial goes first,
191 then active and then inactive.
192
193 Takes optional list of status types, from 'initial', 'active' or
194 'inactive'. For example:
195
196     $lifecycle->Valid('initial', 'active');
197
198 =cut
199
200 sub Valid {
201     my $self = shift;
202     my @types = @_;
203     unless ( @types ) {
204         return @{ $self->{'data'}{''} || [] };
205     }
206
207     my @res;
208     push @res, @{ $self->{'data'}{ $_ } || [] } foreach @types;
209     return @res;
210 }
211
212 =head3 IsValid
213
214 Takes a status and returns true if value is a valid status for the current
215 lifecycle. Otherwise, returns false.
216
217 Takes optional list of status types after the status, so it's possible check
218 validity in particular sets, for example:
219
220     # returns true if status is valid and from initial or active set
221     $lifecycle->IsValid('some_status', 'initial', 'active');
222
223 See also </valid>.
224
225 =cut
226
227 sub IsValid {
228     my $self  = shift;
229     my $value = shift or return 0;
230     return 1 if grep lc($_) eq lc($value), $self->Valid( @_ );
231     return 0;
232 }
233
234 =head3 StatusType
235
236 Takes a status and returns its type, one of 'initial', 'active' or
237 'inactive'.
238
239 =cut
240
241 sub StatusType {
242     my $self = shift;
243     my $status = shift;
244     foreach my $type ( qw(initial active inactive) ) {
245         return $type if $self->IsValid( $status, $type );
246     }
247     return '';
248 }
249
250 =head3 Initial
251
252 Returns an array of all initial statuses for the current lifecycle.
253
254 =cut
255
256 sub Initial {
257     my $self = shift;
258     return $self->Valid('initial');
259 }
260
261 =head3 IsInitial
262
263 Takes a status and returns true if value is a valid initial status.
264 Otherwise, returns false.
265
266 =cut
267
268 sub IsInitial {
269     my $self  = shift;
270     my $value = shift or return 0;
271     return 1 if grep lc($_) eq lc($value), $self->Valid('initial');
272     return 0;
273 }
274
275
276 =head3 Active
277
278 Returns an array of all active statuses for this lifecycle.
279
280 =cut
281
282 sub Active {
283     my $self = shift;
284     return $self->Valid('active');
285 }
286
287 =head3 IsActive
288
289 Takes a value and returns true if value is a valid active status.
290 Otherwise, returns false.
291
292 =cut
293
294 sub IsActive {
295     my $self  = shift;
296     my $value = shift or return 0;
297     return 1 if grep lc($_) eq lc($value), $self->Valid('active');
298     return 0;
299 }
300
301 =head3 inactive
302
303 Returns an array of all inactive statuses for this lifecycle.
304
305 =cut
306
307 sub Inactive {
308     my $self = shift;
309     return $self->Valid('inactive');
310 }
311
312 =head3 is_inactive
313
314 Takes a value and returns true if value is a valid inactive status.
315 Otherwise, returns false.
316
317 =cut
318
319 sub IsInactive {
320     my $self  = shift;
321     my $value = shift or return 0;
322     return 1 if grep lc($_) eq lc($value), $self->Valid('inactive');
323     return 0;
324 }
325
326
327 =head2 Default statuses
328
329 In some cases when status is not provided a default values should
330 be used.
331
332 =head3 DefaultStatus
333
334 Takes a situation name and returns value. Name should be
335 spelled following spelling in the RT config file.
336
337 =cut
338
339 sub DefaultStatus {
340     my $self = shift;
341     my $situation = shift;
342     return $self->{data}{defaults}{ $situation };
343 }
344
345 =head3 DefaultOnCreate
346
347 Returns the status that should be used by default
348 when ticket is created.
349
350 =cut
351
352 sub DefaultOnCreate {
353     my $self = shift;
354     return $self->DefaultStatus('on_create');
355 }
356
357
358 =head3 DefaultOnMerge
359
360 Returns the status that should be used when tickets
361 are merged.
362
363 =cut
364
365 sub DefaultOnMerge {
366     my $self = shift;
367     return $self->DefaultStatus('on_merge');
368 }
369
370 =head3 ReminderStatusOnOpen
371
372 Returns the status that should be used when reminders are opened.
373
374 =cut
375
376 sub ReminderStatusOnOpen {
377     my $self = shift;
378     return $self->DefaultStatus('reminder_on_open') || 'open';
379 }
380
381 =head3 ReminderStatusOnResolve
382
383 Returns the status that should be used when reminders are resolved.
384
385 =cut
386
387 sub ReminderStatusOnResolve {
388     my $self = shift;
389     return $self->DefaultStatus('reminder_on_resolve') || 'resolved';
390 }
391
392 =head2 Transitions, rights, labels and actions.
393
394 =head3 Transitions
395
396 Takes status and returns list of statuses it can be changed to.
397
398 Is status is empty or undefined then returns list of statuses for
399 a new ticket.
400
401 If argument is ommitted then returns a hash with all possible
402 transitions in the following format:
403
404     status_x => [ next_status, next_status, ... ],
405     status_y => [ next_status, next_status, ... ],
406
407 =cut
408
409 sub Transitions {
410     my $self = shift;
411     return %{ $self->{'data'}{'transitions'} || {} }
412         unless @_;
413
414     my $status = shift || '';
415     return @{ $self->{'data'}{'transitions'}{ lc $status } || [] };
416 }
417
418 =head1 IsTransition
419
420 Takes two statuses (from -> to) and returns true if it's valid
421 transition and false otherwise.
422
423 =cut
424
425 sub IsTransition {
426     my $self = shift;
427     my $from = shift;
428     my $to   = shift or return 0;
429     return 1 if grep lc($_) eq lc($to), $self->Transitions($from);
430     return 0;
431 }
432
433 =head3 CheckRight
434
435 Takes two statuses (from -> to) and returns the right that should
436 be checked on the ticket.
437
438 =cut
439
440 sub CheckRight {
441     my $self = shift;
442     my $from = lc shift;
443     my $to = lc shift;
444     if ( my $rights = $self->{'data'}{'rights'} ) {
445         my $check =
446             $rights->{ $from .' -> '. $to }
447             || $rights->{ '* -> '. $to }
448             || $rights->{ $from .' -> *' }
449             || $rights->{ '* -> *' };
450         return $check if $check;
451     }
452     return $to eq 'deleted' ? 'DeleteTicket' : 'ModifyTicket';
453 }
454
455 =head3 RegisterRights
456
457 Registers all defined rights in the system, so they can be addigned
458 to users. No need to call it, as it's called when module is loaded.
459
460 =cut
461
462 sub RegisterRights {
463     my $self = shift;
464
465     my %rights = $self->RightsDescription;
466
467     require RT::ACE;
468
469     require RT::Queue;
470     my $RIGHTS = $RT::Queue::RIGHTS;
471
472     while ( my ($right, $description) = each %rights ) {
473         next if exists $RIGHTS->{ $right };
474
475         $RIGHTS->{ $right } = $description;
476         RT::Queue->AddRightCategories( $right => 'Status' );
477         $RT::ACE::LOWERCASERIGHTNAMES{ lc $right } = $right;
478     }
479 }
480
481 =head3 RightsDescription
482
483 Returns hash with description of rights that are defined for
484 particular transitions.
485
486 =cut
487
488 sub RightsDescription {
489     my $self = shift;
490
491     $self->FillCache unless keys %LIFECYCLES_CACHE;
492
493     my %tmp;
494     foreach my $lifecycle ( values %LIFECYCLES_CACHE ) {
495         next unless exists $lifecycle->{'rights'};
496         while ( my ($transition, $right) = each %{ $lifecycle->{'rights'} } ) {
497             push @{ $tmp{ $right } ||=[] }, $transition;
498         }
499     }
500
501     my %res;
502     while ( my ($right, $transitions) = each %tmp ) {
503         my (@from, @to);
504         foreach ( @$transitions ) {
505             ($from[@from], $to[@to]) = split / -> /, $_;
506         }
507         my $description = 'Change status'
508             . ( (grep $_ eq '*', @from)? '' : ' from '. join ', ', @from )
509             . ( (grep $_ eq '*', @to  )? '' : ' to '. join ', ', @to );
510
511         $res{ $right } = $description;
512     }
513     return %res;
514 }
515
516 =head3 Actions
517
518 Takes a status and returns list of defined actions for the status. Each
519 element in the list is a hash reference with the following key/value
520 pairs:
521
522 =over 4
523
524 =item from - either the status or *
525
526 =item to - next status
527
528 =item label - label of the action
529
530 =item update - 'Respond', 'Comment' or '' (empty string)
531
532 =back
533
534 =cut
535
536 sub Actions {
537     my $self = shift;
538     my $from = shift || return ();
539     $from = lc $from;
540
541     $self->FillCache unless keys %LIFECYCLES_CACHE;
542
543     my @res = grep lc $_->{'from'} eq $from || ( $_->{'from'} eq '*' && lc $_->{'to'} ne $from ),
544         @{ $self->{'data'}{'actions'} };
545
546     # skip '* -> x' if there is '$from -> x'
547     foreach my $e ( grep $_->{'from'} eq '*', @res ) {
548         $e = undef if grep $_->{'from'} ne '*' && $_->{'to'} eq $e->{'to'}, @res;
549     }
550     return grep defined, @res;
551 }
552
553 =head2 Moving tickets between lifecycles
554
555 =head3 MoveMap
556
557 Takes lifecycle as a name string or an object and returns a hash reference with
558 move map from this cycle to provided.
559
560 =cut
561
562 sub MoveMap {
563     my $from = shift; # self
564     my $to = shift;
565     $to = RT::Lifecycle->Load( $to ) unless ref $to;
566     return $LIFECYCLES{'__maps__'}{ $from->Name .' -> '. $to->Name } || {};
567 }
568
569 =head3 HasMoveMap
570
571 Takes a lifecycle as a name string or an object and returns true if move map
572 defined for move from this cycle to provided.
573
574 =cut
575
576 sub HasMoveMap {
577     my $self = shift;
578     my $map = $self->MoveMap( @_ );
579     return 0 unless $map && keys %$map;
580     return 0 unless grep defined && length, values %$map;
581     return 1;
582 }
583
584 =head3 NoMoveMaps
585
586 Takes no arguments and returns hash with pairs that has no
587 move maps.
588
589 =cut
590
591 sub NoMoveMaps {
592     my $self = shift;
593     my @list = $self->List;
594     my @res;
595     foreach my $from ( @list ) {
596         foreach my $to ( @list ) {
597             next if $from eq $to;
598             push @res, $from, $to
599                 unless RT::Lifecycle->Load( $from )->HasMoveMap( $to );
600         }
601     }
602     return @res;
603 }
604
605 =head2 Localization
606
607 =head3 ForLocalization
608
609 A class method that takes no arguments and returns list of strings
610 that require translation.
611
612 =cut
613
614 sub ForLocalization {
615     my $self = shift;
616     $self->FillCache unless keys %LIFECYCLES_CACHE;
617
618     my @res = ();
619
620     push @res, @{ $LIFECYCLES_CACHE{''}{''} || [] };
621     foreach my $lifecycle ( values %LIFECYCLES ) {
622         push @res,
623             grep defined && length,
624             map $_->{'label'},
625             grep ref($_),
626             @{ $lifecycle->{'actions'} || [] };
627     }
628
629     push @res, $self->RightsDescription;
630
631     my %seen;
632     return grep !$seen{lc $_}++, @res;
633 }
634
635 sub loc { return RT->SystemUser->loc( @_ ) }
636
637 sub CanonicalCase {
638     my $self = shift;
639     my ($status) = @_;
640     return undef unless defined $status;
641     return($self->{data}{canonical_case}{lc $status} || lc $status);
642 }
643
644 sub FillCache {
645     my $self = shift;
646
647     my $map = RT->Config->Get('Lifecycles') or return;
648
649     %LIFECYCLES_CACHE = %LIFECYCLES = %$map;
650     $_ = { %$_ } foreach values %LIFECYCLES_CACHE;
651
652     my %all = (
653         '' => [],
654         initial => [],
655         active => [],
656         inactive => [],
657     );
658     foreach my $name ( keys %LIFECYCLES_CACHE ) {
659         next if $name eq "__maps__";
660         my $lifecycle = $LIFECYCLES_CACHE{$name};
661
662         my @statuses;
663         $lifecycle->{canonical_case} = {};
664         foreach my $type ( qw(initial active inactive) ) {
665             for my $status (@{ $lifecycle->{ $type } || [] }) {
666                 if (exists $lifecycle->{canonical_case}{lc $status}) {
667                     warn "Duplicate status @{[lc $status]} in lifecycle $name";
668                 } else {
669                     $lifecycle->{canonical_case}{lc $status} = $status;
670                 }
671                 push @{ $all{ $type } }, $status;
672                 push @statuses, $status;
673             }
674         }
675
676         # Lower-case for consistency
677         # ->{actions} are handled below
678         for my $state (keys %{ $lifecycle->{defaults} || {} }) {
679             my $status = $lifecycle->{defaults}{$state};
680             warn "Nonexistant status @{[lc $status]} in default states in $name lifecycle"
681                 unless $lifecycle->{canonical_case}{lc $status};
682             $lifecycle->{defaults}{$state} =
683                 $lifecycle->{canonical_case}{lc $status} || lc $status;
684         }
685         for my $from (keys %{ $lifecycle->{transitions} || {} }) {
686             warn "Nonexistant status @{[lc $from]} in transitions in $name lifecycle"
687                 unless $from eq '' or $lifecycle->{canonical_case}{lc $from};
688             for my $status ( @{delete($lifecycle->{transitions}{$from}) || []} ) {
689                 warn "Nonexistant status @{[lc $status]} in transitions in $name lifecycle"
690                     unless $lifecycle->{canonical_case}{lc $status};
691                 push @{ $lifecycle->{transitions}{lc $from} },
692                     $lifecycle->{canonical_case}{lc $status} || lc $status;
693             }
694         }
695         for my $schema (keys %{ $lifecycle->{rights} || {} }) {
696             my ($from, $to) = split /\s*->\s*/, $schema, 2;
697             unless ($from and $to) {
698                 warn "Invalid right transition $schema in $name lifecycle";
699                 next;
700             }
701             warn "Nonexistant status @{[lc $from]} in right transition in $name lifecycle"
702                 unless $from eq '*' or $lifecycle->{canonical_case}{lc $from};
703             warn "Nonexistant status @{[lc $to]} in right transition in $name lifecycle"
704                 unless $to eq '*' or $lifecycle->{canonical_case}{lc $to};
705             $lifecycle->{rights}{lc($from) . " -> " .lc($to)}
706                 = delete $lifecycle->{rights}{$schema};
707         }
708
709         my %seen;
710         @statuses = grep !$seen{ $_ }++, @statuses;
711         $lifecycle->{''} = \@statuses;
712
713         unless ( $lifecycle->{'transitions'}{''} ) {
714             $lifecycle->{'transitions'}{''} = [ grep $_ ne 'deleted', @statuses ];
715         }
716
717         my @actions;
718         if ( ref $lifecycle->{'actions'} eq 'HASH' ) {
719             foreach my $k ( sort keys %{ $lifecycle->{'actions'} } ) {
720                 push @actions, $k, $lifecycle->{'actions'}{ $k };
721             }
722         } elsif ( ref $lifecycle->{'actions'} eq 'ARRAY' ) {
723             @actions = @{ $lifecycle->{'actions'} };
724         }
725
726         $lifecycle->{'actions'} = [];
727         while ( my ($transition, $info) = splice @actions, 0, 2 ) {
728             my ($from, $to) = split /\s*->\s*/, $transition, 2;
729             unless ($from and $to) {
730                 warn "Invalid action status change $transition in $name lifecycle";
731                 next;
732             }
733             warn "Nonexistant status @{[lc $from]} in action in $name lifecycle"
734                 unless $from eq '*' or $lifecycle->{canonical_case}{lc $from};
735             warn "Nonexistant status @{[lc $to]} in action in $name lifecycle"
736                 unless $to eq '*' or $lifecycle->{canonical_case}{lc $to};
737             push @{ $lifecycle->{'actions'} },
738                 { %$info,
739                   from => ($lifecycle->{canonical_case}{lc $from} || lc $from),
740                   to   => ($lifecycle->{canonical_case}{lc $to}   || lc $to),   };
741         }
742     }
743
744     # Lower-case the transition maps
745     for my $mapname (keys %{ $LIFECYCLES_CACHE{'__maps__'} || {} }) {
746         my ($from, $to) = split /\s*->\s*/, $mapname, 2;
747         unless ($from and $to) {
748             warn "Invalid lifecycle mapping $mapname";
749             next;
750         }
751         warn "Nonexistant lifecycle $from in $mapname lifecycle map"
752             unless $LIFECYCLES_CACHE{$from};
753         warn "Nonexistant lifecycle $to in $mapname lifecycle map"
754             unless $LIFECYCLES_CACHE{$to};
755         my $map = delete $LIFECYCLES_CACHE{'__maps__'}{$mapname};
756         $LIFECYCLES_CACHE{'__maps__'}{"$from -> $to"} = $map;
757         for my $status (keys %{ $map }) {
758             warn "Nonexistant status @{[lc $status]} in $from in $mapname lifecycle map"
759                 if $LIFECYCLES_CACHE{$from}
760                     and not $LIFECYCLES_CACHE{$from}{canonical_case}{lc $status};
761             warn "Nonexistant status @{[lc $map->{$status}]} in $to in $mapname lifecycle map"
762                 if $LIFECYCLES_CACHE{$to}
763                     and not $LIFECYCLES_CACHE{$to}{canonical_case}{lc $map->{$status}};
764             $map->{lc $status} = lc delete $map->{$status};
765         }
766     }
767
768     foreach my $type ( qw(initial active inactive), '' ) {
769         my %seen;
770         @{ $all{ $type } } = grep !$seen{ $_ }++, @{ $all{ $type } };
771         push @{ $all{''} }, @{ $all{ $type } } if $type;
772     }
773     $LIFECYCLES_CACHE{''} = \%all;
774
775     return;
776 }
777
778 1;