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.576 by root, Tue Jan 3 02:08:49 2012 UTC vs.
Revision 1.598 by root, Sun Nov 11 02:38:10 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,2011 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;
… …
108our $RANDOMDIR = "$LOCALDIR/random"; 113our $RANDOMDIR = "$LOCALDIR/random";
109our $BDBDIR = "$LOCALDIR/db"; 114our $BDBDIR = "$LOCALDIR/db";
110our $PIDFILE = "$LOCALDIR/pid"; 115our $PIDFILE = "$LOCALDIR/pid";
111our $RUNTIMEFILE = "$LOCALDIR/runtime"; 116our $RUNTIMEFILE = "$LOCALDIR/runtime";
112 117
113our %RESOURCE; # unused 118#our %RESOURCE; # unused
114 119
115our $OUTPUT_RATE_MIN = 3000; 120our $OUTPUT_RATE_MIN = 3000;
116our $OUTPUT_RATE_MAX = 1000000; 121our $OUTPUT_RATE_MAX = 1000000;
117 122
118our $MAX_LINKS = 32; # how many chained exits to follow 123our $MAX_LINKS = 32; # how many chained exits to follow
… …
129our $DB_ENV; 134our $DB_ENV;
130 135
131our @EXTRA_MODULES = qw(pod match mapscript incloader); 136our @EXTRA_MODULES = qw(pod match mapscript incloader);
132 137
133our %CFG; 138our %CFG;
139our %EXT_CFG; # cfgkeyname => [var-ref, defaultvalue]
134 140
135our $UPTIME; $UPTIME ||= time; 141our $UPTIME; $UPTIME ||= time;
136our $RUNTIME = 0; 142our $RUNTIME = 0;
137our $SERVER_TICK = 0; 143our $SERVER_TICK = 0;
138our $NOW; 144our $NOW;
… …
219=item $cf::RUNTIME 225=item $cf::RUNTIME
220 226
221The 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
222every server tick. 228every server tick.
223 229
224=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR 230=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR
225$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR 231$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR
226$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR 232$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR
227 233
228Various directories - "/etc", read-only install directory, perl-library 234Various directories - "/etc", read-only install directory, perl-library
229directory, pod-directory, read-only maps directory, "/var", "/var/tmp", 235directory, pod-directory, read-only maps directory, "/var", "/var/tmp",
230unique-items directory, player file directory, random maps directory and 236unique-items directory, player file directory, random maps directory and
231database environment. 237database environment.
… …
335)) { 341)) {
336 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 342 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
337} 343}
338 344
339$EV::DIED = sub { 345$EV::DIED = sub {
340 Carp::cluck "error in event callback: @_"; 346 warn "error in event callback: $@";
341}; 347};
342 348
343############################################################################# 349#############################################################################
344 350
345sub fork_call(&@); 351sub fork_call(&@);
… …
372 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; 378 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
373 $d 379 $d
374 } || "[unable to dump $_[0]: '$@']"; 380 } || "[unable to dump $_[0]: '$@']";
375} 381}
376 382
377=item $scalar = load_file $path 383=item $scalar = cf::load_file $path
378 384
379Loads the given file from path and returns its contents. Croaks on error 385Loads the given file from path and returns its contents. Croaks on error
380and can block. 386and can block.
381 387
382=cut 388=cut
… …
384sub load_file($) { 390sub load_file($) {
385 0 <= aio_load $_[0], my $data 391 0 <= aio_load $_[0], my $data
386 or Carp::croak "$_[0]: $!"; 392 or Carp::croak "$_[0]: $!";
387 393
388 $data 394 $data
395}
396
397=item $success = cf::replace_file $path, $data, $sync
398
399Atomically replaces the file at the given $path with new $data, and
400optionally $sync the data to disk before replacing the file.
401
402=cut
403
404sub replace_file($$;$) {
405 my ($path, $data, $sync) = @_;
406
407 my $lock = cf::lock_acquire ("replace_file:$path");
408
409 my $fh = aio_open "$path~", Fcntl::O_WRONLY | Fcntl::O_CREAT | Fcntl::O_TRUNC, 0644
410 or return;
411
412 $data = $data->() if ref $data;
413
414 length $data == aio_write $fh, 0, (length $data), $data, 0
415 or return;
416
417 !$sync
418 or !aio_fsync $fh
419 or return;
420
421 aio_close $fh
422 and return;
423
424 aio_rename "$path~", $path
425 and return;
426
427 if ($sync) {
428 $path =~ s%/[^/]*$%%;
429 aio_pathsync $path;
430 }
431
432 1
389} 433}
390 434
391=item $ref = cf::decode_json $json 435=item $ref = cf::decode_json $json
392 436
393Converts a JSON string into the corresponding perl data structure. 437Converts a JSON string into the corresponding perl data structure.
… …
856 900
857 return db_get cache => "$id/data"; 901 return db_get cache => "$id/data";
858 } 902 }
859 } 903 }
860 904
861 my $t1 = Time::HiRes::time; 905 my $t1 = EV::time;
862 my $data = $process->(\@data); 906 my $data = $process->(\@data);
863 my $t2 = Time::HiRes::time; 907 my $t2 = EV::time;
864 908
865 info "cache: '$id' processed in ", $t2 - $t1, "s\n"; 909 info "cache: '$id' processed in ", $t2 - $t1, "s\n";
866 910
867 db_put cache => "$id/data", $data; 911 db_put cache => "$id/data", $data;
868 db_put cache => "$id/md5" , $md5; 912 db_put cache => "$id/md5" , $md5;
… …
1388=cut 1432=cut
1389 1433
1390############################################################################# 1434#############################################################################
1391# command handling &c 1435# command handling &c
1392 1436
1393=item cf::register_command $name => \&callback($ob,$args); 1437=item cf::register_command $name => \&callback($ob,$args)
1394 1438
1395Register a callback for execution when the client sends the user command 1439Register a callback for execution when the client sends the user command
1396$name. 1440$name.
1397 1441
1398=cut 1442=cut
… …
1404 #warn "registering command '$name/$time' to '$caller'"; 1448 #warn "registering command '$name/$time' to '$caller'";
1405 1449
1406 push @{ $COMMAND{$name} }, [$caller, $cb]; 1450 push @{ $COMMAND{$name} }, [$caller, $cb];
1407} 1451}
1408 1452
1409=item cf::register_extcmd $name => \&callback($pl,$packet); 1453=item cf::register_extcmd $name => \&callback($pl,@args)
1410 1454
1411Register a callback for execution when the client sends an (synchronous) 1455Register a callback for execution when the client sends an (synchronous)
1412extcmd packet. Ext commands will be processed in the order they are 1456extcmd packet. Ext commands will be processed in the order they are
1413received by the server, like other user commands. The first argument is 1457received by the server, like other user commands. The first argument is
1414the logged-in player. Ext commands can only be processed after a player 1458the logged-in player. Ext commands can only be processed after a player
1415has logged in successfully. 1459has logged in successfully.
1416 1460
1417If the callback returns something, it is sent back as if reply was being 1461The values will be sent back to the client.
1418called.
1419 1462
1463=item cf::register_async_extcmd $name => \&callback($pl,$reply->(...),@args)
1464
1465Same as C<cf::register_extcmd>, but instead of returning values, the
1466callback needs to clal the C<$reply> function.
1467
1420=item cf::register_exticmd $name => \&callback($ns,$packet); 1468=item cf::register_exticmd $name => \&callback($ns,@args)
1421 1469
1422Register a callback for execution when the client sends an (asynchronous) 1470Register a callback for execution when the client sends an (asynchronous)
1423exticmd packet. Exti commands are processed by the server as soon as they 1471exticmd packet. Exti commands are processed by the server as soon as they
1424are received, i.e. out of order w.r.t. other commands. The first argument 1472are received, i.e. out of order w.r.t. other commands. The first argument
1425is a client socket. Exti commands can be received anytime, even before 1473is a client socket. Exti commands can be received anytime, even before
1426log-in. 1474log-in.
1427 1475
1428If the callback returns something, it is sent back as if reply was being 1476The values will be sent back to the client.
1429called.
1430 1477
1431=cut 1478=item cf::register_async_exticmd $name => \&callback($ns,$reply->(...),@args)
1432 1479
1480Same as C<cf::register_extcmd>, but instead of returning values, the
1481callback needs to clal the C<$reply> function.
1482
1483=cut
1484
1433sub register_extcmd { 1485sub register_extcmd($$) {
1434 my ($name, $cb) = @_; 1486 my ($name, $cb) = @_;
1435 1487
1436 $EXTCMD{$name} = $cb; 1488 $EXTCMD{$name} = $cb;
1437} 1489}
1438 1490
1439sub register_exticmd { 1491sub register_async_extcmd($$) {
1440 my ($name, $cb) = @_; 1492 my ($name, $cb) = @_;
1441 1493
1494 $EXTACMD{$name} = $cb;
1495}
1496
1497sub register_exticmd($$) {
1498 my ($name, $cb) = @_;
1499
1442 $EXTICMD{$name} = $cb; 1500 $EXTICMD{$name} = $cb;
1501}
1502
1503sub register_async_exticmd($$) {
1504 my ($name, $cb) = @_;
1505
1506 $EXTIACMD{$name} = $cb;
1443} 1507}
1444 1508
1445use File::Glob (); 1509use File::Glob ();
1446 1510
1447cf::player->attach ( 1511cf::player->attach (
… …
1463 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) }; 1527 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1464 1528
1465 if (ref $msg) { 1529 if (ref $msg) {
1466 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash 1530 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
1467 1531
1468 my @reply;
1469
1470 if (my $cb = $EXTCMD{$type}) { 1532 if (my $cb = $EXTACMD{$type}) {
1533 $cb->(
1534 $pl,
1535 sub {
1536 $pl->ext_msg ("reply-$reply", @_)
1537 if $reply;
1538 },
1539 @payload
1540 );
1541 } else {
1542 my @reply;
1543
1544 if (my $cb = $EXTCMD{$type}) {
1471 @reply = $cb->($pl, @payload); 1545 @reply = $cb->($pl, @payload);
1546 }
1547
1548 $pl->ext_msg ("reply-$reply", @reply)
1549 if $reply;
1472 } 1550 }
1473
1474 $pl->ext_reply ($reply, @reply)
1475 if $reply;
1476 1551
1477 } else { 1552 } else {
1478 error "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1553 error "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1479 } 1554 }
1480 1555
… …
1493 }; 1568 };
1494 1569
1495 $grp 1570 $grp
1496} 1571}
1497 1572
1573sub _ext_cfg_reg($$$$) {
1574 my ($rvar, $varname, $cfgname, $default) = @_;
1575
1576 $cfgname = lc $varname
1577 unless length $cfgname;
1578
1579 $EXT_CFG{$cfgname} = [$rvar, $default];
1580
1581 $$rvar = exists $CFG{$cfgname} ? $CFG{$cfgname} : $default;
1582}
1583
1498sub load_extensions { 1584sub load_extensions {
1499 info "loading extensions..."; 1585 info "loading extensions...";
1586
1587 %EXT_CFG = ();
1500 1588
1501 cf::sync_job { 1589 cf::sync_job {
1502 my %todo; 1590 my %todo;
1503 1591
1504 for my $path (<$LIBDIR/*.ext>) { 1592 for my $path (<$LIBDIR/*.ext>) {
… …
1547 unless exists $done{$_}; 1635 unless exists $done{$_};
1548 } 1636 }
1549 1637
1550 trace "... pass $pass, loading '$k' into '$v->{pkg}'\n"; 1638 trace "... pass $pass, loading '$k' into '$v->{pkg}'\n";
1551 1639
1640 my $source = $v->{source};
1641
1642 # support "CONF varname :confname = default" pseudo-statements
1643 $source =~ s{
1644 ^ CONF \s+ ([^\s:=]+) \s* (?:: \s* ([^\s:=]+) \s* )? = ([^\n#]+)
1645 }{
1646 "our \$$1; BEGIN { cf::_ext_cfg_reg \\\$$1, q\x00$1\x00, q\x00$2\x00, $3 }";
1647 }gmxe;
1648
1552 my $active = eval $v->{source}; 1649 my $active = eval $source;
1553 1650
1554 if (length $@) { 1651 if (length $@) {
1555 error "$v->{path}: $@\n"; 1652 error "$v->{path}: $@\n";
1556 1653
1557 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1654 cf::cleanup "mandatory extension '$k' failed to load, exiting."
… …
1844} 1941}
1845 1942
1846=item $protocol_xml = $player->expand_cfpod ($cfpod) 1943=item $protocol_xml = $player->expand_cfpod ($cfpod)
1847 1944
1848Expand deliantra pod fragments into protocol xml. 1945Expand deliantra pod fragments into protocol xml.
1849
1850=item $player->ext_reply ($msgid, @msg)
1851
1852Sends an ext reply to the player.
1853
1854=cut
1855
1856sub ext_reply($$@) {
1857 my ($self, $id, @msg) = @_;
1858
1859 $self->ns->ext_reply ($id, @msg)
1860}
1861 1946
1862=item $player->ext_msg ($type, @msg) 1947=item $player->ext_msg ($type, @msg)
1863 1948
1864Sends an ext event to the client. 1949Sends an ext event to the client.
1865 1950
… …
3170=cut 3255=cut
3171 3256
3172sub cf::client::ext_msg($$@) { 3257sub cf::client::ext_msg($$@) {
3173 my ($self, $type, @msg) = @_; 3258 my ($self, $type, @msg) = @_;
3174 3259
3175 if ($self->extcmd == 2) {
3176 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); 3260 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
3177 } elsif ($self->extcmd == 1) { # TODO: remove
3178 push @msg, msgtype => "event_$type";
3179 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
3180 }
3181}
3182
3183=item $client->ext_reply ($msgid, @msg)
3184
3185Sends an ext reply to the client.
3186
3187=cut
3188
3189sub cf::client::ext_reply($$@) {
3190 my ($self, $id, @msg) = @_;
3191
3192 return unless $self->extcmd == 2;
3193
3194 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
3195} 3261}
3196 3262
3197=item $success = $client->query ($flags, "text", \&cb) 3263=item $success = $client->query ($flags, "text", \&cb)
3198 3264
3199Queues a query to the client, calling the given callback with 3265Queues a query to the client, calling the given callback with
… …
3256 my $msg = eval { $ns->{json_coder}->decode ($buf) }; 3322 my $msg = eval { $ns->{json_coder}->decode ($buf) };
3257 3323
3258 if (ref $msg) { 3324 if (ref $msg) {
3259 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash 3325 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
3260 3326
3261 my @reply;
3262
3263 if (my $cb = $EXTICMD{$type}) { 3327 if (my $cb = $EXTIACMD{$type}) {
3328 $cb->(
3329 $ns,
3330 sub {
3331 $ns->ext_msg ("reply-$reply", @_)
3332 if $reply;
3333 },
3334 @payload
3335 );
3336 } else {
3337 my @reply;
3338
3339 if (my $cb = $EXTICMD{$type}) {
3264 @reply = $cb->($ns, @payload); 3340 @reply = $cb->($ns, @payload);
3341 }
3342
3343 $ns->ext_msg ("reply-$reply", @reply)
3344 if $reply;
3265 } 3345 }
3266
3267 $ns->ext_reply ($reply, @reply)
3268 if $reply;
3269
3270 } else { 3346 } else {
3271 error "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; 3347 error "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
3272 } 3348 }
3273 3349
3274 cf::override; 3350 cf::override;
… …
3442=cut 3518=cut
3443 3519
3444############################################################################# 3520#############################################################################
3445# the server's init and main functions 3521# the server's init and main functions
3446 3522
3523our %FACEHASH; # hash => idx, #d# HACK for http server
3524
3525# internal api, not fianlised
3526sub set_face {
3527 my ($name, $type, $data) = @_;
3528
3529 my $idx = cf::face::find $name;
3530
3531 if ($idx) {
3532 delete $FACEHASH{cf::face::get_chksum $idx};
3533 } else {
3534 $idx = cf::face::alloc $name;
3535 }
3536
3537 my $hash = cf::face::mangle_chksum Digest::MD5::md5 $data;
3538
3539 cf::face::set_type $idx, $type;
3540 cf::face::set_data $idx, 0, $data, $hash;
3541 cf::face::set_meta $idx, $type & 1 ? undef : undef;
3542 $FACEHASH{$hash} = $idx;#d#
3543
3544 $idx
3545}
3546
3447sub load_facedata($) { 3547sub load_facedata($) {
3448 my ($path) = @_; 3548 my ($path) = @_;
3449 3549
3450 # HACK to clear player env face cache, we need some signal framework 3550 # HACK to clear player env face cache, we need some signal framework
3451 # for this (global event?) 3551 # for this (global event?)
… …
3458 my $facedata = decode_storable load_file $path; 3558 my $facedata = decode_storable load_file $path;
3459 3559
3460 $facedata->{version} == 2 3560 $facedata->{version} == 2
3461 or cf::cleanup "$path: version mismatch, cannot proceed."; 3561 or cf::cleanup "$path: version mismatch, cannot proceed.";
3462 3562
3463 # patch in the exptable
3464 my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
3465 $facedata->{resource}{"res/exp_table"} = {
3466 type => FT_RSRC,
3467 data => $exp_table,
3468 hash => (Digest::MD5::md5 $exp_table),
3469 };
3470 cf::cede_to_tick; 3563 cf::cede_to_tick;
3471 3564
3472 { 3565 {
3473 my $faces = $facedata->{faceinfo}; 3566 my $faces = delete $facedata->{faceinfo};
3474 3567
3475 while (my ($face, $info) = each %$faces) { 3568 for my $face (sort keys %$faces) {
3569 my $info = $faces->{$face};
3476 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3570 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3477 3571
3478 cf::face::set_visibility $idx, $info->{visibility}; 3572 cf::face::set_visibility $idx, $info->{visibility};
3479 cf::face::set_magicmap $idx, $info->{magicmap}; 3573 cf::face::set_magicmap $idx, $info->{magicmap};
3480 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32}; 3574 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
3481 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64}; 3575 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
3482 cf::face::set_data $idx, 2, $info->{glyph} , $info->{glyph} ; 3576 cf::face::set_data $idx, 2, $info->{glyph} , $info->{glyph} ;
3483 3577 $FACEHASH{$info->{hash64}} = $idx;#d#
3578
3484 cf::cede_to_tick; 3579 cf::cede_to_tick;
3485 } 3580 }
3486 3581
3487 while (my ($face, $info) = each %$faces) { 3582 while (my ($face, $info) = each %$faces) {
3488 next unless $info->{smooth}; 3583 next unless $info->{smooth};
… …
3500 cf::cede_to_tick; 3595 cf::cede_to_tick;
3501 } 3596 }
3502 } 3597 }
3503 3598
3504 { 3599 {
3505 my $anims = $facedata->{animinfo}; 3600 my $anims = delete $facedata->{animinfo};
3506 3601
3507 while (my ($anim, $info) = each %$anims) { 3602 while (my ($anim, $info) = each %$anims) {
3508 cf::anim::set $anim, $info->{frames}, $info->{facings}; 3603 cf::anim::set $anim, $info->{frames}, $info->{facings};
3509 cf::cede_to_tick; 3604 cf::cede_to_tick;
3510 } 3605 }
3511 3606
3512 cf::anim::invalidate_all; # d'oh 3607 cf::anim::invalidate_all; # d'oh
3513 } 3608 }
3514 3609
3515 { 3610 {
3516 my $res = $facedata->{resource}; 3611 my $res = delete $facedata->{resource};
3517 3612
3518 while (my ($name, $info) = each %$res) { 3613 while (my ($name, $info) = each %$res) {
3519 if (defined $info->{type}) { 3614 if (defined (my $type = $info->{type})) {
3615 # TODO: different hash - must free and use new index, or cache ixface data queue
3520 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3616 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3521 3617
3618 cf::face::set_type $idx, $type;
3522 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3619 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3523 cf::face::set_type $idx, $info->{type}; 3620 cf::face::set_meta $idx, $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already
3621 $FACEHASH{$info->{hash}} = $idx;#d#
3524 } else { 3622 } else {
3525 $RESOURCE{$name} = $info; # unused 3623# $RESOURCE{$name} = $info; # unused
3526 } 3624 }
3527 3625
3528 cf::cede_to_tick; 3626 cf::cede_to_tick;
3529 } 3627 }
3530 } 3628 }
… …
3548 my $status = load_resource_file_ $_[0]; 3646 my $status = load_resource_file_ $_[0];
3549 get_slot 0.1, 100; 3647 get_slot 0.1, 100;
3550 cf::arch::commit_load; 3648 cf::arch::commit_load;
3551 3649
3552 $status 3650 $status
3651}
3652
3653sub reload_exp_table {
3654 _reload_exp_table;
3655
3656 set_face "res/exp_table" => FT_RSRC,
3657 JSON::XS->new->utf8->canonical->encode (
3658 [map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]
3659 );
3660}
3661
3662sub reload_materials {
3663 _reload_materials;
3553} 3664}
3554 3665
3555sub reload_regions { 3666sub reload_regions {
3556 # HACK to clear player env face cache, we need some signal framework 3667 # HACK to clear player env face cache, we need some signal framework
3557 # for this (global event?) 3668 # for this (global event?)
… …
3572} 3683}
3573 3684
3574sub reload_archetypes { 3685sub reload_archetypes {
3575 load_resource_file "$DATADIR/archetypes" 3686 load_resource_file "$DATADIR/archetypes"
3576 or die "unable to load archetypes\n"; 3687 or die "unable to load archetypes\n";
3688
3689 set_face "res/skill_info" => FT_RSRC,
3690 JSON::XS->new->utf8->canonical->encode (
3691 [map [cf::arch::skillvec ($_)->name], 0 .. cf::arch::skillvec_size - 1]
3692 );
3693 set_face "res/spell_paths" => FT_RSRC,
3694 JSON::XS->new->utf8->canonical->encode (
3695 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
3696 );
3577} 3697}
3578 3698
3579sub reload_treasures { 3699sub reload_treasures {
3580 load_resource_file "$DATADIR/treasures" 3700 load_resource_file "$DATADIR/treasures"
3581 or die "unable to load treasurelists\n"; 3701 or die "unable to load treasurelists\n";
… …
3602} 3722}
3603 3723
3604sub reload_resources { 3724sub reload_resources {
3605 trace "reloading resource files...\n"; 3725 trace "reloading resource files...\n";
3606 3726
3607 reload_exp_table;
3608 reload_materials; 3727 reload_materials;
3609 reload_facedata; 3728 reload_facedata;
3729 reload_exp_table;
3610 reload_sound; 3730 reload_sound;
3611 reload_archetypes; 3731 reload_archetypes;
3612 reload_regions; 3732 reload_regions;
3613 reload_treasures; 3733 reload_treasures;
3614 3734
… …
3666 3786
3667sub main { 3787sub main {
3668 cf::init_globals; # initialise logging 3788 cf::init_globals; # initialise logging
3669 3789
3670 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3790 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3671 LOG llevInfo, "Copyright (C) 2005-2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3791 LOG llevInfo, "Copyright (C) 2005-2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3672 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3792 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3673 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3793 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3674 3794
3675 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3795 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3676 3796
3677 # we must not ever block the main coroutine 3797 # we must not ever block the main coroutine
3678 local $Coro::idle = sub { 3798 $Coro::idle = sub {
3679 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3799 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3680 (async { 3800 (async {
3681 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3801 $Coro::current->{desc} = "IDLE BUG HANDLER";
3682 EV::loop EV::LOOP_ONESHOT; 3802 EV::loop EV::LOOP_ONESHOT;
3683 })->prio (Coro::PRIO_MAX); 3803 })->prio (Coro::PRIO_MAX);
… …
3686 evthread_start IO::AIO::poll_fileno; 3806 evthread_start IO::AIO::poll_fileno;
3687 3807
3688 cf::sync_job { 3808 cf::sync_job {
3689 cf::incloader::init (); 3809 cf::incloader::init ();
3690 3810
3811 db_init;
3812
3691 cf::init_anim; 3813 cf::init_anim;
3692 cf::init_attackmess; 3814 cf::init_attackmess;
3693 cf::init_dynamic; 3815 cf::init_dynamic;
3694 3816
3695 cf::load_settings; 3817 cf::load_settings;
3696 3818
3697 reload_resources; 3819 reload_resources;
3698 reload_config; 3820 reload_config;
3699 db_init;
3700 3821
3701 cf::init_uuid; 3822 cf::init_uuid;
3702 cf::init_signals; 3823 cf::init_signals;
3703 cf::init_skills; 3824 cf::init_skills;
3704 3825
… …
4129 } 4250 }
4130} 4251}
4131 4252
4132{ 4253{
4133 # configure BDB 4254 # configure BDB
4255 info "initialising database";
4134 4256
4135 BDB::min_parallel 16; 4257 BDB::min_parallel 16;
4136 BDB::max_poll_reqs $TICK * 0.1; 4258 BDB::max_poll_reqs $TICK * 0.1;
4137 #$AnyEvent::BDB::WATCHER->priority (1); 4259 #$AnyEvent::BDB::WATCHER->priority (1);
4138 4260
… …
4167 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { }; 4289 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
4168 }; 4290 };
4169 $BDB_TRICKLE_WATCHER = EV::periodic 0, 10, 0, sub { 4291 $BDB_TRICKLE_WATCHER = EV::periodic 0, 10, 0, sub {
4170 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { }; 4292 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
4171 }; 4293 };
4294
4295 info "database initialised";
4172} 4296}
4173 4297
4174{ 4298{
4175 # configure IO::AIO 4299 # configure IO::AIO
4176 4300
4301 info "initialising aio";
4177 IO::AIO::min_parallel 8; 4302 IO::AIO::min_parallel 8;
4178 IO::AIO::max_poll_time $TICK * 0.1; 4303 IO::AIO::max_poll_time $TICK * 0.1;
4179 undef $AnyEvent::AIO::WATCHER; 4304 undef $AnyEvent::AIO::WATCHER;
4305 info "aio initialised";
4180} 4306}
4181 4307
4182our $_log_backtrace; 4308our $_log_backtrace;
4183our $_log_backtrace_last; 4309our $_log_backtrace_last;
4184 4310

Diff Legend

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