From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

LGODDARD / Tk-Wizard-2.144_bsdtar / t / 177_dirselect.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112

              
#! perl -w
# $Id: 77_dirselect.t,v 1.7 2007/08/18 00:44:16 martinthurn Exp $
use strict;
use Cwd;
use ExtUtils::testlib;
use FileHandle;
use Cwd;
use Test::More;
use Tk;
use lib qw(../lib . t/);
BEGIN {
    my $mwTest;
    eval { $mwTest = Tk::MainWindow->new };
    if ($@) {
        plan skip_all => 'Test irrelevant without a display';
    }
    else {
        plan tests => 11;
    }
    $mwTest->destroy if Tk::Exists($mwTest);
    use_ok('Tk::Wizard');
    use_ok('WizTestSettings');
}
my $VERSION = do { my @r = ( q$Revision: 1.7 $ =~ /\d+/g ); sprintf "%d." . "%03d" x $#r, @r };
autoflush STDOUT 1;
our $WAIT = $ENV{TEST_INTERACTIVE} ? 0 : 2222;
my $sDir = getcwd;
my $wizard = Tk::Wizard->new(
    -title => "Test version $VERSION For Tk::Wizard version $Tk::Wizard::VERSION",
    # -debug => 88,
);
isa_ok( $wizard, "Tk::Wizard" );
$wizard->configure(
    -preNextButtonAction => sub { &preNextButtonAction($wizard) },
    -finishButtonAction  => sub { pass('user clicked finish'); 1; },
);
isa_ok( $wizard->cget( -preNextButtonAction ), "Tk::Callback" );
isa_ok( $wizard->cget( -finishButtonAction ),  "Tk::Callback" );
#
# Create pages
#
is(
    $wizard->addPage(
        sub {
            $wizard->blank_frame(
                -wait  => 100,
                -title => "Welcome to the Wizard",
            );
        }
    ),
    1,
    'splash is 1'
);
my $iGET_DIR = $wizard->addDirSelectPage(
    -wait       => $WAIT,
    -nowarnings => "9",
    -variable   => \$sDir,
);
is( $iGET_DIR, 2, 'dirselect is 2' );
is(
    $wizard->addPage(
        sub {
            $wizard->blank_frame(
                -wait  => 100,
                -title => "Page Bye!",
                -text  => "Thanks for testing!"
            );
        }
    ),
    3,
    'bye is 3'
);
$wizard->Show;
pass('after Show');
MainLoop();
pass('after MainLoop');
undef $wizard;
sub preNextButtonAction {
    my $wizard = shift;
    my $iPage  = $wizard->currentPage;
    # diag("start preNextButtonAction(iPage=$iPage), iGET_DIR=$iGET_DIR, wizard is $wizard");
    if ( $iPage == $iGET_DIR ) {
        my $i = $ENV{TEST_INTERACTIVE} ? $wizard->callback_dirSelect( \$sDir ) : 1;
        return $i;
        if ( $_ == 1 ) {
            if ( not $_ ) {
                $wizard->parent->messageBox(
                    -icon  => 'warning',
                    -title => 'Oops',
                    -text  => "Please choose a valid directory.",
                );
            }    # if
        }    # if
        return $_ ? 1 : 0;
    }    # if
    return 1;
}    # preNextButtonAction
__END__