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 5632f43ced7de3a40a3233e05a7cbf6e49a2a035..89b14d5d04d90642761dbe9ae3c8e7561ff50179 100644 (file)
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -5,23 +5,42 @@
 #
 # [Other people have contributed to this file; their copyrights should
 # go here too.]
 #
 # [Other people have contributed to this file; their copyrights should
 # go here too.]

-# Copyright 2004 by Collin Waston <cjwatson@debian.org>
+# Copyright 2004 by Collin Watson <cjwatson@debian.org>
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>

 
 
 package Debbugs::Log;
 
 
 
 package Debbugs::Log;
 

+
+use warnings;

 use strict;
 
 use strict;
 

-use Exporter ();
-use vars qw($VERSION @ISA @EXPORT);
+use vars qw($VERSION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use base qw(Exporter);

 
 BEGIN {
     $VERSION = 1.00;
 
 BEGIN {
     $VERSION = 1.00;

-
-    @ISA = qw(Exporter);
-    @EXPORT = qw(read_log_records write_log_records);
+    $DEBUG = 0 unless defined $DEBUG;
+
+    @EXPORT = ();
+    %EXPORT_TAGS = (write => [qw(write_log_records),
+                            ],
+                   read  => [qw(read_log_records),
+                            ],
+                   misc  => [qw(escape_log),
+                            ],
+                  );
+    @EXPORT_OK = ();
+    Exporter::export_ok_tags(qw(write read misc));
+    $EXPORT_TAGS{all} = [@EXPORT_OK];

 }
 
 }
 

+use Carp;
+
+use Debbugs::Common qw(getbuglocation getbugcomponent make_list);
+use Params::Validate qw(:types validate_with);
+use Encode qw(encode is_utf8);
+

 =head1 NAME
 
 Debbugs::Log - an interface to debbugs .log files
 =head1 NAME
 
 Debbugs::Log - an interface to debbugs .log files


@@ -119,15 +138,70 @@ C<[html]> as above; C<recips> is a reference to an array of recipients
 
 Creates a new log reader based on a .log filehandle.
 
 
 Creates a new log reader based on a .log filehandle.
 

+      my $log = Debbugs::Log->new($logfh);
+      my $log = Debbugs::Log->new(bug_num => $nnn);
+      my $log = Debbugs::Log->new(logfh => $logfh);
+
+Parameters
+
+=over
+
+=item bug_num -- bug number
+
+=item logfh -- log filehandle
+
+=item log_name -- name of log
+
+=back
+
+One of the above options must be passed.
+

 =cut
 
 sub new
 {
     my $this = shift;
 =cut
 
 sub new
 {
     my $this = 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 $class = ref($this) || $this;
     my $self = {};
     bless $self, $class;
     my $class = ref($this) || $this;
     my $self = {};
     bless $self, $class;

-    $self->{logfh} = shift;
+
+    if (exists $param{logfh}) {
+        $self->{logfh} = $param{logfh}
+    }
+    elsif (exists $param{log_name}) {
+        $self->{logfh} = IO::File->new($param{log_name},'r') or
+             die "Unable to open bug log $param{log_name} for reading: $!";
+    }
+    elsif (exists $param{bug_num}) {
+        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: $!";
+    }
+
+    binmode($self->{logfh},':utf8');

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


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


@@ -246,45 +342,98 @@ 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};

-       my $text = $record->{text};
-       die "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.
+       # croak "probably wrong encoding" if is_utf8($record->{text});
+       my ($text) = escape_log($record->{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;
-           print $logfh "\05\n$text\03\n";
+           #$text =~ s/^([\01-\07\030])/\030$1/gm;
+           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') {
        } elsif ($type eq 'incoming-recv') {

-           $text =~ s/^([\01-\07\030])/\030$1/gm;
-           print $logfh "\07\n$text\03\n";
+           #$text =~ s/^([\01-\07\030])/\030$1/gm;
+           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'";

        }
     }
 
     1;
 }
 
        }
     }
 
     1;
 }
 

-=back
+=head2 escape_log
+
+     print {$log} escape_log(@log)
+
+Applies the log escape regex to the passed logfile.
+
+=cut
+
+sub escape_log {
+       my @log = @_;
+       return map {s/^([\01-\07\030])/\030$1/gm; $_ } @log;
+}
+

 
 =head1 CAVEATS
 
 
 =head1 CAVEATS