lilalo

view l3-cgi-lite @ 150:822b36252d7f

find changesets by author, revision, files, or words in the commit message
Вывод больших фрагментов текста не теряется.

Большие фрагменты текста теперь не вырезаются бесследно.
Там, откуда они вырезаются, вставляются ссылки,
по которым можно посмотреть полную версию вывода.
Испытано на больших фрагментах текста,
содержащих до 5000 строк (фрагменты более 5000 строк по умолчанию
обрезаются административно; допустимые размеры задаются в l3config.pm).
Исправлены ошибки, из-за которых большие фрагменты
обрабатывались некорректно.
author igor@chub.in
date Tue Jun 23 01:15:02 2009 +0300 (2009-06-23)
parents 51a232faeb27
children
line source
1 #!/usr/bin/perl
2
3 use strict;
4 use CGI qw(:standard);
5 use utf8;
6
7 BEGIN {
8 chdir("/etc/lilalo/");
9 require "/etc/lilalo/l3config.pm"
10 or die " Can't open l3config.pm ";
11 l3config::init_config();
12 };
13
14 sub path_is_correct($);
15 sub error($);
16 sub remove_extra_slashes_from($);
17 sub print_header($);
18 sub print_footer;
19 sub nav_bar;
20
21 sub count_command_lines($);
22
23 my $print="";
24 my $path = $ENV{PATH_INFO};
25 remove_extra_slashes_from($path);
26
27
28 my $commands_to_show_at_a_go = $l3config::Config{"commands_to_show_at_a_go"};
29 my $start_from_command = "0";
30 my $this_page_number=0;
31 my $page_id;
32 if ($path =~ s/:(.*)//) {
33 $this_page_number = $1;
34 $start_from_command = $this_page_number*$commands_to_show_at_a_go;
35 }
36 $page_id=$this_page_number;
37
38 my $real_path = $l3config::Config{"backend_datadir"} ;
39 my $cgi_path = $l3config::Config{"cgi_path"} ;
40 my $style_files = $l3config::Config{"frontend_files"} ;
41 my $frontend_css = $l3config::Config{"frontend_css"} ;
42
43 my $filter=$ENV{QUERY_STRING};
44 if ($filter =~ s@command_id=([0-9]+)@@){
45 $l3config::Config{"command_id"}=$1;
46 $page_id=$1;
47 }
48 if ($filter =~ /page=([^&]*)/ ) {
49 open(PAGE_NAME, "grep $1 $real_path/sessions-index | tail -1 | sed 's^-<.*^^; s^/[^/]*\$^^'| ");
50 my $page_name;
51 $page_name=<PAGE_NAME>;
52 chomp $page_name;
53 my $id="";
54 if ($filter =~ /id=([^&]*)/) {
55 $id="#$1";
56 }
57 print "Status: 302 Moved\nLocation: http://xgu.ru/l3/$page_name$id\n\n";
58 exit(0);
59 }
60 elsif ($filter !~ /filter=/) {
61 # $filter="";
62 }
63 else {
64 $filter =~ s@.*filter=@@;
65 $filter =~ s@\&.*@@;
66 }
67
68 my $data_file = "data.xml";
69
70 path_is_correct($path)
71 or error ("Путь $path содержит недопустимые символы или комбинации символов.");
72
73 $real_path .= $path;
74 remove_extra_slashes_from($real_path);
75
76 # Чувак, ты хотел бы посмотреть на журнал $path
77 # Он должен находиться в каталоге $real_path файловой системы\n";
78
79 (-d $real_path)
80 or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
81
82 if (-e $real_path."/$data_file") {
83
84 # В каталоге есть файл $data_file
85 # Отлично! Сейчас будем показывать журнал
86
87 # Если существуют html и xml файлы,
88 # html файл новее чем xml,
89 # и CGI-скрипту не передано дополнительных параметров,
90 # используем html файл, иначе перегенируем его
91
92 unless ( -e "$real_path/$data_file"
93 && -e "$real_path/index.html"
94 && (stat("$real_path/index$page_id.html"))[9] > (stat("$real_path/$data_file"))[9]) {
95
96 my $fragment_options;
97 if ($l3config::Config{"command_id"}) {
98 $fragment_options = " --command_id ".$l3config::Config{"command_id"};
99 }
100 else {
101 $fragment_options = " --start_from_command $start_from_command ";
102 }
103 my $l3_frontend = "l3-frontend --backend_datafile $real_path/$data_file".
104 $fragment_options.
105 " --output $real_path/index$page_id.html".
106 " --filter '$filter'";
107 system($l3_frontend) == 0
108 or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
109 }
110
111 {
112 local $/;
113 open(HTML, "<:utf8", "$real_path/index$page_id.html");
114 my $html = <HTML>;
115
116 # Добавим в начало документа навигационную строку
117 my $nav_bar = nav_bar;
118 $html =~ s/(<body[^>]*>)/$1$nav_bar/;
119
120 $print .= $html;
121 close(HTML);
122 }
123
124 }
125 else {
126
127 # В этом каталоге нет файла data.xml
128 # Но в нём должны быть подкаталоги!
129 # Если и их тут нет, то тут вообще делать нечего
130
131 $print .= nav_bar;
132
133 my @dirs = glob("$real_path/*");
134 my $folder_link = "$cgi_path/$path";
135 remove_extra_slashes_from($folder_link);
136
137 $folder_link =~ s@/[^\/]*/?$@@;
138 if ($folder_link) {
139 $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
140 }
141
142 for my $dir (@dirs) {
143 next unless (-d $dir);
144 my ($folder_name) = $dir =~ m@.*/(.*)@;
145 $folder_link = "$cgi_path/$path/$folder_name";
146 $folder_link =~ s@//@/@g;
147 $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
148 }
149
150 $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
151 .$print
152 .print_footer;
153 };
154
155 binmode STDOUT, ":utf8";
156 print header(-charset => "utf-8");
157 print $print;
158 exit(0);
159
160 #----------------------------------------------
161
162
163 sub error($)
164 {
165 my $message = $_[0];
166
167 binmode STDOUT, ":utf8";
168 print header(-charset => "utf-8");
169
170 my $print = "<h2>Извините, произошла ошибка</h2>";
171 $print .= $message;
172
173 print $print;
174 exit(0);
175 }
176
177
178 sub path_is_correct($)
179 {
180 my $path = $_[0];
181 # return 0 if $path =~ m@/../@;
182 return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
183 return 1;
184 }
185
186 sub remove_extra_slashes_from($)
187 {
188 while ($_[0] =~ s@//@/@g) {1;};
189 return $_[0];
190 }
191
192 sub print_header($)
193 {
194 my $title = $_[0];
195 "<html>"
196 ."<head>"
197 ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
198 ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
199 ."<title>$title</title>"
200 ."</head>"
201 }
202
203 sub print_footer()
204 {
205 "</html>";
206 }
207
208 sub nav_bar()
209 {
210 my $nav_bar="";
211 my $skip_first=1;
212 my $current_path="";
213 for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
214 if ($skip_first) {
215 $skip_first--;
216 next;
217 }
218 $current_path .= "/$path_part";
219 $nav_bar .= "/<a href='$current_path'>$path_part</a>";
220 }
221 my $pages=int(count_command_lines("$real_path/$data_file")/$commands_to_show_at_a_go)+1;
222 my $i=1;
223 while ($i<$pages) {
224 if ($i==$this_page_number) {
225 $nav_bar .= " <b>:$i</b>";
226 }
227 else {
228 $nav_bar .= " <a href='$current_path:$i'>:$i</a>";
229 }
230 $i++;
231 }
232 $filter = "($filter)" if $filter;
233 return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar $filter</td></tr></table>";
234 }
235
236 sub count_command_lines($)
237 #
238 # Считает количество строк в файле с данными
239 # Грязный временный хак
240 #
241 {
242 my $filename= $_[0];
243 return int(`grep '<command>' $filename |wc -l`);
244 # return $filename;
245 }
246