lilalo
view l3-frontend @ 49:d021553f4e98
Tabs expanded
| author | devi | 
|---|---|
| date | Sun Dec 04 18:44:21 2005 +0200 (2005-12-04) | 
| parents | 568bab7090fc | 
| children | f9447da96f15 | 
 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             };  
   105         }
   106     }
   108     if ($what eq "commands") {
   109         return \%commands;
   110     } else {
   111         return \%args;
   112     }
   114 }
   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 }
   125 sub close_mywi_socket
   126 {
   127     close ($Mywi_Socket);
   128 }
   131 sub mywi_client
   132 {
   133     my $query = $_[0];
   134     my $mywi;
   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 }
   148 sub make_comment
   149 {
   150     my $cline = $_[0];
   151     #my $files = $_[1];
   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);
   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         }
   176         push @comments, $Commands_Description{$command};
   177     }
   178     return join("
\n", @comments);
   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         }
   196         push @comments, $Args_Description{$arg};
   197     }
   199 }
   201 =cut
   202 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
   203 из XML-документа в переменную @Command_Lines
   205 Предупреждение!
   206 Процедура не в состоянии обрабатывать XML-документ любой структуры.
   207 В действительности файл cache из которого загружаются данные 
   208 просто напоминает XML с виду.
   209 =cut
   210 sub load_command_lines_from_xml
   211 {
   212     my $datafile = $_[0];
   214     open (CLASS, $datafile)
   215         or die "Can't open file of the class ",$datafile,"\n";
   216     local $/;
   217     $data = <CLASS>;
   218     close(CLASS);
   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 }
   229 sub load_sessions_from_xml
   230 {
   231     my $datafile = $_[0];
   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);
   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 }
   250 sub sort_command_lines
   251 {
   252     # Sort Command_Lines
   253     # Write Command_Lines to Command_Lines_Index
   255     my @index;
   256     for (my $i=0;$i<=$#Command_Lines;$i++) {
   257         $index[$i]=$i;
   258     }
   260     @Command_Lines_Index = sort {
   261         $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}
   262     } @index;
   264 }
   266 sub process_command_lines
   267 {
   268     for my $i (@Command_Lines_Index) {
   270         my $cl = \$Command_Lines[$i];
   271         #@{${$cl}->{"new_commands"}} =();
   272         #@{${$cl}->{"new_files"}} =();
   273         $$cl->{"class"} = ""; 
   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         }
   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;
   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 #       }   
   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     }   
   364 }
   367 =cut
   368 Процедура print_command_lines выводит HTML-представление
   369 разобранного lab-скрипта. 
   371 Разобранный lab-скрипт должен находиться в массиве @Command_Lines
   372 =cut
   374 sub print_command_lines
   375 {
   376     my $output_filename=$_[0];
   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"};
   386     # Результат выполнения процедуры равен 
   387     # join("", @Result{header,body,stat,help,about,footer})
   388     my %Result;
   389     my @toc;  # Хранит оглавление
   390     my $note_number=0;
   392     $Result{"body"} = "<table width='100%'>\n";
   394     my $cl;
   395     my $last_tty="";
   396     my $last_day="";
   397     my $in_range=0;
   399     my $current_command=0;
   401 COMMAND_LINE:
   402     for my $k (@Command_Lines_Index) {
   404         my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
   406         next unless $cl;
   409         if ($Config{filter}) {
   410             # Инициализация фильтра
   411             my %filter;
   412             for (split /&/,$Config{filter}) {
   413                 my ($var, $val) = split /=/;
   414                 $filter{$var} = $val || "";
   415             }
   417             for my $filter_key (keys %filter) {
   418                 next COMMAND_LINE unless (
   419                     not defined($cl->{local_session_id}) 
   420                     || not defined($Sessions{$cl->{local_session_id}}->{$filter_key}) 
   421                     || $Sessions{$cl->{local_session_id}}->{$filter_key} eq $filter{$filter_key});
   422             }
   424             #if ($filter{user}) {
   425             #   next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{user} eq $filter{user};
   426             #}
   428             #for my $filter_field (keys %filter) {
   429             #   next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_field} eq $filter{$filter_field};
   430             #}
   431         }
   433         if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
   434             $in_range=1;
   435             next;
   436         }
   437         if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
   438             $in_range=0;
   439             next;
   440         }
   441         next if ($Config{"from"} && $Config{"to"} && !$in_range) 
   442             ||
   443                 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
   444             ||
   445             ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
   446             ||
   447             ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
   449         #my @new_commands=@{$cl->{"new_commands"}};
   450         #my @new_files=@{$cl->{"new_files"}};
   452         if ($cl->{class} eq "note") {
   453             my $note = $cl->{note};
   454             $note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note)));
   455             $note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   456             $note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   457             $Result{"body"} .= "<tr><td colspan='6'>";
   458             $Result{"body"} .= "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title};
   459             $Result{"body"} .= "".$note."<p/><p/></td></td>";
   461             if ($cl->{note_title}) {
   462                 push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";
   463                 $note_number++;
   464             }
   465             next;
   466         }
   468         my $cl_class="cline";
   469         my $out_class="output";
   470         if ($cl->{"class"}) {
   471             $cl_class = $cl->{"class"}."_".$cl_class;
   472             $out_class = $cl->{"class"}."_".$out_class;
   473         }
   475         my @new_commands;
   476         my @new_files;
   477         @new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"};
   478         @new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"};
   480         my $output="";
   481         if ($Config{"head_lines"} || $Config{"tail_lines"}) {
   482             # Partialy output
   483             my @lines = split '\n', $cl->{"output"};
   484             # head
   485             my $mark=1;
   486             for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
   487                 $output .= $lines[$i]."\n";
   488             }
   489             # tail
   490             my $start=$#lines-$Config{"tail_lines"}+1;
   491             if ($start < 0) {
   492                 $start=0;
   493                 $mark=0;
   494             }   
   495             if ($start < $Config{"head_lines"}) {
   496                 $start=$Config{"head_lines"};
   497                 $mark=0;
   498             }   
   499             $output .= $Config{"skip_text"}."\n" if $mark;
   500             for ($i=$start; $i<= $#lines; $i++) {
   501                 $output .= $lines[$i]."\n";
   502             }
   503         } 
   504         else {
   505             # Full output
   506             $output .= $cl->{"output"};
   507         }   
   508         #$output .= "^C\n" if ($cl->{"err"} eq "130");
   510         #
   511         ##
   512         ## Начинается собственно вывод
   513         ##
   514         #
   516         # <command>
   518         my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
   519         next if $Stat{LastCommand} == $cl->{time};
   520         $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};
   521         $Stat{LastCommand} = 0 unless defined $Stat{LastCommand};   
   522         $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}
   523             if $cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval};
   524         $Stat{LastCommand} = $cl->{time};
   525         $Stat{TotalCommands} = 0 unless $Stat{TotalCommands};
   526         $Stat{TotalCommands}++;
   528         # Добавляем спереди 0 для удобочитаемости
   529         $min = "0".$min if $min =~ /^.$/;
   530         $hour = "0".$hour if $hour =~ /^.$/;
   531         $sec = "0".$sec if $sec =~ /^.$/;
   533         $class=$cl->{"out_class"};
   534         $class =~ s/output$//;
   536         $Stat{ErrorCommands}++
   537             if $class =~ /wrong/;
   539         $Result{"body"} .= "<tr class='command'>\n";
   542         # DAY CHANGE
   543         if ( $last_day ne $day) {
   544             #$Result{"body"} .= "<td colspan='6'><p></p><h3>День ",$day,"</h4></td></tr><tr>";
   545             $Result{"body"} .= "<td colspan='6'><p></p><h3 id='day$day'>".$Day_Name[$wday]."</h4></td></tr><tr>";
   546             push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
   547             $last_day=$day;
   548         }
   550         # CONSOLE CHANGE
   551         if ( $last_tty ne $cl->{"tty"}) {
   552             my $host;
   553             #$host = $Sessions{$cl->{local_session_id}}->{user}."@".$Sessions{$cl->{local_session_id}}->{hostname};
   554             my $body = $cl->{"tty"};
   555             $body .= " \@$host" if $host;
   556             $Result{"body"} .= "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>".$body."</td></tr></table></td></tr><tr>";
   557             $last_tty=$cl->{"tty"};
   558         }
   560         # TIME
   561         if ($Config{"show_time"} =~ /^y/i) {
   562             $Result{"body"} .= "<td valign='top' class='time' width='$Config{time_width}'><pre>".
   563                 $hour. ":". $min. ":". $sec.
   564                 "</td>";
   565         } else {
   566             $Result{"body"} .= "<td width='0'/>"
   567         }
   569         # COMMAND
   570         $Result{"body"} .= "<td class='script'>\n";
   571         $Result{"body"} .= "<pre class='${class}cline'>\n";
   572         my $cline = $cl->{"prompt"}.$cl->{"cline"};
   573         $cline =~ s/\n//;
   575         #$cline .= "(".$Sessions{$cl->{local_session_id}}.")";
   577         my $hint = make_comment($cl->{"cline"});
   578         $cline = "<div title='$hint'>$cline</div>" if $hint;
   579         $Result{"body"} .= $cline;
   580         $Result{"body"} .= "</pre>\n";
   582         my $last_command = $cl->{"last_command"};
   583         if (!( 
   584         $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
   585         $Config{"suppress_pagers"}  =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
   586         $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
   587             )) {
   589             $Result{"body"} .= "<pre class='".$cl->{out_class}."'>";
   590             $Result{"body"} .= $output;
   591             $Result{"body"} .= "</pre>\n";
   592         }   
   594         # DIFF
   595         if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
   596             $Result{"body"} .= "<table><tr><td width='5'/><td class='diff'><pre>";
   597             $Result{"body"} .= $cl->{"diff"};
   598             $Result{"body"} .= "</pre></td></tr></table>";
   599         }
   601         #NOTES
   602         if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {
   603             my $note=$cl->{"note"};
   604             $note =~ s/\n/<br\/>\n/msg;
   605             $note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   606             $note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g;
   607         #   Ширину пока не используем
   608         #   $Result{"body"} .= "<table width='$Config{note_width}' class='note'>";
   609             $Result{"body"} .= "<table class='note'>";
   610             $Result{"body"} .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title};
   611             $Result{"body"} .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>";
   612             $Result{"body"} .= "</table>\n";
   613         }
   615         # COMMENT
   616         if ( $Config{"show_comments"} =~ /^y/i) {
   617             my $comment = make_comment($cl->{"cline"});
   618             if ($comment) {
   619                 $Result{"body"} .= "<table width='$Config{comment_width}'>".
   620                         "<tr><td width='5'/><td>";
   621                 $Result{"body"} .= "<table class='note' width='100%'>";
   622                 $Result{"body"} .= $comment;
   623                 $Result{"body"} .= "</table>\n";
   624                 $Result{"body"} .= "</td></tr></table>";
   625             }
   626         }
   628         # Вывод очередной команды окончен
   629         $Result{"body"} .= "</td>\n";
   630         $Result{"body"} .= "</tr>\n";
   631     }
   633     $Result{"body"} .= "</table>\n";
   635     #$Result{"stat"} = "<hr/>";
   637     %StatNames = (
   638         FirstCommand => "Время первой команды журнала",
   639         LastCommand => "Время последней команды журнала",
   640         TotalCommands => "Количество командных строк в журнале",
   641         ErrorsPercentage => "Процент команд с ненулевым кодом завершения, %",
   642         TotalTime => "Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час",
   643         CommandsPerTime => "Количество командных строк в единицу времени, команда/мин",
   644         CommandsFrequency => "Частота использования команд",
   645         RareCommands    => "Частота использования этих команд < 0.5%",
   646     );
   647     @StatOrder = (
   648         FirstCommand,
   649         LastCommand,
   650         TotalCommands,
   651         ErrorsPercentage,
   652         TotalTime,
   653         CommandsPerTime,
   654         CommandsFrequency,
   655         RareCommands,
   656     );
   658     # Подготовка статистики к выводу
   659     # Некоторые значения пересчитываются!
   660     # Дальше их лучше уже не использовать!!!
   662     my %CommandsFrequency = %CommandsFDistribution;
   664     $Stat{TotalTime} ||= 0;
   665     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{FirstCommand} || 0);
   666     $Stat{FirstCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec,  $year+1900, $mon+1, $mday;
   667     ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{LastCommand} || 0);
   668     $Stat{LastCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec,  $year+1900, $mon+1, $mday;
   669     $Stat{ErrorsPercentage} = sprintf "%5.2f", $Stat{ErrorCommands}*100/$Stat{TotalCommands}    
   670         if $Stat{TotalCommands};
   671     $Stat{CommandsPerTime} = sprintf "%5.2f", $Stat{TotalCommands}*60/$Stat{TotalTime}
   672         if $Stat{TotalTime};
   673     $Stat{TotalTime} = sprintf "%5.2f", $Stat{TotalTime}/60/60;
   675     my $total_commands=0;
   676     for $command (keys %CommandsFrequency){
   677         $total_commands += $CommandsFrequency{$command};
   678     }
   679     if ($total_commands) {
   680         for $command (reverse sort {$CommandsFrequency{$a} <=> $CommandsFrequency{$b}} keys %CommandsFrequency){
   681             my $command_html;
   682             my $percentage = sprintf "%5.2f",$CommandsFrequency{$command}*100/$total_commands;
   683             if ($percentage < 0.5) {
   684                 my $hint = make_comment($command);
   685                 $command_html = "$command";
   686                 $command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;
   687                 my $command_html = "<tt>$command_html</tt>";
   688                 $Stat{RareCommands} .= $command_html."<sub><font size='-2'>".$CommandsFrequency{$command}."</font></sub> , ";
   689             }
   690             else {
   691                 my $hint = make_comment($command);
   692                 $command_html = "$command";
   693                 $command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;
   694                 my $command_html = "<tt>$command_html</tt>";
   695                 $percentage = sprintf "%5.2f",$percentage;
   696                 $Stat{CommandsFrequency} .= "<tr><td>".$command_html."</td><td>".$CommandsFrequency{$command}."</td>".
   697                     "<td>|".("="x int($CommandsFrequency{$command}*100/$total_commands))."| $percentage%</td></tr>";
   698             }
   699         }
   700         $Stat{CommandsFrequency} = "<table>".$Stat{CommandsFrequency}."</table>";
   701         $Stat{RareCommands} =~ s/, $// if $Stat{RareCommands};
   702     }
   704     $Result{"stat"} .= "<h2 id='stat'>Статистика</h2>";
   705     $Result{"stat"} .= "<table>";
   706     for my $stat (@StatOrder) {
   707     $Result{"stat"} .= "<tr valign='top'><td width='300'>".$StatNames{"$stat"}."</td><td>".$Stat{"$stat"}."</td></tr>"
   708         if $Stat{"$stat"};
   709     }
   711     $Result{"stat"} .= "</table>";
   712     $Result{"stat"} .= "<font size='-2'>____<br/>*) Интервалы неактивности длительностью ".($Config{stat_inactivity_interval}/60)." минут и более не учитываются</font></br>";
   714     #$Result{"help"} .= "<hr/>";
   715     $Result{"help"} .= "<h2 id='help'>Справка</h2>";
   716     $Result{"help"} .= "$Html_Help<br/>";
   717     #$Result{"about"} .= "<hr/>";
   718     $Result{"about"} .= "<h2 id='about'>О программе</h2>";
   719     $Result{"about"} .= "$Html_About";
   720     $Result{"footer"} .= "</body>\n";
   721     $Result{"footer"} .= "</html>\n";
   723     $Result{"title"} = "Журнал лабораторных работ";
   724     $Result{"title"}.= " -- ".$course_student if $course_student;
   725     if ($course_date) {
   726         $Result{"title"}.= " -- ".$course_date; 
   727         $Result{"title"}.= "/".$course_code if $course_code;
   728     }
   729     else {
   730         $Result{"title"}.= " -- ".$course_code if $course_code;
   731     }
   733     # Заголовок генерируется позже всего
   734     # Тогда, когда известно уже, что должно быть написано в 
   735     # оглавлении
   736     $Result{"header"} = <<HEADER;
   737     <html>
   738     <head>
   739     <meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
   740     <link rel='stylesheet' href='$Config{frontend_css}' type='text/css'/>
   741     <title>$Result{title}</title>
   742     </head>
   743     <body>
   744     <script>
   745     $Html_JavaScript
   746     </script>
   747     <h1>Журнал лабораторных работ</h1>
   749 HEADER
   750     $Result{"header"} .= "<p>" if $course_student || $course_trainer || $course_name || $course_code || $course_date || $course_center;
   751     $Result{"header"} .= "Выполнил $course_student<br/>" if $course_student;
   752     $Result{"header"} .= "Проверил $course_trainer <br/>" if $course_trainer;
   753     $Result{"header"} .= "Курс " if $course_name || $course_code || $course_date;
   754     $Result{"header"} .= "$course_name " if $course_name;
   755     $Result{"header"} .= "($course_code)" if $course_code;
   756     $Result{"header"} .= ", $course_date<br/>" if $course_date;
   757     $Result{"header"} .= "Учебный центр $course_center <br/>" if $course_center;
   758     $Result{"header"} .= "</p>" if $course_student || $course_trainer || $course_name || $course_code || $course_date || $course_center;
   760     my $toc = collapse_list (\@toc);
   761     $Result{"header"} .= <<HEADER;
   762     <table border=0 id='toc' class='toc'>
   763     <tr>
   764     <td>
   765     <div class='toc_title'>Содержание</div>
   766     <ul>
   767         <li><a href='#log'>Журнал</a></li>
   768         <ul>$toc</ul>
   769         <li><a href='#stat'>Статистика</a></li>
   770         <li><a href='#help'>Справка</a></li>
   771         <li><a href='#about'>О программе</a></li>
   772     </ul>
   773     </td>
   774     </tr>
   775     </table>
   777     <h2 id="log">Журнал</h2>
   778 HEADER
   779     $Result{"header"} .= "<table id='visibility_form' class='visibility_form'><tr><td><form>\n";
   780     for my $element (keys %Elements_Visibility)
   781     {
   782         my @e = split /\s+/, $element;
   783         my $showhide = join "", map { "ShowHide('$_');" } @e ;
   784         $Result{"header"} .= "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>".
   785                 $Elements_Visibility{$element}.
   786                 "</input><br>\n";
   787     }
   789     $Result{"header"} .= "</form></td></tr></table>\n";
   791     if ($output_filename eq "-") {
   792         print $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"};
   793     }
   794     else {
   795         open(OUT, ">", $output_filename)
   796             or die "Can't open $output_filename for writing\n";
   797         print OUT $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"};
   798         close(OUT);
   799     }
   800 }
   804 sub collapse_list($)
   805 {
   806     my $res = "";
   807     for my $elem (@{$_[0]}) {
   808         if (ref $elem eq "ARRAY") {
   809             $res .= "<ul>".collapse_list($elem)."</ul>";
   810         }
   811         else
   812         {
   813             $res .= "<li>".$elem."</li>";
   814         }
   815     }
   816     return $res;
   817 }
   822 sub init_variables
   823 {
   824 $Html_Help = <<HELP;
   825     Для того чтобы использовать LiLaLo, не нужно знать ничего особенного:
   826     всё происходит само собой.
   827     Однако, чтобы ведение и последующее использование журналов
   828     было как можно более эффективным, желательно иметь в виду следующее:
   829     <ul>
   830     <li><p> 
   831     В журнал автоматически попадают все команды, данные в любом терминале системы.
   832     </p></li>
   833     <li><p>
   834     Для того чтобы убедиться, что журнал на текущем терминале ведётся, 
   835     и команды записываются, дайте команду w.
   836     В поле WHAT, соответствующем текущему терминалу, 
   837     должна быть указана программа script.
   838     </p></li>
   839     <li><p>
   840     Если код завершения команды равен нулю, 
   841     команда была выполнена без ошибок.
   842     Команды, код завершения которых отличен от нуля, выделяются цветом.
   843 <table>
   844 <tr class='command'>
   845 <td class='script'>
   846 <pre class='wrong_cline'>
   847 \$ l s-l</pre>
   848 <pre class='wrong_output'>bash: l: command not found
   849 </pre>
   850 </td>
   851 </tr>
   852 </table>
   853 <br/>
   854     </p></li>
   855     <li><p>
   856     Команды, ход выполнения которых был прерван пользователем, выделяются цветом.
   857 <table>
   858 <tr class='command'>
   859 <td class='script'>
   860 <pre class='interrupted_cline'>
   861 \$ find / -name abc</pre>
   862 <pre class='interrupted_output'>find: /home/devi-orig/.gnome2: Keine Berechtigung
   863 find: /home/devi-orig/.gnome2_private: Keine Berechtigung
   864 find: /home/devi-orig/.nautilus/metafiles: Keine Berechtigung
   865 find: /home/devi-orig/.metacity: Keine Berechtigung
   866 find: /home/devi-orig/.inkscape: Keine Berechtigung
   867 ^C
   868 </pre>
   869 </td>
   870 </tr>
   871 </table>
   872 <br/>
   873     </p></li>
   874     <li><p>
   875     Команды, выполненные с привилегиями суперпользователя,
   876     выделяются слева красной чертой.
   877 <table>
   878 <tr class='command'>
   879 <td class='script'>
   880 <pre class='_root_cline'>
   881 # id</pre>
   882 <pre class='_root_output'>
   883 uid=0(root) gid=0(root) Gruppen=0(root)
   884 </pre>
   885 </td>
   886 </tr>
   887 </table>
   888     <br/>
   889     </p></li>
   890     <li><p>
   891     Изменения, внесённые в текстовый файл с помощью редактора, 
   892     запоминаются и показываются в журнале в формате ed.
   893     Строки, начинающиеся символом "<", удалены, а строки,
   894     начинающиеся символом ">" -- добавлены.
   895 <table>
   896 <tr class='command'>
   897 <td class='script'>
   898 <pre class='cline'>
   899 \$ vi ~/.bashrc</pre>
   900 <table><tr><td width='5'/><td class='diff'><pre>2a3,5
   901 >    if [ -f /usr/local/etc/bash_completion ]; then
   902 >         . /usr/local/etc/bash_completion
   903 >        fi
   904 </pre></td></tr></table></td>
   905 </tr>
   906 </table>
   907     <br/>
   908     </p></li>
   909     <li><p>
   910     Для того чтобы изменить файл в соответствии с показанными в диффшоте
   911     изменениями, можно воспользоваться командой patch.
   912     Нужно скопировать изменения, запустить программу patch, указав в
   913     качестве её аргумента файл, к которому применяются изменения,
   914     и всавить скопированный текст:
   915 <table>
   916 <tr class='command'>
   917 <td class='script'>
   918 <pre class='cline'>
   919 \$ patch ~/.bashrc</pre>
   920 </td>
   921 </tr>
   922 </table>
   923     В данном случае изменения применяются к файлу ~/.bashrc
   924     </p></li>
   925     <li><p>
   926     Для того чтобы получить краткую справочную информацию о команде, 
   927     нужно подвести к ней мышь. Во всплывающей подсказке появится краткое
   928     описание команды.
   929     </p></li>
   930     <li><p>
   931     Время ввода команды, показанное в журнале, соответствует времени 
   932     <i>начала ввода командной строки</i>, которое равно тому моменту, 
   933     когда на терминале появилось приглашение интерпретатора
   934     </p></li>
   935     <li><p>
   936     Имя терминала, на котором была введена команда, показано в специальном блоке.
   937     Этот блок показывается только в том случае, если терминал
   938     текущей команды отличается от терминала предыдущей.
   939     </p></li>
   940     <li><p>
   941     Вывод не интересующих вас в настоящий момент элементов журнала,
   942     таких как время, имя терминала и других, можно отключить.
   943     Для этого нужно воспользоваться <a href='#visibility_form'>формой управления журналом</a>
   944     вверху страницы.
   945     </p></li>
   946     <li><p>
   947     Небольшие комментарии к командам можно вставлять прямо из командной строки.
   948     Комментарий вводится прямо в командную строку, после символов #^ или #v.
   949     Символы ^ и v показывают направление выбора команды, к которой относится комментарий:
   950     ^ - к предыдущей, v - к следующей.
   951     Например, если в командной строке было введено:
   952 <pre class='cline'>
   953 \$ whoami
   954 </pre>
   955 <pre class='output'>
   956 user
   957 </pre>
   958 <pre class='cline'>
   959 \$ #^ Интересно, кто я?
   960 </pre>
   961     в журнале это будет выглядеть так:
   963 <pre class='cline'>
   964 \$ whoami
   965 </pre>
   966 <pre class='output'>
   967 user
   968 </pre>
   969 <table class='note'><tr><td width='100%' class='note_text'>
   970 <tr> <td> Интересно, кто я?<br/> </td></tr></table> 
   971     </p></li>
   972     <li><p>
   973     Если комментарий содержит несколько строк,
   974     его можно вставить в журнал следующим образом:
   975 <pre class='cline'>
   976 \$ whoami
   977 </pre>
   978 <pre class='output'>
   979 user
   980 </pre>
   981 <pre class='cline'>
   982 \$ cat > /dev/null #^ Интересно, кто я?
   983 </pre>
   984 <pre class='output'>
   985 Программа whoami выводит имя пользователя, под которым 
   986 мы зарегистрировались в системе.
   987 -
   988 Она не может ответить на вопрос о нашем назначении 
   989 в этом мире.
   990 </pre>
   991     В журнале это будет выглядеть так:
   992 <table>
   993 <tr class='command'>
   994 <td class='script'>
   995 <pre class='cline'>
   996 \$ whoami</pre>
   997 <pre class='output'>user
   998 </pre>
   999 <table class='note'><tr><td class='note_title'>Интересно, кто я?</td></tr><tr><td width='100%' class='note_text'>
  1000 Программа whoami выводит имя пользователя, под которым<br/>
  1001 мы зарегистрировались в системе.<br/>
  1002 <br/>
  1003 Она не может ответить на вопрос о нашем назначении<br/>
  1004 в этом мире.<br/>
  1005 </td></tr></table>
  1006 </td>
  1007 </tr>
  1008 </table>
  1009     Для разделения нескольких абзацев между собой
  1010     используйте символ "-", один в строке.
  1011     <br/>
  1012 </p></li>
  1013     <li><p>
  1014     Комментарии, не относящиеся непосредственно ни к какой из команд, 
  1015     добавляются точно таким же способом, только вместо симолов #^ или #v 
  1016     нужно использовать символы #=
  1017     </p></li>
  1018 </ul>
  1019 HELP
  1021 $Html_About = <<ABOUT;
  1022     <p>
  1023     LiLaLo (L3) расшифровывается как Live Lab Log.<br/>
  1024     Программа разработана для повышения эффективности обучения Unix/Linux-системам.<br/>
  1025     (c) Игорь Чубин, 2004-2005<br/>
  1026     </p>
  1027 ABOUT
  1028 $Html_About.='$Id$ </p>';
  1030 $Html_JavaScript = <<JS;
  1031     function getElementsByClassName(Class_Name)
  1032     {
  1033         var Result=new Array();
  1034         var All_Elements=document.all || document.getElementsByTagName('*');
  1035         for (i=0; i<All_Elements.length; i++)
  1036             if (All_Elements[i].className==Class_Name)
  1037         Result.push(All_Elements[i]);
  1038         return Result;
  1039     }
  1040     function ShowHide (name)
  1041     {
  1042         elements=getElementsByClassName(name);
  1043         for(i=0; i<elements.length; i++)
  1044             if (elements[i].style.display == "none")
  1045                 elements[i].style.display = "";
  1046             else
  1047                 elements[i].style.display = "none";
  1048             //if (elements[i].style.visibility == "hidden")
  1049             //  elements[i].style.visibility = "visible";
  1050             //else
  1051             //  elements[i].style.visibility = "hidden";
  1052     }
  1053     function filter_by_output(text)
  1054     {
  1056         var jjj=0;
  1058         elements=getElementsByClassName('command');
  1059         for(i=0; i<elements.length; i++) {
  1060             subelems = elements[i].getElementsByTagName('pre');
  1061             for(j=0; j<subelems.length; j++) {
  1062                 if (subelems[j].className = 'output') {
  1063                     var str = new String(subelems[j].nodeValue);
  1064                     if (jjj != 1) { 
  1065                         alert(str);
  1066                         jjj=1;
  1067                     }
  1068                     if (str.indexOf(text) >0) 
  1069                         subelems[j].style.display = "none";
  1070                     else
  1071                         subelems[j].style.display = "";
  1073                 }
  1075             }
  1076         }       
  1078     }
  1079 JS
  1081 %Search_Machines = (
  1082         "google" =>     {   "query" =>  "http://www.google.com/search?q=" ,
  1083                     "icon"  =>  "$Config{frontend_google_ico}" },
  1084         "freebsd" =>    {   "query" =>  "http://www.freebsd.org/cgi/man.cgi?query=",
  1085                     "icon"  =>  "$Config{frontend_freebsd_ico}" },
  1086         "linux"  =>     {   "query" =>  "http://man.he.net/?topic=",
  1087                     "icon"  =>  "$Config{frontend_linux_ico}"},
  1088         "opennet"  =>   {   "query" =>  "http://www.opennet.ru/search.shtml?words=",
  1089                     "icon"  =>  "$Config{frontend_opennet_ico}"},
  1090         "local" =>  {   "query" =>  "http://www.freebsd.org/cgi/man.cgi?query=",
  1091                     "icon"  =>  "$Config{frontend_local_ico}" },
  1093     );
  1095 %Elements_Visibility = (
  1096         "note"      =>  "замечания",
  1097         "diff"      =>  "редактор",
  1098         "time"      =>  "время",
  1099         "ttychange"     =>  "терминал",
  1100         "wrong_output wrong_cline wrong_root_output wrong_root_cline" 
  1101                 =>  "команды с ошибками",
  1102         "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline" 
  1103                 =>  "прерванные команды",
  1104         "tab_completion_output tab_completion_cline"    
  1105                 =>  "продолжение с помощью tab"
  1106 );
  1108 @Day_Name      = qw/ Воскресенье Понедельник Вторник Среда Четверг Пятница Суббота /;
  1109 @Month_Name    = qw/ Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь /;
  1110 @Of_Month_Name = qw/ Января Февраля Марта Апреля Мая Июня Июля Августа Сентября Октября Ноября Декабря /;
  1111 }
