… | |
… | |
326 | # load/save perl data associated with player->ob objects |
326 | # load/save perl data associated with player->ob objects |
327 | |
327 | |
328 | *on_player_load = sub { |
328 | *on_player_load = sub { |
329 | my ($ob, $path) = @_; |
329 | my ($ob, $path) = @_; |
330 | |
330 | |
331 | if (open my $fh, "<:raw", "$path.cfperl") { |
|
|
332 | |
|
|
333 | #d##TODO#remove |
|
|
334 | |
|
|
335 | my $data = Storable::thaw do { local $/; <$fh> }; |
|
|
336 | |
|
|
337 | $data->{version} <= 1 |
|
|
338 | or return; # too new |
|
|
339 | |
|
|
340 | %$ob = %{$data->{ob}}; |
|
|
341 | return; |
|
|
342 | } |
|
|
343 | |
|
|
344 | for my $o ($ob, $ob->inv) { |
331 | for my $o ($ob, $ob->inv) { |
345 | if (my $value = $o->get_ob_key_value ("_perl_data")) { |
332 | if (my $value = $o->get_ob_key_value ("_perl_data")) { |
346 | $o->set_ob_key_value ("_perl_data"); |
333 | $o->set_ob_key_value ("_perl_data"); |
347 | |
334 | |
348 | %$o = %{ Storable::thaw pack "H*", $value }; |
335 | %$o = %{ Storable::thaw pack "H*", $value }; |
… | |
… | |
353 | *on_player_save = sub { |
340 | *on_player_save = sub { |
354 | my ($ob, $path) = @_; |
341 | my ($ob, $path) = @_; |
355 | |
342 | |
356 | $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_) |
343 | $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_) |
357 | for grep %$_, $ob, $ob->inv; |
344 | for grep %$_, $ob, $ob->inv; |
358 | |
|
|
359 | unlink "$path.cfperl";#d##TODO#remove |
|
|
360 | }; |
345 | }; |
361 | |
346 | |
362 | ############################################################################# |
347 | ############################################################################# |
363 | # core extensions - in perl |
348 | # core extensions - in perl |
364 | |
349 | |