Upgrade to Locale::Maketext 1.06.

p4raw-id: //depot/perl@19987

5 files changed, 391 insertions, 282 deletions

diff --git a/lib/Locale/Maketext.pm b/lib/Locale/Maketext.pm
index 0d4d69fdf5..b978312d8f 100644
--- a/lib/Locale/Maketext.pm
+++ b/lib/Locale/Maketext.pm
@@ -1,5 +1,5 @@
 
-# Time-stamp: "2003-04-18 22:03:06 AHDT"
+# Time-stamp: "2003-06-21 23:41:57 AHDT"
 
 require 5;
 package Locale::Maketext;
@@ -14,7 +14,7 @@ use I18N::LangTags 0.21 ();
 BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
  # define the constant 'DEBUG' at compile-time
 
-$VERSION = "1.05";
+$VERSION = "1.06";
 @ISA = ();
 
 $MATCH_SUPERS = 1;
@@ -328,6 +328,8 @@ sub get_handle {  # This is a constructor and, yes, it CAN FAIL.
 #
 ###########################################################################
 
+use Locale::Maketext::GutsLoader;
+
 sub _http_accept_langs {
   # Deal with HTTP "Accept-Language:" stuff.  Hassle.
   # This code is more lenient than RFC 3282, which you must read.
@@ -384,285 +386,6 @@ sub _http_accept_langs {
 
 ###########################################################################
 
-sub _compile {
-  # This big scarp routine compiles an entry.
-  # It returns either a coderef if there's brackety bits in this, or
-  #  otherwise a ref to a scalar.
-  
-  my $target = ref($_[0]) || $_[0];
-  
-  my(@code);
-  my(@c) = (''); # "chunks" -- scratch.
-  my $call_count = 0;
-  my $big_pile = '';
-  {
-    my $in_group = 0; # start out outside a group
-    my($m, @params); # scratch
-    
-    while($_[1] =~  # Iterate over chunks.
-     m<\G(
-       [^\~\[\]]+  # non-~[] stuff
-       |
-       ~.       # ~[, ~], ~~, ~other
-       |
-       \[          # [ presumably opening a group
-       |
-       \]          # ] presumably closing a group
-       |
-       ~           # terminal ~ ?
-       |
-       $
-     )>xgs
-    ) {
-      print "  \"$1\"\n" if DEBUG > 2;
-
-      if($1 eq '[' or $1 eq '') {       # "[" or end
-        # Whether this is "[" or end, force processing of any
-        #  preceding literal.
-        if($in_group) {
-          if($1 eq '') {
-            $target->_die_pointing($_[1], "Unterminated bracket group");
-          } else {
-            $target->_die_pointing($_[1], "You can't nest bracket groups");
-          }
-        } else {
-          if($1 eq '') {
-            print "   [end-string]\n" if DEBUG > 2;
-          } else {
-            $in_group = 1;
-          }
-          die "How come \@c is empty?? in <$_[1]>" unless @c; # sanity
-          if(length $c[-1]) {
-            # Now actually processing the preceding literal
-            $big_pile .= $c[-1];
-            if($USE_LITERALS and (
-              (ord('A') == 65)
-               ? $c[-1] !~ m<[^\x20-\x7E]>s
-                  # ASCII very safe chars
-               : $c[-1] !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
-                  # EBCDIC very safe chars
-            )) {
-              # normal case -- all very safe chars
-              $c[-1] =~ s/'/\\'/g;
-              push @code, q{ '} . $c[-1] . "',\n";
-              $c[-1] = ''; # reuse this slot
-            } else {
-              push @code, ' $c[' . $#c . "],\n";
-              push @c, ''; # new chunk
-            }
-          }
-           # else just ignore the empty string.
-        }
-
-      } elsif($1 eq ']') {  # "]"
-        # close group -- go back in-band
-        if($in_group) {
-          $in_group = 0;
-          
-          print "   --Closing group [$c[-1]]\n" if DEBUG > 2;
-          
-          # And now process the group...
-          
-          if(!length($c[-1]) or $c[-1] =~ m/^\s+$/s) {
-            DEBUG > 2 and print "   -- (Ignoring)\n";
-            $c[-1] = ''; # reset out chink
-            next;
-          }
-          
-           #$c[-1] =~ s/^\s+//s;
-           #$c[-1] =~ s/\s+$//s;
-          ($m,@params) = split(",", $c[-1], -1);  # was /\s*,\s*/
-          
-          # A bit of a hack -- we've turned "~,"'s into DELs, so turn
-          #  'em into real commas here.
-          if (ord('A') == 65) { # ASCII, etc
-            foreach($m, @params) { tr/\x7F/,/ } 
-          } else {              # EBCDIC (1047, 0037, POSIX-BC)
-            # Thanks to Peter Prymmer for the EBCDIC handling
-            foreach($m, @params) { tr/\x07/,/ } 
-          }
-          
-          # Special-case handling of some method names:
-          if($m eq '_*' or $m =~ m<^_(-?\d+)$>s) {
-            # Treat [_1,...] as [,_1,...], etc.
-            unshift @params, $m;
-            $m = '';
-          } elsif($m eq '*') {
-            $m = 'quant'; # "*" for "times": "4 cars" is 4 times "cars"
-          } elsif($m eq '#') {
-            $m = 'numf';  # "#" for "number": [#,_1] for "the number _1"
-          }
-
-          # Most common case: a simple, legal-looking method name
-          if($m eq '') {
-            # 0-length method name means to just interpolate:
-            push @code, ' (';
-          } elsif($m =~ m<^\w+(?:\:\:\w+)*$>s
-            and $m !~ m<(?:^|\:)\d>s
-             # exclude starting a (sub)package or symbol with a digit 
-          ) {
-            # Yes, it even supports the demented (and undocumented?)
-            #  $obj->Foo::bar(...) syntax.
-            $target->_die_pointing(
-              $_[1], "Can't (yet?) use \"SUPER::\" in a bracket-group method",
-              2 + length($c[-1])
-            )
-             if $m =~ m/^SUPER::/s;
-              # Because for SUPER:: to work, we'd have to compile this into
-              #  the right package, and that seems just not worth the bother,
-              #  unless someone convinces me otherwise.
-            
-            push @code, ' $_[0]->' . $m . '(';
-          } else {
-            # TODO: implement something?  or just too icky to consider?
-            $target->_die_pointing(
-             $_[1],
-             "Can't use \"$m\" as a method name in bracket group",
-             2 + length($c[-1])
-            );
-          }
-          
-          pop @c; # we don't need that chunk anymore
-          ++$call_count;
-          
-          foreach my $p (@params) {
-            if($p eq '_*') {
-              # Meaning: all parameters except $_[0]
-              $code[-1] .= ' @_[1 .. $#_], ';
-               # and yes, that does the right thing for all @_ < 3
-            } elsif($p =~ m<^_(-?\d+)$>s) {
-              # _3 meaning $_[3]
-              $code[-1] .= '$_[' . (0 + $1) . '], ';
-            } elsif($USE_LITERALS and (
-              (ord('A') == 65)
-               ? $p !~ m<[^\x20-\x7E]>s
-                  # ASCII very safe chars
-               : $p !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
-                  # EBCDIC very safe chars            
-            )) {
-              # Normal case: a literal containing only safe characters
-              $p =~ s/'/\\'/g;
-              $code[-1] .= q{'} . $p . q{', };
-            } else {
-              # Stow it on the chunk-stack, and just refer to that.
-              push @c, $p;
-              push @code, ' $c[' . $#c . "], ";
-            }
-          }
-          $code[-1] .= "),\n";
-
-          push @c, '';
-        } else {
-          $target->_die_pointing($_[1], "Unbalanced ']'");
-        }
-        
-      } elsif(substr($1,0,1) ne '~') {
-        # it's stuff not containing "~" or "[" or "]"
-        # i.e., a literal blob
-        $c[-1] .= $1;
-        
-      } elsif($1 eq '~~') { # "~~"
-        $c[-1] .= '~';
-        
-      } elsif($1 eq '~[') { # "~["
-        $c[-1] .= '[';
-        
-      } elsif($1 eq '~]') { # "~]"
-        $c[-1] .= ']';
-
-      } elsif($1 eq '~,') { # "~,"
-        if($in_group) {
-          # This is a hack, based on the assumption that no-one will actually
-          # want a DEL inside a bracket group.  Let's hope that's it's true.
-          if (ord('A') == 65) { # ASCII etc
-            $c[-1] .= "\x7F";
-          } else {              # EBCDIC (cp 1047, 0037, POSIX-BC)
-            $c[-1] .= "\x07";
-          }
-        } else {
-          $c[-1] .= '~,';
-        }
-        
-      } elsif($1 eq '~') { # possible only at string-end, it seems.
-        $c[-1] .= '~';
-        
-      } else {
-        # It's a "~X" where X is not a special character.
-        # Consider it a literal ~ and X.
-        $c[-1] .= $1;
-      }
-    }
-  }
-
-  if($call_count) {
-    undef $big_pile; # Well, nevermind that.
-  } else {
-    # It's all literals!  Ahwell, that can happen.
-    # So don't bother with the eval.  Return a SCALAR reference.
-    return \$big_pile;
-  }
-
-  die "Last chunk isn't null??" if @c and length $c[-1]; # sanity
-  print scalar(@c), " chunks under closure\n" if DEBUG;
-  if(@code == 0) { # not possible?
-    print "Empty code\n" if DEBUG;
-    return \'';
-  } elsif(@code > 1) { # most cases, presumably!
-    unshift @code, "join '',\n";
-  }
-  unshift @code, "use strict; sub {\n";
-  push @code, "}\n";
-
-  print @code if DEBUG;
-  my $sub = eval(join '', @code);
-  die "$@ while evalling" . join('', @code) if $@; # Should be impossible.
-  return $sub;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _die_pointing {
-  # This is used by _compile to throw a fatal error
-  my $target = shift; # class name
-  # ...leaving $_[0] the error-causing text, and $_[1] the error message
-  
-  my $i = index($_[0], "\n");
-
-  my $pointy;
-  my $pos = pos($_[0]) - (defined($_[2]) ? $_[2] : 0) - 1;
-  if($pos < 1) {
-    $pointy = "^=== near there\n";
-  } else { # we need to space over
-    my $first_tab = index($_[0], "\t");
-    if($pos > 2 and ( -1 == $first_tab  or  $first_tab > pos($_[0]))) {
-      # No tabs, or the first tab is harmlessly after where we will point to,
-      # AND we're far enough from the margin that we can draw a proper arrow.
-      $pointy = ('=' x $pos) . "^ near there\n";
-    } else {
-      # tabs screw everything up!
-      $pointy = substr($_[0],0,$pos);
-      $pointy =~ tr/\t //cd;
-       # make everything into whitespace, but preseving tabs
-      $pointy .= "^=== near there\n";
-    }
-  }
-  
-  my $errmsg = "$_[1], in\:\n$_[0]";
-  
-  if($i == -1) {
-    # No newline.
-    $errmsg .= "\n" . $pointy;
-  } elsif($i == (length($_[0]) - 1)  ) {
-    # Already has a newline at end.
-    $errmsg .= $pointy;
-  } else {
-    # don't bother with the pointy bit, I guess.
-  }
-  Carp::croak( "$errmsg via $target, as used" );
-}
-
-###########################################################################
-
 my %tried = ();
   # memoization of whether we've used this module, or found it unusable.
 
diff --git a/lib/Locale/Maketext/ChangeLog b/lib/Locale/Maketext/ChangeLog
index 46a88618e6..a801c2f4a8 100644
--- a/lib/Locale/Maketext/ChangeLog
+++ b/lib/Locale/Maketext/ChangeLog
@@ -1,6 +1,11 @@
 Revision history for Perl suite Locale::Maketext
-                                        Time-stamp: "2003-04-18 22:07:29 AHDT"
+                                        Time-stamp: "2003-06-21 23:38:38 AHDT"
 
+2003-06-21  Sean M. Burke  sburke@cpan.org
+	* Release 1.06:  Now has "use utf8" to make the things work
+	happily.  Some fancy footwork is required to make this work under
+	pre-utf8 perl versions.
+	
 2003-04-18  Sean M. Burke  sburke@cpan.org
 	* Release 1.05:  Different Makefile.PL, same .pm code.
 	
diff --git a/lib/Locale/Maketext/Guts.pm b/lib/Locale/Maketext/Guts.pm
new file mode 100644
index 0000000000..72f0c9b3a1
--- /dev/null
+++ b/lib/Locale/Maketext/Guts.pm
@@ -0,0 +1,295 @@
+
+package Locale::Maketext::Guts;
+BEGIN { *zorp = sub { return scalar @_ } unless defined &zorp; }
+ # Just so we're nice and define SOMETHING in "our" package.
+
+package Locale::Maketext;
+use strict;
+use vars qw($USE_LITERALS $GUTSPATH);
+
+BEGIN {
+  $GUTSPATH = __FILE__;
+  *DEBUG = sub () {0} unless defined &DEBUG;
+}
+
+use utf8;
+
+sub _compile {
+  # This big scary routine compiles an entry.
+  # It returns either a coderef if there's brackety bits in this, or
+  #  otherwise a ref to a scalar.
+  
+  my $target = ref($_[0]) || $_[0];
+  
+  my(@code);
+  my(@c) = (''); # "chunks" -- scratch.
+  my $call_count = 0;
+  my $big_pile = '';
+  {
+    my $in_group = 0; # start out outside a group
+    my($m, @params); # scratch
+    
+    while($_[1] =~  # Iterate over chunks.
+     m<\G(
+       [^\~\[\]]+  # non-~[] stuff
+       |
+       ~.       # ~[, ~], ~~, ~other
+       |
+       \[          # [ presumably opening a group
+       |
+       \]          # ] presumably closing a group
+       |
+       ~           # terminal ~ ?
+       |
+       $
+     )>xgs
+    ) {
+      print "  \"$1\"\n" if DEBUG > 2;
+
+      if($1 eq '[' or $1 eq '') {       # "[" or end
+        # Whether this is "[" or end, force processing of any
+        #  preceding literal.
+        if($in_group) {
+          if($1 eq '') {
+            $target->_die_pointing($_[1], "Unterminated bracket group");
+          } else {
+            $target->_die_pointing($_[1], "You can't nest bracket groups");
+          }
+        } else {
+          if($1 eq '') {
+            print "   [end-string]\n" if DEBUG > 2;
+          } else {
+            $in_group = 1;
+          }
+          die "How come \@c is empty?? in <$_[1]>" unless @c; # sanity
+          if(length $c[-1]) {
+            # Now actually processing the preceding literal
+            $big_pile .= $c[-1];
+            if($USE_LITERALS and (
+              (ord('A') == 65)
+               ? $c[-1] !~ m<[^\x20-\x7E]>s
+                  # ASCII very safe chars
+               : $c[-1] !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
+                  # EBCDIC very safe chars
+            )) {
+              # normal case -- all very safe chars
+              $c[-1] =~ s/'/\\'/g;
+              push @code, q{ '} . $c[-1] . "',\n";
+              $c[-1] = ''; # reuse this slot
+            } else {
+              push @code, ' $c[' . $#c . "],\n";
+              push @c, ''; # new chunk
+            }
+          }
+           # else just ignore the empty string.
+        }
+
+      } elsif($1 eq ']') {  # "]"
+        # close group -- go back in-band
+        if($in_group) {
+          $in_group = 0;
+          
+          print "   --Closing group [$c[-1]]\n" if DEBUG > 2;
+          
+          # And now process the group...
+          
+          if(!length($c[-1]) or $c[-1] =~ m/^\s+$/s) {
+            DEBUG > 2 and print "   -- (Ignoring)\n";
+            $c[-1] = ''; # reset out chink
+            next;
+          }
+          
+           #$c[-1] =~ s/^\s+//s;
+           #$c[-1] =~ s/\s+$//s;
+          ($m,@params) = split(",", $c[-1], -1);  # was /\s*,\s*/
+          
+          # A bit of a hack -- we've turned "~,"'s into DELs, so turn
+          #  'em into real commas here.
+          if (ord('A') == 65) { # ASCII, etc
+            foreach($m, @params) { tr/\x7F/,/ } 
+          } else {              # EBCDIC (1047, 0037, POSIX-BC)
+            # Thanks to Peter Prymmer for the EBCDIC handling
+            foreach($m, @params) { tr/\x07/,/ } 
+          }
+          
+          # Special-case handling of some method names:
+          if($m eq '_*' or $m =~ m<^_(-?\d+)$>s) {
+            # Treat [_1,...] as [,_1,...], etc.
+            unshift @params, $m;
+            $m = '';
+          } elsif($m eq '*') {
+            $m = 'quant'; # "*" for "times": "4 cars" is 4 times "cars"
+          } elsif($m eq '#') {
+            $m = 'numf';  # "#" for "number": [#,_1] for "the number _1"
+          }
+
+          # Most common case: a simple, legal-looking method name
+          if($m eq '') {
+            # 0-length method name means to just interpolate:
+            push @code, ' (';
+          } elsif($m =~ m<^\w+(?:\:\:\w+)*$>s
+            and $m !~ m<(?:^|\:)\d>s
+             # exclude starting a (sub)package or symbol with a digit 
+          ) {
+            # Yes, it even supports the demented (and undocumented?)
+            #  $obj->Foo::bar(...) syntax.
+            $target->_die_pointing(
+              $_[1], "Can't (yet?) use \"SUPER::\" in a bracket-group method",
+              2 + length($c[-1])
+            )
+             if $m =~ m/^SUPER::/s;
+              # Because for SUPER:: to work, we'd have to compile this into
+              #  the right package, and that seems just not worth the bother,
+              #  unless someone convinces me otherwise.
+            
+            push @code, ' $_[0]->' . $m . '(';
+          } else {
+            # TODO: implement something?  or just too icky to consider?
+            $target->_die_pointing(
+             $_[1],
+             "Can't use \"$m\" as a method name in bracket group",
+             2 + length($c[-1])
+            );
+          }
+          
+          pop @c; # we don't need that chunk anymore
+          ++$call_count;
+          
+          foreach my $p (@params) {
+            if($p eq '_*') {
+              # Meaning: all parameters except $_[0]
+              $code[-1] .= ' @_[1 .. $#_], ';
+               # and yes, that does the right thing for all @_ < 3
+            } elsif($p =~ m<^_(-?\d+)$>s) {
+              # _3 meaning $_[3]
+              $code[-1] .= '$_[' . (0 + $1) . '], ';
+            } elsif($USE_LITERALS and (
+              (ord('A') == 65)
+               ? $p !~ m<[^\x20-\x7E]>s
+                  # ASCII very safe chars
+               : $p !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
+                  # EBCDIC very safe chars            
+            )) {
+              # Normal case: a literal containing only safe characters
+              $p =~ s/'/\\'/g;
+              $code[-1] .= q{'} . $p . q{', };
+            } else {
+              # Stow it on the chunk-stack, and just refer to that.
+              push @c, $p;
+              push @code, ' $c[' . $#c . "], ";
+            }
+          }
+          $code[-1] .= "),\n";
+
+          push @c, '';
+        } else {
+          $target->_die_pointing($_[1], "Unbalanced ']'");
+        }
+        
+      } elsif(substr($1,0,1) ne '~') {
+        # it's stuff not containing "~" or "[" or "]"
+        # i.e., a literal blob
+        $c[-1] .= $1;
+        
+      } elsif($1 eq '~~') { # "~~"
+        $c[-1] .= '~';
+        
+      } elsif($1 eq '~[') { # "~["
+        $c[-1] .= '[';
+        
+      } elsif($1 eq '~]') { # "~]"
+        $c[-1] .= ']';
+
+      } elsif($1 eq '~,') { # "~,"
+        if($in_group) {
+          # This is a hack, based on the assumption that no-one will actually
+          # want a DEL inside a bracket group.  Let's hope that's it's true.
+          if (ord('A') == 65) { # ASCII etc
+            $c[-1] .= "\x7F";
+          } else {              # EBCDIC (cp 1047, 0037, POSIX-BC)
+            $c[-1] .= "\x07";
+          }
+        } else {
+          $c[-1] .= '~,';
+        }
+        
+      } elsif($1 eq '~') { # possible only at string-end, it seems.
+        $c[-1] .= '~';
+        
+      } else {
+        # It's a "~X" where X is not a special character.
+        # Consider it a literal ~ and X.
+        $c[-1] .= $1;
+      }
+    }
+  }
+
+  if($call_count) {
+    undef $big_pile; # Well, nevermind that.
+  } else {
+    # It's all literals!  Ahwell, that can happen.
+    # So don't bother with the eval.  Return a SCALAR reference.
+    return \$big_pile;
+  }
+
+  die "Last chunk isn't null??" if @c and length $c[-1]; # sanity
+  print scalar(@c), " chunks under closure\n" if DEBUG;
+  if(@code == 0) { # not possible?
+    print "Empty code\n" if DEBUG;
+    return \'';
+  } elsif(@code > 1) { # most cases, presumably!
+    unshift @code, "join '',\n";
+  }
+  unshift @code, "use strict; sub {\n";
+  push @code, "}\n";
+
+  print @code if DEBUG;
+  my $sub = eval(join '', @code);
+  die "$@ while evalling" . join('', @code) if $@; # Should be impossible.
+  return $sub;
+}
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+sub _die_pointing {
+  # This is used by _compile to throw a fatal error
+  my $target = shift; # class name
+  # ...leaving $_[0] the error-causing text, and $_[1] the error message
+  
+  my $i = index($_[0], "\n");
+
+  my $pointy;
+  my $pos = pos($_[0]) - (defined($_[2]) ? $_[2] : 0) - 1;
+  if($pos < 1) {
+    $pointy = "^=== near there\n";
+  } else { # we need to space over
+    my $first_tab = index($_[0], "\t");
+    if($pos > 2 and ( -1 == $first_tab  or  $first_tab > pos($_[0]))) {
+      # No tabs, or the first tab is harmlessly after where we will point to,
+      # AND we're far enough from the margin that we can draw a proper arrow.
+      $pointy = ('=' x $pos) . "^ near there\n";
+    } else {
+      # tabs screw everything up!
+      $pointy = substr($_[0],0,$pos);
+      $pointy =~ tr/\t //cd;
+       # make everything into whitespace, but preseving tabs
+      $pointy .= "^=== near there\n";
+    }
+  }
+  
+  my $errmsg = "$_[1], in\:\n$_[0]";
+  
+  if($i == -1) {
+    # No newline.
+    $errmsg .= "\n" . $pointy;
+  } elsif($i == (length($_[0]) - 1)  ) {
+    # Already has a newline at end.
+    $errmsg .= $pointy;
+  } else {
+    # don't bother with the pointy bit, I guess.
+  }
+  Carp::croak( "$errmsg via $target, as used" );
+}
+
+1;
+
diff --git a/lib/Locale/Maketext/GutsLoader.pm b/lib/Locale/Maketext/GutsLoader.pm
new file mode 100644
index 0000000000..5cce12e37b
--- /dev/null
+++ b/lib/Locale/Maketext/GutsLoader.pm
@@ -0,0 +1,47 @@
+
+package Locale::Maketext::GutsLoader;
+use strict;
+sub zorp { return scalar @_ }
+
+BEGIN {
+  $Locale::Maketext::GutsLoader::GUTSPATH = __FILE__;
+  *Locale::Maketext::DEBUG = sub () {0}
+   unless defined &Locale::Maketext::DEBUG;
+}
+
+#
+# This whole drama is so that we can load the utf8'd code
+# in Locale::Maketext::Guts, but if that fails, snip the
+# utf8 and then try THAT.
+#
+
+$Locale::Maketext::GUTSPATH = '';
+Locale::Maketext::DEBUG and print "Requiring Locale::Maketext::Guts...\n";
+eval 'require Locale::Maketext::Guts';
+
+if($@) {
+  my $path = $Locale::Maketext::GUTSPATH;
+
+  die "Can't load Locale::Maketext::Guts\nAborting" unless $path;
+  
+  die "No readable file $Locale::Maketext::GutsLoader::GUTSPATH\nAborting"
+   unless -e $path and -f _ and -r _;
+
+  open(IN, $path) or die "Can't read-open $path\nAborting";
+  
+  my $source;
+  { local $/;  $source = <IN>; }
+  close(IN);
+  unless( $source =~ s/\b(use utf8)/# $1/ ) {
+    Locale::Maketext::DEBUG and
+     print "I didn't see 'use utf8' in $path\n";
+  }
+  eval $source;
+  die "Can't compile $path\n...The error I got was:\n$@\nAborting" if $@;
+  Locale::Maketext::DEBUG and print "Non-utf8'd Locale::Maketext::Guts fine\n";
+} else {
+  Locale::Maketext::DEBUG and print "Loaded Locale::Maketext::Guts fine\n";
+}
+
+1;
+
diff --git a/lib/Locale/Maketext/t/90utf8.t b/lib/Locale/Maketext/t/90utf8.t
new file mode 100644
index 0000000000..96731e2b19
--- /dev/null
+++ b/lib/Locale/Maketext/t/90utf8.t
@@ -0,0 +1,39 @@
+
+require 5;
+use Test;
+BEGIN { plan tests => 4; }
+use Locale::Maketext 1.01;
+print "# Hi there...\n";
+ok 1;
+
+
+print "# --- Making sure that get_handle works with utf8 ---\n";
+use utf8;
+
+# declare some classes...
+{
+  package Woozle;
+  @ISA = ('Locale::Maketext');
+  sub dubbil   { return $_[1] * 2  .chr(2000)}
+  sub numerate { return $_[2] . 'en'  }
+}
+{
+  package Woozle::eu_mt;
+  @ISA = ('Woozle');
+  %Lexicon = (
+   'd2' => chr(1000) . 'hum [dubbil,_1]',
+   'd3' => chr(1000) . 'hoo [quant,_1,zaz]',
+   'd4' => chr(1000) . 'hoo [*,_1,zaz]',
+  );
+  keys %Lexicon; # dodges the 'used only once' warning
+}
+
+my $lh;
+print "# Basic sanity:\n";
+ok defined( $lh = Woozle->get_handle('eu-mt') ) && ref($lh);
+ok $lh && $lh->maketext('d2', 7), chr(1000)."hum 14".chr(2000)   ;
+
+
+print "# Byebye!\n";
+ok 1;
+