git rid of encoding in Debbugs::Log; everything should be escaped before here.

[debbugs.git] / Debbugs / Log.pm

diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm
index d36bbe5b96fc429c9213ed81ce925b5017de1288..89b14d5d04d90642761dbe9ae3c8e7561ff50179 100644 (file)
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -35,9 +35,11 @@ BEGIN {
     $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
     $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 

+use Carp;

 
 

-use Debbugs::Common qw(getbuglocation getbugcomponent);
+use Debbugs::Common qw(getbuglocation getbugcomponent make_list);

 use Params::Validate qw(:types validate_with);
 use Params::Validate qw(:types validate_with);

+use Encode qw(encode is_utf8);

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -164,11 +166,11 @@ sub new
         ($param{logfh}) = @_;
     }
     else {
         ($param{logfh}) = @_;
     }
     else {

-        %param = validate_with(params => @_,
+        %param = validate_with(params => \@_,

                                spec   => {bug_num => {type => SCALAR,
                                                       optional => 1,
                                                      },
                                spec   => {bug_num => {type => SCALAR,
                                                       optional => 1,
                                                      },

-                                          logfh   => {type => SCALAR,
+                                          logfh   => {type => HANDLE,

                                                       optional => 1,
                                                      },
                                           log_name => {type => SCALAR,
                                                       optional => 1,
                                                      },
                                           log_name => {type => SCALAR,


@@ -177,7 +179,7 @@ sub new
                                          }
                               );
     }
                                          }
                               );
     }

-    if (grep {exists $param{$_} and defined $param{$_}} qw(bug_num logfh log_name) ne 3) {
+    if (grep({exists $param{$_} and defined $param{$_}} qw(bug_num logfh log_name)) ne 1) {

         croak "Exactly one of bug_num, logfh, or log_name must be passed and must be defined";
     }
 
         croak "Exactly one of bug_num, logfh, or log_name must be passed and must be defined";
     }
 


@@ -193,12 +195,13 @@ sub new
              die "Unable to open bug log $param{log_name} for reading: $!";
     }
     elsif (exists $param{bug_num}) {
              die "Unable to open bug log $param{log_name} for reading: $!";
     }
     elsif (exists $param{bug_num}) {

-        my $location = getbuglocation($bug,'log');
-        my $bug_log = getbugcomponent($bug,'log',$location);
+        my $location = getbuglocation($param{bug_num},'log');
+        my $bug_log = getbugcomponent($param{bug_num},'log',$location);

         $self->{logfh} = IO::File->new($bug_log, 'r') or
              die "Unable to open bug log $bug_log for reading: $!";
     }
 
         $self->{logfh} = IO::File->new($bug_log, 'r') or
              die "Unable to open bug log $bug_log for reading: $!";
     }
 

+    binmode($self->{logfh},':utf8');

     $self->{state} = 'kill-init';
     $self->{linenum} = 0;
     return $self;
     $self->{state} = 'kill-init';
     $self->{linenum} = 0;
     return $self;


@@ -298,14 +301,36 @@ Takes a .log filehandle as input, and returns an array of all records in
 that file. Throws exceptions using die(), so you may want to wrap this in an
 eval().
 
 that file. Throws exceptions using die(), so you may want to wrap this in an
 eval().
 

+Uses exactly the same options as Debbugs::Log::new
+

 =cut
 
 =cut
 

-sub read_log_records (*)
+sub read_log_records

 {
 {

-    my $logfh = shift;
+    my %param;
+    if (@_ == 1) {
+        ($param{logfh}) = @_;
+    }
+    else {
+        %param = validate_with(params => \@_,
+                               spec   => {bug_num => {type => SCALAR,
+                                                      optional => 1,
+                                                     },
+                                          logfh   => {type => HANDLE,
+                                                      optional => 1,
+                                                     },
+                                          log_name => {type => SCALAR,
+                                                       optional => 1,
+                                                      },
+                                         }
+                              );
+    }
+    if (grep({exists $param{$_} and defined $param{$_}} qw(bug_num logfh log_name)) ne 1) {
+        croak "Exactly one of bug_num, logfh, or log_name must be passed and must be defined";
+    }

 
     my @records;
 
     my @records;

-    my $reader = Debbugs::Log->new($logfh);
+    my $reader = Debbugs::Log->new(%param);

     while (defined(my $record = $reader->read_record())) {
        push @records, $record;
     }
     while (defined(my $record = $reader->read_record())) {
        push @records, $record;
     }


@@ -317,38 +342,79 @@ sub read_log_records (*)
 Takes a filehandle and a list of records as input, and prints the .log
 format representation of those records to that filehandle.
 
 Takes a filehandle and a list of records as input, and prints the .log
 format representation of those records to that filehandle.
 

+=back
+

 =cut
 
 =cut
 

-sub write_log_records (*@)
+sub write_log_records

 {
 {

-    my $logfh = shift;
-    my @records = @_;
+    my %param = validate_with(params => \@_,
+                             spec   => {bug_num => {type => SCALAR,
+                                                    optional => 1,
+                                                   },
+                                        logfh   => {type => HANDLE,
+                                                    optional => 1,
+                                                   },
+                                        log_name => {type => SCALAR,
+                                                     optional => 1,
+                                                    },
+                                        records => {type => HASHREF|ARRAYREF,
+                                                   },
+                                       },
+                            );
+    if (grep({exists $param{$_} and defined $param{$_}} qw(bug_num logfh log_name)) ne 1) {
+        croak "Exactly one of bug_num, logfh, or log_name must be passed and must be defined";
+    }
+    my $logfh;
+    if (exists $param{logfh}) {
+        $logfh = $param{logfh}
+    }
+    elsif (exists $param{log_name}) {
+        $logfh = IO::File->new(">>$param{log_name}") or
+             die "Unable to open bug log $param{log_name} for writing: $!";
+    }
+    elsif (exists $param{bug_num}) {
+        my $location = getbuglocation($param{bug_num},'log');
+        my $bug_log = getbugcomponent($param{bug_num},'log',$location);
+        $logfh = IO::File->new($bug_log, 'r') or
+             die "Unable to open bug log $bug_log for reading: $!";
+    }
+    my @records = make_list($param{records});

 
     for my $record (@records) {
        my $type = $record->{type};
 
     for my $record (@records) {
        my $type = $record->{type};

+       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.
+       # croak "probably wrong encoding" if is_utf8($record->{text});

        my ($text) = escape_log($record->{text});
        my ($text) = escape_log($record->{text});

-       die "type '$type' with no text field" unless defined $text;

        if ($type eq 'autocheck') {
        if ($type eq 'autocheck') {

-           print $logfh "\01\n$text\03\n";
+           print {$logfh} "\01\n$text\03\n" or
+               die "Unable to write to logfile: $!";

        } elsif ($type eq 'recips') {
        } elsif ($type eq 'recips') {

-           print $logfh "\02\n";
+           print {$logfh} "\02\n";

            my $recips = $record->{recips};
            if (defined $recips) {
            my $recips = $record->{recips};
            if (defined $recips) {

-               die "recips not undef or array"
+               croak "recips not undef or array"

                    unless ref($recips) eq 'ARRAY';
                    unless ref($recips) eq 'ARRAY';

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

            } else {
            } else {

-               print $logfh "-t\n";
+               print {$logfh} "-t\n" or
+                   die "Unable to write to logfile: $!";

            }
            #$text =~ s/^([\01-\07\030])/\030$1/gm;
            }
            #$text =~ s/^([\01-\07\030])/\030$1/gm;

-           print $logfh "\05\n$text\03\n";
+           print {$logfh} "\05\n$text\03\n" or
+               die "Unable to write to logfile: $!";

        } elsif ($type eq 'html') {
        } elsif ($type eq 'html') {

-           print $logfh "\06\n$text\03\n";
+           print {$logfh} "\06\n$text\03\n" or
+               die "Unable to write to logfile: $!";

        } elsif ($type eq 'incoming-recv') {
            #$text =~ s/^([\01-\07\030])/\030$1/gm;
        } elsif ($type eq 'incoming-recv') {
            #$text =~ s/^([\01-\07\030])/\030$1/gm;

-           print $logfh "\07\n$text\03\n";
+           print {$logfh} "\07\n$text\03\n" or
+               die "Unable to write to logfile: $!";

        } else {
        } else {

-           die "unknown type '$type'";
+           croak "unknown record type type '$type'";

        }
     }
 
        }
     }
 


@@ -365,12 +431,10 @@ 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;

 }
 
 
 }
 
 

-=back
-

 =head1 CAVEATS
 
 This module does none of the formatting that bugreport.cgi et al do. It's
 =head1 CAVEATS
 
 This module does none of the formatting that bugreport.cgi et al do. It's