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.398 by root, Wed Dec 5 11:08:34 2007 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; 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.1 (); 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;
21use Coro::Semaphore; 42use Coro::Semaphore;
22use Coro::AIO; 43use Coro::AIO;
44use Coro::BDB;
23use Coro::Storable; 45use Coro::Storable;
24use Coro::Util (); 46use Coro::Util ();
25 47
26use JSON::XS 2.01 (); 48use JSON::XS 2.01 ();
27use BDB (); 49use BDB ();
28use Data::Dumper; 50use Data::Dumper;
29use Digest::MD5; 51use Digest::MD5;
30use Fcntl; 52use Fcntl;
31use YAML::Syck (); 53use YAML ();
32use IO::AIO 2.51 (); 54use IO::AIO 2.51 ();
33use Time::HiRes; 55use Time::HiRes;
34use Compress::LZF; 56use Compress::LZF;
35use Digest::MD5 (); 57use Digest::MD5 ();
36 58
37# configure various modules to our taste 59# configure various modules to our taste
38# 60#
39$Storable::canonical = 1; # reduce rsync transfers 61$Storable::canonical = 1; # reduce rsync transfers
40Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 62Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
41Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 63Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
42
43# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
44$YAML::Syck::ImplicitUnicode = 1;
45 64
46$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 65$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
47 66
48sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 67sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
49 68
… …
68our $TMPDIR = "$LOCALDIR/" . tmpdir; 87our $TMPDIR = "$LOCALDIR/" . tmpdir;
69our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 88our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
70our $PLAYERDIR = "$LOCALDIR/" . playerdir; 89our $PLAYERDIR = "$LOCALDIR/" . playerdir;
71our $RANDOMDIR = "$LOCALDIR/random"; 90our $RANDOMDIR = "$LOCALDIR/random";
72our $BDBDIR = "$LOCALDIR/db"; 91our $BDBDIR = "$LOCALDIR/db";
92our %RESOURCE;
73 93
74our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 94our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
75our $TICK_WATCHER;
76our $AIO_POLL_WATCHER; 95our $AIO_POLL_WATCHER;
77our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 96our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
78our $NEXT_TICK; 97our $NEXT_TICK;
79our $NOW;
80our $USE_FSYNC = 1; # use fsync to write maps - default off 98our $USE_FSYNC = 1; # use fsync to write maps - default off
81 99
82our $BDB_POLL_WATCHER; 100our $BDB_POLL_WATCHER;
83our $BDB_DEADLOCK_WATCHER; 101our $BDB_DEADLOCK_WATCHER;
84our $BDB_CHECKPOINT_WATCHER; 102our $BDB_CHECKPOINT_WATCHER;
… …
87 105
88our %CFG; 106our %CFG;
89 107
90our $UPTIME; $UPTIME ||= time; 108our $UPTIME; $UPTIME ||= time;
91our $RUNTIME; 109our $RUNTIME;
110our $NOW;
92 111
93our (%PLAYER, %PLAYER_LOADING); # all users 112our (%PLAYER, %PLAYER_LOADING); # all users
94our (%MAP, %MAP_LOADING ); # all maps 113our (%MAP, %MAP_LOADING ); # all maps
95our $LINK_MAP; # the special {link} map, which is always available 114our $LINK_MAP; # the special {link} map, which is always available
96 115
97# 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 ∕
98our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 117our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
99 118
100our $LOAD; # a number between 0 (idle) and 1 (too many objects) 119our $LOAD; # a number between 0 (idle) and 1 (too many objects)
101our $LOADAVG; # same thing, but with alpha-smoothing 120our $LOADAVG; # same thing, but with alpha-smoothing
121our $JITTER; # average jitter
102our $tick_start; # for load detecting purposes 122our $TICK_START; # for load detecting purposes
103 123
104binmode STDOUT; 124binmode STDOUT;
105binmode STDERR; 125binmode STDERR;
106 126
107# read virtual server time, if available 127# read virtual server time, if available
… …
191 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 211 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
192 212
193 LOG llevError, $msg; 213 LOG llevError, $msg;
194 }; 214 };
195} 215}
216
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
226 warn Carp::longmess $_[0];
227 Coro::terminate
228};
229
230$SIG{__DIE__} = sub { }; #d#?
196 231
197@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 232@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
198@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 233@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
199@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 234@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
200@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 235@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
325 360
326 ! ! $LOCK{$key} 361 ! ! $LOCK{$key}
327} 362}
328 363
329sub freeze_mainloop { 364sub freeze_mainloop {
330 return unless $TICK_WATCHER->is_active; 365 tick_inhibit_inc;
331 366
332 my $guard = Coro::guard { 367 Coro::guard \&tick_inhibit_dec;
333 $TICK_WATCHER->start;
334 };
335 $TICK_WATCHER->stop;
336 $guard
337} 368}
338 369
339=item cf::periodic $interval, $cb 370=item cf::periodic $interval, $cb
340 371
341Like 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
… …
442 # this is the main coro, too bad, we have to block 473 # this is the main coro, too bad, we have to block
443 # till the operation succeeds, freezing the server :/ 474 # till the operation succeeds, freezing the server :/
444 475
445 LOG llevError, Carp::longmess "sync job";#d# 476 LOG llevError, Carp::longmess "sync job";#d#
446 477
447 # TODO: use suspend/resume instead
448 # (but this is cancel-safe)
449 my $freeze_guard = freeze_mainloop; 478 my $freeze_guard = freeze_mainloop;
450 479
451 my $busy = 1; 480 my $busy = 1;
452 my @res; 481 my @res;
453 482
… …
464 } else { 493 } else {
465 EV::loop EV::LOOP_ONESHOT; 494 EV::loop EV::LOOP_ONESHOT;
466 } 495 }
467 } 496 }
468 497
469 $time = EV::time - $time; 498 my $time = EV::time - $time;
470 499
471 LOG llevError | logBacktrace, Carp::longmess "long sync job"
472 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
473
474 $tick_start += $time; # do not account sync jobs to server load 500 $TICK_START += $time; # do not account sync jobs to server load
475 501
476 wantarray ? @res : $res[0] 502 wantarray ? @res : $res[0]
477 } else { 503 } else {
478 # we are in another coroutine, how wonderful, everything just works 504 # we are in another coroutine, how wonderful, everything just works
479 505
… …
521 reset_signals; 547 reset_signals;
522 &$cb 548 &$cb
523 }, @args; 549 }, @args;
524 550
525 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
526} 579}
527 580
528=item $value = cf::db_get $family => $key 581=item $value = cf::db_get $family => $key
529 582
530Returns a single value from the environment database. 583Returns a single value from the environment database.
… …
967 } 1020 }
968 1021
969 0 1022 0
970} 1023}
971 1024
972=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) 1025=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
973 1026
974=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) 1027=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
975 1028
976Generate an object-specific event with the given arguments. 1029Generate an object-specific event with the given arguments.
977 1030
… …
1302 my $msg = $@ ? "$v->{path}: $@\n" 1355 my $msg = $@ ? "$v->{path}: $@\n"
1303 : "$v->{base}: extension inactive.\n"; 1356 : "$v->{base}: extension inactive.\n";
1304 1357
1305 if (exists $v->{meta}{mandatory}) { 1358 if (exists $v->{meta}{mandatory}) {
1306 warn $msg; 1359 warn $msg;
1307 warn "mandatory extension failed to load, exiting.\n"; 1360 cf::cleanup "mandatory extension failed to load, exiting.";
1308 exit 1;
1309 } 1361 }
1310 1362
1311 warn $msg; 1363 warn $msg;
1312 } 1364 }
1313 1365
… …
2324 ? normalise $_ 2376 ? normalise $_
2325 : () 2377 : ()
2326 } @{ aio_readdir $UNIQUEDIR or [] } 2378 } @{ aio_readdir $UNIQUEDIR or [] }
2327 ] 2379 ]
2328} 2380}
2329
2330package cf;
2331 2381
2332=back 2382=back
2333 2383
2334=head3 cf::object 2384=head3 cf::object
2335 2385
… …
3148 { 3198 {
3149 my $faces = $facedata->{faceinfo}; 3199 my $faces = $facedata->{faceinfo};
3150 3200
3151 while (my ($face, $info) = each %$faces) { 3201 while (my ($face, $info) = each %$faces) {
3152 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3202 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3203
3153 cf::face::set_visibility $idx, $info->{visibility}; 3204 cf::face::set_visibility $idx, $info->{visibility};
3154 cf::face::set_magicmap $idx, $info->{magicmap}; 3205 cf::face::set_magicmap $idx, $info->{magicmap};
3155 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3206 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
3156 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3207 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
3157 3208
3158 cf::cede_to_tick; 3209 cf::cede_to_tick;
3159 } 3210 }
3160 3211
3161 while (my ($face, $info) = each %$faces) { 3212 while (my ($face, $info) = each %$faces) {
3162 next unless $info->{smooth}; 3213 next unless $info->{smooth};
3214
3163 my $idx = cf::face::find $face 3215 my $idx = cf::face::find $face
3164 or next; 3216 or next;
3217
3165 if (my $smooth = cf::face::find $info->{smooth}) { 3218 if (my $smooth = cf::face::find $info->{smooth}) {
3166 cf::face::set_smooth $idx, $smooth; 3219 cf::face::set_smooth $idx, $smooth;
3167 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3220 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3168 } else { 3221 } else {
3169 warn "smooth face '$info->{smooth}' not found for face '$face'"; 3222 warn "smooth face '$info->{smooth}' not found for face '$face'";
… …
3187 { 3240 {
3188 # TODO: for gcfclient pleasure, we should give resources 3241 # TODO: for gcfclient pleasure, we should give resources
3189 # that gcfclient doesn't grok a >10000 face index. 3242 # that gcfclient doesn't grok a >10000 face index.
3190 my $res = $facedata->{resource}; 3243 my $res = $facedata->{resource};
3191 3244
3192 my $soundconf = delete $res->{"res/sound.conf"};
3193
3194 while (my ($name, $info) = each %$res) { 3245 while (my ($name, $info) = each %$res) {
3246 if (defined $info->{type}) {
3195 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3247 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3196 my $data; 3248 my $data;
3197 3249
3198 if ($info->{type} & 1) { 3250 if ($info->{type} & 1) {
3199 # prepend meta info 3251 # prepend meta info
3200 3252
3201 my $meta = $enc->encode ({ 3253 my $meta = $enc->encode ({
3202 name => $name, 3254 name => $name,
3203 %{ $info->{meta} || {} }, 3255 %{ $info->{meta} || {} },
3204 }); 3256 });
3205 3257
3206 $data = pack "(w/a*)*", $meta, $info->{data}; 3258 $data = pack "(w/a*)*", $meta, $info->{data};
3259 } else {
3260 $data = $info->{data};
3261 }
3262
3263 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3264 cf::face::set_type $idx, $info->{type};
3207 } else { 3265 } else {
3208 $data = $info->{data}; 3266 $RESOURCE{$name} = $info;
3209 } 3267 }
3210 3268
3211 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3212 cf::face::set_type $idx, $info->{type};
3213
3214 cf::cede_to_tick; 3269 cf::cede_to_tick;
3215 } 3270 }
3216
3217 if ($soundconf) {
3218 $soundconf = $enc->decode (delete $soundconf->{data});
3219
3220 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3221 my $sound = $soundconf->{compat}[$_]
3222 or next;
3223
3224 my $face = cf::face::find "sound/$sound->[1]";
3225 cf::sound::set $sound->[0] => $face;
3226 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3227 }
3228
3229 while (my ($k, $v) = each %{$soundconf->{event}}) {
3230 my $face = cf::face::find "sound/$v";
3231 cf::sound::set $k => $face;
3232 }
3233 }
3234 } 3271 }
3272
3273 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3235 3274
3236 1 3275 1
3237} 3276}
3277
3278cf::global->attach (on_resource_update => sub {
3279 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3280 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3281
3282 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3283 my $sound = $soundconf->{compat}[$_]
3284 or next;
3285
3286 my $face = cf::face::find "sound/$sound->[1]";
3287 cf::sound::set $sound->[0] => $face;
3288 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3289 }
3290
3291 while (my ($k, $v) = each %{$soundconf->{event}}) {
3292 my $face = cf::face::find "sound/$v";
3293 cf::sound::set $k => $face;
3294 }
3295 }
3296});
3238 3297
3239register_exticmd fx_want => sub { 3298register_exticmd fx_want => sub {
3240 my ($ns, $want) = @_; 3299 my ($ns, $want) = @_;
3241 3300
3242 while (my ($k, $v) = each %$want) { 3301 while (my ($k, $v) = each %$want) {
… …
3297sub reload_config { 3356sub reload_config {
3298 open my $fh, "<:utf8", "$CONFDIR/config" 3357 open my $fh, "<:utf8", "$CONFDIR/config"
3299 or return; 3358 or return;
3300 3359
3301 local $/; 3360 local $/;
3302 *CFG = YAML::Syck::Load <$fh>; 3361 *CFG = YAML::Load <$fh>;
3303 3362
3304 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3363 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3305 3364
3306 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3365 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3307 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3366 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3327 3386
3328 reload_config; 3387 reload_config;
3329 db_init; 3388 db_init;
3330 load_extensions; 3389 load_extensions;
3331 3390
3332 $TICK_WATCHER->start;
3333 $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;
3334 EV::loop; 3393 EV::loop;
3335} 3394}
3336 3395
3337############################################################################# 3396#############################################################################
3338# initialisation and cleanup 3397# initialisation and cleanup
… …
3535 warn "leaving sync_job"; 3594 warn "leaving sync_job";
3536 3595
3537 1 3596 1
3538 } or do { 3597 } or do {
3539 warn $@; 3598 warn $@;
3540 warn "error while reloading, exiting."; 3599 cf::cleanup "error while reloading, exiting.";
3541 exit 1;
3542 }; 3600 };
3543 3601
3544 warn "reloaded"; 3602 warn "reloaded";
3545}; 3603};
3546 3604
… …
3549sub reload_perl() { 3607sub reload_perl() {
3550 # doing reload synchronously and two reloads happen back-to-back, 3608 # doing reload synchronously and two reloads happen back-to-back,
3551 # coro crashes during coro_state_free->destroy here. 3609 # coro crashes during coro_state_free->destroy here.
3552 3610
3553 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3611 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3612 do_reload_perl;
3554 undef $RELOAD_WATCHER; 3613 undef $RELOAD_WATCHER;
3555 do_reload_perl;
3556 }; 3614 };
3557} 3615}
3558 3616
3559register_command "reload" => sub { 3617register_command "reload" => sub {
3560 my ($who, $arg) = @_; 3618 my ($who, $arg) = @_;
… …
3574 3632
3575our @WAIT_FOR_TICK; 3633our @WAIT_FOR_TICK;
3576our @WAIT_FOR_TICK_BEGIN; 3634our @WAIT_FOR_TICK_BEGIN;
3577 3635
3578sub wait_for_tick { 3636sub wait_for_tick {
3579 return unless $TICK_WATCHER->is_active; 3637 return if tick_inhibit;
3580 return if $Coro::current == $Coro::main; 3638 return if $Coro::current == $Coro::main;
3581 3639
3582 my $signal = new Coro::Signal; 3640 my $signal = new Coro::Signal;
3583 push @WAIT_FOR_TICK, $signal; 3641 push @WAIT_FOR_TICK, $signal;
3584 $signal->wait; 3642 $signal->wait;
3585} 3643}
3586 3644
3587sub wait_for_tick_begin { 3645sub wait_for_tick_begin {
3588 return unless $TICK_WATCHER->is_active; 3646 return if tick_inhibit;
3589 return if $Coro::current == $Coro::main; 3647 return if $Coro::current == $Coro::main;
3590 3648
3591 my $signal = new Coro::Signal; 3649 my $signal = new Coro::Signal;
3592 push @WAIT_FOR_TICK_BEGIN, $signal; 3650 push @WAIT_FOR_TICK_BEGIN, $signal;
3593 $signal->wait; 3651 $signal->wait;
3594} 3652}
3595 3653
3596$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub { 3654sub tick {
3597 if ($Coro::current != $Coro::main) { 3655 if ($Coro::current != $Coro::main) {
3598 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"
3599 unless ++$bug_warning > 10; 3657 unless ++$bug_warning > 10;
3600 return; 3658 return;
3601 } 3659 }
3602 3660
3603 $NOW = $tick_start = EV::now;
3604
3605 cf::server_tick; # one server iteration 3661 cf::server_tick; # one server iteration
3606 3662
3607 $RUNTIME += $TICK;
3608 $NEXT_TICK += $TICK;
3609
3610 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3663 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3611 $NEXT_RUNTIME_WRITE = $NOW + 10; 3664 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3612 Coro::async_pool { 3665 Coro::async_pool {
3613 $Coro::current->{desc} = "runtime saver"; 3666 $Coro::current->{desc} = "runtime saver";
3614 write_runtime 3667 write_runtime
3615 or warn "ERROR: unable to write runtime file: $!"; 3668 or warn "ERROR: unable to write runtime file: $!";
3616 }; 3669 };
… …
3621 } 3674 }
3622 while (my $sig = shift @WAIT_FOR_TICK) { 3675 while (my $sig = shift @WAIT_FOR_TICK) {
3623 $sig->send; 3676 $sig->send;
3624 } 3677 }
3625 3678
3626 $LOAD = ($NOW - $tick_start) / $TICK; 3679 $LOAD = ($NOW - $TICK_START) / $TICK;
3627 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3680 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3628 3681
3629 _post_tick; 3682 if (0) {
3630}; 3683 if ($NEXT_TICK) {
3631$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}
3632 3690
3633{ 3691{
3692 # configure BDB
3693
3634 BDB::min_parallel 8; 3694 BDB::min_parallel 8;
3635 BDB::max_poll_time $TICK * 0.1; 3695 BDB::max_poll_reqs $TICK * 0.1;
3636 $BDB_POLL_WATCHER = EV::io BDB::poll_fileno, EV::READ, \&BDB::poll_cb; 3696 $Coro::BDB::WATCHER->priority (1);
3637
3638 BDB::set_sync_prepare {
3639 my $status;
3640 my $current = $Coro::current;
3641 (
3642 sub {
3643 $status = $!;
3644 $current->ready; undef $current;
3645 },
3646 sub {
3647 Coro::schedule while defined $current;
3648 $! = $status;
3649 },
3650 )
3651 };
3652 3697
3653 unless ($DB_ENV) { 3698 unless ($DB_ENV) {
3654 $DB_ENV = BDB::db_env_create; 3699 $DB_ENV = BDB::db_env_create;
3655 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC 3700 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC
3656 | BDB::LOG_AUTOREMOVE, 1); 3701 | BDB::LOG_AUTOREMOVE, 1);
… …
3683 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { }; 3728 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
3684 }; 3729 };
3685} 3730}
3686 3731
3687{ 3732{
3733 # configure IO::AIO
3734
3688 IO::AIO::min_parallel 8; 3735 IO::AIO::min_parallel 8;
3689
3690 undef $Coro::AIO::WATCHER;
3691 IO::AIO::max_poll_time $TICK * 0.1; 3736 IO::AIO::max_poll_time $TICK * 0.1;
3692 $AIO_POLL_WATCHER = EV::io IO::AIO::poll_fileno, EV::READ, \&IO::AIO::poll_cb; 3737 $Coro::AIO::WATCHER->priority (1);
3693} 3738}
3694 3739
3695my $_log_backtrace; 3740my $_log_backtrace;
3696 3741
3697sub _log_backtrace { 3742sub _log_backtrace {

Diff Legend

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