Binding perl: many improvements

 * lang.py: use lasso_unref instead of g_object_unref.
 * lang.py: handle 'optional' annotation for more types, needed by
   ID-WSF bindings.
 * lang.py, gobject_handling.c: check object type before making the C
   call
 * Makefile.am: improve silent rules, hide all normal output, show
   errors, and with V=1 shows everything
 * glist_handling.c, gobject_handling.c: make local functions static
 * t/Lasso.t: add non regression test for method receiver type checking.
 * glist_handlind.c; remove unused convertion functions.
 * lang.py: clear the semi-assigned list and croak if all list elements
   do not convert to non-NULL values.

5 files changed, 75 insertions, 149 deletions

diff --git a/bindings/perl/Makefile.am b/bindings/perl/Makefile.am
index 9043b86a..d68a23c4 100644
--- a/bindings/perl/Makefile.am
+++ b/bindings/perl/Makefile.am
@@ -1,3 +1,11 @@
+AM_V_SUBMAKE = $(am__v_SUBMAKE_$(V))
+am__v_SUBMAKE_ = $(am__v_SUBMAKE_$(AM_DEFAULT_VERBOSITY))
+am__v_SUBMAKE_0 = @echo "  SUBMAKE    " $@; LOG=`mktemp`; (
+
+AM_V_SUBMAKE_POSTFIX = $(am__v_SUBMAKE_POSTFIX_$(V))
+am__v_SUBMAKE_POSTFIX_ = $(am__v_SUBMAKE_POSTFIX_$(AM_DEFAULT_VERBOSITY))
+am__v_SUBMAKE_POSTFIX_0 = 2>&1 >$$LOG && rm $$LOG ) || ( cat $$LOG; rm $$LOG )
+
 MAINTAINERCLEANFILES = Makefile.in
 MOSTLYCLEANFILES =
 
@@ -30,14 +38,14 @@ Makefile.perl: $(srcdir)/Makefile.PL Lasso.xs Lasso.pm
 			if [ $(srcdir)/$$file -nt $$file ]; then cp -Rf $(srcdir)/$$file .; fi; \
 		done; \
 		chmod -R u+rwX $(TOCOPY); \
-	fi; \
-	LOG=`mktemp`; ( $(PERL) Makefile.PL PREFIX=$(prefix) CCFLAGS="$(LASSO_XS_CFLAGS)" INC="-I. -I$(top_srcdir)" LIBS="`$(top_builddir)/lasso-src-config --libs`" 2>&1 >$$LOG && rm $$LOG ) || ( cat $$LOG; rm $$LOG )
+	fi;
+	$(AM_V_SUBMAKE) $(PERL) Makefile.PL PREFIX=$(prefix) CCFLAGS="$(LASSO_XS_CFLAGS)" INC="-I. -I$(top_srcdir)" LIBS="`$(top_builddir)/lasso-src-config --libs`" OPTIMIZE="-g" $(AM_V_SUBMAKE_POSTFIX)
 
 Lasso.xs Lasso.pm: lang.py typemap-in typemap-out
 	$(AM_V_GEN) $(PYTHON) $(top_srcdir)/bindings/bindings.py -l perl --src-dir=$(top_srcdir)/lasso/ $(EXTRA_ARGS)
 
 blib/arch/auto/Lasso/Lasso.so: Lasso.xs Lasso.pm Makefile.perl gobject_handling.c LassoNode.xs glist_handling.c
-	$(AM_V_GEN) LOG=`mktemp`; (make -f Makefile.perl 2>&1 >$$LOG && rm $$LOG ) || ( cat $$LOG; rm $$LOG )
+	$(AM_V_SUBMAKE) make -f Makefile.perl $(AM_V_SUBMAKE_POSTFIX)
 
 CLEANFILES = Lasso.pm Lasso.xs Lasso.so typemap Lasso.o Lasso.bs pm_to_blib Lasso.c
 
diff --git a/bindings/perl/glist_handling.c b/bindings/perl/glist_handling.c
index ec9d93a4..377bf693 100644
--- a/bindings/perl/glist_handling.c
+++ b/bindings/perl/glist_handling.c
@@ -35,7 +35,7 @@
  *
  * Return value: a newly allocated SV/PV or under.
  */
-SV*
+static SV*
 xmlnode_to_pv(xmlNode *node, gboolean do_free)
 {
 	xmlOutputBufferPtr buf;
@@ -65,11 +65,15 @@ xmlnode_to_pv(xmlNode *node, gboolean do_free)
 	return pestring;
 }
 
-xmlNode *pv_to_xmlnode(SV *value) {
-	char *string = SvPV_nolen(value);
+static xmlNode *
+pv_to_xmlnode(SV *value) {
+	char *string;
 	xmlDoc *doc;
 	xmlNode *node = NULL;
 
+	if (! SvPOK(value))
+		return NULL;
+	string = SvPV_nolen(value);
 	if (! string)
 		return NULL;
 
@@ -83,37 +87,6 @@ xmlNode *pv_to_xmlnode(SV *value) {
 }
 
 /**
- * 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
  *
@@ -121,7 +94,7 @@ glist_string_to_array(GList *list, gboolean do_free)
  *
  * Return value: a newly create #GList
  */
-GList*
+static GList*
 array_to_glist_string(AV *array)
 {
 	I32 len, i;
@@ -141,36 +114,6 @@ array_to_glist_string(AV *array)
 }
 
 /**
- * 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
  *
@@ -178,74 +121,20 @@ glist_gobject_to_array(GList *list, gboolean do_free)
  *
  * Return value: a newly created #GList of #GObject objects
  */
-GList*
+static 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;
+       I32 len, i;
+       GList *result = NULL;
 
-		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);
+       if (! array)
+               return NULL;
+       len = av_len(array);
+       for (i=len-1; i >= 0; i--) {
+               SV **sv;
 
-	return array;
-}
+               sv = av_fetch(array, i, 0);
+               lasso_list_add_gobject(result, gperl_get_object(*sv));
+       }
 
-/**
- * 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;
+       return result;
 }
diff --git a/bindings/perl/gobject_handling.c b/bindings/perl/gobject_handling.c
index aeab6fc5..6689029c 100644
--- a/bindings/perl/gobject_handling.c
+++ b/bindings/perl/gobject_handling.c
@@ -36,14 +36,16 @@
 #define REVIVE_UNDEAD(x) INT2PTR(void*, PTR2UV(x) & ~1)
 
 /* this code is copied / adapted from libglib-perl */
-GHashTable *type_to_package;
+GHashTable *types_by_types;
+GHashTable *types_by_package;
 GQuark wrapper_quark;
 
 extern int lasso_init();
 
-void
+static void
 init_perl_lasso() {
-	type_to_package = g_hash_table_new_full(g_direct_hash, g_direct_equal, NULL, g_free);
+	types_by_types = g_hash_table_new_full(g_direct_hash, g_direct_equal, NULL, g_free);
+	types_by_package = g_hash_table_new_full(g_str_hash, g_str_equal, g_free, NULL);
 	wrapper_quark = g_quark_from_static_string("PerlLasso::wrapper");
 	lasso_init();
 }
@@ -59,7 +61,7 @@ gperl_object_package_from_type (GType gtype)
 		return NULL;
 
 
-	package = g_hash_table_lookup(type_to_package, (gconstpointer)gtype);
+	package = g_hash_table_lookup(types_by_types, (gconstpointer)gtype);
 	if (package)
 		return package;
 
@@ -71,7 +73,8 @@ gperl_object_package_from_type (GType gtype)
 		return NULL;
 
 	package = g_strconcat("Lasso::", &type_name[5], NULL);
-	g_hash_table_insert(type_to_package, (gpointer)gtype, (gpointer)package);
+	g_hash_table_insert(types_by_types, (gpointer)gtype, (gpointer)package);
+	g_hash_table_insert(types_by_package, g_strdup(package), (gpointer)gtype);
 
 	return package;
 }
@@ -234,7 +237,6 @@ gperl_lasso_error(int error)
 	if (error != 0) {
 		HV *hv;
 		SV *sv;
-		char *what = Nullch;
 
 		const char *desc = lasso_strerror(error);
 		hv = newHV();
@@ -245,3 +247,18 @@ gperl_lasso_error(int error)
 		Perl_croak (aTHX_ Nullch);
 	}
 }
+
+/*
+ * check_gobject:
+ * @object: a #GObject object
+ * @gtype: a #GType
+ *
+ * Check that a given pointer is really a pointer to a GObject of certain type.
+ * Return value: TRUE or FALSE.
+ */
+static void
+check_gobject(GObject *object, GType type) {
+	if (! G_IS_OBJECT(object) || ! g_type_is_a(G_OBJECT_TYPE(object), type)) {
+		gperl_lasso_error(LASSO_PARAM_ERROR_BAD_TYPE_OR_NULL_OBJ);
+	}
+}
diff --git a/bindings/perl/lang.py b/bindings/perl/lang.py
index ba24b67d..7370dad2 100644
--- a/bindings/perl/lang.py
+++ b/bindings/perl/lang.py
@@ -246,10 +246,8 @@ INCLUDE: LassoNode.xs
         else:
             raise Exception('Unknown default value for %s' % (arg,))
 
-    def generate_xs_function(self, func):
+    def generate_xs_function(self, func, prefix = None):
         name = func.name
-        if 'get_nameIden' in name:
-            return
         self.xs.pn()
         if not func.return_type or not is_glist(func.return_arg):
             self.xs.pn(func.return_type or 'void')
@@ -262,7 +260,7 @@ INCLUDE: LassoNode.xs
         self.xs.p(name + '(')
         arg_list = []
         if name.endswith('_new'):
-            arg_list.append('SV *cls')
+            arg_list.append('char *cls')
         for arg in func.args:
             decl = ''
             if is_cstring(arg):
@@ -278,18 +276,25 @@ INCLUDE: LassoNode.xs
                 if arg_default(arg):
                     decl += ' = ' + self.default_value(arg)
                 else:
-                    if is_cstring(arg) or is_glist(arg):
+                    if is_cstring(arg) or is_glist(arg) or is_xml_node(arg) or is_object(arg):
                         decl += ' = NULL'
                     else:
                         raise Exception('Do not know what to do for optional: %s' % arg)
             arg_list.append(decl)
         self.xs.p(','.join(arg_list))
         self.xs.pn(')')
+
         if name.endswith('_new'):
             self.xs.pn('  INIT:')
             self.xs.pn('    cls = NULL;')
             self.xs.pn('  C_ARGS:')
             self.xs.pn('    ' + ', '.join([arg_name(arg) for arg in func.args]))
+        elif prefix and not func.name.startswith(prefix + 'new'):
+            self.xs.pn('  INIT:')
+            self.xs.pn('    check_gobject((GObject*)%(first_arg)s, %(gtype)s);' % {
+                'first_arg': arg_name(func.args[0]),
+                'gtype': prefix + 'get_type()' 
+                } )
         need_prototype = False
         for x in func.args:
             if is_glist(x):
@@ -318,10 +323,10 @@ INCLUDE: LassoNode.xs
             self.xs.pn('''   OUTPUT:
          RETVAL''')
             self.xs.pn('''   CLEANUP:
-         g_object_unref(RETVAL);''')
+         lasso_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);''')
+         lasso_unref(RETVAL);''')
         elif is_int(func.return_arg, self.binding_data):
             if name == 'lasso_check_version':
                 self.xs.pn('''   CLEANUP:
@@ -363,6 +368,10 @@ INCLUDE: LassoNode.xs
             for (; i < items; i++) {
                 %(el_type)s data;
                 data = (%(el_type)s)%(convert)s;
+                if (! data) {
+                    %(release)s
+                    croak("an element cannot be converted to an %(el_type)s");
+                }
                 %(push)s(obj->%(field)s, data);
             }
             XSRETURN(0);
@@ -521,7 +530,7 @@ HV*
                 if func.name.startswith(prefix+'new'):
                     self.generate_xs_function(func)
             for func in struct.methods:
-                self.generate_xs_function(func)
+                self.generate_xs_function(func, prefix = prefix)
             for member in struct.members:
                 if arg_type(member) ==  'void*':
                     print 'Skipping %s' % member
diff --git a/bindings/perl/t/Lasso.t b/bindings/perl/t/Lasso.t
index 7b88c959..f2e6e4fb 100755
--- a/bindings/perl/t/Lasso.t
+++ b/bindings/perl/t/Lasso.t
@@ -38,7 +38,10 @@ ok($@->{code} == -409);
 $server = new Lasso::Server($SRCDIR . "/tests/data/sp5-saml2/metadata.xml", $SRCDIR . "/tests/data/sp5-saml2/private-key.pem");
 ok($server);
 $server->add_provider(Lasso::Constants::PROVIDER_ROLE_IDP, $SRCDIR . "/tests/data/idp5-saml2/metadata.xml");
-
 ok(Lasso::check_version(2,2,90, Lasso::Constants::CHECK_VERSION_NUMERIC) == 1);
 ok(Lasso::check_version(2,2,90, Lasso::Constants::CHECK_VERSION_EXACT) == 0);
 
+$@ = undef;
+
+eval { Lasso::Server::dump(undef); };
+ok($@->{code} == Lasso::Constants::PARAM_ERROR_BAD_TYPE_OR_NULL_OBJ);