File Coverage

blib/lib/Proc/Launcher.pm
Criterion Covered Total %
statement 181 205 88.2
branch 66 94 70.2
condition 3 3 100.0
subroutine 24 24 100.0
pod 15 15 100.0
total 289 341 84.7


line stmt bran cond sub pod time code
1             package Proc::Launcher;
2 22     22   62302 use strict;
  22         46  
  22         959  
3 22     22   108 use warnings;
  22         36  
  22         916  
4              
5             our $VERSION = '0.0.35'; # VERSION
6              
7 22     22   17300 use Mouse;
  22         676756  
  22         178  
8              
9             #_* Libraries
10              
11 22     22   7887 use File::Path;
  22         43  
  22         1883  
12 22     22   22024 use File::Tail;
  22         823945  
  22         1479  
13 22     22   18762 use POSIX qw(setsid :sys_wait_h);
  22         173598  
  22         175  
14              
15             #_* POD
16              
17             =head1 NAME
18              
19             Proc::Launcher - yet another forking process controller
20              
21              
22             =head1 VERSION
23              
24             version 0.0.35
25              
26             =head1 SYNOPSIS
27              
28             use Proc::Launcher;
29              
30             # define a method to start your application if it isn't already running
31             use MyApp;
32             my $start_myapp = sub { MyApp->new( context => $some_shared_data )->run() };
33              
34             # create a new launcher object
35             my $launcher = Proc::Launcher->new( start_method => $start_myapp,
36             daemon_name => 'myapp',
37             );
38              
39             # an alternate version of the same thing without the subroutine reference
40             my $launcher = Proc::Launcher->new( class => 'MyApp',
41             start_method => 'run'
42             context => $some_shared_data,
43             daemon_name => 'myapp',
44             );
45              
46             # check if the process was already running
47             if ( $launcher->is_running() ) { warn "Already running!\n" }
48              
49             # start the process if there isn't already one running
50             $launcher->start();
51              
52             # shut down the process if it is already running. start a new process.
53             $launcher->restart();
54              
55             # get the process pid
56             my $pid = $launcher->pid();
57              
58             # kill -HUP
59             $launcher->stop();
60              
61             # kill -9
62             $launcher->force_stop();
63              
64             # get the process log file path
65             my $log = $launcher->log_file;
66              
67             =head1 DESCRIPTION
68              
69             This library is designed to fork one or more long-running background
70             processes and to manage them. This includes starting, stopping, and
71             automatically restarting processes--even those that don't behave well.
72              
73             The pid of the forked child processes are written to pid files and
74             persist across multiple restarts of the launcher. This means that
75             stdout/stderr/stdin of the children are not directly connected to the
76             launching process. All stdout and stderr from the child processes is
77             written to a log file.
78              
79             For more useful functions (e.g. a supervisor to restart processes that
80             die), see L.
81              
82             =head1 RELATED WORK
83              
84             There are a large number of modules already on CPAN for forking and
85             managing child processes, and also for managing daemon processes
86             (apachectl style). After doing a lot of reading and experimentation,
87             I unfortunately ended up deciding to write yet another one. Here is a
88             bit of information on related modules and how this one differs.
89              
90             While it is possible to exec() and manage external executables in the
91             child processes, that is merely an afterthought in this module. If
92             you are looking for a module to start and manage external executables,
93             you might also want to check out L, L,
94             L, or L on CPAN, or ControlFreak on github.
95              
96             If you are looking to investigate and/or kill running processes IDs,
97             see L, L, or L. This
98             module only manages processes that have been forked by this module.
99              
100             If you only want to read and write a PID file, see L.
101              
102             On the other hand, if you're looking for a library to fork dependent
103             child processes that maintain stdout/stderr/stdin connected to the
104             child, check out L, L, L,
105             L, L, etc. This module assumes that all
106             child processes will close stdin/stdout/stderr and will continue to
107             live even after the launching process has exited. Furthermore the
108             launched process will be manageable by launchers that are started
109             after the launched process is already running.
110              
111             This library does not do anything like forking/pre-forking multiple
112             processes for a single daemon (e.g. for a high-volume server, see
113             L) or limiting the maximum number of running
114             child processes (see L or L). Instead
115             it is assumed that you are dealing with is a fixed set of named
116             daemons, each of which is associated with a single process to be
117             managed. Of course any managed processes could fork it's own
118             children. Note that only the process id of the immediate child will
119             be managed--any child processes created by child process
120             (grandchildren of the launcher) are not tracked.
121              
122             Similarly your child process should never do a fork() and exit() or
123             otherwise daemonize on it's own. When the child does this, the
124             launcher will lose track of the grandchild pid and assume it has shut
125             down. This may result in restarting your service while it is already
126             running.
127              
128             This library does not handle command line options--that is left to
129             your application/script. It does not export any methods nor require
130             you to inherit from any classes or to build any subclasses. This
131             means that you can launch a process from any normal perl subroutine or
132             object method--the launched class/method/subroutine does not have to
133             be modified to be daemonized.
134              
135             This library does not use or require an event loop (e.g. AnyEvent,
136             POE, etc.), but is fully usable from with an event loop since objects
137             of this class avoid calling sleep() (doing so inside a single-threaded
138             event loop causes everything else running in the event loop to wait).
139             This does mean that methods such as stop() will return immediately
140             without providing a status. See more about this in the note below in
141             rm_zombies().
142              
143             For compatibility with the planned upcoming L module
144             (which uses L), this module and it's dependencies are
145             written in pure perl.
146              
147             The intended use for this library is that a supervising process will
148             acquire some (immutable) global configuration data which is then
149             passed (at fork time) to one or more long-running component daemon
150             processes. In the Panoptes project, this library is used for starting
151             and managing the various Panoptes components on each node
152             (L, L, L,
153             etc.) and also for managing connections to the remote agents.
154              
155             If you are aware of any other noteworthy modules in this vein, please
156             let me know!
157              
158             =cut
159              
160             #_* Roles
161              
162             with 'Proc::Launcher::Roles::Launchable';
163              
164             #_* Attributes
165              
166             =head1 CONSTRUCTOR OPTIONS
167              
168             The constructor supports the following options, e.g.:
169              
170             my $launcher = Proc::Launcher->new( debug => 1, ... );
171              
172             Each of these attributes will also have a getter, e.g.:
173              
174             if ( $launcher->debug ) { print "DEBUGGING ENABLED!\n" }
175              
176             All attributes are read-only unless otherwise specified. Read/write
177             attributes may be set like so:
178              
179             $launcher->debug( 1 );
180              
181             =over 8
182              
183             =item debug => 0
184              
185             Enable debugging messages to STDOUT. This attribute is read/write.
186              
187             =cut
188              
189             has 'debug' => ( is => 'rw', isa => 'Bool', default => 0 );
190              
191             =item daemon_name => 'somename'
192              
193             Specify the name of the daemon. This will be used as the prefix for
194             the log file, pid file, etc.
195              
196             =cut
197              
198             has 'daemon_name' => ( is => 'ro', isa => 'Str', required => 1 );
199              
200             =item context => $data
201              
202             Context data to be passed to the forked processes. This could be any
203             complex data structure and may contain things like configuration data.
204              
205             =cut
206              
207             has 'context' => ( is => 'ro', default => sub { {} } );
208              
209             =item class => 'My::App'
210              
211             Name of the class where the start method is located. An object of
212             this class will be created, passing in your context data. Then the
213             start_method will be called on the object.
214              
215             =cut
216              
217             has 'class' => ( is => 'ro', isa => 'Str' );
218              
219             =item start_method => 'start_me'
220              
221             If a class is specified, this is the name of the start method in that
222             class.
223              
224             If no class is specified, this must be a subroutine reference.
225              
226             =cut
227              
228             has 'start_method' => ( is => 'ro', required => 1 );
229              
230             =item pid_dir => "$ENV{HOME}/logs"
231              
232             Specify the directory where the pid file should live.
233              
234             =cut
235              
236             has 'pid_dir' => ( is => 'ro',
237             isa => 'Str',
238             lazy => 1,
239             default => sub {
240             my $dir = join "/", $ENV{HOME}, "logs";
241             unless ( -d $dir ) { mkpath( $dir ); }
242             return $dir;
243             },
244             );
245              
246             =item pid_file => "$pid_dir/$daemon_name.pid"
247              
248             Name of the pid file.
249              
250             =cut
251              
252             has 'pid_file' => ( is => 'ro',
253             isa => 'Str',
254             lazy => 1,
255             default => sub {
256             my ( $self ) = @_;
257             my $daemon = $self->daemon_name;
258             return join "/", $self->pid_dir, "$daemon.pid";
259             },
260             );
261              
262             =item disable_file => "$pid_dir/$daemon_name.disabled"
263              
264             Location to the 'disable' file. If this file exists, the daemon will
265             not be started when start() is called.
266              
267             =cut
268              
269             has 'disable_file' => ( is => 'ro',
270             isa => 'Str',
271             lazy => 1,
272             default => sub {
273             my ( $self ) = @_;
274             my $daemon = $self->daemon_name;
275             return join "/", $self->pid_dir, "$daemon.disabled";
276             },
277             );
278              
279             =item log_file => "$pid_dir/$daemon_name.log"
280              
281             Path to the daemon log file. The daemon process will have both stdout
282             and stderr redirected to this log file.
283              
284             =cut
285              
286             has 'log_file' => ( is => 'ro',
287             isa => 'Str',
288             lazy => 1,
289             default => sub {
290             my $self = shift;
291             my $daemon = $self->daemon_name;
292             return join "/", $self->pid_dir, "$daemon.log";
293             },
294             );
295              
296             has 'file_tail' => ( is => 'ro',
297             isa => 'File::Tail',
298             lazy => 1,
299             default => sub {
300             my $self = shift;
301             unless ( -r $self->log_file ) { system( 'touch', $self->log_file ) }
302             return File::Tail->new( name => $self->log_file,
303             nowait => 1,
304             interval => 1,
305             maxinterval => 1,
306             resetafter => 600,
307             );
308             },
309             );
310              
311              
312             =item pipe => 0
313              
314             If set to true, specifies that the forked process should create a
315             named pipe. The forked process can then read from the named pipe on
316             STDIN. If your forked process does not read from and process STDIN,
317             then there's no use in enabling this option.
318              
319             =cut
320              
321             has 'pipe' => ( is => 'ro',
322             isa => 'Bool',
323             default => 0,
324             );
325              
326             =item pipe_file => "$pid_dir/$daemon_name.cmd"
327              
328             Path to the named pipe.
329              
330             =cut
331              
332             has 'pipe_file' => ( is => 'ro',
333             isa => 'Str',
334             lazy => 1,
335             default => sub {
336             my $self = shift;
337             my $daemon = $self->daemon_name;
338             return join "/", $self->pid_dir, "$daemon.cmd";
339             },
340             );
341              
342             #_* Methods
343              
344             =back
345              
346             =head1 METHODS
347              
348             =over 8
349              
350             =item start( $data )
351              
352             Fork a child process. The process id of the forked child will be
353             written to a pid file.
354              
355             The child process will close STDIN and redirect all stdout and stderr
356             to a log file, and then will execute the child start method and will
357             be passed any optional $data that was passed to the start method.
358              
359             Note that there is no ongoing communication channel set up with the
360             child process. Changes to $data in the supervising process will never
361             be available to the child process(es). In order to force the child to
362             pick up the new data, you must stop the child process and then start a
363             new process with a copy of the new data.
364              
365             If the process is found already running, then the method will
366             immediately return null. If a process was successfully forked,
367             success will be returned. Success does not imply that the daemon was
368             started successfully--for that, check is_running().
369              
370             =cut
371              
372             sub start {
373 29     29 1 87 my ( $self, $args ) = @_;
374              
375 29 100       173 unless ( $self->is_enabled ) {
376 4         814 print $self->daemon_name, " daemon disabled, not starting\n";
377 4         25 return;
378             }
379              
380 25 100       104 if ( $self->is_running() ) {
381 1         4 $self->_debug( "Already running, no start needed" );
382 1         7 return;
383             }
384              
385 24         165 my $log = $self->log_file;
386              
387 24 100       41169 if ( my $pid = fork ) { # PARENT
388              
389 19         8200 print "LAUNCHED CHILD PROCESS: pid=$pid log=$log\n";
390              
391             CHECK_PID:
392 19         840 for ( 1 .. 5 ) {
393              
394 44         1056 $self->_debug( "Checking if our child locked the pidfile" );
395              
396             # attempt to read the pidfile
397 44         715 my $locked_pid = $self->pid();
398              
399 44         401 $self->_debug( "Got locked pid: $locked_pid" );
400              
401             # check if the pidfile is locked by a valid process
402 44 100 100     886 if ( $locked_pid && $self->is_running( $pid ) ) {
403              
404 17         146 $self->_debug( "Pid is running: $pid" );
405              
406             # check if the pid that has the lock is our child process
407 17 50       91 if ( $locked_pid == $pid ) {
408              
409 17         75 $self->_debug( "Locked pid is our child pid: $pid" );
410 17         973 return $pid;
411             }
412             else {
413 0         0 $self->_debug( "Locked pid is NOT our child pid: $pid" );
414 0         0 print "CHILD PROCESS ALREADY RUNNING\n";
415 0         0 return;
416             }
417             }
418              
419 27         29004923 sleep 1;
420             }
421             }
422             else { # CHILD
423              
424 5 50       576 unless ( $self->write_my_pid( $$ ) ) {
425 0         0 $self->_debug( "CHILD FAILED TO LOCK PIDFILE: $pid" );
426 0         0 exit 1;
427             }
428              
429             #chdir '/' or die "Can't chdir to /: $!";
430              
431             # wu - ugly bug fix - when closing STDIN, it becomes free and
432             # may later get reused when calling open (resulting in error
433             # 'Filehandle STDIN reopened as $fh only for output'). :/ So
434             # instead of closing, just re-open to /dev/null.
435 5 50       774 open STDIN, '<', '/dev/null' or die "$!";
436              
437 5 50       1152 open STDOUT, '>>', $self->log_file or die "Can't write stdout to $log: $!";
438 5 50       289 open STDERR, '>>', $self->log_file or die "Can't write stderr to $log: $!";
439              
440 5 50       264 setsid or die "Can't start a new session: $!";
441              
442             #umask 0;
443              
444             # this doesn't work on most platforms
445 5         299 $0 = join " - ", "perl", "Proc::Launcher", $self->daemon_name;
446              
447 5         464 print "\n\n", ">" x 77, "\n";
448 5         1449 print "Starting process: pid = $$: ", scalar localtime, "\n\n";
449              
450 5 100       194 if ( $self->pipe ) {
451 1         111 my $named_pipe = $self->pipe_file;
452 1         31 print "CREATING NAMED PIPE: $named_pipe\n";
453 1 50       55 unless (-p $named_pipe) {
454 1         35 unlink $named_pipe;
455 1 50       103 POSIX::mkfifo( $named_pipe, 0700) or die "can't mkfifo $named_pipe: $!"; ## no critic - leading zero
456             }
457 1 50       6821470 open STDIN, '<', $named_pipe or die "$!";
458             }
459              
460             # child
461 5 100       52 if ( $self->class ) {
462              
463 2         15 my $class = $self->class;
464 2         28 print "Loading Class: $class\n";
465              
466 2         1045 eval "require $class"; ## no critic
467              
468 2         4285 my $error = $@;
469 2 50       9 if ( $error ) {
470 0         0 $self->stopped();
471 0         0 die "FATAL ERROR LOADING $class: $error\n";
472             }
473             else {
474 2         67 print "Successfully loaded class\n";
475             }
476              
477 2         28 print "Creating an instance of $class\n";
478 2         5 my $obj;
479             eval { # try
480 2         50 $obj = $class->new( context => $self->context );
481 2         137 1;
482 2 50       7 } or do { # catch
483 0         0 $self->stopped();
484 0         0 die "FATAL: unable to create an instance: $@\n";
485             };
486 2         32 print "Created\n";
487              
488 2         15 my $method = $self->start_method;
489 2         25 print "Calling method on instance: $method\n";
490              
491             eval { # try
492 2         7 $obj->$method( $args );
493 2         10000536 1;
494 2 50       5 } or do { # catch
495 0         0 $self->stopped();
496 0         0 die "FATAL: $@\n";
497             };
498              
499             }
500             else {
501 3         98 print "STARTING\n";
502             eval { # try
503 3         161 $self->start_method->( $args );
504 1         163 1;
505 3 50       78 } or do { # catch
506             # error
507 0         0 print "ERROR: $@\n";
508             };
509              
510             }
511              
512             # cleanup
513 3         146 print "EXITED\n";
514 3         59 $self->stopped();
515              
516 3         1774 exit;
517             }
518             }
519              
520             =item stop()
521              
522             If the process id is active, send it a kill -HUP.
523              
524             =cut
525              
526             sub stop {
527 10     10 1 45 my ( $self ) = @_;
528              
529 10 100       57 if ( ! $self->is_running() ) {
530 1         6 $self->_debug( "Process not found running" );
531 1         1 return 1;
532             }
533              
534 9         36 my $pid = $self->pid();
535              
536 9         76 $self->_debug( "Killing process: $pid" );
537 9         1639 my $status = kill 1 => $pid;
538              
539 9         49 return $status;
540             }
541              
542             =item restart( $data, $sleep )
543              
544             Calls the stop() method, followed by the start() method, optionally
545             passing some $data to the start() method.
546              
547             This method is not recommended since it doesn't check the status of
548             stop(). Instead, call stop(), wait a bit, and then check that the
549             process has shut down before trying to start it again.
550              
551             WARNING: this method calls sleep to allow a process to shut down
552             before trying to start it again. If sleep is set to 0, the child
553             process won't have time to exit, and thus the start() method will
554             never run. As a result, this method is not recommended for use in a
555             single-threaded cooperative multitasking environments such as POE.
556              
557             =cut
558              
559             sub restart {
560 3     3 1 936 my ( $self, $data, $sleep ) = @_;
561              
562 3         16 $self->stop();
563              
564 3 100       10 $sleep = $sleep ? $sleep : 1;
565 3         4000483 sleep $sleep;
566              
567 3         42 $self->start( $data );
568             }
569              
570              
571             =item is_running()
572              
573             Check if a process is running by sending it a 'kill -0' and checking
574             the return status.
575              
576             Before checking the process, rm_zombies() will be called to allow any
577             child processes that have exited to be reaped. See a note at the
578             rm_zombies() method about the leaky abstraction here.
579              
580             If the pid is not active, the stopped() method will also be called to
581             ensure the pid file has been removed.
582              
583             =cut
584              
585             sub is_running {
586 131     131 1 172024 my ( $self, $pid ) = @_;
587              
588 131 100       758 unless ( $pid ) { $pid = $self->pid() }
  112         536  
589              
590 131 100       799 return unless $pid;
591              
592             # clean up deceased child processes before checking if processes
593             # are running.
594 64         513 $self->rm_zombies();
595              
596 64         691 $self->_debug( "CHECKING PID: $pid" );
597              
598 64 100       1021 if ( kill 0 => $pid ) {
599 22 50   22   83836 if ( $!{EPERM} ) {
  22         28854  
  22         28527  
  50         1535  
600             # if process id isn't owned by us, it is assumed to have
601             # been recycled, i.e. our process died and the process id
602             # was assigned to another process.
603 0         0 $self->_debug( "Process id active but owned by someone else" );
604             }
605             else {
606 50         1668 $self->_debug( "STILL RUNNING" );
607 50         696 return $self->daemon_name;
608             }
609             }
610              
611 14         125 $self->_debug( "PROCESS NOT RUNNING" );
612              
613             # process is not running, ensure the pidfile has been cleaned up
614 14         59 $self->stopped();
615              
616 14         105 return;
617             }
618              
619             =item rm_zombies()
620              
621             Calls waitpid to clean up any child processes that have exited.
622              
623             waitpid is called with the WNOHANG option so that it will always
624             return instantly to prevent hanging.
625              
626             Normally this is called when the is_running() method is called (to
627             allow child processes to exit before polling if they are still
628             active). If you are using a Proc::Launcher in a long-lived process,
629             after stopping a daemon you should always call is_running() until you
630             get a false response (i.e. the process has successfully stopped). If
631             you do not call is_running() until the process exits, you will create
632             zombies.
633              
634             =cut
635              
636             sub rm_zombies {
637 74     74 1 1087 waitpid(-1, WNOHANG);
638             }
639              
640             =item force_stop()
641              
642             If the process id is active, then send a 'kill -9'.
643              
644             =cut
645              
646             sub force_stop {
647 9     9 1 962 my ( $self ) = @_;
648              
649 9 100       51 if ( ! $self->is_running() ) {
650 3         28 $self->_debug( "Process not found running" );
651 3         983 return 1;
652             }
653              
654 6         40 $self->_debug( "Process still running, executing with kill -9" );
655 6         31 my $status = kill 9 => $self->pid();
656              
657 6         581 return $status;
658             }
659              
660              
661             =item stopped()
662              
663             This method is called when a process has been detected as successfully
664             shut down. The pidfile will be removed if it still exists.
665              
666             =cut
667              
668             sub stopped {
669 17     17 1 57 my ( $self ) = @_;
670              
671 17         88 $self->_debug( "Process exited" );
672              
673             # remove the pidfile
674 17         111 $self->remove_pidfile();
675              
676             # remove the named pipe if one was enabled
677 17 100       216 if ( $self->pipe ) { unlink $self->pipe_file }
  1         98  
678             }
679              
680             =item pid()
681              
682             Read and return the pid from the pidfile.
683              
684             The pid is validated to ensure it is a number. If an invalid pid is
685             found, 0 is returned.
686              
687             =cut
688              
689             sub pid {
690 176     176 1 519 my ( $self ) = @_;
691              
692 176         1371 my $path = $self->pid_file;
693              
694 176 100       7196 unless ( -r $path ) {
695 92         547 return 0;
696             }
697              
698 84         896 $self->_debug( "READING PID FROM: $path" );
699              
700 84 50       6848 open(my $fh, "<", $path)
701             or die "Couldn't open $path for reading: $!\n";
702              
703 84         2722 my $line = <$fh>;
704              
705 84 50       1609 close $fh or die "Error closing file: $!\n";
706              
707 84 100       263 return 0 unless $line;
708 83         242 chomp $line;
709 83 50       250 return 0 unless $line;
710              
711 83 50       1311 unless ( $line =~ m|^\d+$| ) {
712 0         0 warn "ERROR: PID doesn't look like a number: $line";
713 0         0 return 0;
714             }
715              
716 83         911 return $line;
717             }
718              
719             =item write_my_pid()
720              
721             Write the pid to the pid file.
722              
723             This operation involves checking a couple of times to make sure that
724             no other process is running or trying to start another process at the
725             same time. The pid is actually written to a temporary file and then
726             renamed. Since rename() is an atomic operation on most filesystems,
727             this serves as a basic but effective locking mechanism that doesn't
728             require OS-level locking. This should prevent two processes from both
729             starting a daemon at the same time.
730              
731             =cut
732              
733             sub write_my_pid {
734 5     5 1 263 my ( $self, $pid ) = @_;
735              
736 5 50       135 unless ( $pid ) { $pid = $$ }
  0         0  
737              
738             # try to read the pidfile and see if the pid therein is active
739 5 50       295 return if $self->is_running();
740              
741             # write the pid to a temporary file
742 5         172 my $path = join ".", $self->pid_file, $pid;
743 5         327 $self->_debug( "WRITING PID TO: $path" );
744 5 50       2590 open(my $pid_fh, ">", $path)
745             or die "Couldn't open $path for writing: $!\n";
746 5         133 print $pid_fh $pid;
747 5 50       504 close $pid_fh or die "Error closing file: $!\n";
748              
749             # if some other process has created a pidfile since we last
750             # checked, then it won and we lost
751 5 50       179 if ( -r $self->pid_file ) {
752 0         0 $self->_debug( "Pidfile already created by another process" );
753             return
754 0         0 }
755              
756             # atomic operation
757 5 50       873 unless ( rename $path, $self->pid_file ) {
758 0         0 $self->_debug( "Unable to lock pidfile $path for $pid" );
759 0         0 return;
760             }
761              
762 5         55 $self->_debug( "Successfully renamed pidfile to $path: $pid" );
763              
764 5         82 return 1;
765             }
766              
767             =item remove_pidfile
768              
769             Remove the pidfile. This should only be done after the process has
770             been verified as shut down.
771              
772             Failure to remove the pidfile is not a fatal error.
773              
774             =cut
775              
776             sub remove_pidfile {
777 18     18 1 50 my ( $self ) = @_;
778              
779 18 50       816 return unless -r $self->pid_file;
780              
781 18         402 $self->_debug( "REMOVING PIDFILE: " . $self->pid_file );
782 18         448089 unlink $self->pid_file;
783             }
784              
785             =item read_log
786              
787             Return any new log data since the last offset was written. If there
788             was no offset, set the offset to the current end of file.
789              
790             You may want to call this before performing any operation on the
791             daemon in order to set the position to the end of the file. Then
792             perform your operation, wait a moment, and then call read_log() to get
793             any output generated from your command while you waited.
794              
795             =cut
796              
797             sub read_log {
798 4     4 1 8 my ( $self, $subref ) = @_;
799              
800 4         18 my $name = $self->daemon_name;
801              
802 4         24 while ( my $line=$self->file_tail->read ) {
803 0         0 chomp $line;
804 0         0 $subref->( "$name: $line" );
805             }
806              
807 4         10290 return 1;
808             }
809              
810             =item write_pipe( $string )
811              
812             Write text to the process's named pipe. The child can then read this
813             data from it's STDIN.
814              
815             Simply returns false if a named pipe was not enabled.
816              
817             =cut
818              
819             sub write_pipe {
820 1     1 1 6 my ( $self, $string ) = @_;
821              
822 1 50       19 return unless $self->pipe;
823 1         26 $self->_debug( "Writing to pipe" );
824              
825 1 50       42 unless ( -r $self->pipe_file ) {
826 0         0 $self->_debug( "Pipe found but not readable" );
827 0         0 return;
828             }
829              
830             # remove any trailing whitespace
831 1         25 chomp $string;
832              
833             # blast the string out to the named pipe
834 1 50       3 print { sysopen (my $fh , $self->pipe_file, &POSIX::O_WRONLY) or die "$!\n"; $fh } $string, "\n";
  1         172  
  1         31  
835              
836 1         103 return 1;
837             }
838              
839             =item disable()
840              
841             Create the disable flag file unless it already exists.
842              
843             =cut
844              
845             sub disable {
846 5     5 1 18 my ( $self ) = @_;
847              
848 5 100       43 if ( $self->is_enabled() ) {
849 4         26126 system( "touch", $self->disable_file );
850             }
851              
852 5         233 return 1;
853             }
854              
855             =item enable()
856              
857             If the disable flag file exists, remove it.
858              
859             =cut
860              
861             sub enable {
862 5     5 1 11 my ( $self ) = @_;
863              
864 5 100       18 unless ( $self->is_enabled() ) {
865 4         397 unlink $self->disable_file;
866             }
867              
868 5         28 return 1;
869             }
870              
871             =item is_enabled()
872              
873             Check if the launcher is enabled.
874              
875             If the disable flag file exists, then the launcher will be considered
876             disabled.
877              
878             =cut
879              
880             sub is_enabled {
881 44     44 1 105 my ( $self ) = @_;
882              
883 44 100       1011 return if -r $self->disable_file;
884              
885 33         163 return 1;
886             }
887              
888             # debugging output
889             sub _debug {
890 400     400   1819802 my ( $self, @lines ) = @_;
891              
892 400 100       2480 return unless $self->debug;
893              
894 18         82 for my $line ( @lines ) {
895 18         87 chomp $line;
896 18         3889 print "$line\n";
897             }
898             }
899              
900 22     22   172 no Mouse;
  22         56  
  22         239  
901              
902             1;
903              
904             __END__