MooseX::FSM - The great new MooseX::FSM!


MooseX-FSM documentation Contained in the MooseX-FSM distribution.

Index


Code Index:

VERSION

Top

Version 0.01

SYNOPSIS

Top

MooseX::FSM is a moosish Finite State Machine

Perhaps a little code snippet.

    use MooseX::FSM;

    my $fsm = MooseX::FSM->new( );




	state_table = { start        => { enter => init, input => scan_dirs, exit => finish, transition => { add_dir => 'process_dir' } },
					process_dir  => { enter => new_dir, input => do_dir,  exit => done_dir, transition => { add_file => 'process_file', processed_all_files => start },
					process_file => { enter => new_file, input => do_file, exit => done_file, transition => { processed_file => process_dir }
	...

	has 'start' (
		is			=> 'ro',
		isa			=> 'MooseX::FSM::State',
		metaclass	=> 'state',
		enter		=> 'init',
		input		=> [ scan_dirs , add_dir => 'process_dir' ],
		transition	=> report_dir,
	)

	New syntax sugar coming soon
	state 'start' (
		enter => 
	)

EXPORT

Top

A list of that can be exported. You can delete this section if you don't export anything, such as for a purely object-oriented module.

FUNCTIONS

Top

function1

init_meta the init_meta function is used internaly by Moose to setup the base class which MooseX::FSM provides =cut

debug a simple debug method to log any messages apprioriately =cut

AUTHOR

Top

Gordon Irving, <goraxe at goraxe dot me dotty uk>

BUGS

Top

Please report any bugs or feature requests to bug-moosex-fsm at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=moosex-fsm. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc MooseX::FSM




You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=moosex-fsm

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/moosex-fsm

* CPAN Ratings

http://cpanratings.perl.org/d/moosex-fsm

* Search CPAN

http://search.cpan.org/dist/moosex-fsm

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top


MooseX-FSM documentation Contained in the MooseX-FSM distribution.
package MooseX::FSM;

use Moose ();
use Carp qw(carp croak cluck confess);
use MooseX::FSM::State;

use Moose::Exporter


=head1 NAME

MooseX::FSM - The great new MooseX::FSM!

our $VERSION = '0.01';


Moose::Exporter->setup_import_methods ( also => 'Moose');

sub init_meta {
	shift;
	my %options = @_;
	my $meta = Moose->init_meta(%options);

	Moose::Util::MetaRole::apply_base_class_roles (
		for_class	=> $options{for_class},
		roles 		=> [ 'MooseX::FSM::Role::Object'],
	);
	return $meta;
}

1;

package MooseX::FSM::Role::Object;

use Moose::Role;
use Carp;

#after BUILDALL => sub  {
#	my $self = shift;
#
#	if ($self->start_state) {
##		$meta->get_attribute('start_state');
#
#		$self->transition_to_state($self->start_state);
#		
#	} else {
#
#		carp __PACKAGE__ . " needs to have a 'start_state' state";
#	}
#	
#};

has 'state_table' => (
	is			=> 'ro',
);

has 'current_state' => (
	is		=> 'rw',
	trigger => \&transition_to_state,
);

has 'start_state' => (
	is		=> 'ro',
	required	=> 1,
);


sub debug {
	my ($self, $message) = @_;
#	if ($self->is_debugging) {
#		print $message;
#	}
}

sub error {
	my ($self, $message, @rest) = @_;
	carp "error: $message";
}

sub start {
	my $self = shift;
	$self->debug ("going to transition into the start state\n");
#	$self->transition_to_state($self->start_state());
	$self->current_state($self->start_state());
}

sub transition_to_state {
	my ($self, $state, @rest)  = @_;
	$self->debug( "transition to state $state\n");
#	my $meta = $self->meta;

	my @keep_funcs = qw( current_state transition_to_state debug meta state_table error ); 
	my $keep_re = join "|", @keep_funcs;
	$keep_re = qr/$keep_re/;
	my $meta = $self->meta();

	foreach my $method ($meta->get_all_methods) {
		next if ($method =~ $keep_re);
		$self->debug("\t -> removing " . $method->package_name() . "::". $method->name() . "\n");
		$meta->remove_method($method->name);
	}

	$self->debug("done remove methods\n");

	if (my $state_attr =$meta->get_attribute($state)) {
#		 $meta->get_attribute($state);
		# call exit on current_state
#		if ($self->current_state() && $self->current_state()->has_exit() ) {
#			$self->current_state()->exit();
#		}
		# call transition if exists

		# compose new class
		my $input = $state_attr->input(); # :->get_value($self);
		my $transitions = $state_attr->transitions();
		if ($input && ref ($input) eq 'HASH') {
			while ( my ($key, $sub) = each %$input) {
#				$self->debug_print_methods($state_attr);
				$self->debug("adding method : " . $key . ": ". $sub .   "\n");
#				my $method = Moose::Meta::Method->wrap($sub,{ name=>$key, package_name => ref $self}); 
				
				$meta->add_method($key,$sub); 
#				$meta->add_method($method);
				if (my $new_state =  $transitions->{$key}) { 
					$self->debug("\tsetting transition for input $key to $new_state\n");
					# TODO cache transtion sub routines
					$meta->add_after_method_modifier($key, sub { my $self = shift; return if ($self->current_state() eq $new_state); $self->current_state($new_state); });
				}
			}

		}
		# call enter on new state
		my $enter = $state_attr->enter();
		&$enter($self);
		$self->debug ("setting up new meta object\n");

	}
	else {
		$self->error("could not transition to '$state' as it doesn't exist");
	}
		#my $start_state = $meta->get_attribute($start_state_attribute);
	return $meta; #$self->meta($meta);
}


sub debug_print_attrs {
	my $self = shift;
	my $meta = $self->meta();

	foreach my $attr ($meta->get_all_attributes() ) {
		$self->debug("\t -> attribute -> " . $attr->name() . "\n");
	}
}

sub debug_print_methods {
	my $self = shift;
	my $obj = shift;
	my $meta;
	if ($obj ) {
		$meta = $obj->meta();
	} else {
		$meta =  $self->meta();
	}

	foreach my $method ($meta->get_all_methods() ) {
		$self->debug ("\t -> method -> " . $method->name() . "\n");
	}
}
1;
no Moose;
1; # End of MooseX::FSM