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

3 4 5
static void
free_list (GList *list)
{
6
	dwarn ("%p\n", list);
7 8 9 10 11 12
	g_list_free (list);
}

static void
free_slist (GSList *list)
{
13
	dwarn ("%p\n", list);
14 15 16
	g_slist_free (list);
}

17 18
/* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
 * PUTBACK/SPAGAIN by the caller. */
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
static SV *
glist_to_sv (GITypeInfo* info,
             gpointer pointer,
             GITransfer transfer)
{
	GITypeInfo *param_info;
	GITransfer item_transfer;
	gboolean is_slist;
	GSList *i;
	AV *av;
	SV *value;

	if (pointer == NULL) {
		return &PL_sv_undef;
	}

	/* FIXME: What about an array containing arrays of strings, where the
	 * outer array is GI_TRANSFER_EVERYTHING but the inner arrays are
	 * GI_TRANSFER_CONTAINER? */
38
	item_transfer = GI_TRANSFER_EVERYTHING == transfer
39 40 41 42
		? GI_TRANSFER_EVERYTHING
		: GI_TRANSFER_NOTHING;

	param_info = g_type_info_get_param_type (info, 0);
43
	dwarn ("pointer = %p, param_info = %p, param tag = %d (%s)\n",
44 45 46 47 48 49 50 51 52 53
	       pointer,
	       param_info,
	       g_type_info_get_tag (param_info),
	       g_type_tag_to_string (g_type_info_get_tag (param_info)));

	is_slist = GI_TYPE_TAG_GSLIST == g_type_info_get_tag (info);

	av = newAV ();
	for (i = pointer; i; i = i->next) {
		GIArgument arg = {0,};
54
		dwarn ("  element %p: %p\n", i, i->data);
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
		arg.v_pointer = i->data;
		value = arg_to_sv (&arg, param_info, item_transfer, NULL);
		if (value)
			av_push (av, value);
	}

	if (transfer >= GI_TRANSFER_CONTAINER) {
		if (is_slist)
			g_slist_free (pointer);
		else
			g_list_free (pointer);
	}

	g_base_info_unref ((GIBaseInfo *) param_info);

70 71
	dwarn ("  -> AV = %p, length = %ld\n", av, av_len (av) + 1);

72 73 74 75
	return newRV_noinc ((SV *) av);
}

static gpointer
76
sv_to_glist (GITransfer transfer, GITypeInfo * type_info, SV * sv, GPerlI11nInvocationInfo *iinfo)
77 78 79 80 81 82 83 84
{
	AV *av;
	GITransfer item_transfer;
	gpointer list = NULL;
	GITypeInfo *param_info;
	gboolean is_slist;
	gint i, length;

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

87
	if (!gperl_sv_is_defined (sv))
88 89 90 91 92 93
		return NULL;

	if (!gperl_sv_is_array_ref (sv))
		ccroak ("need an array ref to convert to GList");
	av = (AV *) SvRV (sv);

94 95 96
	item_transfer = GI_TRANSFER_EVERYTHING == transfer
		? GI_TRANSFER_EVERYTHING
		: GI_TRANSFER_NOTHING;
97 98

	param_info = g_type_info_get_param_type (type_info, 0);
99
	dwarn ("  param_info = %p, param tag = %d (%s), transfer = %d\n",
100 101 102 103 104 105 106 107 108 109 110
	       param_info,
	       g_type_info_get_tag (param_info),
	       g_type_tag_to_string (g_type_info_get_tag (param_info)),
	       transfer);

	is_slist = GI_TYPE_TAG_GSLIST == g_type_info_get_tag (type_info);

	length = av_len (av) + 1;
	for (i = 0; i < length; i++) {
		SV **svp;
		svp = av_fetch (av, i, 0);
111
		dwarn ("  element %d: svp = %p\n", i, svp);
112 113 114 115 116
		if (svp && gperl_sv_is_defined (*svp)) {
			GIArgument arg;
			/* FIXME: Is it OK to always allow undef here? */
			sv_to_arg (*svp, &arg, NULL, param_info,
			           item_transfer, TRUE, NULL);
117 118
			/* ENHANCEME: Could use g_[s]list_prepend and
			 * later _reverse for efficiency. */
119 120 121 122 123 124 125
			if (is_slist)
				list = g_slist_append (list, arg.v_pointer);
			else
				list = g_list_append (list, arg.v_pointer);
		}
	}

126 127 128 129 130
	if (GI_TRANSFER_NOTHING == transfer)
		free_after_call (iinfo,
		                 is_slist ? ((GFunc)free_slist) : ((GFunc)free_list),
		                 list);

131
	dwarn ("  -> list = %p, length = %d\n", list, g_list_length (list));
132 133 134 135 136

	g_base_info_unref ((GIBaseInfo *) param_info);

	return list;
}