+# 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;
+
+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];
}
=head1 NAME
[html] is copied unescaped to the output. The record immediately following
this one is considered "boring" and only shown in certain output modes.
-No other types of records are permitted, and the file must end with a ^C
-line.
-
(This is a design flaw in the log format, since it makes it difficult to
change the HTML presentation later, or to present the data in an entirely
different format.)
=back
+No other types of records are permitted, and the file must end with a ^C
+line.
+
+=cut
+
+my %states = (
+ 1 => 'autocheck',
+ 2 => 'recips',
+ 3 => 'kill-end',
+ 5 => 'go',
+ 6 => 'html',
+ 7 => 'incoming-recv',
+);
+
=head2 Perl Record Representation
Each record is a hash. The C<type> field is C<incoming-recv>, C<autocheck>,
=over 4
-=item read_log_records
+=item new
-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().
+Creates a new log reader based on a .log filehandle.
=cut
-sub read_log_records (*)
+sub new
{
- my $logfh = shift;
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+ $self->{logfh} = shift;
+ $self->{state} = 'kill-init';
+ $self->{linenum} = 0;
+ return $self;
+}
- # This comes from bugreport.cgi, but is much simpler since it doesn't
- # worry about the details of output.
+=item read_record
- my %states = (
- 1 => 'autocheck',
- 2 => 'recips',
- 3 => 'kill-end',
- 5 => 'go',
- 6 => 'html',
- 7 => 'incoming-recv',
- );
+Reads and returns a single record from a log reader object. At end of file,
+returns undef. Throws exceptions using die(), so you may want to wrap this
+in an eval().
- my @records;
+=cut
+
+sub read_record
+{
+ my $this = shift;
+ my $logfh = $this->{logfh};
+
+ # This comes from bugreport.cgi, but is much simpler since it doesn't
+ # worry about the details of output.
- my $normstate = 'kill-init';
- my $linenum = 0;
my $record = {};
while (defined (my $line = <$logfh>)) {
chomp $line;
- ++$linenum;
+ ++$this->{linenum};
if (length($line) == 1 and exists $states{ord($line)}) {
# state transitions
my $newstate = $states{ord($line)};
# disallowed transitions
- $_ = "$normstate $newstate";
+ $_ = "$this->{state} $newstate";
unless (/^(go|go-nox|html) kill-end$/ or
/^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/ or
/^kill-body go$/) {
- die "transition from $normstate to $newstate at $linenum disallowed";
+ die "transition from $this->{state} to $newstate at $this->{linenum} disallowed";
}
- if ($newstate =~ /^(autocheck|recips|html|incoming-recv)$/) {
- $record->{type} = $newstate;
- } elsif ($newstate eq 'kill-end') {
- push @records, $record;
- $record = {};
+ $this->{state} = $newstate;
+
+ if ($this->{state} =~ /^(autocheck|recips|html|incoming-recv)$/) {
+ $record->{type} = $this->{state};
+ } elsif ($this->{state} eq 'kill-end') {
+ return $record;
}
- $normstate = $newstate;
next;
}
$_ = $line;
- if ($normstate eq 'incoming-recv') {
+ if ($this->{state} eq 'incoming-recv') {
my $pl = $_;
unless (/^Received: \(at \S+\) by \S+;/) {
die "bad line '$pl' in state incoming-recv";
}
- $normstate = 'go';
+ $this->{state} = 'go';
$record->{text} .= "$_\n";
- } elsif ($normstate eq 'html') {
+ } elsif ($this->{state} eq 'html') {
$record->{text} .= "$_\n";
- } elsif ($normstate eq 'go') {
+ } elsif ($this->{state} eq 'go') {
s/^\030//;
$record->{text} .= "$_\n";
- } elsif ($normstate eq 'go-nox') {
+ } elsif ($this->{state} eq 'go-nox') {
$record->{text} .= "$_\n";
- } elsif ($normstate eq 'recips') {
+ } elsif ($this->{state} eq 'recips') {
if (/^-t$/) {
undef $record->{recips};
} else {
# preserve trailing null fields, e.g. #2298
$record->{recips} = [split /\04/, $_, -1];
}
- $normstate = 'kill-body';
- } elsif ($normstate eq 'autocheck') {
+ $this->{state} = 'kill-body';
+ } elsif ($this->{state} eq 'autocheck') {
$record->{text} .= "$_\n";
next if !/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
- $normstate = 'autowait';
- } elsif ($normstate eq 'autowait') {
+ $this->{state} = 'autowait';
+ } elsif ($this->{state} eq 'autowait') {
$record->{text} .= "$_\n";
next if !/^$/;
- $normstate = 'go-nox';
+ $this->{state} = 'go-nox';
} else {
- die "state $normstate at line $linenum ('$_')";
+ die "state $this->{state} at line $this->{linenum} ('$_')";
}
}
- die "state $normstate at end" unless $normstate eq 'kill-end';
+ die "state $this->{state} at end" unless $this->{state} eq 'kill-end';
+
+ if (keys %$record) {
+ return $record;
+ } else {
+ return undef;
+ }
+}
+
+=item read_log_records
+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().
+
+=cut
+
+sub read_log_records (*)
+{
+ my $logfh = shift;
+
+ my @records;
+ my $reader = Debbugs::Log->new($logfh);
+ while (defined(my $record = $reader->read_record())) {
+ push @records, $record;
+ }
return @records;
}
for my $record (@records) {
my $type = $record->{type};
- my $text = $record->{text};
+ my ($text) = escapelog($record->{text});
die "type '$type' with no text field" unless defined $text;
if ($type eq 'autocheck') {
print $logfh "\01\n$text\03\n";
} else {
print $logfh "-t\n";
}
- $text =~ s/^([\01-\07\030])/\030$1/gm;
+ #$text =~ s/^([\01-\07\030])/\030$1/gm;
print $logfh "\05\n$text\03\n";
} elsif ($type eq 'html') {
print $logfh "\06\n$text\03\n";
} elsif ($type eq 'incoming-recv') {
- $text =~ s/^([\01-\07\030])/\030$1/gm;
+ #$text =~ s/^([\01-\07\030])/\030$1/gm;
print $logfh "\07\n$text\03\n";
} else {
die "unknown type '$type'";
1;
}
+=head2 escapelog
+
+ print {$log} escapelog(@log)
+
+Applies the log escape regex to the passed logfile.
+
+=cut
+
+sub escape_log {
+ my @log = @_;
+ return map { s/^([\01-\07\030])/\030$1/gm; $_ } @log;
+}
+
+
=back
=head1 CAVEATS