File Coverage

blib/lib/Test/Smoke/Util/Execute.pm
Criterion Covered Total %
statement 37 37 100.0
branch 12 12 100.0
condition 2 2 100.0
subroutine 10 10 100.0
pod 6 6 100.0
total 67 67 100.0


line stmt bran cond sub pod time code
1             package Test::Smoke::Util::Execute;
2 15     15   85041 use warnings;
  15         32  
  15         442  
3 15     15   72 use strict;
  15         29  
  15         467  
4              
5             our $VERSION = '0.002';
6              
7 15     15   68 use Cwd;
  15         36  
  15         650  
8              
9 15     15   424 use Test::Smoke::LogMixin;
  15         27  
  15         6936  
10              
11             =head1 NAME
12              
13             Test::Smoke::Util::Execute - Run a command and return its output.
14              
15             =head1 SYNOPSIS
16              
17             use Test::Smoke::Util::Execute;
18              
19             my $ex = Test::Smoke::Execute->new(
20             verbose => $level,
21             command => $command,
22             arguments => [@arguments],
23             );
24             my $output = eval { $ex->run() };
25             if (my $error = $@) {
26             croak("Error running $command: $error");
27             }
28              
29             =head1 DESCRIPTION
30              
31             =head2 Test::Smoke::Util::Execute->new(%arguments)
32              
33             Instantiate an object of this class
34              
35             =head3 Arguments
36              
37             =over
38              
39             =item * verbose => [0, 1, 2]
40              
41             =item * command => $command_to_pass_to_qx
42              
43             =back
44              
45             =head3 Returns
46              
47             The instantiated object.
48              
49             =cut
50              
51             sub new {
52 9     9 1 2597 my $class = shift;
53              
54 9         75 my %args = @_;
55              
56             my $self = {
57             verbose => $args{verbose} || 0,
58             command => $args{command},
59 9   100     105 exitcode => undef,
60             };
61 9         52 return bless $self, $class;
62             }
63              
64             =head2 $executer->full_command()
65              
66             Create the full command as pass to C.
67              
68             =head3 Arguments
69              
70             None
71              
72             =head3 Returns
73              
74             A string with quotes around the elements/arguments that need them.
75              
76             =cut
77              
78             sub full_command {
79 19     19 1 1388 my $self = shift;
80              
81             my $command = join(
82             " ",
83             map {
84 63 100       400 /^(["']).*\1$/
    100          
85             ? $_
86             : / /
87             ? qq/"$_"/
88             : $_
89 19         88 } $self->{command}, $self->arguments(@_)
90             );
91 19         64 return $command;
92             }
93              
94             =head2 $executer->run()
95              
96             Run the command with backticks.
97              
98             =head3 Arguments
99              
100             None
101              
102             =head3 Returns
103              
104             Context aware list or scalar.
105              
106             If any error occured, C<< $self->exitcode >> is set.
107              
108             =cut
109              
110             sub run {
111 15     15 1 4043 my $self = shift;
112              
113 15         62 my $command = $self->full_command(@_);
114 15         40954 $self->log_debug("In pwd(%s) running:", cwd());
115 15         106 $self->log_info("qx[%s]\n", $command);
116              
117 15         115741 my @output = qx/$command/;
118 15         360 $self->{exitcode} = $? >> 8;
119              
120 15 100       527 return wantarray ? @output : join("", @output);
121             }
122              
123             =head2 $executer->exitcode
124              
125             Getter that returns the exitcode.
126              
127             =cut
128              
129 11     11 1 7768 sub exitcode { return $_[0]->{exitcode} }
130              
131             =head2 $executer->verbose
132              
133             Accessor that returns the verbose.
134              
135             =cut
136              
137             sub verbose {
138 33     33 1 838 my $self = shift;
139 33 100       102 if (@_) { $self->{verbose} = shift; }
  1         7  
140              
141             return $self->{verbose}
142 33         181 }
143              
144             =head2 $executer->arguments
145              
146             Accessor that returns the arguments.
147              
148             =cut
149              
150             sub arguments {
151 19     19 1 40 my $self = shift;
152 19 100       58 if (@_) { $self->{arguments} = [@_]; }
  17         124  
153              
154 19 100       61 return $self->{arguments} ? @{ $self->{arguments} } : ()
  17         63  
155             }
156              
157             1;
158              
159             =head1 STUFF
160              
161             (c) MMXIII - Abe Timmerman
162              
163             This library is free software; you can redistribute it and/or modify
164             it under the same terms as Perl itself.
165              
166             See:
167              
168             =over 4
169              
170             =item * http://www.perl.com/perl/misc/Artistic.html
171              
172             =item * http://www.gnu.org/copyleft/gpl.html
173              
174             =back
175              
176             This program is distributed in the hope that it will be useful,
177             but WITHOUT ANY WARRANTY; without even the implied warranty of
178             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
179              
180             =cut