1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
# -*- 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 for file locking with fcntl(2) in which the binary layout of
# the C flock struct has been determined via a C program on installation
# and appropriate Perl code been appended to the package.
package File::FcntlLock::Pure;
use 5.006;
use strict;
use warnings;
use base qw( File::FcntlLock::Core );
our $VERSION = File::FcntlLock::Core->VERSION;
our @EXPORT = @File::FcntlLock::Core::EXPORT;
###########################################################
# Function for doing the actual fcntl() call: assembles the binary
# structure that must be passed to fcntl() from the File::FcntlLock
# object we get passed, calls it and then modifies the File::FcntlLock
# with the data from the flock structure
sub lock {
my ( $self, $fh, $action ) = @_;
my $buf = $self->pack_flock( );
my $ret = fcntl( $fh, $action, $buf );
if ( $ret ) {
$self->unpack_flock( $buf );
$self->{ errno } = $self->{ error } = undef;
} else {
$self->get_error( $self->{ errno } = $! + 0 );
}
return $ret;
}
|
