[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

GError location filename as wide chars



While going through filename bytes versus utf8 in my own program I
noticed this bit of GError which I think is currently concatting utf8
and bytes.

I expect anyone with non-ascii in the path to their perl code files is
probably asking for trouble, but I think a filename_display_name() would
at least get it displaying right.

It's a little tricky to test this.  I used the foo.pl below in a
filename with some utf8, run in a utf8 locale.  Without
filename_display_name() the stringized bit gives an extra "A" etc, per
the usual odour of bad utf8 (or bad odour of utf8, as the case may be
:-)

Index: Glib.pm
===================================================================
--- Glib.pm	(revision 1084)
+++ Glib.pm	(working copy)
@@ -89,8 +89,20 @@
 
 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 {
+     my $location = $_[0]->location;
+     unless (utf8::is_utf8($location)) {
+       $location = Glib::filename_display_name($location);
+     }
+     return $_[0]->message . $location
+   },
    fallback => 1;
 
 sub location { $_[0]->{location} }
@@ -662,7 +674,7 @@
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2003-2008 by muppet and the gtk2-perl team
+Copyright 2003-2009 by muppet and the gtk2-perl team
 
 This library is free software; you can redistribute it and/or modify
 it under the terms of the Lesser General Public License (LGPL).  For
Index: t/d.t
===================================================================
--- t/d.t	(revision 1084)
+++ t/d.t	(working copy)
@@ -23,7 +23,11 @@
 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");
+}
 
 #
 # create a new exception class...
@@ -83,5 +87,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.
use 5.010;
use Gtk2 '-init';

# (setq file-name-coding-system 'utf-8)
# (setq file-name-coding-system nil)

binmode (STDOUT, ":encoding(utf-8)") or die;
#binmode (STDOUT, ":encoding(iso-8859-1)") or die;
#binmode (STDOUT, ":locale") or die;

my $loader = Gtk2::Gdk::PixbufLoader->new();
my $pixbuf;
if (eval {
  $loader->write ($image);
  $loader->close ();
  $pixbuf = $loader->get_pixbuf ();
  1 }) {
  print $pixbuf;
} else {
  my $err = $@;

  my $str = $err->location;
  say "location: ",(utf8::is_utf8($str)?"yes":"no")," ",$str;

  $str = Glib::filename_display_name($str);
  say "location display: ",(utf8::is_utf8($str)?"yes":"no")," ",$str;

  $str = "$err";
  say "err stringize: ",(utf8::is_utf8($str)?"yes":"no")," ",$str;
}
-- 
"Learning more about less and less and less."


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]