[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.455 by root, Sat Sep 27 08:17:40 2008 UTC vs.
Revision 1.461 by root, Fri Dec 19 22:47:29 2008 UTC

 use Opcode;
 use Safe;
 use Safe::Hole;
 use Storable ();
+use Guard ();
 use Coro ();
 use Coro::State;
 use Coro::Handle;
 use Coro::EV;
 use Coro::AnyEvent;
 use Coro::Timer;
 use Coro::Signal;
 use Coro::Semaphore;
+use Coro::SemaphoreSet;
 use Coro::AnyEvent;
 use Coro::AIO;
 use Coro::BDB 1.6;
 use Coro::Storable;
 use Coro::Util ();
 our $JITTER;     # average jitter
 our $TICK_START; # for load detecting purposes
 our @POST_INIT;
+our $REATTACH_ON_RELOAD; # ste to true to force object reattach on reload (slow)
 binmode STDOUT;
 binmode STDERR;
 # read virtual server time, if available
 unless ($RUNTIME || !-e $RUNTIMEFILE) {
 Wait until the given lock is available. See cf::lock_acquire.
 =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.
 Locks are *not* recursive, locking from the same coro twice results in a
 deadlocked coro.
 Return true if the lock is currently active, i.e. somebody has locked it.
 =cut
-our %LOCK;
+our $LOCKS = new Coro::SemaphoreSet;
-our %LOCKER;#d#
 sub lock_wait($) {
-   my ($key) = @_;
+   $LOCKS->wait ($_[0]);
-   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;
-   }
 }
 sub lock_acquire($) {
-   my ($key) = @_;
+   $LOCKS->guard ($_[0])
-   # 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} };
-   }
 }
 sub lock_active($) {
-   my ($key) = @_;
+   $LOCKS->count ($_[0]) < 1
-   ! ! $LOCK{$key}
 }
 sub freeze_mainloop {
    tick_inhibit_inc;
-   Coro::guard \&tick_inhibit_dec;
+   &Guard::guard (\&tick_inhibit_dec);
 }
 =item cf::periodic $interval, $cb
 Like EV::periodic, but randomly selects a starting point so that the actions
             } else {
                aio_unlink "$filename.pst";
             }
             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;
          aio_unlink "$filename.pst";
       }
    my ($name, $cb) = @_;
    $EXTICMD{$name} = $cb;
 }
+use File::Glob ();
 cf::player->attach (
    on_command => sub {
       my ($pl, $name, $params) = @_;
       my $cb = $COMMAND{$name}
       }
       cf::override;
    },
 );
+# "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;
 sub find {
    my ($path, $origin) = @_;
    $path = normalise $path, $origin && $origin->path;
-   cf::lock_wait "map_data:$path";#d#remove
+   my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
-   cf::lock_wait "map_find:$path";
+   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;
       $map->{last_save} = $cf::RUNTIME;
    cf::init_experience;
    cf::init_anim;
    cf::init_attackmess;
    cf::init_dynamic;
-   cf::init_block;
    $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
    # we must not ever block the main coroutine
    local $Coro::idle = sub {
 }
 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 "emergency_perl_save: starting sync()\n";
+   IO::AIO::aio_sync sub {
+      warn "emergency_perl_save: finished sync()\n";
+   };
-   warn "leave emergency perl save\n";
+   warn "emergency_perl_save: leave\n";
 }
 sub post_cleanup {
    my ($make_core) = @_;
       warn "can only reload from main coroutine";
       return;
    }
    return if $RELOAD++;
+   my $t1 = EV::time;
    while ($RELOAD) {
       warn "reloading...";
       warn "entering sync_job";
          cf::reload_config;
          warn "loading extensions";
          cf::load_extensions;
+         if ($REATTACH_ON_RELOAD) {
-         warn "reattaching attachments to objects/players";
+            warn "reattaching attachments to objects/players";
-         _global_reattach; # objects, sockets
+            _global_reattach; # objects, sockets
-         warn "reattaching attachments to maps";
+            warn "reattaching attachments to maps";
-         reattach $_ for values %MAP;
+            reattach $_ for values %MAP;
-         warn "reattaching attachments to players";
+            warn "reattaching attachments to players";
-         reattach $_ for values %PLAYER;
+            reattach $_ for values %PLAYER;
+         }
-         warn "running post_load";
+         warn "running post_init jobs";
          (pop @POST_INIT)->(1) while @POST_INIT;
          warn "leaving sync_job";
          1
       };
       warn "reloaded";
       --$RELOAD;
    }
+   $t1 = EV::time - $t1;
+   warn "reload completed in ${t1}s\n";
 };
 our $RELOAD_WATCHER; # used only during reload
 sub reload_perl() {
    # doing reload synchronously and two reloads happen back-to-back,
    # coro crashes during coro_state_free->destroy here.
+   $RELOAD_WATCHER ||= cf::async {
+      Coro::AIO::aio_wait cache_extensions;
-   $RELOAD_WATCHER ||= EV::timer $TICK * 1.5, 0, sub {
+      $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub {
-      do_reload_perl;
+         do_reload_perl;
-      undef $RELOAD_WATCHER;
+         undef $RELOAD_WATCHER;
+      };
    };
 }
 register_command "reload" => sub {
    my ($who, $arg) = @_;

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.455 by root, Sat Sep 27 08:17:40 2008 UTC vs. Revision 1.461 by root, Fri Dec 19 22:47:29 2008 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.455 by root, Sat Sep 27 08:17:40 2008 UTC vs.
Revision 1.461 by root, Fri Dec 19 22:47:29 2008 UTC