lilalo
changeset 49:d021553f4e98
Tabs expanded
| author | devi |
|---|---|
| date | Sun Dec 04 18:44:21 2005 +0200 (2005-12-04) |
| parents | 568bab7090fc |
| children | ff4ab09fd3f1 |
| files | l3-frontend l3scripts |
line diff
1.1 --- a/l3-frontend Sat Nov 26 16:15:52 2005 +0200 1.2 +++ b/l3-frontend Sun Dec 04 18:44:21 2005 +0200 1.3 @@ -21,7 +21,7 @@ 1.4 # ^^^ 1.5 1.6 our %Stat; 1.7 -our %CommandsFDistribution; # Сколько раз в журнале встречается какая команда 1.8 +our %CommandsFDistribution; # Сколько раз в журнале встречается какая команда 1.9 1.10 sub search_buy; 1.11 sub make_comment; 1.12 @@ -38,163 +38,163 @@ 1.13 1.14 sub main 1.15 { 1.16 - $| = 1; 1.17 + $| = 1; 1.18 1.19 - init_variables(); 1.20 - init_config(); 1.21 + init_variables(); 1.22 + init_config(); 1.23 1.24 - open_mywi_socket(); 1.25 - load_command_lines_from_xml($Config{"backend_datafile"}); 1.26 - load_sessions_from_xml($Config{"backend_datafile"}); 1.27 - sort_command_lines; 1.28 - process_command_lines; 1.29 - print_command_lines($Config{"output"}); 1.30 - close_mywi_socket; 1.31 + open_mywi_socket(); 1.32 + load_command_lines_from_xml($Config{"backend_datafile"}); 1.33 + load_sessions_from_xml($Config{"backend_datafile"}); 1.34 + sort_command_lines; 1.35 + process_command_lines; 1.36 + print_command_lines($Config{"output"}); 1.37 + close_mywi_socket; 1.38 } 1.39 1.40 1.41 sub search_by 1.42 { 1.43 - my $sm = shift; 1.44 - my $topic = shift; 1.45 - $topic =~ s/ /+/; 1.46 - 1.47 - return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='". 1.48 - $Search_Machines{$sm}->{"icon"}."' border='0'/></a>"; 1.49 + my $sm = shift; 1.50 + my $topic = shift; 1.51 + $topic =~ s/ /+/; 1.52 + 1.53 + return "<a href='". $Search_Machines{$sm}->{"query"}."$topic'><img width='16' height='16' src='". 1.54 + $Search_Machines{$sm}->{"icon"}."' border='0'/></a>"; 1.55 } 1.56 1.57 sub extract_from_cline 1.58 # Разобрать командную строку $_[1] и возвратить хэш, содержащий 1.59 # номер первого появление команды в строке: 1.60 -# команда => первая позиция 1.61 +# команда => первая позиция 1.62 { 1.63 - my $what = $_[0]; 1.64 - my $cline = $_[1]; 1.65 - my @lists = split /\;/, $cline; 1.66 - 1.67 - 1.68 - my @commands = (); 1.69 - for my $list (@lists) { 1.70 - push @commands, split /\|/, $list; 1.71 - } 1.72 + my $what = $_[0]; 1.73 + my $cline = $_[1]; 1.74 + my @lists = split /\;/, $cline; 1.75 + 1.76 + 1.77 + my @commands = (); 1.78 + for my $list (@lists) { 1.79 + push @commands, split /\|/, $list; 1.80 + } 1.81 1.82 - my %commands; 1.83 - my %args; 1.84 - my $i=0; 1.85 - for my $command (@commands) { 1.86 - $command =~ s@^\s*\S+/@@; 1.87 - $command =~ /\s*(\S+)\s*(.*)/; 1.88 - if ($1 && $1 eq "sudo" ) { 1.89 - $commands{"$1"}=$i++; 1.90 - $command =~ s/\s*sudo\s+//; 1.91 - } 1.92 - $command =~ s@^\s*\S+/@@; 1.93 - $command =~ /\s*(\S+)\s*(.*)/; 1.94 - if ($1 && !defined $commands{"$1"}) { 1.95 - $commands{"$1"}=$i++; 1.96 - }; 1.97 - if ($2) { 1.98 - my $args = $2; 1.99 - my @args = split (/\s+/, $args); 1.100 - for my $a (@args) { 1.101 - $args{"$a"}=$i++ 1.102 - if !defined $args{"$a"}; 1.103 - }; 1.104 + my %commands; 1.105 + my %args; 1.106 + my $i=0; 1.107 + for my $command (@commands) { 1.108 + $command =~ s@^\s*\S+/@@; 1.109 + $command =~ /\s*(\S+)\s*(.*)/; 1.110 + if ($1 && $1 eq "sudo" ) { 1.111 + $commands{"$1"}=$i++; 1.112 + $command =~ s/\s*sudo\s+//; 1.113 + } 1.114 + $command =~ s@^\s*\S+/@@; 1.115 + $command =~ /\s*(\S+)\s*(.*)/; 1.116 + if ($1 && !defined $commands{"$1"}) { 1.117 + $commands{"$1"}=$i++; 1.118 + }; 1.119 + if ($2) { 1.120 + my $args = $2; 1.121 + my @args = split (/\s+/, $args); 1.122 + for my $a (@args) { 1.123 + $args{"$a"}=$i++ 1.124 + if !defined $args{"$a"}; 1.125 + }; 1.126 1.127 - 1.128 - } 1.129 - } 1.130 + 1.131 + } 1.132 + } 1.133 1.134 - if ($what eq "commands") { 1.135 - return \%commands; 1.136 - } else { 1.137 - return \%args; 1.138 - } 1.139 - 1.140 + if ($what eq "commands") { 1.141 + return \%commands; 1.142 + } else { 1.143 + return \%args; 1.144 + } 1.145 + 1.146 } 1.147 1.148 sub open_mywi_socket 1.149 { 1.150 - $Mywi_Socket = IO::Socket::INET->new( 1.151 - PeerAddr => $Config{mywi_server}, 1.152 - PeerPort => $Config{mywi_port}, 1.153 - Proto => "tcp", 1.154 - Type => SOCK_STREAM); 1.155 + $Mywi_Socket = IO::Socket::INET->new( 1.156 + PeerAddr => $Config{mywi_server}, 1.157 + PeerPort => $Config{mywi_port}, 1.158 + Proto => "tcp", 1.159 + Type => SOCK_STREAM); 1.160 } 1.161 1.162 sub close_mywi_socket 1.163 { 1.164 - close ($Mywi_Socket); 1.165 + close ($Mywi_Socket); 1.166 } 1.167 1.168 1.169 sub mywi_client 1.170 { 1.171 - my $query = $_[0]; 1.172 - my $mywi; 1.173 + my $query = $_[0]; 1.174 + my $mywi; 1.175 1.176 - open_mywi_socket; 1.177 - if ($Mywi_Socket) { 1.178 - local $| = 1; 1.179 - local $/ = ""; 1.180 - print $Mywi_Socket $query."\n"; 1.181 - $mywi = <$Mywi_Socket>; 1.182 - $mywi = "" if $mywi =~ /nothing app/; 1.183 - } 1.184 - close_mywi_socket; 1.185 - return $mywi; 1.186 + open_mywi_socket; 1.187 + if ($Mywi_Socket) { 1.188 + local $| = 1; 1.189 + local $/ = ""; 1.190 + print $Mywi_Socket $query."\n"; 1.191 + $mywi = <$Mywi_Socket>; 1.192 + $mywi = "" if $mywi =~ /nothing app/; 1.193 + } 1.194 + close_mywi_socket; 1.195 + return $mywi; 1.196 } 1.197 1.198 sub make_comment 1.199 { 1.200 - my $cline = $_[0]; 1.201 - #my $files = $_[1]; 1.202 + my $cline = $_[0]; 1.203 + #my $files = $_[1]; 1.204 1.205 - my @comments=(); 1.206 - my @commands = keys %{extract_from_cline("commands", $cline)}; 1.207 - my @args = keys %{extract_from_cline("args", $cline)}; 1.208 - return if (!@commands && !@args); 1.209 - #return "commands=".join(" ",@commands)."; files=".join(" ",@files); 1.210 + my @comments=(); 1.211 + my @commands = keys %{extract_from_cline("commands", $cline)}; 1.212 + my @args = keys %{extract_from_cline("args", $cline)}; 1.213 + return if (!@commands && !@args); 1.214 + #return "commands=".join(" ",@commands)."; files=".join(" ",@files); 1.215 1.216 - # Commands 1.217 - for my $command (@commands) { 1.218 - $command =~ s/'//g; 1.219 - $CommandsFDistribution{$command}++; 1.220 - if (!$Commands_Description{$command}) { 1.221 - my $mywi=""; 1.222 - $mywi = mywi_client ($command); 1.223 - $mywi = join ("\n", grep(/\([18]\)/, split(/\n/, $mywi))); 1.224 - $mywi =~ s/\s+/ /; 1.225 - if ($mywi !~ /^\s*$/) { 1.226 - $Commands_Description{$command} = $mywi; 1.227 - } 1.228 - else { 1.229 - next; 1.230 - } 1.231 - } 1.232 + # Commands 1.233 + for my $command (@commands) { 1.234 + $command =~ s/'//g; 1.235 + $CommandsFDistribution{$command}++; 1.236 + if (!$Commands_Description{$command}) { 1.237 + my $mywi=""; 1.238 + $mywi = mywi_client ($command); 1.239 + $mywi = join ("\n", grep(/\([18]\)/, split(/\n/, $mywi))); 1.240 + $mywi =~ s/\s+/ /; 1.241 + if ($mywi !~ /^\s*$/) { 1.242 + $Commands_Description{$command} = $mywi; 1.243 + } 1.244 + else { 1.245 + next; 1.246 + } 1.247 + } 1.248 1.249 - push @comments, $Commands_Description{$command}; 1.250 - } 1.251 - return join(" \n", @comments); 1.252 - 1.253 - # Files 1.254 - for my $arg (@args) { 1.255 - $arg =~ s/'//g; 1.256 - if (!$Args_Description{$arg}) { 1.257 - my $mywi; 1.258 - $mywi = mywi_client ($arg); 1.259 - $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi))); 1.260 - $mywi =~ s/\s+/ /; 1.261 - if ($mywi !~ /^\s*$/) { 1.262 - $Args_Description{$arg} = $mywi; 1.263 - } 1.264 - else { 1.265 - next; 1.266 - } 1.267 - } 1.268 + push @comments, $Commands_Description{$command}; 1.269 + } 1.270 + return join(" \n", @comments); 1.271 + 1.272 + # Files 1.273 + for my $arg (@args) { 1.274 + $arg =~ s/'//g; 1.275 + if (!$Args_Description{$arg}) { 1.276 + my $mywi; 1.277 + $mywi = mywi_client ($arg); 1.278 + $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi))); 1.279 + $mywi =~ s/\s+/ /; 1.280 + if ($mywi !~ /^\s*$/) { 1.281 + $Args_Description{$arg} = $mywi; 1.282 + } 1.283 + else { 1.284 + next; 1.285 + } 1.286 + } 1.287 1.288 - push @comments, $Args_Description{$arg}; 1.289 - } 1.290 + push @comments, $Args_Description{$arg}; 1.291 + } 1.292 1.293 } 1.294 1.295 @@ -209,157 +209,157 @@ 1.296 =cut 1.297 sub load_command_lines_from_xml 1.298 { 1.299 - my $datafile = $_[0]; 1.300 + my $datafile = $_[0]; 1.301 1.302 - open (CLASS, $datafile) 1.303 - or die "Can't open file of the class ",$datafile,"\n"; 1.304 - local $/; 1.305 - $data = <CLASS>; 1.306 - close(CLASS); 1.307 + open (CLASS, $datafile) 1.308 + or die "Can't open file of the class ",$datafile,"\n"; 1.309 + local $/; 1.310 + $data = <CLASS>; 1.311 + close(CLASS); 1.312 1.313 - for $command ($data =~ m@<command>(.*?)</command>@sg) { 1.314 - my %cl; 1.315 - while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) { 1.316 - $cl{$1} = $2; 1.317 - } 1.318 - push @Command_Lines, \%cl; 1.319 - } 1.320 + for $command ($data =~ m@<command>(.*?)</command>@sg) { 1.321 + my %cl; 1.322 + while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) { 1.323 + $cl{$1} = $2; 1.324 + } 1.325 + push @Command_Lines, \%cl; 1.326 + } 1.327 } 1.328 1.329 sub load_sessions_from_xml 1.330 { 1.331 - my $datafile = $_[0]; 1.332 + my $datafile = $_[0]; 1.333 1.334 - open (CLASS, $datafile) 1.335 - or die "Can't open file of the class ",$datafile,"\n"; 1.336 - local $/; 1.337 - my $data = <CLASS>; 1.338 - close(CLASS); 1.339 + open (CLASS, $datafile) 1.340 + or die "Can't open file of the class ",$datafile,"\n"; 1.341 + local $/; 1.342 + my $data = <CLASS>; 1.343 + close(CLASS); 1.344 1.345 - for my $session ($data =~ m@<session>(.*?)</session>@sg) { 1.346 - my %session; 1.347 - while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) { 1.348 - $session{$1} = $2; 1.349 - } 1.350 - $Sessions{$session{local_session_id}} = \%session; 1.351 - } 1.352 + for my $session ($data =~ m@<session>(.*?)</session>@sg) { 1.353 + my %session; 1.354 + while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) { 1.355 + $session{$1} = $2; 1.356 + } 1.357 + $Sessions{$session{local_session_id}} = \%session; 1.358 + } 1.359 } 1.360 1.361 1.362 1.363 sub sort_command_lines 1.364 { 1.365 - # Sort Command_Lines 1.366 - # Write Command_Lines to Command_Lines_Index 1.367 + # Sort Command_Lines 1.368 + # Write Command_Lines to Command_Lines_Index 1.369 1.370 - my @index; 1.371 - for (my $i=0;$i<=$#Command_Lines;$i++) { 1.372 - $index[$i]=$i; 1.373 - } 1.374 + my @index; 1.375 + for (my $i=0;$i<=$#Command_Lines;$i++) { 1.376 + $index[$i]=$i; 1.377 + } 1.378 1.379 - @Command_Lines_Index = sort { 1.380 - $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"} 1.381 - } @index; 1.382 + @Command_Lines_Index = sort { 1.383 + $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"} 1.384 + } @index; 1.385 1.386 } 1.387 1.388 sub process_command_lines 1.389 { 1.390 - for my $i (@Command_Lines_Index) { 1.391 + for my $i (@Command_Lines_Index) { 1.392 1.393 - my $cl = \$Command_Lines[$i]; 1.394 - #@{${$cl}->{"new_commands"}} =(); 1.395 - #@{${$cl}->{"new_files"}} =(); 1.396 - $$cl->{"class"} = ""; 1.397 + my $cl = \$Command_Lines[$i]; 1.398 + #@{${$cl}->{"new_commands"}} =(); 1.399 + #@{${$cl}->{"new_files"}} =(); 1.400 + $$cl->{"class"} = ""; 1.401 1.402 - if ($$cl->{"err"}) { 1.403 - $$cl->{"class"}="wrong"; 1.404 - $$cl->{"class"}="interrupted" 1.405 - if ($$cl->{"err"} eq 130); 1.406 - } 1.407 - if (!$$cl->{"euid"}) { 1.408 - $$cl->{"class"}.="_root"; 1.409 - } 1.410 - 1.411 -#tab# my @tab_words=split /\s+/, $$cl->{"output"}; 1.412 -#tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/; 1.413 -#tab# $last_word =~ s@.*/@@; 1.414 -#tab# my $this_is_tab=1; 1.415 + if ($$cl->{"err"}) { 1.416 + $$cl->{"class"}="wrong"; 1.417 + $$cl->{"class"}="interrupted" 1.418 + if ($$cl->{"err"} eq 130); 1.419 + } 1.420 + if (!$$cl->{"euid"}) { 1.421 + $$cl->{"class"}.="_root"; 1.422 + } 1.423 + 1.424 +#tab# my @tab_words=split /\s+/, $$cl->{"output"}; 1.425 +#tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/; 1.426 +#tab# $last_word =~ s@.*/@@; 1.427 +#tab# my $this_is_tab=1; 1.428 #tab# 1.429 -#tab# if ($last_word && @tab_words >2) { 1.430 -#tab# for my $tab_words (@tab_words) { 1.431 -#tab# if ($tab_words !~ /^$last_word/) { 1.432 -#tab# $this_is_tab=0; 1.433 -#tab# last; 1.434 -#tab# } 1.435 -#tab# } 1.436 -#tab# } 1.437 -#tab# $$cl->{"class"}="tab" if $this_is_tab; 1.438 - 1.439 +#tab# if ($last_word && @tab_words >2) { 1.440 +#tab# for my $tab_words (@tab_words) { 1.441 +#tab# if ($tab_words !~ /^$last_word/) { 1.442 +#tab# $this_is_tab=0; 1.443 +#tab# last; 1.444 +#tab# } 1.445 +#tab# } 1.446 +#tab# } 1.447 +#tab# $$cl->{"class"}="tab" if $this_is_tab; 1.448 + 1.449 1.450 -# if ( !$$cl->{"err"}) { 1.451 -# # Command does not contain mistakes 1.452 -# 1.453 -# my %commands = extract_from_cline("commands", ${$cl}->{"cline"}); 1.454 -# my %files = extract_from_cline("files", ${$cl}->{"cline"}); 1.455 +# if ( !$$cl->{"err"}) { 1.456 +# # Command does not contain mistakes 1.457 +# 1.458 +# my %commands = extract_from_cline("commands", ${$cl}->{"cline"}); 1.459 +# my %files = extract_from_cline("files", ${$cl}->{"cline"}); 1.460 # 1.461 -# # Searching for new commands only 1.462 -# for my $command (keys %commands) { 1.463 -# if (!defined $Commands_Stat{$command}) { 1.464 -# push @{$$cl->{new_commands}}, $command; 1.465 -# } 1.466 -# $Commands_Stat{$command}++; 1.467 -# } 1.468 -# 1.469 -# for my $file (keys %files) { 1.470 -# if (!defined $Files_Stat{$file}) { 1.471 -# push @{$$cl->{new_files}}, $file; 1.472 -# } 1.473 -# $Files_Stat{$file}++; 1.474 -# } 1.475 -# } 1.476 +# # Searching for new commands only 1.477 +# for my $command (keys %commands) { 1.478 +# if (!defined $Commands_Stat{$command}) { 1.479 +# push @{$$cl->{new_commands}}, $command; 1.480 +# } 1.481 +# $Commands_Stat{$command}++; 1.482 +# } 1.483 +# 1.484 +# for my $file (keys %files) { 1.485 +# if (!defined $Files_Stat{$file}) { 1.486 +# push @{$$cl->{new_files}}, $file; 1.487 +# } 1.488 +# $Files_Stat{$file}++; 1.489 +# } 1.490 +# } 1.491 1.492 - if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) { 1.493 - if ($1 eq "=") { 1.494 - $$cl->{"class"} = "note"; 1.495 - $$cl->{"note"} = $$cl->{"output"}; 1.496 - $$cl->{"note_title"} = $2; 1.497 - } 1.498 - else { 1.499 - my $j = $i; 1.500 - if ($1 eq "^") { 1.501 - $j--; 1.502 - $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty})); 1.503 - } 1.504 - elsif ($1 eq "v") { 1.505 - $j++; 1.506 - $j++ while ($j <= @Command_Lines && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty})); 1.507 - } 1.508 - $Command_Lines[$j]->{note_title}="$2"; 1.509 - $Command_Lines[$j]->{note}=$$cl->{output}; 1.510 - $$cl=0; 1.511 - } 1.512 - } 1.513 - elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) { 1.514 - if ($1 eq "=") { 1.515 - $$cl->{"class"} = "note"; 1.516 - $$cl->{"note"} = $2; 1.517 - } 1.518 - else { 1.519 - my $j=$i; 1.520 - if ($1 eq "^") { 1.521 - $j--; 1.522 - $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty})); 1.523 - } 1.524 - elsif ($1 eq "v") { 1.525 - $j++; 1.526 - $j++ while ($j <= @Command_Lines && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]); 1.527 - } 1.528 - $Command_Lines[$j]->{note}.="$2\n"; 1.529 - $$cl=0; 1.530 - } 1.531 - } 1.532 - } 1.533 + if ($$cl->{cline}=~ m@cat[^#]*#([\^=v])\s*(.*)@) { 1.534 + if ($1 eq "=") { 1.535 + $$cl->{"class"} = "note"; 1.536 + $$cl->{"note"} = $$cl->{"output"}; 1.537 + $$cl->{"note_title"} = $2; 1.538 + } 1.539 + else { 1.540 + my $j = $i; 1.541 + if ($1 eq "^") { 1.542 + $j--; 1.543 + $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty})); 1.544 + } 1.545 + elsif ($1 eq "v") { 1.546 + $j++; 1.547 + $j++ while ($j <= @Command_Lines && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty})); 1.548 + } 1.549 + $Command_Lines[$j]->{note_title}="$2"; 1.550 + $Command_Lines[$j]->{note}=$$cl->{output}; 1.551 + $$cl=0; 1.552 + } 1.553 + } 1.554 + elsif ($$cl->{cline}=~ /#([\^=v])(.*)/) { 1.555 + if ($1 eq "=") { 1.556 + $$cl->{"class"} = "note"; 1.557 + $$cl->{"note"} = $2; 1.558 + } 1.559 + else { 1.560 + my $j=$i; 1.561 + if ($1 eq "^") { 1.562 + $j--; 1.563 + $j-- while ($j >=0 && (!$Command_Lines[$j] || $Command_Lines[$j]->{tty} ne $$cl->{tty})); 1.564 + } 1.565 + elsif ($1 eq "v") { 1.566 + $j++; 1.567 + $j++ while ($j <= @Command_Lines && $Command_Lines[$j]->{tty} ne $$cl->{tty} || !$Command_Lines[$j]); 1.568 + } 1.569 + $Command_Lines[$j]->{note}.="$2\n"; 1.570 + $$cl=0; 1.571 + } 1.572 + } 1.573 + } 1.574 1.575 } 1.576 1.577 @@ -373,447 +373,447 @@ 1.578 1.579 sub print_command_lines 1.580 { 1.581 - my $output_filename=$_[0]; 1.582 + my $output_filename=$_[0]; 1.583 1.584 - my $course_name = $Config{"course-name"}; 1.585 - my $course_code = $Config{"course-code"}; 1.586 - my $course_date = $Config{"course-date"}; 1.587 - my $course_center = $Config{"course-center"}; 1.588 - my $course_trainer = $Config{"course-trainer"}; 1.589 - my $course_student = $Config{"course-student"}; 1.590 - 1.591 + my $course_name = $Config{"course-name"}; 1.592 + my $course_code = $Config{"course-code"}; 1.593 + my $course_date = $Config{"course-date"}; 1.594 + my $course_center = $Config{"course-center"}; 1.595 + my $course_trainer = $Config{"course-trainer"}; 1.596 + my $course_student = $Config{"course-student"}; 1.597 + 1.598 1.599 - # Результат выполнения процедуры равен 1.600 - # join("", @Result{header,body,stat,help,about,footer}) 1.601 - my %Result; 1.602 - my @toc; # Хранит оглавление 1.603 - my $note_number=0; 1.604 + # Результат выполнения процедуры равен 1.605 + # join("", @Result{header,body,stat,help,about,footer}) 1.606 + my %Result; 1.607 + my @toc; # Хранит оглавление 1.608 + my $note_number=0; 1.609 1.610 - $Result{"body"} = "<table width='100%'>\n"; 1.611 - 1.612 - my $cl; 1.613 - my $last_tty=""; 1.614 - my $last_day=""; 1.615 - my $in_range=0; 1.616 + $Result{"body"} = "<table width='100%'>\n"; 1.617 + 1.618 + my $cl; 1.619 + my $last_tty=""; 1.620 + my $last_day=""; 1.621 + my $in_range=0; 1.622 1.623 - my $current_command=0; 1.624 + my $current_command=0; 1.625 1.626 COMMAND_LINE: 1.627 - for my $k (@Command_Lines_Index) { 1.628 + for my $k (@Command_Lines_Index) { 1.629 1.630 - my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]]; 1.631 - 1.632 - next unless $cl; 1.633 + my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]]; 1.634 + 1.635 + next unless $cl; 1.636 1.637 1.638 - if ($Config{filter}) { 1.639 - # Инициализация фильтра 1.640 - my %filter; 1.641 - for (split /&/,$Config{filter}) { 1.642 - my ($var, $val) = split /=/; 1.643 - $filter{$var} = $val || ""; 1.644 - } 1.645 + if ($Config{filter}) { 1.646 + # Инициализация фильтра 1.647 + my %filter; 1.648 + for (split /&/,$Config{filter}) { 1.649 + my ($var, $val) = split /=/; 1.650 + $filter{$var} = $val || ""; 1.651 + } 1.652 1.653 - for my $filter_key (keys %filter) { 1.654 - next COMMAND_LINE unless ( 1.655 - not defined($cl->{local_session_id}) 1.656 - || not defined($Sessions{$cl->{local_session_id}}->{$filter_key}) 1.657 - || $Sessions{$cl->{local_session_id}}->{$filter_key} eq $filter{$filter_key}); 1.658 - } 1.659 + for my $filter_key (keys %filter) { 1.660 + next COMMAND_LINE unless ( 1.661 + not defined($cl->{local_session_id}) 1.662 + || not defined($Sessions{$cl->{local_session_id}}->{$filter_key}) 1.663 + || $Sessions{$cl->{local_session_id}}->{$filter_key} eq $filter{$filter_key}); 1.664 + } 1.665 1.666 - #if ($filter{user}) { 1.667 - # next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{user} eq $filter{user}; 1.668 - #} 1.669 + #if ($filter{user}) { 1.670 + # next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{user} eq $filter{user}; 1.671 + #} 1.672 1.673 - #for my $filter_field (keys %filter) { 1.674 - # next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_field} eq $filter{$filter_field}; 1.675 - #} 1.676 - } 1.677 + #for my $filter_field (keys %filter) { 1.678 + # next COMMAND_LINE unless $Sessions{$cl->{local_session_id}}->{$filter_field} eq $filter{$filter_field}; 1.679 + #} 1.680 + } 1.681 1.682 - if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { 1.683 - $in_range=1; 1.684 - next; 1.685 - } 1.686 - if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { 1.687 - $in_range=0; 1.688 - next; 1.689 - } 1.690 - next if ($Config{"from"} && $Config{"to"} && !$in_range) 1.691 - || 1.692 - ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) 1.693 - || 1.694 - ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) 1.695 - || 1.696 - ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); 1.697 - 1.698 - #my @new_commands=@{$cl->{"new_commands"}}; 1.699 - #my @new_files=@{$cl->{"new_files"}}; 1.700 + if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { 1.701 + $in_range=1; 1.702 + next; 1.703 + } 1.704 + if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { 1.705 + $in_range=0; 1.706 + next; 1.707 + } 1.708 + next if ($Config{"from"} && $Config{"to"} && !$in_range) 1.709 + || 1.710 + ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) 1.711 + || 1.712 + ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) 1.713 + || 1.714 + ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); 1.715 + 1.716 + #my @new_commands=@{$cl->{"new_commands"}}; 1.717 + #my @new_files=@{$cl->{"new_files"}}; 1.718 1.719 - if ($cl->{class} eq "note") { 1.720 - my $note = $cl->{note}; 1.721 - $note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note))); 1.722 - $note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g; 1.723 - $note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g; 1.724 - $Result{"body"} .= "<tr><td colspan='6'>"; 1.725 - $Result{"body"} .= "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title}; 1.726 - $Result{"body"} .= "".$note."<p/><p/></td></td>"; 1.727 + if ($cl->{class} eq "note") { 1.728 + my $note = $cl->{note}; 1.729 + $note = join ("\n", map ("<p>$_</p>", split (/-\n/, $note))); 1.730 + $note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g; 1.731 + $note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g; 1.732 + $Result{"body"} .= "<tr><td colspan='6'>"; 1.733 + $Result{"body"} .= "<h4 id='note$note_number'>".$cl->{note_title}."</h4>" if $cl->{note_title}; 1.734 + $Result{"body"} .= "".$note."<p/><p/></td></td>"; 1.735 1.736 - if ($cl->{note_title}) { 1.737 - push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>"; 1.738 - $note_number++; 1.739 - } 1.740 - next; 1.741 - } 1.742 + if ($cl->{note_title}) { 1.743 + push @{$toc[@toc]},"<a href='#note$note_number'>".$cl->{note_title}."</a>"; 1.744 + $note_number++; 1.745 + } 1.746 + next; 1.747 + } 1.748 1.749 - my $cl_class="cline"; 1.750 - my $out_class="output"; 1.751 - if ($cl->{"class"}) { 1.752 - $cl_class = $cl->{"class"}."_".$cl_class; 1.753 - $out_class = $cl->{"class"}."_".$out_class; 1.754 - } 1.755 + my $cl_class="cline"; 1.756 + my $out_class="output"; 1.757 + if ($cl->{"class"}) { 1.758 + $cl_class = $cl->{"class"}."_".$cl_class; 1.759 + $out_class = $cl->{"class"}."_".$out_class; 1.760 + } 1.761 1.762 - my @new_commands; 1.763 - my @new_files; 1.764 - @new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"}; 1.765 - @new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"}; 1.766 + my @new_commands; 1.767 + my @new_files; 1.768 + @new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"}; 1.769 + @new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"}; 1.770 1.771 - my $output=""; 1.772 - if ($Config{"head_lines"} || $Config{"tail_lines"}) { 1.773 - # Partialy output 1.774 - my @lines = split '\n', $cl->{"output"}; 1.775 - # head 1.776 - my $mark=1; 1.777 - for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) { 1.778 - $output .= $lines[$i]."\n"; 1.779 - } 1.780 - # tail 1.781 - my $start=$#lines-$Config{"tail_lines"}+1; 1.782 - if ($start < 0) { 1.783 - $start=0; 1.784 - $mark=0; 1.785 - } 1.786 - if ($start < $Config{"head_lines"}) { 1.787 - $start=$Config{"head_lines"}; 1.788 - $mark=0; 1.789 - } 1.790 - $output .= $Config{"skip_text"}."\n" if $mark; 1.791 - for ($i=$start; $i<= $#lines; $i++) { 1.792 - $output .= $lines[$i]."\n"; 1.793 - } 1.794 - } 1.795 - else { 1.796 - # Full output 1.797 - $output .= $cl->{"output"}; 1.798 - } 1.799 - #$output .= "^C\n" if ($cl->{"err"} eq "130"); 1.800 + my $output=""; 1.801 + if ($Config{"head_lines"} || $Config{"tail_lines"}) { 1.802 + # Partialy output 1.803 + my @lines = split '\n', $cl->{"output"}; 1.804 + # head 1.805 + my $mark=1; 1.806 + for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) { 1.807 + $output .= $lines[$i]."\n"; 1.808 + } 1.809 + # tail 1.810 + my $start=$#lines-$Config{"tail_lines"}+1; 1.811 + if ($start < 0) { 1.812 + $start=0; 1.813 + $mark=0; 1.814 + } 1.815 + if ($start < $Config{"head_lines"}) { 1.816 + $start=$Config{"head_lines"}; 1.817 + $mark=0; 1.818 + } 1.819 + $output .= $Config{"skip_text"}."\n" if $mark; 1.820 + for ($i=$start; $i<= $#lines; $i++) { 1.821 + $output .= $lines[$i]."\n"; 1.822 + } 1.823 + } 1.824 + else { 1.825 + # Full output 1.826 + $output .= $cl->{"output"}; 1.827 + } 1.828 + #$output .= "^C\n" if ($cl->{"err"} eq "130"); 1.829 1.830 - # 1.831 - ## 1.832 - ## Начинается собственно вывод 1.833 - ## 1.834 - # 1.835 + # 1.836 + ## 1.837 + ## Начинается собственно вывод 1.838 + ## 1.839 + # 1.840 1.841 - # <command> 1.842 + # <command> 1.843 1.844 - my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time}); 1.845 - next if $Stat{LastCommand} == $cl->{time}; 1.846 - $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand}; 1.847 - $Stat{LastCommand} = 0 unless defined $Stat{LastCommand}; 1.848 - $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand} 1.849 - if $cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval}; 1.850 - $Stat{LastCommand} = $cl->{time}; 1.851 - $Stat{TotalCommands} = 0 unless $Stat{TotalCommands}; 1.852 - $Stat{TotalCommands}++; 1.853 + my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time}); 1.854 + next if $Stat{LastCommand} == $cl->{time}; 1.855 + $Stat{FirstCommand} = $cl->{time} unless $Stat{FirstCommand}; 1.856 + $Stat{LastCommand} = 0 unless defined $Stat{LastCommand}; 1.857 + $Stat{TotalTime} += $cl->{time} - $Stat{LastCommand} 1.858 + if $cl->{time} - $Stat{LastCommand} < $Config{stat_inactivity_interval}; 1.859 + $Stat{LastCommand} = $cl->{time}; 1.860 + $Stat{TotalCommands} = 0 unless $Stat{TotalCommands}; 1.861 + $Stat{TotalCommands}++; 1.862 1.863 - # Добавляем спереди 0 для удобочитаемости 1.864 - $min = "0".$min if $min =~ /^.$/; 1.865 - $hour = "0".$hour if $hour =~ /^.$/; 1.866 - $sec = "0".$sec if $sec =~ /^.$/; 1.867 + # Добавляем спереди 0 для удобочитаемости 1.868 + $min = "0".$min if $min =~ /^.$/; 1.869 + $hour = "0".$hour if $hour =~ /^.$/; 1.870 + $sec = "0".$sec if $sec =~ /^.$/; 1.871 1.872 - $class=$cl->{"out_class"}; 1.873 - $class =~ s/output$//; 1.874 + $class=$cl->{"out_class"}; 1.875 + $class =~ s/output$//; 1.876 1.877 - $Stat{ErrorCommands}++ 1.878 - if $class =~ /wrong/; 1.879 - 1.880 - $Result{"body"} .= "<tr class='command'>\n"; 1.881 - 1.882 - 1.883 - # DAY CHANGE 1.884 - if ( $last_day ne $day) { 1.885 - #$Result{"body"} .= "<td colspan='6'><p></p><h3>День ",$day,"</h4></td></tr><tr>"; 1.886 - $Result{"body"} .= "<td colspan='6'><p></p><h3 id='day$day'>".$Day_Name[$wday]."</h4></td></tr><tr>"; 1.887 - push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n"; 1.888 - $last_day=$day; 1.889 - } 1.890 + $Stat{ErrorCommands}++ 1.891 + if $class =~ /wrong/; 1.892 + 1.893 + $Result{"body"} .= "<tr class='command'>\n"; 1.894 + 1.895 + 1.896 + # DAY CHANGE 1.897 + if ( $last_day ne $day) { 1.898 + #$Result{"body"} .= "<td colspan='6'><p></p><h3>День ",$day,"</h4></td></tr><tr>"; 1.899 + $Result{"body"} .= "<td colspan='6'><p></p><h3 id='day$day'>".$Day_Name[$wday]."</h4></td></tr><tr>"; 1.900 + push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n"; 1.901 + $last_day=$day; 1.902 + } 1.903 1.904 - # CONSOLE CHANGE 1.905 - if ( $last_tty ne $cl->{"tty"}) { 1.906 - my $host; 1.907 - #$host = $Sessions{$cl->{local_session_id}}->{user}."@".$Sessions{$cl->{local_session_id}}->{hostname}; 1.908 - my $body = $cl->{"tty"}; 1.909 - $body .= " \@$host" if $host; 1.910 - $Result{"body"} .= "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>".$body."</td></tr></table></td></tr><tr>"; 1.911 - $last_tty=$cl->{"tty"}; 1.912 - } 1.913 + # CONSOLE CHANGE 1.914 + if ( $last_tty ne $cl->{"tty"}) { 1.915 + my $host; 1.916 + #$host = $Sessions{$cl->{local_session_id}}->{user}."@".$Sessions{$cl->{local_session_id}}->{hostname}; 1.917 + my $body = $cl->{"tty"}; 1.918 + $body .= " \@$host" if $host; 1.919 + $Result{"body"} .= "<td colspan='6'><table><tr><td class='ttychange' width='140' align='center'>".$body."</td></tr></table></td></tr><tr>"; 1.920 + $last_tty=$cl->{"tty"}; 1.921 + } 1.922 1.923 - # TIME 1.924 - if ($Config{"show_time"} =~ /^y/i) { 1.925 - $Result{"body"} .= "<td valign='top' class='time' width='$Config{time_width}'><pre>". 1.926 - $hour. ":". $min. ":". $sec. 1.927 - "</td>"; 1.928 - } else { 1.929 - $Result{"body"} .= "<td width='0'/>" 1.930 - } 1.931 + # TIME 1.932 + if ($Config{"show_time"} =~ /^y/i) { 1.933 + $Result{"body"} .= "<td valign='top' class='time' width='$Config{time_width}'><pre>". 1.934 + $hour. ":". $min. ":". $sec. 1.935 + "</td>"; 1.936 + } else { 1.937 + $Result{"body"} .= "<td width='0'/>" 1.938 + } 1.939 1.940 - # COMMAND 1.941 - $Result{"body"} .= "<td class='script'>\n"; 1.942 - $Result{"body"} .= "<pre class='${class}cline'>\n"; 1.943 - my $cline = $cl->{"prompt"}.$cl->{"cline"}; 1.944 - $cline =~ s/\n//; 1.945 + # COMMAND 1.946 + $Result{"body"} .= "<td class='script'>\n"; 1.947 + $Result{"body"} .= "<pre class='${class}cline'>\n"; 1.948 + my $cline = $cl->{"prompt"}.$cl->{"cline"}; 1.949 + $cline =~ s/\n//; 1.950 1.951 - #$cline .= "(".$Sessions{$cl->{local_session_id}}.")"; 1.952 - 1.953 - my $hint = make_comment($cl->{"cline"}); 1.954 - $cline = "<div title='$hint'>$cline</div>" if $hint; 1.955 - $Result{"body"} .= $cline; 1.956 - $Result{"body"} .= "</pre>\n"; 1.957 + #$cline .= "(".$Sessions{$cl->{local_session_id}}.")"; 1.958 + 1.959 + my $hint = make_comment($cl->{"cline"}); 1.960 + $cline = "<div title='$hint'>$cline</div>" if $hint; 1.961 + $Result{"body"} .= $cline; 1.962 + $Result{"body"} .= "</pre>\n"; 1.963 1.964 - my $last_command = $cl->{"last_command"}; 1.965 - if (!( 1.966 - $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) || 1.967 - $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) || 1.968 - $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}}) 1.969 - )) { 1.970 + my $last_command = $cl->{"last_command"}; 1.971 + if (!( 1.972 + $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) || 1.973 + $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) || 1.974 + $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}}) 1.975 + )) { 1.976 1.977 - $Result{"body"} .= "<pre class='".$cl->{out_class}."'>"; 1.978 - $Result{"body"} .= $output; 1.979 - $Result{"body"} .= "</pre>\n"; 1.980 - } 1.981 + $Result{"body"} .= "<pre class='".$cl->{out_class}."'>"; 1.982 + $Result{"body"} .= $output; 1.983 + $Result{"body"} .= "</pre>\n"; 1.984 + } 1.985 1.986 - # DIFF 1.987 - if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) { 1.988 - $Result{"body"} .= "<table><tr><td width='5'/><td class='diff'><pre>"; 1.989 - $Result{"body"} .= $cl->{"diff"}; 1.990 - $Result{"body"} .= "</pre></td></tr></table>"; 1.991 - } 1.992 - 1.993 - #NOTES 1.994 - if ( $Config{"show_notes"} =~ /^y/i && $cl->{"note"}) { 1.995 - my $note=$cl->{"note"}; 1.996 - $note =~ s/\n/<br\/>\n/msg; 1.997 - $note =~ s@(http:[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g; 1.998 - $note =~ s@(www\.[a-zA-Z.0-9/?%-]*)@<a href='$1'>$1</a>@g; 1.999 - # Ширину пока не используем 1.1000 - # $Result{"body"} .= "<table width='$Config{note_width}' class='note'>"; 1.1001 - $Result{"body"} .= "<table class='note'>"; 1.1002 - $Result{"body"} .= "<tr><td class='note_title'>".$cl->{note_title}."</td></tr>" if $cl->{note_title}; 1.1003 - $Result{"body"} .= "<tr><td width='100%' class='note_text'>".$note."</td></tr>"; 1.1004 - $Result{"body"} .= "</table>\n"; 1.1005 - } 1.1006 + # DIFF 1.1007 + if ( $Config{"show_diffs"}