lilalo

diff l3-cgi @ 87:c70be67ed3d4

Наведение порядка в коде.
Обработка чуть лучше отделена от представления.

+ добавлено три совета в документацию
author devi
date Tue Feb 28 13:11:26 2006 +0200 (2006-02-28)
parents d28dda8ea18f
children 385499ec544a
line diff
     1.1 --- a/l3-cgi	Mon Feb 20 17:52:40 2006 +0200
     1.2 +++ b/l3-cgi	Tue Feb 28 13:11:26 2006 +0200
     1.3 @@ -6,16 +6,16 @@
     1.4  use utf8;
     1.5  
     1.6  BEGIN {
     1.7 -	chdir("/home/devi/cvs/lilalo");
     1.8 -	require l3config;
     1.9 -	l3config::init_config();
    1.10 +    chdir("/home/devi/cvs/lilalo");
    1.11 +    require l3config;
    1.12 +    l3config::init_config();
    1.13  };
    1.14  
    1.15  my %filter;
    1.16  
    1.17  for my $key (qw(login_from local_session_id)) {
    1.18 -	$filter{$key} =  param($key) if param($key);
    1.19 -	$filter{$key} = $ENV{$key} if defined $ENV{$key};
    1.20 +    $filter{$key} =     param($key) if param($key);
    1.21 +    $filter{$key} =     $ENV{$key} if defined $ENV{$key};
    1.22  }
    1.23  
    1.24  my %Trainings;
    1.25 @@ -23,7 +23,7 @@
    1.26  my %Machines;
    1.27  my $print = "";
    1.28  
    1.29 -$l3config::Config{cgi2file} = $ENV{cgi2file}	if defined($ENV{cgi2file});
    1.30 +$l3config::Config{cgi2file} = $ENV{cgi2file}    if defined($ENV{cgi2file});
    1.31  $ENV{PATH_INFO} = $l3config::Config{cgi_path_info} if $l3config::Config{cgi_path_info};
    1.32  
    1.33  my $is_not_cgi="";
    1.34 @@ -39,87 +39,93 @@
    1.35  sub load_training
    1.36  {
    1.37          my $training_file;
    1.38 -	
    1.39 -	$training_file = $l3config::Config{"path_classes"}.$_[0].$l3config::Config{"class_suffix"} if $_[0];
    1.40 +    
    1.41 +    $training_file = $l3config::Config{"path_classes"}.$_[0].$l3config::Config{"class_suffix"} if $_[0];
    1.42          $training_file ||= $l3config::Config{"classfile"} || 
    1.43          $l3config::Config{"path_classes"}.$l3config::Config{"class"}.$l3config::Config{"class_suffix"};
    1.44  
    1.45          my $XMLTraining = XMLin($training_file , ForceArray => [ 'student' ] )  
    1.46                  or die "Can't open file of the training ",$training_file,"\n";
    1.47  
    1.48 +        my $course_file = $l3config::Config{"courses_path"}.$XMLTraining->{"course"}.".xml";
    1.49 +        my $XMLCourse;
    1.50 +        if (eval{$XMLCourse = XMLin($course_file)}) {
    1.51 +            $XMLTraining->{"course-name"} = $XMLCourse->{"fullname"};
    1.52 +        }
    1.53 +
    1.54          for my $student (@{$XMLTraining->{"student"}}) {
    1.55 -		$XMLTraining->{host}->{$student->{"host"}}=$student;
    1.56 +        $XMLTraining->{host}->{$student->{"host"}}=$student;
    1.57          }
    1.58 -	return $XMLTraining;
    1.59 +    return $XMLTraining;
    1.60  }
    1.61  
    1.62  
    1.63  
    1.64  if ($ENV{PATH_INFO} eq "/index") {
    1.65 -	# Показываем индекс курсов
    1.66 -	my @training_files = glob($l3config::Config{"path_classes"}."/2*".$l3config::Config{"class_suffix"});
    1.67 -	if (@training_files) {
    1.68 -		for my $training_file (@training_files) {
    1.69 -			$training_file =~ s@.*/@@;
    1.70 -			$training_file =~ s@$l3config::Config{"class_suffix"}$@@;
    1.71 -			my $training = load_training($training_file);
    1.72 -			$Trainings{$training->{"date"}}=$training;
    1.73 -		}
    1.74 -		$print .= "<html>\n";
    1.75 -		$print .= "<head>\n";
    1.76 -		$print .= "<title>Журналы лабораторных работ</title>\n";
    1.77 -		$print .= "</head>\n";
    1.78 -		$print .= "<body>\n";
    1.79 -		$print .= "<table>\n";
    1.80 -		for my $tdate (reverse sort keys %Trainings) {
    1.81 -			my $t = $Trainings{$tdate};
    1.82 -			$print .= "<tr>";
    1.83 -			$print .= "<td>".$t->{date}."</td>";
    1.84 -			$print .= "<td>".$t->{course}."</td>";
    1.85 -			$print .= "</tr>\n";
    1.86 -			$print .= "<tr>";
    1.87 -			$print .= "<td/>";
    1.88 -			$print .= "<td><pre>";
    1.89 -			for my $host (sort keys %{$t->{host}}) {
    1.90 -				my $h = $t->{host}->{$host};
    1.91 -				$print .= "$host";
    1.92 -				$print .= " ".$h->{firstname}." ".$h->{surname}." ";
    1.93 -				$print .= " ".$h->{company}." ";
    1.94 -				$print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/root'>root</a> ";
    1.95 -				$print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/".$h->{user}."'>".$h->{user}."</a> ";
    1.96 -				$print .= "\n";
    1.97 -			}
    1.98 -			$print .= "</pre><td>";
    1.99 -			$print .= "</tr>\n";
   1.100 -		}
   1.101 -		$print .= "</table>\n";
   1.102 -		$print .= "</body>\n";
   1.103 -		$print .= "</html>\n";
   1.104 -	}
   1.105 -	else {
   1.106 -		$print .= "No training-files found<br/>\n";
   1.107 -		$print .= "Template to load files: ".$l3config::Config{"path_classes"}."*".$l3config::Config{"class_suffix"}."\n"
   1.108 -	}
   1.109 +    # Показываем индекс курсов
   1.110 +    my @training_files = glob($l3config::Config{"path_classes"}."/2*".$l3config::Config{"class_suffix"});
   1.111 +    if (@training_files) {
   1.112 +        for my $training_file (@training_files) {
   1.113 +            $training_file =~ s@.*/@@;
   1.114 +            $training_file =~ s@$l3config::Config{"class_suffix"}$@@;
   1.115 +            my $training = load_training($training_file);
   1.116 +            $Trainings{$training->{"date"}}=$training;
   1.117 +        }
   1.118 +        $print .= "<html>\n";
   1.119 +        $print .= "<head>\n";
   1.120 +        $print .= "<title>Журналы лабораторных работ</title>\n";
   1.121 +        $print .= "</head>\n";
   1.122 +        $print .= "<body>\n";
   1.123 +        $print .= "<table>\n";
   1.124 +        for my $tdate (reverse sort keys %Trainings) {
   1.125 +            my $t = $Trainings{$tdate};
   1.126 +            $print .= "<tr>";
   1.127 +            $print .= "<td>".$t->{date}."</td>";
   1.128 +            $print .= "<td>".$t->{course}."</td>";
   1.129 +            $print .= "</tr>\n";
   1.130 +            $print .= "<tr>";
   1.131 +            $print .= "<td/>";
   1.132 +            $print .= "<td><pre>";
   1.133 +            for my $host (sort keys %{$t->{host}}) {
   1.134 +                my $h = $t->{host}->{$host};
   1.135 +                $print .= "$host";
   1.136 +                $print .= " ".$h->{firstname}." ".$h->{surname}." ";
   1.137 +                $print .= " ".$h->{company}." ";
   1.138 +                $print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/root'>root</a> ";
   1.139 +                $print .= "<a href='/cgi-bin/l3/".$tdate."/".$host."/".$h->{user}."'>".$h->{user}."</a> ";
   1.140 +                $print .= "\n";
   1.141 +            }
   1.142 +            $print .= "</pre><td>";
   1.143 +            $print .= "</tr>\n";
   1.144 +        }
   1.145 +        $print .= "</table>\n";
   1.146 +        $print .= "</body>\n";
   1.147 +        $print .= "</html>\n";
   1.148 +    }
   1.149 +    else {
   1.150 +        $print .= "No training-files found<br/>\n";
   1.151 +        $print .= "Template to load files: ".$l3config::Config{"path_classes"}."*".$l3config::Config{"class_suffix"}."\n"
   1.152 +    }
   1.153  }
   1.154  elsif ($ENV{PATH_INFO} eq "/current") {
   1.155 -	open (FRONTEND, "./l3-frontend --output - --show_comments no --frontend_css $l3config::Config{frontend_css}|");
   1.156 -	binmode FRONTEND, ":utf8";
   1.157 -	while (<FRONTEND>) {
   1.158 -		$print .= $_;
   1.159 -	}
   1.160 -	close(FRONTEND);
   1.161 +    open (FRONTEND, "./l3-frontend --output - --show_comments no --frontend_css $l3config::Config{frontend_css}|");
   1.162 +    binmode FRONTEND, ":utf8";
   1.163 +    while (<FRONTEND>) {
   1.164 +        $print .= $_;
   1.165 +    }
   1.166 +    close(FRONTEND);
   1.167  }
   1.168  else {
   1.169 -	# Вызов производится по URL
   1.170 -	$ENV{PATH_INFO} = "/".$ENV{PATH_INFO} unless $ENV{PATH_INFO} =~ m@^/@;
   1.171 -	my ($skip, $training, $host, $user) = split /\//,$ENV{PATH_INFO},4;
   1.172 +    # Вызов производится по URL
   1.173 +    $ENV{PATH_INFO} = "/".$ENV{PATH_INFO} unless $ENV{PATH_INFO} =~ m@^/@;
   1.174 +    my ($skip, $training, $host, $user) = split /\//,$ENV{PATH_INFO},4;
   1.175  
   1.176 -	if (!$host || $host eq "index") {
   1.177 -		# Нам неизвестен курс или явно указан просмотр индекса
   1.178 -		# Просматриваем его
   1.179 +    if (!$host || $host eq "index") {
   1.180 +        # Нам неизвестен курс или явно указан просмотр индекса
   1.181 +        # Просматриваем его
   1.182  
   1.183 -		my $t = load_training($training);
   1.184 -		$training ||= "current";
   1.185 +        my $t = load_training($training);
   1.186 +        $training ||= "current";
   1.187  
   1.188          my $prefix = "/cgi-bin/l3/$training/";
   1.189          my $suffix = "";
   1.190 @@ -130,52 +136,50 @@
   1.191          my $path = $to_file;
   1.192          $path = "" unless $path =~ s@/[^/]*$@@;
   1.193  
   1.194 -		$print .= "<html>\n";
   1.195 -		$print .= "<head>\n";
   1.196 -		$print .= "<title>Журналы лабораторных работ</title>\n";
   1.197 +        $print .= "<html>\n";
   1.198 +        $print .= "<head>\n";
   1.199 +        $print .= "<title>Журналы лабораторных работ</title>\n";
   1.200          $print .= "<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />";
   1.201 -		$print .= "<link rel='stylesheet' href='".$l3config::Config{frontend_css}."' type='text/css'/>\n";
   1.202 -		$print .= "</head>\n";
   1.203 -		$print .= "<body>\n";
   1.204 -		$print .= "<h1>Журналы лабораторных работ</h1>\n";
   1.205 -		$print .= "<table>\n";
   1.206 -		$print .= "<tr class='table_header'>\n";
   1.207 -		$print .= "<td>"."Имя"."</td>";
   1.208 -		$print .= "<td>Хост</td>";
   1.209 -		$print .= "<td colspan='3'>Пользователь</td>";
   1.210 -		$print .= "</tr>\n";
   1.211 -		for my $host (sort keys %{$t->{host}}) {
   1.212 +        $print .= "<link rel='stylesheet' href='".$l3config::Config{frontend_css}."' type='text/css'/>\n";
   1.213 +        $print .= "</head>\n";
   1.214 +        $print .= "<body>\n";
   1.215 +        $print .= "<h1>Журналы лабораторных работ</h1>\n";
   1.216 +        $print .= "<table>\n";
   1.217 +        $print .= "<tr class='table_header'>\n";
   1.218 +        $print .= "<td>"."Имя"."</td>";
   1.219 +        $print .= "<td>Хост</td>";
   1.220 +        $print .= "<td colspan='3'>Пользователь</td>";
   1.221 +        $print .= "</tr>\n";
   1.222 +        for my $host (sort keys %{$t->{host}}) {
   1.223 +            $print .= "<tr>\n";
   1.224 +            my $h = $t->{host}->{$host};
   1.225 +            $print .= "<td>".$h->{firstname}." ".$h->{surname}."</td>";
   1.226 +            $print .= "<td>$host</td>";
   1.227 +            $print .= "<td><a href='".$prefix.$host."/root$suffix'>root</a></td>";
   1.228 +            $print .= "<td><a href='".$prefix.$host."/".$h->{user}."$suffix'>".$h->{user}."</a></td>";
   1.229 +            $print .= "<td><a href='".$prefix.$host."$suffix'>все</a></td>" if not $is_not_cgi;
   1.230 +            $print .= "</td>\n";
   1.231 +            $print .= "</tr>\n";
   1.232  
   1.233 -			
   1.234 -			$print .= "<tr>\n";
   1.235 -			my $h = $t->{host}->{$host};
   1.236 -			$print .= "<td>".$h->{firstname}." ".$h->{surname}."</td>";
   1.237 -			$print .= "<td>$host</td>";
   1.238 -			$print .= "<td><a href='".$prefix.$host."/root$suffix'>root</a></td>";
   1.239 -			$print .= "<td><a href='".$prefix.$host."/".$h->{user}."$suffix'>".$h->{user}."</a></td>";
   1.240 -			$print .= "<td><a href='".$prefix.$host."$suffix'>все</a></td>" if not $is_not_cgi;
   1.241 -			$print .= "</td>\n";
   1.242 -			$print .= "</tr>\n";
   1.243 -
   1.244 -			if ($is_not_cgi) {
   1.245 -				# Это грязный хак
   1.246 -				# Если мы чувствуем, что нас вызывают для генерения индексного файла,
   1.247 -				# нам нужно создать и файлы, на которые он указывает
   1.248 -				# Лучше было бы это сделать хотя бы через вызов функций
   1.249 +            if ($is_not_cgi) {
   1.250 +                # Это грязный хак
   1.251 +                # Если мы чувствуем, что нас вызывают для генерения индексного файла,
   1.252 +                # нам нужно создать и файлы, на которые он указывает
   1.253 +                # Лучше было бы это сделать хотя бы через вызов функций
   1.254  # Такой же хак чуть ниже
   1.255 -				mkdir("$path/$host");
   1.256 -				system("$0 --cgi2file $path/$prefix$host/root$suffix  ".
   1.257 -					  "--cgi_path_info ".$training."/".$host."/root ".
   1.258 -					  "--frontend_css ../$l3config::Config{frontend_css}");
   1.259 -				system("$0 --cgi2file $path/$prefix$host/".$h->{user}."$suffix ".
   1.260 -					  "--cgi_path_info ".$training."/".$host."/".$h->{user}." ".
   1.261 -					  "--frontend_css ../$l3config::Config{frontend_css}");
   1.262 -			#	system("$0 --cgi2file $path/$prefix$host$suffix ".
   1.263 -			#		  "--cgi_path_info ".$training."/".$host." ".
   1.264 -			#		  "--frontend_css ../$l3config::Config{frontend_css}");
   1.265 -			}
   1.266 -			
   1.267 -		}
   1.268 +                mkdir("$path/$host");
   1.269 +                system("$0 --cgi2file $path/$prefix$host/root$suffix  ".
   1.270 +                      "--cgi_path_info ".$training."/".$host."/root ".
   1.271 +                      "--frontend_css ../$l3config::Config{frontend_css}");
   1.272 +                system("$0 --cgi2file $path/$prefix$host/".$h->{user}."$suffix ".
   1.273 +                      "--cgi_path_info ".$training."/".$host."/".$h->{user}." ".
   1.274 +                      "--frontend_css ../$l3config::Config{frontend_css}");
   1.275 +            #   system("$0 --cgi2file $path/$prefix$host$suffix ".
   1.276 +            #         "--cgi_path_info ".$training."/".$host." ".
   1.277 +            #         "--frontend_css ../$l3config::Config{frontend_css}");
   1.278 +            }
   1.279 +            
   1.280 +        }
   1.281  # Такой же хак был чуть выше
   1.282          if ($is_not_cgi) {
   1.283  #            $print .= "<td><a href='".$prefix."instructor.".$suffix."'>все</a></td>";
   1.284 @@ -191,42 +195,45 @@
   1.285              $print .= "<td/>";
   1.286              $print .= "<td><a href='$training"."?login_from=192.168.15.254'>все</a></td>";
   1.287          }
   1.288 -		$print .= "</tr>\n";
   1.289 -		$print .= "</table>\n";
   1.290 -		$print .= "</body>\n";
   1.291 -		$print .= "</html>\n";
   1.292 -	}
   1.293 -	else {
   1.294 +        $print .= "</tr>\n";
   1.295 +        $print .= "</table>\n";
   1.296 +        $print .= "</body>\n";
   1.297 +        $print .= "</html>\n";
   1.298 +    }
   1.299 +    else {
   1.300  
   1.301 -		$l3config::Config{"class"}=$training if $training ne 'current';
   1.302 -		$XMLTraining = load_training;
   1.303 +        $l3config::Config{"class"}=$training if $training ne 'current';
   1.304 +        $XMLTraining = load_training;
   1.305  
   1.306 -		my @args=(
   1.307 -			"--output" 		=>	"-",
   1.308 -			"--show_comments" 	=>	"no",
   1.309 -			"--course-center"	=>	$XMLTraining->{center},
   1.310 -			"--course-trainer"	=>	$XMLTraining->{instructor}->{firstname}." ".$XMLTraining->{instructor}->{surname},
   1.311 -			"--course-student"	=>	$XMLTraining->{host}->{$host}->{firstname}." ".$XMLTraining->{host}->{$host}->{surname},
   1.312 -			"--course-code"		=>	$XMLTraining->{course},
   1.313 -			"--course-date"		=>	$XMLTraining->{date},
   1.314 -			"--encoding"		=>	$XMLTraining->{host}->{$host}->{charset},
   1.315 -		);
   1.316 -		if ($training ne 'current') {
   1.317 -			push @args, 	("--backend_datafile"	=>	"/var/lilalo/lablogs-xml/$training/$host/$user.xml");
   1.318 -		} else {
   1.319 -			$filter{hostname} = $host if $host;
   1.320 -			$filter{user} = $user if $user;
   1.321 -			push @args, ("--filter" => join ("&", (map("$_=$filter{$_}", keys %filter))));
   1.322 -			##push @args, ("--filter" => "hostname=".$host."&user=".$user);
   1.323 -		}
   1.324 +        my @args=(
   1.325 +            "--output"      =>  "-",
   1.326 +            "--show_comments"   =>  "no",
   1.327 +            "--course-center"   =>  $XMLTraining->{center},
   1.328 +            "--course-trainer"  =>  $XMLTraining->{instructor}->{firstname}." ".$XMLTraining->{instructor}->{surname},
   1.329 +            "--course-student"  =>  $XMLTraining->{host}->{$host}->{firstname}." ".$XMLTraining->{host}->{$host}->{surname},
   1.330 +            "--course-code"     =>  $XMLTraining->{course},
   1.331 +            "--course-date"     =>  $XMLTraining->{date},
   1.332 +            "--encoding"        =>  $XMLTraining->{host}->{$host}->{charset},
   1.333 +        );
   1.334 +        if ($XMLTraining->{"course-name"}) {
   1.335 +            push @args, ("--course-name"     =>  $XMLTraining->{"course-name"});
   1.336 +        };
   1.337 +        if ($training ne 'current') {
   1.338 +            push @args,     ("--backend_datafile"   =>  "/var/lilalo/lablogs-xml/$training/$host/$user.xml");
   1.339 +        } else {
   1.340 +            $filter{hostname}   = $host if $host;
   1.341 +            $filter{user}       = $user if $user;
   1.342 +        }
   1.343 +        push @args, ("--filter" => join ("&", (map("$_=$filter{$_}", keys %filter))));
   1.344  
   1.345 -		open (FRONTEND, "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |");
   1.346 -		binmode FRONTEND, ":utf8";
   1.347 -		while (<FRONTEND>) {
   1.348 -			$print .= $_;
   1.349 -		}
   1.350 -		close(FRONTEND);
   1.351 -	}
   1.352 +        #$print .= "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |<br/>";
   1.353 +        open (FRONTEND, "./l3-frontend --frontend_css $l3config::Config{frontend_css} ".join(" ",map("\"$_\"",@args))." |");
   1.354 +        binmode FRONTEND, ":utf8";
   1.355 +        while (<FRONTEND>) {
   1.356 +            $print .= $_;
   1.357 +        }
   1.358 +        close(FRONTEND);
   1.359 +    }
   1.360  }
   1.361  
   1.362  # Если задана переменная окружения l3_to_file,