Adding PidFile implementation and making Daemonize use that
Stevan Little [Thu, 29 Nov 2007 14:56:19 +0000 (14:56 +0000)]
Changes
Makefile.PL
lib/MooseX/Daemonize.pm
lib/MooseX/Daemonize/PidFile.pm [new file with mode: 0644]
t/01.filecreate.t
t/10.pidfile.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 9e83776..1b90f34 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,8 +1,14 @@
 Revision history for MooseX-Daemonize
 
-    - Fix logic that kills process so it doens't always warn about undead 
-      process
-    - Added stop_timeout to allow user to control timings.
+0.05
+    * MooseX::Daemonize
+      - Fix logic that kills process so it doens't always warn about undead 
+        process
+      - Added stop_timeout to allow user to control timings.
+    
+    * MooseX::Daemonize::PidFile
+      - added this package to replace the File::Pid stuff (stevan)
+        - added tests for this (stevan)
 
 0.04 2007-11-11
     - Fix stupid perlcritic.t cause the Module::Starter::PBP tests were stupid but I didn't realize it.
index 9116fac..25c4101 100644 (file)
@@ -9,8 +9,6 @@ all_from 'lib/MooseX/Daemonize.pm';
 build_requires 'Test::More'  => 0;
 
 requires 'Proc::Daemon'      => 0;
-requires 'Carp'              => 0;
-requires 'File::Pid'         => 0;
 requires 'MooseX::Getopt'    => 0;
 requires 'Moose'             => 0.20;
 
index 2db7c99..ffae577 100644 (file)
@@ -1,13 +1,14 @@
 package MooseX::Daemonize;
 use strict;    # because Kwalitee is pedantic
 use Moose::Role;
+use MooseX::Types::Path::Class;
+use Moose::Util::TypeConstraints;
 
-our $VERSION = 0.04;
-use Carp;
-use Proc::Daemon;
+our $VERSION = 0.05;
 
-use File::Pid;
-use Moose::Util::TypeConstraints;
+use Carp 'carp';
+use Proc::Daemon;
+use MooseX::Daemonize::PidFile;
 
 with qw(MooseX::Getopt);
 
@@ -23,27 +24,29 @@ has progname => (
 );
 
 has basedir => (
-    isa      => 'Str',
+    isa      => 'Path::Class::Dir',
     is       => 'ro',
+    coerce   => 1,
     required => 1,
     lazy     => 1,
-    default  => sub { return '/' },
+    default  => sub { Path::Class::Dir->new('/') },
 );
 
 has pidbase => (
-    isa      => 'Str',
+    isa      => 'Path::Class::Dir',
     is       => 'ro',
+    coerce   => 1,
+    required => 1,    
     lazy     => 1,
-    required => 1,
-    default  => sub { return '/var/run' },
+    default  => sub { Path::Class::Dir->new('var', 'run') },
 );
 
-subtype 'Pidfile' => as 'Object' => where { $_->isa('File::Pid') };
-
-coerce 'Pidfile' => from 'Str' => via { File::Pid->new( { file => $_, } ); };
+coerce 'MooseX::Daemonize::PidFile' 
+    => from 'Str' 
+        => via { MooseX::Daemonize::PidFile->new( file => $_ ) };
 
 has pidfile => (
-    isa       => 'Pidfile',
+    isa       => 'MooseX::Daemonize::PidFile',
     is        => 'rw',
     lazy      => 1,
     required  => 1,
@@ -51,20 +54,19 @@ has pidfile => (
     predicate => 'has_pidfile',
     default   => sub {
         my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
-        die "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase);
-        File::Pid->new( { file => $file } );
+        confess "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase);
+        MooseX::Daemonize::PidFile->new( file => $file );
     },
     handles => {
         check      => 'running',
         save_pid   => 'write',
         remove_pid => 'remove',
         get_pid    => 'pid',
-        _pidfile   => 'file',
     },
 );
 
 has foreground => (
-    metaclass   => 'MooseX::Getopt::Meta::Attribute',
+    metaclass   => 'Getopt',
     cmd_aliases => 'f',
     isa         => 'Bool',
     is          => 'ro',
@@ -80,7 +82,7 @@ has is_daemon => (
 has stop_timeout => (
     isa     => 'Int',
     is      => 'rw',
-    default => 2
+    default => sub { 2 }
 );
 
 sub daemonize {
@@ -92,7 +94,9 @@ sub daemonize {
 
 sub start {
     my ($self) = @_;
+    
     confess "instance already running" if $self->check;
+    
     $self->daemonize unless $self->foreground;
 
     return unless $self->is_daemon;
@@ -225,17 +229,17 @@ to do that.
 
 =over
 
-=item progname Str
+=item progname Path::Class::Dir | Str
 
 The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
 
-=item pidbase Str
+=item pidbase Path::Class::Dir | Str
 
 The base for our bid, defaults to /var/run/$progname
 
-=item pidfile Str
+=item pidfile MooseX::Daemonize::PidFile | Str
 
-The file we store our PID in, defaults to /var/run/$progname/ 
+The file we store our PID in, defaults to /var/run/$progname
 
 =item foreground Bool
 
@@ -319,7 +323,7 @@ The C<meta()> method from L<Class::MOP::Class>
     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::Pid>
+Obviously L<Moose>, and L<Proc::Daemon>
 
 =head1 INCOMPATIBILITIES
 
diff --git a/lib/MooseX/Daemonize/PidFile.pm b/lib/MooseX/Daemonize/PidFile.pm
new file mode 100644 (file)
index 0000000..4234072
--- /dev/null
@@ -0,0 +1,136 @@
+package MooseX::Daemonize::PidFile;
+use strict;    # because Kwalitee is pedantic
+use Moose;
+use MooseX::Types::Path::Class;
+
+our $VERSION = '0.01';
+
+has 'pid' => (
+    is      => 'rw',
+    isa     => 'Int',
+    lazy    => 1,
+    default => sub { 
+        my $self = shift;
+        $self->does_file_exist
+            ? $self->file->slurp(chomp => 1)
+            : $$
+    }
+);
+
+has 'file' => (
+    is       => 'ro',
+    isa      => 'Path::Class::File',
+    coerce   => 1,
+    required => 1,
+    handles  => [ 'remove' ]
+);
+
+sub does_file_exist { -s (shift)->file }
+
+sub write {
+    my $self = shift;
+    $self->file->openw->print($self->pid);
+}
+
+sub running {
+    my $self = shift;
+    $self->does_file_exist
+        ? (kill(0, $self->pid) ? 1 : 0)
+        : 0;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Daemonize::PidFile - PID file management for MooseX::Daemonize
+
+=head1 SYNOPSIS
+     
+=head1 DESCRIPTION
+
+=head1 ATTRIBUTES
+
+=over
+
+=item pid Int
+
+=item file Path::Class::File | Str
+
+=back
+
+=head1 METHODS 
+
+=over
+
+=item remove
+
+=item write
+
+=item does_file_exist
+
+=item running
+
+=item meta()
+
+The C<meta()> method from L<Class::MOP::Class>
+
+=back
+
+=head1 DEPENDENCIES
+
+Obviously L<Moose>
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+=head1 BUGS AND LIMITATIONS
+
+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 AUTHOR
+
+Stevan Little  C<< <stevan@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.
+
+=cut
\ No newline at end of file
index 7794164..6293204 100644 (file)
@@ -13,6 +13,7 @@ use MooseX::Daemonize;
     with qw(MooseX::Daemonize);
 
     has filename => ( isa => 'Str', is => 'ro' );
+    
     after start => sub { $_[0]->create_file( $_[0]->filename ) };
 
     sub create_file {
diff --git a/t/10.pidfile.t b/t/10.pidfile.t
new file mode 100644 (file)
index 0000000..66ccb33
--- /dev/null
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 25;
+use Test::Exception;
+
+BEGIN {
+    use_ok('MooseX::Daemonize::PidFile');
+}
+
+{
+    my $f = MooseX::Daemonize::PidFile->new(
+        file => [ 't', 'foo.pid' ]
+    );
+    isa_ok($f, 'MooseX::Daemonize::PidFile');
+
+    isa_ok($f->file, 'Path::Class::File');
+
+    is($f->pid, $$, '... the PID is our current process');
+
+    lives_ok {
+        $f->write
+    } '... writing the PID file';
+
+    is($f->file->slurp(chomp => 1), $f->pid, '... the PID in the file is correct');
+    
+    ok($f->running, '... it is running too');
+
+    lives_ok {
+        $f->remove
+    } '... removing the PID file';
+
+    ok(!-e $f->file, '... the PID file does not exist anymore');
+}
+
+{
+    my $f = MooseX::Daemonize::PidFile->new(
+        file => [ 't', 'bar.pid' ]
+    );
+    isa_ok($f, 'MooseX::Daemonize::PidFile');
+
+    isa_ok($f->file, 'Path::Class::File');
+
+    lives_ok {
+        $f->write
+    } '... writing the PID file';
+
+    is($f->file->slurp(chomp => 1), $f->pid, '... the PID in the file is correct');
+    is($f->pid, $$, '... the PID is our current process');
+    
+    ok($f->running, '... it is running too');    
+
+    lives_ok {
+        $f->remove
+    } '... removing the PID file';
+
+    ok(!-e $f->file, '... the PID file does not exist anymore');
+}
+
+{
+    my $PID = 2001;
+    
+    my $f = MooseX::Daemonize::PidFile->new(
+        file => [ 't', 'baz.pid' ],
+        pid  => $PID,
+    );
+    isa_ok($f, 'MooseX::Daemonize::PidFile');
+
+    isa_ok($f->file, 'Path::Class::File');
+    
+    is($f->pid, $PID, '... the PID is our made up PID');
+
+    lives_ok {
+        $f->write
+    } '... writing the PID file';
+
+    is($f->file->slurp(chomp => 1), $f->pid, '... the PID in the file is correct');
+
+    ok(!$f->running, '... it is not running (cause we made the PID up)');
+
+    lives_ok {
+        $f->remove
+    } '... removing the PID file';
+
+    ok(!-e $f->file, '... the PID file does not exist anymore');
+}