… | |
… | |
14 | |
14 | |
15 | AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent |
15 | AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent |
16 | |
16 | |
17 | =cut |
17 | =cut |
18 | |
18 | |
19 | our $VERSION = 4.14; |
19 | our $VERSION = 4.15; |
20 | |
20 | |
21 | =head1 SYNOPSIS |
21 | =head1 SYNOPSIS |
22 | |
22 | |
23 | use AnyEvent; |
23 | use AnyEvent; |
24 | use AnyEvent::Handle; |
24 | use AnyEvent::Handle; |
… | |
… | |
167 | |
167 | |
168 | Sets the amount of bytes (default: C<0>) that make up an "empty" write |
168 | Sets the amount of bytes (default: C<0>) that make up an "empty" write |
169 | buffer: If the write reaches this size or gets even samller it is |
169 | buffer: If the write reaches this size or gets even samller it is |
170 | considered empty. |
170 | considered empty. |
171 | |
171 | |
|
|
172 | =item linger => <seconds> |
|
|
173 | |
|
|
174 | If non-zero (default: C<3600>), then the destructor of the |
|
|
175 | AnyEvent::Handle object will check wether there is still outstanding write |
|
|
176 | data and will install a watcher that will write out this data. No errors |
|
|
177 | will be reported (this mostly matches how the operating system treats |
|
|
178 | outstanding data at socket close time). |
|
|
179 | |
|
|
180 | This will not work for partial TLS data that could not yet been |
|
|
181 | encoded. This data will be lost. |
|
|
182 | |
172 | =item tls => "accept" | "connect" | Net::SSLeay::SSL object |
183 | =item tls => "accept" | "connect" | Net::SSLeay::SSL object |
173 | |
184 | |
174 | When this parameter is given, it enables TLS (SSL) mode, that means it |
185 | When this parameter is given, it enables TLS (SSL) mode, that means it |
175 | will start making tls handshake and will transparently encrypt/decrypt |
186 | will start making tls handshake and will transparently encrypt/decrypt |
176 | data. |
187 | data. |
… | |
… | |
531 | |
542 | |
532 | require JSON; |
543 | require JSON; |
533 | |
544 | |
534 | $self->{json} ? $self->{json}->encode ($ref) |
545 | $self->{json} ? $self->{json}->encode ($ref) |
535 | : JSON::encode_json ($ref) |
546 | : JSON::encode_json ($ref) |
|
|
547 | }; |
|
|
548 | |
|
|
549 | =item storable => $reference |
|
|
550 | |
|
|
551 | Freezes the given reference using L<Storable> and writes it to the |
|
|
552 | handle. Uses the C<nfreeze> format. |
|
|
553 | |
|
|
554 | =cut |
|
|
555 | |
|
|
556 | register_write_type storable => sub { |
|
|
557 | my ($self, $ref) = @_; |
|
|
558 | |
|
|
559 | require Storable; |
|
|
560 | |
|
|
561 | pack "w/a", Storable::nfreeze ($ref) |
536 | }; |
562 | }; |
537 | |
563 | |
538 | =back |
564 | =back |
539 | |
565 | |
540 | =item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) |
566 | =item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) |
… | |
… | |
1034 | the C<json> write type description, above, for an actual example. |
1060 | the C<json> write type description, above, for an actual example. |
1035 | |
1061 | |
1036 | =cut |
1062 | =cut |
1037 | |
1063 | |
1038 | register_read_type json => sub { |
1064 | register_read_type json => sub { |
1039 | my ($self, $cb, $accept, $reject, $skip) = @_; |
1065 | my ($self, $cb) = @_; |
1040 | |
1066 | |
1041 | require JSON; |
1067 | require JSON; |
1042 | |
1068 | |
1043 | my $data; |
1069 | my $data; |
1044 | my $rbuf = \$self->{rbuf}; |
1070 | my $rbuf = \$self->{rbuf}; |
… | |
… | |
1056 | 1 |
1082 | 1 |
1057 | } else { |
1083 | } else { |
1058 | $self->{rbuf} = ""; |
1084 | $self->{rbuf} = ""; |
1059 | () |
1085 | () |
1060 | } |
1086 | } |
|
|
1087 | } |
|
|
1088 | }; |
|
|
1089 | |
|
|
1090 | =item storable => $cb->($handle, $ref) |
|
|
1091 | |
|
|
1092 | Deserialises a L<Storable> frozen representation as written by the |
|
|
1093 | C<storable> write type (BER-encoded length prefix followed by nfreeze'd |
|
|
1094 | data). |
|
|
1095 | |
|
|
1096 | Raises C<EBADMSG> error if the data could not be decoded. |
|
|
1097 | |
|
|
1098 | =cut |
|
|
1099 | |
|
|
1100 | register_read_type storable => sub { |
|
|
1101 | my ($self, $cb) = @_; |
|
|
1102 | |
|
|
1103 | require Storable; |
|
|
1104 | |
|
|
1105 | sub { |
|
|
1106 | # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method |
|
|
1107 | defined (my $len = eval { unpack "w", $_[0]->{rbuf} }) |
|
|
1108 | or return; |
|
|
1109 | |
|
|
1110 | # remove prefix |
|
|
1111 | substr $_[0]->{rbuf}, 0, (length pack "w", $len), ""; |
|
|
1112 | |
|
|
1113 | # read rest |
|
|
1114 | $_[0]->unshift_read (chunk => $len, sub { |
|
|
1115 | if (my $ref = eval { Storable::thaw ($_[1]) }) { |
|
|
1116 | $cb->($_[0], $ref); |
|
|
1117 | } else { |
|
|
1118 | $self->_error (&Errno::EBADMSG); |
|
|
1119 | } |
|
|
1120 | }); |
1061 | } |
1121 | } |
1062 | }; |
1122 | }; |
1063 | |
1123 | |
1064 | =back |
1124 | =back |
1065 | |
1125 | |
… | |
… | |
1253 | |
1313 | |
1254 | sub DESTROY { |
1314 | sub DESTROY { |
1255 | my $self = shift; |
1315 | my $self = shift; |
1256 | |
1316 | |
1257 | $self->stoptls; |
1317 | $self->stoptls; |
|
|
1318 | |
|
|
1319 | my $linger = exists $self->{linger} ? $self->{linger} : 3600; |
|
|
1320 | |
|
|
1321 | if ($linger && length $self->{wbuf}) { |
|
|
1322 | my $fh = delete $self->{fh}; |
|
|
1323 | my $wbuf = delete $self->{wbuf}; |
|
|
1324 | |
|
|
1325 | my @linger; |
|
|
1326 | |
|
|
1327 | push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub { |
|
|
1328 | my $len = syswrite $fh, $wbuf, length $wbuf; |
|
|
1329 | |
|
|
1330 | if ($len > 0) { |
|
|
1331 | substr $wbuf, 0, $len, ""; |
|
|
1332 | } else { |
|
|
1333 | @linger = (); # end |
|
|
1334 | } |
|
|
1335 | }); |
|
|
1336 | push @linger, AnyEvent->timer (after => $linger, cb => sub { |
|
|
1337 | @linger = (); |
|
|
1338 | }); |
|
|
1339 | } |
1258 | } |
1340 | } |
1259 | |
1341 | |
1260 | =item AnyEvent::Handle::TLS_CTX |
1342 | =item AnyEvent::Handle::TLS_CTX |
1261 | |
1343 | |
1262 | This function creates and returns the Net::SSLeay::CTX object used by |
1344 | This function creates and returns the Net::SSLeay::CTX object used by |