Commit f73ca1c5 authored by Salvatore Bonaccorso's avatar Salvatore Bonaccorso

Imported Upstream version 0.16

parent 60380b2e
Revision history for Perl extension App::Daemon.
0.16 (10/21/2012)
(ms) [rt.cpan.org #44462] forked children now don't remove the master's
pid file anymore when they exit. Thanks to Felix Ostmann and
Vadim Troshchinskiy for proposing the fix.
0.15 (02/22/2012)
(ms) [rt.cpan.org #75219] Umask is now set to 0 to allow OS calls
to provide their own permission masks and not to depend on the
......
......@@ -2,7 +2,7 @@ package App::Daemon;
use strict;
use warnings;
our $VERSION = '0.15';
our $VERSION = '0.16';
use Getopt::Std;
use Pod::Usage;
......@@ -180,9 +180,26 @@ sub daemonize {
detach( $as_user );
}
my $prev_sig = $SIG{__DIE__};
my $master_pid = $$;
DEBUG "Defining die handler";
$SIG{__DIE__} = sub {
# Make sure it's not an eval{} triggering the handler.
if(defined $^S && $^S==0) {
DEBUG __PACKAGE__, " die handler triggered.";
# In case we had a previously defined signal handler, call
# it first and add ours to the end of the chain.
$prev_sig->(@_) if ($prev_sig);
if( $master_pid != $$ ) {
# Verify that it's the main process calling the
# handler and not a previously forked child.
DEBUG "Die handler called for pid $$ but master pid is $master_pid";
} elsif( !defined $^S or $^S != 0 ) {
# Make sure it's not an eval{} triggering the handler.
DEBUG "Die handler called by eval. Ignored.";
} else {
DEBUG "Die handler removes pidfile $pidfile";
unlink $pidfile or warn "Cannot remove $pidfile";
}
};
......
......@@ -4,6 +4,7 @@ Changes
Daemon.pm
eg/test-daemon
eg/test-detach
eg/test-fork-daemon
Makefile.PL
MANIFEST
MANIFEST.SKIP
......@@ -11,5 +12,6 @@ README
t/001Basic.t
t/002Params.t
t/003CmdLine.t
t/004Pidfile.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
......@@ -50,5 +50,5 @@
"url" : "http://github.com/mschilli/app-daemon"
}
},
"version" : "0.15"
"version" : "0.16"
}
......@@ -29,4 +29,4 @@ requires:
Test::More: 0
resources:
repository: http://github.com/mschilli/app-daemon
version: 0.15
version: 0.16
######################################################################
App::Daemon 0.15
App::Daemon 0.16
######################################################################
NAME
......
#!/usr/local/bin/perl -w
use strict;
use Log::Log4perl qw(:easy);
# Program:
use App::Daemon qw( daemonize );
daemonize();
my $pid = fork();
if( !defined $pid ) {
die "fork failed";
}
if( $pid ) {
# parent
} else {
# child
INFO "child exits";
die "Aiieeeeeh";
}
waitpid $pid, 0;
INFO "parent waitpid done";
INFO "parent sleep";
sleep(100);
INFO "parent exiting";
use warnings;
use strict;
use Test::More tests => 4;
use File::Temp qw( tempdir );
use Sysadm::Install qw(:all);
use FindBin qw( $Bin );
use App::Daemon qw(daemonize cmd_line_parse);
use Fcntl qw/:flock/;
use Log::Log4perl qw(:easy);
# Log::Log4perl->easy_init({ level => $DEBUG, layout => "%F-%L> %m%n" });
my $tempdir = tempdir( CLEANUP => 1 );
my ( $stdout, $stderr, $rc );
my $pidfile = "$tempdir/pid";
my $logfile = "$tempdir/log";
my @cmdline = ( $^X, "-I$Bin/../blib/lib", "$Bin/../eg/test-fork-daemon",
"-l", $logfile, "-p", $pidfile, "-v" );
( $stdout, $stderr, $rc ) = tap @cmdline, "start";
is $rc, 0, "app start";
# wait until process is up
while( 1 ) {
if( -f $logfile ) {
ok 1, "daemon started";
last;
}
sleep 1;
}
# wait until child exits
while( 1 ) {
my $data = slurp $logfile;
if( $data =~ /parent waitpid done/ ) {
ok 1, "parent waitpid done";
last;
}
sleep 1;
}
ok -f $pidfile, "pidfile still exists after child exit";
# print slurp( $logfile );
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment