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);
};
$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,
use Params::Validate qw(:types validate_with);
use Encode qw(encode encode_utf8 is_utf8);
use IO::InnerFile;
+use Debbugs::Log::Record;
=head1 NAME
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,
# 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 = $_;
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 {
}
die "state $this->state at end" unless $this->state eq 'kill-end';
- if (keys %$record) {
- return $record;
- } else {
- return undef;
- }
+ return $record;
}
=item rewind
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)
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';
--- /dev/null
+# 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 <don@donarmstrong.com>.
+
+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:
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: $!";
}
# 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';