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.374 by root, Wed Sep 19 22:07:16 2007 UTC vs.
Revision 1.385 by root, Fri Oct 12 19:13:26 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 3.64 (); 15use Coro 4.1 ();
16use Coro::State; 16use Coro::State;
17use Coro::Handle; 17use Coro::Handle;
18use Coro::Event; 18use Coro::Event;
19use Coro::Timer; 19use Coro::Timer;
20use Coro::Signal; 20use Coro::Signal;
27use BDB (); 27use BDB ();
28use Data::Dumper; 28use Data::Dumper;
29use Digest::MD5; 29use Digest::MD5;
30use Fcntl; 30use Fcntl;
31use YAML::Syck (); 31use YAML::Syck ();
32use IO::AIO 2.32 (); 32use IO::AIO 2.51 ();
33use Time::HiRes; 33use Time::HiRes;
34use Compress::LZF; 34use Compress::LZF;
35use Digest::MD5 (); 35use Digest::MD5 ();
36 36
37# configure various modules to our taste 37# configure various modules to our taste
373 } 373 }
374 } 374 }
375 } 375 }
376 376
377 if (@SLOT_QUEUE) { 377 if (@SLOT_QUEUE) {
378 # we do not use wait_For_tick() as it returns immediately when tick is inactive 378 # we do not use wait_for_tick() as it returns immediately when tick is inactive
379 push @cf::WAIT_FOR_TICK, $signal; 379 push @cf::WAIT_FOR_TICK, $signal;
380 $signal->wait; 380 $signal->wait;
381 } else { 381 } else {
382 Coro::schedule; 382 Coro::schedule;
383 } 383 }
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, Carp::longmess "sync job";#d#
433
432 # TODO: use suspend/resume instead 434 # TODO: use suspend/resume instead
433 # (but this is cancel-safe) 435 # (but this is cancel-safe)
434 my $freeze_guard = freeze_mainloop; 436 my $freeze_guard = freeze_mainloop;
435 437
436 my $busy = 1; 438 my $busy = 1;
969# 971#
970 972
971sub _can_merge { 973sub _can_merge {
972 my ($ob1, $ob2) = @_; 974 my ($ob1, $ob2) = @_;
973 975
976 return 1;#d#
977
978 #todo#d# kill yourself and do some recursive checking manually without storable
979 sync_job {
980 my $guard = Coro::Storable::guard;
974 local $Storable::canonical = 1; 981 local $Storable::canonical = 1;
975 my $fob1 = Storable::freeze $ob1; 982 my $fob1 = Storable::freeze $ob1;
976 my $fob2 = Storable::freeze $ob2; 983 my $fob2 = Storable::freeze $ob2;
977
978 $fob1 eq $fob2 984 $fob1 eq $fob2
985 }
979} 986}
980 987
981sub reattach { 988sub reattach {
982 # basically do the same as instantiate, without calling instantiate 989 # basically do the same as instantiate, without calling instantiate
983 my ($obj) = @_; 990 my ($obj) = @_;
1044 close $fh; 1051 close $fh;
1045 1052
1046 if (@$objs) { 1053 if (@$objs) {
1047 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) { 1054 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
1048 chmod SAVE_MODE, $fh; 1055 chmod SAVE_MODE, $fh;
1049 my $data = Storable::nfreeze { version => 1, objs => $objs }; 1056 my $data = Coro::Storable::blocking_nfreeze { version => 1, objs => $objs };
1050 aio_write $fh, 0, (length $data), $data, 0; 1057 aio_write $fh, 0, (length $data), $data, 0;
1051 aio_fsync $fh if $cf::USE_FSYNC; 1058 aio_fsync $fh if $cf::USE_FSYNC;
1052 close $fh; 1059 close $fh;
1053 aio_rename "$filename.pst~", "$filename.pst"; 1060 aio_rename "$filename.pst~", "$filename.pst";
1054 } 1061 }
1085 1092
1086 unless (aio_stat "$filename.pst") { 1093 unless (aio_stat "$filename.pst") {
1087 (aio_load "$filename.pst", $av) >= 0 1094 (aio_load "$filename.pst", $av) >= 0
1088 or return; 1095 or return;
1089 1096
1090 $av = eval { (Storable::thaw $av)->{objs} }; 1097 my $st = eval { Coro::Storable::thaw $av }
1098 || eval { my $guard = Coro::Storable::guard; Storable::thaw $av }; #d# compatibility, remove
1099 $av = $st->{objs};
1091 } 1100 }
1092 1101
1093 utf8::decode (my $decname = $filename); 1102 utf8::decode (my $decname = $filename);
1094 warn sprintf "loading %s (%d,%d)\n", 1103 warn sprintf "loading %s (%d,%d)\n",
1095 $decname, length $data, scalar @{$av || []}; 1104 $decname, length $data, scalar @{$av || []};
2273=cut 2282=cut
2274 2283
2275sub deref { 2284sub deref {
2276 my ($ref) = @_; 2285 my ($ref) = @_;
2277 2286
2278 # temporary compatibility#TODO#remove
2279 $ref =~ s{^<}{player/<};
2280
2281 if ($ref =~ m{^player\/(<1\.\d+>)/(.*)$}) { 2287 if ($ref =~ m{^player\/(<1\.[0-9a-f]+>)/(.*)$}) {
2282 my ($uuid, $name) = ($1, $2); 2288 my ($uuid, $name) = ($1, $2);
2283 my $pl = $cf::PLAYER_LOADING{$name} || cf::player::find $name 2289 my $pl = $cf::PLAYER_LOADING{$name} || cf::player::find $name
2284 or return; 2290 or return;
2285 $pl->ob->uuid eq $uuid 2291 $pl->ob->uuid eq $uuid
2286 or return; 2292 or return;
2633 2639
2634=cut 2640=cut
2635 2641
2636our %CHANNEL = ( 2642our %CHANNEL = (
2637 "c/identify" => { 2643 "c/identify" => {
2638 id => "identify", 2644 id => "infobox",
2639 title => "Identify", 2645 title => "Identify",
2640 reply => undef, 2646 reply => undef,
2641 tooltip => "Items recently identified", 2647 tooltip => "Items recently identified",
2642 }, 2648 },
2643 "c/examine" => { 2649 "c/examine" => {
2644 id => "examine", 2650 id => "infobox",
2645 title => "Examine", 2651 title => "Examine",
2646 reply => undef, 2652 reply => undef,
2647 tooltip => "Signs and other items you examined", 2653 tooltip => "Signs and other items you examined",
2648 }, 2654 },
2655 "c/lookat" => {
2656 id => "infobox",
2657 title => "Look",
2658 reply => undef,
2659 tooltip => "What you saw there",
2660 },
2649); 2661);
2650 2662
2651sub cf::client::send_msg { 2663sub cf::client::send_msg {
2652 my ($self, $channel, $msg, $color, @extra) = @_; 2664 my ($self, $channel, $msg, $color, @extra) = @_;
2653 2665
2654 $msg = $self->pl->expand_cfpod ($msg); 2666 $msg = $self->pl->expand_cfpod ($msg);
2655 2667
2656 $color &= cf::NDI_CLIENT_MASK; # just in case... 2668 $color &= cf::NDI_CLIENT_MASK; # just in case...
2657 2669
2658 # check predefined channels, for the benefit of C 2670 # check predefined channels, for the benefit of C
2659 $channel = $CHANNEL{$channel} if $CHANNEL{$channel}; 2671 if ($CHANNEL{$channel}) {
2672 $channel = $CHANNEL{$channel};
2660 2673
2674 $self->ext_msg (channel_info => $channel)
2675 if $self->can_msg;
2676
2677 $channel = $channel->{id};
2678
2661 if (ref $channel) { 2679 } elsif (ref $channel) {
2662 # send meta info to client, if not yet sent 2680 # send meta info to client, if not yet sent
2663 unless (exists $self->{channel}{$channel->{id}}) { 2681 unless (exists $self->{channel}{$channel->{id}}) {
2664 $self->{channel}{$channel->{id}} = $channel; 2682 $self->{channel}{$channel->{id}} = $channel;
2665 $self->ext_msg (channel_info => $channel) 2683 $self->ext_msg (channel_info => $channel)
2666 if $self->can_msg; 2684 if $self->can_msg;
2883=pod 2901=pod
2884 2902
2885The following functions and methods are available within a safe environment: 2903The following functions and methods are available within a safe environment:
2886 2904
2887 cf::object 2905 cf::object
2888 contr pay_amount pay_player map x y force_find force_add 2906 contr pay_amount pay_player map x y force_find force_add destroy
2889 insert remove name archname title slaying race decrease_ob_nr 2907 insert remove name archname title slaying race decrease_ob_nr
2890 2908
2891 cf::object::player 2909 cf::object::player
2892 player 2910 player
2893 2911
2900=cut 2918=cut
2901 2919
2902for ( 2920for (
2903 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 2921 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
2904 insert remove inv name archname title slaying race 2922 insert remove inv name archname title slaying race
2905 decrease_ob_nr)], 2923 decrease_ob_nr destroy)],
2906 ["cf::object::player" => qw(player)], 2924 ["cf::object::player" => qw(player)],
2907 ["cf::player" => qw(peaceful)], 2925 ["cf::player" => qw(peaceful)],
2908 ["cf::map" => qw(trigger)], 2926 ["cf::map" => qw(trigger)],
2909) { 2927) {
2910 no strict 'refs'; 2928 no strict 'refs';
3267 # and maps saved/destroyed asynchronously. 3285 # and maps saved/destroyed asynchronously.
3268 warn "begin emergency player save\n"; 3286 warn "begin emergency player save\n";
3269 for my $login (keys %cf::PLAYER) { 3287 for my $login (keys %cf::PLAYER) {
3270 my $pl = $cf::PLAYER{$login} or next; 3288 my $pl = $cf::PLAYER{$login} or next;
3271 $pl->valid or next; 3289 $pl->valid or next;
3290 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt
3272 $pl->save; 3291 $pl->save;
3273 } 3292 }
3274 warn "end emergency player save\n"; 3293 warn "end emergency player save\n";
3275 3294
3276 warn "begin emergency map save\n"; 3295 warn "begin emergency map save\n";
3614 $AIO_POLL_WATCHER = Event->io ( 3633 $AIO_POLL_WATCHER = Event->io (
3615 reentrant => 0, 3634 reentrant => 0,
3616 data => WF_AUTOCANCEL, 3635 data => WF_AUTOCANCEL,
3617 fd => IO::AIO::poll_fileno, 3636 fd => IO::AIO::poll_fileno,
3618 poll => 'r', 3637 poll => 'r',
3619 prio => 6, 3638 prio => 0,
3620 cb => \&IO::AIO::poll_cb, 3639 cb => \&IO::AIO::poll_cb,
3621 ); 3640 );
3622} 3641}
3623 3642
3624my $_log_backtrace; 3643my $_log_backtrace;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines