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.

---

---

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! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

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:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

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

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