g_log_set_default_handler

[Kevin Ryde <user42 zip com au>]

While going through some of my exception trapping I thought I might use
a g_log_set_default_handler() to catch logs from possible unknown
domains etc.  I wrote the couple of lines below which seem to work.
There isn't already a way to do it is there?

Index: GLog.xs
===================================================================
--- GLog.xs     (revision 1092)
+++ GLog.xs     (working copy)
@@ -1,5 +1,5 @@
 /*
- * Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for
+ * Copyright (C) 2003-2005, 2009 by the gtk2-perl team (see the file AUTHORS for
  * the full list)
  *
  * This library is free software; you can redistribute it and/or modify it
@@ -85,6 +85,17 @@
        return gperl_convert_flags (g_log_level_flags_get_type (), sv);
 }
 
+/* for GLogFunc style, to be invoked by gperl_log_func() below */
+static GPerlCallback *
+gperl_log_callback_new (SV *log_func, SV *user_data)
+{
+       GType param_types[3];
+       param_types[0] = G_TYPE_STRING;
+       param_types[1] = g_log_level_flags_get_type ();
+       param_types[2] = G_TYPE_STRING;
+       return gperl_callback_new (log_func, user_data,
+                                  3, param_types, G_TYPE_NONE);
+}
 static void
 gperl_log_func (const gchar   *log_domain,
                 GLogLevelFlags log_level,
@@ -94,6 +105,10 @@
        gperl_callback_invoke ((GPerlCallback *) user_data, NULL,
                               log_domain, log_level, message);
 }
+#if GLIB_CHECK_VERSION (2, 6, 0)
+/* the GPerlCallback currently installed as default handler, or NULL if none */
+static GPerlCallback *gperl_log_default_handler_callback = NULL;
+#endif
 
 void
 gperl_log_handler (const gchar   *log_domain,
@@ -191,19 +206,19 @@
 
 =arg log_func (subroutine) handler function
 
+$log_func will be called as
+
+    &$log_func ($log_domain, $log_levels, $user_data);
+
+where $log_domain is the name requested and $log_levels is a
+Glib::LogLevelFlags of a level and flags requested.
 =cut
 guint
 g_log_set_handler (class, gchar_ornull * log_domain, SV * log_levels, SV * log_func, SV * user_data=NULL)
     PREINIT:
        GPerlCallback * callback;
-       GType param_types[3];
     CODE:
-       param_types[0] = G_TYPE_STRING;
-       param_types[1] = g_log_level_flags_get_type ();
-       param_types[2] = G_TYPE_STRING;
-
-       callback = gperl_callback_new (log_func, user_data,
-                                      3, param_types, G_TYPE_NONE);
+       callback = gperl_log_callback_new (log_func, user_data);
        RETVAL = g_log_set_handler (log_domain,
                                    SvGLogLevelFlags (log_levels),
                                    gperl_log_func, callback);
@@ -225,6 +240,60 @@
 
 ##void g_log_default_handler (const gchar *log_domain, GLogLevelFlags log_level, const gchar *message, 
gpointer unused_data);
 
+#if GLIB_CHECK_VERSION (2, 6, 0)
+
+##GLogFunc g_log_set_default_handler (GLogFunc log_func, gpointer user_data);
+=for apidoc
+=for signature prev_log_func = Glib->set_default_handler (log_func)
+=arg log_func (subroutine) handler function or undef
+Install log_func as the default log handler, or if undef then go back
+to Glib's default log handler function.  log_func will be called for
+anything which doesn't otherwise have a handler (either set_handler,
+or gperl_handle_logs_for in L<Glib::xsapi>).
+
+    &$log_func ($log_domain, $log_levels, $user_data);
+
+where $log_domain is a string, and $log_levels is a Glib::LogLevelFlags.
+
+The return value is the previous default handler, or undef if none or
+if the previous handler was some non-Perl handler.
+=cut
+# If the previous handler is a non-perl func it would be cute to wrap
+# and return it so that it could either (a) be re-installed later, or
+# (b) be invoked explicitly from some perl code.  Alas neither is
+# possible since glib doesn't give back the associated previous
+# user_data.  Some C code handlers might not have any userdata, but
+# application or library code which is anything like our present gperl
+# code will definitely need it.
+SV *
+g_log_set_default_handler (class, SV * log_func, SV * user_data=NULL)
+    PREINIT:
+       GPerlCallback *callback, *prev_callback;
+       GLogFunc prev;
+    CODE:
+       callback = gperl_log_callback_new (log_func, user_data);
+       prev = g_log_set_default_handler (gperl_log_func, callback);
+       prev_callback = gperl_log_default_handler_callback;
+
+       RETVAL = &PL_sv_undef;
+       if (prev_callback) {
+               /* if prev != gperl_log_func then someone has installed
+                * another function replacing our handler.  Don't return the
+                * perl prev_callback->func in that case, but do of course
+                * free it.
+                */
+               if (prev == gperl_log_func) {
+                       RETVAL = prev_callback->func;
+                       SvREFCNT_inc_simple_void_NN (RETVAL);
+               }
+               gperl_callback_destroy (prev_callback);
+       }
+       gperl_log_default_handler_callback = callback;
+    OUTPUT:
+       RETVAL
+
+#endif
+
 # this is a little ugly, because i didn't want to export a typemap for
 # GLogLevelFlags.
 
Index: t/a.t
===================================================================
--- t/a.t       (revision 1092)
+++ t/a.t       (working copy)
@@ -20,7 +20,7 @@
        # have to bail out.
        plan skip_all => "g_log doubles messages by accident on 64-bit platforms";
 } else {
-       plan tests => 12;
+       plan tests => 18;
 }
 
 package Foo;
@@ -68,8 +68,34 @@
 # i would expect this to call croak, but it actually just aborts.  :-(
 #eval { Glib->error (__PACKAGE__, 'error'); };
 
+SKIP: {
+  skip "new 2.6 stuff", 6
+    unless Glib->CHECK_VERSION (2,6,0);
 
+  {
+    is (Glib::Log->set_default_handler (undef), undef);
 
+    # anon subs like $sub1 and $sub2 must refer to something in the env like
+    # $x here or they're not gc-ed immediately
+    my $x = 123;
+    my $message;
+    my $sub1 = sub { $message = $_[2]; return $x };
+    is (Glib::Log->set_default_handler ($sub1), undef);
+
+    Glib->log ('An-Unknown-Domain', ['info'], 'a message');
+    is ($message, 'a message');
+
+    my $sub2 = sub { return $x };
+    is (Glib::Log->set_default_handler ($sub2), $sub1);
+    require Scalar::Util;
+    Scalar::Util::weaken ($sub1);
+    is ($sub1, undef);
+
+    is (Glib::Log->set_default_handler (undef), $sub2);
+  }
+}
+
+
 # when you try to connect to a non-existant signal, you get a CRITICAL
 # log message...
 my $object = Foo->new;
@@ -108,7 +134,7 @@
 
 __END__
 
-Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
+Copyright (C) 2003, 2009 by the gtk2-perl team (see the file AUTHORS for the
 full list)
 
 This library is free software; you can redistribute it and/or modify it under