#!/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;
my $print="";
my $path = $ENV{PATH_INFO};
remove_extra_slashes_from($path);
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] ) {
my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html";
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";
}
return "
..
$folder_name