view release on metacpan or  search on metacpan

lib/Class/StateMachine/Declarative/Builder.pm  view on Meta::CPAN

            }
            $self->$action(@_);
        };
        $debug and $debug & 32 and _debug(__PACKAGE__, "installing handler for on($event1 => $action) at $class/$name");
        Class::StateMachine::install_method($class, $event, $sub, $name);
    }

    for my $event (@{$state->{ignore}}) {
        my $before = "$event/before";
        my $event1 = $event;
        my $sub = sub {
            my $self = shift;
            $debug and $debug & 64 and _debug($self, "event $event1 received (ignore)");
            my $method = $self->can($before);
            $self->$method(@_) if $method;
        };
        Class::StateMachine::install_method($class, $event, $sub, $name);
    }

    while (my ($target, $events) = each %{$state->{transitions_rev}}) {
        my $target = $self->{states}{$target}{name};
        for my $event (@$events) {
            my $before = "$event/before";
            my $event1 = $event;
            my $sub = sub {
                my $self = shift;
                $debug and $debug & 64 and _debug($self, "event $event1 received (transition target: $target)");
                if (my $method = $self->can($before)) {
                    $self->state_changed_on_call($method, $self, @_) and return;
                }
                $self->state($target);
            };
            $debug and $debug & 32 and _debug(__PACKAGE__, "installing handler for transition($event1 => $target) at $class/$name");
            Class::StateMachine::install_method($class, $event, $sub, $name);
        }
    }

    $self->_generate_state($_) for @{$state->{substates}};
}

package Class::StateMachine::Declarative::Builder::State;

sub _new {
    my ($class, $name, $parent) = @_;
    $name //= '';
    my $full_name = ($parent ? "$parent->{full_name}/$name" : $name);
    my $final_name = $full_name;
    $final_name =~ s|^/+||;
    my $state = { short_name => $name,
                  full_name => $full_name,
                  name => $final_name,
                  parent => $parent,
                  substates => [],
                  transitions => {},
                  before => {},
                  on => {},
                  ignore => [],
                  delay => [] };
    bless $state, $class;
    push @{$parent->{substates}}, $state if $parent;
    Scalar::Util::weaken($state->{parent});
    $state;
}

1;