perl/DXUDP.pm

   1 package DXUDP;
   2
   3 =head1 NAME
   4
   5 DXUDP - A Mojo compatible UDP thingy
   6
   7 =head1 VERSION
   8
   9 0.01
  10
  11 =head1 SYNOPSIS
  12
  13     use DXUDP;
  14     my $handle = DXUDP->new;
  15
  16     $handle->on(read => sub {
  17         my ($handle, $data) = @_;
  18         ...
  19     });
  20
  21     $handle->on(error => sub {
  22         warn "DXUDP: $_[1]\n";
  23     });
  24
  25     $handle->on(finish => sub {
  26         my($handle, $c, $error) = @_;
  27         warn "Connection: $error\n" if $error;
  28     });
  29
  30     $handle->start;
  31     $handle->ioloop->start unless $handle->ioloop->is_running;
  32
  33 =head1 DESCRIPTION
  34
  35 A simple Mojo compatible UDP thingy
  36
  37 =cut
  38
  39 use Mojo::Base 'Mojo::EventEmitter';
  40 use Mojo::IOLoop;
  41 use Scalar::Util qw(weaken);
  42 use IO::Socket::INET6;
  43
  44 our $VERSION = '0.04';
  45
  46 =head1 EVENTS
  47
  48 =head2 error
  49
  50     $self->on(error => sub {
  51         my($self, $str) = @_;
  52     });
  53
  54 This event is emitted when something goes wrong: Fail to L</listen> to socket,
  55 read from socket or other internal errors.
  56
  57 =head2 finish
  58
  59     $self->on(finish => sub {
  60         my($self, $c, $error) = @_;
  61     });
  62
  63 This event is emitted when the client finish, either successfully or due to an
  64 error. C<$error> will be an empty string on success.
  65
  66 =head2 read
  67
  68     $self->on(read => sub {
  69         my($self, $data) = @_;
  70     });
  71
  72 This event is emitted when a new read request arrives from a client.
  73
  74 =head1 ATTRIBUTES
  75
  76 =head2 ioloop
  77
  78 Holds an instance of L<Mojo::IOLoop>.
  79
  80 =cut
  81
  82 has ioloop => sub { Mojo::IOLoop->singleton };
  83
  84 =head2 inactive_timeout
  85
  86 How long a L<connection|Mojo::TFTPd::Connection> can stay idle before
  87 being dropped. Default is 0 (no timeout).
  88
  89 =cut
  90
  91 has inactive_timeout => 0;
  92
  93
  94 =head1 METHODS
  95
  96 =head2 start
  97
  98 Starts listening to the address and port set in L</Listen>. The L</error>
  99 event will be emitted if the server fail to start.
 100
 101 =cut
 102
 103 sub start {
 104     my ($self, $args) = (shift, ref $_[0] ? $_[0] : {@_});
 105     my $reactor = $self->ioloop->reactor;
 106     my $socket;
 107
 108         my $host = $args->{LocalAddr} || $args->{host} || '0.0.0.0';
 109         my $port = $args->{LocalPort} || $args->{port} || 1234;
 110
 111     $socket = IO::Socket::IP->new(
 112                   LocalAddr => $host,
 113                   LocalPort => $port,
 114                   Proto => 'udp',
 115               );
 116
 117     if(!$socket) {
 118         return $self->emit(error => "Can't create listen socket: $!");
 119     };
 120
 121     Scalar::Util::weaken($self);
 122
 123     $socket->blocking(0);
 124     $reactor->io($socket, sub { $self->_incoming });
 125     $reactor->watch($socket, 1, 0); # watch read events
 126     $self->{socket} = $socket;
 127
 128     return $self;
 129 }
 130
 131 sub _incoming {
 132     my $self = shift;
 133     my $socket = $self->{socket};
 134     my $read = $socket->recv(my $datagram, 65534);
 135
 136     if(!defined $read) {
 137         $self->emit(error => "Read: $!");
 138     }
 139
 140         $self->emit(read => $datagram);
 141 }
 142
 143 has peerhost => sub { return $_[0]->{socket}->peerhost };
 144 has peerport => sub { return $_[0]->{socket}->peerport };
 145
 146 sub DEMOLISH {
 147     my $self = shift;
 148     my $reactor = eval { $self->ioloop->reactor } or return; # may be undef during global destruction
 149
 150     $reactor->remove($self->{socket}) if $self->{socket};
 151 }
 152
 153 =head1 AUTHOR
 154
 155 Svetoslav Naydenov - C<harryl@cpan.org>
 156
 157 Jan Henning Thorsen - C<jhthorsen@cpan.org>
 158
 159 =cut
 160
 161 1;