File Coverage

UnitTestSetup.pm
Criterion Covered Total %
statement 76 79 96.2
branch 8 12 66.6
condition 5 9 55.5
subroutine 15 16 93.7
pod 0 7 0.0
total 104 123 84.5


line stmt bran cond sub pod time code
1             package UnitTestSetup;
2              
3 12     12   1217661 use strict;
  12         119  
  12         349  
4 12     12   74 use warnings;
  12         21  
  12         362  
5              
6 12     12   2238 use parent qw( Exporter );
  12         1526  
  12         84  
7              
8 12     12   2004 use Data::Dumper;
  12         14126  
  12         554  
9 12     12   4204 use Date::Format;
  12         66169  
  12         783  
10 12     12   92 use File::Path;
  12         21  
  12         821  
11 12     12   6107 use File::Temp qw( tempdir );
  12         150762  
  12         683  
12 12     12   79 use Test::More;
  12         21  
  12         105  
13              
14             our @EXPORT_OK
15             = qw( init_test format_time TRUE FALSE FIVE_MINUTES ISO_8601_FORMAT);
16              
17             our %EXPORT_TAGS = ( all => [@EXPORT_OK], );
18              
19             use constant {
20 12         10271 ISO_8601_FORMAT => '%Y-%m-%dT%H:%M:%SZ',
21             TRUE => 1,
22             FALSE => 0,
23             FIVE_MINUTES => 5 * 60,
24 12     12   3860 };
  12         25  
25              
26             caller or __PACKAGE__->main();
27              
28             ########################################################################
29             sub format_time {
30             ########################################################################
31 6     6 0 1258 my ($time) = @_;
32              
33 6         22 return time2str( ISO_8601_FORMAT, time + $time, 'GMT' );
34             }
35              
36             ########################################################################
37             sub read_config {
38             ########################################################################
39 8     8 0 39 my ( $fh, $test ) = @_;
40              
41 8   33     31 $fh = $fh || *DATA;
42              
43 8         18 my %configs;
44              
45             my $config_name;
46              
47 8         48 while ( my $line = <$fh> ) {
48 312         354 chomp $line;
49 312 100       521 if ( $line =~ /^--- (.*) ---$/ ) {
50 24         56 $config_name = $1;
51 24         61 $configs{$1} = [];
52 24         77 next;
53             }
54              
55 288         357 push @{ $configs{$config_name} }, $line;
  288         853  
56             }
57              
58 8         215 close $fh;
59              
60 8 50       88 return $configs{$test} ? $configs{$test} : $configs{'01-credentials.t'};
61             }
62              
63             ########################################################################
64             sub create_credentials_file {
65             ########################################################################
66 8     8 0 38 my ( $home, $credentials, $vars ) = @_;
67              
68             # poor mans templating...
69 8         16 foreach ( @{$credentials} ) {
  8         28  
70 141 100       244 next if !/(@[^@]+@)/;
71              
72 1         3 my $tmpl_var = $1;
73              
74 1         2 my $var = $tmpl_var;
75 1         4 $var =~ s/@//g;
76              
77 1         4 my $val = $vars->{$var};
78              
79 1         15 s/$tmpl_var/$val/g;
80             }
81              
82 8         522 mkdir "$home/.aws";
83              
84 8 50       687 open( my $fh, '>', "$home/.aws/credentials" )
85             or BAIL_OUT('could not create temporary credentials file');
86              
87 8         30 print {$fh} join "\n", @{$credentials};
  8         24  
  8         77  
88              
89 8         408 close $fh;
90              
91 8         73 return "$home/.aws/credentials";
92             }
93              
94             ########################################################################
95             sub create_config_file {
96             ########################################################################
97 8     8 0 25 my ($home) = @_;
98              
99 8 50       137 if ( !-d "$home/.aws" ) {
100 0         0 mkdir "$home/.aws";
101             }
102              
103 8 50       555 open my $fh, '>', "$home/.aws/config"
104             or BAIL_OUT('could not create temporary config file');
105              
106 8         29 print {$fh} join "\n", qw{[default] region=us-east-2};
  8         74  
107              
108 8         260 close $fh;
109              
110 8         67 return "$home/.aws/config";
111             }
112              
113             ########################################################################
114             sub create_home_dir {
115             ########################################################################
116 8     8 0 24 my ($cleanup) = @_;
117              
118 8         37 my $home = tempdir( 'amz-credentials-XXXXX', CLEANUP => $cleanup );
119              
120 8         4266 $ENV{HOME} = $home;
121              
122 8         30 return $home;
123             }
124              
125             ########################################################################
126             sub init_test {
127             ########################################################################
128 8     8 0 742 my (%args) = @_;
129              
130 8   50     124 $ENV{'AWS_PROFILE'} = $args{'profile'} // 'default';
131              
132 8   100     57 my $credentials = read_config( *DATA, $args{'test'} // '01-credentials.t' );
133              
134 8   50     63 my $home = create_home_dir( $args{'cleanup'} // 1 );
135              
136 8         48 create_credentials_file( $home, $credentials, $args{'vars'} );
137 8         39 create_config_file($home);
138              
139 8         43 return $home;
140             }
141              
142             sub main {
143 0     0 0   return print {*STDERR} Dumper [
  0            
144             init_test(
145             cleanup => 0,
146             test => '01-credentials.t',
147             vars => { process => 'foo' },
148             )
149             ];
150             }
151              
152             1;
153              
154             __DATA__