File Coverage

blib/lib/IO/Lambda/Flock.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch	8	12	66.6
condition			n/a
subroutine	8	8	100.0
pod	1	2	50.0
total	46	51	90.2

# $Id: Flock.pm,v 1.8 2009/04/21 14:42:46 dk Exp $
package IO::Lambda::Flock;
use vars qw($DEBUG @ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK   = qw(flock);
%EXPORT_TAGS = ( all => \@EXPORT_OK);
$DEBUG = $IO::Lambda::DEBUG{flock} || 0;

use strict;
use warnings;
use Fcntl ':flock';
use IO::Lambda qw(:all :dev);
use IO::Lambda::Poll qw(poll_event);

sub poll_flock
{
	my ( $expired, $fh, $shared) = @_;
	if ( CORE::flock( $fh, LOCK_NB | ($shared ? LOCK_SH : LOCK_EX) )) {
		warn "flock $fh obtained\n" if $DEBUG;
		return 1, 1;
	}
	return 1, 0 if $expired;
	return 0;
}

sub flock(&)
{
	return this-> override_handler('flock', \&flock, shift)
		if this-> {override}->{flock};

	my $cb = _subname flock => shift;
	my ($fh, %opt) = context;
	my $deadline = exists($opt{timeout}) ? $opt{timeout} : $opt{deadline};

	poll_event(
		$cb, \&flock, \&poll_flock,
		$deadline, $opt{frequency},
		$fh, $opt{shared}
	);
}


# The same code can be written way more elegant:
#
#	sub flock(&)
#	{
#		poller {
#			my %opt = @_;
#			CORE::flock(
#				$opt{fh},
#				LOCK_NB | ($opt{shared} ? LOCK_SH : LOCK_EX
#			);
#		}
#		-> call(context)
#		-> condition(shift, \&flock, 'flock')
#	}
#
#  but will require another calling style:
#
#	context fh => $fh, deadline => 5;
#	flock { ok }

1;

__DATA__