rt/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 __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 IsInactive
 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{ lc $_ }++, @statuses;
 711         $lifecycle->{''} = \@statuses;
 712
 713         unless ( $lifecycle->{'transitions'}{''} ) {
 714             $lifecycle->{'transitions'}{''} = [ grep lc $_ 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{ lc $_ }++, @{ $all{ $type } };
 771         push @{ $all{''} }, @{ $all{ $type } } if $type;
 772     }
 773     $LIFECYCLES_CACHE{''} = \%all;
 774
 775     return;
 776 }
 777
 778 1;