File Coverage

blib/lib/Daemon/DaemonizeLight.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Daemon::DaemonizeLight;
2              
3             require Exporter;
4             @ISA = qw(Exporter);
5             @EXPORT_OK = qw(daemonize);
6 2     2   33203 use strict;
  2         3  
  2         59  
7 2     2   1086 use FindBin;
  2         1858  
  2         95  
8 2     2   1381 use Proc::ProcessTableLight 'process_table';
  0            
  0            
9              
10             =head1 NAME
11              
12             Daemon::DaemonizeLight - New variant of Daemon::Daemonize based on nohup unix command
13              
14             =head1 SYNOPSIS
15              
16             use strict;
17             use Daemon::DaemonizeLight 'daemonize';
18              
19             daemonize();
20              
21             ... something useful code
22              
23             =head1 DESCRIPTION
24              
25             This module provides create simple daemon from your perl script.
26              
27             Only add the daemonize procedure at the beginning of your script.
28              
29             It provide 'start' 'stop' 'restart' arguments for you script in command string.
30              
31             =cut
32              
33             sub check_process{
34             my ($pid)=@_;
35            
36             my $t=process_table();
37            
38             my $exists=0;
39             my $script=$FindBin::RealScript;
40             my $i=0;
41             foreach my $p ( @{$t} ){
42             $exists=1 if (!$pid || $p->{PID}==$pid) && $p->{PID}!=$$ && $p->{COMMAND}=~/$script/;
43             }
44            
45             return $exists;
46             }
47              
48             sub stop{
49             my ($tmp)=@_;
50            
51             my $pid=read_pid($tmp);
52            
53             if ($pid){
54             if (check_process($pid)){
55             print "Try to killing process $FindBin::RealScript : $pid\n";
56             kill 'KILL', $pid;
57             my $i=0;
58             while(check_process($pid) && $i<3){
59             $i++;
60             sleep(1);
61             print ".";
62             }
63             if (check_process($pid)){
64             print "Kill process $FindBin::RealScript : $pid FAIL\n";
65             } else {
66             print "Kill process $FindBin::RealScript : $pid SUCCESS\n";
67             }
68             } else {
69            
70             }
71             } else {
72             print "Nothing to kill\n";
73             }
74             }
75              
76             sub start{
77             my ($tmp)=@_;
78             if (check_process()){
79             print "Process $FindBin::RealScript already exists\n";
80             } else {
81             my $script = $FindBin::Bin.'/'.$FindBin::RealScript;
82             my $clear_script = $tmp.'/'.clear_ext($FindBin::RealScript);
83            
84             print "Starting the process $FindBin::RealScript\n";
85            
86             my $cmd="nohup perl $script pid 1>$clear_script.log 2>$clear_script.err &";
87             `$cmd`;
88            
89             sleep(1);
90             if (check_process()){
91             print "Starting process $FindBin::RealScript SUCCESS\n";
92             } else {
93             print "Starting process $FindBin::RealScript FAILED\n";
94             }
95             }
96             }
97              
98             sub restart{
99             my ($tmp)=@_;
100             stop($tmp);
101             start($tmp);
102             }
103              
104             sub pid{
105             my ($tmp)=@_;
106            
107             my $script=clear_ext($FindBin::RealScript);
108             open(F, ">$tmp/$script.pid");
109             print F $$;
110             close(F);
111             }
112              
113             sub read_pid{
114             my ($tmp)=@_;
115            
116             my $script=clear_ext($FindBin::RealScript);
117             open(F, "$tmp/$script.pid");
118             my $pid=;
119             $pid=~s/[\n\r]//gs;
120             close(F);
121            
122             return $pid;
123             }
124              
125             sub clear_ext{
126             my ($script)=@_;
127            
128             $script=~s/\..{1,3}$//gs;
129            
130             return $script;
131             }
132              
133             sub daemonize{
134             my (%params)=@_;
135            
136             my $tmp=$params{tmp};
137             $tmp=$FindBin::Bin if (!$tmp || !(-d $tmp));
138            
139             my $in=$ARGV[0];
140            
141             my $funcs_in={
142             'start'=>\&start,
143             'stop'=>\&stop,
144             'restart'=>\&restart,
145             'pid'=>\&pid
146             };
147              
148             if (!$funcs_in->{$in}){
149             delete $funcs_in->{pid};
150             die 'Dont`t know input parameter '."'$in'\nTry to ".join(",", sort(keys(%{$funcs_in})))."\n";
151             } else {
152             &{$funcs_in->{$in}}($tmp);
153            
154             if ($in ne 'pid'){
155             die "EXIT\n";
156             }
157             }
158             }
159              
160             =head2 daemonize(%params)
161              
162             %options - only one parameter yet tmp=>'/some/tmp/dir', if not exists then tmp dir takes from directory where your script placed.
163             =cut
164              
165             =head1 SEE ALSO
166              
167             L
168              
169             =head1 AUTHOR
170              
171             Bulichev Evgeniy, >.
172              
173             =head1 COPYRIGHT
174              
175             Copyright (c) 2017 Bulichev Evgeniy. All rights reserved.
176             This module is free software; you can redistribute it and/or modify it
177             under the same terms as Perl itself.
178              
179             =cut
180              
181              
182             1;