lilalo

view l3-cgi @ 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 54fbf2041159
children
line source
1 #!/usr/bin/perl
2
3 use strict;
4 use CGI qw(:standard);
5 use XML::Simple;
6 use utf8;
7
8 BEGIN {
9 chdir("/etc/lilalo");
10 require l3config;
11 l3config::init_config();
12 };
13
14 my %filter;
15
16 for my $key (qw(login_from local_session_id action)) {
17 $filter{$key} = param($key) if param($key);
18 $filter{$key} = $ENV{$key} if defined $ENV{$key};
19 }
20
21 my %Trainings;
22 my $XMLTraining;
23 my %Machines;
24 my $print = "";
25
26 $l3config::Config{cgi2file} = $ENV{cgi2file} if defined($ENV{cgi2file});
27 $ENV{PATH_INFO} = $l3config::Config{cgi_path_info} if $l3config::Config{cgi_path_info};
28
29 my $is_not_cgi="";
30 $is_not_cgi = "1" if $l3config::Config{cgi2file};
31 # Пока что мы считаем, что вызов выполняется через CGI,
32 # если не установлена переменная cgi2file
33 # и не передан такой аргумент командной строки.
34 # Это неверно, но как временное решение - пойдёт
35 my $to_file = $l3config::Config{cgi2file};
36
37 $l3config::Config{frontend_css} =~ s@^/@@ if $is_not_cgi;
38
39 sub load_training
40 {
41 my $training_file;
42
43 $training_file = $_[0] || $l3config::Config{"classfile"} ||
44 $l3config::Config{"path_classes"}.$l3config::Config{"class"}.$l3config::Config{"class_suffix"};
45
46 my $XMLTraining = XMLin($training_file , ForceArray => [ 'student' ] )
47 or die "Can't open file of the training ",$training_file,"\n";
48
49 my $course_file = $l3config::Config{"courses_path"}.$XMLTraining->{"course"}.".xml";
50 my $XMLCourse;
51 if (eval{$XMLCourse = XMLin($course_file)}) {
52 $XMLTraining->{"course-name"} = $XMLCourse->{"fullname"};
53 }
54
55 for my $student (@{$XMLTraining->{"student"}}) {
56 $XMLTraining->{host}->{$student->{"host"}}=$student;
57 }
58 return $XMLTraining;
59 }
60
61
62
63 if ($ENV{PATH_INFO} eq "/index") {
64 # Показываем индекс курсов
65 my @training_files = glob($l3config::Config{"path_classes"}."/2*".$l3config::Config{"class_suffix"});
66 if (@training_files) {
67 for my $training_file (@training_files) {
68 $training_file =~ s@.*/@@;
69 $training_file =~ s@$l3config::Config{"class_suffix"}$@@;
70 my $training = load_training($training_file);
71 $Trainings{$training->{"date"}}=$training;
72 }
73 $print .= "<html>\n";
74 $print .= "<head>\n";
75 $print .= "<title>Журналы лабораторных работ</title>\n";
76 $print .= "</head>\n";
77 $print .= "<body>\n";
78 $print .= "<table>\n";
79 for my $tdate (reverse sort keys %Trainings) {
80 my $t = $Trainings{$tdate};
81 $print .= "<tr>";
82 $print .= "<td>".$t->{date}."</td>";
83 $print .= "<td colspan='7'>".$t->{course}."</td>";
84 $print .= "</tr>\n";
85 for my $host (sort keys %{$t->{host}}) {
86 my %row;
87 my @row_keys = qw{
88 name email company host root user
89 };
90 my $h = $t->{host}->{$host};
91 $row{name}= $h->{firstname}." ".$h->{surname};
92 $row{email}= $h->{email};
93 $row{company} = $h->{company};
94 $row{host} = "$host";
95 $row{root} = "<a href='/cgi-bin/l3/".$tdate."/".$host."/root'>root</a> ";
96 $row{user} = "<a href='/cgi-bin/l3/".$tdate."/".$host."/".$h->{user}."'>".$h->{user}."</a> ";
97 $print .= "<tr>".join("", map("<td style='$_'>$row{$_}</td>", @row_keys))."</tr>";
98 }
99 }
100 $print .= "</table>\n";
101 $print .= "</body>\n";
102 $print .= "</html>\n";
103 }
104 else {
105 $print .= "No training-files found<br/>\n";
106 $print .= "Template to load files: ".$l3config::Config{"path_classes"}."*".$l3config::Config{"class_suffix"}."\n"
107 }
108 }
109 elsif ($ENV{PATH_INFO} eq "/current") {
110 open (FRONTEND, "./l3-frontend --output - --show_comments no --frontend_css $l3config::Config{frontend_css}|");
111 binmode FRONTEND, ":utf8";
112 while (<FRONTEND>) {
113 $print .= $_;
114 }
115 close(FRONTEND);
116 }
117 else {
118 # Вызов производится по URL
119 $ENV{PATH_INFO} = "/".$ENV{PATH_INFO} unless $ENV{PATH_INFO} =~ m@^/@;
120 #my ($skip, $training, $host, $user) = split /\//,$ENV{PATH_INFO},4;
121 my ($skip, $training, $host, $user) = split /\//,$ENV{PATH_INFO},4;
122
123
124 if (!$host || $host eq "index") {
125 # Нам неизвестен курс или явно указан просмотр индекса
126 # Просматриваем его
127 my $t;
128 if ( -e "/var/lilalo/lablogs-xml/$training/class.xml" ) {
129 $t = load_training("/var/lilalo/lablogs-xml/$training/class.xml");
130 }
131 else {
132 $l3config::Config{class}=$training;
133 $t = load_training;
134 }
135 $training ||= "current";
136
137 my $prefix = "/cgi-bin/l3/$training/";
138 my $suffix = "";
139 if ($is_not_cgi) {
140 $prefix = "";
141 $suffix = ".html";
142 }
143 my $path = $to_file;
144 $path = "" unless $path =~ s@/[^/]*$@@;
145
146 $print .= "<html>\n";
147 $print .= "<head>\n";
148 $print .= "<title>Журналы лабораторных работ</title>\n";
149 $print .= "<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />";
150 $print .= "<link rel='stylesheet' href='".$l3config::Config{frontend_css}."' type='text/css'/>\n";
151 $print .= "</head>\n";
152 $print .= "<body>\n";
153 $print .= "<h1>Журналы лабораторных работ</h1>\n";
154 $print .= "<table>\n";
155 $print .= "<tr class='table_header'>\n";
156 $print .= "<td>"."Имя"."</td>";
157 $print .= "<td>Хост</td>";
158 $print .= "<td colspan='3'>Пользователь</td>";
159 $print .= "</tr>\n";
160 for my $host (sort keys %{$t->{host}}) {
161 $print .= "<tr>\n";
162 my $h = $t->{host}->{$host};
163 $print .= "<td>".$h->{firstname}." ".$h->{surname}."</td>";
164 $print .= "<td>$host</td>";
165 $print .= "<td><a href='".$prefix.$host."/root$suffix'>root</a></td>";
166 $print .= "<td><a href='".$prefix.$host."/".$h->{user}."$suffix'>".$h->{user}."</a></td>";
167 $print .= "<td><a href='".$prefix.$host."$suffix'>все</a></td>" if not $is_not_cgi;
168 $print .= "</td>\n";
169 $print .= "</tr>\n";
170
171 if ($is_not_cgi) {
172 # Это грязный хак
173 # Если мы чувствуем, что нас вызывают для генерения индексного файла,
174 # нам нужно создать и файлы, на которые он указывает
175 # Лучше было бы это сделать хотя бы через вызов функций
176 # Такой же хак чуть ниже
177 mkdir("$path/$host");
178 system("$0 --cgi2file $path/$prefix$host/root$suffix ".
179 "--cgi_path_info ".$training."/".$host."/root ".
180 "--frontend_css ../$l3config::Config{frontend_css}");
181 system("$0 --cgi2file $path/$prefix$host/".$h->{user}."$suffix ".
182 "--cgi_path_info ".$training."/".$host."/".$h->{user}." ".
183 "--frontend_css ../$l3config::Config{frontend_css}");
184 # system("$0 --cgi2file $path/$prefix$host$suffix ".
185 # "--cgi_path_info ".$training."/".$host." ".
186 # "--frontend_css ../$l3config::Config{frontend_css}");
187 }
188
189 }
190 # Такой же хак был чуть выше
191 if ($is_not_cgi) {
192 # $print .= "<td><a href='".$prefix."instructor.".$suffix."'>все</a></td>";
193 # system("$0 --cgi2file $path/$prefix$host$suffix"
194 # . " --cgi_path_info ".$training."?login_from=192.168.15.254".$host
195 # . " --frontend_css ../$l3config::Config{frontend_css}");
196 }
197 else {
198 $print .= "<tr>\n";
199 $print .= "<td>"."Инструктор"."</td>";
200 $print .= "<td>from linux.nt</td>";
201 $print .= "<td/>";
202 $print .= "<td/>";
203 $print .= "<td><a href='$training"."?login_from=192.168.15.254'>все</a></td>";
204 }
205 $print .= "</tr>\n";
206 $print .= "</table>\n";
207 $print .= "</body>\n";
208 $print .= "</html>\n";
209 }
210 else {
211
212
213 my @args=(
214 "--output" => "-",
215 "--show_comments" => "no",
216 );
217
218 $l3config::Config{"class"}=$training if $training ne 'current';
219 if ( -e "/var/lilalo/lablogs-xml/$training/class.xml" ) {
220 $XMLTraining = load_training("/var/lilalo/lablogs-xml/$training/class.xml");
221 }
222 else {
223 $XMLTraining = load_training;
224 }
225
226 if ($XMLTraining) {
227 my @args=(
228 "--course-center" => $XMLTraining->{center},
229 "--course-trainer" => $XMLTraining->{instructor}->{firstname}." ".$XMLTraining->{instructor}->{surname},
230 "--course-student" => $XMLTraining->{host}->{$host}->{firstname}." ".$XMLTraining->{host}->{$host}->{surname},
231 "--course-code" => $XMLTraining->{course},
232 "--course-date" => $XMLTraining->{date},
233 "--encoding" => $XMLTraining->{host}->{$host}->{charset},
234 );
235 if ($XMLTraining->{"course-name"}) {
236 push @args, ("--course-name" => $XMLTraining->{"course-name"});
237 };
238 }
239 if ($training ne 'current') {
240 push @args, ("--backend_datafile" => "/var/lilalo/lablogs-xml/$training/$host/$user.xml");
241 } else {
242 $filter{hostname} = $host if $host;
243 $filter{user} = $user if $user;
244 }
245 push @args, ("--filter" => join ("&", (map("$_=$filter{$_}", keys %filter))));
246
247 #$print .= "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |<br/>";
248 open (FRONTEND, "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |");
249 binmode FRONTEND, ":utf8";
250 while (<FRONTEND>) {
251 $print .= $_;
252 }
253 close(FRONTEND);
254 }
255 }
256
257 # Если задана переменная окружения l3_to_file,
258 # печатаем в файл с соответствующим именем,
259 # в противном случае -- выводим на стандартный поток вывода
260 if (not $to_file) {
261 binmode STDOUT, ":utf8";
262 print header(-charset => "utf-8");
263 print $print;
264 }
265 else {
266 open(FILE, ">:utf8", $to_file)
267 or die "Can't open $to_file for writing";
268 print FILE $print;
269 close(FILE);
270 }
271
272