lilalo: 9e6359b7ad55 l3-frontend

lilalo

view l3-frontend @ 115:9e6359b7ad55

Исправлена ошибка с смешением выводв сеансов
Добавлена поддержка таблуяции (tab completion)
l3config.pm перенесён в /etc/lilalo/ ; возможно не окончательно
Имя сервера для l3-upload не прописывается теперь жёстко в коде, а берётся из конфигурационного файла

author	igor
date	Sun Mar 09 22:54:22 2008 +0200 (2008-03-09)
parents	658b4ea105c1
children	71bd999bcb04

line source

1 #!/usr/bin/perl -w

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

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='?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 ("
", map("$_=$cl->{$_}", grep (!/^(output|diff)$/, sort(keys(%{$cl})))));

772 $cline = "<span title='$prompt_hint'>".$cl->{"prompt"}."</span>"

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

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

775

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

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

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

779 }

780 else {

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

782 }

783

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

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

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

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

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

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

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

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

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

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

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

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

796

797 # OUTPUT

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

799 if (!(

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

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

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

803 )) {

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

805 }

806

807 # DIFF

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

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

810 # SHOT

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

812 .$Config{l3shot_path}

813 .$cl->{"screenshot"}

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

815 ."'/>"

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

817

818 #NOTES

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

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

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

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

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

824 };

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

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

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

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

829 }

830

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

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

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

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

835 }

836 last: {

837 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

840

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

842

843 for my $entry_class (keys %new_entries_of) {

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

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

846 my $new_commands_section = make_new_entries_table(

847 $table_caption,

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

849 \@known_commands);

850 }

851 @known_commands = keys %frequency_of_command;

852 $result .= $this_day_result;

853 }

854

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

856

857 }

858

859 #############

860 # make_new_entries_table

861 #

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

863 #

864 # In: $_[0] table_caption

865 # $_[1] entries_class

866 # @_[2..] known_commands

867 # Out:

868

869 sub make_new_entries_table

870 {

871 my $table_caption;

872 my $entries_class = shift;

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

874 my $result = "";

875

876 my %count;

877 my @new_commands = ();

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

879 $count{$c}++

880 }

881 for my $c (keys %frequency_of_command) {

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

883 }

884

885 my $new_commands_section;

886 if (@new_commands){

887 my $hint;

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

889 $hint = make_comment($c);

890 next unless $hint;

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

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

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

894 }

895 }

896 if ($new_commands_section) {

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

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

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

900 . "</tr>"

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

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

903 . "</tr>"

904 . $new_commands_section

905 . "</table>"

906 }

907 return $result;

908 }

909

910 #############

911 # minutes_passed

912 #

913 #

914 #

915 # In: $_[0] seconds_since_last_command

916 # Out: "minutes passed" text

917

918 sub minutes_passed

919 {

920 my $seconds_since_last_command = shift;

921 my $result = "";

922 if ($seconds_since_last_command > 7200) {

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

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

925 : "прошло";

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

927 "часов";

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

929 . $passed_word." >".$hours_passed." ".$hours_word

930 . "</div>\n";

931 }

932 elsif ($seconds_since_last_command > 600) {

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

934

935

936 my $passed_word = $minutes_passed % 100 > 10

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

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

939 : "прошло";

940

941 my $minutes_word = $minutes_passed % 100 > 10

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

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

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

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

946 "минуты";

947

948 if ($seconds_since_last_command < 1800) {

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

950 . $passed_word." ".$minutes_passed." ".$minutes_word

951 . "</div>\n";

952 }

953 else {

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

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

956 . "</div>\n";

957 }

958 }

959 return $result;

960 }

961

962 #############

963 # print_all_txt

964 #

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

966 #

967 # In: $_[0] output_filename

968 # Out:

969

970 sub print_command_lines_txt

971 {

972

973 my $output_filename=$_[0];

974 my $note_number=0;

975

976 my $result = q();

977 my $this_day_resut = q();

978

979 my $cl;

980 my $last_tty="";

981 my $last_session="";

982 my $last_day=q();

983 my $last_wday=q();

984 my $in_range=0;

985

986 my $current_command=0;

987

988 my $cursor_position = 0;

989

990

991 if ($Config{filter}) {

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

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

994 my ($var, $val) = split /=/;

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

996 }

997 }

998

999

1000 COMMAND_LINE:

1001 for my $k (@Command_Lines_Index) {

1002

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

1004 next unless $cl;

1005

1006

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

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

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

1010

1011 for my $filter_key (keys %filter) {

1012 next COMMAND_LINE

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

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

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

1016 }

1017

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

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

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

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

1022 $in_range=1;

1023 next;

1024 }

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

1026 $in_range=0;

1027 next;

1028 }

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

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

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

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

1033

1034

1035 #

1036 ##

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

1038 ##

1039 #

1040

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

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

1043

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

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

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

1047 next;

1048 }

1049

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

1051

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

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

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

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

1056

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

1058

1059 # DAY CHANGE

1060 if ( $last_day ne $day) {

1061 if ($last_day) {

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

1063 $result .= $this_day_result;

1064 }

1065 $last_day = $day;

1066 $last_wday = $wday;

1067 $this_day_result = q();

1068 }

1069

1070 # CONSOLE CHANGE

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

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

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

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

1075 }

1076

1077 # Session change

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

1079 $this_day_result .= "# ------------------------------------------------------------"

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

1081 . " ---------------------------------- \n";

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

1083 }

1084

1085 # TIME

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

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

1088

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

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

1091 }

1092

1093 # COMMAND

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

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

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

1097 }

1098

1099 # OUTPUT

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

1101 if (!(

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

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

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

1105 )) {

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

1107 if ($output) {

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

1109 }

1110 $this_day_result .= $output;

1111 }

1112

1113 # DIFF

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

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

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

1117 $this_day_result .= $diff;

1118 };

1119 # SHOT

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

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

1122 }

1123

1124 #NOTES

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

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

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

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

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

1130 }

1131

1132 }

1133 last: {

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

1135 $result .= $this_day_result;

1136 }

1137

1138 return $result;

1139

1140

1141

1142 }

1143

1144 #############

1145 # print_edit_all_html

1146 #

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

1148 #

1149 # In: $_[0] output_filename

1150 # Out:

1151

1152 sub print_edit_all_html

1153 {

1154 my $output_filename= shift;

1155 my $result;

1156 my $cursor_position = 0;

1157

1158 $result = print_command_lines_txt;

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

1160

1161 $result =

1162 "<html>"

1163 ."<head>"

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

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

1166 ."<title>$title</title>"

1167 ."</head>"

1168 ."<script>"

1169 .$SetCursorPosition_JS

1170 ."</script>"

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

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

1173 ."<form>"

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

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

1176 ."</form>"

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

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

1179 ."</body>"

1180 ."</html>";

1181

1182 if ($output_filename eq "-") {

1183 print $result;

1184 }

1185 else {

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

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

1188 binmode ":utf8";

1189 print OUT "$result";

1190 close(OUT);

1191 }

1192 }

1193

1194 #############

1195 # print_all_txt

1196 #

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

1198 #

1199 # In: $_[0] output_filename

1200 # Out:

1201

1202 sub print_all_txt

1203 {

1204 my $result;

1205

1206 $result = print_command_lines_txt;

1207

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

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

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

1211

1212 if ($output_filename eq "-") {

1213 print $result;

1214 }

1215 else {

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

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

1218 print OUT "$result";

1219 close(OUT);

1220 }

1221 }

1222

1223

1224 #############

1225 # print_all_html

1226 #

1227 #

1228 #

1229 # In: $_[0] output_filename

1230 # Out:

1231

1232

1233 sub print_all_html

1234 {

1235 my $output_filename=$_[0];

1236

1237 my $result;

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

1239 my $files_section = print_files_html;

1240

1241 $result = $debug_output;

1242 $result .= print_header_html($toc);

1243

1244

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

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

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

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

1249 # }

1250

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

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

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

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

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

1256 $result.= print_footer_html;

1257

1258 if ($output_filename eq "-") {

1259 binmode STDOUT, ":utf8";

1260 print $result;

1261 }

1262 else {

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

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

1265 print OUT $result;

1266 close(OUT);

1267 }

1268 }

1269

1270 #############

1271 # print_header_html

1272 #

1273 #

1274 #

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

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

1277

1278 sub print_header_html

1279 {

1280 my $toc = $_[0];

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

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

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

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

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

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

1287

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

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

1290 if ($course_date) {

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

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

1293 : "";

1294 }

1295 else {

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

1297 }

1298

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

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

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

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

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

1304 for my $element (sort keys %Elements_Visibility)

1305 {

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

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

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

1309 $Elements_Visibility{$element}.

1310 "</input></div>";

1311 }

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

1313 . "</div>\n";

1314