File Coverage

blib/lib/Catalyst/Wizard.pm
Criterion Covered Total %
statement 215 334 64.3
branch 58 150 38.6
condition 30 77 38.9
subroutine 32 45 71.1
pod 14 17 82.3
total 349 623 56.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Catalyst::Wizard
4              
5             =head1 DESCRIPTION
6              
7             This plugin provides same functionallity like Catalyst::Plugin::Wizard
8             but in some more flexible and correct way.
9              
10             =head1 SYNOPSIS
11              
12             Plain:
13              
14             # create new wizard
15             my $wizard = Catalyst::Wizard->new( $c );
16              
17             # add steps for that wizard
18             $wizard->add_steps( -detach => '/user/login', '/user/login_submit' );
19             $wizard->add_steps( -last => -redirect => '/user/logout' );
20              
21             # mark step to go to next step after this action
22             $wizard->goto_next;
23              
24             # perform step (calls redirect/detach/forward/whatever)
25             $wizard->perform_step;
26              
27              
28             With Catalyst::Action::Wizard and CatalystX::Wizarded:
29              
30             # just appending step
31             $c->wizard( '/append_this_step' );
32              
33             # just marking as goto_next
34             # NOTE: wizards can either 'die' after this (like in detach)
35             # or just mark wizard as 'goto_next'
36             $c->wizard->goto_next;
37              
38             # adding -last action in wizard (only one added, other
39             # '-last' actions ignored). synonym for -default in C::P::W
40             $c->wizard( -last => -redirect => '/logout' )->goto_next;
41              
42             # make step back (in case some errors happen)
43             $c->wizard->back_to( -redirect => '/append_this_step' );
44              
45             # stash into wizard
46             my $wizard_stash = $c->wizard->stash;
47             $wizard_stash->{parameters} = { %{ $c->req->params } };
48              
49             if ( $c->have_wizard ) {
50             $c->wizard->goto_next;
51             }
52              
53             In TT:
54             [% c.wizard.id_to_form IF c.have_wizard %]
55              
56             [% # INCORRECT! may (and will) cause errors!
57             c.wizard.id_to_form %]
58              
59             In real application:
60             See L<there|CatalystX::Wizarded>.
61              
62             =head1 NOTES
63              
64             This module is for general wizard'ed actions. It may be used with CatalystX::Wizarded and along in separate realization (for example in Controller base)
65              
66             You can use it for creating mulitpart actions (wizards) in following cases:
67              
68             =over
69              
70             =item *
71              
72             When you need to move some items into another folder, you may:
73              
74             =over 4
75              
76             =item *
77              
78             keep current folders select in session (can have difficulties with duplicate selecting of same folder)
79              
80             =item *
81              
82             use it as wizard and keep that info in wizard's stash
83              
84             =back
85              
86             =back
87              
88             =head1 AUTHORS
89              
90             Pavel Boldin (), <davinchi@cpan.ru>
91              
92             =cut
93              
94             package Catalyst::Wizard;
95              
96 3     3   102826 use strict;
  3         9  
  3         271  
97 3     3   16 use warnings;
  3         9  
  3         111  
98              
99 3     3   14 use Digest::MD5 qw(md5_hex);
  3         11  
  3         218  
100 3     3   5044 use URI;
  3         23957  
  3         233  
101 3     3   4206 use URI::QueryParam;
  3         4674  
  3         94  
102 3     3   22 use Carp qw/cluck/;
  3         7  
  3         357  
103 3     3   18 use Scalar::Util;
  3         5  
  3         216  
104              
105              
106 3   50 3   16 use constant DEBUG => $ENV{CATALYST_WIZARD_DEBUG} || 0;
  3         9  
  3         16818  
107              
108              
109             if (DEBUG) {
110             require Carp;
111             Carp->import( 'carp', 'cluck' );
112             }
113              
114             sub DEBUG2 {
115 90     90 0 264 DEBUG >= 2;
116             }
117              
118              
119             our $GOTO_NEXT = "wizard_goto_next\n";
120              
121              
122              
123             sub _dump {
124 19     19   117 require Data::Dumper;
125 19         123 Data::Dumper->new(\@_)->Indent(1)->Terse(1)->Dump;
126             }
127              
128              
129             #---------------------------------------------------------------------------
130             # Main object functions
131             #---------------------------------------------------------------------------
132              
133             =head1 METHODS
134              
135             =head2 new($c [, $wizard_id ])
136              
137             Create wizard object, either new (empty, missing or equal to 'new' C<$wizard_id>) or loaded from Catalyst::Wizard::wizard_storage.
138              
139             Note that C<$wizard_id> can also contain step number (splited from wizard_id by C<_>).
140              
141             =cut
142              
143             sub new {
144 7     7 1 6762 my $class = shift;
145 7   33     48 $class = ref $class || $class;
146              
147 7         24 my ($c, $my_wizard_id) = @_;
148              
149 7         12 my $self = {};
150              
151 7 50       22 DEBUG2 && cluck();
152              
153 7 50       19 DEBUG2 &&
154             __PACKAGE__->info("new: $my_wizard_id "._dump([ (caller(0))[0..3] ]));
155              
156              
157 7 100 100     41 if ( $my_wizard_id
158             && $my_wizard_id ne 'new'
159             ) {
160 3         26 ($my_wizard_id, my $step) = ($my_wizard_id =~ /([0-9a-zA-Z]{32})(?:_(\d+))?/);
161              
162              
163 3         19 $self = $class->wizard_storage( $c, $my_wizard_id );
164 3 50       1652 die "No such wizard: $my_wizard_id" unless $self;
165              
166 3         12 $self->{loaded_from_storage} = 1;
167              
168 3 50       13 $self->check_step_number( $c, $step ) if defined $step;
169              
170             } else {
171 4         14 $self = {
172             wizard_id => _create_wizard_id(),
173             steps => [],
174             step_number => 0,
175             stash => {},
176             no_add_step => 0,
177             no_step_back => 0,
178              
179             steps_already_in_wizard => {},
180             };
181              
182 4         15 $self = bless $self, $class;
183             }
184              
185              
186 7         26 $self->load( $c );
187 7 50       49 DEBUG2 && cluck(_dump($self));
188 7         22 return $self;
189             }
190              
191             #---------------------------------------------------------------------------
192             # INITIALIZATION HELPERS FUNCTIONS
193             #---------------------------------------------------------------------------
194              
195              
196             sub _create_wizard_id {
197 4     4   215 md5_hex(rand().time);
198             }
199              
200             #---------------------------------------------------------------------------
201             # ADDITION OF STEPS FUNCTIONS
202             #---------------------------------------------------------------------------
203              
204             sub _is_force_add_step {
205 19     19   135 $_[4]->{-force};
206             }
207              
208             sub _check_flags {
209 19     19   41 my (undef, $args, $new_steps, undef, $flags) = @_;
210 19 50 66     76 if ( $flags->{-last} && @$args ) {
211 0         0 die "-last should be last in ->wizard call";
212             }
213              
214 19 0 33     63 if ( $flags->{-skip} && @$new_steps && ! exists $new_steps->[-1]{skip} ) {
      33        
215 0         0 die "-skip'ed steps should be first in ->wizard call";
216             }
217             }
218              
219             sub _get_default_flags {
220 37     37   222 return { -force => 0, -last => 0, -skip => 0 };
221             }
222              
223             =for api
224              
225             Making steps from input of @args, passed from add_steps.
226             You can redefine following functions to make it behave different:
227              
228             $self->_get_default_flags
229             returns default flags
230              
231             $self->_check_flags( \@args, \@new_steps, $step_ref, $flags )
232             to check flags
233              
234             $self->_is_force_add_step( \@args, \@new_steps, $step_ref, $flags )
235             should return true if step should added with force (e.g. even if same already exists)
236              
237             $self->_handle_$1_item( \@args, $step_ref, $flags )
238             to handle '-$1' items in \@args
239              
240             =cut
241              
242             sub _make_steps {
243 18     18   44 my $self = shift;
244              
245 18 50       106 DEBUG2 && carp($self->{wizard_id});
246              
247 18         64 my @caller = caller;
248 18   66     99 while ( $_[0] && $_[0] eq 'caller' ) {
249 18         23 shift;
250 18         22 @caller = @{ shift() };
  18         113  
251             }
252              
253 18         55 my $caller = join ':', @caller;
254 18 50       31 DEBUG2 && $self->info("make_steps caller is $caller");
255              
256              
257 18         45 my @args = @_;
258 18         21 my @new_steps;
259              
260 18         46 my $flags = $self->_get_default_flags;
261              
262 18         51 while( @args ) {
263 19         30 my $step = shift @args;
264 19         25 my $step_hash;
265              
266 19         53 while ( exists $flags->{$step} ) {
267 3         6 $flags->{$step}++;
268 3         9 $step = shift @args;
269             }
270              
271 19         31 my $step_ref = {};
272              
273 19 100       57 if ( $flags->{-last} ) {
274 1         4 $step_ref->{last} = 1;
275             }
276              
277 19 50       43 if ( $flags->{-skip} ) {
278 0         0 $step_ref->{skip} = 1;
279             }
280              
281 19 100 66     143 if ( $step eq '-forward' || $step eq '-detach' ) {
    100 66        
    50 66        
    0          
282 13         18 my $step_type = $step;
283 13         18 my $step_args = shift @args;
284 13         15 my $step_path = $step_args;
285              
286 13 100       46 if ( ref $step_args eq 'ARRAY' ) {
287 1         3 $step_path = shift @$step_args;
288             }
289              
290 13 100       76 %$step_ref = (%$step_ref,
291             step_type => $step_type,
292             path => $step_path,
293              
294             ref $step_args ?
295             (args => $step_args) :
296             (),
297             );
298             }
299             elsif ( $step eq '-sub' || $step eq '-subfixed' ){
300 1         2 my $step_type = $step;
301 1         2 my $step_args = shift @args;
302              
303              
304 1 50       8 %$step_ref = (%$step_ref,
305             step_type => '-sub',
306             args => $step_args,
307             fixed => $step_type =~ m/fixed/o ? 1 : 0,
308             );
309             }
310             elsif ( $step eq '-redirect' || $step !~ m/^-/ ) {
311 5         8 my $append_wizard_id = '';
312              
313 5 100       16 if ( $step eq '-redirect' ) {
314 3         6 $step = shift @args;
315             }
316             else {
317 2         3 $append_wizard_id = 1;
318             }
319              
320              
321 5         30 %$step_ref = (%$step_ref,
322             step_type => '-redirect',
323             path => $step,
324             append_wizard_id => $append_wizard_id,
325             );
326             }
327             elsif ( $step =~ m/-(.*)/ ) {
328 0         0 my $step_type = "_handle_$1_item";
329              
330 0 0       0 die "cannot handle tag $1" unless $self->can($step_type);
331              
332 0 0       0 next unless $self->$step_type( \@args, $step_ref, $flags );
333             }
334              
335 19         63 $self->_check_flags( \@args, \@new_steps, $step_ref, $flags );
336              
337 19         40 $step_ref->{caller} = $caller;
338 19         39 $step_ref->{hash} = md5_hex(_dump($step_ref));
339              
340 19 50       1711 DEBUG2 && $self->info(qq/step is @{[ _dump($step_ref) ]}\n/);
  0         0  
341              
342 19 100 100     59 if ( $self->_is_force_add_step( \@args, \@new_steps,
343             $step_ref, $flags )
344             || !exists $self->{steps_already_in_wizard}{ $step_ref->{hash} } ) {
345              
346 13         20 push @new_steps, $step_ref;
347             }
348              
349 19         53 $flags = $self->_get_default_flags;
350             }
351              
352 18         20 DEBUG && $self->info("new steps is @{[ _dump( \@new_steps ) ]}");
353 18         71 @new_steps;
354             }
355              
356             sub _check_last_step {
357 18     18   24 my $self = shift;
358 18         19 my $new_steps = shift;
359              
360 18         28 my $check_for_last_step = $new_steps->[-1];
361              
362 18 100       57 return if ! $check_for_last_step->{last};
363              
364             # remove and dont add it
365 1         3 pop @$new_steps;
366              
367             # already have last_step
368 1 50       10 return if exists $self->{have_last_step};
369              
370             # ok, append that last step for steps
371 1         3 $self->{have_last_step} = 1;
372 1         2 push @{ $self->{steps} }, $check_for_last_step;
  1         3  
373              
374             # remove hash from it and append in 'already in wizard'
375 1         4 $self->_add_to_steps_already_in_wizard( [ $check_for_last_step ] );
376             }
377              
378             sub _check_skip_steps {
379 18     18   20 my $self = shift;
380 18         21 my $new_steps = shift;
381              
382             # dont skip if some steps remaining
383 18 50       25 return if ( $self->{step_number} > @{ $self->{steps} } );
  18         54  
384              
385 18         85 my $skip_count = grep { delete $_->{skip} } @$new_steps;
  12         34  
386              
387 18         43 $self->next_step( $skip_count );
388             }
389              
390             sub _add_to_steps_already_in_wizard {
391 19     19   23 my $self = shift;
392 19         21 my $new_steps = shift;
393              
394 19         41 foreach ( @$new_steps ) {
395 13         62 $self->{steps_already_in_wizard}{ delete $_->{hash} } = 1;
396             }
397             }
398              
399              
400             =head2 $wizard->add_steps( @args )
401              
402             Add steps from @args.
403              
404             @args is an array of path for steps with specification of each step:
405              
406             =over 3
407              
408             =item I<< (-redirect => 'path') >> or I<'path'>
409              
410             Redirect to path. If '-redirect' is given, then no action wizard id will
411             be append to the redirect URL. Use this for last actions in wizard.
412              
413             You can append any query parameters to 'path'.
414              
415             =item I<< (-detach => [ 'path', @step_args ]) >> or I<< (-detach => 'path') >>
416              
417             Detaches to path.
418              
419              
420             =item I<< -last => B<[ -forward | -detach | -redirect ]> => 'path' >>
421              
422             Last step in wizard. Only one (first) '-last' step will be added, all others will be ignored. Note that -last => step should be last in ->add_steps call, elsewhere add_steps will throw exception.
423              
424             =back
425              
426             =cut
427              
428             sub add_steps {
429 18     18 1 1209 my $self = shift;
430              
431 18 50       48 return if $self->{no_add_step};
432              
433 18         92 my @new_steps = $self->_make_steps( caller => [ caller ], @_ );
434              
435 18         58 $self->_check_last_step( \@new_steps );
436              
437 18         21 splice @{ $self->{steps} }, $self->{step_number}, 0, @new_steps;
  18         49  
438 18         45 $self->_add_to_steps_already_in_wizard( \@new_steps );
439              
440 18         44 $self->_check_skip_steps( \@new_steps );
441             }
442              
443              
444              
445             #---------------------------------------------------------------------------
446             # STEP FLOW FUNCTIONS
447             #---------------------------------------------------------------------------
448              
449              
450              
451             sub _step {
452 7     7   6626 my $self = shift;
453              
454 7 50 33     30 if ( exists $self->{step_back} && $self->{step_number} > 0 ) {
455 0         0 return $self->_step_back();
456             }
457              
458 7 50       27 return unless exists $self->{steps}[ $self->{step_number} ];
459              
460 7         17 my $step = $self->{steps}[ $self->{step_number} ];
461              
462 7   50     43 $self->next_step($_[0] || 0);
463              
464 7         29 $step;
465             }
466              
467              
468             =head2 $wizard->next_step(I<[ $shift_count ]>)
469              
470             Shift $shift_count steps, or 1 if no $shift_count is given.
471              
472             =cut
473              
474              
475             sub next_step {
476 29     29 1 33 my $self = shift;
477 29         32 my $shift = shift;
478              
479 29 100       66 $shift = 1 unless defined $shift;
480              
481 29         88 $self->{step_number} += $shift;
482             }
483              
484              
485             #=== FUNCTION ================================================================
486             # NAME: _step_back
487             # PURPOSE: Makes step back.
488             # COMMENTS: none
489             #===============================================================================
490              
491             sub _step_back {
492 0     0   0 my $self = shift;
493 0         0 my $step_back = delete $self->{step_back};
494              
495 0         0 my $path = $step_back->{path};
496              
497 0         0 my $step_to_go;
498              
499 0         0 DEBUG && $self->info(_dump($step_back));
500              
501 0         0 my $i;
502 0         0 for($i = $self->{step_number} - 1; $i >= 0; $i--) {
503 0         0 my $step = $self->{steps}[$i];
504              
505             # $self->info _dump($i, $self);
506              
507              
508 0 0       0 do { $step_to_go = $step; last } if $step->{path} =~ m{^/?$path$};
  0         0  
  0         0  
509             }
510              
511 0 0       0 DEBUG && $self->info("cant find step back") unless $step_to_go;
512 0 0       0 return unless $step_to_go;
513              
514 0         0 my (undef, $other) =
515 0         0 grep { $_->{path} =~ m{^/?$path$} }
516 0         0 reverse @{ $self->{steps} } [0..$self->{step_number} - 1];
517              
518 0 0       0 die "$other remain" if $other;
519              
520 0   0     0 my %step_back = (%$step_to_go,
521             step_type => $step_back->{type} || '-redirect');
522 0         0 $step_back = \%step_back;
523              
524             # to the next of current step
525 0         0 $self->{step_number} = $i; # + 1;
526              
527              
528 0         0 return $step_back;
529             }
530              
531             =head2 $wizard->uri_for_next
532              
533             Returns URI for next step in wizard (if that step is '-redirect').
534              
535             =cut
536              
537              
538             sub uri_for_next {
539 0     0 1 0 my $self = shift;
540              
541 0         0 my $step_number = $self->{step_number}; # + 1;
542              
543 0 0       0 return if $step_number > $#{ $self->{steps} };
  0         0  
544              
545 0         0 my $step = $self->{steps}[ $step_number ];
546              
547             #$self->info "uri_for_next: "._dump($step);
548              
549 0 0       0 return if ( $step->{step_type} ne '-redirect' );
550              
551 0         0 $step->{uri_for_next} = 1;
552              
553 0         0 my $path = $self->_get_full_path( $step,
554             {
555             append_wizard_step => 1,
556             }
557             );
558 0         0 DEBUG && $self->info("uri_for_next return: $path");
559              
560 0         0 return $path;
561             }
562              
563              
564              
565             sub _mark_goto {
566 4     4   14 $_[0]->{goto} = 1;
567              
568             # if goto_next and back_to should end executing of wizard
569 4 50       16 die $GOTO_NEXT if $_[0]->{die_for_goto};
570              
571 4         6 1;
572             }
573              
574              
575             =head2 $wizard->goto_next
576              
577             Mark wizard step to be performed.
578              
579             If $wizard->{die_for_goto} is true will act like detach, throwing $GOTO_NEXT exception.
580              
581             =cut
582              
583             sub goto_next {
584 4     4 1 54 my $self = shift;
585              
586 4         7 DEBUG && $self->info( "goto_next: "._dump([ (caller(0))[0..3] ]) );
587              
588 4 50       8 $self->_mark_goto if $self->{step_number} <= $#{ $self->{steps} } ;
  4         33  
589              
590 4         9 return;
591             }
592              
593             =head2 $wizard->back_to( B<< [ -redirect | -detach | -forward => ] >> 'path' )
594              
595             Return to step 'path' which will be performed by original step type or by step type you set as argument.
596              
597             Will do nothing if none 'path' step if found.
598              
599             =cut
600              
601             sub back_to {
602 0     0 1 0 my $self = shift;
603              
604 0         0 my $path = shift;
605 0         0 my $type;
606              
607 0 0       0 return unless $self->{step_number};
608              
609 0 0 0     0 if ( $path eq '-detach' or $path eq '-forward' ) {
610 0         0 $type = $path;
611 0         0 $path = shift;
612             }
613              
614 0         0 DEBUG && $self->info( $path, $type );
615              
616 0         0 my $found_in_passed = do {
617 0         0 grep { $_->{path} =~ m{^/?$path$} }
  0         0  
618 0         0 reverse @{ $self->{steps} } [0..$self->{step_number} - 1];
619             };
620              
621 0 0       0 return unless $found_in_passed;
622              
623 0         0 $self->{step_back} = {
624             path => $path,
625             type => $type,
626             };
627              
628 0         0 $self->_mark_goto;
629              
630 0         0 1;
631             }
632              
633              
634             =head2 $wizard->perform_step( $c )
635              
636             Perform step. Function to call when step performing should be done.
637             (called, for instance, in Catalyst::Action::Wizard _END)
638              
639             =cut
640              
641             sub perform_step {
642 4     4 1 18 my $self = shift;
643 4         6 my $c = shift;
644              
645 4 50       15 return unless delete $self->{goto};
646              
647 4         16 my $step = $self->_step;
648              
649 4         7 DEBUG && $self->info(_dump($step));
650              
651 4 50       12 return unless $step;
652              
653 4 100 66     29 if ( $step->{step_type} eq '-detach' or $step->{step_type} eq '-forward' ) {
654 1         2 my $step_type = $step->{step_type};
655 1         7 $step_type =~ s/^-//; #THATS NOT SMILE!
656              
657 1         3 $self->next_step;
658              
659 1         6 return $c->$step_type($step->{path}, $step->{args});
660             }
661              
662 3 100       9 if ( $step->{step_type} eq '-sub' ) {
663 1         5 return $self->_make_sub_wizard( $c, $step );
664             }
665              
666 2         12 my $path = $self->_get_full_path($step,
667             {
668             append_wizard_step => 1,
669             }
670             );
671              
672             # dont call ->save, will be saved in Action::Wizard.
673 2         43 $c->response->redirect($path);
674             }
675              
676             #=== FUNCTION ================================================================
677             # NAME: _make_sub_wizard
678             # PURPOSE: make sub wizard from record in sub wizard
679             # PARAMETERS: $self, $c, $step
680             # RETURNS: nothing, redirects/detaches/forwards to first step
681             # of subwizard
682             # THROWS: no exceptions
683             #===============================================================================
684              
685              
686             sub _make_sub_wizard {
687 1     1   2 my $self = shift;
688 1         2 my ($c, $step) = @_;
689              
690 1         4 my $new_wizard = Catalyst::Wizard->new( $c );
691              
692 1         2 $new_wizard->add_steps( @{ $step->{args} } );
  1         4  
693              
694             # to the next step, for ->_step calling in ->last action
695 1         3 $self->next_step;
696 1         5 $new_wizard->add_steps(
697             -last => -redirect => $self->_get_full_path( $self->_step,
698             {
699             append_wizard_step => 1,
700             append_wizard_id => 1,
701             }
702             )
703             );
704              
705 1         4 $new_wizard->{no_add_step} = $step->{fixed};
706 1         2 $new_wizard->{stash} = $self->{stash};
707              
708             # remove our stash
709 1         5 $self->save( $c );
710             # replace with stash of new_wizard
711 1         3309 $new_wizard->load( $c );
712              
713 1         5 DEBUG && $self->info("setting wizard for ".$c->action. " ". refaddr( $c->action ));
714 1         6 $c->req->params->{wid} = $new_wizard->{wizard_id};
715 1         39 _current_wizard( $c, $new_wizard );
716              
717 1         454 DEBUG && $self->info("params: ", $c->req->params->{wid});
718              
719 1         2 DEBUG && $self->info(
720             "old wizard: $self->{wizard_id}
721             new step id: $new_wizard->{wizard_id}");
722              
723              
724             # in case it can die
725 1         2 eval { $new_wizard->goto_next };
  1         5  
726 1         6 $new_wizard->perform_step( $c );
727              
728             # save us, if we reached this point
729 1         394 $new_wizard->save( $c );
730             }
731              
732             #=== FUNCTION ================================================================
733             # NAME: _get_full_path
734             # PURPOSE: Gets full path for redirect
735             #===============================================================================
736              
737              
738             sub _get_full_path {
739 3     3   7 my $self = shift;
740              
741 3         6 my ( $step, $options_ref ) = @_;
742              
743 3   50     10 $options_ref ||= {
744             append_wizard_step => 0,
745             append_wizard_id => 1,
746             };
747              
748             exists $options_ref->{$_} or $options_ref->{$_} = $step->{$_}
749 3   66     25 foreach (qw(append_wizard_step append_wizard_id));
750              
751              
752 3         27 my $uri = URI->new( $step->{path} );
753              
754              
755             #die if ! $options_ref->{ append_wizard_id } && $options_ref->{append_wizard_step};
756              
757 3 50       13579 if ( $options_ref->{ append_wizard_id } ) {
758 3         19 my $wizard_id =
759             $self->_get_wizard_id($options_ref->{append_wizard_step});
760              
761 3         23 $uri->query_param_append( 'wid' => $wizard_id );
762              
763 3 50 33     531 if ( exists $options_ref->{append_to_uri}
764             && ref $options_ref->{append_to_uri} eq 'HASH') {
765              
766 0         0 my $a = $options_ref->{append_to_uri};
767              
768 0         0 $uri->query_param_append( $_ => $a->{$_} ) foreach keys %$a;
769             }
770             }
771              
772 3         5 DEBUG && $self->short_info($uri->as_string);
773              
774 3         19 return $uri->as_string;
775             }
776              
777             #---------------------------------------------------------------------------
778             # OTHER HELPERS
779             #---------------------------------------------------------------------------
780              
781              
782             sub check_step_number {
783 0     0 0 0 my $self = shift;
784 0         0 my $c = shift;
785 0         0 my $step = shift;
786              
787 0         0 DEBUG && $self->info(_dump($step));
788              
789             # forward step by redirect + append_wizard_step is ONLY
790             # if previous step (ie. from which redirection was)
791             # IS redirection type
792 0 0 0     0 if ( $self->{step_number} + 1 == $step
793             && $self->{steps}[
794             $self->{step_number}
795             ]->{step_type} eq '-redirect') {
796              
797              
798 0         0 return $self->next_step;
799             }
800              
801             # back step is only for -redirect steps
802 0 0 0     0 if ( $self->{step_number} > $step
803             && $self->{steps}[$step]->{step_type} eq '-redirect' ) {
804 0 0       0 return $self->_force_dont_step_back if $self->{no_step_back};
805              
806 0         0 $self->{step_number} = $step;
807             }
808             }
809              
810              
811              
812             sub _force_dont_step_back {
813 0     0   0 die "Step back attempt";
814             }
815              
816              
817             =head2 $wizard->stash
818              
819             Stash accessor.
820              
821             =cut
822              
823              
824             sub stash {
825 0     0 1 0 shift->{stash};
826             }
827              
828              
829              
830             sub _get_wizard_id {
831 3     3   7 my $self = shift;
832 3         5 my $add_steps = shift;
833              
834 3         11 my @wizard_id = ($self->{wizard_id});
835              
836 3 50       21 push @wizard_id, $self->{step_number} + $add_steps if defined $add_steps;
837              
838 3         15 return join '_', @wizard_id;
839             }
840              
841              
842             =head2 $wizard->id_to_form
843              
844             Get wizard id as <input> tag for <FORM>.
845              
846             =cut
847              
848              
849             sub id_to_form {
850 0     0 1 0 my $self = shift;
851              
852 0 0       0 if ($self->{steps}[ $self->{step_number} ]->{uri_for_next}) {
853             return
854 0         0 '<input type="hidden" name="wid" value="' .
855             $self->_get_wizard_id(1)
856             . '"/>'."\n";
857             }
858              
859 0   0     0 $self->{"id_to_form"} ||=
860             '<input type="hidden" name="wid" value="'.
861             $self->_get_wizard_id.
862             '"/>'."\n";
863             }
864              
865             #---------------------------------------------------------------------------
866             # LOAD/SAVE AND STORAGES
867             #---------------------------------------------------------------------------
868              
869             =head2 $wizard->load( $c )
870              
871             Loads wizard (by default just installs stash).
872              
873             =cut
874              
875              
876             sub load {
877 9     9 1 18 my ( $self, $c ) = @_;
878              
879             # all ok, can replace wizard in stash
880 9 50 66     28 if ( ! exists $c->stash->{wizard}
    0 0        
881 0 0       0 || ! keys %{ $c->stash->{wizard} } ) {
882 9         76 $c->stash->{wizard} = $self->{stash};
883             }
884             # user first userd stash->wizard and only then
885             # created wizard (by call of $c->wizard)
886             # handle it
887             elsif (
888 0         0 keys %{ $c->stash->{wizard} || {} }
889             && ! keys %{ $self->{stash} } ) {
890              
891             # use it as our own stash
892 0         0 $self->{stash} = $c->stash->{wizard};
893             }
894             #else {
895             # no else -- we cant have both our and catalyst stash->{wizard}
896             # filled, because we ->load'ed in ->new
897             #}
898             }
899              
900             =head2 $wizard->save( $c )
901              
902             Save wizard into wizard_storage.
903              
904             If $c have B<wizard_storage> it will be called with two arguments: wizard id and wizard instance.
905              
906             Elsewhere default (session) storage will be used.
907              
908             =cut
909              
910             sub save {
911 5     5 1 2746 my ( $self, $c ) = @_;
912              
913 5 50       20 DEBUG2 && carp($self->{wizard_id});
914              
915 5         42 DEBUG && $self->info();
916              
917 5 50       8 if ( ! @{ $self->{steps} } ) {
  5         19  
918 0         0 DEBUG && $self->short_info('dont saving wizard without steps');
919 0         0 return;
920             }
921              
922 5         12 my $wizard_id = $self->{wizard_id};
923              
924 5 50       31 if ( $c->can('wizard_storage' ) ) {
925 5 50       10 DEBUG2 && $self->info("Calling supported wizard_storage");
926 5         23 return $c->wizard_storage( $wizard_id => $self );
927             }
928              
929 0         0 delete $c->stash->{wizard};
930 0 0       0 return if $self->{loaded_from_storage};
931              
932 0 0       0 DEBUG2 && $self->info("save sing session $wizard_id");
933 0         0 my $storage = $c->session;
934              
935 0   0     0 $self->{expires} ||= time + $c->config->{wizard}{expires};
936 0 0       0 return if ( $self->{expires} <= time );
937              
938 0         0 $storage->{_wizards}{$wizard_id} = $self;
939             }
940              
941              
942             =head2 Catalyst::Wizard->wizard_storage( $c, $wizard_id )
943              
944             Loads $wizard_id from wizard_storage, if can.
945              
946             First checked if $c can 'wizard_storage'. If yes -- it will be called, else default (session) storage will be used.
947              
948             Note also that this functions purges old wizards in session.
949              
950             =cut
951              
952              
953             sub wizard_storage {
954 3     3 1 7 my ( $class, $c, $wizard_id ) = @_;
955              
956 3 50       31 if ( $c->can('wizard_storage' ) ) {
957 3 50       9 DEBUG2 && $class->info("calling supported wizard_storage");
958 3         14 return $c->wizard_storage( $wizard_id );
959             }
960              
961 0 0       0 DEBUG2 && $class->info("calling session: $wizard_id", $c->action."");
962 0         0 my $storage = $c->session->{_wizards};
963              
964 0         0 foreach my $wid (keys %$storage) {
965 0 0       0 next if ( $storage->{$wid}{expires} > time );
966              
967 0         0 delete $storage->{$wid};
968             }
969              
970 0 0       0 if (exists $storage->{$wizard_id}) {
971 0         0 return $storage->{$wizard_id};
972             }
973              
974 0         0 return;
975             }
976              
977              
978              
979             sub _current_wizard {
980 1     1   3 my ( $c, $current ) = @_;
981              
982 1 50       8 Carp::cluck unless ref $c;
983              
984 1 50       6 if ( $c->can('wizard_storage') ) {
985 1 50       4 DEBUG2 && __PACKAGE__->
986             info("calling supported wizard_storage for current_wizard");
987 1         4 return $c->wizard_storage( 'current' => $current );
988             }
989              
990 0 0         DEBUG2 && __PACKAGE__->
991             info("using \$c->stash->{_current_wizard} as storage");
992              
993 0           my $storage = $c->stash;
994              
995 0 0         $storage->{_current_wizard} = $current if defined $current;
996 0           $storage->{_current_wizard};
997              
998             }
999              
1000              
1001             #---------------------------------------------------------------------------
1002             # UTILITY FUNCTIONS
1003             #---------------------------------------------------------------------------
1004              
1005             sub _dump_self {
1006 0     0     my $self = shift;
1007 0           return ($self->{wizard_id}, " ", _dump($self));
1008             }
1009              
1010              
1011             sub refaddr($) {
1012 0     0 0   sprintf "%x", Scalar::Util::refaddr(shift);
1013             }
1014              
1015             =head2 $wizard->info and $wizard->short_info
1016              
1017             Prints current wizard info.
1018              
1019             short_info omits steps on print.
1020              
1021             Note that info will skip all the inherited methods ($self->SUPER::info call).
1022              
1023             =cut
1024              
1025              
1026             sub info {
1027 0     0 1   my $self = shift;
1028              
1029 0           open my $fh, '>>', '/tmp/logfile';
1030              
1031 0           my $caller_fun;
1032 0   0       for( my $i = 1; $i == 1 || $caller_fun =~ /::(short_)?info$/; $i++ ) {
1033 0           $caller_fun = (caller($i))[3];
1034             }
1035              
1036 0 0         unshift @_, $self->_dump_self, " " if ref $self;
1037 0           unshift @_, $caller_fun, " ";
1038              
1039 0           print $fh @_, "\n";
1040 0           close $fh;
1041             }
1042              
1043              
1044             sub short_info {
1045 0     0 1   my $self = shift;
1046 0           local $self->{steps} = '...skipped...';
1047              
1048 0           $self->info( @_ );
1049             }
1050              
1051             =head1 SEE ALSO
1052              
1053             L<Catalyst::Plugin::Continuation>, L<Catalyst Plugin Wizard (DEPRECATED)|Catalyst::Plugin::Wizard>
1054              
1055             =cut
1056              
1057             =head1 AUTHOR
1058              
1059             Pavel Boldin <davinchi@cpan.org> for REG.RU.
1060              
1061             =cut
1062              
1063             package # hide from PAUSE
1064             Catalyst::FakeWizard;
1065              
1066             sub goto_next {
1067 0     0     my $self = shift;
1068              
1069 0           my $c = $self->[0];
1070 0           my $step_type = $self->[1];
1071 0           my $path = $self->[2];
1072              
1073 0 0 0       if ( $step_type eq 'detach' or $step_type eq 'forward' ) {
1074 0           return $c->$step_type( $path );
1075             }
1076              
1077 0           return $c->response->redirect( $path );
1078             }
1079              
1080 0     0     sub AUTOLOAD {
1081             }
1082              
1083             1;