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.