lilalo

view l3-cgi-lite @ 101:c41cc9a4b5ea

find changesets by author, revision, files, or words in the commit message
* Пофиксил ошибку с неправильной кодировкой mywi-хинтов.
* Подготовил к переходу в иерархию /l3/
** Исправил пути для стилей,
** Забацал красивый l3-cgi-lite


l3-cgi-lite пока что не доделан до нужного уровня,
но я его скоро дорисую.
Уже сейчас это намного более качественный скрипт
через уродский l3-cgi

Он, конечно, поработал в свое время,
но лучше его заменить l3-cgi-lite


Из функционала добавилось:
* Кэширование страниц в html
* Навигация по каталогам
* Навигационная строка в журнале сверху
author devi
date Sat Jun 24 22:53:37 2006 +0300 (2006-06-24)
parents
children 53b890d1ae90
line source
1 #!/usr/bin/perl
2
3 use strict;
4 use CGI qw(:standard);
5 use utf8;
6
7 BEGIN {
8 chdir("/home/devi/cvs/lilalo");
9 require l3config;
10 l3config::init_config();
11 };
12
13 sub path_is_correct($);
14 sub error($);
15 sub remove_extra_slashes_from($);
16 sub print_header($);
17 sub print_footer;
18 sub nav_bar;
19
20 my $print="";
21 my $path = $ENV{PATH_INFO};
22 remove_extra_slashes_from($path);
23
24 my $real_path = $l3config::Config{"backend_datadir"} ;
25 my $cgi_path = $l3config::Config{"cgi_path"} ;
26 my $style_files = $l3config::Config{"frontend_files"} ;
27 my $frontend_css = $l3config::Config{"frontend_css"} ;
28 my $data_file = "data.xml";
29
30 path_is_correct($path)
31 or error ("Путь $path содержит недопустимые символы или комбинации символов.");
32
33 $real_path .= $path;
34 remove_extra_slashes_from($real_path);
35
36 # Чувак, ты хотел бы посмотреть на журнал $path
37 # Он должен находиться в каталоге $real_path файловой системы\n";
38
39 (-d $real_path)
40 or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
41
42 if (-e $real_path."/$data_file") {
43
44 # В каталоге есть файл $data_file
45 # Отлично! Сейчас будем показывать журнал
46
47 # Если существуют html и xml файлы,
48 # html файл новее чем xml,
49 # и CGI-скрипту не передано дополнительных параметров,
50 # используем html файл, иначе перегенируем его
51
52 unless ( -e "$real_path/$data_file"
53 && -e "$real_path/index.html"
54 && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] ) {
55
56 my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html";
57 system($l3_frontend) == 0
58 or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
59 $print .= "(перегенирован)<br/>";
60 }
61
62 {
63 local $/;
64 open(HTML, "<:utf8", "$real_path/index.html");
65 my $html = <HTML>;
66
67 # Добавим в начало документа навигационную строку
68 my $nav_bar = nav_bar;
69 $html =~ s/(<body[^>]*>)/$1$nav_bar/;
70
71 $print .= $html;
72 close(HTML);
73 }
74
75 }
76 else {
77
78 # В этом каталоге нет файла data.xml
79 # Но в нём должны быть подкаталоги!
80 # Если и их тут нет, то тут вообще делать нечего
81
82 $print .= nav_bar;
83
84 my @dirs = glob("$real_path/*");
85 my $folder_link = "$cgi_path/$path";
86 remove_extra_slashes_from($folder_link);
87
88 $folder_link =~ s@/[^\/]*/?$@@;
89 if ($folder_link) {
90 $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
91 }
92
93 for my $dir (@dirs) {
94 next unless (-d $dir);
95 my ($folder_name) = $dir =~ m@.*/(.*)@;
96 $folder_link = "$cgi_path/$path/$folder_name";
97 $folder_link =~ s@//@/@g;
98 $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
99 }
100
101 $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
102 .$print
103 .print_footer;
104 };
105
106 binmode STDOUT, ":utf8";
107 print header(-charset => "utf-8");
108 print $print;
109 exit(0);
110
111 #----------------------------------------------
112
113
114 sub error($)
115 {
116 my $message = $_[0];
117
118 binmode STDOUT, ":utf8";
119 print header(-charset => "utf-8");
120
121 my $print = "<h2>Извините, произошла ошибка</h2>";
122 $print .= $message;
123
124 print $print;
125 exit(0);
126 }
127
128
129 sub path_is_correct($)
130 {
131 my $path = $_[0];
132 return 0 if $path =~ m@/../@;
133 return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
134 return 1;
135 }
136
137 sub remove_extra_slashes_from($)
138 {
139 while ($_[0] =~ s@//@/@g) {1;};
140 return $_[0];
141 }
142
143 sub print_header($)
144 {
145 my $title = $_[0];
146 "<html>"
147 ."<head>"
148 ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
149 ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
150 ."<title>$title</title>"
151 ."</head>"
152 }
153
154 sub print_footer()
155 {
156 "</html>";
157 }
158
159 sub nav_bar()
160 {
161 my $nav_bar="";
162 my $skip_first=1;
163 my $current_path="";
164 for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
165 if ($skip_first) {
166 $skip_first--;
167 next;
168 }
169 $current_path .= "/$path_part";
170 $nav_bar .= "/<a href='$current_path'>$path_part</a>";
171 }
172 return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar</td></tr></table>";
173 }
174