view release on metacpan or  search on metacpan

lib/Gantry/State/Simple.pm  view on Meta::CPAN

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