File Coverage

blib/lib/AnyEvent/Ident/Server.pm
Criterion Covered Total %
statement 59 66 89.3
branch 5 8 62.5
condition 2 4 50.0
subroutine 15 17 88.2
pod 3 4 75.0
total 84 99 84.8


line stmt bran cond sub pod time code
1             package AnyEvent::Ident::Server;
2              
3 4     4   2465 use strict;
  4         9  
  4         165  
4 4     4   20 use warnings;
  4         10  
  4         119  
5 4     4   23 use AnyEvent;
  4         9  
  4         119  
6 4     4   1135 use AnyEvent::Socket qw( tcp_server );
  4         85802  
  4         296  
7 4     4   4085 use AnyEvent::Handle;
  4         45645  
  4         127  
8 4     4   3582 use AnyEvent::Ident::Request;
  4         14  
  4         113  
9 4     4   13838 use AnyEvent::Ident::Response;
  4         10  
  4         135  
10 4     4   3643 use AnyEvent::Ident::Transaction;
  4         10  
  4         131  
11 4     4   25 use Carp qw( croak carp );
  4         8  
  4         4240  
12              
13             # ABSTRACT: Simple asynchronous ident server
14             our $VERSION = '0.06'; # VERSION
15              
16              
17             sub new
18             {
19 3     3 0 10727 my $class = shift;
20 3 50       29 my $args = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
  0         0  
21 3         11 my $port = $args->{port};
22 3 50       17 $port = 113 unless defined $port;
23             bless {
24             hostname => $args->{hostname},
25             port => $port,
26 0     0   0 on_error => $args->{on_error} || sub { carp $_[0] },
27 0     0   0 on_bind => $args->{on_bind} || sub { },
28 3   50     80 }, $class;
      50        
29             }
30              
31              
32             sub start
33             {
34 4     4 1 1895 my($self, $callback) = @_;
35            
36 4 50       35 croak "already started" if $self->{guard};
37            
38             my $cb = sub {
39 6     6   929 my ($fh, $host, $port) = @_;
40              
41 6         13 my $handle;
42             $handle = AnyEvent::Handle->new(
43             fh => $fh,
44             on_error => sub {
45 0         0 my ($hdl, $fatal, $msg) = @_;
46 0         0 $self->{on_error}->($msg);
47 0         0 $_[0]->destroy;
48             },
49             on_eof => sub {
50 0         0 $handle->destroy;
51             },
52 6         74 );
53            
54             $handle->on_read(sub {
55             $handle->push_read( line => sub {
56 11         662 my($handle, $line) = @_;
57 11         24 $line =~ s/\015?\012//g;
58 11         20 my $req = eval { AnyEvent::Ident::Request->new($line) };
  11         80  
59 11 100       55 return $handle->push_write("$line:ERROR:INVALID-PORT\015\012") if $@;
60             my $tx = bless {
61             req => $req,
62             remote_port => $port,
63             local_port => $self->{bindport},
64             remote_address => $host,
65             cb => sub {
66 7         15 my($res) = @_;
67 7         30 $handle->push_write($res->as_string . "\015\012");
68             },
69 7         80 }, 'AnyEvent::Ident::Transaction';
70 7         28 $callback->($tx);
71             })
72 6         1493 });
  11         1468  
73 4         23 };
74              
75             $self->{guard} = tcp_server $self->{hostname}, $self->{port}, $cb, sub {
76 4     4   1465 my($fh, $host, $port) = @_;
77 4         13 $self->{bindport} = $port;
78 4         21 $self->{on_bind}->($self);
79 4         40 };
80            
81 4         499 $self;
82             }
83              
84              
85 8     8 1 189 sub bindport { shift->{bindport} }
86              
87              
88             sub stop
89             {
90 1     1 1 734 my($self) = @_;
91 1         12 delete $self->{guard};
92 1         56 delete $self->{bindport};
93 1         4 $self;
94             }
95              
96             1;
97              
98             __END__