X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FLog.pm;h=5a7306de38ecfd5ecee354e06961aad60610badd;hb=1f81df46999fc3699ce73aeba95af5095a5a413a;hp=90abe9c18a6e3e7330e7ef04097d6a5ee1cf9e39;hpb=580822d029b7914604e00b23974bd1baa8410bed;p=debbugs.git

diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm
index 90abe9c..5a7306d 100644
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -16,7 +16,7 @@ use warnings;
 use strict;
 
 use vars qw($VERSION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS);
-use base qw(Exporter);
+use Exporter qw(import);
 
 BEGIN {
     $VERSION = 1.00;
@@ -25,7 +25,7 @@ BEGIN {
     @EXPORT = ();
     %EXPORT_TAGS = (write => [qw(write_log_records),
 			     ],
-		    read  => [qw(read_log_records),
+		    read  => [qw(read_log_records record_text record_regex),
 			     ],
 		    misc  => [qw(escape_log),
 			     ],
@@ -35,6 +35,13 @@ BEGIN {
     $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 encode_utf8 is_utf8);
+use IO::InnerFile;
+
 =head1 NAME
 
 Debbugs::Log - an interface to debbugs .log files
@@ -45,6 +52,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.
 
+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
@@ -132,17 +144,76 @@ C<[html]> as above; C<recips> is a reference to an array of recipients
 
 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;
+    my %param;
+    if (@_ == 1) {
+	 ($param{logfh}) = @_;
+	 $param{inner_file} = 0;
+    }
+    else {
+	 %param = validate_with(params => \@_,
+				spec   => {bug_num => {type => SCALAR,
+						       optional => 1,
+						      },
+					   logfh   => {type => HANDLE,
+						       optional => 1,
+						      },
+					   log_name => {type => SCALAR,
+							optional => 1,
+                                   },
+                           inner_file => {type => BOOLEAN,
+                                          default => 0,
+                                         },
+					  }
+			       );
+    }
+    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;
-    $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: $!";
+    }
+
     $self->{state} = 'kill-init';
     $self->{linenum} = 0;
+    $self->{inner_file} = $param{inner_file};
     return $self;
 }
 
@@ -180,16 +251,21 @@ sub read_record
 	    }
 
 	    $this->{state} = $newstate;
-
 	    if ($this->{state} =~ /^(autocheck|recips|html|incoming-recv)$/) {
-		$record->{type} = $this->{state};
+            $record->{type} = $this->{state};
+            $record->{start} = $logfh->tell;
+            $record->{stop} = $logfh->tell;
+            $record->{inner_file} = $this->{inner_file};
 	    } elsif ($this->{state} eq 'kill-end') {
+            if ($this->{inner_file}) {
+                $record->{fh} = IO::InnerFile->new($logfh,$record->{start},$record->{stop} - $record->{start})
+            }
 		return $record;
 	    }
 
 	    next;
 	}
-
+    $record->{stop} = $logfh->tell;
 	$_ = $line;
 	if ($this->{state} eq 'incoming-recv') {
 	    my $pl = $_;
@@ -197,14 +273,14 @@ sub read_record
 		die "bad line '$pl' in state incoming-recv";
 	    }
 	    $this->{state} = 'go';
-	    $record->{text} .= "$_\n";
+	    $record->{text} .= "$_\n" unless $this->{inner_file};
 	} elsif ($this->{state} eq 'html') {
-	    $record->{text} .= "$_\n";
+	    $record->{text} .= "$_\n"  unless $this->{inner_file};
 	} elsif ($this->{state} eq 'go') {
 	    s/^\030//;
-	    $record->{text} .= "$_\n";
+	    $record->{text} .= "$_\n"  unless $this->{inner_file};
 	} elsif ($this->{state} eq 'go-nox') {
-	    $record->{text} .= "$_\n";
+	    $record->{text} .= "$_\n"  unless $this->{inner_file};
 	} elsif ($this->{state} eq 'recips') {
 	    if (/^-t$/) {
 		undef $record->{recips};
@@ -213,12 +289,15 @@ sub read_record
 		$record->{recips} = [split /\04/, $_, -1];
 	    }
 	    $this->{state} = 'kill-body';
+        $record->{start} = $logfh->tell+2;
+        $record->{stop} = $logfh->tell+2;
+        $record->{inner_file} = $this->{inner_file};
 	} elsif ($this->{state} eq 'autocheck') {
-	    $record->{text} .= "$_\n";
+	    $record->{text} .= "$_\n" unless $this->{inner_file};
 	    next if !/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
 	    $this->{state} = 'autowait';
 	} elsif ($this->{state} eq 'autowait') {
-	    $record->{text} .= "$_\n";
+	    $record->{text} .= "$_\n" unless $this->{inner_file};
 	    next if !/^$/;
 	    $this->{state} = 'go-nox';
 	} else {
@@ -240,14 +319,39 @@ 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().
 
+Uses exactly the same options as Debbugs::Log::new
+
 =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,
+						       },
+                           inner_file => {type => BOOLEAN,
+                                          default => 0,
+                                         },
+					  }
+			       );
+    }
+    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 $reader = Debbugs::Log->new($logfh);
+    my $reader = Debbugs::Log->new(%param);
     while (defined(my $record = $reader->read_record())) {
 	push @records, $record;
     }
@@ -259,47 +363,101 @@ 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.
 
+=back
+
 =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};
-	my ($text) = escapelog($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.
+        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";
+	    print {$logfh} "\01\n$text\03\n" or
+		die "Unable to write to logfile: $!";
 	} elsif ($type eq 'recips') {
-	    print $logfh "\02\n";
+	    print {$logfh} "\02\n";
 	    my $recips = $record->{recips};
 	    if (defined $recips) {
-		die "recips not undef or array"
+		croak "recips not undef or array"
 		    unless ref($recips) eq 'ARRAY';
-		print $logfh join("\04", @$recips) . "\n";
+                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 "-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";
+	    print {$logfh} "\05\n$text\03\n" or
+		die "Unable to write to logfile: $!";
 	} 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;
-	    print $logfh "\07\n$text\03\n";
+	    print {$logfh} "\07\n$text\03\n" or
+		die "Unable to write to logfile: $!";
 	} else {
-	    die "unknown type '$type'";
+	    croak "unknown record type type '$type'";
 	}
     }
 
     1;
 }
 
-=head2 escapelog
+=head2 escape_log
 
-     print {$log} escapelog(@log)
+     print {$log} escape_log(@log)
 
 Applies the log escape regex to the passed logfile.
 
@@ -307,11 +465,44 @@ Applies the log escape regex to the passed logfile.
 
 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
+sub record_text {
+    my ($record) = @_;
+    if ($record->{inner_file}) {
+        local $/;
+        my $text;
+        my $t = $record->{fh};
+        $text = <$t>;
+        $record->{fh}->seek(0,0);
+        return $text;
+    } else {
+        return $record->{text};
+    }
+}
+
+sub record_regex {
+    my ($record,$regex) = @_;
+    if ($record->{inner_file}) {
+        my @result;
+        my $fh = $record->{fh};
+        while (<$fh>) {
+            if (@result = $_ =~ m/$regex/) {
+                $record->{fh}->seek(0,0);
+                return @result;
+            }
+        }
+        $record->{fh}->seek(0,0);
+        return ();
+    } else {
+        my @result = $record->{text} =~ m/$regex/;
+        return @result;
+        return $record->{text};
+    }
+}
+
 
 =head1 CAVEATS