Proc::PID::File gave me some trouble recently and i may be reinventing the wheel but i need a pidfile module that DWIM.

# i want to do something like this...

=begin example

my $pf = pidfile->new;

if ($pf->is_alive) {
        warn "already running!\n";
        # Proc::PID::File would unlink the pidfile of the
        # active daemon here!
        exit;
} else {
        # if is_alive == 0 Proc::PID::File would go ahead and
        # write the current $$ to the pidfile here.
        warn "starting\n";
        Proc::Daemon::Init;
        $pf->write;    # oops! already written by parent!
}

=cut
[download]

which seems a little weird to me, but maybe i don't grok pidfiles. what i came up with was this:

package pidfile;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.0.1';

use Carp;
use IO::File;
use Fcntl qw(:flock);
use File::Basename;
use File::Spec;

our %PF_Default = (
    path => '/tmp',
    name => basename($0),
    mode => 0644,
);

# Preloaded methods go here.

sub new {
    my ( $class, %args ) = @_;
    my %pf = ( %PF_Default, %args );
    croak "path => $pf{path} is not a directory" unless -d $pf{path};
    croak "path => $pf{path} is not readable"    unless -r _;
    croak "path => $pf{path} is not writeable"   unless -w _;
    croak "name must be set" unless defined $pf{name} and length $pf{n
+ame};

    return bless \%pf, $class;
}

sub pidfile {
    my $s = shift;
    return $s->{file} ||= File::Spec->catfile($s->{path}, $s->{name}."
+.pid");
}

sub activate {
    my $s = shift;
    croak sprintf "%s contains a living pid %d\n", $s->pidfile, $s->ge
+tpid
      if ( $s->is_alive );
    $s->setpid;
}

sub setpid {
    my $s = shift;
    my $f = IO::File->new( $s->pidfile, O_RDWR | O_CREAT, $PF_Default{
+mode} );
    croak sprintf "can't open %s for writing: $!\n", $s->pidfile
      unless defined $f;
    croak sprintf "can't lock_ex %s: $!\n", $s->pidfile
      unless flock $f, LOCK_EX;
    $f->setpos(0);
    $f->truncate(0);
    $f->print( "$$", $/ );
    $f->close;
    return 1;
}

sub getpid {
    my $s = shift;
    my $f = IO::File->new( $s->pidfile, O_RDONLY );
    croak sprintf "can't open %s for reading: $!\n", $s->pidfile
      unless defined $f;
    croak sprintf "can't lock_sh %s: $!\n", $s->pidfile
      unless flock $f, LOCK_SH;
    my $l = $f->getline; 
    $f->close; 
    chomp $l;
    croak sprintf "%s contained non-numeric pid\n", $s->pidfile
      unless $l == $l + 0;
    return $l+0;
}

sub is_alive {
    my $s = shift;
    return 0 unless -f $s->pidfile;
    return kill 0, $s->getpid;
}   

sub is_self {
    my $s = shift;
    return 0 unless -f $s->pidfile;
    return $$ == $s->getpid;
}
    
sub DESTROY {
    my $s = shift;
    unlink $s->pidfile if $s->is_self;
}   
    
1;  
__END__
[download]

Comments, Suggestions, a good Smack with a Stick?

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.