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.405 by root, Mon Dec 17 08:03:22 2007 UTC vs.
Revision 1.411 by root, Fri Feb 1 15:54:07 2008 UTC

… …
27use JSON::XS 2.01 (); 27use JSON::XS 2.01 ();
28use BDB (); 28use BDB ();
29use Data::Dumper; 29use Data::Dumper;
30use Digest::MD5; 30use Digest::MD5;
31use Fcntl; 31use Fcntl;
32use YAML::Syck (); 32use YAML ();
33use IO::AIO 2.51 (); 33use IO::AIO 2.51 ();
34use Time::HiRes; 34use Time::HiRes;
35use Compress::LZF; 35use Compress::LZF;
36use Digest::MD5 (); 36use Digest::MD5 ();
37 37
38# configure various modules to our taste 38# configure various modules to our taste
39# 39#
40$Storable::canonical = 1; # reduce rsync transfers 40$Storable::canonical = 1; # reduce rsync transfers
41Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 41Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
42Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 42Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
43
44# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
45$YAML::Syck::ImplicitUnicode = 1;
46 43
47$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 44$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
48 45
49sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 46sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
50 47
… …
193 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 190 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
194 191
195 LOG llevError, $msg; 192 LOG llevError, $msg;
196 }; 193 };
197} 194}
195
196$Coro::State::DIEHOOK = sub {
197 return unless $^S eq 0; # "eq", not "=="
198
199 if ($Coro::current == $Coro::main) {#d#
200 warn "DIEHOOK called in main context, Coro bug?\n";#d#
201 return;#d#
202 }#d#
203
204 # kill coroutine otherwise
205 warn Carp::longmess $_[0];
206 Coro::terminate
207};
208
209$SIG{__DIE__} = sub { }; #d#?
198 210
199@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 211@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
200@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 212@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
201@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 213@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
202@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 214@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
969 } 981 }
970 982
971 0 983 0
972} 984}
973 985
974=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) 986=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
975 987
976=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) 988=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
977 989
978Generate an object-specific event with the given arguments. 990Generate an object-specific event with the given arguments.
979 991
… …
1304 my $msg = $@ ? "$v->{path}: $@\n" 1316 my $msg = $@ ? "$v->{path}: $@\n"
1305 : "$v->{base}: extension inactive.\n"; 1317 : "$v->{base}: extension inactive.\n";
1306 1318
1307 if (exists $v->{meta}{mandatory}) { 1319 if (exists $v->{meta}{mandatory}) {
1308 warn $msg; 1320 warn $msg;
1309 warn "mandatory extension failed to load, exiting.\n"; 1321 cf::cleanup "mandatory extension failed to load, exiting.";
1310 exit 1;
1311 } 1322 }
1312 1323
1313 warn $msg; 1324 warn $msg;
1314 } 1325 }
1315 1326
… …
3218 $RESOURCE{$name} = $info; 3229 $RESOURCE{$name} = $info;
3219 } 3230 }
3220 3231
3221 cf::cede_to_tick; 3232 cf::cede_to_tick;
3222 } 3233 }
3223
3224 if (my $soundconf = delete $res->{"res/sound.conf"}) {
3225 $soundconf = $enc->decode (delete $soundconf->{data});
3226
3227 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3228 my $sound = $soundconf->{compat}[$_]
3229 or next;
3230
3231 my $face = cf::face::find "sound/$sound->[1]";
3232 cf::sound::set $sound->[0] => $face;
3233 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3234 }
3235
3236 while (my ($k, $v) = each %{$soundconf->{event}}) {
3237 my $face = cf::face::find "sound/$v";
3238 cf::sound::set $k => $face;
3239 }
3240 }
3241 } 3234 }
3235
3236 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3242 3237
3243 1 3238 1
3244} 3239}
3240
3241cf::global->attach (on_resource_update => sub {
3242 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3243 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3244
3245 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3246 my $sound = $soundconf->{compat}[$_]
3247 or next;
3248
3249 my $face = cf::face::find "sound/$sound->[1]";
3250 cf::sound::set $sound->[0] => $face;
3251 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3252 }
3253
3254 while (my ($k, $v) = each %{$soundconf->{event}}) {
3255 my $face = cf::face::find "sound/$v";
3256 cf::sound::set $k => $face;
3257 }
3258 }
3259});
3245 3260
3246register_exticmd fx_want => sub { 3261register_exticmd fx_want => sub {
3247 my ($ns, $want) = @_; 3262 my ($ns, $want) = @_;
3248 3263
3249 while (my ($k, $v) = each %$want) { 3264 while (my ($k, $v) = each %$want) {
… …
3304sub reload_config { 3319sub reload_config {
3305 open my $fh, "<:utf8", "$CONFDIR/config" 3320 open my $fh, "<:utf8", "$CONFDIR/config"
3306 or return; 3321 or return;
3307 3322
3308 local $/; 3323 local $/;
3309 *CFG = YAML::Syck::Load <$fh>; 3324 *CFG = YAML::Load <$fh>;
3310 3325
3311 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3326 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3312 3327
3313 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3328 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3314 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3329 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3542 warn "leaving sync_job"; 3557 warn "leaving sync_job";
3543 3558
3544 1 3559 1
3545 } or do { 3560 } or do {
3546 warn $@; 3561 warn $@;
3547 warn "error while reloading, exiting."; 3562 cf::cleanup "error while reloading, exiting.";
3548 exit 1;
3549 }; 3563 };
3550 3564
3551 warn "reloaded"; 3565 warn "reloaded";
3552}; 3566};
3553 3567
… …
3556sub reload_perl() { 3570sub reload_perl() {
3557 # doing reload synchronously and two reloads happen back-to-back, 3571 # doing reload synchronously and two reloads happen back-to-back,
3558 # coro crashes during coro_state_free->destroy here. 3572 # coro crashes during coro_state_free->destroy here.
3559 3573
3560 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3574 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3575 do_reload_perl;
3561 undef $RELOAD_WATCHER; 3576 undef $RELOAD_WATCHER;
3562 do_reload_perl;
3563 }; 3577 };
3564} 3578}
3565 3579
3566register_command "reload" => sub { 3580register_command "reload" => sub {
3567 my ($who, $arg) = @_; 3581 my ($who, $arg) = @_;

Diff Legend

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