Bindings: add a new perl binding using the new binding infrastructure

 * XS files is autogenerated using bindings/binding.py model of the
   Lasso API. All constants are in the Lasso::Constants package, the
   LASSO_ prefix is removed.
   All classes are now Lasso::ClassName, field accessor also serves as
   setters, i.e you can do this:
   $name_id = Lasso::Saml2NameID::new();
   $name_id->content('coin');
   print $name_id->content;

   Is still missing:
    - a lot of test files,
    - support for hashtables,
    - and throwing exceptions when return code is non-zero.

12 files changed, 1102 insertions, 0 deletions

diff --git a/bindings/perl/LassoNode.xs b/bindings/perl/LassoNode.xs
new file mode 100644
index 00000000..dd672af1
--- /dev/null
+++ b/bindings/perl/LassoNode.xs
@@ -0,0 +1,36 @@
+void
+DESTROY (SV *sv)
+    CODE:
+	GObject *object = gperl_get_object (sv);
+
+        if (!object) /* Happens on object destruction. */
+                return;
+#ifdef NOISY
+        warn ("DESTROY< (%p)[%d] => %s (%p)[%d]\n",
+              object, object->ref_count,
+              gperl_object_package_from_type (G_OBJECT_TYPE (object)),
+              sv, SvREFCNT (SvRV(sv)));
+#endif
+        /* gobject object still exists, so take back the refcount we lend it. */
+        /* this operation does NOT change the refcount of the combined object. */
+
+	if (PL_in_clean_objs) {
+                /* be careful during global destruction. basically,
+                 * don't bother, since refcounting is no longer meaningful. */
+                sv_unmagic (SvRV (sv), PERL_MAGIC_ext);
+
+                g_object_steal_qdata (object, wrapper_quark);
+        } else {
+                SvREFCNT_inc (SvRV (sv));
+                if (object->ref_count > 1) {
+                    /* become undead */
+                    SV *obj = SvRV(sv);
+                    update_wrapper (object, MAKE_UNDEAD(obj));
+                    /* printf("zombies! [%p] (%p)\n", object, obj);*/
+                }
+        }
+        g_object_unref (object);
+#ifdef NOISY
+	warn ("DESTROY> (%p) done\n", object);
+#endif
+
diff --git a/bindings/perl/Makefile.PL b/bindings/perl/Makefile.PL
new file mode 100644
index 00000000..d8898ffe
--- /dev/null
+++ b/bindings/perl/Makefile.PL
@@ -0,0 +1,31 @@
+use 5.010000;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+my $TOP_SRCDIR = $ENV{'TOP_SRCDIR'};
+my $TOP_BUILDDIR = $ENV{'TOP_BUILDDIR'};
+my $SRCDIR = $ENV{'SRCDIR'};
+my $VERSION = $ENV{'VERSION'};
+my $BUILDDIR = $ENV{'BUILDDIR'};
+my $CFLAGS = $ENV{'CFLAGS'};
+
+if (undef($TOP_SRCDIR) || undef($TOP_BUILDDIR)) {
+	exit(1);
+}
+
+$lasso_libs = `$TOP_BUILDDIR/lasso-src-config --libs`;
+
+WriteMakefile(
+    NAME              => 'Lasso',
+    VERSION           => $VERSION,
+    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
+      ( AUTHOR         => 'Benjamin Dauvergne <bdauvergne@entrouvert.com>') : ()),
+    LIBS              => ["-L$TOP_SRCDIR/lasso/.libs -llasso"], # e.g., '-lm'
+    DEFINE            => '', # e.g., '-DHAVE_SOMETHING'
+    INC               => "-I. -I$SRCDIR -I../../../ $CFLAGS", # e.g., '-I. -I/usr/include/other'
+	# Un-comment this if you add C files to link with later:
+    OBJECT            => 'Lasso.o', # link all the C files too
+    MAKEFILE          => 'Makefile.perl',
+
+);
diff --git a/bindings/perl/Makefile.am b/bindings/perl/Makefile.am
new file mode 100644
index 00000000..22bbd7fa
--- /dev/null
+++ b/bindings/perl/Makefile.am
@@ -0,0 +1,43 @@
+MAINTAINERCLEANFILES = Makefile.in
+MOSTLYCLEANFILES =
+
+LASSO_XS_CFLAGS = -fno-strict-aliasing $(LASSO_CFLAGS) $(LASSO_CORE_CFLAGS) $(PERL_CFLAGS) $(AM_CFLAGS)
+
+TESTS = test.sh
+
+if PERL_ENABLED
+INCLUDES = \
+	-I$(top_builddir) \
+	-I$(top_srcdir) \
+	$(SASL_CFLAGS)
+
+all: Lasso.so
+
+EXTRA_DIST=
+
+if WSF_ENABLED
+EXTRA_ARGS = --enable-id-wsf
+endif
+
+Makefile.perl: $(srcdir)/Makefile.PL Lasso.xs Lasso.pm
+	CFLAGS="$(LASSO_XS_CFLAGS)" TOP_SRCDIR="$(top_srcdir)" TOP_BUILDDIR="$(top_builddir)" \
+	       SRCDIR="$(srcdir)" BUILDDIR=./ $(PERL) $(srcdir)/Makefile.PL PREFIX=$(prefix)
+
+	-if [ "$(srcdir)" != "$(builddir)" ]; then cp -R $(srcdir)/t $(srcdir)/test.pl $(srcdir)/Makefile.PL $(srcdir)/LassoNode.xs $(builddir); fi
+
+Lasso.xs Lasso.pm: lang.py typemap.in typemap.out
+	$(PYTHON) $(top_srcdir)/bindings/bindings.py -l perl --src-dir=$(top_srcdir)/lasso/ $(EXTRA_ARGS)
+
+Lasso.so: Lasso.xs Lasso.pm Makefile.perl gobject_handling.c LassoNode.xs glist_handling.c
+	make -f Makefile.perl
+
+CLEANFILES = Lasso.pm Lasso.xs Lasso.so Makefile.perl typemap Lasso.o Lasso.bs pm_to_blib Lasso.c blib
+
+clean-local:
+	-make -f Makefile.perl clean
+	-if [ "$(srcdir)" != "$(builddir)" ]; then rm -rf `find -mindepth 1 -not -name Makefile`; fi
+
+install-exec-local:
+	make -f Makefile.perl install DESTDIR=$(DESTDIR) PREFIX=$(prefix)
+
+endif
diff --git a/bindings/perl/__init__.py b/bindings/perl/__init__.py
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/bindings/perl/__init__.py
diff --git a/bindings/perl/glist_handling.c b/bindings/perl/glist_handling.c
new file mode 100644
index 00000000..ec9d93a4
--- /dev/null
+++ b/bindings/perl/glist_handling.c
@@ -0,0 +1,251 @@
+/*
+ * Lasso - A free implementation of the Liberty Alliance specifications.
+ *
+ * Copyright (C) 2004-2007 Entr'ouvert
+ * http://lasso.entrouvert.org
+ *
+ * Authors: See AUTHORS file in top-level directory.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *
+ */
+
+#include <perl.h>
+#include <glib.h>
+#include <glib-object.h>
+#include <lasso/xml/xml.h>
+#include <lasso/utils.h>
+
+/**
+ * xmlnode_to_pv:
+ * @node: an xmlNode* object
+ * @do_free: do we need to free the node after the conversion
+ *
+ * Return value: a newly allocated SV/PV or under.
+ */
+SV*
+xmlnode_to_pv(xmlNode *node, gboolean do_free)
+{
+	xmlOutputBufferPtr buf;
+	SV *pestring = NULL;
+
+	if (node == NULL) {
+		return &PL_sv_undef;
+	}
+
+	buf = xmlAllocOutputBuffer(NULL);
+	if (buf == NULL) {
+		pestring = &PL_sv_undef;
+	} else {
+		xmlNodeDumpOutput(buf, NULL, node, 0, 1, NULL);
+		xmlOutputBufferFlush(buf);
+		if (buf->conv == NULL) {
+			pestring = newSVpv((char*)buf->buffer->content, 0);
+		} else {
+			pestring = newSVpv((char*)buf->conv->content, 0);
+		}
+		xmlOutputBufferClose(buf);
+	}
+	if (do_free) {
+		lasso_release_xml_node(node);
+	}
+
+	return pestring;
+}
+
+xmlNode *pv_to_xmlnode(SV *value) {
+	char *string = SvPV_nolen(value);
+	xmlDoc *doc;
+	xmlNode *node = NULL;
+
+	if (! string)
+		return NULL;
+
+	doc = xmlReadDoc(BAD_CAST string, NULL, NULL, XML_PARSE_NONET);
+	if (! doc)
+		return NULL;
+	lasso_assign_xml_node(node, xmlDocGetRootElement(doc));
+	lasso_release_doc(doc);
+
+	return node;
+}
+
+/**
+ * glist_string_to_array:
+ * @list: a GList* of strings
+ * @do_free: wheter to free the list after the transformation
+ *
+ * Convert a #GList of strings to a Perl array of strings.
+ *
+ * Return value: a newly created perl array
+ */
+AV*
+glist_string_to_array(GList *list, gboolean do_free)
+{
+	AV *array;
+
+	array = newAV();
+
+	while (list) {
+		SV *sv;
+		sv = newSVpv((char*)list->data, 0);
+		if (! sv)
+			sv = &PL_sv_undef;
+		av_push(array, sv);
+		list = list->next;
+	}
+
+	if (do_free)
+		lasso_release_list_of_strings(list);
+
+	return array;
+}
+
+/**
+ * array_to_glist_string:
+ * @array: a Perl array
+ *
+ * Convert a perl array to a #GList of strings.
+ *
+ * Return value: a newly create #GList
+ */
+GList*
+array_to_glist_string(AV *array)
+{
+	I32 len, i;
+	GList *result = NULL;
+
+	if (! array)
+		return NULL;
+	len = av_len(array);
+	for (i=len-1; i >= 0; i--) {
+		SV **sv;
+
+		sv = av_fetch(array, i, 0);
+		lasso_list_add_string(result, SvPV_nolen(*sv));
+	}
+
+	return result;
+}
+
+/**
+ * glist_gobject_to_array:
+ * @list: a #GList of #GObject objects
+ * @do_free: wheter to free the list after the conversion
+ *
+ * Convert a #GList of #GObject objects to a perl array.
+ *
+ * Return value: a newly created perl array
+ */
+AV*
+glist_gobject_to_array(GList *list, gboolean do_free)
+{
+	AV *array;
+
+	array = newAV();
+	while (list) {
+		SV *sv;
+		sv = gperl_new_object((GObject*)list->data, FALSE);
+		if (! sv)
+			sv = &PL_sv_undef;
+		av_push(array, sv);
+		list = list->next;
+	}
+
+	if (do_free)
+		lasso_release_list_of_gobjects(list);
+
+	return array;
+}
+
+/**
+ * array_to_glist_gobject:
+ * @array: a perl array
+ *
+ * Convert a perl array of #GObject to a #GList of #GObject objects
+ *
+ * Return value: a newly created #GList of #GObject objects
+ */
+GList*
+array_to_glist_gobject(AV *array) {
+	I32 len, i;
+	GList *result = NULL;
+
+	if (! array)
+		return NULL;
+	len = av_len(array);
+	for (i=len-1; i >= 0; i--) {
+		SV **sv;
+
+		sv = av_fetch(array, i, 0);
+		lasso_list_add_gobject(result, gperl_get_object(*sv));
+	}
+
+	return result;
+}
+
+/**
+ * glist_xmlnode_to_array:
+ * @list: a #GList of #xmlNode
+ * @do_free: whether to free the list after the conversion
+ *
+ * Convert a #GList of #xmlNode structures to a perl array of strings.
+ *
+ * Return value: a newly created Perl array */
+AV*
+glist_xmlnode_to_array(GList *list, gboolean do_free)
+{
+	AV *array;
+
+	array = newAV();
+	while (list) {
+		SV *sv = xmlnode_to_pv((xmlNode*)list->data, FALSE);
+		if (! sv)
+			sv = &PL_sv_undef;
+		av_push(array, sv);
+		list = list->next;
+	}
+
+	if (do_free)
+		lasso_release_list_of_xml_node(list);
+
+	return array;
+}
+
+/**
+ * array_to_glist_xmlnode:
+ * @array: a perl array
+ *
+ * Convert a perl array of strings to a #GList of #xmlNode structures.
+ *
+ * Return value: a newly created #GList of #xmlNode structures.
+ */
+GList*
+array_to_glist_xmlnode(AV *array) {
+	I32 len, i;
+	GList *result = NULL;
+
+	if (! array)
+		return NULL;
+	len = av_len(array);
+	for (i=len-1; i >= 0; i--) {
+		SV **sv;
+
+		sv = av_fetch(array, i, 0);
+		lasso_list_add_new_xml_node(result, pv_to_xmlnode(*sv));
+	}
+
+	return result;
+}
diff --git a/bindings/perl/gobject_handling.c b/bindings/perl/gobject_handling.c
new file mode 100644
index 00000000..8e811302
--- /dev/null
+++ b/bindings/perl/gobject_handling.c
@@ -0,0 +1,227 @@
+/*
+ * Lasso - A free implementation of the Liberty Alliance specifications.
+ *
+ * Copyright (C) 2004-2007 Entr'ouvert
+ * http://lasso.entrouvert.org
+ *
+ * Authors: See AUTHORS file in top-level directory.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *
+ */
+
+#include <perl.h>
+#include <glib.h>
+#include <glib-object.h>
+#include <lasso/xml/xml.h>
+
+/*
+ * Manipulate a pointer to indicate that an SV is undead.
+ * Relies on SV pointers being word-aligned.
+ */
+#define IS_UNDEAD(x) (PTR2UV(x) & 1)
+#define MAKE_UNDEAD(x) INT2PTR(void*, PTR2UV(x) | 1)
+#define REVIVE_UNDEAD(x) INT2PTR(void*, PTR2UV(x) & ~1)
+
+/* this code is copied / adapted from libglib-perl */
+GHashTable *type_to_package;
+GQuark wrapper_quark;
+
+extern int lasso_init();
+
+void
+init_perl_lasso() {
+	type_to_package = g_hash_table_new_full(g_int_hash, g_int_equal, NULL, g_free);
+	wrapper_quark = g_quark_from_static_string("PerlLasso::wrapper");
+	lasso_init();
+}
+
+static const char *
+gperl_object_package_from_type (GType gtype)
+{
+	gchar* package;
+	const gchar* type_name;
+
+	if (!g_type_is_a (gtype, G_TYPE_OBJECT) &&
+		!g_type_is_a (gtype, G_TYPE_INTERFACE))
+		return NULL;
+
+	package = g_hash_table_lookup(type_to_package, (gconstpointer)gtype);
+	if (package)
+		return package;
+
+	type_name = g_type_name(gtype);
+	if (! type_name)
+		return NULL;
+
+	if (strncmp(type_name, "Lasso", 5) != 0)
+		return NULL;
+
+	package = g_strconcat("Lasso::", &type_name[5], NULL);
+	g_hash_table_insert(type_to_package, (gpointer)gtype, (gpointer)package);
+
+	return package;
+}
+
+static void
+gobject_destroy_wrapper (SV *obj)
+{
+#ifdef NOISY
+	warn ("gobject_destroy_wrapper (%p)[%d]\n", obj,
+			SvREFCNT ((SV*)REVIVE_UNDEAD(obj)));
+#endif
+	obj = REVIVE_UNDEAD(obj);
+	sv_unmagic (obj, PERL_MAGIC_ext);
+
+	/* we might want to optimize away the call to DESTROY here for non-perl classes. */
+	SvREFCNT_dec (obj);
+}
+
+static HV *
+gperl_object_stash_from_type (GType gtype)
+{
+	const char * package = gperl_object_package_from_type (gtype);
+	if (package)
+		return gv_stashpv (package, TRUE);
+	else
+		return NULL;
+}
+
+static void
+update_wrapper (GObject *object, gpointer obj)
+{
+#ifdef NOISY
+	warn("update_wrapper [%p] (%p)\n", object, obj); */
+#endif
+        g_object_steal_qdata (object, wrapper_quark);
+        g_object_set_qdata_full (object,
+                                 wrapper_quark,
+                                 obj,
+                                 (GDestroyNotify)gobject_destroy_wrapper);
+}
+
+SV *
+gperl_new_object (GObject * object,
+                  gboolean own)
+{
+	SV *obj;
+	SV *sv;
+
+	/* take the easy way out if we can */
+	if (!object) {
+		return &PL_sv_undef;
+	}
+
+	if (!LASSO_IS_NODE (object))
+		croak ("object %p is not really a LassoNode", object);
+
+	/* fetch existing wrapper_data */
+	obj = (SV *)g_object_get_qdata (object, wrapper_quark);
+
+	if (!obj) {
+		/* create the perl object */
+		GType gtype = G_OBJECT_TYPE (object);
+
+		HV *stash = gperl_object_stash_from_type (gtype);
+
+		/* We should only get NULL for the stash here if gtype is
+		 * neither a GObject nor GInterface.  We filtered out all
+		 * non-GObject types a few lines back. */
+		g_assert (stash != NULL);
+
+		/*
+		 * Create the "object", a hash.
+		 *
+		 * This does not need to be a HV, the only problem is finding
+		 * out what to use, and HV is certainly the way to go for any
+		 * built-in objects.
+		 */
+
+		/* this increases the combined object's refcount. */
+		obj = (SV *)newHV ();
+		/* attach magic */
+		sv_magic (obj, 0, PERL_MAGIC_ext, (const char *)object, 0);
+
+		/* The SV has a ref to the C object.  If we are to own this
+		 * object, then any other references will be taken care of
+		 * below in take_ownership */
+		g_object_ref (object);
+
+		/* create the wrapper to return, the _noinc decreases the
+		 * combined refcount by one. */
+		sv = newRV_noinc (obj);
+
+		/* bless into the package */
+		sv_bless (sv, stash);
+
+		/* attach it to the gobject */
+		update_wrapper (object, obj);
+		/* printf("creating new wrapper for [%p] (%p)\n", object, obj); */
+
+		/* the noinc is so that the SV (initially) exists only as long
+		 * as the perl code needs it.  When the DESTROY gets called, we
+		 * check and see if the SV is the only referer to the C object,
+		 * and if so remove both.  Otherwise, the SV will become
+		 * "undead," to be either revived or destroyed with the C
+		 * object */
+
+#ifdef NOISY
+		warn ("gperl_new_object%d %s(%p)[%d] => %s (%p) (NEW)\n", own,
+				G_OBJECT_TYPE_NAME (object), object, object->ref_count,
+				gperl_object_package_from_type (G_OBJECT_TYPE (object)),
+				SvRV (sv));
+#endif
+	} else {
+		/* create the wrapper to return, increases the combined
+		 * refcount by one. */
+
+		/* if the SV is undead, revive it */
+		if (IS_UNDEAD(obj)) {
+			g_object_ref (object);
+			obj = REVIVE_UNDEAD(obj);
+			update_wrapper (object, obj);
+			sv = newRV_noinc (obj);
+			/* printf("reviving undead wrapper for [%p] (%p)\n", object, obj); */
+		} else {
+			/* printf("reusing previous wrapper for %p\n", obj); */
+			sv = newRV_inc (obj);
+		}
+	}
+
+#ifdef NOISY
+	warn ("gperl_new_object%d %s(%p)[%d] => %s (%p)[%d] (PRE-OWN)\n", own,
+			G_OBJECT_TYPE_NAME (object), object, object->ref_count,
+			gperl_object_package_from_type (G_OBJECT_TYPE (object)),
+			SvRV (sv), SvREFCNT (SvRV (sv)));
+#endif
+	if (own)
+		g_object_unref(object);
+
+	return sv;
+}
+
+GObject *
+gperl_get_object (SV * sv)
+{
+	MAGIC *mg;
+
+	if (!sv || !SvOK(sv) || !SvROK (sv) || !(mg = mg_find (SvRV (sv), PERL_MAGIC_ext)))
+		return NULL;
+	if (! mg->mg_ptr)
+		return NULL;
+	if (! G_IS_OBJECT(mg->mg_ptr))
+		return NULL;
+	return (GObject *) mg->mg_ptr;
+}
diff --git a/bindings/perl/lang.py b/bindings/perl/lang.py
new file mode 100644
index 00000000..f562533b
--- /dev/null
+++ b/bindings/perl/lang.py
@@ -0,0 +1,438 @@
+# Lasso - A free implementation of the Liberty Alliance specifications.
+#
+# Copyright (C) 2004-2007 Entr'ouvert
+# http://lasso.entrouvert.org
+#
+# Authors: See AUTHORS file in top-level directory.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+import os
+import os.path
+import sys
+import re
+import textwrap
+from utils import *
+
+class Output(object):
+    def __init__(self, filename, indent = 4):
+        self.fd = open(filename, 'w')
+        self.indent_stack = [0]
+        self.indent_size = indent
+
+    def pn(self, s = ''):
+        print >> self.fd, (' ' * self.indent_stack[-1]) + s
+
+    def p(self, s = ''):
+        print >>self.fd, s,
+
+    def close(self):
+        self.fd.close()
+
+    def indent(self, c = None):
+        if not c:
+            c = self.indent_size
+        self.indent_stack.append(c)
+
+    def unindent(self):
+        self.indent_stack.pop()
+
+package_top = '''package Lasso;
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load('Lasso');
+'''
+
+class Binding:
+    xs = None
+    pm = None
+    typemap = None
+    binding_data = None
+
+    def __init__(self, binding_data):
+        self.binding_data = binding_data
+        self.src_dir = os.path.dirname(__file__)
+        self.xs = Output('Lasso.xs')
+        self.pm = Output('Lasso.pm')
+        self.typemap = Output('typemap')
+
+    def file_content(self, filename):
+        return file(os.path.join(self.src_dir, filename)).read()
+
+    def generate(self):
+        # Generate XS
+        self.generate_typemap()
+        self.generate_xs_header()
+        self.generate_xs_constants()
+        self.generate_xs_functions()
+        self.generate_xs_footer()
+
+        # Generate PM
+        self.generate_pm_header()
+
+
+        # Generate 
+        self.generate_exceptions()
+        for clss in self.binding_data.structs:
+            self.generate_class(clss)
+
+    def generate_typemap(self):
+        self.typemap.pn('TYPEMAP')
+        self.typemap.pn('''
+const gchar *\tT_PV
+gchar *\tT_PV
+gboolean\tT_IV
+const LassoProvider *\tT_GOBJECT_WRAPPER
+xmlNode*\tT_XMLNODE
+GList_string\tT_GLIST_STRING
+GList_xmlnode\tT_GLIST_XMLNODE
+GList_gobject\tT_GLIST_GOBJECT
+const GList*\tT_GLIST_STRING
+GHashTable*\tT_PTRREF
+
+''')
+        # Map integer types
+        for int in [ 'int', 'gint', 'long', 'glong'] + self.binding_data.enums:
+            self.typemap.pn('%-30s T_IV' % int)
+
+        # Map object types
+        for clss in self.binding_data.structs:
+            self.typemap.pn('%-30s T_GOBJECT_WRAPPER' % (clss.name + '*'))
+            self.typemap.pn('const %-30s T_GOBJECT_WRAPPER' % (clss.name + '*'))
+
+        # Create INPUT & OUTPUT maps
+        self.typemap.p(self.file_content('typemap.in'))
+        self.typemap.p(self.file_content('typemap.out'))
+
+    def generate_pm_header(self):
+        # Lasso.pm
+        self.pm.p(package_top)
+
+        for struct in self.binding_data.structs:
+            if struct.name != 'LassoNode':
+                self.pm.pn('package Lasso::%s;' % struct.name[5:])
+                self.pm.pn('our @ISA = qw(%s);' % struct.parent[5:])
+                self.pm.pn()
+
+    def generate_xs_header(self):
+        '''Generate header of XS file'''
+        self.xs.pn('''
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <stdio.h>
+
+#include "gobject_handling.c"
+#include "glist_handling.c"
+
+#define lasso_assign_simple(a,b) a = b;
+
+typedef GList* GList_string;
+typedef GList* GList_gobject;
+typedef GList* GList_xmlnode;
+
+/* #include "ppport.h" */''')
+        for h in self.binding_data.headers:
+            self.xs.pn('#include <%s>' % h)
+        self.xs.pn('''
+MODULE = Lasso PACKAGE = Lasso::Node
+
+INCLUDE: LassoNode.xs
+''')
+        self.xs.pn('MODULE = Lasso		PACKAGE = Lasso      PREFIX = lasso_ ')
+        self.xs.pn()
+        self.xs.pn('PROTOTYPES: ENABLE')
+        self.xs.pn()
+
+    def generate_xs_constants(self):
+        '''Generate a function which can return an int from a string'''
+        self.xs.pn('''BOOT:
+{
+    SV *ct;
+    HV *stash;
+
+    init_perl_lasso();
+    stash = gv_stashpv("Lasso", 1);''')
+        self.xs.indent()
+        for constant in self.binding_data.constants:
+            type, name = constant
+            perl_name = name[6:]
+            self.xs.pn('ct = get_sv("Lasso::Constants::%s", TRUE | GV_ADDMULTI);' % perl_name)
+            if type == 'i':
+                self.xs.pn('sv_setiv(ct, %s);' % name)
+            elif type == 's':
+                self.xs.pn('sv_setpv(ct, %s);' % name)
+            elif type == 'b': # only one case LASSO_WSF_ENABLED
+                self.xs.unindent()
+                self.xs.pn('''#ifdef %s
+    sv_setiv(ct, 1);
+#else
+    sv_setiv(ct, 0);
+#endif''' % name)
+                self.xs.indent()
+            else:
+                raise Exception('Unknown constant type: type: "%s" name: "%s"' % (type,name))
+            self.xs.pn('SvREADONLY_on (ct);')
+        self.xs.unindent()
+        self.xs.pn('}')
+
+
+    def generate_exceptions(self):
+        '''Generate class for exceptions
+
+        Generate a generic Error which can call lasso_strerror and a mapping
+        from rc code to Exception class
+        '''
+
+        for c in self.binding_data.constants:
+            m = re.match(r'LASSO_(\w+)_ERROR_(.*)', c[1])
+            if not m:
+                continue
+            cat, detail = m.groups()
+
+    def generate_xs_footer(self):
+        '''Generate footer of XS file'''
+        pass
+
+    def generate_class(self, clss):
+        klassname = clss.name
+        pass
+
+    def generate_xs_function(self, func):
+        name = func.name
+        if 'get_nameIden' in name:
+            return
+        self.xs.pn()
+        self.xs.pn(func.return_type or 'void')
+        self.xs.p(name + '(')
+        arg_list = []
+        for arg in func.args:
+            if not is_glist(arg):
+                arg_list.append('%s %s' % (arg_type(arg), arg_name(arg)))
+            elif is_glist(arg):
+                arg_list.append('%s %s' % (self.glist_type(arg), arg_name(arg)))
+        self.xs.p(','.join(arg_list))
+        self.xs.pn(')')
+        need_prototype = False
+        for x in func.args:
+            if is_glist(x):
+                need_prototype = True
+        if need_prototype:
+            self.xs.p('PROTOTYPE: ')
+            optional = False
+            proto = []
+            for arg in func.args:
+                if is_optional(arg) and not optional:
+                    proto.append(';')
+                    optional = True
+                if is_glist(arg):
+                    proto.append('\\@')
+                else:
+                    proto.append('$')
+            self.xs.pn(''.join(proto))
+        if '_new_' in name:
+            self.xs.pn('   CODE:')
+            self.xs.pn('       RETVAL = (%(type)s)%(name)s(%(args)s);' %
+                    { 'name': name,
+                      'type': func.return_type,
+                      'args': ' ,'.join([arg_name(arg) for arg in func.args]) })
+            self.xs.pn('''   OUTPUT:
+         RETVAL''')
+            self.xs.pn('''   CLEANUP:
+         g_object_unref(RETVAL);''')
+        elif func.return_type and is_object(func.return_type) and not is_int(func.return_type, self.binding_data) and func.return_owner:
+            self.xs.pn('''   CLEANUP:
+         g_object_unref(RETVAL);''')
+
+    def generate_xs_getter_setter(self, struct, member):
+        name = arg_name(member)
+        type = arg_type(member)
+        el_type = element_type(member)
+        # Simple getter/setter
+        if not is_glist(member) and not is_hashtable(member):
+            self.xs.pn('''
+%(rtype)s
+%(field)s(%(clss)s* obj, %(rtype)s value = 0)
+    CODE:
+        if (items > 1) {
+            %(assignment)s
+            XSRETURN(0);
+        } else {
+            RETVAL = obj->%(field)s;
+        }
+    OUTPUT:
+        RETVAL
+
+            ''' % { 'rtype': type, 'field': name, 'clss': struct.name, 'assignment': self.assign_type(member, 'obj->%s' % arg_name(member), 'value', struct) })
+        elif is_glist(member):
+             self.xs.pn('''
+%(rtype)s
+%(field)s(%(clss)s* obj, ...)
+    PREINIT:
+        int i = 1;
+    CODE:
+        if (items > 1) {
+            %(release)s
+            for (; i < items; i++) {
+                %(el_type)s data;
+                data = (%(el_type)s) %(convert)s;
+                %(push)s(obj->%(field)s, data);
+            }
+            XSRETURN(0);
+        } else {
+            RETVAL = obj->%(field)s;
+        }
+    OUTPUT:
+        RETVAL
+
+            ''' % { 'rtype': self.glist_type(member), 
+                'field': name, 
+                'clss': struct.name,
+                'el_type': self.starify(element_type(member)),
+                'push': self.push_macro(member),
+                'convert': self.convert_function('ST(i)', member),
+                'release': self.release_list('obj', member),
+                })
+        elif is_hashtable(member):
+            print >>sys.stderr, 'W: skipping %(cls)s.%(name)s, GHashtable fields are not supported for the momement' % { 'cls': struct.name, 'name': arg_name(member) }
+
+    def starify(self, str):
+        if '*' in str:
+            return str
+        else:
+            return str + '*'
+
+    def glist_type(self, member):
+        return self.element_type_lookup(member, { 'string': 'GList_string', 'xml_node': 'GList_xmlnode', 'gobject': 'GList_gobject'})
+
+    def element_type_lookup(self, member, lookup_table):
+        if not is_glist(member):
+            raise Exception('calling release_list on %s' % member)
+        type = element_type(member)
+        if is_cstring(type):
+            return lookup_table['string']
+        elif is_xml_node(type):
+            return lookup_table['xml_node']
+        elif is_object(type):
+            return lookup_table['gobject']
+        else:
+            raise Exception('Do not know how to release GList<%s>' % type)
+        return '%s(%s->%s);' % (macro, what, arg_name(member))
+
+
+    def release_list(self, what, member):
+        if not is_glist(member):
+            raise Exception('calling release_list on %s' % member)
+        type = element_type(member)
+        if is_cstring(type):
+            macro = 'lasso_release_list_of_strings'
+        elif is_xml_node(type):
+            macro = 'lasso_release_list_of_xml_node'
+        elif is_object(type):
+            macro = 'lasso_release_list_of_gobjects'
+        else:
+            raise Exception('Do not know how to release GList<%s>' % type)
+        return '%s(%s->%s);' % (macro, what, arg_name(member))
+
+    def convert_function(self, what, member):
+        if not is_glist(member):
+            raise Exception('calling release_list on %s' % member)
+        type = element_type(member)
+        if is_cstring(type):
+            macro = 'SvPV_nolen'
+        elif is_xml_node(type):
+            macro = 'pv_to_xmlnode'
+        elif is_object(type):
+            macro = 'gperl_get_object'
+        else:
+            raise Exception('Do not know how to release GList<%s>' % type)
+        return '%s(%s)' % (macro, what)
+
+    def push_macro(self, member):
+        if not is_glist(member):
+            raise Exception('calling release_list on %s' % member)
+        type = element_type(member)
+        if is_cstring(type):
+            macro = 'lasso_list_add_string'
+        elif is_xml_node(type):
+            macro = 'lasso_list_add_new_xml_node'
+        elif is_object(type):
+            macro = 'lasso_list_add_gobject'
+        else:
+            raise Exception('Do not know how to push to GList<%s>' % type)
+        return macro
+
+    def assign_type(self, arg, to, fr, struct = None):
+        type = arg_type(arg)
+        el_type = element_type(arg)
+        name = arg_name
+        if is_int(arg, self.binding_data):
+            macro = 'lasso_assign_simple'
+        elif is_cstring(arg):
+            macro = 'lasso_assign_string'
+        elif is_xml_node(arg):
+            macro = 'lasso_assign_xml_node'
+        elif is_glist(arg):
+            if not el_type:
+                raise Exception('%s has no element type %s' % (arg, struct))
+            if is_cstring(el_type):
+                macro = 'lasso_assign_list_of_strings'
+            elif is_xml_node(el_type):
+                macro = 'lasso_assign_simple' # FIXME
+            elif is_object(el_type):
+                macro = 'lasso_assign_list_of_gobjects'
+            else:
+                raise Exception('GList<%s> is an unsupported type' % el_type)
+        elif is_object(arg):
+            macro = 'lasso_assign_gobject'
+        elif is_hashtable(arg) or is_boolean(arg) or is_int(arg, self.binding_data):
+            macro = 'lasso_assign_simple' # FIXME
+        else:
+            raise Exception('%s is an unsupported type' % arg)
+        return '%s(%s, %s);' % (macro, to, fr)
+
+    def generate_xs_functions(self):
+        for func in self.binding_data.functions:
+            # skip constructors
+            if func.name.endswith('new') or '_new_' in func.name:
+                continue
+            self.generate_xs_function(func)
+        for struct in self.binding_data.structs:
+            name = struct.name[5:]
+            prefix = 'lasso_' + format_as_underscored(name) + '_'
+            self.xs.pn('\nMODULE = Lasso\tPACKAGE = Lasso::%s\tPREFIX = %s\n' % (name, prefix))
+            # find the constructors
+            for func in self.binding_data.functions:
+                if func.name.startswith(prefix+'new'):
+                    self.generate_xs_function(func)
+            for func in struct.methods:
+                self.generate_xs_function(func)
+            for member in struct.members:
+                if arg_type(member) ==  'void*':
+                    print 'Skipping %s' % member
+                    continue
+                self.generate_xs_getter_setter(struct, member)
+
+    def generate_wrapper(self):
+        pass
+
+    def generate_member_wrapper(self, c):
+        pass
+
+    def return_value(self, vtype, options):
+        pass
+
diff --git a/bindings/perl/t/Lasso.t b/bindings/perl/t/Lasso.t
new file mode 100644
index 00000000..73d7abf5
--- /dev/null
+++ b/bindings/perl/t/Lasso.t
@@ -0,0 +1,15 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Lasso.pm.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('Lasso') };
+
+#########################
+
+# 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.
+
diff --git a/bindings/perl/test.pl b/bindings/perl/test.pl
new file mode 100644
index 00000000..6a0bedb9
--- /dev/null
+++ b/bindings/perl/test.pl
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+
+use ExtUtils::testlib;
+
+use Lasso
diff --git a/bindings/perl/test.sh b/bindings/perl/test.sh
new file mode 100755
index 00000000..e5a0465e
--- /dev/null
+++ b/bindings/perl/test.sh
@@ -0,0 +1,3 @@
+#!/bin/bash
+
+make -f Makefile.perl test
diff --git a/bindings/perl/typemap.in b/bindings/perl/typemap.in
new file mode 100644
index 00000000..ee029372
--- /dev/null
+++ b/bindings/perl/typemap.in
@@ -0,0 +1,10 @@
+INPUT
+
+T_GOBJECT_WRAPPER
+    $var = ($type)gperl_get_object($arg);
+
+T_XMLNODE
+    $var = pv_to_xmlnode($arg);
+
+T_GLIST_STRING
+    $var = array_to_glist_string((AV*)$arg);
diff --git a/bindings/perl/typemap.out b/bindings/perl/typemap.out
new file mode 100644
index 00000000..6327b6ad
--- /dev/null
+++ b/bindings/perl/typemap.out
@@ -0,0 +1,43 @@
+OUTPUT
+
+T_GOBJECT_WRAPPER
+    $arg = gperl_new_object((GObject*)$var, FALSE);
+
+T_XMLNODE_OWN
+    $arg = xmlnode_to_pv($var, TRUE);
+
+T_XMLNODE
+    $arg = xmlnode_to_pv($var, FALSE);
+
+T_GLIST_STRING
+    {
+      I32 ix, length;
+      length = g_list_length((GList*)$var);
+      EXTEND(SP, length);
+      for (ix = 0; ix < length; ++ix) {
+          ST(ix) = sv_2mortal(newSVpv((char*)$var->data, 0));
+          $var = $var->next;
+      }
+    }
+
+T_GLIST_XMLNODE
+    {
+      I32 ix, length;
+      length = g_list_length((GList*)$var);
+      EXTEND(SP, length);
+      for (ix = 0; ix < length; ++ix) {
+          ST(ix) = sv_2mortal(xmlnode_to_pv((xmlNode*)$var->data, FALSE));
+          $var = $var->next;
+      }
+    }
+
+T_GLIST_GOBJECT
+    {
+      I32 ix, length;
+      length = g_list_length((GList*)$var);
+      EXTEND(SP, length);
+      for (ix = 0; ix < length; ++ix) {
+          ST(ix) = sv_2mortal(gperl_new_object((GObject*)$var->data, FALSE));
+          $var = $var->next;
+      }
+    }