#!/usr/bin/perl -w

###############################################################################
# users.pl - this code is for user creation and  administration 
#
# Copyright (C) 1997 Rob "CmdrTaco" Malda
# malda@slashdot.org
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#
#  $Id: users.pl,v 1.22 2000/09/25 17:11:44 pudge Exp $
###############################################################################
use strict;
use lib '../';
use vars '%I';
use Slash;

#################################################################
sub main {
	*I = getSlashConf();
	getSlash();

	my $op = $I{F}{op};

	if ($op eq "userlogin" and $I{U}{uid} > 0) {
		my $refer = 'disc.pl';
		redirect($refer);
		return;
	}

	header("$I{sitename} Users");

	print <<EOT if $I{U}{uid} > 0 && $op ne "userclose";
<P><font face=verdana size=2> [
	<A HREF="$ENV{SCRIPT_NAME}">User Info</A> |
	<A HREF="$ENV{SCRIPT_NAME}?op=edituser">Edit User Info</A> |
	<A HREF="$ENV{SCRIPT_NAME}?op=edithome">Edit Homepage</A> |
	<A HREF="$ENV{SCRIPT_NAME}?op=editcomm">Edit Comments</A> |
	<A HREF="$ENV{SCRIPT_NAME}?op=userclose">Logout</A>
 ] </font></P>

EOT

	# and now the carnage begins
	if ($op eq "newuser") {
		newUser();

	} elsif ($op eq "edituser") {
		# the users_prefs table
		if ($I{U}{uid} > 0) {
			editUser($I{U}{nickname});
		} else {
			displayForm(); #crapMesg();
		}

	} elsif ($op eq "edithome" || $op eq "preferences") {
		# also known as the user_index table
		if ($I{U}{uid} > 0) {
			editHome($I{U}{nickname});
		} else {
			displayForm(); #crapMesg();
		}

	} elsif ($op eq "editcomm") {
		# also known as the user_comments table
		if ($I{U}{uid} > 0) {
			editComm($I{U}{nickname});
		} else {
			displayForm(); #crapMesg();
		}

	} elsif ($op eq "userinfo" || !$op) {
		if ($I{F}{nick}) {
			userInfo($I{F}{nick});
		} elsif ($I{U}{uid} < 1) {
			displayForm();
		} else {
			userInfo($I{U}{nickname});
		}

	} elsif ($op eq "saveuser") {
		saveUser($I{U}{uid});
		userInfo($I{U}{nickname});

	} elsif ($op eq "savecomm") {
		saveComm($I{U}{uid});
		userInfo($I{U}{nickname});

	} elsif ($op eq "savehome") {
		saveHome($I{U}{uid});
		userInfo($I{U}{nickname});

	} elsif ($op eq "sendpw") {
		mailPassword($I{U}{nickname});

	} elsif ($op eq "mailpasswd") {
		mailPassword($I{F}{unickname});

	} elsif ($op eq "suedituser" && $I{U}{aseclev} > 100) {
		editUser($I{F}{name});

	} elsif ($op eq "susaveuser" && $I{U}{aseclev} > 100) {
		saveUser($I{F}{uid}); 

	} elsif ($op eq "sudeluser" && $I{U}{aseclev} > 100) {
		delUser($I{F}{uid});

	} elsif ($op eq "userclose") {
		print "<FONT FACE=VERDANA SIZE=2>Thank you. Please come again.</FONT>";
		displayForm();

	} elsif ($op eq "userlogin" && $I{U}{uid} > 0) {
		# print $query->redirect("$I{rootdir}/index.pl");
		userInfo($I{U}{nickname});

	} elsif ($op eq "preview") {
		previewSlashbox();

	} elsif ($I{U}{uid} > 0) {
		userInfo($I{F}{nick});

	} else {
		displayForm();
	}

	miniAdminMenu() if $I{U}{aseclev} > 100;
	writelog("users", $I{U}{nickname});
	footer();
}

#################################################################
sub crapMesg {
	print <<EOT;
<H1>Error</H1>
<P>Our system doesn't remember who you are,
yet you think you are logged in.  This could be because you are using
an older browser.  Or are behind a firewall or proxy or something that
is stripping cookies.  If you think none of these are the problem, 
please send us your browser version, nickname, uid, platform,
and any other details that seem relavant.  Optionally, you might not have actually ever logged in, please
<A HREF="$I{rootdir}/users.pl">click here</A> to login.</P>
EOT
}

#################################################################
sub checkList {
	my $string = shift;
	$string = substr($string, 0, -1);

	$string =~ s/[^\w,-]//g;
	my @e = split m/,/, $string;
	$string = sprintf "'%s'", join "','", @e;

	if (length($string) > 254) {
		print "You selected too many options<BR>";
		$string = substr($string, 0, 255);
		$string =~ s/,'??\w*?$//g;
	} elsif (length $string < 3) {
		$string = "";
	}

	return $string;
}

#################################################################
sub previewSlashbox {
	my ($title, $content, $url) = sqlSelect(
		"title,block,url", "blocks, sectionblocks",
		"blocks.bid = sectionblocks.bid AND blocks.bid = "
		. $I{dbh}->quote($I{F}{bid})
	);

	my $cleantitle = $title;
	$cleantitle =~ s/<(.*?)>//g;

	titlebar("100%","Preview $cleantitle");
	print <<EOT;
<P>What you see on the right hand side is a preview of the block
labeled "$cleantitle".  If you select it from the
<A HREF="$I{rootdir}/users.pl?op=preferences">Preferences Page</A>,
you will have that little block added to the right hand side of your
<A HREF="$I{rootdir}/index.pl">Custom $I{sitename}</A> page.	 
Exciting?  Not really, but its a great way to waste time.</P>

EOT
	print <<EOT if $I{U}{aseclev} > 999;
<P>Edit <A HREF="$I{rootdir}/admin.pl?op=blocked&bid=$I{F}{bid}">$I{F}{bid}</A></P>
EOT

	print qq!</TD><TD WIDTH="180" VALIGN="TOP">!;

	print portalbox($I{fancyboxwidth}, $title, $content, "", $url);
}

#################################################################
sub miniAdminMenu {
	print <<EOT;
<FORM ACTION="$ENV{SCRIPT_NAME}">
	<FONT FACE=VERDANA SIZE=2> [
		<A HREF="$I{rootdir}/admin.pl">Admin</A> |
		<INPUT TYPE="HIDDEN" NAME="op" VALUE="suedituser">
		<INPUT TYPE="TEXT" NAME="name" VALUE="$I{F}{nick}">
		<INPUT TYPE="SUBMIT" VALUE="Edit">
	 ] </FONT>
</FORM>
EOT
}

#################################################################
sub newUser {
	# Check if User Exists

	$I{F}{newuser} =~ s/\s+/ /g;
	$I{F}{newuser} =~ s/[^ a-zA-Z0-9\$_.+!*'(),-]+//g;
	$I{F}{newuser} = substr($I{F}{newuser}, 0, 20);

	(my $matchname = lc $I{F}{newuser}) =~ s/[^a-zA-Z0-9]//g;

	my($cnt) = sqlSelect(
		"matchname","users",
		"matchname=" . $I{dbh}->quote($matchname)
	) || sqlSelect(
		"realemail","users",
		" realemail=" . $I{dbh}->quote($I{F}{email})
	);

	if ($matchname ne '' && $I{F}{newuser} ne '' && !$cnt && $I{F}{email} =~ /\@/) {
		titlebar("100%", "User $I{F}{newuser} created.");

		$I{F}{pubkey} = stripByMode($I{F}{pubkey}, "html");

		sqlInsert("users", {
			realemail	=> $I{F}{email}, 
			nickname	=> $I{F}{newuser},
			matchname	=> $matchname,
			passwd		=> changePassword()
		});

		my($uid) = sqlSelect("LAST_INSERT_ID()");
		sqlInsert("users_info", { uid => $uid, -lastaccess=>'now()' } );
		sqlInsert("users_prefs", { uid => $uid } );
		sqlInsert("users_comments", { uid => $uid } );
		sqlInsert("users_index", { uid => $uid } );
		# sqlInsert("users_key", { uid => $uid } ); # Not necessary

		print <<EOT;

	<P><B>Email:</B> =$I{F}{email}</P>
	<P><B>User ID:</B> =$uid</P>
	<P><B>Nick:</B> =$I{F}{newuser}</P>
	<P><B>Password: </B>=mailed to $I{F}{email}</P>
	<P>Once you receive your password, you can log in and
	<A HREF="$I{rootdir}/users.pl">set your account up</A></P>

EOT

		mailPassword($I{F}{newuser});

	} else {
		# Duplicate User
		displayForm();
	}
}

#################################################################
sub changePassword {
	my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
	return join '', map { $chars[rand @chars] } 0 .. 7;
}

#################################################################
sub mailPassword {
	my($name) = @_;
	my($nickname, $passwd, $email) = sqlSelect(
		"nickname,passwd,realemail", "users",
		"nickname=" . $I{dbh}->quote($name)
	);

	my $msg = blockCache("newusermsg");
	$msg = prepBlock($msg);
	$msg = eval $msg;

	if ($name ne '' && (lc($name) eq lc($nickname))) {
		sendEmail($email, "$I{sitename} user password for $name", $msg) if $name;
		print "<P>Password for $name was just emailed.</P>\n";
	} else {
		print "<P>$name was not found. No Password mailed.</P>\n"; 
	}
}

#################################################################
sub userInfo {
	my($nick) = @_;

	my $c = $I{dbh}->prepare(
		"SELECT homepage,fakeemail,users.uid,bio, seclev,karma
		 FROM users, users_info
		 WHERE users.uid = users_info.uid AND nickname="
		. $I{dbh}->quote($nick) . " and users.uid > 0"
	);
	$c->execute;

	if (my($home, $email, $uid, $bio, $useclev, $karma) = $c->fetchrow) {
		$bio = stripByMode($bio, "html");
		if ($I{U}{nickname} eq $nick) {
			my $sth = $I{dbh}->prepare("SELECT points FROM users_comments WHERE uid=$uid");
			$sth->execute;
			my $points = $sth->fetchrow_array;
			$sth->finish;

			titlebar("95%", "Welcome back $nick ($uid)");
			print <<EOT;
<P>This is <B>your</B> user info page.  There are thousands more, but this one is yours.
You most likely are not so interested in you, and probably would be most interested in
clicking the "Edit User Info" and "Customize..." links you see up top there so you can
customize $I{sitename}, or change your password.</P>
EOT

			# Users should be able to see their own points.
			if ($I{U}{uid} == $uid && $points > 0) {
				print <<EOT;
<P>You're a moderator with $points points. Please read the
<A HREF="$I{rootdir}/moderation.shtml">Moderator Guidelines</A> before you do any moderation.</P>
<BR>
EOT
			}
			print <<EOT;
<CENTER><IMG SRC="$I{imagedir}/greendot.gif" WIDTH="75%" HEIGHT="1" ALIGN="CENTER"><BR></CENTER>
EOT

		} else {
			titlebar("95%", "User Info for $nick ($uid)");
		}

		print qq!<A HREF="$home">$home</A><BR><A HREF="mailto:$email">$email</A><BR>!;
		print "<P><B>Karma</B> $karma (mostly the sum of moderation done to users comments)<BR></P>"
			if $I{U}{aseclev} || $I{U}{uid} == $uid;
		print "<B>User Bio</B><BR>$bio<P>" if $bio;

		my($k) = sqlSelect("pubkey", "users_key", "uid=$uid");
		$k = stripByMode($k, "html");
		print "<B>Public Key</B><BR><PRE>\n$k</PRE><P>" if $k;

		$I{F}{min} = 0 unless $I{F}{min};

		my $sqlquery = "SELECT pid,sid,cid,subject,"
			. getDateFormat("date","d")
			. ",points FROM comments WHERE uid=$uid ";
		$sqlquery .= " ORDER BY date DESC LIMIT $I{F}{min},50 ";

		my $comments = $I{dbh}->prepare($sqlquery);
		$comments->execute;

		print "<P><B>$nick has posted " . $comments->rows
			. " comments</B> (this only counts the last few weeks)<BR></P>";

		my $x;
		while (my($pid, $sid, $cid, $subj, $cdate, $pts) = $comments->fetchrow) {
			$x++;
			my($r) = sqlSelect("count(*)", "comments", "sid='$sid' and pid=$cid");
			my $replies = " Replies:$r" if $r;

			print <<EOT;
<P><B>$x</B> <A HREF="$I{rootdir}/comments.pl?sid=$sid&cid=$cid">$subj</A> posted on $cdate (Score:$pts$replies)
<FONT FACE=VERDANA SIZE="${\( $I{fontbase} + 2 )}"></P>
EOT
			my $S = sqlSelectHashref("section, title, writestatus", "stories", "sid='$sid'");

			if ($S) {
				my $href = $S->{writestatus} == 10
					? "$I{rootdir}/$S->{section}/$sid.shtml"
					: "$I{rootdir}/article.pl?sid=$sid";

				print qq!<P>attached to <A HREF="$href">$S->{title}</A></P>!;
# $S->{section}/$sid.shtml
			} else {
				my $P = sqlSelectHashref("question", "pollquestions", "qid='$sid'");
				print qq!<BR>attached to <A HREF="$I{rootdir}/pollBooth.pl?qid=$sid"> $P->{question}</A>!
					if $P->{question};
			}
			print "</FONT>";
		}

		$comments->finish;

	} else {
		print "<P>$nick not found.</P>";
	}

	$c->finish;
}

#################################################################
sub editKey {
	my($k) = sqlSelect("pubkey", "users_key", "uid=$_[0]");
	printf qq!<P><B>Public Key</B><BR><TEXTAREA NAME="pubkey" ROWS="4" COLS="60">%s</TEXTAREA>!,
		stripByMode($k, 'literal');
}

#################################################################
sub editUser {
	my($name) = @_;
	my($uid, $realname, $realemail, $fakeemail, $homepage, $nickname,
		$passwd, $sig, $useclev, $bio, $maillist) = sqlSelect(
		"users.uid, realname, realemail, fakeemail, homepage, nickname, " .
		"passwd, sig, seclev, bio, maillist", "users, users_info",
		"users.uid=users_info.uid AND nickname=" . $I{dbh}->quote($name)
	); 

	return if $uid < 1;

	titlebar("100%", "Editing $name ($uid) $realemail");
	print qq!<TABLE ALIGN="CENTER" WIDTH="95%" BGCOLOR="$I{bg}[2]"><TR><TD>!;

	$homepage ||= "http://";
 
	my $tempnick = $nickname;
	$tempnick =~ s/ /+/g;
 
	print <<EOT;
<P>You can automatically login by clicking
<A HREF="$I{rootdir}/index.pl?op=userlogin&upasswd=$passwd&unickname=$tempnick">This Link</A>
and Bookmarking the resulting page. Please note: this is insecure, but very convenient.</P>

<FORM ACTION="$ENV{SCRIPT_NAME}" METHOD="POST">

	<P><B>Real Name</B> (optional)<BR>
		<INPUT TYPE="TEXT" NAME="realname" VALUE="$realname" SIZE="40"><BR>
		<INPUT TYPE="HIDDEN" NAME="uid" VALUE="$uid">
		<INPUT TYPE="HIDDEN" NAME="passwd" VALUE="$passwd">
		<INPUT TYPE="HIDDEN" NAME="name" VALUE="$nickname"></P>

	<P><B>Real Email</B> (required but never displayed publicly. 
		This is where your passwd is mailed.  If you change your
		email, notification will be sent)<BR>
		<INPUT TYPE="TEXT" NAME="realemail" VALUE="$realemail" SIZE="40"></P>

	<P><B>Fake Email</B> (optional:This email publicly displayed by
		your comments, you may spam proof it, leave it blank, 
		or just type in your address)<BR>
		<INPUT TYPE="TEXT" NAME="fakeemail" VALUE="$fakeemail" SIZE="40"></P>

	<P><B>Homepage</B> (optional:you must enter a fully qualified URL!)<BR>
		<INPUT TYPE="TEXT" NAME="homepage" VALUE="$homepage" SIZE="60"></P>

	<P><B>Headline Mailing List</B>
EOT

	selectForm("maillist", "maillist", $maillist);
	printf <<EOT, stripByMode($sig, 'literal'), stripByMode($bio, 'literal');
	<P><B>Signature</B> (appended to the end of your comments.)<BR>
		<TEXTAREA NAME="sig" ROWS="2" COLS="60">%s</TEXTAREA>

	<P><B>Biography</B> (Information publicly displayed on your
		user page.)<BR>
		<TEXTAREA NAME="bio" ROWS="5" COLS="60" WRAP="virtual">%s</TEXTAREA>

EOT

	editKey($uid);

  	print <<EOT;
	<P><B>Password</B> Enter new passwd twice to change it.
		(must be 6-12 chars long)<BR>
		<INPUT TYPE="PASSWORD" NAME="pass1" SIZE="12" MAXLENGTH="12">
		<INPUT TYPE="PASSWORD" NAME="pass2" SIZE="12" MAXLENGTH="12"><P>

</TD></TR></TABLE><P>

	<INPUT TYPE="SUBMIT" NAME="op" VALUE="saveuser">
	</FORM>
EOT

	# print "	<INPUT TYPE="SUBMIT" NAME="op" VALUE="susaveuser"> <INPUT TYPE="SUBMIT" NAME="op" VALUE="sudeluser">" if $I{U}{aseclev}> 499;
}

#################################################################
sub tildeEd {
	my($extid, $exsect, $exaid, $exboxes, $userspace) = @_;
	
	titlebar("100%", "Exclude Stories from the Homepage");

	print <<EOT;
<TABLE WIDTH="515" BORDER="0" CELLPADDING="3" CELLSPACING="3" ALIGN="CENTER">
		<TR BGCOLOR="$I{bg}[3]">
			<TH><FONT FACE=VERDANA COLOR="$I{fg}[3]" SIZE="2">Authors</FONT></TH>
			<TH><FONT FACE=VERDANA COLOR="$I{fg}[3]" SIZE="2">Topics</FONT></TH>
			<TH><FONT FACE=VERDANA COLOR="$I{fg}[3]" SIZE="2">Sections</FONT></TH>
		</TR><TR BGCOLOR="$I{bg}[2]"><TD VALIGN="TOP">
EOT

	# Customizable Authors Thingee
	my $C = sqlSelectMany("aid", "authors", "seclev > 99", "order by aid");
	while (my($aid) = $C->fetchrow) {
		my $checked = ($exaid =~ /'$aid'/) ? ' CHECKED' : '';
		print qq!<FONT FACE=VERDANA SIZE=2><INPUT TYPE="CHECKBOX" NAME="exaid_$aid"$checked>$aid</FONT><BR>\n!;
	}

	$C->finish;

	# Customizable Topic
	print qq!</TD><TD VALIGN="TOP"><MULTICOL COLS="3">!;
	$C = sqlSelectMany("tid,alttext", "topics", "1=1 ", "order by tid");
	while (my($tid, $alttext) = $C->fetchrow) {
		my $checked = ($extid =~ /'$tid'/) ? ' CHECKED' : '';
		print qq!<FONT FACE=VERDANA SIZE=2><INPUT TYPE="CHECKBOX" NAME="extid_$tid"$checked>$alttext</FONT><BR>\n! if $tid;
	}

	$C->finish;
	print "</MULTICOL></TD>";

	# Customizable Sections
	print '<TD VALIGN="TOP">';
	$C = sqlSelectMany("section,title", "sections", "isolate=0", "order by title");

	while (my($section,$title) = $C->fetchrow) {
		my $checked = ($exsect =~ /'$section'/) ? " CHECKED" : "";
		print qq!<FONT FACE=VERDANA SIZE=2><INPUT TYPE="CHECKBOX" NAME="exsect_$section"$checked>$title</FONT><BR>\n! if $section;
	}

	$C->finish;
	print "</TD>";

	print "</TD></TR></TABLE><P>";
	
	titlebar("100%", "Customize InfoBoxes");

	$userspace = stripByMode($userspace, 'literal');
	print <<EOT;
<TABLE WIDTH="515" BGCOLOR="$I{bg}[2]" ALIGN="CENTER" BORDER="0">
	<TR><TD>
	<P><FONT FACE=VERDANA SIZE=2>Configuration Options</FONT>
	<FONT FACE=VERDANA SIZE=2><B>Important:</B> If you leave these all unchecked, it means you
	want the <I>default</I> selection of boxes.  If you start selecting
	boxes, remember to set <B>all</B> of them that you want because the 
	default selection will be <B>ignored</B>.  Default entries are bolded.</FONT>

	<P><B>User Space</B> (check 'user space' below and whatever
	you place here will appear your custom $I{sitename})<BR>
		<TEXTAREA NAME="mylinks" rows=5 COLS="60" WRAP="VIRTUAL">$userspace</TEXTAREA>

	<P><MULTICOL COLS="3">
EOT

	$C = sqlSelectMany("bid,title,ordernum", "sectionblocks", "portal=1", "order by bid");

	while (my($bid,$title,$o) = $C->fetchrow) {
		my $checked = ($exboxes =~ /'$bid'/) ? " CHECKED" : "";
		$title =~ s/<(.*?)>//g;
		print "<B>" if $o > 0;
		print qq!<FONT FACE=VERDANA SIZE=1><INPUT TYPE="CHECKBOX" NAME="exboxes_$bid"$checked></FONT>!
			. qq!<FONT FACE=VERDANA SIZE=1><A HREF="$ENV{SCRIPT_NAME}?op=preview&bid=$bid">!;

		unless ($bid eq "srandblock") {
			print $title;
		} else {
			print "Semi-Random Box";
		}

		print "</A></FONT><BR>\n";
		print "</B>" if $o > 0;
	}

	$C->finish;

	print <<EOT;
	</MULTICOL><P>

	<FONT FACE=VERDANA SIZE=2>If you have reasonable suggestions for boxes that can be added
	here, or a problem with one of the boxes already here,
	email <A HREF="mailto:$I{adminmail}">$I{siteadmin_name}</A>.</FONT>

	<P><FONT FACE=VERDANA SIZE=2>The preferred format is the Netscape RDF format that is
	rapidly becoming the de facto format for exchanging headlines
	between sites.</FONT>
EOT
		
	print "<P></TD></TR></TABLE>";
}

#################################################################
sub editHome {
	my($name) = @_;

	my($uid, $willing, $tzformat, $tzcode, $noicons, $light, $userspace,
		$extid, $exaid, $exsect, $exboxes, $maxstories, $noboxes)
		= sqlSelect("users.uid, willing, dfid, tzcode, noicons, light, "
		. "mylinks, users_index.extid, users_index.exaid, "
		. "users_index.exsect, users_index.exboxes, users_index.maxstories, "
		. "users_index.noboxes", "users, users_prefs, users_index",
		"users.uid=users_prefs.uid AND users.uid=users_index.uid AND "
		. "users.nickname=" . $I{dbh}->quote($name)
	);

	return if $uid < 1;

	titlebar("100%", "Customize $I{sitename}'s Display");

	print <<EOT;
	<FORM ACTION="$ENV{SCRIPT_NAME}" METHOD="POST">
	<TABLE ALIGN="CENTER" WIDTH="95%" BGCOLOR="$I{bg}[2]"><TR><TD>

		<FONT FACE=VERDANA SIZE=2><B>Date/Time Format</B><BR>
EOT

	selectGeneric("dateformats", "tzformat", "id", "description", $tzformat);
	selectGeneric("tzcodes", "tzcode", "tz", "description", $tzcode);
	print "</FONT>";

	my $l_check = $light	? " CHECKED" : "";
	my $b_check = $noboxes	? " CHECKED" : "";
	my $i_check = $noicons	? " CHECKED" : "";
	my $w_check = $willing	? " CHECKED" : "";

	print <<EOT;

	<P><INPUT TYPE="CHECKBOX" NAME="light"$l_check>
	<FONT FACE=VERDANA SIZE=2><B>Light</B> (reduce the complexity of $I{sitename}'s HTML for slow connections)</FONT>

	<P><INPUT TYPE="CHECKBOX" NAME="noboxes"$b_check>
	<FONT FACE=VERDANA SIZE=2><B>Deactivate Slashboxes</B> (just the news, please.)</FONT>

	<P><INPUT TYPE="CHECKBOX" NAME="noicons"$i_check>
	<FONT FACE=VERDANA SIZE=2><B>No Icons</B> (disable topic icon images on stories)</FONT>

	<P><FONT FACE=VERDANA SIZE=2><B>Maximum Stories</B> The default is 12.  The main
	column displays 1/3rd of these at minimum, and all of
	today's stories at maximum.</FONT><BR>
	<INPUT TYPE="TEXT" NAME="maxstories" SIZE="3" VALUE="$maxstories">

	<P><INPUT TYPE="CHECKBOX" NAME="willing"$w_check>
	<FONT FACE=VERDANA SIZE=2><B>Willing to Moderate</B> By default all users are willing to
	<A HREF="$I{rootdir}/moderation.shtml"> Moderate</A>.
	Uncheck this if you aren't interested.</FONT>

	</TD></TR></TABLE><P>
EOT

	tildeEd($extid, $exsect, $exaid, $exboxes, $userspace);

	print qq!\t<INPUT TYPE="SUBMIT" NAME="op" VALUE="savehome">\n!;
	# print qq!\t<INPUT TYPE="SUBMIT" NAME="op" VALUE="susaveuser"> <INPUT TYPE="SUBMIT" NAME="op" VALUE="sudeluser">! if $I{U}{aseclev}> 499;
	print "\t</FORM>\n\n";
}

#################################################################
sub editComm {
	my($name) = @_;

	my($uid, $points, $posttype, $defaultpoints, $maxcommentsize,
		$clsmall, $clbig, $reparent, $noscores, $highlightthresh,
		$commentlimit, $nosigs, $commentspill, $commentsort, $mode,
		$threshold, $hardthresh)
		= sqlSelect("users.uid, points, posttype, defaultpoints, "
		. "maxcommentsize, clsmall, clbig, reparent, noscores, "
		. "highlightthresh, commentlimit, nosigs, commentspill, "
		. "commentsort, mode, threshold, hardthresh",
		"users, users_comments","users.uid=users_comments.uid AND nickname="
		. $I{dbh}->quote($name)
	);

	titlebar("100%", "Comment Options");

	print <<EOT;
	<FORM ACTION="$ENV{SCRIPT_NAME}" METHOD="POST">
	<TABLE ALIGN="CENTER" WIDTH="95%" BGCOLOR="$I{bg}[2]"><TR><TD>
EOT

	print "<FONT FACE=VERDANA SIZE=2><B>Display Mode</B></FONT>";
	selectGeneric("commentmodes", "umode", "mode", "name", $mode);

	print "<P><FONT FACE=VERDANA SIZE=2><B>Sort Order</B></FONT>\n";
	selectForm("sortcodes", "commentsort", $commentsort);

	print "<P><FONT FACE=VERDANA SIZE=2><B>Threshold</B></FONT>";
	selectGeneric("threshcodes", "uthreshold", "thresh", "description", $threshold);

	print <<EOT;
	<BR><FONT FACE=VERDANA SIZE=2>(comments scored less than this setting will be ignored.
	Anonymous posts start at 0, logged in posts start
	at 1.  Moderators add and subtract points according to
	the <A HREF="$I{rootdir}/moderation.shtml">Guidelines</A>.</FONT>
EOT

	print "<P><B>Highlight Threshold</B>";
	selectGeneric("threshcodes", "highlightthresh", "thresh", "description", $highlightthresh);

	print " <BR><FONT FACE=VERDANA SIZE=2>(comments scoring this are displayed even after an article spills into index mode)</FONT>";

	my $h_check = $hardthresh	? " CHECKED" : "";
	my $r_check = $reparent		? " CHECKED" : "";
	my $n_check = $noscores		? " CHECKED" : "";
	my $s_check = $nosigs		? " CHECKED" : "";

	print <<EOT;
	<P><FONT FACE=VERDANA SIZE=2><B>Hard Thresholds</B> (Hides 'X Replies Below
	Current Threshold' Message from Threads)</FONT>
	<INPUT TYPE="CHECKBOX" NAME="hardthresh"$h_check>

	<P><FONT FACE=VERDANA SIZE=2><B>Reparent Highly Rated Comments</B> (causes comments
	to be displayed even if they are replies to comments
	under current threshold)</FONT>
	<INPUT TYPE="CHECKBOX" NAME="reparent"$r_check>

	<P><FONT FACE=VERDANA SIZE=2><B>Do Not Display Scores</B> (Hides score:
	They still <B>apply</B> you just don't see them.)</FONT>
	<INPUT TYPE="CHECKBOX" NAME="noscores"$n_check>

	<P><FONT FACE=VERDANA SIZE=2><B>Limit</B> only display this many comments.
	For best results, set this to a low number and sort by score.</FONT><BR>
	<INPUT TYPE="TEXT" NAME="commentlimit" SIZE="6" VALUE="$commentlimit">

	<P><FONT FACE=VERDANA SIZE=2><B>Index Spill</B> (When an article has this many comments,
	it switches to indexed mode)</FONT><BR>
	<INPUT TYPE="TEXT" NAME="commentspill" VALUE="$commentspill" SIZE="3">

	<P><FONT FACE=VERDANA SIZE=2><B>Small Comment Penalty</B> (Assign -1 to comments smaller
	than this many characters.  This might cause some comments
	to be rated -2 and hence rendered invisible!)</FONT><BR>
	<INPUT TYPE="TEXT" NAME="clsmall" VALUE="$clsmall" SIZE="6">

	<P><FONT FACE=VERDANA SIZE=2><B>Long Comment Bonus </B> (Assign +1 to lengthy comments)</FONT><BR>
	<INPUT TYPE="TEXT" NAME="clbig" VALUE="$clbig" SIZE="6">

	<P><FONT FACE=VERDANA SIZE=2><B>Max Comment Size</B> (Truncates long comments, and 
	adds a \"Read More\" link.  Set really big to disable)</FONT><BR>
	<INPUT TYPE="TEXT" NAME="maxcommentsize" SIZE="6" VALUE="$maxcommentsize">

	<P><B>Disable Sigs</B> (strip sig quotes from comments)
	<INPUT TYPE="CHECKBOX" NAME="nosigs"$s_check>

	<P><B>Comment Post Mode</B>
EOT

	selectGeneric("postmodes", "posttype", "code", "name", $posttype);

	print <<EOT;

	</TD></TR></TABLE><P>

	<INPUT TYPE="SUBMIT" NAME="op" VALUE="savecomm">
</FORM>
EOT

	# print qq! <INPUT TYPE="SUBMIT" NAME="op" VALUE="susaveuser"> <INPUT TYPE="SUBMIT" NAME="op" VALUE="sudeluser">! if $I{U}{aseclev}> 499;
}

#################################################################
sub saveUser {
	my $uid = $I{U}{aseclev} ? shift : $I{U}{uid};
	my $name = $I{U}{aseclev} && $I{F}{name} ? $I{F}{name} : $I{U}{nickname};

	$name = substr($name, 0, 20);
	return unless $uid > 0;

	print "<P>Saving $name<BR><P>";
	print <<EOT if $uid < 1 || !$name;
<P><FONT FACE=VERDANA SIZE=2>Your browser didn't save a cookie properly.  This could mean you are behind a filter that
eliminates them, you are using a browser that doesn't support them, or you rejected it.</FONT></P>
EOT

	# stripByMode _after_ fitting sig into schema, 120 chars
	$I{F}{sig}	 = stripByMode(substr($I{F}{sig}, 0, 120), 'html');
	$I{F}{fakeemail} = chopEntity(stripByMode($I{F}{fakeemail}, 'attribute'), 50);
	$I{F}{homepage}	 = "" if $I{F}{homepage} eq "http://";
	$I{F}{homepage}	 = fixurl($I{F}{homepage});

	# for the users table
	my $H = {
		sig		=> $I{F}{sig},
		homepage	=> $I{F}{homepage},
		fakeemail	=> $I{F}{fakeemail}
	};

	# for the users_info table
	my $H2 = {
		maillist	=> $I{F}{maillist},
		realname	=> $I{F}{realname},
		bio		=> $I{F}{bio}
	};

	my($oldEmail) = sqlSelect("realemail", "users",
		"nickname=" . $I{dbh}->quote($name));

	if ($oldEmail ne $I{F}{realemail}) {
		$H->{realemail} = chopEntity(stripByMode($I{F}{realemail}, 'attribute'), 50);
		print "\nNotifying $oldEmail of the change to their account.<BR>\n";

		sendEmail($oldEmail, "$I{sitename} user email change for $name", <<EOT);
The user account $name on $I{sitename} had this email
associated with it.  A web user from $ENV{REMOTE_ADDR} has
just changed it to $I{F}{realemail}.

If this message is in error, there has likely been a misunderstanding. Do not be alarmed.
It probably means you have a common nickname and someone else wanted it.  They do not have 
your password.  Only this email address has received this email.
EOT
	}

	if ($I{F}{pass1} eq $I{F}{pass2} && length($I{F}{pass1}) > 5) {
		$H->{passwd} = $I{F}{pass1};
		print qq!Password Changed  (You'll need to <A HREF="$ENV{SCRIPT_NAME}">log back in</A> now.)<BR>!;

	} elsif ($I{F}{pass1} ne $I{F}{pass2}) {
		print "<P>Passwords don't match. Password not changed.</P>";

	} elsif (length $I{F}{pass1} < 6 && $I{F}{pass1}) {
		print "<P>Password is too short and was not changed.</P>";
	}

	# update the public key
	sqlReplace("users_key", { uid => $uid, pubkey => $I{F}{pubkey} } );

	# Update users with the $H thing we've been playing with for this whole damn sub
	sqlUpdate("users", $H, "uid=" . $uid . " AND uid>0", 1);

	# Update users with the $H thing we've been playing with for this whole damn sub
	sqlUpdate("users_info", $H2, "uid=" . $uid . " AND uid>0", 1);
}

#################################################################
sub saveComm {
	my $uid  = $I{U}{aseclev} ? shift : $I{U}{uid};
	my $name = $I{U}{aseclev} && $I{F}{name} ? $I{F}{name} : $I{U}{nickname};

	$name = substr($name, 0, 20);
	return unless $uid > 0;

	print "<P>Saving $name<BR><P>";
	print <<EOT if $uid < 1 || !$name;
<P><FONT FACE=VERDANA SIZE=2>Your browser didn't save a cookie properly. This could mean you are behind a filter that
eliminates them, you are using a browser that doesn't support them, or you rejected it.</FONT></P>
EOT

	# Take care of the lists
	# Enforce Ranges for variables that need it
	$I{F}{commentlimit} = 0 if $I{F}{commentlimit} < 1;
	$I{F}{commentspill} = 0 if $I{F}{commentspill} < 1;

	# for users_comments
	my $H = {
		clbig		=> $I{F}{clbig},
		clsmall		=> $I{F}{clsmall},
		mode		=> $I{F}{umode},
		posttype	=> $I{F}{posttype},
		commentsort	=> $I{F}{commentsort},
		threshold	=> $I{F}{uthreshold},
		commentlimit	=> $I{F}{commentlimit},
		commentspill	=> $I{F}{commentspill},
		maxcommentsize	=> $I{F}{maxcommentsize},
		highlightthresh	=> $I{F}{highlightthresh},
		nosigs		=> ($I{F}{nosigs}     ? "1" : "0"),
		reparent	=> ($I{F}{reparent}   ? "1" : "0"),
		noscores	=> ($I{F}{noscores}   ? "1" : "0"),
		hardthresh	=> ($I{F}{hardthresh} ? "1" : "0"),
	};

	# Update users with the $H thing we've been playing with for this whole damn sub
	sqlUpdate("users_comments", $H, "uid=" . $uid . " AND uid>0", 1);
}

#################################################################
sub saveHome {
	my $uid  = $I{U}{aseclev} ? shift : $I{U}{uid};
	my $name = $I{U}{aseclev} && $I{F}{name} ? $I{F}{name} : $I{U}{nickname};

	$name = substr($name, 0, 20);
	return unless $uid > 0;

	print "<P>Saving $name<BR><P>";
	print <<EOT if $uid < 1 || !$name;
<P><FONT FACE=VERDANA SIZE=2>Your browser didn't save a cookie properly. This could mean you are behind a filter that
eliminates them, you are using a browser that doesn't support them, or you rejected it.</FONT></P>
EOT

	my($extid, $exaid, $exsect) = "";
	my($exboxes) = sqlSelect("exboxes", "users_index", "uid=$uid");

	$exboxes =~ s/'//g;
	my @b = split m/,/, $exboxes;

	foreach (@b) {
		$_ = "" unless $I{F}{"exboxes_$_"};
	}

	$exboxes = sprintf "'%s',", join "','", @b;
	$exboxes =~ s/'',//g;

	foreach my $k (keys %{$I{F}}) {
		if ($k =~ /^extid_(.*)/)	{ $extid  .= "'$1'," }
		if ($k =~ /^exaid_(.*)/)	{ $exaid  .= "'$1'," }
		if ($k =~ /^exsect_(.*)/)	{ $exsect .="'$1',"  }
		if ($k =~ /^exboxes_(.*)/) { 
			# Only Append a box if it doesn't exist
			my $box = $1;
			$exboxes .= "'$box'," unless $exboxes =~ /'$box'/;
		}
	}

	$I{F}{maxstories} = 66 if $I{F}{maxstories} > 66;
	$I{F}{maxstories} = 1 if $I{F}{maxstories} < 1;

	# Take care of the preferences table

	# for users_index
	my $H = {
		extid		=> checkList($extid),
		exaid		=> checkList($exaid),
		exsect		=> checkList($exsect),
		exboxes		=> checkList($exboxes),
		maxstories	=> $I{F}{maxstories},
		noboxes		=> ($I{F}{noboxes} ? "1" : "0"),
	};

	# for users_prefs
	my $H2 = {
		light		=> ($I{F}{light} ? "1" : "0"),
		noicons		=> ($I{F}{noicons} ? "1" : "0"),
		willing		=> ($I{F}{willing} ? "1" : "0"),
	}; 

	
	if (defined $I{F}{tzcode} && defined $I{F}{tzformat}) {
		$H2->{tzcode} = $I{F}{tzcode};
		$H2->{dfid} = $I{F}{tzformat};
	}

	$H2->{mylinks} = $I{F}{mylinks} if $I{F}{mylinks};

	# If a user is unwilling to moderate, we should cancel all points, lest
	# they be preserved when they shouldn't be.
	sqlUpdate("users_comments", { points => 0 }, "uid=$uid AND uid>0", 1)
		unless $I{F}{willing};

	# Update users with the $H thing we've been playing with for this whole damn sub
	sqlUpdate("users_index", $H, "uid=" . $uid . " AND uid>0", 1);

	# Update users with the $H thing we've been playing with for this whole damn sub
	sqlUpdate("users_prefs", $H2, "uid=" . $uid . " AND uid>0", 1);
}

#################################################################
sub displayForm {
	print <<EOT;
<TABLE WIDTH="100%" CELLPADDING="10"><TR><TD WIDTH="50%" VALIGN="TOP">

<P><FORM ACTION="$ENV{SCRIPT_NAME}" METHOD="POST">

EOT

	titlebar("100%", $I{F}{unickname} ? "Error Logging In" : "Login");

	print $I{F}{unickname} ? <<EOT1 : $I{allow_anonymous} ? <<EOT2 : <<EOT3;
	<P><FONT FACE=VERDANA SIZE=2>Error. Login Failed!  Please try again,
	or click that mail password button if you forgot your password.</FONT></P>
EOT1
	<P><FONT FACE=VERDANA SIZE=2>Logging in will allow you to post comments as yourself.  If you
	don't login, you will only be able to post as $I{anon_name}.</FONT></P>
EOT2
	<P><FONT FACE=VERDANA SIZE=2>Logging in will allow you to post comments.  If you
	don't login, you will not be able to post.</P></FONT>
EOT3

	$I{F}{unickname} ||= $I{F}{newuser};

	print <<EOT;

	<P><B>Nick:</B> (maximum 20 characters long)<BR>
	<INPUT TYPE="TEXT" NAME="unickname" SIZE="20" VALUE="$I{F}{unickname}"></P>

	<P><B>Password:</B> (6-12 characters long)<BR>
	<INPUT TYPE="PASSWORD" NAME="upasswd" SIZE="12" MAXLENGTH="12"></P>

	<INPUT TYPE="SUBMIT" NAME="op" VALUE="userlogin">
	
	
	<P><B>Forgotten Your Password?</B><BR>
	Type your nickname in the box above and click the button below.
	We'll email you your password in the next two minutes.</P>
	<INPUT TYPE="SUBMIT" NAME="op" VALUE="mailpasswd">

	</TD><TD WIDTH="50%" VALIGN="TOP">
EOT

	titlebar("100%", $I{F}{newuser} ? "Duplicate Account!" : "I'm a New User!");
	print $I{F}{newuser} ? <<EOT1 : <<EOT2;
	<FONT FACE=VERDANA SIZE=2>Apparently you tried to register with a <B>duplicate nickname</B>,
	a <B>duplicate email address</B>, or an <B>invalid email</B>.  You
	can try another below, or use the form on the left to either login,
	or retrieve your forgotten password.</FONT>
EOT1
	<P><FONT FACE=VERDANA SIZE=2>1. Enter your preferred <B>nickname</B>:</FONT><br>
EOT2

	print <<EOT;
	<INPUT TYPE="TEXT" NAME="newuser" SIZE="20" MAXLENGTH="20" VALUE="$I{F}{newuser}"><BR>
	</P>
	<P><FONT FACE=VERDANA SIZE=2>2. Now enter a <B>valid email address</B> address to send your registration
	information.</FONT><BR>
	<INPUT TYPE="TEXT" NAME="email" SIZE="20" VALUE="$I{F}{email}"><BR>
	<FONT FACE=VERDANA SIZE=1>This address will <B>not</B> be displayed on $I{sitename}.</FONT></P>
	<P><FONT FACE=VERDANA SIZE=2>3. Click the button to be mailed a password.</FONT><BR><BR>
	<FONT FACE=VERDANA SIZE=1>I declare that I am at least 18 years of age.<BR></P>
	<P ALIGN=CENTER><INPUT TYPE="SUBMIT" NAME="op" VALUE="newuser"></FONT></P>

	</FORM>

</TD></TR></TABLE>

EOT
}

main();
$I{dbh}->disconnect if $I{dbh};
1;