--- deliantra/server/lib/cf.pm	2006/08/24 13:13:49	1.34
+++ deliantra/server/lib/cf.pm	2006/08/24 17:29:30	1.38
@@ -15,12 +15,17 @@
 
 our %COMMAND;
 our @EVENT;
+our @PLUGIN_EVENT;
 our %PROP_TYPE;
 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;
+   @PLUGIN_EVENT = map lc, @PLUGIN_EVENT;
 
    *CORE::GLOBAL::warn = sub {
       my $msg = join "", @_;
@@ -139,9 +144,9 @@
 sub register {
    my ($base, $pkg) = @_;
 
-   for my $idx (0 .. $#EVENT) {
-      if (my $ref = $pkg->can ("on_$EVENT[$idx]")) {
-         #warn "registering $EVENT[$idx] hook to '$pkg'\n";
+   for my $idx (0 .. $#PLUGIN_EVENT) {
+      if (my $ref = $pkg->can ("on_$PLUGIN_EVENT[$idx]")) {
+         #warn "registering $PLUGIN_EVENT[$idx] hook to '$pkg'\n";
          $hook[$idx]{$base} = $ref;
       }
    }
@@ -185,7 +190,7 @@
    warn "removing extension $pkg\n";
 
    # remove hooks
-   for my $idx (0 .. $#EVENT) {
+   for my $idx (0 .. $#PLUGIN_EVENT) {
       delete $hook[$idx]{$pkg};
    }
 
@@ -229,64 +234,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};
 
-         # 2. unload all extensions
-         for (@exts) {
-            $who->message ("unloading <$_>");
-            unload_extension $_;
+         $k =~ s/\.pm$//;
+         $k =~ s/\//::/g;
+
+         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!");
    }
 };
 
@@ -520,21 +536,6 @@
 # the server's main()
 
 sub run {
-   my $tick = MAX_TIME * 1e-6;
-   my $next = Event::time;
-   my $timer = Event->timer (at => $next, cb => sub {
-      cf::server_tick; # one server iteration
-
-      $next += $tick;
-      my $NOW = Event::time;
-
-      # if we are delayd by > 0.25 second, skip ticks
-      $next = $NOW if $NOW >= $next + .25;
-
-      $_[0]->w->at ($next);
-      $_[0]->w->start;
-   });
-
    Event::loop;
 }
 
@@ -547,5 +548,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 four ticks, skip them all
+      $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
+
+      $TICK_WATCHER->at ($NEXT_TICK);
+      $TICK_WATCHER->start;
+   },
+);
+
 1