File Coverage

blib/lib/AnyEvent/Ident/Client.pm
Criterion Covered Total %
statement 55 80 68.7
branch 11 20 55.0
condition 4 6 66.6
subroutine 10 12 83.3
pod 2 3 66.6
total 82 121 67.7


line stmt bran cond sub pod time code
1             package AnyEvent::Ident::Client;
2              
3 5     5   70657 use strict;
  5         12  
  5         200  
4 5     5   23 use warnings;
  5         11  
  5         148  
5 5     5   3773 use AnyEvent::Socket qw( tcp_connect );
  5         163666  
  5         1841  
6 5     5   6365 use AnyEvent::Handle;
  5         33813  
  5         185  
7 5     5   46 use Carp qw( carp );
  5         10  
  5         5542  
8              
9             # ABSTRACT: Simple asynchronous ident client
10             our $VERSION = '0.06'; # VERSION
11              
12              
13             sub new
14             {
15 7     7 0 29 my $class = shift;
16 7 50       54 my $args = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
  0         0  
17 7         48 my $port = $args->{port};
18 7 100       30 $port = 113 unless defined $port;
19             bless {
20             hostname => $args->{hostname} || '127.0.0.1',
21             port => $port,
22 0     0   0 on_error => $args->{on_error} || sub { carp $_[0] },
23 7   50     170 response_class => $args->{response_class} || 'AnyEvent::Ident::Response',
      50        
      100        
24             }, $class;
25             }
26              
27              
28             sub ident
29             {
30 11     11 1 3092 my($self, $server_port, $client_port, $cb) = @_;
31            
32 11 50       23 unless(eval { $self->{response_class}->can('new') })
  11         236  
33             {
34 0         0 eval 'use ' . $self->{response_class};
35 0 0       0 die $@ if $@;
36             }
37            
38 11         146 my $key = join ':', $server_port, $client_port;
39 11         18 push @{ $self->{$key} }, $cb;
  11         41  
40 11 50       16 return if @{ $self->{$key} } > 1;
  11         42  
41            
42             # if handle is defined then the connection is open and we can push
43             # the request right away.
44 11 100       36 if(defined $self->{handle})
45             {
46 5         29 $self->{handle}->push_write("$server_port,$client_port\015\012");
47 5         393 return;
48             }
49            
50             # if handle is not defined, but wait is, then we are waiting for
51             # the connection, and we queue up the request
52 6 50       24 if(defined $self->{wait})
53             {
54 0         0 push @{ $self->{wait} }, "$server_port,$client_port\015\012";
  0         0  
55 0         0 return;
56             }
57            
58 6         18 $self->{wait} = [];
59            
60             tcp_connect $self->{hostname}, $self->{port}, sub {
61 6     6   5011 my($fh) = @_;
62 6 50       28 return $self->_cleanup->{on_error}->("unable to connect: $!") unless $fh;
63            
64             $self->{handle} = AnyEvent::Handle->new(
65             fh => $fh,
66             on_error => sub {
67 0         0 my ($hdl, $fatal, $msg) = @_;
68 0         0 $self->{on_error}->($msg);
69 0         0 $self->_cleanup;
70 0         0 $_[0]->destroy;
71 0         0 delete $self->{handle};
72             },
73             on_eof => sub {
74 0         0 $self->_cleanup;
75 0         0 $self->{handle}->destroy;
76 0         0 delete $self->{handle};
77             },
78 6         122 );
79            
80 6         607 $self->{handle}->push_write("$server_port,$client_port\015\012");
81 6         2481 $self->{handle}->push_write($_) for @{ $self->{wait} };
  6         29  
82 6         19 delete $self->{wait};
83            
84             $self->{handle}->on_read(sub {
85             $self->{handle}->push_read( line => sub {
86 11         458 my($handle, $line) = @_;
87 11         26 $line =~ s/\015?\012//g;
88 11         54 my $res = $self->{response_class}->new($line);
89 11         47 my $key = $res->_key;
90 11 50       42 if(defined $self->{$key})
91             {
92 11         17 $_->($res) for @{ $self->{$key} };
  11         53  
93 11         357 delete $self->{$key};
94             }
95 11         3363 });
96 6         76 });
97 6         75 };
98            
99 6         10685 return $self;
100             }
101              
102              
103             sub _cleanup
104             {
105 0     0   0 my $self = shift;
106 0         0 foreach my $key (grep /^(\d+):(\d+)$/, keys %$self)
107             {
108 0         0 $_->($self->{response_class}->new("$1,$2:ERROR:UNKNOWN-ERROR"))
109 0         0 for @{ $self->{$key} };
110 0         0 delete $self->{$key};
111             }
112 0         0 $self;
113             }
114              
115             sub close
116             {
117 1     1 1 2 my $self = shift;
118 1 50       94 if(defined $self->{handle})
119             {
120 0         0 $self->_cleanup;
121 0         0 $self->{handle}->destroy;
122 0         0 delete $self->{handle};
123 0         0 delete $self->{wait};
124             }
125             }
126              
127             sub DESTROY
128             {
129 1     1   398 shift->close;
130             }
131              
132             1;
133              
134             __END__