Okay, previously I was having trouble with some resource locking. The application runs under mod_perl, and so is subject to sudden disconnects, for example when the user presses "stop" or "reload." But, the critical part of my program HAS to lock access to the Gimp Perl-Server, or colors/images will get mixed up between users. After sleeping on the problem, I realized I had no choice but to abandon Gimp::lock(), as it is just not smart enough to handle this application. This is because, all the gimp calls have to take place within the callback; Gimp::unlock() doens't work within an END sub. So, I have no way of releasing the lock on disconnect.

What I wanted was something that I didn't have to unlock; something that would just release if you let go of it. Sortof a dead-man-switch resource lock. So, I made a lock daemon, that's only function is life is to accept connections on the specified port, and echo anything written to the port back to the client. The client connects, and then writes a newline to the lock daemon. This blocks until it is this client's turn.

Since I haven't heard of doing resource locking this way before, I thought I should get some opinions on if it is even a good thing to be doing, before I add the code to the snippets section.

first the daemon:

use IO::Socket;
use strict;
my $port = shift || 10101;
my ($data, $remote );
my $server = IO::Socket::INET->new(
                   Listen    => SOMAXCONN,
                   LocalPort => $port,    
                   Reuse     => 1,
                   Proto     => 'tcp' )
    || die "can't open connection: $!";
while (defined($remote = $server->accept)) {
    $remote->autoflush(1);
    while ( $data = <$remote> ) {
    print $remote $data;
    }
}
close($server);
[download]

And the client code:

my $lock = get_lock();
# --- critical stuff ---
release_lock( $lock );

sub get_lock {
    my $server = shift || "localhost";
    my $port = shift || 10101;
    my $retry_count = 0;
    my $lock;
#sometimes the port needs a second, so we let it retry.
    while ( $retry_count++ < 30 ) {
        if( $lock = IO::Socket::INET->new(Proto => "tcp",
                          PeerAddr => $server,
                          PeerPort => $port) ) {
        $lock->autoflush(1);
        last;
        }
    }
    print $lock "\n";
    until ( <$lock> ) { sleep(1) }
    return $lock;
}

sub release_lock {
    my $lock = shift || return;
    return close $lock;
}
[download]

Don't be shy, friends... dig in and tell me why it is not normally done this way. ;)

Paris Sinclair    |    4a75737420416e6f74686572
pariss@efn.org    |    205065726c204861636b6572
I wear my Geek Code on my finger.