[perl-glib: 1/3] Match GLib's log message handling

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

commit a85074d6d1a422762583ebec019448917cbe836a
Author: Emmanuele Bassi <ebassi gnome org>
Date:   Wed May 20 13:45:15 2020 +0100

    Match GLib's log message handling
    
    After GLib gained support for structured log messages, it started
    handling info-level messages differently, by showing them only if the
    G_MESSAGES_DEBUG environment variable is set to either "all" or to a
    colon-separated list of log domains that include the log domain used by
    the message.
    
    The Perl bindings override the old, unstructured log message function,
    which disables all the logging capabilities inside GLib. Since the Perl
    bindings currently do not support G_LOG_MESSSAGE_INFO and
    G_LOG_MESSAGE_DEBUG messages, this means that Perl applications and
    modules will always print out debugging messages that would normally not
    be visible; additionally, the info-level messages use a generic "LOG"
    marker which makes them look like actual warnings, instead of the debugging
    messages they are.
    
    In order to fix this, and be backward compatible with older versions of
    GLib, we need to reimplement the logging logic from GLib into our own
    bindings. This also means adding the ability to emit info-level log
    messages.

 GLog.xs | 52 ++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 38 insertions(+), 14 deletions(-)
---
diff --git a/GLog.xs b/GLog.xs
index 8e0ec3f..342c482 100644
--- a/GLog.xs
+++ b/GLog.xs
@@ -95,7 +95,8 @@ gperl_log_handler (const gchar   *log_domain,
                    const gchar   *message,
                    gpointer       user_data)
 {
-       char * desc;
+        char *desc;
+        char *env;
 
        gboolean in_recursion = (log_level & G_LOG_FLAG_RECURSION) != 0;
        gboolean is_fatal = (log_level & G_LOG_FLAG_FATAL) != 0;
@@ -107,13 +108,30 @@ gperl_log_handler (const gchar   *log_domain,
                message = "(NULL) message";
 
        switch (log_level) {
-               case G_LOG_LEVEL_CRITICAL: desc = "CRITICAL"; break;
-               case G_LOG_LEVEL_ERROR:    desc = "ERROR";    break;
-               case G_LOG_LEVEL_WARNING:  desc = "WARNING";  break;
-               case G_LOG_LEVEL_MESSAGE:  desc = "Message";  break;
-               default: desc = "LOG";
+                case G_LOG_LEVEL_ERROR:    desc = "ERROR";    break;
+                case G_LOG_LEVEL_CRITICAL: desc = "CRITICAL"; break;
+                case G_LOG_LEVEL_WARNING:  desc = "WARNING";  break;
+                case G_LOG_LEVEL_MESSAGE:  desc = "Message";  break;
+                case G_LOG_LEVEL_INFO:     desc = "INFO";     break;
+                case G_LOG_LEVEL_DEBUG:    desc = "DEBUG";    break;
+                default: desc = "LOG";
        }
 
+        /* GLib will automatically skip debug messages unless the
+         * G_MESSAGES_DEBUG environment variable is set to either
+         * "all" or a colon-separated list of log domains that include
+         * the domain used for the message.
+         */
+        if (log_level & (G_LOG_LEVEL_INFO | G_LOG_LEVEL_DEBUG)) {
+                const char *env = g_getenv ("G_MESSAGES_DEBUG");
+                if (env == NULL)
+                        return;
+                if (strcmp (env, "all") != 0 &&
+                    (log_domain == NULL || strstr (env, log_domain) == NULL)) {
+                        return;
+                }
+        }
+
        GPERL_SET_CONTEXT;
        warn ("%s%s%s %s**: %s",
              (log_domain ? log_domain : ""),
@@ -362,21 +380,27 @@ MODULE = Glib::Log        PACKAGE = Glib
 ##define g_message(...)  g_log (G_LOG_DOMAIN, G_LOG_LEVEL_MESSAGE, __VA_ARGS__)
 ##define g_critical(...) g_log (G_LOG_DOMAIN, G_LOG_LEVEL_CRITICAL, __VA_ARGS__)
 ##define g_warning(...)  g_log (G_LOG_DOMAIN, G_LOG_LEVEL_WARNING, __VA_ARGS__)
+##define g_info(...)     g_log (G_LOG_DOMAIN, G_LOG_LEVEL_INFO, __VA_ARGS__)
+##define g_debug(...)    g_log (G_LOG_DOMAIN, G_LOG_LEVEL_DEBUG, __VA_ARGS__)
 void
 error (class, gchar_ornull * domain, const gchar * message)
     ALIAS:
-       error = 0
-       message = 1
-       critical = 2
-       warning = 3
+        error = 0
+        critical = 1
+        warning = 2
+        message = 3
+        info = 4
+        debug = 5
     PREINIT:
        GLogLevelFlags flags = G_LOG_LEVEL_MESSAGE;
     CODE:
        switch (ix) {
-               case 0: flags = G_LOG_LEVEL_ERROR; break;
-               case 1: flags = G_LOG_LEVEL_MESSAGE; break;
-               case 2: flags = G_LOG_LEVEL_CRITICAL; break;
-               case 3: flags = G_LOG_LEVEL_WARNING; break;
+                case 0: flags = G_LOG_LEVEL_ERROR; break;
+                case 1: flags = G_LOG_LEVEL_CRITICAL; break;
+                case 2: flags = G_LOG_LEVEL_WARNING; break;
+                case 3: flags = G_LOG_LEVEL_MESSAGE; break;
+                case 4: flags = G_LOG_LEVEL_INFO; break;
+                case 5: flags = G_LOG_LEVEL_DEBUG; break;
        }
        g_log (domain, flags, "%s", message);