lilalo: bdc1f02d3f87 l3-cgi

lilalo

view l3-cgi @ 83:bdc1f02d3f87

исправлена ошибка с подсказкой в приглашении

author	devi
date	Fri Feb 24 18:43:35 2006 +0200 (2006-02-24)
parents	d499fa3b2af1
children	2cb912bff2ea

line source

1 #!/usr/bin/perl

3 use strict;

4 use CGI qw(:standard);

5 use XML::Simple;

6 use utf8;

8 BEGIN {

9 chdir("/home/devi/cvs/lilalo");

10 require l3config;

11 l3config::init_config();

12 };

14 my %filter;

16 for my $key (qw(login_from local_session_id)) {

17 $filter{$key} = param($key) if param($key);

18 $filter{$key} = $ENV{$key} if defined $ENV{$key};

19 }

21 my %Trainings;

22 my $XMLTraining;

23 my %Machines;

24 my $print = "";

26 $l3config::Config{cgi2file} = $ENV{cgi2file} if defined($ENV{cgi2file});

27 $ENV{PATH_INFO} = $l3config::Config{cgi_path_info} if $l3config::Config{cgi_path_info};

29 my $is_not_cgi="";

30 $is_not_cgi = "1" if $l3config::Config{cgi2file};

31 # Пока что мы считаем, что вызов выполняется через CGI,

32 # если не установлена переменная cgi2file

33 # и не передан такой аргумент командной строки.

34 # Это неверно, но как временное решение - пойдёт

35 my $to_file = $l3config::Config{cgi2file};

37 $l3config::Config{frontend_css} =~ s@^/@@ if $is_not_cgi;

39 sub load_training

40 {

41 my $training_file;

43 $training_file = $l3config::Config{"path_classes"}.$_[0].$l3config::Config{"class_suffix"} if $_[0];

44 $training_file ||= $l3config::Config{"classfile"} ||

45 $l3config::Config{"path_classes"}.$l3config::Config{"class"}.$l3config::Config{"class_suffix"};

47 my $XMLTraining = XMLin($training_file , ForceArray => [ 'student' ] )

48 or die "Can't open file of the training ",$training_file,"\n";

50 for my $student (@{$XMLTraining->{"student"}}) {

51 $XMLTraining->{host}->{$student->{"host"}}=$student;

52 }

53 return $XMLTraining;

54 }

58 if ($ENV{PATH_INFO} eq "/index") {

59 # Показываем индекс курсов

60 my @training_files = glob($l3config::Config{"path_classes"}."/2*".$l3config::Config{"class_suffix"});

61 if (@training_files) {

62 for my $training_file (@training_files) {

63 $training_file =~ s@.*/@@;

64 $training_file =~ s@$l3config::Config{"class_suffix"}$@@;

65 my $training = load_training($training_file);

66 $Trainings{$training->{"date"}}=$training;

67 }

68 $print .= "<html>\n";

69 $print .= "<head>\n";

70 $print .= "<title>Журналы лабораторных работ</title>\n";

71 $print .= "</head>\n";

72 $print .= "<body>\n";

73 $print .= "<table>\n";

74 for my $tdate (reverse sort keys %Trainings) {

75 my $t = $Trainings{$tdate};

76 $print .= "<tr>";

77 $print .= "<td>".$t->{date}."</td>";

78 $print .= "<td>".$t->{course}."</td>";

79 $print .= "</tr>\n";

80 $print .= "<tr>";

81 $print .= "<td/>";

82 $print .= "<td><pre>";

83 for my $host (sort keys %{$t->{host}}) {

84 my $h = $t->{host}->{$host};

85 $print .= "$host";

86 $print .= " ".$h->{firstname}." ".$h->{surname}." ";

87 $print .= " ".$h->{company}." ";

88 $print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/root'>root</a> ";

89 $print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/".$h->{user}."'>".$h->{user}."</a> ";

90 $print .= "\n";

91 }

92 $print .= "</pre><td>";

93 $print .= "</tr>\n";

94 }

95 $print .= "</table>\n";

96 $print .= "</body>\n";

97 $print .= "</html>\n";

98 }

99 else {

100 $print .= "No training-files found<br/>\n";

101 $print .= "Template to load files: ".$l3config::Config{"path_classes"}."*".$l3config::Config{"class_suffix"}."\n"

102 }

103 }

104 elsif ($ENV{PATH_INFO} eq "/current") {

105 open (FRONTEND, "./l3-frontend --output - --show_comments no --frontend_css $l3config::Config{frontend_css}|");

106 binmode FRONTEND, ":utf8";

107 while (<FRONTEND>) {

108 $print .= $_;

109 }

110 close(FRONTEND);

111 }

112 else {

113 # Вызов производится по URL

114 $ENV{PATH_INFO} = "/".$ENV{PATH_INFO} unless $ENV{PATH_INFO} =~ m@^/@;

115 my ($skip, $training, $host, $user) = split /\//,$ENV{PATH_INFO},4;

116

117 if (!$host || $host eq "index") {

118 # Нам неизвестен курс или явно указан просмотр индекса

119 # Просматриваем его

120

121 my $t = load_training($training);

122 $training ||= "current";

123

124 my $prefix = "/cgi-bin/l3/$training/";

125 my $suffix = "";

126 if ($is_not_cgi) {

127 $prefix = "";

128 $suffix = ".html";

129 }

130 my $path = $to_file;

131 $path = "" unless $path =~ s@/[^/]*$@@;

132

133 $print .= "<html>\n";

134 $print .= "<head>\n";

135 $print .= "<title>Журналы лабораторных работ</title>\n";

136 $print .= "<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />";

137 $print .= "<link rel='stylesheet' href='".$l3config::Config{frontend_css}."' type='text/css'/>\n";

138 $print .= "</head>\n";

139 $print .= "<body>\n";

140 $print .= "<h1>Журналы лабораторных работ</h1>\n";

141 $print .= "<table>\n";

142 $print .= "<tr class='table_header'>\n";

143 $print .= "<td>"."Имя"."</td>";

144 $print .= "<td>Хост</td>";

145 $print .= "<td colspan='3'>Пользователь</td>";

146 $print .= "</tr>\n";

147 for my $host (sort keys %{$t->{host}}) {

148

149

150 $print .= "<tr>\n";

151 my $h = $t->{host}->{$host};

152 $print .= "<td>".$h->{firstname}." ".$h->{surname}."</td>";

153 $print .= "<td>$host</td>";

154 $print .= "<td><a href='".$prefix.$host."/root$suffix'>root</a></td>";

155 $print .= "<td><a href='".$prefix.$host."/".$h->{user}."$suffix'>".$h->{user}."</a></td>";

156 $print .= "<td><a href='".$prefix.$host."$suffix'>все</a></td>" if not $is_not_cgi;

157 $print .= "</td>\n";

158 $print .= "</tr>\n";

159

160 if ($is_not_cgi) {

161 # Это грязный хак

162 # Если мы чувствуем, что нас вызывают для генерения индексного файла,

163 # нам нужно создать и файлы, на которые он указывает

164 # Лучше было бы это сделать хотя бы через вызов функций

165 # Такой же хак чуть ниже

166 mkdir("$path/$host");

167 system("$0 --cgi2file $path/$prefix$host/root$suffix ".

168 "--cgi_path_info ".$training."/".$host."/root ".

169 "--frontend_css ../$l3config::Config{frontend_css}");

170 system("$0 --cgi2file $path/$prefix$host/".$h->{user}."$suffix ".

171 "--cgi_path_info ".$training."/".$host."/".$h->{user}." ".

172 "--frontend_css ../$l3config::Config{frontend_css}");

173 # system("$0 --cgi2file $path/$prefix$host$suffix ".

174 # "--cgi_path_info ".$training."/".$host." ".

175 # "--frontend_css ../$l3config::Config{frontend_css}");

176 }

177

178 }

179 # Такой же хак был чуть выше

180 if ($is_not_cgi) {

181 # $print .= "<td><a href='".$prefix."instructor.".$suffix."'>все</a></td>";

182 # system("$0 --cgi2file $path/$prefix$host$suffix"

183 # . " --cgi_path_info ".$training."?login_from=192.168.15.254".$host

184 # . " --frontend_css ../$l3config::Config{frontend_css}");

185 }

186 else {

187 $print .= "<tr>\n";

188 $print .= "<td>"."Инструктор"."</td>";

189 $print .= "<td>from linux.nt</td>";

190 $print .= "<td/>";

191 $print .= "<td/>";

192 $print .= "<td><a href='$training"."?login_from=192.168.15.254'>все</a></td>";

193 }

194 $print .= "</tr>\n";

195 $print .= "</table>\n";

196 $print .= "</body>\n";

197 $print .= "</html>\n";

198 }

199 else {

200

201 $l3config::Config{"class"}=$training if $training ne 'current';

202 $XMLTraining = load_training;

203

204 my @args=(

205 "--output" => "-",

206 "--show_comments" => "no",

207 "--course-center" => $XMLTraining->{center},

208 "--course-trainer" => $XMLTraining->{instructor}->{firstname}." ".$XMLTraining->{instructor}->{surname},

209 "--course-student" => $XMLTraining->{host}->{$host}->{firstname}." ".$XMLTraining->{host}->{$host}->{surname},

210 "--course-code" => $XMLTraining->{course},

211 "--course-date" => $XMLTraining->{date},

212 "--encoding" => $XMLTraining->{host}->{$host}->{charset},

213 );

214 if ($training ne 'current') {

215 push @args, ("--backend_datafile" => "/var/lilalo/lablogs-xml/$training/$host/$user.xml");

216 } else {

217 $filter{hostname} = $host if $host;

218 $filter{user} = $user if $user;

219 push @args, ("--filter" => join ("&", (map("$_=$filter{$_}", keys %filter))));

220 ##push @args, ("--filter" => "hostname=".$host."&user=".$user);

221 }

222

223 open (FRONTEND, "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |");

224 binmode FRONTEND, ":utf8";

225 while (<FRONTEND>) {

226 $print .= $_;

227 }

228 close(FRONTEND);

229 }

230 }

231

232 # Если задана переменная окружения l3_to_file,

233 # печатаем в файл с соответствующим именем,

234 # в противном случае -- выводим на стандартный поток вывода

235 if (not $to_file) {

236 binmode STDOUT, ":utf8";

237 print header(-charset => "utf-8");

238 print $print;

239 }

240 else {

241 open(FILE, ">:utf8", $to_file)

242 or die "Can't open $to_file for writing";

243 print FILE $print;

244 close(FILE);

245 }

246

247