File Coverage

blib/lib/App/Framework/Extension/Daemon.pm
Criterion Covered Total %
statement 12 42 28.5
branch 0 10 0.0
condition 0 3 0.0
subroutine 4 8 50.0
pod 3 3 100.0
total 19 66 28.7


line stmt bran cond sub pod time code
1             package App::Framework::Extension::Daemon ;
2              
3             =head1 NAME
4              
5             App::Framework::Daemon - Daemonize an application
6              
7             =head1 SYNOPSIS
8              
9             use App::Framework '::Daemon' ;
10              
11              
12             =head1 DESCRIPTION
13              
14             App::Framework personality that provides a daemonized program (using Net::Server::Daemonize)
15              
16             B
17              
18             B
19              
20             =cut
21              
22 1     1   5064 use strict ;
  1         3  
  1         54  
23 1     1   7 use Carp ;
  1         3  
  1         122  
24              
25             our $VERSION = "1.000" ;
26              
27              
28             #============================================================================================
29             # USES
30             #============================================================================================
31 1     1   9 use App::Framework::Core ;
  1         2  
  1         24  
32 1     1   8 use App::Framework::Extension ;
  1         2  
  1         544  
33              
34             #============================================================================================
35             # OBJECT HIERARCHY
36             #============================================================================================
37             our @ISA ;
38             our $PRIORITY = 100 ;
39              
40             #============================================================================================
41             # GLOBALS
42             #============================================================================================
43              
44             # Set of script-related default options
45             my @OPTIONS = (
46             # ['log|L=s', 'Log file', 'Specify a log file', ],
47             # ['v|"verbose"', 'Verbose output', 'Make script output more verbose', ],
48             # ['debug=s', 'Set debug level', 'Set the debug level value', ],
49             # ['h|"help"', 'Print help', 'Show brief help message then exit'],
50             # ['man', 'Full documentation', 'Show full man page then exit' ],
51             # ['dryrun|"norun"', 'Dry run', 'Do not execute anything that would alter the file system, just show the commands that would have executed'],
52             ) ;
53              
54             #============================================================================================
55              
56             =head2 FIELDS
57              
58             None
59              
60             =over 4
61              
62             =cut
63              
64             my %FIELDS = (
65             ## Object Data
66             'user' => 'nobody',
67             'group' => 'nobody',
68             'pid' => undef,
69             ) ;
70              
71             #============================================================================================
72              
73             =back
74              
75             =head2 CONSTRUCTOR METHODS
76              
77             =over 4
78              
79             =cut
80              
81             #============================================================================================
82              
83              
84             =item B
85              
86             Create a new App::Framework::Daemon.
87              
88             The %args are specified as they would be in the B method, for example:
89              
90             'mmap_handler' => $mmap_handler
91              
92             The full list of possible arguments are :
93              
94             'fields' => Either ARRAY list of valid field names, or HASH of field names with default values
95              
96             =cut
97              
98             sub new
99             {
100 0     0 1   my ($obj, %args) = @_ ;
101              
102 0   0       my $class = ref($obj) || $obj ;
103              
104             ## Need Net::Server::Daemonize
105 0           eval "use Net::Server::Daemonize;" ;
106 0 0         if (@$)
107             {
108 0           croak "Sorry. You need to have Net::Server::Daemonize installed to be able to use $class" ;
109             }
110              
111             ## create object dynamically
112 0           my $this = App::Framework::Core->inherit($class, %args) ;
113              
114             ## Set options
115 0           $this->feature('Options')->append_options(\@OPTIONS) ;
116            
117             ## hi-jack the app function
118 0     0     $this->extend_fn(
119             'app_fn' => sub {$this->daemon_run(@_);},
120 0           ) ;
121              
122 0           return($this) ;
123             }
124              
125              
126              
127             #============================================================================================
128              
129             =back
130              
131             =head2 CLASS METHODS
132              
133             =over 4
134              
135             =cut
136              
137             #============================================================================================
138              
139             #-----------------------------------------------------------------------------
140              
141             =item B
142              
143             Initialises the object class variables.
144              
145             =cut
146              
147             sub init_class
148             {
149 0     0 1   my $class = shift ;
150 0           my (%args) = @_ ;
151              
152             # Add extra fields
153 0           $class->add_fields(\%FIELDS, \%args) ;
154              
155             # init class
156 0           $class->SUPER::init_class(%args) ;
157              
158             }
159              
160              
161             #============================================================================================
162              
163             =back
164              
165             =head2 OBJECT METHODS
166              
167             =over 4
168              
169             =cut
170              
171             #============================================================================================
172              
173              
174             #----------------------------------------------------------------------------
175              
176             =item B
177              
178             Daemonize then run the application's app subroutine inside a loop.
179            
180             =cut
181              
182              
183             sub daemon_run
184             {
185 0     0 1   my $this = shift ;
186              
187              
188 0           my $use_net=0;
189 0 0         if ($use_net)
190             {
191              
192 0           print "Calling daemonize()...\n" ;
193             ## Daemonize
194 0           Net::Server::Daemonize::daemonize(
195             $this->user, # User
196             $this->group, # Group
197             $this->pid, # Path to PID file - optional
198             );
199 0           print "Calling application run...\n" ;
200            
201             ## call application run
202 0           $this->call_extend_fn('app_fn') ;
203              
204             }
205              
206             else
207             {
208             ##my $pid = safe_fork();
209 0           print "Calling fork()...\n" ;
210 0           my $pid = fork;
211 0 0         unless( defined $pid ){
212 0           die "Couldn't fork: [$!]\n";
213             }
214              
215              
216             ### parent process should do the pid file and exit
217 0 0         if( $pid ){
218              
219 0           print "Killing parent..\n" ;
220 0 0         $pid && exit(0);
221              
222              
223             ### child process will continue on
224             }else{
225              
226            
227 0           print "Calling application run...\n" ;
228            
229             ## call application run
230 0           $this->call_extend_fn('app_fn') ;
231              
232             }
233             }
234              
235              
236              
237             }
238              
239              
240              
241             # ============================================================================================
242             # PRIVATE METHODS
243             # ============================================================================================
244              
245              
246              
247              
248             # ============================================================================================
249             # END OF PACKAGE
250              
251             =back
252              
253             =head1 DIAGNOSTICS
254              
255             Setting the debug flag to level 1 prints out (to STDOUT) some debug messages, setting it to level 2 prints out more verbose messages.
256              
257             =head1 AUTHOR
258              
259             Steve Price C<< >>
260              
261             =head1 BUGS
262              
263             None that I know of!
264              
265             =cut
266              
267              
268             1;
269              
270             __END__