#!/usr/bin/perl
use strict;
# The first line is needed when this is run as a CGI, and it doesn't hurt
# when it's running under mod_perl. -w schould be appended when debugging.
my $mod_perl = 0;	# 1=mod_perl, 0=CGI
if($ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl/) { $mod_perl =1; }

#############################################################
############ Admin configuration start ######################

my $password_on_edit = 1;	# set to 0 to disable password protection of the edit pages

############ Admin configuration end ########################
#############################################################

my %name;
my %user_data; my $r;
if($mod_perl) {
	$r = Apache->request;
	%user_data = $r->args;
	my %env=$r->cgi_env;
	%name = %{&where(\%env)};
} else {
	use K_CGI;
	use Mysql;
	use Bazar;
	use AltaDeja2SQL_WHERE;
	# this function isn't available on linuxrx.com until the next Apache reload 
	%user_data = K_CGI::hent_get_data(\%ENV);
	%name = %{&where(\%ENV)};
}

my %colors = %{&colors(\%user_data)};

my $dbh;
eval {
	unless($dbh = Mysql->connect('','Bazar')) { &fejl("We don\'t seem to be able to cummnicate with our backend database server at the moment.<br>Please try again in a few minutes."); return 1;}
}; &fejl($@) if($@);


### UserID start
my $reason = "";
unless(length($user_data{'UserID'}) > 0) { 
	$user_data{'UserID'} = time . ":" . $ENV{'REMOTE_ADDR'}; 
	$reason = "no ID";
}
else {
	my($tid, $ip) = ($user_data{'UserID'} =~ /^(.+):(.+)$/);
	unless(length($ip) > 0) { 
		# version 1 UserID's were formatted in another way
		$reason = "Old style ID $user_data{'UserID'}";
		$user_data{'UserID'} = time . ":" . $ENV{'REMOTE_ADDR'};
	} elsif($ENV{'REMOTE_ADDR'} ne $ip) {
		$reason = "IP mismatch";
		$user_data{'UserID'} = time . ":" . $ENV{'REMOTE_ADDR'};
	} else {
		# Issue a new ID if it's more than 30 minutes since 
		# the last visit with that ID
		my $s = $dbh->query("select unix_timestamp(Day) from stats where UserID like \'$user_data{'UserID'}\' order by DAY DESC limit 1");
		my ($sidst) = $s->fetchrow();
		if(($sidst + 1800) < time) {
			if($sidst eq "") { $reason = "bogus UserID $user_data{'UserID'}"; }
			else { $reason = "Too old [$sidst] " . time; }
			$user_data{'UserID'} = time . ":" . $ENV{'REMOTE_ADDR'};
		}
	}
}
my $sth = $dbh->query("insert into stats (UserID, side, verbose, comment, edit, referer) values (\'$user_data{'UserID'}\', \'$user_data{'side'}\', \'$user_data{'verbose'}\', \'$user_data{'comment'}\', \'$user_data{'edit'}\', \'$ENV{'HTTP_REFERER'}\')");
if($reason ne "") { $sth = $dbh->query("insert into NewID (Reason) values (\'$reason\')"); }
### UserID end

my $side = &side(\%user_data, $dbh, $r);
unless($side eq "") {
	$r->print(&html_top(\%name, \%colors)) if($mod_perl);
	$r->print($side) if($mod_perl);
	$r->print(&html_footer(\%name, \%user_data)) if($mod_perl);

	print(&html_top(\%name, \%colors)) unless($mod_perl);
	print($side) unless($mod_perl);
	print(&html_footer(\%name, \%user_data)) unless($mod_perl);
}

if($mod_perl) { return 1; }
#
# That's all folks
#

sub side {
	my %user_data = %{$_[0]};
	my $dbh = $_[1];
	my $r=$_[2];
	my $retur;
	my $sth;
	my %hash; my $q;
	my $why = "";
	my $mode;

	# The meat of the script is inside exception handling.
	# That way regardless of what goes wrong (most likely 
	# some db-stuff or a missing perl library) we can just
	# die() on purpose or involuntary and the exceptionhandling
	# will print a nicely formatted error message.
	# Ther's of course nothing wrong with calling &fejl() directly instead,
	# it will end the program and prevent any cruft in being printed.
	#
	eval {
	# Lets figure out why we are here
		my (%menues, @row);
		$sth=$dbh->query("select Navn from lister where instanceof_char like \'menu\'");
		while(@row = $sth->fetchrow) { $menues{$row[0]} = 1; }
		if(exists $user_data{'liste'}) { $why = "editing"; }
		elsif(exists $user_data{'Commit'}) { $why = "commit"; }
		elsif(exists $user_data{'commit_final'}) { $why = "commit_final"; }
		elsif($user_data{'side'} eq "edit_page") { $why = "edit_page"; $user_data{'edit'} = "yes"; }
		elsif($user_data{'side'} eq "questioning") { $why = "questioning"; $user_data{'edit'} = "yes"; }
		elsif($user_data{'side'} eq "questioning_send") { $why = "questioning_send"; $user_data{'edit'} = "yes"; }
		elsif($user_data{'side'} eq "questioning_unrelated") { $why = "questioning_unrelated"; $user_data{'edit'} = "yes"; }
		elsif($user_data{'side'} eq "questioning_finished") { $why = "questioning_finished"; $user_data{'edit'} = "yes"; }
		elsif(exists $user_data{'query'}) { $why = "search"; } 
		else {
			$user_data{'side'} = "Frontpage" unless(exists $menues{$user_data{'side'}});
		}
		# otherwise show a page from side


	# demand password for all editing functionality
	if($password_on_edit) {
		if($user_data{'edit'} eq "yes") {
			my $access = $dbh->query("select * from edit_access");
			my %users; my %hash;
			while(%hash = $access->fetchhash) {
				$users{$hash{'Base64'}} = [$hash{'User'}, $hash{'Pass'}];
			}
			my %headers = $r->headers_in;
			unless(K_CGI::demand_password(\%headers, \%users, $r, "The editing pages")) { return ""; }
		}
	}
	# mode buttons and search field
	# $mode is a subroutine ref, it print's a <table> when invoked
	# It's first parameter is displayed as page-header
	if(($why ne "editing") && ($why ne "commit") && ($why ne "commit_final")) {
		$mode = &mode(\%user_data, \%name);
	}
	# The editing pages
	if($why eq "editing") {
		#$retur .= &{$mode}("");
		my (%sider, $sth1, %hash1);
		$sth = $dbh->query("select side.Side,lister.* from side,lister where side.ID = lister.ID and side.Side like \'$user_data{'side'}\' ORDER BY Navn") || die "select error: " . $dbh->errmsg;
		%hash = $sth->fetchhash;
		$retur .= "<table border=\"0\" width=\"100%\">\n";
		$retur .= "  <tr><td><a href=\"$name{'me'}?" . &param2(\%user_data, 'UserID', 'side', 'verbose', 'comment', 'navigator') . "&edit=yes\">Back<\/A><\/td>\n";
		$retur .= "  <td halign=\"rigth\" width=\"1\"><font size=\"+1\"><font color=\"$colors{'link'}\"><b>Edit an entry<\/b><\/font><\/font><\/td>\n";
		$retur .= "<\/table><br>\n";
		if($user_data{'liste'} eq "") {
			# Make a new entry before continuing if none is specified
			#$sth=$dbh->query("lock tables lister WRITE");
			$sth=$dbh->query("select ID from lister ORDER by ID DESC LIMIT 1") || die "select error: " . $dbh->errmsg;
			%hash = $sth->fetchhash;#print "[$hash{'ID'}]<br>\n";
			if(exists $user_data{'Navn'}) {
				my $q = "insert into lister (";
				my $q1 = ") VALUES (";
				$sth=$dbh->query("select * from lister limit 0");
				foreach($sth->name) { unless(($_ eq "ID") || (($_ eq "instanceof_char") && (!$user_data{'instanceof_char'})) ) { $q .= "$_,"; $q1 .= "\'" . $user_data{$_} . "\',"; }} chop $q1; chop $q;
				$q .= $q1 . ")";
				$sth=$dbh->query($q) || die $q . "<br>" . $dbh->errmsg;
			} else {
				$sth=$dbh->query("insert into lister (Navn) values (\'$hash{'ID'}_unknown\')") || die "select error: " . $dbh->errmsg;
			}
			#$sth=$dbh->query("unlock tables");
			$sth = $dbh->query("select * from lister where ID like \'" . ($hash{'ID'} +1) . "\'") || die "select error: " . $dbh->errmsg;
		} else {
			# else use the specified one
			$sth = $dbh->query("select * from lister where ID=$user_data{'liste'}") || die "select error: " . $dbh->errmsg;
		}
		$retur .= "<form action=\"$name{'me'}\" method=\"get\">\n";
		$retur .= "<table border=\"0\">\n";
		%hash = $sth->fetchhash;
		foreach(keys %hash) {
			# ToDo check that they are alwayes properly unescaped when saved.
			$hash{$_} =~ s/\"/&#34;/g;
			$hash{$_} =~ s/\'/&#37;/g;
			$hash{$_} =~ s/>/&#62;/g;
			$hash{$_} =~ s/</&#60;/g;
			if($_ eq "ID") {
				$retur .= "  <tr><td>$_<\/td><td>$hash{$_}<\/td><\/tr>\n";
				$retur .= "  <input type=\"hidden\" name=\"$_\" value=\"$hash{$_}\">\n";
			} elsif($_ eq "Servertype") {
				if($hash{$_} =~ m/^\s*listserv\s*$/) {
					my ($req, $lis) = ("", "checked");
					my ($sub, $bod) = ("", "checked");
					if($hash{'subscribe'} =~ m/-request\@/i) {
						$lis = ""; $req="checked";
					}
					if($hash{'subscribe'} =~ m/\?subject=/i) {
						$bod = ""; $sub = "checked";
					}
					$retur .= "  <tr><td><\/td><td>-request\@ <input type=\"radio\" name=\"listserv_type\" value=\"request\" $req> listserv\@ <input type=\"radio\" name=\"listserv_type\" value=\"listserv\" $lis>   subject<input type=\"radio\" name=\"listserv_where\" value=\"subject\" $sub>  body<input type=\"radio\" name=\"listserv_where\" value=\"body\" $bod><\/td><\/tr>\n";
				} else {
					$retur .= "  <tr><td><\/td><td>-request\@ <input type=\"radio\" name=\"listserv_type\" value=\"request\"> listserv\@ <input type=\"radio\" name=\"listserv_type\" value=\"listserv\" checked><img src=\"$name{'100_1'}\" border=\"0\" width=\"100\" height=\"1\">subject<input type=\"radio\" name=\"listserv_where\" value=\"subject\">  body<input type=\"radio\" name=\"listserv_where\" value=\"body\" checked><\/td><\/tr>\n";
				}
				$retur .= "  <tr><td>$_<\/td><td><input type=\"text\" name=\"$_\" value=\"$hash{$_}\" size=\"60\"><\/td><\/tr>\n";
			} else {
				$retur .= "  <tr><td>$_<\/td><td><input type=\"text\" name=\"$_\" value=\"$hash{$_}\" size=\"60\"><\/td><\/tr>\n";
			}
		}
		$retur .= &param(\%user_data, 'query', 'search', 'comment', 'verbose', 'UserID', 'side', 'navigator');
		$retur .= "  <tr><td><input type=\"submit\" value=\"Commit changes\" name=\"Commit\"><\/td><td><\/td><\/tr>\n";

		$sth  =  $dbh->query("select side.Side from side,lister where side.ID = lister.ID and lister.ID like \'$user_data{'liste'}\'") || die "select error: " . $dbh->errmsg;
		while(%hash = $sth->fetchhash) { $sider{$hash{'Side'}} = "yes"; }
		#$sth1 =  $dbh->query("select Side from sidebeskrivelse") || die "select error: " . $dbh->errmsg;
		$sth1 =  $dbh->query("select Navn from lister where instanceof_char like \'menu\'") || die "select error: " . $dbh->errmsg;

		$retur .= "  <tr><td colspan=\"2\">\n    <table border=\"0\">\n      <tr>\n";

		my $omg=0;
		my ($linje1, $linje2) = ("      <tr>", "      <tr>");
		while(%hash1 = $sth1->fetchhash) {
			$linje1 .= "<th>$hash1{'Navn'}<\/th>";
			$linje2 .= "<td><center><input type=\"checkbox\" name=\"i_side_$hash1{'Navn'}\" value=\"yes\"";
			if(exists $sider{$hash1{'Navn'}}) { $linje2 .= "checked ><\/center><\/td>"; } else { $linje2 .= "><\/center><\/td>"; }
			if($omg++ == 5) { $linje1 .= "      <\/tr>\n"; $linje2 .=  "<\/tr>\n"; $retur .= $linje1 . $linje2; $omg=0; ($linje1, $linje2) = ("      <tr>", "      <tr>");}
		} unless($omg==0) { $linje1 .= "      <\/tr>\n"; $linje2 .=  "<\/tr>\n"; $retur .= $linje1 . $linje2; }
		$retur .= "    <\/table>\n  <\/td><\/tr>\n";
		$retur .= "<\/table>\n<\/form>\n";
	} elsif($why eq "commit") {
		#$retur .= &{$mode}("Commit page");
		# Opdater en tuple i lister
		$retur .= "<h1>Are these data ready for Commit?<\/h1>\n";
		$retur .= "<table>\n";
		$retur .= "<form>\n";
		my @sider = ("");
		my $omg = 0; my $order;
		if($user_data{'Servertype'} =~ m/^\s*listserv\s*$/i) {
			my ($name, $server) = ($user_data{'List'} =~ m/(.*)\@(.*)/);
			my ($where) = ("body");
			$where = "subject" if($user_data{'listserv_where'} eq "subject");
			if($user_data{'listserv_type'} eq "request") {
				if($user_data{'subscribe'} =~ m/^\s*$/) {
					$user_data{'subscribe'} = "<a href=\"mailto:$name-request\@$server?$where=subscribe\">subscribe<\/A>";
				}
				if($user_data{'unsubscribe'} =~ m/^\s*$/) {
					$user_data{'unsubscribe'} = "<a href=\"mailto:$name-request\@$server?$where=unsubscribe\">unsubscribe<\/A>";
				}
				$user_data{'Server'} = "$name-request\@$server";
			} else {
				if($user_data{'subscribe'} =~ m/^\s*$/) {
					$user_data{'subscribe'} = "<a href=\"mailto:listserv\@$server?$where=subscribe\">subscribe<\/A>";
				}
				if($user_data{'unsubscribe'} =~ m/^\s*$/) {
					$user_data{'unsubscribe'} = "<a href=\"mailto:listserv\@$server?$where=unsubscribe\">unsubscribe<\/A>";
				}
				$user_data{'Server'} = "listserv\@$server";
			}
		} elsif($user_data{'Servertype'} =~ m/^\s*usenet\s*$/i) {
			$user_data{'Server'} = "<a href=\"news:$user_data{'Navn'}\">$user_data{'Navn'}<\/A>";
			$user_data{'archive'} = "<a href=\"http:\/\/www.dejanews.com\/\[LB=http:\/\/www.linuxrx.com\/Lists\/Lists.perl\]\/dnquery.xp?QRY=%7Eg+%28$user_data{'Navn'}%29\">www.dejanews.com<\/A>";
		}
		foreach(keys %user_data) {
			$retur .= "<tr><td>$_<\/td><td>$user_data{$_}<\/td><\/tr>\n" unless($_ =~ m/^i_side_/);
			my($side) = ($_ =~ m/^i_side_(.+)$/);
			$sider[scalar(@sider) - 1] .= "<td>$side<\/td>" if($side ne "");
			$omg++ if($side ne "");
			if($omg == 4) { push @sider, ""; }
		} $retur .= "<\/table>\n";

		$retur .= "<table border=\"2\">\n";
		foreach(@sider) { $retur .= "<tr>$_<\/tr>\n"; }
		if((scalar(@sider) == 1) && ($sider[0] eq "")) { $retur .= "<tr><td><font color=\"red\">No categories selected<\/font><\/td><\/tr>\n"; }
		$retur .= "<\/table>\n";

		delete $user_data{'Commit'};delete $user_data{'Commit_changes'};
		$retur .= "<a href=\"$name{'me'}?UserID=" . K_CGI::urlencode($user_data{'UserID'}) . "&edit=yes&liste=$user_data{'ID'}&" . &param2(\%user_data) . "\">Edit data<\/a><br>\n";
		$retur .= "<a href=\"$name{'me'}?edit=yes&commit_final=yes&" . &param2(\%user_data) . "\">Commit data<\/a><br>\n";
	} elsif($why eq "commit_final") {
		# opdater tabellerne
		#$retur .= &{$mode}("commit_final");
		$retur .= "<tr><td><a href=\"$name{'me'}?" . &param2(\%user_data, 'UserID', "edit", "side", 'verbose', 'comment', 'search', 'query', 'navigator') . "\">Back<\/A><\/td>\n";
		$retur .= "<h1>Commit<\/h1>\n";
		$retur .= "<p><br><br><br><br><\/p>\n";
		# code to do the update
		# Transaction management schould be included in next version
		# so it will be painless to rollback "mistakes" committed by visitors.
		# A few extra tables with timestamps ip-numbers and the like will most likely be enough.

		# Mysql 3.20.x at falconweb doesn't support locking.
		# It's in next version, which I'm currently running a Beta version at home.
		#$sth = $dbh->query("lock tables lister WRITE,side WRITE");

		my $q = "UPDATE lister SET ";
		$sth=$dbh->query("select * from lister limit 0") || die "select error: " . $dbh->errmsg;
		foreach($sth->name) {
			$q .= "$_=" . $dbh->quote($user_data{$_}) . ",";
		} chop $q;
		$q .= " WHERE ID=$user_data{'ID'}";
		# This might very well fail, the Name could already be taken
		unless($sth = $dbh->query($q)) { 
			$retur  = "<h1><font color=\"red\">Your update went wrong<\/font><\/h1><br>\n"; 
			$retur .= "<p>\nThe update could not be entered into the system.<br>";
			$retur .= "maybe the \"Name\" you typed is already taken?\n<\/p>\n";
			$retur .= "<br><p><a href=\"$name{'me'}?liste=$user_data{'ID'}&" . &param2(\%user_data, "liste", "edit", "side", 'verbose', 'comment', 'UserID', 'navigator') . "\">Try again<\/A><\/p>\n";
			$retur .= "<p><a href=\"$name{'me'}?" . &param2(\%user_data, 'UserID', 'verbose', 'comment', 'navigator') . "\">Forget about the update<\/A><\/p>\n";
			$retur .= "<br><p>The errormessage was:<br><pre>" . $dbh->errmsg . "<\/pre><\/p><br>\n<pre>query [$q]<\/pre>\n<br><br>\n";
			return $retur;
		}
		#print "[$q]<br>\n";
		#foreach(keys %user_data) { print "[$_][$user_data{$_}]<br>\n"; }

		# We removes it from all pages, and enteres in into the specified ones.
		$sth = $dbh->query("delete from side where ID=$user_data{'ID'}");
		foreach(keys %user_data) {
			my($side) = ($_ =~ m/^i_side_(.+)/);
			if($side ne "") { $sth=$dbh->query("insert into side (Side,ID) values (" . $dbh->quote($side) . ", $user_data{'ID'})"); }
		}

		#$sth = $dbh->query("unlock tables");
		$retur .= "<p>Your changes have been committed to the base<\/p><br>";
		$retur .= "<p><br><br><br><br><\/p>";
	} elsif($why eq "questioning_send") {
		# Mail out "Lists" letters to all servers that we havent heard from
		# in over the specified amount of time.
		# Tell which servers are getting such a mail.
		# Tell which servers we would have liked to question but wasn't able to
		# because we don't know how.
		# Do not make forms where the user can type in the info. It if's that easy
		# the maintainer ought to write the corresponding code to be fitted
		# into this program.
		# Make a "do not bother with this server next time" form.
		# This piece of code must be crond and mail-response friendly.
		#
		$retur .= "<table width=\"590\"><tr><td>Nothing is done here unless qestioning emails may be sent with the webserver account as From address.<br> Ther\'s a Send_questions.pl that does what this function is supposed to do, it can be run as another user, and the responses can then be placed into the directory where this script will look for the replies. This can eg. be done via procmail or even manually.<br>If you want the mails sent from the webserver account then it's a matter of simple editing to enable the functionality.<\/td><\/tr><\/table>\n";
		$retur .= "<p><b>To be checked manually<\/b><\/p>\n";
		$sth=$dbh->query("select distinct Server from lister where Servertype not like \'%majordomo%\' and Servertype not like \'%usenet%\'") || die "select error: " . $dbh->errmsg;
		while(%hash = $sth->fetchhash) {
			$retur .= "Tjeck this one by hand $hash{'Server'}<br>\n";
		}
		$retur .= "Remember to also check the usenet groups.<br><br><br>\n";

		$retur .= "<p><b>Majordomo<\/b><\/p>\n";
		$sth=$dbh->query("select distinct Server from lister where Servertype like \'%majordomo%\'") || die "select error: " . $dbh->errmsg;
		while(%hash = $sth->fetchhash) {
			#unless(open(MAIL, "| mail $hash{'Server'} ")) {
			#	$retur  = "<h1><font color=\"red\">Sending mail went wrong<\/font><\/h1><br>\n"; 
			#	$retur .= "<br><p>The errormessage was:<br><pre>" . $! . "<\/pre><br>$hash{'Server'}<br>\n";
			#	return $retur;				
			#}
			#print MAIL "lists\n";
			#close MAIL;
			$retur .= "Did not send a \"lists\" command to $hash{'Server'}<br>\n";
		}
	} elsif($why eq "questioning_unrelated") {
		# Server = name of server whose uncategorized lists is to be
		# marked as "unrelated"
		my $do = 0; my $ID;
		foreach(keys %user_data) {
			if($_ =~ m/^ur_/) {
				$do++;
				# errors are catched by the exception handling.
				$sth=$dbh->query("insert into lister (Navn, Server) values (\'$user_data{$_}\',\'$user_data{'Server'}\')") || die "select error: " . $dbh->errmsg;
				$sth=$dbh->query("select ID from lister where Navn like \'$user_data{$_}\' AND Server like \'$user_data{'Server'}\'") || die "select error: " . $dbh->errmsg;
				$ID = $sth->fetchrow;
				$sth=$dbh->query("insert into side (Side,ID) values (\'Unrelated\',\'$ID\')") || die "select error: " . $dbh->errmsg;
			}
		}

		$retur .= "<p>Your changes have been committed to the base<\/p><br>";
		$retur .= "<p><br><br><br><br><\/p>";
	} elsif($why eq "questioning_finished") {
		# MsgID = MessageID for the answer mail that is to be marked as finished
		# so further questionings will ignore it.
		my $q = "update answers set finished=now() where MsgID like \'$user_data{'MsgID'}\'";
		unless($sth = $dbh->query($q)) { 
			my $fejl  = "<h1><font color=\"red\">Your update went wrong<\/font><\/h1><br>\n";
			$fejl .= "<p>\nThe update could not be entered into the system.<br>";
			$fejl .= "<br><p>The errormessage was:<br><pre>" . $dbh->errmsg . "<\/pre><\/p><br>\n<pre>query [$q]<\/pre>\n<br><br>\n";
			die $fejl;
		}
		$retur .= "<p>Your changes have been committed to the base<\/p><br>";
		$retur .= "<p><br><br><br><br><\/p>";
	} elsif($why eq "questioning") {
		# Server request/response
		# It parses all files in $name{'mails'} looking for known messages from 
		# list servers. Those it can't comprehend are just displayed, the content
		# of those it recognices the format of are checked against the db to see 
		# if 1. it's already there
		# 2. it's a new list, 3. a list in the db is no longer on the server.
		# Uses Message-ID to avoid checking the same email twice. Checked ID's is 
		# stored in the db.
		$retur .= &{$mode}("questioning");
		my %hash;
		my %messages; my %fundet;
		my %finished_answers;
		$sth=$dbh->query("select * from answers") || die "select error: " . $dbh->errmsg;
		while(%hash = $sth->fetchhash) { 
			if(($hash{'finished'} ne "") && ($hash{'finished'} ne "0000-00-00 00:00:00")) { $finished_answers{$hash{'MsgID'}} = 1; } 
			#else { $retur .= "Unfinished $hash{'MsgID'}<br>\n";}
		}
		# 1. pass - parsing of all files
		my $tid = time;
		my $state = "udenfor"; my ($ID, $From, $body);
		foreach(glob "$name{'mails'}/*") {
			$retur .= "Checking $_<br>\n";
			unless(open(MAIL, "$_")) { $retur .= "open error : $! <br>\n"; next; }
			while(<MAIL>) {
				if($state eq "udenfor") {
					$From =""; $body=""; $ID="";
					if($_ =~ m/^From [\w\d\-\.]+\@[\w\d\-\.]+ /) { $state = "header"; }
				} elsif($state eq "header") {
					#$retur .= "header ";
					if($_ =~ m/^Message-ID: /i) { 						
						($ID) = ($_ =~ m/^Message-ID: <?(.+)>?$/i); if($ID =~ m/>$/) { $ID = substr $ID, 0, (length $ID) - 1; }
						#$retur .= "ID $_ -- $ID<br>\n";
						unless($sth=$dbh->query("insert into answers (MsgID) values (\'$ID\')")) {
							# it were there already - fine
						}
					}
					elsif($_ =~ m/^From: /i) { ($From) = ($_ =~ m/^From:.*\W([\w\-\.]+\@[\w\-\.]+)/i); }
					# how do we safely detect end of header/start of body??
					elsif($_ =~ m/^X-STATUS:/i) { if(($ID ne "") && ($From ne "")) { $state="body"; } else { $state = "udenfor"; }}
				} elsif($state eq "body") {
					if($_ =~ m/^From [\w\d\-\.]+\@[\w\d\-\.]+ /) { $state = "header"; unless(exists $finished_answers{$ID}) { $messages{$ID} = [$From, $body]; }; $From="";$body=""; }
					else { $body .= $_; }
				}
			}
			# mails flagged as "finished" are ignored.
			unless(exists $finished_answers{$ID}) {
				$messages{$ID} = [$From, $body];
				#$retur .= "$ID " . length($body) . "<br>\n";
			}
			close MAIL  || die "close error mail $_: $!\n";
		}
		$retur .= "<p>" . (scalar (keys %messages)) . " messages found in 1. pass<\/p>\n";
		#foreach(keys %messages) { $retur .= "[$_]" . $messages{$_}[0] ."<br>\n"; }
		$retur .= "<p>1. pass (read the files, parse into messaged) took " . (time - $tid) . " s.<\/p>\n"; $tid = time;

		# $messages{$ID} = ([$From, $body]);
		my $i =0;
		foreach(keys %messages) {
			my %lists;
			my $ID = $_;
			my($server, $servertype);

			#see if it's a "lists" from a majordomo server
			$state = "udenfor"; my $tom=0; my $bid =0;
			foreach(split "\n", $messages{$ID}[1]) {
				my ($l, $b, $liste);
				#$retur .= "$_<br>\n";
				if($_ =~ m/^[\w\d\-\.\@]+ serves the following lists:/) { 
					$state = "lists";
					$server = $messages{$ID}[0];
					$servertype = "majordomo";
				} elsif($_ =~ m/^[\w\d\-\.\@]+ sirve las siguientes listas:/) {
					$state = "lists";
					$server = $messages{$ID}[0];
					$servertype = "majordomo";
				} elsif($_ =~ m/^Here is the current active list of the \d+ mailing lists served by this server:/) {
					$state = "lists";
					$server = $messages{$ID}[0];
					$servertype = "majordomo";
				} elsif($state eq "lists") {
					$l=""; $b=""; $liste="";
					($l, $b) = ($_ =~ m/[\s\t]*([\w\-\d\.]+)[\@\w\d\.]*[\s\t]*([\s\w\-\+\d\.\/\(\)]*)/);
					($liste) = ($server =~ m/(\@.+)$/); $liste = $l . $liste;
					if($l ne "") { $bid=1; $fundet{$i++} = {ID => $ID, "Navn" => $l, "Server" => $server, "Servertype" => $servertype, "List" => $liste, "Beskrivelse" => $b, "subscribe" => "<a href=\"mailto:$server?body=subscribe $l\">subscribe<\/A>",  "unsubscribe" => "<a href=\"mailto:$server?body=unsubscribe $l\">unsubscribe<\/A>", "info" => "<a href=\"mailto:$server?body=info $l\">info<\/A>"}; }
					if($_ =~ m/^$/) { $tom++; if($tom > 1) {last;} }
				}
			}
			$sth=$dbh->query("update answers set Server=\'$server\' where MsgID like \'$ID\'") || die "select error: " . $dbh->errmsg;

			# ToDo write similar tests for listserv, qmail, smartlist etc.		

			# None of the smart functions have recogniced the content, so display it unformated.
			unless($bid) {
 				$fundet{$i++} = {"Body" => $messages{$ID}[1], "ID" => $ID, "From" => $messages{$ID}[0]};
			}
		}
		$retur .= "<p>" . (scalar (keys %fundet)) . " lists and unparsable mails found in 2. pass<\/p>\n";
		$retur .= "<p>2. pass (find the type of each email) took " . (time - $tid) . " s.<\/p>\n"; $tid = time;

		my %lister;
		foreach(keys %fundet) {
			# Write a big page with all the information gathered from the files
			# %fundet{unique_but_useless} = ("Navn" => "", etc. );
			#$retur .= "<p>$fundet{$_}<\/p>\n";
			my %val = %{$fundet{$_}};
			if(exists $val{'Body'}) {
				# an email this program didn't know how to parse
				$retur .= "<p><b>unknown<\/b> <a href=\"$name{'me'}?UserID=" . K_CGI::urlencode($user_data{'UserID'}) . "&liste=&edit=yes\" target=\"indtast\">Make an new entry<\/A>";
				$retur .= "    <a href=\"$name{'me'}?side=questioning_finished&MsgID=" . K_CGI::urlencode($val{'ID'}) . "\">Mark this answer as finished<\/A>\n";
				$retur .= "<br><b>From: $val{'From'}	 MessageID: $val{'ID'}<\/B><BR>\n<pre>\n";
				$retur .= $val{'Body'} . "<br>\n";
				$retur .= "\n<\/pre>\n<\/p><hr>\n";
			} else {
				# See if it's already in the base, tell the user, make an edit
				# button with these data, and another with the saved data.
				# 
				# TODO
				# Check if ther's lists in the db that their servers doesn't mention.
				# Make some buttons to edit those at the bottom of the page.
				#
				$sth=$dbh->query("select * from lister where Navn like \'$val{'Navn'}\' AND Server like \'$val{'Server'}\'") || die "select error: " . $dbh->errmsg;
				%hash = $sth->fetchhash;
				my $key = $val{'Server'} . "_#_#_#_" . $val{'ID'};
				if(exists $hash{'Navn'}) {
					# No descriptions of known lists - they disturb the visual apperance of the GUI
					push @{${$lister{$key}}{'Known'}}, "Known: $val{'Navn'}  -  <a href=\"$name{'me'}?edit=yes&liste=$hash{'ID'}&" . &param2(\%hash) . "\" target=\"indtast\">edit the saved data<\/A> <br>\n";
				} else {
					push @{${$lister{$key}}{'Unknown'}}, "Unknown: $val{'Navn'}  -  $val{'Beskrivelse'}  <a href=\"$name{'me'}?edit=yes&liste=&" . &param2(\%val) . "\" target=\"indtast\">enter the list into the db<\/A> <br>\n";
				}
		   }
		}		
		$retur .= "<p>3-2. pass (See if it's already in the base) took " . (time - $tid) . " s.<\/p>\n"; $tid = time;
		# print the found lists
		foreach(keys %lister) {
			my ($Server, $MsgID) = ($_ =~ m/(.+)_#_#_#_(.+)/);
			my $t=0; my $u = "\n<br><a href=\"$name{'me'}?side=questioning_unrelated&Server=" . K_CGI::urlencode($Server) . "&";
			my $unrelated = $u; my $no = 0;
			my $unrelated_total;
			foreach(@{${$lister{$_}}{'Unknown'}}) { 
				my ($List) = ($_ =~ m/^Unknown:\s(\S+)\s/);
				$unrelated .= "ur_" . $t++ . "=" . K_CGI::urlencode($List) . "&";
				$no = 0;
				if(length($unrelated) > 2000) {
					# Netscape 4.05 for Unix truncates URL's longer than ~ 3500 chars.
					# other browsers seems to have such limits too
					# So we are not allowing more than 2000 characters in a "Mark as unrelated" URI.
					# This limit is somewhat arbitrary but way lower than the limit in Netscape.
					chop $unrelated;
					$unrelated .= "\">Mark some of the unknown as unrelated<\/A><br>\n";
					$unrelated_total = $unrelated;
					$unrelated = $u;
					$no = 1;
				}
			}
			unless($no) {
				chop $unrelated;
				$unrelated .= "\">Mark the unknown as unrelated<\/A><br>\n";
				$unrelated_total = $unrelated;
			}
			$retur .= "<p><b>$Server<\/b>\n";
			$retur .= $unrelated_total;
			$retur .= "<a href=\"$name{'me'}?side=questioning_finished&MsgID=" . K_CGI::urlencode($MsgID) . "\">Mark this answer as finished<\/A><\/p>\n";
			foreach(@{${$lister{$_}}{'Unknown'}}) { $retur .= "$_"; }
			foreach(@{${$lister{$_}}{'Known'}})   { $retur .= "$_"; }
		} $retur .= "\n<hr>\n";
	} else {
		# en af emnesiderne
		$retur .= &{$mode}($user_data{'query'}) unless($user_data{'query'} eq "");
		$retur .= &{$mode}($user_data{'side'})  if($user_data{'query'} eq "");
		
		$retur .= "<table border=\"0\" width=\"100%\">\n";
		$retur .= "<tr><td><a href=\"$name{'me'}?side=edit_page&" . &param2(\%user_data, 'verbose', 'comment', 'UserID', 'navigator') . "\">Orphaned lists<\/A><\/td>\n" if($user_data{'edit'} eq "yes");
		$retur .= "<tr><td><a href=\"$name{'me'}?side=questioning_send&" . &param2(\%user_data, 'verbose', 'comment', 'UserID', 'navigator') . "\">Send questioning emails<\/A><\/td>\n" if($user_data{'edit'} eq "yes");
		$retur .= "<tr><td><a href=\"$name{'me'}?side=questioning&" . &param2(\%user_data, 'verbose', 'comment', 'UserID', 'navigator') . "\">Server replies to questioning emails<\/A><\/td>\n" if($user_data{'edit'} eq "yes");

		$retur .= "<tr><td><a href=\"$name{'me'}?liste=&" . &param2(\%user_data, 'verbose', 'comment', 'UserID', 'navigator') . "\">Make new list-entry<\/A><\/td>\n" if($user_data{'edit'} eq "yes");

		$retur .= "<\/table><br>\n";
		if($why eq "edit_page") {
			# orphaned lists, will get less messy when subselects get's inplemneted in MySQL
			$sth  = $dbh->query("select distinct lister.ID from lister") || die "select error: " . $dbh->errmsg;
			my $sth1 = $dbh->query("select distinct side.ID from side") || die "select error: " . $dbh->errmsg;
			my(%lister, %side, @orp);
			while(%hash = $sth->fetchhash)  { $lister{$hash{'ID'}} = ""; }
			while(%hash = $sth1->fetchhash) { $side{$hash{'ID'}} = ""; }
			foreach(keys %lister) { unless(exists $side{$_}) { push @orp, $_; } }
			unless(scalar(@orp) == 0) {
				$q  = "SELECT lister.* from lister where ";
				foreach(@orp) { $q .= "lister.ID=$_ OR "; } chop $q;chop $q;chop $q;
				$q .= " ORDER BY Navn";
			} else { 
				# Stupid but true. We need this "query" that never returns anything.
				$q = "select * from lister where ID=-1"; 
			}
			$sth = $dbh->query($q) || die "select error: " . $dbh->errmsg;	
		} elsif($why eq "search") {
			$sth = $dbh->listfields("lister"); # Only to populate $sth so $sth->name will work
			my @navne; foreach($sth->name) { push @navne, "lister." . $_; }
			my @res = AltaDeja2SQL_WHERE::to_where($user_data{'query'}, @navne);
			$q = "select distinct lister.* from lister,side WHERE (" . $res[1] . ") AND lister.instanceof_char LIKE 'list' AND side.ID=lister.ID AND side.Side NOT like \'Unrelated\' ORDER BY Navn";
			$sth = $dbh->query($q) || die "<p>QUERY [$q]<br>" . $dbh->errmsg;
		} else {
			$sth = $dbh->query("select side.Side,lister.* from side,lister where side.ID = lister.ID and side.Side like \'$user_data{'side'}\' ORDER BY Navn") || die "select error: " . $dbh->errmsg;
		}
		$retur .= &show($sth, \%user_data);
	}	
	}; &fejl($@) if($@);
	return $retur;
}
sub show {
	my %user_data = %{$_[1]};
	my $sth = $_[0];
	my $retur;
	my $col = 0;
	my $found_lists = 0;
	my $found_menues = 0;
	my %hash;
	my ($menus, $lists) = ("<table border=\"0\">\n<tr><td><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><\/td> <td><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><img src=\"$name{'135_1'}\" width=\"135\" height=\"1\" border=\"0\"><\/td> <td><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><img src=\"$name{'135_1'}\" width=\"135\" height=\"1\" border=\"0\"><\/td><\/tr>", "");
	my $navigator_edit = $user_data{'navigator'};
	$user_data{'navigator'} .= $user_data{'side'} . " : ";

	unless($user_data{'verbose'} eq "yes") {
		my @linjer;
		my $col = 0;
		while(%hash = $sth->fetchhash) {
			if($hash{'instanceof_char'} eq "list") {
				$found_lists++;			
				$linjer[0] .= "<td>    <\/td><td valign=\"top\"><b>" . lc($hash{'Navn'}) . "<\/b>";
				if($user_data{'edit'}) { $linjer[0] .= "    <a href=\"$name{'me'}?edit=yes&liste=" . K_CGI::urlencode($hash{'ID'}) . "&" . &param2(\%user_data, 'side', 'verbose', 'comment', 'query', 'search', 'UserID') . "&navigator=" . K_CGI::urlencode($navigator_edit) . "\">edit<\/A>" ; }
				$linjer[0] .= "<\/td>";
				$linjer[1] .= "<td>    <\/td><td valign=\"top\" width=\"48%\">$hash{'Beskrivelse'}<\/td>";
				$linjer[2] .= "<td>    <\/td><td valign=\"top\">servertype: $hash{'Servertype'}<\/td>";
				$linjer[3] .= "<td>    <\/td><td valign=\"top\">$hash{'subscribe'}   $hash{'unsubscribe'}   $hash{'info'}<\/td>";
				$linjer[4] .= "<td>    <\/td><td><br><\/td>";
				unless($found_lists % 2) {
					$lists .= "<table border=\"0\" width=\"590\">\n";
					for(my $i=0; $i< scalar @linjer;$i++) {
						$lists .= "<tr>$linjer[$i]<\/tr>\n";
						$linjer[$i] = "";
					} $lists .= "<tr><td colspan=\"2\"> <img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><img src=\"$name{'135_1'}\" width=\"135\" height=\"1\" border=\"0\"><\/td>  <td colspan=\"2\"> <img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><img src=\"$name{'135_1'}\" width=\"135\" height=\"1\" border=\"0\"><\/td><\/tr>\n";
					$lists .= "<\/table>\n";
				}
			} else {
				$found_menues++;
				unless($col) { $menus .= "  <tr>\n    <td><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><\/td><td><a href=\"$name{'me'}?UserID=" . K_CGI::urlencode($user_data{'UserID'}) . "&side=" . K_CGI::urlencode($hash{'Navn'}) . "&verbose=" . K_CGI::urlencode($user_data{'verbose'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&edit=" . K_CGI::urlencode($user_data{'edit'}) . "&navigator=" . K_CGI::urlencode($user_data{'navigator'}) . "\">$hash{'Navn'}<\/A><\/td>"; $col++; }
				else { $menus .= "    <td><a href=\"$name{'me'}?UserID=" . K_CGI::urlencode($user_data{'UserID'}) . "&side=" . K_CGI::urlencode($hash{'Navn'}) . "&verbose=" . K_CGI::urlencode($user_data{'verbose'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&edit=" . K_CGI::urlencode($user_data{'edit'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&edit=" . K_CGI::urlencode($user_data{'edit'}) . "&navigator=" . K_CGI::urlencode($user_data{'navigator'}) . "\">$hash{'Navn'}<\/A><\/td>\n  <\/tr>"; $col--; }
			} 
		}
		if($col) { $menus .= "  <\/tr>\n"; }
		$menus .= "<tr><td><br><\/td> <td><\/td><\/tr><\/table>\n";
		if($found_lists % 2) {
			$lists .= "<table border=\"0\" width=\"590\">\n";
			for(my $i=0; $i< scalar @linjer;$i++) {
				$lists .= "<tr>$linjer[$i] <td>    <\/td><td valign=\"top\" width=\"48%\"><\/td><\/tr>\n";
				$linjer[$i] = "";
			} $lists .= "<tr><td colspan=\"2\"> <img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><img src=\"$name{'135_1'}\" width=\"135\" height=\"1\" border=\"0\"><\/td><td colspan=\"2\"> <img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><img src=\"$name{'135_1'}\" width=\"135\" height=\"1\" border=\"0\"><\/td><\/tr>\n";
			$lists .= "<\/table>\n";
		}
	} else {
		while(%hash = $sth->fetchhash) {
			if($hash{'instanceof_char'} eq "list") {
				$found_lists++;
				$lists .= "<table border=\"0\" width=\"590\">\n";
				$lists .= "<tr><td><img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><\/td><td colspan=\"2\"><B>" . lc($hash{'Navn'}) . "<\/B>\n";
				if($user_data{'edit'} eq "yes") { $lists .= "    <a href=\"$name{'me'}?edit=yes&liste=" . K_CGI::urlencode($hash{'ID'}) . "&" . &param2(\%user_data, 'UserID', 'side', 'verbose', 'comment', 'query', 'search', 'navigator') . "\">edit<\/A><\/td><\/tr>\n"; }
				else { $lists .= "<\/td><\/tr>\n"; }
				$lists .= "<tr><td><\/td><td colspan=\"2\">$hash{'Beskrivelse'}<\/td><\/tr>\n";

				$lists .= "<tr><td><\/td><td halign=\"left\">Server	  <\/td><td> " . lc($hash{'Server'}) . "<\/td><\/tr>\n";
				$lists .= "<tr><td><\/td><td halign=\"left\">List 	  <\/td><td> " . lc($hash{'List'}) . "<\/td><\/tr>\n";
				$lists .= "<tr><td><\/td><td halign=\"left\">Archive  <\/td><td> $hash{'archive'}<\/td><\/tr>\n";
				$lists .= "<tr><td><\/td><td halign=\"left\">FAQ  	  <\/td><td> $hash{'faq'}<\/td><\/tr>\n";
				$lists .= "<tr><td><\/td><td halign=\"left\">Servertype<\/td><td> " . ucfirst(lc($hash{'Servertype'})) . "<\/td><\/tr>\n";

				my $where = "body"; $where = "subject" if($hash{'subscribe'} =~ m/subject/i);
				$lists .= "<tr><td><\/td><td halign=\"left\" colspan=\"2\">To subscribe to this list send an email to " . lc($hash{'Server'}) .  " with the word \"subscribe $hash{'Navn'}\" in the $where of the mail, substitute \"subscribe\" with \"unsubscribe\", \"info\" or \"help\" if that\'s what you want,</td></tr>\n" unless($hash{'Servertype'} =~ m/usenet/i);
				$lists .= "<tr><td><\/td><td colspan=\"1\">or click here<\/td><td>$hash{'subscribe'}   $hash{'unsubscribe'}   $hash{'info'}<\/td><\/tr>\n" unless($hash{'Servertype'} =~ m/usenet/i);

				$lists .= "<tr><td><\/td><td halign=\"left\" colspan=\"2\">Use an external newsreader application if your webbrowser doesn\'t launch one when you click the \"Server\" link above.<\/td><\/tr>\n" if($hash{'Servertype'} =~ m/usenet/i);

				$lists .= "<tr><td><\/td><td><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><\/td><td><img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><img src=\"$name{'150_1'}\" width=\"150\" height=\"1\" border=\"0\"><\/td><\/tr>\n";
				$lists .= "<\/table>\n";
			} else {
				$found_menues++;
				unless($col) { $menus .= "  <tr>\n    <td><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><\/td><td><a href=\"$name{'me'}?UserID=" . K_CGI::urlencode($user_data{'UserID'}) . "&side=" . K_CGI::urlencode($hash{'Navn'}) . "&verbose=" . K_CGI::urlencode($user_data{'verbose'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&edit=" . K_CGI::urlencode($user_data{'edit'}) . "&navigator=" . K_CGI::urlencode($user_data{'navigator'}) . "\">$hash{'Navn'}<\/A><\/td>"; $col++; }
				else { $menus .= "    <td><a href=\"$name{'me'}?UserID=" . K_CGI::urlencode($user_data{'UserID'}) . "&side=" . K_CGI::urlencode($hash{'Navn'}) . "&verbose=" . K_CGI::urlencode($user_data{'verbose'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&comment=" . K_CGI::urlencode($user_data{'comment'}) . "&edit=" . K_CGI::urlencode($user_data{'edit'}) . "&navigator=" . K_CGI::urlencode($user_data{'navigator'}) . "\">$hash{'Navn'}<\/A><\/td>\n  <\/tr>"; $col--; }
			}
		}	
		if($col) { $menus .= "  <\/tr>\n"; }
		$menus .= "<tr><td><br><\/td> <td><\/td><\/tr><\/table>\n";
	}
	$retur .= $menus . $lists;

	$retur .= "<table border=\"0\" width=\"590\">\n";

	if(($user_data{'side'} eq "Frontpage") && (!(exists $user_data{'query'}))) {	
		$sth=$dbh->query("select count(Navn) from lister ");
		my($lister) = $sth->fetchrow;
		$sth=$dbh->query("select count(lister.ID) from lister,side where lister.ID=side.ID AND (side.Side like 'Unrelated' OR lister.instanceof_char NOT LIKE 'list')") || die "select error: " . $dbh->errmsg;
		my($unrelated) = $sth->fetchrow;
		$retur .= "<tr><td colspan=\"3\"><br><br>This index includes " .  ($lister - $unrelated) . " mailing-lists and newsgroups at the moment<\/td><\/tr>\n";
	} else {
		$retur .= "<tr><td>    <\/td><td>Ther\'s $found_lists lists in this category\/query<\/td><\/tr>\n" if($found_lists > 2);
	}
	if(!$found_lists && !$found_menues) {
		$retur .= "<center><H3><font color=\"red\">Ther\'s no entries in this category at the moment<\/font><\/H3><\/center>\n";
		$retur .= "<p><br><br><br><br><br><br><br><br><\/p>\n";
	}
	$retur .= "<\/table>\n";
	return $retur;
}
sub param {
	# makes hidden fields for forms with the specified data
	my %user_data = %{shift @_};
	my $retur = "";
	my @navne;
	if($_[0]) {
		@navne = @_;
	} else {
		@navne = keys %user_data;
	}
	foreach(@navne) {
 		$retur .= "    <input type=\"hidden\" name=\"$_\" value=\"$user_data{$_}\">\n";
	}
	return $retur;
}
sub param2 {
	# makes ?query_string's with the specified data
	# complete with URL_encoding
	my %user_data = %{shift @_};
	my $retur = "";
	my @navne;
	if($_[0]) {
		@navne = @_;
	} else {
		@navne = keys %user_data;
	}
	foreach(@navne) { $retur .= K_CGI::urlencode($_) . "=" . K_CGI::urlencode($user_data{$_}) . "&" if($user_data{$_} ne ""); }
	chop $retur;
	return $retur;
}
sub html_top { 
	my %name = %{$_[0]};
	my %colors = %{$_[1]};
	my $retur;
	$retur .= "Content-type: text/html\n\n";
	$retur .= "<html>\n";
	$retur .= "<head>\n  <title>\n    " . $name{'project'} . "  -  " . $name{'page'} . "\n </title>\n";
	$retur .= "  <META name=\"description\" content=\"The Linux resource exchange  -  Linux Related mailinglists\">\n";
	$retur .= "  <META name=\"keywords\"	 content=\"linux, unix, compared, feautures, irix, bsdi, freebsd\">\n";
	$retur .= "</head>\n";
	$retur .= "<body text=\"$colors{'page_text'}\" vlink=\"$colors{'link'}\" link=\"$colors{'link'}\"  background=\"$name{'background'}\">\n\n";
}

sub html_footer {
	my %name = %{$_[0]};
	my %user_data = %{$_[1]};
	my $retur;
	#$retur .= "</table>\n\n";
	$retur .= "<p><\/p>\n";
	$retur .= "<table border=\"0\" width=\"590\">\n";
	$retur .= "<tr><td><i>Please inform us of any lists, FAQ's or archives you think belong in this index, and don\'t hesitate to point out errors in what we have already included.\n";
	unless($user_data{'comment'} eq "no") { 
		$retur .= "You can use the comment service below to contact us.<br>\n";
		$retur .= "If you for some reason prefer email then send it to <a href=\"http://www.image.dk/~elof\">Kristian Elof S&#248;rensen</A> at <a href=\"mailto:elof\@image.dk\">elof\@image.dk</A><\/i><\/p>\n";
		#$retur .= "\n<p>" . Bazar->spyt_ud({"ID" => $ENV{'SCRIPT_NAME'}}) . "<\/p>\n"; 
		$retur .= "\n<p>" . Bazar->spyt_ud({"ID" => '0bce35c01794a2ac265f220d54176e44'}) . "<\/p>\n";
	} else {
		$retur .= "<br>We have a comment service you can use to contact us.<br>\n";
		$retur .= "You get access to it by selecting \"show comments\" above.<\/i><\/p>\n";
	}
	$retur .= "<\/td><\/tr>\n<\/table>\n";
	$retur .= "\n\n</body>\n</html>\n";
}
sub mode {
	# Generates a closure that returns the <table> with the search fields 
	# and the verbose and comments links. It's first parameter is shown 
	# as page heading.
	# It's called in the beginning of sub side but it needs to print the
	# header for the page which will first be known at a later point in 
	# the code.
	# 
	my %user_data = %{$_[0]};
	my $me = ${$_[1]}{'me'};
	my %temp_user_data;

	foreach(keys %{$_[0]}) { $temp_user_data{$_} = ${$_[0]}{$_} unless(($_ eq "query") || ($_ eq "search")); }
	unless(length($temp_user_data{'navigator'}) > 1) { $temp_user_data{'navigator'} = "Frontpage : "; }
	return sub {
		my $retur;
		$retur .= "<table border=\"0\" width=\"590\">\n";
		$retur .= "  <tr><td align=\"right\"><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\"><img src=\"$name{'100_1'}\" width=\"100\" height=\"1\" border=\"0\">";
			if($user_data{'comment'} eq "no") {
				$retur .= "    <font size=\"-1\"><A href=\"$me?comment=yes&" . &param2(\%user_data, 'UserID', 'side', 'verbose', 'edit', 'search', 'query', 'navigator') . "\">show comments<\/A><\/font>\n";
			} else {
				$retur .= "    <font size=\"-1\"><A href=\"$me?comment=no&" . &param2(\%user_data, 'UserID', 'side', 'verbose', 'edit', 'search', 'query', 'navigator') . "\">hide comments<\/A><\/font>\n";
			}
			$retur .= "  <font size=\"-1\"><a href=\"$name{'me'}?edit=yes&" . &param2(\%user_data, 'side', 'verbose', 'comment', 'UserID', 'search', 'query', 'navigator') . "\">edit mode<\/A><\/font>\n" unless($user_data{'edit'} eq "yes");
			$retur .= "  <font size=\"-1\"><a href=\"$name{'me'}?" . &param2(\%user_data, 'side', 'verbose', 'comment', 'search', 'query', 'UserID', 'navigator') . "\">stop editing<\/A><\/font>\n" if($user_data{'edit'} eq "yes");
		$retur .= "<\/td><\/tr>\n";

		$retur .= "<TR>\n  <TD valign=\"top\"><A HREF=\"$name{'main-page'}\"><IMG src=\"$name{'2penguins'}\" alt=\"The Linux Resource Exchange\" height=\"119\" width=\"150\" align=\"left\" border=\"0\"><\/A>\n";
		$retur .= "  <CENTER><FONT SIZE=\"+3\"><A HREF=\"$name{'main-page'}\"><IMG SRC=\"$name{'linuxrx'}\" alt=\"The Linux Resource Exchange\" border=\"0\"></A></FONT><br>\n";
		$retur .= "  <br><br>\n";
		$retur .= "  <B><FONT SIZE=+2>$name{'page'}</B><\/font></CENTER><\/TD><\/TR>\n";
		$retur .= "</table>\n\n";

		$retur .= "<table border=\"0\" width=\"590\">\n<tr><td valign=\"top\">\n";

		$retur .= "<tr><td>"; my $navigator = ""; my $i=0; my $navigator_old;
		foreach(split " : ", $user_data{'navigator'}) {
			$navigator_old = $navigator;
			$navigator .= $_ . " : ";
			$retur .= "<a href=\"$me?" . &param2(\%user_data, 'UserID', 'comment', 'edit', 'verbose') . "&side=" . K_CGI::urlencode($_) . "&navigator=" . K_CGI::urlencode($navigator_old) . "\">" . lc($_) . "<\/A> : \n";
		} $retur .= " " . lc($_[0]) . " <\/td><\/tr>\n";

		unless($user_data{'verbose'} eq "yes") {
			$retur .= "  <tr><td><A href=\"$me?verbose=yes&" . &param2(\%user_data, 'UserID', 'side', 'comment', 'edit', 'search', 'query', 'navigator') . "\">verbose descriptions<\/A><\/td><\/tr>\n";
		} else {
			$retur .= "  <tr><td><A href=\"$me?verbose=no&"  . &param2(\%user_data, 'UserID', 'side', 'comment', 'edit', 'search', 'query', 'navigator') . "\">terse descriptions<\/A><\/td><\/tr>\n";
		}

		my $title = $_[0];
		$title = "" if($title eq  "Frontpage");
		$retur .= "  <tr>\n    <td><form action=\"$me\" method=\"get\"><input type=\"text\" length=\"15\" name=\"query\"><\/td>\n    <td halign=\"rigth\"><font size=\"+1\"><b>$title<\/b><\/font><\/td>\n  <\/tr>\n";
		$retur .= "  <tr>\n    <td><input type=\"submit\" name=\"search\" value=\"search\">" . &param(\%temp_user_data) . "<\/form><\/td>\n  <\/tr>\n";
		$retur .= "<\/table>\n";
		return $retur;
	};
}
sub fejl {
	if($mod_perl) {
		$r->status(200);
		$r->no_cache(1);
		$r->content_type("text/html");
		$r->send_http_header;
		$r->print("<html>\n<head><title>Linux related Mailing Lists<\/title><\/head>\n");
		$r->print("<body bgcolor=\"#ffffff\" text=\"#ff0000\">\n");
		$r->print("<h1>An error occured<\/h1><br><p><br><br><\/p>\n");

		foreach(@_) {
			$r->print("<p>$_<\/p>\n");
		}
		$r->print("<\/body>\n<\/html>\n");
		Apache::exit(0);
	} else {
		print "Content-type: text/html\r\n\r\n";
		print("<html>\n<head><title>Linux related Mailing Lists<\/title><\/head>\n");
		print("<body  text=\"#ff0000\">\n");
		print("<h1>An error occured<\/h1><br><p><br><br><\/p>\n");

		foreach(@_) {
			print("<p>$_<\/p>\n");
		}
		print("<\/body>\n<\/html>\n");
		return 0;
	}
}


sub where {
	my %name;
	my $me = 'http://' . ${$_[0]}{'SERVER_NAME'} . ${$_[0]}{'SCRIPT_NAME'};
	if(${$_[0]}{'SERVER_NAME'} =~ m/www.linuxrx.com$/) {
		#LinuxRX values
		%name = (
			"project"	=> "The Linux Resource Exchange",
			"page"		=> "Linux related Mailing-lists",
			"me"		=> $me,
			"background"	=> "http://www.linuxrx.com/pics/bkgnd1.gif",
			"2penguins"	=> "http://www.linuxrx.com/pics/2penguins.gif",
			"linuxrx"	=> "http://www.linuxrx.com/pics/linuxrx.gif",
			"main-page"	=> "http://www.linuxrx.com/",
			"mails"		=> "/home/linuxrx/public_html/Lists/",
			"100_1"		=> "http://www.linuxrx.com/WS_Linux/100_1.gif",
			"120_1"		=> "http://www.linuxrx.com/WS_Linux/120_1.gif",
			"135_1"		=> "http://www.linuxrx.com/WS_Linux/135_1.gif",
			"150_1"		=> "http://www.linuxrx.com/WS_Linux/150_1.gif",
		);
	} elsif(${$_[0]}{'SERVER_NAME'} eq "www.localdomain") {
		#www.localdomain use
		%name = (
			"project"	=> "The Linux Resource Exchange", 
			"page"		=> "Linux related Mailing-lists",
			"me"		=> $me,
			"main-page"	=> "http://www.linuxrx.com/index.html",
			"background"	=> "http://www.localdomain/linuxhq/pics/bkgnd1.gif",
			"2penguins"	=> "http://www.localdomain/linuxhq/pics/2penguins.gif",
			"linuxrx"	=> "http://www.localdomain/linuxhq/pics/linuxrx.gif",
			"main-page"	=> "http://www.linuxrx.com/",
			"mails"		=> "/home/httpd/public/mod_perl/emails",
		);
	} elsif(${$_[0]}{'SERVER_NAME'} eq "hugin.localdomain") {
		# hugin.localdomain use
		%name = (
			"project" 	=> "The Linux Resource Exchange", 
			"page"		=> "Linux related Mailing-lists",
			"me"		=> $me,
			"background"	=> "http://hugin.localdomain/linuxhq/pics/bkgnd1.gif",
			"2penguins"	=> "http://hugin.localdomain/linuxhq/pics/2penguins.gif",
			"linuxrx"	=> "http://hugin.localdomain/linuxhq/pics/linuxrx.gif",
			"main-page"	=> "http://www.linuxrx.com/",
			"mails"		=> "/home/httpd/html/Tests/mod_perl/emails",
			"100_1"		=> "http://hugin.localdomain/linuxhq/pics/100_1.gif",
			"120_1"		=> "http://hugin.localdomain/linuxhq/pics/120_1.gif",
			"135_1"		=> "http://hugin.localdomain/linuxhq/pics/135_1.gif",
			"150_1"		=> "http://hugin.localdomain/linuxhq/pics/150_1.gif",

		);
	} else {
		# All unknown to this sub eg. falconweb and cramer-ts 
		# are sent to www.linuxrx.com/Lists/Lists.perl
		%name = &where(('SERVER_NAME' => 'www.linuxrx.com', 'SCRIPT_NAME' => '/Lists/Lists.perl'));
	}
	return \%name;
}
sub colors {
	my %user_data = %{$_[0]};
	my %colors = (
		"table_bg"		=> "#ffffff",
		"table_header"	=> "#00c0c0",
		"page_bg"		=> "#FFFFFF",
		"page_text"		=> "#000000",
		"link"			=> "blue"
	);
	my %colors_bright = (
		"table_bg"		=> "#ffffff",
		"table_header"	=> "#ffffff",
		"page_bg"		=> "#ffffff",
		"page_text"		=> "#000000",
		"link"			=> "blue"
	);
	my %colors_bright_edit = (
		"table_bg"		=> "#ffffff",
		"table_header"	=> "lightblue",
		"page_bg"		=> "#ffffff",
		"page_text"		=> "#000000",
		"link"			=> "blue"
	);

	return \%colors_bright_edit if($user_data{'edit'} eq "yes");
	return \%colors_bright_edit if($user_data{'side'} eq "edit_page");
	return \%colors_bright_edit if(exists $user_data{'Commit'});
	return \%colors_bright;
}



=head1 NAME

  Lists - The script behind http://www.linuxrx.com/Lists/Lists.perl

=head1 Description

  This is the code that makes the dynamic HTML user interface, and makes the
  update functionality that's available under the password protected "edit-mode".
  All the code specific to the http://www.linuxrx.com/Lists/Lists.perl is in this
  script, all the generic reusable code is in one of the libraries.

=head1 Keeping the content current

  The mailing-list data that's served by this site needs to be
  kept up to date for the site to be usefull. It's also important
  that newly spotted mailinglist servers can be added to the
  service with a minimum of fuss.
 
  The edit mode serves these purposes. It let's you send out
  questioning emails to all servers alerady in the db, parses
  their response and generates easy to use admin pages, where the
  admin can add and edit the information on new lists.

  The competition seems to have overlooked this importent fact. They holds
  info on lists without including other Linux lists on the same server, even
  though a simple command issued against such a server gives a list of all
  the lists it serves often along with a short description of each one.

  The same edit mode let's the admin select which lists will go
  into which categories, and to take a list away from the index
  if neccesary.


=head1 Other components

  This code relies on several other pieces of code:
  * Bazar.pm, Bazar.pl are used for the comment service.
  * AltaDeja2SQL_WHERE.pm for the search-function.
  * K_CGI.pm for various mod_perl and CGI support functions.
  * MySQL for storage of all data.

  CREATE TABLE lister (
    Navn char(40) DEFAULT '' NOT NULL,
    ID int(4) DEFAULT '0' NOT NULL auto_increment,
    Beskrivelse char(255),
    Server char(87) DEFAULT '' NOT NULL,
    Servertype char(40),
    subscribe char(127),
    unsubscribe char(127),
    info char(127),
    archive char(255),
    faq char(255),
    List char(127),
    Day timestamp(14),
    instanceof_char char(4) DEFAULT 'list' NOT NULL,
    PRIMARY KEY (ID),
    UNIQUE Navn_2 (Navn,Server),
    KEY instanceof_char_i (instanceof_char)
  ); 

  CREATE TABLE side (
    Side char(40) DEFAULT '' NOT NULL,
    ID int(4) DEFAULT '0' NOT NULL,
    PRIMARY KEY (Side,ID),
    KEY ID (ID)
  ); 

  All lists as well as all sub-menues are in the "lister" table.
  "instanceof_char" is either "menu" or "list".
  The "side" table holds an entry each time a list or sub-menu occours 
  in a menu. The "ID" field relates the two tables together.

  The instanceof_char ought to be a 
      enum("list", "menu") DEFAULT  'list'
  but they don't seem to be index-able in the current (3.21.*) version,
  and did not work at all in the older version (3.20.*) of MySQL that's
  used on linuxrx.com

=head1 How it works - technical description

  The pages the casual users sees are generated by passing a
  statement handle to the show {} subroutine, which then extracts
  the data and emits the HTML page.

  All state is kept in the ? parameters that's put after every
  link in the pages. Page cookies like this is the only reliable
  way of keeping state information. Browser cookies are not
  universally accepted, and to keep the state in the server
  and use strange schemes to determine the identity of the visitor
  is error-prone at best.
  
  Every hit is stored in a table in the db, along with some
  information. This is used to make usage statistics.


=head1 Author

Kristian Elof Sørensen C<elof@image.dk>

=cut