File Coverage

blib/lib/Parse/Daemontools/Service.pm
Criterion Covered Total %
statement 76 90 84.4
branch 29 46 63.0
condition 14 23 60.8
subroutine 11 11 100.0
pod 3 6 50.0
total 133 176 75.5


line stmt bran cond sub pod time code
1             package Parse::Daemontools::Service;
2              
3 3     3   53637 use strict;
  3         8  
  3         113  
4 3     3   19 use warnings;
  3         5  
  3         92  
5 3     3   84 use 5.008_005;
  3         14  
  3         142  
6 3     3   3163 use bigint;
  3         16137  
  3         17  
7              
8             our $VERSION = '0.03';
9              
10 3     3   148668 use Carp;
  3         11  
  3         1031  
11              
12             sub new {
13 6     6 1 11859     my($class, $args) = @_;
14 6   100     27     $args ||= {};
15              
16 6         34     my $self = bless {
17                     base_dir => '/service',
18                     %$args,
19                 }, $class;
20              
21 6         18     return $self;
22             }
23              
24             sub base_dir {
25 5     5 1 18     my($self, $base_dir) = @_;
26 5 50       14     if ($base_dir) {
27 0 0       0         if (! -d $base_dir) {
28 0         0             Carp::carp("No such directory: $base_dir");
29 0         0             return;
30                     }
31 0         0         $self->{base_dir} = $base_dir;
32                 }
33 5         21     return $self->{base_dir};
34             }
35              
36             sub status {
37 5     5 1 23     my($self, $service, $param) = @_;
38              
39 5 50       15     if (! $service) {
40 0         0         Carp::carp("Missing mandatory args: service");
41 0         0         return;
42                 }
43              
44 5         14     my $service_dir = join '/', $self->base_dir, $service;
45 5 50       175     if (! -d $service_dir) {
46 0         0         Carp::carp("No such directory: $service_dir");
47 0         0         return;
48                 }
49              
50             ### down
51 5         7     my $normallyup = 0;
52 5 50       98     $normallyup = 1 if ! -e "$service_dir/down";
53              
54             ### supervise/status
55 5         14     my $status_file = join '/', $service_dir, 'supervise', 'status';
56 5 50       125     if (! -f $status_file) {
57 0         0         Carp::carp("No such status file: $status_file");
58 0         0         return;
59                 }
60              
61 5 50       250     open my $fh, '<', $status_file or do {
62 0         0         Carp::carp("Failed to open status file: $status_file: $!");
63 0         0         return;
64                 };
65 5         8     my $status = do { local $/; <$fh> };
  5         19  
  5         123  
66 5         57     close $fh;
67              
68 5         42     my($tai_h, $tai_l, $nanosec, $pid, $paused, $want) = unpack "NNLVCa", $status;
69              
70 5 100       88     $pid = undef if $pid == 0;
71              
72 5         639     my $when = ($tai_h << 32) + $tai_l;
73 5         1726     my $now = tai64_now();
74 5 50       643     if ($now < $when) {
75 0         0         $when = $now;
76                 }
77 5         189     my $elapse = $now - $when;
78              
79 5         621     my @info;
80 5 50 66     24     push @info, "normally down" if ($pid && !$normallyup);
81 5 100 66     90     push @info, "normally up" if (!$pid && $normallyup);
82 5 50 66     101     push @info, "paused" if ($pid && $paused);
83 5 50 66     18     push @info, "want up" if (!$pid && $want eq 'u');
84 5 50 66     28     push @info, "want down" if ($pid && $want eq 'd');
85              
86             ### env/
87 5         8     my $env = {};
88 5         6     my @env_dir;
89 5 100       30     if ($param->{env_dir}) {
90 3 100       11         if (ref $param->{env_dir} eq 'ARRAY') {
91 2         4             @env_dir = @{ $param->{env_dir} };
  2         5  
92                     } else {
93 1         3             @env_dir = ($param->{env_dir});
94                     }
95                 } else {
96 2         8         @env_dir = ("$service_dir/env");
97                 }
98 5         10     for my $ed (@env_dir) {
99 6 100       162         next unless -d $ed;
100              
101 5 50       206         if (opendir my $envdir, $ed) {
102 5         62             while (my $k = readdir $envdir) {
103 20 100       143                 next if $k =~ /^\./;
104 10 50       427                 open my $fh, '<', "$ed/$k" or next;
105 10         11                 my $v = do { local $/; <$fh> };
  10         32  
  10         207  
106 10         92                 close $fh;
107 10         15                 chomp $v;
108 10         65                 $env->{$k} = $v;
109                         }
110                     } else {
111 0         0             Carp::carp("Failed to open env dir: $ed: $!");
112                     }
113                 }
114              
115 5         17     my $start_at = tai642unix($when);
116 5 50 33     772     $start_at = $start_at->numify if ref($start_at) && $start_at->can('numify');
117 5 50 33     154     $elapse = $elapse->numify if ref($elapse) && $elapse->can('numify');
118              
119                 return {
120 5 100       132         service => $service_dir,
121                     status => defined $pid ? 'up' : 'down',
122                     pid => $pid,
123                     seconds => $elapse,
124                     start_at => $start_at,
125                     info => join(", ", @info),
126                     env => $env,
127                 };
128             }
129              
130             # http://cr.yp.to/libtai/tai64.html
131             # http://cr.yp.to/proto/tai64.txt
132             sub unix2tai64 {
133 5     5 0 35     my $u = shift;
134 5         14     return 4611686018427387914 + $u;
135             }
136              
137             sub tai642unix {
138 5     5 0 8     my $t = shift;
139 5         16     return $t - 4611686018427387914;
140             }
141              
142             sub tai64_now {
143 5     5 0 20     return unix2tai64(time());
144             }
145              
146             1;
147              
148             __END__
149            
150             =encoding utf-8
151            
152             =begin html
153            
154             <a href="https://travis-ci.org/hirose31/Parse-Daemontools-Service"><img src="https://travis-ci.org/hirose31/Parse-Daemontools-Service.png?branch=master" alt="Build Status" /></a>
155             <a href="https://coveralls.io/r/hirose31/Parse-Daemontools-Service?branch=master"><img src="https://coveralls.io/repos/hirose31/Parse-Daemontools-Service/badge.png?branch=master" alt="Coverage Status" /></a>
156            
157             =end html
158            
159             =head1 NAME
160            
161             Parse::Daemontools::Service - Retrieve status and env of service under daemontools
162            
163             =begin readme
164            
165             =head1 INSTALLATION
166            
167             To install this module, run the following commands:
168            
169             perl Build.PL
170             ./Build
171             ./Build test
172             ./Build install
173            
174             =end readme
175            
176             =head1 SYNOPSIS
177            
178             Normally, Parse::Daemontools::Service requires root privileges because need to read /service/DAEMON/supervise/status file.
179            
180             use Parse::Daemontools::Service;
181            
182             my $ds = Parse::Daemontools::Service->new;
183             my $status = $ds->status("qmail");
184            
185             my $status = $ds->status("my-daemon",
186             {
187             env_dir => "/service/my-daemon/my-env-dir",
188             });
189            
190             my $status = $ds->status("my-daemon",
191             {
192             env_dir => [
193             "/service/my-daemon/env",
194             "/service/my-daemon/my-env-dir",
195             ],
196             });
197            
198             =head1 DESCRIPTION
199            
200             Parse::Daemontools::Service retrieves status and env of service under daemontools.
201            
202             =head1 METHODS
203            
204             =over 4
205            
206             =item B<new>({ base_dir => Str })
207            
208             base_dir (optional): base directory of daemontools. Default is "/service"
209            
210             =item B<status>($service_name:Str, { env_dir => Str|ArrayRef[Str] })
211            
212             Return status and env of $service_name as following HashRef.
213            
214             +{
215             service => Str, # "/service/my-daemon"
216             pid => Int, # PID of daemon process
217             seconds => Int, # uptime of this daemon process
218             start_at => Int, # UNIX time of this daemon process started at
219             status => Str, # "up" | "down"
220             info => Str, # "" | "normally down" | "normally up" | ...
221             env => { # environment variables in envdir
222             BAR => "bar",
223             FOO => "foo"
224             },
225             },
226            
227             Default env_dir is "/service/my-daemon/env". You can specify env_dir(s) by Str or ArrayRef. When you specify more than one env_dirs, same key are overridden by latter env_dir.
228            
229             =back
230            
231             =head1 AUTHOR
232            
233             HIROSE Masaaki E<lt>hirose31@gmail.comE<gt>
234            
235             =head1 REPOSITORY
236            
237             L<https://github.com/hirose31/Parse-Daemontools-Service>
238            
239             git clone git://github.com/hirose31/Parse-Daemontools-Service.git
240            
241             patches and collaborators are welcome.
242            
243             =head1 SEE ALSO
244            
245             svstat(1)
246            
247             =head1 COPYRIGHT
248            
249             Copyright HIROSE Masaaki
250            
251             =head1 LICENSE
252            
253             This library is free software; you can redistribute it and/or modify
254             it under the same terms as Perl itself.
255            
256             =cut
257