--- deliantra/server/lib/cf.pm 2012/11/06 23:33:15 1.591 +++ deliantra/server/lib/cf.pm 2012/11/09 02:50:50 1.594 @@ -89,7 +89,9 @@ our @EXTS = (); # list of extension package names our %EXTCMD = (); +our %EXTACMD = (); our %EXTICMD = (); +our %EXTIACMD = (); our %EXT_CORO = (); # coroutines bound to extensions our %EXT_MAP = (); # pluggable maps @@ -1433,7 +1435,7 @@ ############################################################################# # command handling &c -=item cf::register_command $name => \&callback($ob,$args); +=item cf::register_command $name => \&callback($ob,$args) Register a callback for execution when the client sends the user command $name. @@ -1449,7 +1451,7 @@ push @{ $COMMAND{$name} }, [$caller, $cb]; } -=item cf::register_extcmd $name => \&callback($pl,$packet); +=item cf::register_extcmd $name => \&callback($pl,@args) Register a callback for execution when the client sends an (synchronous) extcmd packet. Ext commands will be processed in the order they are @@ -1457,10 +1459,14 @@ 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. +The values will be sent back to the client. -=item cf::register_exticmd $name => \&callback($ns,$packet); +=item cf::register_async_extcmd $name => \&callback($pl,$reply->(...),@args) + +Same as C, but instead of returning values, the +callback needs to clal the C<$reply> function. + +=item cf::register_exticmd $name => \&callback($ns,@args) Register a callback for execution when the client sends an (asynchronous) exticmd packet. Exti commands are processed by the server as soon as they @@ -1468,23 +1474,39 @@ 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. +The values will be sent back to the client. + +=item cf::register_async_exticmd $name => \&callback($ns,$reply->(...),@args) + +Same as C, but instead of returning values, the +callback needs to clal the C<$reply> function. =cut -sub register_extcmd { +sub register_extcmd($$) { my ($name, $cb) = @_; $EXTCMD{$name} = $cb; } -sub register_exticmd { +sub register_async_extcmd($$) { + my ($name, $cb) = @_; + + $EXTACMD{$name} = $cb; +} + +sub register_exticmd($$) { my ($name, $cb) = @_; $EXTICMD{$name} = $cb; } +sub register_async_exticmd($$) { + my ($name, $cb) = @_; + + $EXTIACMD{$name} = $cb; +} + use File::Glob (); cf::player->attach ( @@ -1508,14 +1530,25 @@ if (ref $msg) { my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash - my @reply; + if (my $cb = $EXTACMD{$type}) { + $cb->( + $pl, + sub { + $pl->ext_msg ("reply-$reply", @_) + if $reply; + }, + @payload + ); + } else { + my @reply; - if (my $cb = $EXTCMD{$type}) { - @reply = $cb->($pl, @payload); - } + if (my $cb = $EXTCMD{$type}) { + @reply = $cb->($pl, @payload); + } - $pl->ext_reply ($reply, @reply) - if $reply; + $pl->ext_msg ("reply-$reply", @reply) + if $reply; + } } else { error "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; @@ -1912,18 +1945,6 @@ Expand deliantra pod fragments into protocol xml. -=item $player->ext_reply ($msgid, @msg) - -Sends an ext reply to the player. - -=cut - -sub ext_reply($$@) { - my ($self, $id, @msg) = @_; - - $self->ns->ext_reply ($id, @msg) -} - =item $player->ext_msg ($type, @msg) Sends an ext event to the client. @@ -3240,18 +3261,6 @@ $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); } -=item $client->ext_reply ($msgid, @msg) - -Sends an ext reply to the client. - -=cut - -sub cf::client::ext_reply($$@) { - my ($self, $id, @msg) = @_; - - $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg])); -} - =item $success = $client->query ($flags, "text", \&cb) Queues a query to the client, calling the given callback with @@ -3316,15 +3325,25 @@ if (ref $msg) { my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash - my @reply; - - if (my $cb = $EXTICMD{$type}) { - @reply = $cb->($ns, @payload); - } + if (my $cb = $EXTIACMD{$type}) { + $cb->( + $ns, + sub { + $ns->ext_msg ("reply-$reply", @_) + if $reply; + }, + @payload + ); + } else { + my @reply; - $ns->ext_reply ($reply, @reply) - if $reply; + if (my $cb = $EXTICMD{$type}) { + @reply = $cb->($ns, @payload); + } + $ns->ext_msg ("reply-$reply", @reply) + if $reply; + } } else { error "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; } @@ -3703,10 +3722,14 @@ } } +#d# move docstuff to help or so +our %DOCSTRING; + sub reload_pod { trace "loading pods $PODDIR\n"; - my @command_help; + %DOCSTRING = (); + my @command_list; for ( [0, "command_help"], @@ -3719,6 +3742,7 @@ or die "unable to load $path"; my $level = 1e9; + my $rpar; for my $par (@$paragraphs) { if ($par->{type} eq "head2") { @@ -3734,28 +3758,30 @@ my @variants = map "$cmd$_", sort { (length $a) <=> (length $b) } @args; - push @command_help, [$type, \@variants, &cf::pod::as_cfpod ([$par])]; + $rpar = \($DOCSTRING{"command/$cmd"} = &cf::pod::as_cfpod ([$par])); + + push @command_list, [$type, \@variants]; $level = $par->{level}; } else { error "$par->{markup}: unparsable command heading"; } } elsif ($par->{level} > $level) { - $command_help[-1][2] .= &cf::pod::as_cfpod ([$par]); + $$rpar .= &cf::pod::as_cfpod ([$par]); } cf::cede_to_tick; } } - @command_help = sort { + @command_list = sort { $a->[0] <=> $b->[0] or $a->[1] cmp $b->[1] - } @command_help; + } @command_list; cf::cede_to_tick; - add_face "res/command_help" => FT_RSRC, - JSON::XS->new->utf8->encode (\@command_help); + add_face "res/command_list" => FT_RSRC, + JSON::XS->new->utf8->encode (\@command_list); } sub reload_resources {