X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FLog.pm;h=551fd392a36fafea8b452377e30f19dbdc20d266;hb=9ba439f0dec2d3980de21b01d5f335a9d213158f;hp=97f0b0014b69b2aa2b212af2c5169d96f3af9a7b;hpb=675a95f52de1ddd355f5079fe39600b52b16084f;p=debbugs.git diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm index 97f0b00..551fd39 100644 --- a/Debbugs/Log.pm +++ b/Debbugs/Log.pm @@ -37,8 +37,9 @@ BEGIN { use Carp; -use Debbugs::Common qw(getbuglocation getbugcomponent); +use Debbugs::Common qw(getbuglocation getbugcomponent make_list); use Params::Validate qw(:types validate_with); +use Encode qw(encode encode_utf8 is_utf8); =head1 NAME @@ -50,6 +51,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 @@ -165,11 +171,11 @@ sub new ($param{logfh}) = @_; } else { - %param = validate_with(params => @_, + %param = validate_with(params => \@_, spec => {bug_num => {type => SCALAR, optional => 1, }, - logfh => {type => SCALAR, + logfh => {type => HANDLE, optional => 1, }, log_name => {type => SCALAR, @@ -299,14 +305,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; } @@ -318,38 +346,92 @@ 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) = escape_log($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'"; } } @@ -366,12 +448,10 @@ 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 - =head1 CAVEATS This module does none of the formatting that bugreport.cgi et al do. It's