[libanyevent-handle-udp-perl] 04/60: Convert code to Moo
Jonas Smedegaard
js at alioth.debian.org
Mon Sep 30 10:05:36 UTC 2013
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 778e0adbe0b5d83ed504cd4e0c2988fb7cb2fbc5
Author: Leon Timmermans <fawaka at gmail.com>
Date: Fri Oct 14 17:12:06 2011 +0200
Convert code to Moo
---
dist.ini | 1 +
lib/AnyEvent/Handle/UDP.pm | 122 ++++++++++++++++++++++++++++++++------------
2 files changed, 91 insertions(+), 32 deletions(-)
diff --git a/dist.ini b/dist.ini
index 7aeb654..1adc899 100644
--- a/dist.ini
+++ b/dist.ini
@@ -5,3 +5,4 @@ copyright_holder = Leon Timmermans
copyright_year = 2011
[@LEONT::PP]
+target = v5.8
diff --git a/lib/AnyEvent/Handle/UDP.pm b/lib/AnyEvent/Handle/UDP.pm
index 6472d05..2ae499f 100644
--- a/lib/AnyEvent/Handle/UDP.pm
+++ b/lib/AnyEvent/Handle/UDP.pm
@@ -2,31 +2,76 @@ package AnyEvent::Handle::UDP;
use strict;
use warnings FATAL => 'all';
+use Moo;
+
use AnyEvent qw//;
use AnyEvent::Util qw/fh_nonblocking/;
use AnyEvent::Socket qw//;
use Carp qw/croak/;
use Const::Fast qw/const/;
-use Class::XSAccessor accessors => [qw/on_recv on_error receive_size/], getters => [qw/fh/];
use Errno qw/EAGAIN EWOULDBLOCK/;
-use Socket qw/SOL_SOCKET SO_REUSEADDR/;
+use Scalar::Util qw/reftype looks_like_number/;
+use Socket qw/SOL_SOCKET SO_REUSEADDR SOCK_DGRAM/;
+use Symbol qw/gensym/;
+
+use namespace::clean;
const my $default_recv_size => 1500;
-sub new {
- my ($class, %options) = @_;
+has fh => (
+ is => 'ro',
+ default => sub { gensym() },
+);
- croak 'on_recv option is mandatory' if not defined $options{on_recv};
- $options{receive_size} ||= $default_recv_size;
+has _bind_addr => (
+ is => 'ro',
+ init_arg => 'bind',
+ predicate => '_has_bind_addr',
+);
- my $self = bless { map { ( $_ => $options{$_} ) } qw/on_recv receive_size on_error/ }, $class;
+has _connect_addr => (
+ is => 'ro',
+ init_arg => 'connect',
+ predicate => '_has_connect_addr',
+);
- $self->bind_to($options{bind}) if $options{bind};
- $self->connect_to($options{connect}) if $options{connect};
- return $self;
+sub BUILD {
+ my $self = shift;
+ $self->bind_to($self->_bind_addr) if $self->_has_bind_addr;
+ $self->connect_to($self->_connect_addr) if $self->_has_connect_addr;
+ return;
}
+has on_recv => (
+ is => 'rw',
+ isa => sub { reftype($_[0]) eq 'CODE' },
+ required => 1,
+);
+
+has on_error => (
+ is => 'rw',
+ isa => sub { reftype($_[0]) eq 'CODE' },
+ predicate => '_has_error_handler',
+);
+
+has receive_size => (
+ is => 'rw',
+ isa => sub { int $_[0] eq $_[0] },
+ default => sub { $default_recv_size },
+);
+
+has family => (
+ is => 'ro',
+ isa => sub { int $_[0] eq $_[0] },
+ default => sub { 0 },
+);
+
+has _full => (
+ is => 'rw',
+ predicate => '_has_full',
+);
+
sub bind_to {
my ($self, $addr) = @_;
if (ref $addr) {
@@ -58,26 +103,26 @@ sub connect_to {
sub _on_addr {
my ($self, $host, $port, $on_success) = @_;
- AnyEvent::Socket::resolve_sockaddr($host, $port, 'udp', 0, undef, sub {
+ AnyEvent::Socket::resolve_sockaddr($host, $port, 'udp', $self->family, SOCK_DGRAM, sub {
my @targets = @_;
while (1) {
my $target = shift @targets or $self->_error(1, "No such host '$host' or port '$port'");
my ($domain, $type, $proto, $sockaddr) = @{$target};
my $full = join ':', $domain, $type, $proto;
- if ($self->{fh}) {
- return redo if $self->{full} ne $full;
+ if ($self->_has_full) {
+ return redo if $self->_full ne $full;
}
else {
- socket $self->{fh}, $domain, $type, $proto or redo;
- fh_nonblocking $self->{fh}, 1;
- $self->{full} = $full;
+ socket $self->fh, $domain, $type, $proto or redo;
+ fh_nonblocking $self->fh, 1;
+ $self->_full($full);
}
$on_success->($sockaddr);
- $self->{reader} = AE::io $self->{fh}, 0, sub {
- while (defined (my $addr = recv $self->{fh}, my ($buffer), $self->{receive_size}, 0)) {
+ $self->{reader} = AE::io $self->fh, 0, sub {
+ while (defined (my $addr = recv $self->fh, my ($buffer), $self->{receive_size}, 0)) {
$self->{on_recv}($buffer, $self, $addr);
}
$self->_error(1, "Couldn't recv: $!") if $! != EAGAIN and $! != EWOULDBLOCK;
@@ -93,8 +138,8 @@ sub _on_addr {
sub _error {
my ($self, $fatal, $message) = @_;
- if ($self->{on_error}) {
- $self->{on_error}($self, $fatal, $message);
+ if ($self->_has_error_handler) {
+ $self->on_error->($self, $fatal, $message);
$self->destroy if $fatal;
} else {
$self->destroy;
@@ -138,17 +183,10 @@ sub _push_writer {
sub destroy {
my $self = shift;
- $self->DESTROY;
%{$self} = ();
return;
}
-sub DESTROY {
- my $self = shift;
- # XXX
- return;
-}
-
1;
__END__
@@ -161,7 +199,7 @@ This module is an abstraction around UDP sockets for use with AnyEvent.
=method new
-Create a new UDP handle. Its arguments are all optional, though using either connect or bind (or both) is strongly recommended.
+Create a new UDP handle. As arguments it accepts any attribute, as well as these two:
=over 4
@@ -173,19 +211,29 @@ Set the address to which datagrams are sent by default, and the only address fro
The address to bind the socket to. It must be either a packed sockaddr struct or an arrayref containing a hostname and a portnumber.
-=item * on_recv
+=back
+
+All are optional, though using either C<connect> or C<bind> (or both) is strongly recommended unless you give it a connected/bound C<fh>.
+
+=attr on_recv
The callback for when a package arrives. It takes three arguments: the datagram, the handle and the address the datagram was received from.
-=item * on_error
+=attr on_error
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.
-=item * receive_size
+=attr receive_size
The buffer size for the receiving in bytes. It defaults to 1500, which is slightly more than the MTA on ethernet.
-=back
+=attr family
+
+Sets the socket family. The default is C<0>, which means either IPv4 or IPv6. The values C<4> and C<6> mean IPv4 and IPv6 respectively.
+
+=attr fh
+
+The underlying filehandle.
=method bind_to($address)
@@ -199,6 +247,16 @@ Connect to the specified address. Note that a connected socket may be reconnecte
Try to send a message. If a socket is not connected a receptient address must also be given. It is connected giving a receptient may not work as expected, depending on your platform.
+=method destroy
+
+Destroy the handle.
+
=head1 BACKWARDS COMPATIBILITY
This module is B<not> backwards compatible in any way with the previous module of the same name by Jan Henning Thorsen. That module was broken by AnyEvent itself and now considered defunct.
+
+=for Pod::Coverage
+BUILD
+=end
+
+=cut
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libanyevent-handle-udp-perl.git
More information about the Pkg-perl-cvs-commits
mailing list