gperl-i11n-vfunc-object.c 3.44 KB
Newer Older
1 2
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */

3 4 5 6 7 8
static void
store_objects_with_vfuncs (AV *objects_with_vfuncs, GIObjectInfo *info)
{
	if (g_object_info_get_n_vfuncs (info) <= 0)
		return;
	av_push (objects_with_vfuncs,
9
	         newSVpv (g_base_info_get_name (info), 0));
10 11 12 13
}

/* ------------------------------------------------------------------------- */

14
static void
15
generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer class)
16 17 18 19 20 21 22 23 24 25 26
{
	GIStructInfo *struct_info;
	gint n, i;
	struct_info = g_object_info_get_class_struct (info);
	n = g_object_info_get_n_vfuncs (info);
	for (i = 0; i < n; i++) {
		GIVFuncInfo *vfunc_info;
		const gchar *vfunc_name;
		GIFieldInfo *field_info;
		gint field_offset;
		GITypeInfo *field_type_info;
27
		GIBaseInfo *field_interface_info;
28
		gchar *perl_method_name;
29
		GPerlI11nPerlCallbackInfo *callback_info;
30 31 32 33

		vfunc_info = g_object_info_get_vfunc (info, i);
		vfunc_name = g_base_info_get_name (vfunc_info);

34
		perl_method_name = g_ascii_strup (vfunc_name, -1);
35 36 37 38 39 40 41 42
		if (is_forbidden_sub_name (perl_method_name)) {
			/* If the method name coincides with the name of one of
			 * perl's special subs, add "_VFUNC". */
			gchar *replacement = g_strconcat (perl_method_name, "_VFUNC", NULL);
			g_free (perl_method_name);
			perl_method_name = replacement;
		}

43 44 45 46 47 48 49
		{
			/* If there is no implementation of this vfunc at INIT
			 * time, we assume that the intention is to provide no
			 * implementation and we thus skip setting up the class
			 * struct member. */
			HV * stash = gv_stashpv (target_package, 0);
			GV * slot = gv_fetchmethod (stash, perl_method_name);
50
			if (!slot || !GvCV (slot)) {
51
				dwarn ("skipping vfunc %s.%s because it has no implementation\n",
52
				      g_base_info_get_name (info), vfunc_name);
53 54 55 56 57 58
				g_base_info_unref (vfunc_info);
				g_free (perl_method_name);
				continue;
			}
		}

59 60 61
		/* We use the field information here rather than the vfunc
		 * information so that the Perl invoker does not have to deal
		 * with an implicit invocant. */
62 63 64 65
		field_info = get_field_info (struct_info, vfunc_name);
		g_assert (field_info);
		field_offset = g_field_info_get_offset (field_info);
		field_type_info = g_field_info_get_type (field_info);
66
		field_interface_info = g_type_info_get_interface (field_type_info);
67

68
		/* callback_info takes over ownership of perl_method_name. */
69
		callback_info = create_perl_callback_closure_for_named_sub (
70
		                  field_interface_info, perl_method_name);
71
		dwarn ("installing vfunc %s.%s as %s at offset %d (vs. %d) inside %p\n",
72
		       g_base_info_get_name (info), vfunc_name, perl_method_name,
73 74 75 76
		       field_offset, g_vfunc_info_get_offset (vfunc_info),
		       class);
		G_STRUCT_MEMBER (gpointer, class, field_offset) = callback_info->closure;

77
		g_base_info_unref (field_interface_info);
78 79 80 81 82 83
		g_base_info_unref (field_type_info);
		g_base_info_unref (field_info);
		g_base_info_unref (vfunc_info);
	}
	g_base_info_unref (struct_info);
}
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107

/* ------------------------------------------------------------------------- */

static gint
get_vfunc_offset (GIObjectInfo *info, const gchar *vfunc_name)
{
	GIStructInfo *struct_info;
	GIFieldInfo *field_info;
	gint field_offset;

	struct_info = g_object_info_get_class_struct (info);
	g_assert (struct_info);

	field_info = get_field_info (struct_info, vfunc_name);
	g_assert (field_info);
	field_offset = g_field_info_get_offset (field_info);

	g_base_info_unref (field_info);
	g_base_info_unref (struct_info);

	return field_offset;
}