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