Commit d755db4b authored by Salvatore Bonaccorso's avatar Salvatore Bonaccorso

[svn-upgrade] new version libapp-daemon-perl (0.12)

parent c79f4268
blib
pm_to_blib
Makefile
adm
# .licensizer.yml
author:
text: |
2011, Mike Schilli <cpan@perlmeister.com>
header: AUTHORS
mode: verbatim
license:
text: |
Copyright 2011 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.
header: LEGALESE
path_exclude:
- t/
- blib/
Revision history for Perl extension App::Daemon.
0.12 (07/18/2011)
(ms) 'status' now doesn't write to the logfile (suggested by Brian Pitts)
(ms) 'stop' now verifies if the process is still up, and retries
$App::Daemon::kill_retries times (defaults to 3) times, with
1-second sleeps in between.
(ms) Upon successful 'stop', pid file now gets removed (suggested by
Brian Pitts)
(ms) 'status' now triggers exit codes
in compliance with http://refspecs.freestandards.org/LSB_3.1.1/LSB-Core-generic/LSB-Core-generic/iniscrptact.html (suggested by Brian Pitts)
(ms) using SIGTERM now instead of SIGINT to terminate a process
0.11 (08/28/2010)
(ms) Fixed test suite.
......
......@@ -2,11 +2,10 @@ package App::Daemon;
use strict;
use warnings;
our $VERSION = '0.11';
our $VERSION = '0.12';
use Getopt::Std;
use Pod::Usage;
use Log::Log4perl qw(:easy);
use File::Basename;
use Proc::ProcessTable;
use Log::Log4perl qw(:easy);
......@@ -17,11 +16,21 @@ use Fcntl qw/:flock/;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(daemonize cmd_line_parse detach);
use constant LSB_OK => 0;
use constant LSB_DEAD_PID_EXISTS => 1;
use constant LSB_DEAD_LOCK_EXISTS => 2;
use constant LSB_NOT_RUNNING => 3;
use constant LSB_UNKNOWN => 4;
use constant ALREADY_RUNNING => 150;
our ($pidfile, $logfile, $l4p_conf, $as_user, $background,
$loglevel, $action, $appname);
$action = "";
$appname = appname();
our $kill_retries = 3;
our $kill_sig = SIGTERM; # maps to 15 via POSIX.pm
###########################################
sub cmd_line_parse {
###########################################
......@@ -80,6 +89,8 @@ sub cmd_line_parse {
if( Log::Log4perl->initialized() ) {
DEBUG "Log4perl already initialized, doing nothing";
} elsif( $action eq "status" ) {
Log::Log4perl->easy_init( $loglevel );
} elsif( $l4p_conf ) {
Log::Log4perl->init( $l4p_conf );
} elsif( $logfile ) {
......@@ -111,33 +122,53 @@ sub daemonize {
}
if($action eq "status") {
status();
exit 0;
exit status();
}
if($action eq "stop" or $action eq "restart") {
my $exit_code = LSB_NOT_RUNNING;
if(-f $pidfile) {
my $pid = pid_file_read();
if(kill 0, $pid) {
kill 2, $pid;
kill $kill_sig, $pid;
my $killed = 0;
for (1..$kill_retries) {
if(!kill 0, $pid) {
INFO "Process $pid stopped successfully.";
unlink $pidfile or die "Can't remove $pidfile ($!)";
$exit_code = LSB_OK;
$killed++;
last;
}
INFO "Process $pid still running, waiting ...";
sleep 1;
}
if(! $killed) {
ERROR "Process $pid still up, out of retries, giving up.";
$exit_code = LSB_DEAD_PID_EXISTS;
}
} else {
ERROR "Process $pid not running\n";
unlink $pidfile or die "Can't remove $pidfile ($!)";
$exit_code = LSB_NOT_RUNNING;
}
} else {
ERROR "According to my pidfile, there's no instance ",
"of me running.";
$exit_code = LSB_NOT_RUNNING;
}
if($action eq "restart") {
sleep 1;
} else {
INFO "Process $$ stopped by request.";
exit 0;
exit $exit_code;
}
}
if ( my $num = pid_file_process_running() ) {
LOGDIE "Already running: $num (pidfile=$pidfile)\n";
LOGWARN "Already running: $num (pidfile=$pidfile)\n";
exit ALREADY_RUNNING;
}
if( $background ) {
......@@ -220,20 +251,35 @@ sub user_switch {
###########################################
sub status {
###########################################
# Define exit codes according to
# http://refspecs.freestandards.org/LSB_3.1.1/LSB-Core-generic/LSB-Core-generic/iniscrptact.html
my $exit_code = LSB_UNKNOWN;
print "Pid file: $pidfile\n";
if(-f $pidfile) {
my $pid = pid_file_read();
my $running = process_running($pid);
print "Pid in file: $pid\n";
print "Running: ", process_running($pid) ? "yes" : "no", "\n";
print "Running: ", $running ? "yes" : "no", "\n";
if($running) {
# see above
$exit_code = LSB_OK;
} else {
# see above
$exit_code = LSB_DEAD_PID_EXISTS;
}
} else {
print "No pidfile found\n";
$exit_code = LSB_NOT_RUNNING;
}
my @cmdlines = processes_running_by_name( $appname );
print "Name match: ", scalar @cmdlines, "\n";
for(@cmdlines) {
print " ", $_, "\n";
}
return 1;
return $exit_code;
}
......@@ -449,9 +495,17 @@ is run in foreground mode for testing purposes.
=item stop
will find the daemon's PID in the pidfile and send it a kill signal. It
won't verify if this actually shut down the daemon or if it's immune to
the kill signal.
will find the daemon's PID in the pidfile and send it a SIGTERM signal. It
will verify $App::Daemon::kill_retries times if the process is still alive,
with 1-second sleeps in between.
To have App::Daemon send a different signal than SIGTERM (e.g., SIGINT), set
use POSIX;
$App::Daemon::kill_sig = SIGINT;
Note that his requires the numerial value (SIGINT via POSIX.pm), not a
string like "SIGINT".
=item status
......@@ -483,6 +537,26 @@ this instead:
Running: no
Name match: 0
The status commands exit code complies with
http://refspecs.freestandards.org/LSB_3.1.1/LSB-Core-generic/LSB-Core-generic/iniscrptact.html
and returns
0: if the process is up and running
1: the process is dead but the pid file still exists
3: the process is not running
These constants are defined within App::Daemon to help writing test
scripts:
use constant LSB_OK => 0;
use constant LSB_DEAD_PID_EXISTS => 1;
use constant LSB_DEAD_LOCK_EXISTS => 2;
use constant LSB_NOT_RUNNING => 3;
use constant LSB_UNKNOWN => 4;
use constant ALREADY_RUNNING => 150;
=back
=head2 Command Line Options
......@@ -601,7 +675,7 @@ shell prompt immediately.
=head1 AUTHOR
Mike Schilli, cpan@perlmeister.com
2011, Mike Schilli <cpan@perlmeister.com>
=head1 COPYRIGHT AND LICENSE
......@@ -612,3 +686,10 @@ it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
=head1 LICENSE
Copyright 2011 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.
.cvsignore
.licensizer.yml
adm/release
Changes
Daemon.pm
......@@ -6,7 +6,9 @@ eg/test-daemon
eg/test-detach
Makefile.PL
MANIFEST
MANIFEST.SKIP
README
t/001Basic.t
t/002Params.t
t/003CmdLine.t
META.yml Module meta-data (added by MakeMaker)
\.git
\.gz$
Makefile$
Makefile.old
\.bak$
^pm_to_blib$
^blib/
--- #YAML:1.0
name: App-Daemon
version: 0.11
version: 0.12
abstract: Start an Application as a Daemon
author:
- Mike Schilli <m@perlmeister.com>
......@@ -18,6 +18,7 @@ requires:
Log::Log4perl: 1.0
Pod::Usage: 0
Proc::ProcessTable: 0
Sysadm::Install: 0.37
Test::More: 0
resources:
repository: http://github.com/mschilli/app-daemon
......@@ -25,7 +26,7 @@ no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.55_02
generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
......@@ -22,6 +22,7 @@ WriteMakefile(
File::Basename => 0,
Test::More => 0,
File::Temp => 0,
Sysadm::Install => 0.37,
}, # e.g., Module::Name => 1.1
$ExtUtils::MakeMaker::VERSION >= 6.50 ? (%$meta_merge) : (),
($] >= 5.005 ? ## Add these new keywords supported since 5.005
......
######################################################################
App::Daemon 0.11
App::Daemon 0.12
######################################################################
NAME
......@@ -73,9 +73,18 @@ DESCRIPTION
program is run in foreground mode for testing purposes.
stop
will find the daemon's PID in the pidfile and send it a kill signal.
It won't verify if this actually shut down the daemon or if it's
immune to the kill signal.
will find the daemon's PID in the pidfile and send it a SIGTERM
signal. It will verify $App::Daemon::kill_retries times if the
process is still alive, with 1-second sleeps in between.
To have App::Daemon send a different signal than SIGTERM (e.g.,
SIGINT), set
use POSIX;
$App::Daemon::kill_sig = SIGINT;
Note that his requires the numerial value (SIGINT via POSIX.pm), not
a string like "SIGINT".
status
will print out diagnostics on what the status of the daemon is.
......@@ -106,6 +115,26 @@ DESCRIPTION
Running: no
Name match: 0
The status commands exit code complies with
http://refspecs.freestandards.org/LSB_3.1.1/LSB-Core-generic/LSB-Core-generic/iniscrptact.html
and returns
0: if the process is up and running
1: the process is dead but the pid file still exists
3: the process is not running
These constants are defined within App::Daemon to help writing test
scripts:
use constant LSB_OK => 0;
use constant LSB_DEAD_PID_EXISTS => 1;
use constant LSB_DEAD_LOCK_EXISTS => 2;
use constant LSB_NOT_RUNNING => 3;
use constant LSB_UNKNOWN => 4;
use constant ALREADY_RUNNING => 150;
Command Line Options
-X Foreground mode. Log messages go to the screen.
......@@ -204,7 +233,7 @@ DESCRIPTION
shell prompt immediately.
AUTHOR
Mike Schilli, cpan@perlmeister.com
2011, Mike Schilli <cpan@perlmeister.com>
COPYRIGHT AND LICENSE
Copyright (C) 2008 by Mike Schilli
......@@ -213,3 +242,8 @@ COPYRIGHT AND LICENSE
under the same terms as Perl itself, either Perl version 5.8.5 or, at
your option, any later version of Perl 5 you may have available.
LICENSE
Copyright 2011 by Mike Schilli, all rights reserved. This program is
free software, you can redistribute it and/or modify it under the same
terms as Perl itself.
......@@ -5,4 +5,5 @@ use strict;
# Available at http://perlmeister.com/scripts
use lib "$ENV{HOME}/perl-modules";
use ModDevUtils;
system("licensizer");
ModDevUtils::release(0) or exit 0;
# launch app-daemon
use File::Temp qw(tempdir);
use FindBin qw($Bin);
use Sysadm::Install qw(:all);
use Test::More;
use App::Daemon;
use Log::Log4perl qw(:easy);
# Log::Log4perl->easy_init($DEBUG);
plan tests => 6;
my $tempdir = tempdir( CLEANUP => 1 );
my ( $stdout, $stderr, $rc );
my @cmdline = ( $^X, "-I$Bin/../blib/lib", "$Bin/../eg/test-daemon",
"-l", "$tempdir/log", "-p", "$tempdir/pid" );
# start sleep daemon
( $stdout, $stderr, $rc ) = tap @cmdline, "start";
is $rc, 0, "app start";
# start once again
( $stdout, $stderr, $rc ) = tap @cmdline, "start";
is $rc>>8, App::Daemon::ALREADY_RUNNING, "app start again";
# check status
( $stdout, $stderr, $rc ) = tap @cmdline, "status";
is $rc>>8, App::Daemon::LSB_OK, "status started";
# stop daemon
( $stdout, $stderr, $rc ) = tap @cmdline, "stop";
is $rc, 0, "app stop";
# stop daemon again
( $stdout, $stderr, $rc ) = tap @cmdline, "stop";
is $rc>>8, App::Daemon::LSB_NOT_RUNNING, "app stop again";
# check status
( $stdout, $stderr, $rc ) = tap @cmdline, "status";
is $rc>>8, App::Daemon::LSB_NOT_RUNNING, "status stopped";
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