File Coverage

blib/lib/POE/Component/Server/Syslog/UDP.pm
Criterion Covered Total %
statement 73 97 75.2
branch 12 28 42.8
condition 3 6 50.0
subroutine 13 16 81.2
pod 4 6 66.6
total 105 153 68.6


line stmt bran cond sub pod time code
1             # $Id: UDP.pm 449 2004-12-27 01:37:33Z sungo $
2             package POE::Component::Server::Syslog::UDP;
3             $POE::Component::Server::Syslog::UDP::VERSION = '1.22';
4             #ABSTRACT: syslog udp server
5              
6 4     4   219536 use warnings;
  4         6  
  4         132  
7 4     4   15 use strict;
  4         4  
  4         233  
8              
9             sub BINDADDR () { '0.0.0.0' }
10             sub BINDPORT () { 514 }
11             sub DATAGRAM_MAXLEN () { 1024 } # syslogd defaults to this. as do most
12             # libc implementations of syslog
13              
14 4     4   1028 use Params::Validate qw(validate_with);
  4         14391  
  4         246  
15 4     4   19 use Carp qw(carp croak);
  4         5  
  4         178  
16              
17 4     4   14 use POE;
  4         5  
  4         22  
18 4     4   1832 use POE::Filter::Syslog;
  4         6  
  4         89  
19              
20 4     4   20 use Socket;
  4         5  
  4         1761  
21 4     4   29 use IO::Socket::INET;
  4         3  
  4         51  
22              
23             sub spawn {
24 3     3 1 404 my $class = shift;
25              
26             my %args = validate_with(
27             params => \@_,
28             spec => {
29             InputState => {
30             type => &Params::Validate::CODEREF,
31             optional => 1,
32       0     default => sub {},
33             },
34             ErrorState => {
35             type => &Params::Validate::CODEREF,
36             optional => 1,
37       0     default => sub {},
38             },
39 3         228 BindAddress => {
40             type => &Params::Validate::SCALAR,
41             optional => 1,
42             default => BINDADDR,
43             },
44             BindPort => {
45             type => &Params::Validate::SCALAR,
46             optional => 1,
47             default => BINDPORT,
48             },
49             MaxLen => {
50             type => &Params::Validate::SCALAR,
51             optional => 1,
52             default => DATAGRAM_MAXLEN,
53             },
54             Alias => {
55             type => &Params::Validate::SCALAR,
56             optional => 1,
57             },
58             },
59             );
60              
61 3         27 $args{type} = 'udp';
62 3         30 $args{filter} = POE::Filter::Syslog->new();
63              
64             my $sess = POE::Session->create(
65             inline_states => {
66             _start => \&socket_start,
67             _stop => \&shutdown,
68              
69             select_read => \&select_read,
70             register => \®ister,
71             unregister => \&unregister,
72             shutdown => \&shutdown,
73              
74             client_input => $args{InputState},
75             client_error => $args{ErrorState},
76              
77             },
78 3         55 heap => \%args,
79             );
80              
81 3         433 return $sess;
82             }
83              
84              
85             # This is a really good spot to discuss why this is using IO::Socket
86             # instead of a POE wheel of some variety for this. The answer, for once
87             # in my life, is pretty simple. POE::Wheel::SocketFactory doesn't support
88             # connectionless sockets as of the time of writing. In this scenario,
89             # there is no chance of IO::Socket blocking, unless IO::Socket decides
90             # to lose its mind. If it does THAT, there's not a whole hell of a lot
91             # left that's right in the world. :) except maybe pizza. well, good
92             # pizza like you find at Generous George's in Alexandria, VA. and rum.
93             # pretty much any rum. Um, but anyway...
94              
95             sub socket_start {
96             $_[HEAP]->{handle} = IO::Socket::INET->new(
97             Blocking => 0,
98             LocalAddr => $_[HEAP]->{BindAddress},
99             LocalPort => $_[HEAP]->{BindPort},
100 3     3 0 565 Proto => 'udp',
101             ReuseAddr => 1,
102             SocketType => SOCK_DGRAM,
103             );
104              
105 3 50       986 if (defined $_[HEAP]->{handle}) {
106 3         16 $_[KERNEL]->select_read( $_[HEAP]->{handle}, 'select_read' );
107             } else {
108 0         0 croak "Unable to create UDP Listener: $!";
109             }
110 3 100       254 $_[KERNEL]->alias_set( $_[HEAP]->{Alias} ) if $_[HEAP]->{Alias};
111 3         35 return;
112             }
113              
114             sub select_read {
115 3     3 0 1504437 my $message;
116 3         32 my $remote_socket = $_[HEAP]->{handle}->recv($message, $_[HEAP]->{MaxLen}, 0 );
117 3 50       81 if (defined $message) {
118 3         34 $_[HEAP]->{filter}->get_one_start([ $message ]);
119 3         9 my $records = [];
120 3   66     20 while( ($records = $_[HEAP]->{filter}->get_one()) and (@$records > 0)) {
121 3 50 33     29 if(defined $records and ref $records eq 'ARRAY') {
122 3         11 foreach my $record (@$records) {
123 3 50       21 if (my $addr = (sockaddr_in($remote_socket))[1]) {
124 3         62 $record->{addr} = inet_ntoa($addr);
125 3 50       976 if (my $host = gethostbyaddr($addr, AF_INET)) {
126 3         11 $record->{host} = $host;
127             }
128             }
129              
130 3         25 $_[KERNEL]->yield( 'client_input', $record );
131             $_[KERNEL]->post( $_, $_[HEAP]->{sessions}->{$_}->{inputevent}, $record )
132 3         232 for keys %{ $_[HEAP]->{sessions} };
  3         27  
133             }
134             } else {
135 0         0 $_[KERNEL]->yield( 'client_error', $message );
136             $_[KERNEL]->post( $_, $_[HEAP]->{sessions}->{$_}->{errorevent}, $message )
137 0         0 for grep { defined $_[HEAP]->{sessions}->{errorevent} }
  0         0  
138 0         0 keys %{ $_[HEAP]->{sessions} };
139             }
140             }
141             }
142 3         12 return;
143             }
144              
145             sub shutdown {
146 6     6 1 5603 my ($kernel,$heap) = @_[KERNEL,HEAP];
147 6 100       21 if($heap->{handle}) {
148 3         17 $kernel->select_read($heap->{handle});
149 3         337 $heap->{handle}->close();
150             }
151 6         89 delete $heap->{handle};
152 6         17 $kernel->alarm_remove_all();
153 6         192 $kernel->alias_remove( $_ ) for $kernel->alias_list();
154             $kernel->refcount_decrement( $_, __PACKAGE__ )
155 6         154 for keys %{ $heap->{sessions} };
  6         17  
156 6         60 return;
157             }
158              
159             sub register {
160 1     1 1 314 my ($kernel,$self,$sender) = @_[KERNEL,HEAP,SENDER];
161 1         2 my $sender_id = $sender->ID();
162 1         4 my %args;
163 1 50       3 if ( ref $_[ARG0] eq 'HASH' ) {
    0          
164 1         1 %args = %{ $_[ARG0] };
  1         19  
165             }
166             elsif ( ref $_[ARG0] eq 'ARRAY' ) {
167 0         0 %args = @{ $_[ARG0] };
  0         0  
168             }
169             else {
170 0         0 %args = @_[ARG0..$#_];
171             }
172 1         7 $args{lc $_} = delete $args{$_} for keys %args;
173 1 50       3 unless ( $args{inputevent} ) {
174 0         0 warn "No 'inputevent' argument supplied\n";
175 0         0 return;
176             }
177 1 50       4 if ( defined $self->{sessions}->{ $sender_id } ) {
178 0         0 $self->{sessions}->{ $sender_id } = \%args;
179             }
180             else {
181 1         1 $self->{sessions}->{ $sender_id } = \%args;
182 1         4 $kernel->refcount_increment( $sender_id, __PACKAGE__ );
183             }
184 1         23 return;
185             }
186              
187             sub unregister {
188 0     0 1   my ($kernel,$self,$sender) = @_[KERNEL,HEAP,SENDER];
189 0           my $sender_id = $sender->ID();
190 0           my %args;
191 0 0         if ( ref $_[ARG0] eq 'HASH' ) {
    0          
192 0           %args = %{ $_[ARG0] };
  0            
193             }
194             elsif ( ref $_[ARG0] eq 'ARRAY' ) {
195 0           %args = @{ $_[ARG0] };
  0            
196             }
197             else {
198 0           %args = @_[ARG0..$#_];
199             }
200 0           $args{lc $_} = delete $args{$_} for keys %args;
201 0           my $data = delete $self->{sessions}->{ $sender_id };
202 0 0         $kernel->refcount_decrement( $sender_id, __PACKAGE__ ) if $data;
203 0           return;
204             }
205              
206             1;
207              
208              
209             # sungo // vim: ts=4 sw=4 noexpandtab
210              
211             __END__