This patch implements a new type of watcher that I need. I need to be
able to generate events from Perl code, possibly with many watchers for
the same source event, and I need to be able to pass data in the event to
the callbacks. Situations where the per-event data is not required can
be handled using a var watcher, which I've been doing quite happily,
but I now definitely need per-event data. Lacking a better name,
I called these "generic" watchers.
See the documentation in the patch below for details of what I've
implemented. Having now done this, I think if I were designing an event
loop system from scratch I'd use reified event sources, rather than
watchers, as the basis of the architecture. The event source is implicit
in most Event watchers, but is necessarily an explicit object in what I've
implemented here. I like the separation that is achieved between the two.
I'm not planning any other code patches, by the way. I don't expect to
need any more features.
-zefram
diff -ur Event-orig/Event.xs Event-mod/Event.xs
--- Event-orig/Event.xs 2004-11-29 21:53:10.000000000 +0000
+++ Event-mod/Event.xs 2004-12-01 00:12:47.000000000 +0000
@@ -277,6 +277,7 @@
#include "signal.c"
#include "tied.c"
#include "group.c"
+#include "generic.c"
#include "queue.c"
MODULE = Event PACKAGE = Event
@@ -299,6 +300,7 @@
boot_tied();
boot_signal();
boot_group();
+ boot_generic();
boot_queue();
{
SV *apisv;
@@ -539,6 +541,13 @@
PPCODE:
XPUSHs(sv_2mortal(events_mask_2sv(((pe_ioevent*)THIS)->got)));
+MODULE = Event PACKAGE = Event::Event::Dataful
+
+void
+pe_event::data()
+ PPCODE:
+ XPUSHs(((pe_datafulevent*)THIS)->data);
+
MODULE = Event PACKAGE = Event::Event
void
@@ -942,3 +951,54 @@
PUTBACK;
_group_del(THIS, items == 2? sv_mortalcopy(ST(1)) : 0);
SPAGAIN;
+
+MODULE = Event PACKAGE = Event::generic
+
+void
+allocate(clname, temple)
+ SV *clname;
+ SV *temple;
+ PPCODE:
+ XPUSHs(watcher_2sv(pe_generic_allocate(gv_stashsv(clname, 1),
+ SvRV(temple))));
+
+void
+pe_watcher::source(...)
+ PPCODE:
+ PUTBACK;
+ _generic_source(THIS, items == 2? sv_mortalcopy(ST(1)) : 0);
+ SPAGAIN;
+
+MODULE = Event PACKAGE = Event::generic::Source
+
+void
+allocate(clname, temple)
+ SV *clname;
+ SV *temple;
+ PPCODE:
+ if (!SvROK(temple)) croak("Bad template");
+ XPUSHs(genericsrc_2sv(pe_genericsrc_allocate(gv_stashsv(clname, 1),
+ SvRV(temple))));
+
+void
+DESTROY(ref)
+ SV *ref;
+ CODE:
+{
+ pe_genericsrc_dtor(sv_2genericsrc(ref));
+}
+
+void
+pe_genericsrc::event(...)
+ PPCODE:
+ pe_genericsrc_event(THIS,
+ items >= 2 ? sv_mortalcopy(ST(1)) : &PL_sv_undef);
+
+void
+pe_genericsrc::active_watchers()
+ PPCODE:
+ pe_generic *wa = THIS->watchers.next->self;
+ while (wa) {
+ XPUSHs(watcher_2sv(&wa->base));
+ wa = wa->active.next->self;
+ }
diff -ur Event-orig/MANIFEST Event-mod/MANIFEST
--- Event-orig/MANIFEST 2002-01-22 06:11:53.000000000 +0000
+++ Event-mod/MANIFEST 2004-12-01 00:19:40.000000000 +0000
@@ -10,6 +10,7 @@
TODO
Tutorial.pdf
c/ev.c
+c/generic.c
c/group.c
c/hook.c
c/idle.c
@@ -38,6 +39,8 @@
lib/Event/EventAPI.h
lib/Event/MakeMaker.pm
lib/Event/Watcher.pm
+lib/Event/generic.pm
+lib/Event/generic.pod
lib/Event/group.pm
lib/Event/idle.pm
lib/Event/io.pm
diff -ur Event-orig/c/ev.c Event-mod/c/ev.c
--- Event-orig/c/ev.c 2002-05-12 09:29:13.000000000 +0100
+++ Event-mod/c/ev.c 2004-11-28 22:57:31.000000000 +0000
@@ -6,7 +6,7 @@
static pe_cbframe CBFrame[MAX_CB_NEST];
static int CurCBFrame = -1;
-pe_event_vtbl event_vtbl, ioevent_vtbl;
+pe_event_vtbl event_vtbl, ioevent_vtbl, datafulevent_vtbl;
static void pe_anyevent_init(pe_event *ev, pe_watcher *wa) {
assert(wa);
@@ -144,6 +144,42 @@
/*------------------------------------------------------*/
+static pe_event *pe_datafulevent_allocate(pe_watcher *wa) {
+ pe_datafulevent *ev;
+ assert(wa);
+ if (PE_RING_EMPTY(&datafulevent_vtbl.freelist)) {
+ EvNew(15, ev, 1, pe_datafulevent);
+ ev->base.vtbl = &datafulevent_vtbl;
+ PE_RING_INIT(&ev->base.que, ev);
+ } else {
+ pe_ring *lk = datafulevent_vtbl.freelist.prev;
+ PE_RING_DETACH(lk);
+ ev = (pe_datafulevent*) lk->self;
+ }
+ pe_anyevent_init(&ev->base, wa);
+ ev->data = &PL_sv_undef;
+ return &ev->base;
+}
+
+static void pe_datafulevent_dtor(pe_event *ev) {
+ pe_datafulevent *de = (pe_datafulevent *)ev;
+ SvREFCNT_dec(de->data);
+ pe_anyevent_dtor(ev);
+ PE_RING_UNSHIFT(&ev->que, &datafulevent_vtbl.freelist);
+}
+
+EKEYMETH(_event_data) {
+ pe_datafulevent *de = (pe_datafulevent *)ev;
+ if (!nval) {
+ dSP;
+ XPUSHs(de->data);
+ PUTBACK;
+ } else
+ croak("'e_data' is read-only");
+}
+
+/*------------------------------------------------------*/
+
static void pe_event_postCB(pe_cbframe *fp) {
pe_event *ev = fp->ev;
pe_watcher *wa = ev->up;
@@ -318,5 +354,12 @@
vt->dtor = pe_ioevent_dtor;
PE_RING_INIT(&vt->freelist, 0);
+ vt = &datafulevent_vtbl;
+ memcpy(vt, &event_vtbl, sizeof(pe_event_vtbl));
+ vt->stash = gv_stashpv("Event::Event::Dataful", 1);
+ vt->new_event = pe_datafulevent_allocate;
+ vt->dtor = pe_datafulevent_dtor;
+ PE_RING_INIT(&vt->freelist, 0);
+
memset(QueueTime, 0, sizeof(QueueTime));
}
diff -ur Event-orig/c/generic.c Event-mod/c/generic.c
--- Event-orig/c/generic.c 2004-11-29 23:03:11.000000000 +0000
+++ Event-mod/c/generic.c 2004-11-30 23:31:48.000000000 +0000
@@ -0,0 +1,95 @@
+static struct pe_watcher_vtbl pe_generic_vtbl;
+
+static pe_watcher *pe_generic_allocate(HV *stash, SV *temple) {
+ pe_generic *ev;
+ EvNew(14, ev, 1, pe_generic);
+ ev->base.vtbl = &pe_generic_vtbl;
+ pe_watcher_init(&ev->base, stash, temple);
+ ev->source = &PL_sv_undef;
+ PE_RING_INIT(&ev->active, ev);
+ WaREPEAT_on(ev);
+ WaINVOKE1_off(ev);
+ return (pe_watcher*) ev;
+}
+
+static void pe_generic_dtor(pe_watcher *ev) {
+ pe_generic *gw = (pe_generic *)ev;
+ SvREFCNT_dec(gw->source);
+ pe_watcher_dtor(ev);
+ EvFree(14, ev);
+}
+
+static char *pe_generic_start(pe_watcher *_ev, int repeat) {
+ pe_generic *ev = (pe_generic*) _ev;
+ SV *source = ev->source;
+ pe_genericsrc *src;
+ if (!_ev->callback)
+ return "without callback";
+ if (!source || !SvOK(source))
+ return "without source";
+ src = sv_2genericsrc(source);
+ PE_RING_UNSHIFT(&ev->active, &src->watchers);
+ return 0;
+}
+
+static void pe_generic_stop(pe_watcher *_ev) {
+ pe_generic *ev = (pe_generic*) _ev;
+ PE_RING_DETACH(&ev->active);
+}
+
+WKEYMETH(_generic_source) {
+ pe_generic *gw = (pe_generic*)ev;
+ if (nval) {
+ if(SvOK(nval)) {
+ sv_2genericsrc(nval);
+ }
+ SV *old = gw->source;
+ int active = WaPOLLING(ev);
+ if (active) pe_watcher_off(ev);
+ gw->source = SvREFCNT_inc(nval);
+ if (active) pe_watcher_on(ev, 0);
+ SvREFCNT_dec(old);
+ }
+ {
+ dSP;
+ XPUSHs(gw->source);
+ PUTBACK;
+ }
+}
+
+static pe_genericsrc *pe_genericsrc_allocate(HV *stash, SV *temple) {
+ pe_genericsrc *src;
+ EvNew(16, src, 1, pe_genericsrc);
+ src->mysv = stash || temple ? wrap_genericsrc(src, stash, temple) : 0;
+ PE_RING_INIT(&src->watchers, 0);
+ return src;
+}
+
+static void pe_genericsrc_dtor(pe_genericsrc *src) {
+ PE_RING_DETACH(&src->watchers);
+ EvFree(16, src);
+}
+
+static HV *pe_genericsrc_stash;
+
+static void pe_genericsrc_event(pe_genericsrc *src, SV *data) {
+ pe_generic *wa = src->watchers.next->self;
+ while(wa) {
+ pe_datafulevent *ev =
+ (pe_datafulevent*) (*wa->base.vtbl->new_event)(&wa->base);
+ ++ev->base.hits;
+ ev->data = SvREFCNT_inc(data);
+ queueEvent(&ev->base);
+ wa = wa->active.next->self;
+ }
+}
+
+static void boot_generic() {
+ pe_watcher_vtbl *vt = &pe_generic_vtbl;
+ memcpy(vt, &pe_watcher_base_vtbl, sizeof(pe_watcher_base_vtbl));
+ vt->dtor = pe_generic_dtor;
+ vt->start = pe_generic_start;
+ vt->stop = pe_generic_stop;
+ pe_register_vtbl(vt, gv_stashpv("Event::generic",1), &datafulevent_vtbl);
+ pe_genericsrc_stash = gv_stashpv("Event::generic::Source", 1);
+}
diff -ur Event-orig/c/typemap.c Event-mod/c/typemap.c
--- Event-orig/c/typemap.c 2002-05-12 08:54:12.000000000 +0100
+++ Event-mod/c/typemap.c 2004-11-30 22:34:20.000000000 +0000
@@ -1,6 +1,4 @@
-#define MG_PRIVATE_CODE ((((unsigned)'e')<<8) + (unsigned)'v')
-
-static SV *wrap_watcher(void *ptr, HV *stash, SV *temple) {
+static SV *wrap_thing(U16 mgcode, void *ptr, HV *stash, SV *temple) {
SV *ref;
MAGIC **mgp;
MAGIC *mg;
@@ -28,12 +26,39 @@
Zero(mg, 1, MAGIC);
mg->mg_type = '~';
mg->mg_obj = (SV*) ptr; /* NOT refcnt'd */
- mg->mg_private = MG_PRIVATE_CODE;
+ mg->mg_private = mgcode;
*mgp = mg;
return ref;
}
+static void* sv_2thing(U16 mgcode, SV *sv) {
+ MAGIC *mg;
+ SV *origsv = sv;
+ if (!sv || !SvROK(sv))
+ croak("sv_2thing: not a reference?");
+ sv = SvRV(sv);
+ if (SvTYPE(sv) < SVt_PVMG)
+ croak("sv_2thing: not a thing");
+ if (!SvOBJECT(sv))
+ croak("sv_2thing: not an object");
+ mg = mg_find(sv, '~');
+ if (mg) {
+ if (mg->mg_private != mgcode) {
+ croak("Can't find event magic (SV=0x%x)", sv);
+ }
+ return (void*) mg->mg_obj;
+ }
+ croak("sv_2thing: can't decode SV=0x%x", origsv);
+ return 0;
+}
+
+#define MG_WATCHER_CODE ((((unsigned)'e')<<8) + (unsigned)'v')
+
+static SV *wrap_watcher(void *ptr, HV *stash, SV *temple) {
+ return wrap_thing(MG_WATCHER_CODE, ptr, stash, temple);
+}
+
SV *watcher_2sv(pe_watcher *wa) { /**SLOW IS OKAY**/
assert(!WaDESTROYED(wa));
if (!wa->mysv) {
@@ -48,24 +73,26 @@
}
void* sv_2watcher(SV *sv) {
- MAGIC *mg;
- SV *origsv = sv;
- if (!sv || !SvROK(sv))
- croak("sv_2watcher: not a reference?");
- sv = SvRV(sv);
- if (SvTYPE(sv) < SVt_PVMG)
- croak("sv_2watcher: not a watcher");
- if (!SvOBJECT(sv))
- croak("sv_2watcher: not an object");
- mg = mg_find(sv, '~');
- if (mg) {
- if (mg->mg_private != MG_PRIVATE_CODE) {
- croak("Can't find event magic (SV=0x%x)", sv);
- }
- return (void*) mg->mg_obj;
+ return sv_2thing(MG_WATCHER_CODE, sv);
+}
+
+#define MG_GENERICSRC_CODE 2422 /* randomly chosen */
+
+static SV *wrap_genericsrc(void *ptr, HV *stash, SV *temple) {
+ return wrap_thing(MG_GENERICSRC_CODE, ptr, stash, temple);
+}
+
+static HV *pe_genericsrc_stash;
+
+static SV *genericsrc_2sv(pe_genericsrc *src) { /**SLOW IS OKAY**/
+ if (!src->mysv) {
+ src->mysv = wrap_genericsrc(src, pe_genericsrc_stash, 0);
}
- croak("sv_2watcher: can't decode SV=0x%x", origsv);
- return 0;
+ return SvREFCNT_inc(sv_2mortal(src->mysv));
+}
+
+static void* sv_2genericsrc(SV *sv) {
+ return sv_2thing(MG_GENERICSRC_CODE, sv);
}
/*
diff -ur Event-orig/lib/Event/EventAPI.h Event-mod/lib/Event/EventAPI.h
--- Event-orig/lib/Event/EventAPI.h 2000-12-08 16:47:18.000000000 +0000
+++ Event-mod/lib/Event/EventAPI.h 2004-11-30 21:21:00.000000000 +0000
@@ -108,6 +108,12 @@
U16 got;
};
+typedef struct pe_datafulevent pe_datafulevent;
+struct pe_datafulevent {
+ pe_event base;
+ SV *data;
+};
+
typedef struct pe_idle pe_idle;
struct pe_idle {
pe_watcher base;
@@ -163,6 +169,19 @@
pe_watcher **member;
};
+typedef struct pe_generic pe_generic;
+struct pe_generic {
+ pe_watcher base;
+ SV *source;
+ pe_ring active;
+};
+
+typedef struct pe_genericsrc pe_genericsrc;
+struct pe_genericsrc {
+ SV *mysv;
+ pe_ring watchers;
+};
+
typedef struct pe_event_stats_vtbl pe_event_stats_vtbl;
struct pe_event_stats_vtbl {
int on;
diff -ur Event-orig/lib/Event/generic.pm Event-mod/lib/Event/generic.pm
--- Event-orig/lib/Event/generic.pm 2004-11-29 23:03:11.000000000 +0000
+++ Event-mod/lib/Event/generic.pm 2004-12-01 00:25:57.000000000 +0000
@@ -0,0 +1,29 @@
+use strict;
+package Event::generic;
+use base 'Event::Watcher';
+use vars qw(@ATTRIBUTE);
[EMAIL PROTECTED] = qw(source);
+
+'Event::Watcher'->register;
+
+sub new {
+ # lock %Event::;
+
+ my $class = shift;
+ my %arg = @_;
+ my $o = allocate($class, delete $arg{attach_to} || {});
+ $o->init(\%arg);
+ $o;
+}
+
+package Event::generic::Source;
+
+sub new($) {
+ return allocate($_[0], {});
+}
+
+sub watch(@) {
+ return Event->generic("source", @_);
+}
+
+1;
diff -ur Event-orig/lib/Event/generic.pod Event-mod/lib/Event/generic.pod
--- Event-orig/lib/Event/generic.pod 2004-12-01 00:18:31.000000000 +0000
+++ Event-mod/lib/Event/generic.pod 2004-12-01 01:08:26.000000000 +0000
@@ -0,0 +1,124 @@
+=head1 NAME
+
+Event::generic - generic event handling
+
+=head1 SYNOPSIS
+
+ use Event::generic;
+
+ $source = Event::generic::Source->new;
+
+ $w = Event->generic(source => $source, ...);
+ $w = $source->watch(...);
+
+ $source = $w->source;
+ $w->source($source);
+
+ @watchers = $source->active_watchers;
+
+ $source->event;
+ $source->event($data);
+
+ $data = $event->data;
+
+=head1 DESCRIPTION
+
+This module provides a watcher type within the C<Event> framework.
+You must understand the architecture of the C<Event> system in order to
+understand this document.
+
+This module provides a system of reified event sources and watchers
+watching those sources. Events are generated solely by a method on the
+event source object. The events may carry arbitrary data to the event
+handler callbacks. This module is intended for situations where the
+events of interest are best determined by Perl code.
+
+=head1 CLASSES
+
+=over
+
+=item Event::generic::Source
+
+A reified event source.
+
+=item Event::generic
+
+A watcher that can watch C<Event::generic::Source> event sources.
+
+=item Event::Event::Dataful
+
+A (target) event that can carry arbitrary data.
+
+=back
+
+=head1 EVENT SOURCE CLASS
+
+=head2 Constructor
+
+=over
+
+=item Event::generic::Source->new
+
+Creates and returns a new event source.
+
+=back
+
+=head2 Methods
+
+=over
+
+=item $source->active_watchers
+
+Returns a list of all the watchers that are currently actively watching
+this event source. This is the set of watchers that will generate target
+events when the C<event()> method is called on this source.
+
+=item $source->event
+
+=item $source->event(DATA)
+
+The invocation of this method is a source event for watchers of the
+event source. When this method is called, each active watcher of the
+event source generates a target event. The I<DATA>, if supplied, is
+copied into the target event objects, from which it can be retrieved
+using the C<data()> method.
+
+=item $source->watch(ATTR => VALUE, ...)
+
+Generates and returns a new watcher, configured to watch this event
+source. The standard watcher attributes may be specified as arguments.
+The watcher returned is an ordinary C<Event::generic>, and may be
+reconfigured to watch a different event source.
+
+=back
+
+=head1 WATCHER CLASS
+
+=head2 Type-specific attributes
+
+=over
+
+=item source => $source
+
+The event source to watch. This must be either an
+C<Event::generic::Source> object or C<undef>. When set to C<undef>,
+no source is being watched, and the watcher cannot be started.
+
+=back
+
+=head1 EVENT CLASS
+
+=head2 Type-specific methods
+
+=over
+
+=item $event->data
+
+Returns the data associated with the event, which may be any scalar.
+This is read-only, and is set by the event source.
+
+=back
+
+=head1 SEE ALSO
+
+L<Event>
diff -ur Event-orig/lib/Event/typemap Event-mod/lib/Event/typemap
--- Event-orig/lib/Event/typemap 2000-11-28 18:44:41.000000000 +0000
+++ Event-mod/lib/Event/typemap 2004-11-30 21:53:28.000000000 +0000
@@ -2,6 +2,7 @@
pe_watcher * O_WATCHER
pe_event * O_EVENT
+pe_genericsrc * O_GENERICSRC
INPUT
@@ -11,6 +12,9 @@
O_EVENT
$var = ($type) sv_2event($arg)
+O_GENERICSRC
+ $var = ($type) sv_2genericsrc($arg)
+
OUTPUT
O_WATCHER
@@ -18,3 +22,6 @@
O_EVENT
croak("use event_2sv($var)")
+
+O_GENERICSRC
+ croak("use genericsrc_2sv($var)")
diff -ur Event-orig/lib/Event.pm Event-mod/lib/Event.pm
--- Event-orig/lib/Event.pm 2004-11-29 21:54:12.000000000 +0000
+++ Event-mod/lib/Event.pm 2004-11-30 23:33:04.000000000 +0000
@@ -194,6 +194,10 @@
use vars qw(@ISA);
@ISA = 'Event::Event';
+package Event::Event::Dataful;
+use vars qw(@ISA);
[EMAIL PROTECTED] = 'Event::Event';
+
package Event;
require Event::Watcher;
_load_watcher($_) for qw(idle io signal timer var);
END_OF_PATCH
