--- /dev/null
+#!/usr/bin/env perl -l
+
+package TestDaemon;
+use Moose;
+with('MooseX::Daemonize');
+
+before 'daemonize' => sub {
+ warn 'forking ' . $$;
+};
+
+after 'start' => sub {
+ return unless $_[0]->is_daemon;
+ while (1) {
+ local *LOG;
+ open LOG, '>>', '/tmp/testdaemon.log';
+ print LOG "$0:$$";
+ close LOG;
+ sleep 1;
+ }
+};
+
+package main;
+my $td = new_with_options TestDaemon( pidbase => '/tmp' );
+use YAML;
+warn Dump $td->pidfile;
+warn $td->check;
+print "PARENT: $$";
+print 'PID: ' . $td->get_pid;
+print $td->start;
use strict; # because Kwalitee is pedantic
use Moose::Role;
-our $VERSION = 0.01_1;
+our $VERSION = 0.02;
use Carp;
use Proc::Daemon;
);
has basedir => (
- isa => 'Str',
- is => 'ro',
- lazy => 1,
- default => sub { return '/' },
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+ lazy => 1,
+ default => sub { return '/' },
);
has pidbase => (
- isa => 'Str',
- is => 'ro',
-
- # required => 1,
- lazy => 1,
- default => sub { return '/var/run' },
+ isa => 'Str',
+ is => 'ro',
+ lazy => 1,
+ required => 1,
+ default => sub { return '/var/run' },
);
subtype 'Pidfile' => as 'Object' => where { $_->isa('File::Pid') };
-coerce 'Pidfile' => from 'Str' => via {
- File::Pid->new( { file => $_, } );
-};
+
+coerce 'Pidfile' => from 'Str' => via { File::Pid->new( { file => $_, } ); };
has pidfile => (
- isa => 'Pidfile',
- is => 'ro',
- lazy => 1,
- required => 1,
- coerce => 1,
- default => sub {
+ isa => 'Pidfile',
+ is => 'rw',
+ lazy => 1,
+ required => 1,
+ coerce => 1,
+ predicate => 'has_pidfile',
+ default => sub {
die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase;
my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
File::Pid->new( { file => $file } );
save_pid => 'write',
remove_pid => 'remove',
get_pid => 'pid',
+ _pidfile => 'file',
},
);
has foreground => (
- metaclass => 'Getopt',
- cmd_aliases => ['f'],
+ metaclass => 'MooseX::Getopt::Meta::Attribute',
+ cmd_aliases => 'f',
isa => 'Bool',
is => 'ro',
default => sub { 0 },
);
+has is_daemon => (
+ isa => 'Bool',
+ is => 'rw',
+ default => sub { 0 },
+);
+
sub daemonize {
my ($self) = @_;
+ return if Proc::Daemon::Fork;
Proc::Daemon::Init;
+ $self->is_daemon(1);
}
sub start {
my ($self) = @_;
- return if $self->check;
-
+ confess "instance already running" if $self->check;
$self->daemonize unless $self->foreground;
+ return unless $self->is_daemon;
+
+ $self->pidfile->pid($$);
+
# Avoid 'stdin reopened for output' warning with newer perls
## no critic
open( NULL, '/dev/null' );
=item progname Str
-The name of our daemon, defaults to $0
+The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
=item pidbase Str