serve_cache is not exported by Debbugs::Libravatar

[debbugs.git] / Debbugs / Log.pm

diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm
index e64d2369a371b131466dd7f8d7fdf3e4aae4e73b..551fd392a36fafea8b452377e30f19dbdc20d266 100644 (file)
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -39,6 +39,7 @@ use Carp;
 
 use Debbugs::Common qw(getbuglocation getbugcomponent make_list);
 use Params::Validate qw(:types validate_with);
 
 use Debbugs::Common qw(getbuglocation getbugcomponent make_list);
 use Params::Validate qw(:types validate_with);

+use Encode qw(encode encode_utf8 is_utf8);

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -50,6 +51,11 @@ The Debbugs::Log module provides a convenient way for scripts to read and
 write the .log files used by debbugs to store the complete textual records
 of all bug transactions.
 
 write the .log files used by debbugs to store the complete textual records
 of all bug transactions.
 

+Debbugs::Log does not decode utf8 into perl's internal encoding or
+encode into utf8 from perl's internal encoding. For html records and
+all recips, this should probably be done. For other records, this should
+not be needed.
+

 =head2 The .log File Format
 
 .log files consist of a sequence of records, of one of the following four
 =head2 The .log File Format
 
 .log files consist of a sequence of records, of one of the following four


@@ -368,7 +374,7 @@ sub write_log_records
         $logfh = $param{logfh}
     }
     elsif (exists $param{log_name}) {
         $logfh = $param{logfh}
     }
     elsif (exists $param{log_name}) {

-        $logfh = IO::File->new($param{log_name},'w') or
+        $logfh = IO::File->new(">>$param{log_name}") or

              die "Unable to open bug log $param{log_name} for writing: $!";
     }
     elsif (exists $param{bug_num}) {
              die "Unable to open bug log $param{log_name} for writing: $!";
     }
     elsif (exists $param{bug_num}) {


@@ -381,8 +387,15 @@ sub write_log_records
 
     for my $record (@records) {
        my $type = $record->{type};
 
     for my $record (@records) {
        my $type = $record->{type};

-       my ($text) = escape_log($record->{text});
-       croak "record type '$type' with no text field" unless defined $text;
+       croak "record type '$type' with no text field" unless defined $record->{text};
+       # I am not sure if we really want to croak here; but this is
+       # almost certainly a bug if is_utf8 is on.
+        my $text = $record->{text};
+        if (is_utf8($text)) {
+            carp('Record text was in the wrong encoding (perl internal instead of utf8 octets)');
+            $text = encode_utf8($text)
+        }
+       ($text) = escape_log($text);

        if ($type eq 'autocheck') {
            print {$logfh} "\01\n$text\03\n" or
                die "Unable to write to logfile: $!";
        if ($type eq 'autocheck') {
            print {$logfh} "\01\n$text\03\n" or
                die "Unable to write to logfile: $!";


@@ -392,6 +405,15 @@ sub write_log_records
            if (defined $recips) {
                croak "recips not undef or array"
                    unless ref($recips) eq 'ARRAY';
            if (defined $recips) {
                croak "recips not undef or array"
                    unless ref($recips) eq 'ARRAY';

+                my $wrong_encoding = 0;
+                my @recips =
+                    map { if (is_utf8($_)) {
+                        $wrong_encoding=1;
+                        encode_utf8($_);
+                    } else {
+                        $_;
+                    }} @$recips;
+                carp('Recipients was in the wrong encoding (perl internal instead of utf8 octets') if $wrong_encoding;

                print {$logfh} join("\04", @$recips) . "\n" or
                    die "Unable to write to logfile: $!";
            } else {
                print {$logfh} join("\04", @$recips) . "\n" or
                    die "Unable to write to logfile: $!";
            } else {


@@ -426,7 +448,7 @@ Applies the log escape regex to the passed logfile.
 
 sub escape_log {
        my @log = @_;
 
 sub escape_log {
        my @log = @_;

-       return map { s/^([\01-\07\030])/\030$1/gm; $_ } @log;
+       return map {s/^([\01-\07\030])/\030$1/gm; $_ } @log;

 }
 
 
 }