File Coverage

blib/lib/Net/DirectConnect/pslib/psmisc.pm

Criterion	Covered	Total	%
statement	53	891	5.9
branch	5	602	0.8
condition	5	547	0.9
subroutine	18	134	13.4
pod	0	97	0.0
total	81	2271	3.5

#!/usr/bin/perl
#$Id: psmisc.pm 4847 2014-06-30 23:41:45Z pro $ $URL: svn://svn.setun.net/search/trunk/lib/psmisc.pm $

=copyright
PRO-search shared library
Copyright (C) 2003-2011 Oleg Alexeenkov http://pro.setun.net/search/ [e-mail]

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see .
=cut

#print "Content-type: text/html\n\n" if defined($ENV{'SERVER_PORT'}); # for web dev debug
#print "misc execute " , $mi++;
#=pac
#local *config = *main::config;
#%config
#our ( %config );
package    #not ready for cpan
  psmisc;
use strict;
no warnings qw(uninitialized);
no if $] >= 5.017011, warnings => 'experimental::smartmatch';
use utf8;
#use open qw(:utf8 :std);
#use encoding "utf8", STDOUT => "utf8", STDIN => "utf8", STDERR => "utf8";
#use open ':utf8';
use Socket;
use Time::HiRes qw(time);
#use locale;
use Encode;
use POSIX qw(strftime);
use lib::abs;
our $VERSION = ( split( ' ', '$Revision: 4847 $' ) )[1];
our (%config);
#my ( %config );
#local *config = *main::config;
#local
#*psmisc::config = *main::config;
*config = *main::config;
*stat   = *main::stat;
*work   = *main::work;
*param  = *main::param;
*static = *main::static;
#*psmisc::program = *main::program;
use Data::Dumper;    #dev only
$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = 1;
#use vars qw( %config %work %stat %static $param %processor %program %out );    #%human,
#our ( @ISA, @EXPORT, @EXPORT_OK ,%EXPORT_TAGS);
our ( @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
#use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
#require Exporter;
use Exporter 'import';
#our
#@
#@ISA = qw(Exporter);
#    @EXPORT      = qw(A1 A2 A3 A4 A5);
#    @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
#    %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
#our  %config;
@EXPORT = qw(
);
@EXPORT_OK = qw(
  get_params_one
  get_params
  array
  encode_url
  encode_url_link
  decode_url
  printlog
  dmp
  printprog
  openproc
  state
  hconfig
  html_chars
  name_to_ip
  normalize_ip
  ip_to_name
  counter
  timer
  join_url
  split_url
  full_host
  cp_trans
  utf_trans
  to_utf_trans
  cp_trans_hash
  cp_detect_trans
  lang
  min
  max
  alarmed
  mkdir_rec
  sleeper
  mysleep
  check_int
  shuffle
  config_reload
  conf
  http_get
  http_get_code
  loadlist
  shelldata
  printall
  %work %static $param
  %program
);
#  %config
%EXPORT_TAGS = ( log => [qw(printlog dmp)], config => [qw(%config)], all => \@EXPORT_OK, );    #%human %out %processor  %stat

=no
  open_out_file
  close_out_file
=cut

#flush
#our ( %config, %work, %stat, %static, $param, %program, $root_path,  );    #%human, %out, %processor,
our ( %work, %static, $param, %program, $root_path, );                                         #%human, %out, %processor, %stat,
#my %human;
#sub conf_once {
sub config_init {
  return if $static{'lib_init_psmisc'}{ $ENV{'SCRIPT_FILENAME'} }++;
  my ($param) = @_;
  #print "  config_init;";
  #caller_trace(10);
  conf(
    sub {
      #print "  config_init:sub;";
      $config{'stderr_redirect'} ||= '2>&1';                                                   #'2>/dev/null';
#A                                                              |                                                            YA  E   a                                                              |                                                            ya  e   |-ukr------------------|
      $config{'trans'}{'cp1251'} ||=
"\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xA8\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF\xB8\xB2\xB3\xAF\xBF\xAA\xBA";
      $config{'trans'}{'koi8-r'} ||=
"\xE1\xE2\xF7\xE7\xE4\xE5\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1\xB3\xC1\xC2\xD7\xC7\xC4\xC5\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1\xA3\xB6\xA6\xB7\xA7\xB4\xA4";
      $config{'trans'}{'iso8859-5'} ||=
"\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xA1\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF1\xA6\xF6\xA7\xF7\xA4\xF4";
      $config{'trans'}{'cp866'} ||=
"\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\xF0\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF1\xF6\xF7\xF8\xF9\xF4\xF5";
      $config{'trans'}{'utf-8'} ||= "\xD0\xD1";                                                #JUST TRICK for autodetect
      #$config{'trans_up'}{$_} = (split//, $config{'trans'}{$_})[0..32] for keys %{$config{'trans'}};
      $config{'trans_up'}{$_}   = substr( $config{'trans'}{$_}, 0,  33 ),
        $config{'trans_lo'}{$_} = substr( $config{'trans'}{$_}, 33, 33 ),
        #print("$config{'trans_up'}{$_}\n$config{'trans_lo'}{$_}\n"),
        for grep { length $config{'trans'}{$_} >= 66 } keys %{ $config{'trans'} };
      #exit;

=with 50% UPPER case
#cp detect with cp_learn_symbols=10; from 28691 bytes text
  $config{'trans_detect'}{'cp1251'}	||= '\xCE\xEE\xC0\xE0\xE5\xC5\xD2\xF2\xE8\xC8';	#  [­Ќоћ…Ґађ•е] = [­Ќоћ…Ґађ•е];	stat:­[CE]=658; Ќ[EE]=658; о[C0]=578; ћ[E0]=578; …[E5]=503; Ґ[C5]=503; а[D2]=434; ђ[F2]=434; •[E8]=422; е[C8]=422;
  $config{'trans_detect'}{'cp866'}	||= '\xAE\x8E\x80\xA0\xA5\x85\x92\xE2\xA8\x88';	#  [R__Н_:'Ѓ»_] = [Ќ­оћ…Ґађ•е];	stat:Ќ[AE]=658; ­[8E]=658; о[80]=578; ћ[A0]=578; …[A5]=503; Ґ[85]=503; а[92]=434; ђ[E2]=434; •[A8]=422; е[88]=422;
  $config{'trans_detect'}{'koi8-r'}	||= '\xCF\xEF\xC1\xE1\xC5\xE5\xD4\xF4\xC9\xE9';	#  [®Ћ ЂҐ…в’Ё€] = [Ќ­ћо…Ґђа•е];	stat:Ќ[CF]=658; ­[EF]=658; ћ[C1]=578; о[E1]=578; …[C5]=503; Ґ[E5]=503; ђ[D4]=434; а[F4]=434; •[C9]=422; е[E9]=422;
  $config{'trans_detect'}{'utf-8'}	||= '\xD0\xD1\x9E\xBE\xB0\x90\x95\xB5\xA2\x82';	#  [Їп__З_‚Х'] = [Їпз_ЗЇг‚ЃЎ];	stat:Ї[D0]=10542; п[D1]=1934; з[9E]=658; _[BE]=658; З[B0]=578; Ї[90]=578; г[95]=503; ‚[B5]=503; Ѓ[A2]=434; Ў[82]=434;
#$config{'trans_detect'}{'iso8859-5'}	||= '\xDE\xBE\xD0\xB0\xB5\xD5\xC2\xE2\xB8\xD8';	#  [з_ЇЗ‚гЎЃЛм] = [Ќ­ћоҐ…ађе•];	stat:Ќ[DE]=658; ­[BE]=658; ћ[D0]=578; о[B0]=578; Ґ[B5]=503; …[D5]=503; а[C2]=434; ђ[E2]=434; е[B8]=422; •[D8]=422;
=cut

=was
#cp detect with cp_learn_symbols=20; from 14344 bytes text
      $config{'trans_detect'}{'cp1251'} ||= '\xEE\xE0\xE5\xF2\xE8\xED\xF1\xF0\xE2\xEA\xEB\xEF\xE4\xFC\xEC\xE7\xF3\xE1\xFB\xF7'
        ; #  [Ќћ…ђ•ЊџЏЃ‰ЉЋ„ќ‹ѓ‘Ђ˜‚] = [Ќћ…ђ•ЊџЏЃ‰ЉЋ„ќ‹ѓ‘Ђ˜‚];	stat:Ќ[EE]=649; ћ[E0]=573; …[E5]=489; ђ[F2]=425; •[E8]=416; Њ[ED]=410; џ[F1]=379; Џ[F0]=296; Ѓ[E2]=269; ‰[EA]=256; Љ[EB]=221; Ћ[EF]=194; „[E4]=174; ќ[FC]=156; ‹[EC]=153; ѓ[E7]=152; ‘[F3]=141; Ђ[E1]=109; ˜[FB]=108; ‚[F7]=100;
      $config{'trans_detect'}{'cp866'} ||= '\xAE\xA0\xA5\xE2\xA8\xAD\xE1\xE0\xA2\xAA\xAB\xAF\xA4\xEC\xAC\xA7\xE3\xA1\xEB\xE7'
        ; #  [RН_Ѓ»-ЂћХУ<ЖЦ‹ѕ·–єЉѓ] = [Ќћ…ђ•ЊџЏЃ‰ЉЋ„ќ‹ѓ‘Ђ˜‚];	stat:Ќ[AE]=649; ћ[A0]=573; …[A5]=489; ђ[E2]=425; •[A8]=416; Њ[AD]=410; џ[E1]=379; Џ[E0]=296; Ѓ[A2]=269; ‰[AA]=256; Љ[AB]=221; Ћ[AF]=194; „[A4]=174; ќ[EC]=156; ‹[AC]=153; ѓ[A7]=152; ‘[E3]=141; Ђ[A1]=109; ˜[EB]=108; ‚[E7]=100;
      $config{'trans_detect'}{'koi8-r'} ||= '\xCF\xC1\xC5\xD4\xC9\xCE\xD3\xD2\xD7\xCB\xCC\xD0\xC4\xD8\xCD\xDA\xD5\xC2\xD9\xDE'
        ; #  [® ҐвЁ­баўЄ«Ї¤м¬§гЎлз] = [Ќћ…ђ•ЊџЏЃ‰ЉЋ„ќ‹ѓ‘Ђ˜‚];	stat:Ќ[CF]=649; ћ[C1]=573; …[C5]=489; ђ[D4]=425; •[C9]=416; Њ[CE]=410; џ[D3]=379; Џ[D2]=296; Ѓ[D7]=269; ‰[CB]=256; Љ[CC]=221; Ћ[D0]=194; „[C4]=174; ќ[D8]=156; ‹[CD]=153; ѓ[DA]=152; ‘[D5]=141; Ђ[C2]=109; ˜[D9]=108; ‚[DE]=100;
      $config{'trans_detect'}{'utf-8'} ||= '\xD0\xD1\xBE\xB0\xB5\x82\xB8\xBD\x81\x80\xB2\xBA\xBB\xBF\xB4\x8C\xBC\xB7\x83\xB1'
        ; #  [Їп_З‚'Л____Р>ь___Т_+] = [Їп_З‚ЎЛ_ о_Р>ь_«_Тж+];	stat:Ї[D0]=4352; п[D1]=1894; _[BE]=649; З[B0]=573; ‚[B5]=489; Ў[82]=425; Л[B8]=416; _[BD]=410;  [81]=379; о[80]=296; _[B2]=269; Р[BA]=256; >[BB]=221; ь[BF]=194; _[B4]=174; «[8C]=156; _[BC]=153; Т[B7]=152; ж[83]=141; +[B1]=109;
=cut

      #cp detect with cp_learn_symbols=20; from 145699 bytes text
      $config{'trans_detect'}{'cp1251'} = '\xEE\xE0\xE5\xE8\xED\xF2\xF1\xF0\xEB\xE2\xEA\xF3\xEF\xEC\xE4\xFF\xFB\xFC\xE7\xE3'
        ; #  [оаеинтсрлвкупмдяыьзг] = [оаеинтсрлвкупмдяыьзг];	stat:о[EE]=12122; а[E0]=10566; е[E5]=9827; и[E8]=8929; н[ED]=7504; т[F2]=6931; с[F1]=6839; р[F0]=6744; л[EB]=6225; в[E2]=5384; к[EA]=4505; у[F3]=3912; п[EF]=3864; м[EC]=3811; д[E4]=3497; я[FF]=3047; ы[FB]=2693; ь[FC]=2628; з[E7]=2192; г[E3]=1934;
      $config{'trans_detect'}{'utf-8'} = '\xD0\xD1\xBE\xB0\xB5\xB8\xBD\x82\x81\x80\xBB\xB2\xBA\x83\xBF\xBC\xB4\x8F\x8B\x8C'
        ; #  [РС?°чё?'??>Iє?ї???IєГї??ПЛМ];	stat:Р[D0]=88304; С[D1]=39900; ?[BE]=12122; °[B0]=10566; ч[B5]=9827; ё[B8]=8929; ?[BD]=7504; В[82]=6931; Б[81]=6845; А[80]=6744; >[BB]=6225; I[B2]=5384; є[BA]=4505; Г[83]=3912; ї[BF]=3864; ?[BC]=3811; ?[B4]=3497; П[8F]=3047; Л[8B]=2693; М[8C]=2628;
      $config{'trans_detect'}{'cp866'} = '\xAE\xA0\xA5\xA8\xAD\xE2\xE1\xE0\xAB\xA2\xAA\xE3\xAF\xAC\xA4\xEF\xEB\xEC\xA7\xA3'
        ; #  [R ?Ё-вба<ўЄгЇ¬¤плм§?] = [оаеинтсрлвкупмдяыьзг];	stat:о[AE]=12122; а[A0]=10566; е[A5]=9827; и[A8]=8929; н[AD]=7504; т[E2]=6931; с[E1]=6839; р[E0]=6744; л[AB]=6225; в[A2]=5384; к[AA]=4505; у[E3]=3912; п[AF]=3864; м[AC]=3811; д[A4]=3497; я[EF]=3047; ы[EB]=2693; ь[EC]=2628; з[A7]=2192; г[A3]=1934;
      $config{'trans_detect'}{'koi8-r'} = '\xCF\xC1\xC5\xC9\xCE\xD4\xD3\xD2\xCC\xD7\xCB\xD5\xD0\xCD\xC4\xD1\xD9\xD8\xDA\xC7'
        ; #  [ПБЕЙОФУТМЧЛХРНДСЩШЪЗ] = [оаеинтсрлвкупмдяыьзг];	stat:о[CF]=12122; а[C1]=10566; е[C5]=9827; и[C9]=8929; н[CE]=7504; т[D4]=6931; с[D3]=6839; р[D2]=6744; л[CC]=6225; в[D7]=5384; к[CB]=4505; у[D5]=3912; п[D0]=3864; м[CD]=3811; д[C4]=3497; я[D1]=3047; ы[D9]=2693; ь[D8]=2628; з[DA]=2192; г[C7]=1934;
#$config{'trans_detect'}{'iso8859-5'}	= '\xDE\xD0\xD5\xD8\xDD\xE2\xE1\xE0\xDB\xD2\xDA\xE3\xDF\xDC\xD4\xEF\xEB\xEC\xD7\xD3';	#  [ЮРХШЭвбаЫТЪгЯЬФплмЧУ] = [оаеинтсрлвкупмдяыьзг];	stat:о[DE]=12122; а[D0]=10566; е[D5]=9827; и[D8]=8929; н[DD]=7504; т[E2]=6931; с[E1]=6839; р[E0]=6744; л[DB]=6225; в[D2]=5384; к[DA]=4505; у[E3]=3912; п[DF]=3864; м[DC]=3811; д[D4]=3497; я[EF]=3047; ы[EB]=2693; ь[EC]=2628; з[D7]=2192; г[D3]=1934;
#$config{'trans_detect'}{'iso8859-5'}	||= '\xDE\xD0\xD5\xE2\xD8\xDD\xE1\xE0\xD2\xDA\xDB\xDF\xD4\xEC\xDC\xD7\xE3\xD1\xEB\xE7';	#  [зЇгЃмйЂћа§икв‹нў–пЉѓ] = [Ќћ…ђ•ЊџЏЃ‰ЉЋ„ќ‹ѓ‘Ђ˜‚];	stat:Ќ[DE]=649; ћ[D0]=573; …[D5]=489; ђ[E2]=425; •[D8]=416; Њ[DD]=410; џ[E1]=379; Џ[E0]=296; Ѓ[D2]=269; ‰[DA]=256; Љ[DB]=221; Ћ[DF]=194; „[D4]=174; ќ[EC]=156; ‹[DC]=153; ѓ[D7]=152; ‘[E3]=141; Ђ[D1]=109; ˜[EB]=108; ‚[E7]=100;
#$config{'trans_detect'}{'cp1251'}	||= "\xE0\xC0\xEE\xCE"; #ћо Ќ­
#$config{'trans_detect'}{'cp866'}	||= "\xA0\x80\xAE\x8E";
#$config{'trans_detect'}{'koi8-r'}	||= "\xC1\xE1\xCF\xEF";
## $config{'trans_detect'}{'iso8859-5'}	||= "\xD0\xB0\xDE\xBE";
      #$config{'trans_detect'}{'utf-8'}	||= "\xD0\xD1";
      #$config{'trans_detect'}{'bin'} ||= join '', map{'\\x'.sprintf '%02X', $_}0..0x08,0x0B,0x0C,0x0E,0x0F;
      #$config{'trans_detect'}{'latin'} ||= 'a-zA-Z';
      #print $config{'trans_detect'}{'bin'};exit;
      #$config{'trans_name'}{'cp1251'} ||= 'cp1251';
      $config{'trans_name'}{'win1251'}      ||= 'cp1251';
      $config{'trans_name'}{'windows1251'}  ||= 'cp1251';
      $config{'trans_name'}{'windows-1251'} ||= 'cp1251';
      $config{'trans_name'}{'win'}          ||= 'cp1251';
      $config{'trans_name'}{'1251'}         ||= 'cp1251';
      #$config{'trans_name'}{'koi8-r'} ||= 'koi8-r';
      $config{'trans_name'}{'koi8r'} ||= 'koi8-r';
      $config{'trans_name'}{'koi8'}  ||= 'koi8-r';
      $config{'trans_name'}{'koi'}   ||= 'koi8-r';
      #$config{'trans_name'}{'iso8859-5'} ||='iso8859-5';
      $config{'trans_name'}{'iso88595'} ||= 'iso8859-5';
      $config{'trans_name'}{'iso8859'}  ||= 'iso8859-5';
      $config{'trans_name'}{'iso'}      ||= 'iso8859-5';
      #$config{'trans_name'}{'cp866'} ||='cp866';
      $config{'trans_name'}{'866'} ||= 'cp866';
      $config{'trans_name'}{'dos'} ||= 'cp866';
      #$config{'trans_name'}{'utf-8'} ||= 'utf-8';
      $config{'trans_name'}{'utf8'}  ||= 'utf-8';
      $config{'trans_name'}{'utf'}   ||= 'utf-8';
      $config{'cp_detect_strings'}   ||= 0;
      $config{'cp_detect_letters'}   ||= 2;
      $config{'cp_detect_length'}    ||= 10000;
      $config{'kilo'}                ||= 8;                                                      # 5000k 6000k 7000k >8
      $config{'lng'}{'en'}{'months'} ||= [qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)];
      $config{'lng'}{'ru'}{'months'} ||=
        [qw(Янв Фев Мар Апр Май Июн Июл Авг Сен Окт Ноя Дек)];
      @{ $config{'lng'}{$_}{'month_table'} }{ @{ $config{'lng'}{$_}{'months'} || [] } } = ( 0 .. 11 )
        for keys %{ $config{'lng'} };
      #@{ $config{'lng'}{''}{'month_table'} }{ @{ $config{'lng'}{''}{'months'} } } = ( 0 .. 11 )  ;
      $config{'lng'}{'en'}{'wdays'} ||= [qw(Sun Mon Tue Wed Thu Fri Sat)];
      $config{'log_screen'}         ||= 1;
      $config{'log_dir'}            ||= $config{'root_path'};
      unless ( $ENV{'SERVER_PORT'} ) {
        $0 =~ m{([^\\/\s]+)\.\w+$};
        #warn "LD[$0:$1]";
        $config{'log_default'} ||= ( $1 // $0 // 'log' ) . '.log';
      }
      #$config{'log_all'}     ||= '#book.log';
      #$config{'log_all'}     ||= '1';
      $config{'encode_url_file_mask'} ||= '[^a-zA-Z0-9\-.()_]';    #url = '[^a-zA-Z0-9\-.()_!,]';
      $config{'human'}{'date'} ||= sub {                           #v1
        #my ( $day_of_month, $month, $year ) = ( localtime( ( $_[0] or time() ) ) )[ 3 .. 5 ];
        #return sprintf( '%04d' . ( ( ( $_[1] or '/' ) . '%02d' ) x 2 ), $year + 1900, $month + 1, $day_of_month );
        my $d = $_[1] || '/';
        return strftime "%Y${d}%m${d}%d", localtime( $_[0] || time() );
        #strftime "%Y%m%d%H%M%S", localtime
      };
      $config{'human'}{'time'} ||= sub {
#return          sprintf( join( ( $_[1] or ':' ), ( ("%02d") x 3 ) ), ( reverse( ( localtime( ( $_[0] or time() ) ) )[ 0 .. 2 ] ) ) );
        my $d = $_[1] || ':';
        return strftime "%H${d}%M${d}%S", localtime( $_[0] || time() );
      };
      # strftime "%Y-%m-%dT%H:%M:%S", localtime( $_[0] || time() )
      $config{'human'}{'date_time'} ||=
        sub { return human( 'date', $_[0] || time(), $_[2] ) . ( $_[1] || '-' ) . human( 'time', $_[0] || time(), $_[3] ); };
      $config{'human'}{'float'} ||= sub {    #v1
        return ( $_[0] < 8 and $_[0] - int( $_[0] ) )
          ? sprintf( '%.' . ( $_[0] < 1 ? 3 : ( $_[0] < 3 ? 2 : 1 ) ) . 'f', $_[0] )
          : int( $_[0] );
      };
      $config{'human'}{'micro_time'} ||= sub {
        my $now = time();
        ( $now = human( 'float', abs( int($now) - $now ) ) ) =~ s/^0//;
        return ( $now or '' );
      };
      $config{'human'}{'rfc822_date_time'} ||= sub {
        my ( $day_of_month, $month, $year, $wday ) = ( localtime( ( $_[0] or time() ) ) )[ 3 .. 6 ];
        return sprintf( $config{'lng'}{'en'}{'wdays'}[$wday] . ', %02d ' . $config{'lng'}{'en'}{'months'}[$month] . ' %02d',
          $day_of_month, $year + 1900 )
          . ' '
          . $config{'human'}{'time'}->( ( $_[0] or time() ) )
          . ' +0300';
      };
      $config{'human'}{'size'} ||= sub {
        my ( $size, $sp, $unit, $kilo ) = @_;
        $sp   //= ( $ENV{'SERVER_PORT'} ? ' ' : ' ' );
        $unit //= 'B';
        $kilo //= $config{'kilo'} || 8;
        return int( $size / 1099511627776 ) . $sp . 'T' . $unit if ( $size >= $kilo * 1099511627776 );
        return int( $size / 1073741824 ) . $sp . 'G' . $unit    if ( $size >= $kilo * 1073741824 );
        return int( $size / 1048576 ) . $sp . 'M' . $unit       if ( $size >= $kilo * 1048576 );
        return int( $size / 1024 ) . $sp . 'K' . $unit          if ( $size >= $kilo * 1024 );
        return human( 'float', $size ) . $sp . $unit if ( $size > 0 );
        return $size;
      };
      $config{'human'}{'number_k'} ||= sub {
        local $_ = $_[0];
        $_ *= 1024          if ( $_ =~ s/kb?$//gi );
        $_ *= 1048576       if ( $_ =~ s/mb?$//gi );
        $_ *= 1073741824    if ( $_ =~ s/gb?$//gi );
        $_ *= 1099511627776 if ( $_ =~ s/tb?$//gi );
        return $_;
      };
      $config{'human'}{'procent'} ||= sub {    #v1
        return sprintf( '%' . ( $_[0] < 10 ? '.3f' : 'd' ), $_[0] ) . '%';
      };
      $config{'human'}{'time_period'} ||= sub {    #v0
        my ( $tim, $delim, $sign ) = @_;
        $sign = '-', $tim = -$tim if $tim < 0;
        #print("tpern[", $tim, ']'),
        return '' if $tim == 0 or $tim > 1000000000;
        #print("tperf[", $tim, ']'),
        return ( $sign . human( 'float', $tim ) . $delim . "s" ) if $tim < 60;
        $tim = $tim / 60;
        return ( $sign . int($tim) . $delim . "m" ) if $tim < 60;
        $tim = $tim / 60;
        return ( $sign . int($tim) . $delim . "h" ) if $tim < 24;
        $tim = $tim / 24;
        return ( $sign . int($tim) . $delim . "d" ) if $tim <= 31;
        $tim = $tim / 30.5;
        return ( $sign . int($tim) . $delim . "M" ) if $tim < 12;
        $tim = $tim / 12;
        return ( $sign . int($tim) . $delim . "Y" );
      };
      $config{'human'}{'number'} ||= sub {    #v0 #FIXIT
        #return $_ = reverse( join( ' ', split( /(\d{3})/, reverse $_[0] ) ) );
        #local $_ = reverse( join( ' ', split( /(\d{3})/, reverse $_[0] ) ) );
        #return $_;
        #return reverse( join( ' ', grep {length $_} split( /(\d{3})/, reverse $_[0] ) ) )
        return local $_ = reverse join ' ', grep { length $_ } split /(\d{3})/, reverse $_[0];
      };
      #print 'dh1:',Dumper $config{'human'};
      $config{'human'}{'string_long'} ||= sub {
        my $maxlen = ( $_[1] or 20 );
        html_chars( \$_[0] );
        return $_[0] if length $_[0] <= $maxlen;
        my $print = substr( $_[0], 0, $maxlen );
        $print =~ s/[\xD0\xD1]$//;
        $_[0]  =~ s/\"/"/g;
        return "$print...";
      };
      #print 'dh2:',Dumper $config{'human'};
    },
    1010,
  );
}

sub get_params_one(@) {    # p=x,p=y,p=z => p=x,p1=y,p2=z ; p>=z => p=z, p_mode='>'; p => p; -p => -p=1;
  local %_ = %{ ref $_[0] eq 'HASH' ? shift : {} };
  for (@_) {               # PERL RULEZ # SORRY # 8-) #
   #tr/+/ /, s/%([a-f\d]{2})/pack 'C', hex $1/gei for my ( $k, $v ) = /^([^=]+=?)=(.+)$/ ? ( $1, $2 ) : ( /^([^=]*)=?$/, /^-/ );
    tr/+/ /, s/%([a-f\d]{2})/pack 'H*', $1/gei for my ( $k, $v ) = /^([^=]+=?)=(.+)$/ ? ( $1, $2 ) : ( /^([^=]*)=?$/, /^-/ );
    $_{"${1}_mode$2"} .= $3 if $k =~ s/^(.+?)(\d*)([=!><~@]+)$/$1$2/;
    $k =~ s/(\d*)$/($1 < 100 ? $1 + 1 : last)/e while defined $_{$k};
    $_{$k} = $v;           #lc can be here
  }
  wantarray ? %_ : \%_;
}

sub get_params(;$$) {      #v7
  my ( $string, $delim ) = @_;
  $delim ||= '&';
  read( STDIN, local $_ = '', $ENV{'CONTENT_LENGTH'} ) if !$string and $ENV{'CONTENT_LENGTH'};
  local %_ = $string
    ? get_params_one split $delim, $string
    : (
    get_params_one(@ARGV), map { get_params_one split $delim, $_ } split( /;\s*/, $ENV{'HTTP_COOKIE'} ),
    $ENV{'QUERY_STRING'}, $_
    );
  #dmp (\%_);
  wantarray ? %_ : \%_;
}

sub get_params_utf8(;$$) {
  local $_ = &get_params;
  utf8::decode $_ for %$_;
  #dmp (\%_);
  wantarray ? %$_ : $_;
}

sub use_try ($;@) {
  ( my $path = ( my $module = shift ) . '.pm' ) =~ s{::}{/}g;
  $INC{$path} or eval 'use ' . $module . ' qw(' . ( join ' ', @_ ) . ');1;' and $INC{$path};
}
sub is_array ($)      { UNIVERSAL::isa( $_[0], 'ARRAY' ) }
sub is_array_size ($) { UNIVERSAL::isa( $_[0], 'ARRAY' ) and @{ $_[0] } }
sub is_hash ($)       { UNIVERSAL::isa( $_[0], 'HASH' ) }
sub is_hash_size ($)  { UNIVERSAL::isa( $_[0], 'HASH' ) and %{ $_[0] } }
sub is_code ($)       { UNIVERSAL::isa( $_[0], 'CODE' ) }
sub code_run ($;@) { my $f = shift; return $f->(@_) if UNIVERSAL::isa( $f, 'CODE' ) }

sub array (@) {
  local @_ = map { is_array $_ ? @$_ : $_ } ( @_ == 1 and !defined $_[0] ) ? () : @_;
  #local@_ = map { ref $_ eq 'ARRAY' ? @$_ : $_ } (@_ == 1 and !defined$_[0]) ? () : @_;
  wantarray ? @_ : \@_;
}

sub array_any (@) {
  local @_ = map { is_array $_ ? @$_ : is_hash $_ ? sort keys %$_ : is_code $_ ? $_->() : $_ } @_;
  wantarray ? @_ : \@_;
}

sub in ($@) {
  my $v = shift;
  grep { $v eq $_ } &array_any;
}
sub hash_merge ($$) { $_[0]{$_} = $_[1]{$_} for keys %{ $_[1] }; }

=todo
------------jCZJhSDkEEg0Avf4h2hejC
Content-Disposition: form-data; name="n1"

ertyeryery
------------jCZJhSDkEEg0Avf4h2hejC
Content-Disposition: form-data; name="n2"

ryertytry
------------jCZJhSDkEEg0Avf4h2hejC
Content-Disposition: form-data; name="q"

ertyeryery
------------jCZJhSDkEEg0Avf4h2hejC--
=cut

sub encode_url($;$) {    #v5
  my ( $str, $mask ) = @_;
  return $str if defined $mask and !$mask;
  $mask ||= '[^a-zA-Z0-9\-.()_!,]';
  utf8::encode $str;
  #return join( '+', map { s/$mask/'%'.sprintf('%02X', ord($&))/ge; $_ } split( /\x20/, $str ) );
  return join '+', map { s/($mask)/sprintf'%%%02X',ord $1/ge; $_ } split /\x20/, $str;
}

sub encode_url_link($;$) {
  #v5
  my ( $str, $mask ) = @_;
  return $str if defined $mask and !$mask;
  return $str if $str =~ /^(magnet|file):/i;
  #fixed?
  #return $str if $config{'client_ie'};
  #printlog('Eb',Dumper $str);
  # eval {utf8::downgrade($str, 'FAIL_OK')# if utf8::is_utf8($str);
  #};
  #utf8::encode($str);
  #utf8::downgrade($str, 'FAIL_OK') if utf8::is_utf8($str);
  utf8::is_utf8($str) ? utf8::encode($str) : utf8::downgrade( $str, 'FAIL_OK' );
  local %_ = split_url($str);
  $mask ||= '[^a-zA-Z0-9\-.()_\:@\/!,=]';
  #utf8::encode($_{$_}),
  #utf8::downgrade($_{$_}, 'FAIL_OK'),
  $_{$_} =~ s/$mask/sprintf'%%%2X',ord$&/ge for keys %_;
  #printlog('Ea',Dumper \%_);
  return join_url( \%_ );
}

sub decode_url($;$) {    #v1
  my ( $str, $noutf ) = @_;
  $str =~ s/%([a-fA-F0-9]{2})/pack'C',hex$1/eg;
  utf8::decode $str unless $noutf;
  return $str;
}
{
  my %fh;
  my $savetime = 0;

  sub file_append(;$@) {
    local $_ = shift;
    for ( defined $_ ? $_ : keys %fh ) { close( $fh{$_} ), delete( $fh{$_} ) if $fh{$_} and !@_; }
    return if !@_;
    unless ( $fh{$_} ) { return unless open $fh{$_}, '>>', $_; return unless $fh{$_}; }
    print { $fh{$_} } @_;
    if ( time() > $savetime + 5 ) {
      close( $fh{$_} ), delete( $fh{$_} ) for keys %fh;
      $savetime = time();
    }
    return @_;
  }
  END { close( $fh{$_} ) for keys %fh; }
}

sub file_rewrite(;$@) {
    local $_ = shift;
    return unless open my $fh, '>', $_;
    print $fh @_;
}

#all def fac =
#u   u   u  0
#u   1   u  1
#u   0   u  0
#u   1   0  0
#u   *   1  1
#0   *   *  0
#1   *   *  1
sub printlog (@) {          #v5
  #print "[devlog][fac:$_[0]=".$config{ 'log_' . $_[0]}."][][log_screen=$config{'log_screen'} ]\n",Dumper (\%config );
  return if defined $config{ 'log_' . $_[0] } and !$config{ 'log_' . $_[0] } and !$config{'log_all'};
  #my $file = ( $config{'log_all'} or ( defined $config{ 'log_' . $_[0] } ? $config{ 'log_' . $_[0] } : '' ) );
  my $file = ( (
      defined $config{'log_all'}
      ? $config{'log_all'}
      : ( defined $config{ 'log_' . $_[0] } ? $config{ 'log_' . $_[0] } : $config{'log_default'} )
    )
  );
  my $noscreen;
  for ( 0 .. 1 ) {
    $noscreen = 1 if $file =~ s/^[\-_]// or !$file;
    $noscreen = 0 if $file =~ s/^[+\#]//;
    $file = $config{'log_default'}, next if $file eq '1';
    last;
  }
  my $html = !$file and ( $ENV{'SERVER_PORT'} or $config{'view'} eq 'html' or $config{'view'} =~ /http/i );
  $file = undef if $file eq '1';
  my $xml = $config{'view'} eq 'xml';
  my $delim = $config{'log_delim'} || ' ';
  my $string = join '', ( $xml ? '' : () ), (
    ( ( $html || $xml ) and !$file ) ? ()
    : (
      $config{'log_datetime'} eq '0' ? () : human( 'date_time', ),
      ( $config{'log_micro'} ? human('micro_time') : () ),
      ( $config{'log_pid'}   ? (" [$$]")           : () ),
    )
    ), (
    $config{'log_caller'}
    ? (
      ' [', join( ',', grep { $_ and !/^ps/ } ( map { ( caller($_) )[ 2 .. 3 ] } ( 0 .. $config{'log_caller'} - 1 ) ) ), ']'
      )
    : ()
    ),
    $delim, join( $delim, @_ ),
    #(),
    ( $html ? '' : () ), ( $xml ? ']]>' : () ), ("\n");
#print "[devlog][fac:$_[0]=".$config{ 'log_' . $_[0]}."][file=$file][log_screen=$config{'log_screen'} log_default=$config{'log_default'} noscreen=$noscreen html=$html xml=$xml]\n" ;
  file_append( $config{'log_dir'} . $file, $string );
  file_append() if !$config{'log_cache'};    #flush buffer
  #if ( @_ and $file and open( LOG, '>>', $config{'log_dir'}.$file ) ) {
  #print LOG@string;
  #close(LOG);
  #}
  #local $_ = join '', @string;
  #print @string if @_ and $config{'log_screen'} and !$noscreen and ;
  print $string if @_ and $config{'log_screen'} and !$noscreen and ( !utf8::is_utf8($string) or utf8::valid($string) );
  #print "not valid string\n"if utf8::is_utf8($string) and  !utf8::valid($string);
  #state(@_);
  flush() if $config{'log_flush'};
  return @_;
}

sub file_read_ref ($) {
  open my $f, '<', $_[0] or return;
  local $/ = undef;
  my $ret = <$f>;
  close $f;
  return \$ret;
}

sub file_read ($) {    #dont use, del
  open my $f, '<', $_[0] or return;
  local $/ = undef;
  my $ret = <$f>;
  close $f;
  return $ret;
}

sub openproc($;$) {    #my ($proc) = @_;
  printlog( 'dbg', 'run ext:', @_ );
  my $handle;
  #printlog('openok', $handle),
  return $handle if $_[1] ? open( $handle, $_[0], $_[1] ) : open( $handle, $_[0] );
  #return $handle if open( $handle, ((), @_));
  #printlog('openfail');
  return;
}

sub printprog($;$$) {    #v1
  my ( $proc, $nologbody, $handler, $layer ) = @_;
  return unless $proc;
  my $ret;
  my $tim = timer();
  printlog( 'dbg', "Starting [$proc]:" );
  system($proc), return if $nologbody and !$handler;
  my $h = openproc( '-|' . $layer, "$proc $config{'stderr_redirect'}" ) or return 1;
  while ( defined( local $_ = <$h> ) ) {
    s/\s*[\x0A\x0D]*$//;
    next unless length $_;
    printlog( 'dbg', $_ ) unless $nologbody;
    last if ref $handler eq 'CODE' and $ret = $handler->($_);
  }
  close($h);
  printlog( 'dbg', 'prog done per', human( 'time_period', $tim->() ) );
  return $ret;
}

sub start(;$@) {
  my ($cmd) = shift;
  if ($cmd) {
    #$processor{'out'}{'array'}->();
    if ( $^O =~ /^(?:(ms)?(dos|win(32|nt)?))/i and $^O !~ /^cygwin/i ) {
      $config{'starter'}      ||= 'cmd /c';
      $config{'spawn_prefix'} ||= 'start /min /low';
    } else {
      $config{'spawn_postfix'} ||= '&';
    }
#"$config{'starter'} $config{'spawn_prefix'} $config{'perl'} $config{'root_path'}crawler.pl $force $start $config{'spawn_postfix'}";
    my $com = join ' ', $config{'starter'}, $config{'spawn_prefix'}, $cmd, @_, $config{'spawn_postfix'};
    printlog( 'dbg', "starting with $cmd:", $com );
    #printlog( 'dbg', $com );
    return system($com);
  }
}

sub startme(;$@) {
  my ($start) = shift;
  if ($start) {

=old
  my ($start) = shift;
  if ($start) {
    #$processor{'out'}{'array'}->();
    if ( $^O =~ /^(?:(ms)?(dos|win(32|nt)?))/i and $^O !~ /^cygwin/i ) {
      $config{'starter'}      ||= 'cmd /c';
      $config{'spawn_prefix'} ||= 'start /min /low';
    } else {
      $config{'spawn_postfix'} ||= '&';
    }
    my $com =
#"$config{'starter'} $config{'spawn_prefix'} $config{'perl'} $config{'root_path'}crawler.pl $force $start $config{'spawn_postfix'}";
      join ' ', $config{'starter'}, $config{'spawn_prefix'}, $^X, $work{'$0'} || $0, $start, @_, $config{'spawn_postfix'};
    printlog( 'dbg', "starting with $start:", $com );
    #printlog( 'dbg', $com );
    system($com);
  }
=cut

    return start( $^X, $work{'$0'} || $0, $start, @_ );
  }
}
our $indent = 1;
our $join   = ', ';
our $prefix = 'dmp';    # 'dmp '
our $caller_shift = 0;

sub dmp (@) {
  my $fname = (caller(1 + $caller_shift))[3];
  $fname = (caller(0 + $caller_shift))[0] if $fname eq '(eval)';
  printlog $prefix, $fname, ':', ( caller(0 + $caller_shift) )[2], ' ',
    join $join,
      map { ref $_ ? Data::Dumper->new( [$_] )->Indent($indent)->Pair( $indent ? ' => ' : '=>' )->Terse(1)->Sortkeys(1)->Dump() : "'$_'" } @_ ? @_ : $_;
  wantarray ? @_ : $_[0];
}

# trace; # trace 5 calls
# trace 10; # trace 10 calls
# trace 'bzzzz', [42]; # trace 5 and dumpit
sub trace (;@) {
    local $caller_shift = 1;
    for (1..($_[0] =~ /^\d+$/ ? shift : 10)) {
        dmp $_, ((caller $_ + 1 )[3]||(caller $_ )[0]) . ':' . ((caller $_ )[2] || last), ($_ > 1 ? () : @_),;
    }
}

sub state {
  $work{'$0'} ||= $0;
  $0 = $config{'state_prefix'} . join ' ', @_;
}

sub hconfig($;@) {
  my $par = shift;
  #printlog('hc0', $par,@_);
  #printlog('hc1', $_, $par),
  return $config{'fine'}{$_}{$par} for grep { defined( $config{'fine'}{$_}{$par} ) } @_;
  #printlog('hc2', $par),
  return $config{$par};
}

sub html_chars($) {
  #local $_ = $_[0];
  local $_;    # = $_[0];
  $_ = \$_[0] unless ref $_[0];
  $_ ||= $_[0];
  #print "REf:",ref $_, $$_;
  $$_ =~ s/\&/\&\;/g;
  $$_ =~ s/\
  $$_ =~ s/\>/\>\;/g;
  $$_ =~ s/"/\"\;/g;    #"
  return $$_;
}

sub human($;@) {
  #print "HUM", @_;
  my $via = shift;
  #print "CO[$config{'human'}{$via}]", Dumper $config{'human'};
  #my $code = $config{'human'}{$via} if ref $config{'human'}{$via} eq 'CODE';
  #$code ||= $config{'human'}{$via} if ref $config{'human'}{$via} eq 'CODE';
  #return $code->(@_) if $code;
  return $config{'human'}{$via}->(@_) if ref $config{'human'}{$via} eq 'CODE';
  return @_;
}

sub func_cache($;@) {
  my ($func) = shift;
  my $save = $func . join( ':', @_ );
  unless ( $static{'func_cache'}{$save} ) { @{ $static{'func_cache'}{$save} } = $func->(@_); }
  else                                    { }
  return wantarray ? @{ $static{'func_cache'}{$save} } : $static{'func_cache'}{$save}[0];
}

sub name_to_ip_noc($) {
  my ($name) = @_;
  unless ( $name =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
    local $_ = ( gethostbyname($name) )[4];
    return ( $name, 1 ) unless length($_) == 4;
    $name = inet_ntoa($_);
  }
  return $name;
}

sub ip_to_name_noc($) {    #v1
  local $_;
  return $_[0] unless $_ = ( gethostbyname( $_[0] ) )[4];
  return inet_ntoa($_);
}
sub normalize_ip($) { return func_cache( \&normalize_ip_noc, @_ ); }
sub ip_to_name($)   { return func_cache( \&ip_to_name_noc,   @_ ); }
sub name_to_ip($)   { return func_cache( \&name_to_ip_noc,   @_ ); }

sub normalize_ip_noc($) {    #v2
  my ($host) = @_;
  #my ($err);
  my ( $ip, $err ) = name_to_ip($host);
  #printlog "ip[$ip]";
  return undef if $ip =~ /^(?:0|127)\./ and !$host =~ /^(?:0|127)\./;
  return lc $host
    if $config{'norm_skip_host'}
      and ( (
          ref $config{'norm_skip_host'} eq 'Regexp' ? $host =~ $config{'norm_skip_host'} : $host =~ /$config{'norm_skip_host'}/i
        )
      );
  return $ip if $err;
  my ($tmp);
  return $ip unless $tmp = inet_aton($ip);
  return $ip unless $host = ( gethostbyaddr( $tmp, AF_INET ) )[0];
  for my $repl ( @{ $config{'ip_normalize_pre'} || [] } ) {
    last if $host =~ /^$repl\./;
    my $thost = $host;
    $thost =~ s/^[^.]+/$repl/;
    my $pip = inet_aton($ip);
    for $thost ( ( $host =~ /\..+\./ ? ($thost) : () ), $repl . '.' . $host ) {
      next unless @_ = grep $_, ( ( gethostbyname($thost) )[ 4 .. 14 ] );
      return $thost for ( grep $_ eq $pip, @_ );
    }
  }
  return $ip unless @_ = ( gethostbyname($host) )[4];
  return $host for grep $_ eq $ip, map $_ = inet_ntoa($_), @_;
  return $ip;
}

sub counter($;$) {
  my $start = $_[0];
  return sub {
    $start = $_[1] if $_[1];
    return ( $_[0] - $start ) >= 0 ? ( $_[0] - $start ) : $start;
  };
}

sub timer(;$) {
  my ( $start, $ret ) = ( $_[0] || time() );
  return sub {
    $ret = time() - $start;
    $start = ( $_[0] or time() ) if defined( $_[0] );
    return $ret;
  };
}

sub join_url($) {    #v2
  return
      ( $_[0]->{'prot'} ? $_[0]->{'prot'} . '://' : '' )
    . ( $_[0]->{'user'} ? $_[0]->{'user'} . ( $_[0]->{'pass'} ? ':' . $_[0]->{'pass'} : '' ) . '@' : '' )
    . $_[0]->{'host'}
    . ( (
      $_[0]->{'port'}
        and ( !$static{'port2prot'}{ $_[0]->{'port'} } or ( $static{'port2prot'}{ $_[0]->{'port'} } ne $_[0]->{'prot'} ) )
    )
    ? ':'
      . $_[0]->{'port'}
    : ''
    )
    . ( $_[0]->{'dcuser'} ? '/' . $_[0]->{'dcuser'} : '' )
    . ( ( !$_[0]->{'path'} or $_[0]->{'path'} =~ /^\// ) ? '' : '/' )
    . $_[0]->{'path'}
    . ( ( ( !$_[0]->{'path'} and ( !$_[0]->{'host'} or !( $_[0]->{'name'} or $_[0]->{'ext'} ) ) ) or $_[0]->{'path'} =~ /\/$/ )
    ? ''
    : '/' )
    . $_[0]->{'name'}
    . ( $_[0]->{'ext'}   ? '.' . $_[0]->{'ext'}   : '' )
    . ( $_[0]->{'param'} ? '?' . $_[0]->{'param'} : '' )
    . ( $_[0]->{'pos'}   ? '#' . $_[0]->{'pos'}   : '' );
}
#[[prot://][user[:pass]@]host[:port][/dcuser][/[path]][/[name[.ext]]][?param][#pos]
sub split_url($;$) {    #v3
  my $table = ( $_[1] or $config{'sql_tresource'} );
  local %_ = ();
  ( $_{'prot'}, $_{'host'} ) = $_[0]      =~ m|^\s*(?:(\w+)\://)?(.*)$|;
  ( $_{'host'}, $_{'path'} ) = $_{'host'} =~ m|^([^/]*)(/.*)?$|;
  ( $_{'user'}, $_{'host'} ) = $_{'host'} =~ m|^(?:(.+)@)?(.*)|;
  ( $_{'user'}, $_{'pass'} ) = $_{'user'} =~ m|^([^/:@]+):?(.*)|;
  ( $_{'host'}, $_{'port'} ) = $_{'host'} =~ m|([^/:@]+)\:?(\d*)$|;
  $_{'path'} =~ s|([^/]*)$||;
  ( $_{'name'} ) = $1;
  $_{'path'} =~ s|/*$|| if $_{'path'} ne '/';
  $_{'path'} ||= '/' if $_{'name'} or $_{'ext'};
  #( $_{'pos'} ) = ( $_{'name'} =~ s/#(.+)$// ? ($1) : (undef) );
  ( $_{'pos'} )   = $1 if $_{'name'} =~ s/#(.+)$//;
  ( $_{'param'} ) = $1 if $_{'name'} =~ s/\?(.+)$//;
  ( $_{'ext'} ) = ( $_{'name'} =~ s/\.([^\.]+)$// ? ($1) : ('') );
  delete $_{'port'}
    unless ( $_{'port'} and ( !$static{'port2prot'}{ $_{'port'} } or ( $static{'port2prot'}{ $_{'port'} } ne $_{'prot'} ) ) );
  if ( $_{'prot'} eq 'dchub' ) {
    #printlog   ('split_url', 1, Dumper \%_);
    my $dcuser;
    ( $_{'path'} =~ s|^/([^/]+)|| and $dcuser = $1 )
      or ($_{'path'} =~ s|^/?$||
      and $_{'name'} =~ s|(.+)||
      and $dcuser = $1
      and $_{'ext'} =~ s|(.*)||
      and $dcuser .= ( $1 ? ".$1" : '' ) );
    #printlog('dcu', $dcuser);
    #printlog   ('split_url', 2, join ':', %_);
    if ( %{ $config{'sql'}{'table'}{$table}{'dcuser'} or {} } ) { $_{'dcuser'} = $dcuser; }
    else {
      ( $_{'host'} = join_url( { 'host' => $_{'host'}, 'port' => $_{'port'}, 'path' => $dcuser, } ) ) =~ s|/$||;
      delete $_{'port'};
      #printlog   ('split_url', 3, join ':', %_);
    }
  }
  delete $_{$_} for grep !length $_{$_}, keys %_;
  #printlog   ('split_url', 'R', join ':', %_);
  return wantarray ? %_ : \%_;
}

sub full_host($;$) {
  my $table = ( $_[1] or $config{'sql_tresource'} );
  return join_url( {
      ( %{ $config{'sql'}{'table'}{$table}{'user'} or {} } ? () : ( 'user' => $_[0]->{'user'} ) ),
      ( %{ $config{'sql'}{'table'}{$table}{'pass'} or {} } ? () : ( 'pass' => $_[0]->{'pass'} ) ),
      'host' => $_[0]->{'host'}, ( ( (
            $_[0]->{'port'}
              and ( !$static{'port2prot'}{ $_[0]->{'port'} } or ( $static{'port2prot'}{ $_[0]->{'port'} } ne $_[0]->{'prot'} ) )
          )
            and ( !%{ $config{'sql'}{'table'}{$table}{'port'} or {} } or ( $_[0]->{'prot'} eq 'dchub' ) )
        ) ? ( 'port' => $_[0]->{'port'} ) : ()
      ),
      ( %{ $config{'sql'}{'table'}{$table}{'dcuser'} or {} } ? () : ( 'dcuser' => $_[0]->{'dcuser'} ) ),
    }
  );
}
sub cp_normalize($) { return $config{'trans_name'}{ lc $_[0] } || lc $_[0]; }

sub encode_safe ($$) {
  my ( $cto, $string ) = @_;
  #printlog('es', $string);
  $cto = cp_normalize($cto);
  return $string if !$cto or $cto eq 'utf-8';
  #return
  #utf8::downgrade($string),
  #Encode::_utf8_off($string);
  #printlog('ensafeB',$cto, Dumper $string,  utf8::is_utf8 $string);
  #local $_ = Encode::encode $cto, Encode::decode  'utf-8',  $string;
  local $_ = Encode::encode $cto, $string, Encode::FB_WARN;
  # Encode::_utf8_off($_);
  #utf8::downgrade($_),
  #utf8::decode($_),
  #printlog('ensafeA',$cto, Dumper  $_, utf8::is_utf8 $_);
  #printlog('esR', $_);
  return $_;
}

sub cp_trans($$$) {    #v1
  my ( $cfrom, $cto, $string ) = @_;
  $cfrom = cp_normalize($cfrom);
  $cto   = cp_normalize($cto);
  #printlog('dev', 'cp_trans:', $cfrom, $cto, $string);
  return $string if $cto eq $cfrom or !length($string) or !$cfrom or !$cto;
  print( 'dev', 'cp_trans:', join ':', $cfrom, $cto, $string ) if $config{debug};
  #local $_ = "$cfrom -> $cto";
  #caller_trace();
  #return scalar cp_trans_count(@_); # unless $config{'fast_cp_trans'};
  #use Encode;
  #$string = encode($cto, decode($cfrom, $string));
  #return eval {Encode::encode $cto, Encode::decode $cfrom, $string} or $string;
  Encode::from_to $string, $cfrom, $cto, Encode::FB_WARN;
  return $string;
}

sub cp_trans_count($$$) {    #v1
  my ( $cfrom, $cto, $string ) = @_;
  $cfrom = cp_normalize($cfrom);
  $cto   = cp_normalize($cto);
  #printlog('dev', 'cp_trans:', $cfrom, $cto, $string);
  return $string if $cto eq $cfrom or !length($string) or !$cfrom or !$cto;
  #print('dev', 'cp_trans:', join ':',$cfrom, $cto, $string);
  #local $_ = "$cfrom -> $cto";
  #caller_trace();
  #use Encode;
  #$string = encode($cto, decode($cfrom, $string));
  #return encode($cto, decode($cfrom, $string));
  return utf_trans( $cto, $string ) if $cfrom eq 'utf-8' and $config{'trans'}{$cto};
  return to_utf_trans( $cfrom, $string ) if $cto eq 'utf-8' and $config{'trans'}{$cfrom};
  my $cnt;
  if ( $config{'trans'}{$cfrom} and $config{'trans'}{$cto} ) {
    ( $cfrom, $cto ) = \( $config{'trans'}{$cfrom}, $config{'trans'}{$cto} );
    eval "\$cnt = \$string =~ tr/$$cfrom/$$cto/";
  }
  #printlog('dev', "cp_trans($_):", $string),     caller_trace()     if $cnt;
  return wantarray ? ( $string, $cnt ) : $string;
}

sub utf_trans($$) {
  my ( $cto, $string ) = @_;
  $cto ||= $config{'cp_db'};
  $cto = cp_normalize($cto);
  return if $cto eq 'utf-8';
  my ( $cnt, $cnt2 );
  $cnt += $string =~ s/\xD0\x81/\xF0/g;     # e
  $cnt += $string =~ s/\xD1\x91/\xF1/g;     # E
  $cnt += $string =~ s/\xD0\x84/\xF4/g;     # ukr beg
  $cnt += $string =~ s/\xD1\x94/\xF5/g;
  $cnt += $string =~ s/\xD0\x86/\xF6/g;
  $cnt += $string =~ s/\xD1\x96/\xF7/g;
  $cnt += $string =~ s/\xD0\x87/\xF8/g;
  $cnt += $string =~ s/\xD1\x97/\xF9/g;     # ukr end
  $cnt += $string =~ s/\xE2\x80\x94/-/g;    # -
  $cnt += $string =~ s/\xC2\xAB/"/g;        # «
  $cnt += $string =~ s/\xC2\xBB/"/g;        # »
  $cnt += $string =~ s/\xD1\x98/j/g;        #
  $cnt += $string =~ s/\xD0\xB9/\xA9/g;     # й
  #$cnt += $string =~ s/\xD0\xA9/\xC9/g;                           # Щ
  $cnt += $string =~ s/\xD0([\x90-\xBF])/chr(ord($1)-16)/eg;
  $cnt += $string =~ s/\xD1([\x80-\x8F])/chr(ord($1)+96)/eg;
  ( $string, $cnt2 ) = cp_trans_count( 'cp866', $cto, $string );
  $cnt += $cnt2;
  $cnt += $string =~ s/\x21\x16/\xB9/g;     # й
  return wantarray ? ( $string, $cnt ) : $string;
}

sub to_utf_trans($$) {
  my ( $cfrom, $string ) = @_;
  $cfrom ||= $config{'cp_db'};
  $cfrom = cp_normalize($cfrom);
  return if $cfrom eq 'utf-8';
  my $cnt;
  #$cnt += $string =~ s/\xE9/\xD0\xB9/g;                           # й
  $cnt += $string =~ s/\xAB/"/g;            # <
  $cnt += $string =~ s/\xBB/"/g;            # <
  #print "\ndos0[$string]\n";
  ( $string, $cnt ) = cp_trans_count( $cfrom, 'cp866', $string );
  #print "\ndos1[$string]\n";
  $cnt += $string =~ s/([\x80-\x88\x8A-\xA8\xAA-\xAF])/"\xD0".chr(ord($1)+16)/eg;
  $cnt += $string =~ s/([\xE0-\xE8\xEA-\xEF])/"\xD1".chr(ord($1)-96)/eg;
  #print "\ndos2[$string]\n";
  $cnt += $string =~ s/\xF0/\xD0\x81/g;     # e
  $cnt += $string =~ s/\xF1/\xD1\x91/g;     # E
  $cnt += $string =~ s/\xF4/\xD0\x84/g;     # ukr beg
  $cnt += $string =~ s/\xF5/\xD1\x94/g;
  $cnt += $string =~ s/\xF6/\xD0\x86/g;
  $cnt += $string =~ s/\xF7/\xD1\x96/g;
  $cnt += $string =~ s/\xF8/\xD0\x87/g;
  $cnt += $string =~ s/\xF9/\xD1\x97/g;     # ukr end
  #=c
  $cnt += $string =~ s/(?
  $cnt += $string =~ s/(?
  $cnt += $string =~ s/(?
  $cnt += $string =~ s/(?
  $cnt += $string =~ s/(?
  #=cut
  #$cnt += $string =~ s/\xAB/"/g;                           # <
  #$cnt += $string =~ s/\xBB/"/g;                           # >
  return wantarray ? ( $string, $cnt ) : $string;
}

sub cp_trans_hash($$$) {
  my ( $from, $to, $hash ) = @_;
  #printlog('dev', 'cp_trans_hash:', $from, $to, Dumper $hash);
  return $hash if $from eq $to;
  $hash->{$_} = cp_trans( $from, $to, $hash->{$_} ) for grep { !ref $hash->{$_} }keys %$hash;
  return wantarray ? %$hash : $hash;
}

sub max_hash_el($$;$) {
  my ( $hash, $max, $ret ) = @_;
  $hash->{$_} >= $max ? ( $max = $hash->{$_}, $ret = $_ ) : () for grep $_, keys %$hash;
  return $ret;
}

sub cp_dump($) {
  my ($data) = @_;
  printlog( 'devcp', "$_ = $data->{'stat'}{$_}" ) for keys %{ $data->{'stat'} };
}

sub detectcp($) {
  my ($string) = @_;
  my ( $detectedcp, $t );
  my %cpstat;
  for my $cp ( keys %{ $config{'trans_detect'} } ) {
    ( length($$string) > $config{'cp_detect_length'} ? substr( $$string, 0, $config{'cp_detect_length'} ) : $$string ) =~
      s/([$config{'trans_detect'}{$cp}])/++$cpstat{$cp},$1/eg;
    #printlog('testcp:', $cp, $cpstat{$cp});
    #$$string
  }
  $detectedcp = max_hash_el( \%cpstat, $config{'cp_detect_letters'} );
  return wantarray ? ( $detectedcp, \%cpstat ) : $detectedcp;
}

sub cp_detect_trans(\$;$$$$$) {
  my ( $string, $data, $cp_to, $cp_default, $prot, $host ) = @_;
  $data ||= {};
  $cp_to = cp_normalize( $cp_to || hconfig( 'cp_db', $host ) ) || 'utf-8';

=bat
  if (use_try('Encode::Detect')) {
    eval {$$string = decode("Detect", $$string);
    return;
    };
  } elsif (use_try('Encode::Guess')) {
    my $decoder; eval {$decoder = Encode::Guess::guess_encoding($$string, Encode->encodings(":all"));};
printlog(Dumper $decoder);
    if ($decoder) {
    $$string = $decoder->decode($$string);
    return;
    }
  }
=cut

  return 'utf-8' if $cp_to eq 'utf-8' and utf8::decode($$string);
  $cp_default = cp_normalize( $cp_default || hconfig( 'cp_res', $host, $prot ) );
  my $cnt;
  if ( !hconfig( 'no_cp_detect', $host ) and ( ++$data->{'tries'} < 20 or !$data->{'cp'} ) ) {
    ++$data->{'stat'}{ detectcp($string) };
    $data->{'cp'} = max_hash_el( $data->{'stat'}, hconfig( 'cp_detect_strings', $host ) );
#printlog( 'dbg', 'charset detected:', $data->{'cp'}, '   dbg: ', %{ $data->{'stat'} }, Dumper($data), Dumper(detectcp($string)),' [', $$string, ']', "def:$cp_default",);#      if $data->{'cp'} and $data->{'cp'} ne $cp_default;
  }
  #printlog( 'dbg', "encto: from=$data->{'cp'} to=$cp_to, def=$cp_default");
  if (
    $data->{'cp'}    #and ($data->{'cp'} ne $cp_to
    #or $data->{'cp'} eq 'utf-8')
    )
  {
    #( $$string, $cnt ) = cp_trans_count( $data->{'cp'}, $cp_to, $$string );
    return $data->{'cp'} if $data->{'cp'} eq $cp_to;
    $$string = Encode::decode $data->{'cp'}, $$string, Encode::FB_WARN;
    #return $cnt ? $data->{'cp'} : undef;
    #printlog( 'dbg', "charset decoded [$data->{'cp'}]:", $$string);
    return $data->{'cp'};
  }
  if ( $cp_default and $cp_default ne $cp_to ) {
    #( $$string, $cnt ) = cp_trans_count( $cp_default, $cp_to, $$string );
    #return $cnt ? $cp_default : undef;
    $$string = Encode::decode $cp_default, $$string, Encode::FB_WARN;
    #printlog( 'dbg', "charset decoded def [$cp_default]:", $$string);
    return $cp_default;
  }
  return undef;
}

sub cp_up($;$) {    #v1
  my ( $string, $cp ) = ( shift, cp_normalize( shift || 'cp1251' ) );
  eval "\$string =~ tr/$config{'trans_lo'}{$cp}/$config{'trans_up'}{$cp}/"
    if ( $config{'trans_up'}{$cp} and $config{'trans_lo'}{$cp} );
  return $string;
}

sub cp_lo($;$) {    #v1
  my ( $string, $cp ) = ( shift, cp_normalize( shift || 'cp1251' ) );
  eval "\$string =~ tr/$config{'trans_up'}{$cp}/$config{'trans_lo'}{$cp}/"
    if ( $config{'trans_up'}{$cp} and $config{'trans_lo'}{$cp} );
  return $string;
}

sub unref ($;@) {
  local $_ = shift;
  return unless length $_;
  $_ = $$_ while ref $_ eq 'REF';
  return $_->(@_) if ref $_ eq 'CODE';
  @_ = () if ref $_[0];
  return join $,, ( $$_, @_ ) if ref $_ eq 'SCALAR';
  return join $,, $_, @_;
}

sub lang($;$$$) {
  my ( $key, $lang ) = shift, shift;
  #print "CP[$config{'cp_config'},$work{'codepage'}]" if $key eq 'search';
  local $_ = (
      defined $config{'lng'}{ $lang ||= ( $work{'lang'} || $config{'lang'} ) }{$key} ? $config{'lng'}{$lang}{$key}
    : defined $config{'lng'}{''}{$key} ? $config{'lng'}{''}{$key}
    :                                    $key );
  #return unref $_ if ref $_;
  return
    #"[".(%config)."]".
    shift() .    # "CP[$config{'cp_config'},$work{'codepage'}]".
    unref($_) .
    #cp_trans(
    #( $config{'cp_config'} || $config{'cp_perl'} ),
    #$work{'codepage'},
    #) .
    shift();
}

sub printu (@) {
  for (@_) {
    print($_), next unless utf8::is_utf8($_);
    my $s = $_;
    utf8::encode($s);
    print($s);
  }
}

sub json_encode($) {
  if ( use_try 'JSON::XS' ) { return \( JSON::XS->new->encode(@_) ) }
  if ( use_try('JSON') )    { return \( JSON->new->encode(@_) ); }
  {
    local *Data::Dumper::qquote = sub {
      $_[0] =~ s/\\/\\\\/g, s/"/\\"/g for $_[0];
      return ( '"' . $_[0] . '"' );
    };
    return \( Data::Dumper->new( \@_ )->Pair(':')->Terse(1)->Indent(0)->Useqq(1)->Useperl(1)->Dump() );
  }
}

sub min (@) {
  ( sort { $a <=> $b || $a cmp $b } @_ )[0];
}

sub max (@) {
  ( sort { $b <=> $a || $b cmp $a } @_ )[0];
}

sub alarmed {
  my ( $timeout, $proc, @proc_param ) = @_;
  my $ret;
  eval {
    local $SIG{ALRM} = sub { die "alarm\n" }
      if $timeout;    # NB: \n required
    alarm $timeout if $timeout;
    $ret = $proc->(@proc_param) if ref $proc eq 'CODE';
    alarm 0 if $timeout;
  };
  if ( $timeout and $@ ) {
    printlog( 'err', 'Sorry, unknown error (',
      $@, ') runs:', ' [', join( ',', grep $_, map ( ( caller($_) )[2], ( 0 .. 15 ) ) ), ']' ),
      sleeper( 3600, 'alarmed' ), return
      unless $@ eq "alarm\n";    # propagate unexpected errors
    printlog( 'err', 'Sorry, timeout (', $timeout, ')' );
  } else {
    sleeper( undef, 'alarmed' );
  }    #    else { print "no timeout"; }
  return $ret;
}

sub mkdir_rec(;$$) {
  local $_ = shift // $_;
  $_ .= '/' unless m{/$};
  my @ret;
  while (m{/}g) { ( push @ret, $` ), ( @_ ? mkdir $`, $_[0] : mkdir $` ) if length $` }
  @ret;
}

sub check_int($;$$$) {
  my ( $int, $min, $max, $def ) = @_;
  #printlog('dev', 'int', ( "int=$int,min=$min,max=$max,def=$def" ));
  $def = 0 unless defined $def;
  return $def unless ( defined($int) and length($int) );
  #printlog('dev', "int0[$int]", defined $int, length($int));
  $int =~ s/\s+//g;
  $int = int($int);
  #printlog('dev', 'int1',$int);
  return $def unless $int =~ /^-?\d+$/;
  #printlog('dev', 'int2',$int, $min);
  return $min if defined $min and $int < $min;
  #printlog('dev', 'int3',$int, $max);
  return $max if defined $max and $int > $max;
  #printlog('dev', 'int4',$int);
  return $int;
}

=old trash
{
  my $current_name;

  sub open_out_file {
    my ($name) = join( '.', grep ( /.+/, @_ ) );
    $name =~ s/\W+/_/g;
    close_out_file();
    $current_name = "$config{'datadir'}$config{'slash_sys'}$name.$config{'output'}";
    $work{'current_name_work'} = "$current_name$config{'work_ext'}";
    rename( $current_name, $work{'current_name_work'} ) if -e $current_name and $work{'current_name_work'} and $current_name;
    open( I, '>>', $work{'current_name_work'} )
      or printlog( 'err', "!!! UNABLE TO OPEN $work{'current_name_work'}" )
      and return;
  }

  sub close_out_file {
    if ( $work{'current_name_work'} ) {
      $processor{'out'}{'array'}->();
      print I";\n";
      close(I);
      rename( $work{'current_name_work'}, $current_name ) if $work{'current_name_work'} and $current_name;
    }
    $work{'current_name_work'} = $current_name = '';
  }
}
=cut

sub caller_trace(;$) {
  for ( 0 .. $_[0] || 5 ) { local @_ = caller $_; last unless @_; printlog( 'caller', $_, @_ ); }
}

sub lib_init() {
  $SIG{__WARN__} = sub {
    printlog( 'warn', $@, $!, @_ );
    #printlog( 'die', 'caller', $_, caller($_) ) for ( 0 .. 15 );
    #caller_trace(15);
    }, $SIG{__DIE__} = sub {
    printlog( 'die', 'psm',$@, $!, @_ );
    #printlog( 'die', 'caller', $_, caller($_) || last ) for ( 0 .. 15 );
    trace(15);
    }
    if !$static{'no_sig_log'} and !$ENV{'SERVER_PORT'};    #die $!;
  unless ( $static{'port2prot'} ) {
    @{ $static{'port2prot'} }{ ( $config{'scanner'}{$_}{'port'}, $_ ) } = ( $_, $_ ) for keys %{ $config{'scanner'} };
  }
}

sub mysleep($) {
  if ( $_[0] > 1 and $config{'system'} eq 'win' ) {        #activeperl only?
    sleep(1) for ( 0 .. $_[0] );
  } else {
    sleep( $_[0] );
  }
}

sub sleeper($;$$) {
  my ( $max, $where, $min, ) = @_;
  $where ||= join '', caller;
  ( $work{'sleeper'}{$where} ? printlog( 'dev', "sleeper: clean $where was $work{'sleeper'}{$where}" ) : () ),
    $work{'sleeper'}{$where} = 0, return 0
    if !$max
      or $ENV{'SERVER_PORT'};
  $min ||= 0.5;
  #printlog( 'dbg', "sleepe0: sleep $where $work{'sleeper'}{$where} mi=$min" );
  ( $work{'sleeper'}{$where} ||= $min ) *= ( $work{'sleeper'}{$where} > $max ? 1 : 2 );
  printlog( 'dbg', "sleeper: sleep $where $work{'sleeper'}{$where}" );
  mysleep( $work{'sleeper'}{$where} );
  return $work{'sleeper'}{$where};
}

sub shuffle(@) {    #@$deck = map{ splice @$deck, rand(@$deck),  1 }  0..$#$deck;
  my $deck = shift;
  $deck = [ $deck, @_ ] unless ref $deck eq 'ARRAY';
  my $i = @$deck;
  while ( $i-- ) {
    my $j = int rand( $i + 1 );
    @$deck[ $i, $j ] = @$deck[ $j, $i ];
  }
  return wantarray ? @$deck : $deck;
}

sub flush(;$) {
  #printlog('dev', 'FLUSH') ;
  return if $config{'no_flush'};
  select( ( select( $_[0] || *STDOUT ), $| = 1 )[0] );
}

=todo
sub paintdots_onreload {
  my ($ref) = shift;
  sub {
    if ( $_[0] =~ /[Ss]ubroutine (\w+) redefined/ ) {
      my ($subr) = $1;
      ++$$ref;
      local ($|) = 1;
#$CPAN::Frontend->myprint(".($subr)");
#$CPAN::Frontend->myprint(".");
      print(".");
      return;
    }
    warn @_;
  };
}
=cut

sub count(@) { local %_; ++$_{$_} for @_; \%_ }
sub uniq(@) { keys %{ count @_ } }

sub config_read {
  #warn Dumper \@_;
  my @files;
  @files = @{ shift(@_) } if ref $_[0] eq 'ARRAY';
  #warn Dumper \@files;
  #warn Dumper \@_;
  #print "config_read($ENV{'SCRIPT_FILENAME'}, $_[0]);\n";
  #print ("config_read NOREAD!;\n");
  #my $file = ;
  #return if $static{'config_read'}{            $ENV{'SCRIPT_FILENAME'} . $file      }++ and !$_[0];
  #print " [$file] config_read($_[0])";
  #do $ENV{'PROSEARCH_PATH'} . './config.pl' or do '../config.pl';
  #print "config_readb(); root_path = $root_path\n";
  #$root_path ||= lib::abs::path('../').'/';
  ( $ENV{'SCRIPT_FILENAME'} || $work{'$0'} || $0 ) =~ m|^(.+)[/\\].+?$|;
  $root_path =    #||=    $ENV{'PROSEARCH_PATH'} ||
    ( $1 ? $1 . '/' : undef );
  #$root_path||=  $1 . '/' if $1;
  $root_path =~ s|\\|/|g;
  $root_path //= './';
  #do $ENV{'PROSEARCH_PATH'} . './config.pl' or
  #print "pa=". ( $ENV{'SCRIPT_FILENAME'} ,';', $0),"\n";
  unless (@files) {
    @files = (
      $root_path . ( $config{'config_file'} // 'config.pl' )    #, $root_path . 'confdef.pl'
    );
  }
  #warn "config_read(); root_path = $root_path ; file = @files\n";
  my @errs;
  local $_;                                                     #= do ;
  #use lib::abs;
  for my $file ( uniq @files ) {
    ++$_, last if $static{'config_read'}{ $ENV{'SCRIPT_FILENAME'} . $file }++ and !$_[0];
    #warn "reading [$file]", -s $file, ;# lib::abs::path($file);
    #print( ' do1:',$_,',', $!, ' eval=', $@, "\n" ) if !$_ or $! or $@;
    #MAKE ARRAY
    if ( !$ENV{'SERVER_PORT'} and !-e $file and -e $file . '.dist' and use_try('File::Copy') ) {
      printlog( 'warn', 'unfinished install, copying', $file . '.dist', '->', $file );
      File::Copy::copy( $file . '.dist', $file );
    }
    $_ += do $file and last;                                    #and warn("read [$file] ok $! $@;")
    push @errs, map { "config [$file] not found: " . $_ } grep { $_ } $!, $@, unless $_;
    #push @errs, grep { $_ } $!, $@ unless $_;
    #push @errs, grep { $_ } $!, $@, $_ += do $root_path . '../config.pl', push @errs, grep { $_ } $!, $@ unless $_;
  }
  if ( !$_ and !$_[1] ) {
    print "Content-type: text/html\n\n" if defined( $ENV{'SERVER_PORT'} );
    print "config read errors: [@files]: ",, map "$_;\n", @errs;
  }
  #print"rp set1 to [$root_path]\n";
  conf(
    sub {
      #print"rp set2 to [$root_path]\n";
      $config{'root_path'} = $root_path;
    },
    0.0001
  );
  #print( ' do2:',$_,',', $!, ' eval=', $@, "\n" ) if $! or $@;
  #print( ' do1:', $!, 'eval=', $@ ,"\n" ) if $! or $@;
  #print( 'compile err1:', $!, "\n" ) if $!;
  #print ('compile err2:',$@, "\n");
  #require $ENV{'PROSEARCH_PATH'} . './config.pl' or do '../config.pl';
  #print('config_read',Dumper (\%config ));
  #print('config_read',(scalar keys %config ));
}

sub pre_calc_every {
  $config{'post_init_every'}{$_}->(@_)
    for grep { ref $config{'post_init_every'}{$_} eq 'CODE' } sort keys %{ $config{'post_init_every'} || {} };
}

sub pre_calc_once {
  #$config{'post_init_once'}->(@_) if $config{'post_init_once'};
  #print "pre_calc_once\n";
  $config{'post_init_once'}{$_}->(@_)
    for grep { ref $config{'post_init_once'}{$_} eq 'CODE' } sort keys %{ $config{'post_init_once'} || {} };
}

sub pre_calc {
  pre_calc_once(@_);
  pre_calc_every(@_);
}

sub config_reload {
  #warn "config_reload(clear=$_[0];; $config{'root_path'})";
  #print "config_reload(clear!=$_[0])\n";
  my $files = shift if ref $_[0] eq 'ARRAY';
  %config = () if $_[0];
  config_read( ( $files || () ), $_[1], $_[3] );
  #print "read end;";
  $_[2]->() if ref $_[2] eq 'CODE';
  conf();
  #print ('compile err2:',$@, "\n");
  if ( !%config ) {
    print "Content-type: text/html\n\n" if defined( $ENV{'SERVER_PORT'} );
    print("Please fix error in config.pl: [$@]"), exit if $@;
    print "Please create config.pl with parametrs (see config.pl.dist) and correct modes [$!]";
    exit;
  }
  #print('config_reload',(scalar keys %config ));
  #print('config_reload',Dumper (\%config ));
}
sub configure { &config_reload; }
#sub config    { &configure; }       #to del
sub reload_lib {
  #%human = ();
  my $redef = 0;
  for my $file (@_) {
    printlog( 'dbg', "reloading $file: $INC{$file}" );
    open( my $fh, '<', ( $INC{$file} or $file ) ) or printlog( 'err', "reload err $file=$INC{$file}" ), next;
    local ($/);
    local ( $SIG{__WARN__} ) = paintdots_onreload( \$redef );
    local ( $SIG{__DIE__} )  = paintdots_onreload( \$redef );
    eval <$fh>;
    warn $@ if $@;
  }
}
our %conf;

sub conf(;$$) {
  #warn 'conf from ', caller, Dumper \@_ ;
  my ( $sub, $order ) = ( shift, shift );
  #if ( !$ENV{'MOD_PERL'} ) {    $sub->(@_) if $sub;    return;  }
  my $id =    #$ENV{'PROSEARCH_PATH'} ||
    $ENV{'SCRIPT_FILENAME'} || $work{'$0'} || $0;
  #print join ' ',('dev',"conf($sub, $order, [$root_path] id=$id)", caller,"");
  unless ($sub) {
#print("running", scalar keys %{ $conf{'conf_init'}{ $ENV{'PROSEARCH_PATH'} } }, "now=",scalar keys %config, "\n");
#warn("RUNCONF[$id]($_/",scalar keys %{ $conf{'conf_init'}{$id } },"] from(",join('|',@{$conf{'conf_init_from'}{$id}{$_}}), ";", ""),
    $conf{'conf_init'}{$id}{$_}->() for sort { $a <=> $b } keys %{ $conf{'conf_init'}{$id} };
    #warn("confrunned",  "now=",scalar keys %config, "\n");
    return;
  }
  local $_;
  $conf{'conf_init'}{$id}{ $_ = ( $order or $conf{'conf_count'}{$id} += 10 ) } = $sub;
  $conf{'conf_init_from'}{$id}{$_} = [caller];
  #print "conf(@_):", Dumper([caller],$conf{'conf_init'}, $conf{'conf_init_from'});
}

sub http_get {    # REWRITE easier
  my ( $what, $asfile, $lwpopt, $method, $content, $headers_out, $headers_in ) = @_;
  #return "ZZZZZ";
  #printlog( 'dev', 'http_get', $what, $asfile, "cd=$config{'cachedir'};c=$config{'cache_http'}; " );
  my %url = split_url($what);
  my $c = encode_url( $what, $config{'encode_url_file_mask'} );
  if ( length $c > 200 ) {
    my ( $bef, $mid, $aft ) = $c =~ /^(.{50})(.+)(.{50})$/;
    #local $_ = 0;
    my $midv = 0;
    $midv += ord for split //, $mid;
    $c = join '__', $bef, $midv, $aft;
    #$_ += ord;
    #}
  }
  $c = ( $config{'cachedir'} || '.' ) . '/' . $c if $config{'cachedir'};
  $c = $asfile if $asfile and $asfile != 1;
  #printlog('dev', $what, $asfile, "cache=$config{'cache_http'}, dir=$config{'cachedir'};");
  if ( $config{'cache_http'} and -e $c and -M $c < $config{'cache_http'} ) {
    return $c if $asfile;
    if ( open( CF, '<', $c ) ) {
      local $/;
      local $_ = ;
      close(CF);
      return $_;
    }
  }
  printlog( 'warn', 'http_get disabled' ), return if $config{'no_http_get'};
  #printlog('dev', 'http_get',$what, $asfile);
  return eval
    #do
  {
    #printlog 'dev' ,0 ;
    eval('use LWP::UserAgent; use URI::URL;1;') or printlog( 'err', 'http use libs', @!, $! );    #if not installed
    my $ua = LWP::UserAgent->new(
      'agent' => $config{'useragent'} || $config{'crawler_name'},
      'timeout' => hconfig( 'timeout', $url{'host'}, $url{'prot'} ) || 10,
      %{ $config{'lwp'} || {} }, %{ $lwpopt || {} }
    );
    #$ua->proxy('http', 'http://proxy.ru:3128');
    if ( ref $config{'proxy'} eq 'ARRAY' ) {
      local @_ = @{ shuffle( $config{'proxy'} )->[0] };
      #printlog('proxy', @_, Dumper($config{'proxy'}));
      $ua->proxy(@_);
    } elsif ( $config{'proxy'} ) {
      $ua->proxy( 'http', $config{'proxy'} );
    }
    #printlog 'dev' ,1 , $asfile , $c;
    $ua->mirror( $what, $c ), return $c if $asfile;
    $method ||= 'GET';
    #print "RwM:$method;";
    #my $resp =( $method eq 'HEAD' ? $ua->head($what) :
    my $resp = (
      $ua->request(
        HTTP::Request->new(
          $method,
          URI::URL->new($what),
          HTTP::Headers->new(
            #'User-Agent' => ($config{'useragent'} || $config{'crawler_name'}),
            %{ $headers_in || {} }
          ),
          $content
        )
      )
    );
    #my $ret = $headers ? \$resp->content : \$resp->asfile;
    my $ret = $headers_out ? 'as_string' : 'content';
    #printlog 'resp', Dumper $resp;
    #print "[H:",$resp->header();
    #print "[H:",$resp->code();
    if ( $resp->is_success ) {
      if ( $config{'cachedir'} ) {
        open( CF, '>', $c ) or return;
        binmode(CF);
        print CF$resp->$ret();    #content;
        #print CF $ret->(); #content;
        close(CF);
      }
      #return $asfile ? $c : ($resp->content); #{map {$_ => $resp->header($_)}$resp->header_field_names}
      #printlog('dev', 'http ret', $ret, $asfile,"NOW");
      #return "FUCCCCKKAAA";
      #return $resp->$ret();
      return ( $asfile ? $c : ( $resp->$ret() ) );    #{map {$_ => $resp->header($_)}$resp->header_field_names}
      #return $asfile ? $c : $ret->(); #{map {$_ => $resp->header($_)}$resp->header_field_names}
    } else {
      printlog( 'dev', 'http getfail', $what, $resp->code(), $resp->message() );
      #return $asfile ? undef: $resp->message;
      return undef;
    }
    1;
  } or printlog( 'err', @$, @!, $! );
  return undef;
}

sub http_get_code ($;$$) {
  my ( $what, $lwpopt, $method ) = @_;
  #printlog('dev', 'http_get_code',$what, $method);
  my $ret = eval {
    eval('use LWP::UserAgent; use URI::URL;1;') or printlog( 'err', 'http use libs', @!, $! );    #if not installed
    #my $ua = ;
    #$ua->proxy('http', 'http://proxy.ru:3128');
    my $resp = (
      ( LWP::UserAgent->new( 'timeout' => hconfig('timeout'), %{ $config{'lwp'} or {} }, %{ $lwpopt or {} } ) )->request(
        HTTP::Request->new(
          ( $method or 'GET' ),
          URI::URL->new($what), HTTP::Headers->new( 'User-Agent' => $config{'useragent'} || $config{'crawler_name'} )
        )
      )
    );
    #print "[H:",$resp->header();
    #print 'GCR', $resp->code(), "\n";
    return $resp->code();
  } or printlog( 'err', @$, @!, $! );
  return $ret || undef;
}

sub html_strip($) {
  my $s = $_[0];
  $s =~ s{HTTP/.*?\n\n}{}gs;
  $s =~ s///gs;
  $s =~ s{<$_.*?>.*?}{}gs for qw(script style);
  $s =~ s{}{}gs;
  return $s;
}

sub loadlist {
  my %res = ();
  for my $sca (@_) {
    next unless $sca;
    open( SSF, '<', $sca ) or next;
    while () {
      next if /^\s*[#;]/;
      local @_ = split /\s+/, $_;
      my $host = shift or next;
      local %_;
      get_params_one( \%_, @_ );
      $res{$host} = \%_;
    }
    close(SSF);
  }
  return wantarray ? %res : \%res;
}
sub shelldata(@) { s/[\x0d\x0a\"\'\`|><&]//g for @_; }    #`

=c
sub save_list {
 my ($file, $data) = @_;
 use Storable;
 store($data, $file);
=c
 return 1 unless open(SF, '>', $file);
 for my $str (sort keys %$data) {
    print SF join(' ', map{     encode_url($_) . (length($data->{$str}{$_}) ? ( '='. encode_url($data->{$str}{$_})) : ())} sort keys %{$data->{$str}});
#for my $k (sort keys %{$data->{$str}}) {
#}
   print SF "\n";
 }

 close(SF);
}
=cut

=schedule

schedule(everysec, our $___mysub ||= sub{});
schedule([firstafter, everysec], our $___mysub ||= sub{});
schedule({wait=>10, every=>5}, our $___mysub ||= sub{});

=cut

sub schedule($$;@) {    #$Id: psmisc.pm 4847 2014-06-30 23:41:45Z pro $ $URL: svn://svn.setun.net/search/trunk/lib/psmisc.pm $
  our %schedule;
  my ( $every, $func ) = ( shift, shift );
  my $p;
  ( $p->{'wait'}, $p->{'every'}, $p->{'runs'}, $p->{'cond'}, $p->{'id'} ) = @$every if ref $every eq 'ARRAY';
  $p = $every if ref $every eq 'HASH';
  $p->{'every'} ||= $every if !ref $every;
  $p->{'id'} ||= join ';', caller;
  #dmp $p, \%schedule;
  #dmp $schedule{ $p->{'id'} }{'runs'}, $p->{'runs'}, $p, $schedule{ $p->{'id'} } if $p->{'runs'};
  $schedule{ $p->{'id'} }{'func'} = $func if !$schedule{ $p->{'id'} }{'func'} or $p->{'update'};
  $schedule{ $p->{'id'} }{'last'} = time - $p->{'every'} + $p->{'wait'} if $p->{'wait'} and !$schedule{ $p->{'id'} }{'last'};
  #dmp("RUN", $p->{'id'}),
  ++$schedule{ $p->{'id'} }{'runs'}, $schedule{ $p->{'id'} }{'last'} = time, $schedule{ $p->{'id'} }{'func'}->(@_),
        if ( $schedule{ $p->{'id'} }{'last'} + $p->{'every'} < time )
    and ( !$p->{'runs'} or $schedule{ $p->{'id'} }{'runs'} < $p->{'runs'} )
    and ( !( ref $p->{'cond'} eq 'CODE' ) or $p->{'cond'}->( $p, $schedule{ $p->{'id'} }, @_ ) )
    and ref $schedule{ $p->{'id'} }{'func'} eq 'CODE';
}
{    #$Id: psmisc.pm 4847 2014-06-30 23:41:45Z pro $ $URL: svn://svn.setun.net/search/trunk/lib/psmisc.pm $
  my (@locks);
  sub lockfile($) {
    return ( $config{'lock_dir'} || './' ) . ( length $_[0] ? $_[0] : 'lock' ) . ( $config{'lock_ext'} || '.lock' );
  }

  sub lock (;$@) {
    my $name = shift;
    my %p = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    $p{'sleep'}   //= $config{'lock_sleep'}   // 1;
    $p{'timeout'} //= $config{'lock_timeout'} // 600 unless length $p{'timeout'};
    $p{'old'}     //= $config{'lock_old'}     // 3600;
    #$p{'readonly'} ||= 0; #dont write lock file, only wait
    my $waitstart = time();
    my $waits;
  LOCKWAIT:
    while ( -e lockfile $name) {
#printlog( 'lockdev', 'locktime', -M lockfile $name, time() - $^T + 86400 * -M lockfile $name,       $^T + 86400 * -M lockfile $name,      86400 * -M lockfile $name,      );
      printlog( 'lock', $name, 'ignore too old', -M lockfile $name, time() - $^T + 86400 * -M lockfile $name), last
        if time() - $^T + 86400 * -M lockfile $name > $p{'old'};
      printlog( 'lock', $name, 'fail, timeout', int( time() - $waitstart ) ), return 0 if time() - $waitstart > $p{'timeout'};
      printlog( 'lock', 'locked, wait', $name ) unless $waits++;
      sleep $p{'sleep'};
    }
    printlog( 'lock', 'unlocked', $name, 'per', int( time() - $waitstart ) ) if $waits;
    return 1 if $p{'readonly'};
    local $_ = "pid=$$ time=" . int( time() );
    file_rewrite lockfile $name, $_;
    file_rewrite;    #flush
    if ( open my $f, '<', lockfile $name) {
      local $/ = undef;
      my $c = <$f>;
      close $f;
      #printlog 'test', $c;
      printlog( 'warn', 'not my lock', $_, $c ), goto LOCKWAIT if $_ ne $c;
    } else {
      printlog( 'err', 'lock open err', $name, lockfile $name);
      return 0;
    }
    push @locks, lockfile $name;
    return 1;
  }

  sub unlock (;$) {
    my $name = shift;
    local $_ = pop @locks;
    push @locks, $_ if length $name and lockfile($name) ne $_;
    #$name ||= $_;
    #printlog 'lock', 'unlocking', $name, lockfile $name;
    #unlink lockfile( $name ||= $_ );
    unlink $name ? lockfile($name) : $_;
  }

  sub unlock_all () {
    #unlink $_ for reverse @locks;
    unlink $_ while $_ = pop @locks;
  }

  END {
    printlog( 'lock', 'END locked unlock', @locks ) if @locks;
    unlock_all();
  }
  $SIG{$_} ||= sub {
    printlog( 'lock', 'SIG locked unlock', @locks ) if @locks;
    unlock_all();
    exit;
    }
    for qw(INT QUIT KILL TERM);    #HUP
}
{
  my ( $current, $order );

  sub program(;$$) {
    my ( $name, $setorder ) = @_;
    return $current unless $name;
    $program{ $current = $name }{'order'} ||= ( $setorder or $order += ( $config{'order_step'} || 10 ) );
    #print "newprog($current, $program{$current}{'order'});" ;
    return $current;
  }                                #v2
}

sub printall {
  local $_ = shift;
  return unless length $_;
  $_ = $$_ while ref $_ eq 'REF';
  return $_->(@_) if ref $_ eq 'CODE';
  #local
  @_ = () if ref $_[0];
  print( $$_, @_ ), return if ref $_ eq 'SCALAR';
  print $_, @_;
}
program('params');
$program{ program() }{'force'} = 1;
$program{ program() }{'func'} ||= sub { $param = get_params(); };
program('params_pre_config');
$program{ program() }{'mask'}       ||= '^(-*c(onf)?-*)|(--).*';
$program{ program() }{'param_name'} ||= 1;
$program{ program() }{'func'}       ||= sub {
  my ( $v, $w ) = @_;
  $w =~ s/^(-*c(onf?)?-*)|(--)//i;
  $v =~ s/^NUL$//;
  return 0 unless defined($w) and defined($v);
#local @_ = split /__/, eval( '$config' . join( '', map { '{$_[' . $_ . ']}' } ( 0 .. $#_ ) ) . '= $param->{$_};' )  for ( grep { $param->{$_} } keys %$param );
  local @_ = split( /__/, $w ) or return 0;
  #print( 'dev', 'genpre',$w, $v, @_, "\n");
  #printlog( 'dev', 'gen', @_,'$config' . join( '', map { '{$_[' . $_ . ']}' } ( 0 .. $#_ ) ) . ' = $v;' );
  eval( '$config' . join( '', map { '{$_[' . $_ . ']}' } ( 0 .. $#_ ) ) . ' = $v;' );
  #for ( grep { $param->{$_} } keys %$param );
  #$config{$w} = $v if defined($w) and defined($v);
  #printlog('dev', 'res', $config{'zzz'}{'yy'});
  return 0;
};
program('config');
$program{ program() }{'force'} = 1;
$program{ program() }{'func'} ||= sub {
  #print "COOOO";
  config_reload();    #$param
  pre_calc($param);
  #config_init($param);
  return 0;
};
program('params_config');
%{ $program{ program() } } = ( %{ $program{'params_pre_config'} }, 'order' => $program{ program() }{'order'} );
program( 'help', 100000 );
$program{ program() }{'mask'} ||= '^-*he?l?p?$';
$program{ program() }{'func'} ||= sub {
  print "Usage: perl $work{'$0'} [action[=params]] [--config_key[=value]] [...] \n\n Actions:\n";
  for ( sort keys %program ) {
    next if $program{$_}{'force'} or /(_aft)|(_bef)$/;
    print "$_ $program{$_}{'desc'}\n";
  }
  print "\nConfig defaults:\n";
  for ( sort keys %config ) { print "--$_\t[$config{$_}]\n"; }
};

sub program_one($;@) {
  my $current = shift;
  return undef unless exists $program{$current};
  if ( $program{$current}{'func'} and !$program{$current}{'disabled'} ) {
    my @ret;
    printlog( 'trace', 'program run', $current, @_ );
    eval { @ret = $program{$current}{'func'}->(@_); };
    printlog( 'err', 'program', $current, 'run error:', $@ ) if $@;
    return wantarray ? @ret : $ret[0];
  }
  return undef;
}

sub program_run(;$) {
  for my $n ( 0 .. 1 ) {
    my %masks;
    for my $current ( sort keys %program ) { ++$masks{ $program{$current}{'mask'} ||= "^-?$current\\d*\$" }; }
    $program{'default'}{'notmask'} = '^-?(' . join( '|', keys %masks ) . ")\\d*\$";
    for my $current ( grep { !$program{$_}{'checked'} } sort { $program{$a}{'order'} <=> $program{$b}{'order'} } keys %program )
    {
      next if $current eq 'default' and !$n;
      ++$program{$current}{'checked'};
      for my $par ( sort( keys %$param ), grep { $program{$_}{'force'} } keys %program ) {
        if (
          #BUG!!! next line always NOT on one char targets (/ z x ....)
          ( (
              !( $program{$current}{'notmask'} and $par =~ /$program{$current}{'notmask'}/i )
              and $par =~ /$program{$current}{'mask'}/i
            )
            or $program{$current}{'force'}
          )
          and !$program{$current}{'runned'}
          )
        {
          local @_ = (
            ( ( defined( $param->{$par} ) and $param->{$par} ne '' ) ? $param->{$par} : () ),
            ( $program{$current}{'param_name'} ? $par : () )
          );
          state( 'program:', $current, @_ );
          program_one( $current . '_bef', @_ );
          my @r = program_one( $current, @_ );
          program_one( $current . '_aft', @_, \@r );
          printlog( 'warn', 'program finished', $current, '=', @r ) if $r[0] and !ref $r[0];
          $program{$current}{'runned'} = 1 if $program{$current}{'once'} or $program{$current}{'force'};
          $program{$current}{'force'} = '';
        }
      }
    }
  }
}
#BEGIN { config_init(); }
config_init();
#
#
#
#
#
package    #hide from cpan
  psconn;
use strict;
our $VERSION = ( split( ' ', '$Revision: 4847 $' ) )[1];
#use psmisc;
#sub connection {
sub new {
  my $class = shift;
  my $self  = {};
  bless( $self, $class );
  $self->init(@_);
  #printlog( 'conn', 'new', $self, $class, 'deb:', $self->{'error_sleep'} );
  return $self;
}

sub init {
  my $self = shift;
  local %_ =
    ( 'connected' => 0, 'connect_auto' => 1, 'connect_tries' => 100, 'connect_chain_tries' => 10, 'error_sleep' => 5, @_ );
  #@{$self}{ keys %_ } = values %_;
  $self->{$_} //= $_{$_} for keys %_;
  #printlog('dev', 'conn init error_sleep', $self->{'error_sleep'});
  $self->connect() if $self->{'auto_connect'};
  return $self;
}
##methods
#connect
#reconnect
#disconnect
#dropconnect
#keep
##child can do
#_connect
#_disconnect
#_dropconnect
#check_error
#parse_error
#_keep
##vars
#tries
#error_sleep
#auto_connect
##vars status
#connected
sub connect {
  my $self = shift;
  #return ($self->{'connect_check'} ? $self->keep() : 0) if $self->{'connected'};
  return 1 if $self->{'in_connect'} or $self->{'in_disconnect'};
  return $self->keep() if $self->{'connected'};
  #printlog( 'dev', "conn::connect[$self->{'connect_tried'} <= $self->{'connect_tries'}]" );
  #if (!$self->_connect()) {   #ok
  my $aftersleep = 1;
  while ( !$self->{'die'} ) {
    if (  ( !$self->{'connect_tries'} or $self->{'connect_tried'}++ <= $self->{'connect_tries'} )
      and ( !$self->{'connect_chain_tries'} or $self->{'connect_chain_tried'}++ <= $self->{'connect_chain_tries'} ) )
    {
      #do {    {    #ok
      $self->{'in_connect'} = 1;
      if ( !$self->_connect() ) {
        #printlog('CONNECTED!?');
        $self->{'in_connect'} = 0;
        ++$self->{'connected'};
        ++$self->{'connects'};
        $self->{'connect_chain_tried'} = 0;
        #printlog( 'dev', 'oncon', $_ ),
        $self->{ 'on_connect' . $_ }->($self) for grep { ref $self->{ 'on_connect' . $_ } eq 'CODE' } ( '', 1 .. 10 );
        return 0;
      }
      $self->{'in_connect'} = 0;
      $self->dropconnect();
      $self->log(
        'dev',
        'psconn::connect run sleep',
        $self->{'error_sleep'},
        "c=$self->{'connect_tried'}/$self->{'connect_tries'}",
        "ch=$self->{'connect_chain_tried'}/$self->{'connect_chain_tries'}",
      );
      $self->sleep( $self->{'error_sleep'} );
      $aftersleep = 0;
    } else {
      $self->log( 'dev',
" if (( $self->{'connect_tried'}++ <= $self->{'connect_tries'} or !$self->{'connect_tries'} ) and ( $self->{'connect_chain_tried'}++ <= $self->{'connect_chain_tries'} or !$self->{'connect_chain_tries'} ) )"
      );
      last;
    }
  }
  #} while ( ++$self->{'connect_tried'} <= $self->{'connect_tries'} );
  $self->sleep($aftersleep) if $aftersleep;
  return 1;
}

sub reconnect {
  my $self = shift;
  $self->disconnect(@_);
  return $self->connect(@_);
  #++$self->{'reconnects'};
}

sub disconnect {
  my $self = shift;
  return 0 unless $self->{'connected'};
  #printlog('trace', 'psconn::disconnect');
  $self->_disconnect(@_);
  $self->dropconnect(@_);
}

sub dropconnect {
  my $self = shift;
  return 0 unless $self->{'connected'};
  $self->_dropconnect(@_);
  $self->{'connected'} = 0;
}

sub keep {
  my $self = shift;
  #print("psconn::keep\n");
  #print("psconn::keep:R1=0\n"),
  return 0 if $self->{'connected'} and !$self->{'connect_check'};
  #local $_ =$self->_check();
  #print("keep:preR2[$_]\n");
  #print("keep:R2=0[$_]\n"),
  #return 0 if !$_;
  return 0 if !$self->_check();
  #print("keep:postR2[$_]\n");
  #print('keep:R3=rc'),
  return $self->reconnect();
}

sub _connect {
  my $self = shift;
  #printlog('NEWER');
  return 0;
}

sub _disconnect {
  my $self = shift;
  return 0;
}

sub _dropconnect {
  my $self = shift;
  return 0;
}

sub _check {
  my $self = shift;
  #printlog('DONT');
  return 0;
}

sub check_error {
  my $self = shift;
  return 0;
}

sub parse_error {
  my $self = shift;
  return 0;
}

sub DESTROY {
  my $self = shift;
  #printlog('trace', 'psconn::DESTROY');
  $self->disconnect();
}

sub sleep {
  my $self = shift;
  #$self->log( 'dev', 'psconn::sleep', @_ );
  #local $_ = $work{'sql_locked'};
  #sql_unlock_tables() if $work{'sql_locked'} and $_[0];
  CORE::sleep(@_);
  #return psmisc::sleeper(@_);
  #sql_lock_tables($_) if $_ and $_[0];
}
1;