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 @@ ...@@ -14,11 +14,12 @@
%} %}
/* /*
* Rename the C event_subscribe() and event_poll(), so that we can replace * Rename the C event_subscribe(), event_poll(), and event_poll_blocking(), so
* these with perl functions of the same name. * that we can replace these with perl functions of the same name.
*/ */
%rename event_subscribe c_event_subscribe; %rename event_subscribe c_event_subscribe;
%rename event_poll c_event_poll; %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 * We have to replace this one, because it works in a way very foreign to
......
...@@ -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 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; package eventc;
bootstrap event; bootstrap event;
var_event_init(); var_event_init();
...@@ -63,6 +63,12 @@ sub c_event_poll { ...@@ -63,6 +63,12 @@ sub c_event_poll {
my $result = eventc::c_event_poll(@args); my $result = eventc::c_event_poll(@args);
return $result; 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 { sub dont_use_this_function_because_it_does_not_work {
my @args = @_; my @args = @_;
$args[0] = tied(%{$args[0]}); $args[0] = tied(%{$args[0]});
...@@ -526,12 +532,19 @@ sub event_subscribe($$$;$) { ...@@ -526,12 +532,19 @@ sub event_subscribe($$$;$) {
# #
# Clear $callback_ready, call the C event_poll function, and see if the # 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 # 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($) { sub internal_event_poll($$$) {
my $handle = shift; 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) { if ($rv) {
die "Trouble in event_poll - returned $rv\h"; die "Trouble in event_poll - returned $rv\h";
} }
...@@ -546,6 +559,22 @@ sub event_poll($) { ...@@ -546,6 +559,22 @@ sub event_poll($) {
return 0; 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 # 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 # a file that has already done a 'use lib' to get the path to testbed
...@@ -689,7 +718,7 @@ END { ...@@ -689,7 +718,7 @@ END {
} }
} }
push @EXPORT, qw(event_subscribe event_poll EventSend EventSendFatal push @EXPORT, qw(event_subscribe event_poll event_poll_blocking EventSend
EventSendWarn); EventSendFatal EventSendWarn);
1; 1;
...@@ -20,12 +20,19 @@ sub event_subscribe($$$;$) { ...@@ -20,12 +20,19 @@ sub event_subscribe($$$;$) {
# #
# Clear $callback_ready, call the C event_poll function, and see if the # 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 # 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($) { sub internal_event_poll($$$) {
my $handle = shift; 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) { if ($rv) {
die "Trouble in event_poll - returned $rv\h"; die "Trouble in event_poll - returned $rv\h";
} }
...@@ -40,6 +47,22 @@ sub event_poll($) { ...@@ -40,6 +47,22 @@ sub event_poll($) {
return 0; 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 # 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 # a file that has already done a 'use lib' to get the path to testbed
...@@ -183,7 +206,7 @@ END { ...@@ -183,7 +206,7 @@ END {
} }
} }
push @EXPORT, qw(event_subscribe event_poll EventSend EventSendFatal push @EXPORT, qw(event_subscribe event_poll event_poll_blocking EventSend
EventSendWarn); EventSendFatal EventSendWarn);
1; 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 : * This file was automatically generated by :
* Simplified Wrapper and Interface Generator (SWIG) * Simplified Wrapper and Interface Generator (SWIG)
...@@ -62,7 +62,7 @@ extern "C" { ...@@ -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 * perl5ptr.swg
* *
...@@ -96,8 +96,8 @@ extern "C" { ...@@ -96,8 +96,8 @@ extern "C" {
* SWIGSTATIC. * SWIGSTATIC.
* *
* $Log: event_wrap.c,v $ * $Log: event_wrap.c,v $
* Revision 1.3 2002-04-02 23:29:44 ricci * Revision 1.4 2003-02-28 02:10:33 ricci
* Somehow, this file didn't get committed with my last commit. * Add the new blocking poll the the perl libraries.
* *
* Revision 1.1 1996/12/26 22:17:29 beazley * Revision 1.1 1996/12/26 22:17:29 beazley
* Initial revision * Initial revision
...@@ -501,8 +501,8 @@ static void _swig_setpv(CPerl *pPerl, char *name, char *value) { ...@@ -501,8 +501,8 @@ static void _swig_setpv(CPerl *pPerl, char *name, char *value) {
} }
/* /*
* 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) {
...@@ -756,6 +756,28 @@ XS(_wrap_c_event_poll) { ...@@ -756,6 +756,28 @@ XS(_wrap_c_event_poll) {
XSRETURN(argvi); 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) { XS(_wrap_dont_use_this_function_because_it_does_not_work) {
int _result; int _result;
...@@ -2360,6 +2382,7 @@ XS(boot_event) { ...@@ -2360,6 +2382,7 @@ XS(boot_event) {
newXS("eventc::event_register", _wrap_event_register, file); newXS("eventc::event_register", _wrap_event_register, file);
newXS("eventc::event_unregister", _wrap_event_unregister, file); newXS("eventc::event_unregister", _wrap_event_unregister, file);
newXS("eventc::c_event_poll", _wrap_c_event_poll, 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::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_notify", _wrap_event_notify, file);
newXS("eventc::event_schedule", _wrap_event_schedule, 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