1.1 --- a/l3-frontend	Fri Aug 04 18:06:09 2006 +0300
     1.2 +++ b/l3-frontend	Wed Feb 13 02:41:57 2008 +0200
     1.3 @@ -1,6 +1,6 @@
     1.4  #!/usr/bin/perl -w
     1.5  
     1.6 -use IO::Socket;
     1.7 +use POSIX qw(strftime);
     1.8  use lib '.';
     1.9  use l3config;
    1.10  use utf8;
    1.11 @@ -9,9 +9,10 @@
    1.12  our @Command_Lines_Index;
    1.13  our %Commands_Description;
    1.14  our %Args_Description;
    1.15 -our $Mywi_Socket;
    1.16  our %Sessions;
    1.17  
    1.18 +our $debug_output="";      # Используйте эту переменную, если нужно передать отладочную информацию
    1.19 +
    1.20  our %filter;
    1.21  our $filter_url;
    1.22  sub init_filter;
    1.23 @@ -26,12 +27,17 @@
    1.24  our %Elements_Visibility;
    1.25  # ^^^
    1.26  
    1.27 +our $First_Command=$0;
    1.28 +our $Last_Command=40;
    1.29 +
    1.30  our %Stat;
    1.31  our %frequency_of_command; # Сколько раз в журнале встречается какая команда
    1.32  our $table_number=1;
    1.33 +our %tigra_hints;
    1.34  
    1.35  my %mywi_cache_for;         # Кэш для экономии обращений к mywi
    1.36  
    1.37 +sub count_frequency_of_commands;
    1.38  sub make_comment;
    1.39  sub make_new_entries_table;
    1.40  sub load_command_lines_from_xml;
    1.41 @@ -53,6 +59,20 @@
    1.42  sub print_stat_html;
    1.43  sub print_header_html;
    1.44  sub print_footer_html;
    1.45 +sub tigra_hints_generate;
    1.46 +
    1.47 +#### mywi
    1.48 +# 
    1.49 +sub mywi_init;
    1.50 +sub load_mywitxt;
    1.51 +sub mywi_process_query($);
    1.52 +#
    1.53 +sub add_to_log($$);
    1.54 +sub parse_query;
    1.55 +sub search_in_txt;
    1.56 +sub add_to_log($$);
    1.57 +sub mywi_guess($);
    1.58 +#
    1.59  
    1.60  main();
    1.61  
    1.62 @@ -65,8 +85,8 @@
    1.63      $Config{frontend_ico_path}=$Config{frontend_css};
    1.64      $Config{frontend_ico_path}=~s@/[^/]*$@@;
    1.65      init_filter();
    1.66 +    mywi_init();
    1.67  
    1.68 -    open_mywi_socket();
    1.69      load_command_lines_from_xml($Config{"backend_datafile"});
    1.70      load_sessions_from_xml($Config{"backend_datafile"});
    1.71      sort_command_lines;
    1.72 @@ -77,7 +97,6 @@
    1.73      else {
    1.74          print_all_html($Config{"output"});
    1.75      }
    1.76 -    close_mywi_socket;
    1.77  }
    1.78  
    1.79  sub init_filter
    1.80 @@ -150,46 +169,75 @@
    1.81      
    1.82  }
    1.83  
    1.84 -
    1.85 -
    1.86 -
    1.87 -#
    1.88 -# Подпрограммы для работы с mywi
    1.89 -#
    1.90 -
    1.91 -sub open_mywi_socket
    1.92 +sub mywrap($)
    1.93  {
    1.94 -    $Mywi_Socket = IO::Socket::INET->new(
    1.95 -                PeerAddr => $Config{mywi_server},
    1.96 -                PeerPort => $Config{mywi_port},
    1.97 -                Proto    => "tcp",
    1.98 -                Type     => SOCK_STREAM);
    1.99 +return '<div class="t"><div class="b"><div class="l"><div class="r"><div class="bl"><div class="br"><div class="tl"><div class="tr">'.$_[0].
   1.100 +'</div></div></div></div></div></div></div></div>';
   1.101  }
   1.102  
   1.103 -sub close_mywi_socket
   1.104 +sub tigra_hints_generate
   1.105  {
   1.106 -    close ($Mywi_Socket) if $Mywi_Socket ;
   1.107 +    my $tigra_hints_items="";
   1.108 +    for my $hint_id (keys %tigra_hints) {
   1.109 +        $tigra_hints{$hint_id} =~ s@\n@<br/>@gs;
   1.110 +        $tigra_hints{$hint_id} =~ s@ - @ — @gs;
   1.111 +        $tigra_hints{$hint_id} =~ s@'@\\'@gs;
   1.112 +#        $tigra_hints_items .= "'$hint_id' : mywrap('".$tigra_hints{$hint_id}."'),";
   1.113 +        $tigra_hints_items .= "'$hint_id' : '".mywrap($tigra_hints{$hint_id})."',";
   1.114 +    }
   1.115 +    $tigra_hints_items =~ s/,$//; 
   1.116 +    return <<TIGRA;
   1.117 +
   1.118 +var HINTS_CFG = {
   1.119 +	'top'        : 5, // a vertical offset of a hint from mouse pointer
   1.120 +	'left'       : 5, // a horizontal offset of a hint from mouse pointer
   1.121 +	'css'        : 'hintsClass', // a style class name for all hints, TD object
   1.122 +	'show_delay' : 500, // a delay between object mouseover and hint appearing
   1.123 +	'hide_delay' : 2000, // a delay between hint appearing and hint hiding
   1.124 +	'wise'       : true,
   1.125 +	'follow'     : true,
   1.126 +	'z-index'    : 0 // a z-index for all hint layers
   1.127 +},
   1.128 +
   1.129 +HINTS_CFG_NEW = {
   1.130 +    'wise'       : true, // don't go off screen, don't overlap the object in the document
   1.131 +    'margin'     : 10, // minimum allowed distance between the hint and the window edge (negative values accepted)
   1.132 +    'gap'        : 20, // minimum allowed distance between the hint and the origin (negative values accepted)
   1.133 +    'align'      : 'bctl', // align of the hint and the origin (by first letters origin's top|middle|bottom left|center|right to hint's top|middle|bottom left|center|right)
   1.134 +    'css'        : 'hintsClass', // a style class name for all hints, applied to DIV element (see style section in the header of the document)
   1.135 +    'show_delay' : 0, // a delay between initiating event (mouseover for example) and hint appearing
   1.136 +    'hide_delay' : 200, // a delay between closing event (mouseout for example) and hint disappearing
   1.137 +    'follow'     : true, // hint follows the mouse as it moves
   1.138 +    'z-index'    : 100, // a z-index for all hint layers
   1.139 +    'IEfix'      : false, // fix IE problem with windowed controls visible through hints (activate if select boxes are visible through the hints)
   1.140 +    'IEtrans'    : ['blendTrans(DURATION=.3)', null], // [show transition, hide transition] - nice transition effects, only work in IE5+
   1.141 +    'opacity'    : 90 // opacity of the hint in %%
   1.142 +},
   1.143 +
   1.144 +HINTS_ITEMS = {
   1.145 +    $tigra_hints_items
   1.146 +};
   1.147 +var myHint = new THints (HINTS_CFG, HINTS_ITEMS);
   1.148 +
   1.149 +
   1.150 +function mywrap (s_) {
   1.151 +return '<div class="t"><div class="b"><div class="l"><div class="r"><div class="bl"><div class="br"><div class="tl"><div class="tr">'+s_+
   1.152 +'</div></div></div></div></div></div></div></div>';
   1.153 +
   1.154 +}
   1.155 +TIGRA
   1.156 +$a=<<TIGRA;
   1.157 +TIGRA
   1.158  }
   1.159  
   1.160  
   1.161 -sub mywi_client
   1.162 +sub count_frequency_of_commands
   1.163  {
   1.164 -    return "";
   1.165 -    my $query = $_[0];
   1.166 -    my $mywi;
   1.167 -
   1.168 -    open_mywi_socket;
   1.169 -    if ($Mywi_Socket) {
   1.170 -        binmode ":utf8", $Mywi_Socket;
   1.171 -        local $| = 1;
   1.172 -        local $/ = "";
   1.173 -        print $Mywi_Socket $query."\n";
   1.174 -        $mywi = <$Mywi_Socket>;
   1.175 -        utf8::decode($mywi);
   1.176 -        $mywi = "" if $mywi =~ /nothing app/;
   1.177 +    my $cline = $_[0];
   1.178 +    my @commands = keys %{extract_from_cline("commands", $cline)};
   1.179 +    for my $command (@commands) {
   1.180 +        $frequency_of_command{$command}++;
   1.181      }
   1.182 -    close_mywi_socket;
   1.183 -    return $mywi;
   1.184  }
   1.185  
   1.186  sub make_comment
   1.187 @@ -206,9 +254,9 @@
   1.188      # Commands
   1.189      for my $command (@commands) {
   1.190          $command =~ s/'//g;
   1.191 -        $frequency_of_command{$command}++;
   1.192 +        #$frequency_of_command{$command}++;
   1.193          if (!$Commands_Description{$command}) {
   1.194 -            $mywi_cache_for{$command} ||= mywi_client($command) || "";
   1.195 +            $mywi_cache_for{$command} ||= mywi_process_query($command) || "";
   1.196              my $mywi = join ("\n", grep(/\([18]|sh|script\)/, split(/\n/, $mywi_cache_for{$command})));
   1.197              $mywi =~ s/\s+/ /;
   1.198              if ($mywi !~ /^\s*$/) {
   1.199 @@ -330,8 +378,16 @@
   1.200  sub process_command_lines
   1.201  {
   1.202  
   1.203 +
   1.204 +    my $current_command=0;
   1.205 +
   1.206  COMMAND_LINE_PROCESSING:
   1.207      for my $i (@Command_Lines_Index) {
   1.208 +        
   1.209 +        $current_command++;
   1.210 +        next if $current_command < $Config{"start_from_command"};
   1.211 +        last if $current_command > $Config{"start_from_command"} + $Config{"commands_to_show_at_a_go"};
   1.212 +
   1.213          my $cl = \$Command_Lines[$i];
   1.214  
   1.215          next if !$cl;
   1.216 @@ -361,11 +417,15 @@
   1.217          }
   1.218  
   1.219          my $hint;
   1.220 +        count_frequency_of_commands($$cl->{"cline"});
   1.221          $hint = make_comment($$cl->{"cline"});
   1.222 +
   1.223          if ($hint) {
   1.224              $$cl->{hint} = $hint;
   1.225          }
   1.226 -#        $$cl->{hint}="";
   1.227 +        $tigra_hints{$$cl->{"time"}} = $hint;
   1.228 +
   1.229 +        $$cl->{hint}="";
   1.230  
   1.231  # Выводим <head_lines> верхних строк
   1.232  # и <tail_lines> нижних строк,
   1.233 @@ -491,6 +551,8 @@
   1.234      my $last_session="";
   1.235      my $last_day=q();
   1.236      my $last_wday=q();
   1.237 +    my $first_command_of_the_day_unix_time=q();
   1.238 +    my $human_readable_time=q();
   1.239      my $in_range=0;
   1.240  
   1.241      my $current_command=0;
   1.242 @@ -517,6 +579,10 @@
   1.243          my $cl=$Command_Lines[$Command_Lines_Index[$current_command++]];
   1.244          next unless $cl;
   1.245  
   1.246 +        next if $current_command < $Config{"start_from_command"};
   1.247 +        last if $current_command > $Config{"start_from_command"} + $Config{"commands_to_show_at_a_go"};
   1.248 +
   1.249 +
   1.250  # Пропускаем команды, с одинаковым временем
   1.251  # Это не совсем правильно.
   1.252  # Возможно, что это команды, набираемые с помощью <completion>
   1.253 @@ -592,6 +658,7 @@
   1.254  
   1.255          my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time});
   1.256  
   1.257 +
   1.258          # Добавляем спереди 0 для удобочитаемости
   1.259          $min  = "0".$min  if $min  =~ /^.$/;
   1.260          $hour = "0".$hour if $hour =~ /^.$/;
   1.261 @@ -603,6 +670,9 @@
   1.262  
   1.263  # DAY CHANGE
   1.264          if ( $last_day ne $day) {
   1.265 +            $prev_unix_time=$first_command_of_the_day_unix_time;
   1.266 +            $first_command_of_the_day_unix_time = $cl->{time};
   1.267 +            $human_readable_time = strftime "%D", localtime($prev_unix_time);
   1.268              if ($last_day) {
   1.269  
   1.270  # Вычисляем разность множеств.
   1.271 @@ -610,7 +680,9 @@
   1.272  #   @new_commands = keys %frequency_of_command - @known_commands;
   1.273  
   1.274  
   1.275 -                $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
   1.276 +# Выводим предыдущий день
   1.277 +
   1.278 +                $result .= "<h3 id='day_on_sec_$prev_unix_time'>".$Day_Name[$last_wday]." ($human_readable_time)</h3>";
   1.279                  for my $entry_class (sort keys %new_entries_of) {
   1.280                      my $table_caption = "Таблица ".$table_number++.".".$Day_Name[$last_wday]
   1.281                                          .". Новые ".$new_entries_of{$entry_class};
   1.282 @@ -623,7 +695,12 @@
   1.283                  $result .= $this_day_result;
   1.284              }
   1.285  
   1.286 -            push @toc, "<a href='#day$day'>".$Day_Name[$wday]."</a>\n";
   1.287 +# Добавляем текущий день в оглавление
   1.288 +
   1.289 +            $human_readable_time = strftime "%D", localtime($first_command_of_the_day_unix_time);
   1.290 +            push @toc, "<a href='#day_on_sec_$first_command_of_the_day_unix_time'>".$Day_Name[$wday]." ($human_readable_time)</a>\n";
   1.291 +
   1.292 +
   1.293              $last_day=$day;
   1.294              $last_wday=$wday;
   1.295              $this_day_result = q();
   1.296 @@ -672,8 +749,8 @@
   1.297              $cline = "<span class='without_hint'>$cline</span>";
   1.298          }
   1.299  
   1.300 -        $this_day_result .= "<table cellpadding='0' cellspacing='0'><tr><td>\n<div class='cblock_$cl->{class}'>\n";
   1.301 -        $this_day_result .= "<div class='cline'>\n" . $cline ;      #cline
   1.302 +        $this_day_result .= "<DIV class='fixed_div'><table cellpadding='0' cellspacing='0'><tr><td>\n<div class='cblock_$cl->{class}'>\n";
   1.303 +        $this_day_result .= "<div class='cline' onmouseover=\"myHint.show('".$cl->{time}."')\" onmouseout=\"myHint.hide()\">\n" . $cline ;      #cline
   1.304          $this_day_result .= "<span title='Код завершения ".$cl->{"err"}."'>\n"
   1.305                           .  "<img src='".$Config{frontend_ico_path}."/error.png'/>\n"
   1.306                           .  "</span>\n" if $cl->{"err"};
   1.307 @@ -716,11 +793,15 @@
   1.308  
   1.309          # Вывод очередной команды окончен
   1.310          $this_day_result .= "</div>\n";                     # cblock
   1.311 -        $this_day_result .= "</td></tr></table>\n"
   1.312 +        $this_day_result .= "</td></tr></table></DIV>\n"
   1.313                           .  "</div>\n";                     # command
   1.314      }
   1.315      last: {
   1.316 -        $result .= "<h3 id='day$last_day'>".$Day_Name[$last_wday]."</h3>";
   1.317 +        $prev_unix_time=$first_command_of_the_day_unix_time;
   1.318 +        $first_command_of_the_day_unix_time = $cl->{time};
   1.319 +        $human_readable_time = strftime "%D", localtime($prev_unix_time);
   1.320 +
   1.321 +        $result .= "<h3 id='day_on_sec_$prev_unix_time'>".$Day_Name[$last_wday]." ($human_readable_time)</h3>";
   1.322  
   1.323          for my $entry_class (keys %new_entries_of) {
   1.324              my $table_caption = "Таблица ".$table_number++.".".$Day_Name[$last_wday]
   1.325 @@ -1120,7 +1201,8 @@
   1.326      my ($command_lines,$toc)  = print_command_lines_html;
   1.327      my $files_section         = print_files_html;
   1.328  
   1.329 -    $result = print_header_html($toc);
   1.330 +    $result = $debug_output;
   1.331 +    $result .= print_header_html($toc);
   1.332  
   1.333  
   1.334  #    $result.= join " <br/>", keys %Sessions;
   1.335 @@ -1195,9 +1277,11 @@
   1.336  
   1.337  
   1.338      # Управляющая форма отключена
   1.339 -    # Она слишеком сильно мешает, нужно что-то переделать
   1.340 +    # Она слишком сильно мешает, нужно что-то переделать
   1.341      $control_form = "";
   1.342  
   1.343 +    my $tigra_hints_array=tigra_hints_generate;
   1.344 +
   1.345      my $result;
   1.346      $result = <<HEADER;
   1.347      <html>
   1.348 @@ -1207,23 +1291,51 @@
   1.349      <title>$title</title>
   1.350      </head>
   1.351      <body>
   1.352 -    <script>
   1.353 +    <!--<script>
   1.354      $Html_JavaScript
   1.355 -    </script>
   1.356 +    </script>-->
   1.357  
   1.358  <!-- vvv Tigra Hints vvv -->
   1.359  <script language="JavaScript" src="/tigra/hints.js"></script>
   1.360 -<script language="JavaScript" src="/tigra/hints_cfg.js"></script>
   1.361 +<!--<script language="JavaScript" src="/tigra/hints_cfg.js"></script>-->
   1.362 +<script>$tigra_hints_array</script>
   1.363  <style>
   1.364  /* a class for all Tigra Hints boxes, TD object */
   1.365      .hintsClass
   1.366 -        {text-align: center; font-family: Verdana, Arial, Helvetica; padding: 0px 0px 0px 0px;}
   1.367 +        {text-align: left; font-size:80%; font-family: Verdana, Arial, Helvetica; background-color:#ffffee; padding: 0px 0px 0px 0px;}
   1.368  /* this class is used by Tigra Hints wrappers */
   1.369      .row
   1.370          {background: white;}
   1.371 +
   1.372 +
   1.373 +    .bl2 {border: 1px solid #e68200; background:url(/tigra/block/bl2.gif) 0 100% no-repeat; text-align:left}
   1.374 +    .bl {background:url(/tigra/block/bl2.gif) 0 100% no-repeat; text-align:left}
   1.375 +    .br {background:url(/tigra/block/br2.gif) 100% 100% no-repeat}
   1.376 +    .tl {background:url(/tigra/block/tl2.gif) 0 0 no-repeat}
   1.377 +    .tr {background:url(/tigra/block/tr2.gif) 100% 0 no-repeat; padding:10px}
   1.378 +    .tr2 {background:url(/tigra/block/tr2.gif) 100% 0 no-repeat}
   1.379 +    .t {background:url(/tigra/block/dot2.gif) 0 0 repeat-x}
   1.380 +    .b {background:url(/tigra/block/dot2.gif) 0 100% repeat-x}
   1.381 +    .l {background:url(/tigra/block/dot2.gif) 0 0 repeat-y}
   1.382 +    .r {background:url(/tigra/block/dot2.gif) 100% 0 repeat-y}
   1.383 +
   1.384 +
   1.385  </style>
   1.386  <!-- ^^^ Tigra Hints ^^^ -->
   1.387  
   1.388 +<!--
   1.389 +    .bl2 {border: 1px solid #e68200; background:url(/tigra/block/bl2.gif) 0 100% no-repeat; width:20em; text-align:center}
   1.390 +    .bl {background:url(/tigra/block/bl2.gif) 0 100% no-repeat; width:20em; text-align:center}
   1.391 +    .br {background:url(/tigra/block/br2.gif) 100% 100% no-repeat}
   1.392 +    .tl {background:url(/tigra/block/tl2.gif) 0 0 no-repeat}
   1.393 +    .tr {background:url(/tigra/block/tr2.gif) 100% 0 no-repeat; padding:10px}
   1.394 +    .tr2 {background:url(/tigra/block/tr2.gif) 100% 0 no-repeat}
   1.395 +    .t {background:url(/tigra/block/dot2.gif) 0 0 repeat-x; width:20em}
   1.396 +    .b {background:url(/tigra/block/dot2.gif) 0 100% repeat-x}
   1.397 +    .l {background:url(/tigra/block/dot2.gif) 0 0 repeat-y}
   1.398 +    .r {background:url(/tigra/block/dot2.gif) 100% 0 repeat-y}
   1.399 +-->
   1.400 +
   1.401  
   1.402      <div class='edit_link'>
   1.403      [ <a href='?action=edit&$filter_url'>править</a> ]
   1.404 @@ -1824,3 +1936,199 @@
   1.405                  $Search_Machines{$sm}->{"icon"}."' border='0'/></a>";
   1.406  }
   1.407  
   1.408 +
   1.409 +
   1.410 +
   1.411 +########################################################################################
   1.412 +#
   1.413 +# mywi
   1.414 +#
   1.415 +# 
   1.416 +#
   1.417 +#
   1.418 +#
   1.419 +#
   1.420 +#
   1.421 +
   1.422 +
   1.423 +
   1.424 +sub mywi_init
   1.425 +{
   1.426 +    our $MyWiFile = "/home/devi/mywi/mywi.txt";
   1.427 +    our $MyWiLog = "/home/devi/mywi/mywi.log";
   1.428 +    our $section="";
   1.429 +
   1.430 +    our @MywiTXT;       # Массив текстовых записей mywi
   1.431 +    our %MywiHASH;      # Хэш массивов записей
   1.432 +    our %Query;
   1.433 +
   1.434 +    load_mywitxt($MyWiFile, \@MywiTXT, \%MywiHASH);
   1.435 +}
   1.436 +
   1.437 +sub mywi_process_query($)
   1.438 +#
   1.439 +# Сделать подсказку по заданному запросу
   1.440 +# $_[0] - тема для подсказки
   1.441 +# 
   1.442 +# Возвращает:
   1.443 +#   строку-подсказку
   1.444 +#
   1.445 +{
   1.446 +    my $query = shift;
   1.447 +    parse_query($query, \%Query);
   1.448 +    $result = search_in_txt(\%Query, \@MywiTXT, \%MywiHASH);
   1.449 +
   1.450 +    if (!$result) {
   1.451 +        #add_to_log(\%Query, $MyWiLog);
   1.452 +        return "$query nothing appropriate.  Logged. ".join (";",%Query);
   1.453 +    }   
   1.454 +
   1.455 +    return $result;
   1.456 +}
   1.457 +
   1.458 +####################################################################################
   1.459 +#                                   private section
   1.460 +####################################################################################
   1.461 +
   1.462 +sub load_mywitxt
   1.463 +#
   1.464 +# Загрузить файл с записями Mywi_TXT
   1.465 +# в массив
   1.466 +# $_[0] - указатель на массив для загрузки
   1.467 +# $_[1] - имя файла для загрузки
   1.468 +# 
   1.469 +{
   1.470 +    my $MyWiFile = $_[0];
   1.471 +    my $MywiTXT = $_[1];
   1.472 +    my $MywiHASH = $_[2];
   1.473 +    
   1.474 +    open (MW, "$MyWiFile") or die "Can't open $MyWiFile for reading";
   1.475 +    binmode MW, ":utf8";
   1.476 +    @{$MywiTXT} = <MW>;
   1.477 +    close (MWF);
   1.478 +
   1.479 +    for my $mywi_line (@{$MywiTXT}) {
   1.480 +        my $topic = $mywi_line;
   1.481 +        $topic =~ s@\s*\(.*\n@@;
   1.482 +        push @{$$MywiHASH{"$topic"}}, $mywi_line;
   1.483 +#        $MywiHASH{"$topic"} .= $mywi_line;
   1.484 +    }
   1.485 +}
   1.486 +
   1.487 +sub parse_query
   1.488 +#
   1.489 +# Строка запроса:
   1.490 +#   [format:]topic[(section)]
   1.491 +# Элементы format и topic являются не обязательными
   1.492 +#
   1.493 +# $_[0] - строка запроса
   1.494 +# $_[1] - ссылка на хэш запроса
   1.495 +#
   1.496 +{
   1.497 +    my $query_string = shift;
   1.498 +    my $query_hash = shift;
   1.499 +
   1.500 +    %{$query_hash} = (
   1.501 +        "format"    =>  "txt",
   1.502 +        "section"   =>  "",
   1.503 +        "topic" =>  "",
   1.504 +    );
   1.505 +
   1.506 +    if ($query_string =~ s/^([^:]*)://) {
   1.507 +        $query_hash->{"format"} = $1 || "txt";
   1.508 +    }
   1.509 +    if ($query_string =~ s/\(([^(]*)\)$//) {
   1.510 +        $query_hash->{"section"} = $1 || "";
   1.511 +    }
   1.512 +    $query_hash->{"topic"} = $query_string;
   1.513 +}
   1.514 +
   1.515 +
   1.516 +sub search_in_txt
   1.517 +#
   1.518 +# Выполнить поиск в текстовой базе 
   1.519 +# по известному запросу
   1.520 +# $_[0] -- ссылка на хэш запроса
   1.521 +# $_[1] -- ссылка на массив текстовых записей
   1.522 +# $_[2] -- ссылка на хэш массивов текстовых записей
   1.523 +# Результат:
   1.524 +#   найденная текстовая запись в заданном формате
   1.525 +#
   1.526 +{
   1.527 +    my %Query = %{$_[0]};
   1.528 +    my %MywiHASH = %{$_[2]};
   1.529 +
   1.530 +    my $topic = $Query{"topic"};
   1.531 +    my $section = $Query{"section"};
   1.532 +    my $result = "";
   1.533 +
   1.534 +    return join("\n",@{$MywiHASH{"$topic"}})."\n";
   1.535 +
   1.536 +    for my $l (@{$$_[2]{$topic}}) {
   1.537 +#    for my $l (@{$_[1]}) {
   1.538 +        my $line = $l;
   1.539 +        if (
   1.540 +            ($section and $line =~ /^\s*\Q$topic\E\s*\($section*\)\s*-/ )
   1.541 +            or (not $section and $line =~ /^\s*\Q$topic\E\s*(\([^)]*\)?)\s*-/) ) {
   1.542 +            $line =~ s/^.* -//mg if ($Config{"short"});
   1.543 +            $result .= "<para>$line</para>";
   1.544 +        }
   1.545 +    }
   1.546 +    return $result;
   1.547 +}
   1.548 +
   1.549 +
   1.550 +sub add_to_log($$)
   1.551 +#
   1.552 +# Если в базе отсутствует информация по данной теме, 
   1.553 +# сделать предположение доступным способом
   1.554 +# и добавить его в базу
   1.555 +# или просто сделать отметку о необходимости 
   1.556 +# расширения базы
   1.557 +#
   1.558 +# Добавить запись в журнал
   1.559 +# $_[0] - запись (ссылка на хэш)
   1.560 +# $_[1] - имя файла-журнала
   1.561 +#
   1.562 +{
   1.563 +    my $query = $_[0];
   1.564 +    my $MyWiLog = $_[1];
   1.565 +
   1.566 +    open (MWF, ">>:utf8", $MyWiLog) or die "Can't open $MyWiLog for writing";
   1.567 +    my $my_guess = mywi_guess($query);
   1.568 +    print MWF "$my_guess\n";
   1.569 +    close(MWF);
   1.570 +}
   1.571 +
   1.572 +sub mywi_guess($)
   1.573 +# Сформировать исходную строку для журнала по заданному запросу
   1.574 +# Если секция принадлежит 0..9, в качестве основы для результирующего текста использовать whatis
   1.575 +# $_[0] - запись (ссылка на хэш)
   1.576 +# 
   1.577 +# Возвращает:
   1.578 +#   строку-предположение
   1.579 +{
   1.580 +    my %query = %{$_[0]};
   1.581 +
   1.582 +    my $topic = $query{"topic"};
   1.583 +    my $section = $query{"section"};
   1.584 +    
   1.585 +    my $result = "$topic($section)";
   1.586 +    if (!$section or $section =~ /^[1-9]$/)
   1.587 +    {
   1.588 +        # Запрос из категории 1-9
   1.589 +        # Об этом может знать whatis
   1.590 +        $result = `LANG=C whatis -- "$topic"`;
   1.591 +        if ($result =~ /nothing appropriate/i) {
   1.592 +            $result = $topic;
   1.593 +            $result .= "($section)" if $section;
   1.594 +        }
   1.595 +        else {
   1.596 +            1 while ($result =~ s/(\s+)-(\s+)/$1+$2/sg);
   1.597 +            $result =~ s/\s+\(/(/;
   1.598 +            chomp $result;
   1.599 +        }
   1.600 +    }   
   1.601 +    return $result;
   1.602 +}
   1.603 +