File Coverage

blib/lib/App/TestOnTap/Preprocess.pm
Criterion Covered Total %
statement 60 60 100.0
branch 11 14 78.5
condition 6 8 75.0
subroutine 13 13 100.0
pod 0 3 0.0
total 90 98 91.8


line stmt bran cond sub pod time code
1             package App::TestOnTap::Preprocess;
2              
3 19     19   149 use POSIX;
  19         43  
  19         126  
4 19     19   31583 use App::TestOnTap::Util qw(runprocess);
  19         52  
  19         983  
5              
6 19     19   118 use strict;
  19         49  
  19         412  
7 19     19   133 use warnings;
  19         69  
  19         14840  
8              
9             # CTOR
10             #
11             sub new
12             {
13 27     27 0 117 my $class = shift;
14 27         69 my $cmd = shift;
15 27         76 my $args = shift;
16 27         64 my $env = shift;
17 27         71 my $argv = shift;
18              
19 27         149 my $self = bless( { env => $env, argv => $argv }, $class);
20 27 100 66     249 $self->__execPreprocess($cmd, $args) if ($cmd && @$cmd);
21            
22 27         698 return $self;
23             }
24              
25             sub getEnv
26             {
27 26     26 0 68 my $self = shift;
28            
29 26         2440 return $self->{env};
30             }
31              
32             sub getArgv
33             {
34 50     50 0 153 my $self = shift;
35              
36 50         341 return $self->{argv};
37             }
38              
39             sub __execPreprocess
40             {
41 1     1   3 my $self = shift;
42 1         2 my $cmd = shift;
43 1         11 my $args = shift;
44              
45 1         3 my @preproc;
46             my $xit = runprocess
47             (
48             sub
49             {
50 43     43   115 my $l = shift;
51 43         75 chomp($l);
52 43         240 $l =~ s/^\s+|\s+$//g;
53 43 50       221 push(@preproc, $l) if $l;
54             },
55             $args->getSuiteRoot(),
56             (
57             @$cmd,
58 1         12 @{$self->getArgv()}
  1         12  
59             )
60             );
61            
62 1 50       37 die("ERROR: exit code '$xit' when running preprocess command\n") if $xit;
63              
64 1         24 $args->getWorkDirManager()->recordPreprocess([ @preproc ]);
65              
66             my %types =
67             (
68 1     1   20 ENV => sub { $self->__parseEnvLines(@_) },
69 1     1   5 ARGV => sub { $self->__parseArgvLines(@_) }
70 1         27 );
71              
72 1         12 while (my $line = shift(@preproc))
73             {
74 4 100 66     62 if ($line =~ /^\s*#\s*BEGIN\s+([^\s]+)\s*$/ && exists($types{$1}))
75             {
76 2         11 $types{$1}->($1, \@preproc);
77             }
78             else
79             {
80 2         52 warn("WARNING: Unexpected line during preprocessing: '$line'\n");
81             }
82             }
83             }
84              
85             sub __parseEnvLines
86             {
87 1     1   8 my $self = shift;
88 1         8 my $type = shift;
89 1         3 my $preproc = shift;
90              
91 1         3 my %env;
92 1         4 while (my $line = shift(@$preproc))
93             {
94 36 100       172 last if $line =~ /^\s*#\s*END\s+\Q$type\E\s*$/;
95 35 50       121 die("Invalid $type line during preprocessing: '$line'\n") unless ($line =~ /^([^=]+)=(.*)/);
96 35   100     188 $env{$1} = $2 || '';
97             }
98            
99 1         11 $self->{env} = \%env;
100             }
101              
102             sub __parseArgvLines
103             {
104 1     1   10 my $self = shift;
105 1         5 my $type = shift;
106 1         3 my $preproc = shift;
107              
108 1         5 my @argv;
109 1         8 while (my $line = shift(@$preproc))
110             {
111 3 100       36 last if $line =~ /^\s*#\s*END\s+\Q$type\E\s*$/;
112 2         10 push(@argv, $line);
113             }
114            
115 1         16 $self->{argv} = \@argv;
116             }
117              
118             1;