--- deliantra/server/lib/cf.pm 2007/10/01 00:44:44 1.376
+++ deliantra/server/lib/cf.pm 2008/04/24 04:40:31 1.426
@@ -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,30 +27,31 @@
use Symbol;
use List::Util;
use Socket;
-use Storable;
-use Event;
+use EV 3.2;
use Opcode;
use Safe;
use Safe::Hole;
+use Storable ();
-use Coro 3.64 ();
+use Coro 4.50 ();
use Coro::State;
use Coro::Handle;
-use Coro::Event;
+use Coro::EV;
use Coro::Timer;
use Coro::Signal;
use Coro::Semaphore;
use Coro::AIO;
+use Coro::BDB;
use Coro::Storable;
use Coro::Util ();
-use JSON::XS ();
+use JSON::XS 2.01 ();
use BDB ();
use Data::Dumper;
use Digest::MD5;
use Fcntl;
-use YAML::Syck ();
-use IO::AIO 2.32 ();
+use YAML ();
+use IO::AIO 2.51 ();
use Time::HiRes;
use Compress::LZF;
use Digest::MD5 ();
@@ -40,11 +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
-$Event::Eval = 1; # no idea why this is required, but it is
-
-# 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
@@ -72,13 +89,12 @@
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;
-our $NOW;
our $USE_FSYNC = 1; # use fsync to write maps - default off
our $BDB_POLL_WATCHER;
@@ -91,6 +107,7 @@
our $UPTIME; $UPTIME ||= time;
our $RUNTIME;
+our $NOW;
our (%PLAYER, %PLAYER_LOADING); # all users
our (%MAP, %MAP_LOADING ); # all maps
@@ -101,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;
@@ -164,7 +182,7 @@
=item %cf::CFG
-Configuration for the server, loaded from C, or
+Configuration for the server, loaded from C, or
from wherever your confdir points to.
=item cf::wait_for_tick, cf::wait_for_tick_begin
@@ -196,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';
@@ -217,7 +250,7 @@
@{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
}
-$Event::DIED = sub {
+$EV::DIED = sub {
warn "error in event callback: @_";
};
@@ -250,11 +283,11 @@
} || "[unable to dump $_[0]: '$@']";
}
-=item $ref = cf::from_json $json
+=item $ref = cf::decode_json $json
Converts a JSON string into the corresponding perl data structure.
-=item $json = cf::to_json $ref
+=item $json = cf::encode_json $ref
Converts a perl data structure into its JSON representation.
@@ -262,8 +295,8 @@
our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
-sub to_json ($) { $json_coder->encode ($_[0]) }
-sub from_json ($) { $json_coder->decode ($_[0]) }
+sub encode_json($) { $json_coder->encode ($_[0]) }
+sub decode_json($) { $json_coder->decode ($_[0]) }
=item cf::lock_wait $string
@@ -329,13 +362,24 @@
}
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
+
+Like EV::periodic, but randomly selects a starting point so that the actions
+get spread over timer.
+
+=cut
+
+sub periodic($$) {
+ my ($interval, $cb) = @_;
+
+ my $start = rand List::Util::min 180, $interval;
+
+ EV::periodic $start, $interval, 0, $cb
}
=item cf::get_slot $time[, $priority[, $name]]
@@ -375,7 +419,7 @@
}
if (@SLOT_QUEUE) {
- # we do not use wait_For_tick() as it returns immediately when tick is inactive
+ # we do not use wait_for_tick() as it returns immediately when tick is inactive
push @cf::WAIT_FOR_TICK, $signal;
$signal->wait;
} else {
@@ -385,6 +429,8 @@
};
sub get_slot($;$$) {
+ return if tick_inhibit || $Coro::current == $Coro::main;
+
my ($time, $pri, $name) = @_;
$time = $TICK * .6 if $time > $TICK * .6;
@@ -408,8 +454,8 @@
=item cf::sync_job { BLOCK }
-The design of Crossfire TRT requires that the main coroutine ($Coro::main)
-is always able to handle events or runnable, as Crossfire TRT is only
+The design of Deliantra requires that the main coroutine ($Coro::main)
+is always able to handle events or runnable, as Deliantra is only
partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not
acceptable.
@@ -424,13 +470,13 @@
my ($job) = @_;
if ($Coro::current == $Coro::main) {
- my $time = Event::time;
+ my $time = EV::time;
# this is the main coro, too bad, we have to block
# till the operation succeeds, freezing the server :/
- # TODO: use suspend/resume instead
- # (but this is cancel-safe)
+ LOG llevError, Carp::longmess "sync job";#d#
+
my $freeze_guard = freeze_mainloop;
my $busy = 1;
@@ -444,15 +490,16 @@
})->prio (Coro::PRIO_MAX);
while ($busy) {
- Coro::cede or Event::one_event;
+ if (Coro::nready) {
+ Coro::cede_notself;
+ } else {
+ EV::loop EV::LOOP_ONESHOT;
+ }
}
- $time = Event::time - $time;
-
- LOG llevError | logBacktrace, Carp::longmess "long sync job"
- if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
+ my $time = EV::time - $time;
- $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 {
@@ -487,7 +534,7 @@
Executes the given code block with the given arguments in a seperate
process, returning the results. Everything must be serialisable with
Coro::Storable. May, of course, block. Note that the executed sub may
-never block itself or use any form of Event handling.
+never block itself or use any form of event handling.
=cut
@@ -506,6 +553,33 @@
wantarray ? @res : $res[-1]
}
+=item $coin = coin_from_name $name
+
+=cut
+
+our %coin_alias = (
+ "silver" => "silvercoin",
+ "silvercoin" => "silvercoin",
+ "silvercoins" => "silvercoin",
+ "gold" => "goldcoin",
+ "goldcoin" => "goldcoin",
+ "goldcoins" => "goldcoin",
+ "platinum" => "platinacoin",
+ "platinumcoin" => "platinacoin",
+ "platinumcoins" => "platinacoin",
+ "platina" => "platinacoin",
+ "platinacoin" => "platinacoin",
+ "platinacoins" => "platinacoin",
+ "royalty" => "royalty",
+ "royalties" => "royalty",
+);
+
+sub coin_from_name($) {
+ $coin_alias{$_[0]}
+ ? cf::arch::find $coin_alias{$_[0]}
+ : undef
+}
+
=item $value = cf::db_get $family => $key
Returns a single value from the environment database.
@@ -658,7 +732,7 @@
In the following description, CLASS can be any of C, C