| 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@30
 | 
     9 	chdir("/home/devi/cvs/lilalo");
 | 
| 
devi@30
 | 
    10 	require l3config;
 | 
| 
devi@30
 | 
    11 };
 | 
| 
devi@27
 | 
    12 
 | 
| 
devi@37
 | 
    13 my %filter;
 | 
| 
devi@32
 | 
    14 
 | 
| 
devi@37
 | 
    15 for my $key (qw(login_from)) {
 | 
| 
devi@37
 | 
    16 	$filter{$key} =  param($key) if param($key);
 | 
| 
devi@42
 | 
    17 	$filter{$key} = $ENV{$key} if defined $ENV{$key};
 | 
| 
devi@32
 | 
    18 }
 | 
| 
devi@27
 | 
    19 
 | 
| 
devi@30
 | 
    20 my %Trainings;
 | 
| 
devi@30
 | 
    21 my $XMLTraining;
 | 
| 
devi@30
 | 
    22 my %Machines;
 | 
| 
devi@42
 | 
    23 my $print = "";
 | 
| 
devi@30
 | 
    24 
 | 
| 
devi@47
 | 
    25 my $is_not_cgi="";
 | 
| 
devi@47
 | 
    26 $is_not_cgi = "1" if defined($ENV{l3_to_file});
 | 
| 
devi@47
 | 
    27 # Пока что мы считаем, что вызов выполняется через CGI, 
 | 
| 
devi@47
 | 
    28 # если не установлена переменная l3_to_file 
 | 
| 
devi@47
 | 
    29 # Это неверно, но как временное решение - пойдёт
 | 
| 
devi@47
 | 
    30 
 | 
| 
devi@47
 | 
    31 $l3config::Config{frontend_css} =~ s@^/@@ if $is_not_cgi;
 | 
| 
devi@47
 | 
    32 
 | 
| 
devi@30
 | 
    33 sub load_training
 | 
| 
devi@30
 | 
    34 {
 | 
| 
devi@30
 | 
    35         my $classfile = 
 | 
| 
devi@30
 | 
    36 	$_[0]||
 | 
| 
devi@30
 | 
    37         $l3config::Config{"classfile"} || 
 | 
| 
devi@30
 | 
    38         $l3config::Config{"path_classes"}."/".$l3config::Config{"class"}.$l3config::Config{"class_suffix"};
 | 
| 
devi@30
 | 
    39 
 | 
| 
devi@30
 | 
    40         my $XMLTraining = XMLin($classfile , ForceArray => [ 'student' ] )  
 | 
| 
devi@32
 | 
    41                 or die "Can't open file of the training ",$classfile,"\n";
 | 
| 
devi@30
 | 
    42 
 | 
| 
devi@30
 | 
    43         for my $student (@{$XMLTraining->{"student"}}) {
 | 
| 
devi@30
 | 
    44 		$XMLTraining->{host}->{$student->{"host"}}=$student;
 | 
| 
devi@30
 | 
    45         }
 | 
| 
devi@30
 | 
    46 	return $XMLTraining;
 | 
| 
devi@30
 | 
    47 }
 | 
| 
devi@30
 | 
    48 
 | 
| 
devi@29
 | 
    49 
 | 
| 
devi@29
 | 
    50 
 | 
| 
devi@30
 | 
    51 if ($ENV{PATH_INFO} eq "/index") {
 | 
| 
devi@30
 | 
    52 	# Показываем индекс курсов
 | 
| 
devi@30
 | 
    53 	my @training_files = glob($l3config::Config{"path_classes"}."/*".$l3config::Config{"class_suffix"});
 | 
| 
devi@30
 | 
    54 	if (@training_files) {
 | 
| 
devi@30
 | 
    55 		for my $training_file (@training_files) {
 | 
| 
devi@30
 | 
    56 			my $training = load_training($training_file);
 | 
| 
devi@30
 | 
    57 			$Trainings{$training->{"date"}}=$training;
 | 
| 
devi@30
 | 
    58 		}
 | 
| 
devi@42
 | 
    59 		$print .= "<html>\n";
 | 
| 
devi@42
 | 
    60 		$print .= "<head>\n";
 | 
| 
devi@42
 | 
    61 		$print .= "<title>Журналы лабораторных работ</title>\n";
 | 
| 
devi@42
 | 
    62 		$print .= "</head>\n";
 | 
| 
devi@42
 | 
    63 		$print .= "<body>\n";
 | 
| 
devi@42
 | 
    64 		$print .= "<table>\n";
 | 
| 
devi@30
 | 
    65 		for my $tdate (reverse sort keys %Trainings) {
 | 
| 
devi@30
 | 
    66 			my $t = $Trainings{$tdate};
 | 
| 
devi@42
 | 
    67 			$print .= "<tr>";
 | 
| 
devi@42
 | 
    68 			$print .= "<td>".$t->{date}."</td>";
 | 
| 
devi@42
 | 
    69 			$print .= "<td>".$t->{course}."</td>";
 | 
| 
devi@42
 | 
    70 			$print .= "</tr>\n";
 | 
| 
devi@42
 | 
    71 			$print .= "<tr>";
 | 
| 
devi@42
 | 
    72 			$print .= "<td/>";
 | 
| 
devi@42
 | 
    73 			$print .= "<td><pre>";
 | 
| 
devi@30
 | 
    74 			for my $host (sort keys %{$t->{host}}) {
 | 
| 
devi@30
 | 
    75 				my $h = $t->{host}->{$host};
 | 
| 
devi@42
 | 
    76 				$print .= "$host";
 | 
| 
devi@42
 | 
    77 				$print .= " ".$h->{firstname}." ".$h->{surname}." ";
 | 
| 
devi@42
 | 
    78 				$print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/root'>root</a> ";
 | 
| 
devi@42
 | 
    79 				$print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/".$h->{user}."'>".$h->{user}."</a> ";
 | 
| 
devi@42
 | 
    80 				$print .= "\n";
 | 
| 
devi@30
 | 
    81 			}
 | 
| 
devi@42
 | 
    82 			$print .= "</pre><td>";
 | 
| 
devi@42
 | 
    83 			$print .= "</tr>\n";
 | 
| 
devi@30
 | 
    84 		}
 | 
| 
devi@42
 | 
    85 		$print .= "</table>\n";
 | 
| 
devi@42
 | 
    86 		$print .= "</body>\n";
 | 
| 
devi@42
 | 
    87 		$print .= "</html>\n";
 | 
| 
devi@30
 | 
    88 	}
 | 
| 
devi@30
 | 
    89 	else {
 | 
| 
devi@42
 | 
    90 		$print .= "No training-files found<br/>\n";
 | 
| 
devi@42
 | 
    91 		$print .= "Template to load files: ".$l3config::Config{"path_classes"}."*".$l3config::Config{"class_suffix"}."\n"
 | 
| 
devi@30
 | 
    92 	}
 | 
| 
devi@30
 | 
    93 }
 | 
| 
devi@33
 | 
    94 elsif ($ENV{PATH_INFO} eq "/current/index" || $ENV{PATH_INFO} eq "") {
 | 
| 
devi@33
 | 
    95 	my $t = load_training();
 | 
| 
devi@39
 | 
    96 
 | 
| 
devi@42
 | 
    97 	$print .= "<html>\n";
 | 
| 
devi@42
 | 
    98 	$print .= "<head>\n";
 | 
| 
devi@42
 | 
    99 	$print .= "<title>Журналы лабораторных работ</title>\n";
 | 
| 
devi@42
 | 
   100 	$print .= "<link rel='stylesheet' href='".$l3config::Config{frontend_css}."' type='text/css'/>\n";
 | 
| 
devi@42
 | 
   101 	$print .= "</head>\n";
 | 
| 
devi@42
 | 
   102 	$print .= "<body>\n";
 | 
| 
devi@42
 | 
   103 	$print .= "<h1>Журналы лабораторных работ</h1>\n";
 | 
| 
devi@42
 | 
   104 	$print .= "<table>\n";
 | 
| 
devi@42
 | 
   105 	$print .= "<tr class='table_header'>\n";
 | 
| 
devi@42
 | 
   106 	$print .= "<td>"."Имя"."</td>";
 | 
| 
devi@42
 | 
   107 	$print .= "<td>Хост</td>";
 | 
| 
devi@42
 | 
   108 	$print .= "<td colspan='3'>Пользователь</td>";
 | 
| 
devi@42
 | 
   109 	$print .= "</tr>\n";
 | 
| 
devi@33
 | 
   110 	for my $host (sort keys %{$t->{host}}) {
 | 
| 
devi@41
 | 
   111 
 | 
| 
devi@41
 | 
   112 		my $prefix = "/cgi-bin/l3/current/";
 | 
| 
devi@41
 | 
   113 		my $suffix = "";
 | 
| 
devi@47
 | 
   114 		if ($is_not_cgi) {
 | 
| 
devi@47
 | 
   115 			$prefix = "";
 | 
| 
devi@47
 | 
   116 			$suffix = ".html";
 | 
| 
devi@47
 | 
   117 		}
 | 
| 
devi@41
 | 
   118 		
 | 
| 
devi@42
 | 
   119 		$print .= "<tr>\n";
 | 
| 
devi@33
 | 
   120 		my $h = $t->{host}->{$host};
 | 
| 
devi@42
 | 
   121 		$print .= "<td>".$h->{firstname}." ".$h->{surname}."</td>";
 | 
| 
devi@42
 | 
   122 		$print .= "<td>$host</td>";
 | 
| 
devi@42
 | 
   123 		$print .= "<td><a href='".$prefix.$host."/root$suffix'>root</a></td>";
 | 
| 
devi@42
 | 
   124 		$print .= "<td><a href='".$prefix.$host."/".$h->{user}."$suffix'>".$h->{user}."</a></td>";
 | 
| 
devi@42
 | 
   125 		$print .= "<td><a href='".$prefix.$host."$suffix'>все</a></td>";
 | 
| 
devi@42
 | 
   126 		$print .= "</td>\n";
 | 
| 
devi@42
 | 
   127 		$print .= "</tr>\n";
 | 
| 
devi@33
 | 
   128 	}
 | 
| 
devi@42
 | 
   129 	$print .= "<tr>\n";
 | 
| 
devi@42
 | 
   130 	$print .= "<td>"."Инструктор"."</td>";
 | 
| 
devi@42
 | 
   131 	$print .= "<td>from linux.nt</td>";
 | 
| 
devi@42
 | 
   132 	$print .= "<td/>";
 | 
| 
devi@42
 | 
   133 	$print .= "<td/>";
 | 
| 
devi@42
 | 
   134 	$print .= "<td><a href='/cgi-bin/l3/current"."?login_from=192.168.15.254'>все</a></td>";
 | 
| 
devi@42
 | 
   135 	$print .= "</tr>\n";
 | 
| 
devi@42
 | 
   136 	$print .= "</table>\n";
 | 
| 
devi@42
 | 
   137 	$print .= "</body>\n";
 | 
| 
devi@42
 | 
   138 	$print .= "</html>\n";
 | 
| 
devi@33
 | 
   139 }
 | 
| 
devi@31
 | 
   140 elsif ($ENV{PATH_INFO} eq "/current") {
 | 
| 
devi@31
 | 
   141 	open (FRONTEND, "./l3-frontend --output - --show_comments no |");
 | 
| 
devi@31
 | 
   142 	while (<FRONTEND>) {
 | 
| 
devi@43
 | 
   143 		$print .= $_;
 | 
| 
devi@31
 | 
   144 	}
 | 
| 
devi@31
 | 
   145 	close(FRONTEND);
 | 
| 
devi@31
 | 
   146 }
 | 
| 
devi@30
 | 
   147 else {
 | 
| 
devi@30
 | 
   148 	# Вызов производится по URL
 | 
| 
devi@30
 | 
   149 	my ($skip, $course, $host, $user) = split /\//,$ENV{PATH_INFO},4;
 | 
| 
devi@29
 | 
   150 
 | 
| 
devi@32
 | 
   151 	$l3config::Config{"class"}=$course if $course ne 'current';
 | 
| 
devi@30
 | 
   152 	$XMLTraining = load_training;
 | 
| 
devi@30
 | 
   153 
 | 
| 
devi@30
 | 
   154 	my @args=(
 | 
| 
devi@30
 | 
   155 		"--output" 		=>	"-",
 | 
| 
devi@30
 | 
   156 		"--show_comments" 	=>	"no",
 | 
| 
devi@30
 | 
   157 		"--course-center"	=>	$XMLTraining->{center},
 | 
| 
devi@30
 | 
   158 		"--course-trainer"	=>	$XMLTraining->{instructor}->{firstname}." ".$XMLTraining->{instructor}->{surname},
 | 
| 
devi@30
 | 
   159 		"--course-student"	=>	$XMLTraining->{host}->{$host}->{firstname}." ".$XMLTraining->{host}->{$host}->{surname},
 | 
| 
devi@30
 | 
   160 		"--course-code"		=>	$XMLTraining->{course},
 | 
| 
devi@30
 | 
   161 		"--course-date"		=>	$XMLTraining->{date},
 | 
| 
devi@31
 | 
   162 		"--encoding"		=>	$XMLTraining->{host}->{$host}->{charset},
 | 
| 
devi@30
 | 
   163 	);
 | 
| 
devi@32
 | 
   164 	if ($course ne 'current') {
 | 
| 
devi@32
 | 
   165 		push @args, 	("--backend_datafile"	=>	"/var/lilalo/lablogs-xml/$course/$host/$user.xml");
 | 
| 
devi@32
 | 
   166 	} else {
 | 
| 
devi@37
 | 
   167 		$filter{hostname} = $host if $host;
 | 
| 
devi@37
 | 
   168 		$filter{user} = $user if $user;
 | 
| 
devi@37
 | 
   169 		push @args, ("--filter" => join ("&", (map("$_=$filter{$_}", keys %filter))));
 | 
| 
devi@37
 | 
   170 		#push @args, ("--filter" => "hostname=".$host."&user=".$user);
 | 
| 
devi@32
 | 
   171 	}
 | 
| 
devi@30
 | 
   172 
 | 
| 
devi@30
 | 
   173 	open (FRONTEND, "./l3-frontend ".join(" ",map("\"$_\"",@args))." |");
 | 
| 
devi@30
 | 
   174 	while (<FRONTEND>) {
 | 
| 
devi@42
 | 
   175 		$print .= $_;
 | 
| 
devi@30
 | 
   176 	}
 | 
| 
devi@30
 | 
   177 	close(FRONTEND);
 | 
| 
devi@27
 | 
   178 }
 | 
| 
devi@27
 | 
   179 
 | 
| 
devi@47
 | 
   180 # Если задана переменная окружения l3_to_file, 
 | 
| 
devi@47
 | 
   181 # печатаем в файл с соответствующим именем,
 | 
| 
devi@47
 | 
   182 # в противном случае -- выводим на стандартный поток вывода
 | 
| 
devi@47
 | 
   183 if (not defined $ENV{l3_to_file}) {
 | 
| 
devi@47
 | 
   184   binmode STDOUT, ":utf8";
 | 
| 
devi@47
 | 
   185   print header(-charset => "utf-8");
 | 
| 
devi@47
 | 
   186   print $print;
 | 
| 
devi@47
 | 
   187 }
 | 
| 
devi@47
 | 
   188 else {
 | 
| 
devi@47
 | 
   189   open(FILE, ">:utf8", $ENV{l3_to_file})
 | 
| 
devi@47
 | 
   190     or die "Can't open $ENV{l3_to_file} for writing";
 | 
| 
devi@47
 | 
   191   print FILE $print;
 | 
| 
devi@47
 | 
   192   close(FILE);
 | 
| 
devi@47
 | 
   193 }
 | 
| 
devi@47
 | 
   194 
 | 
| 
devi@47
 | 
   195 
 |