lilalo: 466bea239d25 l3-frontend

lilalo

view l3-frontend @ 38:466bea239d25

1) В случае, если команда является повторяющейся,
показывать только последнюю версию команды.
2) lm-install неправильно определял hostname в FreeBSD. Исправлено.

author	devi
date	Tue Nov 22 20:46:46 2005 +0200 (2005-11-22)
parents	219389279acb
children	568bab7090fc

line source

1 #!/usr/bin/perl -w

3 use IO::Socket;

4 use lib '.';

5 use l3config;

6 use locale;

8 our @Command_Lines;

9 our @Command_Lines_Index;

10 our %Commands_Description;

11 our %Args_Description;

12 our $Mywi_Socket;

13 our %Sessions;

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

16 our @Day_Name;

17 our @Month_Name;

18 our @Of_Month_Name;

19 our %Search_Machines;

20 our %Elements_Visibility;

21 # ^^^

23 our %Stat;

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

26 sub search_buy;

27 sub make_comment;

28 sub load_command_lines_from_xml;

29 sub load_sessions_from_xml;

30 sub print_command_lines;

31 sub sort_command_lines;

32 sub process_command_lines;

33 sub init_variables;

34 sub main;

35 sub collapse_list($);

37 main();

39 sub main

40 {

41 $| = 1;

43 init_variables();

44 init_config();

46 open_mywi_socket();

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

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

49 sort_command_lines;

50 process_command_lines;

51 print_command_lines($Config{"output"});

52 close_mywi_socket;

53 }

56 sub search_by

57 {

58 my $sm = shift;

59 my $topic = shift;

60 $topic =~ s/ /+/;

62 return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='".

63 $Search_Machines{$sm}->{"icon"}."' border='0'/></a>";

64 }

66 sub extract_from_cline

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

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

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

70 {

71 my $what = $_[0];

72 my $cline = $_[1];

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

76 my @commands = ();

77 for my $list (@lists) {

78 push @commands, split /\|/, $list;

79 }

81 my %commands;

82 my %args;

83 my $i=0;

84 for my $command (@commands) {

85 $command =~ s@^\s*\S+/@@;

86 $command =~ /\s*(\S+)\s*(.*)/;

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

88 $commands{"$1"}=$i++;

89 $command =~ s/\s*sudo\s+//;

90 }

91 $command =~ s@^\s*\S+/@@;

92 $command =~ /\s*(\S+)\s*(.*)/;

93 if ($1 && !defined $commands{"$1"}) {

94 $commands{"$1"}=$i++;

95 };

96 if ($2) {

97 my $args = $2;

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

99 for my $a (@args) {

100 $args{"$a"}=$i++

101 if !defined $args{"$a"};

102 };

103

104

105 }

106 }

107

108 if ($what eq "commands") {

109 return \%commands;

110 } else {

111 return \%args;

112 }

113

114 }

115

116 sub open_mywi_socket

117 {

118 $Mywi_Socket = IO::Socket::INET->new(

119 PeerAddr => $Config{mywi_server},

120 PeerPort => $Config{mywi_port},

121 Proto => "tcp",

122 Type => SOCK_STREAM);

123 }

124

125 sub close_mywi_socket

126 {

127 close ($Mywi_Socket);

128 }

129

130

131 sub mywi_client

132 {

133 my $query = $_[0];

134 my $mywi;

135

136 open_mywi_socket;

137 if ($Mywi_Socket) {

138 local $| = 1;

139 local $/ = "";

140 print $Mywi_Socket $query."\n";

141 $mywi = <$Mywi_Socket>;

142 $mywi = "" if $mywi =~ /nothing app/;

143 }

144 close_mywi_socket;

145 return $mywi;

146 }

147

148 sub make_comment

149 {

150 my $cline = $_[0];

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

152

153 my @comments=();

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

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

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

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

158

159 # Commands

160 for my $command (@commands) {

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

162 $CommandsFDistribution{$command}++;

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

164 my $mywi="";

165 $mywi = mywi_client ($command);

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

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

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

169 $Commands_Description{$command} = $mywi;

170 }

171 else {

172 next;

173 }

174 }

175

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

177 }

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

179

180 # Files

181 for my $arg (@args) {

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

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

184 my $mywi;

185 $mywi = mywi_client ($arg);

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

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

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

189 $Args_Description{$arg} = $mywi;

190 }

191 else {

192 next;

193 }

194 }

195

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

197 }

198

199 }

200

201 =cut

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

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

204

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

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

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

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

209 =cut

210 sub load_command_lines_from_xml

211 {

212 my $datafile = $_[0];

213

214 open (CLASS, $datafile)

215 or die "Can't open file of the class ",$datafile,"\n";

216 local $/;

217 $data = <CLASS>;

218 close(CLASS);

219

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

221 my %cl;

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

223 $cl{$1} = $2;

224 }

225 push @Command_Lines, \%cl;

226 }

227 }

228

229 sub load_sessions_from_xml

230 {

231 my $datafile = $_[0];

232

233 open (CLASS, $datafile)

234 or die "Can't open file of the class ",$datafile,"\n";

235 local $/;

236 my $data = <CLASS>;

237 close(CLASS);

238

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

240 my %session;

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

242 $session{$1} = $2;

243 }

244 $Sessions{$session{local_session_id}} = \%session;

245 }

246 }

247

248

249

250 sub sort_command_lines

251 {

252 # Sort Command_Lines

253 # Write Command_Lines to Command_Lines_Index

254

255 my @index;

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

257 $index[$i]=$i;

258 }

259

260 @Command_Lines_Index = sort {

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

262 } @index;

263

264 }

265

266 sub process_command_lines

267 {

268 for my $i (@Command_Lines_Index) {

269

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

271 #@{${$cl}->{"new_commands"}} =();

272 #@{${$cl}->{"new_files"}} =();

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

274

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

276 $$cl->{"class"}="wrong";

277 $$cl->{"class"}="interrupted"

278 if ($$cl->{"err"} eq 130);

279 }

280 if (!$$cl->{"euid"}) {

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

282 }

283

284 #tab# my @tab_words=split /\s+/, $$cl->{"output"};

285 #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/;

286 #tab# $last_word =~ s@.*/@@;

287 #tab# my $this_is_tab=1;

288 #tab#

289 #tab# if ($last_word && @tab_words >2) {

290 #tab# for my $tab_words (@tab_words) {

291 #tab# if ($tab_words !~ /^$last_word/) {

292 #tab# $this_is_tab=0;

293 #tab# last;

294 #tab# }

295 #tab# }

296 #tab# }

297 #tab# $$cl->{"class"}="tab" if $this_is_tab;

298

299

300 # if ( !$$cl->{"err"}) {

301 # # Command does not contain mistakes

302 #

303 # my %commands = extract_from_cline("commands", ${$cl}->{"cline"});

304 # my %files = extract_from_cline("files", ${$cl}->{"cline"});

305 #

306 # # Searching for new commands only

307 # for my $command (keys %commands) {

308 # if (!defined $Commands_Stat{$command}) {

309 # push @{$$cl->{new_commands}}, $command;

310 # }

311 # $Commands_Stat{$command}++;

312 # }

313 #

314 # for my $file (keys %files) {

315 # if (!defined $Files_Stat{$file}) {

316 # push @{$$cl->{new_files}}, $file;

317 # }

318 # $Files_Stat{$file}++;

319 # }

320 # }

321

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

323 if ($1 eq "=") {

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

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

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

327 }

328 else {

329 my $j = $i;

330 if ($1 eq "^") {

331 $j--;

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

333 }

334 elsif ($1 eq "v") {

335 $j++;

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

337 }

338 $Command_Lines[$j]->{note_title}="$2";

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

340 $$cl=0;

341 }

342 }

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

344 if ($1 eq "=") {

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

346 $$cl->{"note"} = $2;

347 }

348 else {

349 my $j=$i;

350 if ($1 eq "^") {

351 $j--;

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

353 }

354 elsif ($1 eq "v") {

355 $j++;

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

357 }

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

359 $$cl=0;

360 }

361 }

362 }

363

364 }

365

366

367 =cut

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

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

370

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

372 =cut

373

374 sub print_command_lines

375 {

376 my $output_filename=$_[0];

377

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

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

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

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

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

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

384

385

386 # Результат выполнения процедуры равен

387 # join("", @Result{header,body,stat,help,about,footer})

388 my %Result;

389 my @toc; # Хранит оглавление

390 my $note_number=0;

391

392 $Result{"body"} = "<table width='100%'>\n";

393

394 my $cl;

395 my $last_tty="";

396 my $last_day="";

397 my $in_range=0;

398

399 my $i=0;

400

401 COMMAND_LINE:

402 for my $k (@Command_Lines_Index) {

403

404 my $cl=$Command_Lines[$Command_Lines_Index[$i++]];

405

406 next unless $cl;

407

408

409 if ($Config{filter}) {

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

411 my %filter;

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

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

414 $filter{$var} = $val;

415 }

416

417 for my $filter_key (keys %filter) {

418 next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_key} eq $filter{$filter_key};

419 }

420

421 #if ($filter{user}) {

422 # next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{user} eq $filter{user};

423 #}

424

425 #for my $filter_field (keys %filter) {

426 # next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_field} eq $filter{$filter_field};

427 #}

428 }

429

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

431 $in_range=1;

432 next;

433 }

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

435 $in_range=0;

436 next;

437 }

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

439 ||

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

441 ||

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

443 ||

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

445

446 #my @new_commands=@{$cl->{"new_commands"}};

447 #my @new_files=@{$cl->{"new_files"}};

448

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

450 my $note = $cl->{note};

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

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

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

454 $Result{"body"} .= "<tr><td colspan='6'>";

455 $Result{"body"} .= "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title};

456 $Result{"body"} .= "".$note."<p/><p/></td></td>";

457

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

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

460 $note_number++;

461 }

462 next;

463 }

464

465 my $cl_class="cline";

466 my $out_class="output";

467 if ($cl->{"class"}) {

468 $cl_class = $cl->{"class"}."_".$cl_class;

469 $out_class = $cl->{"class"}."_".$out_class;

470 }

471

472 my @new_commands;

473 my @new_files;

474 @new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"};

475 @new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"};

476

477 my $output="";

478 if ($Config{"head_lines"} || $Config{"tail_lines"}) {

479 # Partialy output

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

481 # head

482 my $mark=1;

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

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

485 }

486 # tail

487 my $start=$#lines-$Config{"tail_lines"}+1;

488 if ($start < 0) {

489 $start=0;

490 $mark=0;

491 }

492 if ($start < $Config{"head_lines"}) {

493 $start=$Config{"head_lines"};

494 $mark=0;

495 }

496 $output .= $Config{"skip_text"}."\n" if $mark;

497 for (my $i=$start; $i<= $#lines; $i++) {

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

499 }

500 }

501 else {

502 # Full output

503 $output .= $cl->{"output"};

504 }

505 #$output .= "^C\n" if ($cl->{"err"} eq "130");

506

507 #

508 ##

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

510 ##

511 #

512

513 # <command>

514

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

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

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

518 $Stat{LastCommand} = 0 unless defined $Stat{LastCommand};

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

520 if $cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval};

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

522 $Stat{TotalCommands} = 0 unless $Stat{TotalCommands};

523 $Stat{TotalCommands}++;

524

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

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

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

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

529

530 $class=$cl->{"out_class"};

531 $class =~ s/output$//;

532

533 $Stat{ErrorCommands}++

534 if $class =~ /wrong/;

535

536 $Result{"body"} .= "<tr class='command'>\n";

537

538

539 # DAY CHANGE

540 if ( $last_day ne $day) {

541 #$Result{"body"} .= "<td colspan='6'><p></p><h3>День ",$day,"</h4></td></tr><tr>";

542 $Result{"body"} .= "<td colspan='6'><p></p><h3 id='day$day'>".$Day_Name[$wday]."</h4></td></tr><tr>";

543 push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";

544 $last_day=$day;

545 }

546

547 # CONSOLE CHANGE

548 if ( $last_tty ne $cl->{"tty"}) {

549 my $host;

550 #$host = $Sessions{$cl->{local_session_id}}->{user}."@".$Sessions{$cl->{local_session_id}}->{hostname};

551 $Result{"body"} .= "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>".$cl->{"tty"}."</td><td>$host</td></tr></table></td></tr><tr>";

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

553 }

554

555 # TIME

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

557 $Result{"body"} .= "<td valign='top' class='time' width='$Config{time_width}'><pre>".

558 $hour. ":". $min. ":". $sec.

559 "</td>";

560 } else {

561 $Result{"body"} .= "<td width='0'/>"

562 }

563

564 # COMMAND

565 $Result{"body"} .= "<td class='script'>\n";

566 $Result{"body"} .= "<pre class='${class}cline'>\n";

567 my $cline = $cl->{"prompt"}.$cl->{"cline"};

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

569

570 #$cline .= "(".$Sessions{$cl->{local_session_id}}.")";

571

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

573 $cline = "<div title='$hint'>$cline</div>" if $hint;

574 $Result{"body"} .= $cline;

575 $Result{"body"} .= "</pre>\n";

576

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

578 if (!(

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

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

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

582 )) {

583

584 $Result{"body"} .= "<pre class='".$cl->{out_class}."'>";

585 $Result{"body"} .= $output;

586 $Result{"body"} .= "</pre>\n";

587 }

588

589 # DIFF

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

591 $Result{"body"} .= "<table><tr><td width='5'/><td class='diff'><pre>";

592 $Result{"body"} .= $cl->{"diff"};

593 $Result{"body"} .= "</pre></td></tr></table>";

594 }

595

596 #NOTES

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

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

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

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

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

602 # Ширину пока не используем

603 # $Result{"body"} .= "<table width='$Config{note_width}' class='note'>";

604 $Result{"body"} .= "<table class='note'>";

605 $Result{"body"} .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title};

606 $Result{"body"} .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>";

607 $Result{"body"} .= "</table>\n";

608 }

609

610 # COMMENT

611 if ( $Config{"show_comments"} =~ /^y/i) {

612 my $comment = make_comment($cl->{"cline"});

613 if ($comment) {

614 $Result{"body"} .= "<table width='$Config{comment_width}'>".

615 "<tr><td width='5'/><td>";

616 $Result{"body"} .= "<table class='note' width='100%'>";

617 $Result{"body"} .= $comment;

618 $Result{"body"} .= "</table>\n";

619 $Result{"body"} .= "</td></tr></table>";

620 }

621 }

622

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

624 $Result{"body"} .= "</td>\n";

625 $Result{"body"} .= "</tr>\n";

626 }

627

628 $Result{"body"} .= "</table>\n";

629

630 #$Result{"stat"} = "<hr/>";

631

632 %StatNames = (

633 FirstCommand => "Время первой команды журнала",

634 LastCommand => "Время последней команды журнала",

635 TotalCommands => "Количество командных строк в журнале",

636 ErrorsPercentage => "Процент команд с ненулевым кодом завершения, %",

637 TotalTime => "Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час",

638 CommandsPerTime => "Количество командных строк в единицу времени, команда/мин",

639 CommandsFrequency => "Частота использования команд",

640 RareCommands => "Частота использования этих команд < 0.5%",

641 );

642 @StatOrder = (

643 FirstCommand,

644 LastCommand,

645 TotalCommands,

646 ErrorsPercentage,

647 TotalTime,

648 CommandsPerTime,

649 CommandsFrequency,

650 RareCommands,

651 );

652

653 # Подготовка статистики к выводу

654 # Некоторые значения пересчитываются!

655 # Дальше их лучше уже не использовать!!!

656

657 my %CommandsFrequency = %CommandsFDistribution;

658

659 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{FirstCommand});

660 $Stat{FirstCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec, $year+1900, $mon+1, $mday;

661 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{LastCommand});

662 $Stat{LastCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec, $year+1900, $mon+1, $mday;

663 $Stat{ErrorsPercentage} = sprintf "%5.2f", $Stat{ErrorCommands}*100/$Stat{TotalCommands}

664 if $Stat{TotalCommands};

665 $Stat{CommandsPerTime} = sprintf "%5.2f", $Stat{TotalCommands}*60/$Stat{TotalTime}

666 if $Stat{TotalTime};

667 $Stat{TotalTime} = sprintf "%5.2f", $Stat{TotalTime}/60/60;

668

669 my $total_commands=0;

670 for $command (keys %CommandsFrequency){

671 $total_commands += $CommandsFrequency{$command};

672 }

673 if ($total_commands) {

674 for $command (reverse sort {$CommandsFrequency{$a} <=> $CommandsFrequency{$b}} keys %CommandsFrequency){

675 my $command_html;

676 my $percentage = sprintf "%5.2f",$CommandsFrequency{$command}*100/$total_commands;

677 if ($percentage < 0.5) {

678 my $hint = make_comment($command);

679 $command_html = "$command";

680 $command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;

681 my $command_html = "<tt>$command_html</tt>";

682 $Stat{RareCommands} .= $command_html."<sub><font size='-2'>".$CommandsFrequency{$command}."</font></sub> , ";

683 }

684 else {

685 my $hint = make_comment($command);

686 $command_html = "$command";

687 $command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;

688 my $command_html = "<tt>$command_html</tt>";

689 $percentage = sprintf "%5.2f",$percentage;

690 $Stat{CommandsFrequency} .= "<tr><td>".$command_html."</td><td>".$CommandsFrequency{$command}."</td>".

691 "<td>|".("="x int($CommandsFrequency{$command}*100/$total_commands))."| $percentage%</td></tr>";

692 }

693 }

694 $Stat{CommandsFrequency} = "<table>".$Stat{CommandsFrequency}."</table>";

695 $Stat{RareCommands} =~ s/, $// if $Stat{RareCommands};

696 }

697

698 $Result{"stat"} .= "<h2 id='stat'>Статистика</h2>";

699 $Result{"stat"} .= "<table>";

700 for my $stat (@StatOrder) {

701 $Result{"stat"} .= "<tr valign='top'><td width='300'>".$StatNames{"$stat"}."</td><td>".$Stat{"$stat"}."</td></tr>"

702 if $Stat{"$stat"};

703 }

704

705 $Result{"stat"} .= "</table>";

706 $Result{"stat"} .= "<font size='-2'>____<br/>*) Интервалы неактивности длительностью ".($Config{stat_inactivity_interval}/60)." минут и более не учитываются</font></br>";

707

708 #$Result{"help"} .= "<hr/>";

709 $Result{"help"} .= "<h2 id='help'>Справка</h2>";

710 $Result{"help"} .= "$Html_Help<br/>";

711 #$Result{"about"} .= "<hr/>";

712 $Result{"about"} .= "<h2 id='about'>О программе</h2>";

713 $Result{"about"} .= "$Html_About";

714 $Result{"footer"} .= "</body>\n";

715 $Result{"footer"} .= "</html>\n";

716

717 $Result{"title"} = "Журнал лабораторных работ";

718 $Result{"title"}.= " -- ".$course_student if $course_student;