lilalo
view l3-frontend @ 48:568bab7090fc
l3-cgi:
Журналы могут быть сохранены в файл,
l3:
Отправка файлов журналов по электронной почте.
l3 do send-logs
Новые параметры:
cgi2file - имя файла, в который будет выполняться запись
cgi_path_info - путь к странице, которая должна быть записана в файл
(то что вводится в браузер после l3/location)
Журналы могут быть сохранены в файл,
l3:
Отправка файлов журналов по электронной почте.
l3 do send-logs
Новые параметры:
cgi2file - имя файла, в который будет выполняться запись
cgi_path_info - путь к странице, которая должна быть записана в файл
(то что вводится в браузер после l3/location)
| author | devi | 
|---|---|
| date | Sat Nov 26 16:15:52 2005 +0200 (2005-11-26) | 
| parents | 466bea239d25 | 
| children | d021553f4e98 | 
 line source
     1 #!/usr/bin/perl -w
     3 use IO::Socket;
     4 use lib '.';
     5 use l3config;
     6 use locale;
     8 our @Command_Lines;
     9 our @Command_Lines_Index;
    10 our %Commands_Description;
    11 our %Args_Description;
    12 our $Mywi_Socket;
    13 our %Sessions;
    15 # vvv Инициализация переменных выполняется процедурой init_variables
    16 our @Day_Name;
    17 our @Month_Name;
    18 our @Of_Month_Name;
    19 our %Search_Machines;
    20 our %Elements_Visibility;
    21 # ^^^
    23 our %Stat;
    24 our %CommandsFDistribution;	# Сколько раз в журнале встречается какая команда
    26 sub search_buy;
    27 sub make_comment;
    28 sub load_command_lines_from_xml;
    29 sub load_sessions_from_xml;
    30 sub print_command_lines;
    31 sub sort_command_lines;
    32 sub process_command_lines;
    33 sub init_variables;
    34 sub main;
    35 sub collapse_list($);
    37 main();
    39 sub main
    40 {
    41 	$| = 1;
    43 	init_variables();
    44 	init_config();
    46 	open_mywi_socket();
    47 	load_command_lines_from_xml($Config{"backend_datafile"});
    48 	load_sessions_from_xml($Config{"backend_datafile"});
    49 	sort_command_lines;
    50 	process_command_lines;
    51 	print_command_lines($Config{"output"});
    52 	close_mywi_socket;
    53 }
    56 sub search_by
    57 {
    58 	my $sm = shift;
    59 	my $topic = shift;
    60 	$topic =~ s/ /+/;
    62 	return "<a href='".	$Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='".
    63 				$Search_Machines{$sm}->{"icon"}."' border='0'/></a>";
    64 }
    66 sub extract_from_cline
    67 # Разобрать командную строку $_[1] и возвратить хэш, содержащий 
    68 # номер первого появление команды в строке:
    69 # 	команда => первая позиция
    70 {
    71 	my $what = $_[0];
    72 	my $cline = $_[1];
    73 	my @lists = split /\;/, $cline;
    76 	my @commands = ();
    77 	for my $list (@lists) {
    78 		push @commands, split /\|/, $list;
    79 	}
    81 	my %commands;
    82 	my %args;
    83 	my $i=0;
    84 	for my $command (@commands) {
    85 		$command =~ s@^\s*\S+/@@;
    86 		$command =~ /\s*(\S+)\s*(.*)/;
    87 		if ($1 && $1 eq "sudo" ) {
    88 			$commands{"$1"}=$i++;
    89 			$command =~ s/\s*sudo\s+//;
    90 		}
    91 		$command =~ s@^\s*\S+/@@;
    92 		$command =~ /\s*(\S+)\s*(.*)/;
    93 		if ($1 && !defined $commands{"$1"}) {
    94 				$commands{"$1"}=$i++;
    95 		};	
    96 		if ($2) {
    97 			my $args = $2;
    98 			my @args = split (/\s+/, $args);
    99 			for my $a (@args) {
   100 				$args{"$a"}=$i++
   101 					if !defined $args{"$a"};
   102 			};	
   105 		}
   106 	}
   108 	if ($what eq "commands") {
   109 		return \%commands;
   110 	} else {
   111 		return \%args;
   112 	}
   114 }
   116 sub open_mywi_socket
   117 {
   118 	$Mywi_Socket = IO::Socket::INET->new(
   119 				PeerAddr => $Config{mywi_server},
   120 				PeerPort => $Config{mywi_port},
   121 				Proto	 => "tcp",
   122 				Type	 => SOCK_STREAM);
   123 }
   125 sub close_mywi_socket
   126 {
   127 	close ($Mywi_Socket);
   128 }
   131 sub mywi_client
   132 {
   133 	my $query = $_[0];
   134 	my $mywi;
   136 	open_mywi_socket;
   137 	if ($Mywi_Socket) {
   138 		local $| = 1;
   139 		local $/ = "";
   140 		print $Mywi_Socket $query."\n";
   141 		$mywi = <$Mywi_Socket>;
   142 		$mywi = "" if $mywi =~ /nothing app/;
   143 	}
   144 	close_mywi_socket;
   145 	return $mywi;
   146 }
   148 sub make_comment
   149 {
   150 	my $cline = $_[0];
   151 	#my $files = $_[1];
   153 	my @comments=(); 
   154 	my @commands = keys %{extract_from_cline("commands", $cline)};
   155 	my @args = keys %{extract_from_cline("args", $cline)};
   156 	return if (!@commands && !@args);
   157 	#return "commands=".join(" ",@commands)."; files=".join(" ",@files);
   159 	# Commands
   160 	for my $command (@commands) {
   161 		$command =~ s/'//g;
   162 		$CommandsFDistribution{$command}++;
   163 		if (!$Commands_Description{$command}) {
   164 			my $mywi="";
   165 			$mywi = mywi_client ($command);
   166 			$mywi = join ("\n", grep(/\([18]\)/, split(/\n/, $mywi)));
   167 			$mywi =~ s/\s+/ /;
   168 			if ($mywi !~ /^\s*$/) {
   169 				$Commands_Description{$command} = $mywi;
   170 			}
   171 			else {
   172 				next;
   173 			}
   174 		}
   176 		push @comments, $Commands_Description{$command};
   177 	}
   178 	return join("
\n", @comments);
   180 	# Files
   181 	for my $arg (@args) {
   182 		$arg =~ s/'//g;
   183 		if (!$Args_Description{$arg}) {
   184 			my $mywi;
   185 			$mywi = mywi_client ($arg);
   186 			$mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));
   187 			$mywi =~ s/\s+/ /;
   188 			if ($mywi !~ /^\s*$/) {
   189 				$Args_Description{$arg} = $mywi;
   190 			}
   191 			else {
   192 				next;
   193 			}
   194 		}
   196 		push @comments, $Args_Description{$arg};
   197 	}
   199 }
   201 =cut
   202 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
   203 из XML-документа в переменную @Command_Lines
   205 Предупреждение!
   206 Процедура не в состоянии обрабатывать XML-документ любой структуры.
   207 В действительности файл cache из которого загружаются данные 
   208 просто напоминает XML с виду.
   209 =cut
   210 sub load_command_lines_from_xml
   211 {
   212 	my $datafile = $_[0];
   214 	open (CLASS, $datafile)
   215 		or die "Can't open file of the class ",$datafile,"\n";
   216 	local $/;
   217 	$data = <CLASS>;
   218 	close(CLASS);
   220 	for $command ($data =~ m@<command>(.*?)</command>@sg) {
   221 		my %cl;
   222 		while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {
   223 			$cl{$1} = $2;
   224 		}
   225 		push @Command_Lines, \%cl;
   226 	}
   227 }
   229 sub load_sessions_from_xml
   230 {
   231 	my $datafile = $_[0];
   233 	open (CLASS, $datafile)
   234 		or die "Can't open file of the class ",$datafile,"\n";
   235 	local $/;
   236 	my $data = <CLASS>;
   237 	close(CLASS);
   239 	for my $session ($data =~ m@<session>(.*?)</session>@sg) {
   240 		my %session;
   241 		while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {
   242 			$session{$1} = $2;
   243 		}
   244 		$Sessions{$session{local_session_id}} = \%session;
   245 	}
   246 }
   250 sub sort_command_lines
   251 {
   252 	# Sort Command_Lines
   253 	# Write Command_Lines to Command_Lines_Index
   255 	my @index;
   256 	for (my $i=0;$i<=$#Command_Lines;$i++) {
   257 		$index[$i]=$i;
   258 	}
   260 	@Command_Lines_Index = sort {
   261 		$Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}
   262 	} @index;
   264 }
   266 sub process_command_lines
   267 {
   268 	for my $i (@Command_Lines_Index) {
   270 		my $cl = \$Command_Lines[$i];
   271 		#@{${$cl}->{"new_commands"}} =();
   272 		#@{${$cl}->{"new_files"}} =();
   273 		$$cl->{"class"} = ""; 
   275 		if ($$cl->{"err"}) {
   276 			$$cl->{"class"}="wrong";
   277 			$$cl->{"class"}="interrupted"
   278 				if ($$cl->{"err"} eq 130);
   279 		}	
   280 		if (!$$cl->{"euid"}) {
   281 			$$cl->{"class"}.="_root";
   282 		}
   284 #tab#		my @tab_words=split /\s+/, $$cl->{"output"};
   285 #tab#		my $last_word= $$cl->{"cline"} =~ /(\S*)$/;
   286 #tab#		$last_word =~ s@.*/@@;
   287 #tab#		my $this_is_tab=1;
   288 #tab#
   289 #tab#		if ($last_word && @tab_words >2) {
   290 #tab#			for my $tab_words (@tab_words) {
   291 #tab#				if ($tab_words !~ /^$last_word/) {
   292 #tab#					$this_is_tab=0;
   293 #tab#					last;
   294 #tab#				}
   295 #tab#			}
   296 #tab#		}	
   297 #tab#		$$cl->{"class"}="tab" if $this_is_tab;
   300 #		if ( !$$cl->{"err"}) {
   301 #			# Command does not contain mistakes
   302 #			
   303 #			my %commands = extract_from_cline("commands", ${$cl}->{"cline"});
   304 #			my %files = extract_from_cline("files", ${$cl}->{"cline"});
   305 #
   306 #			# Searching for new commands only
   307 #			for my $command (keys  %commands) {
   308 #				if (!defined $Commands_Stat{$command}) {
   309 #					push @{$$cl->{new_commands}}, $command;
   310 #				}	
   311 #				$Commands_Stat{$command}++;
   312 #			}
   313 #			
   314 #			for my $file (keys  %files) {
   315 #				if (!defined $Files_Stat{$file}) {
   316 #					push @{$$cl->{new_files}}, $file;
   317 #				}	
   318 #				$Files_Stat{$file}++;
   319 #			}
   320 #		}	
   322 		if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) {
   323 			if ($1 eq "=") {
   324 				$$cl->{"class"} = "note";
   325 				$$cl->{"note"} = $$cl->{"output"};
   326 				$$cl->{"note_title"} = $2;
   327 			}
   328 			else {
   329 				my $j = $i;
   330 				if ($1 eq "^") {
   331 					$j--;
   332 					$j-- while ($j >=0  && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
   333 				}
   334 				elsif ($1 eq "v") {
   335 					$j++;
   336 					$j++ while ($j <= @Command_Lines  && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
   337 				}
   338 				$Command_Lines[$j]->{note_title}="$2";
   339 				$Command_Lines[$j]->{note}=$$cl->{output};
   340 				$$cl=0;
   341 			}
   342 		}
   343 		elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) {
   344 			if ($1 eq "=") {
   345 				$$cl->{"class"} = "note";
   346 				$$cl->{"note"} = $2;
   347 			}
   348 			else {
   349 				my $j=$i;
   350 				if ($1 eq "^") {
   351 					$j--;
   352 					$j-- while ($j >=0  && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
   353 				}
   354 				elsif ($1 eq "v") {
   355 					$j++;
   356 					$j++ while ($j <= @Command_Lines  && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]);
   357 				}
   358 				$Command_Lines[$j]->{note}.="$2\n";
   359 				$$cl=0;
   360 			}
   361 		}
   362 	}	
   364 }
   367 =cut
   368 Процедура print_command_lines выводит HTML-представление
   369 разобранного lab-скрипта. 
   371 Разобранный lab-скрипт должен находиться в массиве @Command_Lines
   372 =cut
   374 sub print_command_lines
   375 {
   376 	my $output_filename=$_[0];
   378 	my $course_name = $Config{"course-name"};
   379 	my $course_code = $Config{"course-code"};
   380 	my $course_date = $Config{"course-date"};
   381 	my $course_center = $Config{"course-center"};
   382 	my $course_trainer = $Config{"course-trainer"};
   383 	my $course_student = $Config{"course-student"};
   386 	# Результат выполнения процедуры равен 
   387 	# join("", @Result{header,body,stat,help,about,footer})
   388 	my %Result;
   389 	my @toc;  # Хранит оглавление
   390 	my $note_number=0;
   392 	$Result{"body"} = "<table width='100%'>\n";
   394 	my $cl;
   395 	my $last_tty="";
   396 	my $last_day="";
   397 	my $in_range=0;
   399 	my $current_command=0;
   401 COMMAND_LINE:
   402 	for my $k (@Command_Lines_Index) {
   404 		my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
   406 		next unless $cl;
   409 		if ($Config{filter}) {
   410 			# Инициализация фильтра
   411 			my %filter;
   412 			for (split /&/,$Config{filter}) {
   413 				my ($var, $val) = split /=/;
   414 				$filter{$var} = $val || "";
   415 			}
   417 			for my $filter_key (keys %filter) {
   418 				next COMMAND_LINE unless (
   419 					not defined($cl->{local_session_id}) 
   420 					|| not defined($Sessions{$cl->{local_session_id}}->{$filter_key}) 
   421 					|| $Sessions{$cl->{local_session_id}}->{$filter_key} eq $filter{$filter_key});
   422 			}
   424 			#if ($filter{user}) {
   425 			#	next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{user} eq $filter{user};
   426 			#}
   428 			#for my $filter_field (keys %filter) {
   429 			#	next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_field} eq $filter{$filter_field};
   430 			#}
   431 		}
   433 		if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
   434 			$in_range=1;
   435 			next;
   436 		}
   437 		if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
   438 			$in_range=0;
   439 			next;
   440 		}
   441 		next if ($Config{"from"} && $Config{"to"} && !$in_range) 
   442 			||
   443 		    	($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
   444 			||
   445 			($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
   446 			||
   447 			($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
   449 		#my @new_commands=@{$cl->{"new_commands"}};
   450 		#my @new_files=@{$cl->{"new_files"}};
   452 		if ($cl->{class} eq "note") {
   453 			my $note = $cl->{note};
   454 			$note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note)));
   455 			$note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   456 			$note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   457 			$Result{"body"} .= "<tr><td colspan='6'>";
   458 			$Result{"body"} .= "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title};
   459 			$Result{"body"} .= "".$note."<p/><p/></td></td>";
   461 			if ($cl->{note_title}) {
   462 				push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";
   463 				$note_number++;
   464 			}
   465 			next;
   466 		}
   468 		my $cl_class="cline";
   469 		my $out_class="output";
   470 		if ($cl->{"class"}) {
   471 			$cl_class = $cl->{"class"}."_".$cl_class;
   472 			$out_class = $cl->{"class"}."_".$out_class;
   473 		}
   475 		my @new_commands;
   476 		my @new_files;
   477 		@new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"};
   478 		@new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"};
   480 		my $output="";
   481 		if ($Config{"head_lines"} || $Config{"tail_lines"}) {
   482 			# Partialy output
   483 			my @lines = split '\n', $cl->{"output"};
   484 			# head
   485 			my $mark=1;
   486 			for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
   487 				$output .= $lines[$i]."\n";
   488 			}
   489 			# tail
   490 			my $start=$#lines-$Config{"tail_lines"}+1;
   491 			if ($start < 0) {
   492 				$start=0;
   493 				$mark=0;
   494 			}	
   495 			if ($start < $Config{"head_lines"}) {
   496 				$start=$Config{"head_lines"};
   497 				$mark=0;
   498 			}	
   499 			$output .= $Config{"skip_text"}."\n" if $mark;
   500 			for ($i=$start; $i<= $#lines; $i++) {
   501 				$output .= $lines[$i]."\n";
   502 			}
   503 		} 
   504 		else {
   505 			# Full output
   506 			$output .= $cl->{"output"};
   507 		}	
   508 		#$output .= "^C\n" if ($cl->{"err"} eq "130");
   510 		#
   511 		##
   512 		## Начинается собственно вывод
   513 		##
   514 		#
   516 		# <command>
   518 		my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
   519 		next if $Stat{LastCommand} == $cl->{time};
   520 		$Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};
   521 		$Stat{LastCommand} = 0 unless defined $Stat{LastCommand};	
   522 		$Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}
   523 			if $cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval};
   524 		$Stat{LastCommand} = $cl->{time};
   525 		$Stat{TotalCommands} = 0 unless $Stat{TotalCommands};
   526 		$Stat{TotalCommands}++;
   528 		# Добавляем спереди 0 для удобочитаемости
   529 		$min = "0".$min if $min =~ /^.$/;
   530 		$hour = "0".$hour if $hour =~ /^.$/;
   531 		$sec = "0".$sec if $sec =~ /^.$/;
   533 		$class=$cl->{"out_class"};
   534 		$class =~ s/output$//;
   536 		$Stat{ErrorCommands}++
   537 			if $class =~ /wrong/;
   539 		$Result{"body"} .= "<tr class='command'>\n";
   542 		# DAY CHANGE
   543 		if ( $last_day ne $day) {
   544 			#$Result{"body"} .= "<td colspan='6'><p></p><h3>День ",$day,"</h4></td></tr><tr>";
   545 			$Result{"body"} .= "<td colspan='6'><p></p><h3 id='day$day'>".$Day_Name[$wday]."</h4></td></tr><tr>";
   546 			push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
   547 			$last_day=$day;
   548 		}
   550 		# CONSOLE CHANGE
   551 		if ( $last_tty ne $cl->{"tty"}) {
   552 			my $host;
   553 			#$host = $Sessions{$cl->{local_session_id}}->{user}."@".$Sessions{$cl->{local_session_id}}->{hostname};
   554 			my $body = $cl->{"tty"};
   555 			$body .= " \@$host" if $host;
   556 			$Result{"body"} .= "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>".$body."</td></tr></table></td></tr><tr>";
   557 			$last_tty=$cl->{"tty"};
   558 		}
   560 		# TIME
   561 		if ($Config{"show_time"} =~ /^y/i) {
   562 			$Result{"body"} .= "<td valign='top' class='time' width='$Config{time_width}'><pre>".
   563 				$hour. ":". $min. ":". $sec.
   564 				"</td>";
   565 		} else {
   566 			$Result{"body"} .= "<td width='0'/>"
   567 		}
   569 		# COMMAND
   570 		$Result{"body"} .= "<td class='script'>\n";
   571 		$Result{"body"} .= "<pre class='${class}cline'>\n";
   572 		my $cline = $cl->{"prompt"}.$cl->{"cline"};
   573 		$cline =~ s/\n//;
   575 		#$cline .= "(".$Sessions{$cl->{local_session_id}}.")";
   577 		my $hint = make_comment($cl->{"cline"});
   578 		$cline = "<div title='$hint'>$cline</div>" if $hint;
   579 		$Result{"body"} .= $cline;
   580 		$Result{"body"} .= "</pre>\n";
   582 		my $last_command = $cl->{"last_command"};
   583 		if (!( 
   584 		$Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
   585 		$Config{"suppress_pagers"}  =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
   586 		$Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
   587 			)) {
   589 			$Result{"body"} .= "<pre class='".$cl->{out_class}."'>";
   590 			$Result{"body"} .= $output;
   591 			$Result{"body"} .= "</pre>\n";
   592 		}	
   594 		# DIFF
   595 		if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
   596 			$Result{"body"} .= "<table><tr><td width='5'/><td class='diff'><pre>";
   597 			$Result{"body"} .= $cl->{"diff"};
   598 			$Result{"body"} .= "</pre></td></tr></table>";
   599 		}
   601 		#NOTES
   602 		if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {
   603 			my $note=$cl->{"note"};
   604 			$note =~ s/\n/<br\/>\n/msg;
   605 			$note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   606 			$note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   607 		#	Ширину пока не используем
   608 		#	$Result{"body"} .= "<table width='$Config{note_width}' class='note'>";
   609 			$Result{"body"} .= "<table class='note'>";
   610 			$Result{"body"} .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title};
   611 			$Result{"body"} .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>";
   612 			$Result{"body"} .= "</table>\n";
   613 		}
   615 		# COMMENT
   616 		if ( $Config{"show_comments"} =~ /^y/i) {
   617 			my $comment = make_comment($cl->{"cline"});
   618 			if ($comment) {
   619 				$Result{"body"} .= "<table width='$Config{comment_width}'>".
   620 						"<tr><td width='5'/><td>";
   621 				$Result{"body"} .= "<table class='note' width='100%'>";
   622 				$Result{"body"} .= $comment;
   623 				$Result{"body"} .= "</table>\n";
   624 				$Result{"body"} .= "</td></tr></table>";
   625 			}
   626 		}
   628 		# Вывод очередной команды окончен
   629 		$Result{"body"} .= "</td>\n";
   630 		$Result{"body"} .= "</tr>\n";
   631 	}
   633 	$Result{"body"} .= "</table>\n";
   635 	#$Result{"stat"} = "<hr/>";
   637 	%StatNames = (
   638 		FirstCommand => "Время первой команды журнала",
   639 		LastCommand => "Время последней команды журнала",
   640 		TotalCommands => "Количество командных строк в журнале",
   641 		ErrorsPercentage => "Процент команд с ненулевым кодом завершения, %",
   642 		TotalTime => "Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час",
   643 		CommandsPerTime => "Количество командных строк в единицу времени, команда/мин",
   644 		CommandsFrequency => "Частота использования команд",
   645 		RareCommands	=> "Частота использования этих команд < 0.5%",
   646 	);
   647 	@StatOrder = (
   648 		FirstCommand,
   649 		LastCommand,
   650 		TotalCommands,
   651 		ErrorsPercentage,
   652 		TotalTime,
   653 		CommandsPerTime,
   654 		CommandsFrequency,
   655 		RareCommands,
   656 	);
   658 	# Подготовка статистики к выводу
   659 	# Некоторые значения пересчитываются!
   660 	# Дальше их лучше уже не использовать!!!
   662 	my %CommandsFrequency = %CommandsFDistribution;
   664 	$Stat{TotalTime} ||= 0;
   665 	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{FirstCommand} || 0);
   666 	$Stat{FirstCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec,  $year+1900, $mon+1, $mday;
   667 	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{LastCommand} || 0);
   668 	$Stat{LastCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec,  $year+1900, $mon+1, $mday;
   669 	$Stat{ErrorsPercentage} = sprintf "%5.2f", $Stat{ErrorCommands}*100/$Stat{TotalCommands}	
   670 		if $Stat{TotalCommands};
   671 	$Stat{CommandsPerTime} = sprintf "%5.2f", $Stat{TotalCommands}*60/$Stat{TotalTime}
   672 		if $Stat{TotalTime};
   673 	$Stat{TotalTime} = sprintf "%5.2f", $Stat{TotalTime}/60/60;
   675 	my $total_commands=0;
   676 	for $command (keys %CommandsFrequency){
   677 		$total_commands += $CommandsFrequency{$command};
   678 	}
   679 	if ($total_commands) {
   680 		for $command (reverse sort {$CommandsFrequency{$a} <=> $CommandsFrequency{$b}} keys %CommandsFrequency){
   681 			my $command_html;
   682 			my $percentage = sprintf "%5.2f",$CommandsFrequency{$command}*100/$total_commands;
   683 			if ($percentage < 0.5) {
   684 				my $hint = make_comment($command);
   685 				$command_html = "$command";
   686 				$command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;
   687 				my $command_html = "<tt>$command_html</tt>";
   688 				$Stat{RareCommands} .= $command_html."<sub><font size='-2'>".$CommandsFrequency{$command}."</font></sub> , ";
   689 			}
   690 			else {
   691 				my $hint = make_comment($command);
   692 				$command_html = "$command";
   693 				$command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;
   694 				my $command_html = "<tt>$command_html</tt>";
   695 				$percentage = sprintf "%5.2f",$percentage;
   696 				$Stat{CommandsFrequency} .= "<tr><td>".$command_html."</td><td>".$CommandsFrequency{$command}."</td>".
   697 					"<td>|".("="x int($CommandsFrequency{$command}*100/$total_commands))."| $percentage%</td></tr>";
   698 			}
   699 		}
   700 		$Stat{CommandsFrequency} = "<table>".$Stat{CommandsFrequency}."</table>";
   701 		$Stat{RareCommands} =~ s/, $// if $Stat{RareCommands};
   702 	}
   704 	$Result{"stat"} .= "<h2 id='stat'>Статистика</h2>";
   705 	$Result{"stat"} .= "<table>";
   706 	for my $stat (@StatOrder) {
   707 	$Result{"stat"} .= "<tr valign='top'><td width='300'>".$StatNames{"$stat"}."</td><td>".$Stat{"$stat"}."</td></tr>"
   708 		if $Stat{"$stat"};
   709 	}
   711 	$Result{"stat"} .= "</table>";
   712 	$Result{"stat"} .= "<font size='-2'>____<br/>*) Интервалы неактивности длительностью ".($Config{stat_inactivity_interval}/60)." минут и более не учитываются</font></br>";
   714 	#$Result{"help"} .= "<hr/>";
   715 	$Result{"help"} .= "<h2 id='help'>Справка</h2>";
   716 	$Result{"help"} .= "$Html_Help<br/>";
   717 	#$Result{"about"} .= "<hr/>";
   718 	$Result{"about"} .= "<h2 id='about'>О программе</h2>";
   719 	$Result{"about"} .= "$Html_About";
   720 	$Result{"footer"} .= "</body>\n";
   721 	$Result{"footer"} .= "</html>\n";
   723 	$Result{"title"} = "Журнал лабораторных работ";
   724 	$Result{"title"}.= " -- ".$course_student if $course_student;
   725 	if ($course_date) {
   726 		$Result{"title"}.= " -- ".$course_date; 
   727 		$Result{"title"}.= "/".$course_code if $course_code;
   728 	}
   729 	else {
   730 		$Result{"title"}.= " -- ".$course_code if $course_code;
   731 	}
   733 	# Заголовок генерируется позже всего
   734 	# Тогда, когда известно уже, что должно быть написано в 
   735 	# оглавлении
   736 	$Result{"header"} = <<HEADER;
   737 	<html>
   738 	<head>
   739 	<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
   740 	<link rel='stylesheet' href='$Config{frontend_css}' type='text/css'/>
   741 	<title>$Result{title}</title>
   742 	</head>
   743 	<body>
   744 	<script>
   745 	$Html_JavaScript
   746 	</script>
   747 	<h1>Журнал лабораторных работ</h1>
   749 HEADER
   750 	$Result{"header"} .= "<p>" if $course_student || $course_trainer || $course_name || $course_code || $course_date || $course_center;
   751 	$Result{"header"} .= "Выполнил $course_student<br/>" if $course_student;
   752 	$Result{"header"} .= "Проверил $course_trainer <br/>" if $course_trainer;
   753 	$Result{"header"} .= "Курс " if $course_name || $course_code || $course_date;
   754 	$Result{"header"} .= "$course_name " if $course_name;
   755 	$Result{"header"} .= "($course_code)" if $course_code;
   756 	$Result{"header"} .= ", $course_date<br/>" if $course_date;
   757 	$Result{"header"} .= "Учебный центр $course_center <br/>" if $course_center;
   758 	$Result{"header"} .= "</p>" if $course_student || $course_trainer || $course_name || $course_code || $course_date || $course_center;
   760 	my $toc = collapse_list (\@toc);
   761 	$Result{"header"} .= <<HEADER;
   762 	<table border=0 id='toc' class='toc'>
   763 	<tr>
   764 	<td>
   765 	<div class='toc_title'>Содержание</div>
   766 	<ul>
   767 		<li><a href='#log'>Журнал</a></li>
   768 		<ul>$toc</ul>
   769 		<li><a href='#stat'>Статистика</a></li>
   770 		<li><a href='#help'>Справка</a></li>
   771 		<li><a href='#about'>О программе</a></li>
   772 	</ul>
   773 	</td>
   774 	</tr>
   775 	</table>
   777 	<h2 id="log">Журнал</h2>
   778 HEADER
   779 	$Result{"header"} .= "<table id='visibility_form' class='visibility_form'><tr><td><form>\n";
   780 	for my $element (keys %Elements_Visibility)
   781 	{
   782 		my @e = split /\s+/, $element;
   783 		my $showhide = join "", map { "ShowHide('$_');" } @e ;
   784 		$Result{"header"} .= "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>".
   785 				$Elements_Visibility{$element}.
   786 				"</input><br>\n";
   787 	}
   789 	$Result{"header"} .= "</form></td></tr></table>\n";
   791 	if ($output_filename eq "-") {
   792 		print $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"};
   793 	}
   794 	else {
   795 		open(OUT, ">", $output_filename)
   796 			or die "Can't open $output_filename for writing\n";
   797 		print OUT $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"};
   798 		close(OUT);
   799 	}
   800 }
   804 sub collapse_list($)
   805 {
   806 	my $res = "";
   807 	for my $elem (@{$_[0]}) {
   808 		if (ref $elem eq "ARRAY") {
   809 			$res .= "<ul>".collapse_list($elem)."</ul>";
   810 		}
   811 		else
   812 		{
   813 			$res .= "<li>".$elem."</li>";
   814 		}
   815 	}
   816 	return $res;
   817 }
   822 sub init_variables
   823 {
   824 $Html_Help = <<HELP;
   825 	Для того чтобы использовать LiLaLo, не нужно знать ничего особенного:
   826 	всё происходит само собой.
   827 	Однако, чтобы ведение и последующее использование журналов
   828 	было как можно более эффективным, желательно иметь в виду следующее:
   829 	<ul>
   830 	<li><p> 
   831 	В журнал автоматически попадают все команды, данные в любом терминале системы.
   832 	</p></li>
   833 	<li><p>
   834 	Для того чтобы убедиться, что журнал на текущем терминале ведётся, 
   835 	и команды записываются, дайте команду w.
   836 	В поле WHAT, соответствующем текущему терминалу, 
   837 	должна быть указана программа script.
   838 	</p></li>
   839 	<li><p>
   840 	Если код завершения команды равен нулю, 
   841 	команда была выполнена без ошибок.
   842 	Команды, код завершения которых отличен от нуля, выделяются цветом.
   843 <table>
   844 <tr class='command'>
   845 <td class='script'>
   846 <pre class='wrong_cline'>
   847 \$ l s-l</pre>
   848 <pre class='wrong_output'>bash: l: command not found
   849 </pre>
   850 </td>
   851 </tr>
   852 </table>
   853 <br/>
   854 	</p></li>
   855 	<li><p>
   856 	Команды, ход выполнения которых был прерван пользователем, выделяются цветом.
   857 <table>
   858 <tr class='command'>
   859 <td class='script'>
   860 <pre class='interrupted_cline'>
   861 \$ find / -name abc</pre>
   862 <pre class='interrupted_output'>find: /home/devi-orig/.gnome2: Keine Berechtigung
   863 find: /home/devi-orig/.gnome2_private: Keine Berechtigung
   864 find: /home/devi-orig/.nautilus/metafiles: Keine Berechtigung
   865 find: /home/devi-orig/.metacity: Keine Berechtigung
   866 find: /home/devi-orig/.inkscape: Keine Berechtigung
   867 ^C
   868 </pre>
   869 </td>
   870 </tr>
   871 </table>
   872 <br/>
   873 	</p></li>
   874 	<li><p>
   875 	Команды, выполненные с привилегиями суперпользователя,
   876 	выделяются слева красной чертой.
   877 <table>
   878 <tr class='command'>
   879 <td class='script'>
   880 <pre class='_root_cline'>
   881 # id</pre>
   882 <pre class='_root_output'>
   883 uid=0(root) gid=0(root) Gruppen=0(root)
   884 </pre>
   885 </td>
   886 </tr>
   887 </table>
   888 	<br/>
   889 	</p></li>
   890 	<li><p>
   891 	Изменения, внесённые в текстовый файл с помощью редактора, 
   892 	запоминаются и показываются в журнале в формате ed.
   893 	Строки, начинающиеся символом "<", удалены, а строки,
   894 	начинающиеся символом ">" -- добавлены.
   895 <table>
   896 <tr class='command'>
   897 <td class='script'>
   898 <pre class='cline'>
   899 \$ vi ~/.bashrc</pre>
   900 <table><tr><td width='5'/><td class='diff'><pre>2a3,5
   901 > 	if [ -f /usr/local/etc/bash_completion ]; then
   902 >         . /usr/local/etc/bash_completion
   903 >     	fi
   904 </pre></td></tr></table></td>
   905 </tr>
   906 </table>
   907 	<br/>
   908 	</p></li>
   909 	<li><p>
   910 	Для того чтобы изменить файл в соответствии с показанными в диффшоте
   911 	изменениями, можно воспользоваться командой patch.
   912 	Нужно скопировать изменения, запустить программу patch, указав в
   913 	качестве её аргумента файл, к которому применяются изменения,
   914 	и всавить скопированный текст:
   915 <table>
   916 <tr class='command'>
   917 <td class='script'>
   918 <pre class='cline'>
   919 \$ patch ~/.bashrc</pre>
   920 </td>
   921 </tr>
   922 </table>
   923 	В данном случае изменения применяются к файлу ~/.bashrc
   924 	</p></li>
   925 	<li><p>
   926 	Для того чтобы получить краткую справочную информацию о команде, 
   927 	нужно подвести к ней мышь. Во всплывающей подсказке появится краткое
   928 	описание команды.
   929 	</p></li>
   930 	<li><p>
   931 	Время ввода команды, показанное в журнале, соответствует времени 
   932 	<i>начала ввода командной строки</i>, которое равно тому моменту, 
   933 	когда на терминале появилось приглашение интерпретатора
   934 	</p></li>
   935 	<li><p>
   936 	Имя терминала, на котором была введена команда, показано в специальном блоке.
   937 	Этот блок показывается только в том случае, если терминал
   938 	текущей команды отличается от терминала предыдущей.
   939 	</p></li>
   940 	<li><p>
   941 	Вывод не интересующих вас в настоящий момент элементов журнала,
   942 	таких как время, имя терминала и других, можно отключить.
   943 	Для этого нужно воспользоваться <a href='#visibility_form'>формой управления журналом</a>
   944 	вверху страницы.
   945 	</p></li>
   946 	<li><p>
   947 	Небольшие комментарии к командам можно вставлять прямо из командной строки.
   948 	Комментарий вводится прямо в командную строку, после символов #^ или #v.
   949 	Символы ^ и v показывают направление выбора команды, к которой относится комментарий:
   950 	^ - к предыдущей, v - к следующей.
   951 	Например, если в командной строке было введено:
   952 <pre class='cline'>
   953 \$ whoami
   954 </pre>
   955 <pre class='output'>
   956 user
   957 </pre>
   958 <pre class='cline'>
   959 \$ #^ Интересно, кто я?
   960 </pre>
   961 	в журнале это будет выглядеть так:
   963 <pre class='cline'>
   964 \$ whoami
   965 </pre>
   966 <pre class='output'>
   967 user
   968 </pre>
   969 <table class='note'><tr><td width='100%' class='note_text'>
   970 <tr> <td> Интересно, кто я?<br/> </td></tr></table> 
   971 	</p></li>
   972 	<li><p>
   973 	Если комментарий содержит несколько строк,
   974 	его можно вставить в журнал следующим образом:
   975 <pre class='cline'>
   976 \$ whoami
   977 </pre>
   978 <pre class='output'>
   979 user
   980 </pre>
   981 <pre class='cline'>
   982 \$ cat > /dev/null #^ Интересно, кто я?
   983 </pre>
   984 <pre class='output'>
   985 Программа whoami выводит имя пользователя, под которым 
   986 мы зарегистрировались в системе.
   987 -
   988 Она не может ответить на вопрос о нашем назначении 
   989 в этом мире.
   990 </pre>
   991 	В журнале это будет выглядеть так:
   992 <table>
   993 <tr class='command'>
   994 <td class='script'>
   995 <pre class='cline'>
   996 \$ whoami</pre>
   997 <pre class='output'>user
   998 </pre>
   999 <table class='note'><tr><td class='note_title'>Интересно, кто я?</td></tr><tr><td width='100%' class='note_text'>
  1000 Программа whoami выводит имя пользователя, под которым<br/>
  1001 мы зарегистрировались в системе.<br/>
  1002 <br/>
  1003 Она не может ответить на вопрос о нашем назначении<br/>
  1004 в этом мире.<br/>
  1005 </td></tr></table>
  1006 </td>
  1007 </tr>
  1008 </table>
  1009 	Для разделения нескольких абзацев между собой
  1010 	используйте символ "-", один в строке.
  1011 	<br/>
  1012 </p></li>
  1013 	<li><p>
  1014 	Комментарии, не относящиеся непосредственно ни к какой из команд, 
  1015 	добавляются точно таким же способом, только вместо симолов #^ или #v 
  1016 	нужно использовать символы #=
  1017 	</p></li>
  1018 </ul>
  1019 HELP
  1021 $Html_About = <<ABOUT;
  1022 	<p>
  1023 	LiLaLo (L3) расшифровывается как Live Lab Log.<br/>
  1024 	Программа разработана для повышения эффективности обучения Unix/Linux-системам.<br/>
  1025 	(c) Игорь Чубин, 2004-2005<br/>
  1026 	</p>
  1027 ABOUT
  1028 $Html_About.='$Id$ </p>';
  1030 $Html_JavaScript = <<JS;
  1031 	function getElementsByClassName(Class_Name)
  1032 	{
  1033 		var Result=new Array();
  1034 		var All_Elements=document.all || document.getElementsByTagName('*');
  1035 		for (i=0; i<All_Elements.length; i++)
  1036 			if (All_Elements[i].className==Class_Name)
  1037 		Result.push(All_Elements[i]);
  1038 		return Result;
  1039 	}
  1040 	function ShowHide (name)
  1041 	{
  1042 		elements=getElementsByClassName(name);
  1043 		for(i=0; i<elements.length; i++)
  1044 			if (elements[i].style.display == "none")
  1045 				elements[i].style.display = "";
  1046 			else
  1047 				elements[i].style.display = "none";
  1048 			//if (elements[i].style.visibility == "hidden")
  1049 			//	elements[i].style.visibility = "visible";
  1050 			//else
  1051 			//	elements[i].style.visibility = "hidden";
  1052 	}
  1053 	function filter_by_output(text)
  1054 	{
  1056 		var jjj=0;
  1058 		elements=getElementsByClassName('command');
  1059 		for(i=0; i<elements.length; i++) {
  1060 			subelems = elements[i].getElementsByTagName('pre');
  1061 			for(j=0; j<subelems.length; j++) {
  1062 				if (subelems[j].className = 'output') {
  1063 					var str = new String(subelems[j].nodeValue);
  1064 					if (jjj != 1) { 
  1065 						alert(str);
  1066 						jjj=1;
  1067 					}
  1068 					if (str.indexOf(text) >0) 
  1069 						subelems[j].style.display = "none";
  1070 					else
  1071 						subelems[j].style.display = "";
  1073 				}
  1075 			}
  1076 		}		
  1078 	}
  1079 JS
  1081 %Search_Machines = (
  1082 		"google" => 	{ 	"query" => 	"http://www.google.com/search?q=" ,
  1083 					"icon" 	=> 	"$Config{frontend_google_ico}" },
  1084 		"freebsd" => 	{ 	"query" => 	"http://www.freebsd.org/cgi/man.cgi?query=",
  1085 					"icon"	=>	"$Config{frontend_freebsd_ico}" },
  1086 		"linux"  => 	{ 	"query" => 	"http://man.he.net/?topic=",
  1087 					"icon"	=>	"$Config{frontend_linux_ico}"},
  1088 		"opennet"  => 	{ 	"query" => 	"http://www.opennet.ru/search.shtml?words=",
  1089 					"icon"	=>	"$Config{frontend_opennet_ico}"},
  1090 		"local" => 	{ 	"query" => 	"http://www.freebsd.org/cgi/man.cgi?query=",
  1091 					"icon"	=>	"$Config{frontend_local_ico}" },
  1093 	);
  1095 %Elements_Visibility = (
  1096 		"note"		=>	"замечания",
  1097 		"diff"		=>	"редактор",
  1098 		"time"		=>	"время",
  1099 		"ttychange" 	=>	"терминал",
  1100 		"wrong_output wrong_cline wrong_root_output wrong_root_cline" 
  1101 				=>	"команды с ошибками",
  1102 		"interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline" 
  1103 				=>	"прерванные команды",
  1104 		"tab_completion_output tab_completion_cline"	
  1105 				=> 	"продолжение с помощью tab"
  1106 );
  1108 @Day_Name      = qw/ Воскресенье Понедельник Вторник Среда Четверг Пятница Суббота /;
  1109 @Month_Name    = qw/ Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь /;
  1110 @Of_Month_Name = qw/ Января Февраля Марта Апреля Мая Июня Июля Августа Сентября Октября Ноября Декабря /;
  1111 }
