| 1 | package cf; |
1 | package cf; |
|
|
2 | |
|
|
3 | use utf8; |
|
|
4 | use strict; |
| 2 | |
5 | |
| 3 | use Symbol; |
6 | use Symbol; |
| 4 | use List::Util; |
7 | use List::Util; |
| 5 | use Storable; |
8 | use Storable; |
| 6 | use Opcode; |
9 | use Opcode; |
| 7 | use Safe; |
10 | use Safe; |
| 8 | use Safe::Hole; |
11 | use Safe::Hole; |
| 9 | |
12 | |
|
|
13 | use Coro; |
|
|
14 | use Coro::Event; |
|
|
15 | use Coro::Timer; |
|
|
16 | use Coro::Signal; |
|
|
17 | use Coro::Semaphore; |
|
|
18 | |
| 10 | use IO::AIO (); |
19 | use IO::AIO; |
| 11 | use YAML::Syck (); |
20 | use YAML::Syck (); |
| 12 | use Time::HiRes; |
21 | use Time::HiRes; |
| 13 | use Event; |
22 | |
| 14 | $Event::Eval = 1; # no idea why this is required, but it is |
23 | use Event; $Event::Eval = 1; # no idea why this is required, but it is |
| 15 | |
24 | |
| 16 | # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? |
25 | # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? |
| 17 | $YAML::Syck::ImplicitUnicode = 1; |
26 | $YAML::Syck::ImplicitUnicode = 1; |
| 18 | |
27 | |
| 19 | use strict; |
28 | $Coro::main->prio (Coro::PRIO_MIN); |
| 20 | |
29 | |
| 21 | sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload |
30 | sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload |
| 22 | |
31 | |
| 23 | our %COMMAND = (); |
32 | our %COMMAND = (); |
| 24 | our %COMMAND_TIME = (); |
33 | our %COMMAND_TIME = (); |
| … | |
… | |
| 249 | my ($self, $victim) = @_; |
258 | my ($self, $victim) = @_; |
| 250 | ... |
259 | ... |
| 251 | } |
260 | } |
| 252 | } |
261 | } |
| 253 | |
262 | |
|
|
263 | =item $attachable->valid |
|
|
264 | |
|
|
265 | Just because you have a perl object does not mean that the corresponding |
|
|
266 | C-level object still exists. If you try to access an object that has no |
|
|
267 | valid C counterpart anymore you get an exception at runtime. This method |
|
|
268 | can be used to test for existence of the C object part without causing an |
|
|
269 | exception. |
|
|
270 | |
| 254 | =cut |
271 | =cut |
| 255 | |
272 | |
| 256 | # the following variables are defined in .xs and must not be re-created |
273 | # the following variables are defined in .xs and must not be re-created |
| 257 | our @CB_GLOBAL = (); # registry for all global events |
274 | our @CB_GLOBAL = (); # registry for all global events |
| 258 | our @CB_OBJECT = (); # all objects (should not be used except in emergency) |
275 | our @CB_OBJECT = (); # all objects (should not be used except in emergency) |
| … | |
… | |
| 413 | } |
430 | } |
| 414 | |
431 | |
| 415 | 0 |
432 | 0 |
| 416 | } |
433 | } |
| 417 | |
434 | |
| 418 | =item $bool = cf::invoke EVENT_GLOBAL_XXX, ... |
435 | =item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) |
| 419 | |
436 | |
| 420 | =item $bool = $object->invoke (EVENT_OBJECT_XXX, ...) |
|
|
| 421 | |
|
|
| 422 | =item $bool = $player->invoke (EVENT_PLAYER_XXX, ...) |
|
|
| 423 | |
|
|
| 424 | =item $bool = $client->invoke (EVENT_CLIENT_XXX, ...) |
437 | =item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) |
| 425 | |
438 | |
| 426 | =item $bool = $map->invoke (EVENT_MAP_XXX, ...) |
|
|
| 427 | |
|
|
| 428 | Generate a global/object/player/map-specific event with the given arguments. |
439 | Generate an object-specific event with the given arguments. |
| 429 | |
440 | |
| 430 | This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be |
441 | This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be |
| 431 | removed in future versions), and there is no public API to access override |
442 | removed in future versions), and there is no public API to access override |
| 432 | results (if you must, access C<@cf::invoke_results> directly). |
443 | results (if you must, access C<@cf::invoke_results> directly). |
| 433 | |
|
|
| 434 | =back |
|
|
| 435 | |
|
|
| 436 | =cut |
|
|
| 437 | |
|
|
| 438 | ############################################################################# |
|
|
| 439 | |
|
|
| 440 | =head2 METHODS VALID FOR ALL ATTACHABLE OBJECTS |
|
|
| 441 | |
|
|
| 442 | Attachable objects includes objects, players, clients and maps. |
|
|
| 443 | |
|
|
| 444 | =over 4 |
|
|
| 445 | |
|
|
| 446 | =item $object->valid |
|
|
| 447 | |
|
|
| 448 | Just because you have a perl object does not mean that the corresponding |
|
|
| 449 | C-level object still exists. If you try to access an object that has no |
|
|
| 450 | valid C counterpart anymore you get an exception at runtime. This method |
|
|
| 451 | can be used to test for existence of the C object part without causing an |
|
|
| 452 | exception. |
|
|
| 453 | |
444 | |
| 454 | =back |
445 | =back |
| 455 | |
446 | |
| 456 | =cut |
447 | =cut |
| 457 | |
448 | |
| … | |
… | |
| 898 | $ns->send_packet ($ns->{query_queue}[0][0]); |
889 | $ns->send_packet ($ns->{query_queue}[0][0]); |
| 899 | } else { |
890 | } else { |
| 900 | $ns->state (ST_PLAYING); |
891 | $ns->state (ST_PLAYING); |
| 901 | } |
892 | } |
| 902 | } |
893 | } |
|
|
894 | }, |
|
|
895 | ); |
|
|
896 | |
|
|
897 | =item $client->coro (\&cb) |
|
|
898 | |
|
|
899 | Create a new coroutine, running the specified callback. The coroutine will |
|
|
900 | be automatically cancelled when the client gets destroyed (e.g. on logout, |
|
|
901 | or loss of connection). |
|
|
902 | |
|
|
903 | =cut |
|
|
904 | |
|
|
905 | sub cf::client::coro { |
|
|
906 | my ($self, $cb) = @_; |
|
|
907 | |
|
|
908 | my $coro; $coro = async { |
|
|
909 | eval { |
|
|
910 | $cb->(); |
|
|
911 | }; |
|
|
912 | warn $@ if $@; |
|
|
913 | warn "cancel myself\n";#d# |
|
|
914 | delete $self->{_coro}{$coro+0}; |
|
|
915 | }; |
|
|
916 | |
|
|
917 | $self->{_coro}{$coro+0} = $coro; |
|
|
918 | } |
|
|
919 | |
|
|
920 | cf::client->attach ( |
|
|
921 | on_destroy => sub { |
|
|
922 | my ($ns) = @_; |
|
|
923 | |
|
|
924 | warn "cancel $_" for values %{ $ns->{_coro} || {} };#d# |
|
|
925 | $_->cancel for values %{ $ns->{_coro} || {} }; |
| 903 | }, |
926 | }, |
| 904 | ); |
927 | ); |
| 905 | |
928 | |
| 906 | =back |
929 | =back |
| 907 | |
930 | |
