lilalo

annotate l3-cgi @ 86:3058ada85a58

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