#!/usr/bin/perl
#
# $Id: StateMachine.pm,v 1.3 2001/10/06 22:19:14 levine Exp $
#
# Copyright (C) 2001  James D. Levine (jdl@vinecorp.com)
#
#
#   This program is free software; you can redistribute it and/or
#   modify it under the terms of the GNU General Public License
#   as published by the Free Software Foundation; either version 2
#   of the License, or (at your option) any later version.
# 
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
# 
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 
#   02111-1307, USA.
#
####################################################################

####################################################################
#
# Implements a rather simple state machine.  Each state is a perl
# object.  The input "symbols" are NWatch::Packet types.  The
# equivalence function for matching input to transitions is a perl
# expression that is evaluated as each packet is received.  Each
# state also has a perl expression which executes when the state
# is entered.
#
# The state machine exposes arbitrary storage to the expressions
# using the storage hash, addressable within expressions
# via %s:FIELD_NAME%.  The state machine performs a substitution
# at the appropriate time.
#
# Fields of the input packet are addressed via %p:FIELD_NAME%.  The
# specific field names are available in the class definitions
# that implement the different packet types.
#
# Eventually the state machine will also expose certain parts of
# the runtime environment such as user preferences, i/o handles, 
# etc. to allow the perl expressions to be more functional.
#
#
#
#
####################################################################

use strict;
use NWatch::Packet;


package NWatch::sm_transition;

sub new
{
    my( $class, $expr, $state ) = @_;

    my $self = 
    {
	expr => $expr,
	state => $state,
    };

    bless $self, $class;
    $self;
}

sub set_or_get
{
    my $field = shift;
    my $self = shift;
    my $val = shift;

    $self->{$field} = $val if defined $val;

    return $self->{$field};
}

sub expr {set_or_get('expr', @_);}
sub state {set_or_get('state', @_);}




####################################################################
#
# sm_state
#
# each state is a 3-tuple ( name, entry_expression, arcs )
# entry_expression = a perl expression evaluated when the state is entered
#
####################################################################



package NWatch::sm_state;

sub set_or_get
{
    my $field = shift;
    my $self = shift;
    my $val = shift;

    $self->{$field} = $val if defined $val;

    return $self->{$field};
}


sub name {set_or_get('name', @_);}
sub entry_expr {set_or_get('entry_expr', @_);}
sub transitions {set_or_get('transitions', @_);}

sub new
{
    my( $class, $name, $entry_expr, $transitions ) = @_;

    my $self = 
    {
	name => $name,		# a text label, for initial machine assembly and logging
	entry_expr => $entry_expr, # some expression to eval when the state is entered
	transitions => undef,	# a listref of sm_transition instances
    };

    bless $self, $class;

    $self;
}

sub entry_expr_subst
{
    my( $self, $packet ) = @_;
    return $self->subst( $self->entry_expr, $packet );
}




####################################################################
#
# state_machine
#
#
# states is a list of sm_state instances;
# states[0] is the start state
#
####################################################################

# add persistent state storage hash
# formalize access to nwatch environment ( i/o channels, user options, port/host observations )

package NWatch::state_machine;


sub new
{
    my( $class, $states, $handler ) = @_;

    my $self = 
    {
	states => $states,	# compiled definition of state machine
	current => $states->[0], # start state is first defined in list
	handler => $handler,	# the PacketHandler which owns this machine

	storage => {},		# arbitrary storage hash for state machine expressions
    };

    bless $self, $class;
    $self->{'time'} = time;

    $self;
}

sub current {set_or_get('current', @_);}
sub handler {set_or_get('handler', @_);}

# return age in seconds

sub age
{
    time - $_[0]->{'time'};
}

sub set_or_get
{
    my $field = shift;
    my $self = shift;
    my $val = shift;

    $self->{$field} = $val if defined $val;

    return $self->{$field};
}


#
# each state specified as [ name, entry-expr [ edges: [eval-expr, transition-to-name)], .. ]
#
#
#

sub compile
{
    my( $states ) = shift;

    # keep both a hash and a list of the states

    my $states_list = [];
    my $states_hash = {};


    # gather up all states, store in an ordered list and a hash
    # mapping the state name to the sm_state instance

    foreach my $state ( @$states )
    {
	my( $name, $entry_expr, $transitions ) = @$state;

	$entry_expr = full_subst( $entry_expr );


#	print "compile: name: $name  entry_expr: $entry_expr  transitions: $transitions \n"
#	    if( NWatch::state_machine::verbose );

	my $s = new NWatch::sm_state( $name, $entry_expr, 0 ); # temporary
	push @$states_list, $s;
	$states_hash->{$name} = $s;
    }


    # now pass over each state, resolving the transitions
    # match each next_state name to the actual sm_state instance
    # mapped in states_hash 

    foreach my $state ( @$states )
    {
	my( $name, $entry_expr, $transitions ) = @$state;

	$entry_expr = full_subst( $entry_expr );

	my $transition_list = [];
	foreach my $transition ( @$transitions )
	{
	    my( $expr, $next_state ) = @$transition;

	    $expr = '( ' . full_subst( $expr ) . ' )';

#	    print "compile: transition: $expr -> $next_state \n"
#		if( NWatch::state_machine::verbose );

	    push @$transition_list, 
	    new NWatch::sm_transition( $expr,
				       $states_hash->{$next_state} );
	}

	$states_hash->{$name}->transitions( $transition_list );
    }

    $states_list;
}


#
# Instead of a stack or a tape, the state machine has a hash
# for storage in which the state machine can store and reference
# arbitrary key/value pairs
#
#  %s:FIELD% - substitute with the value of FIELD from storage
#  %s:FIELD%=expr; - assign a value to FIELD
#

sub storage
{
    my $self = shift;
    return $self->{storage};
}

sub process_packet
{
    my( $self, $packet ) = @_;

    
    my $foo = $self->{current}->input( $packet, $self );

    $self->{current} = $foo;

    my $e = $foo->entry_expr_subst( $packet );
#    my $e = $self->field_expr_subst( $self->storage );

    eval $e;
}


#
# full_subst
#
# a static method which replaces instances of %p:FIELD% and %s:FIELD%
#
# %p:FIELD% maps to $packet->get( "FIELD" )
# %s:FIELD% maps to $self->storage{ "FIELD" }
#
# 

sub full_subst
{
    my( $string, $packet ) = @_;

    $string =~ s/\%p:([\:\w]*)\%/\$p->field_path( "$1" )/g;

    $string =~ s/\%s:(\w*)\%/\$self->storage()->{"$1"}/g;

    $string;
}


sub input
{
    my( $self, $p ) = @_;

#    print "StateMachine::input entry \n";

    my $transitions = $self->current->transitions;	# get current state's transitions
    my $i = 0;			# index into list of transitions

    while( $i <= $#$transitions )
    {
	my $t = $transitions->[$i];

	if( eval $t->expr )	# state matches
	{
	    $self->current( $t->state );
	    #print "StateMachine::input $p evaluating " . $t->state->entry_expr . "\n";
	    eval $t->state->entry_expr;
	    return $t->state;
	}

	$i++;
    }

#    print( "NWatch::state_machine::input: no matching state found\n" )
#	if( NWatch::state_machine::verbose );

    # fall through - let state machine designer insert a default transition
    # if they want to 
}



#
# Simply a packet type which signifies end of transmission.
#

package NWatch::EOT_packet;

@NWatch::EOT_packet::ISA = qw( NWatch::packet );


sub protocol_name { "EOT"; }


sub new
{
    my( $type, $data ) = @_;

    # init from base class
    my $self = NWatch::packet::new( $type, $data );

    $self->set( "eot", 1 );

    $self;
}


1;