/* * returns a pointer to a temp stock item you can use until control returns * to perl. */ static GtkStockItem * SvGtkStockItem (SV * sv) { HV * hv; SV ** svp; GtkStockItem * item; if (!gperl_sv_is_hash_ref (sv)) croak ("malformed stock item; use a reference to a hash as a stock item"); hv = (HV*) SvRV (sv); item = gperl_alloc_temp (sizeof (GtkStockItem)); svp = hv_fetch (hv, "stock_id", 8, FALSE); if (svp) item->stock_id = SvGChar (*svp); svp = hv_fetch (hv, "label", 5, FALSE); if (svp) item->label = SvGChar (*svp); svp = hv_fetch (hv, "modifier", 8, FALSE); if (svp) item->modifier = SvGdkModifierType (*svp); svp = hv_fetch (hv, "keyval", 6, FALSE); if (svp) item->keyval = SvUV (*svp); svp = hv_fetch (hv, "translation_domain", 18, FALSE); if (svp) item->translation_domain = SvGChar (*svp); return item; }
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; }