lilalo
view lm-report @ 20:6cabb6a4b4f5
Изменена информация о копирайте.
Теперь список лет расширен с 2004 до 2004-2005
Теперь список лет расширен с 2004 до 2004-2005
| author | devi |
|---|---|
| date | Fri Sep 23 12:10:34 2005 +0300 (2005-09-23) |
| parents | e2f1de29a491 |
| children | ab8d2a28fc86 |
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 || "";
322 # Parse new command
323 $cl{"uid"} = $2;
324 $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0
325 $cl{"pid"} = $3;
326 $cl{"day"} = $4;
327 $cl{"lab"} = $5;
328 $cl{"hour"} = $6;
329 $cl{"min"} = $7;
330 $cl{"sec"} = $8;
331 $cl{"fullprompt"} = $9;
332 $cl{"prompt"} = $10;
333 $cl{"raw_cline"} = $11;
335 $cl{"err"} = 0;
336 $cl{"output"} = "";
337 $cl{"tty"} = $tty;
339 $cline_vt->process($cl{"raw_cline"}."\n");
340 $cl{"cline"} = $cline_vt->row_plaintext (1);
341 $cl{"cline"} =~ s/\s*$//;
342 $cline_vt->reset();
344 my %commands = extract_from_cline("commands", $cl{"cline"});
345 $cl{"euid"}=0 if defined $commands{"sudo"};
346 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;
347 $cl{"last_command"} = $comms[$#comms] || "";
349 if (
350 $Config{"suppress_editors"} =~ /^y/i
351 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) ||
352 $Config{"suppress_pagers"} =~ /^y/i
353 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) ||
354 $Config{"suppress_terminal"}=~ /^y/i
355 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})
356 ) {
357 $cl{"suppress_output"} = "1";
358 }
359 else {
360 $cl{"suppress_output"} = "0";
362 }
363 $skip_info = 0;
366 print " ",$cl{"last_command"};
368 # Processing previous command line
369 if ($first_pass) {
370 $first_pass = 0;
371 next;
372 }
374 # Error code
375 $last_cl{"err"}=$err;
376 $last_cl{"err"}=130 if $err eq "^C";
378 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {
379 bind_diff(\%last_cl);
380 }
382 # Output
383 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {
384 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {
385 my $line= $vt->row_plaintext($i);
386 next if !defined ($line) || $line =~ /^\s*$/;
387 $line =~ s/\s*$//;
388 $last_cl{"output"} .= $line."\n";
389 }
390 }
391 else {
392 $last_cl{"output"}= "";
393 }
395 $vt->reset();
398 # Classifying the command line
401 # Save
402 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {
403 # Changing encoding
404 for (keys %last_cl) {
405 $last_cl{$_} = $converter->convert($last_cl{$_})
406 if ($Config{"encoding"} &&
407 $Config{"encoding"} !~ /^utf-8$/i);
408 }
409 push @Command_Lines, \%last_cl;
410 }
411 next;
412 }
413 $last_output_length+=length($_);
414 #if (!$cl{"suppress_output"} || $last_output_length < 5000) {
415 if ($last_output_length < 50000) {
416 #print "(",length($_),")" if (length($_) > 2000) ;
417 $vt->process("$_"."\n")
418 }
419 else
420 {
421 if (!$skip_info) {
422 print "($cl{last_command})";
423 $skip_info = 1;
424 }
425 }
426 }
427 close(FILE);
429 }
430 if ($Config{"verbose"} =~ /y/) {
431 print "...finished." ;
432 print "Lines loaded: $commandlines_processed\n";
433 print "Command lines: $commandlines_loaded\n";
434 }
435 }
437 sub search_by
438 {
439 my $sm = shift;
440 my $topic = shift;
441 $topic =~ s/ /+/;
443 return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='".
444 $Search_Machines{$sm}->{"icon"}."' border='0'/></a>";
445 }
447 sub make_comment
448 {
449 my $commands = $_[0];
450 my $files = $_[1];
451 chomp $commands;
452 chomp $files;
453 return if (!$commands && !$files);
455 my $comment="";
457 # Commands
458 for my $command (split /\s+/,$commands) {
459 $command =~ s/'//g;
460 my $description="";
461 eval { $description=`mywi-client '$command'`; } ;
462 $description = join ("<br>\n", grep(/\([18]\)/, split(/\n/, $description)));
463 $description =~ s/.*?-//;
464 next if $description =~ /^\s*$/;
466 my $query=$command." ".$Config{"keywords"};
467 $query =~ s/\ /+/g;
468 my $search= search_by("opennet",$query).
469 search_by("local",$command).
470 search_by("google",$query);
472 $comment .= "<tr><td class='note_title'>$command</td>".
473 "<td class='note_search'>$search</td>".
474 "</tr><tr><td width='100%' colspan='2' class='note_text'>".
475 "$description</td></tr><tr/>";
476 }
478 # Files
479 for my $file (split /\s+/,$files) {
480 $file =~ s@.*/@@;
481 $file =~ s/'//g;
482 next if $file =~ /^\s*$/;
483 next if $file =~ /^-/;
485 my $description=`mywi '$file'`;
486 $description = join ("<br>\n", grep(/\(5\)/, split(/\n/, $description)));
487 next if $description =~ /^\s*$/;
489 my $query=$file." ".$Config{"files_keywords"};
490 $query =~ s/\ /+/g;
491 my $search= search_by("opennet",$query).
492 search_by("local",$file).
493 search_by("google",$query);
495 $comment .= "<tr><td class='note_title'>$file</td>".
496 "<td class='note_search'>$search</td>".
497 "</tr><tr><td width='100%' colspan='2' class='note_text'>".
498 "$description</td></tr><tr/>";
499 }
502 return $comment;
503 }
505 sub printq
506 {
507 my $TO = shift;
508 my $text = join "", @_;
509 $text =~ s/&/&/g;
510 $text =~ s/</</g;
511 $text =~ s/>/>/g;
512 print $TO $text;
513 }
516 sub sort_command_lines
517 {
518 print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/;
520 # Sort Command_Lines
521 # Write Command_Lines to Command_Lines_Index
523 my @index;
524 for (my $i=0;$i<=$#Command_Lines;$i++) {
525 $index[$i]=$i;
526 }
528 @Command_Lines_Index = sort {
529 $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} ||
530 $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} ||
531 $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} ||
532 $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}
533 } @index;
535 print "...finished\n" if $Config{"verbose"} =~ /y/;
537 }
539 sub process_command_lines
540 {
541 my $lab_scripts_path = $_[0];
543 for my $i (@Command_Lines_Index) {
545 my $cl = \$Command_Lines[$i];
546 @{${$cl}->{"new_commands"}} =();
547 @{${$cl}->{"new_files"}} =();
548 $$cl->{"class"} = "";
550 if ($$cl->{"err"}) {
551 $$cl->{"class"}="wrong";
552 $$cl->{"class"}="interrupted"
553 if ($$cl->{"err"} eq 130);
554 }
555 if (!$$cl->{"euid"}) {
556 $$cl->{"class"}.="_root";
557 }
559 #tab# my @tab_words=split /\s+/, $$cl->{"output"};
560 #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/;
561 #tab# $last_word =~ s@.*/@@;
562 #tab# my $this_is_tab=1;
563 #tab#
564 #tab# if ($last_word && @tab_words >2) {
565 #tab# for my $tab_words (@tab_words) {
566 #tab# if ($tab_words !~ /^$last_word/) {
567 #tab# $this_is_tab=0;
568 #tab# last;
569 #tab# }
570 #tab# }
571 #tab# }
572 #tab# $$cl->{"class"}="tab" if $this_is_tab;
575 if ( !$$cl->{"err"}) {
576 # Command does not contain mistakes
578 my %commands = extract_from_cline("commands", ${$cl}->{"cline"});
579 my %files = extract_from_cline("files", ${$cl}->{"cline"});
581 # Searching for new commands only
582 for my $command (keys %commands) {
583 if (!defined $Commands_Stat{$command}) {
584 push @{$$cl->{new_commands}}, $command;
585 }
586 $Commands_Stat{$command}++;
587 }
589 for my $file (keys %files) {
590 if (!defined $Files_Stat{$file}) {
591 push @{$$cl->{new_files}}, $file;
592 }
593 $Files_Stat{$file}++;
594 }
595 }
596 }
598 }
601 =cut
602 Вывести результат обработки журнала.
603 =cut
606 sub print_command_lines
607 {
608 my $output_filename=$_[0];
609 my $format = $Config{"output_format"};
611 my $course_name = $Config{"course-name"};
612 my $course_code = $Config{"course-code"};
613 my $course_date = $Config{"course-date"};
614 my $course_center = $Config{"course-center"};
615 my $course_trainer = $Config{"course-trainer"};
616 my $course_student = $Config{"course-student"};
618 open(OUT, ">", $output_filename)
619 or die "Can't open $output_filename for writing\n";
623 if ($format eq "html") {
624 # vvvv HTML Header
625 print OUT <<HEADER;
626 <html>
627 <head>
628 <meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
629 <link rel='stylesheet' href='labmaker.css' type='text/css'/>
630 </head>
631 <body>
632 <script>
633 function getElementsByClassName(Class_Name)
634 {
635 var Result=new Array();
636 var All_Elements=document.all || document.getElementsByTagName('*');
637 for (i=0; i<All_Elements.length; i++)
638 if (All_Elements[i].className==Class_Name)
639 Result.push(All_Elements[i]);
640 return Result;
641 }
642 function ShowHide (name)
643 {
644 elements=getElementsByClassName(name);
645 for(i=0; i<elements.length; i++)
646 if (elements[i].style.display == "none")
647 elements[i].style.display = "";
648 else
649 elements[i].style.display = "none";
650 //if (elements[i].style.visibility == "hidden")
651 // elements[i].style.visibility = "visible";
652 //else
653 // elements[i].style.visibility = "hidden";
654 }
655 function filter_by_output(text)
656 {
658 var jjj=0;
660 elements=getElementsByClassName('command');
661 for(i=0; i<elements.length; i++) {
662 subelems = elements[i].getElementsByTagName('pre');
663 for(j=0; j<subelems.length; j++) {
664 if (subelems[j].className = 'output') {
665 var str = new String(subelems[j].nodeValue);
666 if (jjj != 1) {
667 alert(str);
668 jjj=1;
669 }
670 if (str.indexOf(text) >0)
671 subelems[j].style.display = "none";
672 else
673 subelems[j].style.display = "";
675 }
677 }
678 }
680 }
681 </script>
682 <h2>Журнал лабораторных работ</h2>
684 <p>
685 Выполнил $course_student<br/>
686 Проверил $course_trainer <br/>
687 Курс $course_name ($course_code),
688 $course_date<br/>
689 Учебный центр $course_center <br/>
690 </p>
692 <ul>
693 <li><a href='#log'>Журнал</a></li>
694 <li><a href='#stat'>Статистика</a></li>
695 <li><a href='#help'>Справка</a></li>
696 <li><a href='#about'>О программе</a></li>
697 </ul>
699 <h3 id="log">Журнал</h3>
700 HEADER
701 print OUT "<table class='visibility_form'><tr><td><form>\n";
702 for my $element (keys %Elements_Visibility)
703 {
704 my @e = split /\s+/, $element;
705 my $showhide = join "", map { "ShowHide('$_');" } @e ;
706 print OUT "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>",
707 $Elements_Visibility{$element},
708 "</input><br>\n";
709 }
710 #print OUT "<input type='text' size='10' name=\"by_command\"/>".
711 #"<input type='button' value='фильтр по командам' onclick=\"filter_by_command()\"/> <br>\n";
712 #print OUT "<input type='text' size='10' name=\"by_output\"/>".
713 #"<input type='button' value='фильтр по результату' ".
714 #"onclick=\"filter_by_output(this.form.by_output.value)\"/> <br>\n";
716 print OUT "</form></td></tr></table>\n";
717 print OUT "<table width='100%'>\n";
718 # ^^^^ HTML Header
719 }
720 else {
721 # XML Header
722 print OUT "<script>\n"
723 }
725 my $cl;
726 my $last_tty="";
727 my $last_day="";
728 my $in_range=0;
729 for my $i (@Command_Lines_Index) {
732 $cl = $Command_Lines[$i];
734 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
735 $in_range=1;
736 next;
737 }
738 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
739 $in_range=0;
740 next;
741 }
742 next if ($Config{"from"} && $Config{"to"} && !$in_range)
743 ||
744 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
745 ||
746 ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
747 ||
748 ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
750 my @new_commands=@{$cl->{"new_commands"}};
751 my @new_files=@{$cl->{"new_files"}};
753 my $cl_class="cline";
754 my $out_class="output";
755 if ($cl->{"class"}) {
756 $cl_class = $cl->{"class"}."_".$cl_class;
757 $out_class = $cl->{"class"}."_".$out_class;
758 }
760 my $output="";
761 if ($Config{"head_lines"} || $Config{"tail_lines"}) {
762 # Partialy output
763 my @lines = split '\n', $cl->{"output"};
764 # head
765 my $mark=1;
766 for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
767 $output .= $lines[$i]."\n";
768 }
769 # tail
770 my $start=$#lines-$Config{"tail_lines"}+1;
771 if ($start < 0) {
772 $start=0;
773 $mark=0;
774 }
775 if ($start < $Config{"head_lines"}) {
776 $start=$Config{"head_lines"};
777 $mark=0;
778 }
779 $output .= $Config{"skip_text"}."\n" if $mark;
780 for (my $i=$start; $i<= $#lines; $i++) {
781 $output .= $lines[$i]."\n";
782 }
783 }
784 else {
785 # Full output
786 $output .= $cl->{"output"};
787 }
788 $output .= "^C\n" if ($cl->{"err"} eq "130");
791 # Printing out
793 # <command>
794 print OUT $format eq "html"
795 ? "<tr class='command'>\n"
796 : "\n<action time='$cl->{hour}:$cl->{min}:$cl->{sec}' tty='$cl->{tty}'>\n";
799 if ($format eq "html") {
801 # DAY CHANGE
802 if ( $last_day ne $cl->{"day"}) {
803 print OUT "<td colspan='6'><p></p><h3>День ",$cl->{"day"},"</h4></td></tr><tr>";
804 $last_day=$cl->{"day"};
805 }
807 # CONSOLE CHANGE
808 if ( $last_tty ne $cl->{"tty"}) {
809 print OUT "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>",$cl->{"tty"},"</td><td/></tr></table></td></tr><tr>";
810 $last_tty=$cl->{"tty"};
811 }
813 # TIME
814 if ($Config{"show_time"} =~ /^y/i) {
815 print OUT "<td valign='top' class='time' width='$Config{time_width}'><pre>",
816 $cl->{"hour"}, ":", $cl->{"min"}, ":", $cl->{"sec"},
817 "</td>";
818 } else {
819 print OUT "<td width='0'/>"
820 }
821 }
823 # COMMAND
826 if ($format eq "html") {
827 print OUT "<td class='script'>\n";
828 print OUT "<pre class='$cl_class'>\n";
829 my $cline = $cl->{"cline"};
830 $cline =~ s/\n//;
831 printq(\*OUT,$cl->{"prompt"},$cl->{"cline"});
832 # printq(\*OUT,"(sudo ".$cl->{"last_command"}.")\n") if !$cl->{"euid"};
833 print OUT "</pre>\n";
834 }
835 else {
836 print OUT "<line class='$cl_class'>\n";
837 print OUT "<prompt>";
838 printq(\*OUT,$cl->{"prompt"});
839 print OUT "</prompt>";
840 print OUT "<command>";
841 printq(\*OUT,$cl->{"cline"});
842 print OUT "</command>";
843 print OUT "\n</line>\n";
844 }
846 my $last_command = $cl->{"last_command"};
847 if (!(
848 $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
849 $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
850 $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
851 )) {
853 if ($format eq "html") {
854 print OUT "<pre class='$out_class'>";
855 printq(\*OUT,$output);
856 print OUT "</pre>\n";
857 }
858 else {
859 print OUT "<output class='$out_class'>\n";
860 printq(\*OUT,$output);
861 print OUT "</output>\n";
862 }
863 }
865 # DIFF
866 if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
867 if ($format eq "html") {
868 #print Dumper(%{$cl->{"diff"}});
869 print OUT "<table><tr><td width='5'/><td class='diff'><pre>";
870 printq(\*OUT,${$Diffs[$cl->{"diff"}]}{"text"});
871 print OUT "</pre></td></tr></table>";
872 }
873 else {
874 print OUT "<diff>\n";
875 printq(\*OUT,${$Diffs[$cl->{"diff"}]}{"text"});
876 print OUT "</diff>\n";
877 }
878 }
880 # COMMENT
881 if ( $Config{"show_comments"} =~ /^y/i) {
882 my $comment = make_comment(join(" ",@new_commands), join (" ",@new_files));
883 if ($comment) {
884 if ($format eq "html") {
885 print OUT "<table width='$Config{comment_width}'>".
886 "<tr><td width='5'/><td>";
887 print OUT "<table class='note' width='100%'>";
888 print OUT $comment;
889 print OUT "</table>\n";
890 print OUT "</td></tr></table>";
891 }
892 # else {
893 # print OUT "<comment>";
894 # printq(\*OUT,$comment);
895 # print OUT "</comment>";
896 # }
897 }
898 }
900 if ($format eq "html") {
901 print OUT "</td>\n";
902 print OUT "</tr>\n";
903 }
904 else {
905 print OUT "</action>\n";
906 }
908 }
909 if ($format eq "html") {
910 print OUT "</table>\n";
912 print OUT "<hr/>";
913 print OUT "<h3 id='stat'>Статистика</h4>";
914 print OUT "Статистическая информация о журнале<br/>";
915 print OUT "<hr/>";
916 print OUT "<h3 id='help'>Справка</h4>";
917 print OUT "$Html_Help<br/>";
918 print OUT "<hr/>";
919 print OUT "<h3 a='about'>О программе</h4>";
920 print OUT "$Html_About";
921 print OUT "</body>\n";
922 print OUT "</html>\n";
923 }
924 else {
925 print OUT "</script>\n";
926 }
927 close(OUT);
928 }
930 sub read_config_file
931 {
932 my $config = $_[0];
933 my $filename = $_[1];
934 open(CONFIG, "$filename")
935 or return;
936 while (<CONFIG>) {
937 s/#.*//;
938 next if /^\s*$/;
939 my ($var, $val) = split /\s*=\s*/, $_, 2;
940 $var =~ s/\s*//;
941 $config->{$var} = $val;
942 }
943 close(CONFIG);
944 }
947 sub print_command_lines2
948 {
949 my $output_filename=$_[0];
950 open(OUT, ">", $output_filename)
951 or die "Can't open $output_filename for writing\n";
954 print OUT <<OUT;
955 <log>
956 OUT
958 my $cl;
959 for my $i (@Command_Lines_Index) {
962 $cl = $Command_Lines[$i];
965 # Printing out
966 print OUT <<OUT;
967 <command>
968 <day>$cl->{day}</day>
969 <hour>$cl->{hour}</hour>
970 <min>$cl->{min}</min>
971 <sec>$cl->{sec}</sec>
972 <tty>$cl->{tty}</tty>
973 <uid>$cl->{uid}</uid>
974 <euid>$cl->{euid}</euid>
975 <prompt>$cl->{prompt}</prompt>
976 <cline>$cl->{cline}</cline>
977 <status>$cl->{err}</cline>
978 <output>
979 $cl->{output}</output>
980 </command>
981 OUT
982 }
984 for my $diff (@Diffs) {
986 print OUT <<OUT;
987 <diff>
988 <path>$diff->{path}</path>
989 <uid>$diff->{uid}</uid>
990 <day>$diff->{day}</day>
991 <hour>$diff->{hour}</hour>
992 <min>$diff->{min}</min>
993 <sec>$diff->{sec}</sec>
994 <text>
995 $diff->{text}</text>
996 </diff>
997 OUT
998 }
1000 print OUT <<OUT;
1001 </log>
1002 OUT
1003 }
1006 $| = 1;
1008 my %file_config;
1009 my %argv_config;
1010 init_variables;
1011 read_config_file(\%file_config, $Config_File);
1012 GetOptions(\%argv_config, map "$_=s", keys %Config);
1013 %Config = (%Config, %file_config, %argv_config);
1015 my $i=0;
1017 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"}))
1018 {
1019 load_diff_files($lab_log);
1020 }
1022 for my $lab_log (split /\s+/, $Config{"input"})
1023 {
1024 my $tofile=$Config{"output"};
1025 $tofile =~ s/$Config{"output_mask"}/$i/;
1026 #load_diff_files($lab_log);
1027 load_command_lines($lab_log, $Config{"input_mask"});
1028 sort_command_lines;
1029 process_command_lines($lab_log);
1030 print_command_lines($tofile);
1031 $i++;
1032 }
1035 sub init_variables
1036 {
1037 $Html_Help = <<HELP;
1038 Справка по использованию журнала
1039 HELP
1041 $Html_About = <<ABOUT;
1042 <p>
1043 LiLaLo (L3) расшифровывается как Live Lab Log.<br/>
1044 Программа разработана для повышения эффективности обучения<br/>
1045 Unix/Linux-системам.<br/>
1046 (c) Игорь Чубин, 2004-2005<br/>
1047 </p>
1048 ABOUT
1049 $Html_About.='$Id$ </p>';
1050 }