view release on metacpan or  search on metacpan

lib/FSA/Rules.pm  view on Meta::CPAN

      },
      yow => {
          rule    => \&goto_yow,
          message => 'Yow!',
          action  => [ \&action_one, \&action_two],
      }
  ]

A rule may also simply be a code reference or value that will be evaluated
when FSA::Rules is determining whether to switch to the new state. You might want
just specify a value or code reference if you don't need a message label or
switch actions to be executed. For example, this C<rules> specification:

  rules => [
      foo => 1
  ]

Is equivalent to this C<rules> specification:

  rules => [
      foo => { rule => 1 }
  ]

And finally, you can specify a rule as an array reference. In this case, the
first item in the array will be evaluated to determine whether to switch to
the new state, and any other items must be code references that will be
executed during the switch. For example, this C<rules> specification:

  rules => [
      yow => [ \&check_yow, \&action_one, \&action_two ]
  ]

Is equivalent to this C<rules> specification:

  rules => [
      yow => {
          rule   =>  \&check_yow,
          action => [ \&action_one, \&action_two ],
      }
  ]

=back

=cut

my (%machines, %states);

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    my $params = ref $_[0] ? shift : {};
    my $fsa = $machines{$self} = {
        done   => undef,
        notes  => {},
        stack  => [],
        table  => {},
        self   => $self,
    };

    # Weaken the circular reference.
    Scalar::Util::weaken $fsa->{self};

    $params->{state_class}  ||= 'FSA::State';
    $params->{state_params} ||= {};
    while (@_) {
        my $state = shift;
        my $def   = shift;
        $self->_croak(qq{The state "$state" already exists})
          if exists $fsa->{table}{$state};

        # Setup enter, exit, and do actions.
        for (qw(on_enter do on_exit)) {
            if (my $ref = ref $def->{$_}) {
                $def->{$_} = [$def->{$_}] if $ref eq 'CODE';
            } else {
                $def->{$_} = [];
            }
        }

        # Create the state object and cache the state data.
        my $obj = $params->{state_class}->new(%{$params->{state_params}});
        $def->{name} = $state;
        $def->{machine} = $self;
        $fsa->{table}{$state} = $obj;
        push @{$fsa->{ord}}, $obj;
        $states{$obj} = $def;

        # Weaken the circular reference.
        Scalar::Util::weaken $def->{machine};
    }

    # Setup rules. We process the table a second time to catch invalid
    # references.
    while (my ($key, $obj) = each %{$fsa->{table}}) {
        my $def = $states{$obj};
        if (my $rule_spec = $def->{rules}) {
            my @rules;
            while (@$rule_spec) {
                my $state = shift @$rule_spec;
                $self->_croak(
                    qq{Unknown state "$state" referenced by state "$key"}
                ) unless $fsa->{table}{$state};

                my $rules = shift @$rule_spec;
                my $exec = ref $rules eq 'ARRAY' ? $rules : [$rules];
                my $rule = shift @$exec;
                my $message;
                if (ref $rule eq 'HASH') {
                    $self->_croak(
                        qq{In rule "$state", state "$key": you must supply a rule.}
                    ) unless exists $rule->{rule};
                    $exec = ref $rule->{action} eq 'ARRAY'
                      ? $rule->{action}
                      : [$rule->{action}]
                      if exists $rule->{action};
                    $message = $rule->{message} if exists $rule->{message};
                    $rule    = $rule->{rule};
                }
                # Used to convert a raw value to a code reference here, but as
                # it ended up as a closure and these don't serialize very
                # well, I pulled it out. Now try_switch has to check to see if
                # a rule is a literal value each time it's called. This
                # actually makes it faster for literal values, but a little
                # slower for code references.

                push @rules, {
                    state   => $fsa->{table}{$state},
                    rule    => $rule,
                    exec    => $exec,
                    message => $message,
                };

                # Weaken the circular reference.
                Scalar::Util::weaken $rules[-1]->{state};
            }
            $def->{rules} = \@rules;
        } else {
            $def->{rules} = [];
        }
    }

    # Handle any parameters.
    $self->start if $params->{start};
    $self->done($params->{done}) if exists $params->{done};
    $self->strict($params->{strict}) if exists $params->{strict};
    return $self;
}

##############################################################################

=head1 Instance Interface

=head2 Instance Methods

=head3 start

  my $state = $fsa->start;

Starts the state machine by setting the state to the first state defined in
the call to C<new()>. If the machine is already in a state, an exception will
be thrown. Returns the start state FSA::State object.

=cut

sub start {
    my $self = shift;
    my $fsa = $machines{$self};
    $self->_croak(
        'Cannot start machine because it is already running'
    ) if $fsa->{current};
    my $state = $fsa->{ord}[0] or return $self;
    $self->curr_state($state);
    return $state;
}

##############################################################################

=head3 at

  $fsa->switch until $fsa->at('game_over');

Requires a state name. Returns false if the current machine state does not
match the name. Otherwise, it returns the state.

=cut

sub at {
    my ($self, $name) = @_;
    $self->_croak("You must supply a state name") unless defined $name;
    my $fsa = $machines{$self};
    $self->_croak(qq{No such state "$name"})
      unless exists $fsa->{table}{$name};
    my $state = $self->curr_state or return;
    return unless $state->name eq $name;