lilalo

view l3-cgi-lite @ 141:c48bd05dca85

find changesets by author, revision, files, or words in the commit message
Восстановлена поддержка сеансов и начальная поддержка правок


Теперь можно посмотреть на команды одного
сеанса; для этого нужно воспользоваться ссылкой,
на строке в начале открытия терминала.

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