view release on metacpan or  search on metacpan

lib/Path/Class/File/Lockable.pm  view on Meta::CPAN

use Carp;

our $VERSION = '0.03';

=head1 NAME

Path::Class::File::Lockable - lock your files with Path::Class::File

=head1 SYNOPSIS

 my $file = Path::Class::File::Lockable->new('path/to/file');
 $file->lock;
 # do stuff with $file
 $file->unlock;

=head1 DESCRIPTION

Path::Class::File::Lockable uses simple files to indicate whether
a file is locked or not. It does not use flock(), since that is
unstable over NFS. Effort has been made to avoid race conditions.

Path::Class::File::Lockable is intended for long-standing locks, as in a
Subversion workspace. See SVN::Class for example.

=head1 METHODS

This is a subclass of Path::Class::File. Only new or overridden methods
are documented here.

=cut

=head2 lock_ext

Returns the file extension used to indicate a lock file. Default is
C<.lock>.

=cut

sub lock_ext {'.lock'}

=head2 lock_file

Returns a Path::Class::File object representing the lock file
itself. No check is made as to whether the lock file exists.

=cut

sub lock_file {
    my $self = shift;
    return Path::Class::File->new( join( '', $self, $self->lock_ext ) );
}

=head2 lock_info

Returns a colon-limited string with the contents of the lock file. 
Will croak if the lock file does not exist.

B<Note> that the owner and timestamp in the file contents
are not from a stat() of the file.
They are written
at the time the lock file is created. So chown'ing or touch'ing
a lock file do not alter its status.

See lock_owner() and lock_time() for easier ways to get at specific
information.

=cut

sub lock_info {
    my $self  = shift;
    my $lfile = $self->lock_file;
    if ( !-s $lfile ) {
        croak "no such lock file: $lfile";
    }
    return $lfile->slurp;
}

=head2 lock_owner

Returns the name of the person who locked the file.

=cut

sub lock_owner {
    my $self = shift;
    return ( split( m/:/, $self->lock_info ) )[0];
}

=head2 lock_time

Returns the time the file was locked (in Epoch seconds).

=cut

sub lock_time {
    my $self = shift;
    return ( split( m/:/, $self->lock_info ) )[1];
}

=head2 lock_pid

Returns the PID of the process that locked the file.

=cut

sub lock_pid {
    my $self = shift;
    return ( split( m/:/, $self->lock_info ) )[2];
}

=head2 locked

Returns true if the file has an existing lock file.

=cut

sub locked {
    my $self = shift;
    return -s $self->lock_file;
}