Gantry::State::Simple - A simple state machine for Gantry

Gantry documentation Contained in the Gantry distribution.

Index

Code Index:

NAME

Top

Gantry::State::Simple - A simple state machine for Gantry

SYNOPSIS

Top

This module implements a simple state machine to control the execution context within Gantry’s handler() method.

DESCRIPTION

Top

When a request comes into Gantry a pre‐determined set of steps are executed. These pre‐determined steps can be termed "states", and the process can be called a "state machine". There are many ways to implement a "state machine", so this document will not get into the semantics of the term.

What this module does, is allow plugins to issue a redirect and have them take effect immediately. The default behavior is to have the redirect happen after the controllers have finished processing.

This is to allow a plugin to initialize properly. For example Gantry::Plugins::Session requires a redirect to /cookiecheck to see if the session cookie has been set. Under the default state handler, this redirect happens after the initial controller has finished processing.

So a race condition happens. You can not manipulate a session until the cookie has been established which doesn't happen until after the initial controller executes. This problem goes away after the redirect.

This module fixes the problem.

CONFIGURATION

Top

To load a differant state machine you need to do the following:

use MyApp qw{ −StateMachine=Simple };

SEE ALSO

Top

 Gantry
 Gantry::State::Default
 Gantry::State::Constants

AUTHOR

Top

Kevin L. Esteb <kesteb@wsipc.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2008 Kevin L. Esteb

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.

Gantry documentation Contained in the Gantry distribution. 
package Gantry::State::Simple;
require Exporter;

use Switch;
use Gantry::State::Constants;

use strict; 
use warnings;
use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );

############################################################
# Variables                                                #
############################################################

@ISA        = qw( Exporter );
@EXPORT     = qw( 
    state_run
    state_engine
    relocate
    relocate_permanently
);

@EXPORT_OK  = qw( );

my ( @p, $p1 );

############################################################
# Functions                                                #
############################################################

#-------------------------------------------------
# $self->state_run( r_or_cgi, plugin_callbacks )
#-------------------------------------------------
sub state_run {
    my ( $self, $r_or_cgi, $plugin_callbacks ) = @_;

    my $status = 200;
    my $state = STATE_POST_ENGINE_INIT;

    eval {

        while ($state) {

            switch ($state) {
                case STATE_POST_ENGINE_INIT {
                    $state = post_engine_init($self, $plugin_callbacks);
                }
                case STATE_PRE_INIT {
                    $state = pre_init($self, $r_or_cgi, $plugin_callbacks);
                    $state = STATE_REDIRECT if ($self->redirect);
                }
                case STATE_INIT {
                    $state = initialize($self, $r_or_cgi);
                    $state = STATE_REDIRECT if ($self->redirect);
                }
                case STATE_POST_INIT {
                    $state = post_init($self, $plugin_callbacks);
                    $state = STATE_REDIRECT if ($self->redirect);
                }
                case STATE_CACHED_PAGES {
                    $state = cached_pages($self);
                }
                case STATE_PRE_ACTION {
                    $state = pre_action($self, $plugin_callbacks);
                    $state = STATE_REDIRECT if ($self->redirect);
                }
                case STATE_ACTION {
                    $state = perform_action($self);
                    $state = STATE_REDIRECT if ($self->redirect);
                    $state = STATE_DECLINED if ($self->declined);
                }
                case STATE_POST_ACTION {
                    $state = post_action($self, $plugin_callbacks);
                    $state = STATE_REDIRECT if ($self->redirect);
                }
                case STATE_SET_HEADERS {
                    $state = set_headers($self);
                }
                case STATE_PRE_PROCESS {
                    $state = pre_process($self, $plugin_callbacks);
                }
                case STATE_PROCESS {
                    $state = process_template($self);
                }
                case STATE_POST_PROCESS {
                    $state = post_process($self, $plugin_callbacks);
                }
                case STATE_OUTPUT {
                    $state = send_output($self);
                }
                case STATE_REDIRECT {
                    $self->redirect_response();
                    $state = STATE_SEND_STATUS;
                }
                case STATE_DECLINED {
                    $self->declined_response($self->action());
                    $state = STATE_SEND_STATUS;
                }
                case STATE_SEND_STATUS {
                    $status =  $self->status ? $self->status : $self->success_code ;
                    $state = STATE_FINI;
                }
            };

        }

    }; if ($@) {

        # Call do_error and return

        my $e = $@;
        $self->do_error($e);
        return($self->cast_custom_error($self->custom_error($e), $e));

    }

    return $status;
}

#-------------------------------------------------
# $self->relocate( $location )
#-------------------------------------------------
sub relocate {
    my ( $self, $location ) = ( shift, shift );

    $location = $self->location if ( ! defined $location );
    $self->redirect( 1 ); # Tag it for the handler to handle nice.
    $self->header_out( 'location', $location );
    $self->status( $self->status_const( 'REDIRECT' ) );

} # end relocate

#-------------------------------------------------
# $self->relocate_permanently( $location )
#-------------------------------------------------
sub relocate_permanently {
    my ( $self, $location ) = ( shift, shift );

    $location = $self->location if ( ! defined $location );
    $self->redirect( 1 ); # Tag it for the handler to handle nice.
    $self->header_out( 'location', $location );
    $self->status( $self->status_const( 'MOVED_PERMANENTLY' ) );

} # end relocate_permanently

#-------------------------------------------------
# $self->state_engine
#-------------------------------------------------
sub state_engine {
    return __PACKAGE__;

} # end state_engine

#-------------------------------------------------
# Private methods
#-------------------------------------------------

sub post_engine_init {
    my ($self, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'post_engine_init' phase

    if (defined $plugin_callbacks->{ $self->namespace }->{ post_engine_init }) {

        foreach my $cb (
            @{ $plugin_callbacks->{ $self->namespace }->{ post_engine_init } }
        ) {
            $cb->( $self );
        }

    }

    return STATE_PRE_INIT;

}

sub pre_init {
    my ($self, $r_or_cgi, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'pre_init' phase 

    if (defined $plugin_callbacks->{ $self->namespace }->{ pre_init }) {

        foreach my $cb (
            @{ $plugin_callbacks->{ $self->namespace }->{ pre_init } }
        ) {
            $cb->( $self, $r_or_cgi );
        }

    }

    return STATE_INIT;

}

sub initialize {
    my ($self, $r_or_cgi) = @_;

    $self->init( $r_or_cgi );

    @p  = $self->cleanroot( $self->dispatch_location() );
    $p1 = ( shift( @p ) || 'main' );

    # set the action
    $self->action( 'do_'. $p1 );

    return STATE_POST_INIT;

}

sub post_init {
    my ($self, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'post_init' phase 

    if (defined $plugin_callbacks->{ $self->namespace }->{ post_init }) {

        foreach my $cb ( 
            @{ $plugin_callbacks->{ $self->namespace }->{ post_init } } 
        ) {
            $cb->( $self );
        }

    }

    return STATE_CACHED_PAGES;

}

sub cached_pages {
    my ($self) = @_;

    # check for response page -- used primarily for caching

    if ($self->gantry_response_page()) {

        $self->set_content_type();
        $self->set_no_cache();       
        $self->status($self->success_code());
        return STATE_OUTPUT;

    }

    return STATE_PRE_ACTION;

}

sub pre_action {
    my ($self, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'pre_action' phase

    if (defined $plugin_callbacks->{ $self->namespace }->{ pre_action }) {

        foreach my $cb (
            @{ $plugin_callbacks->{ $self->namespace }->{ pre_action } } 
        ) {
            $cb->( $self );
        }

    }

    return STATE_ACTION;

}

sub perform_action {
    my ($self) = @_;

    # Do action if valid

    if ($self->can($self->action())) {  

        $self->do_action($self->action(), @p);
        $self->cleanup();  # Cleanup.

    } elsif ($self->can('do_default')) {

        # try the default action

        $self->do_action('do_default', $p1, @p);
        $self->cleanup();

    } else {

        # else return declined

        $self->declined(1);

    }

    $self->declined(1) if ($self->is_status_declined());

    return STATE_POST_ACTION;

}

sub post_action {
    my ($self, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'post_action' phase

    if (defined $plugin_callbacks->{ $self->namespace }->{ post_action }) {

        foreach my $cb (
            @{ $plugin_callbacks->{ $self->namespace }->{ post_action } } 
        ) {
            $cb->( $self );
        }

    }

    return STATE_SET_HEADERS;

}

sub set_headers {
    my ($self) = @_;

    # set http headers

    $self->set_content_type();
    $self->set_no_cache();

    return STATE_PRE_PROCESS;

}

sub pre_process {
    my ($self, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'pre_process' phase

    if (defined $plugin_callbacks->{ $self->namespace }->{ pre_process }) {

        foreach my $cb ( 
            @{ $plugin_callbacks->{ $self->namespace }->{ pre_process } } 
        ) {
            $cb->( $self );
        }

    }

    return STATE_PROCESS;

}

sub process_template {
    my ($self) = @_;

    $self->gantry_response_page( $self->do_process() || '' );

    return STATE_POST_PROCESS;

}

sub post_process {
    my ($self, $plugin_callbacks) = @_;

    # Do the plugin callbacks for the 'post_process' phase 

    if (defined $plugin_callbacks->{ $self->namespace }->{ post_process }) {

        foreach my $cb ( 
            @{ $plugin_callbacks->{ $self->namespace }->{ post_process } } 
        ) {
            $cb->( $self );
        }

    }

    return STATE_OUTPUT;

}

sub send_output {
    my ($self) = @_;

    my $status = $self->status() ? $self->status() : 200;

    if ( $status < 400 ) {
        $self->send_http_header();
        $self->print_output( $self->gantry_response_page() );        
        $self->status($self->status_const('OK'));

    } else {

        $self->cast_custom_error( $self->gantry_response_page() ); 

    }

    return STATE_SEND_STATUS;

}

1;

__END__