Commit e9ef5c69 authored by Robert Ricci's avatar Robert Ricci

Turns out that a single call to the event_poll function can result in

the delivery of multiple notifications. So, instead of a single
notification, which could result in missed ones, we now maintain a
queue.
parent b05398fe
...@@ -37,33 +37,60 @@ ...@@ -37,33 +37,60 @@
* Glue needed to support callbacks under perl * Glue needed to support callbacks under perl
*/ */
%inline %{ %inline %{
/* /*
* Set to 1 by the stub callback below if a notification is ready to be * Queue of notifications that have been received
* processed by a callback.
*/ */
int callback_ready; struct callback_data {
event_notification_t callback_notification;
struct callback_data *next;
};
typedef struct callback_data *callback_data_t;
callback_data_t callback_data_list;
/* /*
* Set when callback_ready is also set * Simple wrappers, since we don't want to (maybe can't) call
* malloc/free from perl
*/ */
event_notification_t callback_notification; callback_data_t allocate_callback_data() {
return (callback_data_t)malloc(sizeof(callback_data_t));
}
void free_callback_data(callback_data_t data) {
free(data);
}
callback_data_t dequeue_callback_data() {
callback_data_t data = callback_data_list;
if (callback_data_list) {
callback_data_list = callback_data_list->next;
}
return data;
}
void enqueue_callback_data(callback_data_t data) {
callback_data_t *pos = &callback_data_list;
while (*pos) {
pos = &((*pos)->next);
}
*pos = data;
}
/* /*
* Stub callback that simply sets callback_ready and * Stub callback that simply pushes a new entry onto the list
* callback_notification * of data for the perl callback function
*/ */
void perl_stub_callback(event_handle_t handle, void perl_stub_callback(event_handle_t handle,
event_notification_t notification, void *data) { event_notification_t notification, void *data) {
callback_ready = 1; callback_data_t new_data;
callback_notification = event_notification_clone(handle,
notification); new_data = allocate_callback_data();
if (!callback_notification) { new_data->callback_notification =
/* event_notification_clone(handle,notification);
* event_notification_clone will have already reported new_data->next = NULL;
* an error message, so we don't have to again
*/ enqueue_callback_data(new_data);
callback_ready = 0;
}
} }
/* /*
......
...@@ -3,7 +3,7 @@ package event; ...@@ -3,7 +3,7 @@ package event;
require Exporter; require Exporter;
require DynaLoader; require DynaLoader;
@ISA = qw(Exporter DynaLoader); @ISA = qw(Exporter DynaLoader);
@EXPORT = qw(address_tuple_alloc address_tuple_free event_register event_unregister c_event_poll dont_use_this_function_because_it_does_not_work event_notify event_schedule event_notification_alloc event_notification_free event_notification_clone event_notification_get_double event_notification_get_int32 event_notification_get_int64 event_notification_get_opaque c_event_notification_get_string event_notification_put_double event_notification_put_int32 event_notification_put_int64 event_notification_put_opaque event_notification_put_string event_notification_remove c_event_subscribe xmalloc xrealloc perl_stub_callback stub_event_subscribe event_notification_get_string event_notification_get_site event_notification_get_expt event_notification_get_group event_notification_get_host event_notification_get_objtype event_notification_get_objname event_notification_get_eventtype event_notification_get_arguments event_notification_set_arguments event_notification_get_sender event_notification_set_sender event_handle_server_set event_handle_server_get event_handle_status_set event_handle_status_get address_tuple_site_set address_tuple_site_get address_tuple_expt_set address_tuple_expt_get address_tuple_group_set address_tuple_group_get address_tuple_host_set address_tuple_host_get address_tuple_objtype_set address_tuple_objtype_get address_tuple_objname_set address_tuple_objname_get address_tuple_eventtype_set address_tuple_eventtype_get address_tuple_scheduler_set address_tuple_scheduler_get ); @EXPORT = qw(address_tuple_alloc address_tuple_free event_register event_unregister c_event_poll dont_use_this_function_because_it_does_not_work event_notify event_schedule event_notification_alloc event_notification_free event_notification_clone event_notification_get_double event_notification_get_int32 event_notification_get_int64 event_notification_get_opaque c_event_notification_get_string event_notification_put_double event_notification_put_int32 event_notification_put_int64 event_notification_put_opaque event_notification_put_string event_notification_remove c_event_subscribe xmalloc xrealloc allocate_callback_data free_callback_data dequeue_callback_data enqueue_callback_data perl_stub_callback stub_event_subscribe event_notification_get_string event_notification_get_site event_notification_get_expt event_notification_get_group event_notification_get_host event_notification_get_objtype event_notification_get_objname event_notification_get_eventtype event_notification_get_arguments event_notification_set_arguments event_notification_get_sender event_notification_set_sender event_handle_server_set event_handle_server_get event_handle_status_set event_handle_status_get address_tuple_site_set address_tuple_site_get address_tuple_expt_set address_tuple_expt_get address_tuple_group_set address_tuple_group_get address_tuple_host_set address_tuple_host_get address_tuple_objtype_set address_tuple_objtype_get address_tuple_objname_set address_tuple_objname_get address_tuple_eventtype_set address_tuple_eventtype_get address_tuple_scheduler_set address_tuple_scheduler_get callback_data_callback_notification_set callback_data_callback_notification_get callback_data_next_set callback_data_next_get );
package eventc; package eventc;
bootstrap event; bootstrap event;
var_event_init(); var_event_init();
...@@ -175,6 +175,34 @@ sub c_event_subscribe { ...@@ -175,6 +175,34 @@ sub c_event_subscribe {
} }
*xmalloc = *eventc::xmalloc; *xmalloc = *eventc::xmalloc;
*xrealloc = *eventc::xrealloc; *xrealloc = *eventc::xrealloc;
sub allocate_callback_data {
my @args = @_;
my $result = eventc::allocate_callback_data(@args);
return undef if (!defined($result));
my %resulthash;
tie %resulthash, "callback_data", $result;
return bless \%resulthash, "callback_data";
}
sub free_callback_data {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::free_callback_data(@args);
return $result;
}
sub dequeue_callback_data {
my @args = @_;
my $result = eventc::dequeue_callback_data(@args);
return undef if (!defined($result));
my %resulthash;
tie %resulthash, "callback_data", $result;
return bless \%resulthash, "callback_data";
}
sub enqueue_callback_data {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::enqueue_callback_data(@args);
return $result;
}
sub perl_stub_callback { sub perl_stub_callback {
my @args = @_; my @args = @_;
$args[0] = tied(%{$args[0]}); $args[0] = tied(%{$args[0]});
...@@ -389,6 +417,71 @@ sub NEXTKEY { ...@@ -389,6 +417,71 @@ sub NEXTKEY {
} }
############# Class : callback_data ##############
package callback_data;
@ISA = qw( event );
%OWNER = ();
%BLESSEDMEMBERS = (
next => 'callback_data',
);
%ITERATORS = ();
sub DISOWN {
my $self = shift;
my $ptr = tied(%$self);
delete $OWNER{$ptr};
};
sub ACQUIRE {
my $self = shift;
my $ptr = tied(%$self);
$OWNER{$ptr} = 1;
};
sub FETCH {
my ($self,$field) = @_;
my $member_func = "eventc::callback_data_${field}_get";
my $val = &$member_func($self);
if (exists $BLESSEDMEMBERS{$field}) {
return undef if (!defined($val));
my %retval;
tie %retval,$BLESSEDMEMBERS{$field},$val;
return bless \%retval, $BLESSEDMEMBERS{$field};
}
return $val;
}
sub STORE {
my ($self,$field,$newval) = @_;
my $member_func = "eventc::callback_data_${field}_set";
if (exists $BLESSEDMEMBERS{$field}) {
&$member_func($self,tied(%{$newval}));
} else {
&$member_func($self,$newval);
}
}
sub FIRSTKEY {
my $self = shift;
$ITERATORS{$self} = ['callback_notification', 'next', ];
my $first = shift @{$ITERATORS{$self}};
return $first;
}
sub NEXTKEY {
my $self = shift;
$nelem = scalar @{$ITERATORS{$self}};
if ($nelem > 0) {
my $member = shift @{$ITERATORS{$self}};
return $member;
} else {
$ITERATORS{$self} = ['callback_notification', 'next', ];
return ();
}
}
# ------- VARIABLE STUBS -------- # ------- VARIABLE STUBS --------
package event; package event;
...@@ -404,8 +497,11 @@ package event; ...@@ -404,8 +497,11 @@ package event;
*EVENT_SCHEDULE = *eventc::EVENT_SCHEDULE; *EVENT_SCHEDULE = *eventc::EVENT_SCHEDULE;
*EVENT_TRAFGEN_START = *eventc::EVENT_TRAFGEN_START; *EVENT_TRAFGEN_START = *eventc::EVENT_TRAFGEN_START;
*EVENT_TRAFGEN_STOP = *eventc::EVENT_TRAFGEN_STOP; *EVENT_TRAFGEN_STOP = *eventc::EVENT_TRAFGEN_STOP;
*callback_ready = *eventc::callback_ready;
*callback_notification = *eventc::callback_notification; my %__callback_data_list_hash;
tie %__callback_data_list_hash,"callback_data", $eventc::callback_data_list;
$callback_data_list= \%__callback_data_list_hash;
bless $callback_data_list, callback_data;
*event_string_buffer = *eventc::event_string_buffer; *event_string_buffer = *eventc::event_string_buffer;
1; 1;
# #
...@@ -435,17 +531,16 @@ sub event_subscribe($$$;$) { ...@@ -435,17 +531,16 @@ sub event_subscribe($$$;$) {
sub event_poll($) { sub event_poll($) {
my $handle = shift; my $handle = shift;
$event::callback_ready = 0;
my $rv = c_event_poll($handle); my $rv = c_event_poll($handle);
if ($rv) { if ($rv) {
die "Trouble in event_poll - returned $rv\h"; die "Trouble in event_poll - returned $rv\h";
} }
if ($event::callback_ready) { while (my $data = dequeue_callback_data() ) {
&$event::callback($handle,$event::callback_notification, &$event::callback($handle,$data->{callback_notification},
$event::callback_data); $event::callback_data);
event_notification_free($handle,$event::callback_notification); event_notification_free($handle,$data->{callback_notification});
free_callback_data($data);
} }
return 0; return 0;
......
...@@ -25,17 +25,16 @@ sub event_subscribe($$$;$) { ...@@ -25,17 +25,16 @@ sub event_subscribe($$$;$) {
sub event_poll($) { sub event_poll($) {
my $handle = shift; my $handle = shift;
$event::callback_ready = 0;
my $rv = c_event_poll($handle); my $rv = c_event_poll($handle);
if ($rv) { if ($rv) {
die "Trouble in event_poll - returned $rv\h"; die "Trouble in event_poll - returned $rv\h";
} }
if ($event::callback_ready) { while (my $data = dequeue_callback_data() ) {
&$event::callback($handle,$event::callback_notification, &$event::callback($handle,$data->{callback_notification},
$event::callback_data); $event::callback_data);
event_notification_free($handle,$event::callback_notification); event_notification_free($handle,$data->{callback_notification});
free_callback_data($data);
} }
return 0; return 0;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment