--- deliantra/server/lib/cf.pm 2006/07/21 00:51:39 1.27 +++ deliantra/server/lib/cf.pm 2006/08/14 04:22:04 1.31 @@ -72,7 +72,7 @@ # we bless all objects into derived classes to force a method lookup # within the Safe compartment. -for my $pkg (qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region)) { +for my $pkg (qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region cf::arch)) { no strict 'refs'; @{"ext::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; } @@ -183,10 +183,6 @@ warn "removing extension $pkg\n"; - if (my $cb = $pkg->can ("on_unload")) { - $cb->($pkg); - } - # remove hooks for my $idx (0 .. $#EVENT) { delete $hook[$idx]{$pkg}; @@ -210,6 +206,13 @@ delete $extcmd{$name}; } + if (my $cb = $pkg->can ("on_unload")) { + eval { + $cb->($pkg); + 1 + } or warn "$pkg unloaded, but with errors: $@"; + } + Symbol::delete_package $pkg; } @@ -287,16 +290,40 @@ }; ############################################################################# -# extcmd framework, basically convert ext arg1 args +# utility functions + +use JSON::Syck (); # TODO# replace by JSON::PC once working + +sub from_json($) { + $JSON::Syck::ImplicitUnicode = 1; # work around JSON::Syck bugs + JSON::Syck::Load $_[0] +} + +sub to_json($) { + $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs + JSON::Syck::Dump $_[0] +} + +############################################################################# +# extcmd framework, basically convert ext # into pkg::->on_extcmd_arg1 (...) while shortcutting a few sub on_extcmd { my ($pl, $buf) = @_; - my ($type) = $buf =~ s/^(\S+) // ? $1 : ""; + my $msg = eval { from_json $buf }; + + if (ref $msg) { + if (my $cb = $extcmd{$msg->{msgtype}}) { + if (my %reply = $cb->[0]->($pl, $msg)) { + $pl->ext_reply ($msg->{msgid}, %reply); + } + } + } else { + warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; + } - $extcmd{$type}[0]->($pl, $buf) - if $extcmd{$type}; + 1 } ############################################################################# @@ -392,6 +419,14 @@ or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; } +=item $player->reply ($npc, $msg[, $flags]) + +Sends a message to the player, as if the npc C<$npc> replied. C<$npc> +can be C. Does the right thing when the player is currently in a +dialogue with the given NPC character. + +=cut + # rough implementation of a future "reply" method that works # with dialog boxes. sub cf::object::player::reply($$$;$) { @@ -407,6 +442,20 @@ } } +=item $player->ext_reply ($msgid, $msgtype, %msg) + +Sends an ext reply to the player. + +=cut + +sub cf::player::ext_reply($$$%) { + my ($self, $id, %msg) = @_; + + $msg{msgid} = $id; + + $self->send ("ext " . to_json \%msg); +} + ############################################################################# # map scripting support