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.382 by root, Thu Oct 11 00:34:31 2007 UTC vs.
Revision 1.388 by root, Thu Oct 18 02:56:13 2007 UTC

… …
4use strict; 4use strict;
5 5
6use Symbol; 6use Symbol;
7use List::Util; 7use List::Util;
8use Socket; 8use Socket;
9use Storable;
10use Event; 9use Event;
11use Opcode; 10use Opcode;
12use Safe; 11use Safe;
13use Safe::Hole; 12use Safe::Hole;
13use Storable ();
14 14
15use Coro 4.1 (); 15use Coro 4.1 ();
16use Coro::State; 16use Coro::State;
17use Coro::Handle; 17use Coro::Handle;
18use Coro::Event; 18use Coro::Event;
… …
427 my $time = Event::time; 427 my $time = Event::time;
428 428
429 # this is the main coro, too bad, we have to block 429 # this is the main coro, too bad, we have to block
430 # till the operation succeeds, freezing the server :/ 430 # till the operation succeeds, freezing the server :/
431 431
432 LOG llevError | logBacktrace, Carp::longmess "sync job";#d# 432 LOG llevError, Carp::longmess "sync job";#d#
433 433
434 # TODO: use suspend/resume instead 434 # TODO: use suspend/resume instead
435 # (but this is cancel-safe) 435 # (but this is cancel-safe)
436 my $freeze_guard = freeze_mainloop; 436 my $freeze_guard = freeze_mainloop;
437 437
… …
444 warn $@ if $@; 444 warn $@ if $@;
445 undef $busy; 445 undef $busy;
446 })->prio (Coro::PRIO_MAX); 446 })->prio (Coro::PRIO_MAX);
447 447
448 while ($busy) { 448 while ($busy) {
449 if (Coro::nready) {
450 Coro::cede_notself;
451 } else {
449 Coro::cede or Event::one_event; 452 Event::one_event;
453 }
450 } 454 }
451 455
452 $time = Event::time - $time; 456 $time = Event::time - $time;
453 457
454 LOG llevError | logBacktrace, Carp::longmess "long sync job" 458 LOG llevError | logBacktrace, Carp::longmess "long sync job"
… …
966 970
967=cut 971=cut
968 972
969############################################################################# 973#############################################################################
970# object support 974# object support
971#
972 975
976sub _object_equal($$);
977sub _object_equal($$) {
978 my ($a, $b) = @_;
979
980 return 0 unless (ref $a) eq (ref $b);
981
982 if ("HASH" eq ref $a) {
983 my @ka = keys %$a;
984 my @kb = keys %$b;
985
986 return 0 if @ka != @kb;
987
988 for (0 .. $#ka) {
989 return 0 unless $ka[$_] eq $kb[$_];
990 return 0 unless _object_equal $a->{$ka[$_]}, $b->{$kb[$_]};
991 }
992
993 } elsif ("ARRAY" eq ref $a) {
994
995 return 0 if @$a != @$b;
996
997 for (0 .. $#$a) {
998 return 0 unless _object_equal $a->[$_], $b->[$_];
999 }
1000
1001 } elsif ($a ne $b) {
1002 return 0;
1003 }
1004
1005 1
1006}
1007
1008our $SLOW_MERGES;#d#
973sub _can_merge { 1009sub _can_merge {
974 my ($ob1, $ob2) = @_; 1010 my ($ob1, $ob2) = @_;
975 1011
976 local $Storable::canonical = 1; 1012 ++$SLOW_MERGES;#d#
977 my $fob1 = Storable::freeze $ob1;
978 my $fob2 = Storable::freeze $ob2;
979 1013
980 $fob1 eq $fob2 1014 # we do the slow way here
1015 return _object_equal $ob1, $ob2
981} 1016}
982 1017
983sub reattach { 1018sub reattach {
984 # basically do the same as instantiate, without calling instantiate 1019 # basically do the same as instantiate, without calling instantiate
985 my ($obj) = @_; 1020 my ($obj) = @_;
… …
1087 1122
1088 unless (aio_stat "$filename.pst") { 1123 unless (aio_stat "$filename.pst") {
1089 (aio_load "$filename.pst", $av) >= 0 1124 (aio_load "$filename.pst", $av) >= 0
1090 or return; 1125 or return;
1091 1126
1092 my $st = eval { Coro::Storable::thaw $av } 1127 my $st = eval { Coro::Storable::thaw $av };
1093 || eval { my $guard = Coro::Storable::guard; Storable::thaw $av }; #d# compatibility, remove
1094 $av = $st->{objs}; 1128 $av = $st->{objs};
1095 } 1129 }
1096 1130
1097 utf8::decode (my $decname = $filename); 1131 utf8::decode (my $decname = $filename);
1098 warn sprintf "loading %s (%d,%d)\n", 1132 warn sprintf "loading %s (%d,%d)\n",
… …
2896=pod 2930=pod
2897 2931
2898The following functions and methods are available within a safe environment: 2932The following functions and methods are available within a safe environment:
2899 2933
2900 cf::object 2934 cf::object
2901 contr pay_amount pay_player map x y force_find force_add 2935 contr pay_amount pay_player map x y force_find force_add destroy
2902 insert remove name archname title slaying race decrease_ob_nr 2936 insert remove name archname title slaying race decrease_ob_nr
2903 2937
2904 cf::object::player 2938 cf::object::player
2905 player 2939 player
2906 2940
… …
2913=cut 2947=cut
2914 2948
2915for ( 2949for (
2916 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 2950 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
2917 insert remove inv name archname title slaying race 2951 insert remove inv name archname title slaying race
2918 decrease_ob_nr)], 2952 decrease_ob_nr destroy)],
2919 ["cf::object::player" => qw(player)], 2953 ["cf::object::player" => qw(player)],
2920 ["cf::player" => qw(peaceful)], 2954 ["cf::player" => qw(peaceful)],
2921 ["cf::map" => qw(trigger)], 2955 ["cf::map" => qw(trigger)],
2922) { 2956) {
2923 no strict 'refs'; 2957 no strict 'refs';
… …
3338 3372
3339 warn "flushing outstanding aio requests"; 3373 warn "flushing outstanding aio requests";
3340 for (;;) { 3374 for (;;) {
3341 BDB::flush; 3375 BDB::flush;
3342 IO::AIO::flush; 3376 IO::AIO::flush;
3343 Coro::cede; 3377 Coro::cede_notself;
3344 last unless IO::AIO::nreqs || BDB::nreqs; 3378 last unless IO::AIO::nreqs || BDB::nreqs;
3345 warn "iterate..."; 3379 warn "iterate...";
3346 } 3380 }
3347 3381
3348 ++$RELOAD; 3382 ++$RELOAD;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines