From: Don Armstrong Date: Sun, 11 Aug 2019 02:15:22 +0000 (-0700) Subject: start mousifying log X-Git-Url: https://git.donarmstrong.com/debbugs.git?a=commitdiff_plain;h=refs%2Fheads%2Fdon%2Fmousify_log;p=debbugs.git start mousifying log --- diff --git a/lib/Debbugs/Control.pm b/lib/Debbugs/Control.pm index 1f8b3aa..1bb76a7 100644 --- a/lib/Debbugs/Control.pm +++ b/lib/Debbugs/Control.pm @@ -115,6 +115,7 @@ use Debbugs::UTF8; use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status); use Debbugs::CGI qw(html_escape); use Debbugs::Log qw(:misc :write); +use Debbugs::Log::Record; use Debbugs::Recipients qw(:add); use Debbugs::Packages qw(:versions :mapping); @@ -3475,10 +3476,11 @@ sub append_action_to_log{ }; $msg = ''; if ((ref($param{message}) and @{$param{message}}) or length($param{message})) { - push @records, {type => exists $param{recips}?'recips':'incoming-recv', - exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(), - text => join('',make_list($param{message})), - }; + push @records, Debbugs::Log::Record-> + new(type => exists $param{recips}?'recips':'incoming-recv', + exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(), + text => join('',make_list($param{message})), + ); } write_log_records(logfh=>$logfh, records => \@records, diff --git a/lib/Debbugs/Log.pm b/lib/Debbugs/Log.pm index 710a844..6dfce93 100644 --- a/lib/Debbugs/Log.pm +++ b/lib/Debbugs/Log.pm @@ -42,6 +42,7 @@ 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; +use Debbugs::Log::Record; =head1 NAME @@ -259,6 +260,30 @@ has '_linenum' => default => 0, ); +=item write + +writes a record + +=cut + +sub write { + my $self = shift; + + my @records = @_; + if (not defined ref($_[0])) { + @records = [@records]; + } + for my $record (@records) { + if (not isa($record,'Debbugs::Log::Record')) { + if (ref($record) ne 'ARRAY') { + croak("Debbugs::Log->write must be passed either a Debbugs::Log::Record or an ARRAYREF"); + } + $record = Debbugs::Log::Record->new(@{$record}); + } + + } +} + =item read_record Reads and returns a single record from a log reader object. At end of file, @@ -275,32 +300,27 @@ sub read_record # This comes from bugreport.cgi, but is much simpler since it doesn't # worry about the details of output. - my $record = {}; - + my $record; while (defined (my $line = <$logfh>)) { - $record->{start} = $logfh->tell() if not defined $record->{start}; + if (not defined $record) { + $record = + Debbugs::Log::Record->new(log_fh => $logfh, + start => $logfh->tell() + ); + } chomp $line; $this->increment_linenum; + $record->stop($logfh->tell); if (length($line) == 1 and exists $states{ord($line)}) { # state transitions $this->state_transition($states{ord($line)}); if ($this->state =~ /^(autocheck|recips|html|incoming-recv)$/) { - $record->{type} = $this->state; - $record->{start} = $logfh->tell; - $record->{stop} = $logfh->tell; - $record->{inner_file} = $this->inner_file; + $record->type($this->state); } elsif ($this->state eq 'kill-end') { - if ($this->inner_file) { - $record->{fh} = - IO::InnerFile->new($logfh,$record->{start}, - $record->{stop} - $record->{start}) - } - return $record; + return $record; } - next; } - $record->{stop} = $logfh->tell; $_ = $line; if ($this->state eq 'incoming-recv') { my $pl = $_; @@ -308,31 +328,30 @@ sub read_record die "bad line '$pl' in state incoming-recv"; } $this->state_transition('go'); - $record->{text} .= "$_\n" unless $this->inner_file; + $record->add_text($_."\n"); } elsif ($this->state eq 'html') { - $record->{text} .= "$_\n" unless $this->inner_file; + $record->add_text($_."\n"); } elsif ($this->state eq 'go') { s/^\030//; - $record->{text} .= "$_\n" unless $this->inner_file; + $record->add_text($_."\n"); } elsif ($this->state eq 'go-nox') { - $record->{text} .= "$_\n" unless $this->inner_file; + $record->add_text($_."\n"); } elsif ($this->state eq 'recips') { if (/^-t$/) { - undef $record->{recips}; + $record->recipients([]); } else { # preserve trailing null fields, e.g. #2298 - $record->{recips} = [split /\04/, $_, -1]; + $record->recipients([split /\04/, $_, -1]); } $this->state_transition('kill-body'); - $record->{start} = $logfh->tell+2; - $record->{stop} = $logfh->tell+2; - $record->{inner_file} = $this->inner_file; + $record->start($logfh->tell+2); + $record->stop($logfh->tell+2); } elsif ($this->state eq 'autocheck') { - $record->{text} .= "$_\n" unless $this->inner_file; + $record->add_text($_."\n"); next if !/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/; $this->state_transition('autowait'); } elsif ($this->state eq 'autowait') { - $record->{text} .= "$_\n" unless $this->inner_file; + $record->add_text($_."\n"); next if !/^$/; $this->state_transition('go-nox'); } else { @@ -341,11 +360,7 @@ sub read_record } die "state $this->state at end" unless $this->state eq 'kill-end'; - if (keys %$record) { - return $record; - } else { - return undef; - } + return $record; } =item rewind @@ -474,11 +489,11 @@ sub write_log_records my @records = make_list($param{records}); for my $record (@records) { - my $type = $record->{type}; - croak "record type '$type' with no text field" unless defined $record->{text}; + my $type = $record->type; + 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}; + 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) @@ -489,7 +504,7 @@ sub write_log_records die "Unable to write to logfile: $!"; } elsif ($type eq 'recips') { print {$logfh} "\02\n"; - my $recips = $record->{recips}; + my $recips = $record->recipients; if (defined $recips) { croak "recips not undef or array" unless ref($recips) eq 'ARRAY'; diff --git a/lib/Debbugs/Log/Record.pm b/lib/Debbugs/Log/Record.pm new file mode 100644 index 0000000..818b902 --- /dev/null +++ b/lib/Debbugs/Log/Record.pm @@ -0,0 +1,84 @@ +# 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. +# Copyright 2019 by Don Armstrong . + +package Debbugs::Log::Record; + +=head1 NAME + +Debbugs::Log::Record -- OO interface to bug log records + +=head1 SYNOPSIS + + use Debbugs::Log::Record; + +=head1 DESCRIPTION + + + +=cut + +use Mouse; +use strictures 2; +use namespace::clean; +use v5.10; # for state + + +has type => (is => 'rw', + isa => 'Str', + default => 'incoming-recv', + ); + +has start => (is => 'rw', + isa => 'Int', + ); + +has stop => (is => 'rw', + isa => 'Int', + ); + +has recipients => (is => 'rw', + isa => 'ArrayRef[Str]', + default => sub {[]} + ); + +has text => (is => 'ro', + isa => 'Str', + writer => '_text', + default => '', + ); + +sub add_text{ + my $self = shift; + $self->_text($self->text().join('',@_)); +} + +has log_fh => (is => 'rw', + isa => 'FileHandle', + ); +has fh => (is => 'rw', + lazy => 1, + builder => + sub {my $self = shift; + return + IO::InnerFile->new($self->log_fh, + $self->start, + $self->stop - $self->start, + ); + }, + ); + +__PACKAGE__->meta->make_immutable; + +no Mouse; +no Mouse::Util::TypeConstraints; +1; + + +__END__ +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: diff --git a/scripts/process b/scripts/process index 3da8f98..69a1fec 100755 --- a/scripts/process +++ b/scripts/process @@ -1136,9 +1136,11 @@ sub appendlog { my $logfh = IO::File->new(">>$log_location") or die "Unable to open $log_location for appending: $!"; write_log_records(logfh => $logfh, - records => [{type => 'incoming-recv', - text => $msg, - }]); + records => [Debbugs::Log::Record-> + new(type => 'incoming-recv', + text => $msg, + ) + ]); close ($logfh) or die "Unable to close $log_location: $!"; } @@ -1219,15 +1221,21 @@ sub sendmessage { # RFC1522 encode the header. $msg = encode_headers($msg) unless $no_encode; + my $log = Debbugs::Log->new($ref); + $log->write(text=>stripbccs($msg), + type => 'recips', + recipients => [map {encode_utf8($_)} @{$recips}] + ); my $hash = get_hashname($ref); #save email to the log my $logfh = IO::File->new(">>db-h/${hash}/${ref}.log") or die "opening db-h/$hash/${ref}.log: $!"; write_log_records(logfh => $logfh, - records => {text => stripbccs($msg), - type => 'recips', - recips => [map {encode_utf8($_)} @{$recips}], - }, + records => [Debbugs::Log::Record-> + new(text => stripbccs($msg), + type => 'recips', + recipients => [map {encode_utf8($_)} @{$recips}], + )], ); if (ref($bcc)) { shift @$recips if $recips->[0] eq '-t';