lilalo: 3cd466f35ad6 l3-frontend

lilalo

view l3-frontend @ 109:3cd466f35ad6

* Добавлено разбиения журнала на блоки
* Оптимизирована генерация всплывающих подсказок
* В заголовке указывается дата
* Переделано взаимодействие с mywi: код mywi интегрирован в lilalo
* Изменён способ вывода таблицы, теперь она лушче показывается в Opera и IE
* Изменён формат diff'а, теперь diff -u

author	igor
date	Wed Feb 13 02:41:57 2008 +0200 (2008-02-13)
parents	54fbf2041159
children	99ea38e538c9

line source

1 #!/usr/bin/perl -w

3 use POSIX qw(strftime);

4 use lib '.';

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

384 COMMAND_LINE_PROCESSING:

385 for my $i (@Command_Lines_Index) {

386

387 $current_command++;

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

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

390

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

392

393 next if !$cl;

394

395 for my $filter_key (keys %filter) {

396 next COMMAND_LINE_PROCESSING

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

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

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

400 }

401

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

403

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

405

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

407

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

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

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

411 : "normal";

412

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

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

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

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

417 }

418

419 my $hint;

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

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

422

423 if ($hint) {

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

425 }

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

427

428 $$cl->{hint}="";

429

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

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

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

433 my $output="";

434

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

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

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

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

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

440 }

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

442 if ((

443 $Config{"head_lines"}

444 || $Config{"tail_lines"}

445 )

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

447 #

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

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

450 }

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

452

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

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

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

456 }

457 }

458 else {

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

460 }

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

462

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

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

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

466

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

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

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

470 }

471 }

472

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

474

475 my $note_operator = $1;

476 my $note_title = $2;

477

478 if ($note_operator eq "=") {

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

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

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

482 }

483 else {

484 my $j = $i;

485 if ($note_operator eq "^") {

486 $j--;

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

488 }

489 elsif ($note_operator eq "v") {

490 $j++;

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

492 }

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

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

495 $$cl=0;

496 }

497 }

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

499

500 my $note_operator = $1;

501 my $note_text = $2;

502

503 if ($note_operator eq "=") {

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

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

506 }

507 else {

508 my $j=$i;

509 if ($note_operator eq "^") {

510 $j--;

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

512 }

513 elsif ($note_operator eq "v") {

514 $j++;

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

516 }

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

518 $$cl=0;

519 }

520 }

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

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

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

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

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

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

527 }

528 }

529

530 }

531

532

533 =cut

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

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

536

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

538 =cut

539

540 sub print_command_lines_html

541 {

542

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

544 my $note_number=0;

545

546 my $result = q();

547 my $this_day_resut = q();

548

549 my $cl;

550 my $last_tty="";

551 my $last_session="";

552 my $last_day=q();

553 my $last_wday=q();

554 my $first_command_of_the_day_unix_time=q();

555 my $human_readable_time=q();

556 my $in_range=0;

557

558 my $current_command=0;

559

560 my @known_commands;

561

562

563

564 $Stat{LastCommand} ||= 0;

565 $Stat{TotalCommands} ||= 0;

566 $Stat{ErrorCommands} ||= 0;

567 $Stat{MistypedCommands} ||= 0;

568

569 my %new_entries_of = (

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

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

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

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

574 );

575

576 COMMAND_LINE:

577 for my $k (@Command_Lines_Index) {

578

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

580 next unless $cl;

581

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

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

584

585

586 # Пропускаем команды, с одинаковым временем

587 # Это не совсем правильно.

588 # Возможно, что это команды, набираемые с помощью <completion>

589 # или запомненные с помощью <ctrl-c>

590

591 next if $Stat{LastCommand} == $cl->{time};

592

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

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

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

596

597 for my $filter_key (keys %filter) {

598 next COMMAND_LINE

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

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

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

602 }

603

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

605 # Хэш %Stat

606

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

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

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

610 }

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

612

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

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

615 };

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

617 $Stat{TotalCommands}++;

618

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

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

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

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

623 $in_range=1;

624 next;

625 }

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

627 $in_range=0;

628 next;

629 }

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

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

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

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

634

635

636

637

638 #

639 ##

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

641 ##

642 #

643

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

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

646

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

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

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

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

651

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

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

654 $note_number++;

655 }

656 next;

657 }

658

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

660

661

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

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

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

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

666

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

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

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

670

671 # DAY CHANGE

672 if ( $last_day ne $day) {

673 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

676 if ($last_day) {

677

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

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

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

681

682

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

684

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

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

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

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

689 my $new_commands_section = make_new_entries_table(

690 $table_caption,

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

692 \@known_commands);

693 }

694 @known_commands = keys %frequency_of_command;

695 $result .= $this_day_result;

696 }

697

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

699

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

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

702

703

704 $last_day=$day;

705 $last_wday=$wday;

706 $this_day_result = q();

707 }

708 else {

709 $this_day_result .= minutes_passed($seconds_since_last_command);

710 }

711

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

713

714 # CONSOLE CHANGE

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

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

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

718 . $tty

719 ."</div>";

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

721 }

722

723 # Session change

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

725 my $tty;

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

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

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

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

730 }

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

732 }

733

734 # TIME

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

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

737 }

738

739 # COMMAND

740 my $cline;

741 $prompt_hint = join ("
", map("$_=$cl->{$_}", grep (!/^(output|diff)$/, sort(keys(%{$cl})))));

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

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

744

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

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

747 }

748 else {

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

750 }

751

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

753 $this_day_result .= "<div class='cline' onmouseover=\"myHint.show('".$cl->{time}."')\" onmouseout=\"myHint.hide()\">\n" . $cline ; #cline

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

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

756 . "</span>\n" if $cl->{"err"};

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

758

759 # OUTPUT

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

761 if (!(

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

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

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

765 )) {

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

767 }

768

769 # DIFF

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

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

772 # SHOT

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

774 .$Config{l3shot_path}

775 .$cl->{"screenshot"}

776 .$Config{l3shot_suffix}

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

778 ."'/>"

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

780

781 #NOTES

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

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

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

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

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

787 };

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

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

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

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

792 }

793

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

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

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

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

798 }

799 last: {

800 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

803

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

805

806 for my $entry_class (keys %new_entries_of) {

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

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

809 my $new_commands_section = make_new_entries_table(

810 $table_caption,

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

812 \@known_commands);

813 }

814 @known_commands = keys %frequency_of_command;

815 $result .= $this_day_result;

816 }

817

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

819

820 }

821

822 #############

823 # make_new_entries_table

824 #

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

826 #

827 # In: $_[0] table_caption

828 # $_[1] entries_class

829 # @_[2..] known_commands

830 # Out:

831

832 sub make_new_entries_table

833 {

834 my $table_caption;

835 my $entries_class = shift;

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

837 my $result = "";

838

839 my %count;

840 my @new_commands = ();

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

842 $count{$c}++

843 }

844 for my $c (keys %frequency_of_command) {

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

846 }

847

848 my $new_commands_section;

849 if (@new_commands){

850 my $hint;

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

852 $hint = make_comment($c);

853 next unless $hint;

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

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

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

857 }

858 }

859 if ($new_commands_section) {

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

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

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

863 . "</tr>"

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

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

866 . "</tr>"

867 . $new_commands_section

868 . "</table>"

869 }

870 return $result;

871 }

872

873 #############

874 # minutes_passed

875 #

876 #

877 #

878 # In: $_[0] seconds_since_last_command

879 # Out: "minutes passed" text

880

881 sub minutes_passed

882 {

883 my $seconds_since_last_command = shift;

884 my $result = "";

885 if ($seconds_since_last_command > 7200) {

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

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

888 : "прошло";

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

890 "часов";

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

892 . $passed_word." >".$hours_passed." ".$hours_word

893 . "</div>\n";

894 }

895 elsif ($seconds_since_last_command > 600) {

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

897

898

899 my $passed_word = $minutes_passed % 100 > 10

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

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

902 : "прошло";

903

904 my $minutes_word = $minutes_passed % 100 > 10

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

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

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

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

909 "минуты";

910

911 if ($seconds_since_last_command < 1800) {

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

913 . $passed_word." ".$minutes_passed." ".$minutes_word

914 . "</div>\n";

915 }

916 else {

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

918 . $passed_word." ".$minutes_passed." ".$minutes_word

919 . "</div>\n";

920 }

921 }

922 return $result;

923 }

924

925 #############

926 # print_all_txt

927 #

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

929 #

930 # In: $_[0] output_filename

931 # Out:

932

933 sub print_command_lines_txt

934 {

935

936 my $output_filename=$_[0];

937 my $note_number=0;

938

939 my $result = q();

940 my $this_day_resut = q();

941

942 my $cl;

943 my $last_tty="";

944 my $last_session="";

945 my $last_day=q();

946 my $last_wday=q();

947 my $in_range=0;

948

949 my $current_command=0;

950

951 my $cursor_position = 0;

952

953

954 if ($Config{filter}) {

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

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

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

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

959 }

960 }

961

962

963 COMMAND_LINE:

964 for my $k (@Command_Lines_Index) {

965

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

967 next unless $cl;

968

969

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

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

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

973

974 for my $filter_key (keys %filter) {

975 next COMMAND_LINE

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

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

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

979 }

980

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

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

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

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

985 $in_range=1;

986 next;

987 }

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

989 $in_range=0;

990 next;

991 }

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

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

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

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

996

997

998 #

999 ##

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

1001 ##

1002 #

1003

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

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

1006

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

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

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

1010 next;

1011 }

1012

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

1014

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

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

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

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

1019

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

1021

1022 # DAY CHANGE

1023 if ( $last_day ne $day) {

1024 if ($last_day) {

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

1026 $result .= $this_day_result;

1027 }

1028 $last_day = $day;

1029 $last_wday = $wday;

1030 $this_day_result = q();

1031 }

1032

1033 # CONSOLE CHANGE

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

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

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

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

1038 }

1039

1040 # Session change

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

1042 $this_day_result .= "# ------------------------------------------------------------"

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

1044 . " ---------------------------------- \n";

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

1046 }

1047

1048 # TIME

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

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

1051

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

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

1054 }

1055

1056 # COMMAND

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

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

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

1060 }

1061

1062 # OUTPUT

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

1064 if (!(

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

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

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

1068 )) {

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

1070 if ($output) {

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

1072 }

1073 $this_day_result .= $output;

1074 }

1075

1076 # DIFF

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

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

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

1080 $this_day_result .= $diff;

1081 };

1082 # SHOT

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

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

1085 }

1086

1087 #NOTES

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

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

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

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

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

1093 }

1094

1095 }

1096 last: {

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

1098 $result .= $this_day_result;

1099 }

1100

1101 return $result;

1102

1103

1104

1105 }

1106

1107 #############

1108 # print_edit_all_html

1109 #

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

1111 #

1112 # In: $_[0] output_filename

1113 # Out:

1114

1115 sub print_edit_all_html

1116 {

1117 my $output_filename= shift;

1118 my $result;

1119 my $cursor_position = 0;

1120

1121 $result = print_command_lines_txt;

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

1123

1124 $result =

1125 "<html>"

1126 ."<head>"

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

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

1129 ."<title>$title</title>"

1130 ."</head>"

1131 ."<script>"

1132 .$SetCursorPosition_JS

1133 ."</script>"

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

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

1136 ."<form>"

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

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

1139 ."</form>"

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

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

1142 ."</body>"

1143 ."</html>";

1144

1145 if ($output_filename eq "-") {

1146 print $result;

1147 }

1148 else {

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

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

1151 binmode ":utf8";

1152 print OUT "$result";

1153 close(OUT);

1154 }

1155 }

1156

1157 #############

1158 # print_all_txt

1159 #

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

1161 #

1162 # In: $_[0] output_filename

1163 # Out:

1164

1165 sub print_all_txt

1166 {

1167 my $result;

1168

1169 $result = print_command_lines_txt;

1170

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

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

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

1174

1175 if ($output_filename eq "-") {

1176 print $result;

1177 }

1178 else {

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

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

1181 print OUT "$result";

1182 close(OUT);

1183 }

1184 }

1185

1186

1187 #############

1188 # print_all_html

1189 #

1190 #

1191 #

1192 # In: $_[0] output_filename

1193 # Out:

1194

1195

1196 sub print_all_html

1197 {

1198 my $output_filename=$_[0];

1199

1200 my $result;

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

1202 my $files_section = print_files_html;

1203

1204 $result = $debug_output;

1205 $result .= print_header_html($toc);

1206

1207

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

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

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

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

1212 # }

1213

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

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

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

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

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

1219 $result.= print_footer_html;

1220

1221 if ($output_filename eq "-") {

1222 binmode STDOUT, ":utf8";

1223 print $result;

1224 }

1225 else {

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

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

1228 print OUT $result;

1229 close(OUT);

1230 }

1231 }

1232

1233 #############

1234 # print_header_html

1235 #

1236 #

1237 #

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

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

1240

1241 sub print_header_html

1242 {

1243 my $toc = $_[0];

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

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

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

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

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

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

1250

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

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

1253 if ($course_date) {

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

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

1256 : "";

1257 }

1258 else {

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

1260 }

1261

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

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

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

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

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

1267 for my $element (sort keys %Elements_Visibility)

1268 {

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

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

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

1272 $Elements_Visibility{$element}.

1273 "</input></div>";

1274 }

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

1276 . "</div>\n";

1277