#!/usr/bin/perl -w
##
## CrudBoard - Fast, neat, useful
##
## See README for details.
##

use strict;

package crudboard;

BEGIN
{
	use DBI;
	use CGI qw(-compile :standard);
	use CGI::Carp 'fatalsToBrowser';
	$CGI::POST_MAX=1024 * 100;
	$CGI::DISABLE_UPLOADS = 1;
	use Fcntl ':flock';
	use Date::Parse;
	use Date::Format;

	use lib qw(.);
	use cbconf;

	verify_conf();

	init_sql();

	sub verify_conf
	{
		print "Define \$BASEDIR\n" unless defined $BASEDIR;
		print "Define \$BASEURL\n" unless defined $BASEURL;
		print "Define \$SCRIPTURL\n" unless defined $SCRIPTURL;
		print "Define \$WRAPLEN\n" unless defined $WRAPLEN;
		print "Define \$TPP\n" unless defined $TPP;
		print "Define \$SPP\n" unless defined $SPP;
		print "Define \$SQLDB\n" unless defined $SQLDB;
		print "Define \$SQLHOST\n" unless defined $SQLHOST;
		print "Define \$SQLUSER\n" unless defined $SQLUSER;
		print "Define \$SQLPASS\n" unless defined $SQLPASS;
		print "Define \$ANONYMOUS\n" unless defined $ANONYMOUS;
		print "Define \$NOSUBJECT\n" unless defined $NOSUBJECT;
	}

	sub init_sql
	{
		my ($db) = get_db_handle();
		my (%tables, $row);
		my $handle = $db->prepare("SHOW TABLES");
		
		$handle->execute();
	
		while($row = $handle->fetchrow_arrayref())
		{
			$tables{$row->[0]} = 1;
		}
	
		unless ($tables{message})
		{
			$db->do("CREATE TABLE message (
					Id int(11) DEFAULT '1' NOT NULL auto_increment,
					Parent int(11) DEFAULT '0' NOT NULL,
					Host varchar(255) NOT NULL,
					Name varchar(255),
					Subject varchar(255),
					Date datetime NOT NULL,
					Message text,
					PRIMARY KEY (Id),
					Key Parent (Parent),
					Key Date (Date),
					Key Host (Host)
				)");
		}
	
		$db->disconnect();
	}

	sub get_db_handle
	{
		my $db = DBI->connect("DBI:mysql:database=$SQLDB;host=$SQLHOST", "$SQLUSER", "$SQLPASS");
	
		if(!$db)
		{
			print "DBI->connect failed\n";
			return;
		}
	
		return $db;
	}
}


sub fork_session
{
        return;
    
	my ($db) = @_;
	$SIG{'CHLD'} = 'IGNORE';

	defined (my $kid = fork) or die "fork: $!\n";
	if($kid)
	{
		$db->disconnect();
		exit(0);
	}

	close STDIN;
	close STDOUT;
	close STDERR;
	open STDIN, "/dev/null";
	open STDOUT, ">/dev/null";
	open STDERR, ">/dev/null";
}

sub end_session
{
	my ($db) = @_;

	$db->disconnect();
	CORE::exit(0);
}

sub make_navibar
{
	my ($thread, $date, $prev, $next, $postanchor) = @_;
	my $ret;

	$prev = "Назад | " unless defined $prev and $prev;
	$next = "Вперёд" unless defined $next and $next;

	$ret = "<center>" . $prev;
	if($thread)
	{
		$ret .= "<a href=\"$BASEURL/thread.html\">Все темы</a> | ";
	}
	else
	{
		$ret .= "Все темы | ";
	}

	if($postanchor)
	{
		$ret .= "<a href=\"#post\">Создать тему</a> | ";
	}
	else
	{
		$ret .= "<a href=\"$SCRIPTURL?post=1\">Создать тему</a> | ";
	}

	$ret .= "<a href=\"$SCRIPTURL?search=1\">Искать</a> | ";
	
	if($date)
	{
		$ret .= "<a href=\"$BASEURL/date.html\">Все сообщения</a> | ";
	}
	else
	{
		$ret .= "Все сообщения | ";
	}
	$ret .= $next . "</center>";

	return $ret;
}

sub saniview
{
	my ($v) = @_;

	return "date" if(defined($v) and $v eq "date");

	return "thread";
}

sub index_line
{
	my ($id, $subject, $name, $date, $link) = @_;

	$date = convert_date($date);

	if($link)
	{
		return "<a href=\"$SCRIPTURL?id=$id\"><strong>$subject</strong> - $name - <em>$date</em></a>";
	}
	else
	{
		return "<strong>$subject</strong> - $name - <em>$date</em>";
	}
}

sub guess_name
{
	my ($db, $query) = @_;
	my $host = cleanup('mbh', $query->remote_host());

	my $row = sql_select_hash($db, "SELECT (Name) from message WHERE Host = '$host' ORDER BY Id DESC LIMIT 1");

	return $row->{Name} || $cbconf::ANONYMOUS;

	return "";
}


sub wrap_process
{
	my ($c, $len, $out, $word) = @_;

	if($c eq "\n" or $c eq " ")
	{
		my $l = length($word);
		
		if($len + $l == $WRAPLEN)
		{
			$out .= $word . "\n";
			$len = 0;
		}
		elsif($len + $l > $WRAPLEN)
		{
			if(substr($out, -1, 1) eq " ")
			{
				chop($out);
			}
			$out .= "\n" . $word;
			$len = $l;

			if($c eq " ")
			{
				$out .= " ";
				$len++;
			}
		}
		else
		{
			$out .= $word . $c;
			if($c eq "\n")
			{
				$len = 0;
			}

			if($c eq " ")
			{
				$len += $l+1;
			}
		}
		$word = "";
	}
	else
	{
		$word .= $c;
	}
	return ($c, $len, $out, $word);
}
# Yechh---that was disgusting.

sub wrap
{
	my ($in) = @_;
	my $c = "";
	my $intag = 0;
	my $len = 0;
	my $word;
	my $out = "";
	my $last;
	my $tmp;

	while($in)
	{
		$last = $c;
		$c = substr($in, 0, 1);
		$in = substr($in, 1);
	
		if($c eq "<" or $c eq ">")
		{
			# flush $word
			if(!$intag and $word)
			{
				($tmp, $len, $out, $word) = wrap_process(" ", $len, $out, $word);
				if(substr($out, -1, 1) eq " ")
				{
					chop($out);
					$len--;
				}
			}
		
			# quoted text
			if(($last eq "\n" or $last eq "") and $c eq ">")
			{
				$intag = 1000000;
			}
			elsif($c eq "<")
			{
				$intag--;
			}
			elsif($c eq ">")
			{
				$intag++;
				goto hack_endtag;
			}
		}
		if($intag)
		{
			hack_endtag:
			$out .= $c;
			if($c eq "\n")
			{
				$len = 0;
				$intag = 0;
			}
			else
			{
				$len++;
			}
			next;
		}

		($c, $len, $out, $word) = wrap_process($c, $len, $out, $word);

	}

	#flush $word
	if($word)
	{
		($tmp, $len, $out, $word) = wrap_process("\n", $len, $out, $word);
		chomp($out);
	}

	return $out;
}

sub sql_select_hash
{
	my ($db, $string) = @_;

	my $handle = $db->prepare("$string");
	
	$handle->execute();

	my $row = $handle->fetchrow_hashref();

	$handle->finish();

	return $row;
}

sub convert_date
{
	my ($in) = @_;

	$in = Date::Format::time2str("%e.%m.%Y %k:%M", Date::Parse::str2time($in));

    if (0) {
	# strip year if current
	my $now_year = (localtime)[5] + 1900;
        if ($in =~  /^\d+\.\d+\.(\d+) / && $now_year == $1) {
            $in =~ s/^(\d+\.\d+)\.(\d+) /$1 /;
        }
    }

	return $in;
}

sub print_header() {
    my $type = 'text/html';

    print $cbconf::CHARSET
        ? qq{Content-Type: $type; charset=$cbconf::CHARSET\n}
        : qq{Content-Type: $type;\n};
    print qq{Cache-Control: max-age=5\n};
    print "\n";
}

sub filter_template
{
	my ($in, $out, %rep) = @_;

	$rep{script} = $SCRIPTURL;
        $rep{boardname} = $cbconf::BOARDNAME;

	while(<$in>)
	{
		while(/<!--(.*?)-->/)
		{
			s/<!--(.*?)-->/$rep{$1}/;
		}
		print $out $_;
	}
}

sub cleanup
{
	my ($tags, $in) = @_;

	return "" if(!defined $in);

	if($tags =~ /b/) #double backslashes
	{
		$in =~ s/\\/\\\\/g;
	}

	if($tags =~ /m/) #cleanup quotes for mysql
	{
		$in =~ s/'/\\'/g;
	}

	if($tags =~ /h/) #escape html tags
	{
		$in =~ s/&/&amp;/g;
		$in =~ s/</&lt;/g;
		$in =~ s/>/&gt;/g;
		$in =~ s/"/&quot;/g;
	}

	return $in;
}

sub post_message
{
	my ($db, $query) = @_;
	my $name = cleanup('mbh', $query->param('name'));
	my $subject = cleanup('mbh', $query->param('subject'));
	my $message = cleanup('mb', $query->param('body'));
	my $parent = cleanup('mbh', $query->param('parent'));
	my $host = cleanup('mbh', $query->remote_host());

	$name = $ANONYMOUS unless $name;
	$subject = $NOSUBJECT unless $subject;

	chomp($message);

	$db->do("INSERT into message (Parent, Host, Name, Subject, Date, Message) VALUES('$parent', '$host', '$name', '$subject', NOW(), '$message')");

	my $row = sql_select_hash($db, "SELECT (Id) from message WHERE Id = LAST_INSERT_ID()");
	
	print $query->redirect("$SCRIPTURL?id=$row->{Id}");

	fork_session($db);

	render_page($db, $query, 0, $TPP, "thread");
	render_page($db, $query, 0, $SPP, "date");

	end_session($db);
}

sub search_message
{
	my ($db, $query) = @_;
	my $name = cleanup('mb', $query->param('name'));
	my $host = cleanup('mb', $query->param('host'));
	my $datef = cleanup('mb', $query->param('datef'));
	my $datet = cleanup('mb', $query->param('datet'));
	my $subject = cleanup('mb', $query->param('subject'));
	my $body = cleanup('mb', $query->param('body'));
	my $start = cleanup('mb', $query->param('start'));
	my $num = cleanup('mb', $query->param('num'));
	my ($prev, $next);
	my @predicates;
	my $h;
	my %rep;

	push @predicates, "Name REGEXP '$name'" if($name ne "");
	push @predicates, "Host REGEXP '$host'" if($host ne "");
	push @predicates, "Date >= '$datef'" if ($datef ne "");
	push @predicates, "Date <= '$datet'" if ($datet ne "");
	push @predicates, "Subject REGEXP '$subject'" if($subject ne "");
	push @predicates, "Message REGEXP '$body'" if($body ne "");

	if($#predicates < 0)
	{
		return render_search($db, $query);
	}
	
	my $string = "where " . join(" AND ", @predicates);

	$rep{render_root} = render_list($db, $string, $start, $num);

	if($start)
	{
		my $a;
		my $newurl;

		$a = $start - $num;
		$a = 0 if $a < 0;

		$newurl = $query->self_url();
		$newurl =~ s/[\?\&]start=\d+//;
		$newurl =~ s/[\?\&]num=\d+//;
		$newurl .= "&start=$a&num=$num";

		$next = "<a href=\"$newurl\">Вперёд</a>";
	}
	else
	{
		$next = "";
	}

	$h = sql_select_hash($db, "SELECT COUNT(*) FROM message $string");
	if($h and $num and (sql_select_hash($db, "SELECT COUNT(*) FROM message $string"))->{'COUNT(*)'} > $start + $num)
	{
		my $newurl;
		my $a;

		$a = $start + $num;

		$newurl = $query->self_url();
		$newurl =~ s/[\?\&]start=\d+//;
		$newurl =~ s/[\?\&]num=\d+//;
		$newurl .= "&start=$a&num=$num";

		$prev = "<a href=\"$newurl\">Назад</a> | ";
	}
	else
	{
		$prev = "";
	}

	$rep{navibar} = make_navibar(1, 1, $prev, $next);
	$rep{predicate} = $string;
	
        print_header();

	open TEMP, "$BASEDIR/results.tmpl" or die "$BASEDIR/results.tmpl: $!\n";

	filter_template(\*TEMP, \*STDOUT, %rep);

	close(TEMP);
}

sub render_message
{
	my ($db, $query) = @_;
	my %rep;
	my ($prev, $next);
	my $id = cleanup('m', $query->param('id'));
	my $msg = sql_select_hash($db, "SELECT * from message WHERE Id = '$id'");
	my $tmp;
	local *TEMP;


        print_header();
	if(!$msg)
	{
		print "<html><body>Error - Message $id not found.</body></html>\n";
		return;
	}

	$rep{"host"} = $msg->{Host};
	$rep{"name"} = $msg->{Name};
	$rep{"subject"} = $msg->{Subject};
	$rep{"date"} = convert_date($msg->{Date});
	$rep{"message"} = wrap($msg->{Message});
	$rep{"id"} = $id;
	$rep{"render_tree"} = render_tree($db, $id);
	$rep{"guessname"} = guess_name($db, $query);
	$rep{"re-subject"} = $rep{"subject"};
	$rep{"re-subject"} =~ s/^Re: //;
	$rep{"re-subject"} =~ s/^/Re: /;
	$rep{"re-message"} = $rep{"message"};
	$rep{"re-message"} =~ s/^/&gt; / if $rep{"message"};
	$rep{"re-message"} =~ s/\n/\n&gt; /sg;
	if(substr($rep{"re-message"}, -1, 6) eq "\n&gt; ")
	{
		$rep{"re-message"} = substr($rep{"re-message"}, 0, -6);
	}
	$rep{"re-message"} .= "\n";

	$tmp = sql_select_hash($db, "SELECT (Id) from message WHERE Id < '$msg->{Id}' ORDER BY Id DESC LIMIT 1");
	
	if($tmp)
	{
		$prev = "<a href=\"$SCRIPTURL?id=$tmp->{Id}\">Назад</a> | ";
	}
	else
	{
		$prev = "";
	}

	$tmp = sql_select_hash($db, "SELECT (Id) from message WHERE Id > '$msg->{Id}' ORDER BY Id LIMIT 1");
	
	if($tmp)
	{
		$next = "<a href=\"$SCRIPTURL?id=$tmp->{Id}\">Вперёд</a>";
	}
	else
	{
		$next = "";
	}
	
	$rep{"navibar"} = make_navibar(1, 1, $prev, $next, 1);

	open TEMP, "$BASEDIR/message.tmpl" or die "$BASEDIR/message.tmpl: $!\n";

	filter_template(\*TEMP, \*STDOUT, %rep);
}

sub root_parent
{
	my ($db, $id) = @_;
	my $row;
	my $last;

	while($row = sql_select_hash($db, "SELECT * from message WHERE Id = '$id'"))
	{
		$id = $row->{Parent};
		$last = $row;
	}

	return $last;
}

sub render_tree
{
	my ($db, $id) = @_;
	my $msg = root_parent($db, $id);
	my $toret;

	$toret = "<ul><li>" . index_line($msg->{Id}, $msg->{Subject}, $msg->{Name}, $msg->{Date}, $id != $msg->{Id}) . "</li>\n";
	$toret .= render_branch($db, $msg->{Id}, 0, 0, $id);
	$toret .= "</ul>";
}

sub render_branch
{
	my ($db, $parent, $start, $num, $nolinkid) = @_;
	my $toret = "";
	my $string = "SELECT * from message WHERE Parent = '$parent' ORDER BY Id "
            . ($parent ? "ASC" : "DESC");

	if($num)
	{
		$string .= " LIMIT $start, $num";
	}

	my $handle = $db->prepare("$string");
	$handle->execute();

	while( my $msg = $handle->fetchrow_hashref())
	{
		$toret .= "<li>" . index_line($msg->{Id}, $msg->{Subject}, $msg->{Name}, $msg->{Date}, $nolinkid != $msg->{Id}) . "</li>\n";
		$toret .= render_branch($db, $msg->{Id}, 0, 0, $nolinkid);
	}

	$handle->finish();

	if($toret)
	{
		$toret = "<ul>" . $toret . "</ul>";
	}

	return $toret;
}

sub render_list
{
	my ($db, $pred, $start, $num) = @_;
	my $toret = "";
	my $string = "SELECT * from message $pred ORDER BY Id DESC";

	if($num)
	{
		$string .= " LIMIT $start, $num";
	}

	my $handle = $db->prepare("$string");


	$handle->execute();

	while( my $msg = $handle->fetchrow_hashref())
	{
		$toret .= "<li>" . index_line($msg->{Id}, $msg->{Subject}, $msg->{Name}, $msg->{Date}, 1) . "</li>\n";
	}

	$handle->finish();

	if($toret)
	{
		$toret = "<ul>" . $toret . "</ul>";
	}

	return $toret;
}

sub render_post
{
	my ($db, $query) = @_;
	my %rep;
	local *TEMP;

	open TEMP, "$BASEDIR/post.tmpl" or die "$BASEDIR/post.tmpl: $!";
	
	$rep{guessname} = guess_name($db, $query);
	$rep{navibar} = make_navibar(1, 1);
	
        print_header();

	filter_template(\*TEMP, \*STDOUT, %rep);

	close(TEMP);
}

sub render_search
{
	my ($db, $query) = @_;
	my %rep;
	local *TEMP;
	
	$rep{navibar} = make_navibar(1, 1);
	
        print_header();

	open TEMP, "$BASEDIR/search.tmpl" or die "$BASEDIR/search.tmpl: $!";

	filter_template(\*TEMP, \*STDOUT, %rep);

	close(TEMP);
}

sub render_page
{
	my ($db, $query, $start, $num, $view) = @_;
	my %rep;
	my $norm = 0;
	my $sqlstring;
	my ($prev, $next);

	local *INDEX;
	local *TEMP;

	if($view eq "date")
	{
		$norm = 1 if($start == 0 and $num == $SPP);
	}
	else
	{
		$norm = 1 if($start == 0 and $num == $TPP);
	}

	open TEMP, "$BASEDIR/$view.tmpl" or die "$BASEDIR/$view.tmpl: $!";
	
	if($norm)
	{
		open INDEX, "+<$BASEDIR/$view.html" or open INDEX, ">$BASEDIR/$view.html" or die "$BASEDIR/$view.html: $!";
		flock(INDEX, Fcntl::LOCK_EX);
		truncate INDEX, 0;
	}
	else
	{
                print_header();
	}

	if($view eq "thread")
	{
		$rep{render_root} = render_branch($db, 0, $start, $num, 0);
		$sqlstring = "SELECT COUNT(*) FROM message WHERE Parent = 0";
	}
	elsif($view eq "date")
	{
		$rep{render_root} = render_list($db, "", $start, $num);
		$sqlstring = "SELECT COUNT(*) FROM message";
	}
	
	if($start)
	{
		my $a;

		$a = $start - $num;
		$a = 0 if $a < 0;
		$next = "<a href=\"$SCRIPTURL?start=$a&num=$num&view=$view\">Вперёд</a>";
	}
	else
	{
		$next = "";
	}

	if($num and (sql_select_hash($db, $sqlstring))->{'COUNT(*)'} > $start + $num)
	{

		$a = $start + $num;
		$prev = "<a href=\"$SCRIPTURL?start=$a&num=$num&view=$view\">Назад</a> | ";
	}
	else
	{
		$prev = "";
	}

	$rep{navibar} = make_navibar($view ne "thread", $view ne "date", $prev, $next);

	if($norm)
	{
		filter_template(\*TEMP, \*INDEX, %rep);
		flock(INDEX, Fcntl::LOCK_UN);
		close(INDEX);
		print $query->redirect("$BASEURL/$view.html");
	}
	else
	{
		filter_template(\*TEMP, \*STDOUT, %rep);
	}
	close(TEMP);

}

sub main
{
	my $db = get_db_handle();
	
	my $query = new CGI;

	if($query->param('id'))
	{
		render_message($db, $query);
	}
	elsif(defined $query->param('post'))
	{
		render_post($db, $query);
	}
	elsif(defined $query->param('parent'))
	{
		post_message($db, $query);
	}
	elsif(defined $query->param('search'))
	{
		if(defined $query->param('body'))
		{
			search_message($db, $query);
		}
		else
		{
			render_search($db, $query);
		}
	}
	else
	{
		my $start = 0;
		my $num;
		my $view;

		$start = $query->param('start') if defined($query->param('start'));
		$num = $query->param('num') if defined($query->param('num'));
		
		$view = saniview($query->param('view'));

		if($view eq "date")
		{
			$num = $SPP unless defined $num;
			render_page($db, $query, $start, $num, "date");
		}
		else
		{
			$num = $TPP unless defined $num;
			render_page($db, $query, $start, $num, "thread");
		}
	}

	$db->disconnect();
}

&main