static gpointer sv_to_callback (GIArgInfo * arg_info, GITypeInfo * type_info, SV * sv, GPerlI11nInvocationInfo * invocation_info) { GIBaseInfo *callback_interface_info; GPerlI11nPerlCallbackInfo *callback_info; GIScopeType scope; /* the destroy notify func is handled by _handle_automatic_arg */ dwarn (" Perl callback at %d (%s)\n", invocation_info->current_pos, g_base_info_get_name (arg_info)); callback_interface_info = g_type_info_get_interface (type_info); callback_info = create_perl_callback_closure (callback_interface_info, sv); callback_info->data_pos = g_arg_info_get_closure (arg_info); callback_info->destroy_pos = g_arg_info_get_destroy (arg_info); callback_info->free_after_use = FALSE; g_base_info_unref (callback_interface_info); dwarn (" Perl callback data at %d, destroy at %d\n", callback_info->data_pos, callback_info->destroy_pos); scope = (!gperl_sv_is_defined (sv)) ? GI_SCOPE_TYPE_CALL : g_arg_info_get_scope (arg_info); switch (scope) { case GI_SCOPE_TYPE_CALL: dwarn (" Perl callback has scope 'call'\n"); free_after_call (invocation_info, (GFunc) release_perl_callback, callback_info); break; case GI_SCOPE_TYPE_NOTIFIED: dwarn (" Perl callback has scope 'notified'\n"); /* This case is already taken care of by the notify * stuff above */ break; case GI_SCOPE_TYPE_ASYNC: dwarn (" Perl callback has scope 'async'\n"); /* FIXME: callback_info->free_after_use = TRUE; */ break; default: ccroak ("unhandled scope type %d encountered", g_arg_info_get_scope (arg_info)); } invocation_info->callback_infos = g_slist_prepend (invocation_info->callback_infos, callback_info); dwarn (" returning Perl closure %p from info %p\n", callback_info->closure, callback_info); return callback_info->closure; }
/* transfer and may_be_null can be gotten from arg_info, but sv_to_arg is also * called from places which don't have access to a GIArgInfo. */ static void sv_to_arg (SV * sv, GIArgument * arg, GIArgInfo * arg_info, GITypeInfo * type_info, GITransfer transfer, gboolean may_be_null, GPerlI11nInvocationInfo * invocation_info) { GITypeTag tag = g_type_info_get_tag (type_info); if (!gperl_sv_is_defined (sv)) /* Interfaces and void types need to be able to handle undef * separately. */ if (!may_be_null && tag != GI_TYPE_TAG_INTERFACE && tag != GI_TYPE_TAG_VOID) { if (arg_info) { ccroak ("undefined value for mandatory argument '%s' encountered", g_base_info_get_name ((GIBaseInfo *) arg_info)); } else { ccroak ("undefined value encountered"); } } switch (tag) { case GI_TYPE_TAG_VOID: /* returns NULL if no match is found */ arg->v_pointer = sv_to_callback_data (sv, invocation_info); 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_UNICHAR: arg->v_uint32 = g_utf8_get_char (SvGChar (sv)); break; case GI_TYPE_TAG_GTYPE: /* GType == gsize */ arg->v_size = gperl_type_from_package (SvPV_nolen (sv)); if (!arg->v_size) arg->v_size = g_type_from_name (SvPV_nolen (sv)); break; case GI_TYPE_TAG_ARRAY: arg->v_pointer = sv_to_array (transfer, type_info, sv, invocation_info); break; case GI_TYPE_TAG_INTERFACE: dwarn (" type %p -> interface\n", type_info); sv_to_interface (arg_info, type_info, transfer, may_be_null, sv, arg, invocation_info); break; case GI_TYPE_TAG_GLIST: case GI_TYPE_TAG_GSLIST: arg->v_pointer = sv_to_glist (transfer, type_info, sv); break; case GI_TYPE_TAG_GHASH: arg->v_pointer = sv_to_ghash (transfer, type_info, sv); break; case GI_TYPE_TAG_ERROR: ccroak ("FIXME - A GError as an in/inout arg? Should never happen!"); break; case GI_TYPE_TAG_UTF8: arg->v_string = gperl_sv_is_defined (sv) ? SvGChar (sv) : NULL; if (transfer >= GI_TRANSFER_CONTAINER) arg->v_string = g_strdup (arg->v_string); break; case GI_TYPE_TAG_FILENAME: /* FIXME: Should we use SvPVbyte_nolen here? */ arg->v_string = gperl_sv_is_defined (sv) ? SvPV_nolen (sv) : NULL; if (transfer >= GI_TRANSFER_CONTAINER) arg->v_string = g_strdup (arg->v_string); break; default: ccroak ("Unhandled info tag %d in sv_to_arg", tag); } }
static SV * arg_to_sv (GIArgument * arg, GITypeInfo * info, GITransfer transfer, GPerlI11nInvocationInfo *iinfo) { GITypeTag tag = g_type_info_get_tag (info); gboolean own = transfer >= GI_TRANSFER_CONTAINER; dwarn (" arg_to_sv: info %p with type tag %d (%s)\n", info, tag, g_type_tag_to_string (tag)); switch (tag) { case GI_TYPE_TAG_VOID: { SV *sv = callback_data_to_sv (arg->v_pointer, iinfo); dwarn (" argument with no type information -> %s\n", sv ? "callback data" : "undef"); return sv ? SvREFCNT_inc (sv) : &PL_sv_undef; } 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_UNICHAR: { SV *sv; gchar buffer[6]; gint length = g_unichar_to_utf8 (arg->v_uint32, buffer); sv = newSVpv (buffer, length); SvUTF8_on (sv); return sv; } case GI_TYPE_TAG_GTYPE: { /* GType == gsize */ const char *package = gperl_package_from_type (arg->v_size); if (!package) package = g_type_name (arg->v_size); return newSVpv (package, PL_na); } case GI_TYPE_TAG_ARRAY: return array_to_sv (info, arg->v_pointer, transfer, iinfo); case GI_TYPE_TAG_INTERFACE: return interface_to_sv (info, arg, own, iinfo); case GI_TYPE_TAG_GLIST: case GI_TYPE_TAG_GSLIST: return glist_to_sv (info, arg->v_pointer, transfer); case GI_TYPE_TAG_GHASH: return ghash_to_sv (info, arg->v_pointer, transfer); case GI_TYPE_TAG_ERROR: ccroak ("FIXME - GI_TYPE_TAG_ERROR"); break; 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 = newSVpv (arg->v_string, PL_na); if (own) g_free (arg->v_string); return sv; } default: ccroak ("Unhandled info tag %d in arg_to_sv", tag); } return NULL; }
static void arg_to_raw (GIArgument *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: case GI_TYPE_TAG_UNICHAR: * (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_GTYPE: * (GType *) raw = arg->v_size; 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_UTF8: case GI_TYPE_TAG_FILENAME: * (gchar **) raw = arg->v_string; break; default: ccroak ("Unhandled info tag %d in arg_to_raw", tag); } }
static void raw_to_arg (gpointer raw, GIArgument *arg, GITypeInfo *info) { GITypeTag tag = g_type_info_get_tag (info); switch (tag) { case GI_TYPE_TAG_VOID: if (g_type_info_is_pointer (info)) { arg->v_pointer = CAST_RAW (raw, gpointer); } else { /* 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: case GI_TYPE_TAG_UNICHAR: 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_GTYPE: arg->v_size = CAST_RAW (raw, GType); 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 = CAST_RAW (raw, gpointer); break; case GI_TYPE_TAG_UTF8: case GI_TYPE_TAG_FILENAME: arg->v_string = CAST_RAW (raw, gchar*); break; default: ccroak ("Unhandled info tag %d in raw_to_arg", tag); } }
static void invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata) { GPerlI11nPerlCallbackInfo *info; GICallableInfo *cb_interface; GPerlI11nInvocationInfo iinfo = {0,}; guint i; guint in_inout; guint n_return_values, n_returned; I32 context; dGPERL_CALLBACK_MARSHAL_SP; PERL_UNUSED_VAR (cif); /* unwrap callback info struct from userdata */ info = (GPerlI11nPerlCallbackInfo *) userdata; cb_interface = (GICallableInfo *) info->interface; prepare_perl_invocation_info (&iinfo, cb_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; for (i = 0; i < iinfo.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); iinfo.current_pos = i; /* the closure argument, which we handle separately, is marked * by having get_closure == i */ if (g_arg_info_get_closure (arg_info) == (gint) i) { g_base_info_unref ((GIBaseInfo *) arg_info); g_base_info_unref ((GIBaseInfo *) arg_type); continue; } dwarn ("arg info: %s (%p)\n" " direction: %d\n" " is return value: %d\n" " is optional: %d\n" " may be null: %d\n" " transfer: %d\n", g_base_info_get_name (arg_info), arg_info, g_arg_info_get_direction (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: %p\n" " is pointer: %d\n" " tag: %s (%d)\n", arg_type, g_type_info_is_pointer (arg_type), g_type_tag_to_string (g_type_info_get_tag (arg_type)), g_type_info_get_tag (arg_type)); if (direction == GI_DIRECTION_IN || direction == GI_DIRECTION_INOUT) { GIArgument arg; SV *sv; raw_to_arg (args[i], &arg, arg_type); sv = arg_to_sv (&arg, arg_type, transfer, &iinfo); /* If arg_to_sv returns NULL, we take that as 'skip * this argument'; happens for GDestroyNotify, for * example. */ if (sv) XPUSHs (sv_2mortal (sv)); } 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 (sv_2mortal (SvREFCNT_inc (info->data))); PUTBACK; /* determine suitable Perl call context */ context = G_VOID | G_DISCARD; if (iinfo.has_return_value) { 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 = iinfo.has_return_value ? in_inout + 1 : in_inout; n_returned = info->sub_name ? call_method (info->sub_name, context) : call_sv (info->code, context); if (n_return_values != 0 && n_returned != n_return_values) { ccroak ("callback returned %d values " "but is supposed to return %d values", n_returned, n_return_values); } /* call-scoped callback infos are freed by * Glib::Object::Introspection::_FuncWrapper::DESTROY */ 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++) { returned_values[in_inout - i - 1] = POPs; } out_index = 0; for (i = 0; i < iinfo.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); gpointer out_pointer = * (gpointer *) args[i]; if (!out_pointer) { dwarn ("skipping out arg %d\n", i); g_base_info_unref (arg_info); g_base_info_unref (arg_type); continue; } if (direction == GI_DIRECTION_INOUT || direction == GI_DIRECTION_OUT) { GIArgument tmp_arg; GITransfer transfer = g_arg_info_get_ownership_transfer (arg_info); gboolean may_be_null = g_arg_info_may_be_null (arg_info); gboolean is_caller_allocated = g_arg_info_is_caller_allocates (arg_info); if (is_caller_allocated) { tmp_arg.v_pointer = out_pointer; } sv_to_arg (returned_values[out_index], &tmp_arg, arg_info, arg_type, transfer, may_be_null, &iinfo); if (!is_caller_allocated) { arg_to_raw (&tmp_arg, out_pointer, arg_type); } out_index++; } g_base_info_unref (arg_info); g_base_info_unref (arg_type); } g_free (returned_values); }
static gpointer sv_to_ghash (GITransfer transfer, GITypeInfo *type_info, SV *sv) { HV *hv; HE *he; GITransfer item_transfer; gpointer hash; GITypeInfo *key_param_info, *value_param_info; GITypeTag key_type_tag; GHashFunc hash_func; GEqualFunc equal_func; I32 n_keys; dwarn ("%s: sv %p\n", G_STRFUNC, sv); if (!gperl_sv_is_defined (sv)) return NULL; if (!gperl_sv_is_hash_ref (sv)) ccroak ("need an hash ref to convert to GHashTable"); hv = (HV *) SvRV (sv); item_transfer = GI_TRANSFER_NOTHING; switch (transfer) { case GI_TRANSFER_EVERYTHING: item_transfer = GI_TRANSFER_EVERYTHING; break; case GI_TRANSFER_CONTAINER: /* nothing special to do */ break; case GI_TRANSFER_NOTHING: /* FIXME: need to free hash after call */ break; } key_param_info = g_type_info_get_param_type (type_info, 0); value_param_info = g_type_info_get_param_type (type_info, 1); key_type_tag = g_type_info_get_tag (key_param_info); switch (key_type_tag) { case GI_TYPE_TAG_FILENAME: case GI_TYPE_TAG_UTF8: hash_func = g_str_hash; equal_func = g_str_equal; break; default: hash_func = NULL; equal_func = NULL; break; } dwarn (" GHashTable with transfer %d\n" " key_param_info %p with type tag %d (%s)\n" " value_param_info %p with type tag %d (%s)\n", transfer, key_param_info, g_type_info_get_tag (key_param_info), g_type_tag_to_string (g_type_info_get_tag (key_param_info)), value_param_info, g_type_info_get_tag (value_param_info), g_type_tag_to_string (g_type_info_get_tag (value_param_info))); hash = g_hash_table_new (hash_func, equal_func); n_keys = hv_iterinit (hv); if (n_keys == 0) goto out; while ((he = hv_iternext (hv)) != NULL) { SV *sv; GIArgument arg = { 0, }; gpointer key_p, value_p; key_p = value_p = NULL; sv = hv_iterkeysv (he); if (sv && gperl_sv_is_defined (sv)) { dwarn (" converting key SV %p\n", sv); /* FIXME: Is it OK to always allow undef here? */ sv_to_arg (sv, &arg, NULL, key_param_info, item_transfer, TRUE, NULL); key_p = arg.v_pointer; } sv = hv_iterval (hv, he); if (sv && gperl_sv_is_defined (sv)) { dwarn (" converting value SV %p\n", sv); sv_to_arg (sv, &arg, NULL, key_param_info, item_transfer, TRUE, NULL); value_p = arg.v_pointer; } if (key_p != NULL && value_p != NULL) g_hash_table_insert (hash, key_p, value_p); } out: dwarn (" -> hash %p of size %d\n", hash, g_hash_table_size (hash)); g_base_info_unref ((GIBaseInfo *) key_param_info); g_base_info_unref ((GIBaseInfo *) value_param_info); return hash; }
static gpointer sv_to_struct (GITransfer transfer, GIBaseInfo * info, GIInfoType info_type, SV * sv) { HV *hv; gsize size = 0; GITransfer field_transfer; gpointer pointer = NULL; dwarn ("sv = %p\n", sv); if (!gperl_sv_is_defined (sv)) return NULL; if (is_struct_disguised (info)) { gchar *package; dwarn (" disguised struct\n"); package = get_struct_package (info); g_assert (package); if (!gperl_sv_is_ref (sv) || !sv_derived_from (sv, package)) ccroak ("Cannot convert scalar %p to an object of type %s", sv, package); g_free (package); return INT2PTR (void *, SvIV ((SV *) SvRV (sv))); } if (!gperl_sv_is_hash_ref (sv)) ccroak ("need a hash ref to convert to struct of type %s", g_base_info_get_name (info)); hv = (HV *) SvRV (sv); switch (info_type) { case GI_INFO_TYPE_BOXED: case GI_INFO_TYPE_STRUCT: size = g_struct_info_get_size ((GIStructInfo *) info); break; case GI_INFO_TYPE_UNION: size = g_union_info_get_size ((GIStructInfo *) info); break; default: g_assert_not_reached (); } dwarn (" size = %"G_GSIZE_FORMAT"\n", size); field_transfer = GI_TRANSFER_NOTHING; dwarn (" transfer = %d\n", transfer); switch (transfer) { case GI_TRANSFER_EVERYTHING: field_transfer = GI_TRANSFER_EVERYTHING; /* fall through */ case GI_TRANSFER_CONTAINER: /* FIXME: What if there's a special allocator for the record? * Like GSlice? */ pointer = g_malloc0 (size); break; default: pointer = gperl_alloc_temp (size); break; } switch (info_type) { case GI_INFO_TYPE_BOXED: case GI_INFO_TYPE_STRUCT: { gint i, n_fields = g_struct_info_get_n_fields ((GIStructInfo *) info); for (i = 0; i < n_fields; i++) { GIFieldInfo *field_info; const gchar *field_name; SV **svp; field_info = g_struct_info_get_field ( (GIStructInfo *) info, i); /* FIXME: Check GIFieldInfoFlags. */ field_name = g_base_info_get_name ( (GIBaseInfo *) field_info); dwarn (" field %d (%s)\n", i, field_name); svp = hv_fetch (hv, field_name, strlen (field_name), 0); if (svp && gperl_sv_is_defined (*svp)) { set_field (field_info, pointer, field_transfer, *svp); } g_base_info_unref ((GIBaseInfo *) field_info); } break; } case GI_INFO_TYPE_UNION: ccroak ("%s: unions not handled yet", G_STRFUNC); default: ccroak ("%s: unhandled info type %d", G_STRFUNC, info_type); } return pointer; }
/* This may call Perl code (via get_field), so it needs to be wrapped with * PUTBACK/SPAGAIN by the caller. */ static SV * struct_to_sv (GIBaseInfo* info, GIInfoType info_type, gpointer pointer, gboolean own) { HV *hv; dwarn ("pointer = %p\n", pointer); if (pointer == NULL) { return &PL_sv_undef; } if (is_struct_disguised (info)) { SV *sv; gchar *package; dwarn (" disguised struct\n"); g_assert (!own); package = get_struct_package (info); g_assert (package); sv = newSV (0); sv_setref_pv (sv, package, pointer); g_free (package); return sv; } hv = newHV (); switch (info_type) { case GI_INFO_TYPE_BOXED: case GI_INFO_TYPE_STRUCT: { gint i, n_fields = g_struct_info_get_n_fields ((GIStructInfo *) info); for (i = 0; i < n_fields; i++) { GIFieldInfo *field_info; SV *sv; field_info = g_struct_info_get_field ((GIStructInfo *) info, i); dwarn (" field %d (%s)\n", i, g_base_info_get_name (field_info)); /* FIXME: Check GIFieldInfoFlags. */ /* FIXME: Is it right to use GI_TRANSFER_NOTHING * here? */ sv = get_field (field_info, pointer, GI_TRANSFER_NOTHING); if (gperl_sv_is_defined (sv)) { const gchar *name; name = g_base_info_get_name ( (GIBaseInfo *) field_info); gperl_hv_take_sv (hv, name, strlen (name), sv); } g_base_info_unref ((GIBaseInfo *) field_info); } break; } case GI_INFO_TYPE_UNION: ccroak ("%s: unions not handled yet", G_STRFUNC); default: ccroak ("%s: unhandled info type %d", G_STRFUNC, info_type); } if (own) { /* FIXME: Is it correct to just call g_free here? What if the * thing was allocated via GSlice? */ g_free (pointer); } return newRV_noinc ((SV *) hv); }