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

Path-Class-File-Lockable documentation Contained in the Path-Class-File-Lockable distribution.

Index

Code Index:

NAME

Top

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

VERSION

Top

Version 0.01

SYNOPSIS

Top

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

DESCRIPTION

Top

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.

METHODS

Top

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

lock_ext

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

lock_file

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

lock_info

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

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.

lock_owner

Returns the name of the person who locked the file.

lock_time

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

lock_pid

Returns the PID of the process that locked the file.

locked

Returns true if the file has an existing lock file.

lock( [owner] )

Acquire a lock on the file.

This method should be NFS-safe via File::NFSLock.

unlock

Removes lock file. Uses system() call to enable unlinking across NFS. Will croak on any error.

AUTHOR

Top

Peter Karman, <karman at cpan.org>

BUGS

Top

Please report any bugs or feature requests to bug-path-class-file-lockable at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Path-Class-File-Lockable. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Path::Class::File::Lockable

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Path-Class-File-Lockable

* CPAN Ratings

http://cpanratings.perl.org/d/Path-Class-File-Lockable

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Path-Class-File-Lockable

* Search CPAN

http://search.cpan.org/dist/Path-Class-File-Lockable

ACKNOWLEDGEMENTS

Top

There are lots of lock file modules on CPAN. Some of them are probably better suited to your needs than this one.

The Minnesota Supercomputing Institute http://www.msi.umn.edu/ sponsored the development of this software.

SEE ALSO

Top

File::NFSLock, Path::Class::File

COPYRIGHT & LICENSE

Top

Copyright 2007 by the Regents of the University of Minnesota. All rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Path-Class-File-Lockable documentation Contained in the Path-Class-File-Lockable distribution. 
package Path::Class::File::Lockable;

use warnings;
use strict;
use base qw( Path::Class::File );
use File::NFSLock;
use Fcntl qw(LOCK_EX LOCK_NB);
use Carp;


our $VERSION = '0.02';


sub lock_ext {'.lock'}


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


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


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


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


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


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


sub lock {
    my $self = shift;
    my $owner = shift || ( getpwuid($<) )[0] || 'anonymous';

    # we have to lock our lock file first, to avoid
    # NFS and race condition badness.
    # so obtain a lock on our lock file, write our lock
    # then release the lock on our lock file.
    # we can't use File::NFSLock all by itself since it is
    # not persistent across processes.
    my $lock = File::NFSLock->new(
        {   file               => $self->lock_file,
            lock_type          => LOCK_EX | LOCK_NB,
            blocking_timeout   => 5,
            stale_lock_timeout => 5
        }
    );

    if ( !$lock ) {
        croak "can't get safe lock on lock file: $File::NFSLock::errstr";
    }

    my $fh = $self->lock_file->openw() or croak "can't write lock file: $!";
    print {$fh} join( ':', $owner, time(), $$ );
    $fh->close;

    $lock->unlock;
}


sub unlock {
    my $self = shift;
    $self->lock_file->remove or croak "can't unlink lock file: $!";
    return 1;
}


1;