--- deliantra/server/lib/cf.pm 2006/07/20 22:03:36 1.26 +++ deliantra/server/lib/cf.pm 2006/08/09 10:57:28 1.29 @@ -16,6 +16,7 @@ our @EVENT; our %PROP_TYPE; our %PROP_IDX; +our $LIBDIR = maps_directory "perl"; BEGIN { @EVENT = map lc, @EVENT; @@ -232,14 +233,47 @@ warn "reloading...\n"; eval { + # 1. cancel all watchers $_->cancel for Event::all_watchers; - unload_extension $_ for @exts; + # 2. unload all extensions + for (@exts) { + $who->message ("unloading <$_>"); + unload_extension $_; + } + + # 3. unload all modules loaded from $LIBDIR + while (my ($k, $v) = each %INC) { + next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; + + $who->message ("removing <$k>"); + delete $INC{$k}; + + $k =~ s/\.pm$//; + $k =~ s/\//::/g; + + if (my $cb = $k->can ("unload_module")) { + $cb->(); + } + + Symbol::delete_package $k; + } + + # 4. get rid of ext::, as good as possible + Symbol::delete_package "ext::$_" + for qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region); + + # 5. remove register_script_function callbacks + # TODO + + # 6. unload cf.pm "a bit" delete $INC{"cf.pm"}; # don't, removes xs symbols, too #Symbol::delete_package __PACKAGE__; + # 7. reload cf.pm + $who->message ("reloading cf.pm"); require cf; }; warn $@ if $@; @@ -253,16 +287,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 } ############################################################################# @@ -358,6 +416,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($$$;$) { @@ -373,6 +439,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 @@ -386,7 +466,7 @@ # here we export the classes and methods available to script code for ( - ["cf::object" => qw(contr)], + ["cf::object" => qw(contr pay_amount pay_player)], ["cf::object::player" => qw(player)], ["cf::player" => qw(peaceful)], ) { @@ -433,7 +513,7 @@ register "", __PACKAGE__; -unshift @INC, maps_directory "perl"; +unshift @INC, $LIBDIR; load_extensions;