--- deliantra/server/lib/cf.pm	2007/09/12 11:10:11	1.367
+++ deliantra/server/lib/cf.pm	2007/10/11 21:09:29	1.383
@@ -12,7 +12,7 @@
 use Safe;
 use Safe::Hole;
 
-use Coro 3.64 ();
+use Coro 4.1 ();
 use Coro::State;
 use Coro::Handle;
 use Coro::Event;
@@ -29,7 +29,7 @@
 use Digest::MD5;
 use Fcntl;
 use YAML::Syck ();
-use IO::AIO 2.32 ();
+use IO::AIO 2.51 ();
 use Time::HiRes;
 use Compress::LZF;
 use Digest::MD5 ();
@@ -82,6 +82,7 @@
 our $USE_FSYNC = 1; # use fsync to write maps - default off
 
 our $BDB_POLL_WATCHER;
+our $BDB_DEADLOCK_WATCHER;
 our $BDB_CHECKPOINT_WATCHER;
 our $BDB_TRICKLE_WATCHER;
 our $DB_ENV;
@@ -355,6 +356,8 @@
 
 $SLOT_QUEUE->cancel if $SLOT_QUEUE;
 $SLOT_QUEUE = Coro::async {
+   $Coro::current->desc ("timeslot manager");
+
    my $signal = new Coro::Signal;
 
    while () {
@@ -372,7 +375,7 @@
       }
 
       if (@SLOT_QUEUE) {
-         # we do not use wait_For_tick() as it returns immediately when tick is inactive
+         # we do not use wait_for_tick() as it returns immediately when tick is inactive
          push @cf::WAIT_FOR_TICK, $signal;
          $signal->wait;
       } else {
@@ -426,6 +429,8 @@
       # this is the main coro, too bad, we have to block
       # till the operation succeeds, freezing the server :/
       
+      LOG llevError | logBacktrace, Carp::longmess "sync job";#d#
+
       # TODO: use suspend/resume instead
       # (but this is cancel-safe)
       my $freeze_guard = freeze_mainloop;
@@ -434,6 +439,7 @@
       my @res;
 
       (async {
+         $Coro::current->desc ("sync job coro");
          @res = eval { $job->() };
          warn $@ if $@;
          undef $busy;
@@ -1027,8 +1033,6 @@
 sub object_freezer_save {
    my ($filename, $rdata, $objs) = @_;
 
-   my $guard = cf::lock_acquire "io";
-
    sync_job {
       if (length $$rdata) {
          utf8::decode (my $decname = $filename);
@@ -1044,7 +1048,7 @@
             if (@$objs) {
                if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
                   chmod SAVE_MODE, $fh;
-                  my $data = Storable::nfreeze { version => 1, objs => $objs };
+                  my $data = Coro::Storable::nfreeze { version => 1, objs => $objs };
                   aio_write $fh, 0, (length $data), $data, 0;
                   aio_fsync $fh if $cf::USE_FSYNC;
                   close $fh;
@@ -1063,8 +1067,6 @@
          aio_unlink "$filename.pst";
       }
    };
-
-   undef $guard;
 }
 
 sub object_freezer_as_string {
@@ -1080,8 +1082,6 @@
 
    my ($data, $av);
 
-   my $guard = cf::lock_acquire "io";
-
    (aio_load $filename, $data) >= 0
       or return;
 
@@ -1089,8 +1089,9 @@
       (aio_load "$filename.pst", $av) >= 0
          or return;
 
-      undef $guard;
-      $av = eval { (Storable::thaw $av)->{objs} };
+      my $st = eval { Coro::Storable::thaw $av }
+            || eval { my $guard = Coro::Storable::guard; Storable::thaw $av }; #d# compatibility, remove
+      $av = $st->{objs};
    }
 
    utf8::decode (my $decname = $filename);
@@ -1354,7 +1355,6 @@
          my $f = new_from_file cf::object::thawer path $login
             or return;
 
-         $f->next;
          my $pl = cf::player::load_pl $f
             or return;
          local $cf::PLAYER_LOADING{$login} = $pl;
@@ -2045,6 +2045,8 @@
    $MAP_PREFETCH{$path} |= $load;
 
    $MAP_PREFETCHER ||= cf::async {
+      $Coro::current->{desc} = "map prefetcher";
+
       while (%MAP_PREFETCH) {
          while (my ($k, $v) = each %MAP_PREFETCH) {
             if (my $map = find $k) {
@@ -2080,6 +2082,7 @@
    local $self->{last_access} = $self->last_access;#d#
 
    cf::async {
+      $Coro::current->{desc} = "map player save";
       $_->contr->save for $self->players;
    };
 
@@ -2276,10 +2279,7 @@
 sub deref {
    my ($ref) = @_;
 
-   # temporary compatibility#TODO#remove
-   $ref =~ s{^<}{player/<};
-
-   if ($ref =~ m{^player\/(<1\.\d+>)/(.*)$}) {
+   if ($ref =~ m{^player\/(<1\.[0-9a-f]+>)/(.*)$}) {
       my ($uuid, $name) = ($1, $2);
       my $pl = $cf::PLAYER_LOADING{$name} || cf::player::find $name
          or return;
@@ -2460,27 +2460,35 @@
    $self->enter_link;
 
    (async {
+      $Coro::current->{desc} = "player::goto $path $x $y";
+
       # *tag paths override both path and x|y
       if ($path =~ /^\*(.*)$/) {
          if (my @obs = grep $_->map, ext::map_tags::find $1) {
             my $ob = $obs[rand @obs];
 
             # see if we actually can go there
-            # todo: use ob_blocked to check all tiles of the destination "object"
-            # for suitability.
+            if (@obs = grep !$self->blocked ($_->map, $_->x, $_->y), $ob, $ob->tail) {
+               $ob = $obs[rand @obs];
+            } else {
+               $self->message ("Wow, it's pretty crowded in there.", cf::NDI_UNIQUE | cf::NDI_RED);
+            }
+            # else put us there anyways for now #d#
 
             ($path, $x, $y) = ($ob->map, $ob->x, $ob->y);
+         } else {
+            ($path, $x, $y) = (undef, undef, undef);
          }
       }
 
       my $map = eval {
-         my $map = cf::map::find $path;
+         my $map = defined $path ? cf::map::find $path : undef;
 
          if ($map) {
             $map = $map->customise_for ($self);
             $map = $check->($map) if $check && $map;
          } else {
-            $self->message ("The exit to '$path' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
+            $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED);
          }
 
          $map
@@ -2580,6 +2588,8 @@
       if $exit->flag (FLAG_DAMNED);
 
    (async {
+      $Coro::current->{desc} = "enter_exit $slaying $hp $sp";
+
       $self->deactivate_recursive; # just to be sure
       unless (eval {
          $self->goto ($slaying, $hp, $sp);
@@ -2626,17 +2636,23 @@
 
 our %CHANNEL = (
    "c/identify" => {
-      id      => "identify",
+      id      => "infobox",
       title   => "Identify",
       reply   => undef,
       tooltip => "Items recently identified",
    },
    "c/examine" => {
-      id      => "examine",
+      id      => "infobox",
       title   => "Examine",
       reply   => undef,
       tooltip => "Signs and other items you examined",
    },
+   "c/lookat" => {
+      id      => "infobox",
+      title   => "Look",
+      reply   => undef,
+      tooltip => "What you saw there",
+   },
 );
 
 sub cf::client::send_msg {
@@ -2647,9 +2663,15 @@
    $color &= cf::NDI_CLIENT_MASK; # just in case...
 
    # check predefined channels, for the benefit of C
-   $channel = $CHANNEL{$channel} if $CHANNEL{$channel};
+   if ($CHANNEL{$channel}) {
+      $channel = $CHANNEL{$channel};
+
+      $self->ext_msg (channel_info => $channel)
+         if $self->can_msg;
+
+      $channel = $channel->{id};
 
-   if (ref $channel) {
+   } elsif (ref $channel) {
       # send meta info to client, if not yet sent
       unless (exists $self->{channel}{$channel->{id}}) {
          $self->{channel}{$channel->{id}} = $channel;
@@ -2876,7 +2898,7 @@
 The following functions and methods are available within a safe environment:
 
   cf::object
-     contr pay_amount pay_player map x y force_find force_add
+     contr pay_amount pay_player map x y force_find force_add destroy
      insert remove name archname title slaying race decrease_ob_nr
 
   cf::object::player
@@ -2893,7 +2915,7 @@
 for (
    ["cf::object"         => qw(contr pay_amount pay_player map force_find force_add x y
                                insert remove inv name archname title slaying race
-                               decrease_ob_nr)],
+                               decrease_ob_nr destroy)],
    ["cf::object::player" => qw(player)],
    ["cf::player"         => qw(peaceful)],
    ["cf::map"            => qw(trigger)],
@@ -3178,6 +3200,7 @@
    local $Coro::idle = sub {
       Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
       (async {
+         $Coro::current->{desc} = "IDLE BUG HANDLER";
          Event::one_event;
       })->prio (Coro::PRIO_MAX);
    };
@@ -3259,6 +3282,7 @@
       for my $login (keys %cf::PLAYER) {
          my $pl = $cf::PLAYER{$login} or next;
          $pl->valid or next;
+         delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt
          $pl->save;
       }
       warn "end emergency player save\n";
@@ -3431,7 +3455,10 @@
 
    if ($who->flag (FLAG_WIZ)) {
       $who->message ("reloading server.");
-      async { reload_perl };
+      async {
+         $Coro::current->{desc} = "perl_reload";
+         reload_perl;
+      };
    }
 };
 
@@ -3460,9 +3487,6 @@
    $signal->wait;
 }
 
-our $stat_fh;
-sysopen $stat_fh, "/tmp/cfstats", Fcntl::O_APPEND | Fcntl::O_CREAT | Fcntl::O_WRONLY, 0600;#d#
-
 $TICK_WATCHER = Event->timer (
    reentrant => 0,
    parked    => 1,
@@ -3476,8 +3500,6 @@
          return;
       }
 
-      my @pl = cf::player::list; my $stats = sprintf "%.2f %d %d %d", $RUNTIME, (scalar @pl), cf::object::actives_size, cf::object::objects_size; #d#
-
       $NOW = $tick_start = Event::time;
 
       cf::server_tick; # one server iteration
@@ -3488,14 +3510,12 @@
       if ($NOW >= $NEXT_RUNTIME_WRITE) {
          $NEXT_RUNTIME_WRITE = $NOW + 10;
          Coro::async_pool {
+            $Coro::current->{desc} = "runtime saver";
             write_runtime
                or warn "ERROR: unable to write runtime file: $!";
          };
       }
 
-#      my $AFTER = Event::time;
-#      warn $AFTER - $NOW;#d#
-
       if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
          $sig->send;
       }
@@ -3515,10 +3535,6 @@
       $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
 
       _post_tick;
-
-      # gather some statistics#d#
-      $stats .= sprintf " %d\n", 10000 * ($NOW - $tick_start);#d#
-      IO::AIO::aio_write $stat_fh, undef, undef, $stats, 0;#d#
    },
 );
 
@@ -3551,6 +3567,10 @@
 
    unless ($DB_ENV) {
       $DB_ENV = BDB::db_env_create;
+      $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC
+                          | BDB::LOG_AUTOREMOVE, 1);
+      $DB_ENV->set_timeout (30, BDB::SET_TXN_TIMEOUT);
+      $DB_ENV->set_timeout (30, BDB::SET_LOCK_TIMEOUT);
 
       cf::sync_job {
          eval {
@@ -3562,16 +3582,22 @@
                0666;
 
             cf::cleanup "db_env_open($BDBDIR): $!" if $!;
-
-            $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC
-                                | BDB::LOG_AUTOREMOVE, 1);
-            $DB_ENV->set_lk_detect;
          };
 
          cf::cleanup "db_env_open(db): $@" if $@;
       };
    }
 
+   $BDB_DEADLOCK_WATCHER = Event->timer (
+      after     => 3,
+      interval  => 1,
+      hard      => 1,
+      prio      => 0,
+      data      => WF_AUTOCANCEL,
+      cb        => sub {
+         BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { };
+      },
+   );
    $BDB_CHECKPOINT_WATCHER = Event->timer (
       after     => 11,
       interval  => 60,
@@ -3604,7 +3630,7 @@
       data      => WF_AUTOCANCEL,
       fd        => IO::AIO::poll_fileno,
       poll      => 'r',
-      prio      => 6,
+      prio      => 0,
       cb        => \&IO::AIO::poll_cb,
    );
 }
@@ -3620,6 +3646,8 @@
    if ($_log_backtrace < 2) {
       ++$_log_backtrace;
       async {
+         $Coro::current->{desc} = "abt $msg";
+
          my @bt = fork_call {
             @addr = map { sprintf "%x", $_ } @addr;
             my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X;