[perl-Glib/gio-support: 1/12] [gio] Initial, very rough support for GIO through gobject-introspection



commit 772d55d694501dff1f3bae37a14619db0328cee1
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Mon Aug 24 20:54:23 2009 +0200

    [gio] Initial, very rough support for GIO through gobject-introspection

 GObjectIntrospection.xs | 1394 +++++++++++++++++++++++++++++++++++++++++++++++
 Glib.xs                 |    3 +
 Makefile.PL             |    7 +-
 lib/Glib.pm             |   57 ++
 4 files changed, 1460 insertions(+), 1 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
new file mode 100644
index 0000000..32fbce1
--- /dev/null
+++ b/GObjectIntrospection.xs
@@ -0,0 +1,1394 @@
+/*
+ * Copyright (C) 2005-2009 by the gtk2-perl team
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *
+ */
+
+#include "gperl.h"
+#include "gperl_marshal.h"
+
+#include <girepository.h>
+#include <ffi.h>
+
+#ifdef NOISY
+# define dwarn(...) warn(__VA_ARGS__)
+#else
+# define dwarn(...)
+#endif
+
+/* ------------------------------------------------------------------------- */
+
+static gpointer create_callback_closure (GITypeInfo *type, SV *code);
+static gpointer create_callback_data (SV *data);
+
+static void invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata);
+static void release_callback (gpointer data);
+
+/* ------------------------------------------------------------------------- */
+
+/* Caller owns return value */
+static GIFunctionInfo *
+get_function_info (GIRepository *repository,
+                   const gchar *basename,
+                   const gchar *namespace,
+                   const gchar *method)
+{
+	dwarn ("%s: %s, %s, %s", G_STRFUNC, basename, namespace, method);
+
+	if (namespace) {
+		GIBaseInfo *namespace_info = g_irepository_find_by_name (
+			repository, basename, namespace);
+		if (!namespace_info)
+			croak ("Can't find information for namespace %s",
+			       namespace);
+
+		GIFunctionInfo *function_info = NULL;
+		switch (g_base_info_get_type (namespace_info)) {
+		    case GI_INFO_TYPE_OBJECT:
+			function_info = g_object_info_find_method (
+				(GIObjectInfo *) namespace_info,
+				method);
+			break;
+		    case GI_INFO_TYPE_INTERFACE:
+			function_info = g_interface_info_find_method (
+				(GIInterfaceInfo *) namespace_info,
+				method);
+			break;
+		    default:
+			croak ("Base info for namespace %s has incorrect type",
+			       namespace);
+		}
+
+		if (!function_info)
+			croak ("Can't find information for method "
+			       "%s::%s", namespace, method);
+
+		g_base_info_unref (namespace_info);
+
+		return function_info;
+	} else {
+		GIBaseInfo *method_info = g_irepository_find_by_name (
+			repository, basename, method);
+		switch (g_base_info_get_type (method_info)) {
+		    case GI_INFO_TYPE_FUNCTION:
+			return (GIFunctionInfo *) method_info;
+		    default:
+			croak ("Base info for method %s has incorrect type",
+			       method);
+		}
+	}
+
+	return NULL;
+}
+
+/* ------------------------------------------------------------------------- */
+
+static gpointer
+sv_to_pointer (GITypeInfo* info, SV *sv)
+{
+	GIBaseInfo *interface;
+	GIInfoType info_type;
+
+	interface = g_type_info_get_interface (info);
+	if (!interface)
+		croak ("Could not convert sv %p to pointer", sv);
+	info_type = g_base_info_get_type (interface);
+
+	dwarn ("    interface %p (%s) of type %d\n",
+	       interface, g_base_info_get_name (interface), info_type);
+
+	gpointer pointer = NULL;
+
+	switch (info_type) {
+	    case GI_INFO_TYPE_OBJECT:
+		pointer = gperl_get_object (sv);
+		break;
+
+	    case GI_INFO_TYPE_UNION:
+	    case GI_INFO_TYPE_STRUCT:
+	    case GI_INFO_TYPE_BOXED:
+	    {
+		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		if (!type)
+			croak ("Could not find GType for boxed/struct/union type %s::%s",
+			       g_base_info_get_namespace (interface),
+			       g_base_info_get_name (interface));
+		dwarn ("    struct gtype %s (%d)\n",
+		       g_type_name (type), type);
+		pointer = gperl_get_boxed_check (sv, type);
+		break;
+	    }
+
+	    case GI_INFO_TYPE_ENUM:
+	    {
+		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		pointer = GINT_TO_POINTER (gperl_convert_enum (type, sv));
+		break;
+	    }
+
+	    case GI_INFO_TYPE_FLAGS:
+	    {
+		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		pointer = GUINT_TO_POINTER (gperl_convert_flags (type, sv));
+		break;
+	    }
+
+	    case GI_INFO_TYPE_CALLBACK:
+	    {
+		const gchar *type_name = g_base_info_get_name (interface);
+		/* FIXME: this is a hack */
+		if (0 == strncmp (type_name, "DestroyNotify", 14)) {
+			warn ("FIXME: callback of name DestroyNotify "
+			      "interpreted as destroy notify thingy");
+			pointer = release_callback;
+		} else {
+			pointer = create_callback_closure (info, sv);
+		}
+		break;
+	    }
+
+	    default:
+		croak ("sv_to_pointer: Don't know how to handle info type %d", info_type);
+	}
+
+	g_base_info_unref ((GIBaseInfo *) interface);
+
+	return pointer;
+}
+
+SV *
+pointer_to_sv (GITypeInfo* info, gpointer pointer, gboolean own)
+{
+	GIBaseInfo *interface;
+	GIInfoType info_type;
+
+	dwarn ("  pointer_to_sv: pointer %p, info %p\n",
+	       pointer, info);
+
+	if (!pointer)
+		return &PL_sv_undef;
+
+	interface = g_type_info_get_interface (info);
+	if (!interface)
+		croak ("Could not convert pointer %p to SV", pointer);
+	info_type = g_base_info_get_type (interface);
+
+	SV *sv = NULL;
+
+	switch (info_type) {
+	    case GI_INFO_TYPE_OBJECT:
+	    case GI_INFO_TYPE_INTERFACE:
+		sv = gperl_new_object (pointer, own);
+		break;
+
+	    case GI_INFO_TYPE_UNION:
+	    case GI_INFO_TYPE_STRUCT:
+	    case GI_INFO_TYPE_BOXED:
+	    {
+		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		if (!type)
+			croak ("Could not find GType for boxed/struct/union type %s::%s",
+			       g_base_info_get_namespace (interface),
+			       g_base_info_get_name (interface));
+		sv = gperl_new_boxed (pointer, type, own);
+		break;
+	    }
+
+	    case GI_INFO_TYPE_ENUM:
+	    {
+		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		sv = gperl_convert_back_enum (type, GPOINTER_TO_INT (pointer));
+		break;
+	    }
+
+	    case GI_INFO_TYPE_FLAGS:
+	    {
+		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		sv = gperl_convert_back_flags (type, GPOINTER_TO_UINT (pointer));
+		break;
+	    }
+
+	    default:
+		croak ("pointer_to_sv: Don't know how to handle info type %d", info_type);
+	}
+
+	g_base_info_unref ((GIBaseInfo *) interface);
+
+	return sv;
+}
+
+static gpointer
+instance_sv_to_pointer (GIFunctionInfo *function_info, SV *sv)
+{
+	// We do *not* own container.
+	GIBaseInfo *container = g_base_info_get_container (
+				  (GIBaseInfo *) function_info);
+	GIInfoType info_type = g_base_info_get_type (container);
+
+	dwarn ("  instance_sv_to_pointer: container name: %s, info type: %d\n",
+	       g_base_info_get_name (container),
+	       info_type);
+
+	gpointer pointer = NULL;
+
+	switch (info_type) {
+	    case GI_INFO_TYPE_OBJECT:
+	    case GI_INFO_TYPE_INTERFACE:
+		pointer = gperl_get_object (sv);
+		dwarn ("    -> object pointer: %p\n", pointer);
+		break;
+
+	    case GI_INFO_TYPE_BOXED:
+	    {
+		GType type = g_registered_type_info_get_g_type (
+			       (GIRegisteredTypeInfo *) container);
+		pointer = gperl_get_boxed_check (sv, type);
+		dwarn ("    -> boxed pointer: %p\n", pointer);
+		break;
+	    }
+
+	    case GI_INFO_TYPE_ENUM:
+	    case GI_INFO_TYPE_FLAGS:
+	    case GI_INFO_TYPE_CALLBACK:
+	    case GI_INFO_TYPE_UNRESOLVED:
+	    default:
+		croak ("instance_sv_to_pointer: Don't know how to handle info type %d", info_type);
+	}
+
+	return pointer;
+}
+
+static void
+sv_to_arg (SV * sv,
+	   GArgument * arg,
+	   GITypeInfo * info,
+           gboolean may_be_null)
+{
+	GITypeTag tag = g_type_info_get_tag (info);
+
+	if (!sv || !SvOK (sv))
+		/* Interfaces need to be able to handle undef separately. */
+		if (!may_be_null && tag != GI_TYPE_TAG_INTERFACE)
+			croak ("undefined value for a mandatory argument encountered");
+
+	switch (tag) {
+	    case GI_TYPE_TAG_VOID:
+		dwarn ("    type %p -> void pointer\n", info);
+		warn ("FIXME: void pointer interpreted as callback user data");
+		/* FIXME: this is a hack */
+		arg->v_pointer = create_callback_data (sv);
+		break;
+
+	    case GI_TYPE_TAG_BOOLEAN:
+		arg->v_boolean = SvTRUE (sv);
+		break;
+
+	    case GI_TYPE_TAG_INT8:
+		arg->v_int8 = (gint8) SvIV (sv);
+		break;
+
+	    case GI_TYPE_TAG_UINT8:
+		arg->v_uint8 = (guint8) SvUV (sv);
+		break;
+
+	    case GI_TYPE_TAG_INT16:
+		arg->v_int16 = (gint16) SvIV (sv);
+		break;
+
+	    case GI_TYPE_TAG_UINT16:
+		arg->v_uint16 = (guint16) SvUV (sv);
+		break;
+
+	    case GI_TYPE_TAG_INT32:
+		arg->v_int32 = (gint32) SvIV (sv);
+		break;
+
+	    case GI_TYPE_TAG_UINT32:
+		arg->v_uint32 = (guint32) SvUV (sv);
+		break;
+
+	    case GI_TYPE_TAG_INT64:
+		arg->v_int64 = SvGInt64 (sv);
+		break;
+
+	    case GI_TYPE_TAG_UINT64:
+		arg->v_uint64 = SvGUInt64 (sv);
+		break;
+
+	    case GI_TYPE_TAG_FLOAT:
+		arg->v_float = (gfloat) SvNV (sv);
+		break;
+
+	    case GI_TYPE_TAG_DOUBLE:
+		arg->v_double = SvNV (sv);
+		break;
+
+	    case GI_TYPE_TAG_INT:
+		arg->v_int = SvIV (sv);
+		break;
+
+	    case GI_TYPE_TAG_UINT:
+		arg->v_uint = SvUV (sv);
+		break;
+
+	    case GI_TYPE_TAG_LONG:
+		arg->v_long = SvIV (sv);
+		break;
+
+	    case GI_TYPE_TAG_ULONG:
+		arg->v_ulong = SvUV (sv);
+		break;
+
+	    case GI_TYPE_TAG_ARRAY:
+		croak ("FIXME - GI_TYPE_TAG_ARRAY");
+		break;
+
+	    case GI_TYPE_TAG_INTERFACE:
+		dwarn ("    type %p -> interface\n", info);
+		arg->v_pointer = sv_to_pointer (info, sv);
+		break;
+
+	    case GI_TYPE_TAG_GLIST:
+		croak ("FIXME - GI_TYPE_TAG_GLIST");
+		break;
+
+	    case GI_TYPE_TAG_GSLIST:
+		croak ("FIXME - GI_TYPE_TAG_GSLIST");
+		break;
+
+	    case GI_TYPE_TAG_GHASH:
+		croak ("FIXME - GI_TYPE_TAG_GHASH");
+		break;
+
+	    case GI_TYPE_TAG_ERROR:
+		croak ("FIXME - A GError as an in/inout arg?  Should never happen!");
+		break;
+
+	    case GI_TYPE_TAG_SSIZE:
+		arg->v_ssize = (gssize) SvIV (sv);
+		break;
+
+	    case GI_TYPE_TAG_SIZE:
+		arg->v_size = (gsize) SvUV (sv);
+		break;
+
+	    case GI_TYPE_TAG_UTF8:
+		arg->v_string = SvOK (sv) ? SvGChar (sv) : NULL;
+		break;
+
+	    case GI_TYPE_TAG_FILENAME:
+		arg->v_string = SvOK (sv) ? gperl_filename_from_sv (sv) : NULL;
+		break;
+
+	    default:
+		croak ("Unhandled info tag %d", tag);
+	}
+}
+
+static SV *
+arg_to_sv (const GArgument * arg,
+	   GITypeInfo * info,
+           GITransfer transfer)
+{
+	GITypeTag tag = g_type_info_get_tag (info);
+	gboolean own = transfer == GI_TRANSFER_EVERYTHING;
+
+	dwarn ("  arg_to_sv: info %p with type tag %d\n", info, tag);
+
+	switch (tag) {
+	    case GI_TYPE_TAG_VOID:
+		return NULL;
+
+	    case GI_TYPE_TAG_BOOLEAN:
+		return boolSV (arg->v_boolean);
+
+	    case GI_TYPE_TAG_INT8:
+		return newSViv (arg->v_int8);
+
+	    case GI_TYPE_TAG_UINT8:
+		return newSVuv (arg->v_uint8);
+
+	    case GI_TYPE_TAG_INT16:
+		return newSViv (arg->v_int16);
+
+	    case GI_TYPE_TAG_UINT16:
+		return newSVuv (arg->v_uint16);
+
+	    case GI_TYPE_TAG_INT32:
+		return newSViv (arg->v_int32);
+
+	    case GI_TYPE_TAG_UINT32:
+		return newSVuv (arg->v_uint32);
+
+	    case GI_TYPE_TAG_INT64:
+		return newSVGInt64 (arg->v_int64);
+
+	    case GI_TYPE_TAG_UINT64:
+		return newSVGUInt64 (arg->v_uint64);
+
+	    case GI_TYPE_TAG_FLOAT:
+		return newSVnv (arg->v_float);
+
+	    case GI_TYPE_TAG_DOUBLE:
+		return newSVnv (arg->v_double);
+
+	    case GI_TYPE_TAG_INT:
+		return newSViv (arg->v_int);
+
+	    case GI_TYPE_TAG_UINT:
+		return newSVuv (arg->v_uint);
+
+	    case GI_TYPE_TAG_LONG:
+		return newSViv (arg->v_long);
+
+	    case GI_TYPE_TAG_ULONG:
+		return newSVuv (arg->v_ulong);
+
+	    case GI_TYPE_TAG_ARRAY:
+		croak ("FIXME - GI_TYPE_TAG_ARRAY");
+
+	    case GI_TYPE_TAG_INTERFACE:
+		return pointer_to_sv (info, arg->v_pointer, own);
+
+	    case GI_TYPE_TAG_GLIST:
+	    {
+		GITypeInfo *param_info;
+		GList *i;
+		AV *av;
+		SV *value;
+
+		param_info = g_type_info_get_param_type (info, 0);
+		av = newAV ();
+
+		dwarn ("    GList: pointer %p, param_info %p with type tag %d\n",
+		      arg->v_pointer,
+		      param_info,
+		      g_type_info_get_tag (param_info));
+
+		for (i = arg->v_pointer; i; i = i->next) {
+			dwarn ("      converting pointer %p\n", i->data);
+			value = pointer_to_sv (param_info, i->data, transfer);
+			if (value)
+				av_push (av, value);
+		}
+
+		if (transfer >= GI_TRANSFER_CONTAINER)
+			g_list_free (arg->v_pointer);
+
+		g_base_info_unref ((GIBaseInfo *) param_info);
+
+		return newRV_noinc ((SV *) av);
+	    }
+
+	    case GI_TYPE_TAG_GSLIST:
+		croak ("FIXME - GI_TYPE_TAG_GSLIST");
+
+	    case GI_TYPE_TAG_GHASH:
+		croak ("FIXME - GI_TYPE_TAG_GHASH");
+
+	    case GI_TYPE_TAG_ERROR:
+		croak ("FIXME - GI_TYPE_TAG_ERROR");
+		break;
+
+	    case GI_TYPE_TAG_SSIZE:
+		return newSViv (arg->v_ssize);
+
+	    case GI_TYPE_TAG_SIZE:
+		return newSVuv (arg->v_size);
+
+	    case GI_TYPE_TAG_UTF8:
+	    {
+		SV *sv = newSVGChar (arg->v_string);
+		if (own)
+			g_free (arg->v_string);
+		return sv;
+	    }
+
+	    case GI_TYPE_TAG_FILENAME:
+	    {
+		SV *sv = gperl_sv_from_filename (arg->v_string);
+		if (own)
+			g_free (arg->v_string);
+		return sv;
+	    }
+
+	    default:
+		croak ("Unhandled info tag %d", tag);
+	}
+
+	return NULL;
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct {
+	ffi_cif *cif;
+	ffi_closure *closure;
+
+	GIBaseInfo *interface;
+
+	SV *code;
+	SV *data;
+
+	gpointer priv; /* perl context */
+} GPerlI11nCallbackInfo;
+
+/* This gross global variable hack is needed because the callback and callback
+ * user data arguments are handled separately by the argument list converter.
+ * But we need a place to save the callback info struct since that's what has
+ * to be passed back to the caller as the real user data.  This in turn is
+ * necessary so that our GDestroyNotify function (release_callback) can free
+ * everything that's been allocated. */
+static GPerlI11nCallbackInfo *current_callback_info = NULL;
+
+static ffi_type *
+get_ffi_type (GITypeInfo *info)
+{
+	if (g_type_info_is_pointer (info)) {
+		return &ffi_type_pointer;
+	}
+
+	switch (g_type_info_get_tag (info)) {
+	    case GI_TYPE_TAG_VOID:
+		return &ffi_type_void;
+	    case GI_TYPE_TAG_BOOLEAN:
+		return &ffi_type_uint;
+	    case GI_TYPE_TAG_INT8:
+		return &ffi_type_sint8;
+	    case GI_TYPE_TAG_UINT8:
+		return &ffi_type_uint8;
+	    case GI_TYPE_TAG_INT16:
+		return &ffi_type_sint16;
+	    case GI_TYPE_TAG_UINT16:
+		return &ffi_type_uint16;
+	    case GI_TYPE_TAG_INT32:
+		return &ffi_type_sint32;
+	    case GI_TYPE_TAG_UINT32:
+		return &ffi_type_uint32;
+	    case GI_TYPE_TAG_INT64:
+		return &ffi_type_sint64;
+	    case GI_TYPE_TAG_UINT64:
+		return &ffi_type_uint64;
+	    case GI_TYPE_TAG_SSIZE:
+	    case GI_TYPE_TAG_INT:
+		return &ffi_type_sint;
+	    case GI_TYPE_TAG_SIZE:
+	    case GI_TYPE_TAG_UINT:
+		return &ffi_type_uint;
+	    case GI_TYPE_TAG_LONG:
+		return &ffi_type_slong;
+	    case GI_TYPE_TAG_ULONG:
+		return &ffi_type_ulong;
+	    case GI_TYPE_TAG_FLOAT:
+		return &ffi_type_float;
+	    case GI_TYPE_TAG_DOUBLE:
+		return &ffi_type_double;
+	    case GI_TYPE_TAG_UTF8:
+	    case GI_TYPE_TAG_FILENAME:
+	    case GI_TYPE_TAG_ARRAY:
+	    case GI_TYPE_TAG_INTERFACE:
+	    case GI_TYPE_TAG_GLIST:
+	    case GI_TYPE_TAG_GSLIST:
+	    case GI_TYPE_TAG_GHASH:
+	    case GI_TYPE_TAG_ERROR:
+		return &ffi_type_pointer;
+	    default:
+		g_assert_not_reached ();
+		return NULL;
+	}
+}
+
+#define CAST_RAW(raw, type) (*((type *) raw))
+
+static void
+raw_to_arg (gpointer raw, GArgument *arg, GITypeInfo *info)
+{
+	GITypeTag tag = g_type_info_get_tag (info);
+
+	switch (tag) {
+	    case GI_TYPE_TAG_VOID:
+		/* do nothing */
+		break;
+
+	    case GI_TYPE_TAG_BOOLEAN:
+		arg->v_boolean = CAST_RAW (raw, gboolean);
+		break;
+
+	    case GI_TYPE_TAG_INT8:
+		arg->v_int8 = CAST_RAW (raw, gint8);
+		break;
+
+	    case GI_TYPE_TAG_UINT8:
+		arg->v_uint8 = CAST_RAW (raw, guint8);
+		break;
+
+	    case GI_TYPE_TAG_INT16:
+		arg->v_int16 = CAST_RAW (raw, gint16);
+		break;
+
+	    case GI_TYPE_TAG_UINT16:
+		arg->v_uint16 = CAST_RAW (raw, guint16);
+		break;
+
+	    case GI_TYPE_TAG_INT32:
+		arg->v_int32 = CAST_RAW (raw, gint32);
+		break;
+
+	    case GI_TYPE_TAG_UINT32:
+		arg->v_uint32 = CAST_RAW (raw, guint32);
+		break;
+
+	    case GI_TYPE_TAG_INT64:
+		arg->v_int64 = CAST_RAW (raw, gint64);
+		break;
+
+	    case GI_TYPE_TAG_UINT64:
+		arg->v_uint64 = CAST_RAW (raw, guint64);
+		break;
+
+	    case GI_TYPE_TAG_FLOAT:
+		arg->v_float = CAST_RAW (raw, gfloat);
+		break;
+
+	    case GI_TYPE_TAG_DOUBLE:
+		arg->v_double = CAST_RAW (raw, gdouble);
+		break;
+
+	    case GI_TYPE_TAG_INT:
+		arg->v_int = CAST_RAW (raw, gint);
+		break;
+
+	    case GI_TYPE_TAG_UINT:
+		arg->v_uint = CAST_RAW (raw, guint);
+		break;
+
+	    case GI_TYPE_TAG_LONG:
+		arg->v_long = CAST_RAW (raw, glong);
+		break;
+
+	    case GI_TYPE_TAG_ULONG:
+		arg->v_ulong = CAST_RAW (raw, gulong);
+		break;
+
+	    case GI_TYPE_TAG_ARRAY:
+	    case GI_TYPE_TAG_INTERFACE:
+	    case GI_TYPE_TAG_GLIST:
+	    case GI_TYPE_TAG_GSLIST:
+	    case GI_TYPE_TAG_GHASH:
+	    case GI_TYPE_TAG_ERROR:
+		arg->v_pointer = * (gpointer *) raw;
+		break;
+
+	    case GI_TYPE_TAG_SSIZE:
+		arg->v_ssize = CAST_RAW (raw, gssize);
+		break;
+
+	    case GI_TYPE_TAG_SIZE:
+		arg->v_size = CAST_RAW (raw, gsize);
+		break;
+
+	    case GI_TYPE_TAG_UTF8:
+	    case GI_TYPE_TAG_FILENAME:
+		arg->v_string = * (gchar **) raw;
+		break;
+
+	    default:
+		croak ("Unhandled info tag %d", tag);
+	}
+}
+
+static void
+arg_to_raw (GArgument *arg, gpointer raw, GITypeInfo *info)
+{
+	GITypeTag tag = g_type_info_get_tag (info);
+
+	switch (tag) {
+	    case GI_TYPE_TAG_VOID:
+		/* do nothing */
+		break;
+
+	    case GI_TYPE_TAG_BOOLEAN:
+		* (gboolean *) raw = arg->v_boolean;
+		break;
+
+	    case GI_TYPE_TAG_INT8:
+		* (gint8 *) raw = arg->v_int8;
+		break;
+
+	    case GI_TYPE_TAG_UINT8:
+		* (guint8 *) raw = arg->v_uint8;
+		break;
+
+	    case GI_TYPE_TAG_INT16:
+		* (gint16 *) raw = arg->v_int16;
+		break;
+
+	    case GI_TYPE_TAG_UINT16:
+		* (guint16 *) raw = arg->v_uint16;
+		break;
+
+	    case GI_TYPE_TAG_INT32:
+		* (gint32 *) raw = arg->v_int32;
+		break;
+
+	    case GI_TYPE_TAG_UINT32:
+		* (guint32 *) raw = arg->v_uint32;
+		break;
+
+	    case GI_TYPE_TAG_INT64:
+		* (gint64 *) raw = arg->v_int64;
+		break;
+
+	    case GI_TYPE_TAG_UINT64:
+		* (guint64 *) raw = arg->v_uint64;
+		break;
+
+	    case GI_TYPE_TAG_FLOAT:
+		* (gfloat *) raw = arg->v_float;
+		break;
+
+	    case GI_TYPE_TAG_DOUBLE:
+		* (gdouble *) raw = arg->v_double;
+		break;
+
+	    case GI_TYPE_TAG_INT:
+		* (gint *) raw = arg->v_int;
+		break;
+
+	    case GI_TYPE_TAG_UINT:
+		* (guint *) raw = arg->v_uint;
+		break;
+
+	    case GI_TYPE_TAG_LONG:
+		* (glong *) raw = arg->v_long;
+		break;
+
+	    case GI_TYPE_TAG_ULONG:
+		* (gulong *) raw = arg->v_ulong;
+		break;
+
+	    case GI_TYPE_TAG_ARRAY:
+	    case GI_TYPE_TAG_INTERFACE:
+	    case GI_TYPE_TAG_GLIST:
+	    case GI_TYPE_TAG_GSLIST:
+	    case GI_TYPE_TAG_GHASH:
+	    case GI_TYPE_TAG_ERROR:
+		* (gpointer *) raw = arg->v_pointer;
+		break;
+
+	    case GI_TYPE_TAG_SSIZE:
+		* (gssize *) raw = arg->v_ssize;
+		break;
+
+	    case GI_TYPE_TAG_SIZE:
+		* (gsize *) raw = arg->v_size;
+		break;
+
+	    case GI_TYPE_TAG_UTF8:
+	    case GI_TYPE_TAG_FILENAME:
+		* (gchar **) raw = arg->v_string;
+		break;
+
+	    default:
+		croak ("Unhandled info tag %d", tag);
+	}
+}
+
+static gpointer
+create_callback_closure (GITypeInfo *cb_type, SV *code)
+{
+	GITypeInfo *ret_info;
+	GICallableInfo *cb_interface;
+	GPerlI11nCallbackInfo *info;
+	ffi_cif *cif;
+	ffi_closure *closure;
+	ffi_type **arg_types;
+	ffi_type *ret_type;
+	gint n_args, i;
+
+	cb_interface = (GICallableInfo *) g_type_info_get_interface (cb_type);
+
+	info = g_new0 (GPerlI11nCallbackInfo, 1);
+	cif = g_new0 (ffi_cif, 1);
+	closure = g_new0 (ffi_closure, 1);
+
+	n_args = g_callable_info_get_n_args (cb_interface);
+	arg_types = g_new0 (ffi_type*, n_args);
+
+	/* lookup type of every arg */
+	for (i = 0; i < n_args; i++) {
+		GIArgInfo *arg_info;
+		GITypeInfo *arg_type;
+
+		arg_info = g_callable_info_get_arg (cb_interface, i);
+		arg_type = g_arg_info_get_type (arg_info);
+
+		arg_types[i] = get_ffi_type (arg_type);
+
+		g_base_info_unref ((GIBaseInfo *) arg_info);
+		g_base_info_unref ((GIBaseInfo *) arg_type);
+	}
+
+	/* lookup return type */
+	ret_info = g_callable_info_get_return_type (cb_interface);
+	ret_type = get_ffi_type (ret_info);
+	g_base_info_unref ((GIBaseInfo *) ret_info);
+
+	/* prepare callback interface */
+	if (FFI_OK != ffi_prep_cif (cif, FFI_DEFAULT_ABI, n_args, ret_type, arg_types))
+		croak ("Couldn't prepare callback interface");
+
+	/* prepare closure; put callback info struct into userdata slot */
+	if (FFI_OK != ffi_prep_closure (closure, cif, invoke_callback, info))
+		croak ("Couldn't prepare callback closure");
+
+	info->cif = cif;
+	info->closure = closure;
+	info->interface = (GIBaseInfo *) cb_interface;
+	info->code = newSVsv (code);
+
+#ifdef PERL_IMPLICIT_CONTEXT
+	info->priv = aTHX;
+#endif
+
+	current_callback_info = info;
+
+	return closure;
+}
+
+static gpointer
+create_callback_data (SV *data)
+{
+	GPerlI11nCallbackInfo *info = current_callback_info;
+
+	info->data = newSVsv (data);
+	current_callback_info = NULL;
+
+	return info;
+}
+
+static void
+invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata)
+{
+	GPerlI11nCallbackInfo *info;
+	GICallableInfo *cb_interface;
+	int n_args, i;
+	int in_inout;
+	GITypeInfo *return_type;
+	gboolean have_return_type;
+	int n_return_values;
+	I32 context;
+	dGPERL_CALLBACK_MARSHAL_SP;
+
+	/* unwrap callback info struct from userdata */
+	info = (GPerlI11nCallbackInfo *) userdata;
+	cb_interface = (GICallableInfo *) info->interface;
+
+	/* set perl context */
+	GPERL_CALLBACK_MARSHAL_INIT (info);
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK (SP);
+
+	/* find arguments; use type information from interface to find in and
+	 * in-out args and their types, count in-out and out args, and find
+	 * suitable converters; push in and in-out arguments onto the perl
+	 * stack */
+	in_inout = 0;
+	n_args = g_callable_info_get_n_args (cb_interface);
+	for (i = 0; i < n_args; i++) {
+		GIArgInfo *arg_info = g_callable_info_get_arg (cb_interface, i);
+		GITypeInfo *arg_type = g_arg_info_get_type (arg_info);
+		GITransfer transfer = g_arg_info_get_ownership_transfer (arg_info);
+		GIDirection direction = g_arg_info_get_direction (arg_info);
+
+		dwarn ("arg info: 0x%x\n"
+		       "  direction: %d\n"
+		       "  is dipper: %d\n"
+		       "  is return value: %d\n"
+		       "  is optional: %d\n"
+		       "  may be null: %d\n"
+		       "  transfer: %d\n",
+		       arg_info,
+		       g_arg_info_get_direction (arg_info),
+		       g_arg_info_is_dipper (arg_info),
+		       g_arg_info_is_return_value (arg_info),
+		       g_arg_info_is_optional (arg_info),
+		       g_arg_info_may_be_null (arg_info),
+		       g_arg_info_get_ownership_transfer (arg_info));
+
+		dwarn ("arg type: 0x%x\n"
+		       "  is pointer: %d\n"
+		       "  tag: %d\n",
+		       arg_type,
+		       g_type_info_is_pointer (arg_type),
+		       g_type_info_get_tag (arg_type));
+
+		if (direction == GI_DIRECTION_IN ||
+		    direction == GI_DIRECTION_INOUT)
+		{
+			GArgument arg;
+			raw_to_arg (args[i], &arg, arg_type);
+			XPUSHs (sv_2mortal (arg_to_sv (&arg, arg_type, transfer)));
+		}
+
+		if (direction == GI_DIRECTION_INOUT ||
+		    direction == GI_DIRECTION_OUT)
+		{
+			in_inout++;
+		}
+
+		g_base_info_unref ((GIBaseInfo *) arg_info);
+		g_base_info_unref ((GIBaseInfo *) arg_type);
+	}
+
+	/* push user data onto the Perl stack */
+	if (info->data)
+		XPUSHs (info->data);
+
+	PUTBACK;
+
+	/* determine suitable Perl call context; return_type is freed further
+	 * below */
+	return_type = g_callable_info_get_return_type (cb_interface);
+	have_return_type =
+		GI_TYPE_TAG_VOID != g_type_info_get_tag (return_type);
+
+	context = G_VOID | G_DISCARD;
+	if (have_return_type) {
+		context = in_inout > 0
+		  ? G_ARRAY
+		  : G_SCALAR;
+	} else {
+		if (in_inout == 1) {
+			context = G_SCALAR;
+		} else if (in_inout > 1) {
+			context = G_ARRAY;
+		}
+	}
+
+	/* do the call, demand #in-out+#out+#return-value return values */
+	n_return_values = have_return_type
+	  ? in_inout + 1
+	  : in_inout;
+	if (n_return_values == 0) {
+		call_sv (info->code, context);
+	} else {
+		int n_returned = call_sv (info->code, context);
+		if (n_returned != n_return_values) {
+			croak ("callback returned %d values "
+			       "but is supposed to return %d values",
+			       n_returned, n_return_values);
+		}
+	}
+
+	SPAGAIN;
+
+	/* convert in-out and out values and stuff them back into args */
+	if (in_inout > 0) {
+		SV **returned_values;
+		int out_index;
+
+		returned_values = g_new0 (SV *, in_inout);
+
+		/* pop scalars off the stack and put them into the array;
+		 * reverse the order since POPs pops items off of the end of
+		 * the stack. */
+		for (i = 0; i < in_inout; i++) {
+			/* FIXME: Does this leak the sv?  Should we check the
+			 * transfer setting? */
+			returned_values[in_inout - i - 1] = newSVsv (POPs);
+		}
+
+		out_index = 0;
+		for (i = 0; i < n_args; i++) {
+			GIArgInfo *arg_info = g_callable_info_get_arg (cb_interface, i);
+			GITypeInfo *arg_type = g_arg_info_get_type (arg_info);
+			GIDirection direction = g_arg_info_get_direction (arg_info);
+			gboolean may_be_null = g_arg_info_may_be_null (arg_info);
+
+			if (direction == GI_DIRECTION_INOUT ||
+			    direction == GI_DIRECTION_OUT)
+			{
+				GArgument tmp_arg;
+				sv_to_arg (returned_values[out_index], &tmp_arg, arg_type, may_be_null);
+				arg_to_raw (&tmp_arg, args[i], arg_type);
+				out_index++;
+			}
+		}
+
+		g_free (returned_values);
+	}
+
+	/* store return value in resp, if any */
+	if (have_return_type) {
+		GArgument arg;
+		GITypeInfo *info;
+		gboolean may_be_null;
+
+		info = g_callable_info_get_return_type (cb_interface);
+		may_be_null = g_callable_info_may_return_null (cb_interface);
+
+		dwarn ("ret type: 0x%x\n"
+		       "  is pointer: %d\n"
+		       "  tag: %d\n",
+		       info,
+		       g_type_info_is_pointer (info),
+		       g_type_info_get_tag (info));
+
+		/* FIXME: Does this leak the sv?  Should we check the transfer
+		 * setting? */
+		sv_to_arg (newSVsv (POPs), &arg, info, may_be_null);
+		arg_to_raw (&arg, resp, info);
+
+		g_base_info_unref ((GIBaseInfo *) info);
+	}
+
+	PUTBACK;
+
+	g_base_info_unref ((GIBaseInfo *) return_type);
+
+	FREETMPS;
+	LEAVE;
+}
+
+static void
+release_callback (gpointer data)
+{
+	GPerlI11nCallbackInfo *info = data;
+
+	if (info->cif)
+		g_free (info->cif);
+
+	if (info->closure)
+		g_free (info->closure);
+
+	if (info->interface)
+		g_base_info_unref (info->interface);
+
+
+	if (info->code)
+		SvREFCNT_dec (info->code);
+
+	if (info->data)
+		SvREFCNT_dec (info->data);
+
+	g_free (info);
+}
+
+/* ------------------------------------------------------------------------- */
+
+MODULE = Glib::Object::_Introspection	PACKAGE = Glib::Object::_Introspection
+
+void
+register_types (class, namespace, version, package)
+	const gchar *namespace
+	const gchar *version
+	const gchar *package
+    PREINIT:
+	GIRepository *repository;
+	GError *error = NULL;
+	gint number, i;
+    CODE:
+	repository = g_irepository_get_default ();
+	g_irepository_require (repository, namespace, version, 0, &error);
+	if (error) {
+		gperl_croak_gerror (NULL, error);
+	}
+
+	number = g_irepository_get_n_infos (repository, namespace);
+	for (i = 0; i < number; i++) {
+		GIBaseInfo *info;
+		GIInfoType info_type;
+		const gchar *name;
+		gchar *full_package;
+		GType type;
+
+		info = g_irepository_get_info (repository, namespace, i);
+		info_type = g_base_info_get_type (info);
+		name = g_base_info_get_name (info);
+
+		if (info_type != GI_INFO_TYPE_OBJECT &&
+		    info_type != GI_INFO_TYPE_INTERFACE &&
+		    info_type != GI_INFO_TYPE_BOXED &&
+		    info_type != GI_INFO_TYPE_STRUCT &&
+		    info_type != GI_INFO_TYPE_UNION &&
+		    info_type != GI_INFO_TYPE_ENUM &&
+		    info_type != GI_INFO_TYPE_FLAGS) {
+			g_base_info_unref ((GIBaseInfo *) info);
+			continue;
+		}
+
+		type = g_registered_type_info_get_g_type (
+			(GIRegisteredTypeInfo *) info);
+		if (!type)
+			croak ("Could not find GType for type %s::%s",
+			       namespace, name);
+
+		full_package = g_strconcat (package, "::", name, NULL);
+		dwarn ("registering %s, %d => %s\n",
+		       g_type_name (type), type,
+		       full_package);
+
+		/* FIXME: This is a hack to get our AUTOLOAD involved. */
+		if (info_type == GI_INFO_TYPE_OBJECT ||
+		    info_type == GI_INFO_TYPE_INTERFACE ||
+		    info_type == GI_INFO_TYPE_BOXED ||
+		    info_type == GI_INFO_TYPE_STRUCT ||
+		    info_type == GI_INFO_TYPE_UNION) {
+			gperl_set_isa (full_package, package);
+		}
+
+		switch (info_type) {
+		    case GI_INFO_TYPE_OBJECT:
+		    case GI_INFO_TYPE_INTERFACE:
+			gperl_register_object (type, full_package);
+			break;
+
+		    case GI_INFO_TYPE_BOXED:
+		    case GI_INFO_TYPE_STRUCT:
+		    case GI_INFO_TYPE_UNION:
+			gperl_register_boxed (type, full_package, NULL);
+			break;
+
+		    case GI_INFO_TYPE_ENUM:
+		    case GI_INFO_TYPE_FLAGS:
+			gperl_register_fundamental (type, full_package);
+			break;
+
+		    default:
+			break;
+		}
+
+		g_free (full_package);
+		g_base_info_unref ((GIBaseInfo *) info);
+	}
+
+void
+invoke (class, basename, namespace, method, ...)
+	const gchar *basename
+	const gchar_ornull *namespace
+	const gchar *method
+PREINIT:
+	int stack_offset = 4;
+
+	GIRepository *repository;
+	GIFunctionInfo *info;
+
+	ffi_cif cif;
+	ffi_type **arg_types = NULL;
+	ffi_type *return_type_ffi = NULL;
+	gpointer *args = NULL;
+	gpointer func_pointer = NULL, instance = NULL;
+	const gchar *symbol = NULL;
+
+	int have_args;
+	int n_args, n_invoke_args;
+	int n_in_args;
+	int n_out_args;
+	int i, out_i;
+	GITypeInfo ** out_arg_type = NULL;
+	GITypeInfo * return_type_info = NULL;
+	gboolean throws, is_constructor, is_method, has_return_value;
+	GArgument return_value;
+	GArgument * in_args = NULL;
+	GArgument * out_args = NULL;
+	GError * local_error = NULL;
+	gpointer local_error_address = &local_error;
+PPCODE:
+	repository = g_irepository_get_default ();
+	info = get_function_info (repository, basename, namespace, method);
+	symbol = g_function_info_get_symbol (info);
+
+	if (!g_typelib_symbol (g_base_info_get_typelib((GIBaseInfo *) info),
+			       symbol, &func_pointer))
+	{
+		croak ("Could not locate symbol %s", symbol);
+	}
+
+	is_constructor =
+		g_function_info_get_flags (info) & GI_FUNCTION_IS_CONSTRUCTOR;
+	if (is_constructor) {
+		stack_offset++;
+	}
+
+	have_args = items - stack_offset;
+
+	n_invoke_args = n_args = g_callable_info_get_n_args ((GICallableInfo *) info);
+
+	throws = g_function_info_get_flags (info) & GI_FUNCTION_THROWS;
+	if (throws) {
+		n_invoke_args++;
+	}
+
+	is_method =
+		(g_function_info_get_flags (info) & GI_FUNCTION_IS_METHOD)
+	    && !is_constructor;
+	if (is_method) {
+		n_invoke_args++;
+	}
+
+	dwarn ("invoke: %s -> n_args %d, n_invoke_args %d, have_args %d\n",
+	       symbol, n_args, n_invoke_args, have_args);
+
+	/* to allow us to make only one pass through the arg list, allocate
+	 * enough space for all args in both the out and in lists.  we'll
+	 * only use as much as we need.  since function argument lists are
+	 * typically small, this shouldn't be a big problem. */
+	if (n_invoke_args) {
+		in_args = gperl_alloc_temp (sizeof (GArgument) * n_invoke_args);
+		out_args = gperl_alloc_temp (sizeof (GArgument) * n_invoke_args);
+		out_arg_type = gperl_alloc_temp (sizeof (GITypeInfo*) * n_invoke_args);
+
+		arg_types = gperl_alloc_temp (sizeof (ffi_type *) * n_invoke_args);
+		args = gperl_alloc_temp (sizeof (gpointer) * n_invoke_args);
+	}
+
+	n_in_args = n_out_args = 0;
+
+	if (is_method) {
+		instance = instance_sv_to_pointer (info, ST (0 + stack_offset));
+		arg_types[0] = &ffi_type_pointer;
+		args[0] = &instance;
+		n_in_args++;
+	}
+
+	int method_offset = is_method ? 1 : 0;
+
+	for (i = 0 ; i < n_args ; i++) {
+		GIArgInfo * arg_info =
+			g_callable_info_get_arg ((GICallableInfo *) info, i);
+		/* In case of out and in-out args, arg_type is unref'ed after
+		 * the function has been invoked */
+		GITypeInfo * arg_type = g_arg_info_get_type (arg_info);
+		gboolean may_be_null = g_arg_info_may_be_null (arg_info);
+
+		dwarn ("  arg tag: %s (%d)\n",
+		       g_type_tag_to_string (g_type_info_get_tag (arg_type)),
+		       g_type_info_get_tag (arg_type));
+
+		switch (g_arg_info_get_direction (arg_info)) {
+		    case GI_DIRECTION_IN:
+			sv_to_arg (ST (i + method_offset + stack_offset), &in_args[n_in_args], arg_type, may_be_null);
+			arg_types[i + method_offset] = get_ffi_type (arg_type);
+			args[i + method_offset] = &in_args[n_in_args];
+			g_base_info_unref ((GIBaseInfo *) arg_type);
+			n_in_args++;
+			break;
+		    case GI_DIRECTION_OUT:
+			out_args[n_out_args].v_pointer =
+				gperl_alloc_temp (sizeof (GArgument));
+			out_arg_type[n_out_args] = arg_type;
+			arg_types[i + method_offset] = &ffi_type_pointer;
+			args[i + method_offset] = &out_args[n_out_args];
+			n_out_args++;
+			break;
+		    case GI_DIRECTION_INOUT:
+		    {
+			GArgument * temp =
+				gperl_alloc_temp (sizeof (GArgument));
+			sv_to_arg (ST (i + method_offset + stack_offset), temp, arg_type, may_be_null);
+			in_args[n_in_args].v_pointer =
+				out_args[n_out_args].v_pointer =
+					temp;
+			out_arg_type[n_out_args] = arg_type;
+			arg_types[i + method_offset] = &ffi_type_pointer;
+			args[i + method_offset] = &in_args[n_in_args];
+			n_in_args++;
+			n_out_args++;
+		    }
+			break;
+		}
+
+		g_base_info_unref ((GIBaseInfo *) arg_info);
+	}
+
+	if (throws) {
+		args[n_invoke_args - 1] = &local_error_address;
+		arg_types[n_invoke_args - 1] = &ffi_type_pointer;
+	}
+
+	/* find the return value type */
+	return_type_info = g_callable_info_get_return_type ((GICallableInfo *) info);
+	return_type_ffi = get_ffi_type (return_type_info);
+
+	/* prepare and call the function */
+	if (FFI_OK != ffi_prep_cif (&cif, FFI_DEFAULT_ABI, n_invoke_args,
+	   	      		    return_type_ffi, arg_types))
+	{
+		g_base_info_unref ((GIBaseInfo *) return_type_info);
+		croak ("Could not prepare a call interface for %s", symbol);
+	}
+
+	ffi_call (&cif, func_pointer, &return_value, args);
+
+	if (local_error) {
+		gperl_croak_gerror (NULL, local_error);
+	}
+
+	/*
+	 * place return value and output args on the stack
+	 */
+	has_return_value = GI_TYPE_TAG_VOID != g_type_info_get_tag (return_type_info);
+	if (has_return_value) {
+		GITransfer return_type_transfer =
+			g_callable_info_get_caller_owns ((GICallableInfo *) info);
+		SV *value = arg_to_sv (&return_value,
+		                       return_type_info,
+		                       return_type_transfer);
+		if (value)
+			XPUSHs (sv_2mortal (value));
+	}
+
+	g_base_info_unref ((GIBaseInfo *) return_type_info);
+
+	/* out args */
+	for (i = out_i = 0 ; i < n_args ; i++) {
+		GIArgInfo * arg_info =
+			g_callable_info_get_arg ((GICallableInfo *) info, i);
+
+		switch (g_arg_info_get_direction (arg_info)) {
+		    case GI_DIRECTION_OUT:
+		    case GI_DIRECTION_INOUT:
+		    {
+			GITransfer transfer = g_arg_info_get_ownership_transfer (arg_info);
+			SV *sv = arg_to_sv (out_args[out_i].v_pointer, out_arg_type[out_i], transfer);
+			if (sv)
+				XPUSHs (sv_2mortal (sv));
+			g_base_info_unref ((GIBaseInfo*) out_arg_type[out_i]);
+		    }
+			out_i++;
+			break;
+		    default:
+			break;
+		}
+
+		g_base_info_unref ((GIBaseInfo *) arg_info);
+	}
+
+	if (has_return_value)
+		out_i++;
+
+	if (out_i == 0) {
+		XSRETURN_EMPTY;
+	} else if (out_i == 1) {
+		XSRETURN (1);
+	} else {
+		PUTBACK;
+		return;
+	}
diff --git a/Glib.xs b/Glib.xs
index fdbbda0..4fe8aff 100644
--- a/Glib.xs
+++ b/Glib.xs
@@ -405,6 +405,9 @@ BOOT:
 #if GLIB_CHECK_VERSION (2, 12, 0)
 	GPERL_CALL_BOOT (boot_Glib__BookmarkFile);
 #endif /* GLIB_CHECK_VERSION (2, 12, 0) */
+#if 1 /* FIXME */
+	GPERL_CALL_BOOT (boot_Glib__Object___Introspection);
+#endif
 	/* make sure that we're running/linked against a version at least as 
 	 * new as we built against, otherwise bad things will happen. */
 	if ((((int)glib_major_version) < GLIB_MAJOR_VERSION)
diff --git a/Makefile.PL b/Makefile.PL
index 5b4707d..6754870 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -57,7 +57,7 @@ mkdir 'build', 0777;
 # If the package can't be found, warn and exit with status 0 to indicate to
 # CPAN testers that their system is not supported.
 my %glibcfg;
-unless (eval { %glibcfg = ExtUtils::PkgConfig->find ("gobject-2.0 >= $build_reqs{Glib}");
+unless (eval { %glibcfg = ExtUtils::PkgConfig->find ("gobject-2.0 >= $build_reqs{Glib} gobject-introspection-1.0"); #FIXME
 	       1; })
 {
 	warn $@;
@@ -92,6 +92,11 @@ if (ExtUtils::PkgConfig->atleast_version ('glib-2.0', '2.12.0')) {
 	push @xs_files, 'GBookmarkFile.xs';
 }
 
+# FIXME
+if (1) {
+	push @xs_files, 'GObjectIntrospection.xs';
+}
+
 our %pm_files = (
      'lib/Glib.pm'                 => '$(INST_LIBDIR)/Glib.pm',
      'lib/Glib/Object/Subclass.pm' => '$(INST_LIBDIR)/Glib/Object/Subclass.pm',
diff --git a/lib/Glib.pm b/lib/Glib.pm
index 6576e53..c27e8ac 100644
--- a/lib/Glib.pm
+++ b/lib/Glib.pm
@@ -215,6 +215,63 @@ sub AUTOLOAD {
 	return $object_or_type->$method (@_);
 }
 
+package Glib::Object::_Introspection;
+
+use strict;
+
+sub find_registered_namespace {
+  my ($class, $namespace) = @_;
+
+  # replace the prefix for unregistered types
+  while ($namespace =~ m/^Glib::Object::_Unregistered::\w+/) {
+    no strict 'refs';
+    my @parents = @{$namespace . '::ISA'};
+    $namespace = $parents[-1];
+  }
+
+  return $namespace;
+}
+
+package Glib::IO;
+
+use strict;
+use Carp;
+
+our $BASENAME = 'Gio';
+our $VERSION = '2.0';
+our $PACKAGE = 'Glib::IO';
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+  my $symbol = $AUTOLOAD;
+  my (@args) = @_;
+
+  # 'namespace::method' or just 'method'
+  if ($symbol =~ m/(?:(.+)::)?(.+)/) {
+    my $namespace = $1;
+    my $method = $2;
+
+    if (defined $namespace) {
+      $namespace = Glib::Object::_Introspection->find_registered_namespace (
+        $namespace);
+
+      # strip off the normal prefix
+      $namespace =~ s/^${PACKAGE}(?:::)?//;
+      $namespace = undef if $namespace eq '';
+    }
+
+    return Glib::Object::_Introspection->invoke(
+      $BASENAME, $namespace, $method, @args);
+  }
+
+  croak "Invalid invocation: Cannot handle $symbol";
+}
+
+sub setup {
+  Glib::Object::_Introspection->register_types($BASENAME, $VERSION, $PACKAGE);
+}
+
 package Glib;
 
 1;



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]