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

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

"; $print .= $message; print $print; exit(0); } sub path_is_correct($) { my $path = $_[0]; # return 0 if $path =~ m@/../@; return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@; return 1; } sub remove_extra_slashes_from($) { while ($_[0] =~ s@//@/@g) {1;}; return $_[0]; } sub print_header($) { my $title = $_[0]; "" ."" ."" ."" ."$title" ."" } sub print_footer() { ""; } sub nav_bar() { my $nav_bar=""; my $skip_first=1; my $current_path=""; for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) { if ($skip_first) { $skip_first--; next; } $current_path .= "/$path_part"; $nav_bar .= "/$path_part"; } my $pages=int(count_command_lines("$real_path/$data_file")/$commands_to_show_at_a_go)+1; my $i=1; while ($i<$pages) { if ($i==$this_page_number) { $nav_bar .= " :$i"; } else { $nav_bar .= " :$i"; } $i++; } return ""; } sub count_command_lines($) # # Считает количество строк в файле с данными # Грязный временный хак # { my $filename= $_[0]; return int(`grep '' $filename |wc -l`); # return $filename; }