lilalo
view l3-frontend @ 62:c4bea959dbb1
Beautyfication of l3-agent code. Many lines were erased. Need to be tested
| author | devi |
|---|---|
| date | Thu Jan 26 00:00:53 2006 +0200 (2006-01-26) |
| parents | 4d7e45bc659b |
| children | 1864df6ccbfe |
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 my %mywi_cache_for; # Кэш для экономии обращений к mywi
28 sub make_comment;
29 sub make_new_commands_table;
30 sub load_command_lines_from_xml;
31 sub load_sessions_from_xml;
32 sub sort_command_lines;
33 sub process_command_lines;
34 sub init_variables;
35 sub main;
36 sub collapse_list($);
38 sub print_all;
39 sub print_command_lines;
40 sub print_stat;
41 sub print_header;
42 sub print_footer;
44 main();
46 sub main
47 {
48 $| = 1;
50 init_variables();
51 init_config();
53 open_mywi_socket();
54 load_command_lines_from_xml($Config{"backend_datafile"});
55 load_sessions_from_xml($Config{"backend_datafile"});
56 sort_command_lines;
57 process_command_lines;
58 print_all($Config{"output"});
59 close_mywi_socket;
60 }
62 # extract_from_cline
64 # In: $what = commands | args
65 # Out: return ссылка на хэш, содержащий результаты разбора
66 # команда => позиция
68 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
69 # номер первого появление команды в строке:
70 # команда => первая позиция
71 sub extract_from_cline
72 {
73 my $what = $_[0];
74 my $cline = $_[1];
75 my @lists = split /\;/, $cline;
78 my @command_lines = ();
79 for my $command_list (@lists) {
80 push(@command_lines, split(/\|/, $command_list));
81 }
83 my %position_of_command;
84 my %position_of_arg;
85 my $i=0;
86 for my $command_line (@command_lines) {
87 $command_line =~ s@^\s*@@;
88 $command_line =~ /\s*(\S+)\s*(.*)/;
89 if ($1 && $1 eq "sudo" ) {
90 $position_of_command{"$1"}=$i++;
91 $command_line =~ s/\s*sudo\s+//;
92 }
93 if ($command_line !~ m@^\s*\S*/etc/@) {
94 $command_line =~ s@^\s*\S+/@@;
95 }
97 $command_line =~ /\s*(\S+)\s*(.*)/;
98 my $command = $1;
99 my $args = $2;
100 if ($command && !defined $position_of_command{"$command"}) {
101 $position_of_command{"$command"}=$i++;
102 };
103 if ($args) {
104 my @args = split (/\s+/, $args);
105 for my $a (@args) {
106 $position_of_arg{"$a"}=$i++
107 if !defined $position_of_arg{"$a"};
108 };
109 }
110 }
112 if ($what eq "commands") {
113 return \%position_of_command;
114 } else {
115 return \%position_of_arg;
116 }
118 }
123 #
124 # Подпрограммы для работы с mywi
125 #
127 sub open_mywi_socket
128 {
129 $Mywi_Socket = IO::Socket::INET->new(
130 PeerAddr => $Config{mywi_server},
131 PeerPort => $Config{mywi_port},
132 Proto => "tcp",
133 Type => SOCK_STREAM);
134 }
136 sub close_mywi_socket
137 {
138 close ($Mywi_Socket) if $Mywi_Socket ;
139 }
142 sub mywi_client
143 {
144 my $query = $_[0];
145 my $mywi;
147 open_mywi_socket;
148 if ($Mywi_Socket) {
149 local $| = 1;
150 local $/ = "";
151 print $Mywi_Socket $query."\n";
152 $mywi = <$Mywi_Socket>;
153 $mywi = "" if $mywi =~ /nothing app/;
154 }
155 close_mywi_socket;
156 return $mywi;
157 }
159 sub make_comment
160 {
161 my $cline = $_[0];
162 #my $files = $_[1];
164 my @comments;
165 my @commands = keys %{extract_from_cline("commands", $cline)};
166 my @args = keys %{extract_from_cline("args", $cline)};
167 return if (!@commands && !@args);
168 #return "commands=".join(" ",@commands)."; files=".join(" ",@files);
170 # Commands
171 for my $command (@commands) {
172 $command =~ s/'//g;
173 $CommandsFDistribution{$command}++;
174 if (!$Commands_Description{$command}) {
175 $mywi_cache_for{$command} ||= mywi_client ($command) || "";
176 my $mywi = join ("\n", grep(/\([18]\)/, split(/\n/, $mywi_cache_for{$command})));
177 $mywi =~ s/\s+/ /;
178 if ($mywi !~ /^\s*$/) {
179 $Commands_Description{$command} = $mywi;
180 }
181 else {
182 next;
183 }
184 }
186 push @comments, $Commands_Description{$command};
187 }
188 return join(" \n", @comments);
190 # Files
191 for my $arg (@args) {
192 $arg =~ s/'//g;
193 if (!$Args_Description{$arg}) {
194 my $mywi;
195 $mywi = mywi_client ($arg);
196 $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));
197 $mywi =~ s/\s+/ /;
198 if ($mywi !~ /^\s*$/) {
199 $Args_Description{$arg} = $mywi;
200 }
201 else {
202 next;
203 }
204 }
206 push @comments, $Args_Description{$arg};
207 }
209 }
211 =cut
212 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
213 из XML-документа в переменную @Command_Lines
215 # In: $datafile имя файла
216 # Out: @CommandLines загруженные командные строки
218 Предупреждение!
219 Процедура не в состоянии обрабатывать XML-документ любой структуры.
220 В действительности файл cache из которого загружаются данные
221 просто напоминает XML с виду.
222 =cut
223 sub load_command_lines_from_xml
224 {
225 my $datafile = $_[0];
227 open (CLASS, $datafile)
228 or die "Can't open file of the class ",$datafile,"\n";
229 local $/;
230 $data = <CLASS>;
231 close(CLASS);
233 for $command ($data =~ m@<command>(.*?)</command>@sg) {
234 my %cl;
235 while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {
236 $cl{$1} = $2;
237 }
238 push @Command_Lines, \%cl;
239 }
240 }
242 sub load_sessions_from_xml
243 {
244 my $datafile = $_[0];
246 open (CLASS, $datafile)
247 or die "Can't open file of the class ",$datafile,"\n";
248 local $/;
249 my $data = <CLASS>;
250 close(CLASS);
252 for my $session ($data =~ m@<session>(.*?)</session>@sg) {
253 my %session;
254 while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {
255 $session{$1} = $2;
256 }
257 $Sessions{$session{local_session_id}} = \%session;
258 }
259 }
262 # sort_command_lines
263 # In: @Command_Lines
264 # Out: @Command_Lies_Index
266 sub sort_command_lines
267 {
269 my @index;
270 for (my $i=0;$i<=$#Command_Lines;$i++) {
271 $index[$i]=$i;
272 }
274 @Command_Lines_Index = sort {
275 $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}
276 } @index;
278 }
280 ##################
281 # process_command_lines
282 #
283 # Обрабатываются командные строки @Command_Lines
284 # Для каждой строки определяется:
285 # class класс
286 # note комментарий
287 #
288 # In: @Command_Lines_Index
289 # In-Out: @Command_Lines
291 sub process_command_lines
292 {
293 for my $i (@Command_Lines_Index) {
294 my $cl = \$Command_Lines[$i];
296 next if !$cl;
298 $$cl->{err} ||=0;
300 # Класс команды
302 $$cl->{"class"} = $$cl->{"err"} eq 130 ? "interrupted"
303 : $$cl->{"err"} eq 127 ? "mistyped"
304 : $$cl->{"err"} ? "wrong"
305 : "normal";
307 if ($$cl->{"cline"} =~ /[^|`]\s*sudo/
308 || $$cl->{"uid"} eq 0) {
309 $$cl->{"class"}.="_root";
310 }
313 #Обработка пометок
314 # Если несколько пометок (notes) идут подряд,
315 # они все объединяются
317 if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) {
319 my $note_operator = $1;
320 my $note_title = $2;
322 if ($note_operator eq "=") {
323 $$cl->{"class"} = "note";
324 $$cl->{"note"} = $$cl->{"output"};
325 $$cl->{"note_title"} = $2;
326 }
327 else {
328 my $j = $i;
329 if ($note_operator eq "^") {
330 $j--;
331 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
332 }
333 elsif ($note_operator eq "v") {
334 $j++;
335 $j++ while ($j <= @Command_Lines && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
336 }
337 $Command_Lines[$j]->{note_title}=$note_title;
338 $Command_Lines[$j]->{note}.=$$cl->{output};
339 $$cl=0;
340 }
341 }
342 elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) {
344 my $note_operator = $1;
345 my $note_text = $2;
347 if ($note_operator eq "=") {
348 $$cl->{"class"} = "note";
349 $$cl->{"note"} = $note_text;
350 }
351 else {
352 my $j=$i;
353 if ($note_operator eq "^") {
354 $j--;
355 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
356 }
357 elsif ($note_operator eq "v") {
358 $j++;
359 $j++ while ($j <= @Command_Lines && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]);
360 }
361 $Command_Lines[$j]->{note}.="$note_text\n";
362 $$cl=0;
363 }
364 }
365 }
367 }
370 =cut
371 Процедура print_command_lines выводит HTML-представление
372 разобранного lab-скрипта.
374 Разобранный lab-скрипт должен находиться в массиве @Command_Lines
375 =cut
377 sub print_command_lines
378 {
380 my @toc; # Оглавление
381 my $note_number=0;
383 my $result = q();
384 my $this_day_resut = q();
386 my $cl;
387 my $last_tty="";
388 my $last_day=q();
389 my $last_wday=q();
390 my $in_range=0;
392 my $current_command=0;
394 my @known_commands;
396 my %filter;
398 if ($Config{filter}) {
399 # Инициализация фильтра
400 for (split /&/,$Config{filter}) {
401 my ($var, $val) = split /=/;
402 $filter{$var} = $val || "";
403 }
404 }
406 #$result = "Filter=".$Config{filter}."\n";
408 $Stat{LastCommand} ||= 0;
409 $Stat{TotalCommands} ||= 0;
410 $Stat{ErrorCommands} ||= 0;
411 $Stat{MistypedCommands} ||= 0;
413 COMMAND_LINE:
414 for my $k (@Command_Lines_Index) {
416 my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
417 next unless $cl;
419 # Пропускаем команды, с одинаковым временем
420 # Это не совсем правильно.
421 # Возможно, что это команды, набираемые с помощью <completion>
422 # или запомненные с помощью <ctrl-c>
424 next if $Stat{LastCommand} == $cl->{time};
426 # Набираем статистику
427 # Хэш %Stat
429 $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};
430 if ($cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval}) {
431 $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}
432 }
433 $Stat{LastCommand} = $cl->{time};
434 $Stat{TotalCommands}++;
436 # Пропускаем строки, которые противоречат фильтру
437 # Если у нас недостаточно информации о том, подходит строка под фильтр или нет,
438 # мы её выводим
440 #$result .= "before<br/>";
441 for my $filter_key (keys %filter) {
442 #$result .= "undefined local session id<br/>\n" if !defined($cl->{local_session_id});
443 #$result .= "undefined filter key $filter_key <br/>\n" if !defined($Sessions{$cl->{local_session_id}}->{$filter_key});
444 #$result .= $Sessions{$cl->{local_session_id}}->{$filter_key}." != ".$filter{$filter_key};
445 next COMMAND_LINE if
446 defined($cl->{local_session_id})
447 && defined($Sessions{$cl->{local_session_id}}->{$filter_key})
448 && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
449 }
451 # Пропускаем строки, выходящие за границу "signature",
452 # при условии, что границы указаны
453 # Пропускаем неправильные/прерванные/другие команды
454 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
455 $in_range=1;
456 next;
457 }
458 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
459 $in_range=0;
460 next;
461 }
462 next if ($Config{"from"} && $Config{"to"} && !$in_range)
463 || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
464 || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
465 || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
467 if ($cl->{class} eq "note") {
468 my $note = $cl->{note};
469 $note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note)));
470 $note =~ s@(http:[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
471 $note =~ s@(www\.[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
472 $this_day_result .= "<tr><td colspan='6'>"
473 . "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title}
474 . "".$note."<p/><p/></td></tr>";
476 if ($cl->{note_title}) {
477 push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";
478 $note_number++;
479 }
480 next;
481 }
484 my $output="";
485 # Выводим <head_lines> верхних строк
486 # и <tail_lines> нижних строк,
487 # если эти параметры существуют
489 my @lines = split '\n', $cl->{"output"};
490 if (($Config{"head_lines"} || $Config{"tail_lines"})
491 && $#lines > $Config{"head_lines"} + $Config{"tail_lines"} ) {
493 for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
494 $output .= $lines[$i]."\n";
495 }
496 $output .= $Config{"skip_text"}."\n";
498 my $start_line=$#lines-$Config{"tail_lines"}+1;
499 for ($i=$start_line; $i<= $#lines; $i++) {
500 $output .= $lines[$i]."\n";
501 }
502 }
503 else {
504 $output .= $cl->{"output"};
505 }
507 #
508 ##
509 ## Начинается собственно вывод
510 ##
511 #
513 my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
515 # Добавляем спереди 0 для удобочитаемости
516 $min = "0".$min if $min =~ /^.$/;
517 $hour = "0".$hour if $hour =~ /^.$/;
518 $sec = "0".$sec if $sec =~ /^.$/;
520 $class=$cl->{"class"};
521 $Stat{ErrorCommands}++ if $class =~ /wrong/;
522 $Stat{MistypedCommands}++ if $class =~ /mistype/;
525 # DAY CHANGE
526 if ( $last_day ne $day) {
527 if ($last_day) {
529 # Вычисляем разность множеств.
530 # Что-то вроде этого, если бы так можно было писать:
531 # @new_commands = keys %CommandsFDistribution - @known_commands;
534 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
536 my $new_commands_section = make_new_commands_table(\@known_commands);
537 @known_commands = keys %CommandsFDistribution;
539 if ($new_commands_section) {
540 $result .= "<h5>Новые команды</h5>"
541 . "<table class='new_commands_table'>"
542 . "<tr class='new_commands_header'><td>Команда</td><td>Описание</td></tr>"
543 . $new_commands_section
544 . "</table>"
545 }
547 $result .= "<table width='100%'>\n";
548 $result .= $this_day_result;
549 $result .= "</table>";
550 }
552 push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
553 $last_day=$day;
554 $last_wday=$wday;
555 $this_day_result = q();
556 }
558 $this_day_result .= "<tr class='command'>\n";
561 # CONSOLE CHANGE
562 if ( $last_tty ne $cl->{"tty"}) {
563 my $tty = $cl->{"tty"};
564 $this_day_result .= "<td colspan='6'>"
565 ."<table><tr><td class='ttychange' width='140' align='center'>"
566 . $tty
567 ."</td></tr></table>"
568 ."</td></tr><tr>";
569 $last_tty=$cl->{"tty"};
570 }
572 # TIME
573 $this_day_result .= $Config{"show_time"} =~ /^y/i
574 ? "<td valign='top' class='time' width='$Config{time_width}'>$hour:$min:$sec</td>"
575 : "<td width='0'/>";
577 # COMMAND
578 my $hint = make_comment($cl->{"cline"});
580 my $cline;
581 $cline = $cl->{"prompt"}.$cl->{"cline"};
582 $cline =~ s/\n//;
584 $cline = "<span title='$hint' class='with_hint'>$cline</span>" if $hint;
585 $cline = "<span class='without_hint'>$cline</span>" if !$hint;
587 $this_day_result .= "<td class='script'>\n";
588 $this_day_result .= "<pre class='${class}_cline'>\n" . $cline . "</pre>\n";
590 # OUTPUT
591 my $last_command = $cl->{"last_command"};
592 if (!(
593 $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
594 $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
595 $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
596 )) {
597 $this_day_result .= "<pre class='".$class."_output'>" . $output . "</pre>\n";
598 }
600 # DIFF
601 if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
602 $this_day_result .= "<table><tr><td width='5'/><td class='diff'><pre>"
603 . $cl->{"diff"}
604 . "</pre></td></tr></table>";
605 }
607 #NOTES
608 if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {
609 my $note=$cl->{"note"};
610 $note =~ s/\n/<br\/>\n/msg;
611 if (not $note =~ s@(http:[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g) {
612 $note =~ s@(www\.[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g;
613 };
614 # Ширину пока не используем
615 # $this_day_result .= "<table width='$Config{note_width}' class='note'>";
616 $this_day_result .= "<table class='note'>";
617 $this_day_result .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title};
618 $this_day_result .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>";
619 $this_day_result .= "</table>\n";
620 }
622 # COMMENT
623 if ( $Config{"show_comments"} =~ /^y/i) {
624 my $comment = make_comment($cl->{"cline"});
625 if ($comment) {
626 $this_day_result .= "<table width='$Config{comment_width}'><tr><td width='5'/><td>"
627 . "<table class='note' width='100%'>"
628 . $comment
629 . "</table>\n"
630 . "</td></tr></table>";
631 }
632 }
634 # Вывод очередной команды окончен
635 $this_day_result .= "</td>\n";
636 $this_day_result .= "</tr>\n";
637 }
638 last: {
639 my $new_commands_section = make_new_commands_table(\@known_commands);
640 @known_commands = keys %CommandsFDistribution;
642 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
643 if ($new_commands_section) {
644 $result .= "<h5>Новые команды</h5>"
645 . "<table class='new_commands_table'>"
646 . "<tr class='new_commands_header'><td>Команда</td><td>Описание</td></tr>"
647 . $new_commands_section
648 . "</table>"
649 }
651 $result .= "<table width='100%'>\n";
652 $result .= $this_day_result;
653 $result .= "</table>";
654 }
656 return ($result, collapse_list (\@toc));
658 }
660 sub make_new_commands_table
661 {
662 my @known_commands = @{$_[0]};
664 my %count;
665 my @new_commands = ();
666 for my $c (keys %CommandsFDistribution, @known_commands) {
667 $count{$c}++
668 }
669 for my $c (keys %CommandsFDistribution) {
670 push @new_commands, $c if $count{$c} != 2;
671 }
674 my $new_commands_section;
675 if (@new_commands){
676 my $hint;
677 for my $c (reverse sort { $CommandsFDistribution{$a} <=> $CommandsFDistribution{$b} } @new_commands) {
678 $hint = make_comment($c);
679 my ($command, $hint) = $hint =~ m/(.*?) \s*- \s*(.*)/;
680 $new_commands_section .= "<tr><td>$command</td><td>$hint</td></tr>" if $hint;
681 }
682 }
683 return $new_commands_section;
684 }
687 #############
688 # print_all
689 #
690 #
691 #
692 # In: $_[0] output_filename
693 # Out:
696 sub print_all
697 {
698 my $output_filename=$_[0];
700 my $result;
701 my ($command_lines,$toc) = print_command_lines;
703 $result = print_header($toc);
704 $result.= "<h2 id='log'>Журнал</h2>" . $command_lines;
705 $result.= "<h2 id='stat'>Статистика</h2>" . print_stat;
706 $result.= "<h2 id='help'>Справка</h2>" . $Html_Help . "<br/>";
707 $result.= "<h2 id='about'>О программе</h2>". $Html_About. "<br/>";
708 $result.= print_footer;
710 if ($output_filename eq "-") {
711 print $result;
712 }
713 else {
714 open(OUT, ">", $output_filename)
715 or die "Can't open $output_filename for writing\n";
716 print OUT $result;
717 close(OUT);
718 }
719 }
721 #############
722 # print_header
723 #
724 #
725 #
726 # In: $_[0] Содержание
727 # Out: Распечатанный заголовок
729 sub print_header
730 {
731 my $toc = $_[0];
732 my $course_name = $Config{"course-name"};
733 my $course_code = $Config{"course-code"};
734 my $course_date = $Config{"course-date"};
735 my $course_center = $Config{"course-center"};
736 my $course_trainer = $Config{"course-trainer"};
737 my $course_student = $Config{"course-student"};
739 my $title = "Журнал лабораторных работ";
740 $title .= " -- ".$course_student if $course_student;
741 if ($course_date) {
742 $title .= " -- ".$course_date;
743 $title .= $course_code ? "/".$course_code
744 : "";
745 }
746 else {
747 $title .= " -- ".$course_code if $course_code;
748 }
750 # Управляющая форма
751 my $control_form .= "<table id='visibility_form' class='visibility_form'><tr><td>Видимые элементы</TD></tr><tr><td><form>\n";
752 for my $element (keys %Elements_Visibility)
753 {
754 my @e = split /\s+/, $element;
755 my $showhide = join "", map { "ShowHide('$_');" } @e ;
756 $control_form .= "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>".
757 $Elements_Visibility{$element}.
758 "</input><br>\n";
759 }
760 $control_form .= "</form></td></tr></table>\n";
762 my $result;
763 $result = <<HEADER;
764 <html>
765 <head>
766 <meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
767 <link rel='stylesheet' href='$Config{frontend_css}' type='text/css'/>
768 <title>$title</title>
769 </head>
770 <body>
771 <script>
772 $Html_JavaScript
773 </script>
775 <!-- vvv Tigra Hints vvv -->
776 <script language="JavaScript" src="/tigra/hints.js"></script>
777 <script language="JavaScript" src="/tigra/hints_cfg.js"></script>
778 <style>
779 /* a class for all Tigra Hints boxes, TD object */
780 .hintsClass
781 {text-align: center; font-family: Verdana, Arial, Helvetica; padding: 0px 0px 0px 0px;}
782 /* this class is used by Tigra Hints wrappers */
783 .row
784 {background: white;}
785 </style>
786 <!-- ^^^ Tigra Hints ^^^ -->
789 <h1 onmouseover="myHint.show('1')" onmouseout="myHint.hide()">Журнал лабораторных работ</h1>
790 HEADER
791 if ( $course_student
792 || $course_trainer
793 || $course_name
794 || $course_code
795 || $course_date
796 || $course_center) {
797 $result .= "<p>";
798 $result .= "Выполнил $course_student<br/>" if $course_student;
799 $result .= "Проверил $course_trainer <br/>" if $course_trainer;
800 $result .= "Курс " if $course_name
801 || $course_code
802 || $course_date;
803 $result .= "$course_name " if $course_name;
804 $result .= "($course_code)" if $course_code;
805 $result .= ", $course_date<br/>" if $course_date;
806 $result .= "Учебный центр $course_center <br/>" if $course_center;
807 $result .= "</p>";
808 }
810 $result .= <<HEADER;
811 <table width='100%'>
812 <tr>
813 <td width='*'>
815 <table border=0 id='toc' class='toc'>
816 <tr>
817 <td>
818 <div class='toc_title'>Содержание</div>
819 <ul>
820 <li><a href='#log'>Журнал</a></li>
821 <ul>$toc</ul>
822 <li><a href='#stat'>Статистика</a></li>
823 <li><a href='#help'>Справка</a></li>
824 <li><a href='#about'>О программе</a></li>
825 </ul>
826 </td>
827 </tr>
828 </table>
830 </td>
831 <td valign='top' width=200>$control_form</td>
832 </tr>
833 </table>
834 HEADER
836 return $result;
837 }
840 #############
841 # print_footer
842 #
843 #
844 #
845 #
846 #
848 sub print_footer
849 {
850 return "</body>\n</html>\n";
851 }
856 #############
857 # print_stat
858 #
859 #
860 #
861 # In:
862 # Out:
864 sub print_stat
865 {
866 %StatNames = (
867 FirstCommand => "Время первой команды журнала",
868 LastCommand => "Время последней команды журнала",
869 TotalCommands => "Количество командных строк в журнале",
870 ErrorsPercentage => "Процент команд с ненулевым кодом завершения, %",
871 MistypesPercentage => "Процент синтаксически неверно набранных команд, %",
872 TotalTime => "Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час",
873 CommandsPerTime => "Количество командных строк в единицу времени, команда/мин",
874 CommandsFrequency => "Частота использования команд",
875 RareCommands => "Частота использования этих команд < 0.5%",
876 );
877 @StatOrder = (
878 FirstCommand,
879 LastCommand,
880 TotalCommands,
881 ErrorsPercentage,
882 MistypesPercentage,
883 TotalTime,
884 CommandsPerTime,
885 CommandsFrequency,
886 RareCommands,
887 );
889 # Подготовка статистики к выводу
890 # Некоторые значения пересчитываются!
891 # Дальше их лучше уже не использовать!!!
893 my %CommandsFrequency = %CommandsFDistribution;
895 $Stat{TotalTime} ||= 0;
896 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{FirstCommand} || 0);
897 $Stat{FirstCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec, $year+1900, $mon+1, $mday;
898 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{LastCommand} || 0);
899 $Stat{LastCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec, $year+1900, $mon+1, $mday;
900 if ($Stat{TotalCommands}) {
901 $Stat{ErrorsPercentage} = sprintf "%5.2f", $Stat{ErrorCommands}*100/$Stat{TotalCommands};
902 $Stat{MistypesPercentage} = sprintf "%5.2f", $Stat{MistypedCommands}*100/$Stat{TotalCommands};
903 }
904 $Stat{CommandsPerTime} = sprintf "%5.2f", $Stat{TotalCommands}*60/$Stat{TotalTime}
905 if $Stat{TotalTime};
906 $Stat{TotalTime} = sprintf "%5.2f", $Stat{TotalTime}/60/60;
908 my $total_commands=0;
909 for $command (keys %CommandsFrequency){
910 $total_commands += $CommandsFrequency{$command};
911 }
912 if ($total_commands) {
913 for $command (reverse sort {$CommandsFrequency{$a} <=> $CommandsFrequency{$b}} keys %CommandsFrequency){
914 my $command_html;
915 my $percentage = sprintf "%5.2f",$CommandsFrequency{$command}*100/$total_commands;
916 if ($percentage < 0.5) {
917 my $hint = make_comment($command);
918 $command_html = "$command";
919 $command_html = "<span title='$hint' class='with_hint'>$command_html</span>" if $hint;
920 $command_html = "<span class='without_hint'>$command_html</span>" if not $hint;
921 my $command_html = "<tt>$command_html</tt>";
922 $Stat{RareCommands} .= $command_html."<sub><font size='-2'>".$CommandsFrequency{$command}."</font></sub> , ";
923 }
924 else {
925 my $hint = make_comment($command);
926 $command_html = "$command";
927 $command_html = "<span title='$hint' class='with_hint'>$command_html</span>" if $hint;
928 $command_html = "<span class='without_hint'>$command_html</span>" if not $hint;
929 my $command_html = "<tt>$command_html</tt>";
930 $percentage = sprintf "%5.2f",$percentage;
931 $Stat{CommandsFrequency} .= "<tr><td>".$command_html."</td><td>".$CommandsFrequency{$command}."</td>".
932 "<td>|".("="x int($CommandsFrequency{$command}*100/$total_commands))."| $percentage%</td></tr>";
933 }
934 }
935 $Stat{CommandsFrequency} = "<table>".$Stat{CommandsFrequency}."</table>";
936 $Stat{RareCommands} =~ s/, $// if $Stat{RareCommands};
937 }
939 my $result = q();
940 for my $stat (@StatOrder) {
941 next unless $Stat{"$stat"};
942 $result .= "<tr valign='top'><td width='300'>".$StatNames{"$stat"}."</td><td>".$Stat{"$stat"}."</td></tr>"
943 }
944 $result = "<table>$result</table>"
945 . "<font size='-2'>____<br/>*) Интервалы неактивности длительностью "
946 . ($Config{stat_inactivity_interval}/60)
947 . " минут и более не учитываются</font></br>";
949 return $result;
950 }
953 sub collapse_list($)
954 {
955 my $res = "";
956 for my $elem (@{$_[0]}) {
957 if (ref $elem eq "ARRAY") {
958 $res .= "<ul>".collapse_list($elem)."</ul>";
959 }
960 else
961 {
962 $res .= "<li>".$elem."</li>";
963 }
964 }
965 return $res;
966 }
971 sub init_variables
972 {
973 $Html_Help = <<HELP;
974 Для того чтобы использовать LiLaLo, не нужно знать ничего особенного:
975 всё происходит само собой.
976 Однако, чтобы ведение и последующее использование журналов
977 было как можно более эффективным, желательно иметь в виду следующее:
978 <ol>
979 <li><p>
980 В журнал автоматически попадают все команды, данные в любом терминале системы.
981 </p></li>
982 <li><p>
983 Для того чтобы убедиться, что журнал на текущем терминале ведётся,
984 и команды записываются, дайте команду w.
985 В поле WHAT, соответствующем текущему терминалу,
986 должна быть указана программа script.
987 </p></li>
988 <li><p>
989 Команды, при наборе которых были допущены синтаксические ошибки,
990 выводятся перечёркнутым текстом:
991 <table>
992 <tr class='command'>
993 <td class='script'>
994 <pre class='mistyped_cline'>
995 \$ l s-l</pre>
996 <pre class='mistyped_output'>bash: l: command not found
997 </pre>
998 </td>
999 </tr>
1000 </table>
1001 <br/>
1002 </p></li>
1003 <li><p>
1004 Если код завершения команды равен нулю,
1005 команда была выполнена без ошибок.
1006 Команды, код завершения которых отличен от нуля, выделяются цветом.
1007 <table>
1008 <tr class='command'>
1009 <td class='script'>
1010 <pre class='wrong_cline'>
1011 \$ test 5 -lt 4</pre>
1012 </pre>
1013 </td>
1014 </tr>
1015 </table>
1016 Обратите внимание на то, что код завершения команды может быть отличен от нуля
1017 не только в тех случаях, когда команда была выполнена с ошибкой.
1018 Многие команды используют код завершения, например, для того чтобы показать результаты проверки
1019 <br/>
1020 </p></li>
1021 <li><p>
1022 Команды, ход выполнения которых был прерван пользователем, выделяются цветом.
1023 <table>
1024 <tr class='command'>
1025 <td class='script'>
1026 <pre class='interrupted_cline'>
1027 \$ find / -name abc</pre>
1028 <pre class='interrupted_output'>find: /home/devi-orig/.gnome2: Keine Berechtigung
1029 find: /home/devi-orig/.gnome2_private: Keine Berechtigung
1030 find: /home/devi-orig/.nautilus/metafiles: Keine Berechtigung
1031 find: /home/devi-orig/.metacity: Keine Berechtigung
1032 find: /home/devi-orig/.inkscape: Keine Berechtigung
1033 ^C
1034 </pre>
1035 </td>
1036 </tr>
1037 </table>
1038 <br/>
1039 </p></li>
1040 <li><p>
1041 Команды, выполненные с привилегиями суперпользователя,
1042 выделяются слева красной чертой.
1043 <table>
1044 <tr class='command'>
1045 <td class='script'>
1046 <pre class='_root_cline'>
1047 # id</pre>
1048 <pre class='_root_output'>
1049 uid=0(root) gid=0(root) Gruppen=0(root)
1050 </pre>
1051 </td>
1052 </tr>
1053 </table>
1054 <br/>
1055 </p></li>
1056 <li><p>
1057 Изменения, внесённые в текстовый файл с помощью редактора,
1058 запоминаются и показываются в журнале в формате ed.
1059 Строки, начинающиеся символом "<", удалены, а строки,
1060 начинающиеся символом ">" -- добавлены.
1061 <table>
1062 <tr class='command'>
1063 <td class='script'>
1064 <pre class='cline'>
1065 \$ vi ~/.bashrc</pre>
1066 <table><tr><td width='5'/><td class='diff'><pre>2a3,5
1067 > if [ -f /usr/local/etc/bash_completion ]; then
1068 > . /usr/local/etc/bash_completion
1069 > fi
1070 </pre></td></tr></table></td>
1071 </tr>
1072 </table>
1073 <br/>
1074 </p></li>
1075 <li><p>
1076 Для того чтобы изменить файл в соответствии с показанными в диффшоте
1077 изменениями, можно воспользоваться командой patch.
1078 Нужно скопировать изменения, запустить программу patch, указав в
1079 качестве её аргумента файл, к которому применяются изменения,
1080 и всавить скопированный текст:
1081 <table>
1082 <tr class='command'>
1083 <td class='script'>
1084 <pre class='cline'>
1085 \$ patch ~/.bashrc</pre>
1086 </td>
1087 </tr>
1088 </table>
1089 В данном случае изменения применяются к файлу ~/.bashrc
1090 </p></li>
1091 <li><p>
1092 Для того чтобы получить краткую справочную информацию о команде,
1093 нужно подвести к ней мышь. Во всплывающей подсказке появится краткое
1094 описание команды.
1095 </p>
1096 <p>
1097 Если справочная информация о команде есть,
1098 команда выделяется голубым фоном, например: <span class="with_hint" title="главный текстовый редактор Unix">vi</span>.
1099 Если справочная информация отсутствует,
1100 команда выделяется розовым фоном, например: <span class="without_hint">notepad.exe</span>.
1101 Справочная информация может отсутствовать в том случае,
1102 если (1) команда введена неверно; (2) если распознавание команды LiLaLo выполнено неверно;
1103 (3) если информация о команде неизвестна LiLaLo.
1104 Последнее возможно для редких команд.
1105 </p></li>
1106 <li><p>
1107 Большие, в особенности многострочные, всплывающие подсказки лучше
1108 всего показываются браузерами KDE Konqueror, Apple Safari и Microsoft Internet Explorer.
1109 В браузерах Mozilla и Firefox они отображаются не полностью,
1110 а вместо перевода строки выводится специальный символ.
1111 </p></li>
1112 <li><p>
1113 Время ввода команды, показанное в журнале, соответствует времени
1114 <i>начала ввода командной строки</i>, которое равно тому моменту,
1115 когда на терминале появилось приглашение интерпретатора
1116 </p></li>
1117 <li><p>
1118 Имя терминала, на котором была введена команда, показано в специальном блоке.
1119 Этот блок показывается только в том случае, если терминал
1120 текущей команды отличается от терминала предыдущей.
1121 </p></li>
1122 <li><p>
1123 Вывод не интересующих вас в настоящий момент элементов журнала,
1124 таких как время, имя терминала и других, можно отключить.
1125 Для этого нужно воспользоваться <a href='#visibility_form'>формой управления журналом</a>
1126 вверху страницы.
1127 </p></li>
1128 <li><p>
1129 Небольшие комментарии к командам можно вставлять прямо из командной строки.
1130 Комментарий вводится прямо в командную строку, после символов #^ или #v.
1131 Символы ^ и v показывают направление выбора команды, к которой относится комментарий:
1132 ^ - к предыдущей, v - к следующей.
1133 Например, если в командной строке было введено:
1134 <pre class='cline'>
1135 \$ whoami
1136 </pre>
1137 <pre class='output'>
1138 user
1139 </pre>
1140 <pre class='cline'>
1141 \$ #^ Интересно, кто я?
1142 </pre>
1143 в журнале это будет выглядеть так:
1145 <pre class='cline'>
1146 \$ whoami
1147 </pre>
1148 <pre class='output'>
1149 user
1150 </pre>
1151 <table class='note'><tr><td width='100%' class='note_text'>
1152 <tr> <td> Интересно, кто я?<br/> </td></tr></table>
1153 </p></li>
1154 <li><p>
1155 Если комментарий содержит несколько строк,
1156 его можно вставить в журнал следующим образом:
1157 <pre class='cline'>
1158 \$ whoami
1159 </pre>
1160 <pre class='output'>
1161 user
1162 </pre>
1163 <pre class='cline'>
1164 \$ cat > /dev/null #^ Интересно, кто я?
1165 </pre>
1166 <pre class='output'>
1167 Программа whoami выводит имя пользователя, под которым
1168 мы зарегистрировались в системе.
1169 -
1170 Она не может ответить на вопрос о нашем назначении
1171 в этом мире.
1172 </pre>
1173 В журнале это будет выглядеть так:
1174 <table>
1175 <tr class='command'>
1176 <td class='script'>
1177 <pre class='cline'>
1178 \$ whoami</pre>
1179 <pre class='output'>user
1180 </pre>
1181 <table class='note'><tr><td class='note_title'>Интересно, кто я?</td></tr><tr><td width='100%' class='note_text'>
1182 Программа whoami выводит имя пользователя, под которым<br/>
1183 мы зарегистрировались в системе.<br/>
1184 <br/>
1185 Она не может ответить на вопрос о нашем назначении<br/>
1186 в этом мире.<br/>
1187 </td></tr></table>
1188 </td>
1189 </tr>
1190 </table>
1191 Для разделения нескольких абзацев между собой
1192 используйте символ "-", один в строке.
1193 <br/>
1194 </p></li>
1195 <li><p>
1196 Комментарии, не относящиеся непосредственно ни к какой из команд,
1197 добавляются точно таким же способом, только вместо симолов #^ или #v
1198 нужно использовать символы #=
1199 </p></li>
1200 </ol>
1201 HELP
1203 $Html_About = <<ABOUT;
1204 <p>
1205 LiLaLo (L3) расшифровывается как Live Lab Log.<br/>
1206 Программа разработана для повышения эффективности обучения Unix/Linux-системам.<br/>
1207 (c) Игорь Чубин, 2004-2005<br/>
1208 </p>
1209 ABOUT
1210 $Html_About.='$Id$ </p>';
1212 $Html_JavaScript = <<JS;
1213 function getElementsByClassName(Class_Name)
1214 {
1215 var Result=new Array();
1216 var All_Elements=document.all || document.getElementsByTagName('*');
1217 for (i=0; i<All_Elements.length; i++)
1218 if (All_Elements[i].className==Class_Name)
1219 Result.push(All_Elements[i]);
1220 return Result;
1221 }
1222 function ShowHide (name)
1223 {
1224 elements=getElementsByClassName(name);
1225 for(i=0; i<elements.length; i++)
1226 if (elements[i].style.display == "none")
1227 elements[i].style.display = "";
1228 else
1229 elements[i].style.display = "none";
1230 //if (elements[i].style.visibility == "hidden")
1231 // elements[i].style.visibility = "visible";
1232 //else
1233 // elements[i].style.visibility = "hidden";
1234 }
1235 function filter_by_output(text)
1236 {
1238 var jjj=0;
1240 elements=getElementsByClassName('command');
1241 for(i=0; i<elements.length; i++) {
1242 subelems = elements[i].getElementsByTagName('pre');
1243 for(j=0; j<subelems.length; j++) {
1244 if (subelems[j].className = 'output') {
1245 var str = new String(subelems[j].nodeValue);
1246 if (jjj != 1) {
1247 alert(str);
1248 jjj=1;
1249 }
1250 if (str.indexOf(text) >0)
1251 subelems[j].style.display = "none";
1252 else
1253 subelems[j].style.display = "";
1255 }
1257 }
1258 }
1260 }
1261 JS
1263 %Search_Machines = (
1264 "google" => { "query" => "http://www.google.com/search?q=" ,
1265 "icon" => "$Config{frontend_google_ico}" },
1266 "freebsd" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=",
1267 "icon" => "$Config{frontend_freebsd_ico}" },
1268 "linux" => { "query" => "http://man.he.net/?topic=",
1269 "icon" => "$Config{frontend_linux_ico}"},
1270 "opennet" => { "query" => "http://www.opennet.ru/search.shtml?words=",
1271 "icon" => "$Config{frontend_opennet_ico}"},
1272 "local" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=",
1273 "icon" => "$Config{frontend_local_ico}" },
1275 );
1277 %Elements_Visibility = (
1278 "note" => "замечания",
1279 "diff" => "редактор",
1280 "time" => "время",
1281 "ttychange" => "терминал",
1282 "wrong_output wrong_cline wrong_root_output wrong_root_cline"
1283 => "команды с ошибками",
1284 "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline"
1285 => "прерванные команды",
1286 "tab_completion_output tab_completion_cline"
1287 => "продолжение с помощью tab"
1288 );
1290 @Day_Name = qw/ Воскресенье Понедельник Вторник Среда Четверг Пятница Суббота /;
1291 @Month_Name = qw/ Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь /;
1292 @Of_Month_Name = qw/ Января Февраля Марта Апреля Мая Июня Июля Августа Сентября Октября Ноября Декабря /;
1293 }
1298 # Временно удалённый код
1299 # Возможно, он не понадобится уже никогда
1302 sub search_by
1303 {
1304 my $sm = shift;
1305 my $topic = shift;
1306 $topic =~ s/ /+/;
1308 return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='".
1309 $Search_Machines{$sm}->{"icon"}."' border='0'/></a>";
1310 }