Merge branch 'don/processencoding' of git+ssh://git.donarmstrong.com/srv/git/debbugs...

[debbugs.git] / Debbugs / Log.pm

diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm
index c4d741e6ab46f322a9519075c2d60cbba416de64..96748b7ee401813e6a096bf825a33122caca9daf 100644 (file)
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -37,8 +37,9 @@ BEGIN {
 
 use Carp;
 
 
 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
 


@@ -169,7 +170,7 @@ sub new
                                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,


@@ -200,6 +201,7 @@ sub new
              die "Unable to open bug log $bug_log for reading: $!";
     }
 
              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;


@@ -299,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;
     }


@@ -318,38 +342,76 @@ 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};

        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'";

        }
     }
 
        }
     }
 


@@ -366,12 +428,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 { eval {$_ = is_utf8($_)?encode("utf8",$_,Encode::FB_CROAK):$_;}; 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