[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.285 by root, Sun Jun 24 04:21:42 2007 UTC vs.
Revision 1.289 by root, Sat Jun 30 03:00:54 2007 UTC

 use Coro::Signal;
 use Coro::Semaphore;
 use Coro::AIO;
 use Coro::Storable;
+use JSON::XS 1.4 ();
 use BDB ();
 use Data::Dumper;
 use Digest::MD5;
 use Fcntl;
 use YAML::Syck ();
 our %COMMAND      = ();
 our %COMMAND_TIME = ();
 our @EXTS         = (); # list of extension package names
 our %EXTCMD       = ();
+our %EXTICMD      = ();
 our %EXT_CORO     = (); # coroutines bound to extensions
 our %EXT_MAP      = (); # pluggable maps
 our $RELOAD; # number of reloads so far
 our @EVENT;
       $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
       $d
    } || "[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.
 =item $json = cf::to_json $ref
 Converts a perl data structure into its JSON representation.
+=cut
+our $json_coder = JSON::XS->new->convert_blessed->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.
    push @{ $COMMAND{$name} }, [$caller, $cb];
 }
 =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.
 =cut
 sub register_extcmd {
    my ($name, $cb) = @_;
    $EXTCMD{$name} = $cb;
+}
+sub register_exticmd {
+   my ($name, $cb) = @_;
+   $EXTICMD{$name} = $cb;
 }
 cf::player->attach (
    on_command => sub {
       my ($pl, $name, $params) = @_;
 sub ext_reply($$%) {
    my ($self, $id, %msg) = @_;
    $msg{msgid} = $id;
    $self->send ("ext " . cf::to_json \%msg);
 }
 =item $player->ext_event ($type, %msg)
       if ($color >= 0) {
          if (0 && $msg =~ /\[/) {
             $self->send_packet ("drawextinfo $color 4 0 $msg")
          } else {
-            s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
+            $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
             $self->send_packet ("drawinfo $color $msg")
          }
       }
    }
 }
 =item $client->ext_event ($type, %msg)
-Sends an exti event to the client.
+Sends an ext event to the client.
 =cut
 sub cf::client::ext_event($$%) {
    my ($self, $type, %msg) = @_;
 Queues a query to the client, calling the given callback with
 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
+Queries can fail, so check the return code. Or don't, as queries will
-reliable at some point in the future.
+become reliable at some point in the future.
 =cut
 sub cf::client::query {
    my ($self, $flags, $text, $cb) = @_;
    utf8::encode $text;
    push @{ $self->{query_queue} }, [(sprintf "query %d %s", $flags, $text), $cb];
    $self->send_packet ($self->{query_queue}[0][0])
       if @{ $self->{query_queue} } == 1;
+   1
 }
 cf::client->attach (
    on_reply => sub {
       my ($ns, $msg) = @_;
             $ns->send_packet ($ns->{query_queue}[0][0]);
          } else {
             $ns->state (ST_PLAYING) if $ns->state == ST_CUSTOM;
          }
       }
+   },
+   on_exticmd => sub {
+      my ($ns, $buf) = @_;
+      my $msg = eval { from_json $buf };
+      if (ref $msg) {
+         if (my $cb = $EXTICMD{$msg->{msgtype}}) {
+            if (my %reply = $cb->($ns, $msg)) {
+               $reply{msgid} = $msg->{msgid};
+               $ns->send ("ext " . cf::to_json \%reply);
+            }
+         }
+      } else {
+         warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
+      }
+      cf::override;
    },
 );
 =item $client->async (\&cb)
    load_facedata "$DATADIR/facedata"
       or die "unable to load facedata\n";
 }
 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 {
       %EXT_CORO = ();
       warn "removing commands";
       %COMMAND = ();
-      warn "removing ext commands";
+      warn "removing ext/exti commands";
-      %EXTCMD = ();
+      %EXTCMD  = ();
+      %EXTICMD = ();
       warn "unloading/nuking all extensions";
       for my $pkg (@EXTS) {
          warn "... unloading $pkg";

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.285 by root, Sun Jun 24 04:21:42 2007 UTC vs. Revision 1.289 by root, Sat Jun 30 03:00:54 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.285 by root, Sun Jun 24 04:21:42 2007 UTC vs.
Revision 1.289 by root, Sat Jun 30 03:00:54 2007 UTC