File Coverage

blib/lib/App/MonM/Checkit/Command.pm
Criterion Covered Total %
statement 15 41 36.5
branch 0 16 0.0
condition 0 13 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 21 77 27.2


line stmt bran cond sub pod time code
1             package App::MonM::Checkit::Command; # $Id: Command.pm 80 2019-07-08 10:41:47Z abalama $
2 1     1   7 use strict;
  1         2  
  1         28  
3 1     1   6 use utf8;
  1         2  
  1         7  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             App::MonM::Checkit::Command - Checkit Command subclass
10              
11             =head1 VIRSION
12              
13             Version 1.00
14              
15             =head1 SYNOPSIS
16              
17            
18             Enable yes
19             Type command
20             Command ls -la
21             Target content
22             IsTrue !!perl/regexp (?i-xsm:README)
23              
24             # . . .
25              
26            
27              
28             Or with STDIN pipe:
29              
30            
31             Enable yes
32             Type command
33             Command perl
34             Content "print q/Oops/"
35             Target content
36             IsTrue Oops
37              
38             # . . .
39              
40            
41              
42             =head1 DESCRIPTION
43              
44             Checkit Command subclass
45              
46             =head2 check
47              
48             Checkit method.
49             This is backend method of L
50              
51             Returns:
52              
53             =over 4
54              
55             =item B
56              
57             The exit status code (ERRORLEVEL, EXITCODE)
58              
59             =item B
60              
61             The STDOUT response content
62              
63             =item B
64              
65             The STDERR response content
66              
67             =item B
68              
69             OK or ERROR value, see "status"
70              
71             =item B
72              
73             Command string
74              
75             =item B
76              
77             0 if error occured (code != 0); 1 if no errors found (code == 0)
78              
79             =back
80              
81             =head1 HISTORY
82              
83             See C file
84              
85             =head1 TO DO
86              
87             See C file
88              
89             =head1 BUGS
90              
91             * none noted
92              
93             =head1 SEE ALSO
94              
95             L
96              
97             =head1 AUTHOR
98              
99             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
100              
101             =head1 COPYRIGHT
102              
103             Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved
104              
105             =head1 LICENSE
106              
107             This program is free software; you can redistribute it and/or
108             modify it under the same terms as Perl itself.
109              
110             See C file and L
111              
112             =cut
113              
114 1     1   35 use vars qw/$VERSION/;
  1         3  
  1         53  
115             $VERSION = '1.00';
116              
117 1     1   7 use CTK::Util qw/ execute /;
  1         2  
  1         46  
118 1     1   5 use CTK::ConfGenUtil;
  1         2  
  1         263  
119              
120             sub check {
121 0     0 1   my $self = shift;
122 0           my $type = $self->type;
123 0 0 0       return $self->maybe::next::method() unless $type && $type eq 'command';
124              
125             # Init
126 0   0       my $command = value($self->config, 'command') || '';
127 0   0       my $content = value($self->config, 'content') // '';
128 0 0         unless (length($command)) {
129 0           $self->status(0);
130 0           $self->source("NOOP");
131 0           $self->message('Command not specified');
132 0           return;
133             }
134 0           $self->source($command);
135              
136             # Run command
137 0           my $exe_err = '';
138 0 0         my $exe_out = execute($command, length($content) ? $content : undef, \$exe_err);
139 0           my $stt = $? >> 8;
140 0 0         my $exe_stt = $stt ? 0 : 1;
141 0           $self->status($exe_stt);
142 0           $self->code($stt);
143 0 0         $self->message($exe_stt ? "OK" : "ERROR");
144 0 0 0       if (defined($exe_out) && length($exe_out)) {
145 0           chomp($exe_out);
146 0           $self->content($exe_out) ;
147             }
148 0 0 0       if (!$exe_stt && $exe_err) {
    0          
149 0           chomp($exe_err);
150 0           $self->error($exe_err);
151             } elsif ($stt) {
152 0           $self->error(sprintf("Exitval=%d", $stt));
153             }
154              
155 0           return;
156             }
157              
158             1;
159              
160             __END__