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.529 by root, Wed Apr 28 11:28:22 2010 UTC vs.
Revision 1.586 by root, Wed Oct 31 15:02:02 2012 UTC

1# 1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG. 2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3# 3#
4# Copyright (©) 2006,2007,2008,2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 4# Copyright (©) 2006,2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5# 5#
6# Deliantra is free software: you can redistribute it and/or modify it under 6# Deliantra is free software: you can redistribute it and/or modify it under
7# the terms of the Affero GNU General Public License as published by the 7# the terms of the Affero GNU General Public License as published by the
8# Free Software Foundation, either version 3 of the License, or (at your 8# Free Software Foundation, either version 3 of the License, or (at your
9# option) any later version. 9# option) any later version.
10# 10#
11# This program is distributed in the hope that it will be useful, 11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details. 14# GNU General Public License for more details.
15# 15#
16# You should have received a copy of the Affero GNU General Public License 16# You should have received a copy of the Affero GNU General Public License
17# and the GNU General Public License along with this program. If not, see 17# and the GNU General Public License along with this program. If not, see
18# <http://www.gnu.org/licenses/>. 18# <http://www.gnu.org/licenses/>.
19# 19#
20# The authors can be reached via e-mail to <support@deliantra.net> 20# The authors can be reached via e-mail to <support@deliantra.net>
21# 21#
22 22
23package cf; 23package cf;
24 24
25use 5.10.0; 25use common::sense;
26use utf8;
27use strict qw(vars subs);
28 26
29use Symbol; 27use Symbol;
30use List::Util; 28use List::Util;
31use Socket; 29use Socket;
32use EV; 30use EV;
… …
78# strictly for debugging 76# strictly for debugging
79$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" }; 77$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
80 78
81sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 79sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
82 80
81our @ORIG_INC;
82
83our %COMMAND = (); 83our %COMMAND = ();
84our %COMMAND_TIME = (); 84our %COMMAND_TIME = ();
85 85
86our @EXTS = (); # list of extension package names 86our @EXTS = (); # list of extension package names
87our %EXTCMD = (); 87our %EXTCMD = ();
… …
93our @EVENT; 93our @EVENT;
94our @REFLECT; # set by XS 94our @REFLECT; # set by XS
95our %REFLECT; # set by us 95our %REFLECT; # set by us
96 96
97our $CONFDIR = confdir; 97our $CONFDIR = confdir;
98
98our $DATADIR = datadir; 99our $DATADIR = datadir;
99our $LIBDIR = "$DATADIR/ext"; 100our $LIBDIR = "$DATADIR/ext";
100our $PODDIR = "$DATADIR/pod"; 101our $PODDIR = "$DATADIR/pod";
101our $MAPDIR = "$DATADIR/" . mapdir; 102our $MAPDIR = "$DATADIR/" . mapdir;
103
102our $LOCALDIR = localdir; 104our $LOCALDIR = localdir;
103our $TMPDIR = "$LOCALDIR/" . tmpdir; 105our $TMPDIR = "$LOCALDIR/" . tmpdir;
104our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 106our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
105our $PLAYERDIR = "$LOCALDIR/" . playerdir; 107our $PLAYERDIR = "$LOCALDIR/" . playerdir;
106our $RANDOMDIR = "$LOCALDIR/random"; 108our $RANDOMDIR = "$LOCALDIR/random";
107our $BDBDIR = "$LOCALDIR/db"; 109our $BDBDIR = "$LOCALDIR/db";
108our $PIDFILE = "$LOCALDIR/pid"; 110our $PIDFILE = "$LOCALDIR/pid";
109our $RUNTIMEFILE = "$LOCALDIR/runtime"; 111our $RUNTIMEFILE = "$LOCALDIR/runtime";
110 112
111our %RESOURCE; 113#our %RESOURCE; # unused
112 114
113our $OUTPUT_RATE_MIN = 3000; 115our $OUTPUT_RATE_MIN = 3000;
114our $OUTPUT_RATE_MAX = 1000000; 116our $OUTPUT_RATE_MAX = 1000000;
115 117
116our $MAX_LINKS = 32; # how many chained exits to follow 118our $MAX_LINKS = 32; # how many chained exits to follow
… …
124our $BDB_DEADLOCK_WATCHER; 126our $BDB_DEADLOCK_WATCHER;
125our $BDB_CHECKPOINT_WATCHER; 127our $BDB_CHECKPOINT_WATCHER;
126our $BDB_TRICKLE_WATCHER; 128our $BDB_TRICKLE_WATCHER;
127our $DB_ENV; 129our $DB_ENV;
128 130
129our @EXTRA_MODULES = qw(pod match mapscript); 131our @EXTRA_MODULES = qw(pod match mapscript incloader);
130 132
131our %CFG; 133our %CFG;
134our %EXT_CFG; # cfgkeyname => [var-ref, defaultvalue]
132 135
133our $UPTIME; $UPTIME ||= time; 136our $UPTIME; $UPTIME ||= time;
134our $RUNTIME; 137our $RUNTIME = 0;
138our $SERVER_TICK = 0;
135our $NOW; 139our $NOW;
136 140
137our (%PLAYER, %PLAYER_LOADING); # all users 141our (%PLAYER, %PLAYER_LOADING); # all users
138our (%MAP, %MAP_LOADING ); # all maps 142our (%MAP, %MAP_LOADING ); # all maps
139our $LINK_MAP; # the special {link} map, which is always available 143our $LINK_MAP; # the special {link} map, which is always available
… …
148 152
149our @POST_INIT; 153our @POST_INIT;
150 154
151our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow) 155our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow)
152our $REALLY_UNLOOP; # never set to true, please :) 156our $REALLY_UNLOOP; # never set to true, please :)
157
158our $WAIT_FOR_TICK = new Coro::Signal;
159our @WAIT_FOR_TICK_BEGIN;
153 160
154binmode STDOUT; 161binmode STDOUT;
155binmode STDERR; 162binmode STDERR;
156 163
157# read virtual server time, if available 164# read virtual server time, if available
… …
191 198
192=over 4 199=over 4
193 200
194=item $cf::UPTIME 201=item $cf::UPTIME
195 202
196The timestamp of the server start (so not actually an uptime). 203The timestamp of the server start (so not actually an "uptime").
204
205=item $cf::SERVER_TICK
206
207An unsigned integer that starts at zero when the server is started and is
208incremented on every tick.
209
210=item $cf::NOW
211
212The (real) time of the last (current) server tick - updated before and
213after tick processing, so this is useful only as a rough "what time is it
214now" estimate.
215
216=item $cf::TICK
217
218The interval between each server tick, in seconds.
197 219
198=item $cf::RUNTIME 220=item $cf::RUNTIME
199 221
200The time this server has run, starts at 0 and is increased by $cf::TICK on 222The time this server has run, starts at 0 and is increased by $cf::TICK on
201every server tick. 223every server tick.
… …
207Various directories - "/etc", read-only install directory, perl-library 229Various directories - "/etc", read-only install directory, perl-library
208directory, pod-directory, read-only maps directory, "/var", "/var/tmp", 230directory, pod-directory, read-only maps directory, "/var", "/var/tmp",
209unique-items directory, player file directory, random maps directory and 231unique-items directory, player file directory, random maps directory and
210database environment. 232database environment.
211 233
212=item $cf::NOW
213
214The time of the last (current) server tick.
215
216=item $cf::TICK
217
218The interval between server ticks, in seconds.
219
220=item $cf::LOADAVG 234=item $cf::LOADAVG
221 235
222The current CPU load on the server (alpha-smoothed), as a value between 0 236The current CPU load on the server (alpha-smoothed), as a value between 0
223(none) and 1 (overloaded), indicating how much time is spent on processing 237(none) and 1 (overloaded), indicating how much time is spent on processing
224objects per tick. Healthy values are < 0.5. 238objects per tick. Healthy values are < 0.5.
… …
233from wherever your confdir points to. 247from wherever your confdir points to.
234 248
235=item cf::wait_for_tick, cf::wait_for_tick_begin 249=item cf::wait_for_tick, cf::wait_for_tick_begin
236 250
237These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 251These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only
238returns directly I<after> the tick processing (and consequently, can only wake one process 252returns directly I<after> the tick processing (and consequently, can only wake one thread
239per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 253per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
254
255Note that cf::Wait_for_tick will immediately return when the server is not
256ticking, making it suitable for small pauses in threads that need to run
257when the server is paused. If that is not applicable (i.e. you I<really>
258want to wait, use C<$cf::WAIT_FOR_TICK>).
259
260=item $cf::WAIT_FOR_TICK
261
262Note that C<cf::wait_for_tick> is probably the correct thing to use. This
263variable contains a L<Coro::Signal> that is broadcats after every server
264tick. Calling C<< ->wait >> on it will suspend the caller until after the
265next server tick.
266
267=cut
268
269sub wait_for_tick();
270sub wait_for_tick_begin();
240 271
241=item @cf::INVOKE_RESULTS 272=item @cf::INVOKE_RESULTS
242 273
243This array contains the results of the last C<invoke ()> call. When 274This array contains the results of the last C<invoke ()> call. When
244C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of 275C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
… …
252 283
253=back 284=back
254 285
255=cut 286=cut
256 287
288sub error(@) { LOG llevError, join "", @_ }
289sub warn (@) { LOG llevWarn , join "", @_ }
290sub info (@) { LOG llevInfo , join "", @_ }
291sub debug(@) { LOG llevDebug, join "", @_ }
292sub trace(@) { LOG llevTrace, join "", @_ }
293
257$Coro::State::WARNHOOK = sub { 294$Coro::State::WARNHOOK = sub {
258 my $msg = join "", @_; 295 my $msg = join "", @_;
259 296
260 $msg .= "\n" 297 $msg .= "\n"
261 unless $msg =~ /\n$/; 298 unless $msg =~ /\n$/;
262 299
263 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 300 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
264 301
265 LOG llevError, $msg; 302 LOG llevWarn, $msg;
266}; 303};
267 304
268$Coro::State::DIEHOOK = sub { 305$Coro::State::DIEHOOK = sub {
269 return unless $^S eq 0; # "eq", not "==" 306 return unless $^S eq 0; # "eq", not "=="
270 307
271 warn Carp::longmess $_[0]; 308 error Carp::longmess $_[0];
272 309
273 if (in_main) {#d# 310 if (in_main) {#d#
274 warn "DIEHOOK called in main context, Coro bug?\n";#d# 311 error "DIEHOOK called in main context, Coro bug?\n";#d#
275 return;#d# 312 return;#d#
276 }#d# 313 }#d#
277 314
278 # kill coroutine otherwise 315 # kill coroutine otherwise
279 Coro::terminate 316 Coro::terminate
… …
299)) { 336)) {
300 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 337 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
301} 338}
302 339
303$EV::DIED = sub { 340$EV::DIED = sub {
304 Carp::cluck "error in event callback: @_"; 341 warn "error in event callback: $@";
305}; 342};
343
344#############################################################################
345
346sub fork_call(&@);
347sub get_slot($;$$);
306 348
307############################################################################# 349#############################################################################
308 350
309=head2 UTILITY FUNCTIONS 351=head2 UTILITY FUNCTIONS
310 352
… …
331 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; 373 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
332 $d 374 $d
333 } || "[unable to dump $_[0]: '$@']"; 375 } || "[unable to dump $_[0]: '$@']";
334} 376}
335 377
378=item $scalar = cf::load_file $path
379
380Loads the given file from path and returns its contents. Croaks on error
381and can block.
382
383=cut
384
385sub load_file($) {
386 0 <= aio_load $_[0], my $data
387 or Carp::croak "$_[0]: $!";
388
389 $data
390}
391
392=item $success = cf::replace_file $path, $data, $sync
393
394Atomically replaces the file at the given $path with new $data, and
395optionally $sync the data to disk before replacing the file.
396
397=cut
398
399sub replace_file($$;$) {
400 my ($path, $data, $sync) = @_;
401
402 my $lock = cf::lock_acquire ("replace_file:$path");
403
404 my $fh = aio_open "$path~", Fcntl::O_WRONLY | Fcntl::O_CREAT | Fcntl::O_TRUNC, 0644
405 or return;
406
407 $data = $data->() if ref $data;
408
409 length $data == aio_write $fh, 0, (length $data), $data, 0
410 or return;
411
412 !$sync
413 or !aio_fsync $fh
414 or return;
415
416 aio_close $fh
417 and return;
418
419 aio_rename "$path~", $path
420 and return;
421
422 if ($sync) {
423 $path =~ s%/[^/]*$%%;
424 aio_pathsync $path;
425 }
426
427 1
428}
429
336=item $ref = cf::decode_json $json 430=item $ref = cf::decode_json $json
337 431
338Converts a JSON string into the corresponding perl data structure. 432Converts a JSON string into the corresponding perl data structure.
339 433
340=item $json = cf::encode_json $ref 434=item $json = cf::encode_json $ref
… …
346our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 440our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
347 441
348sub encode_json($) { $json_coder->encode ($_[0]) } 442sub encode_json($) { $json_coder->encode ($_[0]) }
349sub decode_json($) { $json_coder->decode ($_[0]) } 443sub decode_json($) { $json_coder->decode ($_[0]) }
350 444
445=item $ref = cf::decode_storable $scalar
446
447Same as Coro::Storable::thaw, so blocks.
448
449=cut
450
451BEGIN { *decode_storable = \&Coro::Storable::thaw }
452
453=item $ref = cf::decode_yaml $scalar
454
455Same as YAML::XS::Load, but doesn't leak, because it forks (and thus blocks).
456
457=cut
458
459sub decode_yaml($) {
460 fork_call { YAML::XS::Load $_[0] } @_
461}
462
463=item $scalar = cf::unlzf $scalar
464
465Same as Compress::LZF::compress, but takes server ticks into account, so
466blocks.
467
468=cut
469
470sub unlzf($) {
471 # we assume 100mb/s minimum decompression speed (noncompressible data on a ~2ghz machine)
472 cf::get_slot +(length $_[0]) / 100_000_000, 0, "unlzf";
473 Compress::LZF::decompress $_[0]
474}
475
351=item cf::post_init { BLOCK } 476=item cf::post_init { BLOCK }
352 477
353Execute the given codeblock, I<after> all extensions have been (re-)loaded, 478Execute the given codeblock, I<after> all extensions have been (re-)loaded,
354but I<before> the server starts ticking again. 479but I<before> the server starts ticking again.
355 480
356The cdoeblock will have a single boolean argument to indicate whether this 481The codeblock will have a single boolean argument to indicate whether this
357is a reload or not. 482is a reload or not.
358 483
359=cut 484=cut
360 485
361sub post_init(&) { 486sub post_init(&) {
362 push @POST_INIT, shift; 487 push @POST_INIT, shift;
488}
489
490sub _post_init {
491 trace "running post_init jobs";
492
493 # run them in parallel...
494
495 my @join;
496
497 while () {
498 push @join, map &Coro::async ($_, 0), @POST_INIT;
499 @POST_INIT = ();
500
501 @join or last;
502
503 (pop @join)->join;
504 }
363} 505}
364 506
365=item cf::lock_wait $string 507=item cf::lock_wait $string
366 508
367Wait until the given lock is available. See cf::lock_acquire. 509Wait until the given lock is available. See cf::lock_acquire.
… …
420 EV::periodic $start, $interval, 0, $cb 562 EV::periodic $start, $interval, 0, $cb
421} 563}
422 564
423=item cf::get_slot $time[, $priority[, $name]] 565=item cf::get_slot $time[, $priority[, $name]]
424 566
425Allocate $time seconds of blocking CPU time at priority C<$priority>: 567Allocate $time seconds of blocking CPU time at priority C<$priority>
426This call blocks and returns only when you have at least C<$time> seconds 568(default: 0): This call blocks and returns only when you have at least
427of cpu time till the next tick. The slot is only valid till the next cede. 569C<$time> seconds of cpu time till the next tick. The slot is only valid
570till the next cede.
571
572Background jobs should use a priority les than zero, interactive jobs
573should use 100 or more.
428 574
429The optional C<$name> can be used to identify the job to run. It might be 575The optional C<$name> can be used to identify the job to run. It might be
430used for statistical purposes and should identify the same time-class. 576used for statistical purposes and should identify the same time-class.
431 577
432Useful for short background jobs. 578Useful for short background jobs.
… …
461 } 607 }
462 } 608 }
463 609
464 if (@SLOT_QUEUE) { 610 if (@SLOT_QUEUE) {
465 # we do not use wait_for_tick() as it returns immediately when tick is inactive 611 # we do not use wait_for_tick() as it returns immediately when tick is inactive
466 push @cf::WAIT_FOR_TICK, $signal; 612 $WAIT_FOR_TICK->wait;
467 $signal->wait;
468 } else { 613 } else {
469 $busy = 0; 614 $busy = 0;
470 Coro::schedule; 615 Coro::schedule;
471 } 616 }
472 } 617 }
… …
512=cut 657=cut
513 658
514sub sync_job(&) { 659sub sync_job(&) {
515 my ($job) = @_; 660 my ($job) = @_;
516 661
517 if ($Coro::current == $Coro::main) { 662 if (in_main) {
518 my $time = AE::time; 663 my $time = AE::time;
519 664
520 # this is the main coro, too bad, we have to block 665 # this is the main coro, too bad, we have to block
521 # till the operation succeeds, freezing the server :/ 666 # till the operation succeeds, freezing the server :/
522 667
523 LOG llevError, Carp::longmess "sync job";#d# 668 #LOG llevError, Carp::longmess "sync job";#d#
524 669
525 my $freeze_guard = freeze_mainloop; 670 my $freeze_guard = freeze_mainloop;
526 671
527 my $busy = 1; 672 my $busy = 1;
528 my @res; 673 my @res;
529 674
530 (async { 675 (async {
531 $Coro::current->desc ("sync job coro"); 676 $Coro::current->desc ("sync job coro");
532 @res = eval { $job->() }; 677 @res = eval { $job->() };
533 warn $@ if $@; 678 error $@ if $@;
534 undef $busy; 679 undef $busy;
535 })->prio (Coro::PRIO_MAX); 680 })->prio (Coro::PRIO_MAX);
536 681
537 while ($busy) { 682 while ($busy) {
538 if (Coro::nready) { 683 if (Coro::nready) {
… …
572 $EXT_CORO{$coro+0} = $coro; 717 $EXT_CORO{$coro+0} = $coro;
573 718
574 $coro 719 $coro
575} 720}
576 721
577=item fork_call { }, $args 722=item fork_call { }, @args
578 723
579Executes the given code block with the given arguments in a seperate 724Executes the given code block with the given arguments in a seperate
580process, returning the results. Everything must be serialisable with 725process, returning the results. Everything must be serialisable with
581Coro::Storable. May, of course, block. Note that the executed sub may 726Coro::Storable. May, of course, block. Note that the executed sub may
582never block itself or use any form of event handling. 727never block itself or use any form of event handling.
583 728
584=cut 729=cut
585 730
731sub post_fork {
732 reset_signals;
733}
734
586sub fork_call(&@) { 735sub fork_call(&@) {
587 my ($cb, @args) = @_; 736 my ($cb, @args) = @_;
588 737
589 # we seemingly have to make a local copy of the whole thing, 738 # we seemingly have to make a local copy of the whole thing,
590 # otherwise perl prematurely frees the stuff :/ 739 # otherwise perl prematurely frees the stuff :/
591 # TODO: investigate and fix (likely this will be rather laborious) 740 # TODO: investigate and fix (likely this will be rather laborious)
592 741
593 my @res = Coro::Util::fork_eval { 742 my @res = Coro::Util::fork_eval {
594 reset_signals; 743 cf::post_fork;
595 &$cb 744 &$cb
596 }, @args; 745 } @args;
597 746
598 wantarray ? @res : $res[-1] 747 wantarray ? @res : $res[-1]
599} 748}
600 749
601sub objinfo { 750sub objinfo {
… …
651within each server. 800within each server.
652 801
653=cut 802=cut
654 803
655sub db_table($) { 804sub db_table($) {
805 cf::error "db_get called from main context"
806 if $Coro::current == $Coro::main;
807
656 my ($name) = @_; 808 my ($name) = @_;
657 my $db = BDB::db_create $DB_ENV; 809 my $db = BDB::db_create $DB_ENV;
658 810
659 eval { 811 eval {
660 $db->set_flags (BDB::CHKSUM); 812 $db->set_flags (BDB::CHKSUM);
… …
670} 822}
671 823
672our $DB; 824our $DB;
673 825
674sub db_init { 826sub db_init {
675 cf::sync_job {
676 $DB ||= db_table "db"; 827 $DB ||= db_table "db";
677 };
678} 828}
679 829
680sub db_get($$) { 830sub db_get($$) {
681 my $key = "$_[0]/$_[1]"; 831 my $key = "$_[0]/$_[1]";
682 832
683 cf::sync_job { 833 cf::error "db_get called from main context"
834 if $Coro::current == $Coro::main;
835
684 BDB::db_get $DB, undef, $key, my $data; 836 BDB::db_get $DB, undef, $key, my $data;
685 837
686 $! ? () 838 $! ? ()
687 : $data 839 : $data
688 }
689} 840}
690 841
691sub db_put($$$) { 842sub db_put($$$) {
692 BDB::dbreq_pri 4; 843 BDB::dbreq_pri 4;
693 BDB::db_put $DB, undef, "$_[0]/$_[1]", $_[2], 0, sub { }; 844 BDB::db_put $DB, undef, "$_[0]/$_[1]", $_[2], 0, sub { };
… …
721 872
722 my @data; 873 my @data;
723 my $md5; 874 my $md5;
724 875
725 for (0 .. $#$src) { 876 for (0 .. $#$src) {
726 0 <= aio_load $src->[$_], $data[$_] 877 $data[$_] = load_file $src->[$_];
727 or Carp::croak "$src->[$_]: $!";
728 } 878 }
729 879
730 # if processing is expensive, check 880 # if processing is expensive, check
731 # checksum first 881 # checksum first
732 if (1) { 882 if (1) {
… …
749 899
750 my $t1 = Time::HiRes::time; 900 my $t1 = Time::HiRes::time;
751 my $data = $process->(\@data); 901 my $data = $process->(\@data);
752 my $t2 = Time::HiRes::time; 902 my $t2 = Time::HiRes::time;
753 903
754 warn "cache: '$id' processed in ", $t2 - $t1, "s\n"; 904 info "cache: '$id' processed in ", $t2 - $t1, "s\n";
755 905
756 db_put cache => "$id/data", $data; 906 db_put cache => "$id/data", $data;
757 db_put cache => "$id/md5" , $md5; 907 db_put cache => "$id/md5" , $md5;
758 db_put cache => "$id/meta", $meta; 908 db_put cache => "$id/meta", $meta;
759 909
… …
769 919
770=cut 920=cut
771 921
772sub datalog($@) { 922sub datalog($@) {
773 my ($type, %kv) = @_; 923 my ($type, %kv) = @_;
774 warn "DATALOG ", JSON::XS->new->ascii->encode ({ %kv, type => $type }); 924 info "DATALOG ", JSON::XS->new->ascii->encode ({ %kv, type => $type });
775} 925}
776 926
777=back 927=back
778 928
779=cut 929=cut
… …
974 1124
975 } elsif (exists $cb_id{$type}) { 1125 } elsif (exists $cb_id{$type}) {
976 _attach_cb $registry, $cb_id{$type}, $prio, shift @arg; 1126 _attach_cb $registry, $cb_id{$type}, $prio, shift @arg;
977 1127
978 } elsif (ref $type) { 1128 } elsif (ref $type) {
979 warn "attaching objects not supported, ignoring.\n"; 1129 error "attaching objects not supported, ignoring.\n";
980 1130
981 } else { 1131 } else {
982 shift @arg; 1132 shift @arg;
983 warn "attach argument '$type' not supported, ignoring.\n"; 1133 error "attach argument '$type' not supported, ignoring.\n";
984 } 1134 }
985 } 1135 }
986} 1136}
987 1137
988sub _object_attach { 1138sub _object_attach {
… …
998 _attach $registry, $klass, @attach; 1148 _attach $registry, $klass, @attach;
999 } 1149 }
1000 1150
1001 $obj->{$name} = \%arg; 1151 $obj->{$name} = \%arg;
1002 } else { 1152 } else {
1003 warn "object uses attachment '$name' which is not available, postponing.\n"; 1153 info "object uses attachment '$name' which is not available, postponing.\n";
1004 } 1154 }
1005 1155
1006 $obj->{_attachment}{$name} = undef; 1156 $obj->{_attachment}{$name} = undef;
1007} 1157}
1008 1158
… …
1067 1217
1068 for (@$callbacks) { 1218 for (@$callbacks) {
1069 eval { &{$_->[1]} }; 1219 eval { &{$_->[1]} };
1070 1220
1071 if ($@) { 1221 if ($@) {
1072 warn "$@";
1073 warn "... while processing $EVENT[$event][0](@_) event, skipping processing altogether.\n"; 1222 error "$@", "... while processing $EVENT[$event][0](@_) event, skipping processing altogether.\n";
1074 override; 1223 override;
1075 } 1224 }
1076 1225
1077 return 1 if $override; 1226 return 1 if $override;
1078 } 1227 }
… …
1157 for (@$attach) { 1306 for (@$attach) {
1158 my ($klass, @attach) = @$_; 1307 my ($klass, @attach) = @$_;
1159 _attach $registry, $klass, @attach; 1308 _attach $registry, $klass, @attach;
1160 } 1309 }
1161 } else { 1310 } else {
1162 warn "object uses attachment '$name' that is not available, postponing.\n"; 1311 info "object uses attachment '$name' that is not available, postponing.\n";
1163 } 1312 }
1164 } 1313 }
1165} 1314}
1166 1315
1167cf::attachable->attach ( 1316cf::attachable->attach (
… …
1194 my ($filename, $rdata, $objs) = @_; 1343 my ($filename, $rdata, $objs) = @_;
1195 1344
1196 sync_job { 1345 sync_job {
1197 if (length $$rdata) { 1346 if (length $$rdata) {
1198 utf8::decode (my $decname = $filename); 1347 utf8::decode (my $decname = $filename);
1199 warn sprintf "saving %s (%d,%d)\n", 1348 trace sprintf "saving %s (%d,%d)\n",
1200 $decname, length $$rdata, scalar @$objs 1349 $decname, length $$rdata, scalar @$objs
1201 if $VERBOSE_IO; 1350 if $VERBOSE_IO;
1202 1351
1203 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1352 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1204 aio_chmod $fh, SAVE_MODE; 1353 aio_chmod $fh, SAVE_MODE;
1205 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1354 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
… …
1228 aio_rename "$filename~", $filename; 1377 aio_rename "$filename~", $filename;
1229 1378
1230 $filename =~ s%/[^/]+$%%; 1379 $filename =~ s%/[^/]+$%%;
1231 aio_pathsync $filename if $cf::USE_FSYNC; 1380 aio_pathsync $filename if $cf::USE_FSYNC;
1232 } else { 1381 } else {
1233 warn "unable to save objects: $filename~: $!\n"; 1382 error "unable to save objects: $filename~: $!\n";
1234 } 1383 }
1235 } else { 1384 } else {
1236 aio_unlink $filename; 1385 aio_unlink $filename;
1237 aio_unlink "$filename.pst"; 1386 aio_unlink "$filename.pst";
1238 } 1387 }
… …
1262 my $st = eval { Coro::Storable::thaw $av }; 1411 my $st = eval { Coro::Storable::thaw $av };
1263 $av = $st->{objs}; 1412 $av = $st->{objs};
1264 } 1413 }
1265 1414
1266 utf8::decode (my $decname = $filename); 1415 utf8::decode (my $decname = $filename);
1267 warn sprintf "loading %s (%d,%d)\n", 1416 trace sprintf "loading %s (%d,%d)\n",
1268 $decname, length $data, scalar @{$av || []} 1417 $decname, length $data, scalar @{$av || []}
1269 if $VERBOSE_IO; 1418 if $VERBOSE_IO;
1270 1419
1271 ($data, $av) 1420 ($data, $av)
1272} 1421}
1273 1422
… …
1351 my ($pl, $buf) = @_; 1500 my ($pl, $buf) = @_;
1352 1501
1353 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) }; 1502 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1354 1503
1355 if (ref $msg) { 1504 if (ref $msg) {
1356 my ($type, $reply, @payload) = 1505 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
1357 "ARRAY" eq ref $msg
1358 ? @$msg
1359 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
1360 1506
1361 my @reply; 1507 my @reply;
1362 1508
1363 if (my $cb = $EXTCMD{$type}) { 1509 if (my $cb = $EXTCMD{$type}) {
1364 @reply = $cb->($pl, @payload); 1510 @reply = $cb->($pl, @payload);
… …
1366 1512
1367 $pl->ext_reply ($reply, @reply) 1513 $pl->ext_reply ($reply, @reply)
1368 if $reply; 1514 if $reply;
1369 1515
1370 } else { 1516 } else {
1371 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1517 error "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1372 } 1518 }
1373 1519
1374 cf::override; 1520 cf::override;
1375 }, 1521 },
1376); 1522);
… …
1386 }; 1532 };
1387 1533
1388 $grp 1534 $grp
1389} 1535}
1390 1536
1537sub _ext_cfg_reg($$$$) {
1538 my ($rvar, $varname, $cfgname, $default) = @_;
1539
1540 $cfgname = lc $varname
1541 unless length $cfgname;
1542
1543 $EXT_CFG{$cfgname} = [$rvar, $default];
1544
1545 $$rvar = exists $CFG{$cfgname} ? $CFG{$cfgname} : $default;
1546}
1547
1391sub load_extensions { 1548sub load_extensions {
1549 info "loading extensions...";
1550
1551 %EXT_CFG = ();
1552
1392 cf::sync_job { 1553 cf::sync_job {
1393 my %todo; 1554 my %todo;
1394 1555
1395 for my $path (<$LIBDIR/*.ext>) { 1556 for my $path (<$LIBDIR/*.ext>) {
1396 next unless -r $path; 1557 next unless -r $path;
… …
1414 1575
1415 $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 } 1576 $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 }
1416 if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m; 1577 if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m;
1417 1578
1418 $ext{source} = 1579 $ext{source} =
1419 "package $pkg; use 5.10.0; use strict 'vars', 'subs'; use utf8;\n" 1580 "package $pkg; use common::sense;\n"
1420 . "#line 1 \"$path\"\n{\n" 1581 . "#line 1 \"$path\"\n{\n"
1421 . $source 1582 . $source
1422 . "\n};\n1"; 1583 . "\n};\n1";
1423 1584
1424 $todo{$base} = \%ext; 1585 $todo{$base} = \%ext;
… …
1436 for (split /,\s*/, $v->{meta}{depends}) { 1597 for (split /,\s*/, $v->{meta}{depends}) {
1437 next ext 1598 next ext
1438 unless exists $done{$_}; 1599 unless exists $done{$_};
1439 } 1600 }
1440 1601
1441 warn "... pass $pass, loading '$k' into '$v->{pkg}'\n"; 1602 trace "... pass $pass, loading '$k' into '$v->{pkg}'\n";
1442 1603
1604 my $source = $v->{source};
1605
1606 # support "CONF varname :confname = default" pseudo-statements
1607 $source =~ s{
1608 ^ CONF \s+ ([^\s:=]+) \s* (?:: \s* ([^\s:=]+) \s* )? = ([^\n#]+)
1609 }{
1610 "our \$$1; BEGIN { cf::_ext_cfg_reg \\\$$1, q\x00$1\x00, q\x00$2\x00, $3 }";
1611 }gmxe;
1612
1443 my $active = eval $v->{source}; 1613 my $active = eval $source;
1444 1614
1445 if (length $@) { 1615 if (length $@) {
1446 warn "$v->{path}: $@\n"; 1616 error "$v->{path}: $@\n";
1447 1617
1448 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1618 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1449 if exists $v->{meta}{mandatory}; 1619 if exists $v->{meta}{mandatory};
1450 1620
1451 warn "$v->{base}: optional extension cannot be loaded, skipping.\n"; 1621 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
… …
1453 } else { 1623 } else {
1454 $done{$k} = delete $todo{$k}; 1624 $done{$k} = delete $todo{$k};
1455 push @EXTS, $v->{pkg}; 1625 push @EXTS, $v->{pkg};
1456 $progress = 1; 1626 $progress = 1;
1457 1627
1458 warn "$v->{base}: extension inactive.\n" 1628 info "$v->{base}: extension inactive.\n"
1459 unless $active; 1629 unless $active;
1460 } 1630 }
1461 } 1631 }
1462 1632
1463 unless ($progress) { 1633 unless ($progress) {
… …
1465 1635
1466 while (my ($k, $v) = each %todo) { 1636 while (my ($k, $v) = each %todo) {
1467 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting." 1637 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
1468 if exists $v->{meta}{mandatory}; 1638 if exists $v->{meta}{mandatory};
1469 } 1639 }
1640
1641 last;
1470 } 1642 }
1471 } 1643 }
1472 }; 1644 };
1473} 1645}
1474 1646
… …
1632 my $name = $pl->ob->name; 1804 my $name = $pl->ob->name;
1633 1805
1634 $pl->{deny_save} = 1; 1806 $pl->{deny_save} = 1;
1635 $pl->password ("*"); # this should lock out the player until we have nuked the dir 1807 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1636 1808
1637 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1809 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->ns;
1638 $pl->deactivate; 1810 $pl->deactivate;
1811
1639 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1812 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1640 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1813 $pl->invoke (cf::EVENT_PLAYER_QUIT) if $pl->ns;
1814 ext::highscore::check ($pl->ob);
1815
1641 $pl->ns->destroy if $pl->ns; 1816 $pl->ns->destroy if $pl->ns;
1642 1817
1643 my $path = playerdir $pl; 1818 my $path = playerdir $pl;
1644 my $temp = "$path~$cf::RUNTIME~deleting~"; 1819 my $temp = "$path~$cf::RUNTIME~deleting~";
1645 aio_rename $path, $temp; 1820 aio_rename $path, $temp;
… …
1811sub generate_random_map { 1986sub generate_random_map {
1812 my ($self, $rmp) = @_; 1987 my ($self, $rmp) = @_;
1813 1988
1814 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM 1989 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
1815 1990
1816 # mit "rum" bekleckern, nicht
1817 $self->_create_random_map ( 1991 $self->_create_random_map ($rmp);
1818 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1819 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, $rmp->{miningstyle},
1820 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1821 $rmp->{exit_on_final_map},
1822 $rmp->{xsize}, $rmp->{ysize},
1823 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1824 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1825 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1826 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1827 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1828 (cf::region::find $rmp->{region}), $rmp->{custom}
1829 )
1830} 1992}
1831 1993
1832=item cf::map->register ($regex, $prio) 1994=item cf::map->register ($regex, $prio)
1833 1995
1834Register a handler for the map path matching the given regex at the 1996Register a handler for the map path matching the given regex at the
… …
1839 2001
1840sub register { 2002sub register {
1841 my (undef, $regex, $prio) = @_; 2003 my (undef, $regex, $prio) = @_;
1842 my $pkg = caller; 2004 my $pkg = caller;
1843 2005
1844 no strict;
1845 push @{"$pkg\::ISA"}, __PACKAGE__; 2006 push @{"$pkg\::ISA"}, __PACKAGE__;
1846 2007
1847 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 2008 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1848} 2009}
1849 2010
… …
1861} 2022}
1862 2023
1863sub normalise { 2024sub normalise {
1864 my ($path, $base) = @_; 2025 my ($path, $base) = @_;
1865 2026
1866 $path = "$path"; # make sure its a string 2027 $path = "$path"; # make sure it's a string
1867 2028
1868 $path =~ s/\.map$//; 2029 $path =~ s/\.map$//;
1869 2030
1870 # map plan: 2031 # map plan:
1871 # 2032 #
… …
1886 $base =~ s{[^/]+/?$}{}; 2047 $base =~ s{[^/]+/?$}{};
1887 $path = "$base/$path"; 2048 $path = "$base/$path";
1888 } 2049 }
1889 2050
1890 for ($path) { 2051 for ($path) {
1891 redo if s{//}{/};
1892 redo if s{/\.?/}{/}; 2052 redo if s{/\.?/}{/};
1893 redo if s{/[^/]+/\.\./}{/}; 2053 redo if s{/[^/]+/\.\./}{/};
1894 } 2054 }
1895 2055
1896 $path 2056 $path
… …
1910 $self->init; # pass $1 etc. 2070 $self->init; # pass $1 etc.
1911 return $self; 2071 return $self;
1912 } 2072 }
1913 } 2073 }
1914 2074
1915 Carp::cluck "unable to resolve path '$path' (base '$base')."; 2075 Carp::cluck "unable to resolve path '$path' (base '$base')";
1916 () 2076 ()
1917} 2077}
1918 2078
2079# may re-bless or do other evil things
1919sub init { 2080sub init {
1920 my ($self) = @_; 2081 my ($self) = @_;
1921 2082
1922 $self 2083 $self
1923} 2084}
… …
1988 $self->{load_path} = $path; 2149 $self->{load_path} = $path;
1989 2150
1990 1 2151 1
1991} 2152}
1992 2153
2154# used to laod the header of an original map
1993sub load_header_orig { 2155sub load_header_orig {
1994 my ($self) = @_; 2156 my ($self) = @_;
1995 2157
1996 $self->load_header_from ($self->load_path) 2158 $self->load_header_from ($self->load_path)
1997} 2159}
1998 2160
2161# used to laod the header of an instantiated map
1999sub load_header_temp { 2162sub load_header_temp {
2000 my ($self) = @_; 2163 my ($self) = @_;
2001 2164
2002 $self->load_header_from ($self->save_path) 2165 $self->load_header_from ($self->save_path)
2003} 2166}
2004 2167
2168# called after loading the header from an instantiated map
2005sub prepare_temp { 2169sub prepare_temp {
2006 my ($self) = @_; 2170 my ($self) = @_;
2007 2171
2008 $self->last_access ((delete $self->{last_access}) 2172 $self->last_access ((delete $self->{last_access})
2009 || $cf::RUNTIME); #d# 2173 || $cf::RUNTIME); #d#
2010 # safety 2174 # safety
2011 $self->{instantiate_time} = $cf::RUNTIME 2175 $self->{instantiate_time} = $cf::RUNTIME
2012 if $self->{instantiate_time} > $cf::RUNTIME; 2176 if $self->{instantiate_time} > $cf::RUNTIME;
2013} 2177}
2014 2178
2179# called after loading the header from an original map
2015sub prepare_orig { 2180sub prepare_orig {
2016 my ($self) = @_; 2181 my ($self) = @_;
2017 2182
2018 $self->{load_original} = 1; 2183 $self->{load_original} = 1;
2019 $self->{instantiate_time} = $cf::RUNTIME; 2184 $self->{instantiate_time} = $cf::RUNTIME;
… …
2043 2208
2044sub find; 2209sub find;
2045sub find { 2210sub find {
2046 my ($path, $origin) = @_; 2211 my ($path, $origin) = @_;
2047 2212
2213 cf::cede_to_tick;
2214
2048 $path = normalise $path, $origin && $origin->path; 2215 $path = normalise $path, $origin;
2049 2216
2050 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove 2217 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
2051 my $guard2 = cf::lock_acquire "map_find:$path"; 2218 my $guard2 = cf::lock_acquire "map_find:$path";
2052 2219
2053 $cf::MAP{$path} || do { 2220 $cf::MAP{$path} || do {
… …
2084 2251
2085 { 2252 {
2086 my $guard = cf::lock_acquire "map_data:$path"; 2253 my $guard = cf::lock_acquire "map_data:$path";
2087 2254
2088 return unless $self->valid; 2255 return unless $self->valid;
2089 return unless $self->in_memory == cf::MAP_SWAPPED; 2256 return unless $self->state == cf::MAP_SWAPPED;
2090
2091 $self->in_memory (cf::MAP_LOADING);
2092 2257
2093 $self->alloc; 2258 $self->alloc;
2094 2259
2095 $self->pre_load; 2260 $self->pre_load;
2096 cf::cede_to_tick; 2261 cf::cede_to_tick;
2097 2262
2263 if (exists $self->{load_path}) {
2098 my $f = new_from_file cf::object::thawer $self->{load_path}; 2264 my $f = new_from_file cf::object::thawer $self->{load_path};
2099 $f->skip_block; 2265 $f->skip_block;
2100 $self->_load_objects ($f) 2266 $self->_load_objects ($f)
2101 or return; 2267 or return;
2102 2268
2103 $self->post_load_original 2269 $self->post_load_original
2104 if delete $self->{load_original}; 2270 if delete $self->{load_original};
2105 2271
2106 if (my $uniq = $self->uniq_path) { 2272 if (my $uniq = $self->uniq_path) {
2107 utf8::encode $uniq; 2273 utf8::encode $uniq;
2108 unless (aio_stat $uniq) { 2274 unless (aio_stat $uniq) {
2109 if (my $f = new_from_file cf::object::thawer $uniq) { 2275 if (my $f = new_from_file cf::object::thawer $uniq) {
2110 $self->clear_unique_items; 2276 $self->clear_unique_items;
2111 $self->_load_objects ($f); 2277 $self->_load_objects ($f);
2112 $f->resolve_delayed_derefs; 2278 $f->resolve_delayed_derefs;
2279 }
2113 } 2280 }
2114 } 2281 }
2115 }
2116 2282
2117 $f->resolve_delayed_derefs; 2283 $f->resolve_delayed_derefs;
2284 } else {
2285 $self->post_load_original
2286 if delete $self->{load_original};
2287 }
2288
2289 $self->state (cf::MAP_INACTIVE);
2118 2290
2119 cf::cede_to_tick; 2291 cf::cede_to_tick;
2120 # now do the right thing for maps 2292 # now do the right thing for maps
2121 $self->link_multipart_objects; 2293 $self->link_multipart_objects;
2122 $self->difficulty ($self->estimate_difficulty) 2294 $self->difficulty ($self->estimate_difficulty)
… …
2126 unless ($self->{deny_activate}) { 2298 unless ($self->{deny_activate}) {
2127 $self->decay_objects; 2299 $self->decay_objects;
2128 $self->fix_auto_apply; 2300 $self->fix_auto_apply;
2129 $self->update_buttons; 2301 $self->update_buttons;
2130 cf::cede_to_tick; 2302 cf::cede_to_tick;
2131 $self->activate; 2303 #$self->activate; # no longer activate maps automatically
2132 } 2304 }
2133 2305
2134 $self->{last_save} = $cf::RUNTIME; 2306 $self->{last_save} = $cf::RUNTIME;
2135 $self->last_access ($cf::RUNTIME); 2307 $self->last_access ($cf::RUNTIME);
2136
2137 $self->in_memory (cf::MAP_ACTIVE);
2138 } 2308 }
2139 2309
2140 $self->post_load; 2310 $self->post_load;
2311
2312 1
2141} 2313}
2142 2314
2143# customize the map for a given player, i.e. 2315# customize the map for a given player, i.e.
2144# return the _real_ map. used by e.g. per-player 2316# return the _real_ map. used by e.g. per-player
2145# maps to change the path to ~playername/mappath 2317# maps to change the path to ~playername/mappath
… …
2153# if $self->per_party; 2325# if $self->per_party;
2154 2326
2155 $self 2327 $self
2156} 2328}
2157 2329
2158# find and load all maps in the 3x3 area around a map
2159sub load_neighbours {
2160 my ($map) = @_;
2161
2162 my @neigh; # diagonal neighbours
2163
2164 for (0 .. 3) {
2165 my $neigh = $map->tile_path ($_)
2166 or next;
2167 $neigh = find $neigh, $map
2168 or next;
2169 $neigh->load;
2170
2171 # now find the diagonal neighbours
2172 push @neigh,
2173 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2174 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2175 }
2176
2177 for (grep defined $_->[0], @neigh) {
2178 my ($path, $origin) = @$_;
2179 my $neigh = find $path, $origin
2180 or next;
2181 $neigh->load;
2182 }
2183}
2184
2185sub find_sync { 2330sub find_sync {
2186 my ($path, $origin) = @_; 2331 my ($path, $origin) = @_;
2187 2332
2188 cf::sync_job { find $path, $origin } 2333 # it's a bug to call this from the main context
2334 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync"
2335 if $Coro::current == $Coro::main;
2336
2337 find $path, $origin
2189} 2338}
2190 2339
2191sub do_load_sync { 2340sub do_load_sync {
2192 my ($map) = @_; 2341 my ($map) = @_;
2193 2342
2343 # it's a bug to call this from the main context
2194 cf::LOG cf::llevDebug | cf::logBacktrace, "do_load_sync" 2344 return cf::LOG cf::llevError | cf::logBacktrace, "do_load_sync"
2195 if $Coro::current == $Coro::main; 2345 if $Coro::current == $Coro::main;
2196 2346
2197 cf::sync_job { $map->load }; 2347 $map->load;
2198} 2348}
2199 2349
2200our %MAP_PREFETCH; 2350our %MAP_PREFETCH;
2201our $MAP_PREFETCHER = undef; 2351our $MAP_PREFETCHER = undef;
2202 2352
2203sub find_async { 2353sub find_async {
2204 my ($path, $origin, $load) = @_; 2354 my ($path, $origin, $load) = @_;
2205 2355
2206 $path = normalise $path, $origin && $origin->{path}; 2356 $path = normalise $path, $origin;
2207 2357
2208 if (my $map = $cf::MAP{$path}) { 2358 if (my $map = $cf::MAP{$path}) {
2209 return $map if !$load || $map->in_memory == cf::MAP_ACTIVE; 2359 return $map if !$load || $map->linkable;
2210 } 2360 }
2211 2361
2212 $MAP_PREFETCH{$path} |= $load; 2362 $MAP_PREFETCH{$path} |= $load;
2213 2363
2214 $MAP_PREFETCHER ||= cf::async { 2364 $MAP_PREFETCHER ||= cf::async {
… …
2273sub swap_out { 2423sub swap_out {
2274 my ($self) = @_; 2424 my ($self) = @_;
2275 2425
2276 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2426 my $lock = cf::lock_acquire "map_data:$self->{path}";
2277 2427
2278 return if $self->in_memory != cf::MAP_ACTIVE; 2428 return if !$self->linkable;
2279 return if $self->{deny_save}; 2429 return if $self->{deny_save};
2280 return if $self->players; 2430 return if $self->players;
2281 2431
2282 # first deactivate the map and "unlink" it from the core 2432 # first deactivate the map and "unlink" it from the core
2283 $self->deactivate; 2433 $self->deactivate;
2284 $_->clear_links_to ($self) for values %cf::MAP; 2434 $_->clear_links_to ($self) for values %cf::MAP;
2285 $self->in_memory (cf::MAP_SWAPPED); 2435 $self->state (cf::MAP_SWAPPED);
2286 2436
2287 # then atomically save 2437 # then atomically save
2288 $self->_save; 2438 $self->_save;
2289 2439
2290 # then free the map 2440 # then free the map
… …
2314 2464
2315 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2465 my $lock = cf::lock_acquire "map_data:$self->{path}";
2316 2466
2317 return if $self->players; 2467 return if $self->players;
2318 2468
2319 warn "resetting map ", $self->path, "\n"; 2469 cf::trace "resetting map ", $self->path, "\n";
2320 2470
2321 $self->in_memory (cf::MAP_SWAPPED); 2471 $self->state (cf::MAP_SWAPPED);
2322 2472
2323 # need to save uniques path 2473 # need to save uniques path
2324 unless ($self->{deny_save}) { 2474 unless ($self->{deny_save}) {
2325 my $uniq = $self->uniq_path; utf8::encode $uniq; 2475 my $uniq = $self->uniq_path; utf8::encode $uniq;
2326 2476
… …
2656 # use -1 or undef as default coordinates, not 0, 0 2806 # use -1 or undef as default coordinates, not 0, 0
2657 ($x, $y) = ($map->enter_x, $map->enter_y) 2807 ($x, $y) = ($map->enter_x, $map->enter_y)
2658 if $x <= 0 && $y <= 0; 2808 if $x <= 0 && $y <= 0;
2659 2809
2660 $map->load; 2810 $map->load;
2661 $map->load_neighbours;
2662 2811
2663 return unless $self->contr->active; 2812 return unless $self->contr->active;
2664 2813
2665 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2814 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2666 if ($self->enter_map ($map, $x, $y)) { 2815 if ($self->enter_map ($map, $x, $y)) {
… …
2689 2838
2690sub cf::object::player::goto { 2839sub cf::object::player::goto {
2691 my ($self, $path, $x, $y, $check, $done) = @_; 2840 my ($self, $path, $x, $y, $check, $done) = @_;
2692 2841
2693 if ($self->{_link_recursion} >= $MAX_LINKS) { 2842 if ($self->{_link_recursion} >= $MAX_LINKS) {
2694 warn "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting."; 2843 error "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting.";
2695 $self->failmsg ("Something went wrong inside the server - please contact an administrator!"); 2844 $self->failmsg ("Something went wrong inside the server - please contact an administrator!");
2696 ($path, $x, $y) = @$EMERGENCY_POSITION; 2845 ($path, $x, $y) = @$EMERGENCY_POSITION;
2697 } 2846 }
2698 2847
2699 # do generation counting so two concurrent goto's will be executed in-order 2848 # do generation counting so two concurrent goto's will be executed in-order
… …
2722 ($path, $x, $y) = (undef, undef, undef); 2871 ($path, $x, $y) = (undef, undef, undef);
2723 } 2872 }
2724 } 2873 }
2725 2874
2726 my $map = eval { 2875 my $map = eval {
2727 my $map = defined $path ? cf::map::find $path : undef; 2876 my $map = defined $path ? cf::map::find $path, $self->map : undef;
2728 2877
2729 if ($map) { 2878 if ($map) {
2730 $map = $map->customise_for ($self); 2879 $map = $map->customise_for ($self);
2731 $map = $check->($map, $x, $y, $self) if $check && $map; 2880 $map = $check->($map, $x, $y, $self) if $check && $map;
2732 } else { 2881 } else {
… …
2822 $Coro::current->{desc} = "enter_exit"; 2971 $Coro::current->{desc} = "enter_exit";
2823 2972
2824 unless (eval { 2973 unless (eval {
2825 $self->deactivate_recursive; # just to be sure 2974 $self->deactivate_recursive; # just to be sure
2826 2975
2827 # random map handling
2828 {
2829 my $guard = cf::lock_acquire "exit_prepare:$exit";
2830
2831 prepare_random_map $exit
2832 if $exit->slaying eq "/!";
2833 }
2834
2835 my $map = cf::map::normalise $exit->slaying, $exit->map && $exit->map->path; 2976 my $map = cf::map::normalise $exit->slaying, $exit->map;
2836 my $x = $exit->stats->hp; 2977 my $x = $exit->stats->hp;
2837 my $y = $exit->stats->sp; 2978 my $y = $exit->stats->sp;
2979
2980 # special map handling
2981 my $slaying = $exit->slaying;
2982
2983 # special map handling
2984 if ($slaying eq "/!") {
2985 my $guard = cf::lock_acquire "exit_prepare:$exit";
2986
2987 prepare_random_map $exit
2988 if $exit->slaying eq "/!"; # need to re-check after getting the lock
2989
2990 $map = $exit->slaying;
2991
2992 } elsif ($slaying eq '!up') {
2993 $map = $exit->map->tile_path (cf::TILE_UP);
2994 $x = $exit->x;
2995 $y = $exit->y;
2996
2997 } elsif ($slaying eq '!down') {
2998 $map = $exit->map->tile_path (cf::TILE_DOWN);
2999 $x = $exit->x;
3000 $y = $exit->y;
3001 }
2838 3002
2839 $self->goto ($map, $x, $y); 3003 $self->goto ($map, $x, $y);
2840 3004
2841 # if exit is damned, update players death & WoR home-position 3005 # if exit is damned, update players death & WoR home-position
2842 $self->contr->savebed ($map, $x, $y) 3006 $self->contr->savebed ($map, $x, $y)
… …
2847 $self->message ("Something went wrong deep within the deliantra server. " 3011 $self->message ("Something went wrong deep within the deliantra server. "
2848 . "I'll try to bring you back to the map you were before. " 3012 . "I'll try to bring you back to the map you were before. "
2849 . "Please report this to the dungeon master!", 3013 . "Please report this to the dungeon master!",
2850 cf::NDI_UNIQUE | cf::NDI_RED); 3014 cf::NDI_UNIQUE | cf::NDI_RED);
2851 3015
2852 warn "ERROR in enter_exit: $@"; 3016 error "ERROR in enter_exit: $@";
2853 $self->leave_link; 3017 $self->leave_link;
2854 } 3018 }
2855 })->prio (1); 3019 })->prio (1);
2856} 3020}
2857 3021
… …
3084=cut 3248=cut
3085 3249
3086sub cf::client::ext_reply($$@) { 3250sub cf::client::ext_reply($$@) {
3087 my ($self, $id, @msg) = @_; 3251 my ($self, $id, @msg) = @_;
3088 3252
3089 if ($self->extcmd == 2) { 3253 return unless $self->extcmd == 2;
3254
3090 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg])); 3255 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
3091 } elsif ($self->extcmd == 1) {
3092 #TODO: version 1, remove
3093 unshift @msg, msgtype => "reply", msgid => $id;
3094 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
3095 }
3096} 3256}
3097 3257
3098=item $success = $client->query ($flags, "text", \&cb) 3258=item $success = $client->query ($flags, "text", \&cb)
3099 3259
3100Queues a query to the client, calling the given callback with 3260Queues a query to the client, calling the given callback with
… …
3155 my ($ns, $buf) = @_; 3315 my ($ns, $buf) = @_;
3156 3316
3157 my $msg = eval { $ns->{json_coder}->decode ($buf) }; 3317 my $msg = eval { $ns->{json_coder}->decode ($buf) };
3158 3318
3159 if (ref $msg) { 3319 if (ref $msg) {
3160 my ($type, $reply, @payload) = 3320 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
3161 "ARRAY" eq ref $msg
3162 ? @$msg
3163 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
3164 3321
3165 my @reply; 3322 my @reply;
3166 3323
3167 if (my $cb = $EXTICMD{$type}) { 3324 if (my $cb = $EXTICMD{$type}) {
3168 @reply = $cb->($ns, @payload); 3325 @reply = $cb->($ns, @payload);
… …
3170 3327
3171 $ns->ext_reply ($reply, @reply) 3328 $ns->ext_reply ($reply, @reply)
3172 if $reply; 3329 if $reply;
3173 3330
3174 } else { 3331 } else {
3175 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; 3332 error "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
3176 } 3333 }
3177 3334
3178 cf::override; 3335 cf::override;
3179 }, 3336 },
3180); 3337);
… …
3261 decrease split destroy change_exp value msg lore send_msg)], 3418 decrease split destroy change_exp value msg lore send_msg)],
3262 ["cf::object::player" => qw(player)], 3419 ["cf::object::player" => qw(player)],
3263 ["cf::player" => qw(peaceful send_msg)], 3420 ["cf::player" => qw(peaceful send_msg)],
3264 ["cf::map" => qw(trigger)], 3421 ["cf::map" => qw(trigger)],
3265) { 3422) {
3266 no strict 'refs';
3267 my ($pkg, @funs) = @$_; 3423 my ($pkg, @funs) = @$_;
3268 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 3424 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
3269 for @funs; 3425 for @funs;
3270} 3426}
3271 3427
… …
3310 local @cf::_safe_eval_args = values %vars; 3466 local @cf::_safe_eval_args = values %vars;
3311 @res = wantarray ? eval eval : scalar eval $eval; 3467 @res = wantarray ? eval eval : scalar eval $eval;
3312 } 3468 }
3313 3469
3314 if ($@) { 3470 if ($@) {
3315 warn "$@"; 3471 warn "$@",
3316 warn "while executing safe code '$code'\n"; 3472 "while executing safe code '$code'\n",
3317 warn "with arguments " . (join " ", %vars) . "\n"; 3473 "with arguments " . (join " ", %vars) . "\n";
3318 } 3474 }
3319 3475
3320 wantarray ? @res : $res[0] 3476 wantarray ? @res : $res[0]
3321} 3477}
3322 3478
… …
3347=cut 3503=cut
3348 3504
3349############################################################################# 3505#############################################################################
3350# the server's init and main functions 3506# the server's init and main functions
3351 3507
3508our %FACEHASH; # hash => idx, #d# HACK for http server
3509
3352sub load_facedata($) { 3510sub load_facedata($) {
3353 my ($path) = @_; 3511 my ($path) = @_;
3354 3512
3355 # HACK to clear player env face cache, we need some signal framework 3513 # HACK to clear player env face cache, we need some signal framework
3356 # for this (global event?) 3514 # for this (global event?)
3357 %ext::player_env::MUSIC_FACE_CACHE = (); 3515 %ext::player_env::MUSIC_FACE_CACHE = ();
3358 3516
3359 my $enc = JSON::XS->new->utf8->canonical->relaxed; 3517 my $enc = JSON::XS->new->utf8->canonical->relaxed;
3360 3518
3361 warn "loading facedata from $path\n"; 3519 trace "loading facedata from $path\n";
3362 3520
3363 my $facedata; 3521 my $facedata = decode_storable load_file $path;
3364 0 < aio_load $path, $facedata
3365 or die "$path: $!";
3366
3367 $facedata = Coro::Storable::thaw $facedata;
3368 3522
3369 $facedata->{version} == 2 3523 $facedata->{version} == 2
3370 or cf::cleanup "$path: version mismatch, cannot proceed."; 3524 or cf::cleanup "$path: version mismatch, cannot proceed.";
3371 3525
3372 # patch in the exptable 3526 # patch in the exptable
… …
3379 cf::cede_to_tick; 3533 cf::cede_to_tick;
3380 3534
3381 { 3535 {
3382 my $faces = $facedata->{faceinfo}; 3536 my $faces = $facedata->{faceinfo};
3383 3537
3384 while (my ($face, $info) = each %$faces) { 3538 for my $face (sort keys %$faces) {
3539 my $info = $faces->{$face};
3385 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3540 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3386 3541
3387 cf::face::set_visibility $idx, $info->{visibility}; 3542 cf::face::set_visibility $idx, $info->{visibility};
3388 cf::face::set_magicmap $idx, $info->{magicmap}; 3543 cf::face::set_magicmap $idx, $info->{magicmap};
3389 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32}; 3544 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
3390 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64}; 3545 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
3546 cf::face::set_data $idx, 2, $info->{glyph} , $info->{glyph} ;
3547 $FACEHASH{$info->{hash64}} = $idx;#d#
3391 3548
3392 cf::cede_to_tick; 3549 cf::cede_to_tick;
3393 } 3550 }
3394 3551
3395 while (my ($face, $info) = each %$faces) { 3552 while (my ($face, $info) = each %$faces) {
… …
3400 3557
3401 if (my $smooth = cf::face::find $info->{smooth}) { 3558 if (my $smooth = cf::face::find $info->{smooth}) {
3402 cf::face::set_smooth $idx, $smooth; 3559 cf::face::set_smooth $idx, $smooth;
3403 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3560 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3404 } else { 3561 } else {
3405 warn "smooth face '$info->{smooth}' not found for face '$face'"; 3562 error "smooth face '$info->{smooth}' not found for face '$face'";
3406 } 3563 }
3407 3564
3408 cf::cede_to_tick; 3565 cf::cede_to_tick;
3409 } 3566 }
3410 } 3567 }
… …
3422 3579
3423 { 3580 {
3424 my $res = $facedata->{resource}; 3581 my $res = $facedata->{resource};
3425 3582
3426 while (my ($name, $info) = each %$res) { 3583 while (my ($name, $info) = each %$res) {
3427 if (defined $info->{type}) { 3584 if (defined (my $type = $info->{type})) {
3585 # TODO: different hash - must free and use new index, or cache ixface data queue
3428 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3586 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3429 3587
3430 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3588 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3431 cf::face::set_type $idx, $info->{type}; 3589 cf::face::set_type $idx, $type;
3590 cf::face::set_meta $idx, $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already
3591 $FACEHASH{$info->{hash}} = $idx;#d#
3432 } else { 3592 } else {
3433 $RESOURCE{$name} = $info; 3593# $RESOURCE{$name} = $info; # unused
3434 } 3594 }
3435 3595
3436 cf::cede_to_tick; 3596 cf::cede_to_tick;
3437 } 3597 }
3438 } 3598 }
3439 3599
3440 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); 3600 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3441 3601
3442 1 3602 1
3443} 3603}
3444
3445cf::global->attach (on_resource_update => sub {
3446 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3447 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3448
3449 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3450 my $sound = $soundconf->{compat}[$_]
3451 or next;
3452
3453 my $face = cf::face::find "sound/$sound->[1]";
3454 cf::sound::set $sound->[0] => $face;
3455 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3456 }
3457
3458 while (my ($k, $v) = each %{$soundconf->{event}}) {
3459 my $face = cf::face::find "sound/$v";
3460 cf::sound::set $k => $face;
3461 }
3462 }
3463});
3464 3604
3465register_exticmd fx_want => sub { 3605register_exticmd fx_want => sub {
3466 my ($ns, $want) = @_; 3606 my ($ns, $want) = @_;
3467 3607
3468 while (my ($k, $v) = each %$want) { 3608 while (my ($k, $v) = each %$want) {
… …
3507sub reload_treasures { 3647sub reload_treasures {
3508 load_resource_file "$DATADIR/treasures" 3648 load_resource_file "$DATADIR/treasures"
3509 or die "unable to load treasurelists\n"; 3649 or die "unable to load treasurelists\n";
3510} 3650}
3511 3651
3652sub reload_sound {
3653 trace "loading sound config from $DATADIR/sound\n";
3654
3655 my $soundconf = JSON::XS->new->utf8->relaxed->decode (load_file "$DATADIR/sound");
3656
3657 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3658 my $sound = $soundconf->{compat}[$_]
3659 or next;
3660
3661 my $face = cf::face::find "sound/$sound->[1]";
3662 cf::sound::set $sound->[0] => $face;
3663 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3664 }
3665
3666 while (my ($k, $v) = each %{$soundconf->{event}}) {
3667 my $face = cf::face::find "sound/$v";
3668 cf::sound::set $k => $face;
3669 }
3670}
3671
3512sub reload_resources { 3672sub reload_resources {
3513 warn "reloading resource files...\n"; 3673 trace "reloading resource files...\n";
3514 3674
3675 reload_exp_table;
3676 reload_materials;
3515 reload_facedata; 3677 reload_facedata;
3678 reload_sound;
3516 reload_archetypes; 3679 reload_archetypes;
3517 reload_regions; 3680 reload_regions;
3518 reload_treasures; 3681 reload_treasures;
3519 3682
3520 warn "finished reloading resource files\n"; 3683 trace "finished reloading resource files\n";
3521} 3684}
3522 3685
3523sub reload_config { 3686sub reload_config {
3524 warn "reloading config file...\n"; 3687 trace "reloading config file...\n";
3525 3688
3526 open my $fh, "<:utf8", "$CONFDIR/config" 3689 my $config = load_file "$CONFDIR/config";
3527 or return; 3690 utf8::decode $config;
3528 3691 *CFG = decode_yaml $config;
3529 local $/;
3530 *CFG = YAML::XS::Load scalar <$fh>;
3531 3692
3532 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38]; 3693 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3533 3694
3534 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3695 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3535 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3696 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3539 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()" 3700 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
3540 and die "WARNING: m(un)lockall failed: $!\n"; 3701 and die "WARNING: m(un)lockall failed: $!\n";
3541 }; 3702 };
3542 warn $@ if $@; 3703 warn $@ if $@;
3543 } 3704 }
3544
3545 warn "finished reloading resource files\n";
3546} 3705}
3547 3706
3548sub pidfile() { 3707sub pidfile() {
3549 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT 3708 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT
3550 or die "$PIDFILE: $!"; 3709 or die "$PIDFILE: $!";
… …
3563 seek $fh, 0, 0; 3722 seek $fh, 0, 0;
3564 print $fh $$; 3723 print $fh $$;
3565} 3724}
3566 3725
3567sub main_loop { 3726sub main_loop {
3568 warn "EV::loop starting\n"; 3727 trace "EV::loop starting\n";
3569 if (1) { 3728 if (1) {
3570 EV::loop; 3729 EV::loop;
3571 } 3730 }
3572 warn "EV::loop returned\n"; 3731 trace "EV::loop returned\n";
3573 goto &main_loop unless $REALLY_UNLOOP; 3732 goto &main_loop unless $REALLY_UNLOOP;
3574} 3733}
3575 3734
3576sub main { 3735sub main {
3577 cf::init_globals; # initialise logging 3736 cf::init_globals; # initialise logging
3578 3737
3579 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3738 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3580 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3739 LOG llevInfo, "Copyright (C) 2005-2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3581 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3740 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3582 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3741 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3583 3742
3584 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3743 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3585 3744
… …
3593 }; 3752 };
3594 3753
3595 evthread_start IO::AIO::poll_fileno; 3754 evthread_start IO::AIO::poll_fileno;
3596 3755
3597 cf::sync_job { 3756 cf::sync_job {
3598 cf::init_experience; 3757 cf::incloader::init ();
3758
3599 cf::init_anim; 3759 cf::init_anim;
3600 cf::init_attackmess; 3760 cf::init_attackmess;
3601 cf::init_dynamic; 3761 cf::init_dynamic;
3602 3762
3603 cf::load_settings; 3763 cf::load_settings;
3604 cf::load_materials;
3605 3764
3606 reload_resources; 3765 reload_resources;
3607 reload_config; 3766 reload_config;
3608 db_init; 3767 db_init;
3609 3768
… …
3621 3780
3622 # no (long-running) fork's whatsoever before this point(!) 3781 # no (long-running) fork's whatsoever before this point(!)
3623 use POSIX (); 3782 use POSIX ();
3624 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3783 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3625 3784
3626 (pop @POST_INIT)->(0) while @POST_INIT; 3785 cf::_post_init 0;
3627 }; 3786 };
3628 3787
3629 cf::object::thawer::errors_are_fatal 0; 3788 cf::object::thawer::errors_are_fatal 0;
3630 warn "parse errors in files are no longer fatal from this point on.\n"; 3789 info "parse errors in files are no longer fatal from this point on.\n";
3631 3790
3791 AE::postpone {
3792 undef &main; # free gobs of memory :)
3793 };
3794
3632 main_loop; 3795 goto &main_loop;
3633} 3796}
3634 3797
3635############################################################################# 3798#############################################################################
3636# initialisation and cleanup 3799# initialisation and cleanup
3637 3800
… …
3676 or return; 3839 or return;
3677 3840
3678 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE 3841 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE
3679 and return; 3842 and return;
3680 3843
3681 warn sprintf "runtime file written (%gs).\n", AE::time - $t0; 3844 trace sprintf "runtime file written (%gs).\n", AE::time - $t0;
3682 3845
3683 1 3846 1
3684} 3847}
3685 3848
3686our $uuid_lock; 3849our $uuid_lock;
… …
3698 or return; 3861 or return;
3699 3862
3700 my $value = uuid_seq uuid_cur; 3863 my $value = uuid_seq uuid_cur;
3701 3864
3702 unless ($value) { 3865 unless ($value) {
3703 warn "cowardly refusing to write zero uuid value!\n"; 3866 info "cowardly refusing to write zero uuid value!\n";
3704 return; 3867 return;
3705 } 3868 }
3706 3869
3707 my $value = uuid_str $value + $uuid_skip; 3870 my $value = uuid_str $value + $uuid_skip;
3708 $uuid_skip = 0; 3871 $uuid_skip = 0;
… …
3718 or return; 3881 or return;
3719 3882
3720 aio_rename "$uuid~", $uuid 3883 aio_rename "$uuid~", $uuid
3721 and return; 3884 and return;
3722 3885
3723 warn "uuid file written ($value).\n"; 3886 trace "uuid file written ($value).\n";
3724 3887
3725 1 3888 1
3726 3889
3727} 3890}
3728 3891
… …
3734} 3897}
3735 3898
3736sub emergency_save() { 3899sub emergency_save() {
3737 my $freeze_guard = cf::freeze_mainloop; 3900 my $freeze_guard = cf::freeze_mainloop;
3738 3901
3739 warn "emergency_perl_save: enter\n"; 3902 info "emergency_perl_save: enter\n";
3903
3904 # this is a trade-off: we want to be very quick here, so
3905 # save all maps without fsync, and later call a global sync
3906 # (which in turn might be very very slow)
3907 local $USE_FSYNC = 0;
3740 3908
3741 cf::sync_job { 3909 cf::sync_job {
3742 # this is a trade-off: we want to be very quick here, so 3910 cf::write_runtime_sync; # external watchdog should not bark
3743 # save all maps without fsync, and later call a global sync
3744 # (which in turn might be very very slow)
3745 local $USE_FSYNC = 0;
3746 3911
3747 # use a peculiar iteration method to avoid tripping on perl 3912 # use a peculiar iteration method to avoid tripping on perl
3748 # refcount bugs in for. also avoids problems with players 3913 # refcount bugs in for. also avoids problems with players
3749 # and maps saved/destroyed asynchronously. 3914 # and maps saved/destroyed asynchronously.
3750 warn "emergency_perl_save: begin player save\n"; 3915 info "emergency_perl_save: begin player save\n";
3751 for my $login (keys %cf::PLAYER) { 3916 for my $login (keys %cf::PLAYER) {
3752 my $pl = $cf::PLAYER{$login} or next; 3917 my $pl = $cf::PLAYER{$login} or next;
3753 $pl->valid or next; 3918 $pl->valid or next;
3754 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt 3919 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt
3755 $pl->save; 3920 $pl->save;
3756 } 3921 }
3757 warn "emergency_perl_save: end player save\n"; 3922 info "emergency_perl_save: end player save\n";
3758 3923
3924 cf::write_runtime_sync; # external watchdog should not bark
3925
3759 warn "emergency_perl_save: begin map save\n"; 3926 info "emergency_perl_save: begin map save\n";
3760 for my $path (keys %cf::MAP) { 3927 for my $path (keys %cf::MAP) {
3761 my $map = $cf::MAP{$path} or next; 3928 my $map = $cf::MAP{$path} or next;
3762 $map->valid or next; 3929 $map->valid or next;
3763 $map->save; 3930 $map->save;
3764 } 3931 }
3765 warn "emergency_perl_save: end map save\n"; 3932 info "emergency_perl_save: end map save\n";
3766 3933
3934 cf::write_runtime_sync; # external watchdog should not bark
3935
3767 warn "emergency_perl_save: begin database checkpoint\n"; 3936 info "emergency_perl_save: begin database checkpoint\n";
3768 BDB::db_env_txn_checkpoint $DB_ENV; 3937 BDB::db_env_txn_checkpoint $DB_ENV;
3769 warn "emergency_perl_save: end database checkpoint\n"; 3938 info "emergency_perl_save: end database checkpoint\n";
3770 3939
3771 warn "emergency_perl_save: begin write uuid\n"; 3940 info "emergency_perl_save: begin write uuid\n";
3772 write_uuid_sync 1; 3941 write_uuid_sync 1;
3773 warn "emergency_perl_save: end write uuid\n"; 3942 info "emergency_perl_save: end write uuid\n";
3943
3944 cf::write_runtime_sync; # external watchdog should not bark
3945
3946 trace "emergency_perl_save: syncing database to disk";
3947 BDB::db_env_txn_checkpoint $DB_ENV;
3948
3949 info "emergency_perl_save: starting sync\n";
3950 IO::AIO::aio_sync sub {
3951 info "emergency_perl_save: finished sync\n";
3952 };
3953
3954 cf::write_runtime_sync; # external watchdog should not bark
3955
3956 trace "emergency_perl_save: flushing outstanding aio requests";
3957 while (IO::AIO::nreqs || BDB::nreqs) {
3958 Coro::AnyEvent::sleep 0.01; # let the sync_job do it's thing
3959 }
3960
3961 cf::write_runtime_sync; # external watchdog should not bark
3774 }; 3962 };
3775 3963
3776 warn "emergency_perl_save: starting sync()\n";
3777 IO::AIO::aio_sync sub {
3778 warn "emergency_perl_save: finished sync()\n";
3779 };
3780
3781 warn "emergency_perl_save: leave\n"; 3964 info "emergency_perl_save: leave\n";
3782} 3965}
3783 3966
3784sub post_cleanup { 3967sub post_cleanup {
3785 my ($make_core) = @_; 3968 my ($make_core) = @_;
3786 3969
3970 IO::AIO::flush;
3971
3787 warn Carp::longmess "post_cleanup backtrace" 3972 error Carp::longmess "post_cleanup backtrace"
3788 if $make_core; 3973 if $make_core;
3789 3974
3790 my $fh = pidfile; 3975 my $fh = pidfile;
3791 unlink $PIDFILE if <$fh> == $$; 3976 unlink $PIDFILE if <$fh> == $$;
3792} 3977}
… …
3816 } 4001 }
3817} 4002}
3818 4003
3819sub do_reload_perl() { 4004sub do_reload_perl() {
3820 # can/must only be called in main 4005 # can/must only be called in main
3821 if (in_main) { 4006 unless (in_main) {
3822 warn "can only reload from main coroutine"; 4007 error "can only reload from main coroutine";
3823 return; 4008 return;
3824 } 4009 }
3825 4010
3826 return if $RELOAD++; 4011 return if $RELOAD++;
3827 4012
3828 my $t1 = AE::time; 4013 my $t1 = AE::time;
3829 4014
3830 while ($RELOAD) { 4015 while ($RELOAD) {
3831 warn "reloading..."; 4016 cf::get_slot 0.1, -1, "reload_perl";
4017 info "perl_reload: reloading...";
3832 4018
3833 warn "entering sync_job"; 4019 trace "perl_reload: entering sync_job";
3834 4020
3835 cf::sync_job { 4021 cf::sync_job {
3836 cf::write_runtime_sync; # external watchdog should not bark
3837 cf::emergency_save; 4022 #cf::emergency_save;
3838 cf::write_runtime_sync; # external watchdog should not bark
3839 4023
3840 warn "syncing database to disk";
3841 BDB::db_env_txn_checkpoint $DB_ENV;
3842
3843 # if anything goes wrong in here, we should simply crash as we already saved
3844
3845 warn "flushing outstanding aio requests";
3846 while (IO::AIO::nreqs || BDB::nreqs) {
3847 Coro::EV::timer_once 0.01; # let the sync_job do it's thing
3848 }
3849
3850 warn "cancelling all extension coros"; 4024 trace "perl_reload: cancelling all extension coros";
3851 $_->cancel for values %EXT_CORO; 4025 $_->cancel for values %EXT_CORO;
3852 %EXT_CORO = (); 4026 %EXT_CORO = ();
3853 4027
3854 warn "removing commands"; 4028 trace "perl_reload: removing commands";
3855 %COMMAND = (); 4029 %COMMAND = ();
3856 4030
3857 warn "removing ext/exti commands"; 4031 trace "perl_reload: removing ext/exti commands";
3858 %EXTCMD = (); 4032 %EXTCMD = ();
3859 %EXTICMD = (); 4033 %EXTICMD = ();
3860 4034
3861 warn "unloading/nuking all extensions"; 4035 trace "perl_reload: unloading/nuking all extensions";
3862 for my $pkg (@EXTS) { 4036 for my $pkg (@EXTS) {
3863 warn "... unloading $pkg"; 4037 trace "... unloading $pkg";
3864 4038
3865 if (my $cb = $pkg->can ("unload")) { 4039 if (my $cb = $pkg->can ("unload")) {
3866 eval { 4040 eval {
3867 $cb->($pkg); 4041 $cb->($pkg);
3868 1 4042 1
3869 } or warn "$pkg unloaded, but with errors: $@"; 4043 } or error "$pkg unloaded, but with errors: $@";
3870 } 4044 }
3871 4045
3872 warn "... clearing $pkg"; 4046 trace "... clearing $pkg";
3873 clear_package $pkg; 4047 clear_package $pkg;
3874 } 4048 }
3875 4049
3876 warn "unloading all perl modules loaded from $LIBDIR"; 4050 trace "perl_reload: unloading all perl modules loaded from $LIBDIR";
3877 while (my ($k, $v) = each %INC) { 4051 while (my ($k, $v) = each %INC) {
3878 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 4052 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
3879 4053
3880 warn "... unloading $k"; 4054 trace "... unloading $k";
3881 delete $INC{$k}; 4055 delete $INC{$k};
3882 4056
3883 $k =~ s/\.pm$//; 4057 $k =~ s/\.pm$//;
3884 $k =~ s/\//::/g; 4058 $k =~ s/\//::/g;
3885 4059
… …
3888 } 4062 }
3889 4063
3890 clear_package $k; 4064 clear_package $k;
3891 } 4065 }
3892 4066
3893 warn "getting rid of safe::, as good as possible"; 4067 trace "perl_reload: getting rid of safe::, as good as possible";
3894 clear_package "safe::$_" 4068 clear_package "safe::$_"
3895 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 4069 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
3896 4070
3897 warn "unloading cf.pm \"a bit\""; 4071 trace "perl_reload: unloading cf.pm \"a bit\"";
3898 delete $INC{"cf.pm"}; 4072 delete $INC{"cf.pm"};
3899 delete $INC{"cf/$_.pm"} for @EXTRA_MODULES; 4073 delete $INC{"cf/$_.pm"} for @EXTRA_MODULES;
3900 4074
3901 # don't, removes xs symbols, too, 4075 # don't, removes xs symbols, too,
3902 # and global variables created in xs 4076 # and global variables created in xs
3903 #clear_package __PACKAGE__; 4077 #clear_package __PACKAGE__;
3904 4078
3905 warn "unload completed, starting to reload now"; 4079 info "perl_reload: unload completed, starting to reload now";
3906 4080
3907 warn "reloading cf.pm"; 4081 trace "perl_reload: reloading cf.pm";
3908 require cf; 4082 require cf;
3909 cf::_connect_to_perl_1; 4083 cf::_connect_to_perl_1;
3910 4084
3911 warn "loading config and database again"; 4085 trace "perl_reload: loading config and database again";
3912 cf::reload_config; 4086 cf::reload_config;
3913 4087
3914 warn "loading extensions"; 4088 trace "perl_reload: loading extensions";
3915 cf::load_extensions; 4089 cf::load_extensions;
3916 4090
3917 if ($REATTACH_ON_RELOAD) { 4091 if ($REATTACH_ON_RELOAD) {
3918 warn "reattaching attachments to objects/players"; 4092 trace "perl_reload: reattaching attachments to objects/players";
3919 _global_reattach; # objects, sockets 4093 _global_reattach; # objects, sockets
3920 warn "reattaching attachments to maps"; 4094 trace "perl_reload: reattaching attachments to maps";
3921 reattach $_ for values %MAP; 4095 reattach $_ for values %MAP;
3922 warn "reattaching attachments to players"; 4096 trace "perl_reload: reattaching attachments to players";
3923 reattach $_ for values %PLAYER; 4097 reattach $_ for values %PLAYER;
3924 } 4098 }
3925 4099
3926 warn "running post_init jobs"; 4100 cf::_post_init 1;
3927 (pop @POST_INIT)->(1) while @POST_INIT;
3928 4101
3929 warn "leaving sync_job"; 4102 trace "perl_reload: leaving sync_job";
3930 4103
3931 1 4104 1
3932 } or do { 4105 } or do {
3933 warn $@; 4106 error $@;
3934 cf::cleanup "error while reloading, exiting."; 4107 cf::cleanup "perl_reload: error, exiting.";
3935 }; 4108 };
3936 4109
3937 warn "reloaded";
3938 --$RELOAD; 4110 --$RELOAD;
3939 } 4111 }
3940 4112
3941 $t1 = AE::time - $t1; 4113 $t1 = AE::time - $t1;
3942 warn "reload completed in ${t1}s\n"; 4114 info "perl_reload: completed in ${t1}s\n";
3943}; 4115};
3944 4116
3945our $RELOAD_WATCHER; # used only during reload 4117our $RELOAD_WATCHER; # used only during reload
3946 4118
3947sub reload_perl() { 4119sub reload_perl() {
… …
3968 reload_perl; 4140 reload_perl;
3969 }; 4141 };
3970 } 4142 }
3971}; 4143};
3972 4144
3973unshift @INC, $LIBDIR; 4145#############################################################################
3974 4146
3975my $bug_warning = 0; 4147my $bug_warning = 0;
3976 4148
3977our @WAIT_FOR_TICK;
3978our @WAIT_FOR_TICK_BEGIN;
3979
3980sub wait_for_tick { 4149sub wait_for_tick() {
3981 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main; 4150 return Coro::AnyEvent::poll if tick_inhibit || $Coro::current == $Coro::main;
3982 4151
3983 my $signal = new Coro::Signal; 4152 $WAIT_FOR_TICK->wait;
3984 push @WAIT_FOR_TICK, $signal;
3985 $signal->wait;
3986} 4153}
3987 4154
3988sub wait_for_tick_begin { 4155sub wait_for_tick_begin() {
3989 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main; 4156 return Coro::AnyEvent::poll if tick_inhibit || $Coro::current == $Coro::main;
3990 4157
3991 my $signal = new Coro::Signal; 4158 my $signal = new Coro::Signal;
3992 push @WAIT_FOR_TICK_BEGIN, $signal; 4159 push @WAIT_FOR_TICK_BEGIN, $signal;
3993 $signal->wait; 4160 $signal->wait;
3994} 4161}
… …
3998 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 4165 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3999 unless ++$bug_warning > 10; 4166 unless ++$bug_warning > 10;
4000 return; 4167 return;
4001 } 4168 }
4002 4169
4003 cf::server_tick; # one server iteration 4170 cf::one_tick; # one server iteration
4004 4171
4005 #for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d# 4172 #for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d#
4006 4173
4007 if ($NOW >= $NEXT_RUNTIME_WRITE) { 4174 if ($NOW >= $NEXT_RUNTIME_WRITE) {
4008 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 4175 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
4009 Coro::async_pool { 4176 Coro::async_pool {
4010 $Coro::current->{desc} = "runtime saver"; 4177 $Coro::current->{desc} = "runtime saver";
4011 write_runtime_sync 4178 write_runtime_sync
4012 or warn "ERROR: unable to write runtime file: $!"; 4179 or error "ERROR: unable to write runtime file: $!";
4013 }; 4180 };
4014 } 4181 }
4015 4182
4016 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 4183 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
4017 $sig->send; 4184 $sig->send;
4018 } 4185 }
4019 while (my $sig = shift @WAIT_FOR_TICK) { 4186 $WAIT_FOR_TICK->broadcast;
4020 $sig->send;
4021 }
4022 4187
4023 $LOAD = ($NOW - $TICK_START) / $TICK; 4188 $LOAD = ($NOW - $TICK_START) / $TICK;
4024 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 4189 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
4025 4190
4026 if (0) { 4191 if (0) {
4027 if ($NEXT_TICK) { 4192 if ($NEXT_TICK) {
4028 my $jitter = $TICK_START - $NEXT_TICK; 4193 my $jitter = $TICK_START - $NEXT_TICK;
4029 $JITTER = $JITTER * 0.75 + $jitter * 0.25; 4194 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
4030 warn "jitter $JITTER\n";#d# 4195 debug "jitter $JITTER\n";#d#
4031 } 4196 }
4032 } 4197 }
4033} 4198}
4034 4199
4035{ 4200{
4036 # configure BDB 4201 # configure BDB
4037 4202
4038 BDB::min_parallel 16; 4203 BDB::min_parallel 16;
4039 BDB::max_poll_reqs $TICK * 0.1; 4204 BDB::max_poll_reqs $TICK * 0.1;
4040 $AnyEvent::BDB::WATCHER->priority (1); 4205 #$AnyEvent::BDB::WATCHER->priority (1);
4041 4206
4042 unless ($DB_ENV) { 4207 unless ($DB_ENV) {
4043 $DB_ENV = BDB::db_env_create; 4208 $DB_ENV = BDB::db_env_create;
4044 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT); 4209 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
4045 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7; 4210 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;
… …
4080 IO::AIO::min_parallel 8; 4245 IO::AIO::min_parallel 8;
4081 IO::AIO::max_poll_time $TICK * 0.1; 4246 IO::AIO::max_poll_time $TICK * 0.1;
4082 undef $AnyEvent::AIO::WATCHER; 4247 undef $AnyEvent::AIO::WATCHER;
4083} 4248}
4084 4249
4085my $_log_backtrace; 4250our $_log_backtrace;
4251our $_log_backtrace_last;
4086 4252
4087sub _log_backtrace { 4253sub _log_backtrace {
4088 my ($msg, @addr) = @_; 4254 my ($msg, @addr) = @_;
4089 4255
4090 $msg =~ s/\n//; 4256 $msg =~ s/\n$//;
4091 4257
4258 if ($_log_backtrace_last eq $msg) {
4259 LOG llevInfo, "[ABT] $msg\n";
4260 LOG llevInfo, "[ABT] [duplicate, suppressed]\n";
4092 # limit the # of concurrent backtraces 4261 # limit the # of concurrent backtraces
4093 if ($_log_backtrace < 2) { 4262 } elsif ($_log_backtrace < 2) {
4263 $_log_backtrace_last = $msg;
4094 ++$_log_backtrace; 4264 ++$_log_backtrace;
4095 my $perl_bt = Carp::longmess $msg; 4265 my $perl_bt = Carp::longmess $msg;
4096 async { 4266 async {
4097 $Coro::current->{desc} = "abt $msg"; 4267 $Coro::current->{desc} = "abt $msg";
4098 4268
… …
4118 LOG llevInfo, "[ABT] $_\n" for @bt; 4288 LOG llevInfo, "[ABT] $_\n" for @bt;
4119 --$_log_backtrace; 4289 --$_log_backtrace;
4120 }; 4290 };
4121 } else { 4291 } else {
4122 LOG llevInfo, "[ABT] $msg\n"; 4292 LOG llevInfo, "[ABT] $msg\n";
4123 LOG llevInfo, "[ABT] [suppressed]\n"; 4293 LOG llevInfo, "[ABT] [overload, suppressed]\n";
4124 } 4294 }
4125} 4295}
4126 4296
4127# load additional modules 4297# load additional modules
4128require "cf/$_.pm" for @EXTRA_MODULES; 4298require "cf/$_.pm" for @EXTRA_MODULES;

Diff Legend

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