X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCommon.pm;h=4755fd5d2412f7fbf8f916be1765e417bad3abf8;hb=3cccbb53e0dfd0b7f970250da329615e15a54a99;hp=283f33ef58a6b517d62ebf362f0ccfa9fefc3b86;hpb=0294a1c5b3fde38107f81dd9a8048a299bd2a881;p=debbugs.git

diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm
index 283f33e..4755fd5 100644
--- a/Debbugs/Common.pm
+++ b/Debbugs/Common.pm
@@ -50,12 +50,13 @@ BEGIN{
 				qw(cleanup_eval_fail),
 				qw(hash_slice),
 			       ],
+		     utf8   => [qw(encode_utf8_structure encode_utf8_safely)],
 		     date   => [qw(secs_to_english)],
 		     quit   => [qw(quit)],
 		     lock   => [qw(filelock unfilelock lockpid)],
 		    );
      @EXPORT_OK = ();
-     Exporter::export_ok_tags(qw(lock quit date util misc));
+     Exporter::export_ok_tags(keys %EXPORT_TAGS);
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
@@ -70,6 +71,8 @@ use IO::Scalar;
 use Debbugs::MIME qw(decode_rfc1522);
 use Mail::Address;
 use Cwd qw(cwd);
+use Encode qw(encode_utf8 is_utf8);
+use Storable qw(dclone);
 
 use Params::Validate qw(validate_with :types);
 
@@ -429,6 +432,7 @@ sub __add_to_hash {
     $type //= 'address';
     my $fh = IO::File->new($fn,'r') or
 	die "Unable to open $fn for reading: $!";
+    binmode($fh,':encoding(UTF-8)');
     while (<$fh>) {
 	chomp;
 	next unless m/^(\S+)\s+(\S.*\S)\s*$/;
@@ -823,7 +827,8 @@ sub globify_scalar {
 	  if (defined ref($scalar)) {
 	       if (ref($scalar) eq 'SCALAR' and
 		   not UNIVERSAL::isa($scalar,'GLOB')) {
-		    return IO::Scalar->new($scalar);
+		    open $handle, '>:scalar:utf8', $scalar;
+		    return $handle;
 	       }
 	       else {
 		    return $scalar;
@@ -836,7 +841,7 @@ sub globify_scalar {
 	       carp "Given a non-scalar reference, non-glob to globify_scalar; returning /dev/null handle";
 	  }
      }
-     return IO::File->new('/dev/null','w');
+     return IO::File->new('/dev/null','>:utf8');
 }
 
 =head2 cleanup_eval_fail()
@@ -870,7 +875,7 @@ sub cleanup_eval_fail {
     # ditch the "at foo/bar/baz.pm line 5"
     $error =~ s/\sat\s\S+\sline\s\d+//;
     # ditch croak messages
-    $error =~ s/^\s{3,}.+//g;
+    $error =~ s/^\t+.+\n?//g;
     # ditch trailing multiple periods in case there was a cascade of
     # die messages.
     $error =~ s/\.+$/\./;
@@ -894,6 +899,70 @@ sub hash_slice(\%@) {
     return map {exists $hashref->{$_}?($_,$hashref->{$_}):()} @keys;
 }
 
+
+=head1 UTF-8
+
+These functions are exported with the :utf8 tag
+
+=head2 encode_utf8_structure
+
+     %newdata = encode_utf8_structure(%newdata);
+
+Takes a complex data structure and encodes any strings with is_utf8
+set into their constituent octets.
+
+=cut
+
+our $depth = 0;
+sub encode_utf8_structure {
+    ++$depth;
+    my @ret;
+    for my $_ (@_) {
+	if (ref($_) eq 'HASH') {
+	    push @ret, {encode_utf8_structure(%{$depth == 1 ? dclone($_):$_})};
+	}
+	elsif (ref($_) eq 'ARRAY') {
+	    push @ret, [encode_utf8_structure(@{$depth == 1 ? dclone($_):$_})];
+	}
+	elsif (ref($_)) {
+	    # we don't know how to handle non hash or non arrays
+	    push @ret,$_;
+	}
+	else {
+	    push @ret,encode_utf8_safely($_);
+	}
+    }
+    --$depth;
+    return @ret;
+}
+
+=head2 encode_utf8_safely
+
+     $octets = encode_utf8_safely($string);
+
+Given a $string, returns the octet equivalent of $string if $string is
+in perl's internal encoding; otherwise returns $string.
+
+Silently returns REFs without encoding them. [If you want to deeply
+encode REFs, see encode_utf8_structure.]
+
+=cut
+
+
+sub encode_utf8_safely{
+    my @ret;
+    for my $r (@_) {
+        if (not ref($r) and is_utf8($r)) {
+	    $r = encode_utf8($r);
+	}
+	push @ret,$r;
+    }
+    return wantarray ? @ret : (length @_ > 1 ? @ret : $_[0]);
+}
+
+
+
+
 1;
 
 __END__