| 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; | ||||||