IO::Lambda::Loop::AnyEvent - AnyEvent event loop for IO::Lambda

IO-Lambda documentation Contained in the IO-Lambda distribution.

Index

Code Index:

NAME

Top

IO::Lambda::Loop::AnyEvent - AnyEvent event loop for IO::Lambda

DESCRIPTION

Top

This is the implementation of event loop for IO::Lambda based on AnyEvent event loop. The module is not intended for direct use.

LIMITATIONS

Top

Note that AnyEvent is also a proxy event loop itself, and depending on the actual event loop module it uses, functionality of IO::Lambda might be limited.

Found problems:

* All but Event interfaces don't support IO_EXCEPTION.

* Interface to Tk fails to work when more than one listener to the same filehandle is registered.

* EV doesn't work with threads and disk files.

See AnyEvent for more specific description.

SYNOPSIS

Top

  use AnyEvent;
  use IO::Lambda::Loop::AnyEvent; # explicitly select the event loop module
  use IO::Lambda;

SEE ALSO

Top

AnyEvent

IO-Lambda documentation Contained in the IO-Lambda distribution. 
# $Id: AnyEvent.pm,v 1.9 2009/04/21 12:02:06 dk Exp $

package IO::Lambda::Loop::AnyEvent;
use strict;
use warnings;
use AnyEvent;
use IO::Lambda qw(:constants);
use Time::HiRes qw(time);

my @records;

IO::Lambda::Loop::default('AnyEvent');

sub new   { bless {} , shift }
sub empty { scalar(@records) ? 0 : 1 }

sub watch
{
	my ( $self, $rec) = @_;

	my $flags  = $rec->[WATCH_IO_FLAGS];
	my $poll = '';
	$poll .= 'r' if $flags & IO_READ;
	$poll .= 'w' if $flags & IO_WRITE;
	$poll .= 'e' if $flags & IO_EXCEPTION;
	
	push @records, $rec;
	
	push @$rec, AnyEvent-> io(
		fh    => $rec-> [WATCH_IO_HANDLE],
		poll  => $poll,
		cb    => sub {
			my $nr = @records;
			@records = grep { $_ != $rec } @records;
			return if $nr == @records;

			$nr = pop @$rec;
			pop @$rec while $nr--;

			if ( length($poll) > 1) {
				# check for fh availability
				my $o = '';
				vec( $o, fileno( $rec-> [WATCH_IO_HANDLE]), 1) = 1;
				my ( $r, $w, $e) = ($o, $o, $o);
				my $n = select( $r, $w, $e, 0);
				$rec->[WATCH_IO_FLAGS] &=
					(( $r eq $o) ? IO_READ      : 0) | 
					(( $w eq $o) ? IO_WRITE     : 0) | 
					(( $e eq $o) ? IO_EXCEPTION : 0)
				;
			}
			$rec-> [WATCH_OBJ]-> io_handler($rec)
				if $rec->[WATCH_OBJ];
		}
	);

	if ( defined $rec->[WATCH_DEADLINE]) {
		my $time = $rec-> [WATCH_DEADLINE] - time;
		$time = 0 if $time < 0;
		push @$rec, AnyEvent-> timer(
			after  => $time,
			cb     => sub {
				my $nr = @records;
				@records = grep { $_ != $rec } @records;
				return if $nr == @records;

				$nr = pop @$rec;
				pop @$rec while $nr--;

				$rec-> [WATCH_IO_FLAGS] = 0;
				$rec-> [WATCH_OBJ]-> io_handler($rec)
					if $rec->[WATCH_OBJ];
			}
		);
		push @$rec, 2;
	} else {
		push @$rec, 1;
	}
}

sub after
{
	my ( $self, $rec) = @_;

	my $time = $rec-> [WATCH_DEADLINE] - time;
	$time = 0 if $time < 0;
	push @records, $rec;
	push @$rec, AnyEvent-> timer(
		after  => $time,
		cb     => sub {
			my $nr = @records;
			@records = grep { $_ != $rec } @records;
			return if $nr == @records;

			pop @$rec;
			pop @$rec;

			$rec-> [WATCH_OBJ]-> io_handler($rec)
				if $rec->[WATCH_OBJ];
		},
	), 1;
}

sub yield
{
	AnyEvent-> one_event;
}

sub remove
{
	my ($self, $obj) = @_;

	my @r;
	for ( @records) {
		next unless $_-> [WATCH_OBJ];
		if ( $_->[WATCH_OBJ] == $obj) {
			my $nr = pop @$_;
			pop @$_ while $nr--;
		} else {
			push @r, $_;
		}
	}

	return if @r == @records;
	@records = @r;
}

sub remove_event
{
	my ($self, $rec) = @_;

	my @r;
	for ( @records) {
		if ( $_ == $rec) {
			my $nr = pop @$_;
			pop @$_ while $nr--;
		} else {
			push @r, $_;
		}
	}

	return if @r == @records;
	@records = @r;
}

1;

__DATA__