view release on metacpan or  search on metacpan

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

=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;
}

=head2 lock( [I<owner>] )

Acquire a lock on the file.

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

=cut

sub lock {
    my $self = shift;
    my $owner;
    if ( $^O eq 'MSWin32' ) {
        require Win32;
        $owner = Win32::LoginName();
    }
    else {
        $owner = shift || getlogin() || ( 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;
}

=head2 unlock

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

=cut

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

=head1 AUTHOR

Peter Karman, C<< <karman at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-path-class-file-lockable at rt.cpan.org>, or through the web interface at
L<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.

=head1 SUPPORT

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

    perldoc Path::Class::File::Lockable

You can also look for information at: