| … | |
… | |
| 542 | |
542 | |
| 543 | require JSON; |
543 | require JSON; |
| 544 | |
544 | |
| 545 | $self->{json} ? $self->{json}->encode ($ref) |
545 | $self->{json} ? $self->{json}->encode ($ref) |
| 546 | : 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) |
| 547 | }; |
562 | }; |
| 548 | |
563 | |
| 549 | =back |
564 | =back |
| 550 | |
565 | |
| 551 | =item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) |
566 | =item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) |
| … | |
… | |
| 1045 | the C<json> write type description, above, for an actual example. |
1060 | the C<json> write type description, above, for an actual example. |
| 1046 | |
1061 | |
| 1047 | =cut |
1062 | =cut |
| 1048 | |
1063 | |
| 1049 | register_read_type json => sub { |
1064 | register_read_type json => sub { |
| 1050 | my ($self, $cb, $accept, $reject, $skip) = @_; |
1065 | my ($self, $cb) = @_; |
| 1051 | |
1066 | |
| 1052 | require JSON; |
1067 | require JSON; |
| 1053 | |
1068 | |
| 1054 | my $data; |
1069 | my $data; |
| 1055 | my $rbuf = \$self->{rbuf}; |
1070 | my $rbuf = \$self->{rbuf}; |
| … | |
… | |
| 1067 | 1 |
1082 | 1 |
| 1068 | } else { |
1083 | } else { |
| 1069 | $self->{rbuf} = ""; |
1084 | $self->{rbuf} = ""; |
| 1070 | () |
1085 | () |
| 1071 | } |
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 | }); |
| 1072 | } |
1121 | } |
| 1073 | }; |
1122 | }; |
| 1074 | |
1123 | |
| 1075 | =back |
1124 | =back |
| 1076 | |
1125 | |
