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.572 by root, Sun May 8 11:44:43 2011 UTC vs.
Revision 1.579 by root, Wed Jan 4 03:22:28 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);
… …
2239 2236
2240 unless ($self->{deny_activate}) { 2237 unless ($self->{deny_activate}) {
2241 $self->decay_objects; 2238 $self->decay_objects;
2242 $self->fix_auto_apply; 2239 $self->fix_auto_apply;
2243 $self->update_buttons; 2240 $self->update_buttons;
2244 $self->post_load_physics;
2245 cf::cede_to_tick; 2241 cf::cede_to_tick;
2246 #$self->activate; # no longer activate maps automatically 2242 #$self->activate; # no longer activate maps automatically
2247 } 2243 }
2248 2244
2249 $self->{last_save} = $cf::RUNTIME; 2245 $self->{last_save} = $cf::RUNTIME;
… …
2268# if $self->per_party; 2264# if $self->per_party;
2269 2265
2270 $self 2266 $self
2271} 2267}
2272 2268
2273# find and load all maps in the 3x3 area around a map
2274sub load_neighbours {
2275 my ($map) = @_;
2276
2277 my @neigh; # diagonal neighbours
2278
2279 for (0 .. 3) {
2280 my $neigh = $map->tile_path ($_)
2281 or next;
2282 $neigh = find $neigh, $map
2283 or next;
2284 $neigh->load;
2285
2286 # now find the diagonal neighbours
2287 push @neigh,
2288 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2289 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2290 }
2291
2292 for (grep defined $_->[0], @neigh) {
2293 my ($path, $origin) = @$_;
2294 my $neigh = find $path, $origin
2295 or next;
2296 $neigh->load;
2297 }
2298}
2299
2300sub find_sync { 2269sub find_sync {
2301 my ($path, $origin) = @_; 2270 my ($path, $origin) = @_;
2302 2271
2303 # it's a bug to call this from the main context 2272 # it's a bug to call this from the main context
2304 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync" 2273 return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync"
… …
2323sub find_async { 2292sub find_async {
2324 my ($path, $origin, $load) = @_; 2293 my ($path, $origin, $load) = @_;
2325 2294
2326 $path = normalise $path, $origin; 2295 $path = normalise $path, $origin;
2327 2296
2328 print "find async $path (from $origin)\n";#d#
2329
2330 if (my $map = $cf::MAP{$path}) { 2297 if (my $map = $cf::MAP{$path}) {
2331 return $map if !$load || $map->linkable; 2298 return $map if !$load || $map->linkable;
2332 } 2299 }
2333 2300
2334 $MAP_PREFETCH{$path} |= $load; 2301 $MAP_PREFETCH{$path} |= $load;
… …
2778 # use -1 or undef as default coordinates, not 0, 0 2745 # use -1 or undef as default coordinates, not 0, 0
2779 ($x, $y) = ($map->enter_x, $map->enter_y) 2746 ($x, $y) = ($map->enter_x, $map->enter_y)
2780 if $x <= 0 && $y <= 0; 2747 if $x <= 0 && $y <= 0;
2781 2748
2782 $map->load; 2749 $map->load;
2783 $map->load_neighbours;
2784 2750
2785 return unless $self->contr->active; 2751 return unless $self->contr->active;
2786 2752
2787 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2753 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2788 if ($self->enter_map ($map, $x, $y)) { 2754 if ($self->enter_map ($map, $x, $y)) {
… …
3221=cut 3187=cut
3222 3188
3223sub cf::client::ext_reply($$@) { 3189sub cf::client::ext_reply($$@) {
3224 my ($self, $id, @msg) = @_; 3190 my ($self, $id, @msg) = @_;
3225 3191
3226 if ($self->extcmd == 2) { 3192 return unless $self->extcmd == 2;
3193
3227 $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]));
3228 } elsif ($self->extcmd == 1) {
3229 #TODO: version 1, remove
3230 unshift @msg, msgtype => "reply", msgid => $id;
3231 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
3232 }
3233} 3195}
3234 3196
3235=item $success = $client->query ($flags, "text", \&cb) 3197=item $success = $client->query ($flags, "text", \&cb)
3236 3198
3237Queues a query to the client, calling the given callback with 3199Queues a query to the client, calling the given callback with
… …
3292 my ($ns, $buf) = @_; 3254 my ($ns, $buf) = @_;
3293 3255
3294 my $msg = eval { $ns->{json_coder}->decode ($buf) }; 3256 my $msg = eval { $ns->{json_coder}->decode ($buf) };
3295 3257
3296 if (ref $msg) { 3258 if (ref $msg) {
3297 my ($type, $reply, @payload) = 3259 my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
3298 "ARRAY" eq ref $msg
3299 ? @$msg
3300 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
3301 3260
3302 my @reply; 3261 my @reply;
3303 3262
3304 if (my $cb = $EXTICMD{$type}) { 3263 if (my $cb = $EXTICMD{$type}) {
3305 @reply = $cb->($ns, @payload); 3264 @reply = $cb->($ns, @payload);
… …
3555 3514
3556 { 3515 {
3557 my $res = $facedata->{resource}; 3516 my $res = $facedata->{resource};
3558 3517
3559 while (my ($name, $info) = each %$res) { 3518 while (my ($name, $info) = each %$res) {
3560 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
3561 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3521 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3562 3522
3563 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3523 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3564 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}; # any keys left are stashed into meta unless prepended
3565 } else { 3526 } else {
3566 $RESOURCE{$name} = $info; # unused 3527# $RESOURCE{$name} = $info; # unused
3567 } 3528 }
3568 3529
3569 cf::cede_to_tick; 3530 cf::cede_to_tick;
3570 } 3531 }
3571 } 3532 }
… …
3707 3668
3708sub main { 3669sub main {
3709 cf::init_globals; # initialise logging 3670 cf::init_globals; # initialise logging
3710 3671
3711 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3672 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3712 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.";
3713 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3674 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3714 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3675 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3715 3676
3716 $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
3717 3678
… …
3759 }; 3720 };
3760 3721
3761 cf::object::thawer::errors_are_fatal 0; 3722 cf::object::thawer::errors_are_fatal 0;
3762 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";
3763 3724
3764 my $free_main; $free_main = EV::idle sub { 3725 AE::postpone {
3765 undef $free_main;
3766 undef &main; # free gobs of memory :) 3726 undef &main; # free gobs of memory :)
3767 }; 3727 };
3768 3728
3769 goto &main_loop; 3729 goto &main_loop;
3770} 3730}
… …
3927 3887
3928 cf::write_runtime_sync; # external watchdog should not bark 3888 cf::write_runtime_sync; # external watchdog should not bark
3929 3889
3930 trace "emergency_perl_save: flushing outstanding aio requests"; 3890 trace "emergency_perl_save: flushing outstanding aio requests";
3931 while (IO::AIO::nreqs || BDB::nreqs) { 3891 while (IO::AIO::nreqs || BDB::nreqs) {
3932 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
3933 } 3893 }
3934 3894
3935 cf::write_runtime_sync; # external watchdog should not bark 3895 cf::write_runtime_sync; # external watchdog should not bark
3936 }; 3896 };
3937 3897
… …
4174{ 4134{
4175 # configure BDB 4135 # configure BDB
4176 4136
4177 BDB::min_parallel 16; 4137 BDB::min_parallel 16;
4178 BDB::max_poll_reqs $TICK * 0.1; 4138 BDB::max_poll_reqs $TICK * 0.1;
4179 $AnyEvent::BDB::WATCHER->priority (1); 4139 #$AnyEvent::BDB::WATCHER->priority (1);
4180 4140
4181 unless ($DB_ENV) { 4141 unless ($DB_ENV) {
4182 $DB_ENV = BDB::db_env_create; 4142 $DB_ENV = BDB::db_env_create;
4183 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT); 4143 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
4184 $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