lilalo
view l3-frontend @ 67:70db89d4f840
Prishlos vernut sortirovku
| author | devi |
|---|---|
| date | Fri Jan 27 19:47:23 2006 +0200 (2006-01-27) |
| parents | 3326053f9b23 |
| children | 8c3d80c4891b |
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; # Сколько раз в журнале встречается какая команда
25 our $table_number=1;
27 my %mywi_cache_for; # Кэш для экономии обращений к mywi
29 sub make_comment;
30 sub make_new_entries_table;
31 sub load_command_lines_from_xml;
32 sub load_sessions_from_xml;
33 sub sort_command_lines;
34 sub process_command_lines;
35 sub init_variables;
36 sub main;
37 sub collapse_list($);
39 sub print_all;
40 sub print_command_lines;
41 sub print_stat;
42 sub print_header;
43 sub print_footer;
45 main();
47 sub main
48 {
49 $| = 1;
51 init_variables();
52 init_config();
54 open_mywi_socket();
55 load_command_lines_from_xml($Config{"backend_datafile"});
56 load_sessions_from_xml($Config{"backend_datafile"});
57 sort_command_lines;
58 process_command_lines;
59 print_all($Config{"output"});
60 close_mywi_socket;
61 }
63 # extract_from_cline
65 # In: $what = commands | args
66 # Out: return ссылка на хэш, содержащий результаты разбора
67 # команда => позиция
69 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
70 # номер первого появление команды в строке:
71 # команда => первая позиция
72 sub extract_from_cline
73 {
74 my $what = $_[0];
75 my $cline = $_[1];
76 my @lists = split /\;/, $cline;
79 my @command_lines = ();
80 for my $command_list (@lists) {
81 push(@command_lines, split(/\|/, $command_list));
82 }
84 my %position_of_command;
85 my %position_of_arg;
86 my $i=0;
87 for my $command_line (@command_lines) {
88 $command_line =~ s@^\s*@@;
89 $command_line =~ /\s*(\S+)\s*(.*)/;
90 if ($1 && $1 eq "sudo" ) {
91 $position_of_command{"$1"}=$i++;
92 $command_line =~ s/\s*sudo\s+//;
93 }
94 if ($command_line !~ m@^\s*\S*/etc/@) {
95 $command_line =~ s@^\s*\S+/@@;
96 }
98 $command_line =~ /\s*(\S+)\s*(.*)/;
99 my $command = $1;
100 my $args = $2;
101 if ($command && !defined $position_of_command{"$command"}) {
102 $position_of_command{"$command"}=$i++;
103 };
104 if ($args) {
105 my @args = split (/\s+/, $args);
106 for my $a (@args) {
107 $position_of_arg{"$a"}=$i++
108 if !defined $position_of_arg{"$a"};
109 };
110 }
111 }
113 if ($what eq "commands") {
114 return \%position_of_command;
115 } else {
116 return \%position_of_arg;
117 }
119 }
124 #
125 # Подпрограммы для работы с mywi
126 #
128 sub open_mywi_socket
129 {
130 $Mywi_Socket = IO::Socket::INET->new(
131 PeerAddr => $Config{mywi_server},
132 PeerPort => $Config{mywi_port},
133 Proto => "tcp",
134 Type => SOCK_STREAM);
135 }
137 sub close_mywi_socket
138 {
139 close ($Mywi_Socket) if $Mywi_Socket ;
140 }
143 sub mywi_client
144 {
145 my $query = $_[0];
146 my $mywi;
148 open_mywi_socket;
149 if ($Mywi_Socket) {
150 local $| = 1;
151 local $/ = "";
152 print $Mywi_Socket $query."\n";
153 $mywi = <$Mywi_Socket>;
154 $mywi = "" if $mywi =~ /nothing app/;
155 }
156 close_mywi_socket;
157 return $mywi;
158 }
160 sub make_comment
161 {
162 my $cline = $_[0];
163 #my $files = $_[1];
165 my @comments;
166 my @commands = keys %{extract_from_cline("commands", $cline)};
167 my @args = keys %{extract_from_cline("args", $cline)};
168 return if (!@commands && !@args);
169 #return "commands=".join(" ",@commands)."; files=".join(" ",@files);
171 # Commands
172 for my $command (@commands) {
173 $command =~ s/'//g;
174 $CommandsFDistribution{$command}++;
175 if (!$Commands_Description{$command}) {
176 $mywi_cache_for{$command} ||= mywi_client ($command) || "";
177 my $mywi = join ("\n", grep(/\([18]|sh|script\)/, split(/\n/, $mywi_cache_for{$command})));
178 $mywi =~ s/\s+/ /;
179 if ($mywi !~ /^\s*$/) {
180 $Commands_Description{$command} = $mywi;
181 }
182 else {
183 next;
184 }
185 }
187 push @comments, $Commands_Description{$command};
188 }
189 return join(" \n", @comments);
191 # Files
192 for my $arg (@args) {
193 $arg =~ s/'//g;
194 if (!$Args_Description{$arg}) {
195 my $mywi;
196 $mywi = mywi_client ($arg);
197 $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));
198 $mywi =~ s/\s+/ /;
199 if ($mywi !~ /^\s*$/) {
200 $Args_Description{$arg} = $mywi;
201 }
202 else {
203 next;
204 }
205 }
207 push @comments, $Args_Description{$arg};
208 }
210 }
212 =cut
213 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
214 из XML-документа в переменную @Command_Lines
216 # In: $datafile имя файла
217 # Out: @CommandLines загруженные командные строки
219 Предупреждение!
220 Процедура не в состоянии обрабатывать XML-документ любой структуры.
221 В действительности файл cache из которого загружаются данные
222 просто напоминает XML с виду.
223 =cut
224 sub load_command_lines_from_xml
225 {
226 my $datafile = $_[0];
228 open (CLASS, $datafile)
229 or die "Can't open file of the class ",$datafile,"\n";
230 local $/;
231 $data = <CLASS>;
232 close(CLASS);
234 for $command ($data =~ m@<command>(.*?)</command>@sg) {
235 my %cl;
236 while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {
237 $cl{$1} = $2;
238 }
239 push @Command_Lines, \%cl;
240 }
241 }
243 sub load_sessions_from_xml
244 {
245 my $datafile = $_[0];
247 open (CLASS, $datafile)
248 or die "Can't open file of the class ",$datafile,"\n";
249 local $/;
250 my $data = <CLASS>;
251 close(CLASS);
253 for my $session ($data =~ m@<session>(.*?)</session>@sg) {
254 my %session;
255 while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {
256 $session{$1} = $2;
257 }
258 $Sessions{$session{local_session_id}} = \%session;
259 }
260 }
263 # sort_command_lines
264 # In: @Command_Lines
265 # Out: @Command_Lies_Index
267 sub sort_command_lines
268 {
270 my @index;
271 for (my $i=0;$i<=$#Command_Lines;$i++) {
272 $index[$i]=$i;
273 }
275 @Command_Lines_Index = sort {
276 $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}
277 } @index;
279 }
281 ##################
282 # process_command_lines
283 #
284 # Обрабатываются командные строки @Command_Lines
285 # Для каждой строки определяется:
286 # class класс
287 # note комментарий
288 #
289 # In: @Command_Lines_Index
290 # In-Out: @Command_Lines
292 sub process_command_lines
293 {
294 for my $i (@Command_Lines_Index) {
295 my $cl = \$Command_Lines[$i];
297 next if !$cl;
299 $$cl->{err} ||=0;
301 # Класс команды
303 $$cl->{"class"} = $$cl->{"err"} eq 130 ? "interrupted"
304 : $$cl->{"err"} eq 127 ? "mistyped"
305 : $$cl->{"err"} ? "wrong"
306 : "normal";
308 if ($$cl->{"cline"} =~ /[^|`]\s*sudo/
309 || $$cl->{"uid"} eq 0) {
310 $$cl->{"class"}.="_root";
311 }
314 #Обработка пометок
315 # Если несколько пометок (notes) идут подряд,
316 # они все объединяются
318 if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) {
320 my $note_operator = $1;
321 my $note_title = $2;
323 if ($note_operator eq "=") {
324 $$cl->{"class"} = "note";
325 $$cl->{"note"} = $$cl->{"output"};
326 $$cl->{"note_title"} = $2;
327 }
328 else {
329 my $j = $i;
330 if ($note_operator eq "^") {
331 $j--;
332 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
333 }
334 elsif ($note_operator 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}=$note_title;
339 $Command_Lines[$j]->{note}.=$$cl->{output};
340 $$cl=0;
341 }
342 }
343 elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) {
345 my $note_operator = $1;
346 my $note_text = $2;
348 if ($note_operator eq "=") {
349 $$cl->{"class"} = "note";
350 $$cl->{"note"} = $note_text;
351 }
352 else {
353 my $j=$i;
354 if ($note_operator eq "^") {
355 $j--;
356 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
357 }
358 elsif ($note_operator eq "v") {
359 $j++;
360 $j++ while ($j <= @Command_Lines && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]);
361 }
362 $Command_Lines[$j]->{note}.="$note_text\n";
363 $$cl=0;
364 }
365 }
366 }
368 }
371 =cut
372 Процедура print_command_lines выводит HTML-представление
373 разобранного lab-скрипта.
375 Разобранный lab-скрипт должен находиться в массиве @Command_Lines
376 =cut
378 sub print_command_lines
379 {
381 my @toc; # Оглавление
382 my $note_number=0;
384 my $result = q();
385 my $this_day_resut = q();
387 my $cl;
388 my $last_tty="";
389 my $last_day=q();
390 my $last_wday=q();
391 my $in_range=0;
393 my $current_command=0;
395 my @known_commands;
397 my %filter;
399 if ($Config{filter}) {
400 # Инициализация фильтра
401 for (split /&/,$Config{filter}) {
402 my ($var, $val) = split /=/;
403 $filter{$var} = $val || "";
404 }
405 }
407 #$result = "Filter=".$Config{filter}."\n";
409 $Stat{LastCommand} ||= 0;
410 $Stat{TotalCommands} ||= 0;
411 $Stat{ErrorCommands} ||= 0;
412 $Stat{MistypedCommands} ||= 0;
414 my %new_entries_of = (
415 "1 1" => "программы пользователя",
416 "2 8" => "программы администратора",
417 "3 sh" => "команды интерпретатора",
418 "4 script"=> "скрипты",
419 );
421 COMMAND_LINE:
422 for my $k (@Command_Lines_Index) {
424 my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
425 next unless $cl;
427 # Пропускаем команды, с одинаковым временем
428 # Это не совсем правильно.
429 # Возможно, что это команды, набираемые с помощью <completion>
430 # или запомненные с помощью <ctrl-c>
432 next if $Stat{LastCommand} == $cl->{time};
434 # Пропускаем строки, которые противоречат фильтру
435 # Если у нас недостаточно информации о том, подходит строка под фильтр или нет,
436 # мы её выводим
438 #$result .= "before<br/>";
439 for my $filter_key (keys %filter) {
440 #$result .= "undefined local session id<br/>\n" if !defined($cl->{local_session_id});
441 #$result .= "undefined filter key $filter_key <br/>\n" if !defined($Sessions{$cl->{local_session_id}}->{$filter_key});
442 #$result .= $Sessions{$cl->{local_session_id}}->{$filter_key}." != ".$filter{$filter_key};
443 next COMMAND_LINE if
444 defined($cl->{local_session_id})
445 && defined($Sessions{$cl->{local_session_id}}->{$filter_key})
446 && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
447 }
449 # Набираем статистику
450 # Хэш %Stat
452 $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};
453 if ($cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval}) {
454 $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}
455 }
456 my $seconds_since_last_command = $cl->{time} - $Stat{LastCommand};
457 $Stat{LastCommand} = $cl->{time};
458 $Stat{TotalCommands}++;
461 # Пропускаем строки, выходящие за границу "signature",
462 # при условии, что границы указаны
463 # Пропускаем неправильные/прерванные/другие команды
464 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
465 $in_range=1;
466 next;
467 }
468 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
469 $in_range=0;
470 next;
471 }
472 next if ($Config{"from"} && $Config{"to"} && !$in_range)
473 || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
474 || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
475 || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
477 if ($cl->{class} eq "note") {
478 my $note = $cl->{note};
479 $note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note)));
480 $note =~ s@(http:[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
481 $note =~ s@(www\.[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
482 $this_day_result .= "<tr><td colspan='6'>"
483 . "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title}
484 . "".$note."<p/><p/></td></tr>";
486 if ($cl->{note_title}) {
487 push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";
488 $note_number++;
489 }
490 next;
491 }
494 my $output="";
495 # Выводим <head_lines> верхних строк
496 # и <tail_lines> нижних строк,
497 # если эти параметры существуют
499 my @lines = split '\n', $cl->{"output"};
500 if (($Config{"head_lines"} || $Config{"tail_lines"})
501 && $#lines > $Config{"head_lines"} + $Config{"tail_lines"} ) {
503 for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
504 $output .= $lines[$i]."\n";
505 }
506 $output .= $Config{"skip_text"}."\n";
508 my $start_line=$#lines-$Config{"tail_lines"}+1;
509 for ($i=$start_line; $i<= $#lines; $i++) {
510 $output .= $lines[$i]."\n";
511 }
512 }
513 else {
514 $output .= $cl->{"output"};
515 }
517 #
518 ##
519 ## Начинается собственно вывод
520 ##
521 #
523 my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
525 # Добавляем спереди 0 для удобочитаемости
526 $min = "0".$min if $min =~ /^.$/;
527 $hour = "0".$hour if $hour =~ /^.$/;
528 $sec = "0".$sec if $sec =~ /^.$/;
530 $class=$cl->{"class"};
531 $Stat{ErrorCommands}++ if $class =~ /wrong/;
532 $Stat{MistypedCommands}++ if $class =~ /mistype/;
535 # DAY CHANGE
536 if ( $last_day ne $day) {
537 if ($last_day) {
539 # Вычисляем разность множеств.
540 # Что-то вроде этого, если бы так можно было писать:
541 # @new_commands = keys %CommandsFDistribution - @known_commands;
544 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
548 for my $entry_class (sort keys %new_entries_of) {
549 my $new_commands_section = make_new_entries_table($entry_class=~/[0-9]+\s+(.*)/, \@known_commands);
551 my $table_caption = "Таблица ".$table_number++.". ".$Day_Name[$last_wday].". Новые ".$new_entries_of{$entry_class};
552 if ($new_commands_section) {
553 $result .= "<table class='new_commands_table' width='100%'>"
554 . "<tr class='new_commands_caption'><td colspan='2' align='right'>$table_caption</td></tr>"
555 . "<tr class='new_commands_header'><td width=100>Команда</td><td>Описание</td></tr>"
556 . $new_commands_section
557 . "</table>"
558 }
560 }
561 @known_commands = keys %CommandsFDistribution;
562 $result .= "<table width='100%'>\n";
563 $result .= $this_day_result;
564 $result .= "</table>";
565 }
567 push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
568 $last_day=$day;
569 $last_wday=$wday;
570 $this_day_result = q();
571 }
572 elsif ($seconds_since_last_command > 600) {
573 my $height = $seconds_since_last_command > 1200 ? 100: 60;
574 my $minutes_passed = int($seconds_since_last_command/60);
577 my $minutes_word = $minutes_passed % 100 > 10
578 && $minutes_passed % 100 < 20 ? "минут" :
579 $minutes_passed % 10 == 1 ? "минута":
580 $minutes_passed % 10 == 0 ? "минут" :
581 $minutes_passed % 10 > 4 ? "минут" :
582 "минуты";
584 $this_day_result .= "<tr height='60'>"
585 . "<td colspan='5' height='$height'>"
586 . "<font size='-1'>"
587 . "прошло ".$minutes_passed." ".$minutes_word
588 . "</font>"
589 . "</td></tr>\n";
590 }
592 $this_day_result .= "<tr class='command'>\n";
595 # CONSOLE CHANGE
596 if ( $last_tty ne $cl->{"tty"}) {
597 my $tty = $cl->{"tty"};
598 $this_day_result .= "<td colspan='6'>"
599 ."<table><tr><td class='ttychange' width='140' align='center'>"
600 . $tty
601 ."</td></tr></table>"
602 ."</td></tr><tr>";
603 $last_tty=$cl->{"tty"};
604 }
606 # TIME
607 $this_day_result .= $Config{"show_time"} =~ /^y/i
608 ? "<td width='100' valign='top' class='time' width='$Config{time_width}'>$hour:$min:$sec</td>"
609 : "<td width='0'/>";
611 # CLASS
612 if ($cl->{"err"}) {
613 $this_day_result .= "<td width='8' valign='top'>"
614 . "<table><tr><td width='8' height='8' class='err_box'>"
615 . "E"
616 . "</td></tr></table>"
617 . "</td>";
618 }
619 else {
620 $this_day_result .= "<td width='10' valign='top'>"
621 . " "
622 . "</td>";
623 }
625 # COMMAND
626 my $hint = make_comment($cl->{"cline"});
628 my $cline;
629 $cline = $cl->{"prompt"}.$cl->{"cline"};
630 $cline =~ s/\n//;
632 $cline = "<span title='$hint' class='with_hint'>$cline</span>" if $hint;
633 $cline = "<span class='without_hint'>$cline</span>" if !$hint;
635 $this_day_result .= "<td class='script'>\n";
636 $this_day_result .= "<pre class='${class}_cline'>\n" . $cline . "</pre>\n";
638 # OUTPUT
639 my $last_command = $cl->{"last_command"};
640 if (!(
641 $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
642 $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
643 $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
644 )) {
645 $this_day_result .= "<pre class='".$class."_output'>" . $output . "</pre>\n";
646 }
648 # DIFF
649 if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
650 $this_day_result .= "<table><tr><td width='5'/><td class='diff'><pre>"
651 . $cl->{"diff"}
652 . "</pre></td></tr></table>";
653 }
655 #NOTES
656 if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {
657 my $note=$cl->{"note"};
658 $note =~ s/\n/<br\/>\n/msg;
659 if (not $note =~ s@(http:[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g) {
660 $note =~ s@(www\.[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g;
661 };
662 # Ширину пока не используем
663 # $this_day_result .= "<table width='$Config{note_width}' class='note'>";
664 $this_day_result .= "<table class='note'>";
665 $this_day_result .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title};
666 $this_day_result .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>";
667 $this_day_result .= "</table>\n";
668 }
670 # COMMENT
671 if ( $Config{"show_comments"} =~ /^y/i) {
672 my $comment = make_comment($cl->{"cline"});
673 if ($comment) {
674 $this_day_result .= "<table width='$Config{comment_width}'><tr><td width='5'/><td>"
675 . "<table class='note' width='100%'>"
676 . $comment
677 . "</table>\n"
678 . "</td></tr></table>";
679 }
680 }
682 # Вывод очередной команды окончен
683 $this_day_result .= "</td>\n";
684 $this_day_result .= "</tr>\n";
685 }
686 last: {
687 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
689 for my $entry_class (keys %new_entries_of) {
690 my $new_commands_section = make_new_entries_table("$entry_class", \@known_commands);
691 @known_commands = keys %CommandsFDistribution;
693 my $table_caption = "Таблица ".$table_number++.". Новые ".$new_entries_of{$entry_class}. ". ".$Day_Name[$last_wday];
694 if ($new_commands_section) {
695 $result .= "<table class='new_commands_table'>"
696 . "<tr class='new_commands_caption'><td colspan='2' align='right'>$table_caption</td></tr>"
697 . "<tr class='new_commands_header'><td>Команда</td><td>Описание</td></tr>"
698 . $new_commands_section
699 . "</table>"
700 ;
701 }
703 }
705 $result .= "<table width='100%'>\n";
706 $result .= $this_day_result;
707 $result .= "</table>";
708 }
710 return ($result, collapse_list (\@toc));
712 }
714 sub make_new_entries_table
715 {
716 my $entries_class = shift;
717 my @known_commands = @{$_[0]};
719 my %count;
720 my @new_commands = ();
721 for my $c (keys %CommandsFDistribution, @known_commands) {
722 $count{$c}++
723 }
724 for my $c (keys %CommandsFDistribution) {
725 push @new_commands, $c if $count{$c} != 2;
726 }
729 my $new_commands_section;
730 if (@new_commands){
731 my $hint;
732 for my $c (reverse sort { $CommandsFDistribution{$a} <=> $CommandsFDistribution{$b} } @new_commands) {
733 $hint = make_comment($c);
734 my ($command, $hint) = $hint =~ m/(.*?) \s*- \s*(.*)/;
735 next unless $command =~ s/\($entries_class\)//i;
736 $new_commands_section .= "<tr><td valign='top'>$command</td><td>$hint</td></tr>" if $hint;
737 }
738 }
739 return $new_commands_section;
740 }
743 #############
744 # print_all
745 #
746 #
747 #
748 # In: $_[0] output_filename
749 # Out:
752 sub print_all
753 {
754 my $output_filename=$_[0];
756 my $result;
757 my ($command_lines,$toc) = print_command_lines;
759 $result = print_header($toc);
760 $result.= "<h2 id='log'>Журнал</h2>" . $command_lines;
761 $result.= "<h2 id='stat'>Статистика</h2>" . print_stat;
762 $result.= "<h2 id='help'>Справка</h2>" . $Html_Help . "<br/>";
763 $result.= "<h2 id='about'>О программе</h2>". $Html_About. "<br/>";
764 $result.= print_footer;
766 if ($output_filename eq "-") {
767 print $result;
768 }
769 else {
770 open(OUT, ">", $output_filename)
771 or die "Can't open $output_filename for writing\n";
772 print OUT $result;
773 close(OUT);
774 }
775 }
777 #############
778 # print_header
779 #
780 #
781 #
782 # In: $_[0] Содержание
783 # Out: Распечатанный заголовок
785 sub print_header
786 {
787 my $toc = $_[0];
788 my $course_name = $Config{"course-name"};
789 my $course_code = $Config{"course-code"};
790 my $course_date = $Config{"course-date"};
791 my $course_center = $Config{"course-center"};
792 my $course_trainer = $Config{"course-trainer"};
793 my $course_student = $Config{"course-student"};
795 my $title = "Журнал лабораторных работ";
796 $title .= " -- ".$course_student if $course_student;
797 if ($course_date) {
798 $title .= " -- ".$course_date;
799 $title .= $course_code ? "/".$course_code
800 : "";
801 }
802 else {
803 $title .= " -- ".$course_code if $course_code;
804 }
806 # Управляющая форма
807 my $control_form .= "<table id='visibility_form' class='visibility_form'><tr><td>Видимые элементы</TD></tr><tr><td><form>\n";
808 for my $element (keys %Elements_Visibility)
809 {
810 my @e = split /\s+/, $element;
811 my $showhide = join "", map { "ShowHide('$_');" } @e ;
812 $control_form .= "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>".
813 $Elements_Visibility{$element}.
814 "</input><br>\n";
815 }
816 $control_form .= "</form></td></tr></table>\n";
818 my $result;
819 $result = <<HEADER;
820 <html>
821 <head>
822 <meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
823 <link rel='stylesheet' href='$Config{frontend_css}' type='text/css'/>
824 <title>$title</title>
825 </head>
826 <body>
827 <script>
828 $Html_JavaScript
829 </script>
831 <!-- vvv Tigra Hints vvv -->
832 <script language="JavaScript" src="/tigra/hints.js"></script>
833 <script language="JavaScript" src="/tigra/hints_cfg.js"></script>
834 <style>
835 /* a class for all Tigra Hints boxes, TD object */
836 .hintsClass
837 {text-align: center; font-family: Verdana, Arial, Helvetica; padding: 0px 0px 0px 0px;}
838 /* this class is used by Tigra Hints wrappers */
839 .row
840 {background: white;}
841 </style>
842 <!-- ^^^ Tigra Hints ^^^ -->
845 <h1 onmouseover="myHint.show('1')" onmouseout="myHint.hide()">Журнал лабораторных работ</h1>
846 HEADER
847 if ( $course_student
848 || $course_trainer
849 || $course_name
850 || $course_code
851 || $course_date
852 || $course_center) {
853 $result .= "<p>";
854 $result .= "Выполнил $course_student<br/>" if $course_student;
855 $result .= "Проверил $course_trainer <br/>" if $course_trainer;
856 $result .= "Курс " if $course_name
857 || $course_code
858 || $course_date;
859 $result .= "$course_name " if $course_name;
860 $result .= "($course_code)" if $course_code;
861 $result .= ", $course_date<br/>" if $course_date;
862 $result .= "Учебный центр $course_center <br/>" if $course_center;
863 $result .= "</p>";
864 }
866 $result .= <<HEADER;
867 <table width='100%'>
868 <tr>
869 <td width='*'>
871 <table border=0 id='toc' class='toc'>
872 <tr>
873 <td>
874 <div class='toc_title'>Содержание</div>
875 <ul>
876 <li><a href='#log'>Журнал</a></li>
877 <ul>$toc</ul>
878 <li><a href='#stat'>Статистика</a></li>
879 <li><a href='#help'>Справка</a></li>
880 <li><a href='#about'>О программе</a></li>
881 </ul>
882 </td>
883 </tr>
884 </table>
886 </td>
887 <td valign='top' width=200>$control_form</td>
888 </tr>
889 </table>
890 HEADER
892 return $result;
893 }
896 #############
897 # print_footer
898 #
899 #
900 #
901 #
902 #
904 sub print_footer
905 {
906 return "</body>\n</html>\n";
907 }
912 #############
913 # print_stat
914 #
915 #
916 #
917 # In:
918 # Out:
920 sub print_stat
921 {
922 %StatNames = (
923 FirstCommand => "Время первой команды журнала",
924 LastCommand => "Время последней команды журнала",
925 TotalCommands => "Количество командных строк в журнале",
926 ErrorsPercentage => "Процент команд с ненулевым кодом завершения, %",
927 MistypesPercentage => "Процент синтаксически неверно набранных команд, %",
928 TotalTime => "Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час",
929 CommandsPerTime => "Количество командных строк в единицу времени, команда/мин",
930 CommandsFrequency => "Частота использования команд",
931 RareCommands => "Частота использования этих команд < 0.5%",
932 );
933 @StatOrder = (
934 FirstCommand,
935 LastCommand,
936 TotalCommands,
937 ErrorsPercentage,
938 MistypesPercentage,
939 TotalTime,
940 CommandsPerTime,
941 CommandsFrequency,
942 RareCommands,
943 );
945 # Подготовка статистики к выводу
946 # Некоторые значения пересчитываются!
947 # Дальше их лучше уже не использовать!!!
949 my %CommandsFrequency = %CommandsFDistribution;
951 $Stat{TotalTime} ||= 0;
952 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{FirstCommand} || 0);
953 $Stat{FirstCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec, $year+1900, $mon+1, $mday;
954 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{LastCommand} || 0);
955 $Stat{LastCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec, $year+1900, $mon+1, $mday;
956 if ($Stat{TotalCommands}) {
957 $Stat{ErrorsPercentage} = sprintf "%5.2f", $Stat{ErrorCommands}*100/$Stat{TotalCommands};
958 $Stat{MistypesPercentage} = sprintf "%5.2f", $Stat{MistypedCommands}*100/$Stat{TotalCommands};
959 }
960 $Stat{CommandsPerTime} = sprintf "%5.2f", $Stat{TotalCommands}*60/$Stat{TotalTime}
961 if $Stat{TotalTime};
962 $Stat{TotalTime} = sprintf "%5.2f", $Stat{TotalTime}/60/60;
964 my $total_commands=0;
965 for $command (keys %CommandsFrequency){
966 $total_commands += $CommandsFrequency{$command};
967 }
968 if ($total_commands) {
969 for $command (reverse sort {$CommandsFrequency{$a} <=> $CommandsFrequency{$b}} keys %CommandsFrequency){
970 my $command_html;
971 my $percentage = sprintf "%5.2f",$CommandsFrequency{$command}*100/$total_commands;
972 if ($percentage < 0.5) {
973 my $hint = make_comment($command);
974 $command_html = "$command";
975 $command_html = "<span title='$hint' class='with_hint'>$command_html</span>" if $hint;
976 $command_html = "<span class='without_hint'>$command_html</span>" if not $hint;
977 my $command_html = "<tt>$command_html</tt>";
978 $Stat{RareCommands} .= $command_html."<sub><font size='-2'>".$CommandsFrequency{$command}."</font></sub> , ";
979 }
980 else {
981 my $hint = make_comment($command);
982 $command_html = "$command";
983 $command_html = "<span title='$hint' class='with_hint'>$command_html</span>" if $hint;
984 $command_html = "<span class='without_hint'>$command_html</span>" if not $hint;
985 my $command_html = "<tt>$command_html</tt>";
986 $percentage = sprintf "%5.2f",$percentage;
987 $Stat{CommandsFrequency} .= "<tr><td>".$command_html."</td><td>".$CommandsFrequency{$command}."</td>".
988 "<td>|".("="x int($CommandsFrequency{$command}*100/$total_commands))."| $percentage%</td></tr>";
989 }
990 }
991 $Stat{CommandsFrequency} = "<table>".$Stat{CommandsFrequency}."</table>";
992 $Stat{RareCommands} =~ s/, $// if $Stat{RareCommands};
993 }
995 my $result = q();
996 for my $stat (@StatOrder) {
997 next unless $Stat{"$stat"};
998 $result .= "<tr valign='top'><td width='300'>".$StatNames{"$stat"}."</td><td>".$Stat{"$stat"}."</td></tr>"
999 }
1000 $result = "<table>$result</table>"
1001 . "<font size='-2'>____<br/>*) Интервалы неактивности длительностью "
1002 . ($Config{stat_inactivity_interval}/60)
1003 . " минут и более не учитываются</font></br>";
1005 return $result;
1006 }
1009 sub collapse_list($)
1010 {
1011 my $res = "";
1012 for my $elem (@{$_[0]}) {
1013 if (ref $elem eq "ARRAY") {
1014 $res .= "<ul>".collapse_list($elem)."</ul>";
1015 }
1016 else
1017 {
1018 $res .= "<li>".$elem."</li>";
1019 }
1020 }
1021 return $res;
1022 }
1027 sub init_variables
1028 {
1029 $Html_Help = <<HELP;
1030 Для того чтобы использовать LiLaLo, не нужно знать ничего особенного:
1031 всё происходит само собой.
1032 Однако, чтобы ведение и последующее использование журналов
1033 было как можно более эффективным, желательно иметь в виду следующее:
1034 <ol>
1035 <li><p>
1036 В журнал автоматически попадают все команды, данные в любом терминале системы.
1037 </p></li>
1038 <li><p>
1039 Для того чтобы убедиться, что журнал на текущем терминале ведётся,
1040 и команды записываются, дайте команду w.
1041 В поле WHAT, соответствующем текущему терминалу,
1042 должна быть указана программа script.
1043 </p></li>
1044 <li><p>
1045 Команды, при наборе которых были допущены синтаксические ошибки,
1046 выводятся перечёркнутым текстом:
1047 <table>
1048 <tr class='command'>
1049 <td class='script'>
1050 <pre class='mistyped_cline'>
1051 \$ l s-l</pre>
1052 <pre class='mistyped_output'>bash: l: command not found
1053 </pre>
1054 </td>
1055 </tr>
1056 </table>
1057 <br/>
1058 </p></li>
1059 <li><p>
1060 Если код завершения команды равен нулю,
1061 команда была выполнена без ошибок.
1062 Команды, код завершения которых отличен от нуля, выделяются цветом.
1063 <table>
1064 <tr class='command'>
1065 <td class='script'>
1066 <pre class='wrong_cline'>
1067 \$ test 5 -lt 4</pre>
1068 </pre>
1069 </td>
1070 </tr>
1071 </table>
1072 Обратите внимание на то, что код завершения команды может быть отличен от нуля
1073 не только в тех случаях, когда команда была выполнена с ошибкой.
1074 Многие команды используют код завершения, например, для того чтобы показать результаты проверки
1075 <br/>
1076 </p></li>
1077 <li><p>
1078 Команды, ход выполнения которых был прерван пользователем, выделяются цветом.
1079 <table>
1080 <tr class='command'>
1081 <td class='script'>
1082 <pre class='interrupted_cline'>
1083 \$ find / -name abc</pre>
1084 <pre class='interrupted_output'>find: /home/devi-orig/.gnome2: Keine Berechtigung
1085 find: /home/devi-orig/.gnome2_private: Keine Berechtigung
1086 find: /home/devi-orig/.nautilus/metafiles: Keine Berechtigung
1087 find: /home/devi-orig/.metacity: Keine Berechtigung
1088 find: /home/devi-orig/.inkscape: Keine Berechtigung
1089 ^C
1090 </pre>
1091 </td>
1092 </tr>
1093 </table>
1094 <br/>
1095 </p></li>
1096 <li><p>
1097 Команды, выполненные с привилегиями суперпользователя,
1098 выделяются слева красной чертой.
1099 <table>
1100 <tr class='command'>
1101 <td class='script'>
1102 <pre class='_root_cline'>
1103 # id</pre>
1104 <pre class='_root_output'>
1105 uid=0(root) gid=0(root) Gruppen=0(root)
1106 </pre>
1107 </td>
1108 </tr>
1109 </table>
1110 <br/>
1111 </p></li>
1112 <li><p>
1113 Изменения, внесённые в текстовый файл с помощью редактора,
1114 запоминаются и показываются в журнале в формате ed.
1115 Строки, начинающиеся символом "<", удалены, а строки,
1116 начинающиеся символом ">" -- добавлены.
1117 <table>
1118 <tr class='command'>
1119 <td class='script'>
1120 <pre class='cline'>
1121 \$ vi ~/.bashrc</pre>
1122 <table><tr><td width='5'/><td class='diff'><pre>2a3,5
1123 > if [ -f /usr/local/etc/bash_completion ]; then
1124 > . /usr/local/etc/bash_completion
1125 > fi
1126 </pre></td></tr></table></td>
1127 </tr>
1128 </table>
1129 <br/>
1130 </p></li>
1131 <li><p>
1132 Для того чтобы изменить файл в соответствии с показанными в диффшоте
1133 изменениями, можно воспользоваться командой patch.
1134 Нужно скопировать изменения, запустить программу patch, указав в
1135 качестве её аргумента файл, к которому применяются изменения,
1136 и всавить скопированный текст:
1137 <table>
1138 <tr class='command'>
1139 <td class='script'>
1140 <pre class='cline'>
1141 \$ patch ~/.bashrc</pre>
1142 </td>
1143 </tr>
1144 </table>
1145 В данном случае изменения применяются к файлу ~/.bashrc
1146 </p></li>
1147 <li><p>
1148 Для того чтобы получить краткую справочную информацию о команде,
1149 нужно подвести к ней мышь. Во всплывающей подсказке появится краткое
1150 описание команды.
1151 </p>
1152 <p>
1153 Если справочная информация о команде есть,
1154 команда выделяется голубым фоном, например: <span class="with_hint" title="главный текстовый редактор Unix">vi</span>.
1155 Если справочная информация отсутствует,
1156 команда выделяется розовым фоном, например: <span class="without_hint">notepad.exe</span>.
1157 Справочная информация может отсутствовать в том случае,
1158 если (1) команда введена неверно; (2) если распознавание команды LiLaLo выполнено неверно;
1159 (3) если информация о команде неизвестна LiLaLo.
1160 Последнее возможно для редких команд.
1161 </p></li>
1162 <li><p>
1163 Большие, в особенности многострочные, всплывающие подсказки лучше
1164 всего показываются браузерами KDE Konqueror, Apple Safari и Microsoft Internet Explorer.
1165 В браузерах Mozilla и Firefox они отображаются не полностью,
1166 а вместо перевода строки выводится специальный символ.
1167 </p></li>
1168 <li><p>
1169 Время ввода команды, показанное в журнале, соответствует времени
1170 <i>начала ввода командной строки</i>, которое равно тому моменту,
1171 когда на терминале появилось приглашение интерпретатора
1172 </p></li>
1173 <li><p>
1174 Имя терминала, на котором была введена команда, показано в специальном блоке.
1175 Этот блок показывается только в том случае, если терминал
1176 текущей команды отличается от терминала предыдущей.
1177 </p></li>
1178 <li><p>
1179 Вывод не интересующих вас в настоящий момент элементов журнала,
1180 таких как время, имя терминала и других, можно отключить.
1181 Для этого нужно воспользоваться <a href='#visibility_form'>формой управления журналом</a>
1182 вверху страницы.
1183 </p></li>
1184 <li><p>
1185 Небольшие комментарии к командам можно вставлять прямо из командной строки.
1186 Комментарий вводится прямо в командную строку, после символов #^ или #v.
1187 Символы ^ и v показывают направление выбора команды, к которой относится комментарий:
1188 ^ - к предыдущей, v - к следующей.
1189 Например, если в командной строке было введено:
1190 <pre class='cline'>
1191 \$ whoami
1192 </pre>
1193 <pre class='output'>
1194 user
1195 </pre>
1196 <pre class='cline'>
1197 \$ #^ Интересно, кто я?
1198 </pre>
1199 в журнале это будет выглядеть так:
1201 <pre class='cline'>
1202 \$ whoami
1203 </pre>
1204 <pre class='output'>
1205 user
1206 </pre>
1207 <table class='note'><tr><td width='100%' class='note_text'>
1208 <tr> <td> Интересно, кто я?<br/> </td></tr></table>
1209 </p></li>
1210 <li><p>
1211 Если комментарий содержит несколько строк,
1212 его можно вставить в журнал следующим образом:
1213 <pre class='cline'>
1214 \$ whoami
1215 </pre>
1216 <pre class='output'>
1217 user
1218 </pre>
1219 <pre class='cline'>
1220 \$ cat > /dev/null #^ Интересно, кто я?
1221 </pre>
1222 <pre class='output'>
1223 Программа whoami выводит имя пользователя, под которым
1224 мы зарегистрировались в системе.
1225 -
1226 Она не может ответить на вопрос о нашем назначении
1227 в этом мире.
1228 </pre>
1229 В журнале это будет выглядеть так:
1230 <table>
1231 <tr class='command'>
1232 <td class='script'>
1233 <pre class='cline'>
1234 \$ whoami</pre>
1235 <pre class='output'>user
1236 </pre>
1237 <table class='note'><tr><td class='note_title'>Интересно, кто я?</td></tr><tr><td width='100%' class='note_text'>
1238 Программа whoami выводит имя пользователя, под которым<br/>
1239 мы зарегистрировались в системе.<br/>
1240 <br/>
1241 Она не может ответить на вопрос о нашем назначении<br/>
1242 в этом мире.<br/>
1243 </td></tr></table>
1244 </td>
1245 </tr>
1246 </table>
1247 Для разделения нескольких абзацев между собой
1248 используйте символ "-", один в строке.
1249 <br/>
1250 </p></li>
1251 <li><p>
1252 Комментарии, не относящиеся непосредственно ни к какой из команд,
1253 добавляются точно таким же способом, только вместо симолов #^ или #v
1254 нужно использовать символы #=
1255 </p></li>
1256 </ol>
1257 HELP
1259 $Html_About = <<ABOUT;
1260 <p>
1261 LiLaLo (L3) расшифровывается как Live Lab Log.<br/>
1262 Программа разработана для повышения эффективности обучения Unix/Linux-системам.<br/>
1263 (c) Игорь Чубин, 2004-2005<br/>
1264 </p>
1265 ABOUT
1266 $Html_About.='$Id$ </p>';
1268 $Html_JavaScript = <<JS;
1269 function getElementsByClassName(Class_Name)
1270 {
1271 var Result=new Array();
1272 var All_Elements=document.all || document.getElementsByTagName('*');
1273 for (i=0; i<All_Elements.length; i++)
1274 if (All_Elements[i].className==Class_Name)
1275 Result.push(All_Elements[i]);
1276 return Result;
1277 }
1278 function ShowHide (name)
1279 {
1280 elements=getElementsByClassName(name);
1281 for(i=0; i<elements.length; i++)
1282 if (elements[i].style.display == "none")
1283 elements[i].style.display = "";
1284 else
1285 elements[i].style.display = "none";
1286 //if (elements[i].style.visibility == "hidden")
1287 // elements[i].style.visibility = "visible";
1288 //else
1289 // elements[i].style.visibility = "hidden";
1290 }
1291 function filter_by_output(text)
1292 {
1294 var jjj=0;
1296 elements=getElementsByClassName('command');
1297 for(i=0; i<elements.length; i++) {
1298 subelems = elements[i].getElementsByTagName('pre');
1299 for(j=0; j<subelems.length; j++) {
1300 if (subelems[j].className = 'output') {
1301 var str = new String(subelems[j].nodeValue);
1302 if (jjj != 1) {
1303 alert(str);
1304 jjj=1;
1305 }
1306 if (str.indexOf(text) >0)
1307 subelems[j].style.display = "none";
1308 else
1309 subelems[j].style.display = "";
1311 }
1313 }
1314 }
1316 }
1317 JS
1319 %Search_Machines = (
1320 "google" => { "query" => "http://www.google.com/search?q=" ,
1321 "icon" => "$Config{frontend_google_ico}" },
1322 "freebsd" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=",
1323 "icon" => "$Config{frontend_freebsd_ico}" },
1324 "linux" => { "query" => "http://man.he.net/?topic=",
1325 "icon" => "$Config{frontend_linux_ico}"},
1326 "opennet" => { "query" => "http://www.opennet.ru/search.shtml?words=",
1327 "icon" => "$Config{frontend_opennet_ico}"},
1328 "local" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=",
1329 "icon" => "$Config{frontend_local_ico}" },
1331 );
1333 %Elements_Visibility = (
1334 "note" => "замечания",
1335 "diff" => "редактор",
1336 "time" => "время",
1337 "ttychange" => "терминал",
1338 "wrong_output wrong_cline wrong_root_output wrong_root_cline"
1339 => "команды с ошибками",
1340 "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline"
1341 => "прерванные команды",
1342 "tab_completion_output tab_completion_cline"
1343 => "продолжение с помощью tab"
1344 );
1346 @Day_Name = qw/ Воскресенье Понедельник Вторник Среда Четверг Пятница Суббота /;
1347 @Month_Name = qw/ Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь /;
1348 @Of_Month_Name = qw/ Января Февраля Марта Апреля Мая Июня Июля Августа Сентября Октября Ноября Декабря /;
1349 }
1354 # Временно удалённый код
1355 # Возможно, он не понадобится уже никогда
1358 sub search_by
1359 {
1360 my $sm = shift;
1361 my $topic = shift;
1362 $topic =~ s/ /+/;
1364 return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='".
1365 $Search_Machines{$sm}->{"icon"}."' border='0'/></a>";
1366 }