--- deliantra/server/lib/cf.pm	2007/06/24 04:27:20	1.286
+++ deliantra/server/lib/cf.pm	2007/07/02 03:15:30	1.290
@@ -22,6 +22,7 @@
 use Coro::AIO;
 use Coro::Storable;
 
+use JSON::XS 1.4 ();
 use BDB ();
 use Data::Dumper;
 use Digest::MD5;
@@ -51,6 +52,7 @@
 
 our @EXTS         = (); # list of extension package names
 our %EXTCMD       = ();
+our %EXTICMD      = ();
 our %EXT_CORO     = (); # coroutines bound to extensions
 our %EXT_MAP      = (); # pluggable maps
 
@@ -238,8 +240,6 @@
    } || "[unable to dump $_[0]: '$@']";
 }
 
-use JSON::XS qw(to_json from_json); # TODO# replace by JSON::PC once working
-
 =item $ref = cf::from_json $json
 
 Converts a JSON string into the corresponding perl data structure.
@@ -248,6 +248,13 @@
 
 Converts a perl data structure into its JSON representation.
 
+=cut
+
+our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
+
+sub to_json   ($) { $json_coder->encode ($_[0]) }
+sub from_json ($) { $json_coder->decode ($_[0]) }
+
 =item cf::lock_wait $string
 
 Wait until the given lock is available. See cf::lock_acquire. 
@@ -1031,7 +1038,22 @@
 
 =item cf::register_extcmd $name => \&callback($pl,$packet);
 
-Register a callback fro execution when the client sends an extcmd packet.
+Register a callback for execution when the client sends an (synchronous)
+extcmd packet. Ext commands will be processed in the order they are
+received by the server, like other user commands. The first argument is
+the logged-in player. Ext commands can only be processed after a player
+has logged in successfully.
+
+If the callback returns something, it is sent back as if reply was being
+called.
+
+=item cf::register_exticmd $name => \&callback($ns,$packet);
+
+Register a callback for execution when the client sends an (asynchronous)
+exticmd packet. Exti commands are processed by the server as soon as they
+are received, i.e. out of order w.r.t. other commands. The first argument
+is a client socket. Exti commands can be received anytime, even before
+log-in.
 
 If the callback returns something, it is sent back as if reply was being
 called.
@@ -1044,6 +1066,12 @@
    $EXTCMD{$name} = $cb;
 }
 
+sub register_exticmd {
+   my ($name, $cb) = @_;
+
+   $EXTICMD{$name} = $cb;
+}
+
 cf::player->attach (
    on_command => sub {
       my ($pl, $name, $params) = @_;
@@ -1060,7 +1088,7 @@
    on_extcmd => sub {
       my ($pl, $buf) = @_;
 
-      my $msg = eval { from_json $buf };
+      my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
 
       if (ref $msg) {
          if (my $cb = $EXTCMD{$msg->{msgtype}}) {
@@ -1392,8 +1420,7 @@
    my ($self, $id, %msg) = @_;
 
    $msg{msgid} = $id;
-
-   $self->send ("ext " . cf::to_json \%msg);
+   $self->send ("ext " . $self->ns->{json_coder}->encode (\%msg));
 }
 
 =item $player->ext_event ($type, %msg)
@@ -2366,7 +2393,7 @@
    $msg = $self->pl->expand_cfpod ($msg);
 
    if ($self->can_msg) {
-      $self->send_packet ("msg " . cf::to_json [$color, $type, $msg, @extra]);
+      $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra]));
    } else {
       # replace some tags by gcfclient-compatible ones
       for ($msg) {
@@ -2391,7 +2418,7 @@
 
 =item $client->ext_event ($type, %msg)
 
-Sends an exti event to the client.
+Sends an ext event to the client.
 
 =cut
 
@@ -2399,7 +2426,7 @@
    my ($self, $type, %msg) = @_;
 
    $msg{msgtype} = "event_$type";
-   $self->send_packet ("ext " . cf::to_json \%msg);
+   $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
 }
 
 =item $success = $client->query ($flags, "text", \&cb)
@@ -2408,8 +2435,8 @@
 the reply text on a reply. flags can be C<cf::CS_QUERY_YESNO>,
 C<cf::CS_QUERY_SINGLECHAR> or C<cf::CS_QUERY_HIDEINPUT> or C<0>.
 
-Queries can fail, so check the return code. Or don't, as queries will become
-reliable at some point in the future.
+Queries can fail, so check the return code. Or don't, as queries will
+become reliable at some point in the future.
 
 =cut
 
@@ -2427,9 +2454,16 @@
 
    $self->send_packet ($self->{query_queue}[0][0])
       if @{ $self->{query_queue} } == 1;
+
+   1
 }
 
 cf::client->attach (
+   on_connect => sub {
+      my ($ns) = @_;
+
+      $ns->{json_coder} = JSON::XS->new->utf8->max_size (1e6)->convert_blessed;
+   },
    on_reply => sub {
       my ($ns, $msg) = @_;
 
@@ -2451,6 +2485,24 @@
          }
       }
    },
+   on_exticmd => sub {
+      my ($ns, $buf) = @_;
+
+      my $msg = eval { $ns->{json_coder}->decode ($buf) };
+
+      if (ref $msg) {
+         if (my $cb = $EXTICMD{$msg->{msgtype}}) {
+            if (my %reply = $cb->($ns, $msg)) {
+               $reply{msgid} = $msg->{msgid};
+               $ns->send ("ext " . $ns->{json_coder}->encode (\%reply));
+            }
+         }
+      } else {
+         warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
+      }
+
+      cf::override;
+   },
 );
 
 =item $client->async (\&cb)
@@ -2665,6 +2717,11 @@
 sub reload_archetypes {
    load_resource_file "$DATADIR/archetypes"
       or die "unable to load archetypes\n";
+   #d# NEED to laod twice to resolve forward references
+   # this really needs to be done in an extra post-pass
+   # (which needs to be synchronous, so solve it differently)
+   load_resource_file "$DATADIR/archetypes"
+      or die "unable to load archetypes\n";
 }
 
 sub reload_treasures {
@@ -2866,8 +2923,9 @@
       warn "removing commands";
       %COMMAND = ();
 
-      warn "removing ext commands";
-      %EXTCMD = ();
+      warn "removing ext/exti commands";
+      %EXTCMD  = ();
+      %EXTICMD = ();
 
       warn "unloading/nuking all extensions";
       for my $pkg (@EXTS) {