--- deliantra/server/lib/cf.pm 2009/01/08 00:54:55 1.465
+++ deliantra/server/lib/cf.pm 2010/04/07 18:35:56 1.511
@@ -1,29 +1,30 @@
-#
+#
# This file is part of Deliantra, the Roguelike Realtime MMORPG.
#
-# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
+# Copyright (©) 2006,2007,2008,2009,2010 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.
+# Deliantra is free software: you can redistribute it and/or modify it under
+# the terms of the Affero 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 .
+# You should have received a copy of the Affero GNU General Public License
+# and the GNU General Public License along with this program. If not, see
+# .
#
# The authors can be reached via e-mail to
-#
+#
package cf;
use 5.10.0;
use utf8;
-use strict "vars", "subs";
+use strict qw(vars subs);
use Symbol;
use List::Util;
@@ -33,6 +34,7 @@
use Safe;
use Safe::Hole;
use Storable ();
+use Carp ();
use Guard ();
use Coro ();
@@ -53,9 +55,8 @@
use JSON::XS 2.01 ();
use BDB ();
use Data::Dumper;
-use Digest::MD5;
use Fcntl;
-use YAML ();
+use YAML::XS ();
use IO::AIO ();
use Time::HiRes;
use Compress::LZF;
@@ -74,6 +75,9 @@
Compress::LZF::set_serializer "Storable", "Storable::net_mstore", "Storable::mretrieve";
Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
+# strictly for debugging
+$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
+
sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
our %COMMAND = ();
@@ -87,6 +91,8 @@
our $RELOAD; # number of reloads so far, non-zero while in reload
our @EVENT;
+our @REFLECT; # set by XS
+our %REFLECT; # set by us
our $CONFDIR = confdir;
our $DATADIR = datadir;
@@ -107,13 +113,15 @@
our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
our $NEXT_TICK;
-our $USE_FSYNC = 1; # use fsync to write maps - default off
+our $USE_FSYNC = 1; # use fsync to write maps - default on
our $BDB_DEADLOCK_WATCHER;
our $BDB_CHECKPOINT_WATCHER;
our $BDB_TRICKLE_WATCHER;
our $DB_ENV;
+our @EXTRA_MODULES = qw(pod match mapscript);
+
our %CFG;
our $UPTIME; $UPTIME ||= time;
@@ -134,7 +142,8 @@
our @POST_INIT;
-our $REATTACH_ON_RELOAD; # ste to true to force object reattach on reload (slow)
+our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow)
+our $REALLY_UNLOOP; # never set to true, please :)
binmode STDOUT;
binmode STDERR;
@@ -146,6 +155,8 @@
$RUNTIME = <$fh> + 0.;
}
+eval "sub TICK() { $TICK } 1" or die;
+
mkdir $_
for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR;
@@ -155,6 +166,17 @@
#############################################################################
+%REFLECT = ();
+for (@REFLECT) {
+ my $reflect = JSON::XS::decode_json $_;
+ $REFLECT{$reflect->{class}} = $reflect;
+}
+
+# this is decidedly evil
+$REFLECT{object}{flags} = { map +($_ => undef), grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"} };
+
+#############################################################################
+
=head2 GLOBAL VARIABLES
=over 4
@@ -208,42 +230,45 @@
=item @cf::INVOKE_RESULTS
-This array contains the results of the last C call. When
+This array contains the results of the last C call. When
C is called C<@cf::INVOKE_RESULTS> is set to the parameters of
that call.
+=item %cf::REFLECT
+
+Contains, for each (C++) class name, a hash reference with information
+about object members (methods, scalars, arrays and flags) and other
+metadata, which is useful for introspection.
+
=back
=cut
-BEGIN {
- *CORE::GLOBAL::warn = sub {
- my $msg = join "", @_;
+$Coro::State::WARNHOOK = sub {
+ my $msg = join "", @_;
- $msg .= "\n"
- unless $msg =~ /\n$/;
+ $msg .= "\n"
+ unless $msg =~ /\n$/;
- $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
+ $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
- LOG llevError, $msg;
- };
-}
+ LOG llevError, $msg;
+};
$Coro::State::DIEHOOK = sub {
return unless $^S eq 0; # "eq", not "=="
+ warn Carp::longmess $_[0];
+
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';
@@ -266,7 +291,7 @@
}
$EV::DIED = sub {
- warn "error in event callback: @_";
+ Carp::cluck "error in event callback: @_";
};
#############################################################################
@@ -400,24 +425,29 @@
our @SLOT_QUEUE;
our $SLOT_QUEUE;
+our $SLOT_DECAY = 0.9;
$SLOT_QUEUE->cancel if $SLOT_QUEUE;
$SLOT_QUEUE = Coro::async {
$Coro::current->desc ("timeslot manager");
my $signal = new Coro::Signal;
+ my $busy;
while () {
next_job:
+
my $avail = cf::till_tick;
- if ($avail > 0.01) {
- for (0 .. $#SLOT_QUEUE) {
- if ($SLOT_QUEUE[$_][0] < $avail) {
- my $job = splice @SLOT_QUEUE, $_, 1, ();
- $job->[2]->send;
- Coro::cede;
- goto next_job;
- }
+
+ for (0 .. $#SLOT_QUEUE) {
+ if ($SLOT_QUEUE[$_][0] <= $avail) {
+ $busy = 0;
+ my $job = splice @SLOT_QUEUE, $_, 1, ();
+ $job->[2]->send;
+ Coro::cede;
+ goto next_job;
+ } else {
+ $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
}
}
@@ -426,6 +456,7 @@
push @cf::WAIT_FOR_TICK, $signal;
$signal->wait;
} else {
+ $busy = 0;
Coro::schedule;
}
}
@@ -436,7 +467,8 @@
my ($time, $pri, $name) = @_;
- $time = $TICK * .6 if $time > $TICK * .6;
+ $time = clamp $time, 0.01, $TICK * .6;
+
my $sig = new Coro::Signal;
push @SLOT_QUEUE, [$time, $pri, $sig, $name];
@@ -1149,7 +1181,10 @@
if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
aio_chmod $fh, SAVE_MODE;
aio_write $fh, 0, (length $$rdata), $$rdata, 0;
- aio_fsync $fh if $cf::USE_FSYNC;
+ if ($cf::USE_FSYNC) {
+ aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER;
+ aio_fsync $fh;
+ }
aio_close $fh;
if (@$objs) {
@@ -1157,7 +1192,10 @@
aio_chmod $fh, SAVE_MODE;
my $data = Coro::Storable::nfreeze { version => 1, objs => $objs };
aio_write $fh, 0, (length $data), $data, 0;
- aio_fsync $fh if $cf::USE_FSYNC;
+ if ($cf::USE_FSYNC) {
+ aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER;
+ aio_fsync $fh;
+ }
aio_close $fh;
aio_rename "$filename.pst~", "$filename.pst";
}
@@ -1274,7 +1312,7 @@
use File::Glob ();
cf::player->attach (
- on_command => sub {
+ on_unknown_command => sub {
my ($pl, $name, $params) = @_;
my $cb = $COMMAND{$name}
@@ -1318,7 +1356,7 @@
sub cache_extensions {
my $grp = IO::AIO::aio_group;
- add $grp IO::AIO::aio_readdir $LIBDIR, sub {
+ add $grp IO::AIO::aio_readdirx $LIBDIR, IO::AIO::READDIR_STAT_ORDER, sub {
for (grep /\.ext$/, @{$_[0]}) {
add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data;
}
@@ -1363,38 +1401,47 @@
$todo{$base} = \%ext;
}
+ my $pass = 0;
my %done;
while (%todo) {
my $progress;
+ ++$pass;
+
+ ext:
while (my ($k, $v) = each %todo) {
for (split /,\s*/, $v->{meta}{depends}) {
- goto skip
+ next ext
unless exists $done{$_};
}
- warn "... loading '$k' into '$v->{pkg}'\n";
+ warn "... pass $pass, loading '$k' into '$v->{pkg}'\n";
- unless (eval $v->{source}) {
- my $msg = $@ ? "$v->{path}: $@\n"
- : "$v->{base}: extension inactive.\n";
-
- if (exists $v->{meta}{mandatory}) {
- warn $msg;
- cf::cleanup "mandatory extension failed to load, exiting.";
- }
-
- warn $msg;
- }
+ my $active = eval $v->{source};
+
+ if (length $@) {
+ warn "$v->{path}: $@\n";
- $done{$k} = delete $todo{$k};
- push @EXTS, $v->{pkg};
- $progress = 1;
+ cf::cleanup "mandatory extension '$k' failed to load, exiting."
+ if exists $v->{meta}{mandatory};
+ } else {
+ $done{$k} = delete $todo{$k};
+ push @EXTS, $v->{pkg};
+ $progress = 1;
+
+ warn "$v->{base}: extension inactive.\n"
+ unless $active;
+ }
}
- skip:
- die "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n"
- unless $progress;
+ unless ($progress) {
+ warn "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n";
+
+ while (my ($k, $v) = each %todo) {
+ cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
+ if exists $v->{meta}{mandatory};
+ }
+ }
}
};
}
@@ -1488,6 +1535,19 @@
}
}
+cf::player->attach (
+ on_load => sub {
+ my ($pl, $path) = @_;
+
+ # restore slots saved in save, below
+ my $slots = delete $pl->{_slots};
+
+ $pl->ob->current_weapon ($slots->[0]);
+ $pl->combat_ob ($slots->[1]);
+ $pl->ranged_ob ($slots->[2]);
+ },
+);
+
sub save($) {
my ($pl) = @_;
@@ -1503,6 +1563,9 @@
cf::get_slot 0.01;
+ # save slots, to be restored later
+ local $pl->{_slots} = [$pl->ob->current_weapon, $pl->combat_ob, $pl->ranged_ob];
+
$pl->save_pl ($path);
cf::cede_to_tick;
}
@@ -1724,7 +1787,7 @@
# mit "rum" bekleckern, nicht
$self->_create_random_map (
$rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
- $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
+ $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, $rmp->{miningstyle},
$rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
$rmp->{exit_on_final_map},
$rmp->{xsize}, $rmp->{ysize},
@@ -1980,8 +2043,8 @@
}
}
-sub pre_load { }
-sub post_load { }
+sub pre_load { }
+#sub post_load { } # XS
sub load {
my ($self) = @_;
@@ -2048,6 +2111,9 @@
$self->post_load;
}
+# customize the map for a given player, i.e.
+# return the _real_ map. used by e.g. per-player
+# maps to change the path to ~playername/mappath
sub customise_for {
my ($self, $ob) = @_;
@@ -2211,7 +2277,7 @@
return if $self->players;
- warn "resetting map ", $self->path;
+ warn "resetting map ", $self->path, "\n";
$self->in_memory (cf::MAP_SWAPPED);
@@ -2312,6 +2378,38 @@
]
}
+=item cf::map::static_maps
+
+Returns an arrayref if paths of all static maps (all preinstalled F<.map>
+file in the shared directory excluding F and F). May
+block.
+
+=cut
+
+sub static_maps() {
+ my @dirs = "";
+ my @maps;
+
+ while (@dirs) {
+ my $dir = shift @dirs;
+
+ next if $dir eq "/styles" || $dir eq "/editor";
+
+ my ($dirs, $files) = Coro::AIO::aio_scandir "$MAPDIR$dir", 2
+ or return;
+
+ for (@$files) {
+ s/\.map$// or next;
+ utf8::decode $_;
+ push @maps, "$dir/$_";
+ }
+
+ push @dirs, map "$dir/$_", @$dirs;
+ }
+
+ \@maps
+}
+
=back
=head3 cf::object
@@ -2386,7 +2484,7 @@
id => "say",
title => "Map",
reply => "say ",
- tooltip => "Things said to and replied from npcs near you and other players on the same map only.",
+ tooltip => "Things said to and replied from NPCs near you and other players on the same map only.",
};
our $CHAT_CHANNEL = {
@@ -2516,17 +2614,18 @@
# use -1 or undef as default coordinates, not 0, 0
($x, $y) = ($map->enter_x, $map->enter_y)
- if $x <=0 && $y <= 0;
+ if $x <= 0 && $y <= 0;
$map->load;
$map->load_neighbours;
return unless $self->contr->active;
- $self->flag (cf::FLAG_DEBUG, 0);#d# temp
- $self->activate_recursive;
local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
$self->enter_map ($map, $x, $y);
+
+ # only activate afterwards, to support waiting in hooks
+ $self->activate_recursive;
}
=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
@@ -2724,6 +2823,31 @@
$self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
}
+=item $client->send_big_packet ($pkt)
+
+Like C, but tries to compress large packets, and fragments
+them as required.
+
+=cut
+
+our $MAXFRAGSIZE = cf::MAXSOCKBUF - 64;
+
+sub cf::client::send_big_packet {
+ my ($self, $pkt) = @_;
+
+ # try lzf for large packets
+ $pkt = "lzf " . Compress::LZF::compress $pkt
+ if 1024 <= length $pkt and $self->{can_lzf};
+
+ # split very large packets
+ if ($MAXFRAGSIZE < length $pkt and $self->{can_lzf}) {
+ $self->send_packet ("frag $_") for unpack "(a$MAXFRAGSIZE)*", $pkt;
+ $pkt = "frag";
+ }
+
+ $self->send_packet ($pkt);
+}
+
=item $client->send_msg ($channel, $msg, $color, [extra...])
Send a drawinfo or msg packet to the client, formatting the msg for the
@@ -2735,6 +2859,12 @@
# non-persistent channels (usually the info channel)
our %CHANNEL = (
+ "c/motd" => {
+ id => "infobox",
+ title => "MOTD",
+ reply => undef,
+ tooltip => "The message of the day",
+ },
"c/identify" => {
id => "infobox",
title => "Identify",
@@ -2747,6 +2877,12 @@
reply => undef,
tooltip => "Signs and other items you examined",
},
+ "c/shopinfo" => {
+ id => "infobox",
+ title => "Shop Info",
+ reply => undef,
+ tooltip => "What your bargaining skill tells you about the shop",
+ },
"c/book" => {
id => "infobox",
title => "Book",
@@ -2783,6 +2919,12 @@
reply => undef,
tooltip => "Shows your experience per skill and item power",
},
+ "c/shopitems" => {
+ id => "infobox",
+ title => "Shop Items",
+ reply => undef,
+ tooltip => "Shows the items currently for sale in this shop",
+ },
"c/resistances" => {
id => "infobox",
title => "Resistances",
@@ -2795,6 +2937,12 @@
reply => undef,
tooltip => "Shows information abotu your pets/a specific pet",
},
+ "c/perceiveself" => {
+ id => "infobox",
+ title => "Perceive Self",
+ reply => undef,
+ tooltip => "You gained detailed knowledge about yourself",
+ },
"c/uptime" => {
id => "infobox",
title => "Uptime",
@@ -2859,17 +3007,7 @@
[$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
);
- # try lzf for large packets
- $pkt = "lzf " . Compress::LZF::compress $pkt
- if 1024 <= length $pkt and $self->{can_lzf};
-
- # split very large packets
- if (8192 < length $pkt and $self->{can_lzf}) {
- $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
- $pkt = "frag";
- }
-
- $self->send_packet ($pkt);
+ $self->send_big_packet ($pkt);
}
=item $client->ext_msg ($type, @msg)
@@ -2882,10 +3020,10 @@
my ($self, $type, @msg) = @_;
if ($self->extcmd == 2) {
- $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
} elsif ($self->extcmd == 1) { # TODO: remove
push @msg, msgtype => "event_$type";
- $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
}
}
@@ -2899,11 +3037,11 @@
my ($self, $id, @msg) = @_;
if ($self->extcmd == 2) {
- $self->send_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
} elsif ($self->extcmd == 1) {
#TODO: version 1, remove
unshift @msg, msgtype => "reply", msgid => $id;
- $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
}
}
@@ -3014,7 +3152,7 @@
}
cf::client->attach (
- on_destroy => sub {
+ on_client_destroy => sub {
my ($ns) = @_;
$_->cancel for values %{ (delete $ns->{_coro}) || {} };
@@ -3040,7 +3178,7 @@
$SIG{FPE} = 'IGNORE';
$safe->permit_only (Opcode::opset qw(
- :base_core :base_mem :base_orig :base_math
+ :base_core :base_mem :base_orig :base_math :base_loop
grepstart grepwhile mapstart mapwhile
sort time
));
@@ -3054,6 +3192,7 @@
cf::object
contr pay_amount pay_player map x y force_find force_add destroy
insert remove name archname title slaying race decrease split
+ value
cf::object::player
player
@@ -3069,9 +3208,9 @@
for (
["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
insert remove inv nrof name archname title slaying race
- decrease split destroy change_exp)],
+ decrease split destroy change_exp value msg lore send_msg)],
["cf::object::player" => qw(player)],
- ["cf::player" => qw(peaceful)],
+ ["cf::player" => qw(peaceful send_msg)],
["cf::map" => qw(trigger)],
) {
no strict 'refs';
@@ -3099,8 +3238,10 @@
$qcode =~ s/"/‟/g; # not allowed in #line filenames
$qcode =~ s/\n/\\n/g;
+ %vars = (_dummy => 0) unless %vars;
+
+ my @res;
local $_;
- local @safe::cf::_safe_eval_args = values %vars;
my $eval =
"do {\n"
@@ -3110,9 +3251,15 @@
. "\n}"
;
- sub_generation_inc;
- my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval);
- sub_generation_inc;
+ if ($CFG{safe_eval}) {
+ sub_generation_inc;
+ local @safe::cf::_safe_eval_args = values %vars;
+ @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval);
+ sub_generation_inc;
+ } else {
+ local @cf::_safe_eval_args = values %vars;
+ @res = wantarray ? eval eval : scalar eval $eval;
+ }
if ($@) {
warn "$@";
@@ -3141,8 +3288,8 @@
sub register_script_function {
my ($fun, $cb) = @_;
- no strict 'refs';
- *{"safe::$fun"} = $safe_hole->wrap ($cb);
+ $fun = "safe::$fun" if $CFG{safe_eval};
+ *$fun = $safe_hole->wrap ($cb);
}
=back
@@ -3173,9 +3320,11 @@
or cf::cleanup "$path: version mismatch, cannot proceed.";
# patch in the exptable
+ my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
$facedata->{resource}{"res/exp_table"} = {
type => FT_RSRC,
- data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]),
+ data => $exp_table,
+ hash => (Digest::MD5::md5 $exp_table),
};
cf::cede_to_tick;
@@ -3187,8 +3336,8 @@
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};
- cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
+ cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
+ cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
cf::cede_to_tick;
}
@@ -3222,29 +3371,13 @@
}
{
- # TODO: for gcfclient pleasure, we should give resources
- # that gcfclient doesn't grok a >10000 face index.
my $res = $facedata->{resource};
while (my ($name, $info) = each %$res) {
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} || {} },
- });
-
- $data = pack "(w/a*)*", $meta, $info->{data};
- } else {
- $data = $info->{data};
- }
- cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
+ cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
cf::face::set_type $idx, $info->{type};
} else {
$RESOURCE{$name} = $info;
@@ -3338,11 +3471,13 @@
}
sub reload_config {
+ warn "reloading config file...\n";
+
open my $fh, "<:utf8", "$CONFDIR/config"
or return;
local $/;
- *CFG = YAML::Load <$fh>;
+ *CFG = YAML::XS::Load scalar <$fh>;
$EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
@@ -3356,6 +3491,8 @@
};
warn $@ if $@;
}
+
+ warn "finished reloading resource files\n";
}
sub pidfile() {
@@ -3377,6 +3514,15 @@
print $fh $$;
}
+sub main_loop {
+ warn "EV::loop starting\n";
+ if (1) {
+ EV::loop;
+ }
+ warn "EV::loop returned\n";
+ goto &main_loop unless $REALLY_UNLOOP;
+}
+
sub main {
cf::init_globals; # initialise logging
@@ -3404,15 +3550,15 @@
evthread_start IO::AIO::poll_fileno;
cf::sync_job {
+ cf::load_settings;
+ cf::load_materials;
+
reload_resources;
reload_config;
db_init;
- cf::load_settings;
- cf::load_materials;
cf::init_uuid;
cf::init_signals;
- cf::init_commands;
cf::init_skills;
cf::init_beforeplay;
@@ -3424,12 +3570,13 @@
utime time, time, $RUNTIMEFILE;
# no (long-running) fork's whatsoever before this point(!)
+ use POSIX ();
POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
(pop @POST_INIT)->(0) while @POST_INIT;
};
- EV::loop;
+ main_loop;
}
#############################################################################
@@ -3446,6 +3593,8 @@
}
sub write_runtime_sync {
+ my $t0 = EV::time;
+
# first touch the runtime file to show we are still running:
# the fsync below can take a very very long time.
@@ -3453,7 +3602,7 @@
my $guard = cf::lock_acquire "write_runtime";
- my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT, 0644
+ my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT | O_TRUNC, 0644
or return;
my $value = $cf::RUNTIME + 90 + 10;
@@ -3476,7 +3625,7 @@
aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE
and return;
- warn "runtime file written.\n";
+ warn sprintf "runtime file written (%gs).\n", EV::time - $t0;
1
}
@@ -3695,7 +3844,7 @@
warn "unloading cf.pm \"a bit\"";
delete $INC{"cf.pm"};
- delete $INC{"cf/pod.pm"};
+ delete $INC{"cf/$_.pm"} for @EXTRA_MODULES;
# don't, removes xs symbols, too,
# and global variables created in xs
@@ -3705,7 +3854,7 @@
warn "reloading cf.pm";
require cf;
- cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
+ cf::_connect_to_perl_1;
warn "loading config and database again";
cf::reload_config;
@@ -3777,7 +3926,7 @@
our @WAIT_FOR_TICK_BEGIN;
sub wait_for_tick {
- return if tick_inhibit || $Coro::current == $Coro::main;
+ return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK, $signal;
@@ -3785,7 +3934,7 @@
}
sub wait_for_tick_begin {
- return if tick_inhibit || $Coro::current == $Coro::main;
+ return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK_BEGIN, $signal;
@@ -3801,6 +3950,8 @@
cf::server_tick; # one server iteration
+ #for(1..3e6){} EV::now_update; $NOW=EV::now; # generate load #d#
+
if ($NOW >= $NEXT_RUNTIME_WRITE) {
$NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
Coro::async_pool {
@@ -3832,7 +3983,7 @@
{
# configure BDB
- BDB::min_parallel 8;
+ BDB::min_parallel 16;
BDB::max_poll_reqs $TICK * 0.1;
$AnyEvent::BDB::WATCHER->priority (1);
@@ -3922,7 +4073,8 @@
}
# load additional modules
-use cf::pod;
+require "cf/$_.pm" for @EXTRA_MODULES;
+cf::_connect_to_perl_2;
END { cf::emergency_save }