lilalo: 266dae9ce2a1 l3-frontend

lilalo

view l3-frontend @ 148:266dae9ce2a1

mass upload

author	igor@book.xt.vpn
date	Tue Dec 16 00:18:23 2008 +0200 (2008-12-16)
parents	94f587855947
children	822b36252d7f

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

68 #

69 sub mywi_init;

70 sub load_mywitxt;

71 sub mywi_process_query($);

72 #

73 sub add_to_log($$);

74 sub parse_query;

75 sub search_in_txt;

76 sub add_to_log($$);

77 sub mywi_guess($);

78 #

80 main();

82 sub main

83 {

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 }

104 }

105

106 sub init_filter

107 {

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

116 }

117

118 # extract_from_cline

119

120 # In: $what = commands | args

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

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

123

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

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

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

127 sub extract_from_cline

128 {

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 }

138

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 }

152

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 }

167

168 if ($what eq "commands") {

169 return \%position_of_command;

170 } else {

171 return \%position_of_arg;

172 }

173

174 }

175

176 sub mywrap($)

177 {

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

180 }

181

182 sub tigra_hints_generate

183 {

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;

194

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

204 },

205

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)

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

219 },

220

221 HINTS_ITEMS = {

222 $tigra_hints_items

223 };

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

225

226

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

230

231 }

232 TIGRA

233 $a=<<TIGRA;

234 TIGRA

235 }

236

237

238 sub count_frequency_of_commands

239 {

240 my $cline = $_[0];

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

242 for my $command (@commands) {

243 $frequency_of_command{$command}++;

244 }

245 }

246

247 sub make_comment

248 {

249 my $cline = $_[0];

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

251

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

257

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 }

273

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 }

293

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

295 }

296

297 }

298

299 =cut

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

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

302

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

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

305

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

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

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

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

310 =cut

311 sub load_command_lines_from_xml

312 {

313 my $datafile = $_[0];

314

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

321

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 }

329 }

330

331 sub load_sessions_from_xml

332 {

333 my $datafile = $_[0];

334

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

341

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 }

350 }

351

352 sub load_uploads($)

353 {

354 $dir=$_[0];

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

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

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

358 }

359 }

360

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

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

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

364 # }

365 #}

366 #}

367

368 # sort_command_lines

369 # In: @Command_Lines

370 # Out: @Command_Lies_Index

371

372 sub sort_command_lines

373 {

374

375 my @index;

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

377 $index[$i]=$i;

378 }

379

380 @Command_Lines_Index = sort {

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

382 } @index;

383

384 }

385

386 ##################

387 # process_command_lines

388 #

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

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

391 # class класс

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

393 #

394 # In: @Command_Lines_Index

395 # In-Out: @Command_Lines

396

397 sub process_command_lines

398 {

399

400

401 my $current_command=0;

402 my $prev_i;

403

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

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

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

407

408 COMMAND_LINE_PROCESSING:

409 for my $i (@Command_Lines_Index) {

410

411 $current_command++;

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

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

414

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

416

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

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

419 my $prev_cl;

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

421 $prev_i = $i;

422

423 next if !$cl;

424

425 for my $filter_key (keys %filter) {

426 next COMMAND_LINE_PROCESSING

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

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

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

430 }

431

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

433

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

435

436

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

438

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

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

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

442 : "normal";

443

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

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

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

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

448 }

449

450 my $hint;

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

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

453

454 if ($hint) {

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

456 }

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

458

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

460

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

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

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

464 my $output="";

465

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

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

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

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

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

471 }

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

473 if ((

474 $Config{"head_lines"}

475 || $Config{"tail_lines"}

476 )

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

478 #

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

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

481 }

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

483

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

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

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

487 }

488 }

489 else {

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

491 }

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

493

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

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

496 if (defined($prev_cl)) {

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

498 $tab_seq++;

499 }

500 else {

501 $tab_seq=0;

502 };

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

504

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

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

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

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

509 #}

510 }

511

512

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

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

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

516

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

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

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

520 }

521 }

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

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

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

525 }

526 }

527

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

529

530 my $note_operator = $1;

531 my $note_title = $2;

532

533 if ($note_operator eq "=") {

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

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

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

537 }

538 else {

539 my $j = $i;

540 if ($note_operator eq "^") {

541 $j--;

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

543 }

544 elsif ($note_operator eq "v") {

545 $j++;

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

547 }

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

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

550 $$cl=0;

551 }

552 }

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

554

555 my $note_operator = $1;

556 my $note_text = $2;

557

558 if ($note_operator eq "=") {

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

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

561 }

562 else {

563 my $j=$i;

564 if ($note_operator eq "^") {

565 $j--;

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

567 }

568 elsif ($note_operator eq "v") {

569 $j++;

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

571 }

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

573 $$cl=0;

574 }

575 }

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

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

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

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

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

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

582 }

583 }

584

585 }

586

587

588 =cut

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

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

591

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

593 =cut

594

595 sub print_command_lines_html

596 {

597

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

599 my $note_number=0;

600

601 my $result = q();

602 my $this_day_resut = q();

603

604 my $cl;

605 my $last_tty="";

606 my $last_session="";

607 my $last_day=q();

608 my $last_wday=q();

609 my $first_command_of_the_day_unix_time=q();

610 my $human_readable_time=q();

611 my $in_range=0;

612

613 my $current_command=0;

614

615 my @known_commands;

616

617

618

619 $Stat{LastCommand} ||= 0;

620 $Stat{TotalCommands} ||= 0;

621 $Stat{ErrorCommands} ||= 0;

622 $Stat{MistypedCommands} ||= 0;

623

624 my %new_entries_of = (

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

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

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

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

629 );

630

631 COMMAND_LINE:

632 for my $k (@Command_Lines_Index) {

633

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

635 next unless $cl;

636 my $next_cl=$Command_Lines[$Command_Lines_Index[$current_command+1]];

637

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

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

640

641

642

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

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

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

646

647 for my $filter_key (keys %filter) {

648 next COMMAND_LINE

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

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

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

652 }

653

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

655 # Хэш %Stat

656

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

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

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

660 }

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

662

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

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

665 };

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

667 $Stat{TotalCommands}++;

668

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

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

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

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

673 $in_range=1;

674 next;

675 }

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

677 $in_range=0;

678 next;

679 }

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

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

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

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

684

685

686

687

688 #

689 ##

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

691 ##

692 #

693

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

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

696

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

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

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

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

701

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

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

704 $note_number++;

705 }

706 next;

707 }

708

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

710

711

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

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

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

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

716

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

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

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

720

721 # DAY CHANGE

722 if ( $last_day ne $day) {

723 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

726 if ($last_day) {

727

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

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

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

731

732

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

734

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

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

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

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

739 my $new_commands_section = make_new_entries_table(

740 $table_caption,

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

742 \@known_commands);

743 }

744 @known_commands = keys %frequency_of_command;

745 $result .= $this_day_result;

746 }

747

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

749

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

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

752

753

754 $last_day=$day;

755 $last_wday=$wday;

756 $this_day_result = q();

757 }

758 else {

759 $this_day_result .= minutes_passed($seconds_since_last_command);

760 }

761

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

763

764 # CONSOLE CHANGE

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

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

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

768 . $tty

769 ."</div>";

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

771 }

772

773 # Session change

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

775 my $tty;

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

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

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

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

780 }

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

782 }

783

784 # TIME

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

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

787 }

788

789 # COMMAND

790 my $cline;

791 $prompt_hint = join ("
",

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

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

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

795

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

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

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

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

800

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

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

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

804 }

805 else {

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

807 }

808

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

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

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

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

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

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

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

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

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

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

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

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

821

822 # OUTPUT

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

824 if (!(

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

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

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

828 )) {

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

830 }

831

832 # DIFF

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

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

835 # SHOT

836

837 $this_day_result .= join(".", key(%Uploads));

838 $this_day_result .= "PRIVET";

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

840 # if ($t > $cl->{"time"} && $t < $next_cl->{"time"}) {

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

842 .$Config{l3shot_path}

843 .$Uploads{$cl->{"local_session_id"}}

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

845 ."'/>"

846 }

847

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

849 .$Config{l3shot_path}

850 .$cl->{"screenshot"}

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

852 ."'/>"

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

854

855 #NOTES

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

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

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

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

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

861 };

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

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

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

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

866 }

867

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

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

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

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

872 }

873 last: {

874 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

877

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

879

880 for my $entry_class (keys %new_entries_of) {

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

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

883 my $new_commands_section = make_new_entries_table(

884 $table_caption,

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

886 \@known_commands);

887 }

888 @known_commands = keys %frequency_of_command;

889 $result .= $this_day_result;

890 }

891

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

893

894 }

895

896 #############

897 # make_new_entries_table

898 #

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

900 #

901 # In: $_[0] table_caption

902 # $_[1] entries_class

903 # @_[2..] known_commands

904 # Out:

905

906 sub make_new_entries_table

907 {

908 my $table_caption;

909 my $entries_class = shift;

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

911 my $result = "";

912

913 my %count;

914 my @new_commands = ();

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

916 $count{$c}++

917 }

918 for my $c (keys %frequency_of_command) {

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

920 }

921

922 my $new_commands_section;

923 if (@new_commands){

924 my $hint;

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

926 $hint = make_comment($c);

927 next unless $hint;

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

929 next unless $command =~ s/$$entries_class$//i;

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

931 }

932 }

933 if ($new_commands_section) {

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

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

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