X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FLog.pm;h=96748b7ee401813e6a096bf825a33122caca9daf;hb=4ac94f292bfbf36863795ed9d695be7ad2b5b344;hp=5632f43ced7de3a40a3233e05a7cbf6e49a2a035;hpb=dcb283c0a89bb0c05b78584657f6c8d12f6bf873;p=debbugs.git diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm index 5632f43..96748b7 100644 --- 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.] -# Copyright 2004 by Collin Waston +# Copyright 2004 by Collin Watson +# Copyright 2007 by Don Armstrong package Debbugs::Log; + +use warnings; 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; - - @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 @@ -119,15 +138,70 @@ C<[html]> as above; C 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}) = @_; + } + 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; - $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; @@ -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(). +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, + }, + } + ); + } + 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; } @@ -246,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. +=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 = $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') { - 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"; + 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"; + #$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') { - 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"; + #$text =~ s/^([\01-\07\030])/\030$1/gm; + 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; } -=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