comment on

I have some code that manages a lockfile mechanism used to keep various processes from working on the same things at once. The basic idea is that before a process starts a task it tries to get a lock on the task id. If it cant get the lock it tries to work on something else. What i wanted to do was to have it work like this:

Open the lock file
Try to get an exclusive lock in nonblocking mode.
Unless we get it go to 8.
read the lockfile to see if it was abandonded by another process. Print whatever the situation is.
Write our details to the lockfile
Change from an exclusive lock to a shared lock so that other people can see its held by us.
Goto 10.
If we didnt get the exclusive lock then get a shared lock in blocking mode (wait until we can get a shared lock)
Read and print the info about the process who has created the lock.
Finish

But what happens is that unless I add a step 5.5 which is "Unlock the file" before we "Lock the file in shared mode" the lock status doesnt change from LOCK_EX to LOCK_SH. Thus other process sit waiting for ever. If I do put in the LOCK_UN step then it seems to work, but I cant help but feel there is a race condition involved if I do.

Anyway the code is below (Thanks to tilly for the OnDestroy trick or at least the idea that underlies it.)

use Fcntl ':flock';
use POSIX;
sub iso_time { POSIX::strftime ("%Y-%m-%d %H:%M:%S",localtime($_[0]||t
+ime)) }

sub OnDestroy::DESTROY { shift(@_)->() }

sub OnDestroyDo(&) { bless shift(@_),"OnDestroy" }


sub get_lock {
    my ($lock_dir,$name)=@_;
    my $debug=1;

    $name=~s/[^-\w.#!\@~=+%\$]//g;
    my $lockfile=catfile($lock_dir,$name.'.lock');
    print "Trying lockfile $lockfile\n";
    sysopen(my $FH, $lockfile, O_RDWR | O_CREAT)
        or do { warn "can't open $lockfile: $!" if $debug;
                return;
              };
    # autoflush $FH
    select( (select($FH), $|++)[0] );
    my ( $time, $process, $lname );

    if (flock( $FH, LOCK_EX | LOCK_NB )) {
        ( $time, $process, $lname )=split /\|/,join "",<$FH>;
        seek $FH, 0, 0 or die "Failed rewind:$!";

        if ($debug) {
            if ($process) {
                print "\tLockfile appears to be abandonded by Process 
+#$process started at $time\n"
            } else {
                print "\tLockfile appears to be unprocessed\n"
            }
        }
        my $lock_msg=join("|", iso_time(), $$, $name)."\n";
        print "Locking $lockfile : $lock_msg";
        print $FH $lock_msg;
        truncate($FH, tell($FH)) or die "Failed to truncate:$!";

        # if I remove this it doesnt work on my Win2k box
        flock($FH, LOCK_UN) or die "sharedlock: $!";
        # but if I leave it in then it seems like a race condition is 
+possible.

        flock($FH, LOCK_SH|LOCK_NB) or die "sharedlock: $!";
        return OnDestroyDo {
                            print "\tFinished with and removing $lockf
+ile\n";
                            close $FH or die "Failed to close \$FH:$!"
+;
                            unlink $lockfile or die "Failed to unlink 
+$lockfile\n";
                            undef $FH;
                         };
    } elsif (flock($FH, LOCK_SH|LOCK_NB)) {
        ( $time, $process, $lname )=split /\|/,join "",<$FH>;
        print "\tLockfile $lockfile appears to be locked by Process #$
+process at $time\n"
            if $debug;
    } else {
        print "Failed to get lock on $lockfile, not sure why.\n";
    }
    return
}
[download]

Thanks in advance for any help you might be able to offer.

---
demerphq

_{First they ignore you, then they laugh at you, then they fight you, then you win.

-- Gandhi}

In reply to Frustration with changing lock type by demerphq

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.