File Coverage

blib/lib/MooX/Async/Console/TCPClient.pm
Criterion Covered Total %
statement 15 33 45.4
branch 0 4 0.0
condition 0 3 0.0
subroutine 5 13 38.4
pod 5 5 100.0
total 25 58 43.1


line stmt bran cond sub pod time code
1             package MooX::Async::Console::TCPClient;
2              
3             =head1 NAME
4              
5             MooX::Async::Console::TCPClient - TCP client interaction for MooX::Async::Console
6              
7             =head1 SYNOPSIS
8              
9             See L
10              
11             =head1 DESCRIPTION
12              
13             A L subclass which waits for a complete line of
14             text and invokes L.
15              
16             =head1 BUGS
17              
18             Certainly.
19              
20             =cut
21              
22 1     1   7 use Modern::Perl '2017';
  1         13  
  1         5  
23 1     1   112 use strictures 2;
  1         7  
  1         29  
24              
25 1     1   131 use Moo;
  1         2  
  1         5  
26 1     1   270 use MooX::Async;
  1         2  
  1         5  
27 1     1   37 use namespace::clean;
  1         2  
  1         6  
28              
29             extends MooXAsync('Stream');
30              
31             with 'MooX::Role::Logger';
32              
33             =head1 ATTRIBUTES
34              
35             =over
36              
37             =item id
38              
39             A string composed from L and L which identifies this
40             client.
41              
42             =cut
43              
44             has id => is => lazy => init_arg => undef, builder =>
45 0     0     sub { sprintf 'tcp:%s:%s', $_[0]->address, $_[0]->port };
46              
47             =item address
48              
49             The IP address this client connected from.
50              
51             =cut
52              
53             has address => is => lazy => init_arg => undef, builder =>
54 0     0     sub { $_[0]->read_handle->peerhost }; # TODO: Force normalised ipv6
55              
56             =item port
57              
58             The TCP port this client connected from.
59              
60             =cut
61              
62             has port => is => lazy => init_arg => undef, builder =>
63 0     0     sub { $_[0]->read_handle->peerport };
64              
65             =back
66              
67             =head1 METHODS
68              
69             =over
70              
71             =item flush
72              
73             Flush the client's write buffer.
74              
75             =cut
76              
77 0     0 1   sub flush { $_[0]->write('')->get }
78              
79             =item say
80              
81             Write the arguments to the stream with C<\n> appended.
82              
83             =cut
84              
85 0     0 1   sub say { $_[0]->write($_[1] . "\n") }
86              
87             =back
88              
89             =head1 EVENTS
90              
91             =over
92              
93             =item on_close
94              
95             Invoked when the client has closed the connection.
96              
97             =item on_line
98              
99             Invoked when the client has a complete line of text which is not just
100             whitespace.
101              
102             =cut
103              
104             event $_ for qw(on_close on_line);
105              
106             =item on_error
107              
108             Implemented by this module to close the connection and invoke
109             C when there's an error.
110              
111             =cut
112              
113             sub on_error {
114 0     0 1   local $_[0]->_logger->context->{client} = $_[0]->id;
115 0           $_[0]->_logger->errorf('%s write error: %s', ref $_[0], [ @_[1..$#_] ]);
116 0           $_[0]->close;
117 0           $_[0]->invoke_event(on_close => 'error', @_[1..$#_]);
118             }
119              
120             =item on_read
121              
122             Implemented by this module to detect a complete line in the read
123             buffer and invoke C.
124              
125             =cut
126              
127             sub on_read {
128 0     0 1   my $self = shift;
129 0           local $self->_logger->context->{client} = $self->id;
130 0           my ($rbuf, $eof) = @_;
131 0           while ($$rbuf =~ s/^(.*?)\r?\n//) {
132 0 0 0       next unless length $1 or $1 =~ /^\s+$/;
133 0           $self->invoke_event(on_line => $1);
134             }
135 0 0         return $eof ? 0 : 0+! length $$rbuf;
136             }
137              
138             =item on_read_eof
139              
140             Implemented by this module to invoke C when the client
141             disconnects.
142              
143             =cut
144              
145             sub on_read_eof {
146 0     0 1   local $_[0]->_logger->context->{client} = $_[0]->id;
147 0           $_[0]->invoke_event(on_close => 'EOF');
148             }
149              
150             1;
151              
152             =back
153              
154             =head1 SEE ALSO
155              
156             L
157              
158             L
159              
160             =head1 AUTHOR
161              
162             Matthew King
163              
164             =cut