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.573 by root, Sun May 8 12:40:42 2011 UTC vs.
Revision 1.580 by root, Wed Jan 4 03:22:48 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.
… …
108our $RANDOMDIR = "$LOCALDIR/random"; 108our $RANDOMDIR = "$LOCALDIR/random";
109our $BDBDIR = "$LOCALDIR/db"; 109our $BDBDIR = "$LOCALDIR/db";
110our $PIDFILE = "$LOCALDIR/pid"; 110our $PIDFILE = "$LOCALDIR/pid";
111our $RUNTIMEFILE = "$LOCALDIR/runtime"; 111our $RUNTIMEFILE = "$LOCALDIR/runtime";
112 112
113our %RESOURCE; # unused 113#our %RESOURCE; # unused
114 114
115our $OUTPUT_RATE_MIN = 3000; 115our $OUTPUT_RATE_MIN = 3000;
116our $OUTPUT_RATE_MAX = 1000000; 116our $OUTPUT_RATE_MAX = 1000000;
117 117
118our $MAX_LINKS = 32; # how many chained exits to follow 118our $MAX_LINKS = 32; # how many chained exits to follow
… …
1461 my ($pl, $buf) = @_; 1461 my ($pl, $buf) = @_;
1462 1462
1463 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) }; 1463 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1464 1464
1465 if (ref $msg) { 1465 if (ref $msg) {
1466 my ($type, $reply, @payload) = 1466 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
1467 "ARRAY" eq ref $msg
1468 ? @$msg
1469 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
1470 1467
1471 my @reply; 1468 my @reply;
1472 1469
1473 if (my $cb = $EXTCMD{$type}) { 1470 if (my $cb = $EXTCMD{$type}) {
1474 @reply = $cb->($pl, @payload); 1471 @reply = $cb->($pl, @payload);
… …
2267# if $self->per_party; 2264# if $self->per_party;
2268 2265
2269 $self 2266 $self
2270} 2267}
2271 2268
2272# find and load all maps in the 3x3 area around a map
2273sub load_neighbours {
2274 my ($map) = @_;
2275
2276 my @neigh; # diagonal neighbours
2277
2278 for (0 .. 3) {
2279 my $neigh = $map->tile_path ($_)
2280 or next;
2281 $neigh = find $neigh, $map
2282 or next;
2283 $neigh->load;
2284
2285 # now find the diagonal neighbours
2286 push @neigh,
2287 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2288 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2289 }
2290
2291 for (grep defined $_->[0], @neigh) {
2292 my ($path, $origin) = @$_;
2293 my $neigh = find $path, $origin
2294 or next;
2295 $neigh->load;
2296 }
2297}
2298
2299sub find_sync { 2269sub find_sync {
2300 my ($path, $origin) = @_; 2270 my ($path, $origin) = @_;
2301 2271
2302 # it's a bug to call this from the main context 2272 # it's a bug to call this from the main context
2303 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync" 2273 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync"
… …
2775 # use -1 or undef as default coordinates, not 0, 0 2745 # use -1 or undef as default coordinates, not 0, 0
2776 ($x, $y) = ($map->enter_x, $map->enter_y) 2746 ($x, $y) = ($map->enter_x, $map->enter_y)
2777 if $x <= 0 && $y <= 0; 2747 if $x <= 0 && $y <= 0;
2778 2748
2779 $map->load; 2749 $map->load;
2780 $map->load_neighbours;
2781 2750
2782 return unless $self->contr->active; 2751 return unless $self->contr->active;
2783 2752
2784 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2753 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2785 if ($self->enter_map ($map, $x, $y)) { 2754 if ($self->enter_map ($map, $x, $y)) {
… …
3218=cut 3187=cut
3219 3188
3220sub cf::client::ext_reply($$@) { 3189sub cf::client::ext_reply($$@) {
3221 my ($self, $id, @msg) = @_; 3190 my ($self, $id, @msg) = @_;
3222 3191
3223 if ($self->extcmd == 2) { 3192 return unless $self->extcmd == 2;
3193
3224 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg])); 3194 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
3225 } elsif ($self->extcmd == 1) {
3226 #TODO: version 1, remove
3227 unshift @msg, msgtype => "reply", msgid => $id;
3228 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
3229 }
3230} 3195}
3231 3196
3232=item $success = $client->query ($flags, "text", \&cb) 3197=item $success = $client->query ($flags, "text", \&cb)
3233 3198
3234Queues a query to the client, calling the given callback with 3199Queues a query to the client, calling the given callback with
… …
3289 my ($ns, $buf) = @_; 3254 my ($ns, $buf) = @_;
3290 3255
3291 my $msg = eval { $ns->{json_coder}->decode ($buf) }; 3256 my $msg = eval { $ns->{json_coder}->decode ($buf) };
3292 3257
3293 if (ref $msg) { 3258 if (ref $msg) {
3294 my ($type, $reply, @payload) = 3259 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
3295 "ARRAY" eq ref $msg
3296 ? @$msg
3297 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
3298 3260
3299 my @reply; 3261 my @reply;
3300 3262
3301 if (my $cb = $EXTICMD{$type}) { 3263 if (my $cb = $EXTICMD{$type}) {
3302 @reply = $cb->($ns, @payload); 3264 @reply = $cb->($ns, @payload);
… …
3552 3514
3553 { 3515 {
3554 my $res = $facedata->{resource}; 3516 my $res = $facedata->{resource};
3555 3517
3556 while (my ($name, $info) = each %$res) { 3518 while (my ($name, $info) = each %$res) {
3557 if (defined $info->{type}) { 3519 if (defined (my $type = $info->{type})) {
3520 # TODO: different hash - must free and use new index, or cache ixface data queue
3558 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3521 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3559 3522
3560 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3523 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3561 cf::face::set_type $idx, $info->{type}; 3524 cf::face::set_type $idx, $type;
3525 cf::face::set_meta $idx, $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already
3562 } else { 3526 } else {
3563 $RESOURCE{$name} = $info; # unused 3527# $RESOURCE{$name} = $info; # unused
3564 } 3528 }
3565 3529
3566 cf::cede_to_tick; 3530 cf::cede_to_tick;
3567 } 3531 }
3568 } 3532 }
… …
3704 3668
3705sub main { 3669sub main {
3706 cf::init_globals; # initialise logging 3670 cf::init_globals; # initialise logging
3707 3671
3708 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3672 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3709 LOG llevInfo, "Copyright (C) 2005-2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3673 LOG llevInfo, "Copyright (C) 2005-2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3710 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3674 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3711 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3675 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3712 3676
3713 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3677 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3714 3678
… …
3756 }; 3720 };
3757 3721
3758 cf::object::thawer::errors_are_fatal 0; 3722 cf::object::thawer::errors_are_fatal 0;
3759 info "parse errors in files are no longer fatal from this point on.\n"; 3723 info "parse errors in files are no longer fatal from this point on.\n";
3760 3724
3761 my $free_main; $free_main = EV::idle sub { 3725 AE::postpone {
3762 undef $free_main;
3763 undef &main; # free gobs of memory :) 3726 undef &main; # free gobs of memory :)
3764 }; 3727 };
3765 3728
3766 goto &main_loop; 3729 goto &main_loop;
3767} 3730}
… …
3924 3887
3925 cf::write_runtime_sync; # external watchdog should not bark 3888 cf::write_runtime_sync; # external watchdog should not bark
3926 3889
3927 trace "emergency_perl_save: flushing outstanding aio requests"; 3890 trace "emergency_perl_save: flushing outstanding aio requests";
3928 while (IO::AIO::nreqs || BDB::nreqs) { 3891 while (IO::AIO::nreqs || BDB::nreqs) {
3929 Coro::EV::timer_once 0.01; # let the sync_job do it's thing 3892 Coro::AnyEvent::sleep 0.01; # let the sync_job do it's thing
3930 } 3893 }
3931 3894
3932 cf::write_runtime_sync; # external watchdog should not bark 3895 cf::write_runtime_sync; # external watchdog should not bark
3933 }; 3896 };
3934 3897
… …
4171{ 4134{
4172 # configure BDB 4135 # configure BDB
4173 4136
4174 BDB::min_parallel 16; 4137 BDB::min_parallel 16;
4175 BDB::max_poll_reqs $TICK * 0.1; 4138 BDB::max_poll_reqs $TICK * 0.1;
4176 $AnyEvent::BDB::WATCHER->priority (1); 4139 #$AnyEvent::BDB::WATCHER->priority (1);
4177 4140
4178 unless ($DB_ENV) { 4141 unless ($DB_ENV) {
4179 $DB_ENV = BDB::db_env_create; 4142 $DB_ENV = BDB::db_env_create;
4180 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT); 4143 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
4181 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7; 4144 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;

Diff Legend

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