gperl-i11n-marshal-hash.c 4.37 KB
Newer Older
1 2
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */

3 4
/* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
 * PUTBACK/SPAGAIN by the caller. */
5 6 7 8 9 10 11
static SV *
ghash_to_sv (GITypeInfo *info,
             gpointer pointer,
             GITransfer transfer)
{
	GITypeInfo *key_param_info, *value_param_info;
#ifdef NOISY
12
	GITypeTag key_type_tag, value_type_tag;
13
#endif
14
	gpointer key_p, value_p;
15 16 17 18
	GITransfer item_transfer;
	GHashTableIter iter;
	HV *hv;

19 20
	dwarn ("pointer = %p\n", pointer);

21 22 23 24 25
	if (pointer == NULL) {
		return &PL_sv_undef;
	}

	item_transfer = transfer == GI_TRANSFER_EVERYTHING
26 27
	              ? GI_TRANSFER_EVERYTHING
	              : GI_TRANSFER_NOTHING;
28 29

	key_param_info = g_type_info_get_param_type (info, 0);
30
	value_param_info = g_type_info_get_param_type (info, 1);
31 32

#ifdef NOISY
33 34
	key_type_tag = g_type_info_get_tag (key_param_info);
	value_type_tag = g_type_info_get_tag (value_param_info);
35 36
#endif

37
	dwarn ("  key tag = %d (%s), value tag = %d (%s)\n",
38 39 40 41 42
	       key_type_tag, g_type_tag_to_string (key_type_tag),
	       value_type_tag, g_type_tag_to_string (value_type_tag));

	hv = newHV ();

43 44
	g_hash_table_iter_init (&iter, pointer);
	while (g_hash_table_iter_next (&iter, &key_p, &value_p)) {
45
		GIArgument arg = { 0, };
46
		SV *key_sv, *value_sv;
47

48
		dwarn ("  key pointer %p\n", key_p);
49 50 51 52 53
		arg.v_pointer = key_p;
		key_sv = arg_to_sv (&arg, key_param_info, item_transfer, NULL);
		if (key_sv == NULL)
                        break;

54
		dwarn ("  value pointer %p\n", value_p);
55 56 57 58
		arg.v_pointer = value_p;
		value_sv = arg_to_sv (&arg, value_param_info, item_transfer, NULL);
		if (value_sv == NULL)
			break;
59

60
		(void) hv_store_ent (hv, key_sv, value_sv, 0);
61 62 63
	}

	g_base_info_unref ((GIBaseInfo *) key_param_info);
64
	g_base_info_unref ((GIBaseInfo *) value_param_info);
65 66 67 68 69 70 71 72 73 74

	return newRV_noinc ((SV *) hv);
}

static gpointer
sv_to_ghash (GITransfer transfer,
             GITypeInfo *type_info,
             SV *sv)
{
	HV *hv;
75
	HE *he;
76 77 78
	GITransfer item_transfer;
	gpointer hash;
	GITypeInfo *key_param_info, *value_param_info;
79 80 81 82
	GITypeTag key_type_tag;
	GHashFunc hash_func;
	GEqualFunc equal_func;
	I32 n_keys;
83

84
	dwarn ("sv = %p\n", sv);
85

86
	if (!gperl_sv_is_defined (sv))
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
		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);
108
	value_param_info = g_type_info_get_param_type (type_info, 1);
109

110
	key_type_tag = g_type_info_get_tag (key_param_info);
111

112 113 114 115 116 117
	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;
118

119 120 121 122 123
	    default:
		hash_func = NULL;
		equal_func = NULL;
		break;
	}
124

125
	dwarn ("  transfer = %d, key info = %p, key tag = %d (%s), value info = %p, value tag = %d (%s)\n",
126
	       transfer,
127 128 129 130 131 132 133
	       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)));

134
	hash = g_hash_table_new (hash_func, equal_func);
135

136 137 138
	n_keys = hv_iterinit (hv);
	if (n_keys == 0)
		goto out;
139

140 141 142 143
	while ((he = hv_iternext (hv)) != NULL) {
		SV *sv;
		GIArgument arg = { 0, };
		gpointer key_p, value_p;
144

145
		key_p = value_p = NULL;
146

147
		sv = hv_iterkeysv (he);
148
		dwarn ("  key SV %p\n", sv);
149 150 151 152
		if (sv && gperl_sv_is_defined (sv)) {
			/* FIXME: Is it OK to always allow undef here? */
			sv_to_arg (sv, &arg, NULL, key_param_info,
			           item_transfer, TRUE, NULL);
153
			key_p = arg.v_pointer;
154 155
		}

156
		sv = hv_iterval (hv, he);
157
		dwarn ("  value SV %p\n", sv);
158 159 160 161 162
		if (sv && gperl_sv_is_defined (sv)) {
			sv_to_arg (sv, &arg, NULL, key_param_info,
			           item_transfer, TRUE, NULL);
			value_p = arg.v_pointer;
		}
163

164 165
		if (key_p != NULL && value_p != NULL)
			g_hash_table_insert (hash, key_p, value_p);
166 167 168
	}

out:
169
	dwarn ("  -> hash %p of size %d\n", hash, g_hash_table_size (hash));
170

171
	g_base_info_unref ((GIBaseInfo *) key_param_info);
172 173 174 175
	g_base_info_unref ((GIBaseInfo *) value_param_info);

	return hash;
}