File Coverage

blib/lib/Svsh/S6.pm
Criterion Covered Total %
statement 6 12 50.0
branch n/a
condition 0 4 0.0
subroutine 2 5 40.0
pod 3 3 100.0
total 11 24 45.8


line stmt bran cond sub pod time code
1             package Svsh::S6;
2              
3 1     1   1012 use Moo;
  1         2  
  1         11  
4 1     1   296 use namespace::clean;
  1         2  
  1         5  
5              
6             our $DEFAULT_BASEDIR = '/service';
7              
8             with 'Svsh';
9              
10             =head1 NAME
11              
12             Svsh::S6 - s6 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 does not have a default base directory, but recommends C,
22             so that is what will be used if a base directory was not provided to C.
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('s6-svstat', $_[0]->basedir.'/'.$_);
37             my ($status, $comment, $seconds) = ($raw =~ m/(up|down) \(([^\)]+)\) (\d+)/);
38             $statuses->{$_} = {
39             status => $status,
40             duration => $seconds,
41             pid => '-'
42             };
43              
44             if ($comment =~ m/pid (\d+)/) {
45             $statuses->{$_}->{pid} = $1;
46             }
47             }
48             return $statuses;
49             }
50              
51             =head2 start( @services )
52              
53             =cut
54              
55             sub start {
56             foreach (@{$_[2]->{args}}) {
57             $_[0]->run_cmd('s6-svc', '-u', $_[0]->basedir.'/'.$_);
58             }
59             }
60              
61             =head2 stop( @services )
62              
63             =cut
64              
65             sub stop {
66             foreach (@{$_[2]->{args}}) {
67             $_[0]->run_cmd('s6-svc', '-Dd', $_[0]->basedir.'/'.$_);
68             }
69             }
70              
71             =head2 restart( @services )
72              
73             =cut
74              
75             sub restart {
76             foreach (@{$_[2]->{args}}) {
77             $_[0]->run_cmd('s6-svc', '-q', $_[0]->basedir.'/'.$_);
78             }
79             }
80              
81             =head2 signal( $signal, @services )
82              
83             =cut
84              
85             sub signal {
86             my ($sign, @sv) = @{$_[2]->{args}};
87              
88             # convert signal to perpctl command
89             $sign =~ s/^sig//i;
90             my $cmd = $sign =~ m/^usr(1|2)$/i ? $1 : lc(substr($sign, 0, 1));
91              
92             foreach (@sv) {
93             $_[0]->run_cmd('s6-svc', "-$cmd", $_[0]->basedir.'/'.$_);
94             }
95             }
96              
97             =head2 fg( $service )
98              
99             =cut
100              
101             sub fg {
102             # find out the pid of the logging process
103 0     0 1   my $text = $_[0]->run_cmd('s6-svstat', $_[0]->basedir.'/'.$_[2]->{args}->[0].'/log');
104 0   0       my $pid = ($text =~ m/\(pid (\d+)\)/)[0]
105             || die "Can't figure out pid of the logging process";
106              
107             # find out the current log file
108 0   0       my $logfile = $_[0]->find_logfile($pid)
109             || die "Can't find out process' log file";
110              
111 0           $_[0]->run_cmd('tail', '-f', $logfile, { as_system => 1 });
112             }
113              
114             =head2 rescan()
115              
116             =cut
117              
118             sub rescan {
119 0     0 1   $_[0]->run_cmd('s6-svscanctl', '-a', $_[0]->basedir);
120             }
121              
122             =head2 terminate()
123              
124             =cut
125              
126             sub terminate {
127 0     0 1   $_[0]->run_cmd('s6-svscanctl', '-t', $_[0]->basedir);
128             }
129              
130             =head1 BUGS AND LIMITATIONS
131              
132             Please report any bugs or feature requests to
133             L.
134              
135             =head1 AUTHOR
136              
137             Ido Perlmuter
138              
139             Thanks to the guys at the L,
140             especially Colin Booth, for helping out with suggestions and information.
141              
142             =head1 LICENSE AND COPYRIGHT
143              
144             Copyright (c) 2015-2023, Ido Perlmuter C<< ido@ido50.net >>.
145              
146             Licensed under the Apache License, Version 2.0 (the "License");
147             you may not use this file except in compliance with the License.
148             You may obtain a copy of the License at
149              
150             http://www.apache.org/licenses/LICENSE-2.0
151              
152             Unless required by applicable law or agreed to in writing, software
153             distributed under the License is distributed on an "AS IS" BASIS,
154             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
155             See the License for the specific language governing permissions and
156             limitations under the License.
157              
158             =cut
159              
160             1;
161             __END__