Re: GError location filename as wide chars

[Kevin Ryde <user42 zip com au>]

I wrote:
> utf8::is_utf8

I see that would bump the minimum perl to 5.8.1 instead of 5.8.0.  A bit
of xs like below would avoid that.  It doesn't look great, but it gets
the right effect ...

Index: GError.xs
===================================================================
--- GError.xs   (revision 1109)
+++ GError.xs   (working copy)
@@ -597,3 +597,50 @@
     OUTPUT:
        RETVAL
 
+
+SV *
+location_for_display (SV *error)
+    PREINIT:
+       HV *hv;
+       SV **svp;
+       char *str;
+    CODE:
+       if (!gperl_sv_is_hash_ref (error))
+               croak ("expecting a hash reference for a GError");
+       hv = (HV*) SvRV (error);
+       svp = hv_fetch (hv, "location", 8, FALSE);
+       if (!svp || !gperl_sv_is_defined (*svp)) 
+               XSRETURN(0);
+       RETVAL = *svp;
+       SvREFCNT_inc (RETVAL);
+       str = SvPV_nolen (RETVAL);
+#if GLIB_CHECK_VERSION (2, 6, 0)
+       if (! SvUTF8(RETVAL)) {
+               str = g_filename_display_name(str);
+               SvREFCNT_dec (RETVAL);
+               RETVAL = newSVpv(str,0);
+               SvUTF8_on (RETVAL);
+               g_free (str);
+       }
+#else
+       if (! SvUTF8(RETVAL)) {
+               GError *e = NULL;
+               gsize bytes_written = 0;
+               str = g_filename_to_utf8(str, -1, NULL, &bytes_written, &e);
+               if (e == NULL) {
+                       SvREFCNT_dec (RETVAL);
+                       RETVAL = newSVpvn(str,bytes_written);
+                       SvUTF8_on (RETVAL);
+               }
+               g_free (str);
+               /* ENHANCE-ME: if there's an error we return the 'location'
+                * string of bytes unchanged.  It will get upgraded as if
+                * latin1 by the concatenation in Glib::Error ""
+                * stringizing.  It'd be possible to escape bad bytes in a
+                * style similar to g_filename_display_name(), but don't
+                * really want to duplicate a lot of code here.
+                */
+       }
+#endif
+    OUTPUT:
+       RETVAL
Index: Glib.pm
===================================================================
--- Glib.pm     (revision 1109)
+++ Glib.pm     (working copy)
@@ -89,8 +89,14 @@
 
 package Glib::Error;
 
+# location() is normally the perl "at filename.pl line 123" string with the
+# filename part as raw bytes.  Put it through filename_display_name() before
+# combining with the wide-char message() part.  A plain "." concat would
+# only do utf8::upgrade(), which would mean always treating the filename
+# bytes as latin-1.
+#
 use overload
-   '""' => sub { $_[0]->message.$_[0]->location },
+   '""' => sub { $_[0]->message . $_[0]->location_for_display },
    fallback => 1;
 
 sub location { $_[0]->{location} }
Index: t/d.t
===================================================================
--- t/d.t       (revision 1109)
+++ t/d.t       (working copy)
@@ -8,7 +8,7 @@
 #
 
 use strict;
-use Test::More tests => 36;
+use Test::More tests => 40;
 use Glib;
 
 
@@ -23,8 +23,24 @@
 is ($ ->domain, 'g_convert_error', 'error domain (implies class)');
 ok ($ ->message, "should have an error message, may be translated");
 ok ($ ->location, "should have an error location, may be translated");
-is ($@, $ ->message $ ->location, "stringification operator is overloaded");
+{ my $expect = $ ->message;
+  # location part utf8-ized by filename_display_name, bit hard to check what
+  # that should come out as
+  like ($@, qr/\Q$expect/, "stringification operator is overloaded");
+}
 
+# exercise checks in location_for_display()
+ok (! eval { Glib::Error::location_for_display(undef) },
+    'location_for_display() on undef');
+ok (! eval { Glib::Error::location_for_display(123) },
+    'location_for_display() on number');
+is (Glib::Error::location_for_display({}),
+    undef,
+    'location_for_display() on missing location field');
+is (Glib::Error::location_for_display({location=>undef}),
+    undef,
+    'location_for_display() on undef location field');
+
 #
 # create a new exception class...
 #
@@ -83,5 +99,5 @@
 
 __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).  See LICENSE for more information.