lilalo: 80691b40e6db l3-frontend

lilalo

view l3-frontend @ 151:80691b40e6db

см. предыдущий коммит

author	igor@chub.in
date	Tue Jun 23 01:17:30 2009 +0300 (2009-06-23)
parents	822b36252d7f
children

line source

1 #!/usr/bin/perl

3 use POSIX qw(strftime);

4 use lib '/etc/lilalo';

5 use l3config;

6 use utf8;

7 no warnings;

9 our @Command_Lines;

10 our @Command_Lines_Index;

11 our %Commands_Description;

12 our %Args_Description;

13 our %Sessions;

14 our %Uploads;

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

18 our %filter;

19 our $filter_url;

20 sub init_filter;

22 our %Files;

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

25 our @Day_Name;

26 our @Month_Name;

27 our @Of_Month_Name;

28 our %Search_Machines;

29 our %Elements_Visibility;

30 # ^^^

32 our $First_Command=$0;

33 our $Last_Command=40;

35 our %Stat;

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

37 our $table_number=1;

38 our %tigra_hints;

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

42 sub count_frequency_of_commands;

43 sub make_comment;

44 sub make_new_entries_table;

45 sub load_command_lines_from_xml;

46 sub load_sessions_from_xml;

47 sub load_uploads;

48 sub sort_command_lines;

49 sub process_command_lines;

50 sub init_variables;

51 sub main;

52 sub collapse_list($);

54 sub minutes_passed;

56 sub print_all_txt;

57 sub print_all_html;

58 sub print_edit_all_html;

59 sub print_command_lines_html;

60 sub print_command_lines_txt;

61 sub print_files_html;

62 sub print_stat_html;

63 sub print_header_html;

64 sub print_header2_html;

65 sub print_footer_html;

66 sub tigra_hints_generate;

69 #### mywi

70 #

71 sub mywi_init;

72 sub load_mywitxt;

73 sub mywi_process_query($);

74 #

75 sub add_to_log($$);

76 sub parse_query;

77 sub search_in_txt;

78 sub add_to_log($$);

79 sub mywi_guess($);

80 #

82 main();

84 sub main

85 {

86 $| = 1;

88 init_variables();

89 init_config();

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

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

92 init_filter();

93 mywi_init();

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

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

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

98 sort_command_lines;

99 process_command_lines;

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

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

102 }

103 else {

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

105 }

106 }

107

108 sub init_filter

109 {

110 if ($Config{filter}) {

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

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

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

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

115 }

116 }

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

118 }

119

120 # extract_from_cline

121

122 # In: $what = commands | args

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

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

125

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

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

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

129 sub extract_from_cline

130 {

131 my $what = $_[0];

132 my $cline = $_[1];

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

134

135

136 my @command_lines = ();

137 for my $command_list (@lists) {

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

139 }

140

141 my %position_of_command;

142 my %position_of_arg;

143 my $i=0;

144 for my $command_line (@command_lines) {

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

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

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

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

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

150 }

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

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

153 }

154

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

156 my $command = $1;

157 my $args = $2;

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

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

160 };

161 if ($args) {

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

163 for my $a (@args) {

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

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

166 };

167 }

168 }

169

170 if ($what eq "commands") {

171 return \%position_of_command;

172 } else {

173 return \%position_of_arg;

174 }

175

176 }

177

178 sub mywrap($)

179 {

180 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].

181 '</div></div></div></div></div></div></div></div>';

182 }

183

184 sub tigra_hints_generate

185 {

186 my $tigra_hints_items="";

187 for my $hint_id (keys %tigra_hints) {

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

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

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

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

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

193 }

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

195 return <<TIGRA;

196

197 var HINTS_CFG = {

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

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

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

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

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

203 'wise' : true,

204 'follow' : true,

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

206 },

207

208 HINTS_CFG_NEW = {

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

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

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

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

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

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

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

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

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

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

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

221 },

222

223 HINTS_ITEMS = {

224 $tigra_hints_items

225 };

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

227

228

229 function mywrap (s_) {

230 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_+

231 '</div></div></div></div></div></div></div></div>';

232

233 }

234 TIGRA

235 $a=<<TIGRA;

236 TIGRA

237 }

238

239

240 sub count_frequency_of_commands

241 {

242 my $cline = $_[0];

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

244 for my $command (@commands) {

245 $frequency_of_command{$command}++;

246 }

247 }

248

249 sub make_comment

250 {

251 my $cline = $_[0];

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

253

254 my @comments;

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

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

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

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

259

260 # Commands

261 for my $command (@commands) {

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

263 #$frequency_of_command{$command}++;

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

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

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

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

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

269 $Commands_Description{$command} = $mywi;

270 }

271 else {

272 next;

273 }

274 }

275

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

277 }

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

279

280 # Files

281 for my $arg (@args) {

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

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

284 my $mywi;

285 $mywi = mywi_client ($arg);

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

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

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

289 $Args_Description{$arg} = $mywi;

290 }

291 else {

292 next;

293 }

294 }

295

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

297 }

298

299 }

300

301 =cut

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

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

304

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

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

307

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

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

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

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

312 =cut

313 sub load_command_lines_from_xml

314 {

315 my $datafile = $_[0];

316

317 open (CLASS, $datafile)

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

319 local $/;

320 binmode CLASS, ":utf8";

321 $data = <CLASS>;

322 close(CLASS);

323

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

325 my %cl;

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

327 $cl{$1} = $2;

328 }

329 push @Command_Lines, \%cl;

330 }

331 }

332

333 sub load_sessions_from_xml

334 {

335 my $datafile = $_[0];

336

337 open (CLASS, $datafile)

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

339 local $/;

340 binmode CLASS, ":utf8";

341 my $data = <CLASS>;

342 close(CLASS);

343

344 my $i=0;

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

346 my %session_hash;

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

348 $session_hash{$1} = $2;

349 }

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

351 }

352 }

353

354 sub load_uploads($)

355 {

356 $dir=$_[0];

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

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

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

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

361 }

362 else {

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

364 }

365 }

366 }

367

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

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

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

371 # }

372 #}

373 #}

374

375 # sort_command_lines

376 # In: @Command_Lines

377 # Out: @Command_Lies_Index

378

379 sub sort_command_lines

380 {

381

382 my @index;

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

384 $index[$i]=$i;

385 }

386

387 @Command_Lines_Index = sort {

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

389 } @index;

390

391 }

392

393 ##################

394 # process_command_lines

395 #

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

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

398 # class класс

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

400 #

401 # In: @Command_Lines_Index

402 # In-Out: @Command_Lines

403

404 sub process_command_lines

405 {

406

407

408 my $current_command=0;

409 my $prev_i;

410

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

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

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

414

415 COMMAND_LINE_PROCESSING:

416 for my $i (@Command_Lines_Index) {

417

418 $current_command++;

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

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

421

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

423

424

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

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

427 my $prev_cl;

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

429 $prev_i = $i;

430

431 next if !$cl;

432

433 for my $filter_key (keys %filter) {

434 next COMMAND_LINE_PROCESSING

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

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

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

438 }

439

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

441

442

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

444

445

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

447

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

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

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

451 : "normal";

452

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

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

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

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

457 }

458

459 my $hint;

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

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

462

463 if ($hint) {

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

465 }

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

467

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

469

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

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

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

473 my $output="";

474

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

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

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

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

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

480 }

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

482 if ( !$Config{"command_id"} &&

483 (

484 $Config{"head_lines"}

485 || $Config{"tail_lines"}

486 )

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

488 #

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

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

491 }

492 $output .= "<a href='?command_id=".$$cl->{id}."'>".$Config{"skip_text"}."</a>\n";

493

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

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

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

497 }

498 }

499 else {

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

501 }

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

503

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

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

506 if (defined($prev_cl)) {

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

508 $tab_seq++;

509 }

510 else {

511 $tab_seq=0;

512 };

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

514

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

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

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

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

519 #}

520 }

521

522

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

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

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

526

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

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

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

530 }

531 }

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

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

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

535 }

536 }

537

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

539

540 my $note_operator = $1;

541 my $note_title = $2;

542

543 if ($note_operator eq "=") {

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

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

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

547 }

548 else {

549 my $j = $i;

550 if ($note_operator eq "^") {

551 $j--;

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

553 }

554 elsif ($note_operator eq "v") {

555 $j++;

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

557 }

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

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

560 $$cl=0;

561 }

562 }

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

564

565 my $note_operator = $1;

566 my $note_text = $2;

567

568 if ($note_operator eq "=") {

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

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

571 }

572 else {

573 my $j=$i;

574 if ($note_operator eq "^") {

575 $j--;

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

577 }

578 elsif ($note_operator eq "v") {

579 $j++;

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

581 }

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

583 $$cl=0;

584 }

585 }

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

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

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

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

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

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

592 }

593 }

594

595 }

596

597

598 =cut

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

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

601

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

603 =cut

604

605 sub print_command_lines_html

606 {

607

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

609 my $note_number=0;

610

611 my $result = q();

612 my $this_day_resut = q();

613

614 my $cl;

615 my $last_tty="";

616 my $last_session="";

617 my $last_day=q();

618 my $last_wday=q();

619 my $first_command_of_the_day_unix_time=q();

620 my $human_readable_time=q();

621 my $in_range=0;

622

623 my $current_command=0;

624

625 my @known_commands;

626

627

628

629 $Stat{LastCommand} ||= 0;

630 $Stat{TotalCommands} ||= 0;

631 $Stat{ErrorCommands} ||= 0;

632 $Stat{MistypedCommands} ||= 0;

633

634 my %new_entries_of = (

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

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

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

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

639 );

640

641 COMMAND_LINE:

642 for my $k (@Command_Lines_Index) {

643

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

645 next unless $cl;

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

647

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

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

650

651 next if $Config{"command_id"} && $cl->{id} ne $Config{"command_id"};

652

653

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

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

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

657

658 for my $filter_key (keys %filter) {

659 next COMMAND_LINE

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

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

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

663 }

664

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

666 # Хэш %Stat

667

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

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

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

671 }

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

673

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

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

676 };

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

678 $Stat{TotalCommands}++;

679

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

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

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

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

684 $in_range=1;

685 next;

686 }

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

688 $in_range=0;

689 next;

690 }

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

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

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

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

695

696

697

698

699 #

700 ##

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

702 ##

703 #

704

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

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

707

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

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

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

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

712

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

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

715 $note_number++;

716 }

717 next;

718 }

719

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

721

722

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

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

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

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

727

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

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

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

731

732 # DAY CHANGE

733 if ( $last_day ne $day) {

734 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

737 if ($last_day) {

738

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

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

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

742

743

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

745

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

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

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

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

750 my $new_commands_section = make_new_entries_table(

751 $table_caption,

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

753 \@known_commands);

754 }

755 @known_commands = keys %frequency_of_command;

756 $result .= $this_day_result;

757 }

758

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

760

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

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

763

764

765 $last_day=$day;

766 $last_wday=$wday;

767 $this_day_result = q();

768 }

769 else {

770 $this_day_result .= minutes_passed($seconds_since_last_command);

771 }

772

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

774

775 # CONSOLE CHANGE

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

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

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

779 . $tty

780 ."</div>";

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

782 }

783

784 # Session change

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

786 my $tty;

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

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

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

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

791 }

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

793 }

794

795 # TIME

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

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

798 }

799

800 # COMMAND

801 my $cline;

802 $prompt_hint = join ("
",

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

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

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

806

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

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

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

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

811

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

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

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

815 }

816 else {

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

818 }

819

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

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

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

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

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

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

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

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

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

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

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

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

832

833 # OUTPUT

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

835 if (!(

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

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

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

839 )) {

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

841 }

842

843 # DIFF

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

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

846 # SHOT

847

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

849 #$this_day_result .= "PRIVET";

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

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

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

853 for my $shot (@shots) {

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

855 .$Config{l3shot_path}

856 .$shot

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

858 ."'/><br/>"

859 }

860 }

861 }

862

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

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

865 # .$Config{l3shot_path}

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

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

868 # ."'/>"

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

870

871 #NOTES

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

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

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

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

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

877 };

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

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

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

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

882 }

883

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

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

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

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

888 }

889 last: {

890 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

893

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

895

896 for my $entry_class (keys %new_entries_of) {

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

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

899 my $new_commands_section = make_new_entries_table(

900 $table_caption,

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

902 \@known_commands);

903 }

904 @known_commands = keys %frequency_of_command;

905 $result .= $this_day_result;

906 }

907

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

909

910 }

911

912 #############

913 # make_new_entries_table

914 #

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

916 #

917 # In: $_[0] table_caption

918 # $_[1] entries_class

919 # @_[2..] known_commands

920 # Out:

921

922 sub make_new_entries_table

923 {

924 my $table_caption;

925 my $entries_class = shift;

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

927 my $result = "";

928

929 my %count;

930 my @new_commands = ();

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

932 $count{$c}++

933 }

934 for my $c (keys %frequency_of_command) {

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

936 }

937

938 my $new_commands_section;

939 if (@new_commands){