package Tk::Wizard::Tasks; use strict; use warnings; use warnings::register; use vars '$VERSION'; $VERSION = do { my @r = ( q$Revision: 2.79 $ =~ /\d+/g ); sprintf "%d." . "%03d" x $#r, @r }; 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; =head1 NAME Tk::Wizard::Tasks - C pages to perform sequential tasks =head1 SYNOPSIS Currently automatically loaded by C, though this behaviour is deprecated and is expected to change in 2008. =head1 DESCRIPTION Adds a number of methods to C, to allow the end-user to access the filesystem. =head1 METHODS =head2 addTaskListPage Adds a page to the Wizard that will perform a series of tasks, keeping the user informed by ticking-off a list as each task is accomplished. Whilst the task list is being executed, both the I and I buttons are disabled. Parameters are as for L, plus: =over 4 =item -tasks The tasks to perform, supplied as a reference to an array, where each entry is a pair (i.e. a two-member list), the first of which is a text string to display, the second a reference to code to execute. =item -delay The length of the delay, in milliseconds, after the page has been displayed and before execution the task list is begun. Default is 1000 milliseconds (1 second). See L. =item -continue Display the next Wizard page once the job is done: invokes the callback of the I button at the end of the task. =item -todo_photo =item -doing_photo =item -ok_photo =item -error_photo =item -na_photo Optional: all L objects, displayed as appropriate. C<-na_photo> is displayed if the task code reference returns an undef value, otherwise: C<-ok_photo> is displayed if the task code reference returns a true value, otherwise: C<-error_photo> is displayed. These have defaults taken from L. =item -label_frame_title The label above the L object which contains the task list. Default label is the boring C. =item -frame_args Optional: the arguments to pass in the creation of the C object used to contain the list. =item -frame_pack Optional: array-refernce to pass to the C method of the C containing the list. =back =head3 TASK LIST EXAMPLE $wizard->addTaskListPage( -title => "Toy example", -tasks => [ "Wait five seconds" => sub { sleep 5; 1; }, "Wait ten seconds!" => sub { sleep 10; 1; }, ], ); =cut 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}; } } $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" ); # $self->{nextButton}->invoke if $args->{ -continue }; } }, # End of anonymous sub ); # End of $frame->after args } return $frame; } 1; =head1 AUTHOR Lee Goddard (lgoddard@cpan.org). =head1 COPYRIGHT Copyright (C) Lee Goddard, 11/2002 - 01/2008 ff. Made available under the same terms as Perl itself.