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.408 by root, Mon Jan 14 10:12:12 2008 UTC vs.
Revision 1.415 by root, Thu Apr 10 15:35:16 2008 UTC

1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3#
4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5#
6# Deliantra is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>.
18#
19# The authors can be reached via e-mail to <support@deliantra.net>
20#
21
1package cf; 22package cf;
2 23
3use utf8; 24use utf8;
4use strict; 25use strict;
5 26
6use Symbol; 27use Symbol;
7use List::Util; 28use List::Util;
8use Socket; 29use Socket;
9use EV 1.86; 30use EV 3.2;
10use Opcode; 31use Opcode;
11use Safe; 32use Safe;
12use Safe::Hole; 33use Safe::Hole;
13use Storable (); 34use Storable ();
14 35
15use Coro 4.32 (); 36use Coro 4.50 ();
16use Coro::State; 37use Coro::State;
17use Coro::Handle; 38use Coro::Handle;
18use Coro::EV; 39use Coro::EV;
19use Coro::Timer; 40use Coro::Timer;
20use Coro::Signal; 41use Coro::Signal;
… …
69our $RANDOMDIR = "$LOCALDIR/random"; 90our $RANDOMDIR = "$LOCALDIR/random";
70our $BDBDIR = "$LOCALDIR/db"; 91our $BDBDIR = "$LOCALDIR/db";
71our %RESOURCE; 92our %RESOURCE;
72 93
73our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 94our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
74our $TICK_WATCHER;
75our $AIO_POLL_WATCHER; 95our $AIO_POLL_WATCHER;
76our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 96our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
77our $NEXT_TICK; 97our $NEXT_TICK;
78our $USE_FSYNC = 1; # use fsync to write maps - default off 98our $USE_FSYNC = 1; # use fsync to write maps - default off
79 99
… …
96# used to convert map paths into valid unix filenames by replacing / by ∕ 116# used to convert map paths into valid unix filenames by replacing / by ∕
97our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 117our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
98 118
99our $LOAD; # a number between 0 (idle) and 1 (too many objects) 119our $LOAD; # a number between 0 (idle) and 1 (too many objects)
100our $LOADAVG; # same thing, but with alpha-smoothing 120our $LOADAVG; # same thing, but with alpha-smoothing
121our $JITTER; # average jitter
101our $tick_start; # for load detecting purposes 122our $TICK_START; # for load detecting purposes
102 123
103binmode STDOUT; 124binmode STDOUT;
104binmode STDERR; 125binmode STDERR;
105 126
106# read virtual server time, if available 127# read virtual server time, if available
… …
192 LOG llevError, $msg; 213 LOG llevError, $msg;
193 }; 214 };
194} 215}
195 216
196$Coro::State::DIEHOOK = sub { 217$Coro::State::DIEHOOK = sub {
218 return unless $^S eq 0; # "eq", not "=="
219
220 if ($Coro::current == $Coro::main) {#d#
221 warn "DIEHOOK called in main context, Coro bug?\n";#d#
222 return;#d#
223 }#d#
224
225 # kill coroutine otherwise
197 warn Carp::longmess $_[0]; 226 warn Carp::longmess $_[0];
198 Coro::terminate; 227 Coro::terminate
199}; 228};
229
230$SIG{__DIE__} = sub { }; #d#?
200 231
201@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 232@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
202@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 233@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
203@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 234@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
204@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 235@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
329 360
330 ! ! $LOCK{$key} 361 ! ! $LOCK{$key}
331} 362}
332 363
333sub freeze_mainloop { 364sub freeze_mainloop {
334 return unless $TICK_WATCHER->is_active; 365 tick_inhibit_inc;
335 366
336 my $guard = Coro::guard { 367 Coro::guard \&tick_inhibit_dec;
337 $TICK_WATCHER->start;
338 };
339 $TICK_WATCHER->stop;
340 $guard
341} 368}
342 369
343=item cf::periodic $interval, $cb 370=item cf::periodic $interval, $cb
344 371
345Like EV::periodic, but randomly selects a starting point so that the actions 372Like EV::periodic, but randomly selects a starting point so that the actions
… …
446 # this is the main coro, too bad, we have to block 473 # this is the main coro, too bad, we have to block
447 # till the operation succeeds, freezing the server :/ 474 # till the operation succeeds, freezing the server :/
448 475
449 LOG llevError, Carp::longmess "sync job";#d# 476 LOG llevError, Carp::longmess "sync job";#d#
450 477
451 # TODO: use suspend/resume instead
452 # (but this is cancel-safe)
453 my $freeze_guard = freeze_mainloop; 478 my $freeze_guard = freeze_mainloop;
454 479
455 my $busy = 1; 480 my $busy = 1;
456 my @res; 481 my @res;
457 482
… …
468 } else { 493 } else {
469 EV::loop EV::LOOP_ONESHOT; 494 EV::loop EV::LOOP_ONESHOT;
470 } 495 }
471 } 496 }
472 497
473 $time = EV::time - $time; 498 my $time = EV::time - $time;
474 499
475 LOG llevError | logBacktrace, Carp::longmess "long sync job"
476 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
477
478 $tick_start += $time; # do not account sync jobs to server load 500 $TICK_START += $time; # do not account sync jobs to server load
479 501
480 wantarray ? @res : $res[0] 502 wantarray ? @res : $res[0]
481 } else { 503 } else {
482 # we are in another coroutine, how wonderful, everything just works 504 # we are in another coroutine, how wonderful, everything just works
483 505
… …
525 reset_signals; 547 reset_signals;
526 &$cb 548 &$cb
527 }, @args; 549 }, @args;
528 550
529 wantarray ? @res : $res[-1] 551 wantarray ? @res : $res[-1]
552}
553
554=item $coin = coin_from_name $name
555
556=cut
557
558our %coin_alias = (
559 "silver" => "silvercoin",
560 "silvercoin" => "silvercoin",
561 "silvercoins" => "silvercoin",
562 "gold" => "goldcoin",
563 "goldcoin" => "goldcoin",
564 "goldcoins" => "goldcoin",
565 "platinum" => "platinacoin",
566 "platinumcoin" => "platinacoin",
567 "platinumcoins" => "platinacoin",
568 "platina" => "platinacoin",
569 "platinacoin" => "platinacoin",
570 "platinacoins" => "platinacoin",
571 "royalty" => "royalty",
572 "royalties" => "royalty",
573);
574
575sub coin_from_name($) {
576 $coin_alias{$_[0]}
577 ? cf::arch::find $coin_alias{$_[0]}
578 : undef
530} 579}
531 580
532=item $value = cf::db_get $family => $key 581=item $value = cf::db_get $family => $key
533 582
534Returns a single value from the environment database. 583Returns a single value from the environment database.
… …
1306 my $msg = $@ ? "$v->{path}: $@\n" 1355 my $msg = $@ ? "$v->{path}: $@\n"
1307 : "$v->{base}: extension inactive.\n"; 1356 : "$v->{base}: extension inactive.\n";
1308 1357
1309 if (exists $v->{meta}{mandatory}) { 1358 if (exists $v->{meta}{mandatory}) {
1310 warn $msg; 1359 warn $msg;
1311 warn "mandatory extension failed to load, exiting.\n"; 1360 cf::cleanup "mandatory extension failed to load, exiting.";
1312 exit 1;
1313 } 1361 }
1314 1362
1315 warn $msg; 1363 warn $msg;
1316 } 1364 }
1317 1365
… …
2328 ? normalise $_ 2376 ? normalise $_
2329 : () 2377 : ()
2330 } @{ aio_readdir $UNIQUEDIR or [] } 2378 } @{ aio_readdir $UNIQUEDIR or [] }
2331 ] 2379 ]
2332} 2380}
2333
2334package cf;
2335 2381
2336=back 2382=back
2337 2383
2338=head3 cf::object 2384=head3 cf::object
2339 2385
… …
3340 3386
3341 reload_config; 3387 reload_config;
3342 db_init; 3388 db_init;
3343 load_extensions; 3389 load_extensions;
3344 3390
3345 $TICK_WATCHER->start;
3346 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3391 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3392 evthread_start IO::AIO::poll_fileno;
3347 EV::loop; 3393 EV::loop;
3348} 3394}
3349 3395
3350############################################################################# 3396#############################################################################
3351# initialisation and cleanup 3397# initialisation and cleanup
… …
3548 warn "leaving sync_job"; 3594 warn "leaving sync_job";
3549 3595
3550 1 3596 1
3551 } or do { 3597 } or do {
3552 warn $@; 3598 warn $@;
3553 warn "error while reloading, exiting."; 3599 cf::cleanup "error while reloading, exiting.";
3554 exit 1;
3555 }; 3600 };
3556 3601
3557 warn "reloaded"; 3602 warn "reloaded";
3558}; 3603};
3559 3604
… …
3562sub reload_perl() { 3607sub reload_perl() {
3563 # doing reload synchronously and two reloads happen back-to-back, 3608 # doing reload synchronously and two reloads happen back-to-back,
3564 # coro crashes during coro_state_free->destroy here. 3609 # coro crashes during coro_state_free->destroy here.
3565 3610
3566 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3611 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3612 do_reload_perl;
3567 undef $RELOAD_WATCHER; 3613 undef $RELOAD_WATCHER;
3568 do_reload_perl;
3569 }; 3614 };
3570} 3615}
3571 3616
3572register_command "reload" => sub { 3617register_command "reload" => sub {
3573 my ($who, $arg) = @_; 3618 my ($who, $arg) = @_;
… …
3587 3632
3588our @WAIT_FOR_TICK; 3633our @WAIT_FOR_TICK;
3589our @WAIT_FOR_TICK_BEGIN; 3634our @WAIT_FOR_TICK_BEGIN;
3590 3635
3591sub wait_for_tick { 3636sub wait_for_tick {
3592 return unless $TICK_WATCHER->is_active; 3637 return if tick_inhibit;
3593 return if $Coro::current == $Coro::main; 3638 return if $Coro::current == $Coro::main;
3594 3639
3595 my $signal = new Coro::Signal; 3640 my $signal = new Coro::Signal;
3596 push @WAIT_FOR_TICK, $signal; 3641 push @WAIT_FOR_TICK, $signal;
3597 $signal->wait; 3642 $signal->wait;
3598} 3643}
3599 3644
3600sub wait_for_tick_begin { 3645sub wait_for_tick_begin {
3601 return unless $TICK_WATCHER->is_active; 3646 return if tick_inhibit;
3602 return if $Coro::current == $Coro::main; 3647 return if $Coro::current == $Coro::main;
3603 3648
3604 my $signal = new Coro::Signal; 3649 my $signal = new Coro::Signal;
3605 push @WAIT_FOR_TICK_BEGIN, $signal; 3650 push @WAIT_FOR_TICK_BEGIN, $signal;
3606 $signal->wait; 3651 $signal->wait;
3607} 3652}
3608 3653
3609$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub { 3654sub tick {
3610 if ($Coro::current != $Coro::main) { 3655 if ($Coro::current != $Coro::main) {
3611 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 3656 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3612 unless ++$bug_warning > 10; 3657 unless ++$bug_warning > 10;
3613 return; 3658 return;
3614 } 3659 }
3615 3660
3616 $NOW = $tick_start = EV::now;
3617
3618 cf::server_tick; # one server iteration 3661 cf::server_tick; # one server iteration
3619
3620 $RUNTIME += $TICK;
3621 $NEXT_TICK = $_[0]->at;
3622 3662
3623 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3663 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3624 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 3664 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3625 Coro::async_pool { 3665 Coro::async_pool {
3626 $Coro::current->{desc} = "runtime saver"; 3666 $Coro::current->{desc} = "runtime saver";
… …
3634 } 3674 }
3635 while (my $sig = shift @WAIT_FOR_TICK) { 3675 while (my $sig = shift @WAIT_FOR_TICK) {
3636 $sig->send; 3676 $sig->send;
3637 } 3677 }
3638 3678
3639 $LOAD = ($NOW - $tick_start) / $TICK; 3679 $LOAD = ($NOW - $TICK_START) / $TICK;
3640 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3680 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3641 3681
3642 _post_tick; 3682 if (0) {
3643}; 3683 if ($NEXT_TICK) {
3644$TICK_WATCHER->priority (EV::MAXPRI); 3684 my $jitter = $TICK_START - $NEXT_TICK;
3685 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
3686 warn "jitter $JITTER\n";#d#
3687 }
3688 }
3689}
3645 3690
3646{ 3691{
3647 # configure BDB 3692 # configure BDB
3648 3693
3649 BDB::min_parallel 8; 3694 BDB::min_parallel 8;

Diff Legend

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