--- deliantra/server/lib/cf.pm 2008/01/14 11:41:48 1.409
+++ deliantra/server/lib/cf.pm 2008/04/20 00:44:13 1.423
@@ -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,13 +27,13 @@
use Symbol;
use List::Util;
use Socket;
-use EV 1.86;
+use EV 3.2;
use Opcode;
use Safe;
use Safe::Hole;
use Storable ();
-use Coro 4.32 ();
+use Coro 4.50 ();
use Coro::State;
use Coro::Handle;
use Coro::EV;
@@ -71,7 +92,6 @@
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;
@@ -98,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;
@@ -194,10 +215,20 @@
}
$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;
+ 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';
@@ -331,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
@@ -402,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;
@@ -448,8 +477,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;
@@ -470,12 +497,9 @@
}
}
- $time = EV::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 {
@@ -529,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.
@@ -1308,8 +1359,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;
@@ -1428,6 +1478,8 @@
aio_mkdir playerdir $pl, 0770;
$pl->{last_save} = $cf::RUNTIME;
+ cf::get_slot 0.01;
+
$pl->save_pl ($path);
cf::cede_to_tick;
}
@@ -1729,6 +1781,9 @@
sub generate_random_map {
my ($self, $rmp) = @_;
+
+ my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
+
# mit "rum" bekleckern, nicht
$self->_create_random_map (
$rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
@@ -1860,7 +1915,7 @@
sub save_path {
my ($self) = @_;
- (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
+ (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
"$TMPDIR/$path.map"
}
@@ -1868,7 +1923,7 @@
sub uniq_path {
my ($self) = @_;
- (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
+ (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
"$UNIQUEDIR/$path"
}
@@ -2064,7 +2119,7 @@
$self->{last_save} = $cf::RUNTIME;
$self->last_access ($cf::RUNTIME);
- $self->in_memory (cf::MAP_IN_MEMORY);
+ $self->in_memory (cf::MAP_ACTIVE);
}
$self->post_load;
@@ -2132,7 +2187,7 @@
$path = normalise $path, $origin && $origin->{path};
if (my $map = $cf::MAP{$path}) {
- return $map if !$load || $map->in_memory == cf::MAP_IN_MEMORY;
+ return $map if !$load || $map->in_memory == cf::MAP_ACTIVE;
}
$MAP_PREFETCH{$path} |= $load;
@@ -2179,6 +2234,8 @@
$_->contr->save for $self->players;
};
+ cf::get_slot 0.02;
+
if ($uniq) {
$self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
$self->_save_objects ($uniq, cf::IO_UNIQUES);
@@ -2196,7 +2253,7 @@
my $lock = cf::lock_acquire "map_data:$self->{path}";
return if $self->players;
- return if $self->in_memory != cf::MAP_IN_MEMORY;
+ return if $self->in_memory != cf::MAP_ACTIVE;
return if $self->{deny_save};
$self->in_memory (cf::MAP_SWAPPED);
@@ -2324,15 +2381,14 @@
[
map {
utf8::decode $_;
- /\.map$/
- ? normalise $_
- : ()
+ s/\.map$//; # TODO future compatibility hack
+ /\.pst$/ || !/^$PATH_SEP/o # TODO unique maps apparebntly lack the .map suffix :/
+ ? ()
+ : normalise $_
} @{ aio_readdir $UNIQUEDIR or [] }
]
}
-package cf;
-
=back
=head3 cf::object
@@ -2345,7 +2401,8 @@
=item $ob->inv_recursive
-Returns the inventory of the object _and_ their inventories, recursively.
+Returns the inventory of the object I their inventories, recursively,
+but I the object itself.
=cut
@@ -2360,7 +2417,7 @@
=item $ref = $ob->ref
-creates and returns a persistent reference to an objetc that can be stored as a string.
+Creates and returns a persistent reference to an object that can be stored as a string.
=item $ob = cf::object::deref ($refstring)
@@ -2644,7 +2701,7 @@
$rmp->{random_seed} ||= $exit->random_seed;
- my $data = cf::encode_json $rmp;
+ my $data = JSON::XS->new->utf8->pretty->canonical->encode ($rmp);
my $md5 = Digest::MD5::md5_hex $data;
my $meta = "$RANDOMDIR/$md5.meta";
@@ -3257,6 +3314,13 @@
}
};
+sub load_resource_file($) {
+ my $status = load_resource_file_ $_[0];
+ get_slot 0.1, 100;
+ cf::arch::commit_load;
+ $status
+}
+
sub reload_regions {
# HACK to clear player env face cache, we need some signal framework
# for this (global event?)
@@ -3279,11 +3343,6 @@
sub reload_archetypes {
load_resource_file "$DATADIR/archetypes"
or die "unable to load archetypes\n";
- #d# NEED to laod twice to resolve forward references
- # this really needs to be done in an extra post-pass
- # (which needs to be synchronous, so solve it differently)
- load_resource_file "$DATADIR/archetypes"
- or die "unable to load archetypes\n";
}
sub reload_treasures {
@@ -3294,16 +3353,17 @@
sub reload_resources {
warn "reloading resource files...\n";
- reload_regions;
reload_facedata;
- #reload_archetypes;#d#
reload_archetypes;
+ reload_regions;
reload_treasures;
warn "finished reloading resource files\n";
}
sub init {
+ my $guard = freeze_mainloop;
+
reload_resources;
}
@@ -3338,12 +3398,16 @@
})->prio (Coro::PRIO_MAX);
};
- reload_config;
- db_init;
- load_extensions;
+ {
+ my $guard = freeze_mainloop;
+ reload_config;
+ db_init;
+ load_extensions;
+
+ $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
+ evthread_start IO::AIO::poll_fileno;
+ }
- $TICK_WATCHER->start;
- $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
EV::loop;
}
@@ -3360,7 +3424,7 @@
}
}
-sub write_runtime {
+sub write_runtime_sync {
my $runtime = "$LOCALDIR/runtime";
# first touch the runtime file to show we are still running:
@@ -3398,6 +3462,49 @@
1
}
+our $uuid_lock;
+our $uuid_skip;
+
+sub write_uuid_sync($) {
+ $uuid_skip ||= $_[0];
+
+ return if $uuid_lock;
+ local $uuid_lock = 1;
+
+ my $uuid = "$LOCALDIR/uuid";
+
+ my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
+ or return;
+
+ my $value = uuid_str $uuid_skip + uuid_seq uuid_cur;
+ $uuid_skip = 0;
+
+ (aio_write $fh, 0, (length $value), $value, 0) <= 0
+ and return;
+
+ # always fsync - this file is important
+ aio_fsync $fh
+ and return;
+
+ close $fh
+ or return;
+
+ aio_rename "$uuid~", $uuid
+ and return;
+
+ warn "uuid file written ($value).\n";
+
+ 1
+
+}
+
+sub write_uuid($$) {
+ my ($skip, $sync) = @_;
+
+ $sync ? write_uuid_sync $skip
+ : async { write_uuid_sync $skip };
+}
+
sub emergency_save() {
my $freeze_guard = cf::freeze_mainloop;
@@ -3427,6 +3534,10 @@
warn "begin emergency database checkpoint\n";
BDB::db_env_txn_checkpoint $DB_ENV;
warn "end emergency database checkpoint\n";
+
+ warn "begin write uuid\n";
+ write_uuid_sync 1;
+ warn "end write uuid\n";
};
warn "leave emergency perl save\n";
@@ -3451,9 +3562,9 @@
warn "entering sync_job";
cf::sync_job {
- cf::write_runtime; # external watchdog should not bark
+ cf::write_runtime_sync; # external watchdog should not bark
cf::emergency_save;
- cf::write_runtime; # external watchdog should not bark
+ cf::write_runtime_sync; # external watchdog should not bark
warn "syncing database to disk";
BDB::db_env_txn_checkpoint $DB_ENV;
@@ -3550,8 +3661,7 @@
1
} or do {
warn $@;
- warn "error while reloading, exiting.";
- exit 1;
+ cf::cleanup "error while reloading, exiting.";
};
warn "reloaded";
@@ -3589,8 +3699,7 @@
our @WAIT_FOR_TICK_BEGIN;
sub wait_for_tick {
- return unless $TICK_WATCHER->is_active;
- return if $Coro::current == $Coro::main;
+ return if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK, $signal;
@@ -3598,33 +3707,27 @@
}
sub wait_for_tick_begin {
- return unless $TICK_WATCHER->is_active;
- return if $Coro::current == $Coro::main;
+ return if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK_BEGIN, $signal;
$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 = $_[0]->at;
-
if ($NOW >= $NEXT_RUNTIME_WRITE) {
$NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
Coro::async_pool {
$Coro::current->{desc} = "runtime saver";
- write_runtime
+ write_runtime_sync
or warn "ERROR: unable to write runtime file: $!";
};
}
@@ -3636,12 +3739,17 @@
$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