1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
/* 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 ("%s: pointer %p\n", G_STRFUNC, pointer);
if (pointer == NULL) {
return &PL_sv_undef;
}
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);
/* 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);
}
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 ("%s: sv %p\n", G_STRFUNC, 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: %d\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);
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;
}
|
