lilalo
view l3-cgi-lite @ 158:d775ffd49dbf
minifix: bsd/darwin in uname
| author | Igor Chubin <igor@chub.in> |
|---|---|
| date | Wed Feb 01 17:14:54 2012 +0200 (2012-02-01) |
| parents | 51a232faeb27 |
| children |
line source
1 #!/usr/bin/perl
3 use strict;
4 use CGI qw(:standard);
5 use utf8;
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 };
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;
21 sub count_command_lines($);
23 my $print="";
24 my $path = $ENV{PATH_INFO};
25 remove_extra_slashes_from($path);
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;
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"} ;
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 }
68 my $data_file = "data.xml";
70 path_is_correct($path)
71 or error ("Путь $path содержит недопустимые символы или комбинации символов.");
73 $real_path .= $path;
74 remove_extra_slashes_from($real_path);
76 # Чувак, ты хотел бы посмотреть на журнал $path
77 # Он должен находиться в каталоге $real_path файловой системы\n";
79 (-d $real_path)
80 or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
82 if (-e $real_path."/$data_file") {
84 # В каталоге есть файл $data_file
85 # Отлично! Сейчас будем показывать журнал
87 # Если существуют html и xml файлы,
88 # html файл новее чем xml,
89 # и CGI-скрипту не передано дополнительных параметров,
90 # используем html файл, иначе перегенируем его
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]) {
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 }
111 {
112 local $/;
113 open(HTML, "<:utf8", "$real_path/index$page_id.html");
114 my $html = <HTML>;
116 # Добавим в начало документа навигационную строку
117 my $nav_bar = nav_bar;
118 $html =~ s/(<body[^>]*>)/$1$nav_bar/;
120 $print .= $html;
121 close(HTML);
122 }
124 }
125 else {
127 # В этом каталоге нет файла data.xml
128 # Но в нём должны быть подкаталоги!
129 # Если и их тут нет, то тут вообще делать нечего
131 $print .= nav_bar;
133 my @dirs = glob("$real_path/*");
134 my $folder_link = "$cgi_path/$path";
135 remove_extra_slashes_from($folder_link);
137 $folder_link =~ s@/[^\/]*/?$@@;
138 if ($folder_link) {
139 $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
140 }
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 }
150 $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
151 .$print
152 .print_footer;
153 };
155 binmode STDOUT, ":utf8";
156 print header(-charset => "utf-8");
157 print $print;
158 exit(0);
160 #----------------------------------------------
163 sub error($)
164 {
165 my $message = $_[0];
167 binmode STDOUT, ":utf8";
168 print header(-charset => "utf-8");
170 my $print = "<h2>Извините, произошла ошибка</h2>";
171 $print .= $message;
173 print $print;
174 exit(0);
175 }
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 }
186 sub remove_extra_slashes_from($)
187 {
188 while ($_[0] =~ s@//@/@g) {1;};
189 return $_[0];
190 }
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 }
203 sub print_footer()
204 {
205 "</html>";
206 }
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 }
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 }