#!/usr/bin/perl -w
#
# filter.pl
# J. Uckelman (uckelman@nomic.net)
# 13 March 2001
#

require 5.005;
use DBI;

my $prog = 'filter.pl';

sub findtag ($$$$);
sub getfloat ($$);

eval { require '/home/g1/bin/scripts.conf'; };
die "\n$prog: scripts.conf: $@" if $@;
eval { require '/home/g1/bin/mysql.pl'; };
die "\n$prog: mysql.pl: $@" if $@;
eval { require '/home/g1/bin/subs.pl'; };
die "\n$prog: subs.pl: $@" if $@;

# Connect to game database.
$db = DBI->connect("DBI:mysql:database=g1;host=localhost;port=3306", 'nobody', '') or die "\n$prog: database connect failed: $DBI::errstr";

# Break message into its component parts.
my ($header, $body) = (join '', <STDIN>) =~ m/(.*?)\n{2}(.*)/s;
my ($from) = $header =~ m/^From:.*?<([\w.-]+@[\w.-]+)>/m;
my ($date) = $header =~ m/^Received: \(qmail \d+ invoked by uid 91\); (.*?) -0000$/m;

my $output = '';

# Nix all lines beginning with '>'.
$body =~ s/^>.*$//g;

# Iterate over body looking for tags.
while ($body) {
	my ($bval, $eval, $text);
	last unless $body = (findtag('', $body, '\\\begin', '{'))[1];

	($bval, $body) = findtag('', $body, '', '}');
	die "$from, $date: \\begin missing }" unless $bval;

	($text, $body) = findtag('', $body,  '\\\end', '{');
	die "$from, $date: runaway \\begin or \\begin needs \\end" unless $text;

	($eval, $body) = findtag('', $body, '', '}');
	die "$from, $date: \\begin does not match next \\end" if ($bval ne $eval);

	if ($bval eq 'proposal') {
		my ($tmp, $title, $num, $rev, $owner);

		# Get title.		
		($text, $title) = getfloat($text, '\\\title');

		# Get number.
		($text, $num) = getfloat($text, '\\\number');
				
		# Trim whitespace around text.
		$text =~ s/^\s*(.*?)\s*$/$1/s;

		# Unfold text.
		$text =~ s/([^\n])( +=| *)\n *([^\n])/$1 $3/sg;
		$text =~ s/\. +(\S)/. $1/sg;

		# Is this new?
		if ($num) { 
			# Get revision number, owner.
			($rev) = query("select max(revision)+1 from proposal where number = $num and isnull(end) group by revision");
			($title) = query("select title from proposal where number = $num and revision = $rev - 1") unless $title;
		}
		else { 
			# Get prop number.
			($num) = query("select max(number)+1 from proposal"); 
			$rev = 0;
		}

		# Get owner.
		($owner) = query("select name.name from name, mail where mail.address = '$from' and mail.id = name.id");
			
		$output .= "proposal add\n$num/$rev\n$date\n$owner\n$title\n\n$text\n\n----\n";
	}
	else { die "unrecognized \\begin{$bval}"; }
}

# Make output.
if ($output) {
	my $lastfile;
	
	# Increment file number.
	$lastfile = (sort <$QUEUE/*>)[-1] or $lastfile = 0;
	$lastfile =~ s/.*(\d+)$/$1+1/e;

	# Untaint file number. 
	($lastfile) = $lastfile =~ m/(\d+)/;

	write_file("$QUEUE/$lastfile", $output);
}

$db->disconnect or die "\n$prog: database disconnect failed: $DBI::errstr"; # Wierd! Should never happen.
exit 0;

sub findtag ($$$$) {
	my ($done, $remainder, $tag, $del) = @_;

	my ($backsl, $a, $b) = ();
	# Split remainder into a, backslashes, and b.
	unless (($a, $backsl, $b) = $remainder =~ m/^(.*?)(\\*)$tag$del(.*)/s) { return ("$done$remainder", ''); }
	else { $remainder = $b; }

	# Unguard backslashes, add to done.
	$done .= $a . ("\\" x int(length($backsl)/2));

	# If no tag found, keep looking, else return split.
	if (length($backsl) % 2) { return findtag("$done$tag$del", $remainder, $tag, $del); }
	else { return ($done, $remainder); }
}

sub getfloat ($$) {
	my ($text, $tag) = @_;

	my $tmp = $text;
	my $val;
	($text, $tmp) = findtag('', $tmp, $tag, '{');
	($val, $tmp) = findtag('', $tmp, '', '}');
	$text .= $tmp;

	return ($text, $val);
}

sub notify ($$$$) {
	my ($to, $cc, $subject, $message) = @_;

	open SEND, '|/var/qmail/bin/qmail-inject';
	print SEND <<DONE;
From: A Nomic List Filter <uckelman\@nomic.net>
To: $to
Cc: $cc
Reply-To: uckelman\@nomic.net
Subject: $subject

$message
DONE
	close SEND;
}