lilalo: 05e99d32f1f5 l3-cgi

lilalo

view l3-cgi @ 99:05e99d32f1f5

$1 заменена на \1
Иначе не работало
Странно.... Проверить

author	devi
date	Mon Jun 12 09:32:18 2006 +0300 (2006-06-12)
parents	385499ec544a
children	2c00c61f2d7b

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 action)) {

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 my $course_file = $l3config::Config{"courses_path"}.$XMLTraining->{"course"}.".xml";

51 my $XMLCourse;

52 if (eval{$XMLCourse = XMLin($course_file)}) {

53 $XMLTraining->{"course-name"} = $XMLCourse->{"fullname"};

54 }

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

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

58 }

59 return $XMLTraining;

60 }

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

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

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

67 if (@training_files) {

68 for my $training_file (@training_files) {

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

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

71 my $training = load_training($training_file);

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

73 }

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

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

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

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

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

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

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

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

82 $print .= "<tr>";

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

84 $print .= "<td colspan='7'>".$t->{course}."</td>";

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

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

87 my %row;

88 my @row_keys = qw{

89 name email company host root user

90 };

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

92 $row{name}= $h->{firstname}." ".$h->{surname};

93 $row{email}= $h->{email};

94 $row{company} = $h->{company};

95 $row{host} = "$host";

96 $row{root} = "<a href='/cgi-bin/l3/".$tdate."/".$host."/root'>root</a> ";

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

98 $print .= "<tr>".join("", map("<td style='$_'>$row{$_}</td>", @row_keys))."</tr>";

99 }

100 }

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

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

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

104 }

105 else {

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

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

108 }

109 }

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

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

112 binmode FRONTEND, ":utf8";

113 while (<FRONTEND>) {

114 $print .= $_;

115 }

116 close(FRONTEND);

117 }

118 else {

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

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

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

122

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

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

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

126

127 my $t = load_training($training);

128 $training ||= "current";

129

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

131 my $suffix = "";

132 if ($is_not_cgi) {

133 $prefix = "";

134 $suffix = ".html";

135 }

136 my $path = $to_file;

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

138

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

163

164 if ($is_not_cgi) {

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

180 }

181

182 }

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

184 if ($is_not_cgi) {

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

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

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

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

189 }

190 else {

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

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

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

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

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

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

197 }

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

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

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

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

202 }

203 else {

204

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

206 $XMLTraining = load_training;

207

208 my @args=(

209 "--output" => "-",

210 "--show_comments" => "no",

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

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

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

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

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

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

217 );

218 if ($XMLTraining->{"course-name"}) {

219 push @args, ("--course-name" => $XMLTraining->{"course-name"});

220 };

221 if ($training ne 'current') {

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

223 } else {

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

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

226 }

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

228

229 #$print .= "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |<br/>";

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

231 binmode FRONTEND, ":utf8";

232 while (<FRONTEND>) {

233 $print .= $_;

234 }

235 close(FRONTEND);

236 }

237 }

238

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

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

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

242 if (not $to_file) {

243 binmode STDOUT, ":utf8";

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

245 print $print;

246 }

247 else {

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

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

250 print FILE $print;

251 close(FILE);

252 }

253

254