lilalo
view l3-cgi-lite @ 144:1cbdfdde1274
mass upload
| author | igor@book.xt.vpn |
|---|---|
| date | Mon Dec 15 22:47:03 2008 +0200 (2008-12-15) |
| parents | c48bd05dca85 |
| children | 822b36252d7f |
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 l3config;
10 l3config::init_config();
11 };
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;
20 sub count_command_lines($);
22 my $print="";
23 my $path = $ENV{PATH_INFO};
24 remove_extra_slashes_from($path);
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 }
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"} ;
40 my $filter=$ENV{QUERY_STRING};
41 if ($filter =~ /page=([^&]*)/ ) {
42 open(PAGE_NAME, "grep $1 $real_path/sessions-index | tail -1 | sed 's^-<.*^^; s^/[^/]*\$^^'| ");
43 my $page_name;
44 $page_name=<PAGE_NAME>;
45 chomp $page_name;
46 my $id="";
47 if ($filter =~ /id=([^&]*)/) {
48 $id="#$1";
49 }
50 print "Status: 302 Moved\nLocation: http://xgu.ru/l3/$page_name$id\n\n";
51 exit(0);
52 }
53 elsif ($filter !~ /filter=/) {
54 # $filter="";
55 }
56 else {
57 $filter =~ s@.*filter=@@;
58 $filter =~ s@\&.*@@;
59 }
61 my $data_file = "data.xml";
63 path_is_correct($path)
64 or error ("Путь $path содержит недопустимые символы или комбинации символов.");
66 $real_path .= $path;
67 remove_extra_slashes_from($real_path);
69 # Чувак, ты хотел бы посмотреть на журнал $path
70 # Он должен находиться в каталоге $real_path файловой системы\n";
72 (-d $real_path)
73 or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
75 if (-e $real_path."/$data_file") {
77 # В каталоге есть файл $data_file
78 # Отлично! Сейчас будем показывать журнал
80 # Если существуют html и xml файлы,
81 # html файл новее чем xml,
82 # и CGI-скрипту не передано дополнительных параметров,
83 # используем html файл, иначе перегенируем его
85 unless ( -e "$real_path/$data_file"
86 && -e "$real_path/index.html"
87 && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] && 0!=0 ) {
89 my $l3_frontend = "l3-frontend --backend_datafile $real_path/$data_file".
90 " --output $real_path/index.html".
91 " --start_from_command $start_from_command ".
92 " --filter '$filter'";
93 system($l3_frontend) == 0
94 or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
95 }
97 {
98 local $/;
99 open(HTML, "<:utf8", "$real_path/index.html");
100 my $html = <HTML>;
102 # Добавим в начало документа навигационную строку
103 my $nav_bar = nav_bar;
104 $html =~ s/(<body[^>]*>)/$1$nav_bar/;
106 $print .= $html;
107 close(HTML);
108 }
110 }
111 else {
113 # В этом каталоге нет файла data.xml
114 # Но в нём должны быть подкаталоги!
115 # Если и их тут нет, то тут вообще делать нечего
117 $print .= nav_bar;
119 my @dirs = glob("$real_path/*");
120 my $folder_link = "$cgi_path/$path";
121 remove_extra_slashes_from($folder_link);
123 $folder_link =~ s@/[^\/]*/?$@@;
124 if ($folder_link) {
125 $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
126 }
128 for my $dir (@dirs) {
129 next unless (-d $dir);
130 my ($folder_name) = $dir =~ m@.*/(.*)@;
131 $folder_link = "$cgi_path/$path/$folder_name";
132 $folder_link =~ s@//@/@g;
133 $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
134 }
136 $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
137 .$print
138 .print_footer;
139 };
141 binmode STDOUT, ":utf8";
142 print header(-charset => "utf-8");
143 print $print;
144 exit(0);
146 #----------------------------------------------
149 sub error($)
150 {
151 my $message = $_[0];
153 binmode STDOUT, ":utf8";
154 print header(-charset => "utf-8");
156 my $print = "<h2>Извините, произошла ошибка</h2>";
157 $print .= $message;
159 print $print;
160 exit(0);
161 }
164 sub path_is_correct($)
165 {
166 my $path = $_[0];
167 # return 0 if $path =~ m@/../@;
168 return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
169 return 1;
170 }
172 sub remove_extra_slashes_from($)
173 {
174 while ($_[0] =~ s@//@/@g) {1;};
175 return $_[0];
176 }
178 sub print_header($)
179 {
180 my $title = $_[0];
181 "<html>"
182 ."<head>"
183 ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
184 ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
185 ."<title>$title</title>"
186 ."</head>"
187 }
189 sub print_footer()
190 {
191 "</html>";
192 }
194 sub nav_bar()
195 {
196 my $nav_bar="";
197 my $skip_first=1;
198 my $current_path="";
199 for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
200 if ($skip_first) {
201 $skip_first--;
202 next;
203 }
204 $current_path .= "/$path_part";
205 $nav_bar .= "/<a href='$current_path'>$path_part</a>";
206 }
207 my $pages=int(count_command_lines("$real_path/$data_file")/$commands_to_show_at_a_go)+1;
208 my $i=1;
209 while ($i<$pages) {
210 if ($i==$this_page_number) {
211 $nav_bar .= " <b>:$i</b>";
212 }
213 else {
214 $nav_bar .= " <a href='$current_path:$i'>:$i</a>";
215 }
216 $i++;
217 }
218 $filter = "($filter)" if $filter;
219 return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar $filter</td></tr></table>";
220 }
222 sub count_command_lines($)
223 #
224 # Считает количество строк в файле с данными
225 # Грязный временный хак
226 #
227 {
228 my $filename= $_[0];
229 return int(`grep '<command>' $filename |wc -l`);
230 # return $filename;
231 }