--- deliantra/server/lib/cf.pm	2006/12/22 02:04:20	1.95
+++ deliantra/server/lib/cf.pm	2006/12/22 06:02:29	1.96
@@ -1,5 +1,8 @@
 package cf;
 
+use utf8;
+use strict;
+
 use Symbol;
 use List::Util;
 use Storable;
@@ -7,16 +10,22 @@
 use Safe;
 use Safe::Hole;
 
-use IO::AIO ();
+use Coro;
+use Coro::Event;
+use Coro::Timer;
+use Coro::Signal;
+use Coro::Semaphore;
+
+use IO::AIO;
 use YAML::Syck ();
 use Time::HiRes;
-use Event;
-$Event::Eval = 1; # no idea why this is required, but it is
+
+use Event; $Event::Eval = 1; # no idea why this is required, but it is
 
 # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
 $YAML::Syck::ImplicitUnicode = 1;
 
-use strict;
+$Coro::main->prio (Coro::PRIO_MIN);
 
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
 
@@ -251,6 +260,14 @@
       }
    }
 
+=item $attachable->valid
+
+Just because you have a perl object does not mean that the corresponding
+C-level object still exists. If you try to access an object that has no
+valid C counterpart anymore you get an exception at runtime. This method
+can be used to test for existence of the C object part without causing an
+exception.
+
 =cut
 
 # the following variables are defined in .xs and must not be re-created
@@ -415,19 +432,13 @@
    0
 }
 
-=item $bool = cf::invoke EVENT_GLOBAL_XXX, ...
+=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...)
 
-=item $bool = $object->invoke (EVENT_OBJECT_XXX, ...)
+=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
 
-=item $bool = $player->invoke (EVENT_PLAYER_XXX, ...)
+Generate an object-specific event with the given arguments.
 
-=item $bool = $client->invoke (EVENT_CLIENT_XXX, ...)
-
-=item $bool = $map->invoke (EVENT_MAP_XXX, ...)
-
-Generate a global/object/player/map-specific event with the given arguments.
-
-This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be
+This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be
 removed in future versions), and there is no public API to access override
 results (if you must, access C<@cf::invoke_results> directly).
 
@@ -436,26 +447,6 @@
 =cut
 
 #############################################################################
-
-=head2 METHODS VALID FOR ALL ATTACHABLE OBJECTS
-
-Attachable objects includes objects, players, clients and maps.
-
-=over 4
-
-=item $object->valid
-
-Just because you have a perl object does not mean that the corresponding
-C-level object still exists. If you try to access an object that has no
-valid C counterpart anymore you get an exception at runtime. This method
-can be used to test for existence of the C object part without causing an
-exception.
-
-=back
-
-=cut
-
-#############################################################################
 # object support
 
 sub instantiate {
@@ -903,6 +894,38 @@
    },
 );
 
+=item $client->coro (\&cb)
+
+Create a new coroutine, running the specified callback. The coroutine will
+be automatically cancelled when the client gets destroyed (e.g. on logout,
+or loss of connection).
+
+=cut
+
+sub cf::client::coro {
+   my ($self, $cb) = @_;
+
+   my $coro; $coro = async {
+      eval {
+         $cb->();
+      };
+      warn $@ if $@;
+      warn "cancel myself\n";#d#
+      delete $self->{_coro}{$coro+0};
+   };
+
+   $self->{_coro}{$coro+0} = $coro;
+}
+
+cf::client->attach (
+   on_destroy => sub {
+      my ($ns) = @_;
+
+      warn "cancel $_" for values %{ $ns->{_coro} || {} };#d#
+      $_->cancel for values %{ $ns->{_coro} || {} };
+   },
+);
+
 =back