line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2010-2021 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Net::Async::IRC::Protocol 0.12; |
7
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
108
|
use v5.14; |
|
8
|
|
|
|
|
29
|
|
9
|
8
|
|
|
8
|
|
41
|
use warnings; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
248
|
|
10
|
|
|
|
|
|
|
|
11
|
8
|
|
|
8
|
|
77
|
use base qw( IO::Async::Stream Protocol::IRC ); |
|
8
|
|
|
|
|
51
|
|
|
8
|
|
|
|
|
5325
|
|
12
|
|
|
|
|
|
|
|
13
|
8
|
|
|
8
|
|
175650
|
use Carp; |
|
8
|
|
|
|
|
21
|
|
|
8
|
|
|
|
|
513
|
|
14
|
|
|
|
|
|
|
|
15
|
8
|
|
|
8
|
|
59
|
use Protocol::IRC::Message; |
|
8
|
|
|
|
|
20
|
|
|
8
|
|
|
|
|
188
|
|
16
|
|
|
|
|
|
|
|
17
|
8
|
|
|
8
|
|
46
|
use Encode qw( find_encoding ); |
|
8
|
|
|
|
|
19
|
|
|
8
|
|
|
|
|
367
|
|
18
|
8
|
|
|
8
|
|
52
|
use Time::HiRes qw( time ); |
|
8
|
|
|
|
|
19
|
|
|
8
|
|
|
|
|
78
|
|
19
|
|
|
|
|
|
|
|
20
|
8
|
|
|
8
|
|
5381
|
use IO::Async::Timer::Countdown; |
|
8
|
|
|
|
|
14757
|
|
|
8
|
|
|
|
|
10130
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
C - send and receive IRC messages |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 DESCRIPTION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This subclass of L implements an established IRC |
29
|
|
|
|
|
|
|
connection that has already completed its inital login sequence and is ready |
30
|
|
|
|
|
|
|
to send and receive IRC messages. It handles base message sending and |
31
|
|
|
|
|
|
|
receiving, and implements ping timers. This class provides most of the |
32
|
|
|
|
|
|
|
functionality required for sending and receiving IRC commands and responses |
33
|
|
|
|
|
|
|
by mixing in from L. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Objects of this type would not normally be constructed directly. For IRC |
36
|
|
|
|
|
|
|
clients, see L which is a subclass of it. All the events, |
37
|
|
|
|
|
|
|
parameters, and methods documented below are relevant there. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 EVENTS |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
The following events are invoked, either using subclass methods or C |
44
|
|
|
|
|
|
|
references in parameters: |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head2 $handled = on_message |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head2 $handled = on_message_MESSAGE |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Invoked on receipt of a valid IRC message. See C below. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 on_irc_error $err |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Invoked on receipt of an invalid IRC message if parsing fails. C<$err> is the |
55
|
|
|
|
|
|
|
error message text. If left unhandled, any parse error will result in the |
56
|
|
|
|
|
|
|
connection being immediataely closed, followed by the exception being |
57
|
|
|
|
|
|
|
re-thrown. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head2 on_ping_timeout |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Invoked if the peer fails to respond to a C message within the given |
62
|
|
|
|
|
|
|
timeout. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 on_pong_reply $lag |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Invoked when the peer successfully sends a C reply response to a C |
67
|
|
|
|
|
|
|
message. C<$lag> is the response time in (fractional) seconds. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=cut |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head1 PARAMETERS |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The following named parameters may be passed to C or C: |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=over 8 |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item on_message => CODE |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item on_message_MESSAGE => CODE |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item on_irc_error => CODE |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item on_ping_timeout => CODE |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item on_pong_reply => CODE |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
C references for event handlers. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item pingtime => NUM |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Amount of quiet time, in seconds, after a message is received from the peer, |
92
|
|
|
|
|
|
|
until a C will be sent to check it is still alive. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item pongtime => NUM |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Timeout, in seconds, after sending a C message, to wait for a C |
97
|
|
|
|
|
|
|
response. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item encoding => STRING |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
If supplied, sets an encoding to use to encode outgoing messages and decode |
102
|
|
|
|
|
|
|
incoming messages. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=back |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 new |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
$irc = Net::Async::IRC::Protocol->new( %args ); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Returns a new instance of a C object. This object |
117
|
|
|
|
|
|
|
represents a IRC connection to a peer. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub new |
122
|
|
|
|
|
|
|
{ |
123
|
9
|
|
|
9
|
1
|
27
|
my $class = shift; |
124
|
9
|
|
|
|
|
41
|
my %args = @_; |
125
|
|
|
|
|
|
|
|
126
|
9
|
|
|
|
|
44
|
my $on_closed = delete $args{on_closed}; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
return $class->SUPER::new( |
129
|
|
|
|
|
|
|
%args, |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
on_closed => sub { |
132
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
0
|
my $loop = $self->get_loop; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
0
|
$self->{pingtimer}->stop; |
137
|
0
|
|
|
|
|
0
|
$self->{pongtimer}->stop; |
138
|
|
|
|
|
|
|
|
139
|
0
|
0
|
|
|
|
0
|
$on_closed->( $self ) if $on_closed; |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
0
|
undef $self->{connect_f}; |
142
|
0
|
|
|
|
|
0
|
undef $self->{login_f}; |
143
|
|
|
|
|
|
|
}, |
144
|
9
|
|
|
|
|
161
|
); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub _init |
148
|
|
|
|
|
|
|
{ |
149
|
9
|
|
|
9
|
|
21
|
my $self = shift; |
150
|
9
|
|
|
|
|
63
|
$self->SUPER::_init( @_ ); |
151
|
|
|
|
|
|
|
|
152
|
9
|
|
|
|
|
312
|
my $pingtime = 60; |
153
|
9
|
|
|
|
|
20
|
my $pongtime = 10; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
$self->{pingtimer} = IO::Async::Timer::Countdown->new( |
156
|
|
|
|
|
|
|
delay => $pingtime, |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
on_expire => sub { |
159
|
2
|
|
|
2
|
|
4002313
|
my $now = time(); |
160
|
|
|
|
|
|
|
|
161
|
2
|
|
|
|
|
213
|
$self->send_message( "PING", undef, "$now" ); |
162
|
|
|
|
|
|
|
|
163
|
2
|
|
|
|
|
1065
|
$self->{ping_send_time} = $now; |
164
|
|
|
|
|
|
|
|
165
|
2
|
|
|
|
|
16
|
$self->{pongtimer}->start; |
166
|
|
|
|
|
|
|
}, |
167
|
9
|
|
|
|
|
144
|
); |
168
|
9
|
|
|
|
|
1068
|
$self->add_child( $self->{pingtimer} ); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
$self->{pongtimer} = IO::Async::Timer::Countdown->new( |
171
|
|
|
|
|
|
|
delay => $pongtime, |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
on_expire => sub { |
174
|
1
|
50
|
|
1
|
|
1001703
|
$self->{on_ping_timeout}->( $self ) if $self->{on_ping_timeout}; |
175
|
|
|
|
|
|
|
}, |
176
|
9
|
|
|
|
|
340
|
); |
177
|
9
|
|
|
|
|
561
|
$self->add_child( $self->{pongtimer} ); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# for Protocol::IRC |
181
|
|
|
|
|
|
|
sub encoder |
182
|
|
|
|
|
|
|
{ |
183
|
42
|
|
|
42
|
1
|
8593
|
my $self = shift; |
184
|
42
|
|
|
|
|
106
|
return $self->{encoder}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub configure |
188
|
|
|
|
|
|
|
{ |
189
|
11
|
|
|
11
|
1
|
25
|
my $self = shift; |
190
|
11
|
|
|
|
|
34
|
my %args = @_; |
191
|
|
|
|
|
|
|
|
192
|
11
|
|
|
|
|
89
|
$self->{$_} = delete $args{$_} for grep m/^on_message/, keys %args; |
193
|
|
|
|
|
|
|
|
194
|
11
|
|
|
|
|
36
|
for (qw( on_ping_timeout on_pong_reply on_irc_error )) { |
195
|
33
|
100
|
|
|
|
92
|
$self->{$_} = delete $args{$_} if exists $args{$_}; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
11
|
100
|
|
|
|
43
|
if( exists $args{pingtime} ) { |
199
|
1
|
|
|
|
|
5
|
$self->{pingtimer}->configure( delay => delete $args{pingtime} ); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
11
|
100
|
|
|
|
82
|
if( exists $args{pongtime} ) { |
203
|
1
|
|
|
|
|
4
|
$self->{pongtimer}->configure( delay => delete $args{pongtime} ); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
11
|
100
|
|
|
|
92
|
if( exists $args{encoding} ) { |
207
|
1
|
|
|
|
|
5
|
my $encoding = delete $args{encoding}; |
208
|
1
|
|
|
|
|
6
|
my $obj = find_encoding( $encoding ); |
209
|
1
|
50
|
|
|
|
199
|
defined $obj or croak "Cannot handle an encoding of '$encoding'"; |
210
|
1
|
|
|
|
|
3
|
$self->{encoder} = $obj; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
11
|
|
|
|
|
120
|
$self->SUPER::configure( %args ); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub incoming_message |
217
|
|
|
|
|
|
|
{ |
218
|
20
|
|
|
20
|
1
|
1722
|
my $self = shift; |
219
|
20
|
|
|
|
|
42
|
my ( $message ) = @_; |
220
|
|
|
|
|
|
|
|
221
|
20
|
|
|
|
|
70
|
my @shortargs = ( $message->arg( 0 ) ); |
222
|
20
|
100
|
|
|
|
213
|
push @shortargs, $message->arg( 1 ) if $message->command =~ m/^\d+$/; |
223
|
20
|
100
|
|
|
|
266
|
push @shortargs, "..." if $message->args > 1; |
224
|
|
|
|
|
|
|
|
225
|
20
|
|
|
|
|
177
|
$self->debug_printf( "COMMAND ${\ $message->command } @shortargs" ); |
|
20
|
|
|
|
|
57
|
|
226
|
|
|
|
|
|
|
|
227
|
20
|
|
|
|
|
325
|
return $self->SUPER::incoming_message( @_ ); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 METHODS |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 is_connected |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
$connect = $irc->is_connected; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Returns true if a connection to the peer is established. Note that even |
239
|
|
|
|
|
|
|
after a successful connection, the connection may not yet logged in to. See |
240
|
|
|
|
|
|
|
also the C method. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub is_connected |
245
|
|
|
|
|
|
|
{ |
246
|
6
|
|
|
6
|
1
|
1702
|
my $self = shift; |
247
|
6
|
100
|
|
|
|
26
|
return 0 unless my $connect_f = $self->{connect_f}; |
248
|
5
|
|
33
|
|
|
18
|
return $connect_f->is_ready && !$connect_f->failure; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=head2 is_loggedin |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
$loggedin = $irc->is_loggedin; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Returns true if the full login sequence has been performed on the connection |
256
|
|
|
|
|
|
|
and it is ready to use. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub is_loggedin |
261
|
|
|
|
|
|
|
{ |
262
|
2
|
|
|
2
|
1
|
726
|
my $self = shift; |
263
|
2
|
100
|
|
|
|
13
|
return 0 unless my $login_f = $self->{login_f}; |
264
|
1
|
|
33
|
|
|
5
|
return $login_f->is_ready && !$login_f->failure; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub on_read |
268
|
|
|
|
|
|
|
{ |
269
|
21
|
|
|
21
|
1
|
2053642
|
my $self = shift; |
270
|
21
|
|
|
|
|
59
|
my ( $buffref, $eof ) = @_; |
271
|
|
|
|
|
|
|
|
272
|
21
|
|
|
|
|
47
|
my $pingtimer = $self->{pingtimer}; |
273
|
|
|
|
|
|
|
|
274
|
21
|
100
|
|
|
|
80
|
$pingtimer->is_running ? $pingtimer->reset : $pingtimer->start; |
275
|
|
|
|
|
|
|
|
276
|
21
|
100
|
|
|
|
4789
|
eval { |
277
|
21
|
|
|
|
|
111
|
$self->Protocol::IRC::on_read( $$buffref ); |
278
|
20
|
|
|
|
|
393
|
1; |
279
|
|
|
|
|
|
|
} and return 0; |
280
|
|
|
|
|
|
|
|
281
|
1
|
|
|
|
|
442
|
my $e = "$@"; chomp $e; |
|
1
|
|
|
|
|
6
|
|
282
|
|
|
|
|
|
|
|
283
|
1
|
50
|
|
|
|
4
|
$self->maybe_invoke_event( on_irc_error => $e ) |
284
|
|
|
|
|
|
|
and return 0; |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
0
|
$self->close_now; |
287
|
0
|
|
|
|
|
0
|
die "$e\n"; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=head2 nick |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
$nick = $irc->nick; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Returns the current nick in use by the connection. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=cut |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub _set_nick |
299
|
|
|
|
|
|
|
{ |
300
|
13
|
|
|
13
|
|
30
|
my $self = shift; |
301
|
13
|
|
|
|
|
36
|
( $self->{nick} ) = @_; |
302
|
13
|
|
|
|
|
65
|
$self->{nick_folded} = $self->casefold_name( $self->{nick} ); |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub nick |
306
|
|
|
|
|
|
|
{ |
307
|
4
|
|
|
4
|
1
|
1064
|
my $self = shift; |
308
|
4
|
|
|
|
|
21
|
return $self->{nick}; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head2 nick_folded |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
$nick_folded = $irc->nick_folded; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Returns the current nick in use by the connection, folded by C |
316
|
|
|
|
|
|
|
for convenience. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=cut |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub nick_folded |
321
|
|
|
|
|
|
|
{ |
322
|
11
|
|
|
11
|
1
|
672
|
my $self = shift; |
323
|
11
|
|
|
|
|
47
|
return $self->{nick_folded}; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head1 MESSAGE HANDLING |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
Every incoming message causes a sequence of message handling to occur. First, |
329
|
|
|
|
|
|
|
the message is parsed, and a hash of data about it is created; this is called |
330
|
|
|
|
|
|
|
the hints hash. The message and this hash are then passed down a sequence of |
331
|
|
|
|
|
|
|
potential handlers. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Each handler indicates by return value, whether it considers the message to |
334
|
|
|
|
|
|
|
have been handled. Processing of the message is not interrupted the first time |
335
|
|
|
|
|
|
|
a handler declares to have handled a message. Instead, the hints hash is |
336
|
|
|
|
|
|
|
marked to say it has been handled. Later handlers can still inspect the |
337
|
|
|
|
|
|
|
message or its hints, using this information to decide if they wish to take |
338
|
|
|
|
|
|
|
further action. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
A message with a command of C will try handlers in following places: |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=over 4 |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=item 1. |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
A CODE ref in a parameter called C |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
$on_message_COMMAND->( $irc, $message, \%hints ) |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item 2. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
A method called C |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
$irc->on_message_COMMAND( $message, \%hints ) |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=item 3. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
A CODE ref in a parameter called C |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
$on_message->( $irc, 'COMMAND', $message, \%hints ) |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=item 4. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
A method called C |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
$irc->on_message( 'COMMAND', $message, \%hints ) |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=back |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
As this message handling ability is provided by C, more details |
371
|
|
|
|
|
|
|
about how it works and how to use it can be found at |
372
|
|
|
|
|
|
|
L. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Additionally, some types of messages receive further processing by |
375
|
|
|
|
|
|
|
C and in turn cause new types of events to be invoked. These |
376
|
|
|
|
|
|
|
are further documented by L. |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=cut |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub invoke |
381
|
|
|
|
|
|
|
{ |
382
|
60
|
|
|
60
|
1
|
2684
|
my $self = shift; |
383
|
60
|
100
|
|
|
|
155
|
my $retref = $self->maybe_invoke_event( @_ ) or return undef; |
384
|
31
|
|
|
|
|
684
|
return $retref->[0]; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub on_message_PONG |
388
|
|
|
|
|
|
|
{ |
389
|
1
|
|
|
1
|
0
|
23
|
my $self = shift; |
390
|
1
|
|
|
|
|
3
|
my ( $message, $hints ) = @_; |
391
|
|
|
|
|
|
|
|
392
|
1
|
50
|
|
|
|
5
|
return 1 unless $self->{pongtimer}->is_running; |
393
|
|
|
|
|
|
|
|
394
|
1
|
|
|
|
|
13
|
my $lag = time - $self->{ping_send_time}; |
395
|
|
|
|
|
|
|
|
396
|
1
|
|
|
|
|
7
|
$self->{current_lag} = $lag; |
397
|
1
|
50
|
|
|
|
9
|
$self->{on_pong_reply}->( $self, $lag ) if $self->{on_pong_reply}; |
398
|
|
|
|
|
|
|
|
399
|
1
|
|
|
|
|
11
|
$self->{pongtimer}->stop; |
400
|
|
|
|
|
|
|
|
401
|
1
|
|
|
|
|
168
|
return 1; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=head1 AUTHOR |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
Paul Evans |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=cut |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
0x55AA; |