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.56 by root, Wed Aug 30 08:28:33 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 = sub {
771 my ($map) = @_;
772
773 my $path = $map->tmpname;
774 $path = $map->path unless defined $path;
775
776 warn "$path.cfperl\n";#d#
777
778 open my $fh, "<:raw", "$path.cfperl"
779 or return; # no perl data
780
781 my $data = Storable::thaw do { local $/; <$fh> };
782
783 $data->{version} <= 1
784 or return; # too new
785
786 $map->_set_obs ($data->{obs});
787 $map->invoke (EVENT_MAP_UPGRADE);
788};
789
790attach_to_maps prio => -10000, package => cf::mapsupport::; 796attach_to_maps prio => -10000, package => cf::mapsupport::;
791 797
792############################################################################# 798#############################################################################
793# load/save perl data associated with player->ob objects 799# load/save perl data associated with player->ob objects
794 800
795sub all_objects(@) { 801sub all_objects(@) {
796 @_, map all_objects ($_->inv), @_ 802 @_, map all_objects ($_->inv), @_
797} 803}
798 804
805# TODO: compatibility cruft, remove when no longer needed
799attach_to_players 806attach_to_players
800 on_load => sub { 807 on_load => sub {
801 my ($pl, $path) = @_; 808 my ($pl, $path) = @_;
802 809
803 for my $o (all_objects $pl->ob) { 810 for my $o (all_objects $pl->ob) {
924 931
925############################################################################# 932#############################################################################
926# the server's main() 933# the server's main()
927 934
928sub main { 935sub main {
936 load_extensions;
929 Event::loop; 937 Event::loop;
930} 938}
931 939
932############################################################################# 940#############################################################################
933# initialisation 941# initialisation
934 942
935register "<global>", __PACKAGE__; 943register "<global>", __PACKAGE__;
936 944
937unshift @INC, $LIBDIR; 945unshift @INC, $LIBDIR;
938
939load_extensions;
940 946
941$TICK_WATCHER = Event->timer ( 947$TICK_WATCHER = Event->timer (
942 prio => 1, 948 prio => 1,
943 at => $NEXT_TICK || 1, 949 at => $NEXT_TICK || 1,
944 cb => sub { 950 cb => sub {

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines