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.576 by root, Tue Jan 3 02:08:49 2012 UTC

… …
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);
… …
3759 }; 3718 };
3760 3719
3761 cf::object::thawer::errors_are_fatal 0; 3720 cf::object::thawer::errors_are_fatal 0;
3762 info "parse errors in files are no longer fatal from this point on.\n"; 3721 info "parse errors in files are no longer fatal from this point on.\n";
3763 3722
3764 my $free_main; $free_main = EV::idle sub { 3723 AE::postpone {
3765 undef $free_main;
3766 undef &main; # free gobs of memory :) 3724 undef &main; # free gobs of memory :)
3767 }; 3725 };
3768 3726
3769 goto &main_loop; 3727 goto &main_loop;
3770} 3728}
… …
3927 3885
3928 cf::write_runtime_sync; # external watchdog should not bark 3886 cf::write_runtime_sync; # external watchdog should not bark
3929 3887
3930 trace "emergency_perl_save: flushing outstanding aio requests"; 3888 trace "emergency_perl_save: flushing outstanding aio requests";
3931 while (IO::AIO::nreqs || BDB::nreqs) { 3889 while (IO::AIO::nreqs || BDB::nreqs) {
3932 Coro::EV::timer_once 0.01; # let the sync_job do it's thing 3890 Coro::AnyEvent::sleep 0.01; # let the sync_job do it's thing
3933 } 3891 }
3934 3892
3935 cf::write_runtime_sync; # external watchdog should not bark 3893 cf::write_runtime_sync; # external watchdog should not bark
3936 }; 3894 };
3937 3895
… …
4174{ 4132{
4175 # configure BDB 4133 # configure BDB
4176 4134
4177 BDB::min_parallel 16; 4135 BDB::min_parallel 16;
4178 BDB::max_poll_reqs $TICK * 0.1; 4136 BDB::max_poll_reqs $TICK * 0.1;
4179 $AnyEvent::BDB::WATCHER->priority (1); 4137 #$AnyEvent::BDB::WATCHER->priority (1);
4180 4138
4181 unless ($DB_ENV) { 4139 unless ($DB_ENV) {
4182 $DB_ENV = BDB::db_env_create; 4140 $DB_ENV = BDB::db_env_create;
4183 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT); 4141 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
4184 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7; 4142 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;

Diff Legend

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