lilalo

view l3-cgi @ 100:2c00c61f2d7b

find changesets by author, revision, files, or words in the commit message
Коммичу изменения, но сам не знаю зачем.
Нужно l3-cgi переписать вообще с нуля.
Он мерзкий.

И продумать нужно, как он вообще должен работать.
Понятно, приблизительно, как он должен показывать журнал,
когда до него уже дошли,
но вот если не дошли, то что делать не понятно.
Короче, продумать систему навигации.
author devi
date Wed Jun 14 21:37:22 2006 +0300 (2006-06-14)
parents 62001c1e3295
children 54fbf2041159
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("/home/devi/cvs/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
122 if (!$host || $host eq "index") {
123 # Нам неизвестен курс или явно указан просмотр индекса
124 # Просматриваем его
125 my $t;
126 if ( -e "/var/lilalo/lablogs-xml/$training/class.xml" ) {
127 $t = load_training("/var/lilalo/lablogs-xml/$training/class.xml");
128 }
129 else {
130 $l3config::Config{class}=$training;
131 $t = load_training;
132 }
133 $training ||= "current";
134
135 my $prefix = "/cgi-bin/l3/$training/";
136 my $suffix = "";
137 if ($is_not_cgi) {
138 $prefix = "";
139 $suffix = ".html";
140 }
141 my $path = $to_file;
142 $path = "" unless $path =~ s@/[^/]*$@@;
143
144 $print .= "<html>\n";
145 $print .= "<head>\n";
146 $print .= "<title>Журналы лабораторных работ</title>\n";
147 $print .= "<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />";
148 $print .= "<link rel='stylesheet' href='".$l3config::Config{frontend_css}."' type='text/css'/>\n";
149 $print .= "</head>\n";
150 $print .= "<body>\n";
151 $print .= "<h1>Журналы лабораторных работ</h1>\n";
152 $print .= "<table>\n";
153 $print .= "<tr class='table_header'>\n";
154 $print .= "<td>"."Имя"."</td>";
155 $print .= "<td>Хост</td>";
156 $print .= "<td colspan='3'>Пользователь</td>";
157 $print .= "</tr>\n";
158 for my $host (sort keys %{$t->{host}}) {
159 $print .= "<tr>\n";
160 my $h = $t->{host}->{$host};
161 $print .= "<td>".$h->{firstname}." ".$h->{surname}."</td>";
162 $print .= "<td>$host</td>";
163 $print .= "<td><a href='".$prefix.$host."/root$suffix'>root</a></td>";
164 $print .= "<td><a href='".$prefix.$host."/".$h->{user}."$suffix'>".$h->{user}."</a></td>";
165 $print .= "<td><a href='".$prefix.$host."$suffix'>все</a></td>" if not $is_not_cgi;
166 $print .= "</td>\n";
167 $print .= "</tr>\n";
168
169 if ($is_not_cgi) {
170 # Это грязный хак
171 # Если мы чувствуем, что нас вызывают для генерения индексного файла,
172 # нам нужно создать и файлы, на которые он указывает
173 # Лучше было бы это сделать хотя бы через вызов функций
174 # Такой же хак чуть ниже
175 mkdir("$path/$host");
176 system("$0 --cgi2file $path/$prefix$host/root$suffix ".
177 "--cgi_path_info ".$training."/".$host."/root ".
178 "--frontend_css ../$l3config::Config{frontend_css}");
179 system("$0 --cgi2file $path/$prefix$host/".$h->{user}."$suffix ".
180 "--cgi_path_info ".$training."/".$host."/".$h->{user}." ".
181 "--frontend_css ../$l3config::Config{frontend_css}");
182 # system("$0 --cgi2file $path/$prefix$host$suffix ".
183 # "--cgi_path_info ".$training."/".$host." ".
184 # "--frontend_css ../$l3config::Config{frontend_css}");
185 }
186
187 }
188 # Такой же хак был чуть выше
189 if ($is_not_cgi) {
190 # $print .= "<td><a href='".$prefix."instructor.".$suffix."'>все</a></td>";
191 # system("$0 --cgi2file $path/$prefix$host$suffix"
192 # . " --cgi_path_info ".$training."?login_from=192.168.15.254".$host
193 # . " --frontend_css ../$l3config::Config{frontend_css}");
194 }
195 else {
196 $print .= "<tr>\n";
197 $print .= "<td>"."Инструктор"."</td>";
198 $print .= "<td>from linux.nt</td>";
199 $print .= "<td/>";
200 $print .= "<td/>";
201 $print .= "<td><a href='$training"."?login_from=192.168.15.254'>все</a></td>";
202 }
203 $print .= "</tr>\n";
204 $print .= "</table>\n";
205 $print .= "</body>\n";
206 $print .= "</html>\n";
207 }
208 else {
209
210
211 my @args=(
212 "--output" => "-",
213 "--show_comments" => "no",
214 );
215
216 $l3config::Config{"class"}=$training if $training ne 'current';
217 if ( -e "/var/lilalo/lablogs-xml/$training/class.xml" ) {
218 $XMLTraining = load_training("/var/lilalo/lablogs-xml/$training/class.xml");
219 }
220 else {
221 $XMLTraining = load_training;
222 }
223
224 if ($XMLTraining) {
225 my @args=(
226 "--course-center" => $XMLTraining->{center},
227 "--course-trainer" => $XMLTraining->{instructor}->{firstname}." ".$XMLTraining->{instructor}->{surname},
228 "--course-student" => $XMLTraining->{host}->{$host}->{firstname}." ".$XMLTraining->{host}->{$host}->{surname},
229 "--course-code" => $XMLTraining->{course},
230 "--course-date" => $XMLTraining->{date},
231 "--encoding" => $XMLTraining->{host}->{$host}->{charset},
232 );
233 if ($XMLTraining->{"course-name"}) {
234 push @args, ("--course-name" => $XMLTraining->{"course-name"});
235 };
236 }
237 if ($training ne 'current') {
238 push @args, ("--backend_datafile" => "/var/lilalo/lablogs-xml/$training/$host/$user.xml");
239 } else {
240 $filter{hostname} = $host if $host;
241 $filter{user} = $user if $user;
242 }
243 push @args, ("--filter" => join ("&", (map("$_=$filter{$_}", keys %filter))));
244
245 #$print .= "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |<br/>";
246 open (FRONTEND, "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |");
247 binmode FRONTEND, ":utf8";
248 while (<FRONTEND>) {
249 $print .= $_;
250 }
251 close(FRONTEND);
252 }
253 }
254
255 # Если задана переменная окружения l3_to_file,
256 # печатаем в файл с соответствующим именем,
257 # в противном случае -- выводим на стандартный поток вывода
258 if (not $to_file) {
259 binmode STDOUT, ":utf8";
260 print header(-charset => "utf-8");
261 print $print;
262 }
263 else {
264 open(FILE, ">:utf8", $to_file)
265 or die "Can't open $to_file for writing";
266 print FILE $print;
267 close(FILE);
268 }
269
270