lilalo
view l3-frontend @ 53:eab4f7df854c
Исправлены глюки с обнаружением себя(l3-agent) в FreeBSD. Год задаётся как параметр year
| author | devi | 
|---|---|
| date | Wed Dec 21 19:31:00 2005 +0200 (2005-12-21) | 
| parents | d021553f4e98 | 
| children | d3fcff5e3757 | 
 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) if $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 if 
   419                     defined($cl->{local_session_id}) 
   420                     && defined($Sessions{$cl->{local_session_id}}->{$filter_key}) 
   421                     && $Sessions{$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
   422 		#print $filter_key,"\n";	
   423             }
   425             #if ($filter{user}) {
   426             #   next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{user} eq $filter{user};
   427             #}
   429             #for my $filter_field (keys %filter) {
   430             #   next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_field} eq $filter{$filter_field};
   431             #}
   432         }
   434         if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
   435             $in_range=1;
   436             next;
   437         }
   438         if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
   439             $in_range=0;
   440             next;
   441         }
   442         next if ($Config{"from"} && $Config{"to"} && !$in_range) 
   443             ||
   444                 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
   445             ||
   446             ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
   447             ||
   448             ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
   450         #my @new_commands=@{$cl->{"new_commands"}};
   451         #my @new_files=@{$cl->{"new_files"}};
   453         if ($cl->{class} eq "note") {
   454             my $note = $cl->{note};
   455             $note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note)));
   456             $note =~ s@(http:[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
   457             $note =~ s@(www\.[a-zA-Z.0-9/?\_%-]*)@<a href='$1'>$1</a>@g;
   458             $Result{"body"} .= "<tr><td colspan='6'>";
   459             $Result{"body"} .= "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title};
   460             $Result{"body"} .= "".$note."<p/><p/></td></td>";
   462             if ($cl->{note_title}) {
   463                 push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>";
   464                 $note_number++;
   465             }
   466             next;
   467         }
   469         my $cl_class="cline";
   470         my $out_class="output";
   471         if ($cl->{"class"}) {
   472             $cl_class = $cl->{"class"}."_".$cl_class;
   473             $out_class = $cl->{"class"}."_".$out_class;
   474         }
   476         my @new_commands;
   477         my @new_files;
   478         @new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"};
   479         @new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"};
   481         my $output="";
   482         if ($Config{"head_lines"} || $Config{"tail_lines"}) {
   483             # Partialy output
   484             my @lines = split '\n', $cl->{"output"};
   485             # head
   486             my $mark=1;
   487             for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) {
   488                 $output .= $lines[$i]."\n";
   489             }
   490             # tail
   491             my $start=$#lines-$Config{"tail_lines"}+1;
   492             if ($start < 0) {
   493                 $start=0;
   494                 $mark=0;
   495             }   
   496             if ($start < $Config{"head_lines"}) {
   497                 $start=$Config{"head_lines"};
   498                 $mark=0;
   499             }   
   500             $output .= $Config{"skip_text"}."\n" if $mark;
   501             for ($i=$start; $i<= $#lines; $i++) {
   502                 $output .= $lines[$i]."\n";
   503             }
   504         } 
   505         else {
   506             # Full output
   507             $output .= $cl->{"output"};
   508         }   
   509         #$output .= "^C\n" if ($cl->{"err"} eq "130");
   511         #
   512         ##
   513         ## Начинается собственно вывод
   514         ##
   515         #
   517         # <command>
   519         my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
   520         next if $Stat{LastCommand} == $cl->{time};
   521         $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand};
   522         $Stat{LastCommand} = 0 unless defined $Stat{LastCommand};   
   523         $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand}
   524             if $cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval};
   525         $Stat{LastCommand} = $cl->{time};
   526         $Stat{TotalCommands} = 0 unless $Stat{TotalCommands};
   527         $Stat{TotalCommands}++;
   529         # Добавляем спереди 0 для удобочитаемости
   530         $min = "0".$min if $min =~ /^.$/;
   531         $hour = "0".$hour if $hour =~ /^.$/;
   532         $sec = "0".$sec if $sec =~ /^.$/;
   534         $class=$cl->{"out_class"};
   535         $class =~ s/output$//;
   537         $Stat{ErrorCommands}++
   538             if $class =~ /wrong/;
   540         $Result{"body"} .= "<tr class='command'>\n";
   543         # DAY CHANGE
   544         if ( $last_day ne $day) {
   545             #$Result{"body"} .= "<td colspan='6'><p></p><h3>День ",$day,"</h4></td></tr><tr>";
   546             $Result{"body"} .= "<td colspan='6'><p></p><h3 id='day$day'>".$Day_Name[$wday]."</h4></td></tr><tr>";
   547             push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
   548             $last_day=$day;
   549         }
   551         # CONSOLE CHANGE
   552         if ( $last_tty ne $cl->{"tty"}) {
   553             my $host;
   554             #$host = $Sessions{$cl->{local_session_id}}->{user}."@".$Sessions{$cl->{local_session_id}}->{hostname};
   555             my $body = $cl->{"tty"};
   556             $body .= " \@$host" if $host;
   557             $Result{"body"} .= "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>".$body."</td></tr></table></td></tr><tr>";
   558             $last_tty=$cl->{"tty"};
   559         }
   561         # TIME
   562         if ($Config{"show_time"} =~ /^y/i) {
   563             $Result{"body"} .= "<td valign='top' class='time' width='$Config{time_width}'><pre>".
   564                 $hour. ":". $min. ":". $sec.
   565                 "</td>";
   566         } else {
   567             $Result{"body"} .= "<td width='0'/>"
   568         }
   570         # COMMAND
   571         $Result{"body"} .= "<td class='script'>\n";
   572         $Result{"body"} .= "<pre class='${class}cline'>\n";
   573         my $cline = $cl->{"prompt"}.$cl->{"cline"};
   574         $cline =~ s/\n//;
   576         #$cline .= "(".$Sessions{$cl->{local_session_id}}.")";
   578         my $hint = make_comment($cl->{"cline"});
   579         $cline = "<div title='$hint'>$cline</div>" if $hint;
   580         $Result{"body"} .= $cline;
   581         $Result{"body"} .= "</pre>\n";
   583         my $last_command = $cl->{"last_command"};
   584         if (!( 
   585         $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) ||
   586         $Config{"suppress_pagers"}  =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) ||
   587         $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}})
   588             )) {
   590             $Result{"body"} .= "<pre class='".$cl->{out_class}."'>";
   591             $Result{"body"} .= $output;
   592             $Result{"body"} .= "</pre>\n";
   593         }   
   595         # DIFF
   596         if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) {
   597             $Result{"body"} .= "<table><tr><td width='5'/><td class='diff'><pre>";
   598             $Result{"body"} .= $cl->{"diff"};
   599             $Result{"body"} .= "</pre></td></tr></table>";
   600         }
   602         #NOTES
   603         if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) {
   604             my $note=$cl->{"note"};
   605             $note =~ s/\n/<br\/>\n/msg;
   606             if (not $note =~ s@(http:[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g) {
   607 		     $note =~ s@(www\.[a-zA-Z.0-9/_?%-]*)@<a href='$1'>$1</a>@g;
   608 	    };
   609         #   Ширину пока не используем
   610         #   $Result{"body"} .= "<table width='$Config{note_width}' class='note'>";
   611             $Result{"body"} .= "<table class='note'>";
   612             $Result{"body"} .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title};
   613             $Result{"body"} .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>";
   614             $Result{"body"} .= "</table>\n";
   615         }
   617         # COMMENT
   618         if ( $Config{"show_comments"} =~ /^y/i) {
   619             my $comment = make_comment($cl->{"cline"});
   620             if ($comment) {
   621                 $Result{"body"} .= "<table width='$Config{comment_width}'>".
   622                         "<tr><td width='5'/><td>";
   623                 $Result{"body"} .= "<table class='note' width='100%'>";
   624                 $Result{"body"} .= $comment;
   625                 $Result{"body"} .= "</table>\n";
   626                 $Result{"body"} .= "</td></tr></table>";
   627             }
   628         }
   630         # Вывод очередной команды окончен
   631         $Result{"body"} .= "</td>\n";
   632         $Result{"body"} .= "</tr>\n";
   633     }
   635     $Result{"body"} .= "</table>\n";
   637     #$Result{"stat"} = "<hr/>";
   639     %StatNames = (
   640         FirstCommand => "Время первой команды журнала",
   641         LastCommand => "Время последней команды журнала",
   642         TotalCommands => "Количество командных строк в журнале",
   643         ErrorsPercentage => "Процент команд с ненулевым кодом завершения, %",
   644         TotalTime => "Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час",
   645         CommandsPerTime => "Количество командных строк в единицу времени, команда/мин",
   646         CommandsFrequency => "Частота использования команд",
   647         RareCommands    => "Частота использования этих команд < 0.5%",
   648     );
   649     @StatOrder = (
   650         FirstCommand,
   651         LastCommand,
   652         TotalCommands,
   653         ErrorsPercentage,
   654         TotalTime,
   655         CommandsPerTime,
   656         CommandsFrequency,
   657         RareCommands,
   658     );
   660     # Подготовка статистики к выводу
   661     # Некоторые значения пересчитываются!
   662     # Дальше их лучше уже не использовать!!!
   664     my %CommandsFrequency = %CommandsFDistribution;
   666     $Stat{TotalTime} ||= 0;
   667     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{FirstCommand} || 0);
   668     $Stat{FirstCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec,  $year+1900, $mon+1, $mday;
   669     ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Stat{LastCommand} || 0);
   670     $Stat{LastCommand} = sprintf "%02i:%02i:%02i %04i-%2i-%2i", $hour, $min, $sec,  $year+1900, $mon+1, $mday;
   671     $Stat{ErrorsPercentage} = sprintf "%5.2f", $Stat{ErrorCommands}*100/$Stat{TotalCommands}    
   672         if $Stat{TotalCommands};
   673     $Stat{CommandsPerTime} = sprintf "%5.2f", $Stat{TotalCommands}*60/$Stat{TotalTime}
   674         if $Stat{TotalTime};
   675     $Stat{TotalTime} = sprintf "%5.2f", $Stat{TotalTime}/60/60;
   677     my $total_commands=0;
   678     for $command (keys %CommandsFrequency){
   679         $total_commands += $CommandsFrequency{$command};
   680     }
   681     if ($total_commands) {
   682         for $command (reverse sort {$CommandsFrequency{$a} <=> $CommandsFrequency{$b}} keys %CommandsFrequency){
   683             my $command_html;
   684             my $percentage = sprintf "%5.2f",$CommandsFrequency{$command}*100/$total_commands;
   685             if ($percentage < 0.5) {
   686                 my $hint = make_comment($command);
   687                 $command_html = "$command";
   688                 $command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;
   689                 my $command_html = "<tt>$command_html</tt>";
   690                 $Stat{RareCommands} .= $command_html."<sub><font size='-2'>".$CommandsFrequency{$command}."</font></sub> , ";
   691             }
   692             else {
   693                 my $hint = make_comment($command);
   694                 $command_html = "$command";
   695                 $command_html = "<span title='$hint' class='hint'>$command_html</span>" if $hint;
   696                 my $command_html = "<tt>$command_html</tt>";
   697                 $percentage = sprintf "%5.2f",$percentage;
   698                 $Stat{CommandsFrequency} .= "<tr><td>".$command_html."</td><td>".$CommandsFrequency{$command}."</td>".
   699                     "<td>|".("="x int($CommandsFrequency{$command}*100/$total_commands))."| $percentage%</td></tr>";
   700             }
   701         }
   702         $Stat{CommandsFrequency} = "<table>".$Stat{CommandsFrequency}."</table>";
   703         $Stat{RareCommands} =~ s/, $// if $Stat{RareCommands};
   704     }
   706     $Result{"stat"} .= "<h2 id='stat'>Статистика</h2>";
   707     $Result{"stat"} .= "<table>";
   708     for my $stat (@StatOrder) {
   709     $Result{"stat"} .= "<tr valign='top'><td width='300'>".$StatNames{"$stat"}."</td><td>".$Stat{"$stat"}."</td></tr>"
   710         if $Stat{"$stat"};
   711     }
   713     $Result{"stat"} .= "</table>";
   714     $Result{"stat"} .= "<font size='-2'>____<br/>*) Интервалы неактивности длительностью ".($Config{stat_inactivity_interval}/60)." минут и более не учитываются</font></br>";
   716     #$Result{"help"} .= "<hr/>";
   717     $Result{"help"} .= "<h2 id='help'>Справка</h2>";
   718     $Result{"help"} .= "$Html_Help<br/>";
   719     #$Result{"about"} .= "<hr/>";
   720     $Result{"about"} .= "<h2 id='about'>О программе</h2>";
   721     $Result{"about"} .= "$Html_About";
   722     $Result{"footer"} .= "</body>\n";
   723     $Result{"footer"} .= "</html>\n";
   725     $Result{"title"} = "Журнал лабораторных работ";
   726     $Result{"title"}.= " -- ".$course_student if $course_student;
   727     if ($course_date) {
   728         $Result{"title"}.= " -- ".$course_date; 
   729         $Result{"title"}.= "/".$course_code if $course_code;
   730     }
   731     else {
   732         $Result{"title"}.= " -- ".$course_code if $course_code;
   733     }
   735     # Заголовок генерируется позже всего
   736     # Тогда, когда известно уже, что должно быть написано в 
   737     # оглавлении
   738     $Result{"header"} = <<HEADER;
   739     <html>
   740     <head>
   741     <meta content='text/html; charset=utf-8' http-equiv='Content-Type' />
   742     <link rel='stylesheet' href='$Config{frontend_css}' type='text/css'/>
   743     <title>$Result{title}</title>
   744     </head>
   745     <body>
   746     <script>
   747     $Html_JavaScript
   748     </script>
   749     <h1>Журнал лабораторных работ</h1>
   751 HEADER
   752     $Result{"header"} .= "<p>" if $course_student || $course_trainer || $course_name || $course_code || $course_date || $course_center;
   753     $Result{"header"} .= "Выполнил $course_student<br/>" if $course_student;
   754     $Result{"header"} .= "Проверил $course_trainer <br/>" if $course_trainer;
   755     $Result{"header"} .= "Курс " if $course_name || $course_code || $course_date;
   756     $Result{"header"} .= "$course_name " if $course_name;
   757     $Result{"header"} .= "($course_code)" if $course_code;
   758     $Result{"header"} .= ", $course_date<br/>" if $course_date;
   759     $Result{"header"} .= "Учебный центр $course_center <br/>" if $course_center;
   760     $Result{"header"} .= "</p>" if $course_student || $course_trainer || $course_name || $course_code || $course_date || $course_center;
   762     my $toc = collapse_list (\@toc);
   763     $Result{"header"} .= <<HEADER;
   764     <table border=0 id='toc' class='toc'>
   765     <tr>
   766     <td>
   767     <div class='toc_title'>Содержание</div>
   768     <ul>
   769         <li><a href='#log'>Журнал</a></li>
   770         <ul>$toc</ul>
   771         <li><a href='#stat'>Статистика</a></li>
   772         <li><a href='#help'>Справка</a></li>
   773         <li><a href='#about'>О программе</a></li>
   774     </ul>
   775     </td>
   776     </tr>
   777     </table>
   779     <h2 id="log">Журнал</h2>
   780 HEADER
   781     $Result{"header"} .= "<table id='visibility_form' class='visibility_form'><tr><td><form>\n";
   782     for my $element (keys %Elements_Visibility)
   783     {
   784         my @e = split /\s+/, $element;
   785         my $showhide = join "", map { "ShowHide('$_');" } @e ;
   786         $Result{"header"} .= "<input type='checkbox' name='$e[0]' onclick=\"$showhide\" checked>".
   787                 $Elements_Visibility{$element}.
   788                 "</input><br>\n";
   789     }
   791     $Result{"header"} .= "</form></td></tr></table>\n";
   793     if ($output_filename eq "-") {
   794         print $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"};
   795     }
   796     else {
   797         open(OUT, ">", $output_filename)
   798             or die "Can't open $output_filename for writing\n";
   799         print OUT $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"};
   800         close(OUT);
   801     }
   802 }
   806 sub collapse_list($)
   807 {
   808     my $res = "";
   809     for my $elem (@{$_[0]}) {
   810         if (ref $elem eq "ARRAY") {
   811             $res .= "<ul>".collapse_list($elem)."</ul>";
   812         }
   813         else
   814         {
   815             $res .= "<li>".$elem."</li>";
   816         }
   817     }
   818     return $res;
   819 }
   824 sub init_variables
   825 {
   826 $Html_Help = <<HELP;
   827     Для того чтобы использовать LiLaLo, не нужно знать ничего особенного:
   828     всё происходит само собой.
   829     Однако, чтобы ведение и последующее использование журналов
   830     было как можно более эффективным, желательно иметь в виду следующее:
   831     <ul>
   832     <li><p> 
   833     В журнал автоматически попадают все команды, данные в любом терминале системы.
   834     </p></li>
   835     <li><p>
   836     Для того чтобы убедиться, что журнал на текущем терминале ведётся, 
   837     и команды записываются, дайте команду w.
   838     В поле WHAT, соответствующем текущему терминалу, 
   839     должна быть указана программа script.
   840     </p></li>
   841     <li><p>
   842     Если код завершения команды равен нулю, 
   843     команда была выполнена без ошибок.
   844     Команды, код завершения которых отличен от нуля, выделяются цветом.
   845 <table>
   846 <tr class='command'>
   847 <td class='script'>
   848 <pre class='wrong_cline'>
   849 \$ l s-l</pre>
   850 <pre class='wrong_output'>bash: l: command not found
   851 </pre>
   852 </td>
   853 </tr>
   854 </table>
   855 <br/>
   856     </p></li>
   857     <li><p>
   858     Команды, ход выполнения которых был прерван пользователем, выделяются цветом.
   859 <table>
   860 <tr class='command'>
   861 <td class='script'>
   862 <pre class='interrupted_cline'>
   863 \$ find / -name abc</pre>
   864 <pre class='interrupted_output'>find: /home/devi-orig/.gnome2: Keine Berechtigung
   865 find: /home/devi-orig/.gnome2_private: Keine Berechtigung
   866 find: /home/devi-orig/.nautilus/metafiles: Keine Berechtigung
   867 find: /home/devi-orig/.metacity: Keine Berechtigung
   868 find: /home/devi-orig/.inkscape: Keine Berechtigung
   869 ^C
   870 </pre>
   871 </td>
   872 </tr>
   873 </table>
   874 <br/>
   875     </p></li>
   876     <li><p>
   877     Команды, выполненные с привилегиями суперпользователя,
   878     выделяются слева красной чертой.
   879 <table>
   880 <tr class='command'>
   881 <td class='script'>
   882 <pre class='_root_cline'>
   883 # id</pre>
   884 <pre class='_root_output'>
   885 uid=0(root) gid=0(root) Gruppen=0(root)
   886 </pre>
   887 </td>
   888 </tr>
   889 </table>
   890     <br/>
   891     </p></li>
   892     <li><p>
   893     Изменения, внесённые в текстовый файл с помощью редактора, 
   894     запоминаются и показываются в журнале в формате ed.
   895     Строки, начинающиеся символом "<", удалены, а строки,
   896     начинающиеся символом ">" -- добавлены.
   897 <table>
   898 <tr class='command'>
   899 <td class='script'>
   900 <pre class='cline'>
   901 \$ vi ~/.bashrc</pre>
   902 <table><tr><td width='5'/><td class='diff'><pre>2a3,5
   903 >    if [ -f /usr/local/etc/bash_completion ]; then
   904 >         . /usr/local/etc/bash_completion
   905 >        fi
   906 </pre></td></tr></table></td>
   907 </tr>
   908 </table>
   909     <br/>
   910     </p></li>
   911     <li><p>
   912     Для того чтобы изменить файл в соответствии с показанными в диффшоте
   913     изменениями, можно воспользоваться командой patch.
   914     Нужно скопировать изменения, запустить программу patch, указав в
   915     качестве её аргумента файл, к которому применяются изменения,
   916     и всавить скопированный текст:
   917 <table>
   918 <tr class='command'>
   919 <td class='script'>
   920 <pre class='cline'>
   921 \$ patch ~/.bashrc</pre>
   922 </td>
   923 </tr>
   924 </table>
   925     В данном случае изменения применяются к файлу ~/.bashrc
   926     </p></li>
   927     <li><p>
   928     Для того чтобы получить краткую справочную информацию о команде, 
   929     нужно подвести к ней мышь. Во всплывающей подсказке появится краткое
   930     описание команды.
   931     </p></li>
   932     <li><p>
   933     Время ввода команды, показанное в журнале, соответствует времени 
   934     <i>начала ввода командной строки</i>, которое равно тому моменту, 
   935     когда на терминале появилось приглашение интерпретатора
   936     </p></li>
   937     <li><p>
   938     Имя терминала, на котором была введена команда, показано в специальном блоке.
   939     Этот блок показывается только в том случае, если терминал
   940     текущей команды отличается от терминала предыдущей.
   941     </p></li>
   942     <li><p>
   943     Вывод не интересующих вас в настоящий момент элементов журнала,
   944     таких как время, имя терминала и других, можно отключить.
   945     Для этого нужно воспользоваться <a href='#visibility_form'>формой управления журналом</a>
   946     вверху страницы.
   947     </p></li>
   948     <li><p>
   949     Небольшие комментарии к командам можно вставлять прямо из командной строки.
   950     Комментарий вводится прямо в командную строку, после символов #^ или #v.
   951     Символы ^ и v показывают направление выбора команды, к которой относится комментарий:
   952     ^ - к предыдущей, v - к следующей.
   953     Например, если в командной строке было введено:
   954 <pre class='cline'>
   955 \$ whoami
   956 </pre>
   957 <pre class='output'>
   958 user
   959 </pre>
   960 <pre class='cline'>
   961 \$ #^ Интересно, кто я?
   962 </pre>
   963     в журнале это будет выглядеть так:
   965 <pre class='cline'>
   966 \$ whoami
   967 </pre>
   968 <pre class='output'>
   969 user
   970 </pre>
   971 <table class='note'><tr><td width='100%' class='note_text'>
   972 <tr> <td> Интересно, кто я?<br/> </td></tr></table> 
   973     </p></li>
   974     <li><p>
   975     Если комментарий содержит несколько строк,
   976     его можно вставить в журнал следующим образом:
   977 <pre class='cline'>
   978 \$ whoami
   979 </pre>
   980 <pre class='output'>
   981 user
   982 </pre>
   983 <pre class='cline'>
   984 \$ cat > /dev/null #^ Интересно, кто я?
   985 </pre>
   986 <pre class='output'>
   987 Программа whoami выводит имя пользователя, под которым 
   988 мы зарегистрировались в системе.
   989 -
   990 Она не может ответить на вопрос о нашем назначении 
   991 в этом мире.
   992 </pre>
   993     В журнале это будет выглядеть так:
   994 <table>
   995 <tr class='command'>
   996 <td class='script'>
   997 <pre class='cline'>
   998 \$ whoami</pre>
   999 <pre class='output'>user
  1000 </pre>
  1001 <table class='note'><tr><td class='note_title'>Интересно, кто я?</td></tr><tr><td width='100%' class='note_text'>
  1002 Программа whoami выводит имя пользователя, под которым<br/>
  1003 мы зарегистрировались в системе.<br/>
  1004 <br/>
  1005 Она не может ответить на вопрос о нашем назначении<br/>
  1006 в этом мире.<br/>
  1007 </td></tr></table>
  1008 </td>
  1009 </tr>
  1010 </table>
  1011     Для разделения нескольких абзацев между собой
  1012     используйте символ "-", один в строке.
  1013     <br/>
  1014 </p></li>
  1015     <li><p>
  1016     Комментарии, не относящиеся непосредственно ни к какой из команд, 
  1017     добавляются точно таким же способом, только вместо симолов #^ или #v 
  1018     нужно использовать символы #=
  1019     </p></li>
  1020 </ul>
  1021 HELP
  1023 $Html_About = <<ABOUT;
  1024     <p>
  1025     LiLaLo (L3) расшифровывается как Live Lab Log.<br/>
  1026     Программа разработана для повышения эффективности обучения Unix/Linux-системам.<br/>
  1027     (c) Игорь Чубин, 2004-2005<br/>
  1028     </p>
  1029 ABOUT
  1030 $Html_About.='$Id$ </p>';
  1032 $Html_JavaScript = <<JS;
  1033     function getElementsByClassName(Class_Name)
  1034     {
  1035         var Result=new Array();
  1036         var All_Elements=document.all || document.getElementsByTagName('*');
  1037         for (i=0; i<All_Elements.length; i++)
  1038             if (All_Elements[i].className==Class_Name)
  1039         Result.push(All_Elements[i]);
  1040         return Result;
  1041     }
  1042     function ShowHide (name)
  1043     {
  1044         elements=getElementsByClassName(name);
  1045         for(i=0; i<elements.length; i++)
  1046             if (elements[i].style.display == "none")
  1047                 elements[i].style.display = "";
  1048             else
  1049                 elements[i].style.display = "none";
  1050             //if (elements[i].style.visibility == "hidden")
  1051             //  elements[i].style.visibility = "visible";
  1052             //else
  1053             //  elements[i].style.visibility = "hidden";
  1054     }
  1055     function filter_by_output(text)
  1056     {
  1058         var jjj=0;
  1060         elements=getElementsByClassName('command');
  1061         for(i=0; i<elements.length; i++) {
  1062             subelems = elements[i].getElementsByTagName('pre');
  1063             for(j=0; j<subelems.length; j++) {
  1064                 if (subelems[j].className = 'output') {
  1065                     var str = new String(subelems[j].nodeValue);
  1066                     if (jjj != 1) { 
  1067                         alert(str);
  1068                         jjj=1;
  1069                     }
  1070                     if (str.indexOf(text) >0) 
  1071                         subelems[j].style.display = "none";
  1072                     else
  1073                         subelems[j].style.display = "";
  1075                 }
  1077             }
  1078         }       
  1080     }
  1081 JS
  1083 %Search_Machines = (
  1084         "google" =>     {   "query" =>  "http://www.google.com/search?q=" ,
  1085                     "icon"  =>  "$Config{frontend_google_ico}" },
  1086         "freebsd" =>    {   "query" =>  "http://www.freebsd.org/cgi/man.cgi?query=",
  1087                     "icon"  =>  "$Config{frontend_freebsd_ico}" },
  1088         "linux"  =>     {   "query" =>  "http://man.he.net/?topic=",
  1089                     "icon"  =>  "$Config{frontend_linux_ico}"},
  1090         "opennet"  =>   {   "query" =>  "http://www.opennet.ru/search.shtml?words=",
  1091                     "icon"  =>  "$Config{frontend_opennet_ico}"},
  1092         "local" =>  {   "query" =>  "http://www.freebsd.org/cgi/man.cgi?query=",
  1093                     "icon"  =>  "$Config{frontend_local_ico}" },
  1095     );
  1097 %Elements_Visibility = (
  1098         "note"      =>  "замечания",
  1099         "diff"      =>  "редактор",
  1100         "time"      =>  "время",
  1101         "ttychange"     =>  "терминал",
  1102         "wrong_output wrong_cline wrong_root_output wrong_root_cline" 
  1103                 =>  "команды с ошибками",
  1104         "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline" 
  1105                 =>  "прерванные команды",
  1106         "tab_completion_output tab_completion_cline"    
  1107                 =>  "продолжение с помощью tab"
  1108 );
  1110 @Day_Name      = qw/ Воскресенье Понедельник Вторник Среда Четверг Пятница Суббота /;
  1111 @Month_Name    = qw/ Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь /;
  1112 @Of_Month_Name = qw/ Января Февраля Марта Апреля Мая Июня Июля Августа Сентября Октября Ноября Декабря /;
  1113 }
