lilalo

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