add WebGUI::Wizard

docs/upgrades/upgrade_7.9.3-7.9.4.pl

@@ -37,6 +37,7 @@ addWikiSubKeywords($session);
 addSynopsistoEachWikiPage($session);
 dropVisitorAddressBooks($session);
 alterAddressBookTable($session);
+addWizardHandler( $session );
 
 finish($session); # this line required
 
@@ -50,6 +51,27 @@ finish($session); # this line required
 #    print "DONE!\n" unless $quiet;
 #}
 
+#----------------------------------------------------------------------------
+
+sub addWizardHandler {
+    my ( $sesssion ) = @_;
+    print "\tAdding WebGUI::Wizard... " unless $quiet;
+
+    if ( !grep { $_ eq 'WebGUI::Content::Wizard' } @{$session->config->get('contentHandlers')} ) {
+        # Find the place of Operation and add before
+        my @handlers = ();
+        for my $handler ( @{$session->config->get('contentHandlers')} ) {
+            if ( $handler eq 'WebGUI::Content::Operation' ) {
+                push @handlers, 'WebGUI::Content::Wizard';
+            }
+            push @handlers, $handler;
+        }
+        $session->config->set('contentHandlers',\@handlers);
+    }
+
+    print "DONE!\n" unless $quiet;
+}
+
 #----------------------------------------------------------------------------
 sub addWikiSubKeywords {
     my $session = shift;

etc/WebGUI.conf.original

@@ -976,6 +976,7 @@
     "WebGUI::Content::Account",
     "WebGUI::Content::AssetHistory",
     "WebGUI::Content::FilePump",
+    "WebGUI::Content::Wizard",
     "WebGUI::Content::Operation",
     "WebGUI::Content::Setup",
     "WebGUI::Content::Shop",

lib/WebGUI/Content/Wizard.pm

@@ -0,0 +1,19 @@
+package WebGUI::Content::Wizard;
+
+sub process {
+    my ( $session ) = @_;
+
+    if ( $session->form->get('op') eq 'wizard' && $session->form->get('wizard_class') ) {
+        my $class = $session->form->get('wizard_class');
+        WebGUI::Pluggable->load($class);
+        if ( $class->isa( 'WebGUI::Wizard' ) ) {
+            my $wizard  = $class->new( $session );
+            return $wizard->dispatch;
+        }
+        else {
+            return "Sminternal Smerver Smerror";
+        }
+    }
+}
+
+1;

lib/WebGUI/Wizard.pm

@@ -0,0 +1,303 @@
+package WebGUI::Wizard;
+
+use Scalar::Util qw(blessed);
+use WebGUI::Form;
+
+=head1 NAME
+
+WebGUI::Wizard -- Generate wizards
+
+=head1 SYNOPSIS
+
+ package MyWizard;
+
+ use base 'WebGUI::Wizard';
+
+ sub _get_steps { [qw( step1 finish )] }
+
+ sub www_step1 { 
+    my ( $self ) = @_;
+    return $self->getFormStart 
+        . '<input type="text" name="user" />' 
+        . $self->getFormEnd;
+ }
+
+ sub www_step1Save {
+     my ( $self ) = @_;
+     if ( my $user = $self->session->form->get('user') ) {
+         $self->set({ 'user' => $user });
+         return;
+     }
+     else {
+         return "Must specify a user!";
+     }
+ }
+
+ sub www_finish { 
+     my ( $self ) = @_;
+     return "Thank you! " . $self->get('user');
+ }
+
+=head1 DESCRIPTION
+
+This class allows you to easily create reusable wizards that walk a user 
+through a step-by-step process to perform a task.
+
+A user begins a Wizard by visiting ?op=wizard;wizard_class=MyWizard. Then
+WebGUI shows the first step's form (in the synopsis above, step1 / www_step1 ).
+
+Once the user completes the form, the www_step1Save subroutine is run. If an 
+error is returned, the user is shown the error and the same form again. 
+Otherwise, the wizard continues to the next step (finish).
+
+All parameters gathered by the wizard are saved between page loads into 
+the user's session scratch. Only by restarting the wizard will their progress
+be lost.
+
+=head1 METHODS
+
+=cut
+
+#----------------------------------------------------------------------------
+
+=head2 new ( session ) 
+
+Create a new instance of a Wizard.
+
+=cut
+
+sub new {
+    my ( $class, $session ) = @_;
+    die "Require WebGUI::Session as first argument" 
+        unless blessed( $session ) && $session->isa( 'WebGUI::Session' );
+    return bless { _session => $session, }, $class;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 _get_steps ( )
+
+Return all the names of the steps involved in this wizard, in order. Steps may
+be skipped and/or back-tracked to.
+
+=cut
+
+# OVERRIDE THIS!
+sub _get_steps {
+    return [];
+}
+
+#----------------------------------------------------------------------------
+
+=head2 dispatch ( ) 
+
+Dispatch the request to the correct step(s). Thaw the user's params and freeze
+them again after everything's done.
+
+=cut
+
+sub dispatch {
+    my ($self) = @_;
+
+    # See if we process a form
+    if ( my $step = $self->getCurrentStep ) { 
+        # First fold in the new form bits
+        $self->thaw;
+        my $processSub   = $self->can( 'www_' . $step . 'Save' );
+        my $errorMessage = $processSub->($self);
+        if ($errorMessage) {
+            my $formSub = $self->can( 'www_' . $step );
+            return $self->wrapStyle( $errorMessage . $formSub->($self) );
+        }
+        else {
+            my $step = $self->getNextStep;
+            my $formSub = $self->can( 'www_' . $step );
+            my $output = $formSub->($self);
+            $self->freeze;
+            return $self->wrapStyle( $output );
+        }
+    }
+    else {
+        # Starting over
+        $self->{_params}    = {};
+        $self->freeze;
+        my $formSub = $self->can( 'www_' . $self->_get_steps->[0] );
+        my $output = $formSub->($self);
+        $self->freeze;
+        return $self->wrapStyle( $output );
+    }
+} ## end sub dispatch
+
+#----------------------------------------------------------------------------
+
+=head2 freeze ( )
+
+Save the current params to long-term storage.
+
+=cut
+
+sub freeze {
+    my ( $self ) = @_;
+    $self->session->scratch->set( $self->getCacheKey, JSON->new->encode( $self->{_params} ) );
+}
+
+#----------------------------------------------------------------------------
+
+=head2 get ( [param] )
+
+Get a hashref of params. If C<param> is specified, get only that specific param.
+
+=cut
+
+sub get {
+    my ( $self, $param ) = @_;
+    if ( $param ) { 
+        return $self->{_params}->{$param};
+    }
+    return $self->{_params};
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getCacheKey ( )
+
+Get the unique key to store the params under.
+
+=cut
+
+sub getCacheKey {
+    my ( $self ) = @_;
+    return "Wizard " . blessed( $self );
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getCurrentStep ( )
+
+Get the name of the current step.
+
+=cut
+
+sub getCurrentStep {
+    my ( $self ) = @_;
+    return $self->{_step} || $self->session->form->get( 'wizard_step' );
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getFormEnd ( )
+
+Get the end of the form, including the </form> tag
+
+=cut
+
+sub getFormEnd {
+    my ( $self ) = @_;
+    return WebGUI::Form::formFooter;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getFormStart ( [step] )
+
+Get the start of a form for a given step, defaulting to the current step.
+
+=cut
+
+sub getFormStart {
+    my ( $self, $step ) = @_;
+    $step ||= $self->getCurrentStep;
+    return WebGUI::Form::formHeader( $self->session, {
+        action      => '?op=wizard;wizard_class=' . blessed( $self ) . ';wizard_step=' . $step,
+    } );
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getNextStep ( )
+
+Get the name of the next step 
+
+=cut
+
+sub getNextStep {
+    my ( $self, $step ) = @_;
+    $step ||= $self->getCurrentStep;
+    for my $i ( 0 .. @{ $self->_get_steps } - 1 ) {
+        if ( $self->_get_steps->[$i] eq $step ) {
+            return $self->_get_steps->[ $i + 1 ];
+        }
+    }
+}
+
+#----------------------------------------------------------------------------
+
+=head2 session ( )
+
+Get the WebGUI::Session object
+
+=cut
+
+sub session {
+    return $_[0]->{_session};
+}
+
+#----------------------------------------------------------------------------
+
+=head2 set ( params )
+
+Set a hashref of params.
+
+=cut
+
+sub set {
+    my ( $self, $args ) = @_;
+    $self->{_params} = { %{$self->{_params}}, %$args };
+    return $self->{_params};
+}
+
+#----------------------------------------------------------------------------
+
+=head2 setCurrentStep ( )
+
+Set the current step. Useful before calling dispatch().
+
+=cut
+
+sub setCurrentStep {
+    my ( $self, $step ) = @_;
+    return $self->{_step} = $step;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 thaw ( )
+
+Thaw the user's parameters from the long-term storage, overwriting any current
+parameters.
+
+=cut
+
+sub thaw {
+    my ( $self ) = @_;
+    my $json = $self->session->scratch->get( $self->getCacheKey );
+    return $self->{_params} = JSON->new->decode( $json );
+}
+
+#----------------------------------------------------------------------------
+
+=head2 wrapStyle ( output )
+
+Wrap output in the Wizard style.
+
+TODO: Add wizard-specific template vars like a progress bar and back links
+
+=cut
+
+sub wrapStyle {
+    my ( $self, $output ) = @_;
+
+    return $output;
+}
+
+1;

t/Content/Wizard.t

@@ -0,0 +1,54 @@
+# vim:syntax=perl
+#-------------------------------------------------------------------
+# WebGUI is Copyright 2001-2009 Plain Black Corporation.
+#-------------------------------------------------------------------
+# Please read the legal notices (docs/legal.txt) and the license
+# (docs/license.txt) that came with this distribution before using
+# this software.
+#------------------------------------------------------------------
+# http://www.plainblack.com                     info@plainblack.com
+#------------------------------------------------------------------
+
+# Make sure the Wizard content handler does its job correctly
+#
+#
+
+use FindBin;
+use strict;
+use lib "$FindBin::Bin/../lib";
+use Test::More;
+use WebGUI::Test; # Must use this before any other WebGUI modules
+use WebGUI::Session;
+
+#----------------------------------------------------------------------------
+# Init
+my $session         = WebGUI::Test->session;
+
+
+#----------------------------------------------------------------------------
+# Tests
+
+plan tests => 3;        # Increment this number for each test you create
+
+#----------------------------------------------------------------------------
+# 
+
+use_ok( 'WebGUI::Content::Wizard' );
+
+ok( !WebGUI::Content::Wizard::process( $session ), "Declines correctly" );
+
+$session->request->setup_body( {
+    op              => 'wizard',
+    wizard_class    => 'WebGUI::Wizard::HelloWorld',
+} );
+is( WebGUI::Content::Wizard::process( $session ), "Hello World!\n", "Accepts request and returns response" );
+
+package WebGUI::Wizard::HelloWorld;
+
+use base "WebGUI::Wizard";
+
+sub _get_steps { return ["hello"] }
+sub www_hello { return "Hello World!\n" }
+sub wrapStyle { return $_[1] }
+
+#vim:ft=perl

t/Wizard.t

@@ -0,0 +1,209 @@
+# vim:syntax=perl
+#-------------------------------------------------------------------
+# WebGUI is Copyright 2001-2009 Plain Black Corporation.
+#-------------------------------------------------------------------
+# Please read the legal notices (docs/legal.txt) and the license
+# (docs/license.txt) that came with this distribution before using
+# this software.
+#------------------------------------------------------------------
+# http://www.plainblack.com                     info@plainblack.com
+#------------------------------------------------------------------
+
+# Write a little about what this script tests.
+# 
+#
+
+use FindBin;
+use strict;
+use lib "$FindBin::Bin/lib";
+use Test::More;
+use Test::Deep;
+use WebGUI::Test; # Must use this before any other WebGUI modules
+use WebGUI::Session;
+
+#----------------------------------------------------------------------------
+# Init
+my $session         = WebGUI::Test->session;
+
+
+#----------------------------------------------------------------------------
+# Tests
+
+plan tests => 29;        # Increment this number for each test you create
+
+#----------------------------------------------------------------------------
+# Basic API
+use_ok( 'WebGUI::Wizard' );
+
+ok( !eval{ WebGUI::Wizard->new; 1 }, "Requires a session" );
+ok( !eval{ WebGUI::Wizard->new( "not a session" ); 1 }, "Requires a session" );
+
+my $wizard = WebGUI::Wizard->new( $session );
+isa_ok( $wizard, 'WebGUI::Wizard' );
+is( ref $wizard->_get_steps, "ARRAY", '_get_steps returns arrayref' );
+is( $wizard->session, $session, 'session method' );
+
+ok( !$wizard->getCurrentStep, "No current step yet" );
+$wizard->setCurrentStep( "one" );
+is( $wizard->getCurrentStep, "one", "SetCurrentStep" );
+
+
+#----------------------------------------------------------------------------
+# Form Start and End
+
+my $o   = $wizard->getFormStart;
+like( $o, qr/<form/, 'getFormStart gives form' );
+like( $o, qr/wizard_class.+WebGUI::Wizard/, 'getFormStart wizard_class' );
+like( $o, qr/wizard_step.+one/, 'getFormStart wizard_step' );
+
+$o   = $wizard->getFormStart( "two" );
+like( $o, qr/wizard_step.+two/, 'getFormStart wizard_step override step' );
+
+$o  = $wizard->getFormEnd;
+like( $o, qr{</form>}, 'getFormEnd' );
+
+#----------------------------------------------------------------------------
+# Steps
+
+$wizard = WebGUI::Wizard::Test->new( $session );
+$session->request->setup_body( {
+    wizard_step     => "one",
+} );
+is( $wizard->getCurrentStep, "one", "getCurrentStep from form" );
+is( $wizard->getNextStep, "two", "getNextStep" );
+
+is( $wizard->getNextStep( "three" ), "four", "getNextStep with arg" );
+
+#----------------------------------------------------------------------------
+# Set/Get
+cmp_deeply( 
+    $wizard->set( { "text" => "Hello World!\n", } ),
+    {
+        "text" => "Hello World!\n",
+    },
+    "set returns all params"
+);
+cmp_deeply( 
+    $wizard->set( { "text2" => "Goodbye!\n", } ),
+    {
+        "text" => "Hello World!\n",
+        "text2" => "Goodbye!\n",
+    },
+    "set returns all params"
+);
+is( $wizard->get( 'text' ), "Hello World!\n", "get with arg" );
+cmp_deeply( 
+    $wizard->get, 
+    {
+        "text"  => "Hello World!\n",
+        "text2" => "Goodbye!\n",
+    },
+    'get without arg'
+);
+
+#----------------------------------------------------------------------------
+# Freeze/Thaw
+$wizard->freeze;
+$wizard->set( { "text" => "No!" } );
+$wizard->set( { "add" => "Also No!" } );
+cmp_deeply( 
+    $wizard->thaw,
+    {
+        "text" => "Hello World!\n",
+        "text2" => "Goodbye!\n",
+    },
+    "thaw returns params"
+);
+cmp_deeply( 
+    $wizard->get,
+    {
+        "text" => "Hello World!\n",
+        "text2" => "Goodbye!\n",
+    },
+    "thaw overwrites params"
+);
+
+
+#----------------------------------------------------------------------------
+# dispatch
+
+$wizard = WebGUI::Wizard::Test->new( $session );
+$session->request->setup_body({});
+is( $wizard->dispatch,
+    "begin",
+    "first step is assumed"
+);
+cmp_deeply( 
+    $wizard->thaw,
+    { },
+    'scratch is cleared'
+);
+
+$session->request->setup_body({
+    wizard_step     => "one",
+});
+is( 
+    $wizard->dispatch,
+    'completed',
+    'dispatch success returns text of next step'
+);
+cmp_deeply(
+    $wizard->thaw,
+    {
+        one     => "completed",
+    },
+    "dispatch froze after success"
+);
+
+$session->request->setup_body({
+    wizard_step     => "two",
+});
+is(
+    $wizard->dispatch,
+    "errorcompleted",
+    'dispatch error returns text of process sub and previous form',
+);
+cmp_deeply(
+    $wizard->get,
+    {
+        one     => 'completed',
+        two     => 'error',
+    },
+    'dispatch thawed and allowed new param',
+);
+cmp_deeply(
+    $wizard->thaw,
+    {
+        one     => 'completed',
+    },
+    'dispatch did not freeze error data'
+);
+
+package WebGUI::Wizard::Test;
+use base 'WebGUI::Wizard';
+sub _get_steps { return [qw( one two three four five )] }
+
+sub www_one {
+    my ( $self ) = @_;
+    return "begin";
+}
+
+sub www_oneSave {
+    my ( $self ) = @_;
+    $self->set({ "one" => "completed" });
+    return;
+}
+
+sub www_two {
+    my ( $self ) = @_;
+    return $self->get("one");
+}
+
+sub www_twoSave {
+    my ( $self ) = @_;
+    $self->set({ "two" => "error" });
+    return "error";
+}
+
+
+#vim:ft=perl