X-Git-Url: http://wagner.pp.ru/gitweb/?a=blobdiff_plain;f=forum%2Fforum;h=e7cbc9218f6e23ae34691ed508adc207a72147c9;hb=89667c75001818612ff7456840d369954560e76a;hp=df265c3c6157b3723baa8ddfc2c95628ca22c10a;hpb=c635da4f907912ff26fbfcf6369b9e0dc4393321;p=oss%2Fstilllife.git diff --git a/forum/forum b/forum/forum index df265c3..e7cbc92 100755 --- a/forum/forum +++ b/forum/forum @@ -19,6 +19,9 @@ use HTML::TreeBuilder; use Storable qw(freeze thaw); use Date::Parse; use Email::Valid; +use Image::Size; +use HTML::BBReverse; +use POSIX; use LWP::UserAgent; use Net::OpenID::Consumer; # @@ -345,7 +348,7 @@ sub show_template { } } - $f->attr("type","POST"); + $f->attr("method","POST"); for my $required ($form,"returnto") { if (!$substituted{$required}) { my $element = new HTML::Element('input', @@ -421,39 +424,27 @@ my %userinfo = %{$forum->{"authenticated"}}; # # Специально обрабатываем поля user (должна быть ссылка) и avatar # (должен быть img). -my @userlink = $tree->look_down("_tag"=>"a","class"=>"author"); -if (@userlink) { my $userpage; - if ($userinfo{"user"}=~/^http:/) { - $userpage = $userinfo{"user"}; + if ($userinfo{"openiduser"}) { + $userpage = "http://".$userinfo{"user"}; } else { $userpage = $cgi->url(-absolute=>1).$forum->{"userurl"}."/".$cgi->escape($userinfo{"user"}); } - for my $element (@userlink) { - $element->attr(href=>$userpage); + substinfo($tree,["_tag"=>"a","class"=>"author"], + href=>$userpage,_content=>$userinfo{"user"}); + delete $userinfo{"user"}; + substinfo($tree,["_tag"=>"img","class"=>"avatar"], + src=>$userinfo{"avatar"}||$forum->{templatesurl}."/1x1.gif"); + delete $userinfo{"avatar"}; + + for my $element ( $tree->look_down("class",qr/^ap-/)) { + my $field=$1 if $element->attr("class")=~/^ap-(.*)$/; $element->delete_content(); - $element->push_content($userinfo{"user"}); - } -} -delete $userinfo{"userpage"}; -delete $userinfo{"user"}; -my $avatar = $tree->look_down("_tag"=>"img","class"=>"avatar"); -if ($avatar) { - $avatar->attr(src=>$userinfo{"avatar"}); -} -delete $userinfo{"avatar"}; - -while (my ($field,$value)=each %userinfo) { - my $element = $tree->look_down("class","a".$field); - if ($element) { - $element->delete_content(); - # - # FixME - allow HTML in author attributes - $element->push_content($value); + $element->push_content(str2tree($userinfo{$field})) + if $userinfo{$field}; } -} } # @@ -480,6 +471,7 @@ sub authorize_user { my %userbase; dbmopen %userbase,datafile($forum,"passwd"),0644; if ( $userbase{$user}) { + print STDERR "getting user info for $user\n"; my $userinfo = thaw($userbase{$user}); delete $userinfo->{"passwd"}; $userinfo->{"user"} = $user; @@ -489,8 +481,7 @@ sub authorize_user { } print STDERR "user $user restored session $session\n"; $forum->{"authenticated"}=$userinfo; - print STDERR "authorize_user: - ",$forum->{authenticated}{user}, + print STDERR "authorize_user: ",$forum->{authenticated}{user}, $forum->{authenticated},"\n"; } dbmclose %userbase; @@ -769,37 +760,131 @@ sub reply { # # Находим файл дискуссии, в который надо поместить реплику # + my ($tree,$lockfd)=gettree($ENV{'PATH_TRANSLATED'}); + my $messagetpl = $tree->look_down(class=>"message"); + if (!$messagetpl) { + show_error($forum,"Шаблон темы не содержит элемента с классом + message"); + exit; + } + # + # Генерируем идентификатор записи. # - # Сохраняем приаттаченную картинку, если есть. + my $id = get_uid($forum); + + # - - # Генерируем идентификатор записи. + # Сохраняем приаттаченные картинки, если есть. # - + my $dir = $1 if $ENV{PATH_TRANSLATED}=~/^(.*)$/; + $dir=~ s/[^\/]+$// if (-f $dir); + my %attached; + for (my $i=1;$cgi->param("image$i"); $i++) { + my $userpath=$cgi->param("image$i"); + my $filename=lc($1) if $userpath =~ /([^\/\\]+)$/; + $attached{$filename} = $id."_".$filename; + my $in = $cgi->upload("image$i"); + if (!$in) { + show_error($forum,"Ошибка при загрузке картинки $filename"); + exit; + } + my $out; + open $out,">$dir/$attached{$filename}"; + binmode $out,":bytes"; + local $/=undef; + my $data = <$in>; + print $out $data; + close $in; + close $out; + } # # Преобразуем текст записи в html и чистим его # - my $txtree = undef; - if ($cgi->param("format") eq "bbcode") { - - } elsif ($cgi->param("format") eq "text") { - my $text = $cgi->escapeHTML($cgi->param("text")); - $text=~s/\r?\n\r?\n/

/; - $text=~s/\n/
/; - $txtree = - HTML::TreeBuilder->new_from_content("

$text
"); - } else { # Default - html - $txtree = - HTML::TreeBuilder->new_from_content("
".$cgi->param("text")."
"); - for my $badtag - ("script","style","head","html","object","embed","iframe","frameset","frame", - ($forum->{forbid_tags}?split(/\s*,\s*/,$forum->{forbid_tags}):())) { - for my $element ($txtree->find_by_tag_name($badtag)) { - $element->delete() if defined $element; - } + my $txtree = input2tree($cgi,$forum,"text"); + # + # Находим в тексте URL на приаттаченные картинки и меняем на те + # имена, под которыми мы их сохранили. + # + for my $image ($txtree->find_by_tag_name("img")) { + my $file=lc($image->attr("src")); + if ( exists $attached{$file}) { + $image->attr("src" => $attached{$file}); + my ($width,$height) = imgsize($dir ."/".$attached{$file}); + $image->attr("width" =>$width); + $image->attr("height" => $height); } } + # + # Копируем элемент с классом message + # + my $newmsg = $messagetpl->clone; + my $parent = $messagetpl->parent; + $parent->push_content($newmsg); + # + # Подставляем данные сообщения + # + $newmsg->attr("id"=>$id); + substinfo($newmsg,[class=>"subject"],_content=>$cgi->param("subject")); + my $textnode=$newmsg->look_down("class"=>"mtext"); + if (!$textnode) { + show_error($forum,"В шаблоне реплики нет места для текста"); + } + $textnode->delete_content(); + $textnode->push_content($txtree); + if ($forum->{authenticated}{signature}) { + $textnode->push_content(new HTML::Element("br"),"--", + new HTML::Element("br"),str2tree($forum->{authenticated}{signature})); + } + substitute_user_info($newmsg,$forum); + # + # Подставляем данные в форму msginfo + # + my $editform=$newmsg->look_down(_tag=>"form","class"=>"msginfo"); + if ($editform) { + substinfo($editform,[_tag=>"input",name=>"id"],value=>$id) || + show_error($forum,"В форме управления сообщением нет поля id"); + substinfo($editform,[_tag=>"input",name=>"author"],value=> + $forum->{authenticated}{user}) || + show_error($forum,"В форме управления сообщением нет поля author"); + } + # Подставляем mdate + substinfo($newmsg,["class"=>"mdate"], + _content =>strftime("%d.%m.%Y %H:%M",localtime())); + # Подставляем mreply + substinfo($newmsg,[_tag=>"a","class"=>"mreply"],"href" => + $cgi->url(-absolute=>1,-path_info=>1)."?reply=1&id=$id"); + # Подставляем manchor + substinfo($newmsg,[_tag=>"a","class"=>"manchor"], + "name"=>"#$id","href"=>undef) or + show_error($forum,"В шаблоне сообщения отсутствует якорь для ссылок на него"); + # подставляем mlink + substinfo($newmsg,[_tag=>"a","class"=>"mlink"], + href=>$cgi->path_info."#id"); + # подставляем mparent + my $parent_id=$cgi->param("id"); + if ($parent_id) { + substinfo($newmsg,[_tag => "a",class=>"mparent"], + "href"=>$cgi->path_info."#$parent_id"); + } else { + substinfo($newmsg,[_tag => "a",class=>"mparent"], + "_content"=>""); + } + + # + # Проверяем видимость списка сообщений + # + 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); + forum_redirect($cgi,$forum); + } # # читает файлы прав доступа в дереве форума, и возвращает @@ -857,7 +942,7 @@ sub gettree { my $f; open $f,"<",$filename or return undef; flock $f, LOCK_EX; - my $tree = HTML::TreeBuider->new_from_file($f); + my $tree = HTML::TreeBuilder->new_from_file($f); return ($tree,$f); } # @@ -866,8 +951,9 @@ sub gettree { # sub savetree { - my ($filename,$tree,$lockfd) = shift; + my ($filename,$tree,$lockfd) = @_; my $f; + $filename = $1 if $filename =~ /^(.*)$/; open $f,">",$filename . ".new" or return undef; print $f $tree->as_HTML("<>&"); close $f; @@ -885,18 +971,19 @@ sub savetree { sub get_uid { my $forum = shift; my $f; - open $f,"<+",datafile($forum,"sequence"); + open $f,"+<",datafile($forum,"sequence") or flock $f,LOCK_EX; my $id=<$f> || "0"; $id++; seek $f,0,0; printf $f "%8s\n",$id; close $f; - return sprintf ("%08s",$id); + $id=~/(\d+)/; + return sprintf ("%08s",$1); } -# -# ----------------- OpenID registration ----------------------------- -# +# -------------------------------------------------------------------- +# OpenID registration +# ------------------------------------------------------------------- sub create_openid_consumer { my ($cgi,$forum) = @_; return Net::OpenID::Consumer ->new( @@ -958,13 +1045,15 @@ sub openid_verify { $user=~s/\/$//; my %userbase; dbmopen %userbase,datafile($forum,"passwd"),0664; - if (!$userbase{$user}) { - $userbase{$user} = $forum->{authenticated}={"openiduser"=>1}; + my $username = $user; + $username =~ s/^http:\/\///; + if (!$userbase{$username}) { + $userbase{$username} = freeze($forum->{authenticated}={"openiduser"=>1}); } else { - $forum->{authenticated} = thaw ($userbase{$user}); + $forum->{authenticated} = thaw ($userbase{$username}); } dbmclose %userbase; - $forum->{"authenticated"}{"user"} = $user; + $forum->{"authenticated"}{"user"} = $username; newsession(undef,$forum,$user); # Если указан параметр reply, вызываем обработку реплики if ($cgi->param("reply")) { @@ -978,3 +1067,90 @@ sub openid_verify { exit; } } +#----------------------------------------------------------------- +# Обработка форматированных текстовых полей +#----------------------------------------------------------------- + +sub input2tree { + my ($cgi,$forum,$field_name) = @_; + my $format = $cgi->param($field_name."_format"); + my $text = $cgi->param($field_name); + if ($format eq "bbcode") { + my $parser = HTML::BBReverse->new(); + $text="
".$parser->parse($text)."
"; + } elsif ($format eq "text") { + $text=~s/\r?\n\r?\n/<\/p>

/; + $text=~s/\r?\n/
/; + $text = "

".$text."

"; + } + my $txtree = str2tree($text); + for my $badtag + ("script","style","head","html","object","embed","iframe","frameset","frame", + ($forum->{forbid_tags}?split(/\s*,\s*/,$forum->{forbid_tags}):())) { + for my $element ($txtree->find_by_tag_name($badtag)) { + $element->delete() if defined $element; + } + } + # Проверяем на наличие URL-ок не оформленных ссылками. + return $txtree; +} + + + +sub str2tree { + my ($data)=@_; + my $tree = HTML::TreeBuilder->new(); + # Set parser options here + $tree->parse("
$data
"); + $tree->eof; + my $element=$tree->find("body"); + while (($element =($element->content_list)[0])->tag ne "div") { + } + $element->detach; + $tree->destroy; + return $element; +} + +sub tree2str { + my ($tree)=@_; + return $tree->as_HTML("<>&"); +} + +#------------------------------------------------------------------------ +# Подстановка в дереве +#------------------------------------------------------------------------ + +# +# Найти все элементы, удоволетворяющие заданному критерию и подставить в +# них указанные атрибуты +# +# Параметры 1. Дерево (класса HTML::Element) +# 2. Запрос - ссылка на список вида атрибут=>значение. +# Этот список будет непосредственно передан в +# HTML::Element::look_down +# 3. Далее пары имя-атрибута, значение. Если вместо имени атрибута +# использовать слово _content, заменено будет содержимое элемента. +# Значение для _content - ссылка на HTML::Element. Если там строка, +# она будет вставлена как одиночный текстовый узел. +# 4. Возвращает число выполненных подстановок (0, если искомых элементов +# не найдено. +# +sub substinfo { + my ($tree,$query,@attrs) = @_; + my $count; + foreach my $element ($tree->look_down(@$query)) { + $count ++; + while (@attrs) { + my $attr = shift @attrs; + my $value = shift @attrs; + if ($attr eq "_content") { + $element->delete_content; + $element->push_content($value); + } else { + $element->attr($attr,$value); + } + } + } + return $count; +} +