Introducing the 3rd generation PR viewer.

This is a significant improvement over the previous version, with more
robust patch handling, better encoding/charset handling, numerous
long-overdue bug fixes and a generally more maintainable codebase.

en/cgi/GnatsPR.pm

@@ -0,0 +1,636 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR;
+
+#use MIME::Base64;                      # ports/converters/p5-MIME-Base64
+#use MIME::QuotedPrint;                 #
+#use Convert::UU qw(uudecode uuencode); # ports/converters/p5-Convert-UU
+
+use GnatsPR::Section::Text;
+use GnatsPR::Section::Patch;
+use GnatsPR::Section::Email;
+use GnatsPR::Section::StateChange;
+use GnatsPR::Section::FieldStart;
+
+use GnatsPR::SectionIterator;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Constants
+#------------------------------------------------------------------------------
+
+use constant ENCODING_BASE64 => 1;
+use constant ENCODING_QP     => 2;
+
+use constant PATCH_ANY       => 0x0001;
+use constant PATCH_DIFF      => 0x0002;
+use constant PATCH_UUENC     => 0x0004;
+use constant PATCH_UUENC_BIN => 0x0008;
+use constant PATCH_SHAR      => 0x0010;
+use constant PATCH_BASE64    => 0x0020;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor - Parses data if provided.
+#
+# Args: [data] - Raw data (or ref. to) from query-pr (optional)
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my ($data) = @_;
+
+	my $self = {
+		blobs_single => {}, # Raw text, single-line fields
+		blobs_multi  => {}, # Raw text, multi-line fields
+		header       => {}, # E-mail header bits
+		sections     => {}, # Hash of arrayrefs of sections
+		fromwebform  => 0,  # PR came from the web form?
+		numfields    => 0   # Number of fields we have
+	};
+
+	bless $self, $class;
+
+	if (defined $data) {
+		my $dataref;
+
+		ref $data
+			? $dataref = $data
+			: $dataref = \$data;
+
+		$self->Parse($dataref);
+	}
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: Header()
+# Desc: Return a value from the header hash.
+#
+# Args: $key - Header name, case insensitive.
+#
+# Retn: $val - Value.
+#------------------------------------------------------------------------------
+
+sub Header
+{
+	my $self = shift;
+	my ($key) = @_;
+
+	return $self->{header}->{lc $key};
+}
+
+
+#------------------------------------------------------------------------------
+# Func: FieldSingle()
+# Desc: Return a single line field value.
+#
+# Args: $key - Field name.
+#
+# Retn: $val - Value.
+#------------------------------------------------------------------------------
+
+sub FieldSingle
+{
+	my $self = shift;
+	my ($key) = @_;
+
+	return $self->{blobs_single}->{$key};
+}
+
+
+#------------------------------------------------------------------------------
+# Func: Parse()
+# Desc: Parse a blob of text from query-pr into a structured unit for easy
+#       manipulation.
+#
+# Args: \$data - Raw data from query-pr (non-ref scalar is acceptable too).
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub Parse
+{
+	my $self = shift;
+	my ($data) = @_;
+
+	my $ismulti = 0;
+	my $pastheader = 0;
+
+	# GNATS ensures that > isn't allowed as the first
+	# character on a line, except for field headers.
+	# Any lines beginning with > will be shunted into
+	# 'Unformatted'
+	my @fieldblobs = split /\n>/m, $$data;
+
+	# In the rare case the Unformatted field did
+	# have some debris, be sure to assemble it back
+	# into a complete section.
+	while ($fieldblobs[$#fieldblobs] !~ /^Unformatted:/) {
+		my $last = pop @fieldblobs;
+		$fieldblobs[$#fieldblobs] .= $last;
+	}
+
+	foreach my $blob (@fieldblobs) {
+		my $key;
+
+		# Parse e-mail header; we only care about a few
+		# fields, not the e-mail routing stuff.
+		if (!$pastheader) {
+			foreach my $line (split /\n/, $blob) {
+				if ($line =~ /^(\S+):\s*(.*)$/) {
+					my $val = $2;
+					$key = lc $1;
+
+					# Ignore multiple defs (e.g. Received: headers)
+					exists $self->{header}->{$key}
+						and next;
+
+					$self->{header}->{$key} = $val;
+				} elsif ($line =~ /^\s+(.*)$/) {
+					my $val = $1;
+
+					defined $key
+						or next;
+
+					# No field to append to
+					exists $self->{header}->{$key}
+						or next;
+
+					$self->{header}->{$key} .= "\n$val";
+				}
+			}
+
+			$pastheader = 1;
+			next;
+		}
+
+		if ($blob =~ s/^([^:]+):(\n|\s*)//) {
+			$key = $1;
+			#$ismulti = ($2 and $2 eq "\n");
+
+			# It's multi-liners from here on in
+			$key eq 'Description'
+				and $ismulti = 1;
+		} else {
+			# Hmm...
+			next;
+		}
+
+		# Remove leading/trailing whitespace
+		$blob =~ s/^[\n\s]+//;
+		$blob =~ s/[\n\s]+$//;
+
+		if ($ismulti) {
+			$self->{blobs_multi}->{$key} = $blob;
+		} else {
+			$self->{blobs_single}->{$key} = $blob;
+		}
+	}
+
+	$self->{numfields} = scalar @fieldblobs;
+
+	$self->{fromwebform} =
+		$self->{header}->{'x-send-pr-version'} =~ /^www-/;
+
+	$self->ParseBlobs();
+}
+
+
+#------------------------------------------------------------------------------
+# Func: ParseBlobs()
+# Desc: Parse all the raw field "blobs" into section objects.
+#
+# Args: n/a
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub ParseBlobs
+{
+	my $self = shift;
+
+	foreach my $field (keys %{$self->{blobs_multi}}) {
+		$self->{sections}->{$field} = [];
+
+		push @{$self->{sections}->{$field}},
+			new GnatsPR::Section::FieldStart($field);
+
+		if ($field eq 'Fix') {
+			$self->ParsePatches($field, \($self->{blobs_multi}->{$field}));
+			next;
+		}
+
+		if ($field eq 'Audit-Trail') {
+			# We'll break up the Audit-Trail field by change events.
+			# This is the most reliable way to split, although it's far
+			# from perfect. We'll then look for e-mail responses inside
+			# each chunk for further splitting later.
+			#
+			# Notes/Caveats:
+			# - If someone happened to paste an audit trail event
+			#   inside another's "Why" field, it'd break this. I haven't
+			#   seen this yet and don't expect to.
+			# - The From-To field has to come first. No reason it wouldn't
+			#   under normal circumstances.
+			# - Pasted e-mails in the Why field will be promoted to
+			#   responses, although they often break the GNATS conventions
+			#   we (ab)use to find e-mails (e.g.: leading space on message
+			#   body lines), which makes this more difficult.
+			my @auditevents =
+				split /(?=^(?:[A-Za-z_]+)-Changed-From-To: (?:.*?)\s*$)/m,
+				$self->{blobs_multi}->{$field};
+
+			foreach my $evt (@auditevents) {
+				my $sect = new GnatsPR::Section::StateChange;
+				my $gotwhat = 0;
+				my $gotsect = 0;
+				while ($evt =~ s/^([A-Za-z_]+)-Changed-([A-Za-z_-]+?): (.*?)\s*\n//) {
+					my ($what, $key, $val) = ($1, $2, $3);
+
+					if (!$gotwhat) {
+						$sect->what($what);
+						$gotwhat = 1;
+					}
+
+					$gotsect = 1;
+
+					if ($key eq 'From-To') {
+						my $fromto = $val;
+						if ($fromto =~ /^(.*)->(.*)$/) {
+							$sect->from($1);
+							$sect->to($2);
+						}
+					} elsif ($key eq 'When') {
+						$sect->when($val);
+					} elsif ($key eq 'By') {
+						$sect->by($val);
+					} elsif ($key eq 'Why') {
+						# This is the last one; it's a multi-line
+						# field (remainder of the text.)
+						last;
+					}
+				}
+
+				push @{$self->{sections}->{$field}}, $sect
+					if ($gotsect);
+
+				# Now look for blocks that appear to be e-mail replies
+				# Note: these header fields are the only ones we allow
+				#       as the first header; we could feasibly back-
+				#       track to find the start of the block (in case
+				#       we're not there already), but the more headers
+				#       we accept the more likely this will break on
+				#       some unexpected content.
+				my $next_email = qr/^(From|To|Cc|Subject|Date): (.*)$/m;
+				my $gotwhy = 0;
+
+				while ($evt =~ /$next_email/) {
+					my $match_start = $-[0];
+					my ($header, $body, $indented);
+					my $why;
+
+					$match_start > 0
+						and $why = substr($evt, 0, $match_start, '');
+
+					if ($gotsect) {
+						# We now know where "Why" terminates
+						$sect->why($why) if $sect;
+					} elsif ($why) {
+						# If the first block was a date block,
+						# we need to use a text section for the
+						# intermediate text instead.
+						push @{$self->{sections}->{$field}},
+							new GnatsPR::Section::Text($why)
+							unless ($why =~ /^[\n\s]+$/);
+					}
+
+					$gotwhy = 1;
+					$sect = undef;
+
+					# Chop leading blank lines
+					$evt =~ s/^\n+//;
+
+					if ($evt =~ /^$/m) {
+						# First blank line signals the end of the
+						# e-mail header
+						$header = substr($evt, 0, $+[0]+1, '');
+
+						# Deciding where the body ends is more
+						# difficult...
+
+						# First, let's see if the message is
+						# indented (per GNATS standards)
+						$indented = ($evt =~ /^ /);
+
+						# If, so, find the next blank line, which
+						# signals the body end.
+						if ($indented) {
+							if ($evt =~ /^$/m) {
+								$body = substr($evt, 0, $-[0], '');
+							} else {
+								$body = $evt;
+							}
+							$body =~ s/^ //mg; # Remove indent char
+						} else {
+							# Look for another e-mail block
+							if ($evt =~ /$next_email/) {
+								$body = substr($evt, 0, $-[0], '');
+							} else {
+								# Otherwise, use the whole section
+								$body = $evt;
+							}
+						}
+
+						push @{$self->{sections}->{$field}},
+							new GnatsPR::Section::Email($header, $body);
+					} else {
+						# No end-of-header marker: no choice but to
+						# dump the (possible) e-mail into the Why field
+
+						if ($gotsect && $sect) {
+							$sect->why($evt);
+						} elsif ($evt) {
+							push @{$self->{sections}->{$field}},
+								new GnatsPR::Section::Text($evt);
+						}
+					}
+				}
+
+				# Check for dangling "Why" block
+				if (!$gotwhy) {
+					if ($gotsect && $sect) {
+						$sect->why($evt);
+					} elsif ($evt) {
+						push @{$self->{sections}->{$field}},
+							new GnatsPR::Section::Text($evt);
+					}
+				}
+			}
+
+			next;
+		}
+
+		# Everything else is just text
+		push @{$self->{sections}->{$field}},
+			new GnatsPR::Section::Text($self->{blobs_multi}->{$field});
+	}
+}
+
+
+#------------------------------------------------------------------------------
+# Func: ParsePatches()
+# Desc: Parse the patches out of the given blob of text, emitting Patch and
+#       Text sections as appropriate.
+#
+# Args: $field - Field to push new sections to.
+#       \$text - Raw text
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub ParsePatches
+{
+	my $self = shift;
+	my ($field, $text) = @_;
+
+	while (my $pi = $self->FindPatchStart($text)) {
+		# Everything up to this fragment can be
+		# promoted to a text section
+		push @{$self->{sections}->{$field}},
+			new GnatsPR::Section::Text(substr(
+				$$text,
+				0,
+				$pi->{start},
+				''
+			))
+			unless $pi->{start} == 0;
+
+		$pi->{start} = 0;
+
+		$self->FindPatchEnd($text, $pi);
+
+		# Try to determine if a web/send-pr attachment
+		# has another type of patch inside.
+		if ($pi->{type} eq 'stdattach' or $pi->{type} eq 'webattach') {
+			if (my $pi2 = $self->FindPatchStart($text)) {
+				# Upgrade to more specific type
+				$pi->{type} = $pi2->{type}
+					if ($pi2->{start} == 0);
+			}
+		}
+
+		push @{$self->{sections}->{$field}},
+			new GnatsPR::Section::Patch(substr(
+				$$text,
+				0,
+				$pi->{size},
+				''
+			), $pi->{name}, $pi->{type});
+
+		$$text =~ s/^[\n\s]+//;
+	}
+
+	# Rest of the field is text
+	push @{$self->{sections}->{$field}},
+		new GnatsPR::Section::Text($$text)
+		if ($$text);
+
+	$text = '';
+}
+
+
+#------------------------------------------------------------------------------
+# Func: FindPatchStart()
+# Desc: Find the beginning of the first patch inside the given text blob,
+#       if there is one.
+#
+# Args: \$text - Raw text
+#
+# Retn: \%pi   - Hash of patch info (or undef):
+#                  - start - Start offset of patch
+#                  - type  - Type of attachment found
+#                  - name  - Filename, if available
+#------------------------------------------------------------------------------
+
+sub FindPatchStart
+{
+	my $self = shift;
+	my ($text) = @_;
+
+	# Patch from web CGI script. Characteristics:
+	#   - Only ever one of them.
+	#   - Appended to the end of Fix:
+	#   - Blank line after header line
+	#   - Could contain other types of patch (e.g. shar(1) archive)
+	if ($$text =~ /^Patch attached with submission follows:$/m && $self->{fromwebform}) {
+		my $start = $+[0]; # The newline on the above
+
+		# Next non-blank line (i.e. start of patch)
+		if ($$text =~ /\G^./m) {
+			$start += $+[0]+1;
+			return {start => $start, type => 'webattach'};
+		}
+
+		return undef;
+	}
+
+	# Patch from send-pr(1). Characteristics:
+	#   - Has header and footer line.
+	#   - Appended to the end of Fix:
+	#   - User has an opportunity to edit/mangle.
+	#   - Could contain other types of patch (e.g. shar(1) archive)
+	if ($$text =~ /^---{1,8}\s?([A-Za-z0-9-_.,:%]+) (begins|starts) here\s?---+\n/mi) {
+		my $r = {start => $-[0], type => 'stdattach', name => $1};
+
+		# Chop header line
+		substr($$text, $-[0], $+[0] - $-[0], '');
+
+		return $r;
+	}
+
+	# Patch files from diff(1). Characteristics:
+	#   - Easy to find start.
+	#   - Difficult to find the end.
+	$$text =~ /^((?:(?:---|\*\*\*)\ (?:\S+)\s*(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)\ .*)
+			|(?:(?:---|\*\*\*)\ (?:\S+)\s*(?:\d\d\d\d-\d\d-\d\d\ \d\d:\d\d:\d\d\.\d+)\ .*)
+			|(diff\ -.*?\ .*?\ .*)|(Index:\ \S+)
+			|(\*{3}\ \d+,\d+\ \*{4}))$/mx
+		and return {start => $-[0], type => 'diff'};
+
+	# Shell archive from shar(1)
+	$$text =~ /^# This is a shell archive\.  Save it in a file, remove anything before/m
+		and return {start => $-[0], type => 'shar'};
+
+	# UUencoded file. Characteristics:
+	#   - Has header and footer.
+	$$text =~ /^begin \d\d\d (.*)/m
+		and return {start => $-[0], type => 'uuencoded'};
+
+	return undef;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: FindPatchEnd()
+# Desc: Find the end of the first patch inside the given text blob, if any.
+#
+# Args: \$text - Raw text
+#       \%pi   - Patch info hash from FindPatchStart(). We'll add more data:
+#                  - size - Length of the patch.
+#
+# Retn: \%pi   - Same as above, except undef will be returned if no actual
+#                endpoint was found (size in pi would extend to the end of the
+#                text blob in this case.)
+#------------------------------------------------------------------------------
+
+sub FindPatchEnd
+{
+	my $self = shift;
+	my ($text, $pi) = @_;
+
+	$pi->{size} = 0;
+
+	if ($pi->{type} eq 'webattach') {
+		$$text =~ /$/
+			and $pi->{size} = $+[0];
+	} elsif ($pi->{type} eq 'stdattach') {
+		$$text =~ /^---{1,8}\s?\Q$pi->{name}\E ends here\s?---+/mi
+			and $pi->{size} = $-[0]-1;
+		# Chop footer line
+		substr($$text, $-[0], $+[0] - $-[0], '');
+	} elsif ($pi->{type} eq 'diff') {
+		# XXX: could do better
+		$$text =~ /^$/m
+			and $pi->{size} = $-[0]-1;
+	} elsif ($pi->{type} eq 'shar') {
+		$$text =~ /^exit$/m
+			and $pi->{size} = $+[0];
+	} elsif ($pi->{type} eq 'uuencoded') {
+		$$text =~ /^end$/m
+			and $pi->{size} = $+[0];
+	}
+
+	if ($pi->{size} == 0) {
+		$pi->{size} = length $$text;
+		return undef;
+	}
+
+	return $pi;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: GetAttachment()
+# Desc: Recursively search sections for a downloadable attachment.
+#
+# Args: $num - Attachment index (counts from 1)
+#
+# Retn: $sec - Attachment section (or undef)
+#------------------------------------------------------------------------------
+
+sub GetAttachment
+{
+	my $self = shift;
+	my ($num) = @_;
+	my $cur = 1;
+
+	my $iter = GnatsPR::SectionIterator->new($self, 'Fix', 'Audit-Trail');
+
+	while (my $item = $iter->next()) {
+		if (ref $item eq 'GnatsPR::Section::Patch') {
+			# Patch sections
+			return $item if ($cur++ == $num);
+		} elsif (ref $item eq 'GnatsPR::Section::Email') {
+			# Attachments from MIME messages
+			my $mime_iter = GnatsPR::MIMEIterator->new($item);
+			while (my $part = $mime_iter->next()) {
+				if ($part->isattachment) {
+					return $part if ($cur++ == $num);
+				}
+			}
+		}
+	}
+
+	return undef;
+}
+
+
+1;

en/cgi/GnatsPR/MIMEIterator.pm

@@ -0,0 +1,153 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::MIMEIterator;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $email - GnatsPR::Section::Email instance.
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my $email = shift;
+
+	my $self = {
+		idxlist => [ -1 ],
+		email   => undef
+	};
+
+	bless $self, $class;
+
+	$self->{email} = $email;
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: next()
+# Desc: Return next iterator element.
+#
+# Args: n/a
+#
+# Retn: $next
+#------------------------------------------------------------------------------
+
+sub next
+{
+	my $self = shift;
+
+	my $curr = $self->_current();
+
+	while (1) {
+		my $next = ++$self->{idxlist}->[$#{$self->{idxlist}}];
+
+		# Past last element?
+		if ($next > $#{$curr->{mimeparts}}) {
+			# Back out
+			pop @{$self->{idxlist}};
+
+			# Reached the root
+			$#{$self->{idxlist}} > -1
+				or return undef;
+
+			$curr = $self->_current();
+			next;
+		}
+
+		last;
+	}
+
+	my $rpart = $curr->{mimeparts}->[$self->{idxlist}->[$#{$self->{idxlist}}]];
+
+	# Container part? - find a leaf node
+	while ($#{$rpart->{mimeparts}} > -1) {
+		$rpart = $rpart->{mimeparts}->[0];
+		push @{$self->{idxlist}}, 0;
+	}
+
+	return $rpart;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: isfirst()
+# Desc: Determine if the iterator is at the first element.
+#
+# Args: n/a
+#
+# Retn: $isfirst - true/false
+#------------------------------------------------------------------------------
+
+sub isfirst
+{
+	my $self = shift;
+
+	return (
+		$#{$self->{idxlist}} == 0
+		and $self->{idxlist}->[$#{$self->{idxlist}}] == 0
+	);
+}
+
+
+#------------------------------------------------------------------------------
+# Func: _current()
+# Desc: Traverse to, and return, the current container element.
+#
+# Args: n/a
+#
+# Retn: $curr
+#------------------------------------------------------------------------------
+
+sub _current
+{
+	my $self = shift;
+	my $curr = $self->{email};
+
+	# Find current MIME part container
+	for (my $depth = 0; $depth < $#{$self->{idxlist}}; $depth++) {
+		$curr = $curr->{mimeparts}->[$self->{idxlist}->[$depth]];
+	}
+
+	return $curr;
+}
+
+
+1;

en/cgi/GnatsPR/Section.pm

@@ -0,0 +1,58 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package Section;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: n/a
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+
+	my $self = {
+	};
+
+	bless $self, $class;
+	return $self;
+}
+
+
+1;

en/cgi/GnatsPR/Section/Email.pm

@@ -0,0 +1,189 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::Section::Email;
+
+use GnatsPR::Section::MIME;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $header - Raw e-mail header.
+#       $body   - Raw message body.
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my ($header, $body) = @_;
+
+	my $self = {
+		headerblob => '',
+		bodyblob   => '',
+
+		headers    => {},
+
+		mimeparts  => []
+	};
+
+	bless $self, $class;
+
+	$self->{headerblob} = $header;
+	$self->{bodyblob} = $body;
+
+	$self->ParseHeader() if ($header);
+	$self->ParseBody() if ($body);
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: ParseHeader()
+# Desc: Parse header blob into fields.
+#
+# Args: n/a
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub ParseHeader
+{
+	my $self = shift;
+
+	my $key;
+
+	foreach my $line (split /\n/, $self->{headerblob}) {
+		if ($line =~ /^(\S+):\s*(.*)$/) {
+			my $val = $2;
+			$key = lc $1;
+
+			# Ignore multiple defs (e.g. Received: headers)
+			exists $self->{headers}->{$key}
+				and next;
+
+			$self->{headers}->{$key} = $val;
+		} elsif ($line =~ /^\s*(.*)$/) {
+			my $val = $1;
+
+			defined $key
+				or next;
+
+			# No field to append to
+			exists $self->{headers}->{$key}
+				or next;
+
+			$self->{headers}->{$key} .= ' '.$val;
+		}
+	}
+}
+
+
+#------------------------------------------------------------------------------
+# Func: ParseBody()
+# Desc: Parse body blob.
+#
+# Args: n/a
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub ParseBody
+{
+	# XXX: recurse to second-level parts
+
+	my $self = shift;
+
+	$self->{mimeparts} = [];
+
+	# First of all - attempt to split into MIME parts
+	# Note that since GNATS nukes a bunch of the headers
+	# that we need, this is purely of a heuristic nature.
+
+	# Technically less permissive than RFC1341
+
+	my $nextbound = qr/^--([A-Za-z0-9'()+_,-.\/:=?]{6,70})$/m;
+	my $first = 1;
+
+	while ($self->{bodyblob} =~ s/$nextbound//m) {
+		my $last;
+
+		if ($first) {
+			my $boundary = $1;
+			$nextbound = qr/^--\Q$boundary\E(--)?$/m;
+			$last = 0;
+			$first = 0;
+		} else {
+			$last = ($2 and $2 eq '--');
+		}
+
+		# Promote to MIME part
+
+		push @{$self->{mimeparts}},
+			new GnatsPR::Section::MIME(
+				substr($self->{bodyblob}, 0, $-[0], '')
+			)
+			unless ($-[0] == 0);
+	}
+
+	if (!@{$self->{mimeparts}}) {
+		# No parts - just plain text
+		push @{$self->{mimeparts}},
+			new GnatsPR::Section::MIME($self->{bodyblob});
+	}
+}
+
+
+#------------------------------------------------------------------------------
+# Func: Header()
+# Desc: Return a header field.
+#
+# Args: $key - Header name, case insensitive.
+#
+# Retn: $val - Value.
+#------------------------------------------------------------------------------
+
+sub Header
+{
+	my $self = shift;
+	my ($key) = @_;
+
+	return $self->{headers}->{lc $key};
+}
+
+
+1;

en/cgi/GnatsPR/Section/FieldStart.pm

@@ -0,0 +1,80 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::Section::FieldStart;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $name - Field name.
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my ($name) = @_;
+
+	my $self = {
+		name => ''
+	};
+
+	bless $self, $class;
+
+	$self->{name} = $name;
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: string()
+# Desc: Return the field name.
+#
+# Args: n/a
+#
+# Retn: $string
+#------------------------------------------------------------------------------
+
+sub string
+{
+	my $self = shift;
+
+	return $self->{name};
+}
+
+
+1;

en/cgi/GnatsPR/Section/MIME.pm

@@ -0,0 +1,311 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::Section::MIME;
+
+use MIME::Base64;                      # ports/converters/p5-MIME-Base64
+use MIME::QuotedPrint;                 #
+use Convert::UU qw(uudecode uuencode); # ports/converters/p5-Convert-UU
+
+use Encode;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $blob - Raw MIME part, inc. any headers.
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my ($blob) = @_;
+
+	my $self = {
+		body         => '',
+		decoded_body => '',
+		headers      => {},
+		binary       => 0,
+		encoded      => 0,
+		attachment   => 0,
+		filename     => '',
+		mimeparts    => []   # Sub parts (usually empty)
+	};
+
+	bless $self, $class;
+
+	$self->{body} = $blob;
+
+	$self->Parse() if ($blob);
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Accessors
+#------------------------------------------------------------------------------
+
+sub body
+{
+	my $self = shift;
+	$self->{body} = $_[0] if @_;
+	return $self->{body};
+}
+
+sub isbinary
+{
+	my $self = shift;
+	return $self->{binary};
+}
+
+sub isencoded
+{
+	my $self = shift;
+	return $self->{encoded};
+}
+
+sub isattachment
+{
+	my $self = shift;
+	return $self->{attachment};
+}
+
+sub filename
+{
+	my $self = shift;
+	return $self->{filename};
+}
+
+sub data
+{
+	my $self = shift;
+	return $self->{encoded} ? $self->{decoded_body} : $self->{body};
+}
+
+sub size
+{
+	my $self = shift;
+	return length($self->{encoded} ? $self->{decoded_body} : $self->{body});
+}
+
+
+#------------------------------------------------------------------------------
+# Func: Parse()
+# Desc: Parse and decode raw MIME part.
+#
+# Args: n/a
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub Parse
+{
+	my $self = shift;
+
+	# XXX: decode other charsets?
+
+	$self->{body} =~ s/^[\n\s]+//;
+	$self->{body} =~ s/[\n\s]+$//;
+
+	$self->ParseHeader();
+
+	# Determine if we're a multi-part container
+	if (lc $self->header('content-type') =~ /multipart/
+			and $self->header('content-type:boundary')) {
+		my $bound = $self->header('content-type:boundary');
+		@{$self->{mimeparts}} =
+			map {
+				new GnatsPR::Section::MIME($_);
+			}
+			grep !/^[\n\s]*$/,
+			split /^--\Q$bound\E(?:--)?$/m, $self->{body};
+		$self->{body} = undef;
+		return;
+	}
+
+	# Look for Quoted-Printable (explicit or using a silly heuristic)
+	if (lc $self->header('content-transfer-encoding') eq 'quoted-printable'
+			or $self->{body} =~ /=[0-9A-Fa-f]{2}=[0-9A-Fa-f]{2}/) {
+		$self->{body} = decode('utf8', decode_qp($self->{body}));
+
+	# Base64 -- probably better not to decode
+	} elsif (lc $self->header('content-transfer-encoding') eq 'base64') {
+		$self->{decoded_body} = decode('utf8', decode_base64($self->{body}));
+		$self->{encoded} = 1;
+	}
+
+	# Catches too much stuff that we can display
+	#if ($self->header('content-type')
+	#		&& $self->header('content-type') !~ 'text/') {
+	#	$self->{binary} = 1;
+	#}
+
+	if (lc $self->header('content-disposition') eq 'attachment') {
+		my $filename =
+			$self->header('content-disposition:filename')
+			|| $self->header('content-type:name')
+			|| $self->header('x-attachment-id')
+			|| 'attachment';
+
+		$filename =~ '(?:\.gz|\.bz2|\.zip|\.tar)$'
+			and $self->{binary} = 1;
+
+		$self->{attachment} = 1;
+		$self->{filename} = $filename;
+	}
+
+	if ($self->{body} =~ /^begin \d\d\d (.*)/ && !$self->{encoded}) {
+		$self->{decoded_body} = decode('utf8', uudecode($self->{body}));
+		$self->{encoded} = 1;
+	}
+}
+
+
+#------------------------------------------------------------------------------
+# Func: ParseHeader()
+# Desc: Parse out any MIME header fields.
+#
+# Args: n/a
+#
+# Retn: n/a
+#------------------------------------------------------------------------------
+
+sub ParseHeader
+{
+	my $self = shift;
+	my $header = '';
+	my $key;
+
+	# Start with some defaults
+	$self->{headers}->{'content-type'} = 'text/plain';
+
+	# No header?
+	$self->{body} =~ /^Content-/i
+		or return;
+
+	# Ensure we have an end-of-header marker. Returning here
+	# will result in some bodyless headers being dumped as
+	# text (example in conf/138672) -- but I think this is
+	# the safe option, in case such a header is in fact the
+	# body of a malformed message.
+	$self->{body} =~ /^$/m and $+[0] != length($self->{body}) or return;
+
+	$header = substr($self->{body}, 0, $+[0]+1, '');
+
+	$self->{body} =~ s/^[\n\s]+//;
+
+	foreach my $line (split /\n/, $header) {
+		if ($line =~ /^(\S+): (.*)$/) {
+			$key = lc $1;
+			$self->{headers}->{$key} = $2;
+		} elsif ($line =~ /^\s+(.*)$/) {
+			$key or next;
+			$self->{headers}->{$key} .= ' ' . $1;
+		}
+	}
+
+	# Split up aggregate headers into individual values
+
+	foreach my $key (keys %{$self->{headers}}) {
+		$self->{headers}->{$key} =~ /;/ or next;
+
+		my @chars = split //, $self->{headers}->{$key};
+		my $inquote = 0;
+		my $gotkey = 0;
+		my $k = '';
+		my $v = '';
+
+		foreach my $char (@chars) {
+			if ($char eq '"') {
+				$inquote = !$inquote;
+				next;
+			} elsif ($char eq '=' && !$inquote) {
+				$gotkey = 1;
+				next;
+			} elsif ($char eq ';' && !$inquote) {
+				if ($k and $v) {
+					$k = lc $k;
+					$self->{headers}->{"$key:$k"} = $v;
+				}
+				$k = $v = '';
+				$gotkey = 0;
+				next;
+			} elsif (($char eq ' ' or $char eq '\t') && !$inquote) {
+				next;
+			}
+
+			if ($gotkey) {
+				$v .= $char;
+			} else {
+				$k .= $char;
+			}
+		}
+
+		if ($k and $v) {
+			$k = lc $k;
+			$self->{headers}->{"$key:$k"} = $v;
+		}
+
+		$self->{headers}->{$key} =~ s/;.*$//;
+	}
+}
+
+
+#------------------------------------------------------------------------------
+# Func: header()
+# Desc: Return header.
+#
+# Args: $key
+#
+# Retn: $val
+#------------------------------------------------------------------------------
+
+sub header
+{
+	my $self = shift;
+	my ($key) = @_;
+
+	$key = lc $key;
+
+	return $self->{headers}->{$key}
+		if (exists $self->{headers}->{$key});
+
+	return '';
+}
+
+
+1;

en/cgi/GnatsPR/Section/Patch.pm

@@ -0,0 +1,172 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::Section::Patch;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $text     - Blob of text.
+#       $filename - Filename of patch, if we have one.
+#       $type     - Patch type string (if known).
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my ($text, $filename, $type) = @_;
+
+	my $self = {
+		text     => '',
+		filename => 'patch.txt',
+		type     => 'unknown'
+	};
+
+	bless $self, $class;
+
+	$self->{text} = $text;
+
+	$self->{filename} = $filename if $filename;
+	$self->{type} = $type if $type;
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: string()
+# Desc: Return string contained within.
+#
+# Args: n/a
+#
+# Retn: $string
+#------------------------------------------------------------------------------
+
+sub string
+{
+	my $self = shift;
+
+	return $self->{text};
+}
+
+
+#------------------------------------------------------------------------------
+# Func: size()
+# Desc: Return the length of the contained data.
+#
+# Args: n/a
+#
+# Retn: $string
+#------------------------------------------------------------------------------
+
+sub size
+{
+	my $self = shift;
+
+	return length($self->{text});
+}
+
+
+#------------------------------------------------------------------------------
+# Func: data()
+# Desc: Return the raw decoded (if possible/necessary) data.
+#
+# Args: n/a
+#
+# Retn: $string
+#------------------------------------------------------------------------------
+
+sub data
+{
+	my $self = shift;
+
+	return $self->{text};
+}
+
+
+#------------------------------------------------------------------------------
+# Func: filename()
+# Desc: Return the patch's filename.
+#
+# Args: n/a
+#
+# Retn: $filename
+#------------------------------------------------------------------------------
+
+sub filename
+{
+	my $self = shift;
+
+	return $self->{filename};
+}
+
+
+#------------------------------------------------------------------------------
+# Func: type()
+# Desc: Return the patch's type.
+#
+# Args: n/a
+#
+# Retn: $type
+#------------------------------------------------------------------------------
+
+sub type
+{
+	my $self = shift;
+
+	return $self->{type};
+}
+
+
+#------------------------------------------------------------------------------
+# Func: isbinary()
+# Desc: Is patch binary?
+#
+# Args: n/a
+#
+# Retn: $type
+#------------------------------------------------------------------------------
+
+sub isbinary
+{
+	my $self = shift;
+
+	return 0;
+}
+
+
+1;

en/cgi/GnatsPR/Section/StateChange.pm

@@ -0,0 +1,117 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::Section::StateChange;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: n/a
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+
+	my $self = {
+		what => '', # State or Responsible
+		from => '', # Change from
+		to   => '', # Change to
+		why  => '', # Reason for change
+		when => '', # Date of change
+		by   => ''  # Who changed it
+	};
+
+	bless $self, $class;
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Accessors
+#------------------------------------------------------------------------------
+
+sub what
+{
+	my $self = shift;
+	$self->{what} = $_[0] if @_;
+	return $self->{what};
+}
+
+sub from
+{
+	my $self = shift;
+	$self->{from} = $_[0] if @_;
+	return $self->{from};
+}
+
+sub to
+{
+	my $self = shift;
+	$self->{to} = $_[0] if @_;
+	return $self->{to};
+}
+
+sub why
+{
+	my $self = shift;
+
+	if (scalar @_) {
+		$self->{why} = $_[0];
+		$self->{why} =~ s/^\s+//;
+		$self->{why} =~ s/[\n\s]+$//;
+	}
+	return $self->{why};
+}
+
+sub when
+{
+	my $self = shift;
+	$self->{when} = $_[0] if @_;
+	return $self->{when};
+}
+
+sub by
+{
+	my $self = shift;
+	$self->{by} = $_[0] if @_;
+	return $self->{by};
+}
+
+
+1;

en/cgi/GnatsPR/Section/Text.pm

@@ -0,0 +1,82 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::Section::Text;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $text - Blob of text.
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my ($text) = @_;
+
+	my $self = {
+		text => ''
+	};
+
+	bless $self, $class;
+
+	$text =~ s/[\s\n]+$//s; # Tidy up trailing whitespace
+
+	$self->{text} = $text;
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: string()
+# Desc: Return string contained within.
+#
+# Args: n/a
+#
+# Retn: $string
+#------------------------------------------------------------------------------
+
+sub string
+{
+	my $self = shift;
+
+	return $self->{text};
+}
+
+
+1;

en/cgi/GnatsPR/SectionIterator.pm

@@ -0,0 +1,114 @@
+#!/usr/bin/perl -Tw
+#------------------------------------------------------------------------------
+# Copyright (C) 2011, Shaun Amott <shaun@FreeBSD.org>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD$
+#------------------------------------------------------------------------------
+
+package GnatsPR::SectionIterator;
+
+use strict;
+
+require 5.006;
+
+
+#------------------------------------------------------------------------------
+# Func: new()
+# Desc: Constructor.
+#
+# Args: $gnatspr - GnatsPR instance.
+#       @fields  - Which fields we want sections from. The order determines
+#                  the order of the returned sections. Undefined behaviour if
+#                  no no fields specified.
+#
+# Retn: $self
+#------------------------------------------------------------------------------
+
+sub new
+{
+	my $class = shift;
+	my $gnatspr = shift;
+
+	my $self = {
+		gnatspr     => $gnatspr,
+		currfield   => -1,
+		currsection => -1,
+		wantfields  => []
+	};
+
+	bless $self, $class;
+
+	while (my $f = shift) {
+		push @{$self->{wantfields}}, $f;
+	}
+
+	return $self;
+}
+
+
+#------------------------------------------------------------------------------
+# Func: next()
+# Desc: Return next iterator element.
+#
+# Args: n/a
+#
+# Retn: $next
+#------------------------------------------------------------------------------
+
+sub next
+{
+	my $self = shift;
+	my ($fieldkey, $maxsection);
+
+	# Next section
+	$self->{currsection}++;
+
+	# First field?
+	$self->{currfield} == -1
+		and $self->{currfield} = 0;
+
+	$fieldkey = $self->{wantfields}->[$self->{currfield}];
+	$maxsection = $#{$self->{gnatspr}->{sections}->{$fieldkey}};
+
+	# We've passed the last section in this field
+	while ($self->{currsection} > $maxsection) {
+		# Next field, first section
+		$self->{currfield}++;
+		$self->{currsection} = 0;
+
+		# Run out of fields?
+		$self->{currfield} > $#{$self->{wantfields}}
+			and return undef;
+
+		# Update, and go back to check next field
+		$fieldkey = $self->{wantfields}->[$self->{currfield}];
+		$maxsection = $#{$self->{gnatspr}->{sections}->{$fieldkey}};
+	}
+
+	return $self->{gnatspr}->{sections}->{$fieldkey}->[$self->{currsection}];
+}
+
+
+1;

en/layout/css/query-pr.css

@@ -1,7 +1,7 @@
 /*
  * CSS stylesheet for the new query-pr interface.
  *
- * Copyright (C) 2006, Shaun Amott <shaun@FreeBSD.org>
+ * Copyright (C) 2006-2011, Shaun Amott <shaun@FreeBSD.org>
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -25,17 +25,25 @@
  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  * SUCH DAMAGE.
  *
- * $FreeBSD: www/en/layout/css/query-pr.css,v 1.3 2006/12/09 15:48:29 shaun Exp $
+ * $FreeBSD: www/en/layout/css/query-pr.css,v 1.4 2007/06/04 04:39:51 chinsan Exp $
  */
 
-pre {
-	font-family: "Courier New", Courier, monospace;
+.attachwin {
 	font-size: 100%;
-	white-space: pre;
 	margin-top: 0px;
 	margin-bottom: 0px;
 	overflow: scroll;
 	max-height: 600px;
+	max-width: 655px;
+	width: 655px;
+	margin-left: auto;
+	margin-right: auto;
+}
+
+pre {
+	font-family: "Courier New", "Courier", monospace;
+	font-size: 100%;
+	white-space: pre;
 }
 
 /* Fields */
@@ -44,15 +52,16 @@ td {
 	vertical-align: top;
 }
 
-.mfield {
-	padding: 10px;
-	width: 100%;
+.mfield, p {
+	padding-left: 1.4em;
+	padding-right: 1.4em;
 }
 
 .headtable {
 	border-left: 1px solid #999999;
 	border-bottom: 1px solid #999999;
 	width: 100%;
+	margin-bottom: 16px;
 }
 
 .headtable .key {
@@ -67,20 +76,30 @@ td {
 	font-weight: bold;
 }
 
+.mfieldtable {
+	border-left: 1px solid #999999;
+	border-bottom: 1px solid #999999;
+	width: 100%;
+	margin-bottom: 16px;
+	margin-top: 16px;
+	font-weight: bold;
+}
 
 /* Patch block */
 
 .patchblock {
-	margin-left: auto;
-	margin-right: auto;
 	border: 1px solid #999999;
 	background-color: #EFEFBB;
-	width: 90%;
+	margin-left: auto;
+	margin-right: auto;
+	max-width: 675px;
+	margin-top: 1.4em;
+}
+.patchblock .info {
+	background-color: #ACACAA;
+	text-align: left;
 }
-.patchblock .info { background-color: #ACACAA; }
 .patchblock .content {
-	font-family: "Courier New", Courier, monospace;
-	white-space: pre;
 }
 
 
@@ -92,9 +111,16 @@ td {
 	border: 1px solid #999999;
 	background-color: #EFEFEF;
 	width: 90%;
+	margin-top: 1.4em;
+}
+.auditblock .key  {
+	font-weight: bold;
+	width: 6.0em;
+}
+.auditblock .info {
+	background-color: #ACACAA;
+	text-align: center;
 }
-.auditblock .key  { font-weight: bold; width: 60px; }
-.auditblock .info { background-color: #ACACAA; }
 
 
 /* Reply block */
@@ -105,16 +131,19 @@ td {
 	border: 1px solid #999999;
 	background-color: #EFEFEF;
 	width: 90%;
+	margin-top: 1.4em;
 }
-.replyblock .info { background-color: #AA9900; }
-.replyblock .key  { background-color: #CCCCCC; font-weight: bold; width: 60px; }
-.replyblock .val  { background-color: #CCCCCC; }
-
-
-/* Unexpected (manually inserted) text block */
-
-.unexpectedblock {
-	width: 100%;
+.replyblock .info {
+	background-color: #AA9900;
+	text-align: center;
+}
+.replyblock .key {
+	background-color: #CCCCCC;
+	font-weight: bold;
+	width: 6.0em;
+}
+.replyblock .val {
+	background-color: #CCCCCC;
 }
 
 .quote0            { color: #DD0000; }
@@ -127,3 +156,10 @@ td {
 .patch_hunkinfo    { font-weight: bold; }
 
 .mimeboundary      { border-top: 1px #DD0000 dashed; border-bottom: 0px; }
+
+
+/* Footer */
+
+.footerlinks {
+	margin-top: 40px;
+}