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