lilalo: 2c00c61f2d7b l3-frontend

lilalo

view l3-frontend @ 100:2c00c61f2d7b

Коммичу изменения, но сам не знаю зачем.
Нужно l3-cgi переписать вообще с нуля.
Он мерзкий.

И продумать нужно, как он вообще должен работать.
Понятно, приблизительно, как он должен показывать журнал,
когда до него уже дошли,
но вот если не дошли, то что делать не понятно.
Короче, продумать систему навигации.

author	devi
date	Wed Jun 14 21:37:22 2006 +0300 (2006-06-14)
parents	45196265d30e
children	c41cc9a4b5ea

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

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;

83 sub init_filter

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));

95 # extract_from_cline

97 # In: $what = commands | args

98 # Out: return ссылка на хэш, содержащий результаты разбора

99 # команда => позиция

101 # Разобрать командную строку $_[1] и возвратить хэш, содержащий

102 # номер первого появление команды в строке:

103 # команда => первая позиция

104 sub extract_from_cline

106 my $what = $_[0];

107 my $cline = $_[1];

108 my @lists = split /\;/, $cline;

109

110

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 }

150

157 # Подпрограммы для работы с mywi

160 sub open_mywi_socket

162 $Mywi_Socket = IO::Socket::INET->new(

163 PeerAddr => $Config{mywi_server},

164 PeerPort => $Config{mywi_port},

165 Proto => "tcp",

166 Type => SOCK_STREAM);

169 sub close_mywi_socket

171 close ($Mywi_Socket) if $Mywi_Socket ;

175 sub mywi_client

177 return "";

178 my $query = $_[0];

179 my $mywi;

181 open_mywi_socket;

182 if ($Mywi_Socket) {

183 local $| = 1;

184 local $/ = "";

185 print $Mywi_Socket $query."\n";

186 $mywi = <$Mywi_Socket>;

187 $mywi = "" if $mywi =~ /nothing app/;

188 }

189 close_mywi_socket;

190 return $mywi;

193 sub make_comment

195 my $cline = $_[0];

196 #my $files = $_[1];

198 my @comments;

199 my @commands = keys %{extract_from_cline("commands", $cline)};

200 my @args = keys %{extract_from_cline("args", $cline)};

201 return if (!@commands && !@args);

202 #return "commands=".join(" ",@commands)."; files=".join(" ",@files);

204 # Commands

205 for my $command (@commands) {

206 $command =~ s/'//g;

207 $frequency_of_command{$command}++;

208 if (!$Commands_Description{$command}) {

209 $mywi_cache_for{$command} ||= mywi_client ($command) || "";

210 my $mywi = join ("\n", grep(/\([18]|sh|script\)/, split(/\n/, $mywi_cache_for{$command})));

211 $mywi =~ s/\s+/ /;

212 if ($mywi !~ /^\s*$/) {

213 $Commands_Description{$command} = $mywi;

214 }

215 else {

216 next;

217 }

218 }

220 push @comments, $Commands_Description{$command};

221 }

222 return join("
\n", @comments);

223

224 # Files

225 for my $arg (@args) {

226 $arg =~ s/'//g;

227 if (!$Args_Description{$arg}) {

228 my $mywi;

229 $mywi = mywi_client ($arg);

230 $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));

231 $mywi =~ s/\s+/ /;

232 if ($mywi !~ /^\s*$/) {

233 $Args_Description{$arg} = $mywi;

234 }

235 else {

236 next;

237 }

238 }

240 push @comments, $Args_Description{$arg};

241 }

245 =cut

246 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта

247 из XML-документа в переменную @Command_Lines

249 # In: $datafile имя файла

250 # Out: @CommandLines загруженные командные строки

252 Предупреждение!

253 Процедура не в состоянии обрабатывать XML-документ любой структуры.

254 В действительности файл cache из которого загружаются данные

255 просто напоминает XML с виду.

256 =cut

257 sub load_command_lines_from_xml

259 my $datafile = $_[0];

261 open (CLASS, $datafile)

262 or die "Can't open file with xml lablog ",$datafile,"\n";

263 local $/;

264 binmode CLASS, ":utf8";

265 $data = <CLASS>;

266 close(CLASS);

268 for $command ($data =~ m@<command>(.*?)</command>@sg) {

269 my %cl;

270 while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {

271 $cl{$1} = $2;

272 }

273 push @Command_Lines, \%cl;

274 }

277 sub load_sessions_from_xml

279 my $datafile = $_[0];

281 open (CLASS, $datafile)

282 or die "Can't open file with xml lablog ",$datafile,"\n";

283 local $/;

284 binmode CLASS, ":utf8";

285 my $data = <CLASS>;

286 close(CLASS);

288 my $i=0;

289 for my $session ($data =~ m@<session>(.*?)</session>@msg) {

290 my %session_hash;

291 while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {

292 $session_hash{$1} = $2;

293 }

294 $Sessions{$session_hash{local_session_id}} = \%session_hash;

295 }

299 # sort_command_lines

300 # In: @Command_Lines

301 # Out: @Command_Lies_Index

303 sub sort_command_lines

306 my @index;

307 for (my $i=0;$i<=$#Command_Lines;$i++) {

308 $index[$i]=$i;

309 }

311 @Command_Lines_Index = sort {

312 $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}

313 } @index;

317 ##################

318 # process_command_lines

320 # Обрабатываются командные строки @Command_Lines

321 # Для каждой строки определяется:

322 # class класс

323 # note комментарий

325 # In: @Command_Lines_Index

326 # In-Out: @Command_Lines

328 sub process_command_lines

331 COMMAND_LINE_PROCESSING:

332 for my $i (@Command_Lines_Index) {

333 my $cl = \$Command_Lines[$i];

335 next if !$cl;

337 for my $filter_key (keys %filter) {

338 next COMMAND_LINE_PROCESSING

339 if defined($$cl->{local_session_id})

340 && defined($Sessions{$$cl->{local_session_id}}->{$filter_key})

341 && $Sessions{$$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};

342 }

344 $$cl->{id} = $$cl->{"time"};

346 $$cl->{err} ||=0;

348 # Класс команды

350 $$cl->{"class"} = $$cl->{"err"} eq 130 ? "interrupted"

351 : $$cl->{"err"} eq 127 ? "mistyped"

352 : $$cl->{"err"} ? "wrong"

353 : "normal";

355 if ($$cl->{"cline"} &&

356 $$cl->{"cline"} =~ /[^|`]\s*sudo/

357 || $$cl->{"uid"} eq 0) {

358 $$cl->{"class"}.="_root";

359 }

361 my $hint;

362 $hint = make_comment($$cl->{"cline"});

363 if ($hint) {

364 $$cl->{hint} = $hint;

365 }

366 # $$cl->{hint}="";

368 # Выводим <head_lines> верхних строк

369 # и <tail_lines> нижних строк,

370 # если эти параметры существуют

371 my $output="";

373 if ($$cl->{"last_command"} eq "cat" && !$$cl->{"err"} && !($$cl->{"cline"} =~ /</)) {

374 my $filename = $$cl->{"cline"};

375 $filename =~ s/.*\s+(\S+)\s*$/$1/;

376 $Files{$filename}->{"content"} = $$cl->{"output"};

377 $Files{$filename}->{"source_command_id"} = $$cl->{"id"}

378 }

379 my @lines = split '\n', $$cl->{"output"};

380 if ((

381 $Config{"head_lines"}

382 || $Config{"tail_lines"}

383 )

384 && $#lines > $Config{"head_lines"} + $Config{"tail_lines"} ) {

386 for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {

387 $output .= $lines[$i]."\n";

388 }

389 $output .= $Config{"skip_text"}."\n";

391 my $start_line=$#lines-$Config{"tail_lines"}+1;

392 for (my $i=$start_line; $i<= $#lines; $i++) {

393 $output .= $lines[$i]."\n";

394 }

395 }

396 else {

397 $output = $$cl->{"output"};

398 }

399 $$cl->{short_output} = $output;

401 #Обработка пометок

402 # Если несколько пометок (notes) идут подряд,

403 # они все объединяются

405 if ($$cl->{cline} =~ /l3shot/) {

406 if ($$cl->{output} =~ m@Screenshot is written to.*/(.*)\.xwd@) {

407 $$cl->{screenshot}="$1";

408 }

409 }

411 if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) {

413 my $note_operator = $1;

414 my $note_title = $2;

416 if ($note_operator eq "=") {

417 $$cl->{"class"} = "note";

418 $$cl->{"note"} = $$cl->{"output"};

419 $$cl->{"note_title"} = $2;

420 }

421 else {

422 my $j = $i;

423 if ($note_operator eq "^") {

424 $j--;

425 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));

426 }

427 elsif ($note_operator eq "v") {

428 $j++;

429 $j++ while ($j <= @Command_Lines && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));

430 }

431 $Command_Lines[$j]->{note_title}=$note_title;

432 $Command_Lines[$j]->{note}.=$$cl->{output};

433 $$cl=0;

434 }

435 }

436 elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) {

438 my $note_operator = $1;

439 my $note_text = $2;

441 if ($note_operator eq "=") {

442 $$cl->{"class"} = "note";

443 $$cl->{"note"} = $note_text;

444 }

445 else {

446 my $j=$i;

447 if ($note_operator eq "^") {

448 $j--;

449 $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty}));

450 }

451 elsif ($note_operator eq "v") {

452 $j++;

453 $j++ while ($j <= @Command_Lines && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]);

454 }

455 $Command_Lines[$j]->{note}.="$note_text\n";

456 $$cl=0;

457 }

458 }

459 if ($$cl->{"class"} eq "note") {

460 my $note_html = $$cl->{note};

461 $note_html = join ("\n", map ("<p>$_</p>", split (/-\n/, $note_html)));

462 $note_html =~ s@(http:[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;

463 $note_html =~ s@(www\.[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;

464 $$cl->{"note_html"} = $note_html;

465 }

466 }

471 =cut

472 Процедура print_command_lines выводит HTML-представление

473 разобранного lab-скрипта.

475 Разобранный lab-скрипт должен находиться в массиве @Command_Lines

476 =cut

478 sub print_command_lines_html

481 my @toc; # Оглавление

482 my $note_number=0;

484 my $result = q();

485 my $this_day_resut = q();

486

487 my $cl;

488 my $last_tty="";

489 my $last_session="";

490 my $last_day=q();

491 my $last_wday=q();

492 my $in_range=0;

494 my $current_command=0;

496 my @known_commands;

500 $Stat{LastCommand} ||= 0;

501 $Stat{TotalCommands} ||= 0;

502 $Stat{ErrorCommands} ||= 0;

503 $Stat{MistypedCommands} ||= 0;

505 my %new_entries_of = (

506 "1 1" => "программы пользователя",

507 "2 8" => "программы администратора",

508 "3 sh" => "команды интерпретатора",

509 "4 script"=> "скрипты",

510 );

512 COMMAND_LINE:

513 for my $k (@Command_Lines_Index) {

515 my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];

516 next unless $cl;

518 # Пропускаем команды, с одинаковым временем

519 # Это не совсем правильно.

520 # Возможно, что это команды, набираемые с помощью <completion>

521 # или запомненные с помощью <ctrl-c>

523 next if $Stat{LastCommand} == $cl->{time};

525 # Пропускаем строки, которые противоречат фильтру

526 # Если у нас недостаточно информации о том, подходит строка под фильтр или нет,

527 # мы её выводим

529 for my $filter_key (keys %filter) {

530 next COMMAND_LINE

531 if defined($cl->{local_session_id})

532 && defined($Sessions{$cl->{local_session_id}}->{$filter_key})

533 && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};

534 }

536 # Набираем статистику

537 # Хэш %Stat

539 $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};

540 if ($cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval}) {

541 $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}

542 }

543 my $seconds_since_last_command = $cl->{time} - $Stat{LastCommand};

545 if ($Stat{LastCommand} > $cl->{time}) {

546 $result .= "Время идёт вспять<br/>";

547 };

548 $Stat{LastCommand} = $cl->{time};

549 $Stat{TotalCommands}++;

551 # Пропускаем строки, выходящие за границу "signature",

552 # при условии, что границы указаны

553 # Пропускаем неправильные/прерванные/другие команды

554 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {

555 $in_range=1;

556 next;

557 }

558 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {

559 $in_range=0;

560 next;

561 }

562 next if ($Config{"from"} && $Config{"to"} && !$in_range)

563 || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )

564 || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)

565 || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);

566

572 ## Начинается собственно вывод

576 ### Сначала обрабатываем границы разделов

577 ### Если тип команды "note", это граница

579 if ($cl->{class} eq "note") {

580 $this_day_result .= "<tr><td colspan='6'>"

581 . "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title}

582 . "".$cl->{note_html}."<p/><p/></td></tr>";

584 if ($cl->{note_title}) {

585 push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";

586 $note_number++;

587 }

588 next;

589 }

591 my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});

593 # Добавляем спереди 0 для удобочитаемости

594 $min = "0".$min if $min =~ /^.$/;

595 $hour = "0".$hour if $hour =~ /^.$/;

596 $sec = "0".$sec if $sec =~ /^.$/;

598 $class=$cl->{"class"};

599 $Stat{ErrorCommands}++ if $class =~ /wrong/;

600 $Stat{MistypedCommands}++ if $class =~ /mistype/;

602 # DAY CHANGE

603 if ( $last_day ne $day) {

604 if ($last_day) {

606 # Вычисляем разность множеств.

607 # Что-то вроде этого, если бы так можно было писать:

608 # @new_commands = keys %frequency_of_command - @known_commands;

611 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";

612 for my $entry_class (sort keys %new_entries_of) {

613 my $table_caption = "Таблица ".$table_number++.".".$Day_Name[$last_wday]

614 .". Новые ".$new_entries_of{$entry_class};

615 my $new_commands_section = make_new_entries_table(

616 $table_caption,

617 $entry_class=~/[0-9]+\s+(.*)/,

618 \@known_commands);

619 }

620 @known_commands = keys %frequency_of_command;

621 $result .= $this_day_result;

622 }

624 push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";

625 $last_day=$day;

626 $last_wday=$wday;

627 $this_day_result = q();

628 }

629 else {

630 $this_day_result .= minutes_passed($seconds_since_last_command);

631 }

633 $this_day_result .= "<div class='command' id='command:".$cl->{"id"}."' >\n";

635 # CONSOLE CHANGE

636 if ($cl->{"tty"} && $last_tty ne $cl->{"tty"} && 0) {

637 my $tty = $cl->{"tty"};

638 $this_day_result .= "<div class='ttychange'>"

639 . $tty

640 ."</div>";

641 $last_tty=$cl->{"tty"};

642 }

644 # Session change

645 if ( $last_session ne $cl->{"local_session_id"}) {

646 my $tty;

647 if (defined $Sessions{$cl->{"local_session_id"}}->{"tty"}) {

648 $this_day_result .= "<div class='ttychange'><a href='?local_session_id=".$cl->{"local_session_id"}."'>"

649 . $Sessions{$cl->{"local_session_id"}}->{"tty"}

650 ."</a></div>";

651 }

652 $last_session=$cl->{"local_session_id"};

653 }

655 # TIME

656 if ($Config{"show_time"} =~ /^y/i) {

657 $this_day_result .= "<div class='time'>$hour:$min:$sec</div>"

658 }

660 # COMMAND

661 my $cline;

662 $prompt_hint = join ("
", map("$_=$cl->{$_}", grep (!/^(output|diff)$/, sort(keys(%{$cl})))));

663 $cline = "<span title='$prompt_hint'>".$cl->{"prompt"}."</span>".$cl->{"cline"};

664 $cline =~ s/\n//;

666 if ($cl->{"hint"}) {

667 $cline = "<span title='$cl->{hint}' class='with_hint'>$cline</span>" ;

668 }

669 else {

670 $cline = "<span class='without_hint'>$cline</span>";

671 }

673 $this_day_result .= "<table cellpadding='0' cellspacing='0'><tr><td>\n<div class='cblock_$cl->{class}'>\n";

674 $this_day_result .= "<div class='cline'>\n" . $cline ; #cline

675 $this_day_result .= "<span title='Код завершения ".$cl->{"err"}."'>\n"

676 . "<img src='".$Config{frontend_ico_path}."/error.png'/>\n"

677 . "</span>\n" if $cl->{"err"};

678 $this_day_result .= "</div>\n"; #cline

680 # OUTPUT

681 my $last_command = $cl->{"last_command"};

682 if (!(

683 $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||

684 $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||

685 $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})

686 )) {

687 $this_day_result .= "<pre class='output'>\n" . $cl->{short_output} . "</pre>\n";

688 }

690 # DIFF

691 $this_day_result .= "<pre class='diff'>".$cl->{"diff"}."</pre>"

692 if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"});

693 # SHOT

694 $this_day_result .= "<img src='"

695 .$Config{l3shot_path}

696 .$cl->{"screenshot"}

697 .$Config{l3shot_suffix}

698 ."' alt ='screenshot id ".$cl->{"screenshot"}

699 ."'/>"

700 if ( $Config{"show_screenshots"} =~ /^y/i && $cl->{"screenshot"});

702 #NOTES

703 if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {

704 my $note=$cl->{"note"};

705 $note =~ s/\n/<br\/>\n/msg;

706 if (not $note =~ s@(http:[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g) {

707 $note =~ s@(www\.[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g;

708 };

709 $this_day_result .= "<div class='note'>";

710 $this_day_result .= "<div class='note_title'>".$cl->{note_title}."</div>" if $cl->{note_title};

711 $this_day_result .= "<div class='note_text'>".$note."</div>";

712 $this_day_result .= "</div>\n";

713 }

715 # Вывод очередной команды окончен

716 $this_day_result .= "</div>\n"; # cblock

717 $this_day_result .= "</td></tr></table>\n"

718 . "</div>\n"; # command

719 }

720 last: {

721 $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";

723 for my $entry_class (keys %new_entries_of) {

724 my $table_caption = "Таблица ".$table_number++.".".$Day_Name[$last_wday]

725 . ". Новые ".$new_entries_of{$entry_class};

726 my $new_commands_section = make_new_entries_table(

727 $table_caption,

728 $entry_class=~/[0-9]+\s+(.*)/,

729 \@known_commands);

730 }

731 @known_commands = keys %frequency_of_command;

732 $result .= $this_day_result;

733 }

735 return ($result, collapse_list (\@toc));

739 #############

740 # make_new_entries_table

742 # Напечатать таблицу неизвестных команд

744 # In: $_[0] table_caption

745 # $_[1] entries_class

746 # @_[2..] known_commands

747 # Out:

749 sub make_new_entries_table

751 my $table_caption;

752 my $entries_class = shift;

753 my @known_commands = @{$_[0]};

754 my $result = "";

756 my %count;

757 my @new_commands = ();

758 for my $c (keys %frequency_of_command, @known_commands) {

759 $count{$c}++

760 }

761 for my $c (keys %frequency_of_command) {

762 push @new_commands, $c if $count{$c} != 2;

763 }

765 my $new_commands_section;

766 if (@new_commands){

767 my $hint;

768 for my $c (reverse sort { $frequency_of_command{$a} <=> $frequency_of_command{$b} } @new_commands) {

769 $hint = make_comment($c);

770 next unless $hint;

771 my ($command, $hint) = $hint =~ m/(.*?) \s*- \s*(.*)/;

772 next unless $command =~ s/\($entries_class\)//i;

773 $new_commands_section .= "<tr><td valign='top'>$command</td><td>$hint</td></tr>";

774 }

775 }

776 if ($new_commands_section) {

777 $result .= "<table class='new_commands_table' width='700' cellspacing='0' cellpadding='0'>"

778 . "<tr class='new_commands_caption'>"

779 . "<td colspan='2' align='right'>$table_caption</td>"

780 . "</tr>"

781 . "<tr class='new_commands_header'>"

782 . "<td width=100>Команда</td><td width=600>Описание</td>"

783 . "</tr>"

784 . $new_commands_section

785 . "</table>"

786 }

787 return $result;

790 #############

791 # minutes_passed

795 # In: $_[0] seconds_since_last_command

796 # Out: "minutes passed" text

798 sub minutes_passed

800 my $seconds_since_last_command = shift;

801 my $result = "";

802 if ($seconds_since_last_command > 7200) {

803 my $hours_passed = int($seconds_since_last_command/3600);

804 my $passed_word = $hours_passed % 10 == 1 ? "прошла"

805 : "прошло";

806 my $hours_word = $hours_passed % 10 == 1 ? "часа":

807 "часов";

808 $result .= "<div class='much_time_passed'>"

809 . $passed_word." >".$hours_passed." ".$hours_word

810 . "</div>\n";

811 }

812 elsif ($seconds_since_last_command > 600) {

813 my $minutes_passed = int($seconds_since_last_command/60);

816 my $passed_word = $minutes_passed % 100 > 10

817 && $minutes_passed % 100 < 20 ? "прошло"

818 : $minutes_passed % 10 == 1 ? "прошла"

819 : "прошло";

821 my $minutes_word = $minutes_passed % 100 > 10

822 && $minutes_passed % 100 < 20 ? "минут" :

823 $minutes_passed % 10 == 1 ? "минута":

824 $minutes_passed % 10 == 0 ? "минут" :

825 $minutes_passed % 10 > 4 ? "минут" :

826 "минуты";

828 if ($seconds_since_last_command < 1800) {

829 $result .= "<div class='time_passed'>"

830 . $passed_word." ".$minutes_passed." ".$minutes_word

831 . "</div>\n";

832 }

833 else {

834 $result .= "<div class='much_time_passed'>"

835 . $passed_word." ".$minutes_passed." ".$minutes_word

836 . "</div>\n";

837 }

838 }

839 return $result;

842 #############

843 # print_all_txt

845 # Вывести журнал в текстовом формате

847 # In: $_[0] output_filename

848 # Out:

850 sub print_command_lines_txt

853 my $output_filename=$_[0];

854 my $note_number=0;

856 my $result = q();

857 my $this_day_resut = q();

858

859 my $cl;

860 my $last_tty="";

861 my $last_session="";

862 my $last_day=q();

863 my $last_wday=q();

864 my $in_range=0;

866 my $current_command=0;

868 my $cursor_position = 0;

871 if ($Config{filter}) {

872 # Инициализация фильтра

873 for (split /&/,$Config{filter}) {

874 my ($var, $val) = split /=/;

875 $filter{$var} = $val || "";

876 }

877 }

880 COMMAND_LINE:

881 for my $k (@Command_Lines_Index) {

883 my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];

884 next unless $cl;

887 # Пропускаем строки, которые противоречат фильтру

888 # Если у нас недостаточно информации о том, подходит строка под фильтр или нет,

889 # мы её выводим

891 for my $filter_key (keys %filter) {

892 next COMMAND_LINE

893 if defined($cl->{local_session_id})

894 && defined($Sessions{$cl->{local_session_id}}->{$filter_key})

895 && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};

896 }

898 # Пропускаем строки, выходящие за границу "signature",

899 # при условии, что границы указаны

900 # Пропускаем неправильные/прерванные/другие команды

901 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {

902 $in_range=1;

903 next;

904 }

905 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {

906 $in_range=0;

907 next;

908 }

909 next if ($Config{"from"} && $Config{"to"} && !$in_range)

910 || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )

911 || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)

912 || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);

917 ## Начинается собственно вывод

921 ### Сначала обрабатываем границы разделов

922 ### Если тип команды "note", это граница

924 if ($cl->{class} eq "note") {

925 $this_day_result .= " === ".$cl->{note_title}." === \n" if $cl->{note_title};

926 $this_day_result .= $cl->{note}."\n";

927 next;

928 }

930 my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});

932 # Добавляем спереди 0 для удобочитаемости

933 $min = "0".$min if $min =~ /^.$/;

934 $hour = "0".$hour if $hour =~ /^.$/;

935 $sec = "0".$sec if $sec =~ /^.$/;

937 $class=$cl->{"class"};

939 # DAY CHANGE

940 if ( $last_day ne $day) {

941 if ($last_day) {

942 $result .= "== ".$Day_Name[$last_wday]." == \n";

943 $result .= $this_day_result;

944 }

945 $last_day = $day;

946 $last_wday = $wday;

947 $this_day_result = q();

948 }