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.55 by root, Tue Aug 29 17:32:19 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 chmod SAVE_MODE, "$filename.pst~";
488 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 }
489 } else { 505 } else {
506 unlink $filename;
490 unlink "$filename.pst"; 507 unlink "$filename.pst";
491 } 508 }
492
493 chmod SAVE_MODE, "$filename~";
494 rename "$filename~", $filename;
495} 509}
496 510
497sub object_thawer_load { 511sub object_thawer_load {
498 my ($filename) = @_; 512 my ($filename) = @_;
499 513
514 local $/;
515
516 my $av;
517
518 #TODO: use sysread etc.
519 if (open my $data, "<:raw:perlio", $filename) {
520 $data = <$data>;
500 open my $fh, "<:raw:perlio", "$filename.pst" 521 if (open my $pst, "<:raw:perlio", "$filename.pst") {
501 or return; 522 $av = eval { (Storable::thaw <$pst>)->{objs} };
523 }
524 return ($data, $av);
525 }
502 526
503 eval { local $/; (Storable::thaw <$fh>)->{objs} } 527 ()
504} 528}
505 529
506attach_to_objects 530attach_to_objects
507 prio => -1000000, 531 prio => -1000000,
508 on_clone => sub { 532 on_clone => sub {
704 #Symbol::delete_package __PACKAGE__; 728 #Symbol::delete_package __PACKAGE__;
705 729
706 # 7. reload cf.pm 730 # 7. reload cf.pm
707 $msg->("reloading cf.pm"); 731 $msg->("reloading cf.pm");
708 require cf; 732 require cf;
733
734 $msg->("load extensions");
735 cf::load_extensions;
709 }; 736 };
710 $msg->($@) if $@; 737 $msg->($@) if $@;
711 738
712 $msg->("reloaded"); 739 $msg->("reloaded");
713}; 740};
764 defined $path or return; 791 defined $path or return;
765 792
766 unlink "$path.pst"; 793 unlink "$path.pst";
767}; 794};
768 795
769# old style persistent data, TODO: remove #d#
770*cf::mapsupport::on_swapin =
771*cf::mapsupport::on_load = 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