--- cf.schmorp.de/server/lib/cf.pm	2006/12/27 15:20:54	1.102
+++ cf.schmorp.de/server/lib/cf.pm	2006/12/30 10:16:11	1.103
@@ -10,7 +10,7 @@
 use Safe;
 use Safe::Hole;
 
-use Coro;
+use Coro 3.3;
 use Coro::Event;
 use Coro::Timer;
 use Coro::Signal;
@@ -25,7 +25,7 @@
 # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
 $YAML::Syck::ImplicitUnicode = 1;
 
-$Coro::main->prio (Coro::PRIO_MIN);
+$Coro::main->prio (2); # run main coroutine ("the server") with very high priority
 
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
 
@@ -39,10 +39,33 @@
 our $TICK = MAX_TIME * 1e-6;
 our $TICK_WATCHER;
 our $NEXT_TICK;
+our $NOW;
 
 our %CFG;
 
 our $UPTIME; $UPTIME ||= time;
+our $RUNTIME;
+
+our %MAP; # all maps
+our $LINK_MAP; # the special {link} map
+our $FREEZE;
+
+binmode STDOUT;
+binmode STDERR;
+
+# read virtual server time, if available
+unless ($RUNTIME || !-e cf::localdir . "/runtime") {
+   open my $fh, "<", cf::localdir . "/runtime"
+      or die "unable to read runtime file: $!";
+   $RUNTIME = <$fh> + 0.;
+}
+
+mkdir cf::localdir;
+mkdir cf::localdir . "/" . cf::playerdir;
+mkdir cf::localdir . "/" . cf::tmpdir;
+mkdir cf::localdir . "/" . cf::uniquedir;
+
+our %EXT_CORO;
 
 #############################################################################
 
@@ -54,11 +77,20 @@
 
 The timestamp of the server start (so not actually an uptime).
 
+=item $cf::RUNTIME
+
+The time this server has run, starts at 0 and is increased by $cf::TICK on
+every server tick.
+
 =item $cf::LIBDIR
 
 The perl library directory, where extensions and cf-specific modules can
 be found. It will be added to C<@INC> automatically.
 
+=item $cf::NOW
+
+The time of the last (current) server tick.
+
 =item $cf::TICK
 
 The interval between server ticks, in seconds.
@@ -75,10 +107,11 @@
 BEGIN {
    *CORE::GLOBAL::warn = sub {
       my $msg = join "", @_;
+      utf8::encode $msg;
+
       $msg .= "\n"
          unless $msg =~ /\n$/;
 
-      print STDERR "cfperl: $msg";
       LOG llevError, "cfperl: $msg";
    };
 }
@@ -141,6 +174,31 @@
    JSON::Syck::Dump $_[0]
 }
 
+=item $coro = cf::coro { BLOCK }
+
+Creates and returns a new coro. This coro is automcatially being canceled
+when the extension calling this is being unloaded.
+
+=cut
+
+sub coro(&) {
+   my $cb = shift;
+
+   my $coro; $coro = async {
+      eval {
+         $cb->();
+      };
+      warn $@ if $@;
+   };
+
+   $coro->on_destroy (sub {
+      delete $EXT_CORO{$coro+0};
+   });
+   $EXT_CORO{$coro+0} = $coro;
+
+   $coro
+}
+
 =back
 
 =cut
@@ -918,10 +976,15 @@
          $cb->();
       };
       warn $@ if $@;
-      delete $self->{_coro}{$coro+0};
    };
 
+   $coro->on_destroy (sub {
+      delete $self->{_coro}{$coro+0};
+   });
+
    $self->{_coro}{$coro+0} = $coro;
+
+   $coro
 }
 
 cf::client->attach (
@@ -1172,20 +1235,26 @@
 #############################################################################
 # initialisation
 
-sub _perl_reload(&) {
-   my ($msg) = @_;
-
-   $msg->("reloading...");
+sub _perl_reload() {
+   warn "reloading...";
 
    eval {
+      local $FREEZE = 1;
+
+      cf::emergency_save;
+
       # cancel all watchers
       for (Event::all_watchers) {
          $_->cancel if $_->data & WF_AUTOCANCEL;
       }
 
+      # cancel all extension coros
+      $_->cancel for values %EXT_CORO;
+      %EXT_CORO = ();
+
       # unload all extensions
       for (@exts) {
-         $msg->("unloading <$_>");
+         warn "unloading <$_>";
          unload_extension $_;
       }
 
@@ -1193,7 +1262,7 @@
       while (my ($k, $v) = each %INC) {
          next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
 
-         $msg->("removing <$k>");
+         warn "removing <$k>";
          delete $INC{$k};
 
          $k =~ s/\.pm$//;
@@ -1208,10 +1277,11 @@
 
       # sync database to disk
       cf::db_sync;
+      IO::AIO::flush;
 
       # get rid of safe::, as good as possible
       Symbol::delete_package "safe::$_"
-         for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region);
+         for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
 
       # remove register_script_function callbacks
       # TODO
@@ -1224,7 +1294,7 @@
       #Symbol::delete_package __PACKAGE__;
 
       # reload cf.pm
-      $msg->("reloading cf.pm");
+      warn "reloading cf.pm";
       require cf;
       cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
 
@@ -1233,23 +1303,20 @@
       cf::db_load;
 
       # load extensions
-      $msg->("load extensions");
+      warn "load extensions";
       cf::load_extensions;
 
       # reattach attachments to objects
-      $msg->("reattach");
+      warn "reattach";
       _global_reattach;
    };
-   $msg->($@) if $@;
+   warn $@ if $@;
 
-   $msg->("reloaded");
+   warn "reloaded";
 };
 
 sub perl_reload() {
-   _perl_reload {
-      warn $_[0];
-      print "$_[0]\n";
-   };
+   _perl_reload;
 }
 
 register "<global>", __PACKAGE__;
@@ -1258,10 +1325,8 @@
    my ($who, $arg) = @_;
 
    if ($who->flag (FLAG_WIZ)) {
-      _perl_reload {
-         warn $_[0];
-         $who->message ($_[0]);
-      };
+      $who->message ("reloading...");
+      _perl_reload;
    }
 };
 
@@ -1269,16 +1334,18 @@
 
 $TICK_WATCHER = Event->timer (
    prio  => 0,
-   at    => $NEXT_TICK || 1,
+   at    => $NEXT_TICK || $TICK,
    data  => WF_AUTOCANCEL,
    cb    => sub {
-      cf::server_tick; # one server iteration
+      unless ($FREEZE) {
+         cf::server_tick; # one server iteration
+         $RUNTIME += $TICK;
+      }
 
-      my $NOW = Event::time;
       $NEXT_TICK += $TICK;
 
       # if we are delayed by four ticks or more, skip them all
-      $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
+      $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
 
       $TICK_WATCHER->at ($NEXT_TICK);
       $TICK_WATCHER->start;
@@ -1293,5 +1360,14 @@
            data => WF_AUTOCANCEL,
            cb   => \&IO::AIO::poll_cb);
 
+# we must not ever block the main coroutine
+$Coro::idle = sub {
+   #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
+   warn "FATAL: Coro::idle was called, major BUG\n";
+   (Coro::unblock_sub {
+      Event::one_event;
+   })->();
+};
+
 1