[libanyevent-handle-udp-perl] 07/60: Make push_send actually work

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libanyevent-handle-udp-perl.

commit e9bb271cd48b9948b5d1382663e745ebba3e4368
Author: Leon Timmermans <fawaka at gmail.com>
Date:   Tue Feb 14 02:10:26 2012 +0100

    Make push_send actually work
---
 Changes                    |    1 +
 lib/AnyEvent/Handle/UDP.pm |   41 ++++++++++++++++++++++++++++++++---------
 t/10-basics.t              |    9 +++++----
 3 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/Changes b/Changes
index 8f480b6..bd760c6 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for AnyEvent-Handle-UDP
 
 {{$NEXT}}
+          Make push_send actually work
 
 0.031     2011-10-14 19:48:19 Europe/Amsterdam
           Updated version number
diff --git a/lib/AnyEvent/Handle/UDP.pm b/lib/AnyEvent/Handle/UDP.pm
index 2ae499f..bf41c19 100644
--- a/lib/AnyEvent/Handle/UDP.pm
+++ b/lib/AnyEvent/Handle/UDP.pm
@@ -49,6 +49,14 @@ has on_recv => (
 	required => 1,
 );
 
+has on_drain => (
+	is => 'rw',
+	isa => sub { reftype($_[0]) eq 'CODE' },
+	default => sub {
+		return sub {};
+	},
+);
+
 has on_error => (
 	is => 'rw',
 	isa => sub { reftype($_[0]) eq 'CODE' },
@@ -150,35 +158,46 @@ sub _error {
 
 sub push_send {
 	my ($self, $message, $to) = @_;
-	my $ret = $self->_send();
-	$self->_push_writer($message, $to) if not defined $ret and ($! == EAGAIN or $! == EWOULDBLOCK);
-	return;
+	my $cv = AnyEvent::CondVar->new;
+	if (!$self->{writer}) {
+		my $ret = $self->_send($message, $to, $cv);
+		$self->_push_writer($message, $to, $cv) if not defined $ret and ($! == EAGAIN or $! == EWOULDBLOCK);
+		$self->on_drain->($self) if $ret;
+	}
+	else {
+		$self->_push_writer($message, $to, $cv);
+	}
+	return $cv;
 }
 
 sub _send {
-	my ($self, $message, $to) = @_;
+	my ($self, $message, $to, $cv) = @_;
 	my $ret = defined $to ? send $self->{fh}, $message, 0, $to : send $self->{fh}, $message, 0;
 	$self->on_error->($self->{fh}, 1, "$!") if not defined $ret and ($! != EAGAIN and $! != EWOULDBLOCK);
+	$cv->($ret) if defined $ret;
 	return $ret;
 }
 
 sub _push_writer {
-	my ($self, $message, $to) = @_;
-	push @{$self->{buffers}}, [ $message, $to ];
+	my ($self, $message, $to, $condvar) = @_;
+	push @{$self->{buffers}}, [ $message, $to, $condvar ];
 	$self->{writer} ||= AE::io $self->{fh}, 1, sub {
 		if (@{$self->{buffers}}) {
-			while (my $msg = shift @{$self->{buffers}}) {
-				if (not defined $self->_send(@{$msg})) {
+			while (my ($msg, $to, $cv) = shift @{$self->{buffers}}) {
+				my $ret = $self->_send(@{$msg}, $to, $cv);
+				if (not defined $ret) {
 					unshift @{$self->{buffers}}, $msg;
+					$self->on_error->($self->{fh}, 1, "$!") if $! != EAGAIN and $! != EWOULDBLOCK;
 					last;
 				}
 			}
 		}
 		else {
 			delete $self->{writer};
+			$self->on_drain->($self);
 		}
 	};
-	return;
+	return $condvar;
 }
 
 sub destroy {
@@ -223,6 +242,10 @@ The callback for when a package arrives. It takes three arguments: the datagram,
 
 The callback for when an error occurs. It takes three arguments: the handle, a boolean indicating the error is fatal or not, and the error message.
 
+=attr on_drain
+
+This sets the callback that is called when the send buffer becomes empty. The callback takes the handle as its only argument.
+
 =attr receive_size
 
 The buffer size for the receiving in bytes. It defaults to 1500, which is slightly more than the MTA on ethernet.
diff --git a/t/10-basics.t b/t/10-basics.t
index aa1da30..9ad90fe 100644
--- a/t/10-basics.t
+++ b/t/10-basics.t
@@ -18,10 +18,11 @@ alarm 3;
 
 {
 	my $cb = AE::cv;
-	my $server = IO::Socket::INET->new(LocalHost => 'localhost', LocalPort => 1383, Proto => 'udp') or die $!;
+	my $server = AnyEvent::Handle::UDP->new(bind => [ localhost => 1383 ], on_recv => sub {
+		my ($message, $handle, $client_addr) = @_;
+		$handle->push_send("World", $client_addr);
+	});
 	my $client = AnyEvent::Handle::UDP->new(connect => [ localhost => 1383 ], on_recv => $cb);
-	send $client->fh, "Hello", 0;
-	my $client_addr = recv $server, my ($message), 1500, 0 or die "Could not receive: $!";
-	send $server, "World", 0, $client_addr or die "Could not send: $!";
+	$client->push_send("Hello");
 	is($cb->recv, "World", 'received "World"');
 }

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libanyevent-handle-udp-perl.git