Tk::Wizard::Tasks - C<Tk::Wizard> pages to perform sequential tasks

  $wizard->addTaskListPage(
    -title => "Toy example",
    -tasks => [
      "Wait five seconds" => sub { sleep 5; 1; },
      "Wait ten seconds!" => sub { sleep 10; 1; },
      ],
    );

package Tk::Wizard::Tasks;

use strict;
use warnings;
use warnings::register;
use lib "../../";
use vars '$VERSION';
$VERSION = do { my @r = ( q$Revision: 2.80 $ =~ /\d+/g ); sprintf "%d." . "%03d" x $#r, @r };

use vars qw(@ISA @EXPORT);
BEGIN {
	eval { require Log::Log4perl; };

	# No Log4perl so bluff: see Log4perl FAQ
	if($@) {
		no strict qw"refs";
		*{__PACKAGE__."::$_"} = sub { } for qw(TRACE DEBUG INFO WARN ERROR FATAL);
	}

	# Setup log4perl
	else {
		no warnings;
		no strict qw"refs";
		require Log::Log4perl::Level;
		Log::Log4perl::Level->import(__PACKAGE__);
		Log::Log4perl->import(":easy");
		if ($Log::Log4perl::VERSION < 1.11){
			*{__PACKAGE__."::TRACE"} = *DEBUG;
		}
	}

    require Exporter;    # Exporting Tk's MainLoop so that
    @ISA    = ( "Exporter", );    # I can just use strict and Tk::Wizard without
    @EXPORT = ("MainLoop");       # having to use Tk
}

use Carp ();
use Tk::LabFrame;
use Tk::DirTree;
use Tk::Wizard::Image;

my $WINDOZE = ($^O =~ m/MSWin32/i);
my $dir_term 	 = $WINDOZE ? 'folder' : 'directory';
my $dir_term_ucf = ucfirst $dir_term;

sub Tk::Wizard::addTaskListPage {
    my $self = shift;
    my $args = {@_};

    $self->addPage( sub { $self->_page_taskList($args) } );
}

sub Tk::Wizard::_page_taskList {
    my $self = shift;
    my $args = shift;
    my @tasks;
    my @states = qw[ todo doing ok error na ];
    my $photos = {};
    foreach my $state (@states) {
        my $sArg = "-" . $state . "_photo";
        if ( !$args->{$sArg} ) {
            $photos->{$state} = $self->Photo( $state, -data => $Tk::Wizard::Image::TASK_LIST{$state} );
        }
#        elsif (!-r $args->{$sArg}
#            || !$self->Photo( $state, -file => $args->{$sArg} ) )
#        {
#            warn "# Could not read $sArg from " . $args->{$sArg};
#        }
		elsif ( ref($args->{$sArg}) eq 'SCALAR' ) {
			$photos->{$state} = $self->Photo(
				$state,
				-data => ${$args->{$sArg}}
			) || WARN "Could not read $sArg from referenced data " . ${$args->{$sArg}};
		}
		elsif (-r $args->{$sArg}) {
			$photos->{$state} = $self->Photo(
				$state,
				-file => $args->{$sArg}
			) || WARN "Could not read $sArg from file " . $args->{$sArg};
		}
		else {
			WARN "Could not read $sArg from " . $args->{$sArg};
		}
    }

    $args->{-frame_pack} = [qw/-expand 1 -fill x -padx 30 -pady 10/]
      unless $args->{-frame_pack};

    $args->{-frame_args} = [
        -background => $self->{background},
        -relief     => "flat",
        -bd         => 0,
        -label => $args->{-label_frame_title} || "Performing Tasks: ",
        -labelside => "acrosstop"
	] unless $args->{-frame_args};

    my $frame = $self->blank_frame(
        -title    => $args->{-title}    || "Performing Tasks",
        -subtitle => $args->{-subtitle} || "Please wait whilst the Wizard performs these tasks.",
        -text     => $args->{-text}     || "",
        -wait     => $args->{ -wait },
    );

    if ( $#{ $args->{-tasks} } > -1 ) {
        my $task_frame =
          $frame->LabFrame( @{ $args->{-frame_args} }, -background => $self->{background}, )
          ->pack( @{ $args->{-frame_pack} }, );

        foreach ( my $i = 0 ; $i <= $#{ $args->{-tasks} } ; $i += 2 ) {
            my $icn = "-1";
            my $p = $task_frame->Frame( -background => $self->{background}, )->pack( -side => 'top', -anchor => "w" );
            if ( exists $photos->{todo} ) {
                $icn = $p->Label(
                    -image      => "todo",
                    -anchor     => "w",
                    -background => $self->{background},
                )->pack( -side => "left" );
            }
            $p->Label(
                -font       => $self->{defaultFont},
                -text       => @{ $args->{-tasks} }[$i],
                -anchor     => "w",
                -background => $self->{background},
            )->pack( -side => "left" );
            push @tasks, [ $icn, @{ $args->{-tasks} }[ $i + 1 ] ];
        }

    }

    else {
        $args->{-delay} = 1;
    }

    if ( $args->{ -wait } ) {
        # If we got a non-zero -wait argument, we must be part of an
        # automated test.  In any case, this page is going to auto-flip to
        # the next page soon (via a call to $widget->after).  We do NOT
        # want to start executing our tasks, only to have the Wizard flip
        # to the next page while we're still executing, because then we'll
        # be trying to update Photos that no longer exist (or worse).
    }

    else {
        # Do not let the user click any buttons while we're working:
        $self->{nextButton}->configure( -state => "disabled" )
          if Tk::Exists( $self->{nextButton} );

        $self->{backButton}->configure( -state => "disabled" )
          if Tk::Exists( $self->{backButton} );

        $frame->after(
            $args->{-delay} || 1000,

            sub {
                foreach my $task (@tasks) {
                    if ( Tk::Exists( $task->[0] ) ) {
                        $task->[0]->configure( -image => "doing" );
                        $task->[0]->update;
                    }
                    my $result = &{ $task->[1] };
                    if ( Tk::Exists( $task->[0] ) ) {
                        $task->[0]->configure(
                            -image => defined($result)
                            ? $result
                                  ? 'ok'
                                  : 'error'
                            : 'na'
                        );
                        $task->[0]->update;
                    }
                }

                # We're all done, the user can click buttons again:
                $self->{backButton}->configure( -state => "normal" ) if Tk::Exists( $self->{backButton} );

                if ( Tk::Exists( $self->{nextButton} ) ) {
                    $self->{nextButton}->configure( -state => "normal" );
                    # RT#54904
                    $self->{nextButton}->invoke if $args->{ -continue };
                }
              },

        );
    }
    return $frame;
}




1;