X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=da4923ca78d734bb385f81bc8347c8adcacd915d;hb=d9e417f46628d78ad60adcc7613b8841f6e24342;hp=cb3d2498afa2af761bb20f18b9320a6c1419b47f;hpb=b916501e3239371f7c4b70e9657ccb97c8ff7c03;p=gitmo%2FMooseX-Daemonize.git
diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm
index cb3d249..da4923c 100644
--- a/lib/MooseX/Daemonize.pm
+++ b/lib/MooseX/Daemonize.pm
@@ -2,14 +2,16 @@ package MooseX::Daemonize;
use strict; # because Kwalitee is pedantic
use Moose::Role;
-our $VERSION = 0.04;
-use Carp;
-use Proc::Daemon;
+use MooseX::Daemonize::Types;
-use File::Pid;
-use Moose::Util::TypeConstraints;
+our $VERSION = 0.05;
-with qw(MooseX::Getopt);
+with qw[
+ MooseX::Daemonize::Core
+ MooseX::Daemonize::WithSignalHandling
+ MooseX::Daemonize::WithPidFile
+ MooseX::Getopt
+];
has progname => (
isa => 'Str',
@@ -22,77 +24,50 @@ has progname => (
},
);
-has basedir => (
- isa => 'Str',
+has pidbase => (
+ isa => 'Path::Class::Dir',
is => 'ro',
- required => 1,
+ coerce => 1,
+ required => 1,
lazy => 1,
- default => sub { return '/' },
+ default => sub { Path::Class::Dir->new('var', 'run') },
);
-has pidbase => (
- isa => 'Str',
+has basedir => (
+ isa => 'Path::Class::Dir',
is => 'ro',
- lazy => 1,
+ coerce => 1,
required => 1,
- default => sub { return '/var/run' },
-);
-
-subtype 'Pidfile' => as 'Object' => where { $_->isa('File::Pid') };
-
-coerce 'Pidfile' => from 'Str' => via { File::Pid->new( { file => $_, } ); };
-
-has pidfile => (
- isa => 'Pidfile',
- is => 'rw',
- lazy => 1,
- required => 1,
- coerce => 1,
- predicate => 'has_pidfile',
- default => sub {
- my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
- die "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase);
- File::Pid->new( { file => $file } );
- },
- handles => {
- check => 'running',
- save_pid => 'write',
- remove_pid => 'remove',
- get_pid => 'pid',
- _pidfile => 'file',
- },
+ lazy => 1,
+ default => sub { Path::Class::Dir->new('/') },
);
has foreground => (
- metaclass => 'MooseX::Getopt::Meta::Attribute',
+ metaclass => 'Getopt',
cmd_aliases => 'f',
isa => 'Bool',
is => 'ro',
default => sub { 0 },
);
-has is_daemon => (
- isa => 'Bool',
- is => 'rw',
- default => sub { 0 },
-);
-
has stop_timeout => (
isa => 'Int',
is => 'rw',
- default => 2
+ default => sub { 2 }
);
-sub daemonize {
- my ($self) = @_;
- return if Proc::Daemon::Fork;
- Proc::Daemon::Init;
- $self->is_daemon(1);
+sub init_pidfile {
+ my $self = shift;
+ my $file = $self->pidbase . '/' . $self->progname . '.pid';
+ confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
+ MooseX::Daemonize::PidFile->new( file => $file );
}
sub start {
my ($self) = @_;
- confess "instance already running" if $self->check;
+
+ confess "instance already running" if $self->pidfile->running;
+
$self->daemonize unless $self->foreground;
return unless $self->is_daemon;
@@ -108,7 +83,7 @@ sub start {
# Change to basedir
chdir $self->basedir;
- $self->save_pid;
+ $self->pidfile->write;
$self->setup_signals;
return $$;
}
@@ -118,9 +93,9 @@ my $_kill;
sub stop {
my ( $self, %args ) = @_;
- my $pid = $self->get_pid;
+ my $pid = $self->pidfile->pid;
$self->$_kill($pid) unless $self->foreground();
- $self->remove_pid;
+ $self->pidfile->remove;
return 1 if $args{no_exit};
exit;
}
@@ -131,10 +106,10 @@ sub restart {
$self->start();
}
-sub setup_signals {
- my ($self) = @_;
- $SIG{INT} = sub { $self->handle_sigint; };
- $SIG{HUP} = sub { $self->handle_sighup };
+sub handle_signal {
+ my ($self, $signal) = @_;
+ return $self->handle_sigint if $signal eq 'INT';
+ return $self->handle_sighup if $signal eq 'HUP';
}
sub handle_sigint { $_[0]->stop; }
@@ -162,24 +137,24 @@ $_kill = sub {
# Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
- my ($signal, $timeout) = @$_;
- $timeout = int $timeout;
-
- CORE::kill($signal, $pid);
-
- last unless CORE::kill 0 => $pid or $!{EPERM};
-
- while ($timeout) {
- sleep(1);
+ my ($signal, $timeout) = @$_;
+ $timeout = int $timeout;
+
+ CORE::kill($signal, $pid);
+
last unless CORE::kill 0 => $pid or $!{EPERM};
- $timeout--;
- }
+
+ while ($timeout) {
+ sleep(1);
+ last unless CORE::kill 0 => $pid or $!{EPERM};
+ $timeout--;
+ }
}
return unless ( CORE::kill 0 => $pid or $!{EPERM} );
# IF it is still running
- carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
+ Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
};
1;
@@ -225,17 +200,17 @@ to do that.
=over
-=item progname Str
+=item progname Path::Class::Dir | Str
The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
-=item pidbase Str
+=item pidbase Path::Class::Dir | Str
The base for our bid, defaults to /var/run/$progname
-=item pidfile Str
+=item pidfile MooseX::Daemonize::PidFile | Str
-The file we store our PID in, defaults to /var/run/$progname/
+The file we store our PID in, defaults to /var/run/$progname
=item foreground Bool
@@ -258,10 +233,6 @@ it. Defaults to 2 seconds
=over
-=item check()
-
-Check to see if an instance is already running.
-
=item start()
Setup a pidfile, fork, then setup the signal handlers.
@@ -293,18 +264,6 @@ Handle a INT signal, by default calls C<$self->stop()>
Handle a HUP signal. By default calls C<$self->restart()>
-=item get_pid
-
-Lookup the pid from our pidfile.
-
-=item save_pid
-
-Save the current pid in our pidfile
-
-=item remove_pid
-
-Delete our pidfile
-
=item meta()
The C method from L
@@ -319,7 +278,7 @@ The C method from L
the module is part of the standard Perl distribution, part of the
module's distribution, or must be installed separately. ]
-Obviously L, also L, L, L
+Obviously L, and L
=head1 INCOMPATIBILITIES
@@ -363,6 +322,8 @@ Chris Prather C<< >>
Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
#moose denzians
+Some bug fixes sponsored by Takkle Inc.
+
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2007, Chris Prather C<< >>. All rights