ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.57 by root, Wed Aug 30 11:21:24 2006 UTC vs.
Revision 1.61 by root, Sun Sep 3 22:45:56 2006 UTC

476 } 476 }
477 } 477 }
478} 478}
479 479
480sub object_freezer_save { 480sub object_freezer_save {
481 my ($filename, $objs) = @_; 481 my ($filename, $rdata, $objs) = @_;
482 482
483 if (@$objs) { 483 if (length $$rdata) {
484 warn sprintf "saving %s (%d,%d)\n",
485 $filename, length $$rdata, scalar @$objs;
486
484 open my $fh, ">:raw", "$filename.pst~"; 487 if (open my $fh, ">:raw", "$filename~") {
488 chmod SAVE_MODE, $fh;
489 syswrite $fh, $$rdata;
490 close $fh;
491
492 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
493 chmod SAVE_MODE, $fh;
485 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; 494 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };
486 close $fh; 495 close $fh;
487 unlink "$filename.cfperl";
488 chmod SAVE_MODE, "$filename.pst~";
489 rename "$filename.pst~", "$filename.pst"; 496 rename "$filename.pst~", "$filename.pst";
497 } else {
498 unlink "$filename.pst";
499 }
500
501 rename "$filename~", $filename;
502 } else {
503 warn "FATAL: $filename~: $!\n";
504 }
490 } else { 505 } else {
506 unlink $filename;
491 unlink "$filename.pst"; 507 unlink "$filename.pst";
492 } 508 }
493
494 chmod SAVE_MODE, "$filename~";
495 rename "$filename~", $filename;
496} 509}
497 510
498sub object_thawer_load { 511sub object_thawer_load {
499 my ($filename) = @_; 512 my ($filename) = @_;
500 513
514 local $/;
515
516 my $av;
517
518 #TODO: use sysread etc.
519 if (open my $data, "<:raw:perlio", $filename) {
520 $data = <$data>;
501 open my $fh, "<:raw:perlio", "$filename.pst" 521 if (open my $pst, "<:raw:perlio", "$filename.pst") {
502 or return; 522 $av = eval { (Storable::thaw <$pst>)->{objs} };
523 }
524 return ($data, $av);
525 }
503 526
504 eval { local $/; (Storable::thaw <$fh>)->{objs} } 527 ()
505} 528}
506 529
507attach_to_objects 530attach_to_objects
508 prio => -1000000, 531 prio => -1000000,
509 on_clone => sub { 532 on_clone => sub {
705 #Symbol::delete_package __PACKAGE__; 728 #Symbol::delete_package __PACKAGE__;
706 729
707 # 7. reload cf.pm 730 # 7. reload cf.pm
708 $msg->("reloading cf.pm"); 731 $msg->("reloading cf.pm");
709 require cf; 732 require cf;
733
734 $msg->("load extensions");
735 cf::load_extensions;
710 }; 736 };
711 $msg->($@) if $@; 737 $msg->($@) if $@;
712 738
713 $msg->("reloaded"); 739 $msg->("reloaded");
714}; 740};
765 defined $path or return; 791 defined $path or return;
766 792
767 unlink "$path.pst"; 793 unlink "$path.pst";
768}; 794};
769 795
770# old style persistent data, TODO: remove #d#
771*cf::mapsupport::on_swapin = sub {
772 my ($map) = @_;
773
774 my $path = $map->tmpname;
775 $path = $map->path unless defined $path;
776
777 open my $fh, "<:raw", "$path.cfperl"
778 or return; # no perl data
779
780 my $data = Storable::thaw do { local $/; <$fh> };
781
782 $data->{version} <= 1
783 or return; # too new
784
785 $map->_set_obs ($data->{obs});
786 $map->invoke (EVENT_MAP_UPGRADE);
787};
788
789attach_to_maps prio => -10000, package => cf::mapsupport::; 796attach_to_maps prio => -10000, package => cf::mapsupport::;
790 797
791############################################################################# 798#############################################################################
792# load/save perl data associated with player->ob objects 799# load/save perl data associated with player->ob objects
793 800
794sub all_objects(@) { 801sub all_objects(@) {
795 @_, map all_objects ($_->inv), @_ 802 @_, map all_objects ($_->inv), @_
796} 803}
797 804
805# TODO: compatibility cruft, remove when no longer needed
798attach_to_players 806attach_to_players
799 on_load => sub { 807 on_load => sub {
800 my ($pl, $path) = @_; 808 my ($pl, $path) = @_;
801 809
802 for my $o (all_objects $pl->ob) { 810 for my $o (all_objects $pl->ob) {
923 931
924############################################################################# 932#############################################################################
925# the server's main() 933# the server's main()
926 934
927sub main { 935sub main {
936 load_extensions;
928 Event::loop; 937 Event::loop;
929} 938}
930 939
931############################################################################# 940#############################################################################
932# initialisation 941# initialisation
933 942
934register "<global>", __PACKAGE__; 943register "<global>", __PACKAGE__;
935 944
936unshift @INC, $LIBDIR; 945unshift @INC, $LIBDIR;
937
938load_extensions;
939 946
940$TICK_WATCHER = Event->timer ( 947$TICK_WATCHER = Event->timer (
941 prio => 1, 948 prio => 1,
942 at => $NEXT_TICK || 1, 949 at => $NEXT_TICK || 1,
943 cb => sub { 950 cb => sub {

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines