ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.27 by root, Fri Jul 21 00:51:39 2006 UTC vs.
Revision 1.31 by elmex, Mon Aug 14 04:22:04 2006 UTC

… …
70@ext::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; 70@ext::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object';
71@ext::cf::object::map::ISA = @cf::object::map::ISA = 'cf::object'; 71@ext::cf::object::map::ISA = @cf::object::map::ISA = 'cf::object';
72 72
73# we bless all objects into derived classes to force a method lookup 73# we bless all objects into derived classes to force a method lookup
74# within the Safe compartment. 74# within the Safe compartment.
75for my $pkg (qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region)) { 75for my $pkg (qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region cf::arch)) {
76 no strict 'refs'; 76 no strict 'refs';
77 @{"ext::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 77 @{"ext::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
78} 78}
79 79
80$Event::DIED = sub { 80$Event::DIED = sub {
… …
180 180
181sub unload_extension { 181sub unload_extension {
182 my ($pkg) = @_; 182 my ($pkg) = @_;
183 183
184 warn "removing extension $pkg\n"; 184 warn "removing extension $pkg\n";
185
186 if (my $cb = $pkg->can ("on_unload")) {
187 $cb->($pkg);
188 }
189 185
190 # remove hooks 186 # remove hooks
191 for my $idx (0 .. $#EVENT) { 187 for my $idx (0 .. $#EVENT) {
192 delete $hook[$idx]{$pkg}; 188 delete $hook[$idx]{$pkg};
193 } 189 }
… …
208 # remove extcmds 204 # remove extcmds
209 for my $name (grep $extcmd{$_}[1] eq $pkg, keys %extcmd) { 205 for my $name (grep $extcmd{$_}[1] eq $pkg, keys %extcmd) {
210 delete $extcmd{$name}; 206 delete $extcmd{$name};
211 } 207 }
212 208
209 if (my $cb = $pkg->can ("on_unload")) {
210 eval {
211 $cb->($pkg);
212 1
213 } or warn "$pkg unloaded, but with errors: $@";
214 }
215
213 Symbol::delete_package $pkg; 216 Symbol::delete_package $pkg;
214} 217}
215 218
216sub load_extensions { 219sub load_extensions {
217 my $LIBDIR = maps_directory "perl"; 220 my $LIBDIR = maps_directory "perl";
… …
285 $who->message ("Intruder Alert!"); 288 $who->message ("Intruder Alert!");
286 } 289 }
287}; 290};
288 291
289############################################################################# 292#############################################################################
293# utility functions
294
295use JSON::Syck (); # TODO# replace by JSON::PC once working
296
297sub from_json($) {
298 $JSON::Syck::ImplicitUnicode = 1; # work around JSON::Syck bugs
299 JSON::Syck::Load $_[0]
300}
301
302sub to_json($) {
303 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
304 JSON::Syck::Dump $_[0]
305}
306
307#############################################################################
290# extcmd framework, basically convert ext <id> <pkg> arg1 args 308# extcmd framework, basically convert ext <msg>
291# into pkg::->on_extcmd_arg1 (...) while shortcutting a few 309# into pkg::->on_extcmd_arg1 (...) while shortcutting a few
292 310
293sub on_extcmd { 311sub on_extcmd {
294 my ($pl, $buf) = @_; 312 my ($pl, $buf) = @_;
295 313
296 my ($type) = $buf =~ s/^(\S+) // ? $1 : ""; 314 my $msg = eval { from_json $buf };
297 315
298 $extcmd{$type}[0]->($pl, $buf) 316 if (ref $msg) {
299 if $extcmd{$type}; 317 if (my $cb = $extcmd{$msg->{msgtype}}) {
318 if (my %reply = $cb->[0]->($pl, $msg)) {
319 $pl->ext_reply ($msg->{msgid}, %reply);
320 }
321 }
322 } else {
323 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
324 }
325
326 1
300} 327}
301 328
302############################################################################# 329#############################################################################
303# load/save/clean perl data associated with a map 330# load/save/clean perl data associated with a map
304 331
… …
390sub cf::player::exists($) { 417sub cf::player::exists($) {
391 cf::player::find $_[0] 418 cf::player::find $_[0]
392 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 419 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
393} 420}
394 421
422=item $player->reply ($npc, $msg[, $flags])
423
424Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
425can be C<undef>. Does the right thing when the player is currently in a
426dialogue with the given NPC character.
427
428=cut
429
395# rough implementation of a future "reply" method that works 430# rough implementation of a future "reply" method that works
396# with dialog boxes. 431# with dialog boxes.
397sub cf::object::player::reply($$$;$) { 432sub cf::object::player::reply($$$;$) {
398 my ($self, $npc, $msg, $flags) = @_; 433 my ($self, $npc, $msg, $flags) = @_;
399 434
… …
403 push @{ $self->{record_replies} }, [$npc, $msg, $flags]; 438 push @{ $self->{record_replies} }, [$npc, $msg, $flags];
404 } else { 439 } else {
405 $msg = $npc->name . " says: $msg" if $npc; 440 $msg = $npc->name . " says: $msg" if $npc;
406 $self->message ($msg, $flags); 441 $self->message ($msg, $flags);
407 } 442 }
443}
444
445=item $player->ext_reply ($msgid, $msgtype, %msg)
446
447Sends an ext reply to the player.
448
449=cut
450
451sub cf::player::ext_reply($$$%) {
452 my ($self, $id, %msg) = @_;
453
454 $msg{msgid} = $id;
455
456 $self->send ("ext " . to_json \%msg);
408} 457}
409 458
410############################################################################# 459#############################################################################
411# map scripting support 460# map scripting support
412 461

Diff Legend

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