lilalo

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