… | |
… | |
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; |