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