File Coverage

blib/lib/Shell/Cmd.pm
Criterion Covered Total %
statement 567 712 79.6
branch 250 374 66.5
condition 89 149 59.7
subroutine 46 53 86.7
pod 11 11 100.0
total 963 1299 74.0


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