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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.207 by root, Sun Feb 11 22:42:09 2007 UTC vs.
Revision 1.211 by root, Tue Feb 13 16:23:32 2007 UTC

 use Digest::MD5;
 use Fcntl;
 use IO::AIO 2.32 ();
 use YAML::Syck ();
 use Time::HiRes;
+use Compress::LZF;
+Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
 use Event; $Event::Eval = 1; # no idea why this is required, but it is
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
    $coro
 }
 sub write_runtime {
+   $TICK_WATCHER->is_active or cf::cleanup "mainloop frozen but runtime active", 1;
    my $runtime = cf::localdir . "/runtime";
    my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
       or return;
    return if $self->players;
    return if $self->isa ("ext::map_per_player");#d#
    warn "resetting map ", $self->path;#d#
+   $self->in_memory (cf::MAP_SWAPPED);
+   # need to save uniques path
+   unless ($self->{deny_save}) {
+      my $uniq = $self->uniq_path; utf8::encode $uniq;
+      $self->_save_objects ($uniq, cf::IO_UNIQUES)
+         if $uniq;
+   }
    delete $cf::MAP{$self->path};
-   $self->in_memory (cf::MAP_SWAPPED);
    $self->clear;
    $_->clear_links_to ($self) for values %cf::MAP;
    $self->unlink_save;
 The parameter C<$family> should best start with the name of the extension
 using it, it should be unique.
 =over 4
-=item $hashref = cf::db_get $family
-Return a hashref for use by the extension C<$family>, which can be
-modified. After modifications, you have to call C<cf::db_dirty> or
-C<cf::db_sync>.
 =item $value = cf::db_get $family => $key
-Returns a single value from the database
+Returns a single value from the database.
-=item cf::db_put $family => $hashref
-Stores the given family hashref into the database. Updates are delayed, if
-you want the data to be synced to disk immediately, use C<cf::db_sync>.
 =item cf::db_put $family => $key => $value
-Stores the given C<$value> in the family hash. Updates are delayed, if you
+Stores the given C<$value> in the family.
-want the data to be synced to disk immediately, use C<cf::db_sync>.
-=item cf::db_dirty
-Marks the database as dirty, to be updated at a later time.
-=item cf::db_sync
-Immediately write the database to disk I<if it is dirty>.
 =cut
 our $DB;
-{
+sub db_init {
+   unless ($DB) {
+      $DB = BDB::db_create $DB_ENV;
+      cf::sync_job {
+         eval {
+            $DB->set_flags (BDB::CHKSUM);
+            BDB::db_open $DB, undef, "db", undef, BDB::BTREE,
+                         BDB::CREATE | BDB::AUTO_COMMIT, 0666;
+            cf::cleanup "db_open(db): $!" if $!;
+         };
+         cf::cleanup "db_open(db): $@" if $@;
+      };
-   my $path = cf::localdir . "/database.pst";
+      my $path = cf::localdir . "/database.pst";
+      if (stat $path) {
+         cf::sync_job {
+            my $pst = Storable::retrieve $path;
-   sub db_load() {
+            cf::db_put (board => data      => $pst->{board});
-      $DB = stat $path ? Storable::retrieve $path : { };
+            cf::db_put (guildrules => data => $pst->{guildrules});
-   }
+            cf::db_put (rent => balance    => $pst->{rent}{balance});
+            BDB::db_env_txn_checkpoint $DB_ENV;
-   my $pid;
+            unlink $path;
-   sub db_save() {
-      waitpid $pid, 0 if $pid;
-      if (0 == ($pid = fork)) {
-         $DB->{_meta}{version} = 1;
-         Storable::nstore $DB, "$path~";
-         rename "$path~", $path;
-         cf::_exit 0 if defined $pid;
-      }
+         };
-   }
-   my $dirty;
-   sub db_sync() {
-      db_save if $dirty;
-      undef $dirty;
-   }
-   my $idle = Event->idle (
-      reentrant => 0,
-      min       => 10,
-      max       => 20,
-      repeat    => 0,
-      data      => WF_AUTOCANCEL,
-      cb        => \&db_sync,
-   );
-   sub db_dirty() {
-      $dirty = 1;
-      $idle->start;
-   }
-   sub db_get($;$) {
-      @_ >= 2
-         ? $DB->{$_[0]}{$_[1]}
-         : ($DB->{$_[0]} ||= { })
-   }
-   sub db_put($$;$) {
-      if (@_ >= 3) {
-         $DB->{$_[0]}{$_[1]} = $_[2];
-      } else {
-         $DB->{$_[0]} = $_[1];
-      }
-      db_dirty;
-   }
-   cf::global->attach (
-      prio       => 10000,
-      on_cleanup => sub {
-         db_sync;
-      },
+      }
-   );
+   }
+}
+sub db_get($$) {
+   my $key = "$_[0]/$_[1]";
+   cf::sync_job {
+      BDB::db_get $DB, undef, $key, my $data;
+      $! ? ()
+         : Compress::LZF::sthaw $data
+   }
+}
+sub db_put($$$) {
+   BDB::dbreq_pri 4;
+   BDB::db_put $DB, undef, "$_[0]/$_[1]", Compress::LZF::sfreeze_cr $_[2], 0, sub { };
 }
 #############################################################################
 # the server's init and main functions
          Event::one_event;
       })->prio (Coro::PRIO_MAX);
    };
    cfg_load;
-   db_load;
+   db_init;
    load_extensions;
    $TICK_WATCHER->start;
    Event::loop;
 }
          my $map = $cf::MAP{$path} or next;
          $map->valid or next;
          $map->save;
       }
       warn "end emergency map save\n";
+      warn "begin emergency database checkpoint\n";
+      BDB::db_env_txn_checkpoint $DB_ENV;
+      warn "end emergency database checkpoint\n";
    };
    warn "leave emergency perl save\n";
+}
+sub post_cleanup {
+   my ($make_core) = @_;
+   warn Carp::longmess "post_cleanup backtrace"
+      if $make_core;
 }
 sub reload() {
    # can/must only be called in main
    if ($Coro::current != $Coro::main) {
    cf::emergency_save;
    eval {
       # if anything goes wrong in here, we should simply crash as we already saved
-      warn "syncing database to disk";
-      cf::db_sync;
       warn "cancelling all WF_AUTOCANCEL watchers";
       for (Event::all_watchers) {
          $_->cancel if $_->data & WF_AUTOCANCEL;
       }
+      warn "syncing database to disk";
+      BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
       warn "flushing outstanding aio requests";
       for (;;) {
+         BDB::flush;
          IO::AIO::flush;
          Coro::cede;
-         last unless IO::AIO::nreqs;
+         last unless IO::AIO::nreqs || BDB::nreqs;
          warn "iterate...";
       }
       warn "cancelling all extension coros";
       $_->cancel for values %EXT_CORO;
       require cf;
       cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
       warn "loading config and database again";
       cf::cfg_load;
-      cf::db_load;
       warn "loading extensions";
       cf::load_extensions;
       warn "reattaching attachments to objects/players";
    unless ($DB_ENV) {
       $DB_ENV = BDB::db_env_create;
       cf::sync_job {
+         eval {
-         BDB::db_env_open
+            BDB::db_env_open
-            $DB_ENV,
+               $DB_ENV,
-            $BDB_ENV_DIR,
+               $BDB_ENV_DIR,
-            BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
+               BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
-            | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
+               | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
-            0666;
+               0666;
-         cf::cleanup "$!" if $!;
+            cf::cleanup "db_env_open($BDB_ENV_DIR): $!" if $!;
-         $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1);
+            $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1);
-         $DB_ENV->set_lk_detect;
+            $DB_ENV->set_lk_detect;
+         };
+         cf::cleanup "db_env_open(db): $@" if $@;
       };
    }
 }
 {

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.207 by root, Sun Feb 11 22:42:09 2007 UTC vs. Revision 1.211 by root, Tue Feb 13 16:23:32 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.207 by root, Sun Feb 11 22:42:09 2007 UTC vs.
Revision 1.211 by root, Tue Feb 13 16:23:32 2007 UTC