# Note: All states MUST have package names that begin with 'State::'.
# You can distinguish state-machines as different top-level states.
# Triggers must be in title case

package State;

=head1 State

State library for implementing dynamic-class state-machines.

TODO:

* Think about other ways to do this more efficiently, but also with nice programmer's API

=cut

use strict;
use Carp;

=head2 new

=cut

sub new {
    my ($state, $self) = @_;
    croak "class 'State' is abstract" if $state eq 'State';
    bless $self ||= {}, 'State';
    $self->state($state);
    $self;
}

=head2 state

change to the specified state

=cut

sub state {
    my ($self, $new_state) = @_;
    my $state = ref $self;

    # check whether the new state exists - remove after debugging
    {
	no strict 'refs';
	croak "no such state '$new_state'" unless @{"${new_state}::ISA"};
    }

    # call any exit handlers
    if ($state ne substr $new_state, 0, length $state) {{
	$self->exit;
	$state = substr $state, 0, rindex $state, '::';
	# NOTE: if bless is expensive, don't bless into the common ancestor, unless this IS the new_state
	bless $self, $state;
	last if $state eq substr $new_state, 0, length $state;
	redo;
    }}

    # call any entry handlers
    substr $new_state, 0, length $state, '';
    while (length $new_state) {
	my $i = index $new_state, '::', 2;
	$i = length $new_state if $i == -1;
	$state .= substr $new_state, 0, $i, '';
	bless $self, $state;
	$self->enter;
    }
}

=head2 NOTE:

Beware of calling to, in, out from an event handler for a super-state of the current state.
perhaps should use caller or something to test this?

=cut

=head2 level

change state to that of the calling package - useful when a trigger is handled in an outer state, and the inner state is to be discarded.  Then 'to', 'in', 'out' may be called.  This is a bit dodgy.

=cut

sub level {
    my $self = shift;
    my $new_state = caller;
    $self->state($new_state);
}

=head2 to

change state to another at same level

=cut

sub to {
    my ($self, $new_state) = @_;
    my $state = ref $self;
    $self->state(substr($state, 0, 2 + rindex $state, '::') . $new_state);
}

=head2 in

change state to a substate

=cut

sub in {
    my ($self, $new_state) = @_;
    $self->state(ref($self) . "::$new_state");
}

=head2 out

change state to parent state

=cut

sub out {
    my ($self, $n) = @_;
    my $state = ref $self;
    for (1..(defined $n ? $n : 1)) {
	$state = substr $state, 0, rindex $state, '::';
    }
    $self->state($state);
}

=head2 DESTROY

TODO: watch out for double DESTROY problem - can you fix it?

=cut

sub DESTROY {
    my ($self) = @_;
    $self->state('State');
}

=head2 enter

=cut

sub enter {
#    print "entering state ". ref(shift) . "\n";
}

=head2 exit

=cut

sub exit {
#    print "leaving state ". ref(shift) . "\n";
}

1
