From 56743ec1613ddf1a16a5e2ada00704b6037589df Mon Sep 17 00:00:00 2001
From: Victor Wagner <vitus@wagner.pp.ru>
Date: Tue, 25 Mar 2008 16:26:16 +0000
Subject: [PATCH] newtopic operation somewhat works

---
 forum/forum | 259 +++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 207 insertions(+), 52 deletions(-)

diff --git a/forum/forum b/forum/forum
index faba997..5ece800 100755
--- a/forum/forum
+++ b/forum/forum
@@ -60,7 +60,7 @@ my %permissions = (
 	profile => "normal",
 	setrights => "admin",
 );	
-
+our $path_translated; # Untainted value of PATH_TRANSLATED env var
 my $cgi = new CGI;
 print STDERR "--------------------\n";
 my $forum=get_forum_config();
@@ -144,14 +144,15 @@ sub dir2url {
 	return $prefix.substr($dir,length($root));
 }
 #
-# Поиск файла .forum вверх по дереву от $ENV{PATH_TRANSLATED}  
+# Поиск файла .forum вверх по дереву от $path_translated  
 # Значение PATH_TRANSLATED считаем безопасным - наш web-сервер нам не
 # враг.
 # Возвращает список имя,значение, имя, значение который прививается в
 # хэш
 
 sub get_forum_config {
-	my @path=split("/",$1) if $ENV{PATH_TRANSLATED}=~/^(\S+)$/;
+	$path_translated = $1 if $ENV{PATH_TRANSLATED}=~/^(\S+)$/;
+	my @path=split("/",$path_translated);
 	while (@path>1) {
 		if (-r (my $config=join("/",@path,".forum")) ) {
 			open F,"<",$config;
@@ -186,7 +187,6 @@ sub get_forum_config {
 
 			}	
 			$config{"userurl"} = dir2url($cgi,$config{"userdir"});
-
 			#
 			# Если нет ссылки в конфиге на файл паролей или он не 
 			# существует, выдаем ошибку. С офоромлением, так как шаблоны
@@ -203,6 +203,7 @@ sub get_forum_config {
 			$config{"authperiod"}="+1M" if (! exists $config{"authperiod"}); 
 			$config{"renewtime"} = "86000" if (!exists $config{"renewtime"});
 			$config{"replies_per_page"} = 50 if (!exists $config{"replies_per_page"});
+			$config{"indexfile"} = "index.html" if (!exists $config{"indexfile"});
 			return \%config;
 		}
 		pop @path;
@@ -248,17 +249,6 @@ sub show_error {
 	exit;
 }	
 
-sub gettemplate {
-	my ($forum, $template,$url) = @_;
-	my $filename=$forum->{"templates"}."/$template.html";
-	if (! -r $filename) {
-		show_error($forum,"Нет шаблона $template");
-		exit;
-	}
-	my $tree = HTML::TreeBuilder->new_from_file($filename);
-	fix_forum_links($forum,$tree,$url);
-	return $tree;
-}	
 #
 # Вывод шаблона формы. В шаблоне должна присутстовать форма с  
 # именем, совпадающим с именем form. Если в $cgi есть параметры, имена
@@ -332,12 +322,12 @@ sub show_template {
 				} else {	
 				$element->attr("value",$cgi->param($name));
 				}
-			} elsif ($f->tag eq "textarea") {
-				$f->delete_content;
-				$f->push_content($cgi->param("name"));
-			} elsif ($f->tag eq "select") {
-				for my $option ($f->find_by_tag_name("option")) {
-					if (grep($option->attr("value") eq $_, $cgi-param("name"))) {
+			} elsif ($element->tag eq "textarea") {
+				$element->delete_content;
+				$element->push_content($cgi->param($name));
+			} elsif ($element->tag eq "select") {
+				for my $option ($element->find_by_tag_name("option")) {
+					if (grep($option->attr("value") eq $_, $cgi->param($name))) {
 						$option->attr("selected","");
 					} else {	
 						$option->attr("selected",undef);
@@ -425,13 +415,15 @@ if (defined $user) {
 	dbmopen %users,datafile($forum,"passwd"),0644;
 	if (!$users{$user}) {
 		show_error($forum,"Неизвестный пользователь $user");
+	}
 	my $record = thaw($users{$user});
 	%userinfo = %$record;
 	$userinfo{"user"} = $user;
 } else {
 	# Если не сказано, какой юзер, то текущий.
 	%userinfo = %{$forum->{"authenticated"}}  
-}}
+}
+
 #
 # Специально обрабатываем поля user (должна быть ссылка) и avatar  
 # (должен быть img).
@@ -709,6 +701,12 @@ sub register {
 	newsession(undef,$forum,$user);
 	forum_redirect($cgi,$forum,$returnto) 
 }	
+sub clear_user_cookies {
+	my ($cgi,$forum) = @_;
+	$forum->{cookies}=[ $cgi->cookie(-name=>"sluser", -value=>"0",
+	-expires=>"-1m"),$cgi->cookie(-name=>"slsession", -value=>"0",
+			-expires => "-1m")];
+}			
 #
 # Обработчик формы логина. Сводится к вызову функции authenticate,
 # поскольку мы поддерживаем логин одновременный с отправкой реплики. 
@@ -721,12 +719,6 @@ sub login {
 		show_template(@_);
 	}	
 }	
-sub clear_user_cookies {
-	my ($cgi,$forum) = @_;
-	$forum->{cookies}=[ $cgi->cookie(-name=>"sluser", -value=>"0",
-	-expires=>"-1m"),$cgi->cookie(-name=>"slsession", -value=>"0",
-			-expires => "-1m")];
-}			
 #
 # Обработчик формы logout. В отличие от большинства обработчиков форм,
 # поддерживает обработку методом GET
@@ -773,9 +765,9 @@ sub reply {
 	#
 	# Находим файл дискуссии, в который надо поместить реплику
 	#
-	my ($tree,$lockfd)=gettree($ENV{'PATH_TRANSLATED'}); 
-	my $messagetpl = $tree->look_down(class=>"message");
-	if (!$messagetpl) {
+	my ($tree,$lockfd)=gettree($path_translated); 
+	my $newmsg = newlistelement($tree,"message","messagelist");
+	if (!$newmsg) {
 		show_error($forum,"Шаблон темы не содержит элемента с классом
 		message");
 		exit;
@@ -790,7 +782,8 @@ sub reply {
 	#
 	# Сохраняем приаттаченные картинки, если есть.
 	#
-	my $dir = $1 if $ENV{PATH_TRANSLATED}=~/^(.*)$/;
+	my $dir = $path_translated;
+
 	$dir=~ s/[^\/]+$// if (-f $dir);
 	my %attached;
 	for (my $i=1;$cgi->param("image$i"); $i++) {
@@ -829,12 +822,6 @@ sub reply {
 		}	
 	}	
 	#
-	# Копируем элемент с классом message
-	#
-	my $newmsg = $messagetpl->clone;
-	my $parent = $messagetpl->parent;
-	$parent->push_content($newmsg);
-	#
 	# Подставляем данные сообщения 
 	#
 	$newmsg->attr("id"=>$id);
@@ -878,28 +865,119 @@ sub reply {
 	my $parent_id=$cgi->param("id");
 	if ($parent_id) {
 		substinfo($newmsg,[_tag => "a",class=>"mparent"], 
-			"href"=>$cgi->path_info."#$parent_id");
+			"href"=>$cgi->path_info."#$parent_id",style=>undef);
 	} else {
 		substinfo($newmsg,[_tag => "a",class=>"mparent"], 
-			"_content"=>"");
+			style=>"display: none;");
 	}	
 
-	#
-	# Проверяем видимость списка сообщений 
-	#
-	my $msglist = $tree->look_down("class"=>"messagelist");
-	if ($msglist) {
-		my $style = $msglist->attr("style");
-		$msglist->attr("style",$style) if $style && $style =~ s/display: none;//;
-	}	
 	#
 	# Делаем Уфф и сохраняем то, что получилось 
 	#
-	savetree($ENV{PATH_TRANSLATED},$tree,$lockfd);
+	savetree($path_translated,$tree,$lockfd);
+	record_statistics($forum,"message"),
 	forum_redirect($cgi,$forum);
 	 
 }	
 #
+# Обработка операции создания новой темы. 
+#
+
+sub new_topic {
+	my ($form,$cgi,$forum) = @_;
+	#
+	# Проверяем корректность urlname и прочих полей
+	#
+	my $urlname;
+	if (!$cgi->param("urlname")) {
+		$urlname = get_uid($forum);
+	} else {	
+		$urlname=$1 if $cgi->param("urlname") =~ /^([-\w]+)$/;
+		form_error($form,$cgi,$forum,"Некорректные символы в urlname.
+		Допустимы только латинские буквы, цифры и минус") unless $urlname; 
+	}
+	if (!-d $path_translated) {
+		show_error($forum,"Операция $form может быть вызвана только со
+		страницы форума");
+	}	
+	my $filename = "$path_translated/$urlname.html";
+	if (-f $filename) {
+		form_error($form,$cgi,$forum,"Тема с urlname $urlname уже
+		существует");
+	}	
+	if (!$cgi->param("title")) {
+		form_error($form,$cgi,$forum,"Тема должна иметь непустое название");
+	}	
+	#
+	# Создаем собственно тему
+	#
+	my $tree = gettemplate($forum,"topic",$cgi->path_info."/$urlname.html");
+    # Заполнить название и аннотацию 
+	my $abstract = input2tree($cgi,$forum,"abstract");
+	substinfo($tree,[_tag=>"meta","name"=>"description"],content=>$abstract->as_trimmed_text);
+	substinfo($tree,[_tag=>"title"],_content=>$cgi->param("title"));
+	my $subtree = $tree->look_down("class"=>"topic");
+	my $creation_time=strftime("%d.%m.%Y %H:%M",localtime());
+	if ($subtree) {
+		substinfo($subtree,["class"=>"title"],
+		_content=>$cgi->param("title"));
+		substinfo($subtree,["class"=>"date"],
+			_content=>$creation_time);
+		# Вставляем в страницу КОПИЮ аннотации, поскольку аннотация
+		# нам еще понадобится в списке тем.
+		substinfo($subtree,["class"=>"abstract"],_content=>$abstract->clone);	
+		substitute_user_info($subtree,$forum);	
+	} else {
+		substinfo($tree,["class"=>"title"],
+		_content=>$cgi->param("title"));
+	}	
+	# Скрыть список сообщений.
+	hide_list($tree,"messagelist");
+	savetree($filename,$tree,undef);
+	#
+	# Добавляем элемент в список тем текущего форума
+	#
+	$tree->destroy;
+
+	my $lockfd;
+	($tree,$lockfd)=gettree($path_translated."/".$forum->{"indexfile"});
+	my $newtopic = newlistelement($tree,"topic","topiclist");
+	substinfo($newtopic,[_tag=>"a","class"=>"title"],
+	_content=>$cgi->param("title"), href=>"$urlname.html");
+	substinfo($newtopic,["class"=>"date"], _content=>$creation_time);
+	substinfo($newtopic,["class"=>"abstract"],_content=>$abstract);	
+	substitute_user_info($newtopic,$forum);	
+	$newtopic->attr("id",$urlname);
+	my $controlform = $newtopic->look_down(_tag=>"form",class=>"topicinfo");
+	if ($controlform) {
+		$controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>1).
+		"/$urlname.html");
+		substinfo($controlform,[_tag=>"input",name=>"author"],value=>
+			$forum->{authenticated}{user});
+	}		
+	savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd);
+	record_statistics($forum,"topic");
+	forum_redirect($cgi,$forum,$cgi->path_info."/$urlname.html");
+}
+#---------------------------------------------------------- 
+# База пользователей и права доступа
+#----------------------------------------------------------
+#
+# Записывает в базу данных пользователей, сколько каких объектов 
+# создал текущий пользователь
+#
+sub record_statistics {
+	my ($forum,$type) = @_;
+	my $user = $forum->{authenticated}{user};
+	my %base;
+	dbmopen %base,datafile($forum,"passwd"),0664;
+	my $userinfo = thaw($base{$user});
+	$userinfo->{$type."s"}++;
+	$userinfo->{"last_$type"}=time;
+	$base{$user} = freeze($userinfo);
+	dbmclose %base;
+}
+#
 # читает файлы прав доступа в дереве форума, и возвращает
 # статус текущего пользователя (undef - аноним, banned, normal,
 # moderator или admin
@@ -946,6 +1024,11 @@ sub getrights {
 }		
 
 
+
+#------------------------------------------------------------------
+# Работа с файлами и идентификторами
+#------------------------------------------------------------------
+
 #
 # Залочить файл и получить его распрасенное представление.
 # Возвращает пару ($tree,$lockfd)
@@ -966,7 +1049,6 @@ sub gettree {
 sub savetree {
 	my ($filename,$tree,$lockfd) = @_;
 	my $f;
-	$filename = $1 if $filename =~ /^(.*)$/;
 	open $f,">",$filename . ".new" or return undef;
 	print $f $tree->as_HTML("<>&");
 	close $f;
@@ -975,7 +1057,22 @@ sub savetree {
 	rename $filename.".new",$filename;
 	close $lockfd if defined($lockfd);
 }	
+#
+# Читает шаблон и подготавливает его к размещению по указанной URL.
+# Если url не указана, считается что шаблон будет показан как результат
+# текущего http-запроса.
 
+sub gettemplate {
+	my ($forum, $template,$url) = @_;
+	my $filename=$forum->{"templates"}."/$template.html";
+	if (! -r $filename) {
+		show_error($forum,"Нет шаблона $template");
+		exit;
+	}
+	my $tree = HTML::TreeBuilder->new_from_file($filename);
+	fix_forum_links($forum,$tree,$url);
+	return $tree;
+}	
 
 
 #
@@ -1132,7 +1229,42 @@ sub tree2str {
 #------------------------------------------------------------------------
 # Подстановка в дереве
 #------------------------------------------------------------------------
-
+# Находит 
+# элемент указанного класса и удаляет display: none из его атрибута
+# style. Возвращает 1, если элемент был раскрыт, и 0, если он и до этого 
+# был видимым.
+sub unhide_list {
+	my ($tree,$class) = @_;
+	my $msglist = $tree->look_down("class"=>$class);
+	if ($msglist) {
+		my $style = $msglist->attr("style");
+		if ($style && $style =~ s/display: none;//) {
+			$msglist->attr("style",$style);
+			return 1;
+		} else {
+			return 0;
+		}	
+	} 
+}	
+#
+# Находит первый элемент указанного класса, и приписывает ему display:
+# none в style.
+#
+sub hide_list {
+	my ($tree,$class)=@_;
+	my $msglist = $tree->look_down("class"=>$class);
+	return undef unless $msglist;
+	if (!$msglist->attr("style")) {
+		$msglist->attr("style","display: none;");
+	} else {
+		my $style = $msglist->attr("style");
+		unless ($style=~ s/\bdisplay:\s+\w+\s*;/display: none;/) {
+			$style .= "display: none;";
+		} 
+		$msglist->attr("style",$style);
+	}	
+	return 1;
+}	
 #
 # Найти все элементы, удоволетворяющие заданному критерию и подставить в
 # них указанные атрибуты
@@ -1166,4 +1298,27 @@ sub substinfo {
 	}
 	return $count;	
 }
-
+#
+# newlistelement($tree,$elementclass,$listclass) 
+#
+# Если список с указанным классом скрыт, раскрывает его и возвращает 
+# (единственный) элемент 
+sub newlistelement {
+	my ($tree,$element,$list) =@_;
+	my $msglist = $tree->look_down("class"=>$list);
+	if ($msglist) {
+		my $style = $msglist->attr("style");
+		if ($style && $style =~ s/display: none;//) {
+			$msglist->attr("style",$style);
+			return $msglist->look_down(class=>$element);
+		} else {
+			my $template = $msglist->look_down("class"=>$element);
+			return undef unless $template;
+			my $newitem=$template->clone;
+			$template->parent->push_content($newitem);
+			return $newitem;
+		}
+	} else {
+		return undef;
+	}
+}	
-- 
2.39.5