lilalo
view l3-frontend @ 102:6fce4641575b
Убрал изврат с body
Добавил ссылку на LiLaLo
Добавил ссылку на LiLaLo
| author | devi |
|---|---|
| date | Sat Jun 24 23:13:44 2006 +0300 (2006-06-24) |
| parents | c41cc9a4b5ea |
| children | 53b890d1ae90 |
line source
1 #!/usr/bin/perl -w
3 use IO::Socket;
4 use lib '.';
5 use l3config;
6 use utf8;
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 our %filter;
16 our $filter_url;
17 sub init_filter;
19 our %Files;
21 # vvv Инициализация переменных выполняется процедурой init_variables
22 our @Day_Name;
23 our @Month_Name;
24 our @Of_Month_Name;
25 our %Search_Machines;
26 our %Elements_Visibility;
27 # ^^^
29 our %Stat;
30 our %frequency_of_command; # Сколько раз в журнале встречается какая команда
31 our $table_number=1;
33 my %mywi_cache_for; # Кэш для экономии обращений к mywi
35 sub make_comment;
36 sub make_new_entries_table;
37 sub load_command_lines_from_xml;
38 sub load_sessions_from_xml;
39 sub sort_command_lines;
40 sub process_command_lines;
41 sub init_variables;
42 sub main;
43 sub collapse_list($);
45 sub minutes_passed;
47 sub print_all_txt;
48 sub print_all_html;
49 sub print_edit_all_html;
50 sub print_command_lines_html;
51 sub print_command_lines_txt;
52 sub print_files_html;
53 sub print_stat_html;
54 sub print_header_html;
55 sub print_footer_html;
57 main();
59 sub main
60 {
61 $| = 1;
63 init_variables();
64 init_config();
65 $Config{frontend_ico_path}=$Config{frontend_css};
66 $Config{frontend_ico_path}=~s@/[^/]*$@@;
67 init_filter();
69 open_mywi_socket();
70 load_command_lines_from_xml($Config{"backend_datafile"});
71 load_sessions_from_xml($Config{"backend_datafile"});
72 sort_command_lines;
73 process_command_lines;
74 if (defined($filter{action}) && $filter{action} eq "edit") {
75 print_edit_all_html($Config{"output"});
76 }
77 else {
78 print_all_html($Config{"output"});
79 }
80 close_mywi_socket;
81 }
83 sub init_filter
84 {
85 if ($Config{filter}) {
86 # Инициализация фильтра
87 for (split /&/,$Config{filter}) {
88 my ($var, $val) = split /=/;
89 $filter{$var} = $val || "";
90 }
91 }
92 $filter_url = join ("&", map("$_=$filter{$_}", keys %filter));
93 }
95 # extract_from_cline
97 # In: $what = commands | args
98 # Out: return ссылка на хэш, содержащий результаты разбора
99 # команда => позиция
101 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
102 # номер первого появление команды в строке:
103 # команда => первая позиция
104 sub extract_from_cline
105 {
106 my $what = $_[0];
107 my $cline = $_[1];
108 my @lists = split /\;/, $cline;
111 my @command_lines = ();
112 for my $command_list (@lists) {
113 push(@command_lines, split(/\|/, $command_list));
114 }
116 my %position_of_command;
117 my %position_of_arg;
118 my $i=0;
119 for my $command_line (@command_lines) {
120 $command_line =~ s@^\s*@@;
121 $command_line =~ /\s*(\S+)\s*(.*)/;
122 if ($1 && $1 eq "sudo" ) {
123 $position_of_command{"$1"}=$i++;
124 $command_line =~ s/\s*sudo\s+//;
125 }
126 if ($command_line !~ m@^\s*\S*/etc/@) {
127 $command_line =~ s@^\s*\S+/@@;
128 }
130 $command_line =~ /\s*(\S+)\s*(.*)/;
131 my $command = $1;
132 my $args = $2;
133 if ($command && !defined $position_of_command{"$command"}) {
134 $position_of_command{"$command"}=$i++;
135 };
136 if ($args) {
137 my @args = split (/\s+/, $args);
138 for my $a (@args) {
139 $position_of_arg{"$a"}=$i++
140 if !defined $position_of_arg{"$a"};
141 };
142 }
143 }
145 if ($what eq "commands") {
146 return \%position_of_command;
147 } else {
148 return \%position_of_arg;
149 }
151 }
156 #
157 # Подпрограммы для работы с mywi
158 #
160 sub open_mywi_socket
161 {
162 $Mywi_Socket = IO::Socket::INET->new(
163 PeerAddr => $Config{mywi_server},
164 PeerPort => $Config{mywi_port},
165 Proto => "tcp",
166 Type => SOCK_STREAM);
167 }
169 sub close_mywi_socket
170 {
171 close ($Mywi_Socket) if $Mywi_Socket ;
172 }
175 sub mywi_client
176 {
177 #return "";
178 my $query = $_[0];
179 my $mywi;
181 open_mywi_socket;
182 if ($Mywi_Socket) {
183 binmode ":utf8", $Mywi_Socket;
184 local $| = 1;
185 local $/ = "";
186 print $Mywi_Socket $query."\n";
187 $mywi = <$Mywi_Socket>;
188 utf8::decode($mywi);
189 $mywi = "" if $mywi =~ /nothing app/;
190 }
191 close_mywi_socket;
192 return $mywi;
193 }
195 sub make_comment
196 {
197 my $cline = $_[0];
198 #my $files = $_[1];
200 my @comments;
201 my @commands = keys %{extract_from_cline("commands", $cline)};
202 my @args = keys %{extract_from_cline("args", $cline)};
203 return if (!@commands && !@args);
204 #return "commands=".join(" ",@commands)."; files=".join(" ",@files);
206 # Commands
207 for my $command (@commands) {
208 $command =~ s/'//g;
209 $frequency_of_command{$command}++;
210 if (!$Commands_Description{$command}) {
211 $mywi_cache_for{$command} ||= mywi_client ($command) || "";
212 my $mywi = join ("\n", grep(/\([18]|sh|script\)/, split(/\n/, $mywi_cache_for{$command})));
213 $mywi =~ s/\s+/ /;
214 if ($mywi !~ /^\s*$/) {
215 $Commands_Description{$command} = $mywi;
216 }
217 else {
218 next;
219 }
220 }
222 push @comments, $Commands_Description{$command};
223 }
224 return join(" \n", @comments);
226 # Files
227 for my $arg (@args) {
228 $arg =~ s/'//g;
229 if (!$Args_Description{$arg}) {
230 my $mywi;
231 $mywi = mywi_client ($arg);
232 $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));
233 $mywi =~ s/\s+/ /;
234 if ($mywi !~ /^\s*$/) {
235 $Args_Description{$arg} = $mywi;
236 }
237 else {
238 next;
239 }
240 }
242 push @comments, $Args_Description{$arg};
243 }
245 }
247 =cut
248 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
249 из XML-документа в переменную @Command_Lines
251 # In: $datafile имя файла
252 # Out: @CommandLines загруженные командные строки
254 Предупреждение!
255 Процедура не в состоянии обрабатывать XML-документ любой структуры.
256 В действительности файл cache из которого загружаются данные
257 просто напоминает XML с виду.
258 =cut
259 sub load_command_lines_from_xml
260 {
261 my $datafile = $_[0];
263 open (CLASS, $datafile)
264 or die "Can't open file with xml lablog ",$datafile,"\n";
265 local $/;
266 binmode CLASS, ":utf8";
267 $data = <CLASS>;
268 close(CLASS);
270 for $command ($data =~ m@<command>(.*?)</command>@sg) {
271 my %cl;
272 while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {
273 $cl{$1} = $2;
274 }
275 push @Command_Lines, \%cl;
276 }
277 }
279 sub load_sessions_from_xml
280 {
281 my $datafile = $_[0];
283 open (CLASS, $datafile)
284 or die "Can't open file with xml lablog ",$datafile,"\n";
285 local $/;
286 binmode CLASS, ":utf8";
287 my $data = <CLASS>;
288 close(CLASS);
290 my $i=0;
291 for my $session ($data =~ m@<session>(.*?)</session>@msg) {
292 my %session_hash;
293 while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {
294 $session_hash{$1} = $2;
295 }
296 $Sessions{$session_hash{local_session_id}} = \%session_hash;
297 }
298 }
301 # sort_command_lines
302 # In: @Command_Lines
303 # Out: @Command_Lies_Index
305 sub sort_command_lines
306 {
308 my @index;
309 for (my $i=0;$i<=$#Command_Lines;$i++) {
310 $index[$i]=$i;
311 }
313 @Command_Lines_Index = sort {
314 $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}
315 } @index;
317 }
319 ##################
320 # process_command_lines
321 #
322 # Обрабатываются командные строки @Command_Lines
323 # Для каждой строки определяется:
324 # class класс
325 # note комментарий
326 #
327 # In: @Command_Lines_Index
328 # In-Out: @Command_Lines
330 sub process_command_lines
331 {
333 COMMAND_LINE_PROCESSING:
334 for my $i (@Command_Lines_Index) {
335 my $cl = \$Command_Lines[$i];
337 next if !$cl;
339 for my $filter_key (keys %filter) {
340 next COMMAND_LINE_PROCESSING
341 if defined($$cl->{local_session_id})
342 && defined($Sessions{$$cl->{local_session_id}}->{$filter_key})
343 && $Sessions{$$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
344 }
346 $$cl->{id} = $$cl->{"time"};
348 $$cl->{err} ||=0;
350 # Класс команды
352 $$cl->{"class"} = $$cl->{"err"} eq 130 ? "interrupted"
353 : $$cl->{"err"} eq 127 ? "mistyped"
354 : $$cl->{"err"} ? "wrong"
355 : "normal";
357 if ($$cl->{"cline"} &&
358 $$cl->{"cline"} =~ /[^|`]\s*sudo/
359 || $$cl->{"uid"} eq 0) {
360 $$cl->{"class"}.="_root";
361 }
363 my $hint;
364 $hint = make_comment($$cl->{"cline"});
365 if ($hint) {
366 $$cl->{hint} = $hint;
367 }
368 # $$cl->{hint}="";
370 # Выводим <head_lines> верхних строк
371 # и <tail_lines> нижних строк,
372 # если эти параметры существуют
373 my $output="";
375 if ($$cl->{"last_command"} eq "cat" && !$$cl->{"err"} && !($$cl->{"cline"} =~ /</)) {
376 my $filename = $$cl->{"cline"};
377 $filename =~ s/.*\s+(\S+)\s*$/$1/;
378 $Files{$filename}->{"content"} = $$cl->{"output"};
379 $Files{$filename}->{"source_command_id"} = $$cl->{"id"}
380 }
381 my @lines = split '\n', $$cl->{"output"};
382 if ((
383 $Config{"head_lines"}
384 || $Config{"tail_lines"}
385 )
386 && $#lines > $Config{"head_lines"} + $Config{"tail_lines"} ) {
387 #
388 for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
389 $output .= $lines[$i]."\n";
390 }
391 $output .= $Config{"skip_text"}."\n";
393 my $start_line=$#lines-$Config{"tail_lines"}+1;
394 for (my $i=$start_line; $i<= $#lines; $i++) {
395 $output .= $lines[$i]."\n";
396 }
397 }
398 else {
399 $output = $$cl->{"output"};
400 }
401 $$cl->{short_output} = $output;
403 #Обработка пометок
404 # Если несколько пометок (notes) идут подряд,
405 # они все объединяются
407 if ($$cl->{cline} =~ /l3shot/) {
408 if ($$cl->{output} =~ m@Screenshot is written to.*/(.*)\.xwd@) {
409 $$cl->{screenshot}="$1";
410 }
411 }
413 if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) {
415 my $note_operator = $1;
416 my $note_title = $2;
418 if ($note_operator eq "=") {
419 $$cl->{"class"} = "note";
420 $$cl->{"note"} = $$cl->{"output"};
421 $$cl->{"note_title"} = $2;
422 }
423 else {
424 my $j = $i;
425 if ($note_operator eq "^") {
426 $j--;
427 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
428 }
429 elsif ($note_operator eq "v") {
430 $j++;
431 $j++ while ($j <= @Command_Lines && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
432 }
433 $Command_Lines[$j]->{note_title}=$note_title;
434 $Command_Lines[$j]->{note}.=$$cl->{output};
435 $$cl=0;
436 }
437 }
438 elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) {
440 my $note_operator = $1;
441 my $note_text = $2;
443 if ($note_operator eq "=") {
444 $$cl->{"class"} = "note";
445 $$cl->{"note"} = $note_text;
446 }
447 else {
448 my $j=$i;
449 if ($note_operator eq "^") {
450 $j--;
451 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));
452 }
453 elsif ($note_operator eq "v") {
454 $j++;
455 $j++ while ($j <= @Command_Lines && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]);
456 }
457 $Command_Lines[$j]->{note}.="$note_text\n";
458 $$cl=0;
459 }
460 }
461 if ($$cl->{"class"} eq "note") {
462 my $note_html = $$cl->{note};
463 $note_html = join ("\n", map ("<p>$_</p>", split (/-\n/, $note_html)));
464 $note_html =~ s@(http:[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
465 $note_html =~ s@(www\.[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
466 $$cl->{"note_html"} = $note_html;
467 }
468 }
470 }
473 =cut
474 Процедура print_command_lines выводит HTML-представление
475 разобранного lab-скрипта.
477 Разобранный lab-скрипт должен находиться в массиве @Command_Lines
478 =cut
480 sub print_command_lines_html
481 {
483 my @toc; # Оглавление
484 my $note_number=0;
486 my $result = q();
487 my $this_day_resut = q();
489 my $cl;
490 my $last_tty="";
491 my $last_session="";
492 my $last_day=q();
493 my $last_wday=q();
494 my $in_range=0;
496 my $current_command=0;
498 my @known_commands;
502 $Stat{LastCommand} ||= 0;
503 $Stat{TotalCommands} ||= 0;
504 $Stat{ErrorCommands} ||= 0;
505 $Stat{MistypedCommands} ||= 0;
507 my %new_entries_of = (
508 "1 1" => "программы пользователя",
509 "2 8" => "программы администратора",
510 "3 sh" => "команды интерпретатора",
511 "4 script"=> "скрипты",
512 );
514 COMMAND_LINE:
515 for my $k (@Command_Lines_Index) {
517 my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
518 next unless $cl;
520 # Пропускаем команды, с одинаковым временем
521 # Это не совсем правильно.
522 # Возможно, что это команды, набираемые с помощью <completion>
523 # или запомненные с помощью <ctrl-c>
525 next if $Stat{LastCommand} == $cl->{time};
527 # Пропускаем строки, которые противоречат фильтру
528 # Если у нас недостаточно информации о том, подходит строка под фильтр или нет,
529 # мы её выводим
531 for my $filter_key (keys %filter) {
532 next COMMAND_LINE
533 if defined($cl->{local_session_id})
534 && defined($Sessions{$cl->{local_session_id}}->{$filter_key})
535 && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
536 }
538 # Набираем статистику
539 # Хэш %Stat
541 $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};
542 if ($cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval}) {
543 $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}
544 }
545 my $seconds_since_last_command = $cl->{time} - $Stat{LastCommand};
547 if ($Stat{LastCommand} > $cl->{time}) {
548 $result .= "Время идёт вспять<br/>";
549 };
550 $Stat{LastCommand} = $cl->{time};
551 $Stat{TotalCommands}++;
553 # Пропускаем строки, выходящие за границу "signature",
554 # при условии, что границы указаны
555 # Пропускаем неправильные/прерванные/другие команды
556 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
557 $in_range=1;
558 next;
559 }
560 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
561 $in_range=0;
562 next;
563 }
564 next if ($Config{"from"} && $Config{"to"} && !$in_range)
565 || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
566 || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
567 || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
572 #
573 ##
574 ## Начинается собственно вывод
575 ##
576 #
578 ### Сначала обрабатываем границы разделов
579 ### Если тип команды "note", это граница
581 if ($cl->{class} eq "note") {
582 $this_day_result .= "<tr><td colspan='6'>"
583 . "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title}
584 . "".$cl->{note_html}."<p/><p/></td></tr>";
586 if ($cl->{note_title}) {
587 push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";
588 $note_number++;
589 }
590 next;
591 }
593 my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
595 # Добавляем спереди 0 для удобочитаемости
596 $min = "0".$min if $min =~ /^.$/;
597 $hour = "0".$hour if $hour =~ /^.$/;
598 $sec = "0".$sec if $sec =~ /^.$/;
600 $class=$cl->{"class"};
601 $Stat{ErrorCommands}++ if $class =~ /wrong/;
602 $Stat{MistypedCommands}++ if $class =~ /mistype/;
604 # DAY CHANGE
605 if ( $last_day ne $day) {
606 if ($last_day) {
608 # Вычисляем разность множеств.
609 # Что-то вроде этого, если бы так можно было писать:
610 # @new_commands = keys %frequency_of_command - @known_commands;
613 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
614 for my $entry_class (sort keys %new_entries_of) {
615 my $table_caption = "Таблица ".$table_number++.".".$Day_Name[$last_wday]
616 .". Новые ".$new_entries_of{$entry_class};
617 my $new_commands_section = make_new_entries_table(
618 $table_caption,
619 $entry_class=~/[0-9]+\s+(.*)/,
620 \@known_commands);
621 }
622 @known_commands = keys %frequency_of_command;
623 $result .= $this_day_result;
624 }
626 push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
627 $last_day=$day;
628 $last_wday=$wday;
629 $this_day_result = q();
630 }
631 else {
632 $this_day_result .= minutes_passed($seconds_since_last_command);
633 }
635 $this_day_result .= "<div class='command' id='command:".$cl->{"id"}."' >\n";
637 # CONSOLE CHANGE
638 if ($cl->{"tty"} && $last_tty ne $cl->{"tty"} && 0) {
639 my $tty = $cl->{"tty"};
640 $this_day_result .= "<div class='ttychange'>"
641 . $tty
642 ."</div>";
643 $last_tty=$cl->{"tty"};
644 }
646 # Session change
647 if ( $last_session ne $cl->{"local_session_id"}) {
648 my $tty;
649 if (defined $Sessions{$cl->{"local_session_id"}}->{"tty"}) {
650 $this_day_result .= "<div class='ttychange'><a href='?local_session_id=".$cl->{"local_session_id"}."'>"
651 . $Sessions{$cl->{"local_session_id"}}->{"tty"}
652 ."</a></div>";
653 }
654 $last_session=$cl->{"local_session_id"};
655 }
657 # TIME
658 if ($Config{"show_time"} =~ /^y/i) {
659 $this_day_result .= "<div class='time'>$hour:$min:$sec</div>"
660 }
662 # COMMAND
663 my $cline;
664 $prompt_hint = join (" ", map("$_=$cl->{$_}", grep (!/^(output|diff)$/, sort(keys(%{$cl})))));
665 $cline = "<span title='$prompt_hint'>".$cl->{"prompt"}."</span>".$cl->{"cline"};
666 $cline =~ s/\n//;
668 if ($cl->{"hint"}) {
669 $cline = "<span title='$cl->{hint}' class='with_hint'>$cline</span>" ;
670 }
671 else {
672 $cline = "<span class='without_hint'>$cline</span>";
673 }
675 $this_day_result .= "<table cellpadding='0' cellspacing='0'><tr><td>\n<div class='cblock_$cl->{class}'>\n";
676 $this_day_result .= "<div class='cline'>\n" . $cline ; #cline
677 $this_day_result .= "<span title='Код завершения ".$cl->{"err"}."'>\n"
678 . "<img src='".$Config{frontend_ico_path}."/error.png'/>\n"
679 . "</span>\n" if $cl->{"err"};
680 $this_day_result .= "</div>\n"; #cline
682 # OUTPUT
683 my $last_command = $cl->{"last_command"};
684 if (!(
685 $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
686 $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
687 $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
688 )) {
689 $this_day_result .= "<pre class='output'>\n" . $cl->{short_output} . "</pre>\n";
690 }
692 # DIFF
693 $this_day_result .= "<pre class='diff'>".$cl->{"diff"}."</pre>"
694 if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"});
695 # SHOT
696 $this_day_result .= "<img src='"
697 .$Config{l3shot_path}
698 .$cl->{"screenshot"}
699 .$Config{l3shot_suffix}
700 ."' alt ='screenshot id ".$cl->{"screenshot"}
701 ."'/>"
702 if ( $Config{"show_screenshots"} =~ /^y/i && $cl->{"screenshot"});
704 #NOTES
705 if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {
706 my $note=$cl->{"note"};
707 $note =~ s/\n/<br\/>\n/msg;
708 if (not $note =~ s@(http:[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g) {
709 $note =~ s@(www\.[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g;
710 };
711 $this_day_result .= "<div class='note'>";
712 $this_day_result .= "<div class='note_title'>".$cl->{note_title}."</div>" if $cl->{note_title};
713 $this_day_result .= "<div class='note_text'>".$note."</div>";
714 $this_day_result .= "</div>\n";
715 }
717 # Вывод очередной команды окончен
718 $this_day_result .= "</div>\n"; # cblock
719 $this_day_result .= "</td></tr></table>\n"
720 . "</div>\n"; # command
721 }
722 last: {
723 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
725 for my $entry_class (keys %new_entries_of) {
726 my $table_caption = "Таблица ".$table_number++.".".$Day_Name[$last_wday]
727 . ". Новые ".$new_entries_of{$entry_class};
728 my $new_commands_section = make_new_entries_table(
729 $table_caption,
730 $entry_class=~/[0-9]+\s+(.*)/,
731 \@known_commands);
732 }
733 @known_commands = keys %frequency_of_command;
734 $result .= $this_day_result;
735 }
737 return ($result, collapse_list (\@toc));
739 }
741 #############
742 # make_new_entries_table
743 #
744 # Напечатать таблицу неизвестных команд
745 #
746 # In: $_[0] table_caption
747 # $_[1] entries_class
748 # @_[2..] known_commands
749 # Out:
751 sub make_new_entries_table
752 {
753 my $table_caption;
754 my $entries_class = shift;
755 my @known_commands = @{$_[0]};
756 my $result = "";
758 my %count;
759 my @new_commands = ();
760 for my $c (keys %frequency_of_command, @known_commands) {
761 $count{$c}++
762 }
763 for my $c (keys %frequency_of_command) {
764 push @new_commands, $c if $count{$c} != 2;
765 }
767 my $new_commands_section;
768 if (@new_commands){
769 my $hint;
770 for my $c (reverse sort { $frequency_of_command{$a} <=> $frequency_of_command{$b} } @new_commands) {
771 $hint = make_comment($c);
772 next unless $hint;
773 my ($command, $hint) = $hint =~ m/(.*?) \s*- \s*(.*)/;
774 next unless $command =~ s/\($entries_class\)//i;
775 $new_commands_section .= "<tr><td valign='top'>$command</td><td>$hint</td></tr>";
776 }
777 }
778 if ($new_commands_section) {
779 $result .= "<table class='new_commands_table' width='700' cellspacing='0' cellpadding='0'>"
780 . "<tr class='new_commands_caption'>"
781 . "<td colspan='2' align='right'>$table_caption</td>"
782 . "</tr>"
783 . "<tr class='new_commands_header'>"
784 . "<td width=100>Команда</td><td width=600>Описание</td>"
785 . "</tr>"
786 . $new_commands_section
787 . "</table>"
788 }
789 return $result;
790 }
792 #############
793 # minutes_passed
794 #
795 #
796 #
797 # In: $_[0] seconds_since_last_command
798 # Out: "minutes passed" text
800 sub minutes_passed
801 {
802 my $seconds_since_last_command = shift;
803 my $result = "";
804 if ($seconds_since_last_command > 7200) {
805 my $hours_passed = int($seconds_since_last_command/3600);
806 my $passed_word = $hours_passed % 10 == 1 ? "прошла"
807 : "прошло";
808 my $hours_word = $hours_passed % 10 == 1 ? "часа":
809 "часов";
810 $result .= "<div class='much_time_passed'>"
811 . $passed_word." >".$hours_passed." ".$hours_word
812 . "</div>\n";
813 }
814 elsif ($seconds_since_last_command > 600) {
815 my $minutes_passed = int($seconds_since_last_command/60);
818 my $passed_word = $minutes_passed % 100 > 10
819 && $minutes_passed % 100 < 20 ? "прошло"
820 : $minutes_passed % 10 == 1 ? "прошла"
821 : "прошло";
823 my $minutes_word = $minutes_passed % 100 > 10
824 && $minutes_passed % 100 < 20 ? "минут" :
825 $minutes_passed % 10 == 1 ? "минута":
826 $minutes_passed % 10 == 0 ? "минут" :
827 $minutes_passed % 10 > 4 ? "минут" :
828 "минуты";
830 if ($seconds_since_last_command < 1800) {
831 $result .= "<div class='time_passed'>"
832 . $passed_word." ".$minutes_passed." ".$minutes_word
833 . "</div>\n";
834 }
835 else {
836 $result .= "<div class='much_time_passed'>"
837 . $passed_word." ".$minutes_passed." ".$minutes_word
838 . "</div>\n";
839 }
840 }
841 return $result;
842 }
844 #############
845 # print_all_txt
846 #
847 # Вывести журнал в текстовом формате
848 #
849 # In: $_[0] output_filename
850 # Out:
852 sub print_command_lines_txt
853 {
855 my $output_filename=$_[0];
856 my $note_number=0;
858 my $result = q();
859 my $this_day_resut = q();
861 my $cl;
862 my $last_tty="";
863 my $last_session="";
864 my $last_day=q();
865 my $last_wday=q();
866 my $in_range=0;
868 my $current_command=0;
870 my $cursor_position = 0;
873 if ($Config{filter}) {
874 # Инициализация фильтра
875 for (split /&/,$Config{filter}) {
876 my ($var, $val) = split /=/;
877 $filter{$var} = $val || "";
878 }
879 }
882 COMMAND_LINE:
883 for my $k (@Command_Lines_Index) {
885 my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
886 next unless $cl;
889 # Пропускаем строки, которые противоречат фильтру
890 # Если у нас недостаточно информации о том, подходит строка под фильтр или нет,
891 # мы её выводим
893 for my $filter_key (keys %filter) {
894 next COMMAND_LINE
895 if defined($cl->{local_session_id})
896 && defined($Sessions{$cl->{local_session_id}}->{$filter_key})
897 && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
898 }
900 # Пропускаем строки, выходящие за границу "signature",
901 # при условии, что границы указаны
902 # Пропускаем неправильные/прерванные/другие команды
903 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
904 $in_range=1;
905 next;
906 }
907 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
908 $in_range=0;
909 next;
910 }
911 next if ($Config{"from"} && $Config{"to"} && !$in_range)
912 || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
913 || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
914 || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
917 #
918 ##
919 ## Начинается собственно вывод
920 ##
921 #
923 ### Сначала обрабатываем границы разделов
924 ### Если тип команды "note", это граница
926 if ($cl->{class} eq "note") {
927 $this_day_result .= " === ".$cl->{note_title}." === \n" if $cl->{note_title};
928 $this_day_result .= $cl->{note}."\n";
929 next;
930 }
932 my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
934 # Добавляем спереди 0 для удобочитаемости
935 $min = "0".$min if $min =~ /^.$/;
936 $hour = "0".$hour if $hour =~ /^.$/;
937 $sec = "0".$sec if $sec =~ /^.$/;
939 $class=$cl->{"class"};
941 # DAY CHANGE
942 if ( $last_day ne $day) {
943 if ($last_day) {
944 $result .= "== ".$Day_Name[$last_wday]." == \n";
945 $result .= $this_day_result;
946 }
947 $last_day = $day;
948 $last_wday = $wday;
949 $this_day_result = q();
950 }
952 # CONSOLE CHANGE
953 if ($cl->{"tty"} && $last_tty ne $cl->{"tty"} && 0) {