File Coverage

blib/lib/Test/Smoke/Util/Execute.pm
Criterion Covered Total %
statement 34 34 100.0
branch 8 10 80.0
condition 2 2 100.0
subroutine 9 9 100.0
pod 5 5 100.0
total 58 60 96.6


line stmt bran cond sub pod time code
1             package Test::Smoke::Util::Execute;
2 15     15   105878 use warnings;
  15         51  
  15         540  
3 15     15   88 use strict;
  15         46  
  15         588  
4              
5             our $VERSION = '0.001';
6              
7 15     15   99 use Cwd;
  15         41  
  15         823  
8              
9 15     15   530 use Test::Smoke::LogMixin;
  15         32  
  15         6276  
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 7     7 1 3381 my $class = shift;
53              
54 7         95 my %args = @_;
55              
56             my $self = {
57             verbose => $args{verbose} || 0,
58             command => $args{command},
59 7   100     128 exitcode => undef,
60             };
61 7         74 return bless $self, $class;
62             }
63              
64             =head2 $executer->run()
65              
66             Run the command with backticks.
67              
68             =head3 Arguments
69              
70             None
71              
72             =head3 Returns
73              
74             Context aware list or scalar.
75              
76             If any error occured, C<< $self->exitcode >> is set.
77              
78             =cut
79              
80             sub run {
81 15     15 1 5490 my $self = shift;
82              
83             my $command = join(
84             " ",
85             map {
86 56 100       473 / / ? qq/"$_"/ : $_
87 15         102 } $self->{command}, $self->arguments(@_)
88             );
89 15         62180 $self->log_debug("In pwd(%s) running:", cwd());
90 15         274 $self->log_info("qx[%s]\n", $command);
91              
92 15         168523 my @output = qx/$command/;
93 15         544 $self->{exitcode} = $? >> 8;
94              
95 15 100       852 return wantarray ? @output : join("", @output);
96             }
97              
98             =head2 $executer->exitcode
99              
100             Getter that returns the exitcode.
101              
102             =cut
103              
104 11     11 1 11230 sub exitcode { return $_[0]->{exitcode} }
105              
106             =head2 $executer->verbose
107              
108             Accessor that returns the verbose.
109              
110             =cut
111              
112             sub verbose {
113 33     33 1 1165 my $self = shift;
114 33 100       169 if (@_) { $self->{verbose} = shift; }
  1         9  
115              
116             return $self->{verbose}
117 33         278 }
118              
119             =head2 $executer->arguments
120              
121             Accessor that returns the arguments.
122              
123             =cut
124              
125             sub arguments {
126 15     15 1 35 my $self = shift;
127 15 50       134 if (@_) { $self->{arguments} = [@_]; }
  15         184  
128              
129 15 50       69 return $self->{arguments} ? @{ $self->{arguments} } : ()
  15         108  
130             }
131              
132             1;
133              
134             =head1 STUFF
135              
136             (c) MMXIII - Abe Timmerman
137              
138             This library is free software; you can redistribute it and/or modify
139             it under the same terms as Perl itself.
140              
141             See:
142              
143             =over 4
144              
145             =item * http://www.perl.com/perl/misc/Artistic.html
146              
147             =item * http://www.gnu.org/copyleft/gpl.html
148              
149             =back
150              
151             This program is distributed in the hope that it will be useful,
152             but WITHOUT ANY WARRANTY; without even the implied warranty of
153             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
154              
155             =cut