lilalo: 4c02cf4123ee l3-frontend

lilalo

view l3-frontend @ 98:4c02cf4123ee

l3-agent и l3-backend изменены так, что
все записанные команды теперь привязаны к контексту,
заданному в параметре
l3cd
агента

Их XML-представление теперь сохраняется не только в общем
файле backend.xml,
но и в файлах соответствующих контексту l3cd

$Config{backend_datadir}/$l3cd/data.xml

Параметр l3cd (пока что) меняется вручную в конфигурационном
файле агента ~/.l3rc

После того как параметр изменён необходимо перезапустить агент,
отправив ему сигнал HUP
killall -1 l3-agent

ЧТО НУЖНО СДЕЛАТЬ:

== Безопасность ==

* Сделать процедуру залогивинивания и проверки подлинности пользователя
* Ограничить доступ на запись в контекстные каталоги для пользователей

== Смена каталога ==
* Сделать команду l3, которая позволяет изменить и просмотреть
текущий l3-контекст

l3 pwd
l3 cd /devi/netflow

author	devi
date	Sun Jun 11 22:07:42 2006 +0300 (2006-06-11)
parents	d3182b751893
children	05e99d32f1f5

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