--- deliantra/server/lib/cf.pm 2007/12/17 07:03:32 1.402
+++ deliantra/server/lib/cf.pm 2008/04/02 11:13:55 1.412
@@ -1,3 +1,24 @@
+#
+# This file is part of Deliantra, the Roguelike Realtime MMORPG.
+#
+# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
+#
+# Deliantra is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+#
+# The authors can be reached via e-mail to
+#
+
package cf;
use utf8;
@@ -6,7 +27,7 @@
use Symbol;
use List::Util;
use Socket;
-use EV;
+use EV 1.86;
use Opcode;
use Safe;
use Safe::Hole;
@@ -29,7 +50,7 @@
use Data::Dumper;
use Digest::MD5;
use Fcntl;
-use YAML::Syck ();
+use YAML ();
use IO::AIO 2.51 ();
use Time::HiRes;
use Compress::LZF;
@@ -41,9 +62,6 @@
Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
-# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
-$YAML::Syck::ImplicitUnicode = 1;
-
$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
@@ -71,9 +89,9 @@
our $PLAYERDIR = "$LOCALDIR/" . playerdir;
our $RANDOMDIR = "$LOCALDIR/random";
our $BDBDIR = "$LOCALDIR/db";
+our %RESOURCE;
our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
-our $TICK_WATCHER;
our $AIO_POLL_WATCHER;
our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
our $NEXT_TICK;
@@ -100,7 +118,8 @@
our $LOAD; # a number between 0 (idle) and 1 (too many objects)
our $LOADAVG; # same thing, but with alpha-smoothing
-our $tick_start; # for load detecting purposes
+our $JITTER; # average jitter
+our $TICK_START; # for load detecting purposes
binmode STDOUT;
binmode STDERR;
@@ -195,6 +214,21 @@
};
}
+$Coro::State::DIEHOOK = sub {
+ return unless $^S eq 0; # "eq", not "=="
+
+ if ($Coro::current == $Coro::main) {#d#
+ warn "DIEHOOK called in main context, Coro bug?\n";#d#
+ return;#d#
+ }#d#
+
+ # kill coroutine otherwise
+ warn Carp::longmess $_[0];
+ Coro::terminate
+};
+
+$SIG{__DIE__} = sub { }; #d#?
+
@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
@@ -328,13 +362,9 @@
}
sub freeze_mainloop {
- return unless $TICK_WATCHER->is_active;
+ tick_inhibit_inc;
- my $guard = Coro::guard {
- $TICK_WATCHER->start;
- };
- $TICK_WATCHER->stop;
- $guard
+ Coro::guard \&tick_inhibit_dec;
}
=item cf::periodic $interval, $cb
@@ -445,8 +475,6 @@
LOG llevError, Carp::longmess "sync job";#d#
- # TODO: use suspend/resume instead
- # (but this is cancel-safe)
my $freeze_guard = freeze_mainloop;
my $busy = 1;
@@ -467,12 +495,9 @@
}
}
- $time = EV::time - $time;
+ my $time = EV::time - $time;
- LOG llevError | logBacktrace, Carp::longmess "long sync job"
- if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
-
- $tick_start += $time; # do not account sync jobs to server load
+ $TICK_START += $time; # do not account sync jobs to server load
wantarray ? @res : $res[0]
} else {
@@ -970,7 +995,7 @@
0
}
-=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...)
+=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
@@ -1305,8 +1330,7 @@
if (exists $v->{meta}{mandatory}) {
warn $msg;
- warn "mandatory extension failed to load, exiting.\n";
- exit 1;
+ cf::cleanup "mandatory extension failed to load, exiting.";
}
warn $msg;
@@ -3151,6 +3175,7 @@
while (my ($face, $info) = each %$faces) {
my $idx = (cf::face::find $face) || cf::face::alloc $face;
+
cf::face::set_visibility $idx, $info->{visibility};
cf::face::set_magicmap $idx, $info->{magicmap};
cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
@@ -3161,8 +3186,10 @@
while (my ($face, $info) = each %$faces) {
next unless $info->{smooth};
+
my $idx = cf::face::find $face
or next;
+
if (my $smooth = cf::face::find $info->{smooth}) {
cf::face::set_smooth $idx, $smooth;
cf::face::set_smoothlevel $idx, $info->{smoothlevel};
@@ -3190,52 +3217,58 @@
# that gcfclient doesn't grok a >10000 face index.
my $res = $facedata->{resource};
- my $soundconf = delete $res->{"res/sound.conf"};
-
while (my ($name, $info) = each %$res) {
- my $idx = (cf::face::find $name) || cf::face::alloc $name;
- my $data;
+ if (defined $info->{type}) {
+ my $idx = (cf::face::find $name) || cf::face::alloc $name;
+ my $data;
+
+ if ($info->{type} & 1) {
+ # prepend meta info
+
+ my $meta = $enc->encode ({
+ name => $name,
+ %{ $info->{meta} || {} },
+ });
- if ($info->{type} & 1) {
- # prepend meta info
-
- my $meta = $enc->encode ({
- name => $name,
- %{ $info->{meta} || {} },
- });
+ $data = pack "(w/a*)*", $meta, $info->{data};
+ } else {
+ $data = $info->{data};
+ }
- $data = pack "(w/a*)*", $meta, $info->{data};
+ cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
+ cf::face::set_type $idx, $info->{type};
} else {
- $data = $info->{data};
+ $RESOURCE{$name} = $info;
}
- cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
- cf::face::set_type $idx, $info->{type};
-
cf::cede_to_tick;
}
+ }
- if ($soundconf) {
- $soundconf = $enc->decode (delete $soundconf->{data});
+ cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
- for (0 .. SOUND_CAST_SPELL_0 - 1) {
- my $sound = $soundconf->{compat}[$_]
- or next;
+ 1
+}
- my $face = cf::face::find "sound/$sound->[1]";
- cf::sound::set $sound->[0] => $face;
- cf::sound::old_sound_index $_, $face; # gcfclient-compat
- }
+cf::global->attach (on_resource_update => sub {
+ if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
+ $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
- while (my ($k, $v) = each %{$soundconf->{event}}) {
- my $face = cf::face::find "sound/$v";
- cf::sound::set $k => $face;
- }
+ for (0 .. SOUND_CAST_SPELL_0 - 1) {
+ my $sound = $soundconf->{compat}[$_]
+ or next;
+
+ my $face = cf::face::find "sound/$sound->[1]";
+ cf::sound::set $sound->[0] => $face;
+ cf::sound::old_sound_index $_, $face; # gcfclient-compat
}
- }
- 1
-}
+ while (my ($k, $v) = each %{$soundconf->{event}}) {
+ my $face = cf::face::find "sound/$v";
+ cf::sound::set $k => $face;
+ }
+ }
+});
register_exticmd fx_want => sub {
my ($ns, $want) = @_;
@@ -3300,7 +3333,7 @@
or return;
local $/;
- *CFG = YAML::Syck::Load <$fh>;
+ *CFG = YAML::Load <$fh>;
$EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
@@ -3330,8 +3363,8 @@
db_init;
load_extensions;
- $TICK_WATCHER->start;
$Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
+ evthread_start;
EV::loop;
}
@@ -3538,8 +3571,7 @@
1
} or do {
warn $@;
- warn "error while reloading, exiting.";
- exit 1;
+ cf::cleanup "error while reloading, exiting.";
};
warn "reloaded";
@@ -3552,8 +3584,8 @@
# coro crashes during coro_state_free->destroy here.
$RELOAD_WATCHER ||= EV::timer 0, 0, sub {
- undef $RELOAD_WATCHER;
do_reload_perl;
+ undef $RELOAD_WATCHER;
};
}
@@ -3577,7 +3609,7 @@
our @WAIT_FOR_TICK_BEGIN;
sub wait_for_tick {
- return unless $TICK_WATCHER->is_active;
+ return if tick_inhibit;
return if $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
@@ -3586,7 +3618,7 @@
}
sub wait_for_tick_begin {
- return unless $TICK_WATCHER->is_active;
+ return if tick_inhibit;
return if $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
@@ -3594,20 +3626,15 @@
$signal->wait;
}
-$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub {
+sub tick {
if ($Coro::current != $Coro::main) {
Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
unless ++$bug_warning > 10;
return;
}
- $NOW = $tick_start = EV::now;
-
cf::server_tick; # one server iteration
- $RUNTIME += $TICK;
- $NEXT_TICK += $TICK;
-
if ($NOW >= $NEXT_RUNTIME_WRITE) {
$NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
Coro::async_pool {
@@ -3624,18 +3651,24 @@
$sig->send;
}
- $LOAD = ($NOW - $tick_start) / $TICK;
+ $LOAD = ($NOW - $TICK_START) / $TICK;
$LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
- _post_tick;
-};
-$TICK_WATCHER->priority (EV::MAXPRI);
+ if (0) {
+ if ($NEXT_TICK) {
+ my $jitter = $TICK_START - $NEXT_TICK;
+ $JITTER = $JITTER * 0.75 + $jitter * 0.25;
+ warn "jitter $JITTER\n";#d#
+ }
+ }
+}
{
# configure BDB
BDB::min_parallel 8;
BDB::max_poll_reqs $TICK * 0.1;
+ $Coro::BDB::WATCHER->priority (1);
unless ($DB_ENV) {
$DB_ENV = BDB::db_env_create;
@@ -3676,6 +3709,7 @@
IO::AIO::min_parallel 8;
IO::AIO::max_poll_time $TICK * 0.1;
+ $Coro::AIO::WATCHER->priority (1);
}
my $_log_backtrace;