File Coverage

lib/Ubic/Cmd.pm
Criterion Covered Total %
statement 84 210 40.0
branch 11 68 16.1
condition 8 34 23.5
subroutine 19 36 52.7
pod 12 12 100.0
total 134 360 37.2


line stmt bran cond sub pod time code
1             package Ubic::Cmd;
2             $Ubic::Cmd::VERSION = '1.60';
3 2     2   14581 use strict;
  2         2  
  2         45  
4 2     2   6 use warnings;
  2         1  
  2         48  
5              
6             # ABSTRACT: ubic methods with pretty printing.
7              
8              
9 2     2   408 use Params::Validate qw(:all);
  2         5861  
  2         305  
10 2     2   9 use Scalar::Util qw(blessed);
  2         2  
  2         102  
11 2     2   412 use List::MoreUtils qw(any);
  2         7038  
  2         11  
12 2     2   740 use List::Util qw(max);
  2         3  
  2         132  
13 2     2   7 use Try::Tiny;
  2         2  
  2         69  
14 2     2   258 use Ubic;
  2         2  
  2         46  
15 2     2   8 use Ubic::Result qw(result);
  2         8  
  2         64  
16 2     2   512 use Ubic::Cmd::Results;
  2         4  
  2         3045  
17              
18             sub new {
19 1     1 1 2 my $class = shift;
20 1         6 my $self = validate(@_, {});
21 1         10 return bless $self => $class;
22             }
23              
24              
25             our $SINGLETON;
26             sub _obj {
27 8     8   50 my ($param) = validate_pos(@_, 1);
28 8 100       42 if (blessed($param)) {
29 4         7 return $param;
30             }
31 4 50       13 if ($param eq 'Ubic::Cmd') {
32             # method called as a class method => singleton
33 4   66     16 $SINGLETON ||= Ubic::Cmd->new();
34 4         13 return $SINGLETON;
35             }
36 0         0 die "Unknown argument '$param'";
37             }
38              
39              
40             sub _any_method {
41 3     3   5 my $self = shift;
42 3         42 my $params = validate(@_, {
43             service => 1,
44             results => 0,
45             action => 1, # Starting/Stopping/...
46             method => 1,
47             enabled_only => 0,
48             });
49 3         17 my ($service, $results, $action, $method, $enabled_only) = @$params{qw/ service results action method enabled_only /};
50 3   33     37 $results ||= Ubic::Cmd::Results->new;
51              
52             $self->traverse($service, sub {
53 3     3   4 my $service = shift;
54 3         8 my $name = $service->full_name;
55 3 50 33     9 if ($enabled_only and not Ubic->is_enabled($name)) {
56 0         0 print "$name is down\n";
57 0         0 $results->add(result('down'));
58 0         0 return;
59             }
60 3         10 print "$action $name... ";
61 3         5 my $result = eval { Ubic->$method($name) };
  3         14  
62 3   66     17 $result ||= result($@);
63 3 100       42 $results->print($result, $@ ? 'bad' : ());
64 3         25 });
65 3         108 return $results;
66             }
67              
68             sub start {
69 2     2 1 1525 my $self = _obj(shift);
70 2         19 return $self->_any_method({
71             service => shift,
72             results => shift,
73             action => 'Starting',
74             method => 'start',
75             });
76             }
77              
78              
79             sub stop {
80 1     1 1 14 my $self = _obj(shift);
81 1         17 return $self->_any_method({
82             service => shift,
83             results => shift,
84             action => 'Stopping',
85             method => 'stop',
86             });
87             }
88              
89             sub restart {
90 0     0 1 0 my $self = _obj(shift);
91 0         0 return $self->_any_method({
92             service => shift,
93             results => shift,
94             action => 'Restarting',
95             method => 'restart',
96             });
97             }
98              
99             sub try_restart {
100 0     0 1 0 my $self = _obj(shift);
101 0         0 return $self->_any_method({
102             service => shift,
103             results => shift,
104             action => 'Restarting',
105             method => 'try_restart',
106             enabled_only => 1,
107             });
108             }
109              
110             sub reload {
111 0     0 1 0 my $self = _obj(shift);
112 0         0 return $self->_any_method({
113             service => shift,
114             results => shift,
115             action => 'Reloading',
116             method => 'reload',
117             enabled_only => 1,
118             });
119             }
120              
121             sub force_reload {
122 0     0 1 0 my $self = _obj(shift);
123 0         0 return $self->_any_method({
124             service => shift,
125             results => shift,
126             action => 'Reloading',
127             method => 'force_reload',
128             enabled_only => 1,
129             });
130             }
131              
132             sub do_custom_command {
133 1     1 1 4 my $self = _obj(shift);
134 1         4 my $service = shift;
135 1         2 my $command = shift;
136 1   33     11 my $results = shift || Ubic::Cmd::Results->new;
137              
138 1         2 my $count = 0;
139 1         2 my $error = 0;
140             $self->traverse($service, sub {
141 1     1   2 my $service = shift;
142 1         4 my $name = $service->full_name;
143              
144             # Imagine we have multiservice X with subservices X.A, X.B and X.C.
145             # X may want to support custom command CC by implementing it in X.A and X.B but not in X.C.
146             # In this case X.A->CC and X.B->CC will be called, and X.C will be skipped.
147 1 50       4 if (grep { $_ eq $command } $service->custom_commands) {
  2         8  
148 1         5 print "Running $command for $name... ";
149             try {
150 1         34 Ubic->do_custom_command($name, $command);
151 1         5 $results->print_good("ok\n");
152             } catch {
153 0         0 $results->print(result('unknown', "failed: $_"), 'bad');
154 1         13 };
155 1         11 $count++;
156             }
157 1         8 });
158 1 50       5 unless ($count) {
159             # But if none of X subservices support our custom command, something is obviously wrong.
160 0 0       0 if ($service->isa('Ubic::Multiservice')) {
161 0         0 die "None of ".$service->full_name." subservices support $command";
162             }
163             else {
164             # it is unlikely that this error will happen, because we already checked that $service supports $command
165 0         0 die "$command unsupported";
166             }
167             }
168              
169             # TODO - what if X want to implement custom command itself?
170             # should custom commands have different types, "try to call me in each subservice" and "call me for multiservice itself"?
171              
172 1         3 return;
173             }
174              
175             sub usage {
176 0     0 1 0 my $self = _obj(shift);
177 0         0 my $command = shift;
178 0         0 print STDERR "Unknown command '$command'. See 'ubic help'.\n";
179 0         0 exit(2); # or exit(3)? see LSB for details
180             }
181              
182              
183             sub traverse($$$) {
184 4     4 1 8 my $self = _obj(shift);
185 4         12 my ($service, $callback, $indent) = @_;
186 4   50     17 $indent ||= 0;
187              
188 4 50       23 if (not defined $service) {
    50          
189 0         0 $service = Ubic->root_service;
190             }
191             elsif (not blessed($service)) {
192 4         16 $service = Ubic->service($service);
193             }
194 4         29 my $name = $service->full_name;
195              
196 4 50       31 if ($service->isa('Ubic::Multiservice')) {
197 0 0       0 if ($service->full_name) {
198 0         0 print ' ' x $indent, $service->full_name, "\n";
199 0         0 $indent = $indent + 4;
200             }
201 0         0 for my $subservice ($service->services) {
202 0         0 $self->traverse($subservice, $callback, $indent); # FIXME - remember result
203             }
204             }
205             else {
206 4         23 print(' ' x $indent);
207 4         10 return $callback->($service, $indent);
208             }
209             }
210              
211             sub print_status($$;$$) {
212 0     0 1   my $self = _obj(shift);
213 0           my $service = shift;
214 0           my $force_cached = shift;
215 0   0       my $results = shift || Ubic::Cmd::Results->new;
216              
217             # TODO - use Credentials instead
218 0           my $user = getpwuid($>);
219 0 0         unless (defined $user) {
220 0           die "Can't detect user by uid $>";
221             }
222              
223 0           my $max_offset = 0;
224             $self->traverse($service, sub {
225 0     0     my ($service, $indent) = @_;
226 0           my $name = $service->full_name;
227 0           print $name;
228              
229             # calculating the number of tabs to separate service name from status
230             # status will be aligned whenever possible without sacrificing the real-time properties
231             # i.e., we add several tabs to align status with previous lines, but following lines can increase the number of tabs if necessary
232             # TODO - there are two possibilities to improve this:
233             # 1) look at the further *simple* services and add tabs:
234             # blah
235             # blah.a off
236             # blah.blahblahblah off
237             # blah.c off
238             # (current implementation wouldn't align "blah.a" line correctly)
239             # this would require the change to traverse() method api, though
240             # 2) pre-compile whole service tree before printing anything
241             # but output speed would suffer
242 0           my $offset = length($name) + $indent;
243 0 0         if ($offset < $max_offset) {
244 0           print "\t" x (int($max_offset) / 8 - int($offset / 8));
245             }
246             else {
247 0           $max_offset = $offset;
248             }
249 0           print "\t";
250              
251 0           my $enabled = Ubic->is_enabled($name);
252 0 0         unless ($enabled) {
253 0           print "off\n";
254 0           $results->add(result('down'));
255 0           return;
256             }
257              
258 0           my $status;
259             my $cached;
260 0 0 0       if ($force_cached or ($> and $user ne Ubic->service($name)->user)) {
      0        
261 0           $status = Ubic->cached_status($name);
262 0           $cached = 1;
263             }
264             else {
265 0           $status = eval { Ubic->status($name) };
  0            
266 0 0         if ($@) {
267 0           $status = result($@);
268             }
269             }
270 0 0         if ($status->status eq 'running') {
271 0           $results->print($status);
272             }
273             else {
274 0           $results->print($status, 'bad'); # up and not running is always bad
275             }
276 0           });
277              
278             # TODO - print actual uplevel service's status, it can be service-specific
279 0 0   0     if (any { $_->status ne 'running' and $_->status ne 'down' } $results->results) {
  0 0          
280 0           $results->exit_code(3); # some services are not running when they should be
281             }
282 0           return $results;
283             }
284              
285             sub run {
286 0     0 1   my $self = _obj(shift);
287 0           my $params = validate(@_, {
288             name => 1,
289             command => { type => SCALAR },
290             force => 0,
291             });
292 0           my @names;
293 0 0         if (ref $params->{name} eq 'ARRAY') {
294 0           @names = @{$params->{name}};
  0            
295             }
296             else {
297 0           @names = ($params->{name});
298             }
299              
300 0           my $command = $params->{command};
301              
302 0           my $results = Ubic::Cmd::Results->new;
303 0           for my $name (@names) {
304 0           $self->_run_impl({ name => $name, command => $command, force => $params->{force}, results => $results });
305             }
306 0           exit $results->exit_code;
307             }
308              
309             sub _check_multiop {
310 0     0     my $self = _obj(shift);
311 0           my ($service, $command, $force) = validate_pos(@_, 1, 1, 1);
312              
313 0 0         return unless $service->isa('Ubic::Multiservice');
314              
315 0   0       my $screen_name = $service->name || 'root';
316 0           my $multiop = $service->multiop;
317 0 0         if ($multiop eq 'forbidden') {
    0          
    0          
318 0           die "$screen_name multiservice forbids $command\n";
319             }
320             elsif ($multiop eq 'protected') {
321 0 0         unless ($force) {
322 0 0         die "Use --force option if you want to $command all "
323             .($service->name ? $service->name.' ' : '')."services\n";
324             }
325             }
326             elsif ($multiop ne 'allowed') {
327 0           die "$screen_name has invalid multiop value '$multiop'\n";
328             }
329             }
330              
331             # run and modify results object
332             sub _run_impl {
333 0     0     my $self = _obj(shift);
334 0           my $params = validate(@_, {
335             name => { type => SCALAR | UNDEF },
336             command => { type => SCALAR },
337             results => { isa => 'Ubic::Cmd::Results' },
338             force => 0,
339             });
340 0           my $command = $params->{command};
341 0           my $name = $params->{name};
342 0           my $results = $params->{results};
343              
344 0 0 0       if ($command eq 'status' or $command eq 'cached-status') {
345 0           my $force_cached;
346 0 0         if ($command eq 'cached-status') {
347 0           $force_cached = 1;
348             }
349             try {
350 0     0     $self->print_status($name, $force_cached, $results);
351             }
352             catch {
353 0     0     print STDERR $_;
354 0           $results->exit_code(4); # internal error
355 0           };
356 0           return;
357             }
358              
359 0 0 0       if ($name and not Ubic->root_service->has_service($name)) {
360 0           print STDERR "Service '$name' not found\n";
361 0           $results->exit_code(5);
362 0           return;
363             }
364              
365             # FIXME - we're constructing service and drop it to reconstruct later
366             # but we need to construct service to check it's custom commands
367 0 0         my $service = $name ? Ubic->service($name) : Ubic->root_service;
368              
369             # yes, custom "start" command will override default "start" command, although it's not very useful :)
370             # but we need this because of current "logrotate" hack
371 0 0         if (grep { $_ eq $command } $service->custom_commands) {
  0            
372 0           $self->_check_multiop($service, $command, $params->{force});
373             try {
374 0     0     $self->do_custom_command($service, $command, $results);
375             }
376             catch {
377 0     0     print STDERR "'$name $command' error: $_\n";
378 0           $results->exit_code(1); # generic error, TODO - more lsb-specific errors?
379 0           };
380 0           return;
381             }
382              
383 0 0         $command = "force_reload" if $command eq "logrotate"; #FIXME: non LSB command!
384              
385 0           my $method = $command;
386 0           $method =~ s/-/_/g;
387 0 0         unless (grep { $_ eq $method } qw/ start stop restart try_restart reload force_reload /) {
  0            
388 0           $self->usage($command);
389             }
390              
391 0           $self->_check_multiop($service, $command, $params->{force});
392             try {
393 0     0     $self->$method($service, $results);
394             }
395             catch {
396 0 0   0     if ($name) {
397 0           print STDERR "'$name $method' error: $_\n";
398             }
399             else {
400 0           print STDERR "'$method' error: $_\n";
401             }
402 0           $results->exit_code(1); # generic error, TODO - more lsb-specific errors?
403 0           };
404 0           return;
405             }
406              
407              
408             1;
409              
410             __END__