lilalo
diff l3-frontend @ 110:2fc1f3f08760
fix
| author | igor |
|---|---|
| date | Wed Feb 13 02:43:33 2008 +0200 (2008-02-13) |
| parents | 54fbf2041159 |
| children | 99ea38e538c9 |
line diff
1.1 --- a/l3-frontend Fri Aug 04 18:06:09 2006 +0300 1.2 +++ b/l3-frontend Wed Feb 13 02:43:33 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 +