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