File Coverage

blib/lib/Clustericious/Admin/RemoteHandler.pm
Criterion Covered Total %
statement 66 75 88.0
branch 31 40 77.5
condition 21 30 70.0
subroutine 18 21 85.7
pod 0 11 0.0
total 136 177 76.8


line stmt bran cond sub pod time code
1             package Clustericious::Admin::RemoteHandler;
2              
3 9     9   38 use strict;
  9         12  
  9         256  
4 9     9   39 use warnings;
  9         11  
  9         233  
5 9     9   165 use 5.010;
  9         21  
6 9     9   33 use AE;
  9         12  
  9         182  
7 9     9   3800 use AnyEvent::Open3::Simple 0.76;
  9         43095  
  9         7398  
8              
9             our $VERSION = '1.09'; # VERSION
10              
11             sub new
12             {
13 30     30 0 200 my($class, %args) = @_;
14            
15             # args: prefix, clad, user, host, payload
16            
17             my $self = bless {
18             prefix => $args{prefix},
19             clad => $args{clad},
20             cv => AE::cv,
21             summary => $args{clad}->summary,
22 30         1806 }, $class;
23            
24 30         94 my $clad = $args{clad};
25            
26             # TODO: handle the same host multiple times
27 30 100       125 if($clad->log_dir)
28             {
29 3         25 my $fn = $clad->log_dir->file($args{prefix} . ".log");
30 3 50       587 open(my $fh, '>', "$fn")
31             || die "unable to write to $fn $!";
32 3         666 $self->{logfile} = $fh;
33 3         84 $self->{logfilename} = $fn;
34             }
35            
36 30         64 my $done = $self->{cv};
37            
38             my $ipc = AnyEvent::Open3::Simple->new(
39             on_start => sub {
40 30     30   204894 my($proc, $program, @args) = @_;
41 30 50       408 $self->print_line(star => "% $program @args") if $clad->verbose;
42             },
43             on_stdout => sub {
44 35     35   2495528 my($proc, $line) = @_;
45 35         267 $self->print_line(out => $line);
46             },
47             on_stderr => sub {
48 6     6   773161 my($proc, $line) = @_;
49 6         43 $self->print_line(err => $line);
50             },
51             on_exit => sub {
52 30     30   1413180 my($proc, $exit, $signal) = @_;
53 30 100 66     143 $self->print_line(exit => $exit) if ($self->summary && !$signal) || $exit;
      100        
54 30 50       84 $self->print_line(sig => $signal) if $signal;
55 30 100 66     175 $clad->ret(2) if $exit || $signal;
56 30         112 $self->cleanup;
57             },
58             on_error => sub {
59 0     0   0 my($error) = @_;
60 0         0 $self->print_line(fail => $error);
61 0         0 $clad->ret(2);
62 0         0 $self->cleanup;
63             },
64 30         800 );
65            
66             $ipc->run(
67             $clad->ssh_command,
68             $clad->ssh_options,
69             $clad->ssh_extra,
70             ($args{user} ? ('-l' => $args{user}) : ()),
71             $args{host},
72             $clad->server_command,
73             \$args{payload},
74 30 100       1820 );
75              
76 30         5449 $self;
77             }
78              
79 69     69 0 488 sub clad { shift->{clad} }
80 41     41 0 1686 sub prefix { shift->{prefix} }
81 77     77 0 617 sub summary { shift->{summary} }
82 80     80 0 292 sub logfile { shift->{logfile} }
83 0     0 0 0 sub logfilename { shift->{logfilename} }
84              
85             sub cleanup
86             {
87 30     30 0 59 my($self) = @_;
88 30 100       81 $self->logfile->close if $self->logfile;
89 30         492 $self->{cv}->send;
90             }
91              
92             sub color
93             {
94 0     0 0 0 my($self) = @_;
95 0   0     0 $self->{color} //= $self->clad->next_color;
96             }
97              
98             sub is_color
99             {
100 88     88 0 127 my($self) = @_;
101 88   66     567 $self->{is_color} //= $self->clad->color;
102             }
103              
104             sub print_line
105             {
106 47     47 0 160 my($self, $code, $line) = @_;
107              
108 47         180 my $fh = $self->logfile;
109 47 100       217 printf $fh "[%-4s] %s\n", $code, $line
110             if $fh;
111            
112 47         260 my $last_line = $code =~ /^(exit|sig|fail)$/;
113            
114 47 100 100     162 return if $self->summary && ! $last_line;
115            
116 41 100 100     197 if($last_line && $line ne '0')
117             {
118 4 50       24 print Term::ANSIColor::color($self->clad->fail_color) if $self->is_color;
119             }
120             else
121             {
122 37 50       120 print Term::ANSIColor::color($self->color) if $self->is_color;
123             }
124              
125 41         106 printf "[%@{[ $self->clad->host_length ]}s %-4s] ", $self->prefix, $code;
  41         123  
126              
127 41 100       181 if(! $last_line)
128             {
129 35 100       123 if($code eq 'err')
130             {
131 6 50       26 print Term::ANSIColor::color($self->clad->err_color) if $self->is_color;
132             }
133             else
134             {
135 29 50       78 print Term::ANSIColor::color('reset') if $self->is_color;
136             }
137             }
138            
139 41         423 print $line;
140            
141 41 100 100     291 if($last_line || $code eq 'err')
142             {
143 12 50       51 print Term::ANSIColor::color('reset') if $self->is_color;
144             }
145            
146 41         333 print "\n";
147            
148 41 50 66     435 if($fh && $last_line && $line ne '0')
      33        
149             {
150 0         0 print ' ' x ($self->clad->host_length +8), "see @{[ $self->logfilename ]}\n";
  0         0  
151             }
152             }
153              
154 30     30 0 93 sub cv { shift->{cv} }
155              
156             1;
157              
158             __END__
159              
160             =pod
161              
162             =encoding UTF-8
163              
164             =head1 NAME
165              
166             Clustericious::Admin::RemoteHandler
167              
168             =head1 VERSION
169              
170             version 1.09
171              
172             =head1 AUTHOR
173              
174             Graham Ollis <plicease@cpan.org>
175              
176             =head1 COPYRIGHT AND LICENSE
177              
178             This software is copyright (c) 2015 by Graham Ollis.
179              
180             This is free software; you can redistribute it and/or modify it under
181             the same terms as the Perl 5 programming language system itself.
182              
183             =cut