use strict; # because Kwalitee is pedantic
use Moose::Role;
-our $VERSION = 0.01;
+our $VERSION = 0.01_1;
use Carp;
use Proc::Daemon;
-use File::Flock;
-use File::Slurp;
+use File::Pid;
+use Moose::Util::TypeConstraints;
with qw(MooseX::Getopt);
},
);
+has basedir => (
+ isa => 'Str',
+ is => 'ro',
+ lazy => 1,
+ default => sub { return '/' },
+);
+
has pidbase => (
- isa => 'Str',
- is => 'ro',
- lazy => 1,
- required => 1,
- default => sub { return '/var/run' },
+ isa => 'Str',
+ is => 'ro',
+
+ # required => 1,
+ lazy => 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 => 'Str',
+ isa => 'Pidfile',
is => 'ro',
lazy => 1,
required => 1,
- default => sub { $_[0]->pidbase . '/' . $_[0]->progname . '.pid' },
+ coerce => 1,
+ default => sub {
+ die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase;
+ my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
+ File::Pid->new( { file => $file } );
+ },
+ handles => {
+ check => 'running',
+ save_pid => 'write',
+ remove_pid => 'remove',
+ get_pid => 'pid',
+ },
);
has foreground => (
default => sub { 0 },
);
-sub check {
- my ($self) = @_;
- my $pidfile = $self->pidfile;
- if ( -e $pidfile ) {
- my $prog = $self->progname;
- chomp( my $pid = read_file($pidfile) );
- 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;
$self->daemonize unless $self->foreground;
- my $pidfile = $self->pidfile;
- lock( $pidfile, undef, 'nonblocking' )
- or croak "Could not lock PID file $pidfile: $!";
- write_file( $pidfile, "$$\n" );
- unlock($pidfile);
+ # Avoid 'stdin reopened for output' warning with newer perls
+ ## no critic
+ open( NULL, '/dev/null' );
+ <NULL> if (0);
+ ## use critic
+
+ # Change to basedir
+ chdir $self->basedir;
+
+ $self->save_pid;
$self->setup_signals;
- return;
+ return $$;
}
sub stop {
- my ($self) = @_;
- my $pidfile = $self->pidfile;
- unless ( -e $pidfile ) {
- 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: $!";
- unlink($pidfile);
- unlock($pidfile);
- return;
+ my ( $self, %args ) = @_;
+ my $pid = $self->get_pid;
+ $self->_kill($pid) unless $self->foreground();
+ $self->remove_pid;
+ return 1 if $args{no_exit};
+ exit;
}
sub restart {
my ($self) = @_;
- $self->stop();
+ $self->stop( no_exit => 1 );
$self->start();
}
sub setup_signals {
- my $self = @_;
- $SIG{INT} = sub { $_[0]->handle_sigint; };
- $SIG{HUP} = sub { $_[0]->handle_sighup };
+ my ($self) = @_;
+ $SIG{INT} = sub { $self->handle_sigint; };
+ $SIG{HUP} = sub { $self->handle_sighup };
}
sub handle_sigint { $_[0]->stop; }
-sub handle_sighup { return; }
+sub handle_sighup { $_[0]->restart; }
-sub kill {
+sub _kill {
+ confess "_kill isn't public" unless caller eq __PACKAGE__;
my ( $self, $pid ) = @_;
- unless ( kill 0 => $pid ) {
- carp "$pid already appears dead.";
+ return unless $pid;
+ unless ( CORE::kill 0 => $pid ) {
+
+ # warn "$pid already appears dead.";
+ return;
+ }
+
+ if ( $pid eq $$ ) {
+
+ # warn "$pid is us! Can't commit suicied.";
return;
}
- kill( 2, $pid ); # Try SIGINT
- sleep(1) if kill( 0, $pid );
+ CORE::kill( 2, $pid ); # Try SIGINT
+ sleep(2) if CORE::kill( 0, $pid );
- unless ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- kill( 15, $pid ); # try SIGTERM
- sleep(1) if kill( 0, $pid );
+ unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
+ CORE::kill( 15, $pid ); # try SIGTERM
+ sleep(2) if CORE::kill( 0, $pid );
}
- unless ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- kill( 9, $pid ); # finally try SIGKILL
- sleep(1) if kill( 0, $pid );
+ unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
+ CORE::kill( 9, $pid ); # finally try SIGKILL
+ sleep(3) if CORE::kill( 0, $pid );
}
- unless ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
+ unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
+ carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
}
return;
=item handle_sigint()
-Handle a INT signal, by default calls C<$self->stop()>;
+Handle a INT signal, by default calls C<$self->stop()>
=item handle_sighup()
-Handle a HUP signal. Nothing is done by default.
+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<meta()> method from L<Class::MOP::Class>
+The C<meta()> method from L<Class::MOP::Class>
=back
the module is part of the standard Perl distribution, part of the
module's distribution, or must be installed separately. ]
-Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Flock>, L<File::Slurp>
+Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Pid>
=head1 INCOMPATIBILITIES
Chris Prather C<< <perigrin@cpan.org> >>
+=head1 THANKS
+
+Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, and the #moose denzians
=head1 LICENCE AND COPYRIGHT
projects / gitmo/MooseX-Daemonize.git / blobdiff