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.476 by root, Wed Sep 2 16:54:20 2009 UTC vs.
Revision 1.531 by root, Wed Apr 28 21:07:41 2010 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 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 4# Copyright (©) 2006,2007,2008,2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5# 5#
6# Deliantra is free software: you can redistribute it and/or modify 6# Deliantra is free software: you can redistribute it and/or modify it under
7# it under the terms of the GNU General Public License as published by 7# the terms of the Affero GNU General Public License as published by the
8# the Free Software Foundation, either version 3 of the License, or 8# Free Software Foundation, either version 3 of the License, or (at your
9# (at your 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 GNU General Public License 16# You should have received a copy of the Affero GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>. 17# and the GNU General Public License along with this program. If not, see
18# <http://www.gnu.org/licenses/>.
18# 19#
19# 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>
20# 21#
21 22
22package cf; 23package cf;
23 24
24use 5.10.0; 25use 5.10.0;
25use utf8; 26use utf8;
… …
31use EV; 32use EV;
32use Opcode; 33use Opcode;
33use Safe; 34use Safe;
34use Safe::Hole; 35use Safe::Hole;
35use Storable (); 36use Storable ();
37use Carp ();
36 38
37use Guard (); 39use Guard ();
38use Coro (); 40use Coro ();
39use Coro::State; 41use Coro::State;
40use Coro::Handle; 42use Coro::Handle;
… …
51use Coro::Util (); 53use Coro::Util ();
52 54
53use JSON::XS 2.01 (); 55use JSON::XS 2.01 ();
54use BDB (); 56use BDB ();
55use Data::Dumper; 57use Data::Dumper;
56use Digest::MD5;
57use Fcntl; 58use Fcntl;
58use YAML (); 59use YAML::XS ();
59use IO::AIO (); 60use IO::AIO ();
60use Time::HiRes; 61use Time::HiRes;
61use Compress::LZF; 62use Compress::LZF;
62use Digest::MD5 (); 63use Digest::MD5 ();
63 64
… …
88our %EXT_CORO = (); # coroutines bound to extensions 89our %EXT_CORO = (); # coroutines bound to extensions
89our %EXT_MAP = (); # pluggable maps 90our %EXT_MAP = (); # pluggable maps
90 91
91our $RELOAD; # number of reloads so far, non-zero while in reload 92our $RELOAD; # number of reloads so far, non-zero while in reload
92our @EVENT; 93our @EVENT;
94our @REFLECT; # set by XS
95our %REFLECT; # set by us
93 96
94our $CONFDIR = confdir; 97our $CONFDIR = confdir;
95our $DATADIR = datadir; 98our $DATADIR = datadir;
96our $LIBDIR = "$DATADIR/ext"; 99our $LIBDIR = "$DATADIR/ext";
97our $PODDIR = "$DATADIR/pod"; 100our $PODDIR = "$DATADIR/pod";
… …
103our $RANDOMDIR = "$LOCALDIR/random"; 106our $RANDOMDIR = "$LOCALDIR/random";
104our $BDBDIR = "$LOCALDIR/db"; 107our $BDBDIR = "$LOCALDIR/db";
105our $PIDFILE = "$LOCALDIR/pid"; 108our $PIDFILE = "$LOCALDIR/pid";
106our $RUNTIMEFILE = "$LOCALDIR/runtime"; 109our $RUNTIMEFILE = "$LOCALDIR/runtime";
107 110
108our %RESOURCE; 111our %RESOURCE; # unused
112
113our $OUTPUT_RATE_MIN = 3000;
114our $OUTPUT_RATE_MAX = 1000000;
115
116our $MAX_LINKS = 32; # how many chained exits to follow
117our $VERBOSE_IO = 1;
109 118
110our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 119our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
111our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 120our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
112our $NEXT_TICK; 121our $NEXT_TICK;
113our $USE_FSYNC = 1; # use fsync to write maps - default on 122our $USE_FSYNC = 1; # use fsync to write maps - default on
… …
115our $BDB_DEADLOCK_WATCHER; 124our $BDB_DEADLOCK_WATCHER;
116our $BDB_CHECKPOINT_WATCHER; 125our $BDB_CHECKPOINT_WATCHER;
117our $BDB_TRICKLE_WATCHER; 126our $BDB_TRICKLE_WATCHER;
118our $DB_ENV; 127our $DB_ENV;
119 128
120our @EXTRA_MODULES = qw(pod mapscript); 129our @EXTRA_MODULES = qw(pod match mapscript);
121 130
122our %CFG; 131our %CFG;
123 132
124our $UPTIME; $UPTIME ||= time; 133our $UPTIME; $UPTIME ||= time;
125our $RUNTIME; 134our $RUNTIME;
… …
159 168
160our $EMERGENCY_POSITION; 169our $EMERGENCY_POSITION;
161 170
162sub cf::map::normalise; 171sub cf::map::normalise;
163 172
173sub in_main() {
174 $Coro::current == $Coro::main
175}
176
177#############################################################################
178
179%REFLECT = ();
180for (@REFLECT) {
181 my $reflect = JSON::XS::decode_json $_;
182 $REFLECT{$reflect->{class}} = $reflect;
183}
184
185# this is decidedly evil
186$REFLECT{object}{flags} = { map +($_ => undef), grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"} };
187
164############################################################################# 188#############################################################################
165 189
166=head2 GLOBAL VARIABLES 190=head2 GLOBAL VARIABLES
167 191
168=over 4 192=over 4
… …
214returns directly I<after> the tick processing (and consequently, can only wake one process 238returns directly I<after> the tick processing (and consequently, can only wake one process
215per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 239per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
216 240
217=item @cf::INVOKE_RESULTS 241=item @cf::INVOKE_RESULTS
218 242
219This array contains the results of the last C<invoke ()> call. When 243This array contains the results of the last C<invoke ()> call. When
220C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of 244C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
221that call. 245that call.
222 246
247=item %cf::REFLECT
248
249Contains, for each (C++) class name, a hash reference with information
250about object members (methods, scalars, arrays and flags) and other
251metadata, which is useful for introspection.
252
223=back 253=back
224 254
225=cut 255=cut
226 256
227BEGIN { 257$Coro::State::WARNHOOK = sub {
228 *CORE::GLOBAL::warn = sub {
229 my $msg = join "", @_; 258 my $msg = join "", @_;
230 259
231 $msg .= "\n" 260 $msg .= "\n"
232 unless $msg =~ /\n$/; 261 unless $msg =~ /\n$/;
233 262
234 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 263 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
235 264
236 LOG llevError, $msg; 265 LOG llevError, $msg;
237 }; 266};
238}
239 267
240$Coro::State::DIEHOOK = sub { 268$Coro::State::DIEHOOK = sub {
241 return unless $^S eq 0; # "eq", not "==" 269 return unless $^S eq 0; # "eq", not "=="
242 270
243 if ($Coro::current == $Coro::main) {#d# 271 warn Carp::longmess $_[0];
272
273 if (in_main) {#d#
244 warn "DIEHOOK called in main context, Coro bug?\n";#d# 274 warn "DIEHOOK called in main context, Coro bug?\n";#d#
245 return;#d# 275 return;#d#
246 }#d# 276 }#d#
247 277
248 # kill coroutine otherwise 278 # kill coroutine otherwise
249 warn Carp::longmess $_[0];
250 Coro::terminate 279 Coro::terminate
251}; 280};
252
253$SIG{__DIE__} = sub { }; #d#?
254 281
255@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 282@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
256@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 283@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
257@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 284@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
258@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 285@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
272)) { 299)) {
273 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 300 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
274} 301}
275 302
276$EV::DIED = sub { 303$EV::DIED = sub {
277 warn "error in event callback: @_"; 304 Carp::cluck "error in event callback: @_";
278}; 305};
279 306
280############################################################################# 307#############################################################################
281 308
282=head2 UTILITY FUNCTIONS 309=head2 UTILITY FUNCTIONS
… …
379} 406}
380 407
381=item cf::periodic $interval, $cb 408=item cf::periodic $interval, $cb
382 409
383Like EV::periodic, but randomly selects a starting point so that the actions 410Like EV::periodic, but randomly selects a starting point so that the actions
384get spread over timer. 411get spread over time.
385 412
386=cut 413=cut
387 414
388sub periodic($$) { 415sub periodic($$) {
389 my ($interval, $cb) = @_; 416 my ($interval, $cb) = @_;
… …
406 433
407=cut 434=cut
408 435
409our @SLOT_QUEUE; 436our @SLOT_QUEUE;
410our $SLOT_QUEUE; 437our $SLOT_QUEUE;
438our $SLOT_DECAY = 0.9;
411 439
412$SLOT_QUEUE->cancel if $SLOT_QUEUE; 440$SLOT_QUEUE->cancel if $SLOT_QUEUE;
413$SLOT_QUEUE = Coro::async { 441$SLOT_QUEUE = Coro::async {
414 $Coro::current->desc ("timeslot manager"); 442 $Coro::current->desc ("timeslot manager");
415 443
416 my $signal = new Coro::Signal; 444 my $signal = new Coro::Signal;
445 my $busy;
417 446
418 while () { 447 while () {
419 next_job: 448 next_job:
449
420 my $avail = cf::till_tick; 450 my $avail = cf::till_tick;
421 if ($avail > 0.01) { 451
422 for (0 .. $#SLOT_QUEUE) { 452 for (0 .. $#SLOT_QUEUE) {
423 if ($SLOT_QUEUE[$_][0] < $avail) { 453 if ($SLOT_QUEUE[$_][0] <= $avail) {
454 $busy = 0;
424 my $job = splice @SLOT_QUEUE, $_, 1, (); 455 my $job = splice @SLOT_QUEUE, $_, 1, ();
425 $job->[2]->send; 456 $job->[2]->send;
426 Coro::cede; 457 Coro::cede;
427 goto next_job; 458 goto next_job;
428 } 459 } else {
460 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
429 } 461 }
430 } 462 }
431 463
432 if (@SLOT_QUEUE) { 464 if (@SLOT_QUEUE) {
433 # we do not use wait_for_tick() as it returns immediately when tick is inactive 465 # we do not use wait_for_tick() as it returns immediately when tick is inactive
434 push @cf::WAIT_FOR_TICK, $signal; 466 push @cf::WAIT_FOR_TICK, $signal;
435 $signal->wait; 467 $signal->wait;
436 } else { 468 } else {
469 $busy = 0;
437 Coro::schedule; 470 Coro::schedule;
438 } 471 }
439 } 472 }
440}; 473};
441 474
442sub get_slot($;$$) { 475sub get_slot($;$$) {
443 return if tick_inhibit || $Coro::current == $Coro::main; 476 return if tick_inhibit || $Coro::current == $Coro::main;
444 477
445 my ($time, $pri, $name) = @_; 478 my ($time, $pri, $name) = @_;
446 479
447 $time = $TICK * .6 if $time > $TICK * .6; 480 $time = clamp $time, 0.01, $TICK * .6;
481
448 my $sig = new Coro::Signal; 482 my $sig = new Coro::Signal;
449 483
450 push @SLOT_QUEUE, [$time, $pri, $sig, $name]; 484 push @SLOT_QUEUE, [$time, $pri, $sig, $name];
451 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE; 485 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE;
452 $SLOT_QUEUE->ready; 486 $SLOT_QUEUE->ready;
… …
479 513
480sub sync_job(&) { 514sub sync_job(&) {
481 my ($job) = @_; 515 my ($job) = @_;
482 516
483 if ($Coro::current == $Coro::main) { 517 if ($Coro::current == $Coro::main) {
484 my $time = EV::time; 518 my $time = AE::time;
485 519
486 # this is the main coro, too bad, we have to block 520 # this is the main coro, too bad, we have to block
487 # till the operation succeeds, freezing the server :/ 521 # till the operation succeeds, freezing the server :/
488 522
489 LOG llevError, Carp::longmess "sync job";#d# 523 LOG llevError, Carp::longmess "sync job";#d#
… …
506 } else { 540 } else {
507 EV::loop EV::LOOP_ONESHOT; 541 EV::loop EV::LOOP_ONESHOT;
508 } 542 }
509 } 543 }
510 544
511 my $time = EV::time - $time; 545 my $time = AE::time - $time;
512 546
513 $TICK_START += $time; # do not account sync jobs to server load 547 $TICK_START += $time; # do not account sync jobs to server load
514 548
515 wantarray ? @res : $res[0] 549 wantarray ? @res : $res[0]
516 } else { 550 } else {
… …
560 reset_signals; 594 reset_signals;
561 &$cb 595 &$cb
562 }, @args; 596 }, @args;
563 597
564 wantarray ? @res : $res[-1] 598 wantarray ? @res : $res[-1]
599}
600
601sub objinfo {
602 (
603 "counter value" => cf::object::object_count,
604 "objects created" => cf::object::create_count,
605 "objects destroyed" => cf::object::destroy_count,
606 "freelist size" => cf::object::free_count,
607 "allocated objects" => cf::object::objects_size,
608 "active objects" => cf::object::actives_size,
609 )
565} 610}
566 611
567=item $coin = coin_from_name $name 612=item $coin = coin_from_name $name
568 613
569=cut 614=cut
… …
1150 1195
1151 sync_job { 1196 sync_job {
1152 if (length $$rdata) { 1197 if (length $$rdata) {
1153 utf8::decode (my $decname = $filename); 1198 utf8::decode (my $decname = $filename);
1154 warn sprintf "saving %s (%d,%d)\n", 1199 warn sprintf "saving %s (%d,%d)\n",
1155 $decname, length $$rdata, scalar @$objs; 1200 $decname, length $$rdata, scalar @$objs
1201 if $VERBOSE_IO;
1156 1202
1157 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1203 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1158 aio_chmod $fh, SAVE_MODE; 1204 aio_chmod $fh, SAVE_MODE;
1159 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1205 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1160 if ($cf::USE_FSYNC) { 1206 if ($cf::USE_FSYNC) {
… …
1217 $av = $st->{objs}; 1263 $av = $st->{objs};
1218 } 1264 }
1219 1265
1220 utf8::decode (my $decname = $filename); 1266 utf8::decode (my $decname = $filename);
1221 warn sprintf "loading %s (%d,%d)\n", 1267 warn sprintf "loading %s (%d,%d)\n",
1222 $decname, length $data, scalar @{$av || []}; 1268 $decname, length $data, scalar @{$av || []}
1269 if $VERBOSE_IO;
1223 1270
1224 ($data, $av) 1271 ($data, $av)
1225} 1272}
1226 1273
1227=head2 COMMAND CALLBACKS 1274=head2 COMMAND CALLBACKS
… …
1286} 1333}
1287 1334
1288use File::Glob (); 1335use File::Glob ();
1289 1336
1290cf::player->attach ( 1337cf::player->attach (
1291 on_command => sub { 1338 on_unknown_command => sub {
1292 my ($pl, $name, $params) = @_; 1339 my ($pl, $name, $params) = @_;
1293 1340
1294 my $cb = $COMMAND{$name} 1341 my $cb = $COMMAND{$name}
1295 or return; 1342 or return;
1296 1343
… …
1375 . "\n};\n1"; 1422 . "\n};\n1";
1376 1423
1377 $todo{$base} = \%ext; 1424 $todo{$base} = \%ext;
1378 } 1425 }
1379 1426
1427 my $pass = 0;
1380 my %done; 1428 my %done;
1381 while (%todo) { 1429 while (%todo) {
1382 my $progress; 1430 my $progress;
1383 1431
1432 ++$pass;
1433
1434 ext:
1384 while (my ($k, $v) = each %todo) { 1435 while (my ($k, $v) = each %todo) {
1385 for (split /,\s*/, $v->{meta}{depends}) { 1436 for (split /,\s*/, $v->{meta}{depends}) {
1386 goto skip 1437 next ext
1387 unless exists $done{$_}; 1438 unless exists $done{$_};
1388 } 1439 }
1389 1440
1390 warn "... loading '$k' into '$v->{pkg}'\n"; 1441 warn "... pass $pass, loading '$k' into '$v->{pkg}'\n";
1391 1442
1392 unless (eval $v->{source}) { 1443 my $active = eval $v->{source};
1444
1445 if (length $@) {
1393 my $msg = $@ ? "$v->{path}: $@\n" 1446 warn "$v->{path}: $@\n";
1394 : "$v->{base}: extension inactive.\n";
1395 1447
1396 if (exists $v->{meta}{mandatory}) {
1397 warn $msg;
1398 cf::cleanup "mandatory extension failed to load, exiting."; 1448 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1399 } 1449 if exists $v->{meta}{mandatory};
1400 1450
1401 warn $msg; 1451 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
1452 delete $todo{$k};
1453 } else {
1454 $done{$k} = delete $todo{$k};
1455 push @EXTS, $v->{pkg};
1456 $progress = 1;
1457
1458 warn "$v->{base}: extension inactive.\n"
1459 unless $active;
1402 } 1460 }
1403
1404 $done{$k} = delete $todo{$k};
1405 push @EXTS, $v->{pkg};
1406 $progress = 1;
1407 } 1461 }
1408 1462
1409 skip: 1463 unless ($progress) {
1410 die "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n" 1464 warn "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n";
1411 unless $progress; 1465
1466 while (my ($k, $v) = each %todo) {
1467 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
1468 if exists $v->{meta}{mandatory};
1469 }
1470 }
1412 } 1471 }
1413 }; 1472 };
1414} 1473}
1415 1474
1416############################################################################# 1475#############################################################################
… …
1500 $cf::PLAYER{$login} = $pl 1559 $cf::PLAYER{$login} = $pl
1501 } 1560 }
1502 } 1561 }
1503} 1562}
1504 1563
1564cf::player->attach (
1565 on_load => sub {
1566 my ($pl, $path) = @_;
1567
1568 # restore slots saved in save, below
1569 my $slots = delete $pl->{_slots};
1570
1571 $pl->ob->current_weapon ($slots->[0]);
1572 $pl->combat_ob ($slots->[1]);
1573 $pl->ranged_ob ($slots->[2]);
1574 },
1575);
1576
1505sub save($) { 1577sub save($) {
1506 my ($pl) = @_; 1578 my ($pl) = @_;
1507 1579
1508 return if $pl->{deny_save}; 1580 return if $pl->{deny_save};
1509 1581
… …
1514 1586
1515 aio_mkdir playerdir $pl, 0770; 1587 aio_mkdir playerdir $pl, 0770;
1516 $pl->{last_save} = $cf::RUNTIME; 1588 $pl->{last_save} = $cf::RUNTIME;
1517 1589
1518 cf::get_slot 0.01; 1590 cf::get_slot 0.01;
1591
1592 # save slots, to be restored later
1593 local $pl->{_slots} = [$pl->ob->current_weapon, $pl->combat_ob, $pl->ranged_ob];
1519 1594
1520 $pl->save_pl ($path); 1595 $pl->save_pl ($path);
1521 cf::cede_to_tick; 1596 cf::cede_to_tick;
1522} 1597}
1523 1598
… …
1560 $pl->password ("*"); # this should lock out the player until we have nuked the dir 1635 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1561 1636
1562 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1637 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1563 $pl->deactivate; 1638 $pl->deactivate;
1564 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1639 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1565 $pl->ob->check_score;
1566 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1640 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1567 $pl->ns->destroy if $pl->ns; 1641 $pl->ns->destroy if $pl->ns;
1568 1642
1569 my $path = playerdir $pl; 1643 my $path = playerdir $pl;
1570 my $temp = "$path~$cf::RUNTIME~deleting~"; 1644 my $temp = "$path~$cf::RUNTIME~deleting~";
… …
1625 \@logins 1699 \@logins
1626} 1700}
1627 1701
1628=item $player->maps 1702=item $player->maps
1629 1703
1704=item cf::player::maps $login
1705
1630Returns an arrayref of map paths that are private for this 1706Returns an arrayref of map paths that are private for this
1631player. May block. 1707player. May block.
1632 1708
1633=cut 1709=cut
1634 1710
… …
1696=cut 1772=cut
1697 1773
1698sub find_by_path($) { 1774sub find_by_path($) {
1699 my ($path) = @_; 1775 my ($path) = @_;
1700 1776
1777 $path =~ s/^~[^\/]*//; # skip ~login
1778
1701 my ($match, $specificity); 1779 my ($match, $specificity);
1702 1780
1703 for my $region (list) { 1781 for my $region (list) {
1704 if ($region->{match} && $path =~ $region->{match}) { 1782 if ($region->{match} && $path =~ $region->{match}) {
1705 ($match, $specificity) = ($region, $region->specificity) 1783 ($match, $specificity) = ($region, $region->specificity)
… …
1736 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM 1814 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
1737 1815
1738 # mit "rum" bekleckern, nicht 1816 # mit "rum" bekleckern, nicht
1739 $self->_create_random_map ( 1817 $self->_create_random_map (
1740 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1818 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1741 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1819 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, $rmp->{miningstyle},
1742 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1820 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1743 $rmp->{exit_on_final_map}, 1821 $rmp->{exit_on_final_map},
1744 $rmp->{xsize}, $rmp->{ysize}, 1822 $rmp->{xsize}, $rmp->{ysize},
1745 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1823 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1746 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1824 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
… …
1768 1846
1769 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1847 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1770} 1848}
1771 1849
1772# also paths starting with '/' 1850# also paths starting with '/'
1773$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}]; 1851$EXT_MAP{"cf::map::wrap"} = [0, qr{^(?=/)}];
1774 1852
1775sub thawer_merge { 1853sub thawer_merge {
1776 my ($self, $merge) = @_; 1854 my ($self, $merge) = @_;
1777 1855
1778 # we have to keep some variables in memory intact 1856 # we have to keep some variables in memory intact
… …
1992 2070
1993 $cf::MAP{$path} = $map 2071 $cf::MAP{$path} = $map
1994 } 2072 }
1995} 2073}
1996 2074
1997sub pre_load { } 2075sub pre_load { }
1998sub post_load { } 2076#sub post_load { } # XS
1999 2077
2000sub load { 2078sub load {
2001 my ($self) = @_; 2079 my ($self) = @_;
2002 2080
2003 local $self->{deny_reset} = 1; # loading can take a long time 2081 local $self->{deny_reset} = 1; # loading can take a long time
… …
2060 } 2138 }
2061 2139
2062 $self->post_load; 2140 $self->post_load;
2063} 2141}
2064 2142
2143# customize the map for a given player, i.e.
2144# return the _real_ map. used by e.g. per-player
2145# maps to change the path to ~playername/mappath
2065sub customise_for { 2146sub customise_for {
2066 my ($self, $ob) = @_; 2147 my ($self, $ob) = @_;
2067 2148
2068 return find "~" . $ob->name . "/" . $self->{path} 2149 return find "~" . $ob->name . "/" . $self->{path}
2069 if $self->per_player; 2150 if $self->per_player;
… …
2085 or next; 2166 or next;
2086 $neigh = find $neigh, $map 2167 $neigh = find $neigh, $map
2087 or next; 2168 or next;
2088 $neigh->load; 2169 $neigh->load;
2089 2170
2171 # now find the diagonal neighbours
2090 push @neigh, 2172 push @neigh,
2091 [$neigh->tile_path (($_ + 3) % 4), $neigh], 2173 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2092 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 2174 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2093 } 2175 }
2094 2176
… …
2146 $MAP_PREFETCHER->prio (6); 2228 $MAP_PREFETCHER->prio (6);
2147 2229
2148 () 2230 ()
2149} 2231}
2150 2232
2233# common code, used by both ->save and ->swapout
2151sub save { 2234sub _save {
2152 my ($self) = @_; 2235 my ($self) = @_;
2153
2154 my $lock = cf::lock_acquire "map_data:$self->{path}";
2155 2236
2156 $self->{last_save} = $cf::RUNTIME; 2237 $self->{last_save} = $cf::RUNTIME;
2157 2238
2158 return unless $self->dirty; 2239 return unless $self->dirty;
2159 2240
… …
2179 } else { 2260 } else {
2180 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 2261 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
2181 } 2262 }
2182} 2263}
2183 2264
2265sub save {
2266 my ($self) = @_;
2267
2268 my $lock = cf::lock_acquire "map_data:$self->{path}";
2269
2270 $self->_save;
2271}
2272
2184sub swap_out { 2273sub swap_out {
2185 my ($self) = @_; 2274 my ($self) = @_;
2186 2275
2187 # save first because save cedes
2188 $self->save;
2189
2190 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2276 my $lock = cf::lock_acquire "map_data:$self->{path}";
2191 2277
2192 return if $self->players;
2193 return if $self->in_memory != cf::MAP_ACTIVE; 2278 return if $self->in_memory != cf::MAP_ACTIVE;
2194 return if $self->{deny_save}; 2279 return if $self->{deny_save};
2280 return if $self->players;
2195 2281
2282 # first deactivate the map and "unlink" it from the core
2283 $self->deactivate;
2284 $_->clear_links_to ($self) for values %cf::MAP;
2196 $self->in_memory (cf::MAP_SWAPPED); 2285 $self->in_memory (cf::MAP_SWAPPED);
2286
2287 # then atomically save
2288 $self->_save;
2289
2290 # then free the map
2291 $self->clear;
2292}
2293
2294sub reset_at {
2295 my ($self) = @_;
2296
2297 # TODO: safety, remove and allow resettable per-player maps
2298 return 1e99 if $self->{deny_reset};
2299
2300 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2301 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2302
2303 $time + $to
2304}
2305
2306sub should_reset {
2307 my ($self) = @_;
2308
2309 $self->reset_at <= $cf::RUNTIME
2310}
2311
2312sub reset {
2313 my ($self) = @_;
2314
2315 my $lock = cf::lock_acquire "map_data:$self->{path}";
2316
2317 return if $self->players;
2318
2319 warn "resetting map ", $self->path, "\n";
2320
2321 $self->in_memory (cf::MAP_SWAPPED);
2322
2323 # need to save uniques path
2324 unless ($self->{deny_save}) {
2325 my $uniq = $self->uniq_path; utf8::encode $uniq;
2326
2327 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2328 if $uniq;
2329 }
2330
2331 delete $cf::MAP{$self->path};
2197 2332
2198 $self->deactivate; 2333 $self->deactivate;
2199 $_->clear_links_to ($self) for values %cf::MAP; 2334 $_->clear_links_to ($self) for values %cf::MAP;
2200 $self->clear; 2335 $self->clear;
2201}
2202
2203sub reset_at {
2204 my ($self) = @_;
2205
2206 # TODO: safety, remove and allow resettable per-player maps
2207 return 1e99 if $self->{deny_reset};
2208
2209 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2210 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2211
2212 $time + $to
2213}
2214
2215sub should_reset {
2216 my ($self) = @_;
2217
2218 $self->reset_at <= $cf::RUNTIME
2219}
2220
2221sub reset {
2222 my ($self) = @_;
2223
2224 my $lock = cf::lock_acquire "map_data:$self->{path}";
2225
2226 return if $self->players;
2227
2228 warn "resetting map ", $self->path;
2229
2230 $self->in_memory (cf::MAP_SWAPPED);
2231
2232 # need to save uniques path
2233 unless ($self->{deny_save}) {
2234 my $uniq = $self->uniq_path; utf8::encode $uniq;
2235
2236 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2237 if $uniq;
2238 }
2239
2240 delete $cf::MAP{$self->path};
2241
2242 $self->deactivate;
2243 $_->clear_links_to ($self) for values %cf::MAP;
2244 $self->clear;
2245 2336
2246 $self->unlink_save; 2337 $self->unlink_save;
2247 $self->destroy; 2338 $self->destroy;
2248} 2339}
2249 2340
… …
2257 2348
2258 delete $cf::MAP{$self->path}; 2349 delete $cf::MAP{$self->path};
2259 2350
2260 $self->unlink_save; 2351 $self->unlink_save;
2261 2352
2262 bless $self, "cf::map"; 2353 bless $self, "cf::map::wrap";
2263 delete $self->{deny_reset}; 2354 delete $self->{deny_reset};
2264 $self->{deny_save} = 1; 2355 $self->{deny_save} = 1;
2265 $self->reset_timeout (1); 2356 $self->reset_timeout (1);
2266 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2357 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2267 2358
… …
2324 : normalise $_ 2415 : normalise $_
2325 } @{ aio_readdir $UNIQUEDIR or [] } 2416 } @{ aio_readdir $UNIQUEDIR or [] }
2326 ] 2417 ]
2327} 2418}
2328 2419
2420=item cf::map::static_maps
2421
2422Returns an arrayref if paths of all static maps (all preinstalled F<.map>
2423file in the shared directory excluding F</styles> and F</editor>). May
2424block.
2425
2426=cut
2427
2428sub static_maps() {
2429 my @dirs = "";
2430 my @maps;
2431
2432 while (@dirs) {
2433 my $dir = shift @dirs;
2434
2435 next if $dir eq "/styles" || $dir eq "/editor";
2436
2437 my ($dirs, $files) = Coro::AIO::aio_scandir "$MAPDIR$dir", 2
2438 or return;
2439
2440 for (@$files) {
2441 s/\.map$// or next;
2442 utf8::decode $_;
2443 push @maps, "$dir/$_";
2444 }
2445
2446 push @dirs, map "$dir/$_", @$dirs;
2447 }
2448
2449 \@maps
2450}
2451
2329=back 2452=back
2330 2453
2331=head3 cf::object 2454=head3 cf::object
2332 2455
2333=cut 2456=cut
… …
2465 2588
2466Freezes the player and moves him/her to a special map (C<{link}>). 2589Freezes the player and moves him/her to a special map (C<{link}>).
2467 2590
2468The player should be reasonably safe there for short amounts of time (e.g. 2591The player should be reasonably safe there for short amounts of time (e.g.
2469for loading a map). You I<MUST> call C<leave_link> as soon as possible, 2592for loading a map). You I<MUST> call C<leave_link> as soon as possible,
2470though, as the palyer cannot control the character while it is on the link 2593though, as the player cannot control the character while it is on the link
2471map. 2594map.
2472 2595
2473Will never block. 2596Will never block.
2474 2597
2475=item $player_object->leave_link ($map, $x, $y) 2598=item $player_object->leave_link ($map, $x, $y)
… …
2496sub cf::object::player::enter_link { 2619sub cf::object::player::enter_link {
2497 my ($self) = @_; 2620 my ($self) = @_;
2498 2621
2499 $self->deactivate_recursive; 2622 $self->deactivate_recursive;
2500 2623
2624 ++$self->{_link_recursion};
2625
2501 return if UNIVERSAL::isa $self->map, "ext::map_link"; 2626 return if UNIVERSAL::isa $self->map, "ext::map_link";
2502 2627
2503 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 2628 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
2504 if $self->map && $self->map->{path} ne "{link}"; 2629 if $self->map && $self->map->{path} ne "{link}";
2505 2630
2506 $self->enter_map ($LINK_MAP || link_map, 10, 10); 2631 $self->enter_map ($LINK_MAP || link_map, 3, 3);
2507} 2632}
2508 2633
2509sub cf::object::player::leave_link { 2634sub cf::object::player::leave_link {
2510 my ($self, $map, $x, $y) = @_; 2635 my ($self, $map, $x, $y) = @_;
2511 2636
… …
2528 ($x, $y) = (-1, -1) 2653 ($x, $y) = (-1, -1)
2529 unless (defined $x) && (defined $y); 2654 unless (defined $x) && (defined $y);
2530 2655
2531 # use -1 or undef as default coordinates, not 0, 0 2656 # use -1 or undef as default coordinates, not 0, 0
2532 ($x, $y) = ($map->enter_x, $map->enter_y) 2657 ($x, $y) = ($map->enter_x, $map->enter_y)
2533 if $x <=0 && $y <= 0; 2658 if $x <= 0 && $y <= 0;
2534 2659
2535 $map->load; 2660 $map->load;
2536 $map->load_neighbours; 2661 $map->load_neighbours;
2537 2662
2538 return unless $self->contr->active; 2663 return unless $self->contr->active;
2539 2664
2540 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2665 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2541 $self->enter_map ($map, $x, $y); 2666 if ($self->enter_map ($map, $x, $y)) {
2542 2667 # entering was successful
2668 delete $self->{_link_recursion};
2543 # only activate afterwards, to support waiting in hooks 2669 # only activate afterwards, to support waiting in hooks
2544 $self->activate_recursive; 2670 $self->activate_recursive;
2545} 2671 }
2546 2672
2673}
2674
2547=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2675=item $player_object->goto ($path, $x, $y[, $check->($map, $x, $y, $player)[, $done->($player)]])
2548 2676
2549Moves the player to the given map-path and coordinates by first freezing 2677Moves the player to the given map-path and coordinates by first freezing
2550her, loading and preparing them map, calling the provided $check callback 2678her, loading and preparing them map, calling the provided $check callback
2551that has to return the map if sucecssful, and then unfreezes the player on 2679that has to return the map if sucecssful, and then unfreezes the player on
2552the new (success) or old (failed) map position. In either case, $done will 2680the new (success) or old (failed) map position. In either case, $done will
… …
2559 2687
2560our $GOTOGEN; 2688our $GOTOGEN;
2561 2689
2562sub cf::object::player::goto { 2690sub cf::object::player::goto {
2563 my ($self, $path, $x, $y, $check, $done) = @_; 2691 my ($self, $path, $x, $y, $check, $done) = @_;
2692
2693 if ($self->{_link_recursion} >= $MAX_LINKS) {
2694 warn "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting.";
2695 $self->failmsg ("Something went wrong inside the server - please contact an administrator!");
2696 ($path, $x, $y) = @$EMERGENCY_POSITION;
2697 }
2564 2698
2565 # do generation counting so two concurrent goto's will be executed in-order 2699 # do generation counting so two concurrent goto's will be executed in-order
2566 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2700 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2567 2701
2568 $self->enter_link; 2702 $self->enter_link;
… …
2592 my $map = eval { 2726 my $map = eval {
2593 my $map = defined $path ? cf::map::find $path : undef; 2727 my $map = defined $path ? cf::map::find $path : undef;
2594 2728
2595 if ($map) { 2729 if ($map) {
2596 $map = $map->customise_for ($self); 2730 $map = $map->customise_for ($self);
2597 $map = $check->($map) if $check && $map; 2731 $map = $check->($map, $x, $y, $self) if $check && $map;
2598 } else { 2732 } else {
2599 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED); 2733 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED);
2600 } 2734 }
2601 2735
2602 $map 2736 $map
… …
2610 if ($gen == $self->{_goto_generation}) { 2744 if ($gen == $self->{_goto_generation}) {
2611 delete $self->{_goto_generation}; 2745 delete $self->{_goto_generation};
2612 $self->leave_link ($map, $x, $y); 2746 $self->leave_link ($map, $x, $y);
2613 } 2747 }
2614 2748
2615 $done->() if $done; 2749 $done->($self) if $done;
2616 })->prio (1); 2750 })->prio (1);
2617} 2751}
2618 2752
2619=item $player_object->enter_exit ($exit_object) 2753=item $player_object->enter_exit ($exit_object)
2620 2754
… …
2737 2871
2738 utf8::encode $text; 2872 utf8::encode $text;
2739 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); 2873 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
2740} 2874}
2741 2875
2876=item $client->send_big_packet ($pkt)
2877
2878Like C<send_packet>, but tries to compress large packets, and fragments
2879them as required.
2880
2881=cut
2882
2883our $MAXFRAGSIZE = cf::MAXSOCKBUF - 64;
2884
2885sub cf::client::send_big_packet {
2886 my ($self, $pkt) = @_;
2887
2888 # try lzf for large packets
2889 $pkt = "lzf " . Compress::LZF::compress $pkt
2890 if 1024 <= length $pkt and $self->{can_lzf};
2891
2892 # split very large packets
2893 if ($MAXFRAGSIZE < length $pkt and $self->{can_lzf}) {
2894 $self->send_packet ("frag $_") for unpack "(a$MAXFRAGSIZE)*", $pkt;
2895 $pkt = "frag";
2896 }
2897
2898 $self->send_packet ($pkt);
2899}
2900
2742=item $client->send_msg ($channel, $msg, $color, [extra...]) 2901=item $client->send_msg ($channel, $msg, $color, [extra...])
2743 2902
2744Send a drawinfo or msg packet to the client, formatting the msg for the 2903Send a drawinfo or msg packet to the client, formatting the msg for the
2745client if neccessary. C<$type> should be a string identifying the type of 2904client if neccessary. C<$type> should be a string identifying the type of
2746the message, with C<log> being the default. If C<$color> is negative, suppress 2905the message, with C<log> being the default. If C<$color> is negative, suppress
… …
2748 2907
2749=cut 2908=cut
2750 2909
2751# non-persistent channels (usually the info channel) 2910# non-persistent channels (usually the info channel)
2752our %CHANNEL = ( 2911our %CHANNEL = (
2912 "c/motd" => {
2913 id => "infobox",
2914 title => "MOTD",
2915 reply => undef,
2916 tooltip => "The message of the day",
2917 },
2753 "c/identify" => { 2918 "c/identify" => {
2754 id => "infobox", 2919 id => "infobox",
2755 title => "Identify", 2920 title => "Identify",
2756 reply => undef, 2921 reply => undef,
2757 tooltip => "Items recently identified", 2922 tooltip => "Items recently identified",
… …
2759 "c/examine" => { 2924 "c/examine" => {
2760 id => "infobox", 2925 id => "infobox",
2761 title => "Examine", 2926 title => "Examine",
2762 reply => undef, 2927 reply => undef,
2763 tooltip => "Signs and other items you examined", 2928 tooltip => "Signs and other items you examined",
2929 },
2930 "c/shopinfo" => {
2931 id => "infobox",
2932 title => "Shop Info",
2933 reply => undef,
2934 tooltip => "What your bargaining skill tells you about the shop",
2764 }, 2935 },
2765 "c/book" => { 2936 "c/book" => {
2766 id => "infobox", 2937 id => "infobox",
2767 title => "Book", 2938 title => "Book",
2768 reply => undef, 2939 reply => undef,
… …
2884 my $pkt = "msg " 3055 my $pkt = "msg "
2885 . $self->{json_coder}->encode ( 3056 . $self->{json_coder}->encode (
2886 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra] 3057 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
2887 ); 3058 );
2888 3059
2889 # try lzf for large packets
2890 $pkt = "lzf " . Compress::LZF::compress $pkt
2891 if 1024 <= length $pkt and $self->{can_lzf};
2892
2893 # split very large packets
2894 if (8192 < length $pkt and $self->{can_lzf}) {
2895 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
2896 $pkt = "frag";
2897 }
2898
2899 $self->send_packet ($pkt); 3060 $self->send_big_packet ($pkt);
2900} 3061}
2901 3062
2902=item $client->ext_msg ($type, @msg) 3063=item $client->ext_msg ($type, @msg)
2903 3064
2904Sends an ext event to the client. 3065Sends an ext event to the client.
… …
2907 3068
2908sub cf::client::ext_msg($$@) { 3069sub cf::client::ext_msg($$@) {
2909 my ($self, $type, @msg) = @_; 3070 my ($self, $type, @msg) = @_;
2910 3071
2911 if ($self->extcmd == 2) { 3072 if ($self->extcmd == 2) {
2912 $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); 3073 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
2913 } elsif ($self->extcmd == 1) { # TODO: remove 3074 } elsif ($self->extcmd == 1) { # TODO: remove
2914 push @msg, msgtype => "event_$type"; 3075 push @msg, msgtype => "event_$type";
2915 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 3076 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2916 } 3077 }
2917} 3078}
2918 3079
2919=item $client->ext_reply ($msgid, @msg) 3080=item $client->ext_reply ($msgid, @msg)
2920 3081
… …
2924 3085
2925sub cf::client::ext_reply($$@) { 3086sub cf::client::ext_reply($$@) {
2926 my ($self, $id, @msg) = @_; 3087 my ($self, $id, @msg) = @_;
2927 3088
2928 if ($self->extcmd == 2) { 3089 if ($self->extcmd == 2) {
2929 $self->send_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg])); 3090 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
2930 } elsif ($self->extcmd == 1) { 3091 } elsif ($self->extcmd == 1) {
2931 #TODO: version 1, remove 3092 #TODO: version 1, remove
2932 unshift @msg, msgtype => "reply", msgid => $id; 3093 unshift @msg, msgtype => "reply", msgid => $id;
2933 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 3094 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2934 } 3095 }
2935} 3096}
2936 3097
2937=item $success = $client->query ($flags, "text", \&cb) 3098=item $success = $client->query ($flags, "text", \&cb)
2938 3099
… …
3039 3200
3040 $coro 3201 $coro
3041} 3202}
3042 3203
3043cf::client->attach ( 3204cf::client->attach (
3044 on_destroy => sub { 3205 on_client_destroy => sub {
3045 my ($ns) = @_; 3206 my ($ns) = @_;
3046 3207
3047 $_->cancel for values %{ (delete $ns->{_coro}) || {} }; 3208 $_->cancel for values %{ (delete $ns->{_coro}) || {} };
3048 }, 3209 },
3049); 3210);
… …
3065our $safe_hole = new Safe::Hole; 3226our $safe_hole = new Safe::Hole;
3066 3227
3067$SIG{FPE} = 'IGNORE'; 3228$SIG{FPE} = 'IGNORE';
3068 3229
3069$safe->permit_only (Opcode::opset qw( 3230$safe->permit_only (Opcode::opset qw(
3070 :base_core :base_mem :base_orig :base_math 3231 :base_core :base_mem :base_orig :base_math :base_loop
3071 grepstart grepwhile mapstart mapwhile 3232 grepstart grepwhile mapstart mapwhile
3072 sort time 3233 sort time
3073)); 3234));
3074 3235
3075# here we export the classes and methods available to script code 3236# here we export the classes and methods available to script code
… …
3127 $qcode =~ s/"/‟/g; # not allowed in #line filenames 3288 $qcode =~ s/"/‟/g; # not allowed in #line filenames
3128 $qcode =~ s/\n/\\n/g; 3289 $qcode =~ s/\n/\\n/g;
3129 3290
3130 %vars = (_dummy => 0) unless %vars; 3291 %vars = (_dummy => 0) unless %vars;
3131 3292
3293 my @res;
3132 local $_; 3294 local $_;
3133 local @safe::cf::_safe_eval_args = values %vars;
3134 3295
3135 my $eval = 3296 my $eval =
3136 "do {\n" 3297 "do {\n"
3137 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" 3298 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n"
3138 . "#line 0 \"{$qcode}\"\n" 3299 . "#line 0 \"{$qcode}\"\n"
3139 . $code 3300 . $code
3140 . "\n}" 3301 . "\n}"
3141 ; 3302 ;
3142 3303
3304 if ($CFG{safe_eval}) {
3143 sub_generation_inc; 3305 sub_generation_inc;
3306 local @safe::cf::_safe_eval_args = values %vars;
3144 my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); 3307 @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval);
3145 sub_generation_inc; 3308 sub_generation_inc;
3309 } else {
3310 local @cf::_safe_eval_args = values %vars;
3311 @res = wantarray ? eval eval : scalar eval $eval;
3312 }
3146 3313
3147 if ($@) { 3314 if ($@) {
3148 warn "$@"; 3315 warn "$@";
3149 warn "while executing safe code '$code'\n"; 3316 warn "while executing safe code '$code'\n";
3150 warn "with arguments " . (join " ", %vars) . "\n"; 3317 warn "with arguments " . (join " ", %vars) . "\n";
… …
3169=cut 3336=cut
3170 3337
3171sub register_script_function { 3338sub register_script_function {
3172 my ($fun, $cb) = @_; 3339 my ($fun, $cb) = @_;
3173 3340
3174 no strict 'refs'; 3341 $fun = "safe::$fun" if $CFG{safe_eval};
3175 *{"safe::$fun"} = $safe_hole->wrap ($cb); 3342 *$fun = $safe_hole->wrap ($cb);
3176} 3343}
3177 3344
3178=back 3345=back
3179 3346
3180=cut 3347=cut
… …
3201 3368
3202 $facedata->{version} == 2 3369 $facedata->{version} == 2
3203 or cf::cleanup "$path: version mismatch, cannot proceed."; 3370 or cf::cleanup "$path: version mismatch, cannot proceed.";
3204 3371
3205 # patch in the exptable 3372 # patch in the exptable
3373 my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
3206 $facedata->{resource}{"res/exp_table"} = { 3374 $facedata->{resource}{"res/exp_table"} = {
3207 type => FT_RSRC, 3375 type => FT_RSRC,
3208 data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]), 3376 data => $exp_table,
3377 hash => (Digest::MD5::md5 $exp_table),
3209 }; 3378 };
3210 cf::cede_to_tick; 3379 cf::cede_to_tick;
3211 3380
3212 { 3381 {
3213 my $faces = $facedata->{faceinfo}; 3382 my $faces = $facedata->{faceinfo};
… …
3215 while (my ($face, $info) = each %$faces) { 3384 while (my ($face, $info) = each %$faces) {
3216 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3385 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3217 3386
3218 cf::face::set_visibility $idx, $info->{visibility}; 3387 cf::face::set_visibility $idx, $info->{visibility};
3219 cf::face::set_magicmap $idx, $info->{magicmap}; 3388 cf::face::set_magicmap $idx, $info->{magicmap};
3220 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3389 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
3221 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3390 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
3222 3391
3223 cf::cede_to_tick; 3392 cf::cede_to_tick;
3224 } 3393 }
3225 3394
3226 while (my ($face, $info) = each %$faces) { 3395 while (my ($face, $info) = each %$faces) {
… …
3250 3419
3251 cf::anim::invalidate_all; # d'oh 3420 cf::anim::invalidate_all; # d'oh
3252 } 3421 }
3253 3422
3254 { 3423 {
3255 # TODO: for gcfclient pleasure, we should give resources
3256 # that gcfclient doesn't grok a >10000 face index.
3257 my $res = $facedata->{resource}; 3424 my $res = $facedata->{resource};
3258 3425
3259 while (my ($name, $info) = each %$res) { 3426 while (my ($name, $info) = each %$res) {
3260 if (defined $info->{type}) { 3427 if (defined $info->{type}) {
3261 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3428 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3262 my $data;
3263 3429
3264 if ($info->{type} & 1) { 3430 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3265 # prepend meta info
3266
3267 my $meta = $enc->encode ({
3268 name => $name,
3269 %{ $info->{meta} || {} },
3270 });
3271
3272 $data = pack "(w/a*)*", $meta, $info->{data};
3273 } else {
3274 $data = $info->{data};
3275 }
3276
3277 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3278 cf::face::set_type $idx, $info->{type}; 3431 cf::face::set_type $idx, $info->{type};
3279 } else { 3432 } else {
3280 $RESOURCE{$name} = $info; 3433 $RESOURCE{$name} = $info; # unused
3281 } 3434 }
3282 3435
3283 cf::cede_to_tick; 3436 cf::cede_to_tick;
3284 } 3437 }
3285 } 3438 }
3286 3439
3287 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); 3440 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3288 3441
3289 1 3442 1
3290} 3443}
3291
3292cf::global->attach (on_resource_update => sub {
3293 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3294 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3295
3296 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3297 my $sound = $soundconf->{compat}[$_]
3298 or next;
3299
3300 my $face = cf::face::find "sound/$sound->[1]";
3301 cf::sound::set $sound->[0] => $face;
3302 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3303 }
3304
3305 while (my ($k, $v) = each %{$soundconf->{event}}) {
3306 my $face = cf::face::find "sound/$v";
3307 cf::sound::set $k => $face;
3308 }
3309 }
3310});
3311 3444
3312register_exticmd fx_want => sub { 3445register_exticmd fx_want => sub {
3313 my ($ns, $want) = @_; 3446 my ($ns, $want) = @_;
3314 3447
3315 while (my ($k, $v) = each %$want) { 3448 while (my ($k, $v) = each %$want) {
… …
3354sub reload_treasures { 3487sub reload_treasures {
3355 load_resource_file "$DATADIR/treasures" 3488 load_resource_file "$DATADIR/treasures"
3356 or die "unable to load treasurelists\n"; 3489 or die "unable to load treasurelists\n";
3357} 3490}
3358 3491
3492sub reload_sound {
3493 warn "loading sound config from $DATADIR/sound\n";
3494
3495 0 < Coro::AIO::aio_load "$DATADIR/sound", my $data
3496 or die "$DATADIR/sound $!";
3497
3498 my $soundconf = JSON::XS->new->utf8->relaxed->decode ($data);
3499
3500 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3501 my $sound = $soundconf->{compat}[$_]
3502 or next;
3503
3504 my $face = cf::face::find "sound/$sound->[1]";
3505 cf::sound::set $sound->[0] => $face;
3506 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3507 }
3508
3509 while (my ($k, $v) = each %{$soundconf->{event}}) {
3510 my $face = cf::face::find "sound/$v";
3511 cf::sound::set $k => $face;
3512 }
3513}
3514
3359sub reload_resources { 3515sub reload_resources {
3360 warn "reloading resource files...\n"; 3516 warn "reloading resource files...\n";
3361 3517
3362 reload_facedata; 3518 reload_facedata;
3519 reload_sound;
3363 reload_archetypes; 3520 reload_archetypes;
3364 reload_regions; 3521 reload_regions;
3365 reload_treasures; 3522 reload_treasures;
3366 3523
3367 warn "finished reloading resource files\n"; 3524 warn "finished reloading resource files\n";
3368} 3525}
3369 3526
3370sub reload_config { 3527sub reload_config {
3528 warn "reloading config file...\n";
3529
3371 open my $fh, "<:utf8", "$CONFDIR/config" 3530 open my $fh, "<:utf8", "$CONFDIR/config"
3372 or return; 3531 or return;
3373 3532
3374 local $/; 3533 local $/;
3375 *CFG = YAML::Load <$fh>; 3534 *CFG = YAML::XS::Load scalar <$fh>;
3376 3535
3377 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3536 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3378 3537
3379 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3538 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3380 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3539 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3381 3540
3382 if (exists $CFG{mlockall}) { 3541 if (exists $CFG{mlockall}) {
… …
3384 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()" 3543 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
3385 and die "WARNING: m(un)lockall failed: $!\n"; 3544 and die "WARNING: m(un)lockall failed: $!\n";
3386 }; 3545 };
3387 warn $@ if $@; 3546 warn $@ if $@;
3388 } 3547 }
3548
3549 warn "finished reloading resource files\n";
3389} 3550}
3390 3551
3391sub pidfile() { 3552sub pidfile() {
3392 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT 3553 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT
3393 or die "$PIDFILE: $!"; 3554 or die "$PIDFILE: $!";
… …
3421 3582
3422 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3583 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3423 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3584 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3424 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3585 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3425 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3586 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3426
3427 cf::init_experience;
3428 cf::init_anim;
3429 cf::init_attackmess;
3430 cf::init_dynamic;
3431 3587
3432 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3588 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3433 3589
3434 # we must not ever block the main coroutine 3590 # we must not ever block the main coroutine
3435 local $Coro::idle = sub { 3591 local $Coro::idle = sub {
… …
3441 }; 3597 };
3442 3598
3443 evthread_start IO::AIO::poll_fileno; 3599 evthread_start IO::AIO::poll_fileno;
3444 3600
3445 cf::sync_job { 3601 cf::sync_job {
3602 cf::init_experience;
3603 cf::init_anim;
3604 cf::init_attackmess;
3605 cf::init_dynamic;
3606
3607 cf::load_settings;
3608 cf::load_materials;
3609
3446 reload_resources; 3610 reload_resources;
3447 reload_config; 3611 reload_config;
3448 db_init; 3612 db_init;
3449 3613
3450 cf::load_settings;
3451 cf::load_materials;
3452 cf::init_uuid; 3614 cf::init_uuid;
3453 cf::init_signals; 3615 cf::init_signals;
3454 cf::init_commands;
3455 cf::init_skills; 3616 cf::init_skills;
3456 3617
3457 cf::init_beforeplay; 3618 cf::init_beforeplay;
3458 3619
3459 atomic; 3620 atomic;
… …
3466 use POSIX (); 3627 use POSIX ();
3467 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3628 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3468 3629
3469 (pop @POST_INIT)->(0) while @POST_INIT; 3630 (pop @POST_INIT)->(0) while @POST_INIT;
3470 }; 3631 };
3632
3633 cf::object::thawer::errors_are_fatal 0;
3634 warn "parse errors in files are no longer fatal from this point on.\n";
3471 3635
3472 main_loop; 3636 main_loop;
3473} 3637}
3474 3638
3475############################################################################# 3639#############################################################################
… …
3477 3641
3478# install some emergency cleanup handlers 3642# install some emergency cleanup handlers
3479BEGIN { 3643BEGIN {
3480 our %SIGWATCHER = (); 3644 our %SIGWATCHER = ();
3481 for my $signal (qw(INT HUP TERM)) { 3645 for my $signal (qw(INT HUP TERM)) {
3482 $SIGWATCHER{$signal} = EV::signal $signal, sub { 3646 $SIGWATCHER{$signal} = AE::signal $signal, sub {
3483 cf::cleanup "SIG$signal"; 3647 cf::cleanup "SIG$signal";
3484 }; 3648 };
3485 } 3649 }
3486} 3650}
3487 3651
3488sub write_runtime_sync { 3652sub write_runtime_sync {
3653 my $t0 = AE::time;
3654
3489 # first touch the runtime file to show we are still running: 3655 # first touch the runtime file to show we are still running:
3490 # the fsync below can take a very very long time. 3656 # the fsync below can take a very very long time.
3491 3657
3492 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef; 3658 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef;
3493 3659
3494 my $guard = cf::lock_acquire "write_runtime"; 3660 my $guard = cf::lock_acquire "write_runtime";
3495 3661
3496 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT, 0644 3662 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT | O_TRUNC, 0644
3497 or return; 3663 or return;
3498 3664
3499 my $value = $cf::RUNTIME + 90 + 10; 3665 my $value = $cf::RUNTIME + 90 + 10;
3500 # 10 is the runtime save interval, for a monotonic clock 3666 # 10 is the runtime save interval, for a monotonic clock
3501 # 60 allows for the watchdog to kill the server. 3667 # 60 allows for the watchdog to kill the server.
… …
3514 or return; 3680 or return;
3515 3681
3516 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE 3682 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE
3517 and return; 3683 and return;
3518 3684
3519 warn "runtime file written.\n"; 3685 warn sprintf "runtime file written (%gs).\n", AE::time - $t0;
3520 3686
3521 1 3687 1
3522} 3688}
3523 3689
3524our $uuid_lock; 3690our $uuid_lock;
… …
3650 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3816 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3651 for my $name (keys %$leaf_symtab) { 3817 for my $name (keys %$leaf_symtab) {
3652 _gv_clear *{"$pkg$name"}; 3818 _gv_clear *{"$pkg$name"};
3653# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3819# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3654 } 3820 }
3655 warn "cleared package $pkg\n";#d#
3656} 3821}
3657 3822
3658sub do_reload_perl() { 3823sub do_reload_perl() {
3659 # can/must only be called in main 3824 # can/must only be called in main
3660 if ($Coro::current != $Coro::main) { 3825 if (in_main) {
3661 warn "can only reload from main coroutine"; 3826 warn "can only reload from main coroutine";
3662 return; 3827 return;
3663 } 3828 }
3664 3829
3665 return if $RELOAD++; 3830 return if $RELOAD++;
3666 3831
3667 my $t1 = EV::time; 3832 my $t1 = AE::time;
3668 3833
3669 while ($RELOAD) { 3834 while ($RELOAD) {
3670 warn "reloading..."; 3835 warn "reloading...";
3671 3836
3672 warn "entering sync_job"; 3837 warn "entering sync_job";
… …
3743 3908
3744 warn "unload completed, starting to reload now"; 3909 warn "unload completed, starting to reload now";
3745 3910
3746 warn "reloading cf.pm"; 3911 warn "reloading cf.pm";
3747 require cf; 3912 require cf;
3748 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 3913 cf::_connect_to_perl_1;
3749 3914
3750 warn "loading config and database again"; 3915 warn "loading config and database again";
3751 cf::reload_config; 3916 cf::reload_config;
3752 3917
3753 warn "loading extensions"; 3918 warn "loading extensions";
… …
3775 3940
3776 warn "reloaded"; 3941 warn "reloaded";
3777 --$RELOAD; 3942 --$RELOAD;
3778 } 3943 }
3779 3944
3780 $t1 = EV::time - $t1; 3945 $t1 = AE::time - $t1;
3781 warn "reload completed in ${t1}s\n"; 3946 warn "reload completed in ${t1}s\n";
3782}; 3947};
3783 3948
3784our $RELOAD_WATCHER; # used only during reload 3949our $RELOAD_WATCHER; # used only during reload
3785 3950
… …
3788 # coro crashes during coro_state_free->destroy here. 3953 # coro crashes during coro_state_free->destroy here.
3789 3954
3790 $RELOAD_WATCHER ||= cf::async { 3955 $RELOAD_WATCHER ||= cf::async {
3791 Coro::AIO::aio_wait cache_extensions; 3956 Coro::AIO::aio_wait cache_extensions;
3792 3957
3793 $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub { 3958 $RELOAD_WATCHER = AE::timer $TICK * 1.5, 0, sub {
3794 do_reload_perl; 3959 do_reload_perl;
3795 undef $RELOAD_WATCHER; 3960 undef $RELOAD_WATCHER;
3796 }; 3961 };
3797 }; 3962 };
3798} 3963}
… …
3815 3980
3816our @WAIT_FOR_TICK; 3981our @WAIT_FOR_TICK;
3817our @WAIT_FOR_TICK_BEGIN; 3982our @WAIT_FOR_TICK_BEGIN;
3818 3983
3819sub wait_for_tick { 3984sub wait_for_tick {
3820 return if tick_inhibit || $Coro::current == $Coro::main; 3985 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3821 3986
3822 my $signal = new Coro::Signal; 3987 my $signal = new Coro::Signal;
3823 push @WAIT_FOR_TICK, $signal; 3988 push @WAIT_FOR_TICK, $signal;
3824 $signal->wait; 3989 $signal->wait;
3825} 3990}
3826 3991
3827sub wait_for_tick_begin { 3992sub wait_for_tick_begin {
3828 return if tick_inhibit || $Coro::current == $Coro::main; 3993 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3829 3994
3830 my $signal = new Coro::Signal; 3995 my $signal = new Coro::Signal;
3831 push @WAIT_FOR_TICK_BEGIN, $signal; 3996 push @WAIT_FOR_TICK_BEGIN, $signal;
3832 $signal->wait; 3997 $signal->wait;
3833} 3998}
… …
3838 unless ++$bug_warning > 10; 4003 unless ++$bug_warning > 10;
3839 return; 4004 return;
3840 } 4005 }
3841 4006
3842 cf::server_tick; # one server iteration 4007 cf::server_tick; # one server iteration
4008
4009 #for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d#
3843 4010
3844 if ($NOW >= $NEXT_RUNTIME_WRITE) { 4011 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3845 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 4012 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3846 Coro::async_pool { 4013 Coro::async_pool {
3847 $Coro::current->{desc} = "runtime saver"; 4014 $Coro::current->{desc} = "runtime saver";
… …
3870} 4037}
3871 4038
3872{ 4039{
3873 # configure BDB 4040 # configure BDB
3874 4041
3875 BDB::min_parallel 8; 4042 BDB::min_parallel 16;
3876 BDB::max_poll_reqs $TICK * 0.1; 4043 BDB::max_poll_reqs $TICK * 0.1;
3877 $AnyEvent::BDB::WATCHER->priority (1); 4044 $AnyEvent::BDB::WATCHER->priority (1);
3878 4045
3879 unless ($DB_ENV) { 4046 unless ($DB_ENV) {
3880 $DB_ENV = BDB::db_env_create; 4047 $DB_ENV = BDB::db_env_create;
… …
3961 } 4128 }
3962} 4129}
3963 4130
3964# load additional modules 4131# load additional modules
3965require "cf/$_.pm" for @EXTRA_MODULES; 4132require "cf/$_.pm" for @EXTRA_MODULES;
4133cf::_connect_to_perl_2;
3966 4134
3967END { cf::emergency_save } 4135END { cf::emergency_save }
3968 4136
39691 41371
3970 4138

Diff Legend

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