view release on metacpan or  search on metacpan

lib/DynGig/Util/LockFile/PID.pm  view on Meta::CPAN

    my $mode = -f $file ? '+<' : '+>';
    my $this;

    croak "open $file: $!" unless open $this, $mode, $file;

    bless \$this, ref $class || $class;
}

=head1 DESCRIPTION

=head2 lock()

Attempts to acquire lock. Returns pid if successful. Returns undef otherwise.

=cut
sub lock
{
    my $this = shift @_;
    my $handle = $$this;
    my $pid;

    return $pid unless flock $handle, LOCK_EX | LOCK_NB;

    sysseek $handle, 0, 0;
    sysread $handle, $pid, 64;

    if ( $pid && $pid eq $$ )
    {
    }
    elsif ( $pid && $pid =~ /^\d+$/ && kill 0, $pid )
    {
        $pid = undef;
    }
    else
    {
        sysseek $handle, 0, 0;
        truncate $handle, 0;
        syswrite $handle, ( $pid = $$ );
    }
 
    flock $handle, LOCK_UN;
    return $pid;
}

=head2 handle()

Returns the handle of the lock file.

=cut
sub handle
{
    my $this = shift;
    my $handle = $$this;

    sysseek $handle, 0, 0;
    return $handle;
}

=head2 check( $filename )

Returns ID of process that owns the lock. Returns 0 if not locked.

=cut
sub check
{
    my ( $class, $file ) = @_;

    croak 'lock file not defined' unless defined $file;

    my ( $handle, $pid );

    return open( $handle, '<', $file ) && read( $handle, $pid, 1024 )
        && $pid =~ /^\d+$/ && $pid && kill 0, $pid ? $pid : 0;
}

=head1 SEE ALSO

Fcntl

=head1 NOTE

See DynGig::Util

=cut

1;

__END__