lilalo: c48bd05dca85 l3-frontend

lilalo

view l3-frontend @ 141:c48bd05dca85

Восстановлена поддержка сеансов и начальная поддержка правок

Теперь можно посмотреть на команды одного
сеанса; для этого нужно воспользоваться ссылкой,
на строке в начале открытия терминала.

Появилась начальная поддержка правок.
Кнопка [ править ] на странице
открывает окно, где можно редактировать
текстовое представление журнала.
Правда, оно пока что не сохраняется.

author	igor@chub.in
date	Mon Jul 21 16:44:11 2008 +0300 (2008-07-21)
parents	31ebdfe9797d
children	2c9ea8e4fa14

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;

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

16 our %filter;

17 our $filter_url;

18 sub init_filter;

20 our %Files;

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

23 our @Day_Name;

24 our @Month_Name;

25 our @Of_Month_Name;

26 our %Search_Machines;

27 our %Elements_Visibility;

28 # ^^^

30 our $First_Command=$0;

31 our $Last_Command=40;

33 our %Stat;

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

35 our $table_number=1;

36 our %tigra_hints;

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

40 sub count_frequency_of_commands;

41 sub make_comment;

42 sub make_new_entries_table;

43 sub load_command_lines_from_xml;

44 sub load_sessions_from_xml;

45 sub sort_command_lines;

46 sub process_command_lines;

47 sub init_variables;

48 sub main;

49 sub collapse_list($);

51 sub minutes_passed;

53 sub print_all_txt;

54 sub print_all_html;

55 sub print_edit_all_html;

56 sub print_command_lines_html;

57 sub print_command_lines_txt;

58 sub print_files_html;

59 sub print_stat_html;

60 sub print_header_html;

61 sub print_footer_html;

62 sub tigra_hints_generate;

64 #### mywi

65 #

66 sub mywi_init;

67 sub load_mywitxt;

68 sub mywi_process_query($);

69 #

70 sub add_to_log($$);

71 sub parse_query;

72 sub search_in_txt;

73 sub add_to_log($$);

74 sub mywi_guess($);

75 #

77 main();

79 sub main

80 {

81 $| = 1;

83 init_variables();

84 init_config();

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

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

87 init_filter();

88 mywi_init();

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

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

92 sort_command_lines;

93 process_command_lines;

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

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

96 }

97 else {

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

99 }

100 }

101

102 sub init_filter

103 {

104 if ($Config{filter}) {

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

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

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

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

109 }

110 }

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

112 }

113

114 # extract_from_cline

115

116 # In: $what = commands | args

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

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

119

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

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

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

123 sub extract_from_cline

124 {

125 my $what = $_[0];

126 my $cline = $_[1];

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

128

129

130 my @command_lines = ();

131 for my $command_list (@lists) {

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

133 }

134

135 my %position_of_command;

136 my %position_of_arg;

137 my $i=0;

138 for my $command_line (@command_lines) {

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

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

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

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

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

144 }

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

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

147 }

148

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

150 my $command = $1;

151 my $args = $2;

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

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

154 };

155 if ($args) {

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

157 for my $a (@args) {

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

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

160 };

161 }

162 }

163

164 if ($what eq "commands") {

165 return \%position_of_command;

166 } else {

167 return \%position_of_arg;

168 }

169

170 }

171

172 sub mywrap($)

173 {

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

175 '</div></div></div></div></div></div></div></div>';

176 }

177

178 sub tigra_hints_generate

179 {

180 my $tigra_hints_items="";

181 for my $hint_id (keys %tigra_hints) {

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

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

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

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

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

187 }

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

189 return <<TIGRA;

190

191 var HINTS_CFG = {

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

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

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

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

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

197 'wise' : true,

198 'follow' : true,

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

200 },

201

202 HINTS_CFG_NEW = {

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

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

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

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

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

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

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

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

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

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

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

215 },

216

217 HINTS_ITEMS = {

218 $tigra_hints_items

219 };

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

221

222

223 function mywrap (s_) {

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

225 '</div></div></div></div></div></div></div></div>';

226

227 }

228 TIGRA

229 $a=<<TIGRA;

230 TIGRA

231 }

232

233

234 sub count_frequency_of_commands

235 {

236 my $cline = $_[0];

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

238 for my $command (@commands) {

239 $frequency_of_command{$command}++;

240 }

241 }

242

243 sub make_comment

244 {

245 my $cline = $_[0];

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

247

248 my @comments;

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

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

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

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

253

254 # Commands

255 for my $command (@commands) {

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

257 #$frequency_of_command{$command}++;

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

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

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

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

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

263 $Commands_Description{$command} = $mywi;

264 }

265 else {

266 next;

267 }

268 }

269

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

271 }

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

273

274 # Files

275 for my $arg (@args) {

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

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

278 my $mywi;

279 $mywi = mywi_client ($arg);

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

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

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

283 $Args_Description{$arg} = $mywi;

284 }

285 else {

286 next;

287 }

288 }

289

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

291 }

292

293 }

294

295 =cut

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

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

298

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

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

301

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

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

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

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

306 =cut

307 sub load_command_lines_from_xml

308 {

309 my $datafile = $_[0];

310

311 open (CLASS, $datafile)

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

313 local $/;

314 binmode CLASS, ":utf8";

315 $data = <CLASS>;

316 close(CLASS);

317

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

319 my %cl;

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

321 $cl{$1} = $2;

322 }

323 push @Command_Lines, \%cl;

324 }

325 }

326

327 sub load_sessions_from_xml

328 {

329 my $datafile = $_[0];

330

331 open (CLASS, $datafile)

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

333 local $/;

334 binmode CLASS, ":utf8";

335 my $data = <CLASS>;

336 close(CLASS);

337

338 my $i=0;

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

340 my %session_hash;

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

342 $session_hash{$1} = $2;

343 }

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

345 }

346 }

347

348

349 # sort_command_lines

350 # In: @Command_Lines

351 # Out: @Command_Lies_Index

352

353 sub sort_command_lines

354 {

355

356 my @index;

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

358 $index[$i]=$i;

359 }

360

361 @Command_Lines_Index = sort {

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

363 } @index;

364

365 }

366

367 ##################

368 # process_command_lines

369 #

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

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

372 # class класс

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

374 #

375 # In: @Command_Lines_Index

376 # In-Out: @Command_Lines

377

378 sub process_command_lines

379 {

380

381

382 my $current_command=0;

383 my $prev_i;

384

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

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

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

388

389 COMMAND_LINE_PROCESSING:

390 for my $i (@Command_Lines_Index) {

391

392 $current_command++;

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

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

395

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

397

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

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

400 my $prev_cl;

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

402 $prev_i = $i;

403

404 next if !$cl;

405

406 for my $filter_key (keys %filter) {

407 next COMMAND_LINE_PROCESSING

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

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

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

411 }

412

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

414

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

416

417

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

419

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

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

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

423 : "normal";

424

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

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

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

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

429 }

430

431 my $hint;

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

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

434

435 if ($hint) {

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

437 }

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

439

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

441

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

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

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

445 my $output="";

446

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

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

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

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

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

452 }

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

454 if ((

455 $Config{"head_lines"}

456 || $Config{"tail_lines"}

457 )

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

459 #

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

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

462 }

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

464

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

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

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

468 }

469 }

470 else {

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

472 }

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

474

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

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

477 if (defined($prev_cl)) {

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

479 $tab_seq++;

480 }

481 else {

482 $tab_seq=0;

483 };

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

485

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

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

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

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

490 #}

491 }

492

493

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

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

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

497

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

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

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

501 }

502 }

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

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

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

506 }

507 }

508

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

510

511 my $note_operator = $1;

512 my $note_title = $2;

513

514 if ($note_operator eq "=") {

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

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

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

518 }

519 else {

520 my $j = $i;

521 if ($note_operator eq "^") {

522 $j--;

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

524 }

525 elsif ($note_operator eq "v") {

526 $j++;

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

528 }

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

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

531 $$cl=0;

532 }

533 }

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

535

536 my $note_operator = $1;

537 my $note_text = $2;

538

539 if ($note_operator eq "=") {

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

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

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]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]);

552 }

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

554 $$cl=0;

555 }

556 }

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

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

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

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

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

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

563 }

564 }

565

566 }

567

568

569 =cut

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

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

572

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

574 =cut

575

576 sub print_command_lines_html

577 {

578

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

580 my $note_number=0;

581

582 my $result = q();

583 my $this_day_resut = q();

584

585 my $cl;

586 my $last_tty="";

587 my $last_session="";

588 my $last_day=q();

589 my $last_wday=q();

590 my $first_command_of_the_day_unix_time=q();

591 my $human_readable_time=q();

592 my $in_range=0;

593

594 my $current_command=0;

595

596 my @known_commands;

597

598

599

600 $Stat{LastCommand} ||= 0;

601 $Stat{TotalCommands} ||= 0;

602 $Stat{ErrorCommands} ||= 0;

603 $Stat{MistypedCommands} ||= 0;

604

605 my %new_entries_of = (

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

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

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

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

610 );

611

612 COMMAND_LINE:

613 for my $k (@Command_Lines_Index) {

614

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

616 next unless $cl;

617

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

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

620

621

622

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

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

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

626

627 for my $filter_key (keys %filter) {

628 next COMMAND_LINE

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

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

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

632 }

633

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

635 # Хэш %Stat

636

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

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

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

640 }

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

642

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

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

645 };

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

647 $Stat{TotalCommands}++;

648

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

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

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

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

653 $in_range=1;

654 next;

655 }

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

657 $in_range=0;

658 next;

659 }

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

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

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

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

664

665

666

667

668 #

669 ##

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

671 ##

672 #

673

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

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

676

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

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

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

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

681

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

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

684 $note_number++;

685 }

686 next;

687 }

688

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

690

691

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

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

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

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

696

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

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

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

700

701 # DAY CHANGE

702 if ( $last_day ne $day) {

703 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

706 if ($last_day) {

707

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

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

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

711

712

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

714

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

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

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

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

719 my $new_commands_section = make_new_entries_table(

720 $table_caption,

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

722 \@known_commands);

723 }

724 @known_commands = keys %frequency_of_command;

725 $result .= $this_day_result;

726 }

727

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

729

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

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

732

733

734 $last_day=$day;

735 $last_wday=$wday;

736 $this_day_result = q();

737 }

738 else {

739 $this_day_result .= minutes_passed($seconds_since_last_command);

740 }

741

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

743

744 # CONSOLE CHANGE

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

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

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

748 . $tty

749 ."</div>";

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

751 }

752

753 # Session change

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

755 my $tty;

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

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

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

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

760 }

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

762 }

763

764 # TIME

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

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

767 }

768

769 # COMMAND

770 my $cline;

771 $prompt_hint = join ("
",

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

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

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

775

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

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

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

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

780

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

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

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

784 }

785 else {

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

787 }

788

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

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

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

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

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

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

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

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

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

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

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

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

801

802 # OUTPUT

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

804 if (!(

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

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

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

808 )) {

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

810 }

811

812 # DIFF

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

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

815 # SHOT

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

817 .$Config{l3shot_path}

818 .$cl->{"screenshot"}

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

820 ."'/>"

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

822

823 #NOTES

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

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

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

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

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

829 };

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

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

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

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

834 }

835

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

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

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

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

840 }

841 last: {

842 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

845

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

847

848 for my $entry_class (keys %new_entries_of) {

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

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

851 my $new_commands_section = make_new_entries_table(

852 $table_caption,

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

854 \@known_commands);

855 }

856 @known_commands = keys %frequency_of_command;

857 $result .= $this_day_result;

858 }

859

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

861

862 }

863

864 #############

865 # make_new_entries_table

866 #

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

868 #

869 # In: $_[0] table_caption

870 # $_[1] entries_class

871 # @_[2..] known_commands

872 # Out:

873

874 sub make_new_entries_table

875 {

876 my $table_caption;

877 my $entries_class = shift;

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

879 my $result = "";

880

881 my %count;

882 my @new_commands = ();

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

884 $count{$c}++

885 }

886 for my $c (keys %frequency_of_command) {

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

888 }

889

890 my $new_commands_section;

891 if (@new_commands){

892 my $hint;

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

894 $hint = make_comment($c);

895 next unless $hint;

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

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

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

899 }

900 }

901 if ($new_commands_section) {

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

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

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

905 . "</tr>"

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

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

908 . "</tr>"

909 . $new_commands_section

910 . "</table>"

911 }

912 return $result;

913 }

914

915 #############

916 # minutes_passed

917 #

918 #

919 #

920 # In: $_[0] seconds_since_last_command

921 # Out: "minutes passed" text

922

923 sub minutes_passed

924 {

925 my $seconds_since_last_command = shift;

926 my $result = "";

927 if ($seconds_since_last_command > 7200) {

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

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

930 : "прошло";

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

932 "часов";

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

934 . $passed_word." >".$hours_passed." ".$hours_word

935 . "</div>\n";

936 }

937 elsif ($seconds_since_last_command > 600) {

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

939

940

941 my $passed_word = $minutes_passed % 100 > 10

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

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

944 : "прошло";

945

946 my $minutes_word = $minutes_passed % 100 > 10

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

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

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

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

951 "минуты";

952

953 if ($seconds_since_last_command < 1800) {

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

955 . $passed_word." ".$minutes_passed." ".$minutes_word

956 . "</div>\n";

957 }

958 else {

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

960 . $passed_word." ".$minutes_passed." ".$minutes_word

961 . "</div>\n";

962 }

963 }

964 return $result;

965 }

966

967 #############

968 # print_all_txt

969 #

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

971 #

972 # In: $_[0] output_filename

973 # Out:

974

975 sub print_command_lines_txt

976 {

977

978 my $output_filename=$_[0];

979 my $note_number=0;

980

981 my $result = q();

982 my $this_day_resut = q();

983

984 my $cl;

985 my $last_tty="";

986 my $last_session="";

987 my $last_day=q();

988 my $last_wday=q();

989 my $in_range=0;

990

991 my $current_command=0;

992

993 my $cursor_position = 0;

994

995

996 if ($Config{filter}) {

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

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

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

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

1001 }

1002 }

1003

1004

1005 COMMAND_LINE:

1006 for my $k (@Command_Lines_Index) {

1007

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

1009 next unless $cl;

1010

1011

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

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

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

1015

1016 for my $filter_key (keys %filter) {

1017 next COMMAND_LINE

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

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

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

1021 }

1022

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

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

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

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

1027 $in_range=1;

1028 next;

1029 }

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

1031 $in_range=0;

1032 next;

1033 }

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

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

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

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

1038

1039

1040 #

1041 ##

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

1043 ##

1044 #

1045

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

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

1048

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

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

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

1052 next;

1053 }

1054

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

1056

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

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

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

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

1061

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

1063

1064 # DAY CHANGE

1065 if ( $last_day ne $day) {

1066 if ($last_day) {

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

1068 $result .= $this_day_result;

1069 }

1070 $last_day = $day;

1071 $last_wday = $wday;

1072 $this_day_result = q();

1073 }

1074

1075 # CONSOLE CHANGE

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

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

1078 $this_day_result .= " #l3: ------- другая консоль ----\n";

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

1080 }

1081

1082 # Session change

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

1084 $this_day_result .= "# ------------------------------------------------------------"

1085 . " l3: local_session_id=".$cl->{"local_session_id"}

1086 . " ---------------------------------- \n";

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

1088 }

1089

1090 # TIME

1091 my @nl_counter = split (/\n/, $result);

1092 $cursor_position=length($result) - @nl_counter;

1093

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

1095 $this_day_result .= "$hour:$min:$sec"

1096 }

1097

1098 # COMMAND

1099 $this_day_result .= " ".$cl->{"prompt"}.$cl->{"cline"}."\n";

1100 if ($cl->{"err"}) {

1101 $this_day_result .= " #l3: err=".$cl->{'err'}."\n";

1102 }

1103

1104 # OUTPUT

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

1106 if (!(

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

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

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

1110 )) {

1111 my $output = $cl->{short_output};

1112 if ($output) {

1113 $output =~ s/^/ |/mg;

1114 }

1115 $this_day_result .= $output;

1116 }

1117

1118 # DIFF

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

1120 my $diff = $cl->{"diff"};

1121 $diff =~ s/^/ |/mg;

1122 $this_day_result .= $diff;

1123 };

1124 # SHOT

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

1126 $this_day_result .= " #l3: screenshot=".$cl->{'screenshot'}."\n";

1127 }

1128

1129 #NOTES

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

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

1132 $note =~ s/\n/\n#^/msg;

1133 $this_day_result .= "#^ == ".$cl->{note_title}." ==\n" if $cl->{note_title};

1134 $this_day_result .= "#^ ".$note."\n";

1135 }

1136

1137 }

1138 last: {

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

1140 $result .= $this_day_result;

1141 }

1142

1143 return $result;

1144

1145

1146

1147 }

1148

1149 #############

1150 # print_edit_all_html

1151 #

1152 # Вывести страницу с текстовым представлением журнала для редактирования

1153 #

1154 # In: $_[0] output_filename

1155 # Out:

1156

1157 sub print_edit_all_html

1158 {

1159 my $output_filename= shift;

1160 my $result;

1161 my $cursor_position = 0;

1162

1163 $result = print_command_lines_txt;

1164 my $title = ">Журнал лабораторных работ. Правка";

1165

1166 $result =

1167 "<html>"

1168 ."<head>"

1169 ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"

1170 ."<link rel='stylesheet' href='$Config{frontend_css}' type='text/css'/>"

1171 ."<title>$title</title>"

1172 ."</head>"

1173 ."<script>"

1174 .$SetCursorPosition_JS

1175 ."</script>"

1176 ."<body onLoad='setCursorPosition(document.all.mytextarea, $cursor_position, $cursor_position+10)'>"

1177 ."<h1>Журнал лабораторных работ. Правка</h1>"

1178 ."<form>"

1179 ."<textarea rows='30' cols='100' wrap='off' id='mytextarea'>$result</textarea>"

1180 ."<br/><input type='submit' value='Сохранить' label='label'/>"

1181 ."</form>"

1182 ."<p>Внимательно правим, потом сохраняем</p>"

1183 ."<p>Строки, начинающиеся символами #l3: можно трогать, только если точно знаешь, что делаешь</p>"

1184 ."</body>"

1185 ."</html>";

1186

1187 if ($output_filename eq "-") {

1188 print $result;

1189 }

1190 else {

1191 open(OUT, ">", $output_filename)

1192 or die "Can't open $output_filename for writing\n";

1193 binmode ":utf8";

1194 print OUT "$result";

1195 close(OUT);

1196 }

1197 }

1198

1199 #############

1200 # print_all_txt

1201 #

1202 # Вывести страницу с текстовым представлением журнала для редактирования

1203 #

1204 # In: $_[0] output_filename

1205 # Out:

1206

1207 sub print_all_txt

1208 {

1209 my $result;

1210

1211 $result = print_command_lines_txt;

1212

1213 $result =~ s/>/>/g;

1214 $result =~ s/</</g;

1215 $result =~ s/&/&/g;

1216

1217 if ($output_filename eq "-") {

1218 print $result;

1219 }

1220 else {

1221 open(OUT, ">:utf8", $output_filename)

1222 or die "Can't open $output_filename for writing\n";

1223 print OUT "$result";

1224 close(OUT);

1225 }

1226 }

1227

1228

1229 #############

1230 # print_all_html

1231 #

1232 #

1233 #

1234 # In: $_[0] output_filename

1235 # Out:

1236

1237

1238 sub print_all_html

1239 {

1240 my $output_filename=$_[0];

1241

1242 my $result;

1243 my ($command_lines,$toc) = print_command_lines_html;

1244 my $files_section = print_files_html;

1245

1246 $result = $debug_output;

1247 $result .= print_header_html($toc);

1248

1249

1250 # $result.= join " <br/>", keys %Sessions;

1251 # for my $sess (keys %Sessions) {

1252 # $result .= join " ", keys (%{$Sessions{$sess}});

1253 # $result .= "<br/>";

1254 # }

1255

1256 $result.= "<h2 id='log'>Журнал</h2>" . $command_lines;

1257 $result.= "<h2 id='files'>Файлы</h2>" . $files_section if $files_section;

1258 $result.= "<h2 id='stat'>Статистика</h2>" . print_stat_html;

1259 $result.= "<h2 id='help'>Справка</h2>" . $Html_Help . "<br/>";

1260 $result.= "<h2 id='about'>О программе</h2>". $Html_About. "<br/>";

1261 $result.= print_footer_html;

1262

1263 if ($output_filename eq "-") {

1264 binmode STDOUT, ":utf8";

1265 print $result;

1266 }

1267 else {

1268 open(OUT, ">:utf8", $output_filename)

1269 or die "Can't open $output_filename for writing\n";

1270 print OUT $result;

1271 close(OUT);

1272 }

1273 }

1274

1275 #############

1276 # print_header_html

1277 #

1278 #

1279 #

1280 # In: $_[0] Содержание

1281 # Out: Распечатанный заголовок

1282

1283 sub print_header_html

1284 {

1285 my $toc = $_[0];

1286 my $course_name = $Config{"course-name"};

1287 my $course_code = $Config{"course-code"};

1288 my $course_date = $Config{"course-date"};

1289 my $course_center = $Config{"course-center"};

1290 my $course_trainer = $Config{"course-trainer"};

1291 my $course_student = $Config{"course-student"};

1292

1293 my $title = "Журнал лабораторных работ";

1294 $title .= " -- ".$course_student if $course_student;

1295 if ($course_date) {

1296 $title .= " -- ".$course_date;

1297 $title .= $course_code ? "/".$course_code

1298 : "";

1299 }

1300 else {

1301 $title .= " -- ".$course_code if $course_code;

1302 }

1303

1304 # Управляющая форма

1305 my $control_form .= "<div class='visibility_form' title='Выберите какие элементы должны быть показаны в журнале'>"

1306 . "<span class='header'>Видимые элементы</span>"

1307 . "<span class='window_controls'><a href='' onclick='' title='свернуть форму управления'>_</a> <a href='' onclick='' title='закрыть форму управления'>x</a></span>"

1308 . "<div><form>\n";

1309 for my $element (sort keys %Elements_Visibility)

1310 {

1311 my ($skip, @e) = split /\s+/, $element;

1312 my $showhide = join "", map { "ShowHide('$_');" } @e ;

1313 $control_form .= "<div><input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>".

1314 $Elements_Visibility{$element}.

1315 "</input></div>";

1316 }

1317 $control_form .= "</form>\n"

1318 . "</div>\n";

1319