The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl FSM-Simple.t'

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

# change 'tests => 1' to 'tests => last_test_to_print';

use strict;
use warnings;

use Test::More tests => 83;
use Test::Exception;

BEGIN { use_ok('FSM::Simple') };

my $machine = FSM::Simple->new(trans_history => 1);

# Define states.
lives_ok { $machine->add_state(name => 'init',      sub => \&init)      } 'add state init';
lives_ok { $machine->add_state(name => 'make_cake', sub => \&make_cake) } 'add state make_cake';
lives_ok { $machine->add_state(name => 'eat_cake',  sub => \&eat_cake)  } 'add state eat_cake';
lives_ok { $machine->add_state(name => 'clean',     sub => \&clean)     } 'add state clean';
lives_ok { $machine->add_state(name => 'stop',      sub => \&stop)      } 'add state stop';

# Set initial state - optional (default it is first added state).
lives_ok { $machine->init_state('init') } 'set init state';
ok $machine->init_state eq 'init', 'check returned init state';

# Define transitions.
lives_ok { $machine->add_trans(from => 'init',      to => 'make_cake', exp_val => 'makeCake') } 'add transition 1';
lives_ok { $machine->add_trans(from => 'make_cake', to => 'eat_cake',  exp_val => 1)          } 'add transition 2';
lives_ok { $machine->add_trans(from => 'eat_cake',  to => 'clean',     exp_val => 'good')     } 'add transition 3';
lives_ok { $machine->add_trans(from => 'eat_cake',  to => 'make_cake', exp_val => 'bad')      } 'add transition 4';
lives_ok { $machine->add_trans(from => 'clean',     to => 'stop',      exp_val => 'foo')      } 'add transition 5';
lives_ok { $machine->add_trans(from => 'clean',     to => 'stop',      exp_val => 'done')     } 'add transition 6'; # 'stop' is a key of hash that this transition is replacing previous transitions.


lives_ok { $machine->run() } 'run state machine';


print "\n";
my $ra_trans_history = $machine->trans_history;
ok ref $ra_trans_history eq 'ARRAY',   'check trans_history returned type (1)';
ok scalar @$ra_trans_history,          'check size of history array (1)'; # array has random size but greater than 0
ok shift @$ra_trans_history eq 'init', 'check first element in history array';
ok pop @$ra_trans_history   eq 'stop', 'check last element in history array';

print "\n";
$machine->clear_trans_history;
$ra_trans_history = $machine->trans_history;
ok ref $ra_trans_history eq 'ARRAY',   'check trans_history returned type (2)';
ok 0 == scalar @$ra_trans_history,     'check size of history array (2)';


# Without trans history.
print "\n";
$machine->clear_trans_history;
$machine->clear_trans_stats;
$machine->trans_history_off;
lives_ok { $machine->run() } 'run state machine without transitions history';

$ra_trans_history = $machine->trans_history;
ok ref $ra_trans_history eq 'ARRAY',  'check trans_history returned type (3)';
ok 0 == scalar(@$ra_trans_history),   'check size of history array (3)';


print "\n";
my $rh_trans_stats = $machine->trans_stats;
ok ref $rh_trans_stats eq 'HASH',  'check trans_stats returned type (1)';
ok exists $rh_trans_stats->{init}, 'check init state existence';
ok $rh_trans_stats->{init} == 1,   'check init state counter';

print "\n";
$machine->clear_trans_stats;
$rh_trans_stats = $machine->trans_stats;
ok ref $rh_trans_stats eq 'HASH',     'check trans_stats returned type (2)';
ok exists $rh_trans_stats->{init},    'check init state existence (2)';
ok $rh_trans_stats->{init} == 0,      'check init state counter (2)';

print "\n";
my @trans_array = $machine->trans_array;
ok scalar @trans_array,            'check size of transitions array';
my $index = 0;
foreach my $rh_trans (@trans_array) {
    print "\n";
    ok ref $rh_trans eq 'HASH',  "check type of transitions array element [$index]";
    ok exists $rh_trans->{from}, "check existence of 'from' key in transitions array element [$index]"; 
    ok exists $rh_trans->{to},   "check existence of 'to' key in transitions array element [$index]";
    ok exists $rh_trans->{returned_value}, "check existence of 'returned_value' key in transitions array element [$index]";    
    
    if ($rh_trans->{from} eq 'make_cake') {
        ok $rh_trans->{to} eq 'eat_cake',      'check destination state in transition';
        ok $rh_trans->{returned_value} eq '1', 'check returned value in transition';
    }
    
    $index++;
}

print "\n";
my $graphviz_code = $machine->generate_graphviz_code(name => 'test_graph', size => '7');
ok ref $graphviz_code eq '', 'check generate_graphviz_code returned type (1)';
ok $graphviz_code =~ /digraph test_graph/, 'check name of graphviz definition';
ok $graphviz_code =~ /size="7"/x,          'check value of size in graphviz code (1)';

print "\n";
$graphviz_code = $machine->generate_graphviz_code;
ok ref $graphviz_code eq '', 'check generate_graphviz_code returned type (2)';
ok $graphviz_code =~ /digraph finite_state_machine/, 'check default name of graphviz definition';
ok $graphviz_code =~ /size="8"/x,                    'check default value of size in graphviz code (2)';

print "\n";
$graphviz_code = $machine->generate_graphviz_code(name => 'test_graph3');
ok ref $graphviz_code eq '', 'check generate_graphviz_code returned type (3)';
ok $graphviz_code =~ /digraph test_graph3/, 'check another name of graphviz definition';
ok $graphviz_code =~ /size="8"/x,           'check default value of size in graphviz code (3)';


# Checking die when is non existing returned value.
lives_ok { $machine->add_state(name => 'wrong_ret_val', sub => \&wrong_ret_val) } 'add state which returns wrong value';
lives_ok { $machine->init_state('wrong_ret_val')                                } 'set new init state (1)';
dies_ok  { $machine->run()                                                      } 'run state machine again and die (1)';

# Checking die when returned value from custom sub is not a SCALAR.
lives_ok { $machine->add_state(name => 'wrong_ret_val_type', sub => \&wrong_ret_val_type) } 'add state which returns wrong value type';
lives_ok { $machine->init_state('wrong_ret_val_type')                                } 'set new init state (2)';
dies_ok  { $machine->run()                                                      } 'run state machine again and die (2)';



# Without trans history.
print "\n";
my $machine2 = FSM::Simple->new(); 

# Define states.
lives_ok { $machine2->add_state(name => 'init', sub => \&init) } 'add state init';
lives_ok { $machine2->add_state(name => 'stop', sub => \&stop) } 'add state stop';

# Define transitions.
lives_ok { $machine2->add_trans(from => 'init', to => 'stop', exp_val => 'makeCake') } 'add transition 1';

lives_ok { $machine2->run() } 'run state machine without transitions history';

my $ra_trans_history2 = $machine2->trans_history;
ok ref $ra_trans_history2 eq 'ARRAY', 'check trans_history returned type (4)';
ok 0 == scalar(@$ra_trans_history2),  'check size of history array (4)';


# With trans history.
print "\n";
my $machine3 = FSM::Simple->new(); # 

# Define states.
lives_ok { $machine3->add_state(name => 'init', sub => \&init) } 'add state init';
lives_ok { $machine3->add_state(name => 'stop', sub => \&stop) } 'add state stop';

# Define transitions.
lives_ok { $machine3->add_trans(from => 'init', to => 'stop', exp_val => 'makeCake') } 'add transition 1';

lives_ok { $machine3->trans_history_on } 'turn on transitions history';
lives_ok { $machine3->run() } 'run state machine with turned on transitions history';

my $ra_trans_history3 = $machine3->trans_history;
ok ref $ra_trans_history3    eq 'ARRAY', 'check trans_history returned type (5)';
ok 2 == scalar(@$ra_trans_history3),  'check size of history array (5)';
ok shift @$ra_trans_history3 eq 'init', 'check first element in history array (5)';
ok shift @$ra_trans_history3 eq 'stop', 'check last element in history array (5)';



##########################################################################################
### User defined subroutines.
##########################################################################################

sub init {
	my $rh_args = shift;
	print "Let's make a cake\n";
	
	$rh_args->{returned_value} = 'makeCake';
	return $rh_args;
}

sub make_cake {
	my $rh_args = shift;
	print "I am making a cake\n";

    $rh_args->{returned_value} = 1;
    return $rh_args;
}

sub eat_cake {
	my $rh_args = shift;
	print "I am eating a cake\n";
	
	# If the cake is tasty then return 'good' otherwise 'bad'.
	srand;
	if (rand(1000) < 400) {
		$rh_args->{returned_value} = 'good';
	}
	else {
		$rh_args->{returned_value} = 'bad';
	}
    
    return $rh_args;
}

sub clean {
	my $rh_args = shift;
	print "I am cleaning the kitchen\n";

    $rh_args->{returned_value} = 'done';
    return $rh_args;
}

sub stop {
	my $rh_args = shift;
	print "Stop machine\n";

    $rh_args->{returned_value} = undef;
    return $rh_args;
}

sub wrong_ret_val {
    my $rh_args = shift;
    
    $rh_args->{returned_value} = 'not_expecting_value';
    return $rh_args;
}

sub wrong_ret_val_type {
    my $rh_args = shift;
    
    $rh_args->{returned_value} = ['some_value'];
    return $rh_args;
}

1;