[perl-Glib/enum-constants] Install constant numeric subs for all enum and flags values

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

commit 361ba7d55f045ea6113479e5798f4213ee7e7dff
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Wed Jul 22 22:31:17 2015 +0200

    Install constant numeric subs for all enum and flags values
    
    Install, for example, a constant sub Glib::IOCondition::HUP returning
    the number 16.
    
    This is useful when a function, signal or property expects or returns an
    enum or flags value, but the API specification is such that our special
    enum and flags string handlers are not invoked.  Example:
    Gtk3::TextTag's "weight" property accepts any positive integer but
    predefined values are given by the Pango::Weight enum.

 GType.xs    |  132 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 lib/Glib.pm |    9 ++++
 t/c.t       |   59 ++++++++++++++++++++++++++-
 3 files changed, 191 insertions(+), 9 deletions(-)
---
diff --git a/GType.xs b/GType.xs
index 142eb55..ecf6648 100644
--- a/GType.xs
+++ b/GType.xs
@@ -41,6 +41,10 @@ G_LOCK_DEFINE_STATIC (types_by_package);
 G_LOCK_DEFINE_STATIC (packages_by_type);
 G_LOCK_DEFINE_STATIC (wrapper_class_by_type);
 
+/* pre-declarations */
+static void gperl_type_enum_install_constants (GType flags_type, const char *package);
+static void gperl_type_flags_install_constants (GType flags_type, const char *package);
+
 /*
  * this is just like gtk_type_class --- it keeps a reference on the classes
  * it returns so they stick around.  this is most important for enums and
@@ -109,8 +113,12 @@ gperl_register_fundamental (GType gtype, const char * package)
        G_UNLOCK (types_by_package);
        G_UNLOCK (packages_by_type);
 
-       if (g_type_is_a (gtype, G_TYPE_FLAGS) && gtype != G_TYPE_FLAGS)
+       if (g_type_is_a (gtype, G_TYPE_ENUM) && gtype != G_TYPE_ENUM) {
+               gperl_type_enum_install_constants (gtype, package);
+       } else if (g_type_is_a (gtype, G_TYPE_FLAGS) && gtype != G_TYPE_FLAGS) {
+               gperl_type_flags_install_constants (gtype, package);
                gperl_set_isa (package, "Glib::Flags");
+       }
 }
 
 =item void gperl_register_fundamental_alias (GType gtype, const char * package)
@@ -311,6 +319,51 @@ gperl_type_flags_get_values (GType flags_type)
 }
 
 
+static void
+gperl_type_enum_install_constants (GType enum_type, const char *package)
+{
+       HV *stash;
+       GEnumValue * vals;
+
+       g_return_if_fail (G_TYPE_IS_ENUM (enum_type));
+
+       stash = gv_stashpv (package, GV_ADD);
+       vals = gperl_type_enum_get_values (enum_type);
+       while (vals && vals->value_name && vals->value_nick) {
+               char *tmp, *constant_name = g_ascii_strup (vals->value_nick, -1);
+               for (tmp = constant_name; *tmp != '\0'; tmp++) {
+                       if (*tmp == '-') *tmp = '_';
+               }
+               /* The new sub takes ownership of the SV. */
+               newCONSTSUB (stash, constant_name, newSViv (vals->value));
+               g_free (constant_name);
+               vals++;
+       }
+}
+
+static void
+gperl_type_flags_install_constants (GType flags_type, const char *package)
+{
+       HV *stash;
+       GFlagsValue * vals;
+
+       g_return_if_fail (G_TYPE_IS_FLAGS (flags_type));
+
+       stash = gv_stashpv (package, GV_ADD);
+       vals = gperl_type_flags_get_values (flags_type);
+       while (vals && vals->value_name && vals->value_nick) {
+               char *tmp, *constant_name = g_ascii_strup (vals->value_nick, -1);
+               for (tmp = constant_name; *tmp != '\0'; tmp++) {
+                       if (*tmp == '-') *tmp = '_';
+               }
+               /* The new sub takes ownership of the SV. */
+               newCONSTSUB (stash, constant_name, newSVuv (vals->value));
+               g_free (constant_name);
+               vals++;
+       }
+}
+
+
 =item gboolean gperl_try_convert_enum (GType gtype, SV * sv, gint * val)
 
 return FALSE if I<sv> can't be mapped to a valid member of the registered
@@ -325,18 +378,36 @@ gperl_try_convert_enum (GType type,
                        SV * sv,
                        gint * val)
 {
-       GEnumValue * vals;
-       char *val_p = SvPV_nolen(sv);
+       GEnumValue * vals, * vals_iter;
+       char *val_p;
+       gint val_i;
+
+       /* first, try as a string */
+       val_p = SvPV_nolen(sv);
        if (*val_p == '-') val_p++;
        vals = gperl_type_enum_get_values (type);
-       while (vals && vals->value_nick && vals->value_name) {
-               if (gperl_str_eq (val_p, vals->value_nick) ||
-                   gperl_str_eq (val_p, vals->value_name)) {
-                       *val = vals->value;
+       vals_iter = vals;
+       while (vals_iter && vals_iter->value_nick && vals_iter->value_name) {
+               if (gperl_str_eq (val_p, vals_iter->value_nick) ||
+                   gperl_str_eq (val_p, vals_iter->value_name)) {
+                       *val = vals_iter->value;
                        return TRUE;
                }
-               vals++;
+               vals_iter++;
+       }
+
+       /* then, try again as an integer */
+       val_i = SvIV (sv);
+       vals_iter = vals;
+       while (vals_iter && vals_iter->value_nick && vals_iter->value_name) {
+               if (vals_iter->value == val_i) {
+                       *val = vals_iter->value;
+                       return TRUE;
+               }
+               vals_iter++;
        }
+
+       /* give up */
        return FALSE;
 }
 
@@ -436,6 +507,45 @@ gperl_try_convert_flag (GType type,
                }
                vals++;
        }
+       return FALSE;
+}
+
+static int
+uint_inv_compare (gconstpointer a, gconstpointer b)
+{
+       guint int_a = * ((guint *) a);
+       guint int_b = * ((guint *) b);
+       return - (int_a - int_b);
+}
+
+static gboolean
+gperl_check_flag_int (GType type,
+                      guint val_i)
+{
+       GFlagsValue * vals;
+       guint i, remainder = val_i;
+       GArray *vals_i;
+
+       vals = gperl_type_flags_get_values (type);
+       vals_i = g_array_new (FALSE, FALSE, sizeof (guint));
+       while (vals && vals->value_nick && vals->value_name) {
+               g_array_append_val (vals_i, vals->value);
+               vals++;
+       }
+
+       g_array_sort (vals_i, uint_inv_compare);
+
+       for (i = 0; i < vals_i->len; i++) {
+               guint candidate = g_array_index (vals_i, guint, i);
+               if (candidate <= remainder) {
+                       remainder -= candidate;
+               }
+               if (remainder == 0) {
+                       return TRUE;
+               }
+       }
+
+       g_array_free (vals_i, TRUE);
 
        return FALSE;
 }
@@ -497,6 +607,12 @@ gperl_convert_flags (GType type,
        }
        if (SvPOK (val))
                return gperl_convert_flag_one (type, SvPV_nolen (val));
+       if (SvIOK (val) || SvUOK (val) || SvNOK (val)) {
+               guint val_i = SvUV (val);
+               if (gperl_check_flag_int (type, val_i)) {
+                       return val_i;
+               }
+       }
 
        croak ("FATAL: invalid %s value %s, expecting a string scalar or an arrayref of strings",
               g_type_name (type), SvPV_nolen (val));
diff --git a/lib/Glib.pm b/lib/Glib.pm
index cf109f1..90eb05f 100644
--- a/lib/Glib.pm
+++ b/lib/Glib.pm
@@ -508,6 +508,15 @@ access the flag values directly as strings (but you are not allowed to
 modify the array), and when stringified C<"$flags"> a flags value will
 output a human-readable version of its contents.
 
+Normally, there is no need to access the underlying numeric values of enum or
+flags values.  But for the rare cases where the numeric values are required,
+they are provided as constant subs accessible as C<Package::NICK_NAME> where
+the package is the one associated with the enum or flags, e.g.,
+"Glib::SpawnFlags", and the sub name is the nick name in upper case with '-'
+replaced by '_', e.g., "LEAVE_DESCRIPTORS_OPEN".  So the numeric value of
+G_SPAWN_LEAVE_DESCRIPTORS_OPEN is accessible as
+C<Glib::SpawnFlags::LEAVE_DESCRIPTORS_OPEN>.
+
 =head2 It's All the Same
 
 For the most part, the remaining bits of GLib are unchanged.  GMainLoop is now
diff --git a/t/c.t b/t/c.t
index 5b8d633..13f6211 100644
--- a/t/c.t
+++ b/t/c.t
@@ -10,10 +10,11 @@
 
 use strict;
 use warnings;
+use List::Util qw/sum/;
 
 #########################
 
-use Test::More tests => 57;
+use Test::More tests => 125;
 BEGIN { use_ok('Glib') };
 
 #########################
@@ -262,6 +263,62 @@ ok ($obj->get ('some_flags') != [qw/value-one/], '!= is overloaded');
 ok ($obj->get ('some_flags') eq [qw/value-one value-two/], 'eq is overloaded');
 ok ($obj->get ('some_flags') ne [qw/value-one/], 'ne is overloaded');
 
+#
+# Constants
+#
+{
+  no strict 'refs';
+
+  # Use numeric constants for an enum type.
+  my $obj = Tester->new;
+  $obj->set (some_enum => TestEnum::VALUE_TWO ());
+  is ($obj->get ('some_enum'), 'value-two',
+      'enum property, TestEnum::VALUE_TWO => value-two');
+  {
+    local $@;
+    eval { $obj->set (some_enum => 7); };
+    like ($@, qr/invalid/, 'enum property, invalid value dies');
+  }
+
+  # Use numeric constants for a flags type.  Try all possible combinations.
+  # http://stackoverflow.com/questions/994235/how-can-i-generate-all-subsets-of-a-list-in-perl
+  my @flag_values = (TestFlags::VALUE_ONE (),
+                     TestFlags::VALUE_TWO (),
+                     TestFlags::VALUE_THREE (),
+                     TestFlags::VALUE_FOUR (),
+                     TestFlags::VALUE_FIVE (),
+                     TestFlags::VALUE_SIX ());
+  foreach my $count (1 .. (1<<@flag_values)-1) {
+    my $flags = [ map $count & (1<<$_) ? $flag_values[$_] : (), 0..$#flag_values ];
+    my $flags_i = sum @$flags;
+    $obj->set (some_flags => $flags_i);
+    ok ($obj->get ('some_flags') == $flags_i,
+        "flags property, $flags_i OK");
+  }
+  {
+    local $@;
+    eval { $obj->set (some_flags => 2**3); };
+    like ($@, qr/invalid/, 'flags property, invalid value dies');
+  }
+
+  # Compare constants for a flags type.
+  my @value_infos = Glib::Type->list_values ('Glib::IOCondition');
+  my @subs = map { my $n = $_->{nick}; $n =~ s/-/_/g; uc $n } @value_infos;
+  my @values = map { $_->{value} } @value_infos;
+  is_deeply ([map { *{'Glib::IOCondition::' . $_}->() } @subs], \ values,
+             'Glib::IOCondition: the constants and Glib::Type->list_values agree');
+
+  skip 'new 2.14 stuff', 1
+    unless Glib->CHECK_VERSION (2, 14, 0);
+
+  # Compore constants for an enum type.
+  @value_infos = Glib::Type->list_values ('Glib::UserDirectory');
+  @subs = map { my $n = $_->{nick}; $n =~ s/-/_/g; uc $n } @value_infos;
+  @values = map { $_->{value} } @value_infos;
+  is_deeply ([map { *{'Glib::UserDirectory::' . $_}->() } @subs], \ values,
+             'Glib::UserDirectory: the constants and Glib::Type->list_values agree');
+}
+
 __END__
 
 Copyright (C) 2003-2005, 2009 by the gtk2-perl team (see the file AUTHORS for the