--- deliantra/server/lib/cf.pm	2008/09/27 08:17:40	1.455
+++ deliantra/server/lib/cf.pm	2008/12/15 17:04:53	1.460
@@ -34,6 +34,7 @@
 use Safe::Hole;
 use Storable ();
 
+use Guard ();
 use Coro ();
 use Coro::State;
 use Coro::Handle;
@@ -42,6 +43,7 @@
 use Coro::Timer;
 use Coro::Signal;
 use Coro::Semaphore;
+use Coro::SemaphoreSet;
 use Coro::AnyEvent;
 use Coro::AIO;
 use Coro::BDB 1.6;
@@ -132,6 +134,8 @@
 
 our @POST_INIT;
 
+our $REATTACH_ON_RELOAD; # ste to true to force object reattach on reload (slow)
+
 binmode STDOUT;
 binmode STDERR;
 
@@ -330,7 +334,7 @@
 =item my $lock = cf::lock_acquire $string
 
 Wait until the given lock is available and then acquires it and returns
-a Coro::guard object. If the guard object gets destroyed (goes out of scope,
+a L<Guard> object. If the guard object gets destroyed (goes out of scope,
 for example when the coroutine gets canceled), the lock is automatically
 returned.
 
@@ -346,51 +350,24 @@
 
 =cut
 
-our %LOCK;
-our %LOCKER;#d#
+our $LOCKS = new Coro::SemaphoreSet;
 
 sub lock_wait($) {
-   my ($key) = @_;
-
-   if ($LOCKER{$key} == $Coro::current) {#d#
-      Carp::cluck "lock_wait($key) for already-acquired lock";#d#
-      return;#d#
-   }#d#
-
-   # wait for lock, if any
-   while ($LOCK{$key}) {
-      #local $Coro::current->{desc} = "$Coro::current->{desc} <waiting for lock $key>";
-      push @{ $LOCK{$key} }, $Coro::current;
-      Coro::schedule;
-   }
+   $LOCKS->wait ($_[0]);
 }
 
 sub lock_acquire($) {
-   my ($key) = @_;
-
-   # wait, to be sure we are not locked
-   lock_wait $key;
-
-   $LOCK{$key} = [];
-   $LOCKER{$key} = $Coro::current;#d#
-
-   Coro::guard {
-      delete $LOCKER{$key};#d#
-      # wake up all waiters, to be on the safe side
-      $_->ready for @{ delete $LOCK{$key} };
-   }
+   $LOCKS->guard ($_[0])
 }
 
 sub lock_active($) {
-   my ($key) = @_;
-
-   ! ! $LOCK{$key}
+   $LOCKS->count ($_[0]) < 1
 }
 
 sub freeze_mainloop {
    tick_inhibit_inc;
 
-   Coro::guard \&tick_inhibit_dec;
+   &Guard::guard (\&tick_inhibit_dec);
 }
 
 =item cf::periodic $interval, $cb
@@ -1189,8 +1166,11 @@
             }
 
             aio_rename "$filename~", $filename;
+
+            $filename =~ s%/[^/]+$%%;
+            aio_pathsync $filename if $cf::USE_FSYNC;
          } else {
-            warn "FATAL: $filename~: $!\n";
+            warn "unable to save objects: $filename~: $!\n";
          }
       } else {
          aio_unlink $filename;
@@ -1291,6 +1271,8 @@
    $EXTICMD{$name} = $cb;
 }
 
+use File::Glob ();
+
 cf::player->attach (
    on_command => sub {
       my ($pl, $name, $params) = @_;
@@ -1332,6 +1314,19 @@
    },
 );
 
+# "readahead" all extensions
+sub cache_extensions {
+   my $grp = IO::AIO::aio_group;
+
+   add $grp IO::AIO::aio_readdir $LIBDIR, sub {
+      for (grep /\.ext$/, @{$_[0]}) {
+         add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data;
+      }
+   };
+
+   $grp
+}
+
 sub load_extensions {
    cf::sync_job {
       my %todo;
@@ -1969,13 +1964,10 @@
 
    $path = normalise $path, $origin && $origin->path;
 
-   cf::lock_wait "map_data:$path";#d#remove
-   cf::lock_wait "map_find:$path";
+   my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
+   my $guard2 = cf::lock_acquire "map_find:$path";
 
    $cf::MAP{$path} || do {
-      my $guard1 = cf::lock_acquire "map_data:$path"; # just for the fun of it
-      my $guard2 = cf::lock_acquire "map_find:$path";
-
       my $map = new_from_path cf::map $path
          or return;
 
@@ -3557,39 +3549,49 @@
 sub emergency_save() {
    my $freeze_guard = cf::freeze_mainloop;
 
-   warn "enter emergency perl save\n";
+   warn "emergency_perl_save: enter\n";
 
    cf::sync_job {
+      # this is a trade-off: we want to be very quick here, so
+      # save all maps without fsync, and later call a global sync
+      # (which in turn might be very very slow)
+      local $USE_FSYNC = 0;
+
       # use a peculiar iteration method to avoid tripping on perl
       # refcount bugs in for. also avoids problems with players
       # and maps saved/destroyed asynchronously.
-      warn "begin emergency player save\n";
+      warn "emergency_perl_save: begin player save\n";
       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";
+      warn "emergency_perl_save: end player save\n";
 
-      warn "begin emergency map save\n";
+      warn "emergency_perl_save: begin map save\n";
       for my $path (keys %cf::MAP) {
          my $map = $cf::MAP{$path} or next;
          $map->valid or next;
          $map->save;
       }
-      warn "end emergency map save\n";
+      warn "emergency_perl_save: end map save\n";
 
-      warn "begin emergency database checkpoint\n";
+      warn "emergency_perl_save: begin database checkpoint\n";
       BDB::db_env_txn_checkpoint $DB_ENV;
-      warn "end emergency database checkpoint\n";
+      warn "emergency_perl_save: end database checkpoint\n";
 
-      warn "begin write uuid\n";
+      warn "emergency_perl_save: begin write uuid\n";
       write_uuid_sync 1;
-      warn "end write uuid\n";
+      warn "emergency_perl_save: end write uuid\n";
    };
 
-   warn "leave emergency perl save\n";
+   warn "emergency_perl_save: starting sync()\n";
+   IO::AIO::aio_sync sub {
+      warn "emergency_perl_save: finished sync()\n";
+   };
+
+   warn "emergency_perl_save: leave\n";
 }
 
 sub post_cleanup {
@@ -3637,6 +3639,8 @@
 
    return if $RELOAD++;
 
+   my $t1 = EV::time;
+
    while ($RELOAD) {
       warn "reloading...";
 
@@ -3724,14 +3728,16 @@
          warn "loading extensions";
          cf::load_extensions;
 
-         warn "reattaching attachments to objects/players";
-         _global_reattach; # objects, sockets
-         warn "reattaching attachments to maps";
-         reattach $_ for values %MAP;
-         warn "reattaching attachments to players";
-         reattach $_ for values %PLAYER;
+         if ($REATTACH_ON_RELOAD) {
+            warn "reattaching attachments to objects/players";
+            _global_reattach; # objects, sockets
+            warn "reattaching attachments to maps";
+            reattach $_ for values %MAP;
+            warn "reattaching attachments to players";
+            reattach $_ for values %PLAYER;
+         }
 
-         warn "running post_load";
+         warn "running post_init jobs";
          (pop @POST_INIT)->(1) while @POST_INIT;
 
          warn "leaving sync_job";
@@ -3745,6 +3751,9 @@
       warn "reloaded";
       --$RELOAD;
    }
+
+   $t1 = EV::time - $t1;
+   warn "reload completed in ${t1}s\n";
 };
 
 our $RELOAD_WATCHER; # used only during reload
@@ -3753,9 +3762,13 @@
    # doing reload synchronously and two reloads happen back-to-back,
    # coro crashes during coro_state_free->destroy here.
 
-   $RELOAD_WATCHER ||= EV::timer $TICK * 1.5, 0, sub {
-      do_reload_perl;
-      undef $RELOAD_WATCHER;
+   $RELOAD_WATCHER ||= cf::async {
+      Coro::AIO::aio_wait cache_extensions;
+
+      $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub {
+         do_reload_perl;
+         undef $RELOAD_WATCHER;
+      };
    };
 }