File: | t/TestLib.pm |
Coverage: | 89.2% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package 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 | |||||||
9 | require Exporter; | ||||||
10 | our @ISA = qw(Exporter); | ||||||
11 | our @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 | |||||||
36 | sub 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 | |||||||
52 | sub 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 | |||||||
91 | 1; |