File Coverage

blib/lib/Svsh/Daemontools.pm
Criterion Covered Total %
statement 6 10 60.0
branch n/a
condition 0 4 0.0
subroutine 2 3 66.6
pod 1 1 100.0
total 9 18 50.0


line stmt bran cond sub pod time code
1             package Svsh::Daemontools;
2              
3 1     1   946 use Moo;
  1         3  
  1         5  
4 1     1   318 use namespace::clean;
  1         23  
  1         7  
5              
6             our $DEFAULT_BASEDIR = '/service';
7              
8             with 'Svsh';
9              
10             =head1 NAME
11              
12             Svsh::Daemontools - daemontools support for svsh
13              
14             =head1 DESCRIPTION
15              
16             This class provides support for L
17             to L - the supervisor shell.
18              
19             =head2 DEFAULT BASE DIRECTORY
20              
21             C uses C as its default base directory. If a base directory
22             is not provided to C, that is what will be used.
23              
24             =head1 IMPLEMENTED METHODS
25              
26             Refer to L for complete explanation of these methods. Only changes from
27             the base specifications are listed here.
28              
29             =head2 status()
30              
31             =cut
32              
33             sub status {
34             my $statuses = {};
35             foreach ($_[0]->_service_dirs) {
36             my $raw = $_[0]->run_cmd('svstat', $_[0]->basedir.'/'.$_);
37              
38             my ($status, $pid, $duration) = $raw =~ m/$_: (\w+)(?: \(pid (\d+)\))? (\d+) seconds/;
39              
40             $statuses->{$_} = {
41             status => $status,
42             duration => $duration || 0,
43             pid => $pid || '-'
44             };
45             }
46             return $statuses;
47             }
48              
49             =head2 start( @services )
50              
51             =cut
52              
53             sub start {
54             $_[0]->run_cmd('svc', '-u', map { $_[0]->basedir.'/'.$_ } @{$_[2]->{args}});
55             }
56              
57             =head2 stop( @services )
58              
59             =cut
60              
61             sub stop {
62             $_[0]->run_cmd('svc', '-d', map { $_[0]->basedir.'/'.$_ } @{$_[2]->{args}});
63             }
64              
65             =head2 restart( @services )
66              
67             This is implemented by sending the C signal to the services, as opposed to the
68             usual C signal, since C does not provide a way of sending the
69             C signal. Future versions might reimplement this with perl's C function.
70              
71             =cut
72              
73             sub restart {
74             $_[0]->run_cmd('svc', '-t', map { $_[0]->basedir.'/'.$_ } @{$_[2]->{args}});
75             }
76              
77             =head2 signal( $signal, @services )
78              
79             C, C, C and C are not supported by C.
80              
81             =cut
82              
83             sub signal {
84             my ($sign, @sv) = @{$_[2]->{args}};
85              
86             # convert signal to perpctl command
87             $sign =~ s/^sig//i;
88             die "daemontools does not support the $sign signal"
89             if lc($sign) =~ m/^(usr\d|quit|winch)$/;
90              
91             $_[0]->run_cmd('svc', '-'.lc(substr($sign, 0, 1)), map { $_[0]->basedir.'/'.$_ } @sv);
92             }
93              
94             =head2 fg( $service )
95              
96             =cut
97              
98             sub fg {
99             # find out the pid of the logging process
100 0     0 1   my $text = $_[0]->run_cmd('svstat', $_[0]->basedir.'/'.$_[2]->{args}->[0].'/log');
101 0   0       my $pid = ($text =~ m/up \(pid (\d+)\)/)[0]
102             || die "Can't figure out pid of the logging process";
103              
104             # find out the current log file
105 0   0       my $logfile = $_[0]->find_logfile($pid)
106             || die "Can't find out process' log file";
107              
108 0           $_[0]->run_cmd('tail', '-f', $logfile, { as_system => 1 });
109             }
110              
111             =head1 BUGS AND LIMITATIONS
112              
113             Please report any bugs or feature requests to
114             L.
115              
116             =head1 AUTHOR
117              
118             Ido Perlmuter
119              
120             Thanks to the guys at the L,
121             especially Colin Booth, for helping out with suggestions and information.
122              
123             =head1 LICENSE AND COPYRIGHT
124              
125             Copyright (c) 2015-2023, Ido Perlmuter C<< ido@ido50.net >>.
126              
127             Licensed under the Apache License, Version 2.0 (the "License");
128             you may not use this file except in compliance with the License.
129             You may obtain a copy of the License at
130              
131             http://www.apache.org/licenses/LICENSE-2.0
132              
133             Unless required by applicable law or agreed to in writing, software
134             distributed under the License is distributed on an "AS IS" BASIS,
135             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
136             See the License for the specific language governing permissions and
137             limitations under the License.
138              
139             =cut
140              
141             1;
142             __END__