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.554 by root, Sat Jun 26 22:10:18 2010 UTC vs.
Revision 1.603 by root, Tue Nov 13 01:12:23 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
32use Safe; 32use Safe;
33use Safe::Hole; 33use Safe::Hole;
34use Storable (); 34use Storable ();
35use Carp (); 35use Carp ();
36 36
37use Guard (); 37use AnyEvent ();
38use AnyEvent::IO ();
39use AnyEvent::DNS ();
40
38use Coro (); 41use Coro ();
39use Coro::State; 42use Coro::State;
40use Coro::Handle; 43use Coro::Handle;
41use Coro::EV; 44use Coro::EV;
42use Coro::AnyEvent; 45use Coro::AnyEvent;
48use Coro::AIO; 51use Coro::AIO;
49use Coro::BDB 1.6; 52use Coro::BDB 1.6;
50use Coro::Storable; 53use Coro::Storable;
51use Coro::Util (); 54use Coro::Util ();
52 55
56use Guard ();
53use JSON::XS 2.01 (); 57use JSON::XS 2.01 ();
54use BDB (); 58use BDB ();
55use Data::Dumper; 59use Data::Dumper;
56use Fcntl; 60use Fcntl;
57use YAML::XS (); 61use YAML::XS ();
58use IO::AIO (); 62use IO::AIO ();
59use Time::HiRes;
60use Compress::LZF; 63use Compress::LZF;
61use Digest::MD5 (); 64use Digest::MD5 ();
62 65
63AnyEvent::detect; 66AnyEvent::detect;
64 67
83our %COMMAND = (); 86our %COMMAND = ();
84our %COMMAND_TIME = (); 87our %COMMAND_TIME = ();
85 88
86our @EXTS = (); # list of extension package names 89our @EXTS = (); # list of extension package names
87our %EXTCMD = (); 90our %EXTCMD = ();
91our %EXTACMD = ();
88our %EXTICMD = (); 92our %EXTICMD = ();
93our %EXTIACMD = ();
89our %EXT_CORO = (); # coroutines bound to extensions 94our %EXT_CORO = (); # coroutines bound to extensions
90our %EXT_MAP = (); # pluggable maps 95our %EXT_MAP = (); # pluggable maps
91 96
92our $RELOAD; # number of reloads so far, non-zero while in reload 97our $RELOAD; # number of reloads so far, non-zero while in reload
93our @EVENT; 98our @EVENT;
94our @REFLECT; # set by XS 99our @REFLECT; # set by XS
95our %REFLECT; # set by us 100our %REFLECT; # set by us
96 101
97our $CONFDIR = confdir; 102our $CONFDIR = confdir;
103
98our $DATADIR = datadir; 104our $DATADIR = datadir;
99our $LIBDIR = "$DATADIR/ext"; 105our $LIBDIR = "$DATADIR/ext";
100our $PODDIR = "$DATADIR/pod"; 106our $PODDIR = "$DATADIR/pod";
101our $MAPDIR = "$DATADIR/" . mapdir; 107our $MAPDIR = "$DATADIR/" . mapdir;
108
102our $LOCALDIR = localdir; 109our $LOCALDIR = localdir;
103our $TMPDIR = "$LOCALDIR/" . tmpdir; 110our $TMPDIR = "$LOCALDIR/" . tmpdir;
104our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 111our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
105our $PLAYERDIR = "$LOCALDIR/" . playerdir; 112our $PLAYERDIR = "$LOCALDIR/" . playerdir;
106our $RANDOMDIR = "$LOCALDIR/random"; 113our $RANDOMDIR = "$LOCALDIR/random";
107our $BDBDIR = "$LOCALDIR/db"; 114our $BDBDIR = "$LOCALDIR/db";
108our $PIDFILE = "$LOCALDIR/pid"; 115our $PIDFILE = "$LOCALDIR/pid";
109our $RUNTIMEFILE = "$LOCALDIR/runtime"; 116our $RUNTIMEFILE = "$LOCALDIR/runtime";
110 117
111our %RESOURCE; # unused 118#our %RESOURCE; # unused
112 119
113our $OUTPUT_RATE_MIN = 3000; 120our $OUTPUT_RATE_MIN = 3000;
114our $OUTPUT_RATE_MAX = 1000000; 121our $OUTPUT_RATE_MAX = 1000000;
115 122
116our $MAX_LINKS = 32; # how many chained exits to follow 123our $MAX_LINKS = 32; # how many chained exits to follow
127our $DB_ENV; 134our $DB_ENV;
128 135
129our @EXTRA_MODULES = qw(pod match mapscript incloader); 136our @EXTRA_MODULES = qw(pod match mapscript incloader);
130 137
131our %CFG; 138our %CFG;
139our %EXT_CFG; # cfgkeyname => [var-ref, defaultvalue]
132 140
133our $UPTIME; $UPTIME ||= time; 141our $UPTIME; $UPTIME ||= time;
134our $RUNTIME; 142our $RUNTIME = 0;
143our $SERVER_TICK = 0;
135our $NOW; 144our $NOW;
136 145
137our (%PLAYER, %PLAYER_LOADING); # all users 146our (%PLAYER, %PLAYER_LOADING); # all users
138our (%MAP, %MAP_LOADING ); # all maps 147our (%MAP, %MAP_LOADING ); # all maps
139our $LINK_MAP; # the special {link} map, which is always available 148our $LINK_MAP; # the special {link} map, which is always available
148 157
149our @POST_INIT; 158our @POST_INIT;
150 159
151our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow) 160our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow)
152our $REALLY_UNLOOP; # never set to true, please :) 161our $REALLY_UNLOOP; # never set to true, please :)
162
163our $WAIT_FOR_TICK = new Coro::Signal;
164our @WAIT_FOR_TICK_BEGIN;
153 165
154binmode STDOUT; 166binmode STDOUT;
155binmode STDERR; 167binmode STDERR;
156 168
157# read virtual server time, if available 169# read virtual server time, if available
191 203
192=over 4 204=over 4
193 205
194=item $cf::UPTIME 206=item $cf::UPTIME
195 207
196The timestamp of the server start (so not actually an uptime). 208The timestamp of the server start (so not actually an "uptime").
209
210=item $cf::SERVER_TICK
211
212An unsigned integer that starts at zero when the server is started and is
213incremented on every tick.
214
215=item $cf::NOW
216
217The (real) time of the last (current) server tick - updated before and
218after tick processing, so this is useful only as a rough "what time is it
219now" estimate.
220
221=item $cf::TICK
222
223The interval between each server tick, in seconds.
197 224
198=item $cf::RUNTIME 225=item $cf::RUNTIME
199 226
200The time this server has run, starts at 0 and is increased by $cf::TICK on 227The time this server has run, starts at 0 and is increased by $cf::TICK on
201every server tick. 228every server tick.
202 229
203=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR 230=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR
204$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR 231$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR
205$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR 232$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR
206 233
207Various directories - "/etc", read-only install directory, perl-library 234Various directories - "/etc", read-only install directory, perl-library
208directory, pod-directory, read-only maps directory, "/var", "/var/tmp", 235directory, pod-directory, read-only maps directory, "/var", "/var/tmp",
209unique-items directory, player file directory, random maps directory and 236unique-items directory, player file directory, random maps directory and
210database environment. 237database environment.
211 238
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 239=item $cf::LOADAVG
221 240
222The current CPU load on the server (alpha-smoothed), as a value between 0 241The 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 242(none) and 1 (overloaded), indicating how much time is spent on processing
224objects per tick. Healthy values are < 0.5. 243objects per tick. Healthy values are < 0.5.
232Configuration for the server, loaded from C</etc/deliantra-server/config>, or 251Configuration for the server, loaded from C</etc/deliantra-server/config>, or
233from wherever your confdir points to. 252from wherever your confdir points to.
234 253
235=item cf::wait_for_tick, cf::wait_for_tick_begin 254=item cf::wait_for_tick, cf::wait_for_tick_begin
236 255
237These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 256These are functions that inhibit the current coroutine one tick.
238returns directly I<after> the tick processing (and consequently, can only wake one thread 257cf::wait_for_tick_begin only returns directly I<after> the tick
258processing (and consequently, can only wake one thread per tick), while
239per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 259cf::wait_for_tick wakes up all waiters after tick processing.
260
261Note that cf::wait_for_tick will immediately return when the server is not
262ticking, making it suitable for small pauses in threads that need to run
263when the server is paused. If that is not applicable (i.e. you I<really>
264want to wait, use C<$cf::WAIT_FOR_TICK>).
265
266=item $cf::WAIT_FOR_TICK
267
268Note that C<cf::wait_for_tick> is probably the correct thing to use. This
269variable contains a L<Coro::Signal> that is broadcats after every server
270tick. Calling C<< ->wait >> on it will suspend the caller until after the
271next server tick.
240 272
241=cut 273=cut
242 274
243sub wait_for_tick(); 275sub wait_for_tick();
244sub wait_for_tick_begin(); 276sub wait_for_tick_begin();
310)) { 342)) {
311 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 343 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
312} 344}
313 345
314$EV::DIED = sub { 346$EV::DIED = sub {
315 Carp::cluck "error in event callback: @_"; 347 warn "error in event callback: $@";
316}; 348};
349
350#############################################################################
351
352sub fork_call(&@);
353sub get_slot($;$$);
317 354
318############################################################################# 355#############################################################################
319 356
320=head2 UTILITY FUNCTIONS 357=head2 UTILITY FUNCTIONS
321 358
342 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; 379 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
343 $d 380 $d
344 } || "[unable to dump $_[0]: '$@']"; 381 } || "[unable to dump $_[0]: '$@']";
345} 382}
346 383
384=item $scalar = cf::load_file $path
385
386Loads the given file from path and returns its contents. Croaks on error
387and can block.
388
389=cut
390
391sub load_file($) {
392 0 <= aio_load $_[0], my $data
393 or Carp::croak "$_[0]: $!";
394
395 $data
396}
397
398=item $success = cf::replace_file $path, $data, $sync
399
400Atomically replaces the file at the given $path with new $data, and
401optionally $sync the data to disk before replacing the file.
402
403=cut
404
405sub replace_file($$;$) {
406 my ($path, $data, $sync) = @_;
407
408 my $lock = cf::lock_acquire ("replace_file:$path");
409
410 my $fh = aio_open "$path~", Fcntl::O_WRONLY | Fcntl::O_CREAT | Fcntl::O_TRUNC, 0644
411 or return;
412
413 $data = $data->() if ref $data;
414
415 length $data == aio_write $fh, 0, (length $data), $data, 0
416 or return;
417
418 !$sync
419 or !aio_fsync $fh
420 or return;
421
422 aio_close $fh
423 and return;
424
425 aio_rename "$path~", $path
426 and return;
427
428 if ($sync) {
429 $path =~ s%/[^/]*$%%;
430 aio_pathsync $path;
431 }
432
433 1
434}
435
347=item $ref = cf::decode_json $json 436=item $ref = cf::decode_json $json
348 437
349Converts a JSON string into the corresponding perl data structure. 438Converts a JSON string into the corresponding perl data structure.
350 439
351=item $json = cf::encode_json $ref 440=item $json = cf::encode_json $ref
357our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 446our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
358 447
359sub encode_json($) { $json_coder->encode ($_[0]) } 448sub encode_json($) { $json_coder->encode ($_[0]) }
360sub decode_json($) { $json_coder->decode ($_[0]) } 449sub decode_json($) { $json_coder->decode ($_[0]) }
361 450
451=item $ref = cf::decode_storable $scalar
452
453Same as Coro::Storable::thaw, so blocks.
454
455=cut
456
457BEGIN { *decode_storable = \&Coro::Storable::thaw }
458
362=item $ref = cf::yaml_load $scalar 459=item $ref = cf::decode_yaml $scalar
363 460
364Same as YAML::XS::Load, but doesn't leak, because it forks (and thus blocks). 461Same as YAML::XS::Load, but doesn't leak, because it forks (and thus blocks).
365 462
366=cut 463=cut
367 464
368sub fork_call(&@); 465sub decode_yaml($) {
369
370sub yaml_load($) {
371 fork_call { YAML::XS::Load $_[0] } @_ 466 fork_call { YAML::XS::Load $_[0] } @_
467}
468
469=item $scalar = cf::unlzf $scalar
470
471Same as Compress::LZF::compress, but takes server ticks into account, so
472blocks.
473
474=cut
475
476sub unlzf($) {
477 # we assume 100mb/s minimum decompression speed (noncompressible data on a ~2ghz machine)
478 cf::get_slot +(length $_[0]) / 100_000_000, 0, "unlzf";
479 Compress::LZF::decompress $_[0]
372} 480}
373 481
374=item cf::post_init { BLOCK } 482=item cf::post_init { BLOCK }
375 483
376Execute the given codeblock, I<after> all extensions have been (re-)loaded, 484Execute the given codeblock, I<after> all extensions have been (re-)loaded,
460 EV::periodic $start, $interval, 0, $cb 568 EV::periodic $start, $interval, 0, $cb
461} 569}
462 570
463=item cf::get_slot $time[, $priority[, $name]] 571=item cf::get_slot $time[, $priority[, $name]]
464 572
465Allocate $time seconds of blocking CPU time at priority C<$priority>: 573Allocate $time seconds of blocking CPU time at priority C<$priority>
466This call blocks and returns only when you have at least C<$time> seconds 574(default: 0): This call blocks and returns only when you have at least
467of cpu time till the next tick. The slot is only valid till the next cede. 575C<$time> seconds of cpu time till the next tick. The slot is only valid
576till the next cede.
577
578Background jobs should use a priority less than zero, interactive jobs
579should use 100 or more.
468 580
469The optional C<$name> can be used to identify the job to run. It might be 581The optional C<$name> can be used to identify the job to run. It might be
470used for statistical purposes and should identify the same time-class. 582used for statistical purposes and should identify the same time-class.
471 583
472Useful for short background jobs. 584Useful for short background jobs.
501 } 613 }
502 } 614 }
503 615
504 if (@SLOT_QUEUE) { 616 if (@SLOT_QUEUE) {
505 # we do not use wait_for_tick() as it returns immediately when tick is inactive 617 # we do not use wait_for_tick() as it returns immediately when tick is inactive
506 push @cf::WAIT_FOR_TICK, $signal; 618 $WAIT_FOR_TICK->wait;
507 $signal->wait;
508 } else { 619 } else {
509 $busy = 0; 620 $busy = 0;
510 Coro::schedule; 621 Coro::schedule;
511 } 622 }
512 } 623 }
627 reset_signals; 738 reset_signals;
628} 739}
629 740
630sub fork_call(&@) { 741sub fork_call(&@) {
631 my ($cb, @args) = @_; 742 my ($cb, @args) = @_;
632
633 # we seemingly have to make a local copy of the whole thing,
634 # otherwise perl prematurely frees the stuff :/
635 # TODO: investigate and fix (likely this will be rather laborious)
636 743
637 my @res = Coro::Util::fork_eval { 744 my @res = Coro::Util::fork_eval {
638 cf::post_fork; 745 cf::post_fork;
639 &$cb 746 &$cb
640 } @args; 747 } @args;
767 874
768 my @data; 875 my @data;
769 my $md5; 876 my $md5;
770 877
771 for (0 .. $#$src) { 878 for (0 .. $#$src) {
772 0 <= aio_load $src->[$_], $data[$_] 879 $data[$_] = load_file $src->[$_];
773 or Carp::croak "$src->[$_]: $!";
774 } 880 }
775 881
776 # if processing is expensive, check 882 # if processing is expensive, check
777 # checksum first 883 # checksum first
778 if (1) { 884 if (1) {
791 897
792 return db_get cache => "$id/data"; 898 return db_get cache => "$id/data";
793 } 899 }
794 } 900 }
795 901
796 my $t1 = Time::HiRes::time; 902 my $t1 = EV::time;
797 my $data = $process->(\@data); 903 my $data = $process->(\@data);
798 my $t2 = Time::HiRes::time; 904 my $t2 = EV::time;
799 905
800 info "cache: '$id' processed in ", $t2 - $t1, "s\n"; 906 info "cache: '$id' processed in ", $t2 - $t1, "s\n";
801 907
802 db_put cache => "$id/data", $data; 908 db_put cache => "$id/data", $data;
803 db_put cache => "$id/md5" , $md5; 909 db_put cache => "$id/md5" , $md5;
1323=cut 1429=cut
1324 1430
1325############################################################################# 1431#############################################################################
1326# command handling &c 1432# command handling &c
1327 1433
1328=item cf::register_command $name => \&callback($ob,$args); 1434=item cf::register_command $name => \&callback($ob,$args)
1329 1435
1330Register a callback for execution when the client sends the user command 1436Register a callback for execution when the client sends the user command
1331$name. 1437$name.
1332 1438
1333=cut 1439=cut
1339 #warn "registering command '$name/$time' to '$caller'"; 1445 #warn "registering command '$name/$time' to '$caller'";
1340 1446
1341 push @{ $COMMAND{$name} }, [$caller, $cb]; 1447 push @{ $COMMAND{$name} }, [$caller, $cb];
1342} 1448}
1343 1449
1344=item cf::register_extcmd $name => \&callback($pl,$packet); 1450=item cf::register_extcmd $name => \&callback($pl,@args)
1345 1451
1346Register a callback for execution when the client sends an (synchronous) 1452Register a callback for execution when the client sends an (synchronous)
1347extcmd packet. Ext commands will be processed in the order they are 1453extcmd packet. Ext commands will be processed in the order they are
1348received by the server, like other user commands. The first argument is 1454received by the server, like other user commands. The first argument is
1349the logged-in player. Ext commands can only be processed after a player 1455the logged-in player. Ext commands can only be processed after a player
1350has logged in successfully. 1456has logged in successfully.
1351 1457
1352If the callback returns something, it is sent back as if reply was being 1458The values will be sent back to the client.
1353called.
1354 1459
1460=item cf::register_async_extcmd $name => \&callback($pl,$reply->(...),@args)
1461
1462Same as C<cf::register_extcmd>, but instead of returning values, the
1463callback needs to clal the C<$reply> function.
1464
1355=item cf::register_exticmd $name => \&callback($ns,$packet); 1465=item cf::register_exticmd $name => \&callback($ns,@args)
1356 1466
1357Register a callback for execution when the client sends an (asynchronous) 1467Register a callback for execution when the client sends an (asynchronous)
1358exticmd packet. Exti commands are processed by the server as soon as they 1468exticmd packet. Exti commands are processed by the server as soon as they
1359are received, i.e. out of order w.r.t. other commands. The first argument 1469are received, i.e. out of order w.r.t. other commands. The first argument
1360is a client socket. Exti commands can be received anytime, even before 1470is a client socket. Exti commands can be received anytime, even before
1361log-in. 1471log-in.
1362 1472
1363If the callback returns something, it is sent back as if reply was being 1473The values will be sent back to the client.
1364called.
1365 1474
1366=cut 1475=item cf::register_async_exticmd $name => \&callback($ns,$reply->(...),@args)
1367 1476
1477Same as C<cf::register_extcmd>, but instead of returning values, the
1478callback needs to clal the C<$reply> function.
1479
1480=cut
1481
1368sub register_extcmd { 1482sub register_extcmd($$) {
1369 my ($name, $cb) = @_; 1483 my ($name, $cb) = @_;
1370 1484
1371 $EXTCMD{$name} = $cb; 1485 $EXTCMD{$name} = $cb;
1372} 1486}
1373 1487
1374sub register_exticmd { 1488sub register_async_extcmd($$) {
1375 my ($name, $cb) = @_; 1489 my ($name, $cb) = @_;
1376 1490
1491 $EXTACMD{$name} = $cb;
1492}
1493
1494sub register_exticmd($$) {
1495 my ($name, $cb) = @_;
1496
1377 $EXTICMD{$name} = $cb; 1497 $EXTICMD{$name} = $cb;
1498}
1499
1500sub register_async_exticmd($$) {
1501 my ($name, $cb) = @_;
1502
1503 $EXTIACMD{$name} = $cb;
1378} 1504}
1379 1505
1380use File::Glob (); 1506use File::Glob ();
1381 1507
1382cf::player->attach ( 1508cf::player->attach (
1396 my ($pl, $buf) = @_; 1522 my ($pl, $buf) = @_;
1397 1523
1398 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) }; 1524 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1399 1525
1400 if (ref $msg) { 1526 if (ref $msg) {
1401 my ($type, $reply, @payload) = 1527 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
1402 "ARRAY" eq ref $msg
1403 ? @$msg
1404 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
1405 1528
1406 my @reply;
1407
1408 if (my $cb = $EXTCMD{$type}) { 1529 if (my $cb = $EXTACMD{$type}) {
1530 $cb->(
1531 $pl,
1532 sub {
1533 $pl->ext_msg ("reply-$reply", @_)
1534 if $reply;
1535 },
1536 @payload
1537 );
1538 } else {
1539 my @reply;
1540
1541 if (my $cb = $EXTCMD{$type}) {
1409 @reply = $cb->($pl, @payload); 1542 @reply = $cb->($pl, @payload);
1543 }
1544
1545 $pl->ext_msg ("reply-$reply", @reply)
1546 if $reply;
1410 } 1547 }
1411
1412 $pl->ext_reply ($reply, @reply)
1413 if $reply;
1414 1548
1415 } else { 1549 } else {
1416 error "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1550 error "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1417 } 1551 }
1418 1552
1431 }; 1565 };
1432 1566
1433 $grp 1567 $grp
1434} 1568}
1435 1569
1570sub _ext_cfg_reg($$$$) {
1571 my ($rvar, $varname, $cfgname, $default) = @_;
1572
1573 $cfgname = lc $varname
1574 unless length $cfgname;
1575
1576 $EXT_CFG{$cfgname} = [$rvar, $default];
1577
1578 $$rvar = exists $CFG{$cfgname} ? $CFG{$cfgname} : $default;
1579}
1580
1436sub load_extensions { 1581sub load_extensions {
1437 info "loading extensions..."; 1582 info "loading extensions...";
1583
1584 %EXT_CFG = ();
1438 1585
1439 cf::sync_job { 1586 cf::sync_job {
1440 my %todo; 1587 my %todo;
1441 1588
1442 for my $path (<$LIBDIR/*.ext>) { 1589 for my $path (<$LIBDIR/*.ext>) {
1485 unless exists $done{$_}; 1632 unless exists $done{$_};
1486 } 1633 }
1487 1634
1488 trace "... pass $pass, loading '$k' into '$v->{pkg}'\n"; 1635 trace "... pass $pass, loading '$k' into '$v->{pkg}'\n";
1489 1636
1637 my $source = $v->{source};
1638
1639 # support "CONF varname :confname = default" pseudo-statements
1640 $source =~ s{
1641 ^ CONF \s+ ([^\s:=]+) \s* (?:: \s* ([^\s:=]+) \s* )? = ([^\n#]+)
1642 }{
1643 "our \$$1; BEGIN { cf::_ext_cfg_reg \\\$$1, q\x00$1\x00, q\x00$2\x00, $3 }";
1644 }gmxe;
1645
1490 my $active = eval $v->{source}; 1646 my $active = eval $source;
1491 1647
1492 if (length $@) { 1648 if (length $@) {
1493 error "$v->{path}: $@\n"; 1649 error "$v->{path}: $@\n";
1494 1650
1495 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1651 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1512 1668
1513 while (my ($k, $v) = each %todo) { 1669 while (my ($k, $v) = each %todo) {
1514 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting." 1670 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
1515 if exists $v->{meta}{mandatory}; 1671 if exists $v->{meta}{mandatory};
1516 } 1672 }
1673
1674 last;
1517 } 1675 }
1518 } 1676 }
1519 }; 1677 };
1520} 1678}
1521 1679
1781 1939
1782=item $protocol_xml = $player->expand_cfpod ($cfpod) 1940=item $protocol_xml = $player->expand_cfpod ($cfpod)
1783 1941
1784Expand deliantra pod fragments into protocol xml. 1942Expand deliantra pod fragments into protocol xml.
1785 1943
1786=item $player->ext_reply ($msgid, @msg)
1787
1788Sends an ext reply to the player.
1789
1790=cut
1791
1792sub ext_reply($$@) {
1793 my ($self, $id, @msg) = @_;
1794
1795 $self->ns->ext_reply ($id, @msg)
1796}
1797
1798=item $player->ext_msg ($type, @msg) 1944=item $player->ext_msg ($type, @msg)
1799 1945
1800Sends an ext event to the client. 1946Sends an ext event to the client.
1801 1947
1802=cut 1948=cut
1861sub generate_random_map { 2007sub generate_random_map {
1862 my ($self, $rmp) = @_; 2008 my ($self, $rmp) = @_;
1863 2009
1864 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM 2010 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
1865 2011
1866 # mit "rum" bekleckern, nicht
1867 $self->_create_random_map ( 2012 $self->_create_random_map ($rmp);
1868 $rmp,
1869 $rmp->{wall_name}, $rmp->{monsterstyle},
1870 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1871 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{this_map},
1872 $rmp->{exit_on_final_map},
1873 $rmp->{xsize}, $rmp->{ysize},
1874 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1875 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1876 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1877 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1878 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1879 (cf::region::find $rmp->{region})
1880 )
1881} 2013}
1882 2014
1883=item cf::map->register ($regex, $prio) 2015=item cf::map->register ($regex, $prio)
1884 2016
1885Register a handler for the map path matching the given regex at the 2017Register a handler for the map path matching the given regex at the
1963 2095
1964 Carp::cluck "unable to resolve path '$path' (base '$base')"; 2096 Carp::cluck "unable to resolve path '$path' (base '$base')";
1965 () 2097 ()
1966} 2098}
1967 2099
2100# may re-bless or do other evil things
1968sub init { 2101sub init {
1969 my ($self) = @_; 2102 my ($self) = @_;
1970 2103
1971 $self 2104 $self
1972} 2105}
2037 $self->{load_path} = $path; 2170 $self->{load_path} = $path;
2038 2171
2039 1 2172 1
2040} 2173}
2041 2174
2175# used to laod the header of an original map
2042sub load_header_orig { 2176sub load_header_orig {
2043 my ($self) = @_; 2177 my ($self) = @_;
2044 2178
2045 $self->load_header_from ($self->load_path) 2179 $self->load_header_from ($self->load_path)
2046} 2180}
2047 2181
2182# used to laod the header of an instantiated map
2048sub load_header_temp { 2183sub load_header_temp {
2049 my ($self) = @_; 2184 my ($self) = @_;
2050 2185
2051 $self->load_header_from ($self->save_path) 2186 $self->load_header_from ($self->save_path)
2052} 2187}
2053 2188
2189# called after loading the header from an instantiated map
2054sub prepare_temp { 2190sub prepare_temp {
2055 my ($self) = @_; 2191 my ($self) = @_;
2056 2192
2057 $self->last_access ((delete $self->{last_access}) 2193 $self->last_access ((delete $self->{last_access})
2058 || $cf::RUNTIME); #d# 2194 || $cf::RUNTIME); #d#
2059 # safety 2195 # safety
2060 $self->{instantiate_time} = $cf::RUNTIME 2196 $self->{instantiate_time} = $cf::RUNTIME
2061 if $self->{instantiate_time} > $cf::RUNTIME; 2197 if $self->{instantiate_time} > $cf::RUNTIME;
2062} 2198}
2063 2199
2200# called after loading the header from an original map
2064sub prepare_orig { 2201sub prepare_orig {
2065 my ($self) = @_; 2202 my ($self) = @_;
2066 2203
2067 $self->{load_original} = 1; 2204 $self->{load_original} = 1;
2068 $self->{instantiate_time} = $cf::RUNTIME; 2205 $self->{instantiate_time} = $cf::RUNTIME;
2094sub find { 2231sub find {
2095 my ($path, $origin) = @_; 2232 my ($path, $origin) = @_;
2096 2233
2097 cf::cede_to_tick; 2234 cf::cede_to_tick;
2098 2235
2099 $path = normalise $path, $origin && $origin->path; 2236 $path = normalise $path, $origin;
2100 2237
2101 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove 2238 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
2102 my $guard2 = cf::lock_acquire "map_find:$path"; 2239 my $guard2 = cf::lock_acquire "map_find:$path";
2103 2240
2104 $cf::MAP{$path} || do { 2241 $cf::MAP{$path} || do {
2135 2272
2136 { 2273 {
2137 my $guard = cf::lock_acquire "map_data:$path"; 2274 my $guard = cf::lock_acquire "map_data:$path";
2138 2275
2139 return unless $self->valid; 2276 return unless $self->valid;
2140 return unless $self->in_memory == cf::MAP_SWAPPED; 2277 return unless $self->state == cf::MAP_SWAPPED;
2141
2142 $self->in_memory (cf::MAP_LOADING);
2143 2278
2144 $self->alloc; 2279 $self->alloc;
2145 2280
2146 $self->pre_load; 2281 $self->pre_load;
2147 cf::cede_to_tick; 2282 cf::cede_to_tick;
2148 2283
2284 if (exists $self->{load_path}) {
2149 my $f = new_from_file cf::object::thawer $self->{load_path}; 2285 my $f = new_from_file cf::object::thawer $self->{load_path};
2150 $f->skip_block; 2286 $f->skip_block;
2151 $self->_load_objects ($f) 2287 $self->_load_objects ($f)
2152 or return; 2288 or return;
2153 2289
2154 $self->post_load_original 2290 $self->post_load_original
2155 if delete $self->{load_original}; 2291 if delete $self->{load_original};
2156 2292
2157 if (my $uniq = $self->uniq_path) { 2293 if (my $uniq = $self->uniq_path) {
2158 utf8::encode $uniq; 2294 utf8::encode $uniq;
2159 unless (aio_stat $uniq) { 2295 unless (aio_stat $uniq) {
2160 if (my $f = new_from_file cf::object::thawer $uniq) { 2296 if (my $f = new_from_file cf::object::thawer $uniq) {
2161 $self->clear_unique_items; 2297 $self->clear_unique_items;
2162 $self->_load_objects ($f); 2298 $self->_load_objects ($f);
2163 $f->resolve_delayed_derefs; 2299 $f->resolve_delayed_derefs;
2300 }
2164 } 2301 }
2165 } 2302 }
2166 }
2167 2303
2168 $f->resolve_delayed_derefs; 2304 $f->resolve_delayed_derefs;
2305 } else {
2306 $self->post_load_original
2307 if delete $self->{load_original};
2308 }
2309
2310 $self->state (cf::MAP_INACTIVE);
2169 2311
2170 cf::cede_to_tick; 2312 cf::cede_to_tick;
2171 # now do the right thing for maps 2313 # now do the right thing for maps
2172 $self->link_multipart_objects; 2314 $self->link_multipart_objects;
2173 $self->difficulty ($self->estimate_difficulty) 2315 $self->difficulty ($self->estimate_difficulty)
2177 unless ($self->{deny_activate}) { 2319 unless ($self->{deny_activate}) {
2178 $self->decay_objects; 2320 $self->decay_objects;
2179 $self->fix_auto_apply; 2321 $self->fix_auto_apply;
2180 $self->update_buttons; 2322 $self->update_buttons;
2181 cf::cede_to_tick; 2323 cf::cede_to_tick;
2182 $self->activate; 2324 #$self->activate; # no longer activate maps automatically
2183 } 2325 }
2184 2326
2185 $self->{last_save} = $cf::RUNTIME; 2327 $self->{last_save} = $cf::RUNTIME;
2186 $self->last_access ($cf::RUNTIME); 2328 $self->last_access ($cf::RUNTIME);
2187
2188 $self->in_memory (cf::MAP_ACTIVE);
2189 } 2329 }
2190 2330
2191 $self->post_load; 2331 $self->post_load;
2192 2332
2193 1 2333 1
2206# if $self->per_party; 2346# if $self->per_party;
2207 2347
2208 $self 2348 $self
2209} 2349}
2210 2350
2211# find and load all maps in the 3x3 area around a map
2212sub load_neighbours {
2213 my ($map) = @_;
2214
2215 my @neigh; # diagonal neighbours
2216
2217 for (0 .. 3) {
2218 my $neigh = $map->tile_path ($_)
2219 or next;
2220 $neigh = find $neigh, $map
2221 or next;
2222 $neigh->load;
2223
2224 # now find the diagonal neighbours
2225 push @neigh,
2226 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2227 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2228 }
2229
2230 for (grep defined $_->[0], @neigh) {
2231 my ($path, $origin) = @$_;
2232 my $neigh = find $path, $origin
2233 or next;
2234 $neigh->load;
2235 }
2236}
2237
2238sub find_sync { 2351sub find_sync {
2239 my ($path, $origin) = @_; 2352 my ($path, $origin) = @_;
2240 2353
2354 # it's a bug to call this from the main context
2241 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync" 2355 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync"
2242 if $Coro::current == $Coro::main; 2356 if $Coro::current == $Coro::main;
2243 2357
2244 find $path, $origin 2358 find $path, $origin
2245} 2359}
2246 2360
2247sub do_load_sync { 2361sub do_load_sync {
2248 my ($map) = @_; 2362 my ($map) = @_;
2249 2363
2364 # it's a bug to call this from the main context
2250 return cf::LOG cf::llevError | cf::logBacktrace, "do_load_sync" 2365 return cf::LOG cf::llevError | cf::logBacktrace, "do_load_sync"
2251 if $Coro::current == $Coro::main; 2366 if $Coro::current == $Coro::main;
2252 2367
2253 $map->load; 2368 $map->load;
2254} 2369}
2257our $MAP_PREFETCHER = undef; 2372our $MAP_PREFETCHER = undef;
2258 2373
2259sub find_async { 2374sub find_async {
2260 my ($path, $origin, $load) = @_; 2375 my ($path, $origin, $load) = @_;
2261 2376
2262 $path = normalise $path, $origin && $origin->{path}; 2377 $path = normalise $path, $origin;
2263 2378
2264 if (my $map = $cf::MAP{$path}) { 2379 if (my $map = $cf::MAP{$path}) {
2265 return $map if !$load || $map->in_memory == cf::MAP_ACTIVE; 2380 return $map if !$load || $map->linkable;
2266 } 2381 }
2267 2382
2268 $MAP_PREFETCH{$path} |= $load; 2383 $MAP_PREFETCH{$path} |= $load;
2269 2384
2270 $MAP_PREFETCHER ||= cf::async { 2385 $MAP_PREFETCHER ||= cf::async {
2329sub swap_out { 2444sub swap_out {
2330 my ($self) = @_; 2445 my ($self) = @_;
2331 2446
2332 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2447 my $lock = cf::lock_acquire "map_data:$self->{path}";
2333 2448
2334 return if $self->in_memory != cf::MAP_ACTIVE; 2449 return if !$self->linkable;
2335 return if $self->{deny_save}; 2450 return if $self->{deny_save};
2336 return if $self->players; 2451 return if $self->players;
2337 2452
2338 # first deactivate the map and "unlink" it from the core 2453 # first deactivate the map and "unlink" it from the core
2339 $self->deactivate; 2454 $self->deactivate;
2340 $_->clear_links_to ($self) for values %cf::MAP; 2455 $_->clear_links_to ($self) for values %cf::MAP;
2341 $self->in_memory (cf::MAP_SWAPPED); 2456 $self->state (cf::MAP_SWAPPED);
2342 2457
2343 # then atomically save 2458 # then atomically save
2344 $self->_save; 2459 $self->_save;
2345 2460
2346 # then free the map 2461 # then free the map
2372 2487
2373 return if $self->players; 2488 return if $self->players;
2374 2489
2375 cf::trace "resetting map ", $self->path, "\n"; 2490 cf::trace "resetting map ", $self->path, "\n";
2376 2491
2377 $self->in_memory (cf::MAP_SWAPPED); 2492 $self->state (cf::MAP_SWAPPED);
2378 2493
2379 # need to save uniques path 2494 # need to save uniques path
2380 unless ($self->{deny_save}) { 2495 unless ($self->{deny_save}) {
2381 my $uniq = $self->uniq_path; utf8::encode $uniq; 2496 my $uniq = $self->uniq_path; utf8::encode $uniq;
2382 2497
2535 2650
2536Creates and returns a persistent reference to an object that can be stored as a string. 2651Creates and returns a persistent reference to an object that can be stored as a string.
2537 2652
2538=item $ob = cf::object::deref ($refstring) 2653=item $ob = cf::object::deref ($refstring)
2539 2654
2540returns the objetc referenced by refstring. may return undef when it cnanot find the object, 2655returns the objetc referenced by refstring. may return undef when it cannot find the object,
2541even if the object actually exists. May block. 2656even if the object actually exists. May block.
2542 2657
2543=cut 2658=cut
2544 2659
2545sub deref { 2660sub deref {
2712 # use -1 or undef as default coordinates, not 0, 0 2827 # use -1 or undef as default coordinates, not 0, 0
2713 ($x, $y) = ($map->enter_x, $map->enter_y) 2828 ($x, $y) = ($map->enter_x, $map->enter_y)
2714 if $x <= 0 && $y <= 0; 2829 if $x <= 0 && $y <= 0;
2715 2830
2716 $map->load; 2831 $map->load;
2717 $map->load_neighbours;
2718 2832
2719 return unless $self->contr->active; 2833 return unless $self->contr->active;
2720 2834
2721 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2835 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2722 if ($self->enter_map ($map, $x, $y)) { 2836 if ($self->enter_map ($map, $x, $y)) {
2778 ($path, $x, $y) = (undef, undef, undef); 2892 ($path, $x, $y) = (undef, undef, undef);
2779 } 2893 }
2780 } 2894 }
2781 2895
2782 my $map = eval { 2896 my $map = eval {
2783 my $map = defined $path ? cf::map::find $path : undef; 2897 my $map = defined $path ? cf::map::find $path, $self->map : undef;
2784 2898
2785 if ($map) { 2899 if ($map) {
2786 $map = $map->customise_for ($self); 2900 $map = $map->customise_for ($self);
2787 $map = $check->($map, $x, $y, $self) if $check && $map; 2901 $map = $check->($map, $x, $y, $self) if $check && $map;
2788 } else { 2902 } else {
2878 $Coro::current->{desc} = "enter_exit"; 2992 $Coro::current->{desc} = "enter_exit";
2879 2993
2880 unless (eval { 2994 unless (eval {
2881 $self->deactivate_recursive; # just to be sure 2995 $self->deactivate_recursive; # just to be sure
2882 2996
2883 # random map handling
2884 {
2885 my $guard = cf::lock_acquire "exit_prepare:$exit";
2886
2887 prepare_random_map $exit
2888 if $exit->slaying eq "/!";
2889 }
2890
2891 my $map = cf::map::normalise $exit->slaying, $exit->map && $exit->map->path; 2997 my $map = cf::map::normalise $exit->slaying, $exit->map;
2892 my $x = $exit->stats->hp; 2998 my $x = $exit->stats->hp;
2893 my $y = $exit->stats->sp; 2999 my $y = $exit->stats->sp;
3000
3001 # special map handling
3002 my $slaying = $exit->slaying;
3003
3004 # special map handling
3005 if ($slaying eq "/!") {
3006 my $guard = cf::lock_acquire "exit_prepare:$exit";
3007
3008 prepare_random_map $exit
3009 if $exit->slaying eq "/!"; # need to re-check after getting the lock
3010
3011 $map = $exit->slaying;
3012
3013 } elsif ($slaying eq '!up') {
3014 $map = $exit->map->tile_path (cf::TILE_UP);
3015 $x = $exit->x;
3016 $y = $exit->y;
3017
3018 } elsif ($slaying eq '!down') {
3019 $map = $exit->map->tile_path (cf::TILE_DOWN);
3020 $x = $exit->x;
3021 $y = $exit->y;
3022 }
2894 3023
2895 $self->goto ($map, $x, $y); 3024 $self->goto ($map, $x, $y);
2896 3025
2897 # if exit is damned, update players death & WoR home-position 3026 # if exit is damned, update players death & WoR home-position
2898 $self->contr->savebed ($map, $x, $y) 3027 $self->contr->savebed ($map, $x, $y)
3123=cut 3252=cut
3124 3253
3125sub cf::client::ext_msg($$@) { 3254sub cf::client::ext_msg($$@) {
3126 my ($self, $type, @msg) = @_; 3255 my ($self, $type, @msg) = @_;
3127 3256
3128 if ($self->extcmd == 2) {
3129 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); 3257 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
3130 } elsif ($self->extcmd == 1) { # TODO: remove
3131 push @msg, msgtype => "event_$type";
3132 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
3133 }
3134}
3135
3136=item $client->ext_reply ($msgid, @msg)
3137
3138Sends an ext reply to the client.
3139
3140=cut
3141
3142sub cf::client::ext_reply($$@) {
3143 my ($self, $id, @msg) = @_;
3144
3145 if ($self->extcmd == 2) {
3146 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
3147 } elsif ($self->extcmd == 1) {
3148 #TODO: version 1, remove
3149 unshift @msg, msgtype => "reply", msgid => $id;
3150 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
3151 }
3152} 3258}
3153 3259
3154=item $success = $client->query ($flags, "text", \&cb) 3260=item $success = $client->query ($flags, "text", \&cb)
3155 3261
3156Queues a query to the client, calling the given callback with 3262Queues a query to the client, calling the given callback with
3211 my ($ns, $buf) = @_; 3317 my ($ns, $buf) = @_;
3212 3318
3213 my $msg = eval { $ns->{json_coder}->decode ($buf) }; 3319 my $msg = eval { $ns->{json_coder}->decode ($buf) };
3214 3320
3215 if (ref $msg) { 3321 if (ref $msg) {
3216 my ($type, $reply, @payload) = 3322 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
3217 "ARRAY" eq ref $msg
3218 ? @$msg
3219 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
3220 3323
3221 my @reply;
3222
3223 if (my $cb = $EXTICMD{$type}) { 3324 if (my $cb = $EXTIACMD{$type}) {
3325 $cb->(
3326 $ns,
3327 sub {
3328 $ns->ext_msg ("reply-$reply", @_)
3329 if $reply;
3330 },
3331 @payload
3332 );
3333 } else {
3334 my @reply;
3335
3336 if (my $cb = $EXTICMD{$type}) {
3224 @reply = $cb->($ns, @payload); 3337 @reply = $cb->($ns, @payload);
3338 }
3339
3340 $ns->ext_msg ("reply-$reply", @reply)
3341 if $reply;
3225 } 3342 }
3226
3227 $ns->ext_reply ($reply, @reply)
3228 if $reply;
3229
3230 } else { 3343 } else {
3231 error "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; 3344 error "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
3232 } 3345 }
3233 3346
3234 cf::override; 3347 cf::override;
3402=cut 3515=cut
3403 3516
3404############################################################################# 3517#############################################################################
3405# the server's init and main functions 3518# the server's init and main functions
3406 3519
3520{
3521 package cf::face;
3522
3523 our %HASH; # hash => idx
3524 our @DATA; # dynamically-created facedata, only faceste 0 used
3525 our @FOFS; # file offset, if > 0
3526 our @SIZE; # size of face, in octets
3527 our @META; # meta hash of face, if any
3528 our $DATAFH; # facedata filehandle
3529
3530 # internal api, not finalised
3531 sub set {
3532 my ($name, $type, $data) = @_;
3533
3534 my $idx = cf::face::find $name;
3535
3536 if ($idx) {
3537 delete $HASH{cf::face::get_chksum $idx};
3538 } else {
3539 $idx = cf::face::alloc $name;
3540 }
3541
3542 my $hash = cf::face::mangle_csum Digest::MD5::md5 $data;
3543
3544 cf::face::set_type $idx, $type;
3545 cf::face::set_csum $idx, 0, $hash;
3546
3547 # we need to destroy the SV itself, not just modify it, as a running ix
3548 # might hold a reference to it: "delete" achieves that.
3549 delete $FOFS[0][$idx];
3550 delete $DATA[0][$idx];
3551 $DATA[0][$idx] = $data;
3552 $SIZE[0][$idx] = length $data;
3553 delete $META[$idx];
3554 $HASH{$hash} = $idx;#d#
3555
3556 $idx
3557 }
3558
3559 sub _get_data($$$) {
3560 my ($idx, $set, $cb) = @_;
3561
3562 if (defined $DATA[$set][$idx]) {
3563 $cb->($DATA[$set][$idx]);
3564 } elsif (my $fofs = $FOFS[$set][$idx]) {
3565 my $size = $SIZE[$set][$idx];
3566 my $buf;
3567 IO::AIO::aio_read $DATAFH, $fofs, $size, $buf, 0, sub {
3568 if ($_[0] == $size) {
3569 #cf::debug "read face $idx, $size from $fofs as ", length $buf;#d#
3570 $cb->($buf);
3571 } else {
3572 cf::error "INTERNAL ERROR: unable to read facedata for face $idx#$set ($size, $fofs), ignoring request.";
3573 }
3574 };
3575 } else {
3576 cf::error "requested facedata for unknown face $idx#$set, ignoring.";
3577 }
3578 }
3579
3580 # rather ineffient
3581 sub cf::face::get_data($;$) {
3582 my ($idx, $set) = @_;
3583
3584 _get_data $idx, $set, Coro::rouse_cb;
3585 Coro::rouse_wait
3586 }
3587
3588 sub cf::face::ix {
3589 my ($ns, $set, $idx, $pri) = @_;
3590
3591 _get_data $idx, $set, sub {
3592 $ns->ix_send ($idx, $pri, $_[0]);
3593 };
3594 }
3595}
3596
3407sub load_facedata($) { 3597sub load_facedata($) {
3408 my ($path) = @_; 3598 my ($path) = @_;
3409 3599
3410 # HACK to clear player env face cache, we need some signal framework
3411 # for this (global event?)
3412 %ext::player_env::MUSIC_FACE_CACHE = ();
3413
3414 my $enc = JSON::XS->new->utf8->canonical->relaxed; 3600 my $enc = JSON::XS->new->utf8->canonical->relaxed;
3415 3601
3416 trace "loading facedata from $path\n"; 3602 trace "loading facedata from $path\n";
3417 3603
3418 0 < aio_load $path, my $facedata 3604 my $facedata = decode_storable load_file "$path/faceinfo";
3419 or die "$path: $!";
3420
3421 $facedata = Coro::Storable::thaw $facedata;
3422 3605
3423 $facedata->{version} == 2 3606 $facedata->{version} == 2
3424 or cf::cleanup "$path: version mismatch, cannot proceed."; 3607 or cf::cleanup "$path/faceinfo: version mismatch, cannot proceed.";
3425 3608
3426 # patch in the exptable 3609 my $fh = aio_open "$DATADIR/facedata", IO::AIO::O_RDONLY, 0
3427 my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]); 3610 or cf::cleanup "$path/facedata: $!, cannot proceed.";
3428 $facedata->{resource}{"res/exp_table"} = { 3611
3429 type => FT_RSRC, 3612 get_slot 1, -100, "load_facedata"; # make sure we get a very big slot
3430 data => $exp_table, 3613
3431 hash => (Digest::MD5::md5 $exp_table), 3614 # BEGIN ATOMIC
3432 }; 3615 # from here on, everything must be atomic - no thread switch allowed
3433 cf::cede_to_tick; 3616 my $t1 = EV::time;
3434 3617
3435 { 3618 {
3436 my $faces = $facedata->{faceinfo}; 3619 my $faces = $facedata->{faceinfo};
3437 3620
3438 while (my ($face, $info) = each %$faces) { 3621 for my $face (sort keys %$faces) {
3622 my $info = $faces->{$face};
3439 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3623 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3440 3624
3441 cf::face::set_visibility $idx, $info->{visibility}; 3625 cf::face::set_visibility $idx, $info->{visibility};
3442 cf::face::set_magicmap $idx, $info->{magicmap}; 3626 cf::face::set_magicmap $idx, $info->{magicmap};
3443 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32}; 3627 cf::face::set_csum $idx, 0, $info->{hash64}; $cf::face::SIZE[0][$idx] = $info->{size64}; $cf::face::FOFS[0][$idx] = $info->{fofs64};
3444 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64}; 3628 cf::face::set_csum $idx, 1, $info->{hash32}; $cf::face::SIZE[1][$idx] = $info->{size32}; $cf::face::FOFS[1][$idx] = $info->{fofs32};
3445 3629 cf::face::set_csum $idx, 2, $info->{glyph}; $cf::face::DATA[2][$idx] = $info->{glyph};
3446 cf::cede_to_tick; 3630 $cf::face::HASH{$info->{hash64}} = $idx;
3631 delete $cf::face::META[$idx];
3447 } 3632 }
3448 3633
3449 while (my ($face, $info) = each %$faces) { 3634 while (my ($face, $info) = each %$faces) {
3450 next unless $info->{smooth}; 3635 next unless $info->{smooth};
3451 3636
3456 cf::face::set_smooth $idx, $smooth; 3641 cf::face::set_smooth $idx, $smooth;
3457 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3642 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3458 } else { 3643 } else {
3459 error "smooth face '$info->{smooth}' not found for face '$face'"; 3644 error "smooth face '$info->{smooth}' not found for face '$face'";
3460 } 3645 }
3461
3462 cf::cede_to_tick;
3463 } 3646 }
3464 } 3647 }
3465 3648
3466 { 3649 {
3467 my $anims = $facedata->{animinfo}; 3650 my $anims = $facedata->{animinfo};
3468 3651
3469 while (my ($anim, $info) = each %$anims) { 3652 while (my ($anim, $info) = each %$anims) {
3470 cf::anim::set $anim, $info->{frames}, $info->{facings}; 3653 cf::anim::set $anim, $info->{frames}, $info->{facings};
3471 cf::cede_to_tick;
3472 } 3654 }
3473 3655
3474 cf::anim::invalidate_all; # d'oh 3656 cf::anim::invalidate_all; # d'oh
3475 } 3657 }
3476 3658
3477 { 3659 {
3478 my $res = $facedata->{resource}; 3660 my $res = $facedata->{resource};
3479 3661
3480 while (my ($name, $info) = each %$res) { 3662 while (my ($name, $info) = each %$res) {
3481 if (defined $info->{type}) { 3663 if (defined (my $type = $info->{type})) {
3664 # TODO: different hash - must free and use new index, or cache ixface data queue
3482 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3665 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3483 3666
3484 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3485 cf::face::set_type $idx, $info->{type}; 3667 cf::face::set_type $idx, $type;
3668 cf::face::set_csum $idx, 0, $info->{hash};
3669 $cf::face::SIZE[0][$idx] = $info->{size};
3670 $cf::face::FOFS[0][$idx] = $info->{fofs};
3671 $cf::face::META[$idx] = $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already
3672 $cf::face::HASH{$info->{hash}} = $idx;
3486 } else { 3673 } else {
3487 $RESOURCE{$name} = $info; # unused 3674# $RESOURCE{$name} = $info; # unused
3488 } 3675 }
3489
3490 cf::cede_to_tick;
3491 } 3676 }
3492 } 3677 }
3678
3679 ($fh, $cf::face::DATAFH) = ($cf::face::DATAFH, $fh);
3680
3681 # HACK to clear player env face cache, we need some signal framework
3682 # for this (global event?)
3683 %ext::player_env::MUSIC_FACE_CACHE = ();
3684
3685 # END ATOMIC
3686
3687 cf::debug "facedata atomic update time ", EV::time - $t1;
3493 3688
3494 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); 3689 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3690
3691 aio_close $fh if $fh; # close old facedata
3495 3692
3496 1 3693 1
3497} 3694}
3498 3695
3499register_exticmd fx_want => sub { 3696register_exticmd fx_want => sub {
3510 my $status = load_resource_file_ $_[0]; 3707 my $status = load_resource_file_ $_[0];
3511 get_slot 0.1, 100; 3708 get_slot 0.1, 100;
3512 cf::arch::commit_load; 3709 cf::arch::commit_load;
3513 3710
3514 $status 3711 $status
3712}
3713
3714sub reload_exp_table {
3715 _reload_exp_table;
3716
3717 cf::face::set
3718 "res/exp_table" => FT_RSRC,
3719 JSON::XS->new->utf8->canonical->encode (
3720 [map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]
3721 );
3722}
3723
3724sub reload_materials {
3725 _reload_materials;
3515} 3726}
3516 3727
3517sub reload_regions { 3728sub reload_regions {
3518 # HACK to clear player env face cache, we need some signal framework 3729 # HACK to clear player env face cache, we need some signal framework
3519 # for this (global event?) 3730 # for this (global event?)
3527 if exists $_->{match}; 3738 if exists $_->{match};
3528 } 3739 }
3529} 3740}
3530 3741
3531sub reload_facedata { 3742sub reload_facedata {
3532 load_facedata "$DATADIR/facedata" 3743 load_facedata $DATADIR
3533 or die "unable to load facedata\n"; 3744 or die "unable to load facedata\n";
3534} 3745}
3535 3746
3536sub reload_archetypes { 3747sub reload_archetypes {
3537 load_resource_file "$DATADIR/archetypes" 3748 load_resource_file "$DATADIR/archetypes"
3538 or die "unable to load archetypes\n"; 3749 or die "unable to load archetypes\n";
3750
3751 cf::face::set
3752 "res/skill_info" => FT_RSRC,
3753 JSON::XS->new->utf8->canonical->encode (
3754 [map [cf::arch::skillvec ($_)->name], 0 .. cf::arch::skillvec_size - 1]
3755 );
3756
3757 cf::face::set
3758 "res/spell_paths" => FT_RSRC,
3759 JSON::XS->new->utf8->canonical->encode (
3760 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
3761 );
3539} 3762}
3540 3763
3541sub reload_treasures { 3764sub reload_treasures {
3542 load_resource_file "$DATADIR/treasures" 3765 load_resource_file "$DATADIR/treasures"
3543 or die "unable to load treasurelists\n"; 3766 or die "unable to load treasurelists\n";
3544} 3767}
3545 3768
3546sub reload_sound { 3769sub reload_sound {
3547 trace "loading sound config from $DATADIR/sound\n"; 3770 trace "loading sound config from $DATADIR/sound\n";
3548 3771
3549 0 < Coro::AIO::aio_load "$DATADIR/sound", my $data
3550 or die "$DATADIR/sound $!";
3551
3552 my $soundconf = JSON::XS->new->utf8->relaxed->decode ($data); 3772 my $soundconf = JSON::XS->new->utf8->relaxed->decode (load_file "$DATADIR/sound");
3553 3773
3554 for (0 .. SOUND_CAST_SPELL_0 - 1) { 3774 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3555 my $sound = $soundconf->{compat}[$_] 3775 my $sound = $soundconf->{compat}[$_]
3556 or next; 3776 or next;
3557 3777
3567} 3787}
3568 3788
3569sub reload_resources { 3789sub reload_resources {
3570 trace "reloading resource files...\n"; 3790 trace "reloading resource files...\n";
3571 3791
3572 reload_exp_table;
3573 reload_materials; 3792 reload_materials;
3574 reload_facedata; 3793 reload_facedata;
3794 reload_exp_table;
3575 reload_sound; 3795 reload_sound;
3576 reload_archetypes; 3796 reload_archetypes;
3577 reload_regions; 3797 reload_regions;
3578 reload_treasures; 3798 reload_treasures;
3579 3799
3581} 3801}
3582 3802
3583sub reload_config { 3803sub reload_config {
3584 trace "reloading config file...\n"; 3804 trace "reloading config file...\n";
3585 3805
3586 0 < aio_load "$CONFDIR/config", my $config 3806 my $config = load_file "$CONFDIR/config";
3587 or die "$CONFDIR/config: $!";
3588
3589 utf8::decode $config; 3807 utf8::decode $config;
3590 *CFG = yaml_load $config; 3808 *CFG = decode_yaml $config;
3591 3809
3592 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38]; 3810 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3593 3811
3594 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3812 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3595 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3813 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3633 3851
3634sub main { 3852sub main {
3635 cf::init_globals; # initialise logging 3853 cf::init_globals; # initialise logging
3636 3854
3637 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3855 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3638 LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3856 LOG llevInfo, "Copyright (C) 2005-2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3639 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3857 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3640 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3858 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3641 3859
3642 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3860 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3643 3861
3644 # we must not ever block the main coroutine 3862 # we must not ever block the main coroutine
3645 local $Coro::idle = sub { 3863 $Coro::idle = sub {
3646 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3864 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3647 (async { 3865 (async {
3648 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3866 $Coro::current->{desc} = "IDLE BUG HANDLER";
3649 EV::loop EV::LOOP_ONESHOT; 3867 EV::loop EV::LOOP_ONESHOT;
3650 })->prio (Coro::PRIO_MAX); 3868 })->prio (Coro::PRIO_MAX);
3653 evthread_start IO::AIO::poll_fileno; 3871 evthread_start IO::AIO::poll_fileno;
3654 3872
3655 cf::sync_job { 3873 cf::sync_job {
3656 cf::incloader::init (); 3874 cf::incloader::init ();
3657 3875
3876 db_init;
3877
3658 cf::init_anim; 3878 cf::init_anim;
3659 cf::init_attackmess; 3879 cf::init_attackmess;
3660 cf::init_dynamic; 3880 cf::init_dynamic;
3661 3881
3662 cf::load_settings; 3882 cf::load_settings;
3663 3883
3664 reload_resources; 3884 reload_resources;
3665 reload_config; 3885 reload_config;
3666 db_init;
3667 3886
3668 cf::init_uuid; 3887 cf::init_uuid;
3669 cf::init_signals; 3888 cf::init_signals;
3670 cf::init_skills; 3889 cf::init_skills;
3671 3890
3685 }; 3904 };
3686 3905
3687 cf::object::thawer::errors_are_fatal 0; 3906 cf::object::thawer::errors_are_fatal 0;
3688 info "parse errors in files are no longer fatal from this point on.\n"; 3907 info "parse errors in files are no longer fatal from this point on.\n";
3689 3908
3690 my $free_main; $free_main = EV::idle sub { 3909 AE::postpone {
3691 undef $free_main;
3692 undef &main; # free gobs of memory :) 3910 undef &main; # free gobs of memory :)
3693 }; 3911 };
3694 3912
3695 goto &main_loop; 3913 goto &main_loop;
3696} 3914}
3853 4071
3854 cf::write_runtime_sync; # external watchdog should not bark 4072 cf::write_runtime_sync; # external watchdog should not bark
3855 4073
3856 trace "emergency_perl_save: flushing outstanding aio requests"; 4074 trace "emergency_perl_save: flushing outstanding aio requests";
3857 while (IO::AIO::nreqs || BDB::nreqs) { 4075 while (IO::AIO::nreqs || BDB::nreqs) {
3858 Coro::EV::timer_once 0.01; # let the sync_job do it's thing 4076 Coro::AnyEvent::sleep 0.01; # let the sync_job do it's thing
3859 } 4077 }
3860 4078
3861 cf::write_runtime_sync; # external watchdog should not bark 4079 cf::write_runtime_sync; # external watchdog should not bark
3862 }; 4080 };
3863 4081
4044 4262
4045############################################################################# 4263#############################################################################
4046 4264
4047my $bug_warning = 0; 4265my $bug_warning = 0;
4048 4266
4049our @WAIT_FOR_TICK;
4050our @WAIT_FOR_TICK_BEGIN;
4051
4052sub wait_for_tick() { 4267sub wait_for_tick() {
4053 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main; 4268 return Coro::AnyEvent::poll if tick_inhibit || $Coro::current == $Coro::main;
4054 4269
4055 my $signal = new Coro::Signal; 4270 $WAIT_FOR_TICK->wait;
4056 push @WAIT_FOR_TICK, $signal;
4057 $signal->wait;
4058} 4271}
4059 4272
4060sub wait_for_tick_begin() { 4273sub wait_for_tick_begin() {
4061 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main; 4274 return Coro::AnyEvent::poll if tick_inhibit || $Coro::current == $Coro::main;
4062 4275
4063 my $signal = new Coro::Signal; 4276 my $signal = new Coro::Signal;
4064 push @WAIT_FOR_TICK_BEGIN, $signal; 4277 push @WAIT_FOR_TICK_BEGIN, $signal;
4065 $signal->wait; 4278 $signal->wait;
4066} 4279}
4070 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 4283 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
4071 unless ++$bug_warning > 10; 4284 unless ++$bug_warning > 10;
4072 return; 4285 return;
4073 } 4286 }
4074 4287
4075 cf::server_tick; # one server iteration 4288 cf::one_tick; # one server iteration
4076 4289
4077 #for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d# 4290 #for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d#
4078 4291
4079 if ($NOW >= $NEXT_RUNTIME_WRITE) { 4292 if ($NOW >= $NEXT_RUNTIME_WRITE) {
4080 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 4293 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
4086 } 4299 }
4087 4300
4088 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 4301 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
4089 $sig->send; 4302 $sig->send;
4090 } 4303 }
4091 while (my $sig = shift @WAIT_FOR_TICK) { 4304 $WAIT_FOR_TICK->broadcast;
4092 $sig->send;
4093 }
4094 4305
4095 $LOAD = ($NOW - $TICK_START) / $TICK; 4306 $LOAD = ($NOW - $TICK_START) / $TICK;
4096 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 4307 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
4097 4308
4098 if (0) { 4309 if (0) {
4104 } 4315 }
4105} 4316}
4106 4317
4107{ 4318{
4108 # configure BDB 4319 # configure BDB
4320 info "initialising database";
4109 4321
4110 BDB::min_parallel 16; 4322 BDB::min_parallel 16;
4111 BDB::max_poll_reqs $TICK * 0.1; 4323 BDB::max_poll_reqs $TICK * 0.1;
4112 $AnyEvent::BDB::WATCHER->priority (1); 4324 #$AnyEvent::BDB::WATCHER->priority (1);
4113 4325
4114 unless ($DB_ENV) { 4326 unless ($DB_ENV) {
4115 $DB_ENV = BDB::db_env_create; 4327 $DB_ENV = BDB::db_env_create;
4116 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT); 4328 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
4117 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7; 4329 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;
4142 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { }; 4354 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
4143 }; 4355 };
4144 $BDB_TRICKLE_WATCHER = EV::periodic 0, 10, 0, sub { 4356 $BDB_TRICKLE_WATCHER = EV::periodic 0, 10, 0, sub {
4145 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { }; 4357 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
4146 }; 4358 };
4359
4360 info "database initialised";
4147} 4361}
4148 4362
4149{ 4363{
4150 # configure IO::AIO 4364 # configure IO::AIO
4151 4365
4366 info "initialising aio";
4152 IO::AIO::min_parallel 8; 4367 IO::AIO::min_parallel 8;
4153 IO::AIO::max_poll_time $TICK * 0.1; 4368 IO::AIO::max_poll_time $TICK * 0.1;
4154 undef $AnyEvent::AIO::WATCHER; 4369 undef $AnyEvent::AIO::WATCHER;
4370 info "aio initialised";
4155} 4371}
4156 4372
4157our $_log_backtrace; 4373our $_log_backtrace;
4158our $_log_backtrace_last; 4374our $_log_backtrace_last;
4159 4375

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines