# -*- cperl -*-
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Copyright (C) 2002-2014 Jens Thoms Toerring <jt@toerring.de>
package
File::FcntlLock;
use
5.006;
use
strict;
use
warnings;
use
POSIX;
use
Errno;
use
Carp;
our
$VERSION
=
'0.20'
;
bootstrap File::FcntlLock
$VERSION
;
###########################################################
#
# Function for locking or unlocking a file or determining which
# process holds a lock.
sub
lock
{
my
(
$self
,
$fh
,
$action
) =
@_
;
my
(
$ret
,
$err
);
# Figure out the file descriptor - we might get a file handle, a
# typeglob or already a file descriptor) and set it to a value which
# will make fcntl(2) fail with EBADF if the argument is undefined or
# is a file handle that's invalid.
my
$fd
= (
ref
(
$fh
) or
$fh
=~ /^\*/ ) ?
fileno
(
$fh
) :
$fh
;
$fd
= -1
unless
defined
$fd
;
# Set the action argument to something invalid if it's not defined
# which then fcntl(2) fails and errno gets set accordingly
$action
= -1
unless
defined
$action
;
if
(
$ret
= C_fcntl_lock(
$fd
,
$action
,
$self
,
$err
) ) {
$self
->{ errno } =
$self
->{ error } =
undef
;
}
elsif
(
$err
) {
die
"Internal error in File::FcntlLock module detected"
;
}
else
{
$self
->get_error(
$self
->{ errno } = $! + 0 );
}
return
$ret
;
}
1;
# Local variables:
# tab-width: 4
# indent-tabs-mode: nil
# End: