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 c9a9e3002693531df28599014ef263f72f3626f6..96748b7ee401813e6a096bf825a33122caca9daf 100644 (file)
--- a/Debbugs/Log.pm
+++ b/Debbugs/Log.pm
@@ -1,17 +1,46 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# 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


@@ -109,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;


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


@@ -236,45 +342,95 @@ 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};
+       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 { eval {$_ = is_utf8($_)?encode("utf8",$_,Encode::FB_CROAK):$_;}; s/^([\01-\07\030])/\030$1/gm; $_ } @log;
+}
+

 
 =head1 CAVEATS
 
 
 =head1 CAVEATS