+ my $tree = gettemplate($forum,"topic",$url);
+ # Заполнить название и аннотацию
+ 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=>0,
+ -query_string=>0).$url);
+ substinfo($controlform,[_tag=>"input",name=>"author"],value=>
+ $forum->{authenticated}{user});
+ }
+ update_topic_list($forum,$newtopic,0,$creation_time);
+ savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd);
+ record_statistics($forum,"topic");
+ forum_redirect($cgi,$forum,$cgi->url(-base=>1).$url);
+}
+
+sub new_forum {
+ my ($form,$cgi,$forum) = @_;
+ #
+ # Проверяем корректность urlname и прочих полей
+ #
+ my $urlname;
+ if (!$cgi->param("urlname")) {
+ form_error($form,$cgi,$forum,"Форуму необходимо задать непустое urlname");
+ }
+ if ($cgi->param("urlname") eq ".") {
+ $urlname = "."
+ } 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 $newname = "$path_translated/$urlname";
+ $newname=$path_translated if ($urlname eq ".");
+ my $filename = "$newname/$forum->{indexfile}";
+ if (-f $filename) {
+ form_error($form,$cgi,$forum,"Форум $urlname уже существует");
+ }
+ if (!$cgi->param("title")) {
+ form_error($form,$cgi,$forum,"Форум должен иметь непустое название");
+ }
+ mkdir $newname unless -d $newname;
+ #
+ # Сохраняем логотип
+ #
+ my ($logo_name,$logo_width,$logo_height);
+ if ($cgi->param("logo")) {
+ my $userpath = $cgi->param("logo");
+ $logo_name="logo.".lc($1) if $userpath=~/\.([^.]+)$/;
+ my $in = $cgi->upload("logo");
+ if (!$in) {
+ show_error($forum,"Ошибка при загрузке картинки $userpath");
+ exit;
+ }
+ my $out;
+ open $out,">$newname/$logo_name";
+ binmode $out,":bytes";
+ local $/=undef;
+ my $data = <$in>;
+ print $out $data;
+ close $in;
+ close $out;
+ ($logo_width,$logo_height) = imgsize("$newname/$logo_name");
+ } else {
+ $logo_name = $forum->{"templatesurl"}."/1x1.gif";
+ $logo_width = 1;
+ $logo_height=1;
+ }
+
+
+ #
+ # Создаем собственно оглавление форума
+ #
+
+ my $url = $cgi->path_info."/$urlname";
+ $url= $cgi->path_info if $urlname eq ".";
+ $url =~ s/\/+/\//g;
+ my $tree = gettemplate($forum,"forum",$url);
+ # Удалить элементы, который присутствуют только на главной странице
+ if ($urlname ne ".") {
+ for my $element ($tree->look_down("class"=>"top-page")) {
+ $element->delete;
+ }
+ }
+ # Заполнить название и аннотацию
+ 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"=>"annotation")
+ or show_error($forum,"В шаблоне форума отсутствует класс annotation");
+ my $creation_time=strftime("%d.%m.%Y %H:%M",localtime());
+ 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);
+ substinfo($subtree,[_tag=>"img","class"=>"logo"],
+ src=> $logo_name, width=>$logo_width, height=>$logo_height);
+ # Скрыть списки подфорумов и тем .
+ hide_list($tree,"forumlist");
+ hide_list($tree,"topiclist");
+ if ($urlname eq ".") {
+ for my $link_up ($tree->look_down(_tag=>"a",href=>"..")) {
+ $link_up->delete;
+ }
+ }
+ savetree($filename,$tree,undef);
+ $tree->destroy;
+ #
+ # Добавляем элемент в список тем текущего форума
+ #
+ if ($urlname ne ".") {
+ my $lockfd;
+ ($tree,$lockfd)=gettree($path_translated."/".$forum->{"indexfile"});
+ my $newforum = newlistelement($tree,"forum","forumlist");
+ substinfo($newforum,[_tag=>"a","class"=>"title"],
+ _content=>$cgi->param("title"), href=>"$urlname/");
+ substinfo($newforum,["class"=>"date"], _content=>$creation_time);
+ substinfo($newforum,["class"=>"abstract"],_content=>$abstract);
+ substinfo($newforum,[_tag=>"img","class"=>"logo"],src=>"$urlname/$logo_name",
+ width=>$logo_width,height=>$logo_height);
+ substitute_user_info($newforum,$forum);
+ $newforum->attr("id",$urlname);
+ my $controlform = $newforum->look_down(_tag=>"form",class=>"foruminfo");
+ if ($controlform) {
+ $controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>0).
+ $url);
+ substinfo($controlform,[_tag=>"input",name=>"author"],value=>
+ $forum->{authenticated}{user});
+ }
+ savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd);
+ record_statistics($forum,"forum");
+ } else {
+ # Создаем тему для "свежих реплик"
+ my $recent = gettemplate($forum,"topic",$url."/recent.html");
+ # remove reply link from page itself
+ for my $link ($recent->look_down(_tag =>"a", href=>qr/reply=/)) {
+ $link->delete;
+ }
+ substinfo($recent,["_tag"=>"title"],$cgi->param("title").": Свежие сообщения");
+ substinfo($recent,["class"=>"title"],
+ _content=>$cgi->param("title"). ": Свежие сообщения");
+ hide_list($recent,"messagelist");
+ savetree($path_translated."/recent.html",$recent,undef);
+
+ }
+
+ forum_redirect($cgi,$forum,$cgi->url(-base=>1).$url);
+}
+
+#
+# Обработка операции удаления всего на свете
+#
+sub delete_item {
+ my ($formname,$cgi,$forum) = @_;
+ #
+ # Сначала разберемся, что мы собственно удаляем
+ #
+ if ($cgi->param("user")) {
+ delete_user($cgi,$forum,$cgi->param("user"));
+ } elsif (-f $path_translated) {
+ if ($cgi->param("id")) {
+ delete_comment($cgi,$forum,$path_translated,$cgi->param("id"));
+ } else {
+ delete_topic($cgi,$forum,$path_translated);
+ }
+ } elsif (-d $path_translated && -f $path_translated ."/". $forum->{indexfile}) {
+ delete_forum($cgi,$forum,$path_translated);
+ } else {
+ show_error($forum,"Невозможно удалить неопознанный объект");
+ }
+}
+#
+# Удаление пользователя
+#
+sub delete_user {
+ my ($cgi,$forum,$user) = @_;
+ if ($forum->{authenticated}{user} ne $user &&
+ getrights($cgi,$forum) ne "admin") {
+ show_error($forum,"У вас недостаточно прав для удаления
+ пользователя $user");
+ }
+ my %base;
+ dbmopen %base,datafile($forum,"passwd"),0644;
+ delete $base{$user};
+ dbmclose %base;
+ forum_redirect($cgi,$forum,$forum->{forumtop});
+}
+#
+# Удаление реплики
+#
+sub delete_comment {
+ my ($cgi,$forum,$topic,$id) = @_;
+ my ($tree,$lockfd) = gettree($topic);
+ my ($msg) = $tree->look_down(id => $id);
+ show_error($forum,"В данной теме нет реплики с id=$id") if (!$msg);
+ if (getrights($cgi,$forum) ne "moderator"
+ && getrights($cgi,$forum) ne "admin") {
+ my $author= $msg->look_down(_tag=>"input",name=>"author");
+ if ($author->attr("value") ne $forum->{authenticated}{user}) {
+ show_error($forum,"У вас нет прав на удаление этого сообщения");
+ }
+ }
+ delete_from_list($tree,"messagelist","message",$msg);
+ savetree($topic,$tree,$lockfd);
+ $tree->delete;
+ ($tree,$lockfd) = gettree($forum->{forumroot}."/recent.html");
+ ($msg) = $tree->look_down(id => $id);
+ if ($msg) {
+ delete_from_list($tree,"messagelist","message",$msg);
+ savetree($forum->{forumroot}."/recent.html",$tree,$lockfd);
+ } else {
+ discardtree($tree,$lockfd);
+ }
+ # Если у реплики были картинки, то их тоже надо грохнуть
+ for my $pic (<$id."_*.*">) {
+ unlink $pic;
+ }
+ forum_redirect($cgi,$forum,$cgi->path_info);
+}
+#
+# Удаление темы
+#
+sub delete_topic {
+ my ($cgi,$forum,$topic) = @_;
+ # Если модератор, то в тему и не заглядываем
+ my ($dir,$id) = ($1,$2) if $topic=~/^(.*)\/([^\/]+).html$/;
+ show_error($forum,"Неверное имя темы $topic") unless ($dir && $id);
+ if (getrights($cgi,$forum) ne "moderator" &&
+ getrights($cgi,$forum) ne "admin") {
+ # Проверяем авторство темы и наличие в ней сообщений
+ my ($tree,$lockfd) = gettree($topic);
+ my $info = $tree->look_down(class=>"topic");
+ my $author = $tree->look_down(class=>"author");
+ if ($author->as_text() ne $forum->{authenticated}{user}) {
+ show_error($forum,"У вас нет права удалять эту тему");
+ }
+ $info = $tree->look_down(class=>"messagelist");
+ if ($info->attr("style") !~ /display: none;/) {
+ show_error($forum,"Невозможно удалить тему, содержащую сообщения");
+ }
+ discardtree($tree,$lockfd);
+ } # FIXME при удалении непустой темы модератором почистить recent.html
+ my ($tree,$lockfd) = gettree($dir . "/".$forum->{indexfile});
+ delete_from_list($tree,"topiclist","topic",$id);
+ savetree($tree,$dir ."/".$forum->{indexfile});
+ unlink $topic;
+ my $redirect_url = $cgi->path_info;
+ $redirect_url =~ s/\/[^\/]*$//;
+ forum_redirect($cgi,$forum,$redirect_url);
+}
+#
+# Удаление форума
+#
+sub delete_forum {
+ my ($cgi,$forum,$dir) = @_;
+ if (getrights($cgi,$forum) ne "moderator" && getrights($cgi,$forum)
+ ne "admin") {
+ show_error($forum,"У вас нет права удалять форумы");
+ }
+ opendir DIR,$dir;
+ my $count = 0;
+ while ( my $entry=readdir DIR) {
+ next if $entry eq $forum->{indexfile};
+ next if $entry eq "perms.txt";
+ next if $entry =~ /^logo.[^.]+/;
+ show_error($forum,"Нельзя удалять корень форума" )
+ if $entry eq ".forum";
+ $count ++;
+ }
+ closedir DIR;
+ show_error("Нельзя удалять непустой форум") if $count;
+ # Находим родительский форум
+ my $upper = $dir;
+ $upper=~s/([\/]+)$/$forum->{indexfile}/;
+ my $id = $1 if $dir =~ /\/([\/]+)$/;
+ # Удаляем форум из списка.
+ my ($tree,$lockfd) = gettree($upper);
+ delete_from_list($tree,"forumlist","forum",$id);
+ savetree($upper,$tree,$lockfd);
+ # Удаляем из файловой системы
+ opendir DIR,$dir;
+ for my $entry ( readdir DIR) {
+ unlink "$dir/$entry";
+ }
+ rmdir $dir;
+ my $redirect_url = $cgi->path_info;
+ $redirect_url =~s/\/$//;
+ $redirect_url =~ s/\/[^\/]*$//;
+ forum_redirect($cgi,$forum,$redirect_url);