--- deliantra/server/lib/cf.pm	2007/01/09 21:32:42	1.155
+++ deliantra/server/lib/cf.pm	2007/01/10 22:54:06	1.160
@@ -35,7 +35,10 @@
 
 our %COMMAND      = ();
 our %COMMAND_TIME = ();
+
+our @EXTS         = (); # list of extension package names
 our %EXTCMD       = ();
+our %EXT_CORO     = (); # coroutines bound to extensions
 
 our @EVENT;
 our $LIBDIR = datadir . "/ext";
@@ -54,7 +57,6 @@
 our %MAP;    # all maps
 our $LINK_MAP; # the special {link} map
 our $RANDOM_MAPS = cf::localdir . "/random";
-our %EXT_CORO; # coroutines bound to extensions
 
 our $WAIT_FOR_TICK;     $WAIT_FOR_TICK     ||= new Coro::Signal;
 our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
@@ -159,10 +161,6 @@
    warn "error in event callback: @_";
 };
 
-my %ext_pkg;
-my @exts;
-my @hook;
-
 =head2 UTILITY FUNCTIONS
 
 =over 4
@@ -321,7 +319,7 @@
 
 =item $coro = cf::async_ext { BLOCK }
 
-Like async, but this coro is automcatially being canceled when the
+Like async, but this coro is automatically being canceled when the
 extension calling this is being unloaded.
 
 =cut
@@ -369,6 +367,9 @@
 
 package cf::path;
 
+use overload
+   '""' => \&as_string;
+
 # used to convert map paths into valid unix filenames by repalcing / by ∕
 our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
 
@@ -387,6 +388,8 @@
    # ~/...       per-player maps without a specific player (DO NOT USE)
    # ~user/...   per-player map of a specific user
 
+   $path =~ s/$PATH_SEP/\//go;
+
    if ($path =~ /^{/) {
       # fine as it is
    } elsif ($path =~ s{^\?random/}{}) {
@@ -942,10 +945,7 @@
 sub register_extcmd {
    my ($name, $cb) = @_;
 
-   my $caller = caller;
-   #warn "registering extcmd '$name' to '$caller'";
-
-   $EXTCMD{$name} = [$cb, $caller];
+   $EXTCMD{$name} = $cb;
 }
 
 cf::player->attach (
@@ -968,7 +968,7 @@
 
       if (ref $msg) {
          if (my $cb = $EXTCMD{$msg->{msgtype}}) {
-            if (my %reply = $cb->[0]->($pl, $msg)) {
+            if (my %reply = $cb->($pl, $msg)) {
                $pl->ext_reply ($msg->{msgid}, %reply);
             }
          }
@@ -980,12 +980,6 @@
    },
 );
 
-sub register {
-   my ($base, $pkg) = @_;
-
-   #TODO
-}
-
 sub load_extension {
    my ($path) = @_;
 
@@ -995,7 +989,7 @@
    $pkg =~ s/[^[:word:]]/_/g;
    $pkg = "ext::$pkg";
 
-   warn "loading '$path' into '$pkg'\n";
+   warn "... loading '$path' into '$pkg'\n";
 
    open my $fh, "<:utf8", $path
       or die "$path: $!";
@@ -1010,50 +1004,7 @@
       or die $@ ? "$path: $@\n"
                 : "extension disabled.\n";
 
-   push @exts, $pkg;
-   $ext_pkg{$base} = $pkg;
-
-#   no strict 'refs';
-#   @{"$pkg\::ISA"} = ext::;
-
-   register $base, $pkg;
-}
-
-sub unload_extension {
-   my ($pkg) = @_;
-
-   warn "removing extension $pkg\n";
-
-   # remove hooks
-   #TODO
-#   for my $idx (0 .. $#PLUGIN_EVENT) {
-#      delete $hook[$idx]{$pkg};
-#   }
-
-   # remove commands
-   for my $name (keys %COMMAND) {
-      my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
-
-      if (@cb) {
-         $COMMAND{$name} = \@cb;
-      } else {
-         delete $COMMAND{$name};
-      }
-   }
-
-   # remove extcmds
-   for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
-      delete $EXTCMD{$name};
-   }
-
-   if (my $cb = $pkg->can ("unload")) {
-      eval {
-         $cb->($pkg);
-         1
-      } or warn "$pkg unloaded, but with errors: $@";
-   }
-
-   Symbol::delete_package $pkg;
+   push @EXTS, $pkg;
 }
 
 sub load_extensions {
@@ -1242,9 +1193,8 @@
    for (@$files) {
       utf8::decode $_;
       next if /\.(?:pl|pst)$/;
-      next unless /^$PATH_SEP/;
+      next unless /^$PATH_SEP/o;
 
-      s/$PATH_SEP/\//g;
       push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
    }
 
@@ -1441,10 +1391,34 @@
    $self->in_memory (cf::MAP_IN_MEMORY);
 }
 
+# find and load all maps in the 3x3 area around a map
+sub load_diag {
+   my ($map) = @_;
+
+   my @diag; # diagonal neighbours
+
+   for (0 .. 3) {
+      my $neigh = $map->tile_path ($_)
+         or next;
+      $neigh = find $neigh, $map
+         or next;
+      $neigh->load;
+
+      push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
+                  [$neigh->tile_path (($_ + 1) % 4), $neigh];
+   }
+
+   for (@diag) {
+      my $neigh = find @$_
+         or next;
+      $neigh->load;
+   }
+}
+
 sub find_sync {
    my ($path, $origin) = @_;
 
-   cf::sync_job { cf::map::find $path, $origin }
+   cf::sync_job { find $path, $origin }
 }
 
 sub do_load_sync {
@@ -1453,6 +1427,38 @@
    cf::sync_job { $map->load };
 }
 
+our %MAP_PREFETCH;
+our $MAP_PREFETCHER = Coro::async {
+   while () {
+      while (%MAP_PREFETCH) {
+         my $key = each %MAP_PREFETCH
+            or next;
+         my $path = delete $MAP_PREFETCH{$key};
+
+         my $map = find $path
+            or next;
+         $map->load;
+      }
+      Coro::schedule;
+   }
+};
+
+sub find_async {
+   my ($path, $origin) = @_;
+
+   $path = new cf::path $path, $origin && $origin->path;
+   my $key = $path->as_string;
+
+   if (my $map = $cf::MAP{$key}) {
+      return $map if $map->in_memory == cf::MAP_IN_MEMORY;
+   }
+
+   $MAP_PREFETCH{$key} = $path;
+   $MAP_PREFETCHER->ready;
+
+   ()
+}
+
 sub save {
    my ($self) = @_;
 
@@ -1578,6 +1584,30 @@
    $map
 }
 
+=item cf::map::unique_maps
+
+Returns an arrayref of cf::path's of all shared maps that have
+instantiated unique items. May block.
+
+=cut
+
+sub unique_maps() {
+   my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
+      or return;
+
+   my @paths;
+
+   for (@$files) {
+      utf8::decode $_;
+      next if /\.pst$/;
+      next unless /^$PATH_SEP/o;
+
+      push @paths, new cf::path $_;
+   }
+
+   \@paths
+}
+
 package cf;
 
 =back
@@ -1709,6 +1739,7 @@
       if $x <=0 && $y <= 0;
 
    $map->load;
+   $map->load_diag;
 
    return unless $self->contr->active;
    $self->activate_recursive;
@@ -1755,7 +1786,6 @@
    my ($self, $path, $x, $y) = @_;
 
    $path = new cf::path $path;
-   $path ne "/" or Carp::cluck ("oy");#d#
 
    $self->enter_link;
 
@@ -1842,7 +1872,7 @@
       }) {
          $self->message ("Something went wrong deep within the crossfire server. "
                      . "I'll try to bring you back to the map you were before. "
-                     . "Please report this to the dungeon master",
+                     . "Please report this to the dungeon master!",
                        cf::NDI_UNIQUE | cf::NDI_RED);
 
          warn "ERROR in enter_exit: $@";
@@ -2220,7 +2250,7 @@
    }
 }
 
-sub emergency_save {
+sub emergency_save() {
    my $freeze_guard = cf::freeze_mainloop;
 
    warn "enter emergency perl save\n";
@@ -2258,28 +2288,48 @@
 
    warn "reloading...";
 
+   warn "freezing server";
    my $guard = freeze_mainloop;
    cf::emergency_save;
 
+   warn "sync database to disk";
+   cf::db_sync;
+   IO::AIO::flush;
+
    eval {
       # if anything goes wrong in here, we should simply crash as we already saved
 
-      # cancel all watchers
+      warn "cancel all watchers";
       for (Event::all_watchers) {
          $_->cancel if $_->data & WF_AUTOCANCEL;
       }
 
-      # cancel all extension coros
+      warn "cancel all extension coros";
       $_->cancel for values %EXT_CORO;
       %EXT_CORO = ();
 
-      # unload all extensions
-      for (@exts) {
-         warn "unloading <$_>";
-         unload_extension $_;
+      warn "remove commands";
+      %COMMAND = ();
+
+      warn "remove ext commands";
+      %EXTCMD = ();
+
+      warn "unload/nuke all extensions";
+      for my $pkg (@EXTS) {
+         warn "... unloading $pkg";
+
+         if (my $cb = $pkg->can ("unload")) {
+            eval {
+               $cb->($pkg);
+               1
+            } or warn "$pkg unloaded, but with errors: $@";
+         }
+
+         warn "... nuking $pkg";
+         Symbol::delete_package $pkg;
       }
 
-      # unload all modules loaded from $LIBDIR
+      warn "unload all perl modules loaded from $LIBDIR";
       while (my ($k, $v) = each %INC) {
          next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
 
@@ -2296,40 +2346,31 @@
          Symbol::delete_package $k;
       }
 
-      # sync database to disk
-      cf::db_sync;
-      IO::AIO::flush;
-
-      # get rid of safe::, as good as possible
+      warn "get rid of safe::, as good as possible";
       Symbol::delete_package "safe::$_"
          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
-      
-      # unload cf.pm "a bit"
+      warn "unload cf.pm \"a bit\"";
       delete $INC{"cf.pm"};
 
       # don't, removes xs symbols, too,
       # and global variables created in xs
       #Symbol::delete_package __PACKAGE__;
 
-      # reload cf.pm
       warn "reloading cf.pm";
       require cf;
       cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
 
-      # load config and database again
+      warn "load config and database again";
       cf::cfg_load;
       cf::db_load;
 
-      # load extensions
       warn "load extensions";
       cf::load_extensions;
 
-      # reattach attachments to objects
-      warn "reattach";
+      warn "reattach attachments to objects/players";
       _global_reattach;
+      warn "reattach attachments to maps";
       reattach $_ for values %MAP;
    };
 
@@ -2339,7 +2380,7 @@
       exit 1;
    }
 
-   warn "reloaded successfully";
+   warn "reloaded";
 };
 
 #############################################################################
@@ -2385,8 +2426,6 @@
    $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
 }
 
-register "<global>", __PACKAGE__;
-
 register_command "reload" => sub {
    my ($who, $arg) = @_;