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: mbeattie@black.ox.ac.uk (Malcolm Beattie)
Subject: Re: lockf and fcntl
Message-ID: <1993Dec22.100008.29265@black.ox.ac.uk>
Originator: mbeattie@black
Organization: Oxford University Computing Services, Oxford, U.K.
References: <CIEptt.KuM@usenet.ucs.indiana.edu>
Date: Wed, 22 Dec 1993 10:00:08 GMT
Lines: 60

In article <CIEptt.KuM@usenet.ucs.indiana.edu> jwd@stone.ucs.indiana.edu (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 <mbeattie@black.ox.ac.uk>
Oxford University Computing Services
"Widget. It's got a widget. A lovely widget. A widget it has got." --Jack Dee



.