X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCommon.pm;h=cf53b07e0e35344c35823496315585cd958df8ca;hb=refs%2Fheads%2Fdon%2Fcookies;hp=ae3c844936dcf26c09293d80e0a2bd3a77ac2074;hpb=d91858a335a8eba1d303261131ebb72ecc8b331a;p=debbugs.git

diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm
index ae3c844..cf53b07 100644
--- a/Debbugs/Common.pm
+++ b/Debbugs/Common.pm
@@ -39,7 +39,7 @@ BEGIN{
 
      @EXPORT = ();
      %EXPORT_TAGS = (util   => [qw(getbugcomponent getbuglocation getlocationpath get_hashname),
-				qw(appendfile buglog getparsedaddrs getmaintainers),
+				qw(appendfile overwritefile buglog getparsedaddrs getmaintainers),
 				qw(bug_status),
 				qw(getmaintainers_reverse),
 				qw(getpseudodesc),
@@ -55,7 +55,7 @@ BEGIN{
 		     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,10 +70,12 @@ use IO::Scalar;
 use Debbugs::MIME qw(decode_rfc1522);
 use Mail::Address;
 use Cwd qw(cwd);
+use Storable qw(dclone);
 
 use Params::Validate qw(validate_with :types);
 
 use Fcntl qw(:DEFAULT :flock);
+use Encode qw(is_utf8 decode_utf8);
 
 our $DEBUG_FH = \*STDERR if not defined $DEBUG_FH;
 
@@ -218,6 +220,28 @@ sub appendfile {
 	close $fh or die "Unable to close $file: $!";
 }
 
+=head2 overwritefile
+
+     ovewritefile($file,'data','to','append');
+
+Opens file.new, writes data to it, then moves file.new to file.
+
+=cut
+
+sub overwritefile {
+	my ($file,@data) = @_;
+	my $fh = IO::File->new("${file}.new",'w') or
+	     die "Unable top open ${file}.new for writing: $!";
+	print {$fh} @data or die "Unable to write to ${file}.new: $!";
+	close $fh or die "Unable to close ${file}.new: $!";
+	rename("${file}.new",$file) or
+	    die "Unable to rename ${file}.new to $file: $!";
+}
+
+
+
+
+
 =head2 getparsedaddrs
 
      my $address = getparsedaddrs($address);
@@ -407,6 +431,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*$/;
@@ -792,6 +817,10 @@ Will carp if given a scalar which isn't a scalarref or a glob (or
 globref), and return /dev/null. May return undef if IO::Scalar or
 IO::File fails. (Check $!)
 
+The scalar will fill with octets, not perl's internal encoding, so you
+must use decode_utf8() after on the scalar, and encode_utf8() on it
+before. This appears to be a bug in the underlying modules.
+
 =cut
 
 sub globify_scalar {
@@ -801,7 +830,12 @@ sub globify_scalar {
 	  if (defined ref($scalar)) {
 	       if (ref($scalar) eq 'SCALAR' and
 		   not UNIVERSAL::isa($scalar,'GLOB')) {
-		    return IO::Scalar->new($scalar);
+                   if (is_utf8(${$scalar})) {
+                       ${$scalar} = decode_utf8(${$scalar});
+                       carp(q(\$scalar must not be in perl's internal encoding));
+                   }
+		    open $handle, '>:scalar:utf8', $scalar;
+		    return $handle;
 	       }
 	       else {
 		    return $scalar;
@@ -814,7 +848,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','>:encoding(UTF-8)');
 }
 
 =head2 cleanup_eval_fail()
@@ -847,6 +881,8 @@ 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/^\t+.+\n?//g;
     # ditch trailing multiple periods in case there was a cascade of
     # die messages.
     $error =~ s/\.+$/\./;
@@ -870,6 +906,7 @@ sub hash_slice(\%@) {
     return map {exists $hashref->{$_}?($_,$hashref->{$_}):()} @keys;
 }
 
+
 1;
 
 __END__