File Coverage

lib/Shell/Cmd.pm
Criterion Covered Total %
statement 599 717 84.9
branch 293 370 80.2
condition 103 135 76.3
subroutine 47 53 90.5
pod 11 11 100.0
total 1053 1286 83.0


line stmt bran cond sub pod time code
1             package Shell::Cmd;
2             # Copyright (c) 2013-2021 Sullivan Beck. All rights reserved.
3             # This program is free software; you can redistribute it and/or modify it
4             # under the same terms as Perl itself.
5              
6             # Variables used in scripts
7             # SC_ORIG_DIRE : the directory you were in when the script ran
8             # SC_DIRE : the working directory of the script
9             # SC_DIRE_n : the working directory going into command n
10             # SC_FAILED = N : the command which failed
11             # SC_CURR_EXIT : the exit code for the current command
12             # SC_CURR_SUCC : 1 if the current command (any alternate) succeeded
13             # SC_RETRIES = N : this command will run up to N times
14             # SC_TRY = N : we're currently on the Nth try
15              
16             ###############################################################################
17              
18             require 5.008;
19 93     93   268812 use warnings 'all';
  93         213  
  93         4190  
20 93     93   486 use strict;
  93         170  
  93         2488  
21 93     93   50957 use Capture::Tiny qw(capture capture_stdout capture_stderr);
  93         1651511  
  93         6955  
22 93     93   99213 use Net::OpenSSH;
  93         3450327  
  93         5316  
23 93     93   64680 use Parallel::ForkManager 0.7.6;
  93         5196284  
  93         4433  
24 93     93   873 use IO::File;
  93         208  
  93         17256  
25 93     93   730 use Cwd;
  93         196  
  93         835123  
26              
27             our($VERSION);
28             $VERSION = "3.04";
29              
30             $| = 1;
31             $Data::Dumper::Sortkeys = 1;
32              
33             ###############################################################################
34             # METHODS TO CREATE OBJECT
35             ###############################################################################
36              
37             sub version {
38             # uncoverable subroutine
39             # uncoverable statement
40 0     0 1 0 my($self) = @_;
41             # uncoverable statement
42 0         0 return $VERSION;
43             }
44              
45             sub new {
46 79     79 1 828872 my($class,%options) = @_;
47              
48 79         1173 my $self = {};
49              
50 79         1222 bless $self,$class;
51 79         1668 $self->flush();
52              
53 79         345 return $self;
54             }
55              
56             sub flush {
57 89     89 1 2321 my($self, @opts) = @_;
58              
59 89 100       1811 my $all = 1 if (! @opts);
60 89         725 my %opts = map { $_,1 } @opts;
  4         16  
61              
62             # $self = {
63             # 'g' => { VAR => VAL } global options
64             # 'c' => { VAR => VAL } per-command options
65             # 'e' => [ VAR, VAL ] environment
66             # 'o' => { out => STDOUT, output from script mode
67             # err => STDERR,
68             # exit => EXIT }
69             # 's' => { HOST => { out => STDOUT, output from ssh script mode
70             # err => STDERR,
71             # exit => EXIT } }
72             # 'curr' => NUM, the current command in
73             # the output method
74             # 'err' => ERROR,
75             # 'cmd' => { CMD_NUM => CMD_DESC } command descriptions
76             # 'cmd_num' => NUM
77             # 'max_alt' => NUM the greatest number of
78             # alternates
79             # 'scr' => [] the current script
80              
81 89         2159 $$self{'err'} = '';
82 89         1247 $$self{'scr'} = [];
83              
84 89 100 100     6232 if ($all || $opts{'opts'}) {
85 86         11022 $$self{'g'} =
86             {
87             #
88             # Options set with the options method.
89             #
90              
91             'mode' => 'run',
92             'dire' => '',
93             'output' => 'both',
94             'script' => '',
95             'echo' => 'noecho',
96             'failure' => 'exit',
97              
98             'tmp_script' => "/tmp/.cmd.shell.$$",
99             'tmp_script_keep' => 0,
100             'ssh_script' => '',
101             'ssh_script_keep' => 0,
102              
103             'ssh_opts' => {},
104             'ssh_num' => 1,
105             'ssh_sleep' => 0,
106              
107             #
108             # A description of the script (calulated
109             # from some of the obove options in _script_options).
110             #
111             # s_type : Type of script currently being
112             # created.
113             # run, simple, script
114             # simple : Type of simple script currently being
115             # created.
116             # script : s_type = script
117             # failure : s_type = run, failure = display
118             # c_echo : mode=run: echo,noecho,failed
119             # otherwise: ''
120             # c_fail : How to treat command failure
121             # in the calculated environment.
122             # simple: ''
123             # otherwise: exit,display,continue
124             # out : 1 if STDOUT captured
125             # err : 1 if STDERR captured
126             # redir : String to redirect output
127             #
128              
129             's_type' => '',
130             'simple' => '',
131             'out' => 0,
132             'err' => 0,
133             'redir' => '',
134             'c_echo' => '',
135             'c_fail' => '',
136              
137             #
138             # Script indentation (used to keep track of
139             # all indentation)
140             #
141             'ind_per_lev' => 3,
142             'ind_cur_lev' => 0,
143             'curr_ind' => "",
144             'next_ind' => "",
145             'prev_ind' => "",
146              
147             #
148             # Keep track of current flow structure
149             # as commands are added (not used once
150             # they are done).
151             #
152             # ( [ FLOW, CMD_NUM ],
153             # [ FLOW, CMD_NUM ], ... )
154             # where:
155             # FLOW : type of flow
156             # CMD_NUM : command where it opened
157             #
158             'flow' => [],
159             };
160             }
161              
162 89 100 100     1313 if ($all || $opts{'commands'}) {
163             # cmd => { CMD_NUM => { 'meta' => VAL, (0 or a string)
164             # 'label' => LABEL,
165             # 'cmd' => [ CMD ],
166             # 'dire' => DIRE,
167             # 'noredir' => 0/1,
168             # 'retry' => NUM,
169             # 'sleep' => NUM,
170             # 'check' => CMD,
171             # 'flow' => if/loop/...
172             # 'flow_type' => open/cont/close
173             # }
174 86         431 $$self{'cmd'} = {};
175 86         351 $$self{'cmd_num'} = 1;
176 86         333 $$self{'max_alt'} = 0;
177             }
178              
179             # Command options
180             # c_flow 1 if this is a flow command
181             # c_num The number of the current command
182             # f_num The failure code (c_num if <=200, 201 otherwise)
183             # alts 1 if alternates are available
184             # a_num The number of the alternate
185             # c_label The label for the command
186             #
187             # c_retries The number of retries
188             # c_sleep How long to sleep between retries
189             # c_redir Redirect string for this command (takes into account
190             # noredir)
191             # c_check The command to check success
192             # c_check_q The quoted check command
193             # simp If the current command is in a simple script
194             #
195             # cmd_str The current command string
196             # e.g. '/bin/ls /tmp'
197             # cmd_str_q The quoted command string
198             # cmd_label A label describing the command (command number and
199             # command label if available):
200             # '1'
201             # '1 [LABEL]'
202             # alt_label A label describing the alternate
203             # '1.1'
204             # '1.1 [LABEL]'
205             # '1.0' (if no alternates)
206              
207 89         319 $$self{'c'} = {};
208              
209 89 100 100     1151 $$self{'e'} = [] if ($all || $opts{'env'});
210              
211 89 100 100     724 if ($all || $opts{'out'}) {
212 86         346 $$self{'o'} = {};
213 86         658 $$self{'s'} = {};
214 86         375 $$self{'curr'} = 0;
215             }
216              
217 89         391 return;
218             }
219              
220             ###############################################################################
221             # METHODS TO SET OPTIONS
222             ###############################################################################
223              
224             sub dire {
225 6     6 1 38923 my($self,$dire) = @_;
226 6 100       24 return $$self{'g'}{'dire'} if (! defined($dire));
227              
228 2         8 return $self->options("dire",$dire);
229             }
230              
231             sub mode {
232 75     75 1 1119 my($self,$mode) = @_;
233 75 100       593 return $$self{'g'}{'mode'} if (! defined($mode));
234              
235 2         7 return $self->options("mode",$mode);
236             }
237              
238             sub env {
239 21     21 1 1366 my($self,@tmp) = @_;
240 21 100       91 return @{ $$self{'e'} } if (! @tmp);
  4         13  
241              
242 17         70 while (@tmp) {
243 36         67 my $var = shift(@tmp);
244 36         121 my $val = $self->_quote(shift(@tmp));
245 36         63 push @{ $$self{'e'} },($var,$val);
  36         153  
246             }
247              
248 17         53 return;
249             }
250              
251             sub options {
252 233     233 1 11560 my($self,%opts) = @_;
253              
254             OPT:
255 233         1376 foreach my $opt (keys %opts) {
256              
257 312         1111 my $val = $opts{$opt};
258 312         1086 $opt = lc($opt);
259              
260 312 100 100     5312 if ($opt eq 'mode') {
    100 100        
    100 100        
    100 100        
    100          
    100          
    100          
    100          
    100          
261              
262 75 100       1616 if (lc($val) =~ /^(run|dry-run|script)$/) {
263 74         479 $$self{'g'}{$opt} = lc($val);
264 74         388 next OPT;
265             }
266              
267             } elsif ($opt eq 'dire') {
268 18         214 $$self{'g'}{$opt} = $self->_quote($val);
269 18         62 next OPT;
270              
271             } elsif ($opt eq 'output') {
272              
273 11 100       143 if (lc($val) =~ /^(both|merged|stdout|stderr|quiet)$/) {
274 10         51 $$self{'g'}{$opt} = lc($val);
275 10         63 next OPT;
276             }
277              
278             } elsif ($opt eq 'script') {
279              
280 27 100       406 if (lc($val) =~ /^(run|script|simple)$/) {
281 26         175 $$self{'g'}{$opt} = lc($val);
282 26         111 next OPT;
283             }
284              
285             } elsif ($opt eq 'echo') {
286              
287 4 100       34 if (lc($val) =~ /^(echo|noecho|failed)$/) {
288 3         15 $$self{'g'}{$opt} = lc($val);
289 3         8 next OPT;
290             }
291              
292             } elsif ($opt eq 'failure') {
293              
294 13 100       146 if (lc($val) =~ /^(exit|display|continue)$/) {
295 12         55 $$self{'g'}{$opt} = lc($val);
296 12         36 next OPT;
297             }
298              
299             } elsif ($opt =~ s/^ssh://) {
300 1         4 $$self{'g'}{'ssh_opts'}{$opt} = $val;
301 1         4 next OPT;
302              
303             } elsif ($opt eq 'ssh_num' ||
304             $opt eq 'ssh_sleep'
305             ) {
306 2         21 $$self{'g'}{$opt} = $val;
307 2         8 next OPT;
308              
309             } elsif ($opt eq 'tmp_script' ||
310             $opt eq 'tmp_script_keep' ||
311             $opt eq 'ssh_script' ||
312             $opt eq 'ssh_script_keep'
313             ) {
314 160         591 $$self{'g'}{$opt} = $val;
315 160         506 next OPT;
316              
317             } else {
318 1         6 $self->_err("Invalid option: $opt");
319 1         4 return 1;
320             }
321              
322 5         22 $self->_err("Invalid value: $opt [ $val ]");
323 5         19 return 1;
324             }
325              
326 227         970 return 0;
327             }
328              
329             ###############################################################################
330             # ADDING COMMANDS
331             ###############################################################################
332              
333             sub cmd {
334 489     489 1 8335 my($self,@args) = @_;
335              
336 489         1224 while (@args) {
337 490         969 my $cmd = shift(@args);
338 490         959 my $cmd_num = $$self{'cmd_num'}++;
339              
340 490 100 100     1593 if (ref($cmd) ne '' &&
341             ref($cmd) ne 'ARRAY') {
342 1         3 $$self{'err'} = "cmd must be a string or listref";
343 1         4 $self->_err($$self{'err'});
344 1         2 return 1;
345             }
346              
347 489         784 my %options;
348 489 100 100     1868 if (@args && ref($args[0]) eq 'HASH') {
349 106         226 %options = %{ shift(@args) };
  106         448  
350             }
351              
352 489         1284 foreach my $opt (keys %options) {
353 114 100       954 if ($opt !~ /^(dire|noredir|retry|sleep|check|label)$/) {
354 2         7 $$self{'err'} = "Invalid cmd option: $opt";
355 2         20 $self->_err($$self{'err'});
356 2         9 return 1;
357             }
358 112 100       389 if ($opt eq 'dire') {
359 3         19 $$self{'cmd'}{$cmd_num}{$opt} = $self->_quote($options{$opt});
360             } else {
361 109         1132 $$self{'cmd'}{$cmd_num}{$opt} = $options{$opt};
362             }
363             }
364              
365             # Check if it is a flow command. Also, make sure that flow
366             # commands are properly opened, closed, and nested.
367              
368 487         1455 my $err = $self->_cmd_flow($cmd,$cmd_num);
369 487 100       1104 return 1 if ($err);
370              
371             # If the command has alternates, update the max_alt value
372             # as necessary.
373              
374 481 100       1043 if (ref($cmd) eq 'ARRAY') {
375 10         17 my $n = $#{ $cmd } + 1;
  10         31  
376 10 100       55 if ($n > $$self{'max_alt'}) {
377 9         27 $$self{'max_alt'} = $n;
378             }
379              
380 10         79 $$self{'cmd'}{$cmd_num}{'cmd'} = $cmd;
381              
382             } else {
383 471         3282 $$self{'cmd'}{$cmd_num}{'cmd'} = [ $cmd ];
384             }
385              
386             }
387 480         1376 return 0;
388             }
389              
390             #####################
391             # Check whether a command is a flow command
392              
393             sub _cmd_flow {
394 487     487   1108 my($self,$cmd,$cmd_num) = @_;
395              
396             # A flow command may not have alternatives, so it must be a single command.
397 487 100       1119 return if (ref($cmd));
398              
399 477         677 my($flow,$type,$err);
400              
401             #
402             # Check to see if it is a flow command
403             #
404              
405 477 100 100     8487 if ($cmd =~ /^\s*(if)\s+.*?;\s*then\s*$/ ||
    100 100        
      100        
      100        
      100        
      100        
406             $cmd =~ /^\s*(elif)\s+.*?;\s*then\s*$/ ||
407             $cmd =~ /^\s*(else)\s*$/ ||
408             $cmd =~ /^\s*(fi)\s*$/) {
409 17         107 $flow = $1;
410              
411 17 100       115 if ($flow eq 'if') {
    100          
412 7         68 $err = $self->_cmd_open_flow($cmd_num,'if');
413 7         61 $$self{'cmd'}{$cmd_num}{'flow_type'} = 'open';
414             } elsif ($flow eq 'fi') {
415 3         20 $err = $self->_cmd_close_flow($cmd_num,'if','fi');
416 3         16 $$self{'cmd'}{$cmd_num}{'flow_type'} = 'close';
417             } else {
418 7         33 $err = $self->_cmd_cont_flow($cmd_num,'if',$flow);
419 7         39 $$self{'cmd'}{$cmd_num}{'flow_type'} = 'cont';
420             }
421 17         67 $$self{'cmd'}{$cmd_num}{'flow'} = 'if';
422              
423             } elsif ($cmd =~ /^\s*(while)\s+.*?;\s*do\s*$/ ||
424             $cmd =~ /^\s*(until)\s+.*?;\s*do\s*$/ ||
425             $cmd =~ /^\s*(for)\s+.*?;\s*do\s*$/ ||
426             $cmd =~ /^\s*(done)\s*$/) {
427 24         270 $flow = $1;
428              
429 24 100 100     255 if ($flow eq 'while' || $flow eq 'until' || $flow eq 'for') {
      100        
430 13         156 $err = $self->_cmd_open_flow($cmd_num,'loop [while|until|for]');
431 13         146 $$self{'cmd'}{$cmd_num}{'flow_type'} = 'open';
432             } else {
433 11         104 $err = $self->_cmd_close_flow($cmd_num,'loop [while|until|for]','done');
434 11         80 $$self{'cmd'}{$cmd_num}{'flow_type'} = 'close';
435             }
436 24         76 $$self{'cmd'}{$cmd_num}{'flow'} = 'loop';
437              
438             } else {
439 436         1198 return 0;
440             }
441              
442             #
443             # Flow commands may not have the following options:
444             # dire, noredir, retry, check
445             #
446              
447 41         116 foreach my $opt ('dire','noredir','retry','check') {
448 158 100       413 if (exists $$self{'cmd'}{$cmd_num}{$opt}) {
449 4         22 $$self{'err'} = "$opt option not allowed with flow command: $cmd_num";
450 4         15 return 1;
451             }
452             }
453              
454 37 100       98 return 1 if ($err);
455 35         108 return 0;
456             }
457              
458             sub _cmd_curr_flow {
459 91     91   226 my($self) = @_;
460 91         168 my @flow = @{ $$self{'g'}{'flow'} };
  91         330  
461 91 100       473 return '' if (! @flow);
462 22         86 return $flow[$#flow]->[0];
463             }
464             sub _cmd_open_flow {
465 20     20   108 my($self,$cmd_num,$flow) = @_;
466              
467 20         68 push(@{ $$self{'g'}{'flow'} },
  20         130  
468             [$flow,$cmd_num]);
469              
470 20         66 return 0;
471             }
472             sub _cmd_close_flow {
473 14     14   110 my($self,$cmd_num,$flow,$close) = @_;
474              
475 14         71 my $curr_flow = $self->_cmd_curr_flow();
476 14 100       58 if ($flow ne $curr_flow) {
477 1         5 $$self{'err'} = "Broken flow: '$close' found, but no '$flow': $cmd_num";
478 1         2 return 1;
479             }
480              
481 13         27 pop(@{ $$self{'g'}{'flow'} });
  13         35  
482 13         38 return 0;
483             }
484             sub _cmd_cont_flow {
485 7     7   38 my($self,$cmd_num,$flow,$cont) = @_;
486              
487 7         38 my $curr_flow = $self->_cmd_curr_flow();
488 7 100       20 if ($flow ne $curr_flow) {
489 1         4 $$self{'err'} = "Broken flow: '$cont' found, but no '$flow': $cmd_num";
490 1         3 return 1;
491             }
492 6         12 return 0;
493             }
494             sub _cmd_valid_script {
495 71     71   217 my($self) = @_;
496              
497 71 100       359 return 1 if ($$self{'err'});
498 70         346 my $curr_flow = $self->_cmd_curr_flow();
499 70 100       271 if ($curr_flow) {
500 1         5 $$self{'err'} = "Broken flow: '$curr_flow' opened, but not closed";
501 1         4 return 1;
502             }
503 69         226 return 0;
504             }
505              
506             ###############################################################################
507             # RUN THE COMMANDS
508             ###############################################################################
509              
510             sub run {
511 71     71 1 148634 my($self) = @_;
512 71 100       445 if ($self->_cmd_valid_script()) {
513 2         13 $self->_err($$self{'err'});
514 2         11 return 252;
515             }
516 69         592 $self->_script();
517              
518             #
519             # Return the script if this is a dry run.
520             #
521              
522 69         157 my $script = join("\n",@{ $$self{'scr'} });
  69         2846  
523 69 100       581 return $script if ($$self{'g'}{'mode'} eq 'dry-run');
524              
525             #
526             # If it's running in real-time, do so.
527             #
528              
529 43         130 my $tmp_script = $$self{'g'}{'tmp_script'};
530 43 100       167 if (! $tmp_script) {
531 1         5 $self->_err("tmp_script option must be set");
532 1         6 return 254;
533             }
534              
535 42         719 my $out = new IO::File;
536              
537 42 100       2867 if ($out->open("> $tmp_script")) {
538 41         20793 print $out $script;
539 41         550 $out->close();
540             } else {
541 1         95 $self->_err("tmp_script not writable");
542 1         8 return 254;
543             }
544              
545 41         2429 my $err;
546 41 100       275 if ($$self{'g'}{'mode'} eq 'run') {
547 33         2440862 system(". $tmp_script");
548 33         1791 $err = $?;
549              
550 33 100       1242 if (! $$self{'g'}{'tmp_script_keep'}) {
551 1         156 unlink($tmp_script);
552             }
553              
554 33         3664 return $err;
555             }
556              
557             #
558             # If it's running in 'script' mode, capture the output so that
559             # we can parse it.
560             #
561              
562 8         22 my($stdout,$stderr,$exit);
563              
564             # We will always keep at least one of STDOUT/STDERR because they contain the
565             # information necessary to see what commands run. In 'quiet' mode, the
566             # individual commands will discard all output, but the overall script will
567             # still use STDOUT.
568 8 100 100     101 if ($$self{'g'}{'out'} &&
    100          
569             $$self{'g'}{'err'}) {
570 5     5   631 ($stdout,$stderr,$exit) = capture { system( ". $tmp_script" ) };
  5         97460  
571             } elsif ($$self{'g'}{'err'}) {
572 1     1   117 ($stderr,$exit) = capture_stderr { system( ". $tmp_script" ) };
  1         7958  
573             } else {
574 2     2   240 ($stdout,$exit) = capture_stdout { system( ". $tmp_script" ) };
  2         16490  
575             }
576 8         10787 $exit = $exit >> 8;
577              
578 8 100       167 if (! $$self{'g'}{'tmp_script_keep'}) {
579 1         61 unlink($tmp_script);
580             }
581              
582 8 100       222 $$self{'o'}{'out'} = $self->_script_output($stdout) if ($stdout);
583 8 100       94 $$self{'o'}{'err'} = $self->_script_output($stderr) if ($stderr);
584 8         77 $$self{'o'}{'exit'} = $exit;
585              
586 8         180 return $exit;
587             }
588              
589             ###############################################################################
590             # CREATE THE SCRIPT
591             ###############################################################################
592              
593             sub _script {
594 69     69   220 my($self) = @_;
595 69         165 my(@ret);
596 69         525 $self->_script_options();
597 69         728 $self->_ind_0();
598              
599 69         177 while (1) {
600              
601             ##############################
602             # If needed, we'll generate a simple script.
603             #
604             # The simple script is used in two ways:
605             # o If a simple script is all that is needed, we'll use this
606             # to print out the list of commands that would run without
607             # all of the fancy error handling and I/O redirection.
608             # o If the 'failure' option is set to 'display', we'll build
609             # in a function to the script that will display the commands
610             # that should have run. This function will be called in
611             # the event of a failure.
612              
613 69 100       311 if ($$self{'g'}{'simple'}) {
614 6         37 $self->_script_init('simple');
615              
616 6         104 foreach my $cmd_num (1 .. $$self{'cmd_num'}-1) {
617 18         120 $self->_cmd_options($cmd_num,'simple');
618 18         103 $self->_script_cmd($cmd_num)
619             }
620              
621 6         63 $self->_script_term('simple');
622              
623 6 100       30 last if ($$self{'g'}{'simple'} eq 'simple');
624             }
625              
626             ##############################
627             # Now generate the full script
628              
629 67         458 $self->_script_init();
630              
631 67         823 foreach my $cmd_num (1 .. $$self{'cmd_num'}-1) {
632 460         1766 $self->_cmd_options($cmd_num);
633 460         1255 $self->_script_cmd($cmd_num)
634             }
635              
636 67         394 $self->_script_term();
637              
638 67         210 last;
639             }
640             }
641              
642             sub _script_init {
643 73     73   245 my($self,$simple) = @_;
644 73         182 my($text,$env,$text2);
645              
646 73 100       240 if ($simple) {
647 6         44 $$self{'c'}{'simp'} = $$self{'g'}{'simple'};
648             } else {
649 67         616 $$self{'c'}{'simp'} = '';
650             }
651              
652 73 100       324 if ($simple) {
653              
654 6         43 $text = <<'EOT';
655             : simple () {
656             : echo ""
657             : echo "#****************************************"
658             : if [ $SC_FAILED -eq 201 ]; then
659             : echo "# The following script failed after command 200"
660             : elif [ $SC_FAILED -gt 201 ]; then
661             : echo "# The following script failed during initialization"
662             : else
663             : echo "# The following script failed at command $SC_FAILED"
664             : fi
665             : while read line ;do
666             : echo "$line"
667             : done << SC_SIMPLE_EOS
668             : SC_ORIG_DIRE=`pwd`;
669             EOT
670              
671             } else {
672 67         419 $text = <<'EOT';
673             : SC_FAILED=0;
674             : echo "# SC_ORIG_DIRE=`pwd`";
675             : SC_ORIG_DIRE=`pwd`;
676             :
677             : main () {
678             EOT
679             }
680              
681 73         201 $env = <<'EOT';
682             : echo '# export =""';
683             : export ="";
684             EOT
685              
686 73         205 $text2 = <<'EOT';
687             : echo '# SC_DIRE=""';
688             : SC_DIRE="";
689             : echo '# cd "$SC_DIRE"';
690             : cd "$SC_DIRE";
691             : cd "$SC_DIRE" 2>/dev/null;
692             : if [ $? -ne 0 ]; then
693             : SC_FAILED=255;
694             : return;
695             : fi
696             : echo "# SC_DIRE=$SC_ORIG_DIRE";
697             : SC_DIRE=$SC_ORIG_DIRE;
698             EOT
699              
700 73         574 $self->_text_to_script($text);
701 73 100       575 $self->_ind_plus() if (! $simple);
702              
703 73         204 my(@tmp) = @{ $$self{'e'} };
  73         296  
704 73         328 while (@tmp) {
705 32         64 my $var = shift(@tmp);
706 32         64 my $val = shift(@tmp);
707 32         63 my $str = $env;
708 32         187 $str =~ s//$var/g;
709 32         186 $str =~ s//$val/g;
710 32         101 $self->_text_to_script($str);
711             }
712              
713 73         348 $self->_text_to_script($text2);
714             }
715              
716             sub _script_term {
717 73     73   300 my($self,$simple) = @_;
718 73         175 my($text);
719              
720 73 100       319 if ($simple) {
721 6         45 $$self{'c'}{'simp'} = $$self{'g'}{'simple'};
722 6         45 $text = <<'EOT';
723             : cd "$SC_ORIG_DIRE";
724             : SC_SIMPLE_EOS
725             : }
726             :
727             EOT
728              
729             } else {
730 67         260 $self->_ind_minus();
731 67         571 $text = <<'EOT';
732             : }
733             :
734             : main;
735             : cd "$SC_ORIG_DIRE";
736             : if [ $SC_FAILED -ne 0 ]; then
737             : simple;
738             : fi
739             : echo '# cd "$SC_ORIG_DIRE"';
740             : exit $SC_FAILED;
741             :
742             EOT
743             }
744              
745 73         426 $self->_text_to_script($text);
746             }
747              
748             #####################
749             # This analyzes the options and sets some variables to determine
750             # how the script behaves.
751             #
752             sub _script_options {
753 69     69   208 my($self) = @_;
754              
755             #
756             # Calculate the type of script that we're creating.
757             #
758             # In dry-run mode, we may produce any of the script types:
759             # simple, run, script
760             #
761             # In run/script mode, we will produce that type of script.
762             # We'll also produce a simple script for failure in 'run'
763             # mode if 'failure' is 'display'.
764             #
765              
766 69 100       365 if ($$self{'g'}{'mode'} eq 'dry-run') {
767 26 100       184 $$self{'g'}{'s_type'} = ($$self{'g'}{'script'} ? $$self{'g'}{'script'} : 'run');
768 26 100 100     286 if ($$self{'g'}{'script'} eq 'simple') {
    100          
769 2         5 $$self{'g'}{'simple'} = 'simple';
770             } elsif ($$self{'g'}{'s_type'} eq 'run' &&
771             $$self{'g'}{'failure'} eq 'display') {
772 2         7 $$self{'g'}{'simple'} = 'failure';
773             } else {
774 22         71 $$self{'g'}{'simple'} = '';
775             }
776             } else {
777 43         183 $$self{'g'}{'s_type'} = $$self{'g'}{'mode'};
778 43 100 100     549 if ($$self{'g'}{'s_type'} eq 'run' &&
779             $$self{'g'}{'failure'} eq 'display') {
780 2         8 $$self{'g'}{'simple'} = 'failure';
781             } else {
782 41         165 $$self{'g'}{'simple'} = '';
783             }
784             }
785              
786             #
787             # Echoing commands applies to run mode. In both dry-run and
788             # script mode, it doesn't apply.
789             #
790              
791 69 100       337 if ($$self{'g'}{'mode'} eq 'run') {
792 35         132 $$self{'g'}{'c_echo'} = $$self{'g'}{'echo'};
793             } else {
794 34         112 $$self{'g'}{'c_echo'} = '';
795             }
796              
797             #
798             # When a command fails, we normally handle it using the 'failure'
799             # option. In a simple script, we don't do failure handling.
800             #
801              
802 69 100       263 if ($$self{'g'}{'s_type'} eq 'simple') {
803 2         5 $$self{'g'}{'c_fail'} = '';
804             } else {
805 67         207 $$self{'g'}{'c_fail'} = $$self{'g'}{'failure'};
806             }
807              
808             #
809             # Analyze the 'output' option to determine whether we are capturing
810             # STDOUT and/or STDERR. Set the 'redir' flag to the appropriate
811             # string for performing this capture.
812             #
813             # 'simple' scripts do no redirection.
814             #
815             #
816             # If we ever want:
817             # STDOUT -> /dev/null, STDERR -> STDOUT:
818             # use:
819             # $$self{'c'}{'g_redir'} = '2>&1 >/dev/null';
820              
821 69 100 100     548 if ($$self{'g'}{'s_type'} eq 'run' ||
822             $$self{'g'}{'s_type'} eq 'script') {
823              
824 67 100       359 if ($$self{'g'}{'output'} eq 'both') {
    100          
    100          
    100          
825             # Capturing both so no redirection
826 59         365 $$self{'g'}{'redir'} = '';
827 59         184 $$self{'g'}{'out'} = 1;
828 59         146 $$self{'g'}{'err'} = 1;
829 59         544 $$self{'g'}{'quiet'} = 0;
830              
831             } elsif ($$self{'g'}{'output'} eq 'merged') {
832             # Merged output
833 1         3 $$self{'g'}{'redir'} = '2>&1';
834 1         3 $$self{'g'}{'out'} = 1;
835 1         2 $$self{'g'}{'err'} = 0;
836 1         10 $$self{'g'}{'quiet'} = 0;
837              
838             } elsif ($$self{'g'}{'output'} eq 'stdout') {
839             # Keep STDOUT, discard STDERR
840 2         8 $$self{'g'}{'redir'} = '2>/dev/null';
841 2         7 $$self{'g'}{'out'} = 1;
842 2         3 $$self{'g'}{'err'} = 0;
843 2         17 $$self{'g'}{'quiet'} = 0;
844              
845             } elsif ($$self{'g'}{'output'} eq 'stderr') {
846             # Discard STDOUT, keep STDERR
847 2         10 $$self{'g'}{'redir'} = '>/dev/null';
848 2         6 $$self{'g'}{'out'} = 0;
849 2         4 $$self{'g'}{'err'} = 1;
850 2         16 $$self{'g'}{'quiet'} = 0;
851              
852             } else {
853             # Discard everthing
854 3         17 $$self{'g'}{'redir'} = '>/dev/null 2>&1';
855 3         18 $$self{'g'}{'out'} = 0;
856 3         8 $$self{'g'}{'err'} = 0;
857 3         25 $$self{'g'}{'quiet'} = 1;
858             }
859              
860             } else {
861             # s_type = simple
862              
863 2         15 $$self{'g'}{'redir'} = '';
864 2         5 $$self{'g'}{'out'} = 1;
865 2         7 $$self{'g'}{'err'} = 1;
866              
867             }
868             }
869              
870             ###############################################################################
871             # ADD A COMMAND TO THE SCRIPT
872             ###############################################################################
873              
874             sub _script_cmd {
875 478     478   932 my($self,$cmd_num) = @_;
876              
877 478 100       1145 if ($$self{'cmd'}{$cmd_num}{'flow'}) {
878 30         95 $self->_script_cmd_flow($cmd_num);
879             } else {
880 448         1262 $self->_script_cmd_nonflow($cmd_num);
881             }
882             }
883              
884             sub _script_cmd_flow {
885 30     30   67 my($self,$cmd_num) = @_;
886              
887 30         71 my $type = $$self{'cmd'}{$cmd_num}{'flow_type'};
888              
889 30 100       141 if ($type eq 'open') {
    100          
890 13         83 $self->_script_cmd_cmd();
891 13         48 $self->_ind_plus();
892             } elsif ($type eq 'cont') {
893 4         10 $self->_ind_minus();
894 4         10 $self->_script_cmd_cmd();
895 4         11 $self->_ind_plus();
896             } else {
897 13         49 $self->_ind_minus();
898 13         38 $self->_script_cmd_cmd();
899             }
900             }
901              
902             sub _script_cmd_nonflow {
903 448     448   862 my($self,$cmd_num) = @_;
904              
905 448         1294 $self->_script_cmd_init($cmd_num);
906 448         716 my $n = @{ $$self{'cmd'}{$cmd_num}{'cmd'} };
  448         1053  
907              
908 448 100       1031 if ($n > 1) {
909             # Command with alternates
910              
911 9         55 for (my $a=1; $a<= $n; $a++) {
912 24         79 $self->_alt_options($cmd_num,$a);
913 24         49 $self->_script_cmd_cmd();
914             }
915              
916             } else {
917             # Single command
918              
919 439         1245 $self->_script_cmd_cmd();
920             }
921              
922 448         1400 $self->_script_cmd_term($cmd_num);
923             }
924              
925             sub _script_cmd_init {
926 448     448   853 my($self,$cmd_num) = @_;
927              
928 448         843 my $text = <<'EOT';
929             : #
930             :
931             : #
932             : # Command
933             : #
934             :
935             : SC_CURR_EXIT=0;
936             : SC_CURR_SUCC=0;
937             :
938             : echo '# SC_DIRE_=`pwd`';
939             : echo '# cd ""';
940             : SC_DIRE_=`pwd`;
941             : cd "";
942             : cd "" 2>/dev/null;
943             : if [ $? -eq 0 ]; then
944             EOT
945              
946 448         1139 $self->_text_to_script($text);
947              
948 448         1024 $text = <<'EOT';
949             :
950             : SC_RETRIES=;
951             : SC_TRY=0;
952             : while [ $SC_TRY -lt $SC_RETRIES ]; do
953             EOT
954              
955 448         1118 $self->_text_to_script($text);
956 448 100 100     1819 $self->_ind_plus() if ($$self{'c'}{'c_retries'} && ! $$self{'c'}{'simp'});
957             }
958              
959             sub _script_cmd_term {
960 448     448   979 my($self,$cmd_num) = @_;
961              
962 448         1060 my $text = <<'EOT';
963             :
964             : if [ $SC_CURR_EXIT -eq 0 ]; then
965             : break;
966             : fi
967             : SC_TRY=`expr $SC_TRY + 1`;
968             : if [ $SC_TRY -lt $SC_RETRIES ]; then
969             : sleep ;
970             : fi
971             : done
972             EOT
973              
974 448         1562 $self->_text_to_script($text);
975              
976 448         1061 $text = <<'EOT';
977             :
978             : echo '# cd "$SC_DIRE_"';
979             : cd "$SC_DIRE_";
980             : else
981             : SC_CURR_EXIT=;
982             : fi
983             EOT
984              
985 448         1211 $self->_text_to_script($text);
986              
987 448         714 $text = <<'EOT';
988             :
989             : if [ $SC_FAILED -eq 0 -a $SC_CURR_EXIT -ne 0 ]; then
990             : SC_FAILED=;
991             : fi
992             :
993             : if [ $SC_FAILED -ne 0 ]; then
994             : return;
995             : fi
996             EOT
997              
998 448         937 $self->_text_to_script($text);
999             }
1000              
1001             sub _script_cmd_cmd {
1002 493     493   897 my($self) = @_;
1003 493         730 my($text);
1004              
1005             # Print out any header and echo the command as appropriate
1006              
1007 493 100       1356 if (! $$self{'c'}{'simp'}) {
1008 475 100       1165 if (! $$self{'c'}{'c_flow'}) {
1009 445         1029 $text = <<'EOT';
1010             :
1011             : #
1012             : # Command
1013             : #
1014             :
1015             : if [ $SC_CURR_SUCC -eq 0 ]; then
1016             : echo "#SC CMD .";
1017             : echo "#SC CMD ." >&2;
1018             : echo "#SC CMD .";
1019             : echo "#SC TRY $SC_TRY";
1020             : echo "#SC TRY $SC_TRY" >&2;
1021             : fi
1022             :
1023             : echo "# ";
1024             : echo "# Check with: ";
1025             : echo "# ALT: ";
1026             : echo "# ";
1027             : echo "# Check with: ";
1028             EOT
1029              
1030 445         1050 $self->_text_to_script($text);
1031             }
1032             }
1033              
1034             # We want to generate essentially the following script:
1035             #
1036             # CMD1
1037             # if [ "$?" != 0 ]; then
1038             # CMD2
1039             # fi
1040             # ...
1041             # if [ "$?" != 0 ]; then
1042             # CMDn
1043             # fi
1044             # if [ "$?" != 0 ]; then
1045             # exit X
1046             # fi
1047             #
1048             # where CMDn is the last alternate and X is the command number.
1049             #
1050             # If we have a 'check' option, we'll need to run that
1051             # command immediately after every CMDi.
1052             #
1053             # if command succeeded
1054             # SC_CURR_SUCC = 1 -> this will mean that no more alternates run
1055             # SC_CURR_EXIT = 0
1056             # else if this is the first alternate to fail
1057             # SC_CURR_EXIT = $? -> we'll use the first exit code if all alt. fail
1058             #
1059             # For script mode, make sure that both STDOUT and STDIN have a newline.
1060              
1061              
1062 493 100       1537 if ($$self{'c'}{'c_flow'}) {
    100          
1063 30         82 $text = <<'EOT';
1064             :
1065             :
1066             EOT
1067              
1068             } elsif ($$self{'c'}{'simp'}) {
1069 18         85 $text = <<'EOT';
1070             : ;
1071             EOT
1072              
1073             } else {
1074 445         803 $text = <<'EOT';
1075             :
1076             : if [ $SC_CURR_SUCC -eq 0 ]; then
1077             : ;
1078             : # CHECK WITH
1079             : ;
1080             : CMD_EXIT=$?;
1081             : echo "";
1082             : echo "" >&2;
1083             : if [ $CMD_EXIT -eq 0 ]; then
1084             : SC_CURR_SUCC=1;
1085             : SC_CURR_EXIT=0;
1086             : elif [ $SC_CURR_EXIT -eq 0 ]; then
1087             : SC_CURR_EXIT=$CMD_EXIT;
1088             : fi
1089             : if [ $CMD_EXIT -ne 0 ]; then
1090             : echo "#SC EXIT . $CMD_EXIT";
1091             : echo "#SC EXIT . $CMD_EXIT" >&2;
1092             : echo "#SC EXIT . $CMD_EXIT";
1093             : fi
1094             : fi
1095             EOT
1096             }
1097              
1098 493         1096 $self->_text_to_script($text);
1099             }
1100              
1101             ###################
1102              
1103             # Set cmd_str and cmd_pref for the current command.
1104             #
1105             sub _alt_options {
1106 24     24   55 my($self,$cmd_num,$alt_num) = @_;
1107 24         53 my $label = $$self{'c'}{'c_label'};
1108              
1109             #
1110             # Only called with a command with alternates.
1111             #
1112              
1113 24         66 $$self{'c'}{'cmd_str'} = $$self{'cmd'}{$cmd_num}{'cmd'}[$alt_num-1];
1114 24         78 $$self{'c'}{'cmd_str_q'} = $self->_quote($$self{'c'}{'cmd_str'});
1115 24 100       140 $$self{'c'}{'cmd_label'} = "$cmd_num" . ($label ? " [$label]" : '');
1116 24         86 $$self{'c'}{'alt_label'} = "$cmd_num.$alt_num";
1117 24         42 $$self{'c'}{'alts'} = 1;
1118 24         50 $$self{'c'}{'a_num'} = $alt_num;
1119             }
1120              
1121             sub _cmd_options {
1122 478     478   1128 my($self,$cmd_num,$simple) = @_;
1123              
1124 478         1089 $$self{'c'}{'c_num'} = $cmd_num;
1125 478 100       1314 $$self{'c'}{'f_num'} = ($cmd_num > 200 ? 201 : $cmd_num);
1126 478         1709 $$self{'c'}{'c_label'} = $$self{'cmd'}{$cmd_num}{'label'};
1127              
1128             $$self{'c'}{'c_retries'} = ($$self{'cmd'}{$cmd_num}{'retry'}
1129 478 100       1645 ? $$self{'cmd'}{$cmd_num}{'retry'}+0
1130             : 0);
1131             $$self{'c'}{'c_sleep'} = ($$self{'cmd'}{$cmd_num}{'sleep'}
1132 478 100       1344 ? $$self{'cmd'}{$cmd_num}{'sleep'}+0
1133             : 0);
1134             $$self{'c'}{'c_redir'} = (($$self{'cmd'}{$cmd_num}{'noredir'} ||
1135             $simple ||
1136             ! $$self{'g'}{'redir'})
1137             ? ''
1138 478 100 100     3771 : ' ' . $$self{'g'}{'redir'} );
1139             $$self{'c'}{'c_check'} = ($$self{'cmd'}{$cmd_num}{'check'}
1140 478 100       1451 ? $$self{'cmd'}{$cmd_num}{'check'}
1141             : '');
1142 478         1384 $$self{'c'}{'c_check_q'} = $self->_quote($$self{'c'}{'c_check'});
1143             $$self{'c'}{'c_dir'} = ($$self{'cmd'}{$cmd_num}{'dire'}
1144 478 100       1305 ? $self->_quote($$self{'cmd'}{$cmd_num}{'dire'})
1145             : '');
1146              
1147 478 100       1265 $$self{'c'}{'c_retries'} = 0 if ($$self{'c'}{'c_retries'} == 1);
1148              
1149 478         1040 $$self{'c'}{'ind'} = $$self{'g'}{'curr_ind'};
1150 478 100       1067 $$self{'c'}{'simp'} = $$self{'g'}{'simple'} if ($simple);
1151              
1152 478 100       1403 $$self{'c'}{'c_flow'} = ($$self{'cmd'}{$cmd_num}{'flow'} ? 1 : 0);
1153              
1154             # Handle the cases of a command with no alternates and init stuff
1155              
1156 478         722 my $n = @{ $$self{'cmd'}{$cmd_num}{'cmd'} };
  478         982  
1157              
1158 478 100       1271 if ($n == 1) {
1159             #
1160             # A command with no alternates.
1161             #
1162              
1163 469         855 my $label = $$self{'c'}{'c_label'};
1164 469         1076 $$self{'c'}{'cmd_str'} = $$self{'cmd'}{$cmd_num}{'cmd'}[0];
1165 469         1073 $$self{'c'}{'cmd_str_q'} = $self->_quote($$self{'c'}{'cmd_str'});
1166 469 100       1706 $$self{'c'}{'cmd_label'} = $cmd_num . ($label ? " [$label]" : '');
1167 469         1224 $$self{'c'}{'alt_label'} = "$cmd_num.0";
1168 469         829 $$self{'c'}{'alts'} = 0;
1169 469         1059 $$self{'c'}{'a_num'} = 0;
1170             }
1171             }
1172              
1173             ###############################################################################
1174              
1175             # Text to script
1176              
1177             sub _text_to_script {
1178 3429     3429   5764 my($self,$text) = @_;
1179 3429         4648 my @script;
1180              
1181             # Text is a combination of:
1182             # : CMD
1183             # : CMD
1184             # : CMD
1185             # : CMD
1186             # : CMD
1187             #
1188             # means to include this line only if the given TAG has a value
1189             # of 'VAL'. The TAG can be either of:
1190             # $$self{'c'}{TAG}
1191             # $$self{'g'}{TAG}
1192             # means to include this line only if the given TAG does NOT
1193             # have a value of 'VAL'
1194             # means to include this line only if the TAG has a true value
1195             # means to include this line only if the TAG has a false value
1196             # CMD can include indentation relative to the current text
1197             # CMD can include and it will be replaced by the
1198             # value of TAG
1199             #
1200             # Every line must contain a colon, and the colon defines the start of
1201             # the actual line (so spacing to the right of the colon is used to
1202             # determine indentation).
1203              
1204 3429         16504 my @lines = split(/\n/,$text);
1205 3429         5049 my $line_ind = '';
1206              
1207             LINE:
1208 3429         5644 foreach my $line (@lines) {
1209 37784         145607 $line =~ /(.*?)\s*:(\s*)(.*)$/;
1210 37784         98108 my($tags,$ind,$cmd) = ($1,$2,$3);
1211              
1212 37784         126981 while ($tags =~ s,^<(!?)(.*?)>,,) {
1213 38257         86885 my ($not,$tagstr) = ($1,$2);
1214 38257 100       80023 if ($tagstr =~ /^(.*?)=(.*)$/) {
1215 12064         25299 my($tag,$req) = ($1,$2);
1216 12064 100       21121 if ($self->_tagval($tag) eq $req) {
1217 731 100       2633 next LINE if ($not);
1218             } else {
1219 11333 100       27345 next LINE if (! $not);
1220             }
1221              
1222             } else {
1223 26193         33316 my $tag = $tagstr;
1224 26193 100       40628 if ($self->_tagval($tag)) {
1225 1168 100       3242 next LINE if ($not);
1226             } else {
1227 25025 100       72813 next LINE if (! $not);
1228             }
1229             }
1230             }
1231              
1232 14691         29658 while ($cmd =~ /<\?(.*?)\?>/) {
1233 2582         5121 my $tag = $1;
1234 2582         4516 my $val = $self->_tagval($tag);
1235 2582         40764 $cmd =~ s/<\?$tag\?>/$val/g;
1236             }
1237              
1238 14691 100       24364 if (! $cmd) {
1239 2903         4986 push(@script,'');
1240 2903         4927 next;
1241             }
1242              
1243 11788         15728 my $len = length($ind);
1244 11788 100       20138 $line_ind = $len if ($line_ind eq '');
1245              
1246 11788 100       22908 if ($len > $line_ind) {
    100          
1247 2308         5226 $self->_ind_plus();
1248 2308         3213 $line_ind = $len;
1249             } elsif ($len < $line_ind) {
1250 2326         4946 $self->_ind_minus();
1251 2326         3113 $line_ind = $len;
1252             }
1253 11788         17474 my $spc = $$self{'g'}{'curr_ind'};
1254 11788         30335 push(@script,"${spc}$cmd");
1255             }
1256              
1257 3429         4584 push @{ $$self{'scr'} },@script;
  3429         16055  
1258             }
1259              
1260             sub _tagval {
1261 40839     40839   59253 my($self,$tag) = @_;
1262              
1263 40839         46462 my $val;
1264 40839 100       78029 if (exists $$self{'c'}{$tag}) {
    100          
1265 22364         31158 $val = $$self{'c'}{$tag};
1266             } elsif (exists $$self{'g'}{$tag}) {
1267 12651         18028 $val = $$self{'g'}{$tag};
1268             }
1269              
1270 40839 100       66831 $val = '' if (! defined($val));
1271 40839         78545 return $val;
1272             }
1273              
1274             #####################
1275             # Script indentation
1276              
1277             sub _ind {
1278 4889     4889   6701 my($self) = @_;
1279             $$self{'g'}{'curr_ind'} =
1280 4889         10678 " "x($$self{'g'}{'ind_per_lev'} * $$self{'g'}{'ind_cur_lev'});
1281             $$self{'g'}{'next_ind'} =
1282 4889         9074 " "x($$self{'g'}{'ind_per_lev'} * ($$self{'g'}{'ind_cur_lev'} + 1));
1283             $$self{'g'}{'prev_ind'} =
1284             " "x($$self{'g'}{'ind_cur_lev'} == 0
1285             ? 0
1286 4889 100       12501 : $$self{'g'}{'ind_per_lev'} * ($$self{'g'}{'ind_cur_lev'} - 1));
1287             }
1288              
1289             sub _ind_0 {
1290 69     69   248 my($self) = @_;
1291 69         240 $$self{'g'}{'ind_cur_lev'} = 0;
1292 69         460 $self->_ind();
1293             }
1294              
1295             sub _ind_plus {
1296 2410     2410   3787 my($self) = @_;
1297 2410         3503 $$self{'g'}{'ind_cur_lev'}++;
1298 2410         4024 $self->_ind();
1299             }
1300             sub _ind_minus {
1301 2410     2410   3452 my($self) = @_;
1302 2410         3496 $$self{'g'}{'ind_cur_lev'}--;
1303 2410         3844 $self->_ind();
1304             }
1305              
1306             ###############################################################################
1307              
1308             sub _err {
1309 13     13   38 my($self,$text) = @_;
1310              
1311             # uncoverable branch false
1312 13 100       43 if ($ENV{'SHELL_CMD_TESTING'}) {
1313 8         15 return;
1314             }
1315              
1316 5         132 print STDERR "# ERROR: ${text}\n";
1317 5         19 return;
1318             }
1319              
1320             # This prepares a string to be enclosed in double quotes.
1321             #
1322             # Escape: \ $ ` "
1323             #
1324             sub _quote {
1325 1029     1029   1881 my($self,$string) = @_;
1326              
1327 1029         2398 $string =~ s/([\\\$`"])/\\$1/g;
1328 1029         2274 return $string;
1329             }
1330              
1331             ###############################################################################
1332             # The stdout/stderr from a script-mode run are each of the form:
1333             # #SC CMD N1.A1
1334             # ...
1335             # #SC CMD N2.A2
1336             # ...
1337             # where N* are the command number and A* are the alternate number.
1338             #
1339             # Retries are noted with:
1340             # #SC TRY T
1341             #
1342             # If the script fails, for the failing command, it includes:
1343             # #SC EXIT N1.A1 EXIT_VALUE
1344             #
1345             # STDOUT and STDERR are guaranteed to be identical in form (provided both
1346             # are kept).
1347             #
1348             sub _script_output {
1349 13     13   113 my($self,$out) = @_;
1350 13         155 my @out = split(/\n/,$out);
1351              
1352             #
1353             # Parse stdout and turn it into:
1354             #
1355             # ( [ CMD_NUM_1, ALT_NUM_1, TRY_1, EXIT_1, STDOUT_1 ],
1356             # [ CMD_NUM_2, ALT_NUM_2, TRY_2, EXIT_2, STDOUT_2 ], ... )
1357             #
1358              
1359 13         78 my @cmd_raw;
1360              
1361             PARSE_LOOP:
1362 13         87 while (@out) {
1363              
1364             #
1365             # Get STDOUT (or STDERR) for the one command.
1366             #
1367              
1368 50         181 my($cmd_num,$alt_num,$cmd_exit,$cmd_try,$tmp);
1369 50         0 my($out_hdr,@output);
1370 50         112 $cmd_exit = 0;
1371 50         96 $cmd_try = 0;
1372              
1373 50         124 $out_hdr = shift(@out);
1374              
1375             # The output MUST start with a header:
1376             # #SC CMD X.Y
1377             #
1378             # uncoverable branch true
1379 50 50       396 if ($out_hdr !~ /^\#SC CMD (\d+)\.(\d+)$/) {
1380             # Invalid output... should never happen
1381             # uncoverable statement
1382 0         0 $self->_err("Missing command header in STDOUT: $out_hdr");
1383             # uncoverable statement
1384 0         0 return ();
1385             }
1386              
1387 50         275 ($cmd_num,$alt_num) = ($1,$2);
1388              
1389 50   100     326 while (@out && $out[0] !~ /^\#SC CMD (\d+)\.(\d+)$/) {
1390 114 100       1121 if ($out[0] =~ /^\#SC TRY (\d+)$/) {
    100          
1391 20         52 $cmd_try = $1;
1392 20         64 shift(@out);
1393              
1394             } elsif ($out[0] =~ /^\#SC EXIT $cmd_num\.$alt_num (\d+)$/) {
1395 20         48 $cmd_exit = $1;
1396 20         99 shift(@out);
1397              
1398             } else {
1399 74         410 push(@output,shift(@out));
1400             }
1401             }
1402              
1403 50 100 100     291 pop(@output) if (! defined($output[$#output]) || $output[$#output] eq '');
1404 50         362 push (@cmd_raw, [ $cmd_num,$alt_num,$cmd_try,$cmd_exit,\@output ]);
1405             }
1406              
1407             #
1408             # Now go through this list and group all alternates together and determine
1409             # the status for each command.
1410             #
1411             # This will now look like:
1412             # ( CMD_1 CMD_2 ... )
1413             # where
1414             # CMD_i = [ CMD_NUM EXIT TRY_1 TRY_2 ... ]
1415             # CMD_NUM is the command number being executed
1416             # EXIT is the exit code produced by this command
1417             # TRY_i is the i'th retry (there will only be one if
1418             # the command does not have retries
1419             #
1420             # TRY_i = [ ALT_1 ALT_2 ... ]
1421             # ALT_i = [ LINE1 LINE2 ... ] the output
1422             #
1423             # The exit code is the one produced by the very first alternate in the first
1424             # try.
1425             #
1426             # When looking at a command (I), we have to take into account the following
1427             # command (J = I+1).
1428             #
1429             # I J
1430             # CMD ALT TRY CMD ALT TRY
1431             #
1432             # * * * * 0/1 0 The next command is from a totally new
1433             # command, so the current command concludes
1434             # a retry and a command.
1435             #
1436             # C A T C A+1 T The next command is another alternate.
1437             # Add it to the current retry.
1438             #
1439             # C A T C 0/1 T+1 The next command starts another retry,
1440             # so the current command concludes a
1441             # retry, but NOT a command.
1442             #
1443             # Everthing else is an error
1444             #
1445              
1446 13         42 my @cmds = (); # @cmds = ( CMD_1 CMD_2 ... )
1447 13         42 my @cmd = (); # @cmd = ( TRY_1 TRY_2 ... )
1448 13         47 my @try = (); # @try = ( ALT_1 ALT_2 ... )
1449 13         37 my $alt; # $alt = [ LINE_1 LINE_2 ... ]
1450 13         35 my $cmd_curr = 0;
1451 13         34 my $alt_curr = 0;
1452 13         38 my $try_curr = 0;
1453 13         28 my $cmd_next = 0;
1454 13         40 my $alt_next = 0;
1455 13         27 my $try_next = 0;
1456 13         25 my $exit_curr = 0;
1457 13         48 my $exit_next = 0;
1458 13         51 my $i = 0;
1459              
1460 13         37 ($cmd_curr,$alt_curr,$try_curr,$exit_curr,$alt) = @{ shift(@cmd_raw) };
  13         50  
1461 13         52 push(@try,$alt);
1462              
1463             COMMAND_LOOP:
1464 13         75 while (@cmd_raw) {
1465 37         74 $i++;
1466              
1467 37         58 ($cmd_next,$alt_next,$try_next,$exit_next,$alt) = @{ shift(@cmd_raw) };
  37         91  
1468              
1469             VALID_CONDITIONS: {
1470              
1471             ## ALT_NEXT = 0/1 and
1472             ## TRY_NEXT = 0
1473             ## next command
1474             ##
1475             ## All valid CMD_NEXT != CMD_CURR entries will be covered here.
1476              
1477 37 100 100     79 if ($alt_next <= 1 &&
  37         222  
1478             $try_next == 0) {
1479              
1480 21         71 push(@cmd,[@try]);
1481 21         68 push(@cmds,[$cmd_curr,$exit_curr,@cmd]);
1482 21         49 @cmd = ();
1483 21         45 @try = ($alt);
1484 21         35 $cmd_curr = $cmd_next;
1485 21         33 $alt_curr = $alt_next;
1486 21         37 $try_curr = $try_next;
1487 21         41 $exit_curr= $exit_next;
1488 21         120 next COMMAND_LOOP;
1489             }
1490              
1491             # uncoverable branch true
1492 16 50       37 if ($cmd_next != $cmd_curr) {
1493             # uncoverable statement
1494 0         0 last VALID_CONDITIONS;
1495             }
1496              
1497             ## ALT_NEXT = ALT_CURR+1
1498             ## next alternate
1499             ##
1500             ## All valid entries will have TRY_NEXT = TRY_CURR
1501              
1502 16 100       43 if ($alt_next == $alt_curr+1) {
1503              
1504             # uncoverable branch true
1505 8 50       18 if ($try_next != $try_curr) {
1506             # uncoverable statement
1507 0         0 last VALID_CONDITIONS;
1508             }
1509              
1510 8         13 push(@try,$alt);
1511 8         12 $alt_curr = $alt_next;
1512 8         10 $exit_curr= $exit_next;
1513 8         14 next COMMAND_LOOP;
1514             }
1515              
1516             ## ALT_NEXT = 0/1 and
1517             ## TRY_NEXT = TRY_CURR+1
1518             ## next try
1519             ##
1520             ## Everything left must have both of these conditions.
1521              
1522             # uncoverable branch true
1523 8 50       15 if ($alt_next > 1) {
1524             # uncoverable statement
1525 0         0 last VALID_CONDITIONS;
1526             }
1527              
1528             # uncoverable branch true
1529 8 50       19 if ($try_next != $try_curr+1) {
1530             # uncoverable statement
1531 0         0 last VALID_CONDITIONS;
1532             }
1533              
1534 8         26 push(@cmd,[@try]);
1535 8         19 @try = ($alt);
1536 8         12 $alt_curr = $alt_next;
1537 8         12 $try_curr = $try_next;
1538 8         11 $exit_curr= $exit_next;
1539 8         17 next COMMAND_LOOP;
1540             }
1541              
1542             #
1543             # Everything else is an error in the output (should never happen)
1544             #
1545              
1546             # uncoverable statement
1547 0         0 $self->_err("Unexpected error in output: $i " .
1548             "[$cmd_curr,$alt_curr,$try_curr] " .
1549             "[$cmd_next,$alt_next,$try_next]");
1550             # uncoverable statement
1551 0         0 return ();
1552             }
1553              
1554             #
1555             # Add on the last command is stored.
1556             #
1557              
1558 13         49 push(@cmd,[@try]);
1559 13         46 push(@cmds,[$cmd_curr,$exit_curr,@cmd]);
1560              
1561 13         167 return [@cmds];
1562             }
1563              
1564             ###############################################################################
1565              
1566             sub ssh {
1567 0     0 1 0 my($self,@hosts) = @_;
1568              
1569 0 0       0 if (! @hosts) {
1570 0         0 $self->_err("A host or hosts must be supplied with the ssh method");
1571 0         0 return;
1572             }
1573              
1574 0 0       0 if ($self->_cmd_valid_script()) {
1575 0         0 $self->_err("script flow commands not closed correctly");
1576 0         0 return;
1577             }
1578 0         0 $self->_script();
1579              
1580             #
1581             # Return the script if this is a dry run.
1582             #
1583              
1584 0         0 my $script = join("\n",@{ $$self{'scr'} });
  0         0  
1585 0 0       0 return $script if ($$self{'g'}{'mode'} eq 'dry-run');
1586              
1587             #
1588             # Create the temporary script
1589             #
1590              
1591 0         0 my $tmp_script = $$self{'g'}{'tmp_script'};
1592 0 0       0 if (! $tmp_script) {
1593 0         0 $self->_err("tmp_script option must be set");
1594 0         0 return 254;
1595             }
1596              
1597 0         0 my $out = new IO::File;
1598              
1599 0 0       0 if ($out->open("> $tmp_script")) {
1600 0         0 print $out $script;
1601 0         0 $out->close();
1602             } else {
1603 0         0 $self->_err("tmp_script not writable");
1604 0         0 return 254;
1605             }
1606              
1607             #
1608             # Run the script
1609             #
1610              
1611 0         0 my %ret;
1612 0 0       0 if ($$self{'g'}{'ssh_num'} == 1) {
1613 0         0 %ret = $self->_ssh_serial(@hosts);
1614             } else {
1615 0         0 %ret = $self->_ssh_parallel(@hosts);
1616             }
1617              
1618 0 0       0 if (! $$self{'g'}{'tmp_script_keep'}) {
1619 0         0 unlink($tmp_script);
1620             }
1621              
1622 0         0 return %ret;
1623             }
1624              
1625             sub _ssh_serial {
1626 0     0   0 my($self,@hosts) = @_;
1627 0         0 my %ret;
1628              
1629 0         0 foreach my $host (@hosts) {
1630 0         0 $ret{$host} = $self->_ssh($host);
1631             }
1632              
1633 0         0 return %ret;
1634             }
1635              
1636             sub _ssh_parallel {
1637 0     0   0 my($self,@hosts) = @_;
1638 0         0 my %ret;
1639              
1640 0 0       0 my $max_proc = ($$self{'g'}{'ssh_num'} ? $$self{'g'}{'ssh_num'} : @hosts);
1641 0         0 my $manager = Parallel::ForkManager->new($max_proc);
1642              
1643             $manager->run_on_finish
1644             (
1645             sub {
1646 0     0   0 my($pid,$exit_code,$id,$signal,$core_dump,$data) = @_;
1647 0         0 my($host,$exit,$stdout,$stderr) = @$data;
1648 0         0 $ret{$host} = $exit;
1649 0 0       0 $$self{'s'}{$host}{'out'} = $self->_script_output($stdout)
1650             if (defined $stdout);
1651 0 0       0 $$self{'s'}{$host}{'err'} = $self->_script_output($stderr)
1652             if (defined $stderr);
1653 0         0 $$self{'s'}{$host}{'exit'} = $exit;
1654             }
1655 0         0 );
1656              
1657 0         0 foreach my $host (@hosts) {
1658 0 0       0 $manager->start and next;
1659              
1660 0         0 my @r = ($host,$self->_ssh($host));
1661              
1662 0         0 $manager->finish(0,\@r);
1663             }
1664              
1665 0         0 $manager->wait_all_children();
1666 0         0 return %ret;
1667             }
1668              
1669             sub _ssh {
1670 0     0   0 my($self,$host) = @_;
1671              
1672 0         0 my $ssh = Net::OpenSSH->new($host, %{ $$self{'g'}{'ssh_opts'} });
  0         0  
1673              
1674 0         0 my $script_loc = $$self{'g'}{'tmp_script'};
1675 0   0     0 my $script_rem = $$self{'g'}{'ssh_script'} || $script_loc;
1676 0 0       0 $ssh->scp_put($script_loc,$script_rem) or return 253;
1677              
1678             #
1679             # If we're sleeping, do so.
1680             #
1681              
1682 0 0       0 if ($$self{'g'}{'ssh_sleep'}) {
1683 0         0 my $n = $$self{'g'}{'ssh_sleep'};
1684 0 0       0 if ($n < 0) {
1685 0         0 sleep(-$n);
1686             } else {
1687 0         0 sleep(int(rand($$self{'g'}{'ssh_sleep'})));
1688             }
1689             }
1690              
1691             #
1692             # If it's running in real-time, do so.
1693             #
1694              
1695 0 0       0 if ($$self{'g'}{'mode'} eq 'run') {
1696 0         0 $ssh->system({},". $script_rem");
1697 0         0 my $ret = $?;
1698              
1699 0 0       0 if (! $$self{'g'}{'ssh_script_keep'}) {
1700 0         0 $ssh->system({},"rm -f $script_rem");
1701             }
1702 0         0 return ($ret);
1703             }
1704              
1705             #
1706             # If it's running in script mode, do so.
1707             #
1708              
1709 0         0 my($stdout,$stderr,$exit);
1710              
1711 0 0       0 if ($$self{'g'}{'err'}) {
    0          
1712 0         0 ($stdout,$stderr) = $ssh->capture2({},". $script_rem");
1713 0 0       0 $stdout = undef if (! $$self{'g'}{'out'});
1714             } elsif ($$self{'g'}{'out'}) {
1715 0         0 $stdout = $ssh->capture({},". $script_rem");
1716             } else {
1717 0         0 $ssh->system({},". $script_rem");
1718             }
1719 0         0 $exit = $?;
1720 0         0 $exit = $exit >> 8;
1721              
1722 0 0       0 if (! $$self{'g'}{'ssh_script_keep'}) {
1723 0         0 $ssh->system({},"rm -f $script_rem");
1724             }
1725              
1726 0         0 return ($exit,$stdout,$stderr);
1727             }
1728              
1729             ###############################################################################
1730              
1731             sub output {
1732 141     141 1 186278 my($self,%options) = @_;
1733              
1734 141 50       403 my $host = (exists $options{'host'} ? $options{'host'} : '');
1735 141 50       312 my $type = (exists $options{'output'} ? $options{'output'} : 'stdout');
1736 141 50       310 my $cmd = (exists $options{'command'} ? $options{'command'} : 'curr');
1737              
1738 141 50       831 if ($type !~ /^(stdout|stderr|command|num|label|exit)$/) {
1739 0         0 $self->_err("Invalid output option: output=$type");
1740 0         0 return;
1741             }
1742              
1743             #
1744             # Output from ssh method
1745             #
1746              
1747 141 50       307 if ($host) {
1748 0         0 my @all = keys %{ $$self{'s'} };
  0         0  
1749 0 0       0 if (! @all) {
1750 0         0 $self->_err("Invalid option in output: " .
1751             "host not allowed unless run with ssh method");
1752 0         0 return;
1753             }
1754              
1755             # host = all
1756             # host = HOST,HOST,...
1757              
1758 0 0 0     0 if ($host eq 'all' || $host =~ /,/) {
1759 0         0 my %ret;
1760 0 0       0 my @host = ($host eq 'all'
1761             ? @all
1762             : split(/,/,$host));
1763              
1764 0         0 foreach my $host (@host) {
1765 0 0       0 if (! exists $$self{'s'}{$host}) {
1766 0         0 $self->_err("Host has no output: $host");
1767 0         0 next;
1768             }
1769              
1770 0         0 $ret{$host} = [ $self->_output($type,$cmd,$$self{'s'}{$host}) ];
1771             }
1772 0         0 return %ret;
1773             }
1774              
1775             # host = HOST
1776              
1777 0 0       0 if (! exists $$self{'s'}{$host}) {
1778 0         0 $self->_err("Host has no output: $host");
1779 0         0 return;
1780             }
1781 0         0 return $self->_output($type,$cmd,$$self{'s'}{$host});
1782             }
1783              
1784             #
1785             # Output from run method
1786             #
1787              
1788 141         396 return $self->_output($type,$cmd,$$self{'o'});
1789             }
1790              
1791             sub _output {
1792 141     141   296 my($self,$type,$cmd,$output) = @_;
1793              
1794             #
1795             # Figure out which output sections need to be returned.
1796             #
1797              
1798 141         189 my @c;
1799 141 100       263 my $no = (exists $$output{'out'} ? @{ $$output{'out'} } : 0);
  116         189  
1800 141 100       279 my $ne = (exists $$output{'err'} ? @{ $$output{'err'} } : 0);
  91         127  
1801 141 100       265 my $max = ($no > $ne ? $no : $ne);
1802              
1803 141 100       517 if ($cmd eq 'curr') {
    100          
    100          
    100          
    50          
1804 26         57 push @c,$$self{'curr'};
1805              
1806             } elsif ($cmd eq 'next') {
1807 5         13 $$self{'curr'}++;
1808 5         20 push @c,$$self{'curr'};
1809              
1810             } elsif ($cmd eq 'all') {
1811 43         138 push @c, (0 .. ($max-1));
1812              
1813             } elsif ($cmd eq 'fail') {
1814             # Find the command that failed.
1815              
1816 38         108 foreach my $i (0 .. ($max-1)) {
1817 86 100 66     383 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    50 33        
1818 74 100       186 if ($$output{'out'}[$i][1]) {
1819 9         13 push(@c,$i);
1820 9         18 last;
1821             }
1822              
1823             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1824 12 50       28 if ($$output{'err'}[$i][1]) {
1825 0         0 push(@c,$i);
1826 0         0 last;
1827             }
1828             }
1829             }
1830              
1831             } elsif ($cmd =~ /^\d+$/) {
1832             # CMD_NUM
1833              
1834 29         96 foreach my $i (0 .. ($max-1)) {
1835 68 100 66     284 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    50 33        
1836 56 100       134 if ($$output{'out'}[$i][0] eq $cmd) {
1837 23         49 push(@c,$i);
1838             }
1839              
1840             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1841 12 100       30 if ($$output{'err'}[$i][0] eq $cmd) {
1842 6         13 push(@c,$i);
1843             }
1844             }
1845             }
1846              
1847             } else {
1848             # LABEL
1849              
1850 0         0 foreach my $i (0 .. ($max-1)) {
1851 0 0 0     0 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    0 0        
1852 0         0 my $n = $$output{'out'}[$i][0];
1853 0 0       0 if ($$self{'cmd'}{$n}{'label'} eq $cmd) {
1854 0         0 push(@c,$i);
1855             }
1856              
1857             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1858 0         0 my $n = $$output{'err'}[$i][0];
1859 0 0       0 if ($$self{'cmd'}{$n}{'label'} eq $cmd) {
1860 0         0 push(@c,$i);
1861             }
1862             }
1863             }
1864             }
1865              
1866 141 100       397 return if (! @c);
1867              
1868             #
1869             # Now gather up the stuff to return.
1870             #
1871              
1872 112         173 my @ret;
1873              
1874 112         224 foreach my $i (@c) {
1875 175 100       695 if ($type eq 'stdout') {
    100          
    100          
    100          
    100          
    50          
1876 31         51 my @r;
1877 31 100 66     187 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
1878 27         59 my @tmp = @{ $$output{'out'}[$i] };
  27         78  
1879 27         50 shift(@tmp);
1880 27         134 shift(@tmp);
1881 27         57 foreach my $try (@tmp) {
1882 31         56 foreach my $alt (@$try) {
1883 35         76 push(@r,@$alt);
1884             }
1885             }
1886 27         125 push(@ret,[@r]);
1887             }
1888              
1889             } elsif ($type eq 'stderr') {
1890 21         34 my @r;
1891 21 100 66     107 if (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1892 13         25 my @tmp = @{ $$output{'err'}[$i] };
  13         45  
1893 13         21 shift(@tmp);
1894 13         24 shift(@tmp);
1895 13         23 foreach my $try (@tmp) {
1896 15         26 foreach my $alt (@$try) {
1897 17         44 push(@r,@$alt);
1898             }
1899             }
1900 13         36 push(@ret,[@r]);
1901             }
1902              
1903             } elsif ($type eq 'command') {
1904 31         47 my $n;
1905 31 100 66     187 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    50 33        
1906 27         100 $n = $$output{'out'}[$i][0];
1907             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1908 4         9 $n = $$output{'err'}[$i][0];
1909             }
1910 31         159 push(@ret,$$self{'cmd'}{$n}{'cmd'});
1911              
1912             } elsif ($type eq 'num') {
1913 37         59 my $n;
1914 37 100 66     231 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    50 33        
1915 32         75 $n = $$output{'out'}[$i][0];
1916             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1917 5         10 $n = $$output{'err'}[$i][0];
1918             }
1919 37         111 push(@ret,$n);
1920              
1921             } elsif ($type eq 'label') {
1922 23         35 my $n;
1923 23 100 66     162 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    50 33        
1924 19         50 $n = $$output{'out'}[$i][0];
1925             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1926 4         8 $n = $$output{'err'}[$i][0];
1927             }
1928 23         97 push(@ret,$$self{'cmd'}{$n}{'label'});
1929              
1930             } elsif ($type eq 'exit') {
1931 32         44 my $exit;
1932 32 100 66     210 if (exists $$output{'out'} && defined $$output{'out'}[$i]) {
    50 33        
1933 28         67 $exit = $$output{'out'}[$i][1];
1934             } elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) {
1935 4         8 $exit = $$output{'err'}[$i][1];
1936             }
1937 32         85 push(@ret,$exit);
1938             }
1939             }
1940              
1941 112         583 return @ret;
1942             }
1943              
1944             1;
1945             # Local Variables:
1946             # mode: cperl
1947             # indent-tabs-mode: nil
1948             # cperl-indent-level: 3
1949             # cperl-continued-statement-offset: 2
1950             # cperl-continued-brace-offset: 0
1951             # cperl-brace-offset: 0
1952             # cperl-brace-imaginary-offset: 0
1953             # cperl-label-offset: 0
1954             # End: