POE::Session::Cascading - Stack-like POE Sessions

    POE::Session::Cascading->new(
        name => 'foo',
        events => [
            'state1' => \&state1,
            'state2 => \&state2,
        ],
    );

    sub state1 {
        my %args = @_;
        $args{KERNEL}->post('somewhere','somestate');
        # [ snip ]

    }

    sub state2 {
        my %args = @_;
        # [ snip ]

        $args{SESSION}->stop;
    }

    $poe_kernel->post('foo','state1');

    POE::Session::Cascading->new(
        name => 'foo',
        events => [
            step1 => \&step1,
            step2 => \&step2,
            step3 => \&step3,
        ]
    );

    $args{SESSION}->stop;

    $args{SESSION}->go;

    $args{SESSION}->swap($state1, $state2);

package POE::Session::Cascading;

# DOCUMENTATION #{{{

#}}}


use warnings;
use strict;

use Carp;
use POE::Kernel;
use vars qw(%STACK %STACKINFO);

our $VERSION = '2.01';

sub CSC_STOP () { 0 }
sub CSC_OK () { 1 }

BEGIN {
    unless(defined &POE::Session::Cascading::DEBUG) {
        *POE::Session::Cascading::DEBUG = sub { 0 } ;
    }
}               


# sub new {{{

sub new {
    my $class = shift;
    croak("No arguments passed to new(). Cannot continue.") unless @_;
    croak("Odd number of arguments passed to new(). Cannot continue.") unless $#_ % 2;

    my %args = @_;
    
    croak("Argument 'name' not passed to new(). Cannot continue.") unless $args{name};
    croak("Argument 'events' not passed to new(). Cannot continue.") unless $args{events};
    croak("Argument 'events' not an array reference in new(). Cannot continue.") unless ref $args{events} eq 'ARRAY';
     
    my $sess_name = $args{name};
    my $event_stack = $args{events};

    croak("There is already a session by the name of '$sess_name'. Cannot continue.") if $STACK{$sess_name};

    print "Creating new stack named $sess_name\n" if DEBUG;
    for (my $i = 0; $i<@{$event_stack}; $i++) {
        my $name = $event_stack->[$i];
        my $coderef = $event_stack->[++$i];
        unless(ref $coderef eq 'CODE') {
            carp("Event '$name' not a code reference. Skipping.");
            next;
        }
        print "Registering state '$name' for session '$sess_name'\n" if DEBUG;
        push @{$STACK{$sess_name}}, $coderef;
        $STACKINFO{$sess_name}{$name} = $#{$STACK{$sess_name}};
    }
        
    my $self = {};
    $self->{name} = $sess_name;
    $self->{stack} = $STACK{$sess_name};
    $self->{info} = $STACKINFO{$sess_name};
    $self->{status} = CSC_OK;
     
    bless $self, $class;
    print "Allocating a new POE session for stack named $sess_name\n" if DEBUG;
    $POE::Kernel::poe_kernel->session_alloc($self);
    return $self;
}
#}}}

# sub _invoke_state {{{

# Handle events
sub _invoke_state {
    my ($self, $source_session, $state, $etc, $file, $line) = @_;
    print "Caught event $state\n" if DEBUG;
   
    assert($self,"Object integrity");
    assert($state,"State name");
    
    if($state eq '_start') {
        # Starting up. Set an alias and ensure persistence
        
        print "Setting kernel alias to $self->{name}\n" if DEBUG;
        $POE::Kernel::poe_kernel->alias_set($self->{name});
        
    } elsif ($state eq '_stop') {
        # Shutting down. Delete the relevant stack.
        
        print "Deleting stack for $self->{name} in _stop\n" if DEBUG;
        delete $STACK{$self->{name}};
        
    } elsif ($state eq 'step') {
        # Take a step. Fire off the wrapper.
        # This is a happy call to make sure this blocks a lot less than it would otherwise.
        
        return $self->step(@{$etc});
        
    } else {
        # A normal event. Do we know this event? Does it belong to stack?
        if(defined $self->{info}->{$state}) {
            # We know this state and this stack. Fire off the wrapper to process the stack.
            $POE::Kernel::poe_kernel->post($self->{name}, 'step', $STACKINFO{$self->{name}}{$state}, @{$etc});
            
        } else {
            # We have no idea what this event is. 
            print "ERR: Unknown event '$state' called on session '$self->{name}'\n" if DEBUG;
            
        } 
    }
}
#}}}

# sub step {{{

sub step {
    my $self = shift;
    my $itr = shift;
    my @args = @_;
    if($itr < @{$self->{stack}}) {
        my $ret = $self->{stack}->[$itr]->(SESSION => $self, KERNEL => $POE::Kernel::poe_kernel, ARGS => \@args);
        if ( ($self->{status} != CSC_STOP) && (++$itr < @{$self->{stack}})) {
            $self->{status} = CSC_OK;
            $POE::Kernel::poe_kernel->post($self->{name}, 'step', $itr, $ret, @args);
        } else {
            return CSC_STOP;
        }
    }
}
# }}}

sub ID {
  $POE::Kernel::poe_kernel->ID_session_to_id(shift);
}

sub stop {
    my $self = shift;
    $self->{status} = CSC_STOP;
}

sub go {
    my $self = shift;
    $self->{status} = CSC_OK;
}

sub swap {
    my $self = shift;
    my ($state1, $state2) = @_;

    assert(ref $self,'Object integrity');
    assert($self->{info}, 'Stash integrity');
    assert(ref $self->{info}, 'Stash referential integrity');
    assert($self->{stack}, 'Stack integrity');
    assert(ref $self->{stack}, 'Stack referential integrity');

    
    return 0 unless $state1 and $state2;
    
        
    my $pos1 = $self->{info}->{$state1};
    my $pos2 = $self->{info}->{$state2};

    return 0 unless defined $pos1 and defined $pos2;
    
    my $temp = $self->{stack}->[$pos1];
    $self->{stack}->[$pos1] = $self->{stack}->[$pos2];
    $self->{stack}->[$pos2] = $temp;
    
    $self->{info}->{$state1} = $pos2;
    $self->{info}->{$state2} = $pos1;
    
    return 1;
}

sub DESTROY {
    my $self = shift; 
    return unless ref $self && $self->{name};
    delete $STACK{$self->{name}};
    delete $STACKINFO{$self->{name}};
}

sub assert ($;$) {
    unless($_[0]) {
        Carp::confess( _fail_msg($_[1]) );
    }
    return undef;
} 

# Can't call confess() here or the stack trace will be wrong.
sub _fail_msg {
    my($name) = shift;
    my $msg = 'Assertion';
    $msg   .= " ($name)" if defined $name;
    $msg   .= " failed!\n";
    return $msg;
}     

1;
__END__

# MORE DOCS {{{

#}}}

# sungo // vim: ts=4 sw=4 et