package MooseX::Daemonize;
-use strict; # because Kwalitee is pedantic
+use strict; # because Kwalitee is pedantic
use Moose::Role;
our $VERSION = 0.01;
use Carp;
use Proc::Daemon;
+
use File::Flock;
use File::Slurp;
with qw(MooseX::Getopt);
has progname => (
- isa => 'Str',
- is => 'ro',
- default => sub { lc $_[0]->meta->name },
+ isa => 'Str',
+ is => 'ro',
+ lazy => 1,
+ required => 1,
+ default => sub {
+ ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
+ return $name;
+ },
);
has pidbase => (
is => 'ro',
lazy => 1,
required => 1,
- default => sub { $_[0]->pidbase .'/'. $_[0]->progname . '.pid' },
+ default => sub { $_[0]->pidbase . '/' . $_[0]->progname . '.pid' },
);
has foreground => (
if ( -e $pidfile ) {
my $prog = $self->progname;
chomp( my $pid = read_file($pidfile) );
- unless ( kill 0 => $pid or $!{EPERM} ) {
- carp "$prog already running ($pid).";
- }
- else {
- carp "$prog not running but $pidfile exists. Perhaps it is stale?";
+ if ( kill 0 => $pid ) {
+ croak "$prog already running ($pid).";
}
+ carp "$prog not running but $pidfile exists. Perhaps it is stale?";
return 1;
}
return 0;
}
+sub daemonize {
+ my ($self) = @_;
+ Proc::Daemon::Init;
+}
+
sub start {
my ($self) = @_;
return if $self->check;
lock( $pidfile, undef, 'nonblocking' )
or croak "Could not lock PID file $pidfile: $!";
write_file( $pidfile, "$$\n" );
-
+ unlock($pidfile);
$self->setup_signals;
return;
}
my ($self) = @_;
my $pidfile = $self->pidfile;
unless ( -e $pidfile ) {
- croak $self->progname . 'is not currently running.';
+ carp $self->progname . ' is not currently running.';
+ return;
}
+ chomp( my $pid = read_file($pidfile) );
+ $self->kill($pid) unless $self->foreground();
lock( $pidfile, undef, 'nonblocking' )
or croak "Could not lock PID file $pidfile: $!";
- chomp( my $pid = read_file($pidfile) );
- $self->kill($pid);
unlink($pidfile);
+ unlock($pidfile);
return;
}
$self->start();
}
-sub daemonize {
- my ($self) = @_;
- Proc::Daemon::Init;
-}
-
sub setup_signals {
my $self = @_;
$SIG{INT} = sub { $_[0]->handle_sigint; };
sub kill {
my ( $self, $pid ) = @_;
- unless ( kill 0 => $pid or $!{EPERM} ) {
- carp "$pid appears dead.";
+ unless ( kill 0 => $pid ) {
+ carp "$pid already appears dead.";
return;
}