lilalo: 822b36252d7f l3-frontend

lilalo

view l3-frontend @ 150:822b36252d7f

Вывод больших фрагментов текста не теряется.

Большие фрагменты текста теперь не вырезаются бесследно.
Там, откуда они вырезаются, вставляются ссылки,
по которым можно посмотреть полную версию вывода.
Испытано на больших фрагментах текста,
содержащих до 5000 строк (фрагменты более 5000 строк по умолчанию
обрезаются административно; допустимые размеры задаются в l3config.pm).
Исправлены ошибки, из-за которых большие фрагменты
обрабатывались некорректно.

author	igor@chub.in
date	Tue Jun 23 01:15:02 2009 +0300 (2009-06-23)
parents	266dae9ce2a1
children	80691b40e6db

line source

1 #!/usr/bin/perl

3 use POSIX qw(strftime);

4 use lib '/etc/lilalo';

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 %Sessions;

13 our %Uploads;

15 our $debug_output=""; # Используйте эту переменную, если нужно передать отладочную информацию

17 our %filter;

18 our $filter_url;

19 sub init_filter;

21 our %Files;

23 # vvv Инициализация переменных выполняется процедурой init_variables

24 our @Day_Name;

25 our @Month_Name;

26 our @Of_Month_Name;

27 our %Search_Machines;

28 our %Elements_Visibility;

29 # ^^^

31 our $First_Command=$0;

32 our $Last_Command=40;

34 our %Stat;

35 our %frequency_of_command; # Сколько раз в журнале встречается какая команда

36 our $table_number=1;

37 our %tigra_hints;

39 my %mywi_cache_for; # Кэш для экономии обращений к mywi

41 sub count_frequency_of_commands;

42 sub make_comment;

43 sub make_new_entries_table;

44 sub load_command_lines_from_xml;

45 sub load_sessions_from_xml;

46 sub load_uploads;

47 sub sort_command_lines;

48 sub process_command_lines;

49 sub init_variables;

50 sub main;

51 sub collapse_list($);

53 sub minutes_passed;

55 sub print_all_txt;

56 sub print_all_html;

57 sub print_edit_all_html;

58 sub print_command_lines_html;

59 sub print_command_lines_txt;

60 sub print_files_html;

61 sub print_stat_html;

62 sub print_header_html;

63 sub print_footer_html;

64 sub tigra_hints_generate;

67 #### mywi

69 sub mywi_init;

70 sub load_mywitxt;

71 sub mywi_process_query($);

73 sub add_to_log($$);

74 sub parse_query;

75 sub search_in_txt;

76 sub add_to_log($$);

77 sub mywi_guess($);

80 main();

82 sub main

84 $| = 1;

86 init_variables();

87 init_config();

88 $Config{frontend_ico_path}=$Config{frontend_css};

89 $Config{frontend_ico_path}=~s@/[^/]*$@@;

90 init_filter();

91 mywi_init();

93 load_command_lines_from_xml($Config{"backend_datafile"});

94 load_uploads($Config{"upload_dir"});

95 load_sessions_from_xml($Config{"backend_datafile"});

96 sort_command_lines;

97 process_command_lines;

98 if (defined($filter{action}) && $filter{action} eq "edit") {

99 print_edit_all_html($Config{"output"});

100 }

101 else {

102 print_all_html($Config{"output"});

103 }

106 sub init_filter

108 if ($Config{filter}) {

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

110 for (split /;;/,$Config{filter}) {

111 my ($var, $val) = split /::/;

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

113 }

114 }

115 $filter_url = join (";;", map("$_::$filter{$_}", keys %filter));

118 # extract_from_cline

120 # In: $what = commands | args

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

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

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

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

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

127 sub extract_from_cline

129 my $what = $_[0];

130 my $cline = $_[1];

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

132

133

134 my @command_lines = ();

135 for my $command_list (@lists) {

136 push(@command_lines, split(/\|/, $command_list));

137 }

139 my %position_of_command;

140 my %position_of_arg;

141 my $i=0;

142 for my $command_line (@command_lines) {

143 $command_line =~ s@^\s*@@;

144 $command_line =~ /\s*(\S+)\s*(.*)/;

145 if ($1 && $1 eq "sudo" ) {

146 $position_of_command{"$1"}=$i++;

147 $command_line =~ s/\s*sudo\s+//;

148 }

149 if ($command_line !~ m@^\s*\S*/etc/@) {

150 $command_line =~ s@^\s*\S+/@@;

151 }

153 $command_line =~ /\s*(\S+)\s*(.*)/;

154 my $command = $1;

155 my $args = $2;

156 if ($command && !defined $position_of_command{"$command"}) {

157 $position_of_command{"$command"}=$i++;

158 };

159 if ($args) {

160 my @args = split (/\s+/, $args);

161 for my $a (@args) {

162 $position_of_arg{"$a"}=$i++

163 if !defined $position_of_arg{"$a"};

164 };

165 }

166 }

168 if ($what eq "commands") {

169 return \%position_of_command;

170 } else {

171 return \%position_of_arg;

172 }

173

176 sub mywrap($)

178 return '<div class="t"><div class="b"><div class="l"><div class="r"><div class="bl"><div class="br"><div class="tl"><div class="tr">'.$_[0].

179 '</div></div></div></div></div></div></div></div>';

182 sub tigra_hints_generate

184 my $tigra_hints_items="";

185 for my $hint_id (keys %tigra_hints) {

186 $tigra_hints{$hint_id} =~ s@\n@<br/>@gs;

187 $tigra_hints{$hint_id} =~ s@ - @ — @gs;

188 $tigra_hints{$hint_id} =~ s@'@\\'@gs;

189 # $tigra_hints_items .= "'$hint_id' : mywrap('".$tigra_hints{$hint_id}."'),";

190 $tigra_hints_items .= "'$hint_id' : '".mywrap($tigra_hints{$hint_id})."',";

191 }

192 $tigra_hints_items =~ s/,$//;

193 return <<TIGRA;

195 var HINTS_CFG = {

196 'top' : 5, // a vertical offset of a hint from mouse pointer

197 'left' : 5, // a horizontal offset of a hint from mouse pointer

198 'css' : 'hintsClass', // a style class name for all hints, TD object

199 'show_delay' : 500, // a delay between object mouseover and hint appearing

200 'hide_delay' : 2000, // a delay between hint appearing and hint hiding

201 'wise' : true,

202 'follow' : true,

203 'z-index' : 0 // a z-index for all hint layers

206 HINTS_CFG_NEW = {

207 'wise' : true, // don't go off screen, don't overlap the object in the document

208 'margin' : 10, // minimum allowed distance between the hint and the window edge (negative values accepted)

209 'gap' : 20, // minimum allowed distance between the hint and the origin (negative values accepted)

210 'align' : 'bctl', // align of the hint and the origin (by first letters origin's top|middle|bottom left|center|right to hint's top|middle|bottom left|center|right)

211 'css' : 'hintsClass', // a style class name for all hints, applied to DIV element (see style section in the header of the document)

212 'show_delay' : 0, // a delay between initiating event (mouseover for example) and hint appearing

213 'hide_delay' : 200, // a delay between closing event (mouseout for example) and hint disappearing

214 'follow' : true, // hint follows the mouse as it moves

215 'z-index' : 100, // a z-index for all hint layers

216 'IEfix' : false, // fix IE problem with windowed controls visible through hints (activate if select boxes are visible through the hints)

217 'IEtrans' : ['blendTrans(DURATION=.3)', null], // [show transition, hide transition] - nice transition effects, only work in IE5+

218 'opacity' : 90 // opacity of the hint in %%

221 HINTS_ITEMS = {

222 $tigra_hints_items

224 var myHint = new THints (HINTS_CFG, HINTS_ITEMS);

227 function mywrap (s_) {

228 return '<div class="t"><div class="b"><div class="l"><div class="r"><div class="bl"><div class="br"><div class="tl"><div class="tr">'+s_+

229 '</div></div></div></div></div></div></div></div>';

232 TIGRA

233 $a=<<TIGRA;

234 TIGRA

238 sub count_frequency_of_commands

240 my $cline = $_[0];

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

242 for my $command (@commands) {

243 $frequency_of_command{$command}++;

244 }

247 sub make_comment

249 my $cline = $_[0];

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

252 my @comments;

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

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

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

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

258 # Commands

259 for my $command (@commands) {

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

261 #$frequency_of_command{$command}++;

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

263 $mywi_cache_for{$command} ||= mywi_process_query($command) || "";

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

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

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

267 $Commands_Description{$command} = $mywi;

268 }

269 else {

270 next;

271 }

272 }

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

275 }

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

277

278 # Files

279 for my $arg (@args) {

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

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

282 my $mywi;

283 $mywi = mywi_client ($arg);

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

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

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

287 $Args_Description{$arg} = $mywi;

288 }

289 else {

290 next;

291 }

292 }

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

295 }

299 =cut

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

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

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

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

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

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

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

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

310 =cut

311 sub load_command_lines_from_xml

313 my $datafile = $_[0];

315 open (CLASS, $datafile)

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

317 local $/;

318 binmode CLASS, ":utf8";

319 $data = <CLASS>;

320 close(CLASS);

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

323 my %cl;

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

325 $cl{$1} = $2;

326 }

327 push @Command_Lines, \%cl;

328 }

331 sub load_sessions_from_xml

333 my $datafile = $_[0];

335 open (CLASS, $datafile)

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

337 local $/;

338 binmode CLASS, ":utf8";

339 my $data = <CLASS>;

340 close(CLASS);

342 my $i=0;

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

344 my %session_hash;

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

346 $session_hash{$1} = $2;

347 }

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

349 }

352 sub load_uploads($)

354 $dir=$_[0];

355 for $i (glob("$dir/*.png")) {

356 $i =~ s@.*/(([0-9-]+)_([0-9]+).*)@$1@;

357 if (defined($Uploads{$2}{$3})) {

358 $Uploads{$2}{$3} .= " ".$i;

359 }

360 else {

361 $Uploads{$2}{$3}=$i;

362 }

363 }

366 #for $key (sort keys %session) {

367 # for $t (sort { $a <=> $b } keys %{ $session{$key} }) {

368 # print $session{$key}{$t}."\n";

369 # }

373 # sort_command_lines

374 # In: @Command_Lines

375 # Out: @Command_Lies_Index

377 sub sort_command_lines

380 my @index;

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

382 $index[$i]=$i;

383 }

385 @Command_Lines_Index = sort {

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

387 } @index;

391 ##################

392 # process_command_lines

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

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

396 # class класс

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

399 # In: @Command_Lines_Index

400 # In-Out: @Command_Lines

402 sub process_command_lines

406 my $current_command=0;

407 my $prev_i;

409 my $tab_seq =0 ; # номер команды в последовательности tab-completion

410 # отличен от нуля только для тех последовательностей,

411 # где постоянно нажимается клавиша tab

413 COMMAND_LINE_PROCESSING:

414 for my $i (@Command_Lines_Index) {

415

416 $current_command++;

417 next if $current_command < $Config{"start_from_command"};

418 last if $current_command > $Config{"start_from_command"} + $Config{"commands_to_show_at_a_go"};

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

422 # Запоминаем предыщуюу команду

423 # Она нам потребуется, в частности, для ввода tab_seq рпи обработке tab_completion

424 my $prev_cl;

425 $prev_cl = \$Command_Lines[$prev_i] if defined($prev_i);

426 $prev_i = $i;

428 next if !$cl;

430 for my $filter_key (keys %filter) {

431 next COMMAND_LINE_PROCESSING

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

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

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

435 }

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

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

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

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

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

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

447 : "normal";

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

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

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

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

453 }

455 my $hint;

456 count_frequency_of_commands($$cl->{"cline"});

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

459 if ($hint) {

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

461 }

462 $tigra_hints{$$cl->{"time"}} = $hint;

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

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

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

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

469 my $output="";

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

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

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

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

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

476 }

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

478 if ((

479 $Config{"head_lines"}

480 || $Config{"tail_lines"}

481 )

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

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

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

486 }

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

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

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

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

492 }

493 }

494 else {

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

496 }

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

499 # Обработка команд с одинаковым временем

500 # Скорее всего они набраны с помощью tab-completion

501 if (defined($prev_cl)) {

502 if ($$prev_cl->{time} == $$cl->{time} && $$prev_cl->{nonce} == $$cl->{nonce}) {

503 $tab_seq++;

504 }

505 else {

506 $tab_seq=0;

507 };

508 $$prev_cl->{tab_seq}=$tab_seq;

510 # Обработка команд с одинаковым номером в истории

511 # Скорее всего они набраны с помощью Ctrl-C

512 #if ($$prev_cl->{history} == $$cl->{history}) {

513 # $$prev_cl->{break}=1;

514 #}

515 }

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

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

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

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

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

524 $$cl->{screenshot}="$1".$Config{l3shot_suffix};

525 }

526 }

527 if ($$cl->{cline} =~ /l3upload/) {

528 if ($$cl->{output} =~ m@Uploaded file name is (.*)@) {

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

530 }

531 }

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

535 my $note_operator = $1;

536 my $note_title = $2;

538 if ($note_operator eq "=") {

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

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

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

542 }

543 else {

544 my $j = $i;

545 if ($note_operator eq "^") {

546 $j--;

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

548 }

549 elsif ($note_operator eq "v") {

550 $j++;

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

552 }

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

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

555 $$cl=0;

556 }

557 }

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

560 my $note_operator = $1;

561 my $note_text = $2;

563 if ($note_operator eq "=") {

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

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

566 }

567 else {

568 my $j=$i;

569 if ($note_operator eq "^") {

570 $j--;

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

572 }

573 elsif ($note_operator eq "v") {

574 $j++;

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

576 }

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

578 $$cl=0;

579 }

580 }

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

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

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

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

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

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

587 }

588 }

593 =cut

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

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

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

598 =cut

600 sub print_command_lines_html

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

604 my $note_number=0;

606 my $result = q();

607 my $this_day_resut = q();

608

609 my $cl;

610 my $last_tty="";

611 my $last_session="";

612 my $last_day=q();

613 my $last_wday=q();

614 my $first_command_of_the_day_unix_time=q();

615 my $human_readable_time=q();

616 my $in_range=0;

618 my $current_command=0;

620 my @known_commands;

624 $Stat{LastCommand} ||= 0;

625 $Stat{TotalCommands} ||= 0;

626 $Stat{ErrorCommands} ||= 0;

627 $Stat{MistypedCommands} ||= 0;

629 my %new_entries_of = (

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

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

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

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

634 );

636 COMMAND_LINE:

637 for my $k (@Command_Lines_Index) {

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

640 next unless $cl;

641 my $next_cl=$Command_Lines[$Command_Lines_Index[$current_command]];

643 next if $current_command < $Config{"start_from_command"};

644 last if $current_command > $Config{"start_from_command"} + $Config{"commands_to_show_at_a_go"};

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

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

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

652 for my $filter_key (keys %filter) {

653 next COMMAND_LINE

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

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

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

657 }

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

660 # Хэш %Stat

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

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

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

665 }

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

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

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

670 };

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

672 $Stat{TotalCommands}++;

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

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

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

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

678 $in_range=1;

679 next;

680 }

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

682 $in_range=0;

683 next;

684 }

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

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

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

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

689

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

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

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

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

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

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

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

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

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

709 $note_number++;

710 }

711 next;

712 }

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

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

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

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

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

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

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

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

726 # DAY CHANGE

727 if ( $last_day ne $day) {

728 $prev_unix_time=$first_command_of_the_day_unix_time;

729 $first_command_of_the_day_unix_time = $cl->{time};

730 $human_readable_time = strftime "%D", localtime($prev_unix_time);

731 if ($last_day) {

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

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

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

738 # Выводим предыдущий день

740 $result .= "<h3 id='day_on_sec_$prev_unix_time'>".$Day_Name[$last_wday]." ($human_readable_time)</h3>";

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

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

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

744 my $new_commands_section = make_new_entries_table(

745 $table_caption,

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

747 \@known_commands);

748 }

749 @known_commands = keys %frequency_of_command;

750 $result .= $this_day_result;

751 }

753 # Добавляем текущий день в оглавление

755 $human_readable_time = strftime "%D", localtime($first_command_of_the_day_unix_time);

756 push @toc, "<a href='#day_on_sec_$first_command_of_the_day_unix_time'>".$Day_Name[$wday]." ($human_readable_time)</a>\n";

759 $last_day=$day;

760 $last_wday=$wday;

761 $this_day_result = q();

762 }

763 else {

764 $this_day_result .= minutes_passed($seconds_since_last_command);

765 }

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

769 # CONSOLE CHANGE

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

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

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

773 . $tty

774 ."</div>";

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

776 }

778 # Session change

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

780 my $tty;

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

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

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

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

785 }

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

787 }

789 # TIME

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

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

792 }

794 # COMMAND

795 my $cline;

796 $prompt_hint = join ("
",

797 map("$_=$cl->{$_}",

798 grep (!/^(output|short_output|diff)$/,

799 sort(keys(%{$cl})))));

801 $cl->{"prompt"} =~ s/ $//;

802 $cline = "<span title='$prompt_hint' class='prompt'><a href='#".$cl->{time}."' id='".$cl->{time}."'>".$cl->{"prompt"}."</a></span>"

803 ."<span onmouseover=\"myHint.show('".$cl->{time}."')\" onmouseout=\"myHint.hide()\">".$cl->{"cline"}."</span>";

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

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

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

808 $cline = "<span class='with_hint'>$cline</span>" ;

809 }

810 else {

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

812 }

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

815 $this_day_result .= "<div class='cline'>" . $cline ; #cline

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

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

818 . "</span>\n" if ($cl->{"err"} and not $cl->{tab_seq} and not $cl->{break});

819 $this_day_result .= "<span title='Tab completion ".$cl->{tab_seq}."'>\n"

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

821 . "</span>\n" if $cl->{tab_seq};

822 $this_day_result .= "<span title='Ctrl-C pressed'>\n"

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

824 . "</span>\n" if ($cl->{break} and not $cl->{tab_seq});

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

827 # OUTPUT

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

829 if (!(

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

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

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

833 )) {

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

835 }

837 # DIFF

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

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

840 # SHOT

842 #$this_day_result .= join(".", keys(%Uploads));

843 #$this_day_result .= "PRIVET";

844 for $t (sort { $a <=> $b } keys %{ $Uploads{$cl->{"local_session_id"}} }) {

845 if (($t >= $cl->{"time"} and $t < $next_cl->{"time"}) or ($t >= $cl->{"time"} and not defined($next_cl))) {

846 my @shots=split(/\s+/, $Uploads{$cl->{"local_session_id"}}{$t});

847 for my $shot (@shots) {

848 $this_day_result .= "<IMG src='"

849 .$Config{l3shot_path}

850 .$shot

851 ."' alt ='screenshot id ".$shot

852 ."'/><br/>"

853 }

854 }

855 }

857 # Временно заблокировано

858 # $this_day_result .= "<img src='"

859 # .$Config{l3shot_path}

860 # .$cl->{"screenshot"}

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

862 # ."'/>"

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

865 #NOTES

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

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

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

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

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

871 };

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

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

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

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

876 }

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

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

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

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

882 }

883 last: {

884 $prev_unix_time=$first_command_of_the_day_unix_time;

885 $first_command_of_the_day_unix_time = $cl->{time};

886 $human_readable_time = strftime "%D", localtime($prev_unix_time);

888 $result .= "<h3 id='day_on_sec_$prev_unix_time'>".$Day_Name[$last_wday]." ($human_readable_time)</h3>";

890 for my $entry_class (keys %new_entries_of) {

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

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

893 my $new_commands_section = make_new_entries_table(

894 $table_caption,

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

896 \@known_commands);

897 }

898 @known_commands = keys %frequency_of_command;

899 $result .= $this_day_result;

900 }

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

906 #############

907 # make_new_entries_table

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

911 # In: $_[0] table_caption

912 # $_[1] entries_class

913 # @_[2..] known_commands

914 # Out:

916 sub make_new_entries_table

918 my $table_caption;

919 my $entries_class = shift;

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

921 my $result = "";

923 my %count;

924 my @new_commands = ();

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

926 $count{$c}++

927 }

928 for my $c (keys %frequency_of_command) {

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

930 }