File Coverage

File:t/TestLib.pm
Coverage:89.2%

linestmtbrancondsubpodtimecode
1package TestLib;
2
3
5
5
5
36
18
131
use strict;
4
5
5
5
31
15
216
use warnings;
5
6
5
5
5
32
15
969
use Cwd 'getcwd';
7
5
5
5
42
15
16586
use File::Path qw( mkpath rmtree );
8
9require Exporter;
10our @ISA = qw(Exporter);
11our @EXPORT_OK = qw( t_module t_dir t_startup t_teardown t_capture t_action_files );
12
13
73
0
3206
sub t_module { 'App::Dest' }
14
15{
16    my ( $dir, $pwd );
17
18    sub t_dir {
19
6
0
13179
        $dir ||= ( $ENV{APPDESTDIR} ) ? $ENV{APPDESTDIR} . $$ : 'dest_test_' . $$;
20    }
21
22    sub t_startup {
23
6
0
482
        $pwd = getcwd();
24
6
72
        t_dir();
25
6
3595
        mkpath($dir) unless ( -d $dir );
26
6
121
        chdir($dir);
27    }
28
29    sub t_teardown {
30
6
0
83
        chdir($pwd);
31
6
11197
        rmtree($dir);
32
6
122
        ( $pwd, $dir ) = ( undef, undef );
33    }
34}
35
36sub t_capture {
37
41
0
329
    my $sub = shift;
38
39
41
250
    local *STDOUT;
40
41
159
    my $stdout;
41
5
5
5
41
127
81
57
952
    open( STDOUT, '>', \$stdout );
42
43
41
10863
    local *STDERR;
44
41
184
    my $stderr;
45
41
318
    open( STDERR, '>', \$stderr );
46
47
41
41
191
207
    eval { $sub->(@_) };
48
49
41
14969
    return $stdout, $stderr, $@;
50}
51
52sub t_action_files {
53
3
0
36
    for my $action (@_) {
54
8
110
        my ( $deploy_prereq, $revert_prereq );
55
8
71
        ( $action, $deploy_prereq, $revert_prereq ) = @$action if ( ref $action );
56
57
8
138
        ( my $name = $action ) =~ s/\W/_/g;
58
8
75
        $name = 'state_' . $name . '.txt';
59
60
8
4403
        mkpath($action);
61
62
8
400
        open( my $deploy, '>', $action . '/deploy.bat' );
63
8
218
        print $deploy "echo $action >> $name\n";
64
8
88
        print $deploy ':; # dest.prereq: ', $deploy_prereq, "\n" if ($deploy_prereq);
65
8
193
        close $deploy;
66
67
8
4639
        open( my $verify, '>', $action . '/verify.bat' );
68
8
92
        print $verify ':<<CMDLITERAL', "\n";
69
8
43
        print $verify '@echo off', "\n";
70
8
41
        print $verify 'goto :CMDSCRIPT', "\n";
71
8
42
        print $verify 'CMDLITERAL', "\n";
72
8
50
        print $verify 'state=`grep ' . $action . ' ' . $name . ' 2> /dev/null`', "\n";
73
8
41
        print $verify 'if [ ${#state} -gt 0 ]; then echo 1; else echo 0; fi', "\n";
74
8
39
        print $verify 'exit', "\n";
75
8
36
        print $verify ':CMDSCRIPT', "\n";
76
8
39
        print $verify 'set /p state=<', $name, "\n";
77
8
61
        print $verify 'if %state%==' . $action . ' ( echo 1 ) else ( echo 0 )', "\n";
78
8
209
        close $verify;
79
80
8
287
        open( my $revert, '>', $action . '/revert.bat' );
81
8
58
        print $revert "echo '' > $name\n";
82
8
48
        print $revert ':; # dest.prereq: ', $revert_prereq, "\n" if ($revert_prereq);
83
8
148
        close $revert;
84
85
8
24
40
320
        chmod( 0755, map { $action . '/' . $_ } qw( deploy.bat verify.bat revert.bat ) );
86    }
87
88
3
19
    return;
89}
90
911;