The perl interface is cleaner at least. Need to work out how to get the call back working

4 files changed, 184 insertions, 16 deletions

diff --git a/libvxi11client/perlbits/Client.xs b/libvxi11client/perlbits/Client.xs
new file mode 100644
index 0000000..b747707
--- /dev/null
+++ b/libvxi11client/perlbits/Client.xs
@@ -0,0 +1,140 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+MODULE = VXI11::Client		PACKAGE = VXI11::Client		
+
+int
+abort()
+	CODE:
+		RETVAL = vxi11_abort();
+	OUTPUT:
+		RETVAL
+
+int
+clear(waitforlock)
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_clear(waitforlock);
+	OUTPUT:
+		RETVAL
+
+int
+close()
+	CODE:
+		RETVAL = vxi11_close();
+	OUTPUT:
+		RETVAL
+
+int
+create_intr_chan()
+	CODE:
+		RETVAL = vxi11_create_intr_chan();
+	OUTPUT:
+		RETVAL
+
+int
+destroy_intr_chan()
+	CODE:
+		RETVAL = vxi11_destroy_intr_chan();
+	OUTPUT:
+		RETVAL
+
+int
+docmd(cmd, waitforlock)
+	unsigned long	cmd
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_docmd();
+	OUTPUT:
+		RETVAL
+
+int
+enable_srq(enable, callback)
+	bool	enable
+	SV *	callback
+	CODE:
+		RETVAL = glue_enable_srq(enable, callback);
+	OUTPUT:
+		RETVAL
+
+int
+local(waitforlock)
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_local(waitforlock);
+	OUTPUT:
+		RETVAL
+
+int
+lock(waitforlock)
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_lock(waitforlock);
+	OUTPUT:
+		RETVAL
+
+int
+open(address, device)
+	char *	address
+	char *	device
+	CODE:
+		RETVAL = vxi11_open(address, device);	
+	OUTPUT:
+		RETVAL
+
+int
+read(buffer, bufferlen, waitlock, termchrset, termchr)
+	char *	buffer
+	unsigned int	bufferlen
+	bool	waitlock
+	bool	termchrset
+	char	termchr
+	CODE:
+		RETVAL = vxi11_read(buffer, bufferlen, waitlock, termchrset, termchr);
+	OUTPUT:
+		RETVAL
+
+int
+readstatusbyte(waitforlock)
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_readstatusbyte();
+	OUTPUT:
+		RETVAL
+
+int
+remote(waitforlock)
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_remote();
+	OUTPUT:
+		RETVAL
+
+int
+trigger(waitforlock)
+	bool	waitforlock
+	CODE:
+		RETVAL = vxi11_trigger();
+	OUTPUT:
+		RETVAL
+
+int
+unlock()
+	CODE:
+		RETVAL = vxi11_unlock();
+	OUTPUT:
+		RETVAL
+
+int
+write(data, len, waitlock, end)
+	char *	data
+	unsigned int	len
+	bool	waitlock
+	bool	end
+	CODE:
+		RETVAL = vxi11_write(data, len, waitlock, end);
+	OUTPUT:
+		RETVAL
diff --git a/libvxi11client/perlbits/VXI11-Client.t b/libvxi11client/perlbits/VXI11-Client.t
index ac3d581..5b7f35f 100644
--- a/libvxi11client/perlbits/VXI11-Client.t
+++ b/libvxi11client/perlbits/VXI11-Client.t
@@ -8,7 +8,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 16;
+use Test::More tests => 14;
 BEGIN { use_ok('VXI11::Client') };
 
 #########################
@@ -16,18 +16,18 @@ BEGIN { use_ok('VXI11::Client') };
 # Insert your test code below, the Test::More module is use()ed here so read
 # its man page ( perldoc Test::More ) for help writing this test script.
 
-is(&VXI11::Client::vopen("roi", 0), 1, "Open");
-is(&VXI11::Client::vlock(0), 1, "Lock");
-is(&VXI11::Client::vwrite("*IDN?", 6, 0, 0), 6, "Write");
-ok(&VXI11::Client::vreadstatusbyte(0) >= 0 , "Read status byte");
-is(&VXI11::Client::vcreate_intr_chan(), 1, "Create intr channel");
-is(&VXI11::Client::venable_srq(1), 1, "Enable interrupts");
-is(&VXI11::Client::venable_srq(0), 1, "Disable interrupts");
-is(&VXI11::Client::vdestroy_intr_chan(), 1, "Destroy intr channel");
-is(&VXI11::Client::vabort(), 1, "Abort");
-is(&VXI11::Client::vclear(0), 1, "Clear");
-is(&VXI11::Client::vtrigger(0), 1, "Trigger");
-is(&VXI11::Client::vlocal(0), 1, "Local");
-is(&VXI11::Client::vremote(0), 1, "Remote");
-is(&VXI11::Client::vunlock(), 1, "Unlock");
-is(&VXI11::Client::vclose(), 1, "Close");
+is(&VXI11::Client::open("roi", 0), 1, "Open");
+is(&VXI11::Client::lock(0), 1, "Lock");
+is(&VXI11::Client::write("*IDN?", 6, 0, 0), 6, "Write");
+ok(&VXI11::Client::readstatusbyte(0) >= 0 , "Read status byte");
+is(&VXI11::Client::create_intr_chan(), 1, "Create intr channel");
+#is(&VXI11::Client::enable_srq(1, sub { print "Interrupt fired\n" }), 1, "Enable interrupts");
+#is(&VXI11::Client::enable_srq(0), 1, "Disable interrupts");
+is(&VXI11::Client::destroy_intr_chan(), 1, "Destroy intr channel");
+is(&VXI11::Client::abort(), 1, "Abort");
+is(&VXI11::Client::clear(0), 1, "Clear");
+is(&VXI11::Client::trigger(0), 1, "Trigger");
+is(&VXI11::Client::local(0), 1, "Local");
+is(&VXI11::Client::remote(0), 1, "Remote");
+is(&VXI11::Client::unlock(), 1, "Unlock");
+is(&VXI11::Client::close(), 1, "Close");
diff --git a/libvxi11client/perlbits/perlglue.c b/libvxi11client/perlbits/perlglue.c
new file mode 100644
index 0000000..e870477
--- /dev/null
+++ b/libvxi11client/perlbits/perlglue.c
@@ -0,0 +1,23 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+#include "perlglue.h"
+
+#define INTERRUPTHANDLE "libvxi11client"
+
+extern int vxi11_enable_srq(bool enable, char* handle, void (*callback)(void));
+
+static SV* perlcallback = NULL;
+
+static void interruptcallback(void) {
+	//PUSHMARK(SP);
+	call_sv(perlcallback, G_DISCARD | G_NOARGS);
+}
+
+int glue_enable_srq(bool enable, SV* callback) {
+	perlcallback = callback;
+	return vxi11_enable_srq(enable, INTERRUPTHANDLE, interruptcallback);
+}
diff --git a/libvxi11client/perlbits/perlglue.h b/libvxi11client/perlbits/perlglue.h
new file mode 100644
index 0000000..09e71aa
--- /dev/null
+++ b/libvxi11client/perlbits/perlglue.h
@@ -0,0 +1,5 @@
+#include <EXTERN.h>
+#include <perl.h>
+
+int glue_enable_srq(bool enable, SV* callback);
+