+#
+# Поправляет ссылки на служебные файлы и скрипты форума
+#
+sub fix_forum_links {
+ my ($forum,$tree,$path_info) = @_;
+ $path_info=$ENV{'PATH_INFO'} if (!defined $path_info);
+ my $script_with_path = $ENV{SCRIPT_NAME}.$path_info;
+ ELEMENT:
+ for my $element ($tree->find_by_tag_name("form","img","link","script","a")) {
+ my $attr;
+ if ($element->tag eq "form") {
+ $attr = "action";
+ } elsif ($element->tag eq "a"|| $element->tag eq "link") {
+ $attr = "href";
+ } else {
+ $attr ="src";
+ }
+ my $link = $element->attr($attr);
+ print STDERR "Fixing link $link\n";
+ # Абсолютная ссылка - оставляем как есть.
+ next ELEMENT if (! defined $link || $link=~/^\w+:/);
+ # Ссылка от корня сайта.
+ if (substr($link,0,1) eq "/") {
+ # Если она не ведет на наш скрипт, не обрабатываем
+ next ELEMENT if substr($link,0,length($ENV{SCRIPT_NAME}) ne
+ $ENV{SCRIPT_NAME}) ;
+ # Иначе пишем туда слово forum вместо реального имени
+ # скрипта чтобы потом единообразно обработать
+ $link =~ s/^[^\?]+/forum/;
+ }
+ if (!($link =~ s!^templates/!$forum->{templatesurl}/!) &&
+ !($link =~ s!^users/!$forum->{usersurl}/!) &&
+ !($link =~ s!^forum\b!$script_with_path!)) {
+ $link = $forum->{"forumtop"}."/".$link
+ }
+ print STDERR "Fixed to $link\n";
+ $element->attr($attr,$link);
+ }
+}