[perl-Glib-Object-Introspection] Avoid doing some work in XS that we can also do in Perl

[Torsten SchÃnfeld <tsch src gnome org>]

commit cfd03f151d0b148bb3c71c92160db7c27ff84648
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sat Jan 19 20:17:46 2013 +0100

    Avoid doing some work in XS that we can also do in Perl

 GObjectIntrospection.xs          |   21 ++++++++-------------
 gperl-i11n-method.c              |   34 ----------------------------------
 gperl-i11n-vfunc-object.c        |   11 +++++++++++
 lib/Glib/Object/Introspection.pm |    6 +++---
 4 files changed, 22 insertions(+), 50 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 908cc0c..56f4f49 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -260,13 +260,14 @@ static GType find_union_member_gtype (const gchar *package, const gchar *namespa
 /* methods */
 static void store_methods (HV *namespaced_functions, GIBaseInfo *info, GIInfoType info_type);
 
+/* object vfuncs */
+static void store_objects_with_vfuncs (AV *objects_with_vfuncs, GIObjectInfo *info);
+static void generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer class);
+
 /* interface vfuncs */
 static void generic_interface_init (gpointer iface, gpointer data);
 static void generic_interface_finalize (gpointer iface, gpointer data);
 
-/* object vfuncs */
-static void generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer class);
-
 /* misc. */
 static void call_carp_croak (const char *msg);
 static void call_carp_carp (const char *msg);
@@ -341,7 +342,7 @@ _register_types (class, namespace, package)
 	HV *namespaced_functions;
 	HV *fields;
 	AV *interfaces;
-	HV *objects_with_vfuncs;
+	AV *objects_with_vfuncs;
     PPCODE:
 	repository = g_irepository_get_default ();
 
@@ -350,7 +351,7 @@ _register_types (class, namespace, package)
 	namespaced_functions = newHV ();
 	fields = newHV ();
 	interfaces = newAV ();
-	objects_with_vfuncs = newHV ();
+	objects_with_vfuncs = newAV ();
 
 	number = g_irepository_get_n_infos (repository, namespace);
 	for (i = 0; i < number; i++) {
@@ -395,7 +396,7 @@ _register_types (class, namespace, package)
 		}
 
 		if (info_type == GI_INFO_TYPE_OBJECT) {
-			store_vfuncs (objects_with_vfuncs, info);
+			store_objects_with_vfuncs (objects_with_vfuncs, info);
 		}
 
 		/* These are the types that we want to register with perl-Glib. */
@@ -738,21 +739,15 @@ _find_vfuncs_with_implementation (class, object_package, target_package)
 		const gchar *vfunc_name;
 		GIFieldInfo *field_info;
 		gint field_offset;
-		gchar *perl_method_name;
 		vfunc_info = g_object_info_get_vfunc (object_info, i);
 		vfunc_name = g_base_info_get_name (vfunc_info);
 		/* FIXME: g_vfunc_info_get_offset does not seem to work here. */
 		field_info = get_field_info (struct_info, vfunc_name);
 		g_assert (field_info);
 		field_offset = g_field_info_get_offset (field_info);
-		perl_method_name = g_ascii_strup (vfunc_name, -1);
 		if (G_STRUCT_MEMBER (gpointer, target_klass, field_offset)) {
-			AV *av = newAV ();
-			av_push (av, newSVpv (vfunc_name, PL_na));
-			av_push (av, newSVpv (perl_method_name, PL_na));
-			XPUSHs (sv_2mortal (newRV_noinc ((SV *) av)));
+			XPUSHs (sv_2mortal (newSVpv (vfunc_name, PL_na)));
 		}
-		g_free (perl_method_name);
 		g_base_info_unref (field_info);
 		g_base_info_unref (vfunc_info);
 	}
diff --git a/gperl-i11n-method.c b/gperl-i11n-method.c
index 5752d0a..547ec80 100644
--- a/gperl-i11n-method.c
+++ b/gperl-i11n-method.c
@@ -53,37 +53,3 @@ store_methods (HV *namespaced_functions, GIBaseInfo *info, GIInfoType info_type)
 	gperl_hv_take_sv (namespaced_functions, namespace, strlen (namespace),
 	                  newRV_noinc ((SV *) av));
 }
-
-/* ------------------------------------------------------------------------- */
-
-static void
-store_vfuncs (HV *objects_with_vfuncs, GIObjectInfo *info)
-{
-	const gchar *object_name;
-	AV *vfuncs_av;
-	gint n_vfuncs, i;
-
-	n_vfuncs = g_object_info_get_n_vfuncs (info);
-	if (n_vfuncs <= 0)
-		return;
-
-	object_name = g_base_info_get_name (info);
-	vfuncs_av = newAV ();
-
-	for (i = 0; i < n_vfuncs; i++) {
-		GIVFuncInfo *vfunc_info =
-			g_object_info_get_vfunc (info, i);
-		const gchar *vfunc_name =
-			g_base_info_get_name (vfunc_info);
-		gchar *vfunc_perl_name = g_ascii_strup (vfunc_name, -1);
-		AV *vfunc_av = newAV ();
-		av_push (vfunc_av, newSVpv (vfunc_name, PL_na));
-		av_push (vfunc_av, newSVpv (vfunc_perl_name, PL_na));
-		av_push (vfuncs_av, newRV_noinc ((SV *) vfunc_av));
-		g_free (vfunc_perl_name);
-		g_base_info_unref (vfunc_info);
-	}
-
-	gperl_hv_take_sv (objects_with_vfuncs, object_name, strlen (object_name),
-	                  newRV_noinc ((SV *) vfuncs_av));
-}
diff --git a/gperl-i11n-vfunc-object.c b/gperl-i11n-vfunc-object.c
index 6f22f83..ea35d8c 100644
--- a/gperl-i11n-vfunc-object.c
+++ b/gperl-i11n-vfunc-object.c
@@ -1,6 +1,17 @@
 /* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 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,
+	         newSVpv (g_base_info_get_name (info), PL_na));
+}
+
+/* ------------------------------------------------------------------------- */
+
+static void
 generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer class)
 {
 	GIStructInfo *struct_info;
diff --git a/lib/Glib/Object/Introspection.pm b/lib/Glib/Object/Introspection.pm
index e252f42..731e7fd 100644
--- a/lib/Glib/Object/Introspection.pm
+++ b/lib/Glib/Object/Introspection.pm
@@ -162,7 +162,7 @@ sub setup {
     };
   }
 
-  foreach my $object_name (keys %{$objects_with_vfuncs}) {
+  foreach my $object_name (@{$objects_with_vfuncs}) {
     my $object_package = $package . '::' . $object_name;
     my $installer_name = $object_package . '::_INSTALL_OVERRIDES';
     *{$installer_name} = sub {
@@ -216,8 +216,8 @@ sub INIT {
         my $provider_package = $non_perl_parent_packages[$j];
         my @vfuncs = __PACKAGE__->_find_vfuncs_with_implementation(
                        $provider_package, $implementer_package);
-        VFUNC: foreach my $vfunc_names (@vfuncs) {
-          my ($vfunc_name, $perl_vfunc_name) = @{$vfunc_names};
+        VFUNC: foreach my $vfunc_name (@vfuncs) {
+          my $perl_vfunc_name = uc $vfunc_name;
           if (exists $_FORBIDDEN_SUB_NAMES{$perl_vfunc_name}) {
             $perl_vfunc_name .= '_VFUNC';
           }