Article 9096 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:9096
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!pipex!doc.ic.ac.uk!uknet!comlab.ox.ac.uk!mbeattie
From: [email protected] (Malcolm Beattie)
Subject: Re: lockf and fcntl
Message-ID: <[email protected]>
Originator: mbeattie@black
Organization: Oxford University Computing Services, Oxford, U.K.
References: <[email protected]>
Date: Wed, 22 Dec 1993 10:00:08 GMT
Lines: 60

In article <[email protected]> [email protected] (Jon Dunn) writes:
>
>Has anyone written a function to emulate lockf in perl using fcntl?
>I'm trying to write my own, but I'm not sure how to build and pass the
>flock struct to perl's fcntl.  I would appreciate any code examples or
>suggestions people might have.  Thanks!

Here's a `require' file that I use:

CONFIG: {
   # change 0 to 1 in following line to use flock(2) instead of fcntl(2)
   $lockfile'brokenfcntl = 0;

   unless ($lockfile'brokenfcntl) {
       require "fcntl.ph";
       require "unistd.ph";
       require "sys/types.ph";
   }
}

sub lockfile {
   local($file, $wait) = @_;
   if ($lockfile'brokenfcntl) {
       flock($file, $wait ? 2 : 6);
   } else {
       local($flock);
       $flock = pack("ssllI", &F_WRLCK, &SEEK_SET, 0, 1, 0);
       fcntl($file, $wait ? &F_SETLKW : &F_SETLK, $flock);
   }
}

sub ownerlockfile {
   local($file) = @_;
   local($pid);
   $flock = pack("ssllI", &F_WRLCK, &SEEK_SET, 0, 1, 0);
   return -1 if $lockfile'brokenfcntl || fcntl($file, &F_GETLK, $flock) == -1;
   (unpack("ssllI", $flock))[4];
}

1;

The flock stuff is there because stock Ultrix 4.3A has a broken
lockd (which is used even for locking local files once it's fired
up) which stopped fcntl locking from working (DEC have sent a patch
now.) Use &lockfile(MYFILEHANDLE, $waitflag) to get a write
(exclusive) lock on the file. $waitflag should be non-zero if you
want to block until you get the lock (if another process has the
lock) or zero if you want to return immediately (you get true/false
for whether the lock succeeded.) I haven't included an &unlockfile
because I only wanted the lock to die when the process did:
&unlockfile can be an exercise for the reader.
&ownerlockfile(MYFILEHANDLE) returns the PID of the process which
has a lock on (the first byte of) the file, or it returns -1
if no process has it locked.

--Malcolm
--
Malcolm Beattie <[email protected]>
Oxford University Computing Services
"Widget. It's got a widget. A lovely widget. A widget it has got." --Jack Dee