6 use vars qw($VERSION @ISA @EXPORT);
12 @EXPORT = qw(read_log_records write_log_records);
17 Debbugs::Log - an interface to debbugs .log files
21 The Debbugs::Log module provides a convenient way for scripts to read and
22 write the .log files used by debbugs to store the complete textual records
23 of all bug transactions.
25 =head2 The .log File Format
27 .log files consist of a sequence of records, of one of the following four
28 types. ^A, ^B, etc. represent those control characters.
38 [mail] must start with /^Received: \(at \S+\) by \S+;/, and is copied to the
43 Auto-forwarded messages are recorded like this:
49 C<[mail]> must contain /^X-Debian-Bugs(-\w+)?: This is an autoforward from
50 \S+/. The first line matching that is removed; all lines in the message body
51 that begin with 'X' will be copied to the output, minus the 'X'.
53 Nothing in debbugs actually generates this record type any more, but it may
54 still be in old .logs at some sites.
59 [recip]^D[recip]^D[...] OR -t
64 Each [recip] is output after "Message sent"; C<-t> represents the same
65 sendmail option, indicating that the recipients are taken from the headers
66 of the message itself.
74 [html] is copied unescaped to the output. The record immediately following
75 this one is considered "boring" and only shown in certain output modes.
77 No other types of records are permitted, and the file must end with a ^C
82 =head2 Perl Record Representation
84 Each record is a hash. The C<type> field is C<incoming-recv>, C<autocheck>,
85 C<recips>, or C<html> as above; C<mail> and C<html> contain text as above;
86 C<recips> is a reference to an array of recipients (strings), or undef for
93 =item read_log_records
95 Takes a .log filehandle as input, and returns an array of all records in
96 that file. Throws exceptions using die(), so you may want to wrap this in an
101 sub read_log_records (*)
105 # This comes from bugreport.cgi, but is much simpler since it doesn't
106 # worry about the details of output.
114 7 => 'incoming-recv',
119 my $normstate = 'kill-init';
123 while (defined (my $line = <$logfh>)) {
126 if (length($line) == 1 and exists $states{ord($line)}) {
128 my $newstate = $states{ord($line)};
130 # disallowed transitions
131 $_ = "$normstate $newstate";
132 unless (/^(go|go-nox|html) kill-end$/ or
133 /^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/ or
135 die "transition from $normstate to $newstate at $linenum disallowed";
138 if ($newstate =~ /^(autocheck|recips|html|incoming-recv)$/) {
139 $record->{type} = $newstate;
140 } elsif ($newstate eq 'kill-end') {
141 push @records, $record;
145 $normstate = $newstate;
150 if ($normstate eq 'incoming-recv') {
152 unless (/^Received: \(at \S+\) by \S+;/) {
153 die "bad line '$pl' in state incoming-recv";
156 $record->{text} .= "$_\n";
157 } elsif ($normstate eq 'html') {
158 $record->{text} .= "$_\n";
159 } elsif ($normstate eq 'go') {
161 $record->{text} .= "$_\n";
162 } elsif ($normstate eq 'go-nox') {
163 $record->{text} .= "$_\n";
164 } elsif ($normstate eq 'recips') {
166 undef $record->{recips};
168 # preserve trailing null fields, e.g. #2298
169 $record->{recips} = [split /\04/, $_, -1];
171 $normstate = 'kill-body';
172 } elsif ($normstate eq 'autocheck') {
173 $record->{text} .= "$_\n";
174 next if !/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
175 $normstate = 'autowait';
176 } elsif ($normstate eq 'autowait') {
177 $record->{text} .= "$_\n";
179 $normstate = 'go-nox';
181 die "state $normstate at line $linenum ('$_')";
184 die "state $normstate at end" unless $normstate eq 'kill-end';
189 =item write_log_records
191 Takes a filehandle and a list of records as input, and prints the .log
192 format representation of those records to that filehandle.
196 sub write_log_records (*@)
201 for my $record (@records) {
202 my $type = $record->{type};
203 my $text = $record->{text};
204 die "type '$type' with no text field" unless defined $text;
205 if ($type eq 'autocheck') {
206 print $logfh "\01\n$text\03\n";
207 } elsif ($type eq 'recips') {
208 print $logfh "\02\n";
209 my $recips = $record->{recips};
210 if (defined $recips) {
211 die "recips not undef or array"
212 unless ref($recips) eq 'ARRAY';
213 print $logfh join("\04", @$recips) . "\n";
217 $text =~ s/^([\01-\07\030])/\030$1/gm;
218 print $logfh "\05\n$text\03\n";
219 } elsif ($type eq 'html') {
220 print $logfh "\06\n$text\03\n";
221 } elsif ($type eq 'incoming-recv') {
222 $text =~ s/^([\01-\07\030])/\030$1/gm;
223 print $logfh "\07\n$text\03\n";
225 die "unknown type '$type'";
236 This module does none of the formatting that bugreport.cgi et al do. It's
237 simply a means for extracting and rewriting raw records.