lilalo: 99ea38e538c9 l3-frontend

lilalo

view l3-frontend @ 111:99ea38e538c9

Добавил:
* l3upload

Исправил:
* хинт теперь всплывает только при наведении непосредственно на команду
(а не на приглашение и не на символ кода завершения)
* подсветка неизвестных команд не такая сильная

author	igor
date	Sat Feb 16 13:41:48 2008 +0200 (2008-02-16)
parents	3cd466f35ad6
children	658b4ea105c1

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".$Config{l3shot_suffix};

470 }

471 }

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

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

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

475 }

476 }

477

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

479

480 my $note_operator = $1;

481 my $note_title = $2;

482

483 if ($note_operator eq "=") {

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

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

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

487 }

488 else {

489 my $j = $i;

490 if ($note_operator eq "^") {

491 $j--;

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

493 }

494 elsif ($note_operator eq "v") {

495 $j++;

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

497 }

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

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

500 $$cl=0;

501 }

502 }

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

504

505 my $note_operator = $1;

506 my $note_text = $2;

507

508 if ($note_operator eq "=") {

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

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

511 }

512 else {

513 my $j=$i;

514 if ($note_operator eq "^") {

515 $j--;

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

517 }

518 elsif ($note_operator eq "v") {

519 $j++;

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

521 }

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

523 $$cl=0;

524 }

525 }

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

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

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

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

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

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

532 }

533 }

534

535 }

536

537

538 =cut

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

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

541

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

543 =cut

544

545 sub print_command_lines_html

546 {

547

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

549 my $note_number=0;

550

551 my $result = q();

552 my $this_day_resut = q();

553

554 my $cl;

555 my $last_tty="";

556 my $last_session="";

557 my $last_day=q();

558 my $last_wday=q();

559 my $first_command_of_the_day_unix_time=q();

560 my $human_readable_time=q();

561 my $in_range=0;

562

563 my $current_command=0;

564

565 my @known_commands;

566

567

568

569 $Stat{LastCommand} ||= 0;

570 $Stat{TotalCommands} ||= 0;

571 $Stat{ErrorCommands} ||= 0;

572 $Stat{MistypedCommands} ||= 0;

573

574 my %new_entries_of = (

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

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

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

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

579 );

580

581 COMMAND_LINE:

582 for my $k (@Command_Lines_Index) {

583

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

585 next unless $cl;

586

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

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

589

590

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

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

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

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

595

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

597

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

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

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

601

602 for my $filter_key (keys %filter) {

603 next COMMAND_LINE

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

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

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

607 }

608

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

610 # Хэш %Stat

611

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

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

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

615 }

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

617

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

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

620 };

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

622 $Stat{TotalCommands}++;

623

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

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

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

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

628 $in_range=1;

629 next;

630 }

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

632 $in_range=0;

633 next;

634 }

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

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

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

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

639

640

641

642

643 #

644 ##

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

646 ##

647 #

648

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

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

651

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

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

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

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

656

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

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

659 $note_number++;

660 }

661 next;

662 }

663

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

665

666

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

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

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

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

671

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

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

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

675

676 # DAY CHANGE

677 if ( $last_day ne $day) {

678 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

681 if ($last_day) {

682

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

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

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

686

687

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

689

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

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

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

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

694 my $new_commands_section = make_new_entries_table(

695 $table_caption,

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

697 \@known_commands);

698 }

699 @known_commands = keys %frequency_of_command;

700 $result .= $this_day_result;

701 }

702

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

704

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

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

707

708

709 $last_day=$day;

710 $last_wday=$wday;

711 $this_day_result = q();

712 }

713 else {

714 $this_day_result .= minutes_passed($seconds_since_last_command);

715 }

716

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

718

719 # CONSOLE CHANGE

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

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

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

723 . $tty

724 ."</div>";

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

726 }

727

728 # Session change

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

730 my $tty;

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

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

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

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

735 }

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

737 }

738

739 # TIME

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

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

742 }

743

744 # COMMAND

745 my $cline;

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

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

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

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

750

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

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

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

754 }

755 else {

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

757 }

758

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

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

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

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

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

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

765

766 # OUTPUT

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

768 if (!(

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

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

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

772 )) {

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

774 }

775

776 # DIFF

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

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

779 # SHOT

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

781 .$Config{l3shot_path}

782 .$cl->{"screenshot"}

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

784 ."'/>"

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

786

787 #NOTES

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

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

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

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

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

793 };

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

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

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

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

798 }

799

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

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

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

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

804 }

805 last: {

806 $prev_unix_time=$first_command_of_the_day_unix_time;

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

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

809

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

811

812 for my $entry_class (keys %new_entries_of) {

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

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

815 my $new_commands_section = make_new_entries_table(

816 $table_caption,

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

818 \@known_commands);

819 }

820 @known_commands = keys %frequency_of_command;

821 $result .= $this_day_result;

822 }

823

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

825

826 }

827

828 #############

829 # make_new_entries_table

830 #

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

832 #

833 # In: $_[0] table_caption

834 # $_[1] entries_class

835 # @_[2..] known_commands

836 # Out:

837

838 sub make_new_entries_table

839 {

840 my $table_caption;

841 my $entries_class = shift;

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

843 my $result = "";

844

845 my %count;

846 my @new_commands = ();

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

848 $count{$c}++

849 }

850 for my $c (keys %frequency_of_command) {

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

852 }

853

854 my $new_commands_section;

855 if (@new_commands){

856 my $hint;

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

858 $hint = make_comment($c);

859 next unless $hint;

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

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

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

863 }

864 }

865 if ($new_commands_section) {

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

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

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

869 . "</tr>"

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

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

872 . "</tr>"

873 . $new_commands_section

874 . "</table>"

875 }

876 return $result;

877 }

878

879 #############

880 # minutes_passed

881 #

882 #

883 #

884 # In: $_[0] seconds_since_last_command

885 # Out: "minutes passed" text

886

887 sub minutes_passed

888 {

889 my $seconds_since_last_command = shift;

890 my $result = "";

891 if ($seconds_since_last_command > 7200) {

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

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

894 : "прошло";

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

896 "часов";

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

898 . $passed_word." >".$hours_passed." ".$hours_word

899 . "</div>\n";

900 }

901 elsif ($seconds_since_last_command > 600) {

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

903

904

905 my $passed_word = $minutes_passed % 100 > 10

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

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

908 : "прошло";

909

910 my $minutes_word = $minutes_passed % 100 > 10

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

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

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

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

915 "минуты";

916

917 if ($seconds_since_last_command < 1800) {

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

919 . $passed_word." ".$minutes_passed." ".$minutes_word

920 . "</div>\n";

921 }

922 else {

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

924 . $passed_word." ".$minutes_passed." ".$minutes_word

925 . "</div>\n";

926 }

927 }

928 return $result;

929 }

930

931 #############

932 # print_all_txt

933 #

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

935 #

936 # In: $_[0] output_filename

937 # Out:

938

939 sub print_command_lines_txt

940 {

941

942 my $output_filename=$_[0];

943 my $note_number=0;

944

945 my $result = q();

946 my $this_day_resut = q();

947

948 my $cl;

949 my $last_tty="";

950 my $last_session="";

951 my $last_day=q();

952 my $last_wday=q();

953 my $in_range=0;

954

955 my $current_command=0;

956

957 my $cursor_position = 0;

958

959

960 if ($Config{filter}) {

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

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

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

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

965 }

966 }

967

968

969 COMMAND_LINE:

970 for my $k (@Command_Lines_Index) {

971

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

973 next unless $cl;

974

975

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

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

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

979

980 for my $filter_key (keys %filter) {

981 next COMMAND_LINE

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

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

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

985 }

986

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

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

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

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

991 $in_range=1;

992 next;

993 }

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

995 $in_range=0;

996 next;

997 }

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

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

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

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

1002

1003

1004 #

1005 ##

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

1007 ##

1008 #

1009

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

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

1012

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

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

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

1016 next;

1017 }

1018

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

1020

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

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

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

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

1025

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

1027

1028 # DAY CHANGE

1029 if ( $last_day ne $day) {

1030 if ($last_day) {

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

1032 $result .= $this_day_result;

1033 }

1034 $last_day = $day;

1035 $last_wday = $wday;

1036 $this_day_result = q();

1037 }

1038

1039 # CONSOLE CHANGE

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

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

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

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

1044 }

1045

1046 # Session change

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

1048 $this_day_result .= "# ------------------------------------------------------------"

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

1050 . " ---------------------------------- \n";

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

1052 }

1053

1054 # TIME

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

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

1057

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

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

1060 }

1061

1062 # COMMAND

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

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

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

1066 }

1067

1068 # OUTPUT

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

1070 if (!(

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

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

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

1074 )) {

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

1076 if ($output) {

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

1078 }

1079 $this_day_result .= $output;

1080 }

1081

1082 # DIFF

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

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

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

1086 $this_day_result .= $diff;

1087 };

1088 # SHOT

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

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

1091 }

1092

1093 #NOTES

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

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

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

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

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

1099 }

1100

1101 }

1102 last: {

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

1104 $result .= $this_day_result;

1105 }

1106

1107 return $result;

1108

1109

1110

1111 }

1112

1113 #############

1114 # print_edit_all_html

1115 #

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

1117 #

1118 # In: $_[0] output_filename

1119 # Out:

1120

1121 sub print_edit_all_html

1122 {

1123 my $output_filename= shift;

1124 my $result;

1125 my $cursor_position = 0;

1126

1127 $result = print_command_lines_txt;

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

1129

1130 $result =

1131 "<html>"

1132 ."<head>"

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

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

1135 ."<title>$title</title>"

1136 ."</head>"

1137 ."<script>"

1138 .$SetCursorPosition_JS

1139 ."</script>"

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

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

1142 ."<form>"

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

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

1145 ."</form>"

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

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

1148 ."</body>"

1149 ."</html>";

1150

1151 if ($output_filename eq "-") {

1152 print $result;

1153 }

1154 else {

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

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

1157 binmode ":utf8";

1158 print OUT "$result";

1159 close(OUT);

1160 }

1161 }

1162

1163 #############

1164 # print_all_txt

1165 #

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

1167 #

1168 # In: $_[0] output_filename

1169 # Out:

1170

1171 sub print_all_txt

1172 {

1173 my $result;

1174

1175 $result = print_command_lines_txt;

1176

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

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

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

1180

1181 if ($output_filename eq "-") {

1182 print $result;

1183 }

1184 else {

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

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

1187 print OUT "$result";

1188 close(OUT);

1189 }

1190 }

1191

1192

1193 #############

1194 # print_all_html

1195 #

1196 #

1197 #

1198 # In: $_[0] output_filename

1199 # Out:

1200

1201

1202 sub print_all_html

1203 {

1204 my $output_filename=$_[0];

1205

1206 my $result;

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

1208 my $files_section = print_files_html;

1209

1210 $result = $debug_output;

1211 $result .= print_header_html($toc);

1212

1213

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

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

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

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

1218 # }

1219

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

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

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

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

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

1225 $result.= print_footer_html;

1226

1227 if ($output_filename eq "-") {

1228 binmode STDOUT, ":utf8";

1229 print $result;

1230 }

1231 else {

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

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

1234 print OUT $result;

1235 close(OUT);

1236 }

1237 }

1238

1239 #############

1240 # print_header_html

1241 #

1242 #

1243 #

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

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

1246

1247 sub print_header_html

1248 {

1249 my $toc = $_[0];

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

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

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

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

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

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

1256

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

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

1259 if ($course_date) {

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

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

1262 : "";

1263 }

1264 else {

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

1266 }

1267

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

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

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

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

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

1273 for my $element (sort keys %Elements_Visibility)

1274 {

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

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

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

1278 $Elements_Visibility{$element}.

1279 "</input></div>";

1280 }

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

1282 . "</div>\n";

1283