| … | |
… | |
| 21 | use Coro::Semaphore; |
21 | use Coro::Semaphore; |
| 22 | use Coro::AIO; |
22 | use Coro::AIO; |
| 23 | use Coro::Storable; |
23 | use Coro::Storable; |
| 24 | use Coro::Util (); |
24 | use Coro::Util (); |
| 25 | |
25 | |
| 26 | use JSON::XS (); |
26 | use JSON::XS 2.01 (); |
| 27 | use BDB (); |
27 | use BDB (); |
| 28 | use Data::Dumper; |
28 | use Data::Dumper; |
| 29 | use Digest::MD5; |
29 | use Digest::MD5; |
| 30 | use Fcntl; |
30 | use Fcntl; |
| 31 | use YAML::Syck (); |
31 | use YAML::Syck (); |
| … | |
… | |
| 246 | $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; |
246 | $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; |
| 247 | $d |
247 | $d |
| 248 | } || "[unable to dump $_[0]: '$@']"; |
248 | } || "[unable to dump $_[0]: '$@']"; |
| 249 | } |
249 | } |
| 250 | |
250 | |
| 251 | =item $ref = cf::from_json $json |
251 | =item $ref = cf::decode_json $json |
| 252 | |
252 | |
| 253 | Converts a JSON string into the corresponding perl data structure. |
253 | Converts a JSON string into the corresponding perl data structure. |
| 254 | |
254 | |
| 255 | =item $json = cf::to_json $ref |
255 | =item $json = cf::encode_json $ref |
| 256 | |
256 | |
| 257 | Converts a perl data structure into its JSON representation. |
257 | Converts a perl data structure into its JSON representation. |
| 258 | |
258 | |
| 259 | =cut |
259 | =cut |
| 260 | |
260 | |
| 261 | our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max |
261 | our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max |
| 262 | |
262 | |
| 263 | sub to_json ($) { $json_coder->encode ($_[0]) } |
263 | sub encode_json($) { $json_coder->encode ($_[0]) } |
| 264 | sub from_json ($) { $json_coder->decode ($_[0]) } |
264 | sub decode_json($) { $json_coder->decode ($_[0]) } |
| 265 | |
265 | |
| 266 | =item cf::lock_wait $string |
266 | =item cf::lock_wait $string |
| 267 | |
267 | |
| 268 | Wait until the given lock is available. See cf::lock_acquire. |
268 | Wait until the given lock is available. See cf::lock_acquire. |
| 269 | |
269 | |
| … | |
… | |
| 1055 | cf::attachable->attach ( |
1055 | cf::attachable->attach ( |
| 1056 | prio => -1000000, |
1056 | prio => -1000000, |
| 1057 | on_instantiate => sub { |
1057 | on_instantiate => sub { |
| 1058 | my ($obj, $data) = @_; |
1058 | my ($obj, $data) = @_; |
| 1059 | |
1059 | |
| 1060 | $data = from_json $data; |
1060 | $data = decode_json $data; |
| 1061 | |
1061 | |
| 1062 | for (@$data) { |
1062 | for (@$data) { |
| 1063 | my ($name, $args) = @$_; |
1063 | my ($name, $args) = @$_; |
| 1064 | |
1064 | |
| 1065 | $obj->attach ($name, %{$args || {} }); |
1065 | $obj->attach ($name, %{$args || {} }); |
| … | |
… | |
| 2638 | $rmp->{origin_y} = $exit->y; |
2638 | $rmp->{origin_y} = $exit->y; |
| 2639 | } |
2639 | } |
| 2640 | |
2640 | |
| 2641 | $rmp->{random_seed} ||= $exit->random_seed; |
2641 | $rmp->{random_seed} ||= $exit->random_seed; |
| 2642 | |
2642 | |
| 2643 | my $data = cf::to_json $rmp; |
2643 | my $data = cf::encode_json $rmp; |
| 2644 | my $md5 = Digest::MD5::md5_hex $data; |
2644 | my $md5 = Digest::MD5::md5_hex $data; |
| 2645 | my $meta = "$RANDOMDIR/$md5.meta"; |
2645 | my $meta = "$RANDOMDIR/$md5.meta"; |
| 2646 | |
2646 | |
| 2647 | if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { |
2647 | if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { |
| 2648 | aio_write $fh, 0, (length $data), $data, 0; |
2648 | aio_write $fh, 0, (length $data), $data, 0; |
