Commit 8ffb8cf4 authored by Robert Ricci's avatar Robert Ricci
Browse files

Remove SWIG from the build process - unfortunately, it's slightly

broken. Also, it made me slightly uneasy that there was no way to
prevent swig from putting one of its generated files in sorce
directory. So, I've just checked in the two major files that get
generated by SWIG, so that the make rule that runs it never gets
invoked.

One of the reasons for doing this is that swig generates slightly
broken code when the -exportall (which does perl module exports
correctly) arugment is given. A very minor amount of manual tweaking
of the generated .pm file can fix this problem. So, the checked in
copy of event.pm has these tweaks applied.

As a result of all of this, exports work correctly in the event perl
module, so the hacky practice of putting your program in the event
namespace is no longer necessary.
parent 447bb8a5
......@@ -7,11 +7,6 @@ grok macros -- some have been 'translated' into regular functions, but not all.
Note that you don't get any magic perl garbage collection, etc, for C objects.
So, you still have to call address_tuple_alloc/address_tuple_free, etc.
Also, SWIG modules do not export functions. This means that you have to either
prefix everthing with 'event::' (cumbersome, since most event system stuff
starts with 'event_' already), or cheat, by putting yourself in the module's
namespace with the line 'package event;'
Examples of the use of the perl event system are in the examples/ directory,
and mirror the C examples.
......
......@@ -11,7 +11,6 @@
use lib '@prefix@/lib';
use event;
package event; # Laziness so that we don't have to specify package name
use Getopt::Std;
use strict;
......
......@@ -10,7 +10,6 @@
use lib '@prefix@/lib';
use event;
package event; # Laziness so that we don't have to specify package name
use Getopt::Std;
use strict;
......
......@@ -36,7 +36,7 @@ event_r.o: event.c
# These three targets are for the perl binding to the event system
#
$(SRCDIR)/event_wrap.c: event.i event.c event.pm.tail
swig -dnone -perl5 -shadow -I$(SRCDIR) $(SRCDIR)/event.i
swig -exportall -dnone -perl5 -shadow -I$(SRCDIR) $(SRCDIR)/event.i
cat $(SRCDIR)/event.pm.tail >> event.pm
event_wrap.o: $(SRCDIR)/event_wrap.c
......
# This file was automatically generated by SWIG
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 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 );
package eventc;
bootstrap event;
var_event_init();
# ---------- BASE METHODS -------------
package event;
sub TIEHASH {
my ($classname,$obj) = @_;
return bless $obj, $classname;
}
sub CLEAR { }
sub this {
my $ptr = shift;
return tied(%$ptr);
}
# ------- FUNCTION WRAPPERS --------
package event;
sub address_tuple_alloc {
my @args = @_;
my $result = eventc::address_tuple_alloc(@args);
return undef if (!defined($result));
my %resulthash;
tie %resulthash, "address_tuple", $result;
return bless \%resulthash, "address_tuple";
}
sub address_tuple_free {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::address_tuple_free(@args);
return $result;
}
sub event_register {
my @args = @_;
my $result = eventc::event_register(@args);
return undef if (!defined($result));
my %resulthash;
tie %resulthash, "event_handle", $result;
return bless \%resulthash, "event_handle";
}
sub event_unregister {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_unregister(@args);
return $result;
}
sub c_event_poll {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::c_event_poll(@args);
return $result;
}
sub dont_use_this_function_because_it_does_not_work {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::dont_use_this_function_because_it_does_not_work(@args);
return $result;
}
sub event_notify {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notify(@args);
return $result;
}
sub event_schedule {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_schedule(@args);
return $result;
}
sub event_notification_alloc {
my @args = @_;
$args[0] = tied(%{$args[0]});
$args[1] = tied(%{$args[1]});
my $result = eventc::event_notification_alloc(@args);
return $result;
}
sub event_notification_free {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_free(@args);
return $result;
}
sub event_notification_clone {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_clone(@args);
return $result;
}
sub event_notification_get_double {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_double(@args);
return $result;
}
sub event_notification_get_int32 {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_int32(@args);
return $result;
}
sub event_notification_get_int64 {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_int64(@args);
return $result;
}
sub event_notification_get_opaque {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_opaque(@args);
return $result;
}
sub c_event_notification_get_string {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::c_event_notification_get_string(@args);
return $result;
}
sub event_notification_put_double {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_put_double(@args);
return $result;
}
sub event_notification_put_int32 {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_put_int32(@args);
return $result;
}
sub event_notification_put_int64 {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_put_int64(@args);
return $result;
}
sub event_notification_put_opaque {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_put_opaque(@args);
return $result;
}
sub event_notification_put_string {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_put_string(@args);
return $result;
}
sub event_notification_remove {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_remove(@args);
return $result;
}
sub c_event_subscribe {
my @args = @_;
$args[0] = tied(%{$args[0]});
$args[2] = tied(%{$args[2]});
my $result = eventc::c_event_subscribe(@args);
return $result;
}
*xmalloc = *eventc::xmalloc;
*xrealloc = *eventc::xrealloc;
sub perl_stub_callback {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::perl_stub_callback(@args);
return $result;
}
sub stub_event_subscribe {
my @args = @_;
$args[0] = tied(%{$args[0]});
$args[1] = tied(%{$args[1]});
my $result = eventc::stub_event_subscribe(@args);
return $result;
}
sub event_notification_get_string {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_string(@args);
return $result;
}
sub event_notification_get_site {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_site(@args);
return $result;
}
sub event_notification_get_expt {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_expt(@args);
return $result;
}
sub event_notification_get_group {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_group(@args);
return $result;
}
sub event_notification_get_host {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_host(@args);
return $result;
}
sub event_notification_get_objtype {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_objtype(@args);
return $result;
}
sub event_notification_get_objname {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_objname(@args);
return $result;
}
sub event_notification_get_eventtype {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_eventtype(@args);
return $result;
}
sub event_notification_get_arguments {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_arguments(@args);
return $result;
}
sub event_notification_set_arguments {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_set_arguments(@args);
return $result;
}
sub event_notification_get_sender {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_get_sender(@args);
return $result;
}
sub event_notification_set_sender {
my @args = @_;
$args[0] = tied(%{$args[0]});
my $result = eventc::event_notification_set_sender(@args);
return $result;
}
############# Class : event_handle ##############
package event_handle;
@ISA = qw( event );
%OWNER = ();
%BLESSEDMEMBERS = (
);
%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::event_handle_${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::event_handle_${field}_set";
if (exists $BLESSEDMEMBERS{$field}) {
&$member_func($self,tied(%{$newval}));
} else {
&$member_func($self,$newval);
}
}
sub FIRSTKEY {
my $self = shift;
$ITERATORS{$self} = ['server', 'status', ];
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} = ['server', 'status', ];
return ();
}
}
############# Class : address_tuple ##############
package address_tuple;
@ISA = qw( event );
%OWNER = ();
%BLESSEDMEMBERS = (
);
%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::address_tuple_${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::address_tuple_${field}_set";
if (exists $BLESSEDMEMBERS{$field}) {
&$member_func($self,tied(%{$newval}));
} else {
&$member_func($self,$newval);
}
}
sub FIRSTKEY {
my $self = shift;
$ITERATORS{$self} = ['site', 'expt', 'group', 'host', 'objtype', 'objname', 'eventtype', 'scheduler', ];
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} = ['site', 'expt', 'group', 'host', 'objtype', 'objname', 'eventtype', 'scheduler', ];
return ();
}
}
# ------- VARIABLE STUBS --------
package event;
*MAXHOSTNAMELEN = *eventc::MAXHOSTNAMELEN;
*ADDRESSTUPLE_ANY = *eventc::ADDRESSTUPLE_ANY;
*ADDRESSTUPLE_ALL = *eventc::ADDRESSTUPLE_ALL;
*OBJECTTYPE_TESTBED = *eventc::OBJECTTYPE_TESTBED;
*OBJECTTYPE_TRAFGEN = *eventc::OBJECTTYPE_TRAFGEN;
*EVENT_HOST_ANY = *eventc::EVENT_HOST_ANY;
*EVENT_NULL = *eventc::EVENT_NULL;
*EVENT_TEST = *eventc::EVENT_TEST;
*EVENT_SCHEDULE = *eventc::EVENT_SCHEDULE;
*EVENT_TRAFGEN_START = *eventc::EVENT_TRAFGEN_START;
*EVENT_TRAFGEN_STOP = *eventc::EVENT_TRAFGEN_STOP;
*callback_ready = *eventc::callback_ready;
*callback_notification = *eventc::callback_notification;
*event_string_buffer = *eventc::event_string_buffer;
1;
#
# CODE PAST THIS POINT WAS NOT AUTOMATICALLY GENERATED BY SWIG
#
# For now, this has to get cat'ed onto the end of event.pm, since it
# doesn't seem possible to get SWIG to just pass it through into the
# output file
#
#
# Stash away the given callback and data, and call the C event_subscribe
# function that uses a stub callback
#
sub event_subscribe($$$;$) {
my ($handle,$function,$tuple,$data) = @_;
$event::callback = $function;
$event::callback_data = $data;
return stub_event_subscribe($handle,$tuple);
}
#
# 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.
#
sub event_poll($) {
my $handle = shift;
$event::callback_ready = 0;
my $rv = c_event_poll($handle);
if ($rv) {
die "Trouble in event_poll - returned $rv\h";
}
if ($event::callback_ready) {
&$event::callback($handle,$event::callback_notification,
$event::callback_data);
event_notification_free($handle,$event::callback_notification);
}
return 0;
}
push @EXPORT, qw(event_subscribe event_poll);
1;
......@@ -41,6 +41,6 @@ sub event_poll($) {
return 0;
}
push @EXPORT, qw(event_subscribe event_poll);
1;
This diff is collapsed.
......@@ -21,8 +21,6 @@ my $TBOPS = "@TBOPSEMAIL@";
$| = 1;
use event;
package event;
use libdb;
use libtestbed;
use Getopt::Std;
......
Supports Markdown
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