--- deliantra/server/lib/cf.pm	2006/12/23 05:25:35	1.99
+++ deliantra/server/lib/cf.pm	2006/12/25 11:25:49	1.100
@@ -33,8 +33,6 @@
 our %COMMAND_TIME = ();
 our %EXTCMD       = ();
 
-_init_vars;
-
 our @EVENT;
 our $LIBDIR = datadir . "/ext";
 
@@ -95,7 +93,7 @@
 # we bless all objects into (empty) derived classes to force a method lookup
 # within the Safe compartment.
 for my $pkg (qw(
-   cf::global
+   cf::global cf::attachable
    cf::object cf::object::player
    cf::client cf::player
    cf::arch cf::living
@@ -271,12 +269,13 @@
 =cut
 
 # the following variables are defined in .xs and must not be re-created
-our @CB_GLOBAL = (); # registry for all global events
-our @CB_OBJECT = (); # all objects (should not be used except in emergency)
-our @CB_PLAYER = ();
-our @CB_CLIENT = ();
-our @CB_TYPE   = (); # registry for type (cf-object class) based events
-our @CB_MAP    = ();
+our @CB_GLOBAL     = (); # registry for all global events
+our @CB_ATTACHABLE = (); # registry for all attachables
+our @CB_OBJECT     = (); # all objects (should not be used except in emergency)
+our @CB_PLAYER     = ();
+our @CB_CLIENT     = ();
+our @CB_TYPE       = (); # registry for type (cf-object class) based events
+our @CB_MAP        = ();
 
 my %attachment;
 
@@ -292,6 +291,9 @@
                            @{$registry->[$event] || []}, $cb;
 }
 
+# hack
+my %attachable_klass = map +($_ => 1), KLASS_OBJECT, KLASS_CLIENT, KLASS_PLAYER, KLASS_MAP;
+
 # attach handles attaching event callbacks
 # the only thing the caller has to do is pass the correct
 # registry (== where the callback attaches to).
@@ -302,6 +304,11 @@
    my $prio = 0;
    my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT;
 
+   #TODO: get rid of this hack
+   if ($attachable_klass{$klass}) {
+      %cb_id = (%cb_id, map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == KLASS_ATTACHABLE, 0 .. $#EVENT);
+   }
+
    while (@arg) {
       my $type = shift @arg;
 
@@ -386,7 +393,7 @@
    exists $obj->{_attachment}{$name}
 }
 
-for my $klass (qw(GLOBAL OBJECT PLAYER CLIENT MAP)) {
+for my $klass (qw(ATTACHABLE GLOBAL OBJECT PLAYER CLIENT MAP)) {
    eval "#line " . __LINE__ . " 'cf.pm'
       sub cf::\L$klass\E::_attach_registry {
          (\\\@CB_$klass, KLASS_$klass)
@@ -449,38 +456,50 @@
 #############################################################################
 # object support
 
-sub instantiate {
-   my ($obj, $data) = @_;
-
-   $data = from_json $data;
+cf::attachable->attach (
+   prio           => -1000000,
+   on_instantiate => sub {
+      my ($obj, $data) = @_;
 
-   for (@$data) {
-      my ($name, $args) = @$_;
+      $data = from_json $data;
 
-      $obj->attach ($name, %{$args || {} });
-   }
-}
+      for (@$data) {
+         my ($name, $args) = @$_;
 
-# basically do the same as instantiate, without calling instantiate
-sub reattach {
-   my ($obj) = @_;
-   my $registry = $obj->registry;
+         $obj->attach ($name, %{$args || {} });
+      }
+   },
+   on_reattach => sub {
+      # basically do the same as instantiate, without calling instantiate
+      my ($obj) = @_;
+      my $registry = $obj->registry;
 
-   @$registry = ();
+      @$registry = ();
 
-   delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
+      delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
 
-   for my $name (keys %{ $obj->{_attachment} || {} }) {
-      if (my $attach = $attachment{$name}) {
-         for (@$attach) {
-            my ($klass, @attach) = @$_;
-            _attach $registry, $klass, @attach;
+      for my $name (keys %{ $obj->{_attachment} || {} }) {
+         if (my $attach = $attachment{$name}) {
+            for (@$attach) {
+               my ($klass, @attach) = @$_;
+               _attach $registry, $klass, @attach;
+            }
+         } else {
+            warn "object uses attachment '$name' that is not available, postponing.\n";
          }
-      } else {
-         warn "object uses attachment '$name' that is not available, postponing.\n";
       }
-   }
-}
+   },
+   on_clone => sub {
+      my ($src, $dst) = @_;
+
+      @{$dst->registry} = @{$src->registry};
+
+      %$dst = %$src;
+
+      %{$dst->{_attachment}} = %{$src->{_attachment}}
+         if exists $src->{_attachment};
+   },
+);
 
 sub object_freezer_save {
    my ($filename, $rdata, $objs) = @_;
@@ -540,20 +559,6 @@
    ()
 }
 
-cf::object->attach (
-   prio     => -1000000,
-   on_clone => sub {
-      my ($src, $dst) = @_;
-
-      @{$dst->registry} = @{$src->registry};
-
-      %$dst = %$src;
-
-      %{$dst->{_attachment}} = %{$src->{_attachment}}
-         if exists $src->{_attachment};
-   },
-);
-
 #############################################################################
 # command handling &c
 
@@ -1218,6 +1223,8 @@
       # reload cf.pm
       $msg->("reloading cf.pm");
       require cf;
+      cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
+
 
       # load config and database again
       cf::cfg_load;