--- deliantra/server/lib/cf.pm	2010/04/29 07:59:17	1.533
+++ deliantra/server/lib/cf.pm	2010/05/06 22:35:41	1.545
@@ -22,9 +22,7 @@
 
 package cf;
 
-use 5.10.0;
-use utf8;
-use strict qw(vars subs);
+use common::sense;
 
 use Symbol;
 use List::Util;
@@ -80,6 +78,8 @@
 
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
 
+our @ORIG_INC;
+
 our %COMMAND      = ();
 our %COMMAND_TIME = ();
 
@@ -126,7 +126,7 @@
 our $BDB_TRICKLE_WATCHER;
 our $DB_ENV;
 
-our @EXTRA_MODULES = qw(pod match mapscript);
+our @EXTRA_MODULES = qw(pod match mapscript incloader);
 
 our %CFG;
 
@@ -520,13 +520,13 @@
 sub sync_job(&) {
    my ($job) = @_;
 
-   if ($Coro::current == $Coro::main) {
+   if (in_main) {
       my $time = AE::time;
 
       # this is the main coro, too bad, we have to block
       # till the operation succeeds, freezing the server :/
       
-      LOG llevError, Carp::longmess "sync job";#d#
+      #LOG llevError, Carp::longmess "sync job";#d#
 
       my $freeze_guard = freeze_mainloop;
 
@@ -659,6 +659,9 @@
 =cut
 
 sub db_table($) {
+   cf::error "db_get called from main context"
+      if $Coro::current == $Coro::main;
+
    my ($name) = @_;
    my $db = BDB::db_create $DB_ENV;
 
@@ -678,20 +681,19 @@
 our $DB;
 
 sub db_init {
-   cf::sync_job {
-      $DB ||= db_table "db";
-   };
+   $DB ||= db_table "db";
 }
 
 sub db_get($$) {
    my $key = "$_[0]/$_[1]";
 
-   cf::sync_job {
-      BDB::db_get $DB, undef, $key, my $data;
+   cf::error "db_get called from main context"
+      if $Coro::current == $Coro::main;
 
-      $! ? ()
-         : $data
-   }
+   BDB::db_get $DB, undef, $key, my $data;
+
+   $! ? ()
+      : $data
 }
 
 sub db_put($$$) {
@@ -1423,7 +1425,7 @@
             if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m;
 
          $ext{source} =
-            "package $pkg; use 5.10.0; use strict 'vars', 'subs'; use utf8;\n"
+            "package $pkg; use common::sense;\n"
             . "#line 1 \"$path\"\n{\n"
             . $source
             . "\n};\n1";
@@ -1848,7 +1850,6 @@
    my (undef, $regex, $prio) = @_;
    my $pkg = caller;
 
-   no strict;
    push @{"$pkg\::ISA"}, __PACKAGE__;
 
    $EXT_MAP{$pkg} = [$prio, qr<$regex>];
@@ -1870,7 +1871,7 @@
 sub normalise {
    my ($path, $base) = @_;
 
-   $path = "$path"; # make sure its a string
+   $path = "$path"; # make sure it's a string
 
    $path =~ s/\.map$//;
 
@@ -1919,7 +1920,7 @@
       }
    }
 
-   Carp::cluck "unable to resolve path '$path' (base '$base').";
+   Carp::cluck "unable to resolve path '$path' (base '$base')";
    ()
 }
 
@@ -2052,6 +2053,8 @@
 sub find {
    my ($path, $origin) = @_;
 
+   cf::cede_to_tick;
+
    $path = normalise $path, $origin && $origin->path;
 
    my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
@@ -2192,16 +2195,19 @@
 sub find_sync {
    my ($path, $origin) = @_;
 
-   cf::sync_job { find $path, $origin }
+   return cf::LOG cf::llevError | cf::logBacktrace, "do_find_sync"
+      if $Coro::current == $Coro::main;
+
+   find $path, $origin
 }
 
 sub do_load_sync {
    my ($map) = @_;
 
-   cf::LOG cf::llevDebug | cf::logBacktrace, "do_load_sync"
+   return cf::LOG cf::llevError | cf::logBacktrace, "do_load_sync"
       if $Coro::current == $Coro::main;
 
-   cf::sync_job { $map->load };
+   $map->load;
 }
 
 our %MAP_PREFETCH;
@@ -3270,7 +3276,6 @@
    ["cf::player"         => qw(peaceful send_msg)],
    ["cf::map"            => qw(trigger)],
 ) {
-   no strict 'refs';
    my ($pkg, @funs) = @$_;
    *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
       for @funs;
@@ -3522,6 +3527,8 @@
 sub reload_resources {
    trace "reloading resource files...\n";
 
+   reload_exp_table;
+   reload_materials;
    reload_facedata;
    reload_sound;
    reload_archetypes;
@@ -3588,7 +3595,7 @@
    cf::init_globals; # initialise logging
 
    LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
-   LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
+   LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
    LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
    LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
 
@@ -3606,13 +3613,13 @@
    evthread_start IO::AIO::poll_fileno;
 
    cf::sync_job {
-      cf::init_experience;
+      cf::incloader::init ();
+
       cf::init_anim;
       cf::init_attackmess;
       cf::init_dynamic;
 
       cf::load_settings;
-      cf::load_materials;
 
       reload_resources;
       reload_config;
@@ -3640,7 +3647,12 @@
    cf::object::thawer::errors_are_fatal 0;
    info "parse errors in files are no longer fatal from this point on.\n";
 
-   main_loop;
+   my $free_main; $free_main = EV::idle sub {
+      undef $free_main;
+      undef &main; # free gobs of memory :)
+   };
+
+   goto &main_loop;
 }
 
 #############################################################################
@@ -3749,11 +3761,13 @@
 
    info "emergency_perl_save: enter\n";
 
+   # 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;
+
    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;
+      cf::write_runtime_sync; # external watchdog should not bark
 
       # use a peculiar iteration method to avoid tripping on perl
       # refcount bugs in for. also avoids problems with players
@@ -3767,6 +3781,8 @@
       }
       info "emergency_perl_save: end player save\n";
 
+      cf::write_runtime_sync; # external watchdog should not bark
+
       info "emergency_perl_save: begin map save\n";
       for my $path (keys %cf::MAP) {
          my $map = $cf::MAP{$path} or next;
@@ -3775,6 +3791,8 @@
       }
       info "emergency_perl_save: end map save\n";
 
+      cf::write_runtime_sync; # external watchdog should not bark
+
       info "emergency_perl_save: begin database checkpoint\n";
       BDB::db_env_txn_checkpoint $DB_ENV;
       info "emergency_perl_save: end database checkpoint\n";
@@ -3782,11 +3800,25 @@
       info "emergency_perl_save: begin write uuid\n";
       write_uuid_sync 1;
       info "emergency_perl_save: end write uuid\n";
-   };
 
-   info "emergency_perl_save: starting sync()\n";
-   IO::AIO::aio_sync sub {
-      info "emergency_perl_save: finished sync()\n";
+      cf::write_runtime_sync; # external watchdog should not bark
+
+      trace "emergency_perl_save: syncing database to disk";
+      BDB::db_env_txn_checkpoint $DB_ENV;
+
+      info "emergency_perl_save: starting sync\n";
+      IO::AIO::aio_sync sub {
+         info "emergency_perl_save: finished sync\n";
+      };
+
+      cf::write_runtime_sync; # external watchdog should not bark
+
+      trace "emergency_perl_save: flushing outstanding aio requests";
+      while (IO::AIO::nreqs || BDB::nreqs) {
+         Coro::EV::timer_once 0.01; # let the sync_job do it's thing
+      }
+
+      cf::write_runtime_sync; # external watchdog should not bark
    };
 
    info "emergency_perl_save: leave\n";
@@ -3795,6 +3827,8 @@
 sub post_cleanup {
    my ($make_core) = @_;
 
+   IO::AIO::flush;
+
    error Carp::longmess "post_cleanup backtrace"
       if $make_core;
 
@@ -3829,7 +3863,7 @@
 
 sub do_reload_perl() {
    # can/must only be called in main
-   if (in_main) {
+   unless (in_main) {
       error "can only reload from main coroutine";
       return;
    }
@@ -3839,24 +3873,13 @@
    my $t1 = AE::time;
 
    while ($RELOAD) {
+      cf::get_slot 0.1, -1, "reload_perl";
       info "reloading...";
 
       trace "entering sync_job";
 
       cf::sync_job {
-         cf::write_runtime_sync; # external watchdog should not bark
-         cf::emergency_save;
-         cf::write_runtime_sync; # external watchdog should not bark
-
-         trace "syncing database to disk";
-         BDB::db_env_txn_checkpoint $DB_ENV;
-
-         # if anything goes wrong in here, we should simply crash as we already saved
-
-         trace "flushing outstanding aio requests";
-         while (IO::AIO::nreqs || BDB::nreqs) {
-            Coro::EV::timer_once 0.01; # let the sync_job do it's thing
-         }
+         #cf::emergency_save;
 
          trace "cancelling all extension coros";
          $_->cancel for values %EXT_CORO;
@@ -3981,7 +4004,7 @@
    }
 };
 
-unshift @INC, $LIBDIR;
+#############################################################################
 
 my $bug_warning = 0;
 
@@ -4058,22 +4081,20 @@
       $DB_ENV->set_timeout (30, BDB::SET_TXN_TIMEOUT);
       $DB_ENV->set_timeout (30, BDB::SET_LOCK_TIMEOUT);
 
-      (Coro::async { # async to keep sync_job from complaining
-         cf::sync_job {
-            eval {
-               BDB::db_env_open
-                  $DB_ENV,
-                  $BDBDIR,
-                  BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
-                  | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
-                  0666;
-
-               cf::cleanup "db_env_open($BDBDIR): $!" if $!;
-            };
+      cf::sync_job {
+         eval {
+            BDB::db_env_open
+               $DB_ENV,
+               $BDBDIR,
+               BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
+               | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
+               0666;
 
-            cf::cleanup "db_env_open(db): $@" if $@;
+            cf::cleanup "db_env_open($BDBDIR): $!" if $!;
          };
-      })->join;
+
+         cf::cleanup "db_env_open(db): $@" if $@;
+      };
    }
 
    $BDB_DEADLOCK_WATCHER = EV::periodic 0, 3, 0, sub {