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   1138 use Moo;
  1         1  
  1         6  
4 1     1   219 use namespace::clean;
  1         2  
  1         6  
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             No bugs have been reported.
114              
115             Please report any bugs or feature requests to
116             C, or through the web interface at
117             L.
118              
119             =head1 SUPPORT
120              
121             You can find documentation for this module with the perldoc command.
122              
123             perldoc Svsh::Daemontools
124              
125             You can also look for information at:
126              
127             =over 4
128            
129             =item * RT: CPAN's request tracker
130            
131             L
132            
133             =item * AnnoCPAN: Annotated CPAN documentation
134            
135             L
136            
137             =item * CPAN Ratings
138            
139             L
140            
141             =item * Search CPAN
142            
143             L
144            
145             =back
146              
147             =head1 AUTHOR
148              
149             Ido Perlmuter
150              
151             =head1 LICENSE AND COPYRIGHT
152              
153             Copyright (c) 2015, Ido Perlmuter C<< ido at ido50 dot net >>.
154              
155             This module is free software; you can redistribute it and/or
156             modify it under the same terms as Perl itself, either version
157             5.8.1 or any later version. See L
158             and L.
159              
160             The full text of the license can be found in the
161             LICENSE file included with this module.
162              
163             =head1 DISCLAIMER OF WARRANTY
164              
165             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
166             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
167             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
168             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
169             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
170             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
171             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
172             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
173             NECESSARY SERVICING, REPAIR, OR CORRECTION.
174              
175             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
176             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
177             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
178             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
179             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
180             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
181             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
182             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
183             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
184             SUCH DAMAGES.
185              
186             =cut
187              
188             1;
189             __END__