From: Chris Prather Date: Thu, 17 May 2007 03:04:43 +0000 (+0000) Subject: skipping tests if you don't have Test::* installed X-Git-Tag: 0.01~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a49526793f4ad674abfd7670f4c6a0de9b6df265;p=gitmo%2FMooseX-Daemonize.git skipping tests if you don't have Test::* installed r16589@alice-3: perigrin | 2007-04-13 19:26:09 -0500 now with accurate error messages (d'oh!) r21430@alice-3: perigrin | 2007-05-16 22:02:59 -0500 Add a first draft of MooseX::Daemonize --- a49526793f4ad674abfd7670f4c6a0de9b6df265 diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..0f28d97 --- /dev/null +++ b/Build.PL @@ -0,0 +1,3 @@ +# Dear Distribution Packager. This use of require is intentional. +# Module::Install detects Build.PL usage and acts accordingly. +require 'Makefile.PL'; diff --git a/Changes b/Changes new file mode 100644 index 0000000..3b4bf44 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for MooseX-Daemonize + +0.0.1 Wed May 16 11:46:56 2007 + Initial release. + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..228fd9f --- /dev/null +++ b/MANIFEST @@ -0,0 +1,19 @@ +.cvsignore +Build.PL +Changes +inc/Module/Install.pm +inc/Module/Install/Base.pm +inc/Module/Install/Makefile.pm +inc/Module/Install/MakeMaker.pm +inc/Module/Install/Metadata.pm +lib/MooseX/Daemonize.pm +Makefile.PL +MANIFEST +META.yml # Will be created by "make dist" +README +t/00.load.t +t/01.filecreate.t +t/kwalitee.t +t/perlcritic.t +t/pod-coverage.t +t/pod.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..bdfdcb3 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use inc::Module::Install; +WriteMakefile( + NAME => 'MooseX::Daemonize', + AUTHOR => 'Chris Prather ', + VERSION_FROM => 'lib/MooseX/Daemonize.pm', + ABSTRACT_FROM => 'lib/MooseX/Daemonize.pm', + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'Proc::Daemon' => 0, + 'Carp' => 0, + 'File::Flock' => 0, + 'File::Slurp' => 0, + 'Moose' => 0.20, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'MooseX-Daemonize-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..1aa72e4 --- /dev/null +++ b/README @@ -0,0 +1,47 @@ +MooseX-Daemonize version 0.0.1 + +[ REPLACE THIS... + + The README is used to introduce the module and provide instructions on + how to install the module, any machine dependencies it may have (for + example C compilers and installed libraries) and any other information + that should be understood before the module is installed. + + A README file is required for CPAN modules since CPAN extracts the + README file from a module distribution so that people browsing the + archive can use it get an idea of the modules uses. It is usually a + good idea to provide version information here so that people can + decide whether fixes for the module are worth downloading. +] + + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + + +Alternatively, to install with Module::Build, you can use the following commands: + + perl Build.PL + ./Build + ./Build test + ./Build install + + + +DEPENDENCIES + +None. + + +COPYRIGHT AND LICENCE + +Copyright (C) 2007, Chris Prather + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm new file mode 100644 index 0000000..2a92e61 --- /dev/null +++ b/lib/MooseX/Daemonize.pm @@ -0,0 +1,324 @@ +package MooseX::Daemonize; +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 }, +); + +has pidbase => ( + isa => 'Str', + is => 'ro', + lazy => 1, + required => 1, + default => sub { return '/var/run' }, +); + +has pidfile => ( + isa => 'Str', + is => 'ro', + lazy => 1, + required => 1, + default => sub { $_[0]->pidbase .'/'. $_[0]->progname . '.pid' }, +); + +has foreground => ( + metaclass => 'Getopt', + cmd_aliases => ['f'], + isa => 'Bool', + is => 'ro', + default => sub { 0 }, +); + +sub check { + my ($self) = @_; + my $pidfile = $self->pidfile; + 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?"; + } + return 1; + } + return 0; +} + +sub start { + my ($self) = @_; + return if $self->check; + + $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" ); + + $self->setup_signals; + return; +} + +sub stop { + my ($self) = @_; + my $pidfile = $self->pidfile; + unless ( -e $pidfile ) { + croak $self->progname . 'is not currently running.'; + } + lock( $pidfile, undef, 'nonblocking' ) + or croak "Could not lock PID file $pidfile: $!"; + chomp( my $pid = read_file($pidfile) ); + $self->kill($pid); + unlink($pidfile); + return; +} + +sub restart { + my ($self) = @_; + $self->stop(); + $self->start(); +} + +sub daemonize { + my ($self) = @_; + Proc::Daemon::Init; +} + +sub setup_signals { + my $self = @_; + $SIG{INT} = sub { $_[0]->handle_sigint; }; + $SIG{HUP} = sub { $_[0]->handle_sighup }; +} + +sub handle_sigint { $_[0]->stop; } +sub handle_sighup { return; } + +sub kill { + my ( $self, $pid ) = @_; + unless ( kill 0 => $pid or $!{EPERM} ) { + carp "$pid appears dead."; + return; + } + + kill( 2, $pid ); # Try SIGINT + sleep(1) if 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 ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running + kill( 9, $pid ); # finally try SIGKILL + sleep(1) if 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! + } + + return; +} + +1; +__END__ + + +=head1 NAME + +MooseX::Daemonize - provides a Role that daemonizes your Moose based application. + + +=head1 VERSION + +This document describes MooseX::Daemonize version 0.0.1 + + +=head1 SYNOPSIS + + package FileMaker; + use Moose; + with qw(MooseX::Daemonize); + + sub create_file { + my ( $self, $file ) = @_; + open( FILE, ">$file" ) || die; + close(FILE); + } + + no Moose; + + # then in the main package ... + + my $daemon = FileMaker->new(); + $daemon->start(); + $daemon->create_file($file); + $daemon->stop(); + +=head1 DESCRIPTION + +Often you want to write a persistant daemon that has a pid file, and responds appropriately to Signals. +This module helps provide the basic infrastructure to do that. + +=head1 ATTRIBUTES + +=over + +=item progname Str + +The name of our daemon, defaults to $0 + +=item pidbase Str + +The base for our bid, defaults to /var/run/$progname + +=item pidfile Str + +The file we store our PID in, defaults to /var/run/$progname/ + +=item foreground Bool + +If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f. + +=back + +=head1 METHODS + +=over + +=item check() + +Check to see if an instance is already running. + +=item start() + +Setup a pidfile, fork, then setup the signal handlers. + +=item stop() + +Stop the process matching the pidfile, and unlinks the pidfile. + +=item restart() + +Litterally + + $self->stop(); + $self->start(); + +=item daemonize() + +Calls C to daemonize this process. + +=item kill($pid) + +Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up. + +=item setup_signals() + +Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP + +=item handle_sigint() + +Handle a INT signal, by default calls C<$self->stop()>; + +=item handle_sighup() + +Handle a HUP signal. Nothing is done by default. + +=item meta() + +the C method from L + +=back + +=head1 DEPENDENCIES + +=for author to fill in: + A list of all the other modules that this module relies upon, + including any restrictions on versions, and an indication whether + 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, L + +=head1 INCOMPATIBILITIES + +=for author to fill in: + A list of any modules that this module cannot be used in conjunction + with. This may be due to name conflicts in the interface, or + competition for system or program resources, or due to internal + limitations of Perl (for example, many modules that use source code + filters are mutually incompatible). + +None reported. + + +=head1 BUGS AND LIMITATIONS + +=for author to fill in: + A list of known problems with the module, together with some + indication Whether they are likely to be fixed in an upcoming + release. Also a list of restrictions on the features the module + does provide: data types that cannot be handled, performance issues + and the circumstances in which they may arise, practical + limitations on the size of data sets, special cases that are not + (yet) handled, etc. + +No bugs have been reported. + +Please report any bugs or feature requests to +C, or through the web interface at +L. + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHOR + +Chris Prather C<< >> + + +=head1 LICENCE AND COPYRIGHT + +Copyright (c) 2007, Chris Prather C<< >>. All rights reserved. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. See L. + + +=head1 DISCLAIMER OF WARRANTY + +BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE +ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH +YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL +NECESSARY SERVICING, REPAIR, OR CORRECTION. + +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE +LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, +OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE +THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. diff --git a/t/00.load.t b/t/00.load.t new file mode 100644 index 0000000..f900fb9 --- /dev/null +++ b/t/00.load.t @@ -0,0 +1,7 @@ +use Test::More tests => 1; + +BEGIN { +use_ok( 'MooseX::Daemonize' ); +} + +diag( "Testing MooseX::Daemonize $MooseX::Daemonize::VERSION" ); diff --git a/t/01.filecreate.t b/t/01.filecreate.t new file mode 100644 index 0000000..a0e27d9 --- /dev/null +++ b/t/01.filecreate.t @@ -0,0 +1,45 @@ +use Test::More no_plan => 1; +use Proc::Daemon; +use Cwd; + +## Since a daemon will not be able to print terminal output, we +## have a test daemon create a file, and another process test for +## its existence. + +{ + + package FileMaker; + use Moose; + with qw(MooseX::Daemonize); + + sub create_file { + my ( $self, $file ) = @_; + open( FILE, ">$file" ) || die $!; + close(FILE); + } + + no Moose; +} + +package main; + +## Try to make sure we are in the test directory +my $cwd = Cwd::cwd(); +chdir 't' if ( $cwd !~ m|/t$| ); +$cwd = Cwd::cwd(); + +## Test filename +my $file = join( '/', $cwd, 'im_alive' ); +## Parent process will check if file created. Child becomes the daemon. +if ( my $pid = Proc::Daemon::Fork ) { + sleep(5); # Punt on sleep time, 5 seconds should be enough + ok( -e $file, "$file exists"); + unlink($file); +} +else { + my $daemon = FileMaker->new(pidbase => '.'); + $daemon->start(); + $daemon->create_file($file); + $daemon->stop(); + exit; +} diff --git a/t/kwalitee.t b/t/kwalitee.t new file mode 100644 index 0000000..7576615 --- /dev/null +++ b/t/kwalitee.t @@ -0,0 +1,5 @@ +use Test::More; + +eval { require Test::Kwalitee; Test::Kwalitee->import() }; + +plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; diff --git a/t/perlcritic.t b/t/perlcritic.t new file mode 100644 index 0000000..7e7b210 --- /dev/null +++ b/t/perlcritic.t @@ -0,0 +1,9 @@ +#!perl + +if (!require Test::Perl::Critic) { + Test::More::plan( + skip_all => "Test::Perl::Critic required for testing PBP compliance" + ); +} + +Test::Perl::Critic::all_critic_ok(); diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..703f91d --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,6 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..976d7cd --- /dev/null +++ b/t/pod.t @@ -0,0 +1,6 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; +all_pod_files_ok();