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