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