Catalyst::Action::Wizard - actions like realization of wizards. You need this

#===============================================================================
#
#         FILE:  Wizard.pm
#
#  DESCRIPTION:  Wizarded action.
#
#       AUTHOR:  Pavel Boldin (), <davinchi@cpan.ru>
#      COMPANY:  Domain name registrar REG.RU
#      CREATED:  21.06.2008 19:34:41 MSD
#===============================================================================

package Catalyst::Action::Wizard;

use strict;
use warnings;


use Catalyst::Action;
use Catalyst::Wizard;
use Catalyst::Utils;
use Class::C3;

use Scalar::Util;
use Data::Dumper;
use base 'Catalyst::Action';

our $VERSION = '0.007';

sub refaddr($) {
    sprintf "%x", Scalar::Util::refaddr(shift);
}

sub _current_wizard {
    return Catalyst::Wizard::_current_wizard(@_);
}

sub _new_wizard {
    my $c    = shift;
    my $wizard_id = shift || 'new';

    my $class = $c->config->{wizard}{class} || 'Catalyst::Wizard';

    Catalyst::Utils::ensure_class_loaded( $class );

    Catalyst::Wizard::DEBUG && 
	Catalyst::Wizard->info( 'calling _new_wizard: '.$wizard_id );

    _current_wizard($c, $class->new( $c, $wizard_id ) );
}

sub _dont_create_if_empty {
    my $c = shift;
    my $caller_pkg = shift;

    # check if not creating wizard in this caller package
    if ( my $re = $c->config->{wizard}{_ignore_empty_wizard_call_pkg_re} ) {
	return 1 if $caller_pkg =~ $re;
	return;
    }

    return unless exists $c->config->{wizard}{ignore_empty_wizard_call_pkg};

    my $config = $c->config->{wizard}{ignore_empty_wizard_call_pkg};

    return unless ref $config  eq 'ARRAY';

    my @prefixes = grep { m/::$/o } @$config;
    my @packages = grep { m/\w$/o } @$config;

    my @regexp;

    if ( @packages ) {
	push @regexp, '^(?:'.join ('|', @packages).')$';
    }

    if ( @prefixes ) {
	push @regexp, '^(?:'.join ('|', @prefixes).')';
    }

    my $regexp = join '|', @regexp;

    $regexp = qr/$regexp/o;

    $c->config->{wizard}{_ignore_empty_wizard_call_pkg_re} = $regexp;

    # pass thru
    return _dont_create_if_empty( $c, $caller_pkg );
}

sub wizard {
    my $self	= shift;
    my $c	= shift;

    if ( @_ ) { 

	if (	! _current_wizard( $c ) 
	    &&	$_[0] eq '-last' 
	    && (
			@_ == 3 
		    ||	@_ == 2 
	        ) ) {
	    shift;

	    my $step_type = 'redirect';

	    if ( @_ == 2 ) {
		$step_type = shift;
		$step_type =~ s/^-//g;

		if ( $step_type !~ m/redirect|detach|forward/ ) {
		    die "Unknown step type: $step_type";
		}
	    }

	    my $path = shift;

	    my $fake_wizard = [ $c, $step_type, $path ];

	    bless $fake_wizard, 'Catalyst::FakeWizard';

	    return $fake_wizard;
	}

	if ( !_current_wizard( $c ) ) {
	    _new_wizard( $c );
	}

	_current_wizard($c)->add_steps(caller => [ caller ], @_);
    } elsif(	! _current_wizard( $c ) 
	    &&	_dont_create_if_empty( $c, caller() ) ) {
	return bless \(my $a = ''), 'Catalyst::FakeWizard';
    }

    return _current_wizard($c);
}

sub execute {
    my $self = shift;
    my ($controller, $c) = @_;

    #warn "executing: $self";

    if ( $self->name eq '_BEGIN' ) {
	my $wizard_id = $c->can('wizard_id') ? $c->wizard_id 
	    : exists $c->req->params->{wid}  ? $c->req->params->{wid}
	    : ''
	    ;

	my $wizard_id_without_step;
	
	if ( $wizard_id ) {
	    ($wizard_id_without_step) = $wizard_id =~ /([0-9a-zA-Z]{32})/;
	}

	if ( $wizard_id && $wizard_id_without_step ) {
	    _new_wizard( $c, $wizard_id );
	}

    } elsif ( $self->name eq '_END' ) {
#	$self->next::method(@_);
	if ( _current_wizard( $c ) ) {
	    _current_wizard( $c )->save( $c );
	}
#	return;
    } elsif ( not $self->name =~ /^_(?:ACTION|DISPATCH|AUTO)/ ) {

	my @ret = eval { $self->next::method(@_) };

	# can be created in action
	my $wizard = _current_wizard( $c );

	if ($wizard
	    &&	
	    (
		( 
		    $@ 
		 && $@ eq $Catalyst::Wizard::GOTO_NEXT 
		) 
		||  $wizard->{goto} 
	    ) ) {

	    undef $@;
	    $wizard->perform_step( $c );
	}
	elsif ( $@ ) {
	    die $@;
	}

	return wantarray ? @ret : $ret[0];
    }

    $self->next::method(@_);
}

1;