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.449 by root, Sat Sep 20 00:09:27 2008 UTC vs.
Revision 1.456 by root, Tue Sep 30 04:00:35 2008 UTC

81our %EXTCMD = (); 81our %EXTCMD = ();
82our %EXTICMD = (); 82our %EXTICMD = ();
83our %EXT_CORO = (); # coroutines bound to extensions 83our %EXT_CORO = (); # coroutines bound to extensions
84our %EXT_MAP = (); # pluggable maps 84our %EXT_MAP = (); # pluggable maps
85 85
86our $RELOAD; # number of reloads so far 86our $RELOAD; # number of reloads so far, non-zero while in reload
87our @EVENT; 87our @EVENT;
88 88
89our $CONFDIR = confdir; 89our $CONFDIR = confdir;
90our $DATADIR = datadir; 90our $DATADIR = datadir;
91our $LIBDIR = "$DATADIR/ext"; 91our $LIBDIR = "$DATADIR/ext";
128our $LOAD; # a number between 0 (idle) and 1 (too many objects) 128our $LOAD; # a number between 0 (idle) and 1 (too many objects)
129our $LOADAVG; # same thing, but with alpha-smoothing 129our $LOADAVG; # same thing, but with alpha-smoothing
130our $JITTER; # average jitter 130our $JITTER; # average jitter
131our $TICK_START; # for load detecting purposes 131our $TICK_START; # for load detecting purposes
132 132
133our @POST_INIT;
134
133binmode STDOUT; 135binmode STDOUT;
134binmode STDERR; 136binmode STDERR;
135 137
136# read virtual server time, if available 138# read virtual server time, if available
137unless ($RUNTIME || !-e $RUNTIMEFILE) { 139unless ($RUNTIME || !-e $RUNTIMEFILE) {
305our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 307our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
306 308
307sub encode_json($) { $json_coder->encode ($_[0]) } 309sub encode_json($) { $json_coder->encode ($_[0]) }
308sub decode_json($) { $json_coder->decode ($_[0]) } 310sub decode_json($) { $json_coder->decode ($_[0]) }
309 311
312=item cf::post_init { BLOCK }
313
314Execute the given codeblock, I<after> all extensions have been (re-)loaded,
315but I<before> the server starts ticking again.
316
317The cdoeblock will have a single boolean argument to indicate whether this
318is a reload or not.
319
320=cut
321
322sub post_init(&) {
323 push @POST_INIT, shift;
324}
325
310=item cf::lock_wait $string 326=item cf::lock_wait $string
311 327
312Wait until the given lock is available. See cf::lock_acquire. 328Wait until the given lock is available. See cf::lock_acquire.
313 329
314=item my $lock = cf::lock_acquire $string 330=item my $lock = cf::lock_acquire $string
341 return;#d# 357 return;#d#
342 }#d# 358 }#d#
343 359
344 # wait for lock, if any 360 # wait for lock, if any
345 while ($LOCK{$key}) { 361 while ($LOCK{$key}) {
362 #local $Coro::current->{desc} = "$Coro::current->{desc} <waiting for lock $key>";
346 push @{ $LOCK{$key} }, $Coro::current; 363 push @{ $LOCK{$key} }, $Coro::current;
347 Coro::schedule; 364 Coro::schedule;
348 } 365 }
349} 366}
350 367
1170 } else { 1187 } else {
1171 aio_unlink "$filename.pst"; 1188 aio_unlink "$filename.pst";
1172 } 1189 }
1173 1190
1174 aio_rename "$filename~", $filename; 1191 aio_rename "$filename~", $filename;
1192
1193 $filename =~ s%/[^/]+$%%;
1194 aio_pathsync $filename;
1175 } else { 1195 } else {
1176 warn "FATAL: $filename~: $!\n"; 1196 warn "FATAL: $filename~: $!\n";
1177 } 1197 }
1178 } else { 1198 } else {
1179 aio_unlink $filename; 1199 aio_unlink $filename;
1444 1464
1445sub exists($) { 1465sub exists($) {
1446 my ($login) = @_; 1466 my ($login) = @_;
1447 1467
1448 $cf::PLAYER{$login} 1468 $cf::PLAYER{$login}
1449 or cf::sync_job { !aio_stat path $login } 1469 or !aio_stat path $login
1450} 1470}
1451 1471
1452sub find($) { 1472sub find($) {
1453 return $cf::PLAYER{$_[0]} || do { 1473 return $cf::PLAYER{$_[0]} || do {
1454 my $login = $_[0]; 1474 my $login = $_[0];
2771 id => "infobox", 2791 id => "infobox",
2772 title => "Body Parts", 2792 title => "Body Parts",
2773 reply => undef, 2793 reply => undef,
2774 tooltip => "Shows which body parts you posess and are available", 2794 tooltip => "Shows which body parts you posess and are available",
2775 }, 2795 },
2796 "c/skills" => {
2797 id => "infobox",
2798 title => "Skills",
2799 reply => undef,
2800 tooltip => "Shows your experience per skill and item power",
2801 },
2776 "c/uptime" => { 2802 "c/uptime" => {
2777 id => "infobox", 2803 id => "infobox",
2778 title => "Uptime", 2804 title => "Uptime",
2779 reply => undef, 2805 reply => undef,
2780 tooltip => "How long the server has been running since last restart", 2806 tooltip => "How long the server has been running since last restart",
3334 reload_treasures; 3360 reload_treasures;
3335 3361
3336 warn "finished reloading resource files\n"; 3362 warn "finished reloading resource files\n";
3337} 3363}
3338 3364
3339sub init {
3340 my $guard = freeze_mainloop;
3341
3342 evthread_start IO::AIO::poll_fileno;
3343
3344 reload_resources;
3345}
3346
3347sub reload_config { 3365sub reload_config {
3348 open my $fh, "<:utf8", "$CONFDIR/config" 3366 open my $fh, "<:utf8", "$CONFDIR/config"
3349 or return; 3367 or return;
3350 3368
3351 local $/; 3369 local $/;
3383 seek $fh, 0, 0; 3401 seek $fh, 0, 0;
3384 print $fh $$; 3402 print $fh $$;
3385} 3403}
3386 3404
3387sub main { 3405sub main {
3388 atomic; 3406 cf::init_globals; # initialise logging
3407
3408 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3409 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3410 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3411 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3412
3413 cf::init_experience;
3414 cf::init_anim;
3415 cf::init_attackmess;
3416 cf::init_dynamic;
3417 cf::init_block;
3418
3419 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3389 3420
3390 # we must not ever block the main coroutine 3421 # we must not ever block the main coroutine
3391 local $Coro::idle = sub { 3422 local $Coro::idle = sub {
3392 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3423 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3393 (async { 3424 (async {
3394 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3425 $Coro::current->{desc} = "IDLE BUG HANDLER";
3395 EV::loop EV::LOOP_ONESHOT; 3426 EV::loop EV::LOOP_ONESHOT;
3396 })->prio (Coro::PRIO_MAX); 3427 })->prio (Coro::PRIO_MAX);
3397 }; 3428 };
3398 3429
3399 { 3430 evthread_start IO::AIO::poll_fileno;
3400 my $guard = freeze_mainloop; 3431
3432 cf::sync_job {
3433 reload_resources;
3401 reload_config; 3434 reload_config;
3402 db_init; 3435 db_init;
3436
3437 cf::load_settings;
3438 cf::load_materials;
3439 cf::init_uuid;
3440 cf::init_signals;
3441 cf::init_commands;
3442 cf::init_skills;
3443
3444 cf::init_beforeplay;
3445
3446 atomic;
3447
3403 load_extensions; 3448 load_extensions;
3404 3449
3405 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3406 }
3407
3408 utime time, time, $RUNTIMEFILE; 3450 utime time, time, $RUNTIMEFILE;
3409 3451
3410 # no (long-running) fork's whatsoever before this point(!) 3452 # no (long-running) fork's whatsoever before this point(!)
3411 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3453 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3454
3455 (pop @POST_INIT)->(0) while @POST_INIT;
3456 };
3412 3457
3413 EV::loop; 3458 EV::loop;
3414} 3459}
3415 3460
3416############################################################################# 3461#############################################################################
3474 my $uuid = "$LOCALDIR/uuid"; 3519 my $uuid = "$LOCALDIR/uuid";
3475 3520
3476 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644 3521 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
3477 or return; 3522 or return;
3478 3523
3479 my $value = uuid_str $uuid_skip + uuid_seq uuid_cur; 3524 my $value = uuid_seq uuid_cur;
3525
3526 unless ($value) {
3527 warn "cowardly refusing to write zero uuid value!\n";
3528 return;
3529 }
3530
3531 my $value = uuid_str $value + $uuid_skip;
3480 $uuid_skip = 0; 3532 $uuid_skip = 0;
3481 3533
3482 (aio_write $fh, 0, (length $value), $value, 0) <= 0 3534 (aio_write $fh, 0, (length $value), $value, 0) <= 0
3483 and return; 3535 and return;
3484 3536
3574 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3626 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3575 for my $name (keys %$leaf_symtab) { 3627 for my $name (keys %$leaf_symtab) {
3576 _gv_clear *{"$pkg$name"}; 3628 _gv_clear *{"$pkg$name"};
3577# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3629# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3578 } 3630 }
3579 warn "cleared package #$pkg\n";#d# 3631 warn "cleared package $pkg\n";#d#
3580} 3632}
3581
3582our $RELOAD; # how many times to reload
3583 3633
3584sub do_reload_perl() { 3634sub do_reload_perl() {
3585 # can/must only be called in main 3635 # can/must only be called in main
3586 if ($Coro::current != $Coro::main) { 3636 if ($Coro::current != $Coro::main) {
3587 warn "can only reload from main coroutine"; 3637 warn "can only reload from main coroutine";
3682 warn "reattaching attachments to maps"; 3732 warn "reattaching attachments to maps";
3683 reattach $_ for values %MAP; 3733 reattach $_ for values %MAP;
3684 warn "reattaching attachments to players"; 3734 warn "reattaching attachments to players";
3685 reattach $_ for values %PLAYER; 3735 reattach $_ for values %PLAYER;
3686 3736
3737 warn "running post_load";
3738 (pop @POST_INIT)->(1) while @POST_INIT;
3739
3687 warn "leaving sync_job"; 3740 warn "leaving sync_job";
3688 3741
3689 1 3742 1
3690 } or do { 3743 } or do {
3691 warn $@; 3744 warn $@;
3701 3754
3702sub reload_perl() { 3755sub reload_perl() {
3703 # doing reload synchronously and two reloads happen back-to-back, 3756 # doing reload synchronously and two reloads happen back-to-back,
3704 # coro crashes during coro_state_free->destroy here. 3757 # coro crashes during coro_state_free->destroy here.
3705 3758
3706 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3759 $RELOAD_WATCHER ||= EV::timer $TICK * 1.5, 0, sub {
3707 do_reload_perl; 3760 do_reload_perl;
3708 undef $RELOAD_WATCHER; 3761 undef $RELOAD_WATCHER;
3709 }; 3762 };
3710} 3763}
3711 3764

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines