devi@101: #!/usr/bin/perl devi@101: devi@101: use strict; devi@101: use CGI qw(:standard); devi@101: use utf8; devi@101: devi@101: BEGIN { devi@101: chdir("/home/devi/cvs/lilalo"); devi@101: require l3config; devi@101: l3config::init_config(); devi@101: }; devi@101: devi@101: sub path_is_correct($); devi@101: sub error($); devi@101: sub remove_extra_slashes_from($); devi@101: sub print_header($); devi@101: sub print_footer; devi@101: sub nav_bar; devi@101: devi@101: my $print=""; devi@101: my $path = $ENV{PATH_INFO}; devi@101: remove_extra_slashes_from($path); devi@101: devi@101: my $real_path = $l3config::Config{"backend_datadir"} ; devi@101: my $cgi_path = $l3config::Config{"cgi_path"} ; devi@101: my $style_files = $l3config::Config{"frontend_files"} ; devi@101: my $frontend_css = $l3config::Config{"frontend_css"} ; devi@101: my $data_file = "data.xml"; devi@101: devi@101: path_is_correct($path) devi@101: or error ("Путь $path содержит недопустимые символы или комбинации символов."); devi@101: devi@101: $real_path .= $path; devi@101: remove_extra_slashes_from($real_path); devi@101: devi@101: # Чувак, ты хотел бы посмотреть на журнал $path devi@101: # Он должен находиться в каталоге $real_path файловой системы\n"; devi@101: devi@101: (-d $real_path) devi@101: or error("Каталог $real_path не существует. Проверьте, пожалуйста, URL\n"); devi@101: devi@101: if (-e $real_path."/$data_file") { devi@101: devi@101: # В каталоге есть файл $data_file devi@101: # Отлично! Сейчас будем показывать журнал devi@101: devi@101: # Если существуют html и xml файлы, devi@101: # html файл новее чем xml, devi@101: # и CGI-скрипту не передано дополнительных параметров, devi@101: # используем html файл, иначе перегенируем его devi@101: devi@101: unless ( -e "$real_path/$data_file" devi@101: && -e "$real_path/index.html" devi@101: && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] ) { devi@101: devi@101: my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html"; devi@101: system($l3_frontend) == 0 devi@101: or error("Файл журнала найден, но возникла ошибка при его обработке:
$!"); devi@101: $print .= "(перегенирован)
"; devi@101: } devi@101: devi@101: { devi@101: local $/; devi@101: open(HTML, "<:utf8", "$real_path/index.html"); devi@101: my $html = ; devi@101: devi@101: # Добавим в начало документа навигационную строку devi@101: my $nav_bar = nav_bar; devi@101: $html =~ s/(]*>)/$1$nav_bar/; devi@101: devi@101: $print .= $html; devi@101: close(HTML); devi@101: } devi@101: devi@101: } devi@101: else { devi@101: devi@101: # В этом каталоге нет файла data.xml devi@101: # Но в нём должны быть подкаталоги! devi@101: # Если и их тут нет, то тут вообще делать нечего devi@101: devi@101: $print .= nav_bar; devi@101: devi@101: my @dirs = glob("$real_path/*"); devi@101: my $folder_link = "$cgi_path/$path"; devi@101: remove_extra_slashes_from($folder_link); devi@101: devi@101: $folder_link =~ s@/[^\/]*/?$@@; devi@101: if ($folder_link) { devi@101: $print .= "..
"; devi@101: } devi@101: devi@101: for my $dir (@dirs) { devi@101: next unless (-d $dir); devi@101: my ($folder_name) = $dir =~ m@.*/(.*)@; devi@101: $folder_link = "$cgi_path/$path/$folder_name"; devi@101: $folder_link =~ s@//@/@g; devi@101: $print .= "$folder_name
"; devi@101: } devi@101: devi@101: $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path")) devi@101: .$print devi@101: .print_footer; devi@101: }; devi@101: devi@101: binmode STDOUT, ":utf8"; devi@101: print header(-charset => "utf-8"); devi@101: print $print; devi@101: exit(0); devi@101: devi@101: #---------------------------------------------- devi@101: devi@101: devi@101: sub error($) devi@101: { devi@101: my $message = $_[0]; devi@101: devi@101: binmode STDOUT, ":utf8"; devi@101: print header(-charset => "utf-8"); devi@101: devi@101: my $print = "

Извините, произошла ошибка

"; devi@101: $print .= $message; devi@101: devi@101: print $print; devi@101: exit(0); devi@101: } devi@101: devi@101: devi@101: sub path_is_correct($) devi@101: { devi@101: my $path = $_[0]; devi@101: return 0 if $path =~ m@/../@; devi@101: return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@; devi@101: return 1; devi@101: } devi@101: devi@101: sub remove_extra_slashes_from($) devi@101: { devi@101: while ($_[0] =~ s@//@/@g) {1;}; devi@101: return $_[0]; devi@101: } devi@101: devi@101: sub print_header($) devi@101: { devi@101: my $title = $_[0]; devi@101: "" devi@101: ."" devi@101: ."" devi@101: ."" devi@101: ."$title" devi@101: ."" devi@101: } devi@101: devi@101: sub print_footer() devi@101: { devi@101: ""; devi@101: } devi@101: devi@101: sub nav_bar() devi@101: { devi@101: my $nav_bar=""; devi@101: my $skip_first=1; devi@101: my $current_path=""; devi@101: for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) { devi@101: if ($skip_first) { devi@101: $skip_first--; devi@101: next; devi@101: } devi@101: $current_path .= "/$path_part"; devi@101: $nav_bar .= "/$path_part"; devi@101: } devi@101: return ""; devi@101: } devi@101: