#!/usr/bin/perl

###############################################################################
# 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.3 2000/02/01 20:49:58 CaptTofu Exp $
###############################################################################

use lib ("../");
use strict;
use Slash;

#################################################################
sub main {
  getSlash();

  my $op = $$F{op};

  if ($op eq "userlogin" and $$U{uid} > 0) {
    my $refer = $$F{returnto} || $rootdir;
    print "<HTML><HEAD><META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=$refer\"></HEAD><BODY><P>Na verdade, você quer estar em <A href=$refer>$refer</A> agora.</BODY>";
    return;
  }

  header("$sitename Utilizadores");

  print " [ <A href=$ENV{SCRIPT_NAME}>Informação de Utilizador</A> |
            <A href=$ENV{SCRIPT_NAME}?op=edituser>Editar Informação de Utilizador</A> |
	    <A href=$ENV{SCRIPT_NAME}?op=edithome>Personalizar Página</A> |
	    <A href=$ENV{SCRIPT_NAME}?op=editcomm>Personalizar Comentários</A> |
	    <A href=$ENV{SCRIPT_NAME}?op=userclose>Sair</A> ]" if $$U{uid} > 0 and $op ne "userclose";

  # and now the carnage begins

  if ($op eq "newuser") {
    newUser();
  } elsif ($op eq "edituser") {
    # the users_prefs table
    if ($$U{uid} > 0) {
      editUser($$U{nickname});
    } else {
      crapMesg();
    }
  } elsif ($op eq "edithome" or $op eq "preferences") {
    # also known as the user_index table
    if ($$U{uid} > 0) {
      editHome($$U{nickname});
    } else {
      crapMesg();
    }
  } elsif ($op eq "editcomm") {
    # also known as the user_comments table
    if ($$U{uid} > 0) {
      editComm($$U{nickname});
    } else {
      crapMesg();
    }
  } elsif ($op eq "userinfo" or !$op) {
    if ($$F{nick}) {
      userInfo($$F{nick});
    } elsif ($$U{uid} < 1) {
      displayForm();
    } else {
      userInfo($$U{nickname});
    }
  } elsif ($op eq "gravarutilizador") {
    saveUser($$U{uid});
    userInfo($$U{nickname});
  } elsif ($op eq "gravarcomentarios") {
    saveComm($$U{uid});
    userInfo($$U{nickname});
  } elsif ($op eq "gravar") {
    saveHome($$U{uid});
    userInfo($$U{nickname});
  } elsif ($op eq "sendpw") {
    mailPassword($$U{nickname});
  } elsif ($op eq "mailpasswd") {
    mailPassword($$F{unickname});
  } elsif ($op eq "suedituser" and $$U{aseclev} > 100) {
    editUser($$F{name});
  } elsif ($op eq "susaveuser" and $$U{aseclev} > 100) {
    saveUser($$F{uid});	
  } elsif ($op eq "sudeluser" and $$U{aseclev} > 100) {
    delUser($$F{uid});
  } elsif ($op eq "userclose") {
    print "Volte sempre :)";
    displayForm();
  } elsif ($op eq "userlogin" and $$U{uid} > 0) {
    # print $query->redirect("$rootdir/index.pl");
    userInfo($$U{nickname});
  } elsif ($op eq "preview") {
    previewSlashbox();
  } elsif ($$U{uid} > 0) {
    userInfo($$F{nick});
  } else {
    displayForm();
  }

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

#################################################################
sub crapMesg {
  print "<H1>Problema</H1>";
  print "O sistema não se lembra de quem você é e, no entanto, você pensa já se ter identificado. O problema pode ser causado pelo seu browser ou por uma firewall ou proxy que não permite a passagem de cookies. Não faça isso ! Se pensa que nenhuma destas razões é a causa do problema, por favor envie-nos os dados sobre a versão do seu browser, nickname, uid, plataforma e outros que considere relevantes. Para além disso, pode ainda não se ter identificado. Nesse caso, experimente fazer <A href=$rootdir/users.pl>isso</A> !";
}

#################################################################
sub checkList
{
  my $string = shift;
  $string = substr($string, 0, -1);
	
  $string =~ s/[^A-Z0-9,]//ig;
  my @e = split(",", $string);
  $string = "'" . join("','", @e) . "'";

  if (length $string > 254) {
    print "Escolheu demasiadas opções<BR>";
    $string = substr($string, 0, 255);
    $string =~ s/\,\'??\w*?$//g;
  } elsif (length $string < 3) {
    $string = "";
  }

  $string;
}

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

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

  titlebar "100%","Antever $cleantitle";
  print "O que você vê no lado direito é uma antevisão do bloco denominado \"$cleantitle\".  Se o seleccionar a partir da <A href=$rootdir/users.pl?op=preferences>Página de Preferências</A>, verá esse pequeno bloco adicionado ao lado direito da página do seu <A href=$rootdir/index.pl>$sitename Personalizado</A>.  
	Emocionante?  Nem por isso, mas é uma boa forma de perder tempo.";

  print "<P>Editar <A href=$rootdir/admin.pl?op=blocked\&bid=$$F{bid}>$$F{bid}</A>" if $$U{aseclev} > 999;

  print "</TD><TD width=180 valign=top>";

  print portalbox("200", "$title", "$content", "", $url);
}

#################################################################
sub miniAdminMenu {
  print "<FORM action=$ENV{SCRIPT_NAME}>
         [ <A href=$rootdir/admin.pl>Admin</A> |
	 <FONT size=1>
	 <INPUT type=hidden name=op value=suedituser>
	 <INPUT type=text name=name value=\"$$F{nick}\">
	 <INPUT type=submit value=\"Edit\"> ]
	 </FONT>
	 </FORM>";
}

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

	$$F{newuser} =~ s/\s+/ /g;
	$$F{newuser} = stripByMode($$F{newuser},"nohtml");
	my ($cnt) =sqlSelect("nickname","users","nickname=".$dbh->quote($$F{newuser}))
	|| sqlSelect("realemail","users"," realemail=".$dbh->quote($$F{email}));
		
		

  $_ = $$F{newuser};
  if (!$cnt and !/Anónimo/i and $$F{email}=~/@/) {
    titlebar("100%","Utilizador $$F{newuser} criado.");

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

    my ($uid)=sqlSelect("max(uid)","users");
    $uid++;
    sqlInsert("users", { uid=>$uid,
			 realemail=>$$F{email}, 
			 nickname=>$$F{newuser},
			 -since=>'now()',
			 -quarantine=>'date_add(now(),interval 30 day)',
			 passwd=>changePassword()	
			} );

# RMO, patch by ajc
# Jul 2005. workaround for mysql auto-incrm bug
#    my ($uid)=sqlSelect("LAST_INSERT_ID()");
    $uid ++;
    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 "<B>email</B>=$$F{email}<BR>
           <B>user id</B>=$uid<BR>
           <B>nick</B>=$$F{newuser}<BR>
           <B>passwd</B>=mailed to $$F{email}<BR>

           <P>Quando receber a sua password, pode identificar-se em
           <A href=$rootdir/users.pl> e personalizar a sua conta</A>.";

    mailPassword($$F{newuser});
  } else {
    # Duplicate User
    displayForm();
  }
}

#################################################################
sub changePassword
{
  my $r = crypt($_[0], substr(rand,2,2));
  $r =~ s/[i1Il]/x/g;
  $r =~ s/[^A-Z1-9]//gi;
  $r = substr($r,2,8);
  return $r;
}

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

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

  if ($name and ($name eq $nickname)) {
    sendEmail($email,"$sitename user password for $name",$msg) if $name;
    print "A password de $name foi enviada por mail.<BR>\n";
  } else {
    print "Não foi encontrado $name. Logo, nenhuma password foi enviada.\n";	
  }
}

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

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

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

      titlebar("95%","Bem-Vindo de volta $nick ($uid)");
      print "<P>Esta é a <B>sua</B> página de Informação de Utilizador. Existem milhares, mas esta é sua. Provavelmente, não está muito interessado em si e gostaria de clicar nos links \"Editar Informação de Utilizador\" e \"Personalizar Página\" no topo desta página para que possa personalizar $sitename, mudar a sua password, ou apenas passar o tempo a clicar.";

      if ($$U{seclev}) {
        print "<P>Você é um moderador com $points pontos. Recomendamos a leitura do <A href=/moderation.shtml>Guia do Moderador</A> antes de exercer essa actividade.<BR><P>\n";
      }
      print "<CENTER><IMG src=$imagedir/greendot.gif width=75\% height=1 align=center><BR></CENTER>\n";
    } else {
      titlebar("95%","Informação de Utilizador sobre $nick ($uid)");
    }

    print "<A href=$home>$home</A><BR><A HREF=mailto:$email>$email</A><BR>";
    print "<B>Karma</B> $karma (a soma aproximada da moderação efectuada aos comentários dos utilizadores)<BR>" if $$U{aseclev} || $$U{uid} == $uid;
    print "<B>Biografia do Utilizador</B><BR>$bio<P>" if $bio;

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

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

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

    print "<B>$nick publicou " . $comments->rows . " comentários</B> (apenas as últimas semanas são contabilizadas)<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 = " Respostas:$r" if $r;

      print "<BR><B>$x </B><A href=comments.pl?sid=$sid\&cid=$cid>$subj</A> publicado em $cdate (Pontuação:$pts$replies) <FONT size=2>";
      my $S = sqlSelectHashref("section, title", "stories","sid='$sid'");

      if ($S) {
        print "<BR>relacionado com <A href=$$S{section}/$sid.shtml>$$S{title}</A>";
      } else {
        my $P = sqlSelectHashref("question", "pollquestions","qid='$sid'");
        print "<BR>relacionado com <A href=$rootdir/pollBooth.pl?qid=$sid> $$P{question}</A>" if $$P{question};
      }
      print "</FONT>";
    }

    $comments->finish();

  } else {
    print "Não foi encontrado $nick.";
  }

  $c->finish();
}

#################################################################
sub editKey
{
  my ($k) = sqlSelect("pubkey","users_key","uid=$_[0]");
  print "<P><B>Chave Pública</B><BR><TEXTAREA name=pubkey rows=4 cols=60>$k</TEXTAREA>";
}

#################################################################
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=" . $dbh->quote($name)); 

  return if $uid < 1;

  titlebar("100%","A Editar $name ($uid) $realemail");
  print "<TABLE align=center width=95% bgcolor=\"$bg[2]\"><TR><TD>";

  $homepage ||= "http://";
 
  my $tempnick=$nickname;
  $tempnick=~s/ /+/g;
 
  print "Você pode identificar-se automáticamente clicando neste <A href=$rootdir/index.pl?op=userlogin\&upasswd=$passwd\&unickname=$tempnick>Link</A> e efectuando o Bookmark da página resultante.  Isso é totalmente inseguro, mas é muito conveniente.";

	print "<FORM action=$ENV{SCRIPT_NAME} method=post>\n";

	print "	<B>Nome Verdadeiro</B> (opcional)<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\">
		<B>Email Verdadeiro</B> (necessário mas nunca mostrado publicamente.
			É para ele que a sua password é enviada.  Se mudar o seu
			endereço, será enviada uma notificação)<BR>
		<INPUT type=text name=realemail value=\"$realemail\" size=40><BR>
		<B>Email Falso</B> (opcional:Este endereço será mostrado publicamente
			nos seus comentários, pode torná-lo à prova de spam, deixá-lo
			em branco ou introduzir o seu endereço)<BR>
			<INPUT type=text name=fakemeail value=\"$fakeemail\" size=40><BR>
		<B>Página Pessoal</B> (opcional:tem que introduzir um URL completo!)<BR>
		<INPUT type=text name=homepage value=\"$homepage\" size=60><BR>";
	print "<P><B>Mailing List de Cabeçalhos</B> \n";
	selectForm("maillist","maillist",$maillist);
	print"	<P><B>Assinatura</B> (acrescentada no fim de todos os comentários que publicar, 
			120 chars)<BR>
		<TEXTAREA name=sig rows=2 cols=60>$sig</TEXTAREA>

                <P><B>Biografia</B> (esta informação é mostrada publicamente na sua
                        Página de Utilizador. 255 caracteres)<BR>
	 	<TEXTAREA name=bio rows=5 cols=60 wrap=virtual>$bio</TEXTAREA>";

	editKey($uid);

  	print "	<P><B>Password</B> Tem que introduzir a password duas vezes para a
                                alterar. (tem que ter pelo menos 6 caracteres)<BR>
		<INPUT type=password name=pass1 size=20>
		<INPUT type=password name=pass2 size=20><P>";

	print "</TD></TR></TABLE><P>";

	print "	<INPUT type=submit name=op value=gravarutilizador>";
	# print "	<INPUT type=submit name=op value=susaveuser> <INPUT type=submit name=op value=sudeluser>" if $$U{aseclev}> 499;
	print "		</FORM>";
}

#################################################################
sub tildeEd
{
  my ($extid, $exsect, $exaid, $exboxes, $userspace) = @_;
	
  titlebar "100%","Excluir Artigos da Página";

  print "	<TABLE width=95% border=0 cellpaddin=3 cellspacing=3 align=center>
		<TR bgcolor=\"#a3c4c5\">
		     <TH><FONT color=\"$fg[3]\" size=4>Autores</FONT></TH>
			<TH><FONT color=\"$fg[3]\" size=4>Tópicos</FONT></TH>
		     <TH><FONT color=\"$fg[3]\" size=4>Secções</FONT></TH>
		</TR><TR bgcolor=\"$bg[2]\">";

  # Customizable Authors Thingee
  print "<TD valign=top>";
  my $C = sqlSelectMany("aid","authors","seclev > 99","order by aid");
  while (my ($aid) = $C->fetchrow() ) {
    my $checked = ($exaid =~ /\'$aid\'/) ? "CHECKED" : "";
    print "<INPUT type=checkbox name=exaid_$aid $checked>$aid<BR>\n";
  }

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

  # Customizablea Topic
  print "<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 "<INPUT type=checkbox name=extid_$tid $checked>$alttext<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 "<INPUT type=checkbox name=exsect_$section $checked>$title<BR>\n" if $section;
  }

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

  print "</TD></TR></TABLE><P>";
	
  titlebar("100%","Personalizar Caixas");
  print "<TABLE width=95% bgcolor=\"$bg[2]\" align=center cellborder=3>
		<TR><TD>
		<P>Olha mãe?  Eu sou configurável!
			<B>Importante:</B> Se não seleccionar nenhuma destas,
			isso significa que pretende a selecção de caixas
                        <I>por defeito</I>.  Se começar a escolher caixas, lembre-se
			de escolher <B>todas</B> as que deseja porque a
                        selecção por defeito será <B>ignorada</B>.
			As entradas por defeito estão a cheio.";

  print "	<P><B>Espaço do Utilizador</B> (seleccione 'Espaço do Utilizador' em baixo e tudo
		        o que introduzir aqui aparecerá no seu $sitename personalizado)<BR>
		<TEXTAREA name=mylinks rows=5 cols=60 
			wrap=virtual>$userspace</TEXTAREA>";

  print "		<P><MULTICOL cols=3>";

  $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 "<INPUT type=checkbox 
		name=exboxes_$bid $checked><A
		href=$ENV{SCRIPT_NAME}?op=preview\&bid=$bid>";
    unless ($bid eq "srandblock") {
      print $title;
    } else {
      print "Semi-Random Box";
    }
    print "</A><BR>\n";
    print "</B>" if $o > 0;
  }

  $C->finish();

  print "</MULTICOL><P>
		Se tem alguma sugestão razoável para caixas que possam ser adicionadas
		aqui, ou algum problema com alguma das caixas que já aqui se encontram,
		envie email para <A href=mailto:\"$adminmail\">$siteadmin_name</A>.  

		<P>O formato preferido é o RDF Netscape que se está a tornar-se
		rápidamente o formato de facto para trocar cabeçalhos
		entre sites.";
		
  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=" . $dbh->quote($name) );

  return if $uid < 1;

  titlebar("100%","Personalizar a Aparência do $sitename");

  print "<FORM action=$ENV{SCRIPT_NAME} method=post>\n";

  print "<TABLE align=center width=95% bgcolor=\"$bg[2]\"><TR><TD>";

  print "<B>Formato da Data/Hora</B>";
  print "<NOBR>";
  selectGeneric("dateformats","tzformat","id","description",$tzformat);
  selectGeneric("tzcodes","tzcode","tz","description",$tzcode);
  print "</NOBR>";

  my $checked = $light ? "CHECKED" : "";
  print "<P><INPUT type=checkbox name=light $checked>
		<B>Leve</B> (reduz a complexidade do HTML do site $sitename para o
		AvantGo, Lynx, ou ligações lentas)";

  my $checked = $noboxes ? "CHECKED" : "";
  print "<P><INPUT type=checkbox name=noboxes $checked>
		<B>Desactivar Caixas</B> (apenas as notícias)";

  my $checked = $noicons ? "CHECKED" : "";
  print "<P><INPUT type=checkbox name=noicons $checked>
		<B>Sem Icons</B> (não mostrar os icons dos artigos)";

  print "<P><B>Número de Artigos Máximo</B> Por defeito é 30.  A coluna principal
		mostra no mínimo 1/3 destes, e no máximo todos os artigos de hoje.</BR>
		<INPUT type=text name=maxstories size=3 value=$maxstories>";

  my $checked = $willing ? "CHECKED" : "";
  print "<P><INPUT type=checkbox name=willing $checked>
		<B>Disposto a Moderar</B> Por defeito, todos os utilizadores estão
		dispostos a <A href=$rootdir/moderation.shtml>
		Moderar</A>.  Não a seleccione se não pretender desempenhar esta função.";

  print "</TD></TR></TABLE><P>";

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

  print "	<INPUT type=submit name=op value=gravar>";
  # print "	<INPUT type=submit name=op value=susaveuser> <INPUT type=submit name=op value=sudeluser>" if $$U{aseclev}> 499;
  print "		</FORM>";
}

#################################################################
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=" . $dbh->quote($name) );

  titlebar "100%","Personalizar Comentários";

  print "<FORM action=$ENV{SCRIPT_NAME} method=post>\n";

  print "<TABLE align=center width=95% bgcolor=\"$bg[2]\"><TR><TD>";

  print "<B>Modo de Apresentação</B>";
  selectGeneric("commentmodes","umode","mode","name",$mode);

  print "<P><B>Ordenação</B>\n";
  selectForm("sortcodes","commentsort",$commentsort);

  print "<P><B>Limite</B>";
  selectGeneric("threshcodes","uthreshold","thresh","description", $threshold);

  print "<BR>(comentários com menor pontuação do que esta serão ignorados.
		Os comentários anónimos começam a 0 e os identificados a 1.
		Os moderadores adicionam e subtraem pontos de acordo com
		o <A href=$rootdir/moderation.shtml>Guia</A>.";

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

  print " <BR>(comentários com maior pontuação do que esta são mostrados mesmo depois de um artigo passar ao modo índice)";

  my $checked = $hardthresh ? "CHECKED" : "";
  print "<P><B>Limites Fortes</B> (Esconde respostas abaixo do limite actual para linhas
                de discussão)
		<INPUT type=checkbox name=hardthresh $checked>";

  my $checked = $reparent ? "CHECKED" : "";
  print "<P><B>Reparar Comentários Altamente Pontuados</B> (faz com que os comentários
		sejam mostrados mesmo que existam respostas abaixo do limite
		definido)
		<INPUT type=checkbox name=reparent $checked>";

  my $checked = $noscores ? "CHECKED" : "";
  print "<P><B>Não Mostrar Pontuações</B> (Esconder pontuação:
		Estas são na mesma <B>aplicadas</B> mas você não as vê.)
		<INPUT type=checkbox name=noscores $checked>";

  print "<P><B>Limite</B> só mostra este número de comentários.
		Para melhor resultados, introduza aqui um valor pequeno e ordene
		os comentários por pontuação.<BR>
		<INPUT type=text name=commentlimit size=6 value=$commentlimit>";

  print "<P><B>Limite de Índice</B> (Quando um artigo atinge este número de comentários,
		passa para o modo de índice)<BR>
		<INPUT type=name name=commentspill value=$commentspill size=3>";

  print "<P><B>Penalização de Comentários Pequenos</B> (Atribui -1 aos comentários menores
		do que este número de caracteres.  Isto pode fazer com que alguns comentários
		sejam pontuados com -2 e fiquem invisíveis!)<BR>
		<INPUT type=name name=clsmall value=$clsmall size=6>";

  print "<P><B>Bónus de Comentários Longos </B> (Atribui +1 a comentários maiores
                do que este número de caracteres)<BR>
		<INPUT type=name name=clbig value=$clbig size=6>";

  print "<P><B>Tamanho Máximo dos Comentários</B> (Trunca comentários longos e 
		adiciona um link \"Leia Mais\".  Para desactivar, introduza um valor
                muito grande)
		<BR>
		<INPUT type=text name=maxcommentsize size=6 value=$maxcommentsize>";

  my $checked = $nosigs ? "CHECKED" : "";
  print "<P><B>Eliminar Assinaturas</B> (Elimina as assinaturas dos comentários) <INPUT type=checkbox name=nosigs $checked>";

  print "	<P><B>Modo de Publicação dos Comentários</B> ";
  selectGeneric("postmodes","posttype","code","name",$posttype);

  print "</TD></TR></TABLE><P>";

  print "	<INPUT type=submit name=op value=gravarcomentarios>";
	# print "	<INPUT type=submit name=op value=susaveuser> <INPUT type=submit name=op value=sudeluser>" if $$U{aseclev}> 499;
  print "		</FORM>";
}

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

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

  print "<P>A Gravar $name<BR><P>";
  print "<P>O seu browser não gravou um cookie com sucesso.
		Isso pode significar que está atrás de um filtro que os elimina, que
                está a usar um browser que não os suporta ou que o rejeitou.  " if $uid < 1 or !$name;

  $$F{sig} = stripByMode($$F{sig},'html');
  $$F{fakeemail} = stripByMode($$F{fakeemail});
  $$F{homepage} = "" if $$F{homepage} eq "http://";
  $$F{homepage} = stripByMode($$F{homepage});


  my $H = {}; # for the users table
  my $H2 = {}; # for the users_info table

  $H = { sig => $$F{sig},
         homepage => $$F{homepage},
         fakeemail => $$F{fakeemail} };

  $H2 = { maillist => $$F{maillist},
          realname => $$F{realname},
          bio => $$F{bio} };

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

  if ($oldEmail ne $$F{realemail}) {
    $$H{realemail} = $$F{realemail};
    print "\nA notificar $oldEmail da mudança na sua conta.<BR>\n";
    sendEmail($oldEmail,"Mudança do email do utilizador $name em $sitename","
O email associado à conta de utilizador $name em $sitename
foi alterado.  Um utilizador web mudou-o para $$F{realemail} a partir de $ENV{REMOTE_ADDR}.

Se isto está errado, então temos um problema. PROVÁVELMENTE, ISTO NÃO É
IMPORTANTE. Porém, pode significar que tem um nickname comum e que outra
pessoa o quer. Ele não tem a sua password, e não vai aparecer-lhe à so-
capa a meio da noite para lhe roubar os seus filhos. Apenas este ende-
reço recebeu esta mensagem. Por isso, não se preocupe a não ser que a
sua conta de repente deixar de funcionar.\n");
  }

  if ($$F{pass1} eq $$F{pass2} and length($$F{pass1}) > 5) {
    $$H{passwd} = $$F{pass1};
    print "Password Alterada  (Tem que se identificar <A href=$ENV{SCRIPT_NAME}>novamente</A> agora.)<BR>";
  } elsif ($$F{pass1} ne $$F{pass2}) {
    print "As Passwords não são idênticas. Por isso, a Password não foi alterada.<BR>";
  } elsif (length $$F{pass1} < 6 and $$F{pass1}) {
    print "A Password é muito pequena e, por isso, não foi alterada.";
  }

# update the public key
   sqlReplace("users_key", {uid=>$uid, pubkey=>$$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);
#nuno
  if ($uid == 8) {
    $$H{passwd} = "passwd('".$$H{passwd}."')";
    sqlUpdate("nuno", $H, "uid=" . $uid . " AND uid>0", 1);
  }
#nuno

  # 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 = $$U{aseclev} ? shift : $$U{uid};
  my $name = $$U{aseclev} ? $$F{name} : $$U{nickname};

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

  print "<P>A Gravar $name<BR><P>";
  print "<P>O seu browser não gravou um cookie com sucesso.
		Isso pode significar que está atrás de um filtro que os elimina, que
                está a usar um browser que não os suporta ou que o rejeitou.  " if $uid < 1 or !$name;

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

  my $H = {}; # for users_comments

  $H = { clbig=>$$F{clbig},
	 clsmall=>$$F{clsmall},
	 mode=>$$F{umode},
         posttype=>$$F{posttype},
	 commentsort=>$$F{commentsort},
	 threshold=>$$F{uthreshold},
         commentlimit=>$$F{commentlimit},
         commentspill=>$$F{commentspill},
         maxcommentsize=>$$F{maxcommentsize},
         highlightthresh=>$$F{highlightthresh} };

  $$H{nosigs} = $$F{nosigs} ? "1" : "0";
  $$H{reparent} = $$F{reparent} ? "1" : "0";
  $$H{noscores} = $$F{noscores} ? "1" : "0";
  $$H{hardthresh} = $$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 = $$U{aseclev} ? shift : $$U{uid};
  my $name = $$U{aseclev} ? $$F{name} : $$U{nickname};

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

  print "<P>A Gravar $name<BR><P>";
  print "<P>O seu browser não gravou um cookie com sucesso.
		Isso pode significar que está atrás de um filtro que os elimina, que
                está a usar um browser que não os suporta ou que o rejeitou.  " if $uid < 1 or !$name;

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

  $exboxes =~ s/'//g;
  my @b = split(",", $exboxes);

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

  $exboxes = "'" . join("','", @b) . "',";
  $exboxes =~ s/\'\',//g;

  foreach my $k (keys %$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\'/;
    }
  }

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

  # Take care of the preferences table

  my $H = {}; # for users_index
  my $H2 = {}; # for users_prefs

  $$H{extid} = checkList($extid);
  $$H{exaid} = checkList($exaid);
  $$H{exsect} = checkList($exsect);
  $$H{exboxes} = checkList($exboxes);
  $$H{maxstories} = $$F{maxstories};
  $$H{noboxes} = $$F{noboxes} ? "1" : "0";

  $$H2{light} = $$F{light} ? "1" : "0";
  $$H2{noicons} = $$F{noicons} ? "1" : "0";
  $$H2{willing} = $$F{willing} ? "1" : "0";
  
  if (defined $$F{tzcode} and defined $$F{tzformat}) {
    $$H2{tzcode} = $$F{tzcode};
    $$H2{dfid} = $$F{tzformat};
  }

  $$H2{mylinks} = $$F{mylinks} if $$F{mylinks};


  # 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 "<TABLE width=100% cellpadding=10><TR><TD width=50% valign=top>";

	print "<P><FORM action=$ENV{SCRIPT_NAME} method=post>";
	titlebar("100%",$$F{unickname}?"Error Logging In":"Login");
	print "Alerta! Você não se identificou! Aparentemente, introduziu
		a password errada, o nickname errado, ou então o servidor foi
                invadido por aliens. Sugiro que tente novamente, ou então, caso se tenha
                esquecido da password, que clique o botão respectivo." if $$F{unickname};

	print "Identificando-se poderá publicar comentários com o seu nome.
		Se não o fizer, só os poderá publicar como Anónimo." unless $$F{unickname};

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

	print "	<P><B>Nick:</B><BR>
		<INPUT type=text name=unickname size=20 
			value=\"$$F{unickname}\"><BR>
		<B>Password:</B><BR>
		<INPUT type=password name=upasswd size=20><BR>
		<INPUT type=submit name=op value=userlogin>
		<INPUT type=submit name=op value=mailpasswd>
		";
	print "</TD><TD width=50\% valign=top>";
	titlebar("100%",$$F{newuser}?"Conta Duplicada!":"Sou um Novo Utilizador!");
	print " Aparentemente, você tentou registar-se com um <B>nickname
                já existente</B>, um <B>email já existente</B>, ou
                um <B>email inválido</B>. Você pode tentar outro em baixo,
                ou usar o formulário da esquerda para se identificar ou recuperar
                a password esquecida.
		" if $$F{newuser};
		
	
	print "	O quê? Ainda não tem conta?  Então introduza o seu
		<B>nickname</B> preferido aqui: 
		" unless $$F{newuser};
	print "<INPUT type=text name=newuser size=20 value=\"$$F{newuser}\">
		<BR> e um <B>endereço de email válido </B> para enviar a informação
                de registo.
		Este endereço <B>não</B> será mostrado no $sitename.
		<INPUT type=text name=email size=20 value=\"$$F{email}\"><BR>
		<INPUT type=submit name=op value=newuser> Clique no botão para receber
                uma password.<BR>
		</FORM>
		";
	print "</TD></TR></TABLE>";
}

main;
$dbh->disconnect() if $dbh;
1;
