lilalo
view lm-report @ 93:45196265d30e
Написан прототип lm get
author | devi |
---|---|
date | Sat Apr 22 17:08:05 2006 +0300 (2006-04-22) |
parents | ab8d2a28fc86 |
children |
line source
1 #!/usr/bin/perl -w
3 #
4 # (c) Igor Chubin, imchubin@mail.ru, 2004-2005
5 #
7 use strict;
8 use Getopt::Long;
9 use Term::VT102;
10 use Text::Iconv;
11 use Data::Dumper;
13 our $Config_File = "labmaker.conf";
14 our %Config = (
15 "skip_empty" => "yes",
16 "skip_interrupted" => "no",
17 "skip_wrong" => "no",
18 "editors" => ["vi", "pico", "ee", "vim"],
19 "pagers" => ["more", "less", "zmore", "zless", "info",
20 "man", "mc", "trafshow", "screen", "cfdisk",
21 "trafshow-bsd", "yes", "lynx", "links", "centericq"
22 ],
23 "terminal" => ["mc"],
24 "suppress_editors" => "yes",
25 "suppress_pagers" => "yes",
26 "suppress_terminal" => "yes",
28 "terminal_width" => 100,
29 "terminal_height" => 100,
30 "verbose" => "yes",
32 "head_lines" => 5,
33 "tail_lines" => 5,
34 "skip_text" => "...",
35 "show_time" => "yes",
36 "show_diffs" => "yes",
37 "show_comments" => "yes",
39 "input" => "/root/.labmaker",
40 "diffs" => "",
41 "input_mask" => "*.script",
42 "encoding" => "utf-8",
44 "output" => "/var/www/lm/reportINDEX.html",
45 #"output" => "report.xml",
46 "output_mask" => "INDEX",
47 "output_format" => "html",
49 "signature" => "#lm:",
50 "from" => "",
51 "to" => "",
52 "lab" => "",
53 "keywords" => "linux command",
54 "files_keywords" => "linux file",
56 comment_width => "300",
57 time_width => "60",
59 "course-name" => "",
60 "course-code" => "",
61 "course-date" => "",
62 "course-center" => "",
63 "course-trainer" => "",
64 "course-student" => "",
66 );
68 our @Command_Lines;
69 our @Command_Lines_Index;
70 our @Diffs;
72 our %Commands_Stat; # Statistics about commands usage
73 our %Files_Stat; # Statistics about commands usage
75 our %Search_Machines = (
76 "google" => { "query" => "http://www.google.com/search?q=" ,
77 "icon" => "google.ico" },
78 "freebsd" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=",
79 "icon" => "freebsd.ico" },
80 "linux" => { "query" => "http://man.he.net/?topic=",
81 "icon" => "linux.ico"},
82 "opennet" => { "query" => "http://www.opennet.ru/search.shtml?words=",
83 "icon" => "opennet.ico"},
84 "local" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=",
85 "icon" => "freebsd.ico" },
87 );
89 our %Elements_Visibility = (
90 "note" => "замечания",
91 "diff" => "редактор",
92 "time" => "время",
93 "ttychange" => "терминал",
94 "wrong_output wrong_cline wrong_root_output wrong_root_cline"
95 => "команды с ошибками",
96 "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline"
97 => "прерванные команды",
98 "tab_completion_output tab_completion_cline"
99 => "продолжение с помощью tab"
100 );
102 sub init_variables;
103 our $Html_Help;
104 our $Html_About;
107 sub load_diff_files
108 {
109 my @pathes = @_;
111 for my $path (@pathes) {
112 my $template = "*.diff";
113 my @files = <$path/$template>;
114 my $i=0;
115 for my $file (@files) {
116 my %diff;
118 $diff{"path"}=$path;
119 $diff{"uid"}="SET THIS";
121 # Сейчас UID определяется из названия каталога
122 # откуда берутся diff-файлы
123 # Это неправильно
124 #
125 # ВАРИАНТ:
126 # К файлам жураналам должны прилагаться ситемны файлы,
127 # мз которых и будет определяться соответствие
128 # имён пользователей их uid'ам
129 #
130 $diff{"uid"} = 0 if $path =~ m@/root/@;
132 $diff{"bind_to"}="";
133 $diff{"time_range"}=-1;
135 next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@;
136 $diff{"day"}=$1 || "";
137 $diff{"hour"}=$2;
138 $diff{"min"}=$3;
139 $diff{"sec"}=$4 || 0;
141 $diff{"index"}=$i;
143 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";
145 local $/;
146 open (F, "$file")
147 or return "Can't open file $file ($_[0]) for reading";
148 my $text = <F>;
149 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {
150 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");
151 $text = $converter->convert($text);
152 }
153 close(F);
154 $diff{"text"}=$text;
155 #print "$file loaded ($diff{day})\n";
157 push @Diffs, \%diff;
158 $i++;
159 }
160 }
161 }
164 sub bind_diff
165 {
166 # my $path = shift;
167 # my $pid = shift;
168 # my $day = shift;
169 # my $lab = shift;
171 print "Trying to bind diff...\n";
173 my $cl = shift;
174 my $hour = $cl->{"hour"};
175 my $min = $cl->{"min"};
176 my $sec = $cl->{"sec"};
178 my $min_dt = 10000;
180 for my $diff (@Diffs) {
181 # Check here date, time and user
182 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));
183 #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"});
185 my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);
186 if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) {
187 print "Approppriate diff found: dt=$dt\n";
188 if ($diff->{"bind_to"}) {
189 undef $diff->{"bind_to"}->{"diff"};
190 };
191 $diff->{"time_range"}=$dt;
192 $diff->{"bind_to"}=$cl;
194 $cl->{"diff"} = $diff->{"index"};
195 $min_dt = $dt;
196 }
198 }
199 }
202 sub extract_from_cline
203 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
204 # номер первого появление команды в строке:
205 # команда => первая позиция
206 {
207 my $what = $_[0];
208 my $cline = $_[1];
209 my @lists = split /\;/, $cline;
212 my @commands = ();
213 for my $list (@lists) {
214 push @commands, split /\|/, $list;
215 }
217 my %commands;
218 my %files;
219 my $i=0;
220 for my $command (@commands) {
221 $command =~ /\s*(\S+)\s*(.*)/;
222 if ($1 && $1 eq "sudo" ) {
223 $commands{"$1"}=$i++;
224 $command =~ s/\s*sudo\s+//;
225 }
226 $command =~ /\s*(\S+)\s*(.*)/;
227 if ($1 && !defined $commands{"$1"}) {
228 $commands{"$1"}=$i++;
229 };
230 if ($2) {
231 my $args = $2;
232 my @args = split (/\s+/, $args);
233 for my $a (@args) {
234 $files{"$a"}=$i++
235 if !defined $files{"$a"};
236 };
239 }
240 }
242 if ($what eq "commands") {
243 return %commands;
244 } else {
245 return %files;
246 }
248 }
250 sub load_command_lines
251 {
252 my $lab_scripts_path = $_[0];
253 my $lab_scripts_mask = $_[1];
255 my $cline_re_base = qq'
256 (?:\\^?([0-9]*C?)) # exitcode
257 (?:_([0-9]+)_)? # uid
258 (?:_([0-9]+)_) # pid
259 (...?) # day
260 (.?.?) # lab
261 \\s # space separator
262 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time
263 .\\[50D.\\[K # killing symbols
264 (.*?([\$\#]\\s?)) # prompt
265 (.*) # command line
266 ';
267 #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x;
268 #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x;
269 my $cline_re = qr/$cline_re_base/sx;
270 my $cline_re1 = qr/$cline_re_base\x0D/sx;
271 my $cline_re2 = qr/$cline_re_base$/sx;
273 my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"},
274 'rows' => $Config{"terminal_height"});
275 my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"},
276 'rows' => $Config{"terminal_height"});
278 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")
279 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);
281 print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/;
283 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;
284 my $file;
285 my $files_number = $#lab_scripts;
286 my $ii = 0;
287 my $skip_info;
289 my $commandlines_loaded =0;
290 my $commandlines_processed =0;
292 for $file (@lab_scripts){
293 #printf "\t%i %3.2f\n", $ii, (100*$ii++/$files_number) if $Config{"verbose"} =~ /y/;
295 open (FILE, "$file");
296 binmode FILE;
297 $file =~ m@.*/(.*?)-.*@;
299 my $tty = $1;
300 my $first_pass = 1;
301 my %cl;
302 my $last_output_length=0;
303 while (<FILE>) {
304 $commandlines_processed++;
305 # time
307 if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {
308 s/.*\x0d(?!\x0a)//;
309 # print "!!!",$_,"!!!\n";
310 # next;
311 # while (m/$cline_re1/gs) {
312 # }
313 m/$cline_re2/gs;
315 $commandlines_loaded++;
316 $last_output_length=0;
318 # Previous command
319 my %last_cl = %cl;
320 my $err = $1 || "";
323 =cut
325 ТАБЛИЦА КОМАНД
327 uid
328 Идентификатор пользователя
330 tty
331 Идентификатор терминала, на котором была вызвана команда
333 pid
334 PID-процесса командного интерпретатора,
335 в котором была вызвана команда
337 lab
338 лабораторная работа, к которой относится команда.
339 Идентификатор текущей лабораторной работы
340 хранится в файле ~/.labmaker/lab
342 pwd (!)
343 текущий каталог, из которого была вызвана команда
345 day
346 время вызова, день
347 В действительности здесь хранится не время вызова команды,
348 а с момента появления приглашения командного интерпретатора
349 для ввода команды
352 hour
353 время вызова, час
355 min
356 время вызова, минута
358 sec
359 время вызова, секунда
361 time (!)
362 время вызова команды в Unix-формате.
363 Предпочтительнее использовать этот формат чем hour:min:sec,
364 использовавшийся в Labmaker
366 fullprompt
367 Приглашение командной строки
369 prompt
370 Сокращённое приглашение командной строки
372 cline
373 Командная строка
375 output
376 Результат выполнения команды
378 diff
379 Указатель на ассоциированный с командой diff
381 note (!)
382 Текстовый комментарий к команде.
383 Может генерироваться из самого лога с помощью команд
384 #^ Комментарий
385 #v Комментарий
386 в том случае, если для комментирования достаточно одной строки,
387 или с помощью команд
388 cat > /dev/null #^ Заголовок
389 Текст
390 ^D
391 в том случае, если комментарий развёрнутый.
392 В последнем случае комментарий может содержать
393 заголовок, абзацы и несложное форматирование.
395 Символ ^ или v после знака комментария # обозначает,
396 к какой команде относится комментарий:
397 к предыдущей (^) или последующей (v)
399 err
400 Код завершения командной строки
402 histnum (!)
403 Номер команды в истории командного интерпретатора
405 status (!)
406 Является ли данная команда вызванной (r), запомненной (s)
407 или это подсказка completion (c).
409 Команды, которые были вызваны и обработаны интерпретатором
410 имеют состояние "r". К таким командам относится большинство
411 команд вводимых в интерпретатор.
413 Если команда набрана, но вызывать её по какой-либо причине
414 не хочется (например, команда может быть не полной, вредоносной
415 или просто бессмысленной в текущих условиях),
416 её можно сбросить с помощью комбинации клавиш Ctrl-C
417 (не путайте с прерыванием работающей команды! здесь она даже
418 не запускается!).
419 В таком случае она не выполняется, но попадает в журнал
420 со статусом "s".
422 Если команда появилась в журнале благодаря автопроолжению
423 -- когда было показано несколько вариантов --
424 она имеет статус "c".
426 euid
427 Идентификатор пользователя от имени которого будет
428 выполняться команда.
429 Может отличаться от реального uid в том случае,
430 если вызывается с помощью sudo
433 version (!)
434 Версия lilalo-prompt использовавшаяся при записи
435 команды.
437 0 - версия использовавшая в labmaker.
438 Отсутствует информация о текущем каталоге и номере в истории.
439 Информация о версии также не указана в приглашении.
442 1 - версия использующаяся в lilalo
444 raw_file (*)
445 Имя файла, в котором находится бинарное представление журнала.
446 Может содержать ключевое слово HERE,
447 обозначающее что бинарное представление хранится
448 непосредственно в базе данных в атрибуте raw_data
450 raw_start (*)
451 Начало блока командной строки в файле бинарного представления
453 raw_end (*)
454 Конец блока командной строки в файле бинарного представления
456 raw_cline (*)
457 Необработанная командная строка в бинарном виде
459 raw_data (*)
460 Бинарное представление команды и результатов её выполнения
465 ТАБЛИЦА SESSION
467 Информация о сеансах
472 =cut
474 # Parse new command
475 $cl{"uid"} = $2;
476 $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0
477 $cl{"pid"} = $3;
478 $cl{"day"} = $4;
479 $cl{"lab"} = $5;
480 $cl{"hour"} = $6;
481 $cl{"min"} = $7;
482 $cl{"sec"} = $8;
483 $cl{"fullprompt"} = $9;
484 $cl{"prompt"} = $10;
485 $cl{"raw_cline"} = $11;
487 $cl{"err"} = 0;
488 $cl{"output"} = "";
489 $cl{"tty"} = $tty;
491 $cline_vt->process($cl{"raw_cline"}."\n");
492 $cl{"cline"} = $cline_vt->row_plaintext (1);
493 $cl{"cline"} =~ s/\s*$//;
494 $cline_vt->reset();
496 my %commands = extract_from_cline("commands", $cl{"cline"});
497 $cl{"euid"}=0 if defined $commands{"sudo"};
498 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;
499 $cl{"last_command"} = $comms[$#comms] || "";
501 if (
502 $Config{"suppress_editors"} =~ /^y/i
503 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) ||
504 $Config{"suppress_pagers"} =~ /^y/i
505 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) ||
506 $Config{"suppress_terminal"}=~ /^y/i
507 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})
508 ) {
509 $cl{"suppress_output"} = "1";
510 }
511 else {
512 $cl{"suppress_output"} = "0";
514 }
515 $skip_info = 0;
518 print " ",$cl{"last_command"};
520 # Processing previous command line
521 if ($first_pass) {
522 $first_pass = 0;
523 next;
524 }
526 # Error code
527 $last_cl{"err"}=$err;
528 $last_cl{"err"}=130 if $err eq "^C";
530 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {
531 bind_diff(\%last_cl);
532 }
534 # Output
535 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {
536 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {
537 my $line= $vt->row_plaintext($i);
538 next if !defined ($line) || $line =~ /^\s*$/;
539 $line =~ s/\s*$//;
540 $last_cl{"output"} .= $line."\n";
541 }
542 }
543 else {
544 $last_cl{"output"}= "";
545 }
547 $vt->reset();
550 # Classifying the command line
553 # Save
554 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {
555 # Changing encoding
556 for (keys %last_cl) {
557 $last_cl{$_} = $converter->convert($last_cl{$_})
558 if ($Config{"encoding"} &&
559 $Config{"encoding"} !~ /^utf-8$/i);
560 }
561 push @Command_Lines, \%last_cl;
562 }
563 next;
564 }
565 $last_output_length+=length($_);
566 #if (!$cl{"suppress_output"} || $last_output_length < 5000) {
567 if ($last_output_length < 50000) {
568 #print "(",length($_),")" if (length($_) > 2000) ;
569 $vt->process("$_"."\n")
570 }
571 else
572 {
573 if (!$skip_info) {
574 print "($cl{last_command})";
575 $skip_info = 1;
576 }
577 }
578 }
579 close(FILE);
581 }
582 if ($Config{"verbose"} =~ /y/) {
583 print "...finished." ;
584 print "Lines loaded: $commandlines_processed\n";
585 print "Command lines: $commandlines_loaded\n";
586 }
587 }
589 sub search_by
590 {
591 my $sm = shift;
592 my $topic = shift;
593 $topic =~ s/ /+/;
595 return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='".
596 $Search_Machines{$sm}->{"icon"}."' border='0'/></a>";
597 }
599 sub make_comment
600 {
601 my $commands = $_[0];
602 my $files = $_[1];
603 chomp $commands;
604 chomp $files;
605 return if (!$commands && !$files);
607 my $comment="";
609 # Commands
610 for my $command (split /\s+/,$commands) {
611 $command =~ s/'//g;
612 my $description="";
613 eval { $description=`mywi-client '$command'`; } ;
614 $description = join ("<br>\n", grep(/\([18]\)/, split(/\n/, $description)));
615 $description =~ s/.*?-//;
616 next if $description =~ /^\s*$/;
618 my $query=$command." ".$Config{"keywords"};
619 $query =~ s/\ /+/g;
620 my $search= search_by("opennet",$query).
621 search_by("local",$command).
622 search_by("google",$query);
624 $comment .= "<tr><td class='note_title'>$command</td>".
625 "<td class='note_search'>$search</td>".
626 "</tr><tr><td width='100%' colspan='2' class='note_text'>".
627 "$description</td></tr><tr/>";
628 }
630 # Files
631 for my $file (split /\s+/,$files) {
632 $file =~ s@.*/@@;
633 $file =~ s/'//g;
634 next if $file =~ /^\s*$/;
635 next if $file =~ /^-/;
637 my $description=`mywi '$file'`;
638 $description = join ("<br>\n", grep(/\(5\)/, split(/\n/, $description)));
639 next if $description =~ /^\s*$/;
641 my $query=$file." ".$Config{"files_keywords"};
642 $query =~ s/\ /+/g;
643 my $search= search_by("opennet",$query).
644 search_by("local",$file).
645 search_by("google",$query);
647 $comment .= "<tr><td class='note_title'>$file</td>".
648 "<td class='note_search'>$search</td>".
649 "</tr><tr><td width='100%' colspan='2' class='note_text'>".
650 "$description</td></tr><tr/>";
651 }
654 return $comment;
655 }
657 sub printq
658 {
659 my $TO = shift;
660 my $text = join "", @_;
661 $text =~ s/&/&/g;
662 $text =~ s/</</g;
663 $text =~ s/>/>/g;
664 print $TO $text;
665 }
668 sub sort_command_lines
669 {
670 print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/;
672 # Sort Command_Lines
673 # Write Command_Lines to Command_Lines_Index
675 my @index;
676 for (my $i=0;$i<=$#Command_Lines;$i++) {
677 $index[$i]=$i;
678 }
680 @Command_Lines_Index = sort {
681 $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} ||
682 $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} ||
683 $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} ||
684 $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}
685 } @index;
687 print "...finished\n" if $Config{"verbose"} =~ /y/;
689 }
691 sub process_command_lines
692 {
693 my $lab_scripts_path = $_[0];
695 for my $i (@Command_Lines_Index) {
697 my $cl = \$Command_Lines[$i];
698 @{${$cl}->{"new_commands"}} =();
699 @{${$cl}->{"new_files"}} =();
700 $$cl->{"class"} = "";
702 if ($$cl->{"err"}) {
703 $$cl->{"class"}="wrong";
704 $$cl->{"class"}="interrupted"
705 if ($$cl->{"err"} eq 130);
706 }
707 if (!$$cl->{"euid"}) {
708 $$cl->{"class"}.="_root";
709 }
711 #tab# my @tab_words=split /\s+/, $$cl->{"output"};
712 #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/;
713 #tab# $last_word =~ s@.*/@@;
714 #tab# my $this_is_tab=1;
715 #tab#
716 #tab# if ($last_word && @tab_words >2) {
717 #tab# for my $tab_words (@tab_words) {
718 #tab# if ($tab_words !~ /^$last_word/) {
719 #tab# $this_is_tab=0;
720 #tab# last;
721 #tab# }
722 #tab# }
723 #tab# }
724 #tab# $$cl->{"class"}="tab" if $this_is_tab;
727 if ( !$$cl->{"err"}) {
728 # Command does not contain mistakes
730 my %commands = extract_from_cline("commands", ${$cl}->{"cline"});
731 my %files = extract_from_cline("files", ${$cl}->{"cline"});
733 # Searching for new commands only
734 for my $command (keys %commands) {
735 if (!defined $Commands_Stat{$command}) {
736 push @{$$cl->{new_commands}}, $command;
737 }
738 $Commands_Stat{$command}++;
739 }
741 for my $file (keys %files) {
742 if (!defined $Files_Stat{$file}) {
743 push @{$$cl->{new_files}}, $file;
744 }
745 $Files_Stat{$file}++;
746 }
747 }
748 }
750 }
753 =cut
754 Вывести результат обработки журнала.
755 =cut
758 sub print_command_lines
759 {
760 my $output_filename=$_[0];
761 my $format = $Config{"output_format"};
763 my $course_name = $Config{"course-name"};
764 my $course_code = $Config{"course-code"};
765 my $course_date = $Config{"course-date"};
766 my $course_center = $Config{"course-center"};
767 my $course_trainer = $Config{"course-trainer"};
768 my $course_student = $Config{"course-student"};
770 open(OUT, ">", $output_filename)
771 or die "Can't open $output_filename for writing\n";
775 if ($format eq "html") {
776 # vvvv HTML Header
777 print OUT <<HEADER;
778 <html>
779 <head>
780 <meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
781 <link rel='stylesheet' href='labmaker.css' type='text/css'/>
782 </head>
783 <body>
784 <script>
785 function getElementsByClassName(Class_Name)
786 {
787 var Result=new Array();
788 var All_Elements=document.all || document.getElementsByTagName('*');
789 for (i=0; i<All_Elements.length; i++)
790 if (All_Elements[i].className==Class_Name)
791 Result.push(All_Elements[i]);
792 return Result;
793 }
794 function ShowHide (name)
795 {
796 elements=getElementsByClassName(name);
797 for(i=0; i<elements.length; i++)
798 if (elements[i].style.display == "none")
799 elements[i].style.display = "";
800 else
801 elements[i].style.display = "none";
802 //if (elements[i].style.visibility == "hidden")
803 // elements[i].style.visibility = "visible";
804 //else
805 // elements[i].style.visibility = "hidden";
806 }
807 function filter_by_output(text)
808 {
810 var jjj=0;
812 elements=getElementsByClassName('command');
813 for(i=0; i<elements.length; i++) {
814 subelems = elements[i].getElementsByTagName('pre');
815 for(j=0; j<subelems.length; j++) {
816 if (subelems[j].className = 'output') {
817 var str = new String(subelems[j].nodeValue);
818 if (jjj != 1) {
819 alert(str);
820 jjj=1;
821 }
822 if (str.indexOf(text) >0)
823 subelems[j].style.display = "none";
824 else
825 subelems[j].style.display = "";
827 }
829 }
830 }
832 }
833 </script>
834 <h2>Журнал лабораторных работ</h2>
836 <p>
837 Выполнил $course_student<br/>
838 Проверил $course_trainer <br/>
839 Курс $course_name ($course_code),
840 $course_date<br/>
841 Учебный центр $course_center <br/>
842 </p>
844 <ul>
845 <li><a href='#log'>Журнал</a></li>
846 <li><a href='#stat'>Статистика</a></li>
847 <li><a href='#help'>Справка</a></li>
848 <li><a href='#about'>О программе</a></li>
849 </ul>
851 <h3 id="log">Журнал</h3>
852 HEADER
853 print OUT "<table class='visibility_form'><tr><td><form>\n";
854 for my $element (keys %Elements_Visibility)
855 {
856 my @e = split /\s+/, $element;
857 my $showhide = join "", map { "ShowHide('$_');" } @e ;
858 print OUT "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>",
859 $Elements_Visibility{$element},
860 "</input><br>\n";
861 }
862 #print OUT "<input type='text' size='10' name=\"by_command\"/>".
863 #"<input type='button' value='фильтр по командам' onclick=\"filter_by_command()\"/> <br>\n";
864 #print OUT "<input type='text' size='10' name=\"by_output\"/>".
865 #"<input type='button' value='фильтр по результату' ".
866 #"onclick=\"filter_by_output(this.form.by_output.value)\"/> <br>\n";
868 print OUT "</form></td></tr></table>\n";
869 print OUT "<table width='100%'>\n";
870 # ^^^^ HTML Header
871 }
872 else {
873 # XML Header
874 print OUT "<script>\n"
875 }
877 my $cl;
878 my $last_tty="";
879 my $last_day="";
880 my $in_range=0;
881 for my $i (@Command_Lines_Index) {
884 $cl = $Command_Lines[$i];
886 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
887 $in_range=1;
888 next;
889 }
890 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
891 $in_range=0;
892 next;
893 }
894 next if ($Config{"from"} && $Config{"to"} && !$in_range)
895 ||
896 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
897 ||
898 ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
899 ||
900 ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
902 my @new_commands=@{$cl->{"new_commands"}};
903 my @new_files=@{$cl->{"new_files"}};
905 my $cl_class="cline";
906 my $out_class="output";
907 if ($cl->{"class"}) {
908 $cl_class = $cl->{"class"}."_".$cl_class;
909 $out_class = $cl->{"class"}."_".$out_class;
910 }
912 my $output="";
913 if ($Config{"head_lines"} || $Config{"tail_lines"}) {
914 # Partialy output
915 my @lines = split '\n', $cl->{"output"};
916 # head
917 my $mark=1;
918 for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
919 $output .= $lines[$i]."\n";
920 }
921 # tail
922 my $start=$#lines-$Config{"tail_lines"}+1;
923 if ($start < 0) {
924 $start=0;
925 $mark=0;
926 }
927 if ($start < $Config{"head_lines"}) {
928 $start=$Config{"head_lines"};
929 $mark=0;
930 }
931 $output .= $Config{"skip_text"}."\n" if $mark;
932 for (my $i=$start; $i<= $#lines; $i++) {
933 $output .= $lines[$i]."\n";
934 }
935 }
936 else {
937 # Full output
938 $output .= $cl->{"output"};
939 }
940 $output .= "^C\n" if ($cl->{"err"} eq "130");
943 # Printing out
945 # <command>
946 print OUT $format eq "html"
947 ? "<tr class='command'>\n"
948 : "\n<action time='$cl->{hour}:$cl->{min}:$cl->{sec}' tty='$cl->{tty}'>\n";
951 if ($format eq "html") {
953 # DAY CHANGE
954 if ( $last_day ne $cl->{"day"}) {
955 print OUT "<td colspan='6'><p></p><h3>День ",$cl->{"day"},"</h4></td></tr><tr>";
956 $last_day=$cl->{"day"};
957 }
959 # CONSOLE CHANGE
960 if ( $last_tty ne $cl->{"tty"}) {
961 print OUT "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>",$cl->{"tty"},"</td><td/></tr></table></td></tr><tr>";
962 $last_tty=$cl->{"tty"};
963 }
965 # TIME
966 if ($Config{"show_time"} =~ /^y/i) {
967 print OUT "<td valign='top' class='time' width='$Config{time_width}'><pre>",
968 $cl->{"hour"}, ":", $cl->{"min"}, ":", $cl->{"sec"},
969 "</td>";
970 } else {
971 print OUT "<td width='0'/>"
972 }
973 }
975 # COMMAND
978 if ($format eq "html") {
979 print OUT "<td class='script'>\n";
980 print OUT "<pre class='$cl_class'>\n";
981 my $cline = $cl->{"cline"};
982 $cline =~ s/\n//;
983 printq(\*OUT,$cl->{"prompt"},$cl->{"cline"});
984 # printq(\*OUT,"(sudo ".$cl->{"last_command"}.")\n") if !$cl->{"euid"};
985 print OUT "</pre>\n";
986 }
987 else {
988 print OUT "<line class='$cl_class'>\n";
989 print OUT "<prompt>";
990 printq(\*OUT,$cl->{"prompt"});
991 print OUT "</prompt>";
992 print OUT "<command>";
993 printq(\*OUT,$cl->{"cline"});
994 print OUT "</command>";
995 print OUT "\n</line>\n";
996 }
998 my $last_command = $cl->{"last_command"};
999 if (!(
1000 $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
1001 $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
1002 $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
1003 )) {
1005 if ($format eq "html") {
1006 print OUT "<pre class='$out_class'>";
1007 printq(\*OUT,$output);
1008 print OUT "</pre>\n";
1009 }
1010 else {
1011 print OUT "<output class='$out_class'>\n";
1012 printq(\*OUT,$output);
1013 print OUT "</output>\n";
1014 }
1015 }
1017 # DIFF
1018 if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
1019 if ($format eq "html") {
1020 #print Dumper(%{$cl->{"diff"}});
1021 print OUT "<table><tr><td width='5'/><td class='diff'><pre>";
1022 printq(\*OUT,${$Diffs[$cl->{"diff"}]}{"text"});
1023 print OUT "</pre></td></tr></table>";
1024 }
1025 else {
1026 print OUT "<diff>\n";
1027 printq(\*OUT,${$Diffs[$cl->{"diff"}]}{"text"});
1028 print OUT "</diff>\n";
1029 }
1030 }
1032 # COMMENT
1033 if ( $Config{"show_comments"} =~ /^y/i) {
1034 my $comment = make_comment(join(" ",@new_commands), join (" ",@new_files));
1035 if ($comment) {
1036 if ($format eq "html") {
1037 print OUT "<table width='$Config{comment_width}'>".
1038 "<tr><td width='5'/><td>";
1039 print OUT "<table class='note' width='100%'>";
1040 print OUT $comment;
1041 print OUT "</table>\n";
1042 print OUT "</td></tr></table>";
1043 }
1044 # else {
1045 # print OUT "<comment>";
1046 # printq(\*OUT,$comment);
1047 # print OUT "</comment>";
1048 # }
1049 }
1050 }
1052 if ($format eq "html") {
1053 print OUT "</td>\n";
1054 print OUT "</tr>\n";
1055 }
1056 else {
1057 print OUT "</action>\n";
1058 }
1060 }
1061 if ($format eq "html") {
1062 print OUT "</table>\n";
1064 print OUT "<hr/>";
1065 print OUT "<h3 id='stat'>Статистика</h4>";
1066 print OUT "Статистическая информация о журнале<br/>";
1067 print OUT "<hr/>";
1068 print OUT "<h3 id='help'>Справка</h4>";
1069 print OUT "$Html_Help<br/>";
1070 print OUT "<hr/>";
1071 print OUT "<h3 a='about'>О программе</h4>";
1072 print OUT "$Html_About";
1073 print OUT "</body>\n";
1074 print OUT "</html>\n";
1075 }
1076 else {
1077 print OUT "</script>\n";
1078 }
1079 close(OUT);
1080 }
1082 sub read_config_file
1083 {
1084 my $config = $_[0];
1085 my $filename = $_[1];
1086 open(CONFIG, "$filename")
1087 or return;
1088 while (<CONFIG>) {
1089 s/#.*//;
1090 next if /^\s*$/;
1091 my ($var, $val) = split /\s*=\s*/, $_, 2;
1092 $var =~ s/\s*//;
1093 $config->{$var} = $val;
1094 }
1095 close(CONFIG);
1096 }
1099 sub print_command_lines2
1100 {
1101 my $output_filename=$_[0];
1102 open(OUT, ">", $output_filename)
1103 or die "Can't open $output_filename for writing\n";
1106 print OUT <<OUT;
1107 <log>
1108 OUT
1110 my $cl;
1111 for my $i (@Command_Lines_Index) {
1114 $cl = $Command_Lines[$i];
1117 # Printing out
1118 print OUT <<OUT;
1119 <command>
1120 <day>$cl->{day}</day>
1121 <hour>$cl->{hour}</hour>
1122 <min>$cl->{min}</min>
1123 <sec>$cl->{sec}</sec>
1124 <tty>$cl->{tty}</tty>
1125 <uid>$cl->{uid}</uid>
1126 <euid>$cl->{euid}</euid>
1127 <prompt>$cl->{prompt}</prompt>
1128 <cline>$cl->{cline}</cline>
1129 <status>$cl->{err}</cline>
1130 <output>
1131 $cl->{output}</output>
1132 </command>
1133 OUT
1134 }
1136 for my $diff (@Diffs) {
1138 print OUT <<OUT;
1139 <diff>
1140 <path>$diff->{path}</path>
1141 <uid>$diff->{uid}</uid>
1142 <day>$diff->{day}</day>
1143 <hour>$diff->{hour}</hour>
1144 <min>$diff->{min}</min>
1145 <sec>$diff->{sec}</sec>
1146 <text>
1147 $diff->{text}</text>
1148 </diff>
1149 OUT
1150 }
1152 print OUT <<OUT;
1153 </log>
1154 OUT
1155 }
1158 $| = 1;
1160 my %file_config;
1161 my %argv_config;
1162 init_variables;
1163 read_config_file(\%file_config, $Config_File);
1164 GetOptions(\%argv_config, map "$_=s", keys %Config);
1165 %Config = (%Config, %file_config, %argv_config);
1167 my $i=0;
1169 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"}))
1170 {
1171 load_diff_files($lab_log);
1172 }
1174 for my $lab_log (split /\s+/, $Config{"input"})
1175 {
1176 my $tofile=$Config{"output"};
1177 $tofile =~ s/$Config{"output_mask"}/$i/;
1178 #load_diff_files($lab_log);
1179 load_command_lines($lab_log, $Config{"input_mask"});
1180 sort_command_lines;
1181 process_command_lines($lab_log);
1182 print_command_lines($tofile);
1183 $i++;
1184 }