--- deliantra/server/lib/cf.pm	2006/08/15 18:07:25	1.32
+++ deliantra/server/lib/cf.pm	2006/08/24 14:04:29	1.36
@@ -19,6 +19,10 @@
 our %PROP_IDX;
 our $LIBDIR = maps_directory "perl";
 
+our $TICK = MAX_TIME * 1e-6;
+our $TICK_WATCHER;
+our $NEXT_TICK;
+
 BEGIN {
    @EVENT = map lc, @EVENT;
 
@@ -229,64 +233,75 @@
    }
 }
 
-register_command "perl-reload", 0, sub {
-   my ($who, $arg) = @_;
+sub _perl_reload(&) {
+   my ($msg) = @_;
 
-   if ($who->flag (FLAG_WIZ)) {
-      $who->message ("reloading...");
+   $msg->("reloading...");
 
-      warn "reloading...\n";
-      eval {
-         # 1. cancel all watchers
-         $_->cancel for Event::all_watchers;
+   eval {
+      # 1. cancel all watchers
+      $_->cancel for Event::all_watchers;
+
+      # 2. unload all extensions
+      for (@exts) {
+         $msg->("unloading <$_>");
+         unload_extension $_;
+      }
+
+      # 3. unload all modules loaded from $LIBDIR
+      while (my ($k, $v) = each %INC) {
+         next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
+
+         $msg->("removing <$k>");
+         delete $INC{$k};
+
+         $k =~ s/\.pm$//;
+         $k =~ s/\//::/g;
 
-         # 2. unload all extensions
-         for (@exts) {
-            $who->message ("unloading <$_>");
-            unload_extension $_;
+         if (my $cb = $k->can ("unload_module")) {
+            $cb->();
          }
 
-         # 3. unload all modules loaded from $LIBDIR
-         while (my ($k, $v) = each %INC) {
-            next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
+         Symbol::delete_package $k;
+      }
 
-            $who->message ("removing <$k>");
-            delete $INC{$k};
+      # 4. get rid of ext::, as good as possible
+      Symbol::delete_package "ext::$_"
+         for qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region);
+
+      # 5. remove register_script_function callbacks
+      # TODO
+      
+      # 6. unload cf.pm "a bit"
+      delete $INC{"cf.pm"};
+
+      # don't, removes xs symbols, too
+      #Symbol::delete_package __PACKAGE__;
+
+      # 7. reload cf.pm
+      $msg->("reloading cf.pm");
+      require cf;
+   };
+   $msg->($@) if $@;
 
-            $k =~ s/\.pm$//;
-            $k =~ s/\//::/g;
+   $msg->("reloaded");
+};
 
-            if (my $cb = $k->can ("unload_module")) {
-               $cb->();
-            }
+sub perl_reload() {
+   _perl_reload {
+      warn $_[0];
+      print "$_[0]\n";
+   };
+}
 
-            Symbol::delete_package $k;
-         }
+register_command "perl-reload", 0, sub {
+   my ($who, $arg) = @_;
 
-         # 4. get rid of ext::, as good as possible
-         Symbol::delete_package "ext::$_"
-            for qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region);
-
-         # 5. remove register_script_function callbacks
-         # TODO
-         
-         # 6. unload cf.pm "a bit"
-         delete $INC{"cf.pm"};
-
-         # don't, removes xs symbols, too
-         #Symbol::delete_package __PACKAGE__;
-
-         # 7. reload cf.pm
-         $who->message ("reloading cf.pm");
-         require cf;
+   if ($who->flag (FLAG_WIZ)) {
+      _perl_reload {
+         warn $_[0];
+         $who->message ($_[0]);
       };
-      warn $@ if $@;
-      $who->message ($@) if $@;
-      warn "reloaded\n";
-
-      $who->message ("reloaded");
-   } else {
-      $who->message ("Intruder Alert!");
    }
 };
 
@@ -387,10 +402,14 @@
 #############################################################################
 # load/save perl data associated with player->ob objects
 
+sub all_objects(@) {
+   @_, map all_objects ($_->inv), @_
+}
+
 *on_player_load = sub {
    my ($ob, $path) = @_;
 
-   for my $o ($ob, $ob->inv) {
+   for my $o (all_objects $ob) {
       if (my $value = $o->get_ob_key_value ("_perl_data")) {
          $o->set_ob_key_value ("_perl_data");
 
@@ -403,24 +422,12 @@
    my ($ob, $path) = @_;
 
    $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_)
-      for grep %$_, $ob, $ob->inv;
+      for grep %$_, all_objects $ob;
 };
 
 #############################################################################
 # core extensions - in perl
 
-my $delta_timer = Event->timer (
-   parked => 1,
-   prio   => Event::PRIO_HIGH,
-   cb     => sub { Event::unloop (undef) },
-);
-
-sub sleep_delta($) {
-   $delta_timer->at (Event::time + $_[0]);
-   $delta_timer->start;
-   Event::loop;
-}
-
 =item cf::player::exists $login
 
 Returns true when the given account exists.
@@ -525,6 +532,13 @@
 }
 
 #############################################################################
+# the server's main()
+
+sub run {
+   Event::loop;
+}
+
+#############################################################################
 # initialisation
 
 register "<global>", __PACKAGE__;
@@ -533,5 +547,22 @@
 
 load_extensions;
 
+$TICK_WATCHER = Event->timer (
+   prio => 1,
+   at   => $NEXT_TICK || 1,
+   cb   => sub {
+      cf::server_tick; # one server iteration
+
+      my $NOW = Event::time;
+      $NEXT_TICK += $TICK;
+
+      # if we are delayed by > 0.25 second, skip ticks
+      $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + .25;
+
+      $TICK_WATCHER->at ($NEXT_TICK);
+      $TICK_WATCHER->start;
+   },
+);
+
 1