lilalo
diff l3-cgi-lite @ 104:77f033a04361
Пофиксил приглашение
| author | devi |
|---|---|
| date | Tue Jun 27 10:58:57 2006 +0300 (2006-06-27) |
| parents | |
| children | 53b890d1ae90 |
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/l3-cgi-lite Tue Jun 27 10:58:57 2006 +0300 1.3 @@ -0,0 +1,174 @@ 1.4 +#!/usr/bin/perl 1.5 + 1.6 +use strict; 1.7 +use CGI qw(:standard); 1.8 +use utf8; 1.9 + 1.10 +BEGIN { 1.11 + chdir("/home/devi/cvs/lilalo"); 1.12 + require l3config; 1.13 + l3config::init_config(); 1.14 +}; 1.15 + 1.16 +sub path_is_correct($); 1.17 +sub error($); 1.18 +sub remove_extra_slashes_from($); 1.19 +sub print_header($); 1.20 +sub print_footer; 1.21 +sub nav_bar; 1.22 + 1.23 +my $print=""; 1.24 +my $path = $ENV{PATH_INFO}; 1.25 +remove_extra_slashes_from($path); 1.26 + 1.27 +my $real_path = $l3config::Config{"backend_datadir"} ; 1.28 +my $cgi_path = $l3config::Config{"cgi_path"} ; 1.29 +my $style_files = $l3config::Config{"frontend_files"} ; 1.30 +my $frontend_css = $l3config::Config{"frontend_css"} ; 1.31 +my $data_file = "data.xml"; 1.32 + 1.33 +path_is_correct($path) 1.34 + or error ("Путь $path содержит недопустимые символы или комбинации символов."); 1.35 + 1.36 +$real_path .= $path; 1.37 +remove_extra_slashes_from($real_path); 1.38 + 1.39 +# Чувак, ты хотел бы посмотреть на журнал $path 1.40 +# Он должен находиться в каталоге $real_path файловой системы\n"; 1.41 + 1.42 +(-d $real_path) 1.43 + or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n"); 1.44 + 1.45 +if (-e $real_path."/$data_file") { 1.46 + 1.47 +# В каталоге есть файл $data_file 1.48 +# Отлично! Сейчас будем показывать журнал 1.49 + 1.50 +# Если существуют html и xml файлы, 1.51 +# html файл новее чем xml, 1.52 +# и CGI-скрипту не передано дополнительных параметров, 1.53 +# используем html файл, иначе перегенируем его 1.54 + 1.55 + unless ( -e "$real_path/$data_file" 1.56 + && -e "$real_path/index.html" 1.57 + && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] ) { 1.58 + 1.59 + my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html"; 1.60 + system($l3_frontend) == 0 1.61 + or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!"); 1.62 + $print .= "(перегенирован)<br/>"; 1.63 + } 1.64 + 1.65 + { 1.66 + local $/; 1.67 + open(HTML, "<:utf8", "$real_path/index.html"); 1.68 + my $html = <HTML>; 1.69 + 1.70 +# Добавим в начало документа навигационную строку 1.71 + my $nav_bar = nav_bar; 1.72 + $html =~ s/(<body[^>]*>)/$1$nav_bar/; 1.73 + 1.74 + $print .= $html; 1.75 + close(HTML); 1.76 + } 1.77 + 1.78 +} 1.79 +else { 1.80 + 1.81 +# В этом каталоге нет файла data.xml 1.82 +# Но в нём должны быть подкаталоги! 1.83 +# Если и их тут нет, то тут вообще делать нечего 1.84 + 1.85 + $print .= nav_bar; 1.86 + 1.87 + my @dirs = glob("$real_path/*"); 1.88 + my $folder_link = "$cgi_path/$path"; 1.89 + remove_extra_slashes_from($folder_link); 1.90 + 1.91 + $folder_link =~ s@/[^\/]*/?$@@; 1.92 + if ($folder_link) { 1.93 + $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>"; 1.94 + } 1.95 + 1.96 + for my $dir (@dirs) { 1.97 + next unless (-d $dir); 1.98 + my ($folder_name) = $dir =~ m@.*/(.*)@; 1.99 + $folder_link = "$cgi_path/$path/$folder_name"; 1.100 + $folder_link =~ s@//@/@g; 1.101 + $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>"; 1.102 + } 1.103 + 1.104 + $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path")) 1.105 + .$print 1.106 + .print_footer; 1.107 +}; 1.108 + 1.109 +binmode STDOUT, ":utf8"; 1.110 +print header(-charset => "utf-8"); 1.111 +print $print; 1.112 +exit(0); 1.113 + 1.114 +#---------------------------------------------- 1.115 + 1.116 + 1.117 +sub error($) 1.118 +{ 1.119 +my $message = $_[0]; 1.120 + 1.121 +binmode STDOUT, ":utf8"; 1.122 +print header(-charset => "utf-8"); 1.123 + 1.124 +my $print = "<h2>Извините, произошла ошибка</h2>"; 1.125 +$print .= $message; 1.126 + 1.127 +print $print; 1.128 +exit(0); 1.129 +} 1.130 + 1.131 + 1.132 +sub path_is_correct($) 1.133 +{ 1.134 + my $path = $_[0]; 1.135 + return 0 if $path =~ m@/../@; 1.136 + return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@; 1.137 + return 1; 1.138 +} 1.139 + 1.140 +sub remove_extra_slashes_from($) 1.141 +{ 1.142 + while ($_[0] =~ s@//@/@g) {1;}; 1.143 + return $_[0]; 1.144 +} 1.145 + 1.146 +sub print_header($) 1.147 +{ 1.148 + my $title = $_[0]; 1.149 + "<html>" 1.150 + ."<head>" 1.151 + ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />" 1.152 + ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>" 1.153 + ."<title>$title</title>" 1.154 + ."</head>" 1.155 +} 1.156 + 1.157 +sub print_footer() 1.158 +{ 1.159 + "</html>"; 1.160 +} 1.161 + 1.162 +sub nav_bar() 1.163 +{ 1.164 + my $nav_bar=""; 1.165 + my $skip_first=1; 1.166 + my $current_path=""; 1.167 + for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) { 1.168 + if ($skip_first) { 1.169 + $skip_first--; 1.170 + next; 1.171 + } 1.172 + $current_path .= "/$path_part"; 1.173 + $nav_bar .= "/<a href='$current_path'>$path_part</a>"; 1.174 + } 1.175 + return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar</td></tr></table>"; 1.176 +} 1.177 +