lilalo

view l3-cgi-lite @ 115:9e6359b7ad55

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