add Test::MooseX::Daemonize
Chris Prather [Fri, 18 May 2007 04:04:14 +0000 (04:04 +0000)]
lib/MooseX/Daemonize.pm
lib/Test/MooseX/Daemonize.pm [new file with mode: 0644]
t/01.filecreate.t

index 2a92e61..62e7034 100644 (file)
@@ -136,7 +136,6 @@ sub kill {
 1;
 __END__
 
-
 =head1 NAME
 
 MooseX::Daemonize - provides a Role that daemonizes your Moose based application.
diff --git a/lib/Test/MooseX/Daemonize.pm b/lib/Test/MooseX/Daemonize.pm
new file mode 100644 (file)
index 0000000..6160c65
--- /dev/null
@@ -0,0 +1,219 @@
+package Test::MooseX::Daemonize;
+use strict;
+use Test::More;
+use Proc::Daemon;
+
+# BEGIN CARGO CULTING
+use Sub::Exporter;
+use Test::Builder;
+our $VERSION   = '0.01';
+our $AUTHORITY = 'cpan:PERIGRIN';
+
+my @exports = qw[
+    daemonize_ok
+];
+
+Sub::Exporter::setup_exporter({
+    exports => \@exports,
+    groups  => { default => \@exports }
+});
+
+our $Test = Test::Builder->new;
+
+sub daemonize_ok {
+    my ( $daemon, $msg ) = @_;
+    unless ( my $pid = Proc::Daemon::Fork ) {
+        $daemon->start();
+        exit;
+    }
+    else {
+        sleep(5);    # Punt on sleep time, 5 seconds should be enough        
+        $Test->ok( kill 0 => $pid or $!{EPERM}, $msg );
+        return $pid;
+    }
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+Test::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 main;
+    use Cwd;
+
+    ## Try to make sure we are in the test directory
+    chdir 't' if ( Cwd::cwd() !~ m|/t$| );
+    my $cwd = Cwd::cwd();
+
+    my $file = join( '/', $cwd, 'im_alive' );
+    my $daemon = FileMaker->new( pidbase => '.', filename => $file );
+
+    daemonize_ok( $daemon, 'child forked okay' );
+    ok( -e $file, "$file exists" );
+    unlink($file);
+
+=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<Proc::Daemon::Init> 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<meta()> method from L<Class::MOP::Class>
+
+=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<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Flock>, L<File::Slurp>
+
+=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<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>.
+
+=head1 SEE ALSO
+
+L<Proc::Daemon>, L<Daemon::Generic>, L<MooseX::Getopt>
+
+=head1 AUTHOR
+
+Chris Prather  C<< <perigrin@cpan.org> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. 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<perlartistic>.
+
+
+=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.
\ No newline at end of file
index a0e27d9..e6a161b 100644 (file)
@@ -1,6 +1,5 @@
-use Test::More no_plan => 1;
-use Proc::Daemon;
-use Cwd;
+use Test::More tests => 2;
+use Test::MooseX::Daemonize;
 
 ##  Since a daemon will not be able to print terminal output, we
 ##  have a test daemon create a file, and another process test for
@@ -12,6 +11,10 @@ use Cwd;
     use Moose;
     with qw(MooseX::Daemonize);
 
+    has filename => ( isa => 'Str', is => 'ro' );
+
+    after start => sub { $_[0]->create_file( $_[0]->filename ) };
+
     sub create_file {
         my ( $self, $file ) = @_;
         open( FILE, ">$file" ) || die $!;
@@ -21,25 +24,18 @@ use Cwd;
     no Moose;
 }
 
+
 package main;
+use Cwd;
 
 ## Try to make sure we are in the test directory
+chdir 't' if ( Cwd::cwd() !~ m|/t$| );
 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;
-}
+my $daemon = FileMaker->new( pidbase => '.', filename => $file );
+
+daemonize_ok( $daemon, 'child forked okay' );
+ok( -e $file, "$file exists" );
+unlink($file);
+