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.404 by root, Mon Dec 17 07:27:58 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
… …
69our $TMPDIR = "$LOCALDIR/" . tmpdir; 66our $TMPDIR = "$LOCALDIR/" . tmpdir;
70our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 67our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
71our $PLAYERDIR = "$LOCALDIR/" . playerdir; 68our $PLAYERDIR = "$LOCALDIR/" . playerdir;
72our $RANDOMDIR = "$LOCALDIR/random"; 69our $RANDOMDIR = "$LOCALDIR/random";
73our $BDBDIR = "$LOCALDIR/db"; 70our $BDBDIR = "$LOCALDIR/db";
71our %RESOURCE;
74 72
75our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 73our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
76our $TICK_WATCHER; 74our $TICK_WATCHER;
77our $AIO_POLL_WATCHER; 75our $AIO_POLL_WATCHER;
78our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 76our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
… …
192 $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;
193 191
194 LOG llevError, $msg; 192 LOG llevError, $msg;
195 }; 193 };
196} 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#?
197 210
198@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 211@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
199@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 212@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
200@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 213@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
201@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 214@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
968 } 981 }
969 982
970 0 983 0
971} 984}
972 985
973=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) 986=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
974 987
975=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) 988=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
976 989
977Generate an object-specific event with the given arguments. 990Generate an object-specific event with the given arguments.
978 991
… …
1303 my $msg = $@ ? "$v->{path}: $@\n" 1316 my $msg = $@ ? "$v->{path}: $@\n"
1304 : "$v->{base}: extension inactive.\n"; 1317 : "$v->{base}: extension inactive.\n";
1305 1318
1306 if (exists $v->{meta}{mandatory}) { 1319 if (exists $v->{meta}{mandatory}) {
1307 warn $msg; 1320 warn $msg;
1308 warn "mandatory extension failed to load, exiting.\n"; 1321 cf::cleanup "mandatory extension failed to load, exiting.";
1309 exit 1;
1310 } 1322 }
1311 1323
1312 warn $msg; 1324 warn $msg;
1313 } 1325 }
1314 1326
… …
3149 { 3161 {
3150 my $faces = $facedata->{faceinfo}; 3162 my $faces = $facedata->{faceinfo};
3151 3163
3152 while (my ($face, $info) = each %$faces) { 3164 while (my ($face, $info) = each %$faces) {
3153 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3165 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3166
3154 cf::face::set_visibility $idx, $info->{visibility}; 3167 cf::face::set_visibility $idx, $info->{visibility};
3155 cf::face::set_magicmap $idx, $info->{magicmap}; 3168 cf::face::set_magicmap $idx, $info->{magicmap};
3156 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3169 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
3157 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3170 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
3158 3171
3159 cf::cede_to_tick; 3172 cf::cede_to_tick;
3160 } 3173 }
3161 3174
3162 while (my ($face, $info) = each %$faces) { 3175 while (my ($face, $info) = each %$faces) {
3163 next unless $info->{smooth}; 3176 next unless $info->{smooth};
3177
3164 my $idx = cf::face::find $face 3178 my $idx = cf::face::find $face
3165 or next; 3179 or next;
3180
3166 if (my $smooth = cf::face::find $info->{smooth}) { 3181 if (my $smooth = cf::face::find $info->{smooth}) {
3167 cf::face::set_smooth $idx, $smooth; 3182 cf::face::set_smooth $idx, $smooth;
3168 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3183 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3169 } else { 3184 } else {
3170 warn "smooth face '$info->{smooth}' not found for face '$face'"; 3185 warn "smooth face '$info->{smooth}' not found for face '$face'";
… …
3188 { 3203 {
3189 # TODO: for gcfclient pleasure, we should give resources 3204 # TODO: for gcfclient pleasure, we should give resources
3190 # that gcfclient doesn't grok a >10000 face index. 3205 # that gcfclient doesn't grok a >10000 face index.
3191 my $res = $facedata->{resource}; 3206 my $res = $facedata->{resource};
3192 3207
3193 my $soundconf = delete $res->{"res/sound.conf"};
3194
3195 while (my ($name, $info) = each %$res) { 3208 while (my ($name, $info) = each %$res) {
3209 if (defined $info->{type}) {
3196 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3210 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3197 my $data; 3211 my $data;
3198 3212
3199 if ($info->{type} & 1) { 3213 if ($info->{type} & 1) {
3200 # prepend meta info 3214 # prepend meta info
3201 3215
3202 my $meta = $enc->encode ({ 3216 my $meta = $enc->encode ({
3203 name => $name, 3217 name => $name,
3204 %{ $info->{meta} || {} }, 3218 %{ $info->{meta} || {} },
3205 }); 3219 });
3206 3220
3207 $data = pack "(w/a*)*", $meta, $info->{data}; 3221 $data = pack "(w/a*)*", $meta, $info->{data};
3222 } else {
3223 $data = $info->{data};
3224 }
3225
3226 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3227 cf::face::set_type $idx, $info->{type};
3208 } else { 3228 } else {
3209 $data = $info->{data}; 3229 $RESOURCE{$name} = $info;
3210 } 3230 }
3211 3231
3212 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3213 cf::face::set_type $idx, $info->{type};
3214
3215 cf::cede_to_tick; 3232 cf::cede_to_tick;
3216 } 3233 }
3217
3218 if ($soundconf) {
3219 $soundconf = $enc->decode (delete $soundconf->{data});
3220
3221 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3222 my $sound = $soundconf->{compat}[$_]
3223 or next;
3224
3225 my $face = cf::face::find "sound/$sound->[1]";
3226 cf::sound::set $sound->[0] => $face;
3227 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3228 }
3229
3230 while (my ($k, $v) = each %{$soundconf->{event}}) {
3231 my $face = cf::face::find "sound/$v";
3232 cf::sound::set $k => $face;
3233 }
3234 }
3235 } 3234 }
3235
3236 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3236 3237
3237 1 3238 1
3238} 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});
3239 3260
3240register_exticmd fx_want => sub { 3261register_exticmd fx_want => sub {
3241 my ($ns, $want) = @_; 3262 my ($ns, $want) = @_;
3242 3263
3243 while (my ($k, $v) = each %$want) { 3264 while (my ($k, $v) = each %$want) {
… …
3298sub reload_config { 3319sub reload_config {
3299 open my $fh, "<:utf8", "$CONFDIR/config" 3320 open my $fh, "<:utf8", "$CONFDIR/config"
3300 or return; 3321 or return;
3301 3322
3302 local $/; 3323 local $/;
3303 *CFG = YAML::Syck::Load <$fh>; 3324 *CFG = YAML::Load <$fh>;
3304 3325
3305 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3326 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3306 3327
3307 $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};
3308 $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};
… …
3536 warn "leaving sync_job"; 3557 warn "leaving sync_job";
3537 3558
3538 1 3559 1
3539 } or do { 3560 } or do {
3540 warn $@; 3561 warn $@;
3541 warn "error while reloading, exiting."; 3562 cf::cleanup "error while reloading, exiting.";
3542 exit 1;
3543 }; 3563 };
3544 3564
3545 warn "reloaded"; 3565 warn "reloaded";
3546}; 3566};
3547 3567
… …
3550sub reload_perl() { 3570sub reload_perl() {
3551 # doing reload synchronously and two reloads happen back-to-back, 3571 # doing reload synchronously and two reloads happen back-to-back,
3552 # coro crashes during coro_state_free->destroy here. 3572 # coro crashes during coro_state_free->destroy here.
3553 3573
3554 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3574 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3575 do_reload_perl;
3555 undef $RELOAD_WATCHER; 3576 undef $RELOAD_WATCHER;
3556 do_reload_perl;
3557 }; 3577 };
3558} 3578}
3559 3579
3560register_command "reload" => sub { 3580register_command "reload" => sub {
3561 my ($who, $arg) = @_; 3581 my ($who, $arg) = @_;

Diff Legend

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