All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

Commit fccf4efd authored by Robert Ricci's avatar Robert Ricci

Add the new blocking poll the the perl libraries.

parent 1b38c7d1
......@@ -14,11 +14,12 @@
%}
/*
* Rename the C event_subscribe() and event_poll(), so that we can replace
* these with perl functions of the same name.
* Rename the C event_subscribe(), event_poll(), and event_poll_blocking(), so
* that we can replace these with perl functions of the same name.
*/
%rename event_subscribe c_event_subscribe;
%rename event_poll c_event_poll;
%rename event_poll_blocking c_event_poll_blocking;
/*
* We have to replace this one, because it works in a way very foreign to
......
......@@ -3,7 +3,7 @@ package event;
require Exporter;
require 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 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 );
@EXPORT = qw(address_tuple_alloc address_tuple_free event_register event_unregister c_event_poll c_event_poll_blocking 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;
bootstrap event;
var_event_init();
......@@ -63,6 +63,12 @@ sub c_event_poll {
my $result = eventc::c_event_poll(@args);
return $result;
}
sub c_event_poll_blocking {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::c_event_poll_blocking(@args);
return $result;
}
sub dont_use_this_function_because_it_does_not_work {
my @args = @_;
$args[0] = tied(%{$args[0]});
......@@ -526,12 +532,19 @@ sub event_subscribe($$$;$) {
#
# Clear $callback_ready, call the C event_poll function, and see if the
# C callback got called (as evidenced by $callback_ready getting set) If it
# did, call the perl callback function.
# did, call the perl callback function. Handle both blocking and non-blocking
# versions of the call
#
sub event_poll($) {
my $handle = shift;
sub internal_event_poll($$$) {
my ($handle, $block, $timeout) = @_;
my $rv;
if ($block) {
$rv = c_event_poll_blocking($handle,$timeout);
} else {
$rv = c_event_poll($handle);
}
my $rv = c_event_poll($handle);
if ($rv) {
die "Trouble in event_poll - returned $rv\h";
}
......@@ -546,6 +559,22 @@ sub event_poll($) {
return 0;
}
#
# Wrapper for the internal polling function, non-blocking version
#
sub event_poll($) {
my $handle = shift;
return &internal_event_poll($handle,0,0);
}
#
# Same as above, but for the blocking version
#
sub event_poll_blocking($$) {
my ($handle, $timeout) = @_;
return &internal_event_poll($handle,1,$timeout);
}
#
# NOTE: The following line will only work if this module is included by
# a file that has already done a 'use lib' to get the path to testbed
......@@ -689,7 +718,7 @@ END {
}
}
push @EXPORT, qw(event_subscribe event_poll EventSend EventSendFatal
EventSendWarn);
push @EXPORT, qw(event_subscribe event_poll event_poll_blocking EventSend
EventSendFatal EventSendWarn);
1;
......@@ -20,12 +20,19 @@ sub event_subscribe($$$;$) {
#
# Clear $callback_ready, call the C event_poll function, and see if the
# C callback got called (as evidenced by $callback_ready getting set) If it
# did, call the perl callback function.
# did, call the perl callback function. Handle both blocking and non-blocking
# versions of the call
#
sub event_poll($) {
my $handle = shift;
sub internal_event_poll($$$) {
my ($handle, $block, $timeout) = @_;
my $rv;
if ($block) {
$rv = c_event_poll_blocking($handle,$timeout);
} else {
$rv = c_event_poll($handle);
}
my $rv = c_event_poll($handle);
if ($rv) {
die "Trouble in event_poll - returned $rv\h";
}
......@@ -40,6 +47,22 @@ sub event_poll($) {
return 0;
}
#
# Wrapper for the internal polling function, non-blocking version
#
sub event_poll($) {
my $handle = shift;
return &internal_event_poll($handle,0,0);
}
#
# Same as above, but for the blocking version
#
sub event_poll_blocking($$) {
my ($handle, $timeout) = @_;
return &internal_event_poll($handle,1,$timeout);
}
#
# NOTE: The following line will only work if this module is included by
# a file that has already done a 'use lib' to get the path to testbed
......@@ -183,7 +206,7 @@ END {
}
}
push @EXPORT, qw(event_subscribe event_poll EventSend EventSendFatal
EventSendWarn);
push @EXPORT, qw(event_subscribe event_poll event_poll_blocking EventSend
EventSendFatal EventSendWarn);
1;
/*
* FILE : /users/ricci/testbed/event/lib/event_wrap.c
* FILE : /home/ricci/testbed/event/lib/event_wrap.c
*
* This file was automatically generated by :
* Simplified Wrapper and Interface Generator (SWIG)
......@@ -62,7 +62,7 @@ extern "C" {
/*****************************************************************************
* $Header: /home/cvs_mirrors/cvs-public.flux.utah.edu/CVS/testbed/event/lib/event_wrap.c,v 1.3 2002-04-02 23:29:44 ricci Exp $
* $Header: /home/cvs_mirrors/cvs-public.flux.utah.edu/CVS/testbed/event/lib/event_wrap.c,v 1.4 2003-02-28 02:10:33 ricci Exp $
*
* perl5ptr.swg
*
......@@ -96,8 +96,8 @@ extern "C" {
* SWIGSTATIC.
*
* $Log: event_wrap.c,v $
* Revision 1.3 2002-04-02 23:29:44 ricci
* Somehow, this file didn't get committed with my last commit.
* Revision 1.4 2003-02-28 02:10:33 ricci
* Add the new blocking poll the the perl libraries.
*
* Revision 1.1 1996/12/26 22:17:29 beazley
* Initial revision
......@@ -501,8 +501,8 @@ static void _swig_setpv(CPerl *pPerl, char *name, char *value) {
}
/*
* Stub callback that simply sets callback_ready and
* callback_notification
* Stub callback that simply pushes a new entry onto the list
* of data for the perl callback function
*/
void perl_stub_callback(event_handle_t handle,
event_notification_t notification, void *data) {
......@@ -756,6 +756,28 @@ XS(_wrap_c_event_poll) {
XSRETURN(argvi);
}
XS(_wrap_c_event_poll_blocking) {
int _result;
event_handle_t _arg0;
unsigned int _arg1;
int argvi = 0;
dXSARGS ;
cv = cv;
if ((items < 2) || (items > 2))
croak("Usage: c_event_poll_blocking(handle,timeout);");
if (SWIG_GetPtr(ST(0),(void **) &_arg0,"event_handle")) {
croak("Type error in argument 1 of c_event_poll_blocking. Expected event_handle.");
XSRETURN(1);
}
_arg1 = (unsigned int )SvIV(ST(1));
_result = (int )event_poll_blocking(_arg0,_arg1);
ST(argvi) = sv_newmortal();
sv_setiv(ST(argvi++),(IV) _result);
XSRETURN(argvi);
}
XS(_wrap_dont_use_this_function_because_it_does_not_work) {
int _result;
......@@ -2360,6 +2382,7 @@ XS(boot_event) {
newXS("eventc::event_register", _wrap_event_register, file);
newXS("eventc::event_unregister", _wrap_event_unregister, file);
newXS("eventc::c_event_poll", _wrap_c_event_poll, file);
newXS("eventc::c_event_poll_blocking", _wrap_c_event_poll_blocking, file);
newXS("eventc::dont_use_this_function_because_it_does_not_work", _wrap_dont_use_this_function_because_it_does_not_work, file);
newXS("eventc::event_notify", _wrap_event_notify, file);
newXS("eventc::event_schedule", _wrap_event_schedule, file);
......
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