+ foreach my $name ( keys %LIFECYCLES_CACHE ) {
+ next if $name eq "__maps__";
+ my $lifecycle = $LIFECYCLES_CACHE{$name};
+
+ my $type = $lifecycle->{type} ||= 'ticket';
+ $LIFECYCLES_TYPES{$type} ||= {
+ '' => [],
+ initial => [],
+ active => [],
+ inactive => [],
+ actions => [],
+ };
+
+ my @statuses;
+ $lifecycle->{canonical_case} = {};
+ foreach my $category ( qw(initial active inactive) ) {
+ for my $status (@{ $lifecycle->{ $category } || [] }) {
+ if (exists $lifecycle->{canonical_case}{lc $status}) {
+ warn "Duplicate status @{[lc $status]} in lifecycle $name";
+ } else {
+ $lifecycle->{canonical_case}{lc $status} = $status;
+ }
+ push @{ $LIFECYCLES_TYPES{$type}{$category} }, $status;
+ push @statuses, $status;
+ }
+ }
+
+ # Lower-case for consistency
+ # ->{actions} are handled below
+ for my $state (keys %{ $lifecycle->{defaults} || {} }) {
+ my $status = $lifecycle->{defaults}{$state};
+ warn "Nonexistant status @{[lc $status]} in default states in $name lifecycle"
+ unless $lifecycle->{canonical_case}{lc $status};
+ $lifecycle->{defaults}{$state} =
+ $lifecycle->{canonical_case}{lc $status} || lc $status;
+ }
+ for my $from (keys %{ $lifecycle->{transitions} || {} }) {
+ warn "Nonexistant status @{[lc $from]} in transitions in $name lifecycle"
+ unless $from eq '' or $lifecycle->{canonical_case}{lc $from};
+ for my $status ( @{delete($lifecycle->{transitions}{$from}) || []} ) {
+ warn "Nonexistant status @{[lc $status]} in transitions in $name lifecycle"
+ unless $lifecycle->{canonical_case}{lc $status};
+ push @{ $lifecycle->{transitions}{lc $from} },
+ $lifecycle->{canonical_case}{lc $status} || lc $status;
+ }
+ }
+ for my $schema (keys %{ $lifecycle->{rights} || {} }) {
+ my ($from, $to) = split /\s*->\s*/, $schema, 2;
+ unless ($from and $to) {
+ warn "Invalid right transition $schema in $name lifecycle";
+ next;
+ }
+ warn "Nonexistant status @{[lc $from]} in right transition in $name lifecycle"
+ unless $from eq '*' or $lifecycle->{canonical_case}{lc $from};
+ warn "Nonexistant status @{[lc $to]} in right transition in $name lifecycle"
+ unless $to eq '*' or $lifecycle->{canonical_case}{lc $to};
+
+ warn "Invalid right name ($lifecycle->{rights}{$schema}) in $name lifecycle; right names must be ASCII"
+ if $lifecycle->{rights}{$schema} =~ /\P{ASCII}/;
+
+ warn "Invalid right name ($lifecycle->{rights}{$schema}) in $name lifecycle; right names must be <= 25 characters"
+ if length($lifecycle->{rights}{$schema}) > 25;
+
+ $lifecycle->{rights}{lc($from) . " -> " .lc($to)}
+ = delete $lifecycle->{rights}{$schema};