xref: /dports/net/prosearch/search/crawler.pl

#!/usr/local/bin/perl
#$Id: crawler.pl 4843 2013-08-14 12:17:58Z pro $ $URL: svn://svn.setun.net/search/trunk/crawler.pl $

=copyright
PRO-search crawler
Copyright (C) 2003-2011 Oleg Alexeenkov http://pro.setun.net/search/ proler@gmail.com

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 <http://www.gnu.org/licenses/>.
=cut

package pscrawler;
use strict;
no warnings qw(uninitialized);
no if $] >= 5.017011, warnings => 'experimental::smartmatch';
use utf8;
use Time::Local;
use Time::HiRes qw(time sleep);
use Encode;
use Net::FTP;
use Data::Dumper;    #dev only
$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = $Data::Dumper::Terse = 1;
exit if defined $ENV{'REMOTE_ADDR'};    # cgi not allowed
#use lib './dcppp', './lib';
our ( %config, $param, %work, %stat, %static );
our ( %processor, %program );           #, %human
#*pscrawler::work = *main::work;
#*pscrawler::stat = *main::stat;
#*pscrawler::config = *main::config;
#*pscrawler::program = *main::program;
*config = *main::config;
#=z
#use vars
my ( $tq, $rq, $vq );
our ( @ISA, @EXPORT, @EXPORT_OK );
require Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw( %config $param %work %stat %static );
#=cut
#$0 =~ m|^(.+)[/\\].+?$|;                #v0
#our $root_path ||= $1 . '/' if $1;
#$root_path =~ s|\\|/|g;
use lib::abs qw(./ ./lib);
#eval "use lib '$root_path'" if $root_path;
#eval "use lib '$root_path./lib';
#      use psmisc; use pssql;";          #use Net::DirectConnect;
use psmisc qw(:all);
use pssql;
psmisc::use_try('Net::DirectConnect');
#'$root_path./dcppp',
print($@), exit if $@;
#use lib ;
my (%ipstt);
#our was here
$work{'start_timer'} = psmisc::timer();
use sigtrap qw(handler safedie normal-signals error-signals INFO);

sub safedie {
  printlog( 'info', $0, make_stat() ), return if $_[0] eq 'INFO';
  printlog(
    'info', 'Signal ', @_,
    'recieved, flushing buffer, reloading conf.',
    ( %stat ? ( 'Stat: ', map { "$_=$stat{$_};" } keys %stat ) : () )
    ),
    #$processor{'out'}{'array'}->()
    $static{'db'}->flush_insert(), psmisc::config_read(), psmisc::config_reload(), return
    if $_[0] eq 'HUP' and ( $config{'win_hup'} or $config{'system'} ne 'win' );
  printlog( 'info', 'Signal', @_, 'recieved, ignoring, not fatal?' ), return if grep { $_[0] eq $_ } qw(PIPE SEGV);
  printlog( 'info', 'Signal', @_, 'recieved, exiting' );
  #{
  #local $config{'log_all'} = 1; #DEV
  #printlog( 'info', 'executing on_interrupt', int(time) );
  $work{'on_interrupt'}->(@_) if ( !$work{'die'} and $work{'on_interrupt'} );
  #}
  $static{'db'}->{'die'} = $work{'die'} = 1;
  exit;
}

sub on_interrupt {
  $work{'on_interrupt'} = undef, return unless @_;
  $work{'on_interrupt'} = $_[0] if $_[0];
}

sub allowscan {
  my ( $by, $table, $tim, $period ) = @_;
  return 0 unless %$by;
  return 1 if $config{'force'};
  if (    #!$config{'sql _use_dbi'}    or
    $static{'banned'}->{ join_url($by) } or $static{'banned'}->{ $by->{'host'} } or $static{'banned'}->{ $by->{'range'} }
    )
  {

=c
printlog('dbg','allowscan:banned:', join_url($by),'ra=',$by->{'range'} , 'reason:',
"sud: ! $config{'sql _use_dbi'}
  banby:  or ",$static{'banned'}->{ join_url($by) },"
  ho  or ", $static{'banned'}->{ $by->{'host'} }, "
  ra  or ", $static{'banned'}->{ $by->{'range'} } , "
  ra h", %{$static{'banned'}->{ $by->{'range'} } }

);
=cut

    $static{'db'}->update( $table, undef, { %$by, 'scan' => int( time() ) + $config{'banned_time'} } )
      if $table and $config{'banned_time'};
    return 0;
  }
  #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
  my $where = join(
    ' AND ',
    map( "$rq$_$rq = " . $static{'db'}->quote( $by->{$_} ),
      grep { %{ $config{'sql'}{'table'}{$table}{$_} or {} } and $config{'sql'}{'table'}{$table}{$_}{'primary'} } keys %$by )
  );
  #MAKE QUERY
  #printlog('dev', "tim($tim) per($period)", );
  my $base =
    ( $table
      and %$by
      and ( !$tim or !$period )
    ? $static{'db'}->line("SELECT ${rq}scan$rq, ${rq}period$rq FROM $tq$static{'db'}->{'table_prefix'}$table$tq WHERE $where")
    : {} );
  #printlog('dev', 'btim, bper = ', $base->{'scan'}, $base->{'period'});
  #printlog('dev', 'skiptime',join_url($by), $tim);
  $tim ||= $base->{'scan'};
  $work{'skiptime'}{ join_url($by) } = $tim;
  $period ||= ( $base->{'period'} or hconfig( 'period', $by->{'host'}, $by->{'prot'} ) );
  $work{'skipperiod'}{ join_url($by) } = $period;
  if ( !$tim or ( $tim < time - $period ) ) {
    local $config{'scan_timeout'} = $period / 2 if $config{'scan_timeout'} >= $period;
    $static{'db'}->update(
      $table, undef, {
        $static{'db'}->filter_row( $table, 'primary', $by ), (
          #$period ne $base->{'period'} ? ( 'period' => $period ) : (),
          $config{'noscan'} ? () : ( 'scan' => int( time() ) - $config{'scan_timeout'} )
        )
      }
    ) if $table;
    #printlog('dbg','allowscan', join_url($by), psmisc::human('time_period',time - $tim), psmisc::human('time_period',$period));
    return 1;
  }
#else { printlog('dbg','NOT allowscan', join_url($by), psmisc::human('time_period',time - $tim), psmisc::human('time_period',$period)); }
  return 0;
}

sub resetcounters {
  ( $work{'sizec'}, $work{'filec'}, $work{'dirc'} ) =
    ( counter( $stat{'size'} ), counter( $stat{'files'} ), counter( $stat{'dirs'} ) );
}

sub uni_get {
  my ($what) = @_;
  my ($prot) = $what =~ m|^\s*(\w+):|;
  return $processor{'prot'}{$prot}{'get'}->($what) if $prot and ref $processor{'prot'}{$prot}{'get'} eq 'CODE';
  return $what;
}

sub scan_stop () {
  local $_ = $work{'die'} || $config{'periodic_stop'} || ( !$config{'no_stop'} and -f $config{'stop_file'} );
  printlog( 'info', "stopping: fl=$config{'periodic_stop'} file=$config{'stop_file'}" ) if $_;
  $_;
}

sub oneliner {
  my ( $oneline, $content ) = @_;
  #if ( $content =~ /^GLOB/ ) {
  if ( ref $content eq 'GLOB' ) {
    while (<$content>) { $oneline->(); if ($work{'interrupt'} ){delete $work{'interrupt'}; close $content; last; }; }
    #} elsif ( $content =~ /^ARRAY/ ) {
  } elsif ( ref $content eq 'ARRAY' ) {
    while ( defined( $_ = shift @$content ) ) { $oneline->(); }
  } else {
    for ( split( "\n", $content ) ) { $oneline->(); }
  }
}
$processor{'desc'}{'m3u'}{'func'} ||= sub {
  my ( $file, $data ) = @_;
  return unless $file;
  my ( $curdesc, %detectcp );
  $file = Encode::encode hconfig(
    'cp_shell'    #, $host, $prot
  ), $file, Encode::FB_DEFAULT;
  open( DESC, '<', $file ) or return ();
  while (<DESC>) {
    cp_detect_trans( $_, \%detectcp, $config{'cp_int'}, $config{'cp_m3u'} );
    if (/^#EXTINF:(\d+),(.+)/i) {
      #$curdesc = '[' . $1 . 's] ' . $2;
      $curdesc = $2;
      $data->{$_}{'meta'} .= " len=$1";
      $curdesc =~ s/[\x0d\x0a\x00-\x1F]+/ /g;
    } elsif (/^(.+\..+)$/) {
      tr/A-Z/a-z/;
      s/[\x0d\x0a\x00-\x1F]//g;
      s/^\s+|\s+$//g;
      $data->{$_}{'desc'} .= ' ' . $curdesc;
    }
  }
  close(DESC);
  return $data;
};
$processor{'desc'}{'bbs'}{'func'} ||= sub {
  my ( $file, $data ) = @_;
  #printlog "bbs[( $file,  )]", Dumper $data;
  return unless $file;
  my $curfile = '';
  my %detectcp;
  $file = Encode::encode hconfig(
    'cp_shell'    #, $host, $prot
  ), $file, Encode::FB_DEFAULT;
  open( DESC, '<', $file ) or return;    #(printlog('dev', "cant open [$file]"),return ());
  while (<DESC>) {
    #printlog Dumper "bbs[$_]";
    if (/^-(.*)/) { next; }
    elsif (/^(\w\S*)\s*(\[\s*(\d*)\]\s*)?(.*)\s*/) {
      $curfile = $1;
      $curfile =~ tr/A-Z/a-z/;
      $curfile =~ s/\.$//g;
      my $desc = $4;
      cp_detect_trans( $desc, \%detectcp, $config{'cp_int'}, $config{'cp_desc'} );
      #!!! TODO UTF:# $desc =~ s/[\x0d\x0a\x00-\x1F]+/ /g;
      $data->{$curfile}{'desc'} .= ' ' . $desc unless ( $desc =~ /^\s*$config{'nodesc'}\s*$/i );
    } else {
      next unless $curfile;
      next unless /^\s*(.+)/;
      next if length( $data->{$curfile}{'desc'} ) > 250;
      my $tmp = $1;
      next unless $tmp;
      cp_detect_trans( $tmp, \%detectcp, $config{'cp_int'}, $config{'cp_desc'} );
      #!!! TODO UTF:# $tmp =~ s/[\x0d\x0a\x00-\x1F]//g;
      chomp($tmp);
      next unless $tmp;
      $data->{$curfile}{'desc'} .= '\\\\n' . $tmp;
    }
    #params load    $data{$curfile}{desc} = dos2win($data{$curfile}{desc}) if ( exists($data{$curfile}{desc}) );
    #if ( exists($data{$curfile}{desc}) ) { #!!
    #while ($data{$curfile}{desc} =~ s/^\s*file(\S*)\=(\S*)\s*//i) {
    #$data{$curfile}{$1} = $2 if $1 and $2;
    #}
    #}
  }
  close(DESC);
  return $data;
};

sub fileparser {    # $file, $prot, $full, $size, \%files    # $host,
  for my $dsk ( keys %{ $processor{'desc'} } ) {
    #printlog("$config{'desc'}{$dsk}{'mask'} and $_[0] 2:$_[2] 3:$_[3] 4:$_[4] ");
    if ( $config{'desc'}{$dsk}{'mask'} and $_[0] =~ /$config{'desc'}{$dsk}{'mask'}/i ) {
      #printlog("matched![$dsk][m:$config{'desc'}{$dsk}{'max'}][1:$_[1]]");
      psmisc::code_run( $processor{'desc'}{$dsk}{'func'}, psmisc::code_run($processor{'prot'}{ $_[1] }{'get'}, $_[2] ), $_[4] )
        if !$config{'desc'}{$dsk}{'max'}
          or $_[3] <= $config{'desc'}{$dsk}{'max'};
    }
  }
}

sub filesave (@) {
  for (@_) {
    for ( values %$_ ) {
      $_->{type} = $config{ext_to_type}{ $_->{ext} };
      $_->{type} = 1 if !$_->{size};
    }
    #printlog 'ins', Dumper $_;
    $static{'db'}->insert_hash_hash( $config{'sql_tfile'}, $_ );
  }
}

sub update_to_root (\%\%;$$) {
  my ( $res, $core, $local, $url_orig ) = @_;
  my $path_ = '';    #'/';
  #/ /a /a/b /a/b/c
  for my $d (
    !length $res->{'path'} ? '' : split '/',
    #'/' .
    $local ? $url_orig : $res->{'path'}
    )
  {
    #printlog( 'dev', 'cd', $res->{'path'}, 'd:',$d, 'p:',$path_ );
    $core->{'path'} = $path_ || '/';
    $core->{'name'} = $d;
    #printlog('dev',  $res->{'path'}, $path_, Dumper $core);
    $static{'db'}->update( $config{'sql_tfile'}, undef, $core );
    $core->{'desc'} = '';
    $path_ .= '/' . $d if length $d;
    #dmp('dsc!'),
    $core->{'desc'} = $res->{'desc'} if $res->{'path'} eq $path_;
  }
  #=cut
}

=cu

$processor{'out'}{'mysql'} ||= sub {
  return $static{'db'}->do(@_) if $config{'sql_use_dbi'};

  cut
  my @ret;
  for my $st (@_) {
    my $str = $st;                          # bugg
    my $q = ( $str =~ /\"/ ? "'" : '"' );
    $str =~ s/$q//g;
    $str =~ s/\`/\\`/g;
    printlog( 'dmp', "via mysql cmdline query {$str}" );
    my $up =
        ( $config{'sql_user'} ? "-u$config{'sql_user'} " : '' )
      . ( $config{'sql_pass'} ? "-p$config{'sql_pass'} " : '' )
      . ( $config{'sql_port'} ? "-P$config{'sql_port'} " : '' );
    push( @ret, `$config{'mysql'} $up $config{'sql_mysqlopt'} -e $q$str$q $config{'sql_base'}` );
  }
  return @ret;

};
=cut

=TODO
$processor{'out'}{'mysql_file'} ||= sub {
  printprog("$config{'mysql'} $config{'sql_mysqlopt'} $config{'sql_base'} < $_") for @_;
};

{
  my $gt = timer();
  $processor{'out'}{'sql'} ||= sub {
    my $ret;
    for my $str (@_) {
      next unless $str;
      if ( $config{'sql_use_dbi'} ) {
        my $t = timer() if $config{'debug_time'};
        $ret += $static{'db'}->do($str);
        printlog(
          'time',
          'SQL',
          psmisc::human( 'time_period', $t->() ),
          ',by',
          $ret,
          ( $t->() > 1 ? '=' . psmisc::human( 'float', $ret / $t->() ) . 'fps' : () ),
          ',SCAN=',
          psmisc::human( 'time_period', $gt->() ),
          ',',
          ( $gt->() > 1 ? '=' . psmisc::human( 'float', $ret / $gt->() ) . 'fps' : () )
        ) if $config{'debug_time'} and $config{'debug_time'} <= $ret;
        $gt = timer() if $config{'debug_time'};
      } else {
        open_out_file('hosts') unless $work{'current_name_work'};
        print I$str;
        ++$ret;
      }
    }
    return $ret;
  };
}

=cut

$processor{'format'}{'dir'} ||= sub {
  my $scan           = int( time() );
  my $curent_process = shift(@_);
  $curent_process =~ s/^(\S+:)?(\/*[^\/]+\/[^\/]+)\/(.+)$/$1$2/;
  #printlog('dev', 'cp', $curent_process);
  return unless $curent_process;
  $curent_process =~ tr/\\/\//;
  #printlog('dev', 'cp', $curent_process);
  my $path = $3;
  $path = $curent_process . '/' . $path;
  $path =~ s/[\\\/]+$//g;
  my $local;
  $local = 1 if $curent_process =~ m{^(?:\w:|/)};
  $local = 0 if $curent_process =~ m{^//};
  my $prot = 'file';
  $prot = $config{'local_prot'} if $local and $config{'local_prot'};
  my $errors = 0;
  my %files  = ();
BUG: for my $content (@_) {
    my ( $host, $dir_ ) =
      $local ? ( $config{'local_host'}, $curent_process ) : $curent_process =~ /^\/+([^\/]+)\/+([^\/]+)(.*)/;
    #printlog('dev', 'cp', $curent_process, "hd[$host, $dir_]");
    #$host = $config{'local_host'} if $local;

=z
    if ($host) {
      $files{''} = {
        'prot' => $prot,
        'host' => $host,
        'scan' => $scan,
        ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
      };

      $files{' '} = {
        'prot' => $prot,
        'host' => $host,
        'path' => '/',
        ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
        'scan' => $scan,
      };
#=cut

#if (length $dir_) {
      my $path_ = '';    #'/';
#/ /a /a/b /a/b/c
      for my $d ( split '/', '/' . $dir_ ) {
        #printlog('dev','cd', $d, $path_);
        $files{ '  ' . $path_ . $d } = {
          'prot' => $prot,
          'host' => $host,
          'scan' => $scan,
          'path' => $path_ || '/',
          'name' => $d,
          ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
        };
        $path_ .= '/' . $d if length $d;
      }
#}
    }
=cut

    my $oneline = sub {
      #printlog('dev', 'G0', $_);
      my ( $mday, $mon, $year, $hours, $min, $size, $file, $ext, $desc, $utime );
      if (/^ (Directory of|Содержимое папки) (.+)\s*$/) {
        #printlog('dbg', 'ins1', Dumper(\%files));
        #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
        filesave( \%files );
        %files = ();
        $path  = $2;
        $path =~ tr/\\/\//;
        $path =~ s/[\x0a\x0d\x00-\x1F]+//g;
        chomp($path);
        #$path = cp_trans(hconfig('cp_share', $host), hconfig('cp_db', $host), $path);
        #$path = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_db', $host, $prot ), $path );
        $config{'local_path'}->($path) if $local and ref $config{'local_path'} eq 'CODE';
        #printlog('dev', 'r0', $path),
        return;
      } elsif ( hconfig( 'skip_path_mask', $host ) and $path =~ /$config{'skip_path_mask'}/i ) {
        ++$stat{'skipped'};
        #printlog('dev', 'r1'),
        return;
      } elsif (/^\s*Total Files Listed/) {
        #printlog('dev', 'n2'),
        next BUG;
      } elsif ( /^Имя папки (.+) слишком длинно./ and ++$errors > hconfig( 'max_errors', $host, $prot ) ) {
        printlog( 'err', 'max errors reached:', $errors, $_ );
        #printlog('dev', 'l3'),
        last;
      }
      ( $mday, $mon, $year, $hours, $min, $size, $file ) = /(\d+)\.(\d+)\.(\d+)\s+(\d+)\:(\d+)\s+(\d+|\<DIR\>)\s+(.+)\s*/i
        or return;
      return if $size eq '0';
      $size = 0 if $size =~ /DIR/i;
      return if $file =~ /^\.+$/;
      $file =~ s/[\x0a\x0d\x00-\x1F]//g;
      $file =~ s/\.$//g;
      chomp($file);
      return if hconfig( 'skip_hidden', $host ) and ( $file =~ /^\./ or $path =~ m;(^|/)\.; );
      fileparser( $file, $prot, $path . '/' . $file, $size, \%files );
      #$file = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_db', $host, $prot ), $file );
      my $lfile = $file;
      $lfile =~ tr/A-Z/a-z/;
      $files{$lfile}{'name'} = $file;
      $year += 2000 if length($year) == 2;
      $year = 1990 if ( ( $year > 2020 ) or ( $year < 1980 ) );    #timelocal BUG
      $files{$lfile}{'time'} = timelocal( 0, $min, $hours, $mday, --$mon, $year );
      $files{$lfile}{'time'}     = 640000000 if ( $files{$lfile}{'time'} > ( $scan + 2592000 ) );
      $files{$lfile}{'fullname'} = $prot . ':' . $path . '/' . $file;
      $files{$lfile}{'prot'}     = $prot;
      ( $files{$lfile}{'host'}, $files{$lfile}{'path'} ) = $path =~ /^?\/?\/?([^\/]+)(.+)/;
      $files{$lfile}{'ext'}  = ( $files{$lfile}{'name'} =~ s/\.([^\.]+)$// ? $1 : '' );
      $files{$lfile}{'scan'} = $scan;
      $files{$lfile}{'size'} = $size;
      #printlog('dbg', 'ins', Dumper(\%files));
    };
    oneliner( $oneline, $content );
    #printlog('dbg', 'ins0', Dumper(\%files));
    #exit;
    #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
    #} continue {
    #printlog('dbg', 'ins1', Dumper(\%files));
  }
  #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
  filesave( \%files );
  #%files = ();
};
$processor{'format'}{'smb-ls'} ||= sub {
  my $scan           = int( time() );
  my $curent_process = shift(@_);
  $curent_process =~ s/^(\S+:)?(\/*[^\/]+\/[^\/]+)\/(.+)$/$1$2/;
  return unless $curent_process;
  $curent_process =~ tr/\\/\//;
  $curent_process =~ s{/+$}{};
  my $path = $3;
  $path = $curent_process . '/' . $path;
  $path =~ s/[\\\/]+$//g;
  my $prot = 'file';

  for my $content (@_) {
    my %data  = ();
    my %files = ();
    my $root  = 0;
    my ( $host, $dir_ ) = $curent_process =~ /^\/+([^\/]+)\/+([^\/]+)(.*)/;

=z
    if ($host) {
      $files{''} = {
        'prot' => $prot,
        'host' => $host,
        ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
        'scan' => $scan
      };
      $files{' '} = {
        'prot' => $prot,
        'host' => $host,
        'path' => '/',
        ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
        'scan' => $scan
      };
      $files{'  '} = {
        'prot' => $prot,
        'host' => $host,
        'path' => '/',
        'name' => $dir_,
        ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
        'scan' => $scan
        }
        if $dir_;





    }
=cut

    my $oneline = sub {
      my ( $mday, $mon, $year, $hours, $min, $sec, $size, $file, $ext, $desc, $utime, $attr );
      if (/^(\\.*)\s*$/) {
        #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
        filesave( \%files );
        %files = ();
        ( $path = $1 ) =~ s/\\+/\\/g;
        #$path = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_db', $host, $prot ), $path );
        $path = $curent_process . $path;
        $path =~ tr/\\/\//;
        $path =~ s/[\x0a\x0d\x00-\x1F]//g;
        chomp($path);
        return;
      } elsif ( hconfig( 'skip_path_mask', $host ) and $path =~ /$config{'skip_path_mask'}/i ) {
        ++$stat{'skipped'};
        return;
      } elsif ( hconfig( 'interrupt_path_re', $host ) and $path =~ $config{'interrupt_path_re'} ) {
	printlog('warn', "found interrupt path [$path]");
        ++$work{'interrupt'};
        return;
      }
      ( $size, $mon, $mday, $hours, $min, $sec, $year ) = /\s+(\d+)\s+\w+\s+(\w+)\s+(\d+)\s+(\d+)\:(\d+)\:(\d+)\s+(\d+)\s*$/
        or return;
      $file = $`;
      $file =~ s/\s+([ADHSR]+)$//;
      $attr = $1;
      $file =~ s/(\s*$)|(^\s*)//g;
      return if $file =~ /^\.+\s*$/;
      return if hconfig( 'skip_hidden', $host ) and $attr =~ /H/;
      return if $size eq '0' and !$attr =~ /D/;
      $file =~ s/[\x0a\x0d\x00-\x1F]//g;
      $file =~ s/\.$//g;
      $file =~ s/\s*$//;
      chomp($file);
      return if hconfig( 'skip_hidden', $host ) and ( $file =~ /^\./ or $path =~ m;(^|/)\.; );
      #$file = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_db', $host, $prot ), $file );
      fileparser( $file, $prot, $path . hconfig( 'slash_perl', $host ) . $file, $size, \%files );
      my $lfile = $file;
      $lfile =~ tr/A-Z/a-z/;
      $files{$lfile}{'name'} = $file;
      $year += 2000 if length($year) == 2;
      $year = 1990 if ( ( $year > 2020 ) or ( $year < 1980 ) );    #timelocal BUG
      $mon = $config{'lng'}{ $config{'lng_smbls'} }{'month_table'}{$mon} unless $mon =~ /^\d+$/;
      $files{$lfile}{'time'} = timelocal( $sec, $min, $hours, $mday, $mon, $year );
      $files{$lfile}{'time'}     = 640000000 if ( $files{$lfile}{'time'} > ( $scan + 2592000 ) );
      $files{$lfile}{'fullname'} = $prot . ':' . $path . '/' . $file;
      $files{$lfile}{'prot'}     = $prot;
      ( $files{$lfile}{'host'}, $files{$lfile}{'path'} ) = $path =~ /^?\/?\/?([^\/]+)(.+)/;
      $files{$lfile}{'ext'}  = ( $files{$lfile}{'name'} =~ s/\.([^\.]+)$// ? $1 : '' );
      $files{$lfile}{'scan'} = $scan;
      $files{$lfile}{'size'} = $size;
    };
    oneliner( $oneline, $content );
    #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
    filesave( \%files );
  }
};
$processor{'prot'}{'file'}{'toplevel'} ||= sub {
  return '' unless $config{'smbclient'} or $config{'net_view'};
  my ($host) = @_;
  shelldata($host);
  return unless $host =~ /\S/;
  my $prot = 'file';
  #--user=username[%password]
  #printlog("dev", 'opening');
  my $h = openproc(
    '-|' . ':encoding(' . hconfig( 'cp_res', $host, $prot ) . ')',
    qq{$config{'starter'} $config{'net_view'} $config{'smbclient'} }
      . hconfig( 'smb_opt', $host )
      . qq{ $config{'view_opt'} "$config{'slash_net'}$host" $config{'stderr_redirect'}}
  ) or return '';
  #printlog("dev", 'H:',$h);
  while (<$h>) {
    #printlog("dev", 'proc:',$_);
    #next;
    next unless /^\s*(.+)\s+((Disk)|(Диск)|(IPC))\s+(\w\:)?\s+(.*)\s*$/i;
    my ( $share, $desc ) = ( $1, $7 );
    $share =~ s/\s*$//g;
    next if hconfig( 'skip_hidden', $host ) and $share =~ /\$$/;
    $processor{'prot'}{'file'}{'scan'}->( '//' . $host . '/' . $share );
    #?if ( $desc =~ /\S/ ) {
    #$share = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_db', $host, $prot ), $share );
    $desc =~ s/\s+$//;
    #$desc = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_db', $host, $prot ), $desc );
    #$static{'db'}->insert_hash_hash(
    #printlog('dev',"ins [$share]");
    $static{'db'}->insert_hash(
      $config{'sql_tfile'}, {
        #'' => {
        'prot' => $prot,
        'host' => $host,
        'path' => '/',
        'name' => $share,
        ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
        'desc' => $desc,
        'scan' => int( time() )
          #}
      }
    );
    #}
  }
  close($h);
  return '';
};
$processor{'prot'}{'file'}{'scan'} ||= sub {
  my $prot = 'file';
  for (@_) {
    my $where = $_;
    next if $where =~ /^\s*$/;
    printlog( 'smb', "$where : scanning..." );
    $where =~ s/\\|\//$config{'slash_dir'}/g;    #RO VALUE SOMETIMES
    $where =~ s/[\x0d\x0a\"]//g;
    my ($host) = $where =~ /([\w.]+)/;
    #print('dev', "wbef[$where]");
    my $wheres = $where;    #cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_shell', $host, $prot ), $where );
    $where = Encode::encode hconfig( 'cp_shell', $host, $prot ), $where, Encode::FB_DEFAULT;
    #print('dev', "waft[$wheres]");
    my ($dir);
    ( undef, $where, $dir ) = $where =~ /^(\S+:)?(\/*[^\/]+\/[^\/]+)?\/?(.+)?\/?$/;
    $dir =~ s/\/+$//;
    $dir = '-D ' . $dir if $config{'smbclient'} and $dir;
    shelldata( $where, $dir );
    $where = qq|"$where"| if $where;
    $dir   = qq|"$dir"|   if $dir;
    #--user=username[%password]
    my $h = openproc(
      '-|' . ':encoding(' . hconfig( 'cp_res', $host, $prot ) . ')',
      qq{$config{'starter'} $config{'smbclient'} }
        . hconfig( 'smb_opt', $host )
        . qq{ $config{'dir_cmd'} $config{'smb_ls_opt'} $dir $where $config{'stderr_redirect'}}
    ) or next;
    #$wheres = cp_trans( hconfig( 'cp_shell', $host ), hconfig( 'cp_db', $host ), $wheres );
    $processor{'format'}{ hconfig( 'share_list_fmt', $host ) }->( $wheres, $h );
    #$processor{'format'}{ hconfig( 'share_list_fmt', $host ) }->( $where, $h );
    close($h);
  }
};
#==
#$config{'scanner'}{ 'local' }{'no_res_stat'} =1;
$processor{'prot'}{'local'}{'func'} ||= sub {
  my $prot = 'local';
  for my $wheres (@_) {
    #printlog('dev' , "prot'}{'local'}{'func",$wheres);
    my %url = split_url($wheres);
    $wheres =~ s|^$prot://||i;
    $processor{'prot'}{$prot}{'scan'}->( (
        $wheres
          #( $wheres =~ m|[^/]+/[^/]+| or $wheres =~ m{^(\.|/)} )
          #? ( ( $wheres =~ m{^(\.|/)} ? '' : '//' ) . $wheres )
          #: ( ( $wheres =~ /^\w\:/ ) ? $wheres : $processor{'prot'}{$prot}{'toplevel'}->($wheres) )
      )
    );
    purge_res( \%url ) if $config{'purge_every_res'};
  }
};
$processor{'prot'}{'local'}{'get'} ||= sub { return $_[0]; };
$processor{'prot'}{'local'}{'scan'} ||= sub {
  my $prot = $config{'local_prot'} || 'local';
  for my $where (@_) {
    #my $where = $_;
    next if $where =~ /^\s*$/;
    printlog( 'local', "$where : scanning..." );
    $where =~ s/\\|\//$config{'slash_dir'}/g;
    $where =~ s/[\x0d\x0a\"]//g;
    my ($host) = $config{'local_host'};    #$where =~ /([\w.]+)/;
    my $wheres = $where;    # = cp_trans( hconfig( 'cp_res', $host, $prot ), hconfig( 'cp_shell', $host, $prot ), $where );
    $where = Encode::encode hconfig( 'cp_shell', $host, $prot ), $where, Encode::FB_DEFAULT;
    my ($dir);
    #( $where, $dir ) = $where =~ /^((?:\S+:)?\/*[^\/]+\/[^\/]+)?\/?(.+)?\/?$/;
    #$dir =~ s/\/+$//;
    #$dir = '-D ' . $dir if $config{'smbclient'} and $dir;
    shelldata($where);
    $where = qq|"$where"| if $where;
    #$dir   = qq|"$dir"|   if $dir;
    #--user=username[%password]
    my $h = openproc(
      '-|' . ':encoding(' . hconfig( 'cp_res', $host, $prot ) . ')',
#"$config{'starter'} $config{'smbclient'} $config{'smb_opt'} $config{'dir_cmd'} $config{'smb_ls_opt'} $dir $where $config{'stderr_redirect'} |"
      qq{$config{'starter'} $config{'local_cmd'} $config{'local_opt'} $dir $where $config{'stderr_redirect'}}
    ) or next;
    #$wheres = cp_trans( hconfig( 'cp_shell', $host ), hconfig( 'cp_db', $host ), $wheres );
    #printlog('dev', 'parsef', hconfig( 'local_list_fmt', $host ));
    $processor{'format'}{ hconfig( 'local_list_fmt', $host ) }->( $wheres, $h );
    close($h);
  }
};

sub purge_res {
  local $config{'purge'} = ( $config{'purge_res_time'} or $config{'period'} * 2 );
  psmisc::program_one( 'purge', undef, $config{'sql_tfile'},
    'AND ' . $static{'db'}->where_body( $_[0], undef, $config{'sql_tfile'} ) )
    if $config{'purge_every_res'};
}
$processor{'prot'}{'file'}{'func'} ||= sub {
  my $prot = 'file';
  for my $wheres (@_) {
    my %url = split_url($wheres);
    $wheres =~ s|^$prot://||i;
    $processor{'prot'}{$prot}{'scan'}->( (
          ( $wheres =~ m|[^/]+/[^/]+| or $wheres =~ m{^(\.|/)} )
        ? ( ( $wheres =~ m{^(\.|/)} ? '' : '//' ) . $wheres )
        : ( ( $wheres =~ /^\w\:/ ) ? $wheres : $processor{'prot'}{$prot}{'toplevel'}->($wheres) )
      )
    );
    purge_res( \%url ) if $config{'purge_every_res'};
  }
};
$processor{'prot'}{'file'}{'get'} ||= sub {
  return $_[0] if $config{'system'} =~ /win/i;
  my ( $file, $service, $save ) = @_;
  my $prot = 'file';
  $file =~ s/\|\>\<\"//g;
  ( undef, $service, $file ) = $file =~ /^(\S+:)?(\/*[^\/]+\/[^\/]+)\/(.+)$/;
  $save = encode_url( $prot . ':' . $service . '/' . $file, $config{'encode_url_file_mask'} );
  $file =~ s/\/+/\\\\/g;
  #$file =~ s/\'/\'\'/g;       bbb u u ggg   ' symol in file name
  #$file =~ s/\'/\\\'\\\'/g;   bbb u u ggg       !!!TODO test with "
  #$file =~ s/\'/\\\'/g;       bbb uuu ggg
  return '' if $file =~ /\'/;
  my ($host) = $service =~ /([\w.]+)/;
  #$file = cp_trans( hconfig( 'cp_db', $host, $prot ), hconfig( 'cp_res', $host, $prot ), $file );
  $file = Encode::encode hconfig( 'cp_shell', $host, $prot ), $file, Encode::FB_DEFAULT;
  $save = hconfig('tmpdir') . hconfig( 'slash_sys', $host ) . $save;
  return $save if -e $save and time - $^T + 86400 * -M $save < hconfig( 'purge', $host, $prot );
  shelldata( $file, $save, $service );
  printprog(
    qq{$config{'starter'} $config{'smbclient'} }
      . hconfig( 'smb_opt', $host )
      . qq{ $config{'get_opt'} -c 'get "$file" "$save"' "$service"},
    1
  );
  return $save;
};
{
  my ($ftp);
  $processor{'prot'}{'ftp'}{'get'} ||= sub {
    my ( $file, $save ) = @_;
    my %url = split_url($file);
    $save = encode_url( $file, $config{'encode_url_file_mask'} );
    $file = join_url( { 'path' => $url{'path'}, 'name' => $url{'name'}, 'ext' => $url{'ext'} } );
    $save = hconfig( 'tmpdir', $url{'host'} ) . hconfig( 'slash_sys', $url{'host'} ) . $save;
    $save =~ s/^(.{240}).*/$1/;
    return $save if -e $save and time - $^T + 86400 * -M $save < hconfig( 'purge', $url{'host'}, $url{'prot'} );
    $ftp =
      $work{'ftp'}
      { join_url( { 'user' => $url{'user'}, 'pass' => $url{'pass'}, 'host' => $url{'host'}, 'port' => $url{'port'} } ) };
    #printlog('dev' ,"1:$ftp;", %url);
    return if ftp_keep( $$ftp, %url );
    #printlog('dev' ,"2:$ftp;$$ftp;$$ftp;");
    eval { $$$ftp->get( $file, $save ); };
    return $save;
  };
  END { $$$ftp->close() if !ftp_check($$ftp); }
}
$processor{'prot'}{'rsync'}{'toplevel'} ||= sub {
  return '' unless $config{'rsync'};
  my ($host) = @_;
  #my $prot = 'rsync';
  shelldata($host);
  my %url = split_url($host);
  return unless $host =~ /\S/;
  my $h = openproc( '-|' . ':encoding(' . hconfig( 'cp_res', $url{'host'}, $url{'prot'} ) . ')',
    "$config{'starter'} $config{'rsync'} $config{'rsync_param'} \"$host\" $config{'stderr_redirect'}" )
    or return '';
  my %scanned;
  while (<$h>) {
    next if /^rsync(?: error)?:/i;
    next unless /(\S+)\s+(.*)\s*/;
    my ( $share, $desc ) = ( $1, $2 );
    next if $scanned{$share}++;
    $processor{'prot'}{'rsync'}{'scan'}->( $host . '/' . $share );
    if ( $desc =~ /\S/ ) {
      #$share = cp_trans( hconfig( 'cp_rsync', $host ), hconfig( 'cp_db', $host ), $share );
      $desc =~ s/\s+$//;
      #$desc = cp_trans( hconfig( 'cp_rsync', $host ), hconfig( 'cp_db', $host ), $desc );
      #$static{'db'}->insert_hash_hash( $config{'sql_tfile'},
      filesave( {
          '' => {
            %url,
            'path' => '/',
            'name' => $share,
            ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
            'desc' => $desc,
            'scan' => int( time() )
          }
        }
      );
    }
  }
  close($h);
  return '';
};
$processor{'prot'}{'rsync'}{'scan'} ||= sub {
  for (@_) {
    my $where = $_;
    next if $where =~ /^\s*$/;
    printlog( 'rsync', "$where : scanning..." );
    shelldata($where);
    my %url = split_url($where);
    #$where = cp_trans( hconfig( 'cp_rsync', $url{'host'} ), hconfig( 'cp_shell', $url{'host'} ), $where );
    my $wheres = Encode::encode hconfig( 'cp_shell', $url{'host'}, $url{'prot'} ), $where, Encode::FB_DEFAULT;
    my $h = openproc( '-|' . ':encoding(' . hconfig( 'cp_res', $url{'host'}, $url{'prot'} ) . ')',
      "$config{'starter'} $config{'rsync'} $config{'rsync_param'} \"$wheres\" $config{'stderr_redirect'}" )
      or next;
    #$where = cp_trans( hconfig( 'cp_shell', $url{'host'} ), hconfig( 'cp_db', $url{'host'} ), $where );
    $processor{'format'}{'rsync'}->( $where, $h );
    close($h);
  }
};
$processor{'prot'}{'rsync'}{'get'} ||= sub {
  #TODO
};
$processor{'prot'}{'rsync'}{'func'} ||= sub {
  for my $wheres (@_) {
    my %url = split_url($wheres);
    $processor{'prot'}{'rsync'}{'scan'}->( ( ( $url{'path'} and $url{'path'} ne '/' ) or $url{'name'} )
      ? $wheres
      : $processor{'prot'}{'rsync'}{'toplevel'}->($wheres) );
    purge_res( \%url ) if $config{'purge_every_res'};
  }
};
$processor{'format'}{'rsync'} ||= sub {
  my $url = shift(@_);
  $url .= '/' unless $url =~ m|/$|;
  my %url  = split_url($url);
  my $scan = int( time() );
  my $path = $url{'path'};
  $path =~ s/[\\\/]+$//g;
  my $lastpath = $path;
  for my $content (@_) {
    my %data  = ();
    my %files = ();

=z
    if ( $url{'host'} ) {    # ??
      my ($dir_) = $url{'path'} =~ /([^\/]+)/;
      $files{''} = {
        'prot' => $url{'prot'},
        'host' => $url{'host'}, (
          hconfig( 'unknown_time', $url{'host'} ) ne ''
          ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
          : ()
        ),
        'scan' => $scan
      };
      $files{' '} = {
        'prot' => $url{'prot'},
        'host' => $url{'host'},
        'path' => '/', (
          hconfig( 'unknown_time', $url{'host'} ) ne ''
          ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
          : ()
        ),
        'scan' => $scan
      };
      $files{'  '} = {
        'prot' => $url{'prot'},
        'host' => $url{'host'},
        'path' => '/',
        'name' => $dir_, (
          hconfig( 'unknown_time', $url{'host'} ) ne ''
          ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
          : ()
        ),
        'scan' => $scan
        }
        if $dir_;
    }
=cut

    my $oneline = sub {
      chomp;
      s/[\x0a\x0d\x00-\x1F]//g;
      #printlog( 'rsyncdmp', 'ol', $_ );
      my ( $mday, $mon, $year, $hours, $min, $sec, $utime, $attr );    #$size, $name ,$ext, $desc,
      my (%file);
      #warn $_;
      ( $attr, $file{'size'}, $year, $mon, $mday, $hours, $min, $sec, $file{'path'}, $file{'name'}, $file{'ext'} ) =
        m|^(\S+)\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)\s+(?:(.+)/)?(.*?)(?:\.([^\.]+))?\s*$|
        or return;
      $file{'path'} = $path . ( $file{'path'} ? '/' : '' ) . $file{'path'};
      $file{'path'} =~ s/[\x0a\x0d\x00-\x1F]//g;
      if ( $lastpath ne $file{'path'} ) {
        #printlog( 'rsyncdbg', 'path change from', $lastpath, $file{'path'}, 'uploaded', scalar %files );
        #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
        filesave( \%files );
        %files    = ();
        $lastpath = $file{'path'};
      }
      return if $file{'name'} =~ /^\.+\s*$/;
      return if $file{'size'} == 0 and !$attr =~ /^d/;
      $file{'size'} = 0 if $attr =~ /^d/;
      $file{'file'} = $file{'name'} . ( $file{'ext'} ? '.' : '' ) . $file{'ext'};
      return if hconfig( 'skip_hidden', $url{'host'} ) and ( $file{'file'} =~ /^\./ or $file{'path'} =~ m;(^|/)\.; );
      #$file = cp_trans(hconfig('cp_rsync', $url{'host'}), hconfig('cp_db', $url{'host'}), $file);
      fileparser( $file{'file'}, $url{'prot'},
        $url{'prot'} . '://' . $file{'path'} . hconfig( 'slash_perl', $url{'host'} ) . $file{'file'},
        $file{'size'}, \%files );
      my $lfile = $file{'file'};
      $lfile =~ tr/A-Z/a-z/;
      ( $file{'prot'}, $file{'host'}, $file{'scan'} ) = ( $url{'prot'}, $url{'host'}, $scan );
      $year = 1990 if ( ( $year > 2020 ) or ( $year < 1980 ) );    #timelocal BUG
      $file{'time'} = 640000000
        if ( ( $file{'time'} = timelocal( $sec, $min, $hours, $mday, --$mon, $year ) ) > ( $scan + 2592000 ) );
      %{ $files{$lfile} } = %file;
    };
    oneliner( $oneline, $content );
    #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
    filesave( \%files );
  }
};

$processor{'prot'}{'nfs'}{'get'} ||= sub { return $_[0]; };

$processor{'prot'}{'nfs'}{'func'} ||= sub {
  for my $wheres (@_) {
    my %url = split_url($wheres);
    $processor{'prot'}{'nfs'}{'scan'}->( ( ( $url{'path'} and $url{'path'} ne '/' ) or $url{'name'} )
      ? $wheres
      : $processor{'prot'}{'nfs'}{'toplevel'}->($wheres) );
    purge_res( \%url ) if $config{'purge_every_res'};
  }
};
$processor{'prot'}{'nfs'}{'toplevel'} //= sub {
  #return '' unless $config{'rsync'};
  my ($host) = @_;
  #my $prot = 'rsync';
  shelldata($host);
  my %url = split_url($host);
  return unless $host =~ /\S/;
  #printlog('nfs', 'mount', ` $config{'showmount'} $url{host}`);
  #printlog('nfs', 'mount-a', ` $config{'showmount'} -a $url{host}`);
  #printlog('nfs', 'mount-e', ` $config{'showmount'} -e $url{host}`);
  #printlog('nfs', 'mount-d', ` $config{'showmount'} -d $url{host}`);
  #printlog( 'nfs', 'mount-e', ` $config{'showmount'} -e $url{host}` );
  my $h = openproc( '-|' . ':encoding(' . hconfig( 'cp_res', $url{'host'}, $url{'prot'} ) . ')',
    "$config{'starter'} $config{'showmount'} $config{'showmount_param'} $url{host} $config{'stderr_redirect'}" )
    or return '';
  my %scanned;
  my $line;
  while (<$h>) {
    printlog( 'nfs', $config{'showmount'}, $config{'showmount_param'}, $_ );
    next unless $line++;
    #next if m{(?:can't do mountdump rpc|Unable to receive)}i; #'
    #printlog( 'nfs', '-a:', $_ );
    next if /^(?:showmount|RPC):/;
    #next unless /^(\S+):(\S.*)\s*/;
    next unless /^\s*(\S+)(?:\s+(\S.*))?\s*/;
    my ( $share, $desc ) = ( $1, $2 );
    #my ( $hostname, $share ) = ( $1, $2);
    #printlog('nfs', 'parsed:', ( $hostname, $share ));
    next if $scanned{$share}++;
    $processor{'prot'}{'nfs'}{'scan'}->( $host . $share );
    #if ( $desc =~ /\S/ ) {
    if ( $share =~ /\S/ ) {
      #$share =~ s{^/}{};
      #$share .= '/';
      #$share = cp_trans( hconfig( 'cp_rsync', $host ), hconfig( 'cp_db', $host ), $share );
      #$desc =~ s/\s+$//;
      #$desc = cp_trans( hconfig( 'cp_rsync', $host ), hconfig( 'cp_db', $host ), $desc );
      #$static{'db'}->insert_hash_hash( $config{'sql_tfile'},
      #=no
      my ( $path, $name ) = $share =~ m{^(.+)?/([^/]+)$};
      filesave( {
          '' => {
            %url,
            'path' => $path,
            'name' => $name,
            ( hconfig( 'unknown_time', $host ) ne '' ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $host ) ) : () ),
            'meta' => "mountpoint=1",
            'desc' => $desc,
            'scan' => int( time() )
          }
        }
      );
      #=cut
      #update_to_root( %url, %url, $local, $url_orig );
      my %res = (
        %url,
        'path' => $share,    #. '/',
        #desc=>'desc!',
      );
      local %_ = (
        %res,
        'path' => '',
        'name' => '',
        'ext'  => '',
        #'desc' => $work{'desc'}{ $url{'host'} }{ $url{'prot'} },
        'scan' => int( time() )
      );
      update_to_root( %res, %_ );
    }
  }
  close($h);
  return '';
};
$processor{'prot'}{'nfs'}{'scan'} //= sub {

=later

point= pointroot/host/path

mount -t nfs -o soft,intr,retrans=10,retrycnt=2,timeout=10

ls

  local $config{'local_prot'} = 'nfs';
  $processor{'prot'}{'nfs'}{'scan'}->()



umount



=cut

  for my $where (@_) {
    #my $where = $_;
    next if $where =~ /^\s*$/;
    printlog( 'nfs', "$where : scanning..." );
    shelldata($where);
    my %url = split_url($where);
    #dmp \%url;
    my $path = join_url( { path => $url{'path'}, name => $url{'name'} } );
    #(my $point_name = $where) =~ s/\W/_/g;
    #$point_name = $path;
    my $point_host = "$config{'nfs_root'}/$url{host}";
    my $point      = "$point_host$path";
    my $exists     = -d $point;
    my @dirs       = mkdir_rec $point;
    my ($mount)    = "$url{'host'}:" . $path;
    #$where = cp_trans( hconfig( 'cp_rsync', $url{'host'} ), hconfig( 'cp_shell', $url{'host'} ), $where );
    my $wheres = Encode::encode hconfig( 'cp_shell', $url{'host'}, $url{'prot'} ), $where, Encode::FB_DEFAULT;
    #printprog("mount -t nfs -o soft,intr,retrans=10,retrycnt=2,timeout=10 $mount $point");    # unless $exists;
    printprog("$config{'starter'} $config{'mount'} $config{'mount_param'} $mount $point");
    printprog("$config{'starter'} $config{'df'} $config{'df_param'} $point");
    local $config{'local_root_path'} = $point_host;
    local $config{'local_prot'}      = 'nfs';
    local $config{'local_host'}      = $url{'host'};
    $point .= '/';
    $processor{'prot'}{'local'}{'scan'}->($point);
    printprog("$config{'starter'} $config{'umount'} $config{'umount_param'} $point") if $point;
    rmdir for reverse @dirs;
    #unlink $point;
  }
};
$processor{'format'}{'ls'} ||= sub {
  my $url = shift @_;
  $url =~ tr/\\/\//;
  #printlog('dev', 'ls', $url);
  my $local;
  $local = 1 if $url =~ m{^(?:\w:|/)};
  my ( $user, $pass, $host, $port, $path ) = @{ split_url($url) }{ 'user', 'pass', 'host', 'port', 'path' };
  my $prot = 'ftp';
  $prot = $config{'local_prot'} if $local and $config{'local_prot'};
  $host = $config{'local_host'} if $local and $config{'local_host'};
  my $path_cut = $config{'local_root_path'};
  $path_cut =~ s{^(/)}{$1?};
  $path =~ s{^$path_cut/?}{} if $path_cut;
  my (%files);

  for my $content (@_) {
    my $scan = int( time() );
    my $lfile;
    my $oneline = sub {
      s/[\x0a\x0d]//g;
      #printlog('dev', 'lsdmp', $_);
      my ( $mday, $mon, $year, $hours, $min, $size, $file, $ext );
      if (/^\.?\/?(.*)\s*:\s*$/) {
        $path = $1;
        $path =~ s{^$path_cut/?}{} if $path_cut;
        #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
        filesave( \%files );
        %files = ();
        return;
      } elsif ( $config{'skip_path_mask'} and $path =~ /$config{'skip_path_mask'}/i ) {
        ++$stat{'skipped'};
        return;
      } elsif (/^\s*[rd\-]/) {
        ( $size, $mon, $mday, $hours, $min, $file ) =
          /^\s*\S+\s+\d*\s*\S+\s*\S*\s+(\d+)\s+(\S+)\s+(\d+)\s+(\d+):?(\d+)?\s+(.+)\s*$/;
        return if $file =~ /^\.+\s*$/;
        return if $size == 0 and !/^d/;
        $size = 0 if /^d/;
        $file =~ s/[\x0a\x0d\x00-\x1F]//g;
        $file =~ s/(\.|\s)*$//g;
        chomp($file);
        return if hconfig( 'skip_hidden', $host ) and ( $file =~ /^\./ or $path =~ m;(^|/)\.; );
        $lfile = $file;
        $lfile =~ tr/A-Z/a-z/;
        $files{$lfile}{'name'} = $file;
        $files{$lfile}{'size'} = $size;
        $mon                   = $config{'lng'}{ $config{'lng_ls'} }{'month_table'}{$mon};

        if ( $min eq '' ) {
          $year = $hours;
          $hours = $min = 0;
        } else {
          $year = ( localtime(time) )[5] + 1900;    #$curyear;
          --$year if $mon > ( localtime(time) )[4];
        }
        $year = 1990 if $year > 2020 or $year < 1980;    #timelocal BUG
        $mday = 28 if ( $mon == 1 and $mday > 28 ) or !$mday;    #Another bug 8(
        eval {                                                   #no more bugs 8)
          $files{$lfile}{'time'} = timelocal( 0, $min, $hours, $mday, $mon, $year );
        };
        $files{$lfile}{'time'} = 640000000 if ( $files{$lfile}{'time'} > ( $scan + 86400 ) );    # 2592000
      } else {
        return;
      }
      fileparser(
        $file, $prot,
        join_url( {
            'prot' => $prot,
            'user' => $user,
            'pass' => $pass,
            'host' => $host,
            'port' => $port,
            'path' => $path,
            'name' => $file
          }
        ),
        $size,
        \%files
      );
      $files{$lfile}{'fullname'} = join_url( {
          'prot' => $prot,
          'user' => $user,
          'pass' => $pass,
          'host' => $host,
          'port' => $port,
          'path' => $path,
          'name' => $file
        }
      );
      $files{$lfile}{'fullname'} =~ s/[\x00-\x1F]//g;
      #printlog"cpdet", $host, Dumper $work{$host}{'detectcp'}, $_ , hconfig( 'cp_res', $host, $prot ),
      #$files{$lfile}{'desc'} = "cp=$_ " . $files{$lfile}{'desc'}
      $files{$lfile}{'meta'} .= " cp=$_"
        if $_ = cp_detect_trans( $files{$lfile}{'fullname'}, \%{ $work{$host}{'detectcp'} }, undef, undef, $prot, $host )
          and $_ ne hconfig( 'cp_res', $host, $prot );
      (
        $files{$lfile}{'prot'}, $files{$lfile}{'user'}, $files{$lfile}{'pass'}, $files{$lfile}{'host'},
        $files{$lfile}{'port'}, $files{$lfile}{'path'}, $files{$lfile}{'name'}, $files{$lfile}{'ext'}
      ) = @{ split_url( $files{$lfile}{'fullname'} ) }{ 'prot', 'user', 'pass', 'host', 'port', 'path', 'name', 'ext' };
      $files{$lfile}{'host'} = full_host( { 'host' => $host, 'user' => $user, 'pass' => $pass, 'port' => $port } );
      $files{$lfile}{'path'} ||= '/';
      $files{$lfile}{'scan'} = $scan;
    };
    oneliner( $oneline, $content );
  }
  filesave( \%files );
  #  $static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
};

sub ftp_reconnect {
  my ( $ftp, %url ) = @_;
  $$ftp->close() if defined $$ftp;
  $work{'ftp_connected'} = 0;
  printlog(
    'hint',
    "FTP RECONNECTS1: host=$url{'host'} ftp_reconnects=$stat{'ftp_reconnects'} ftp_reconnect_max=",
    hconfig( 'ftp_reconnect_max', $url{'host'} ),
    'f=',
    $work{'filec'}->( $stat{'files'} ),
    'd=',
    $work{'dirc'}->( $stat{'dirs'} ),
    's=',
    $work{'sizec'}->( $stat{'size'} )
    ),
    return 3
    if ++$stat{'ftp_reconnects'} >= hconfig( 'ftp_reconnect_max', $url{'host'} );
  eval {
    $$ftp = Net::FTP->new(
      $url{'host'},
      'Timeout' => hconfig( 'timeout', $url{'host'}, $url{'prot'} ),
      ( hconfig( 'passive', $url{'host'} ) ? ( 'Passive' => 1 ) : () ), ( $url{'port'} ? ( 'Port' => $url{'port'} ) : () ),
      %{ hconfig( 'sockopts', $url{'host'}, $url{'prot'} ) || {} }
    );
  };
  printlog( 'warn', 'ftp connect err', $@ ) if $@;
  return 1 if !defined $$ftp;
  my $message = $$ftp->message();
  #printlog('ftp', "FTP: message: $message");
  $message =~ s/\s+$//;
  if (
    !hconfig( 'ftp_recurse_force', $url{'host'} ) and !defined( $config{'fine'}{ $url{'host'} }{'ftp_recurse_force'} ) and (
      $message =~ /PureFTPd/i || $message =~ /Pure-FTPd/i    # PureFTPd sends only 2000 lines of "ls -lR"
      || $message =~ /CesarFTP/i                             # CesarFTP does not print "<DIRECTORY>:"
      || $message =~ /GuildFTPd/i                            # GuildFTPd gets crazy when attempting to use "ls -lR"
      || $message =~ /Microsoft/i                            # ??? can't parse output of "ls -lR" of Microsoft FTP server
      || $message =~ /Serv-U/i                               # Serv-U's "ls -lR" does not work well in all cases
      || $message =~ /Gene6 FTP Server/i
    )
    )
  {
    $config{'fine'}{ $url{'host'} }{'ftp_recurse_force'} = 1;
    printlog( 'ftp', "ftp_recurse_force=1 for $url{'host'}" );
  }
  if (
    !$$ftp->login(
      ( $url{'user'} or hconfig( 'anonymous_user', $url{'host'} ) ),
      ( $url{'pass'} or hconfig( 'anonymous_pass', $url{'host'} ) )
    )
    )
  {
    $$ftp->close() if defined $$ftp;
    printlog( 'ftp', "FTP: cannot login", join_url( \%url ) );
    return 2;
  }
  psmisc::cp_detect_trans($message);
  printlog( 'ftp',
        "FTP: connected ($stat{'ftp_reconnects'}/"
      . hconfig( 'ftp_reconnect_max', $url{'host'} ) . ") to "
      . join_url( \%url )
      . " pasv="
      . hconfig( 'passive', $url{'host'} )
      . "; [$message]" );
  $work{'desc'}{ $url{'host'} }{'ftp'} = $message;
  ++$work{'ftp_connected'};
  $work{'ftp'}
    { join_url( { 'user' => $url{'user'}, 'pass' => $url{'pass'}, 'host' => $url{'host'}, 'port' => $url{'port'} } ) } = \$ftp;
  #$ftp;
  #printlog("ftpis", "$ftp, $$ftp;");
  return 0;
}

sub ftp_reconnect_while {
  my ( $ftp, %url ) = @_;
  my $retry = 0;
  do {
    return 0 unless ftp_reconnect( $ftp, %url );    # !!!???
    return 2 unless $work{'ftp_connected'};
    printlog(
      'hint',
      "FTP RECONNECTS2: host=$url{'host'} ftp_reconnects=$stat{'ftp_reconnects'} ftp_reconnect_max=",
      hconfig( 'ftp_reconnect_max', $url{'host'} )
      ),
      return 3
      if $stat{'ftp_reconnects'} >= hconfig( 'ftp_reconnect_max', $url{'host'} );
    mysleep($_) if ( $_ = hconfig( 'ftp_reconnect_sleep', $url{'host'} ) );
    printlog( 'ftp',
          "FTP $url{'host'} reconnecting $retry ($stat{'ftp_reconnects'}/"
        . hconfig( 'ftp_reconnect_max', $url{'host'} )
        . ") [$@]" );
  } while ( $retry++ <= hconfig( 'ftp_reconnect_retry', $url{'host'} ) );
  return 1;
}

sub ftp_check {
  my ($ftp) = @_;
  return 1 unless ( defined $ftp and defined $$ftp and $ftp and $$ftp );
  my $code = $$ftp->code();
  return 2 if grep( $code eq $_, ( '599', '000', '200', '425', '150' ) );
  return 3 unless ( defined $ftp and defined $$ftp and $ftp and $$ftp );
  return 0;
}

sub ftp_keep {
  my ( $ftp, %url ) = @_;
  #printlog('dev', 'ftp_keep', $ftp);
  return ftp_reconnect_while( $ftp, %url ) if ftp_check($ftp);
  return 0;
}

sub _list_cmd_ {    #from NET:FTP
  my $ftp = shift;
  my $cmd = 'LIST';
  my $res = pop;
  delete ${*$ftp}{'net_ftp_port'};
  delete ${*$ftp}{'net_ftp_pasv'};
  my $data;
  eval { $data = $ftp->_data_cmd( $cmd, @_ ) };
  printlog( 'warn', "ftp LIST cmd failed", $@ ), return if $@;
  return unless ( defined $data );
  require Net::FTP::A;
  bless $data, "Net::FTP::A";    # Force ASCII mode
  my $databuf = '';
  my $buf     = '';
  @_ = ();
  my $blksize = ${*$ftp}{'net_ftp_blksize'};

  while ( $data->read( $databuf, $blksize ) ) {
    $buf .= $databuf;
    for my $line ( split( /\n/, $buf ) ) {
      $processor{'format'}{'ls'}->( $res, \@_ ), @_ = () if @_ and $line =~ /\:\s*$/ and !$_[$#_];
      push @_, $line;            #if $line;
    }
    $buf = ( $buf !~ /\n$/ ? "\n" . pop @_ : '' );
  }
  $processor{'format'}{'ls'}->( $res, \@_ ) if @_;
  $data->close();
}
{
  my ( @toscan, $toscanfile );

  sub savearray {
    my ( $file, $arr ) = @_;
    return unless ( $file and $arr and open( TSO, '>', $file ) );
    while ( defined( $_ = shift @$arr ) ) { print TSO$_ . "\n" if $_; }
    close(TSO);
  }
  $processor{'prot'}{'ftp'}{'func'} ||= sub {
    #printlog( 'dbg', "prot'}{'ftp'}{'func" );
    foreach my $url (@_) {
      $url .= '/' if $url !~ m|/$|;
      my %url = split_url($url);
      my $ftp;
      $stat{'ftp_reconnects'} = $work{'ftp_connected'} = 0;
      next if ftp_keep( \$ftp, %url );
      my ($content);
      my $tryrec = 1;
      $stat{'ftp_errors'} = 0;

      unless ( hconfig( 'ftp_recurse_force', $url{'host'} ) ) {
        _list_cmd_(
          $ftp,
          "$config{'ls_opt'} $url{'path'}",
          join_url( {
              'user' => $url{'user'},
              'pass' => $url{'pass'},
              'host' => $url{'host'},
              'port' => $url{'port'},
              'path' => $url{'path'}
            }
          )
        );
        $tryrec = 0
          if ( $work{'filec'}->( $stat{'files'} ) > hconfig( 'ftp_recurse_threshold', $url{'host'} ) )
          and !ftp_check( \$ftp );
        if ( $config{'old_ftp_recurse'} and $tryrec ) {    #delete block
          printlog( 'dbg', "Old recurse" );
          $content = '';
          eval { $content = $ftp->dir("-lRGn $url{'path'}") };
          if ($content) {
            $tryrec = 0 if ( scalar @$content > hconfig( 'ftp_recurse_threshold', $url{'host'} ) ) and !ftp_check( \$ftp );
            $processor{'format'}{'ls'}->( join_url( \%url ), $content );
          }
        }
      }
      my $passive = 0;
      if ($tryrec) {
        printlog( 'ftp', "Trying recurse mode" ) unless hconfig( 'ftp_recurse_force', $url{'host'} );
        my $dir;
        @toscan = ();
        $toscanfile =
            $config{'datadir'}
          . $config{'slash_sys'}
          . encode_url(
          join_url( {
              'prot' => $url{'prot'},
              'user' => $url{'user'},
              'pass' => $url{'pass'},
              'host' => $url{'host'},
              'port' => $url{'port'}
            }
          )
          ) . '.toscan';
        my $toscanold = time - $^T + 86400 * -M $toscanfile;
#printlog('warn', ".toscan too old, skipping, days=",  -M $toscanfile, ' period=', hconfig( 'period', $url{'host'}, $url{'prot'} ), $toscanold, 'C', -C $toscanfile, 'A', -A $toscanfile) ;
        $toscanold = undef if $toscanold < hconfig( 'period', $url{'host'}, $url{'prot'} );
        printlog(
          'info',
          ".toscan too old, skipping, days=",
          int -M $toscanfile,
          ' period=', hconfig( 'period', $url{'host'}, $url{'prot'} ) / 86400
        ) if $toscanold;
        if (  !$toscanold
          and -e $toscanfile
          and rename( $toscanfile, $toscanfile . $config{'work_ext'} )
          and open( TSO, '<', $toscanfile . $config{'work_ext'} ) )
        {
          printlog( 'dbg', "Loading", $toscanfile, "path=[$url{'path'}]" );
          while (<TSO>) {
            s/^\s*//;
            s/\s*$//;
            my ($name) = m|/([^/]+)$|;
            printlog( 'dbg', 'toscan load skip path:', $_, $name ), next
              if ( $config{'skip_path_mask'} and $name =~ /^$config{'skip_path_mask'}$/i )
              or ( $url{'path'} and !m{^$url{'path'}} );
            push( @toscan, $_ );
          }
          close(TSO);
          unlink( $toscanfile . $config{'work_ext'} );
          my $where =
            $static{'db'}->where( { %url, ( $url{'path'} eq '/' ? ( 'path' => '' ) : () ) }, undef, $config{'sql_tresource'} );
          #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
          my $res =
            $static{'db'}->line("SELECT * FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq $where LIMIT 1");
          printlog( 'dev', 'ftptoscan stat: ', %$res );
          $stat{'dirs'}  += $res->{'dirs'};
          $stat{'files'} += $res->{'files'};
          $stat{'size'}  += $res->{'size'};
          printlog( 'dev', 'ftptoscan s: ', $stat{'dirs'}, $stat{'files'}, $stat{'size'} );
        } else {
          $dir = ( $url{'path'} or '/' );
          push( @toscan, $dir );
        }
        my %scanned;
        FTPSCAN: while (@toscan) {
          FTPTOSCAN: while ( $dir = pop(@toscan) ) {    #v1:shift v2:pop
            @toscan = (),
              printlog(
              'hint',
              "MAX ERRORS REACHED: host=$url{'host'} ftp_errors=$stat{'ftp_errors'} max_errors=",
              hconfig( 'max_errors', $url{'host'}, $url{'prot'} ),
              'f=',
              $work{'filec'}->( $stat{'files'} ),
              'd=',
              $work{'dirc'}->( $stat{'dirs'} ),
              's=',
              $work{'sizec'}->( $stat{'size'} ),
              $_
              ),
              printlog( 'warn', 'MAX ERRORS REACHED at', $url{'host'}, $dir, $_ ), last
              if $stat{'ftp_errors'} > hconfig( 'max_errors', $url{'host'}, $url{'prot'}, );
            #printlog( 'ftpdbg', scalar @toscan, $dir );
            ++$stat{'ftp_errors'}, printlog( 'dbg', 'TOO LONG PATH', $dir, $_ ), next
              if length($dir) > hconfig( 'ftp_recurse_path_max', $url{'host'} );
            for my $retry ( 0 .. 3 ) {
              last if ftp_keep( \$ftp, %url ) or $work{'die'};
              #printlog( 'ftpdbg', "trying change  to [$dir]" );
              $content = '';
              if ( $work{'die'} ) { last; }
              elsif ( hconfig( 'ftp_use_cwd', $url{'host'} ) ) {
                my $ret;
                eval { $ret = $ftp->cwd($dir); };
                if ($ret) {
                  eval { $content = $ftp->dir(); };
                } else {
                  printlog( 'dbg', "Cannot change to $dir" );
                  last;
                }
              } else {
                eval { $content = $ftp->dir($dir); };
              }
              local $_ = $ftp->pwd();
              s|/+$||;
              $_ = '/' . $_ if $_ and $_ !~ m|^/|;
              printlog( 'err', "CWD failed or PWD bug  mustbe:", $dir, "pwd:", $_ ), $dir = $_, if ( $dir ne $_ ) and $_ and !m|^/\w\:|;
              printlog( 'err', "loop scan [$dir] $scanned{$dir} times"), next FTPTOSCAN if $scanned{$dir}++ > 2;
              $passive = 9, last if ( !ftp_check( \$ftp ) and $content ) or $work{'die'};
              printlog( 'dbg', "FTP getdir retry $retry " );    #, ++$passive, next if ftp_check(\$ftp);
              printlog( 'dbg', "Trying passive mode [$passive]" ), $config{'fine'}{ $url{'host'} }{'passive'} = 1
                if ( ++$passive == 1 )
                and !$config{'fine'}{ $url{'host'} }{'passive'};
              $ftp->pasv() if $passive == 1;
              ftp_reconnect( \$ftp, %url ) if $passive == 2 or $retry == 2;
              delete $config{'fine'}{ $url{'host'} }{'passive'} if $passive == 3;
            }
            ( $work{'ftp_connected'} ? next : last ) unless $content;
            my ( @thisdir, $listed_dirs, $num );
            for (@$content) {
              printlog( 'dmp', $_ );
              ++$stat{'ftp_errors'}, printlog( 'dbg', 'BUGGY FTPD ', $dir, $_ ), @thisdir = (), last
                if /^ftpd: .*: No such file or directory/i;
              ++$stat{'ftp_errors'}, printlog( 'dbg', 'BAD RECURSION SKIPPED [second listed dir]:', $dir, $1 ), @thisdir = (),
                last
                if /^\.?\/?(.+)\s*:\s*$/ and $listed_dirs++;
              next
                if !(/^\s*d\S+\s+\d*\s*\S+\s*\S*\s+(\d+)\s+(\S+)\s+(\d+)\s+(\d+):?(\d+)?\s+(.+)\s*$/)
                  or ( $6 =~ /^\.+[\s\xFF]*$/ )
                  or ( $6 =~ /^[\s\xFF]*$/ );
              my $name = $6;
              $name =~ s/(^\s*)|(\s*$)//g;
              #printlog( 'dev', 'name:', $name );
              printlog( 'dbg', 'skip path:', $name ), next
                if $config{'skip_path_mask'} and $name =~ /^$config{'skip_path_mask'}$/i;
              my $add = $dir . ( $dir eq '/' ? '' : '/' ) . $name;
              #printlog( 'dev', "DIR:$dir; name:$name; add:$add;\n$_" );
              ++$stat{'ftp_errors'}, printlog( 'dbg', 'BAD RECURSION SKIPPED [path dupes]:', $dir, $add ), next
                if $add =~ m|(/\Q$name\E){$config{'ftp_rec_path_dupes'},}$|;
              push( @thisdir, $add );    #v1:unshift v2:push
            }
            push( @toscan, @thisdir );
            unshift( @$content, $dir . ':' );
            $processor{'format'}{'ls'}->( join_url( \%url ), $content );
            $content = '';
            #!!! DIRS FILES !!!
            @toscan = (),
              printlog(
              'warn',
              "! recurse detected: $url{'host'} :",
              $work{'sizec'}->( $stat{'size'} ),
              $work{'filec'}->( $stat{'files'} )
              )
              if $work{'filec'}->( $stat{'files'} ) > hconfig( 'ftp_rec_max_number', $url{'host'} )
                and $work{'sizec'}->( $stat{'size'} ) / $work{'filec'}->( $stat{'files'} ) <
                hconfig( 'ftp_rec_min_size', $url{'host'} );
            last unless $work{'ftp_connected'};
          }
          last unless $work{'ftp_connected'};
        }
        if (@toscan) {
          ++$work{'scan_unfinished'};
          savearray( $toscanfile, \@toscan );
        }
      }
      $ftp->quit() if defined $ftp;
      purge_res( \%url ) if $config{'purge_every_res'};
    }
  };
  END { savearray( $toscanfile, \@toscan ) if @toscan and $toscanfile; }
}
$processor{'format'}{'html'} ||= sub {
  my %outh;
  my $host = shift(@_);
  my $scan = int( time() );
  my $prot = 'http';
  my $desc;
  for my $content (@_) {
    my $oneline = sub {
      my @l = split /href/i;
      for (@l) {
        if (/^=([\"\'])((\w|[\.=\/:?&%\-])+)\1/i) {    #???
          #my $url = decode_url($2);
          my $url = $2;
          #printlog('dev', 'hol:',$_);
          if ( $url =~ /^(http\:\/\/)/i ) {
            if ( $url =~ /^http\:\/\/$host/i )         #\w*\.?
            {
              if ( $url =~ /^http\:\/\/$host\/((\w|[\.\-])+)\/?/i ) {    #\w*\.?
                my $file = decode_url($1);
                ++$outh{$host}{$file}{'c'};
                #$outh{$host}{$file}{'desc'} = $desc;
                #$outh{$host}{$1}{'desc'} = cp_detect_trans(\$desc, \%detectcp, undef, $prot, $host);
              }
            }
          } elsif ( $url =~ /^(\S+\:\/\/)/i ) {
          } elsif ( $url =~ m{(?:^|/)((\w*[\.\-\%]*)+)(?:$|/)} ) {
            #} elsif ($url =~ m{((\w*|[.\-%]*)+)}){
            #printlog('dev', $host," url1:[$url] -> [$1]");
            my $file = decode_url($1);
            #printlog('dev', $host,' url2:',$url, " : $file");
            ++$outh{$host}{$file}{'c'};
            #$outh{$host}{$file}{'desc'} = $desc;
            #$outh{$host}{$1}{'desc'} = cp_detect_trans(\$desc, \%detectcp, undef, $prot, $host);
          }
        }
      }
    };
    oneliner( $oneline, $content );
  }
  for my $host ( keys %outh ) {
    for my $rr ( keys %{ $outh{$host} } ) {
      next if $rr =~ /cgi-bin/i;
      my %url = split_url( $prot . '://' . $host . '/' . $rr );
      #$static{'db'}->insert_hash_hash($config{'sql_tfile'},
      filesave( {
          '' => {
            %url,
            'size' => ( $url{'ext'} ? 1 : 0 ), (
              hconfig( 'unknown_time', $url{'host'} ) ne ''
              ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
              : ()
            ),
            'desc' => $outh{ $url{'host'} }{$rr}{'desc'},
            'scan' => $scan
          }
        }
      );
    }
  }
};
$processor{'prot'}{'http'}{'get'} ||= $processor{'prot'}{'https'}{'get'} ||= sub {
  local $config{'cachedir'} = $config{'tmpdir'};
  return http_get( $_[0], 1 );
};
$processor{'prot'}{'http'}{'func'} ||= sub {
  if ( $config{'use_old_http'} ) {
    my $scan = int( time() );
  SKIP0: for my $url (@_) {
      next unless $url =~ /\S/;
      $url =~ s/\/+$//;
      my %url     = split_url($url);
      my @content = ( http_get($url) );
      my %detectcp;
      if ( $content[0] =~ /\<.+\>/ ) {
        for my $skipmask ( @{ $config{'http_skip'} } ) { next SKIP0 if $content[0] =~ /$skipmask/i; }
        my ($desc) = $content[0] =~ /\<title.*\>\s*(.+)\s*\<\/title\s*\>/is;
        cp_detect_trans( $desc, \%detectcp, undef, undef, $url{'prot'}, $url{'host'} );
        $work{'desc'}{ $url{'host'} }{ $url{'prot'} } = $desc;
        $processor{'format'}{'html'}->( $url{'host'}, \@content );
        $stat{'dirs'}  += 1;
        $stat{'files'} += 1;
        $stat{'size'}  += 1;
      }
    }
  } else {
    my $scan = int( time() );
  SKIP0: for my $url (@_) {
      next unless $url =~ /\S/;
      $url =~ s/\/+$//;
      http_dl(
        $url,
        sub {
          my $url = $_[0];
          my %url = split_url($url);
          #my @content = ( http_get($url) );
          my @content = ( $_[1] );
          my %detectcp;
          if ( $content[0] =~ /\<.+\>/ ) {
            for my $skipmask ( @{ $config{'http_skip'} } ) { next SKIP0 if $content[0] =~ /$skipmask/i; }
            my ( $desc, $content );
            ($desc) = $content[0] =~ /\<title.*\>\s*(.+?)\s*\<\/title\s*\>/is;
            #if (psmisc::is_hash_size $config{'sql'}{'table'}{ $config{'sql_tfile'} }{'content'}) {
            #$content = striplinks($content[0]);
            #} else {
            $content = psmisc::html_strip( $config{'http_no_strip'} ? $content[0] : striplinks( $content[0] ) );
            $content =~ s/&\w+;/ /g;
            $content =~ s/\s+/ /g;
            #}
            cp_detect_trans( $desc,    \%detectcp, undef, undef, $url{'prot'}, $url{'host'} );
            cp_detect_trans( $content, \%detectcp, undef, undef, $url{'prot'}, $url{'host'} );
            #dmp \%detectcp;
            #printlog('dev', "desc:[$desc]");
            #$work{'desc'}{ $url{'host'} }{ $url{'prot'} } = $desc;
            #$processor{'format'}{'html'}->( $url{'host'}, \@content );
            $static{'db'}->insert_hash(
              $config{'sql_tfile'}, {
                %url, (
                  keys %{ $config{'sql'}{'table'}{ $config{'sql_tfile'} }{'param'} } ? ()
                  : ( 'ext' => $url{'ext'} . ( $url{'param'} ? '?' . $url{'param'} : '' ) )
                ),
                'size' => length $content[0], (
                  hconfig( 'unknown_time', $url{'host'} ) ne ''
                  ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
                  : ()
                ),
                'content' => $content,
                'desc'    => $desc,
                'scan'    => $scan,
              }
            );
            #$stat{'dirs'}  += 1;
            $stat{'files'} += 1;
            $stat{'size'}  += length $content[0];
          }
        },
        sub {
          my $url = $_[0];
          my %url = split_url($url);
          #my @content = ( http_get($url) );
          $static{'db'}->insert_hash(
            $config{'sql_tfile'}, {
              %url, (
                keys %{ $config{'sql'}{'table'}{ $config{'sql_tfile'} }{'param'} } ? ()
                : ( 'ext' => $url{'ext'} . ( $url{'param'} ? '?' . $url{'param'} : '' ) )
              ),
              'size' => 1, (
                hconfig( 'unknown_time', $url{'host'} ) ne ''
                ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
                : ()
              ),
              #'desc' => $desc,
              'scan' => $scan
            }
          );
          #$stat{'dirs'}  += 1;
          $stat{'files'} += 1;
          $stat{'size'}  += 1;
        }
      );
    }
  }
};
{
  my $state;

  sub http_get2 {
    my ( $what, $asfile, $lwpopt, $method ) = @_;
    printlog( 'dev', 'http_get', @_ );
    my %url = split_url($what);
    use LWP::UserAgent;
    use URI::URL;
    my $ua = LWP::UserAgent->new(
      #$config{lwp}          = { timeout => 10, max_size => 1000000, max_redirect => 1 };
      max_size     => hconfig( 'max_size',     $url{host}, $url{prot} ) || 1000000,
      max_redirect => hconfig( 'max_redirect', $url{host}, $url{prot} ) || 1,
      timeout      => hconfig( 'timeout',      $url{host}, $url{prot} ) || 10,
      %{ $config{lwp} || {} }, %{ $lwpopt || {} }
    );
    if ( ref $config{'proxy'} eq 'ARRAY' ) {
      local @_ = @{ psmisc::shuffle( $config{proxy} )->[0] };
      $ua->proxy(@_);
    } elsif ( $config{'proxy'} ) {
      $ua->proxy( 'http', $config{'proxy'} );
    }
    $method ||= 'GET';
    #my $resp = $method eq 'HEAD' ? $ua->head($what) :
    my $resp = (
      $ua->request(
        new HTTP::Request( $method, new URI::URL($what), new HTTP::Headers( 'User-Agent' => $config{'crawler_name'} ) )
      )
    );
    $stat{'bytes'} += length( $resp->content );
    #my $type = lc( ( split /[\s;,]/, $resp->header('Content-Type') )[0] );
    my $type = http_type( undef, $resp->header('Content-Type') );
    #printlog ("Type",$type);
    #printlog ("hdr",$resp->as_string());
    $stat{'bytes_skipped'} += length( $resp->content ), printlog( 'skip', $what, "type1=[$type]" ),
      $state->{callback_skip}->( $what, $type ), return ( wantarray ? ( undef, $resp ) : undef )
      unless $config{http_avail_types}{$type};
    #print "[H:",Dumper($resp);
    #print "[H:",$resp->code();
    if ( $resp->is_success ) {
      ++$stat{'urls'};
      return wantarray ? ( $resp->as_string(), $resp ) : $resp->as_string();
    } else {
      printlog( 'warn', 'http getfail', $what, $resp->message, );    #Dumper($resp)
      #return $asfile ? undef: $resp->message;
      return wantarray ? ( undef, $resp ) : undef;
    }
  }

  sub http_type_full {
    return $_[1] if $_[1];
    return $state->{type}{ $_[0] } if defined $state->{type}{ $_[0] };
    return $state->{type}{ $_[0] } = ( ( http_get2( $_[0], undef, undef, 'HEAD' ) )[1]->header('Content-Type') ) || '';
  }
  sub http_type { return lc( ( split /[\s;,]/, http_type_full(@_) )[0] ); }

  sub http_parse {
    my ( $url, $dir ) = @_[ 1 .. 2 ];    #$state,
    $dir =~ s{[?#].*}{}g;
    $dir =~ s{[^/]+?$}{};
    #for ( $_[0] =~ m{<a.+?href=["']?([^'"\s>]+)['"]?.*?>}ig ) {
    for (
      $_[0] =~
      #m{<(?:a|frame).+?(?:href|src)=["']?([^'"\s>]+)['"]?.*?>}ig
      m{<(?:a|frame)[^>]+(?:href|src)=["']?([^'"\s>]+)['"]?[^>]*>}ig
      )
    {
      #dmp ("[c=$_]\n"),
      #$_ = $c, next unless defined $_;
      #print ("set $_ = $c]\n"),
      s/\s//g;
      #printlog( 'dev', "link0 [$_]" );
      #printlog( 'warn', "not protocol [$_]" ),
      next if m{^\w+:(?:[^/]|$)};
      my $no_check = 0;
      ++$no_check if s/#.*//g;
      s/&amp;/&/g;
      s{^/*\.\.?/*}{}g;
      next unless length $_;
      $_ = ( s{^\.*/}{}g ? $state->{root} : $dir ) . $_ unless m{^\w+://};
      s{/+\./+}{/}g;
      #s{/[^/]+/\.\.(/|$)}{$1}g;
      #s{[^/]+/\.\./?}{}g;
      #s{[^/]+/+\.\.}{}g;
      s{[^/]+/+\.\.}{}g while m{[^/]+/+\.\.};
      s{/+\.$}{}g;
      #s{(?<!(?:^\w:))/{2,}}{/};
      s{^(\w+://)}{};
      my $prot = $1;
      s{/{2,}}{/}g;
      $_ = $prot . $_;
      #printlog( 'dev', "link1 [$_]" );
      if (m{^$state->{root}}) {
        my ( $filename, $script ) = m{/([^/]*?)(?:\?(.*))?$};
        my $ext = lc( ( $filename =~ m{\.([^\.]+)$} )[0] );
        #printlog('dev', "$_ => filename=[$filename] ext=[$ext] script=[$script] $force_download");
        printlog( 'skip', $_, "ext=[$ext] filename=[$filename]" ), $state->{callback_skip}->( $_, $ext ), next
          if $config{http_ext_skip}{$ext};
        ++$no_check if !$ext or !$filename or $script or $config{http_ext_force}{$ext};
        #if ($force_download) {
        $state->{int}{$_} ||= { n => ++$state->{links}, check => !$no_check };
        $state->{depth}{$_} = $state->{depth}{$url} + 1
          if !$state->{depth}{$_}
            or $state->{depth}{$_} > $state->{depth}{$url} + 1;
        #}
      } else {
        $state->{ext}{$_} ||= ++$state->{links};
      }
    }
  }

  sub http_page {
    return if $state->{download}{ $state->{current} };
    {
      printlog( "warn", "max_depth reached on $state->{current} $state->{depth}{$state->{current}}" ), last
        if $state->{depth}{ $state->{current} } > hconfig( 'http_max_depth', $state->{current_url}{'host'} );
      local @_;
      printlog( 'skip', $state->{current}, "robots.txt", @_ ), last
        if @_ = grep { $state->{current} =~ m{\w+://[^/]+\Q$_} ? $_ : () } keys %{ $state->{disallow} };
      if ( $state->{int}{ $state->{current} }{check} ) {
        my $type = http_type( $state->{current} );
        printlog( 'skip', $state->{current}, "type2=[$type]" ), $state->{callback_skip}->( $state->{current}, $type ), last
          unless $config{http_avail_types}{$type};
      }
      my ( $content, $resp ) = http_get2( $state->{current} );
      #CB!     print { $state->{OUT} }     $content;
      $state->{callback_page}->( $state->{current}, $content );
      printlog( "info", 'downloaded', $state->{page_limit}, $state->{current},
        "depth=$state->{depth}{$state->{current}}, size=",
        length($content), 'type=', $resp->header('Content-Type') )
        if length($content);
      http_parse( $content, $state->{current}, $resp->base );    #$state,
    }
    ++$state->{download}{ $state->{current} };
  }

  sub http_dl {
    my ( $root, $callback_page, $callback_skip ) = @_;           #, $state
    #local %config = %config;
    $root .= '/' unless $root =~ m{/$};
    $root = 'http://' . $root unless $root =~ m{^\w+://};
    $state = {};
    $state->{callback_page} = $callback_page || sub { };
    $state->{callback_skip} = $callback_skip || sub { };
    $state->{root}          = $root;
    $state->{current} ||= $root;

    if ( !$state->{robots_ok} ) {
      local $_ = $root;
      #$state->{current} = ;
      s{(\w+://[^/]+).*$}{$1};
      $_ .= '/robots.txt';
      for ( split /\n+/, http_get($_) ) {
        #printlog('rob', $_);
        #++$state->{disallow}{$1}, printlog( 'rob', $1 ) if m{Disallow:\s*(.+)\s*$}i;
        if (m{Disallow:\s*(.+)\s*$}i) {
          $_ = $1;
          s/[\x0D\x0A]//g;
          s{/$}{}g;
          ++$state->{disallow}{$_}, printlog( 'rob', "[$_]" );
        }
      }
      ++$state->{robots_ok};
    }
    #$state->{int}{$root} = {};
    $state->{out} = $root;
    $state->{out} =~ s{\w+://}{};
    $state->{out} =~ s{/$}{}g;
    $state->{out} =~ s{/}{_}g;
    my %url = split_url($root);
    while ( $state->{current} ) {
      printlog( 'err', "pages limit reached on $state->{root}", $state->{page_limit}, ), last
        if ++$state->{page_limit} > hconfig( 'http_max_pages', $state->{current_url}{'host'} );
      http_page($state);
      $state->{current} = ( (
          hconfig( 'http_next_selector', $state->{current_url}{'host'} )
            ->( grep { !$state->{download}{$_} } keys %{ $state->{int} } )
        )[0]
      );
      #printlog('dev' ,'selected', $state->{current},'from', grep { !$state->{download}{$_} } keys %{ $state->{int} });
      $state->{current_url} = split_url( $state->{current} );
      sleep( hconfig( 'http_page_sleep', $state->{current_url}{'host'} ) );
    }
    #close( $state->{OUT} );
    $state->{finished} = 1;
    #save_ext();
  }
}
$config{'select_weight'} //= 0.1;
$config{'select_around'} //= 1;
$config{'ret_field'}     //= 'block';    #'text'
$config{'ret_sep'}       //= ' ';

sub striplinks {                         # $Id: crawler.pl 4843 2013-08-14 12:17:58Z pro $
  my $file = shift;
  #  print "[$file]";
  #my @blocks = split m{</?a} ;
  #my @blocks = split m{(<a.*?>)} ;
  $file =~ s{<$_.*?>.*?</$_.*?>}{}gsi for qw(style script);
  $file =~ s{<!--.*?-->}{}gs;
  my @blocks = split m{((?:<a.*?>.*?</a.*?>)|(?:<(?:td).*?>))}is, $file;
  my @flags;
  my $n = 0;
  my ( $depth, %avg, %avgn, %min );
  for my $block (@blocks) {
    $flags[$n]{'n'} = $n;
    $flags[$n]{'link'} = 1 if $block =~ /^<a/i;
    my $blockstrip = $block;
    $blockstrip =~ s{</?$_.*?>}{}gsi for qw(p br);
    #print "\nbs:[$blockstrip]\n";
    $flags[$n]{'blocklen'} = length $blockstrip;
    #print "BLOCK[$block]\n";
    ++$depth,
      #print("+[$_]")
      for $block =~ m{<\w+.*?>}gs;
    --$depth,
      #print("-[$_]")
      for $block =~ m{</\w+.*?>}gs;
    --$depth,
      #print("-![$_]")
      for $block =~ m{<\w+.*?/>}gs;
    #$depth += $block =~ m{<\w+>}g;
    #print "DEP:". join ':', ($block =~ m{</?\w+>}g);
    #    print "DEP:" . ( $flags[$n]{'depth'} = $depth );
    #    my $text = HTML::Entities::decode($block);
    my $text = HTML::Entities::decode_entities($block);
    $text =~ tr/\xAB\xBB\xA0/<> /;
    #    $text =~ s/&nbsp;/ /g;
    #    $text =~ s/&\w+;/ /g;
    #unless ($flags[$n]{'link'})
    {
      $text =~ s{<.*?>}{}gs;
      $text =~ s/\W/ /g;
      $text =~ s/\d/ /g;
      $text =~ s/\s+/ /g;
      $text =~ s/\s+$//g;
      $text =~ s/^\s+//g;
      $flags[$n]{'textlen'} = length $text;
    }    # else {$text= '' ;}
    $flags[$n]{'bt'} = $flags[$n]{'blocklen'} / $flags[$n]{'textlen'} if $flags[$n]{'textlen'};
    $avg{bt} += $flags[$n]{'bt'};
    ++$avgn{bt} if $flags[$n]{'bt'};
    $min{bt} = $n if $flags[$n]{'bt'} and $flags[$n]{'bt'} < $flags[ $min{bt} ]{'bt'};
    local $Data::Dumper::Indent = 0;
    #    print Dumper( $flags[$n] ) . " [$text]\n";    #$block
    $flags[$n]{text}  = $text;
    $flags[$n]{block} = $block;
  } continue {
    ++$n;
  }
  $avg{$_} /= $avgn{$_} for keys %avg;
  #print join ":", @blocks;
  #  print 'avg:', join ':', map { "$_=$avg{$_}" } keys %avg;
  #  print "\nminbt:", Dumper( $flags[ $min{bt} ] );
  #  print "\n\nSelecting\n\n";
  my @a = grep { $_->{textlen} } @flags;
  my $step = 1 / ( @a || 1 );
  my $n = 0;
  $_->{weight_textlen} = $n += $step for sort {
    #    $b->{bt} <=> $a->{bt}
    $a->{textlen} <=> $b->{textlen}
  } @a;
  #  $step = 1 / @flags;
  $n = 0;
  #   @a    = grep { $_->{textlen} } @flags;
  $_->{weight_bt} = $n += $step for sort { $b->{bt} <=> $a->{bt} } @a;
  $_->{weight} = $_->{weight_bt} + $_->{weight_textlen} for @a;
  my $max_weight;
  #print( Dumper($_) . "\n" ),
  $max_weight = $_->{weight} for sort {
    #    $b->{bt} <=> $a->{bt}
    #    $a->{textlen} <=> $b->{textlen}
    $a->{weight} <=> $b->{weight}
    }
    #    grep {    $_->{bt} and $_->{bt} < $avg{bt}}
    grep { !$_->{link} } @a;
  for my $n ( grep { $_->{weight} > $max_weight - $config{'select_weight'} } @flags ) {
    #   $n->{selected} = 1;
    $flags[ $n->{n} + $_ ]{selected} = 1 for ( -$config{'select_around'} .. $config{'select_around'} );
  }
  #print "\n\nResult:\n\n";
  my $ret;
  for my $n ( grep { $_->{selected} } @flags ) {
    #print "$n->{text} ";
    $ret .= $n->{ $config{ret_field} } . $config{ret_sep};
  }
  return $ret;
}

sub updateuser {
  my ( $dc, $user, $params ) = @_;
  my $peerlist = $dc->{'adc'} ? $dc->{'peers'} : $dc->{'NickList'};
#dmp $user, $params;
#printlog( 'dbg', 'updateuser: skipping user', $user, 'with share =', $peerlist->{$user}{INF}{SS}, $peerlist->{$user}{'sharesize'} , caller, Dumper $params   ),
  return if ( !$peerlist->{$user}{'sharesize'} and !$peerlist->{$user}{INF}{SS} ) and length $user;
  if ($user) {
    $params->{'ip'} ||= $peerlist->{$user}{INF}{I4} || $peerlist->{$user}{INF}{I6} || $peerlist->{$user}{'ip'};
    $params->{'desc'} ||= $peerlist->{$user}{INF}{DE}
      || $peerlist->{$user}{'description'};    #if $peerlist->{$user}{'description'};
    $params->{'cid'} ||= $peerlist->{$user}{INF}{ID};
  }
  #printlog('dev', "userdesc1=[$params->{'desc'}] ($user)") if $params->{'desc'};
  #$params->{'desc'} ||= $params->{'DE'};
  $params->{'desc'} =~ s/^(?:\s*(?:\{\S*?\})?(?:\[\S*?\])?)+//g;
  #printlog('dev', "userdesc2=[$params->{'desc'}]") if $params->{'desc'};
  #$params->{'desc'} =~ s/^\s*(?:\[\S+?\])\s*PeerWeb\s*DC\+\+\s*//ig;
  $params->{'desc'} =~ s/^\s*(PeerWeb|Apex)\s*DC\+\+\s*//ig;
  #printlog('dev', "userdesc3=[$params->{'desc'}]") if $params->{'desc'};
  $params->{'prot'} ||= $dc->{'adc'} ? 'adc' : 'dchub';
  $params->{'dcuser'} ||= $params->{NI} || $peerlist->{$user}{INF}{NI} || $user;
  #delete $params->{'port'} if $params->{'prot'} eq 'dchub' and $params->{'port'} == 411;
  $params->{'host'} = full_host( { 'prot' => $params->{'prot'}, %$dc } );    #, %$params
  #printlog('dev',' host= ',$params->{'host'},'from',$dc->{'host'} ,$dc->{'port'},'and',%$params);
  $params->{'time'} ||= ( $params->{'off'} ? int( time() ) - $config{'online_minutes'} * 120 : int( time() ) )
    unless $params->{'no_time'};
  #printlog('dev','timeup',$params->{'dcuser'}, $params->{'time'}, int(time()));
  #!$params->{'host'}   = cp_trans( $config{ 'cp_' . $params->{'prot'} }, $config{'cp_db'}, $params->{'host'} );
  #!$params->{'dcuser'} = cp_trans( $config{ 'cp_' . $params->{'prot'} }, $config{'cp_db'}, $params->{'dcuser'} );
  #!$params->{'desc'}   = cp_trans( $config{ 'cp_' . $params->{'prot'} }, $config{'cp_db'}, $params->{'desc'} );
  $static{'db'}->update( $config{'sql_tresource'}, undef, { 'path' => '', %$params } ) unless $params->{'no_res'};    #, 1
  unless ( $params->{'no_file'} ) {
    $static{'db'}->update( $config{'sql_tfile'}, undef, { 'path' => $_, %$params } )
      for ( '', '/' );
  }
  $params->{'port'} ||= $peerlist->{$user}{INF}{U4} || $peerlist->{$user}{INF}{U6} || $peerlist->{$user}{'port'}
    if $user and $config{'allow_ping_user_port'};
  delete $params->{'port'} if $params->{'port'} > 65535;
  #printlog('dev', 'update', %$params);
  $static{'db'}->update( $config{'sql_thost'}, undef, $params );    #, 1 'ip' => $ip,
}
$processor{'prot'}{'dchub'}{'func'} ||= sub {
  my ($filelists) = $stat{'filelists'};
  my $dc;
  foreach my $url (@_) {
    my %url = split_url($url);
    #printlog('split:', Dumper(\%url));
    $url{'dcuser'} = $1 if $url{'host'} =~ s|/(.+)||;
    my $hub = join_url( { 'host' => $url{'host'}, 'port' => $url{'port'} } );
    #next if $config{'dchub'}{$hub}{'disabled'};
    next if hconfig( 'disabled', $url{'prot'}, $hub );
    printlog(
      'dc',
      "Creating bot ver",
      ( $config{'version'} or 'r' . ( split( ' ', '$Revision: 4843 $' ) )[1] ),
      $Net::DirectConnect::VERSION, "to $url",
    );
    local %_ = ( %{ $config{'fine'}{ $url{'prot'} } }, %{ $config{'fine'}{$hub} } );
    $_{modules}{filelist} = 1 if $_{share};
    $dc = Net::DirectConnect->new(
      #'host' => $url,
      'host' => join_url( { map { $_ => $url{$_} } qw(prot host) } ),
      'port' => $url{'port'},
      'log'  => sub {
        my $dc = shift;
        #printlog('ERR', $dc, @_), return unless ref $dc;
        printlog( shift, "[$dc->{'number'}]", @_, );
      },
      'no_charset_console' => 1,
      #%{ $config{'fine'}{'dchub'} },
      'no_auto_share_downloaded' => 1,
      'sql'                      => $config{'sql'},
      'db'                       => $static{'db'},
      %_,
      'auto_connect' => 0,
      'auto_GetINFO' => 1,
    );
    #printlog ('dev', 'SH1', Dumper $config{'fine'}{'dchub'});
    $dc->{'sharesize'} = psmisc::human( 'number_k', $dc->{'sharesize'} );
    #printlog ('dev', 'SH2', Dumper $dc);
    my $nicklistres = 1 if $url{'dcuser'};
    $dc->{'handler'}{'NickList'} = sub {
      my $dcu = shift;
      updateuser( $dc, $_ ) for keys %{ $dc->{'NickList'} };
      printlog( 'dc', "Nicklist recieved = ", scalar keys %{ $dc->{'NickList'} } );
      $nicklistres = 1;
    };
    $dc->{'handler'}{'MyINFO'} = sub {
      my $dcu = shift;
      ($_) = $_[0] =~ /\S+\s+(\S+)\s+(.*)/;
      updateuser(
        $dc, $_, (
          hconfig( 'dcbot_size_myinfo', $hub )
            && $dc->{'NickList'}->{$_}{'sharesize'} > 0 ? { ( 'size' => $dc->{'NickList'}->{$_}{'sharesize'} ) } : ()
        )
      );
    };
    $dc->{'handler'}{'chatline'} = sub {
      my $dcu = shift;
      ($_) = $_[0] =~ /^<(\S+)>/;
      updateuser( $dc, $_ ) if $dc->{'NickList'}->{$_} or $config{'dcbot_update_unknown'};    #Hub-Security
    };
    $dc->{'handler'}{'welcome'} = sub {
      my $dcu = shift;
      printlog(
        'dc', 'welcome:', $_[0]    #scalar cp_trans( $config{ 'cp_' . $url{'prot'} }, $config{'cp_log'}, $_[0] )
      );
    };
    $dc->{'handler'}{'quit'} = sub {
      my $dcu = shift;
      updateuser( $dc, $_, { 'off' => 1 } );
    };
    $dc->{'handler'}{'BadPass'} = sub {
      my $dcu = shift;
      printlog( 'err', 'BadPassword' );
    };
    $dc->{'handler'}{'LogedIn'} = sub {
      my $dcu = shift;
      printlog( 'dbg', $_[0], 'is LogedIn' );
    };
    $dc->{'handler'}{'user_ip'} = sub {
      my $dcu = shift;
      #printlog('dev', 'hUserip', @_);
      updateuser(
        $dc,
        $_[0], {
          'ip' => $_[1],
          #( $_[2] != 411 ? ( 'port' => $_[2] ) : () ),
          'port'    => $_[2],
          'no_res'  => 1,
          'no_file' => 1,
          'no_time' => 1
        }
      ) if $_[1] ne name_to_ip( split_url( $url{'host'} )->{'host'} );
    };
    $dc->{'handler'}{'INF'} = sub {
      my $dcu = shift;
      #dmp @_;
      #($_) = $_[0] =~ /\S+\s+(\S+)\s+(.*)/;
      return if $_[0][-1] eq 'I';
      updateuser( $dc, $_[-1]{ID} || $_[0][-1], $_[-1] );
      #  $dc, $_, (
      #    hconfig( 'dcbot_size_myinfo', $hub )
      #      && $dc->{'NickList'}->{$_}{'sharesize'} > 0 ? { ( 'size' => $dc->{'NickList'}->{$_}{'sharesize'} ) } : ()
      #  )
      #);
    };
    $dc->{'handler'}{'QUI'} = sub {
      my $dcu = shift;
      dmp \@_;
      updateuser( $dc, $_[1], { 'off' => 1 } );
    };
    $dc->{'auto_recv'} = 0 if $url{'dcuser'};
    printlog( 'dc', "Connecting to", $url );
    $dc->connect();
    #printlog( 'dev', __LINE__);
    $dc->wait();    #for 1 .. 5;
    #printlog( 'dev', __LINE__, 'waited');
    next unless $dc->{'socket'};
    $dc->wait_connect(20);    #for 1 .. 5;
    #printlog( 'dev', __LINE__, 'waited',20);
    #1    while !$dc->recv(1);
    printlog( 'warn', "connect timeout", $dc->{'status'} ), next unless $dc->{'status'} eq 'connected';
    printlog( 'dbg', "connected", $dc->{'status'} );
    if ( !$dc->{'adc'} and !$url{'dcuser'} and !$nicklistres and !$dc->{'auto_GetNickList'} ) {
      printlog( 'dbg', "Get nicks" );
      $dc->cmd('GetNickList');
      next unless $dc->{'socket'};
      my $trynickres = hconfig( 'nicks_receive', $hub ) || 50;
      #$dc->recv(1), sleep(0.1) while --$trynickres > 0 and !$nicklistres;
      $dc->wait(5) while --$trynickres > 0 and !$nicklistres;
    }
    #printlog( 'dbg', "nicks:", $nicklistres, );
    printlog( 'dbg', "Starting [$dc->{'host'} : $dc->{'port'}]" );
    my $saveto =
        $config{'datadir'}
      . $config{'slash_sys'}
      . $dc->{'host'}
      . ( $dc->{'port'} != $config{'scanner'}{ $url{'prot'} }{'port'} ? '.' . $dc->{'port'} : '' ) . '.'
      . $url{'prot'};    #'dchub';
    $dc->wait(5);
    next unless $dc->{'socket'};
    my $peerlist = $dc->{'adc'} ? $dc->{'peers_cid'} : $dc->{'NickList'};
    #my $peerlist = $dc->{'adc'} ? $dc->{'peers'} : $dc->{'NickList'};
    printlog( 'dev', "work", hconfig( 'dcbot_wait_start', $hub ) );
    $dc->wait( hconfig( 'dcbot_wait_start', $hub ) || 5 );
    #psmisc::file_rewrite( 'dump', Dumper $dc);
    printlog( 'dbg', "Starting users", ( $url{'dcuser'} or scalar keys %$peerlist ) );
    my $hubhost = $url{'host'};
    my $hubport = $url{'port'};
    my $n;
    my @todo = ( $url{'dcuser'} || ( sort keys %$peerlist ) );
    printlog(
      'info', "todo users:", scalar @todo,    #Dumper \@todo#, $dc
    );

    for my $user (@todo) {
      #printlog( 'dev', "looking at [$user]");
      printlog( 'err', 'skipping bad user', "[$user]" ), next if !length $user or $user !~ /\S/;
      last if scan_stop;
      ++$n;
      my $get = 1;
      $url{'dcuser'} = $peerlist->{$user}{INF}{NI} || $user;
      $url{'host'} = full_host( { %url, 'host' => $hubhost, 'port' => $hubport } );
      #printlog('split:', Dumper(\%url));
      my %url_db = %url;
      #cp_trans_hash( $config{ 'cp_' . $url{'prot'} }, $config{'cp_db'}, \%url_db );
      #my $file =           ;
      my $file = encode_url(
        #scalar cp_trans( $config{ 'cp_' . $url{'prot'} }, $config{'cp_shell'},
        Encode::encode(
          'utf-8',    #hconfig( 'cp_shell' ),
          $dc->{'adc'} ? $peerlist->{$user}{INF}{NI} : $user, Encode::FB_DEFAULT
        ),
        $config{'encode_dc_user_mask'}
      );
      my $saveas_noext = $saveto . $config{'slash_sys'} . $file;
      my $saveas       = $saveas_noext . '.xml.bz2';
#my $saveasshell = Encode::encode hconfig( 'cp_shell' ), $saveas;
#$saveas_noext = Encode::encode hconfig( 'cp_shell' ), $saveas_noext;
#printlog( 'dev', "1user=$url{'dcuser'}; host=$url{'host'}; get=$get; config{'no_dcbot_download'}=$config{'no_dcbot_download'}" );
      my $sharesize = $peerlist->{$user}{INF}{SS} || $peerlist->{$user}{'sharesize'};
      if ( !hconfig( 'no_dcbot_download', $hub, $user ) ) {
        printlog(
          'dbg', 'looking at', $url{'host'}, '/', $url{'dcuser'}, ' filelist:', -s $saveas, int -M $saveas, $n, '/',
          scalar keys %$peerlist, 'share:', $sharesize,
          #Dumper $peerlist->{$user}
        );
        #printlog( 'dbg', "skip [$user] (filelist exists)" ), $get = 0
        #if
        #( !hconfig( 'forceforce', $hub ) and -s $saveto . $config{'slash_sys'} . $file . '.xml.bz2' );
        printlog( 'dbg', "skip [$user] (self)" ), $get = 0
          if $user eq $dc->{'Nick'}
            or $dc->{'INF'}{'SID'} eq $user
            or $dc->{'INF'}{'CID'} eq $user;
        printlog( 'dbg', "skip [$user] (scanned)" ), $get = 0
          if (
          !hconfig( 'forcedc', $hub, $user )
          and (( -s $saveas and ( ( time - $^T + 86400 * -M $saveas ) < $config{'dcbot_client_period'} ) )
            or ( -s $saveas . '.ok' and ( ( time - $^T + 86400 * -M $saveas . '.ok' ) < $config{'dcbot_client_period'} ) ) )
          ) or !allowscan( \%url_db, $config{'sql_tresource'}, undef, $config{'dcbot_client_period'} );
        my $already = dcscanned($user);
        #dmp 'already', $already;
        if (
          ( $already->{tiger} or $already->{cid} ) and (
            time - $already->{scan} < $config{'dcbot_client_period'}
            #or $scan < $already->{scan}
          )
          )
        {
          printlog( 'dbg', "skip [$user] (cid: already scanned)", $config{'dcbot_client_period'}, time - $already->{scan} ),
            $get = 0;
        }
      }
#$dc->cmd( 'GetINFO', $user ), $dc->work()if !$dc->{'adc'}and !hconfig( 'dcbot_no_getinfo', $hub, $user )and !$peerlist->{$user}{'info'}and grep { $_ ne 'INF' } keys %{ $peerlist->{$user} };    #, $dc->recv()
      if ( !hconfig( 'no_dcbot_download', $hub, $user ) ) {
        printlog( 'dbg', "skip [$user] (share $sharesize bytes)" ), $get = 0
          if !hconfig( 'forcedc', $hub, $user )    #!$config{'force'}
            and ( defined($sharesize) or hconfig( 'no_dcbot_download_unknown', $hub, $user ) ) and !$sharesize;
        printlog( 'dbg', "skip [$user] unable get from passive user" ), $get = 0
          if $dc->{'M'} eq 'P' and ( ( $dc->{adc} and !$peerlist->{$user}{INF}{I4} ) or $peerlist->{$user}{'M'} eq 'P' );
        printlog( 'dbg', "skip [$user] no free user slots ($peerlist->{$user}{'S'})" ), $get = 0 if    #!$config{'force'}
          !$dc->{'adc'} and !hconfig( 'forcedc', $hub, $user ) and $peerlist->{$user}{'S'} eq '0';
      }
#printlog( 'dev', "2user=$url{'dcuser'}; host=$url{'host'}; get=$get; config{'no_dcbot_download'}=$config{'no_dcbot_download'}" );
      if ( !hconfig( 'no_dcbot_download', $hub, $user ) and $get ) {
        printlog( 'dc', "Skip unknown user [$user]" ), next
          if !keys %{ $peerlist->{$user}{'INF'} } and !grep { $_ ne 'INF' } keys %{ $peerlist->{$user} };
        printlog( 'dc',  "Get filelist from [$user]" );
        printlog( 'dbg', "get: [$saveas_noext] user=$user to[$saveto]" );
        mkdir_rec( $saveto, 0777 );
        $dc->get( $user, '', $saveas_noext );                                                          #.get
        ++$stat{'filelists'};
        #$dc->wait(1, hconfig( 'dcbot_pause',  $hub )) and
        #$dc->wait(10, 0.1) for 0..5;
        #printlog( 'dev',  "sleep", hconfig( 'dcbot_pause',  $hub ) );
        $dc->wait( hconfig( 'dcbot_pause', $hub ) );
        #sleep hconfig( 'dcbot_pause',  $hub );
        #sleep $config{'dcbot_pause'};
      } elsif ( $config{'force_ip_collect'}
        and $user                   ne $dc->{'Nick'}
        and $dc->{'INF'}{'SID'}     ne $user
        and $dc->{'INF'}{'CID'}     ne $user
        and $peerlist->{$user}{'M'} ne 'P'
        and !( $peerlist->{$user}{'INF'}{'I4'} or $peerlist->{$user}{'INF'}{'I6'} )
        and ( ( $dc->{'M'} ne 'P' ) or $dc->{'allow_passive_ConnectToMe'} ) )
      {    #to do to dcpp lib
        printlog( 'dc', 'trying connect to us', $user );
        $dc->cmd( 'Rev' . 'ConnectToMe', $user ) if !$dc->{'adc'};    #TODO for adc
      }
      #$dc->info();
      #printlog( 'dev',  "cycle end" );
      printlog( 'err', 'hub inactive!' ), $dc->info(), last unless $dc->active();    #$dc->{'socket'};
    }
    my $share;
    $share += $peerlist->{$_}{INF}{SS} || $peerlist->{$_}{'sharesize'} for keys %$peerlist;
    $share = psmisc::human( 'size', $share );
    updateuser(
      $dc, '', {
        %$dc,
        'desc' => ( scalar keys %$peerlist or 0 ) . ' users ' . $share . ' ' . $dc->{'HubName'},
        'scan' => int( time() )
      }
    );
    printlog( 'dbg', 'ended, aftersleep' );
    #$dc->wait(100,1) for ( 0 .. 60 );
    $dc->wait(10) if $url{'dcuser'};
    $dc->wait_finish();
    printlog( 'dc', 'Finished' );
    $dc->destroy();
    psmisc::file_rewrite( 'dcexit.dump', Dumper $dc );
    #todo: hubstat
    #printlog('info', $dc->{'IpList'});
    #printlog('info', $dc->{'NickList'});
    #for( keys %{ $dc->{'IpList'} } ) {
##printlog('dev', "ip=$_, nick=",$dc->{'IpList'}->{$_}{'Nick'}, 'port=',$dc->{'IpList'}->{$_}->{'port'});
    #printlog('dbg','updating info about user ip:', $dc->{'IpList'}->{$_}{'Nick'}, $_),
    #updateuser($dc, $dc->{'IpList'}->{$_}->{'Nick'}, {'ip' => $_,
    #'port' => $dc->{'IpList'}->{$_}->{'port'},
    #'no_res' => 1, 'no_file' => 1, 'no_time' => 1});
    #}
    $processor{'file'}{ $url{'prot'} }{'func'}->($saveto) unless hconfig( 'no_dcbot_upload', $hub );
  } continue {
    #$dc = undef;
    $dc->destroy() if $dc;
    #printlog('dev', Dumper($dc));
    #delete $dc->{$_}for keys %$dc;
    $dc = undef;
    #undef $dc;
    printlog( 'dev', "dcexit (fail)" );
  }
  $work{'proc_scans'} -= $stat{'filelists'} - $filelists;
};
$processor{'prot'}{'dchub'}{'get'} ||= sub {
  #TODO
};
$processor{'prot'}{'adc'}{$_}    ||= $processor{'prot'}{'dchub'}{$_},
  $processor{'prot'}{'adcs'}{$_} ||= $processor{'prot'}{'dchub'}{$_},
  for keys %{ $processor{'prot'}{'dchub'} };

sub nmap_host_name () {
  my $hostip   = $+{ip};
  my $hostname = $+{name};
  $hostip   ||= $hostname;
  $hostname ||= $hostip;
  my $host = ( ( !$config{'nmap_nores'} and $hostname ) ? $hostname : $hostip );
  $host =~ s/\(|\)//g;
  return wantarray ? ( $host, $hostip, $hostname ) : $host;
}
$processor{'format'}{'nmap'} ||= sub {
  my $nping = shift @_;
  my ( $host, $hostip, $hostname );
  my @resbuffer;
  my %nstat;
  $nping = $nping =~ /-P[0n]/;
  for my $content (@_) {
    my ( $hostup, $resolvs );
    my $oneline = sub {
      chomp;
      s/[\x0d\x0a]+//g;
      #printlog( 'nmap', $_ );
      if (
           /Host\s+(?<name>\S*)\s+(:?\((?<ip>\S+)\)\s*)?appears to be up/io
        or /Host:\s*(?<ip>\S+)\s*(?<name>\S*)\s*(Status: Up|Ports:)/io
        or /Interesting ports on (?<name>\S*)\s*\((?<ip>\S+)\)/io
        or /Interesting ports on (?<ip>\S+):/io
        or /Discovered open port (?<port>\S+)\/tcp on (?<ip>\S+)/io
        or /Nmap scan report for (?<name>\S+)\s*(:?\((?<ip>\S+)\)\s*)?\s*(?<down>\[host down\])?/io
        #Nmap scan report for 24.117.235.52 [host down]
        )
      {
        ( $host, $hostip, $hostname ) = nmap_host_name();
        #$hostip = $+{ip};
        #$hostname = $+{name};
        #$hostip   ||= $hostname;
        #$hostname ||= $hostip;
        #$host = ( ( !$config{'nmap_nores'} and $hostname ) ? $hostname : $hostip );
        #$host =~ s/\(|\)//g;
        return if !$host or $host =~ /^\d$/;
        $hostup = 1 if !$nping;
        $hostup = 0 if $+{down};
        #printlog ('up', $host, $hostup, Dumper \%+);
        #$resolvs = 0;
        #$nstat{$hostip}
      } elsif (/^\s*Host is up(?:\.| \((?<latency>\S+)s latency\))/) {
        $hostup = 1 unless $nping;
        $nstat{'host'}{$host}{$_} = $+{$_} for grep { length $+{$_} } qw(latency);
      } elsif (
        /^\s*Nmap (?:done|finished): (?<total>\d+) IP addresses \((?<up>\d+) hosts up\) scanned in (?<seconds>\S+) seconds/)
      {
        #
        #Completed Connect Scan at 20:21, 7.66s elapsed (1024 total ports)
        #Scanning 256 hosts [4 ports/host]
        #$work{'range_size'} = $+{total};
        $nstat{'up'}   = $+{up};
        $nstat{'per'}  = $+{seconds};
        $nstat{'size'} = $+{total};
      } elsif (/^\s*Raw packets sent: (?<sp>\d+) \((?<sb>\S+)\) \| Rcvd: (?<rp>\d+) \((?<rb>\S+)\)/) {
        $nstat{$_} = $+{$_} for keys %+;
        #count traffic bytes?
      } elsif (
/^\s*All (?<ports>\d+) scanned ports on (?<name>\S+)(?: \((?<ip>\S+)\))? are (?:closed|filtered)(?: \((?<closed>\S+)\) or filtered \((?<filtered>\S+)\))?/
        )
      {
        ( $host, $hostip, $hostname ) = nmap_host_name();
        $hostup = 0 if $nping;
        #printlog ('down', $host, $hostup, Dumper \%+);
        $nstat{'host'}{$host}{$_} = $+{$_} for grep { length $+{$_} } qw(closed filtered);    # ports
      } elsif (/Not shown: (?<closed>\d+) closed ports/) {
        $nstat{'host'}{$host}{$_} = $+{$_} for grep { length $+{$_} } qw(closed);
      }
      if ( m{(?<port>\S+)/tcp\s+(?<state>open|on|unfiltered)}io or m{Discovered open port (?<port>\S+)/tcp on (?<host>\S+)} ) {
        my ( $port, $prot ) = ( $1, $static{'port2prot'}{$1} );
        return unless $host;
        return if $config{'scanner'}{$prot}{'disabled'};
        $host = normalize_ip($host) if $config{'host_by_name_norm'};                          # and !$resolvs++;
        printlog( 'warn', "invalid host" ), next unless $host;
        my $res = $prot . '://' . $host;
        return if $nstat{'scanned'}{$res}++;
        push( @resbuffer, $res ) unless $config{'nmap_only'};

        unless ( $static{'banned'}->{$res} or $static{'banned'}->{$host} ) {
          #warn "tryup";
          #psmisc::dmp('tryup', $prot, $_->database),
          $_->update( $config{'sql_tresource'}, undef, { 'prot' => $prot, 'host' => $host } )
            for grep { $_ } $static{'db'}, $static{'db_shard'}{$prot};
        }
        $processor{'urls'}->(@resbuffer), @resbuffer = () if $#resbuffer >= $config{'start_by'} - 1;
        $hostup = 1 if $nping;
        ++$ipstt{'resalive'}{$host};    #remove
        ++$nstat{'resalive'}{$host};
        $nstat{'prot'}{$prot}{$host} = 1;
        $nstat{'host'}{$host}{$prot} = 1;
      }
      if ($hostup) {
        $host = normalize_ip($host) if $config{'host_by_name_norm'};
        #$static{'db'}->line("SELECT * FROM $tq$config{'sql_thost'}$tq WHERE host!=$vq$host$vq AND ip=$vq$ip$vq")->{'host'}
        $static{'db'}->update(
          $config{'sql_thost'},
          undef, {
            'host' => $host,
            'ip'   => $hostip,
            'time' => int( time() ),
            'meta' => join( ' ', map { "$_=$nstat{'host'}{$host}{$_}" } keys %{ $nstat{'host'}{$host} } )
          }
        );
        ++$ipstt{'alive'}{$host};
        ++$ipstt{'ralive'}{$host};    # not optimal!
        #++$nstat{'up'}{$host};
        $hostup = 0;
      }
    };
    oneliner( $oneline, $content );
  }
  for my $p ( keys %{ $nstat{'prot'} || {} } ) { $nstat{$p} = scalar keys %{ $nstat{'prot'}{$p} || {} }; }
  dmp( \%nstat );
  $processor{'urls'}->(@resbuffer) if @resbuffer;
  return \%nstat;
};

sub speed ($$) {
  my ( $t, $c ) = @_;
  my $ps;
  $ps = $c / $t if $c and $t > 0;
  $ps = ' at ' . psmisc::human( 'float', $ps ) . 'ps' if $ps;
  return 'per ' . psmisc::human( 'time_period', $t ) . $ps;
}
$processor{'url'} ||= sub {
  my @rng = @_;
  #printlog('dev', '$processor{url}', @_);
  %ipstt = ();
  @rng = reverse(@rng) if $config{'ranges_reverse'};
  shuffle( \@rng ) if $config{'ranges_shuffle'};
  my $ranges = 0;
  for my $range (@rng) {
    ++$ranges;
    $range =~ s/^\s+|\s+$//g;
    next if !$range or $range =~ /^[;#]/;
    my ($desc) = $1 if $range =~ s/\s+(.+)//;
    $range = 'local://' . $range
      if ( $range =~ /^\w:/ and $config{'system'} =~ /win/ )
      or $range =~ m{^([/\\])(!:\1)} and -d $range;
    $range = '\\\\' . $range if $range =~ /^(?:\.|\w\:[^\/\\]|\\[^\\])/;    #    |(\/[^\/])!!!   |((\\)|(\/)$)
    $range =~ tr/\\/\// if $range =~ s/^\s*(?:\\\\|\/\/)/file:\/\//;
    my $tim = timer();
    #todo $range = 'range://'    unless ( $range =~ /\:\/\// );
    #printlog('dev', '$processor{url}2', $range);
    if ( $range =~ /\:\/\// ) { $processor{'scan_proto_host'}->($range); next; }
    next
    #unless allowscan( { 'range' => $range, 'desc' => $desc }, $config{'sql_tranges'}, undef, $config{'range_period'} );
    #unless allowscan( { 'range' => $range, 'desc' => $desc }, $config{'sql_tranges'}, undef, hconfig('range_period', $range) );
      unless allowscan( { 'range' => $range, 'desc' => $desc }, $config{'sql_tranges'}, undef,
          hconfig( 'period', $range, 'range' ) );
    next if $config{'noscan'};
    ( $ipstt{'ralive'}, $ipstt{'resalive'} ) = ();
    printlog( 'nmap', "scanning $range [", $ranges, '/', $#rng + 1, ']' );
    state( "scan:", $range );
    my $nmap_myip;
    $nmap_myip = '-S ' . $config{'myip'}
      if $config{'myip'}
        and $config{'get_myip_mask'}
        and $range =~ /$config{'get_myip_mask'}/;
    my $port = join ',',
      map { $config{'scanner'}{$_}{'port'} }
      grep { $config{'scanner'}{$_}{'port'} and !$config{'scanner'}{$_}{'disabled'} and !$config{'scanner'}{$_}{'no_nmap'} }
      keys %{ $config{'scanner'} };
    $port = $config{'nmap_param_port'} . ' ' . $port
      if $port and $config{'nmap_param_port'} and !$config{'pingonly'} and !$param->{'pingonly'};    # del $param
    my $scantype = $port ? $config{'nmap_scan'} : $config{'nmap_ping'};
    shelldata($range);
    state( "scan range: $range", );
    on_interrupt(
      sub {
        $static{'db'}->update(
          $config{'sql_tranges'},
          undef, {
            'range' => $range,
            #'scan'  => int( time() + hconfig('on_interrupt', $range) - hconfig('range_period', $range)),
            'scan' => int( time() + hconfig( 'on_interrupt', $range ) - hconfig( 'period', $range, 'range' ) ),
          }
        );
      }
    ) if hconfig( 'on_interrupt', $range );
    my $h = openproc(
"$config{'starter'} $config{'nmap'} $scantype $port $config{'nmap_param'} $config{'nmap_nores'} $nmap_myip $range $config{'stderr_redirect'} |"
    ) or next;
    my $nstat = $processor{'format'}{'nmap'}->( $config{'nmap_param'}, $h ) || {};
    on_interrupt();
    close($h);
    my $ips = ( 2**( 32 - $1 ) ) if !$nstat->{'size'} and $range =~ m|^\s*\d+\.\d+\.\d+\.\d+/(\d+)\s*$|;
    $ips = $nstat->{'size'} if $nstat->{'size'};
    #$nstat->{'range_size'} = 0;
    %_ = (
      'range' => $range,
      'scan'  => int( time() ),
      'alive' => scalar( keys %{ $ipstt{'ralive'} } ),
      'size'  => ( $ips or 1 ),
      'meta'  => join( ' ', map { "$_=$nstat->{$_}" } grep { !ref $nstat->{$_} } keys %$nstat )
    );
    $_{'time'} = int( time() ) if scalar( keys %{ $ipstt{'ralive'} } );
    $static{'db'}->update( $config{'sql_tranges'}, undef, \%_ );
    my $t = $tim->();
    #my $ipps = $ips / $t if $t > 0;
    #( $ipps = sprintf( "%.3f", $ipps ) ) .= ' ipps' if $ipps;
    #$ips = " [$ips] " if $ips;
    printlog(
      'nmap', "finished $range $ips alive:", scalar( keys %{ $ipstt{'ralive'} } ), ', resalive:',
      scalar( keys %{ $ipstt{'resalive'} } ),
      #' per', psmisc::human( 'time_period', $t ), $ipps
      speed( $t, $ips ), $_{meta},
    );
    ++$work{'scans'};
  }
};

sub url_local2ext (\%) {
  my $url = \%{ $_[0] };
  $url->{prot} = $config{'local_prot'};
  $url->{host} = $config{'local_host'};
  $config{'local_path'}->( $url->{path} ) if $config{'local_path'} eq 'CODE';
  $url;
}
$processor{'prot'}{'range'}{'func'} ||= sub { printlog( 'dev', '$processor{range}', @_ ); };
$processor{'scan_proto_host'} ||= sub {
  for my $url (@_) {
    #printlog('dev', '$processor{scan_proto_host}', $url);
    $url =~ s/\s+$//;
    $url =~ tr|\\|/|;
    $url .= '/' unless $url =~ m|/$|;
    my $url_orig = $url;
    my %url      = split_url($url);
    #printlog('dev', '$processor{scan_proto_host}', %url);
    #printlog('dev', '$processor{scan_proto_host} pre norm', join_url(\%url));
    $url{'host'} = normalize_ip( $url{'host'} )
      if $url{'host'}
        and $url{'prot'} ne 'range'
        and hconfig( 'host_by_name_norm',       $url{'host'}, $url{'prot'} )
        and hconfig( 'host_by_name_norm_force', $url{'host'}, $url{'prot'} )
        #and !( $config{'norm_skip_host'} and $url{'host'} =~ /$config{'norm_skip_host'}/i )
    ;
    #printlog('warn', "host [$url{'host'}]", name_to_ip($url{'host'}));
    printlog( 'warn', "invalid host [$url]" ), next if !$url{'host'} and $url{'prot'} ne 'local';
#printlog('dev', '$processor{scan_proto_host}3', %url, $config{'scanner'}{ $url{'prot'} }{'disabled'}, $config{'scanner'}{ $url{'prot'} }{'func'});
#printlog('dev', '$processor{scan_proto_host} post norm', join_url(\%url));
    next
      if $config{'scanner'}{ $url{'prot'} }{'disabled'}
        or ( !$url{'host'} and $url{'prot'} ne 'local' )
        or !$processor{'prot'}{ $url{'prot'} }{'func'};
    $url{'path'} = '' if $url{'path'} eq '/';
    $url = join_url( \%url );
    my $desc;    #todo
    my $table = $url{'prot'} eq 'range' ? $config{'sql_tranges'} : $config{'sql_tresource'};
    my %res = $url{'prot'} eq 'range' ? ( 'range' => $url, 'desc' => $desc ) : ( %url, 'host' => full_host( \%url ), );
    #printlog('dev', '$processor{scan_proto_host}2', %res);
    printlog(
      'dbg',
      "Skipping $url (scanned",
      psmisc::human( 'time_period', int( time() ) - $work{'skiptime'}{$url} ),
      ' ago) period=',
      psmisc::human( 'time_period', $work{'skipperiod'}{$url} ),
      ),
      next
      if (
      !allowscan(
        \%res, $table, undef, ( ( $url{'prot'} eq 'dchub' and $url{'host'} =~ m|/| ) ? $config{'dcbot_client_period'} : undef )
      )
      );
    next if $config{'noscan'};
    #} else {
    #if !$config{'noscan'};
    #{
    local $config{'force'} = 0 if $work{'scan_proto_host_reset_force'};
    resetcounters();
    $work{'scan_unfinished'} = 0;
    state( "scan:", join_url( \%url ) );
    printlog( 'dbg', "Starting scan", join_url( \%url ) );
    on_interrupt(
      sub {
        #$static{'db'}->flush();
        #local $config{'log_dmp'} = 1;
        #printlog('dev', 'on_interrupt update'),
        $static{'db'}->update( $table, undef,
          { %url, 'scan' => int( time() + hconfig( 'on_interrupt', values %url ) - hconfig( 'period', values %url ) ), } )
          if hconfig( 'on_interrupt', values %url );
      }
    );
    my $tim = timer();
    #printlog('dev', '$processor{scan_proto_host} fu ', $url_orig,join_url(\%url));
    $processor{'prot'}{ $url{'prot'} }{'func'}->( ( $url{'prot'} eq 'local' ) ? $url_orig : join_url( \%url ) );
    on_interrupt();
    ++$work{'scans'};
    $static{'db'}->flush_insert()
      #$processor{'out'}{'array'}->()
      if hconfig( 'flush_sql_every_res', values %url );
    next if $config{'scanner'}{ $url{'prot'} }{'no_res_stat'};
    #printlog('dev', '$processor{scan_proto_host} fu0 ', $url_orig,join_url(\%url), join_url(\%res));
    my $local;
    $local = 1 if $url{'prot'} eq 'local';
    %url = %{ url_local2ext(%url) }, %res = %{ url_local2ext(%res) }, if $url{'prot'} eq 'local';
  #printlog('dev', '$processor{scan_proto_host} fu ', $url_orig,join_url(\%url), join_url(\%res), "loc[$local]");
  #local $config{'log_dmp'} = 1;
  #printlog('dev', 'on_finish update', 'files=',$work{'filec'}->( $stat{'files'} ), 'size=', $work{'sizec'}->( $stat{'size'} ));
  #dmp \%stat;
    local %_;
    if ( $work{'filec'}->( $stat{'files'} ) ) {
      %_ = (
        %res, %{ $config{'clear_file'} || {} },
        'files' => $work{'filec'}->( $stat{'files'} ),
        'dirs'  => $work{'dirc'}->( $stat{'dirs'} ),
        'size'  => $work{'sizec'}->( $stat{'size'} )
      );
      $_{'time'} = int( time() );
      $_{'scan'} = int( time() ) unless $work{'scan_unfinished'};
      $static{'db'}->update( $config{'sql_tresource'}, undef, \%_ );
    }
    #%_ = ( %res, 'ip' => ip_to_name( $url{'host'} ), 'scan' => int( time() ) );
    %_ = ( %res, 'ip' => name_to_ip( $url{'host'} ), 'scan' => int( time() ) );
    $_{'time'} = int( time() ) if $work{'filec'}->( $stat{'files'} );
    $static{'db'}->update( $config{'sql_thost'}, undef, \%_ );
#printlog('dev', 'sizec',  $work{'sizec'}->( $stat{'size'}),$work{'filec'}->( $stat{'files'})  ,$work{'filec'}->( $stat{'dirs'}));
    if ( $work{'sizec'}->( $stat{'size'} ) and ( $work{'filec'}->( $stat{'files'} ) or $work{'filec'}->( $stat{'dirs'} ) ) ) {
      %_ = (
        %res,
        'path' => '',
        'name' => '',
        'ext'  => '',
        'desc' => $work{'desc'}{ $url{'host'} }{ $url{'prot'} },
        'scan' => int( time() )
      );
      $static{'db'}->update( $config{'sql_tfile'}, undef, \%_ );
      #$_{'path'} = '/';
      #$static{'db'}->update( $config{'sql_tfile'}, undef, \%_ );
      #printlog( 'dev', 'cd0', $res{'path'}, $local ? $url_orig : $res{'path'}, Dumper \%res);
      #=z
      update_to_root( %res, %_, $local, $url_orig );
      my $t = $tim->();
      printlog(
        'stat', $url, 'size', $work{'sizec'}->( $stat{'size'} ),
        'files', $work{'filec'}->( $stat{'files'} ),
        'dirs',
        $work{'filec'}->( $stat{'dirs'} ),
        speed( $t, $work{'filec'}->( $stat{'files'} ) )
      );
    }
    #}
  }
};

=del
sub startme {
  my ($start) = @_;
  if ($start) {
#$processor{'out'}{'array'}->();
    my $com =
#"$config{'starter'} $config{'spawn_prefix'} $config{'perl'} $config{'root_path'}crawler.pl $force $start $config{'spawn_postfix'}";
"$config{'starter'} $config{'spawn_prefix'} $^X $0 $force $start $config{'spawn_postfix'}";

    printlog( 'dbg', "starting with $start:", $com );
#printlog( 'dbg', $com );
    system($com);
  }
}
=cut

sub startself {
  my ($start) = @_;
  $static{'db'}->flush_insert();
  #if (defined $start) {
  my $force = "--force=$config{'force'}" if $config{'force'};
  return psmisc::startme( join ' ', $force, $start );
  #}
}
$processor{'urls'} ||= sub {
  my ( $start, @urlproc );
  for (@_) {
    next unless $_;
    if ( !$config{'noscan'} and $config{'spawn'} and /\:\/\// ) { $start .= " $_ "; }
    else                                                        { push( @urlproc, $_ ); }
  }
  startself($start);
  mysleep( $config{'scan_sleep'} );
  $processor{'url'}->(@urlproc) if @urlproc;
};

=c
$processor{'file'}{'sql'}{'func'} ||= sub {
  my $tper = timer();
  for my $datafile ( grep { $_ } @_ ) {
    my $filesize = ( -s ( $datafile or next ) or next );
    printlog(
      'info',
      'Uploading ',
      $datafile,
      " ($filesize bytes) ...", (
        $tper->()
          and $stat{'total_bytes'}
        ? " prognose:" . psmisc::human('time_period', ( $filesize * $tper->() ) / $stat{'total_bytes'} ) . 's'
        : ''
      )
    );
    my $per = timer();
    rename( $datafile, $datafile . '.up' );
    $processor{'out'}{'mysql_file'}->("$datafile.up");
    rename( $datafile . '.up', $datafile . '.ok' );
    $stat{'total_bytes'} += $filesize;
    printlog(
      'time',
      " done per ",
      $per->(),
      " sec ",
      $per->() ? 'at ' . ( $filesize / $per->() ) . ' b/s ' : '',
      "[total $stat{'total_bytes'} bytes per ",
      psmisc::human('time_period', $tper - () ),
      " sec ",
      ( $tper->() ? 'at ' . int( $stat{'total_bytes'} / $tper->() ) : '' ),
      ' b/s]',
    );
  }
};
=cut

sub dcscanned {
  local %_ = ref $_[0] ? %{ $_[0] } : ( cid => $_[0] );
  #$static{'db'}->line
  $static{'db'}->query( $config{'sql'}{'table'}{ $config{'sql_tresource'} }{'cid'}
    ? qq{SELECT * FROM $tq$config{'sql_tresource'}$tq WHERE ${rq}cid${rq}=} . $static{'db'}->quote( $_{'cid'} ) . qq{ LIMIT 1}
    : qq{SELECT * FROM $tq$config{'sql_tfile'}$tq WHERE ${rq}tiger${rq}=}
      . $static{'db'}->quote( $_{'cid'} )
      . qq{ AND ${rq}path${rq}=${vq}${vq} LIMIT 1} )->[0];
}
#!!! TODO : gz tgz
$processor{'file'}{'bz2'}{'func'} ||= sub {
  my $tper = timer();
  $processor{'file'}{'xml'}{'func'}->(@_), return if $config{'direct_unzip'};
  for my $datafile ( grep { $_ } @_ ) {
    #my $filesize = -s $datafile;
    my $filesize = -s ( $datafile || next );
    unless ($filesize) {
      prinlog( 'no fs', $datafile );
      rename( $datafile, $datafile . '.ok' );
      next;
    }
    printlog(
      'info',
      'Extracting ',
      $datafile,
      " ($filesize bytes) ...", (
        $tper->() and $stat{'total_bytes'} ? " prognose:" . int( ( $filesize * $tper->() ) / $stat{'total_bytes'} ) . 's' : ''
      )
    );
    my $per = timer();
    shelldata($datafile);
    printprog( "$config{'bzip2'} $config{'bzip2_uncompress'} \"$datafile\"", 1 );
    rename( $datafile, $datafile . '.ok' );
    $stat{'total_bytes'} += $filesize;
    printlog(
      'time',
      " done per ",
      $per->(),
      " sec ",
      $per->() ? 'at ' . ( $filesize / $per->() ) . ' b/s ' : '',
      "[total",
      psmisc::human( 'size', $stat{'total_bytes'} ),
      "bytes per",
      psmisc::human( 'time_period', $tper->() ),
      ' ',
      ( $tper->() ? 'at ' . int( $stat{'total_bytes'} / $tper->() ) : '' ),
      ' b/s]',
    );
  }
};
$processor{'file'}{'xml'}{'func'} ||= sub {    #dc++
  our $tper ||= timer();
  my ( %url, %files );
  $url{'prot'} = 'dchub';
  for my $datafile ( grep { $_ } @_ ) {
    last if scan_stop;
    my $datafilebug = $datafile;
    my $per         = timer();
    #my $filesize    = -s $datafile;
    my $filesize = ( -s ( $datafile or next ) or next );
    my $files;
    my $scan = int( $^T - 86400 * -M $datafile );
    #int( time() )
    printlog(
      'dc',
      'Parsing ',
      $datafile,
      " ($filesize bytes) ...", (
        $tper->() and $stat{'total_bytes'} ? " prognose:" . int( ( $filesize * $tper->() ) / $stat{'total_bytes'} ) . 's' : ''
        )
        #, 'scan=', $scan, ' now=', int(time()), ' mdf=' , ( -M $datafile ) * 86400
    );
    rename( $datafile, $datafile . '.up' );
    on_interrupt(
      sub {
        rename( $datafile . '.up', $datafile );
        filesave( \%files );
        %files = ();
      }
    );
    #printlog('dev', "tryop[$datafile]");
    #local @_ = ;
    my $cpdata = {};
    my $fh;
    if (
      #open ((),@_)
      $datafile =~ /\.xml\.bz2$/i
      ? open( $fh, '-|' . ':encoding(utf-8)', qq{$config{'bzip2'} $config{'bzip2_uncompress'}c "$datafile.up"} )
      : open( $fh, '<' . ':encoding(utf-8)',  "$datafile.up" )
      #open($fh, ($datafile =~ /\.xml\.bz2$/i
      #? ('-|' . ':encoding(utf-8)', , qq{$config{'bzip2'} $config{'bzip2_uncompress'}c "$datafile.up"})
      #: ('<' . ':encoding(utf-8)', "$datafile.up") ))
      )
    {
      my @dir;
      my $path = '/';
      %url = ( %url, 'port' => '', split_url( $work{'current_dchub'} ) );    #clean port of prev iteration
      #$url{'dcuser'} = cp_trans( $config{'cp_shell'}, $config{'cp_db'}, decode_url($datafile) );
      #eval {
      $url{'dcuser'} = Encode::decode 'utf-8', decode_url($datafile), Encode::FB_DEFAULT;
	#};
      printlog( 'err', 'cant decode ', $datafile, decode_url($datafile) ), rename( $datafile . '.up', $datafile . '.err' ), next
        if $@;
      $url{'dcuser'} =~ s/\.xml(\.bz2)?$//i;
      $url{'dcuser'} =~ s{^.+(\\|/)}{}i;
      my $url = join_url( \%url );
      $url{'host'} = full_host( \%url );
      my %time =
        ( hconfig( 'unknown_time', $url{'host'} ) ne ''
        ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
        : () );
      ( $work{'sizec'}, $work{'filec'}, $work{'dirc'} ) =
        ( counter( $stat{'size'} ), counter( $stat{'files'} ), counter( $stat{'dirs'} ) );
      local $/ = '<';
      my $decoder = sub {
        $_ = HTML::Entities::decode_entities($_);
        #printlog('decoder');
        }
        if psmisc::use_try 'HTML::Entities';
      my $cid;
      while (<$fh>) {
        last if $work{'die'};
        #if ( my ( $file, $size, $tiger ) = /^File Name="([^"]+)" Size="(\d+)" TTH="([^"]+)"/i ) {
        local %_;
        #$_ = HTML::Entities::decode_entities_old $_;
        #$_ = HTML::Entities::decode_entities $_;
        psmisc::code_run $decoder;
        #psmisc::cp_detect_trans($_, $cpdata, 'utf-8', 'utf-8'); #some filelist not in utf
        s/^(\w+)\s//;
        my ($w) = lc($1);
        s/(\w+)="([^"]+)"/$_{lc$1}=$2;''/eg;    #"
        #printlog 'dev', "s: [$w]", Dumper  \%_;
        #if ( /^File Name="([^"]+)" Size="(\d+)" TTH="([^"]+)"/i ) {
        if ( $w eq 'file' and length $_{name} ) {
          #printlog('dev','1', $config{'cp_dc_list'}, $config{'cp_db'}, $_{name});
          local $_ = $_{name};                  # = cp_trans( $config{'cp_dc_list'}, $config{'cp_db'}, $file );
          #printlog('dev','2', $config{'cp_dc_list'}, $config{'cp_db'}, $file);
          my ($ext) = ( $_{name} =~ s/\.([^\.]+)$// ? ($1) : ('') );
          $_{meta} = join ' ', map { qq{$_="$_{$_}"} } grep { $_{$_} } qw(br hit);
  #my %meta;
  #my @k = sort grep {$_ ne qw(name size ) , ($config{'sql'}{'table'}{ $config{'sql_tfile'} }{'tiger'} ? () : ('tth'))} keys %_;
          $files{ $path . '/' . $_ } = {
            %url, %_,
            'path' => $path,
            #'name' => $_{name},
            'ext'  => $ext,
            'size' => int $_{size},
            'time' => int $_{ts},
            %time, (
              $config{'sql'}{'table'}{ $config{'sql_tfile'} }{'tiger'}    #{'array_insert'}
              ? ( 'tiger' => $_{tth} )
              : ( 'desc' => 'tiger=' . $_{tth} )
            ),
            'scan' => $scan
          };
          ++$stat{'total_files'};
          ++$files;
          #} elsif ( my ($file) = /^Directory Name="([^"]+)">/i ) {    #"
        } elsif ( $w eq 'directory' and length $_{name} ) {
          local $_ = $_{name};    # = cp_trans( $config{'cp_dc_list'}, $config{'cp_db'}, $file );
          push( @dir, $_{name} );
          my ($ext) = ( $_{name} =~ s/\.([^\.]+)$// ? ($1) : ('') );
          $files{ $path . '/' . $_ } = { %url, 'path' => $path, 'name' => $_{name}, 'ext' => $ext, %time, 'scan' => $scan };
          $path = ( join( '/', @dir ) or '/' );
          #printlog 'dev', 'dir start', "[$_]", $path, 'd=', @dir;
        } elsif (m|^/Directory>|i) {
          #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%files );
          #printlog 'saving', Dumper \%files;
          filesave( \%files );
          %files = ();
          #printlog 'dev', 'dir end', "[$_]",$path,  'd=',  @dir;
          pop(@dir);
          $path = join( '/', @dir ) || '/';
          #} elsif (/^FileListing .*Base="([^"]+)"/i) {                #"mc
        } elsif ( $w eq 'filelisting' and length $_{base} ) {
          my $last;
          $cid //= $_{cid} if $_{cid};
          my $already;
          if ( $_{cid} and $config{'use_dc'} and !$config{'use_dc_user_dupes'} ) {
            #printlog 'Cur', Dumper #$static{'db'}->select($config{'sql_tfile'}, {'tiger'=>$_{'cid'}, 'path'=>''});
            $already = dcscanned( \%_ );
            #printlog 'cid', $_{cid}, Dumper $already, $config{'dcbot_client_period'}, time - $already->{scan}, $scan ;
            #;
            if (  ( $already->{tiger} or $already->{cid} )
              and ( time - $already->{scan} < $config{'dcbot_client_period'} or $scan < $already->{scan} ) )
            {
              printlog(
                'info', 'skipping already scanned ',
                $url, 'as', join_url($already),
                psmisc::human( 'time_period', time - $already->{scan} ),
                $config{'dcbot_client_period'},
              );
              #printlog('warn', 'not uploading');
              rename( $datafile . '.up', $datafile . '.ok' );
              $last = 1;
            }
          }
          @dir = ( $_{base} eq '/' ? '' : $_{base} );
          $path = join( '/', @dir ) || '/';
          my $save = {
            %url, (
              hconfig( 'unknown_time', $url{'host'} ) ne ''
              ? ( 'time' => int( time() ) - hconfig( 'unknown_time', $url{'host'} ) )
              : ()
            ),
            'scan' => $scan
          };
          #%_ = ( '' => { %$_, 'desc' => $_{'generator'}, 'tiger' => $_{'cid'}, }, ' ' => { %$_, 'path' => '/' }, );
          #$static{'db'}->insert_hash_hash( $config{'sql_tfile'}, \%_ );
          #filesave( \%_ );
          my @replace = qw(prot host port dcuser);
          my %meta = ( 'meta' => 'link=' . encode_url( join_url($already) ) );
          for ( 0 .. 1 ) {
            filesave( {
                '' => { %meta, %$save, 'desc' => $_{'generator'}, 'tiger' => ( $_{'cid'} || $_{'tiger'} ), },
                ' ' => { %meta, %$save, 'path' => '/' },
              }
            );
            last unless psmisc::is_hash_size $already;
            %meta = ();
            printlog(
              'info', 'saving already scanned',
              $url, 'at', psmisc::human( 'time_period', time - $already->{'scan'} ),
              'as', join_url($already)
            ) if !$_ and !$last;
            $url{$_} = $save->{$_} = $already->{$_} for @replace;
            $url{'host'} = full_host( \%url );
          }
          last if $last;
        }
      }
      close($fh);
      on_interrupt();
      #filesave( \%files ); %files = ();
      %_ = (
        %url,
        'scan'  => $scan,
        'files' => $work{'filec'}->( $stat{'files'} ),
        'dirs'  => $work{'dirc'}->( $stat{'dirs'} ),
        'size'  => $work{'sizec'}->( $stat{'size'} ),
        ( !$cid ? () : ( 'cid' => $cid ) ),
      );
      $_{'time'} = $scan if $work{'filec'}->( $stat{'files'} );
      $static{'db'}->update( $config{'sql_tresource'}, undef, { %_, %{ $config{'clear_file'} || {} } } );
    }
    rename( $datafilebug . '.up', $datafilebug . '.ok' );
    $stat{'total_bytes'} += $filesize;
    printlog(
      'time',
      " done per ",
      psmisc::human( 'time_period', $per->() ),
      ,
      $per->()
      ? 'at ' . psmisc::human( 'float', $filesize / $per->() ) . ' bps ' . psmisc::human( 'float', $files / $per->() ) . ' fps '
      : '',
      "[total $stat{'total_bytes'} bytes $stat{'total_files'} files per ",
      psmisc::human( 'time_period', $tper->() ),
      ' ', (
        $tper->()
        ? 'at ' . int( $stat{'total_bytes'} / $tper->() ) . ' bps  ' . int( $stat{'total_files'} / $tper->() ) . ' fps'
        : ''
      ),
      ' ]',
    );
  }
};
$processor{'file'}{'toscan'}{'func'} ||= sub {
  local $config{'force'} = 1;
  for my $datafile ( grep { $_ } @_ ) {
    my $url = ( $datafile or next );
    $url =~ s{^.+(\\|/)}{}i;
    $url =~ s/\.toscan$//i;
    $url = decode_url($url);
    local $config{'ftp_recurse_force'} = 1;
    resetcounters();
    $processor{'prot'}{'ftp'}{'func'}->($url);
  }
};
for ( keys %{ $processor{'format'} } ) {
  $processor{'file'}{$_}{'func'} ||= sub {
    for my $datafile ( grep { $_ } @_ ) {
      rename( $datafile, $datafile . '.up' );
      open( F, '<', $datafile . '.up' ) or next;
      $datafile =~ s/.$_$//i;
      $processor{'format'}{$_}->( $datafile, \*F );
      close(F);
      rename( $datafile . '.up', $datafile . '.ok' );
    }
  };
}
$processor{'file'}{'url'}{'func'} ||= sub {
  for my $datafile ( grep { $_ } @_ ) {
    #printlog('dev', "LOAD:$datafile");
    open( my $fh, ( ( $datafile eq '-' ) ? ($datafile) : ( '<', $datafile ) ) ) or next;
    $processor{'url'}->(<$fh>);
    close($fh);
  }
};
$processor{'file'}{'config'}{'func'} = $processor{'file'}{'hublist'}{'func'} ||= sub {
  local $config{'host_by_name_norm'} = 0;
  for my $datafile ( grep { $_ } @_ ) {
    $datafile = uni_get($datafile);
    next
      unless (
      open(
        my $fh, (
            ( $datafile eq '-' )
          ? ($datafile)
          : ( $datafile =~ /\.xml\.bz2$/i ? "$config{'bzip2'} $config{'bzip2_uncompress'}c \"$datafile\"|" : '<' . $datafile )
        )
      )
      );
    printlog( 'dc', 'hublist: loading', $datafile );
    while (<$fh>) {
      #printlog ('dev', $_);
      if (m|^\s*<Hub\s.*?Address="\s*(\w+://)?([^:/"]+):?(\d*)\s*"|i) {    #"mc
        #printlog ('dev', $_);
        my %url = ( 'prot' => 'dchub' );
        $processor{'url'}->(
          ( $1 || $url{'prot'} . '://' ) . $2 . ( $3 and $3 != $config{'scanner'}{ $url{'prot'} }{'port'} ? ':' . $3 : '' ) );
        ++$stat{'hublist'};
      }
    }
    close($fh);
  }
};
$processor{'file'}{'list'}{'func'} ||= sub {
  local $config{'host_by_name_norm'} = 0;
  for my $datafile ( grep { $_ } @_ ) {
    $datafile = uni_get($datafile);
    next unless ( open( my $fh, ( ( $datafile eq '-' ) ? ($datafile) : ( '<', $datafile ) ) ) );
    printlog( 'dc', 'hub .list: loading', $datafile );
    while (<$fh>) {
      if (m{^\s*([^:/\|]+):?(\d*)\s*\|}i) {
        my %url = ( 'prot' => 'dchub' );
        $processor{'url'}->( 'dchub://' . $1 . ( $2 and $2 != $config{'scanner'}{ $url{'prot'} }{'port'} ? ':' . $2 : '' ) );
        ++$stat{'list'};
      }
    }
    close($fh);
  }
};
$processor{'file'}{'ok'}{'func'} ||= sub { unlink(@_) unless $config{'keep_ok'} or $config{'debug'}; };
$processor{'file'}{'partial'}{'func'} ||= sub {
  #printlog( 'pt', "$_", 86400 * -M $_ ) for @_
  unlink( grep { 3600 < 86400 * -M $_ } @_ ) unless $config{'keep_ok'} or $config{'debug'};
};
$processor{'file'}{'up'}{'func'} ||= sub {
  #printlog( 'pt', "$_", 86400 * -M $_ ) for @_
  unlink( grep { 7 < -M $_ } @_ ) unless $config{'debug'};
};
$processor{'file'}{'dchub'}{'func'} ||= sub {
  for my $datadir ( grep { $_ and -d } @_ ) {
    $work{'current_dchub'} = $datadir;
    $work{'current_dchub'} =~ s{^.*[/\\]}{}ig;
    $work{'current_dchub'} = $1 . '://' . $work{'current_dchub'} if $work{'current_dchub'} =~ s{\.((?:dchub|adc))$}{}ig;
    $work{'current_dchub'} =~ s/\.(\d+)$/:$1/
      if $work{'current_dchub'} =~ /(\d+\.){4}(\d+)$/
        or $work{'current_dchub'} =~ /\D\.(\d+)$/;
    printlog( 'dbg', "dir:", $datadir, " hub:$work{'current_dchub'}" );
    local $config{'del_empty_dir'} = $config{'del_empty_dcdir'};
    $processor{'dir'}->($datadir);
  }
  #$processor{'out'}{'array'}->();
  $static{'db'}->flush_insert();
};
$processor{'file'}{'adc'}{'func'}  ||= $processor{'file'}{'dchub'}{'func'};
$processor{'file'}{'adcs'}{'func'} ||= $processor{'file'}{'dchub'}{'func'};
$processor{'file'}{'ldi'}{'func'}  ||= sub {
  my $table = $config{'sql_tfile'};
  for my $datafile ( grep { $_ } @_ ) {
    rename( $datafile, $datafile . '.up' );
    my $mydatafile = $datafile;
    $mydatafile =~ s!\\+|/+!$config{'slash_mysql'}!g;
    next if !$mydatafile or !-s $mydatafile . '.up';
    #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
    $static{'db'}->do(
"LOAD DATA $static{'db'}->{'LOW_PRIORITY'} LOCAL INFILE '$mydatafile.up' REPLACE INTO TABLE $config{'sql_tfile'} FIELDS OPTIONALLY ENCLOSED BY \"'\" ("
        . join(
        ',',
        map( "$rq$_$rq", (
            sort { $config{'sql'}{'table'}{$table}{$b}{'order'} <=> $config{'sql'}{'table'}{$table}{$a}{'order'} }
            grep( $config{'sql'}{'table'}{$table}{$_}{'array_insert'}, keys %{ $config{'sql'}{'table'}{$table} } )
          ) )
        )
        . ")"
    );
    rename( $datafile . '.up', $datafile . '.ok' );
  }
};
$processor{'dir'} ||= sub {
  for my $dir (@_) {
    printlog( 'info', "uploading [$dir]" );
    $dir .= $config{'slash_perl'} if $dir and !( $dir =~ /[\/\\]$/ );
    #printlog( 'dev', "dir: [$dir]:",<$dir*.$_>, <$dir.*.$_> );
    #!!! READDIR HERE
    for my $type ( shuffle( keys %{ $processor{'file'} } ) ) {    #!!!!SORT
      #$processor{'file'}{$_}{'func'}->( @{ shuffle( [ <$dir*.$_>, <$dir.*.$_> ] ) } )
      next if ref $processor{'file'}{$type}{'func'} ne 'CODE' or $processor{'file'}{$type}{'disabled'};    #and @dir;
      last if scan_stop;
      my @files = shuffle( <$dir*.$type>, <$dir.*.$type> );
      $processor{'file'}{$type}{'func'}->(
        grep {
#printlog('dev', 'dt', $_, int(time), int( $^T - 86400 *  -M $_   ), psmisc::human('time_period', time - $^T +  86400 * -M $_   ));
          $_ and time - $^T + 86400 * -M $_ > $processor{'file'}{$type}{'purge'} || $config{'purge'}
        } @files
      );
      unlink for grep { !-s } @files;
      #my $scan = int( $^T - ( -M $datafile ) * 86400 );
    }
    my @dir = grep { !m{/\.\.?$} } <$dir*>, <$dir.*>;
    #printlog 'D', Dumper \@dir;
    printlog( 'dbg', "deleted empty $dir:", ( rmdir($dir) or $! ) ) if $config{'del_empty_dir'} and !@dir;
  }
  $static{'db'}->flush_insert();
  #$processor{'out'}{'array'}->();
};
#{
#my ( $current, $order );
#sub newcurrent { $program{ $current = $_[0] }{'order'} ||= $order += 10; }            #v2
#}
$program{ psmisc::program('init') }{'force'} = 1;
$program{ psmisc::program() }{'func'} ||= sub {
  printlog(
    'info', "Started with [",
    $^X, $work{'$0'}, join ' ',
    map( $_ . ( ( $param->{$_} ne '' and $param->{$_} != 1 ) ? "=$param->{$_}" : '' ), sort keys %$param ),
    "] version:", ( $config{'version'} or 'r' . ( split( ' ', '$Revision: 4843 $' ) )[1] )
    )
    if    # $param and
    %$param and !$config{'nolog_startstop'};
  mkdir_rec( $config{'datadir'}, 0777 );
  mkdir_rec( $config{'tmpdir'},  0777 );
#later  $config{'sql_mysqlopt'} = ( $config{'sql_host'} ? ' -h ' . $config{'sql_host'} : ' ' ) . ' ' . $config{'sql_mysqlopt'} . ' ';
  $static{'banned'} = { loadlist( $config{'file_banned'} ), %{ $config{'banned'} || {} } };
#if ( ref $config{'sql_base_up'} eq 'HASH' ) {    $config{'sql'}{$_} = $config{'sql_base_up'}{$_}      for keys %{ $config{'sql_base_up'} };
#} else {    $config{'sql'}{'database'} = $config{'sql_base_up'};  }
  $work{'cp_input'} = $config{'cp_shell'};
  psmisc::lib_init();
  $config{'sql'}{'codepage'} ||= $config{'cp_db'} if $config{'cp_db'};
  unless ( keys %$param ) {
    printlog( 'info',
          'Short usage: '
        . ( $work{'$0'} || $0 )
        . ' [install] [file.to.load] [ftp://res.to.scan] [proc[=3]] [--configparam=value] [--sql__configparam=value]' );
  }
  return 0;
};
$program{ psmisc::program('db') }{'force'} = 1;
$program{ psmisc::program() }{'func'} ||= sub {
  #END {printlog('WOW1', $static{'db'}->{'dbh'});};
  #printlog 'dev', "user0:", $static{'db'}, $config{'sql'}{user}, $config{'sql_base_up'}{user};
  #printlog 'dev', 'U', Dumper $config{'sql_base_up'};
  $static{'db'} ||= pssql->new(
    #'codepage'        => $config{'cp_db'},
    'handler_insert0' => sub {
      my ( $self, $table, $hash ) = @_;
      #printlog('dev', 'handler_insert0', @_);
      if ( $table eq $config{'sql_tfile'} ) {    #TODO CONFIGURABLE

=old
        if (  !$self->{'use_dbi'}
          and $work{'current_output_file'} ne $hash->{$_}{'host'}
          and $hash->{'host'} )
        {
          $work{'current_output_file'} = $hash->{'host'};
          open_out_file( $work{'current_output_file'} );
        }
=cut

        if ( $hash->{'size'} ) {
          ++$stat{'files'};
          $stat{'size'} += $hash->{'size'} if $hash->{'size'} < $config{'max_stat_file_size'};
        } else {
          ++$stat{'dirs'};
        }
      }
    },
    'handler_insert2' => sub {
      my ( $self, $table, $hash ) = @_;
      #printlog('dev', 'handler_insert2', @_);
      $work{'upscanned'} = counter( $stat{'files'} ) unless $work{'upscanned'};
      if (  $work{'filec'}
        and $work{'filec'}->( $stat{'files'} )
        and $work{'upscanned'}->( $stat{'files'} ) > $config{'update_scan_every'} )
      {
        #local $config{'log_dmp'} = 1;
        #printlog('dev', 'on_update update'),
        $work{'upscanned'} = counter( $stat{'files'} );
        #my ($values) = values(%$hash);
        my ($values) = $hash;
        #printlog('dev', 'handler_insert2values:', $values);
        #sql_update(
        my %scantime = ( 'scan' => int( time() ), 'time' => int( time() ) ) if $values->{'prot'} ne 'dchub';
        $self->update(
          $config{'sql_tresource'},
          undef, {
            $self->filter_row( $config{'sql_tresource'}, 'primary', $values ),
            'path' => '',
            #'scan' => int( time() ),
            #'time' => int( time() )
            %scantime
          }
        );
#!!! TODO < BUG !!!
#printlog('dev', 'now=', 'files=',$work{'filec'}->( $stat{'files'} ), 'size=', $work{'sizec'}->( $stat{'size'} ));
#$self->select_log($config{'sql_tresource'}, {$self->filter_row( $config{'sql_tresource'}, 'primary', $values ), 'path'  => '',});
#printlog('dev', 'wherebody=',$self->where_body({'files' => $work{'filec'}->( $stat{'files'} ), 'files_mode'=>'g'}, undef, $config{'sql_tresource'}, ));
        $self->update(
          #sql_update(
          $config{'sql_tresource'},
          undef, {
            $self->filter_row( $config{'sql_tresource'}, 'primary', $values ),
            'path'  => '',
            'files' => $work{'filec'}->( $stat{'files'} ),
            'dirs'  => $work{'dirc'}->( $stat{'dirs'} ),
            'size'  => $work{'sizec'}->( $stat{'size'} )
          },
          $self->where_body(
            { 'files' => $work{'filec'}->( $stat{'files'} ), 'files_mode' => 'l' },
            undef, $config{'sql_tresource'},
            )
            #"$self->{'rq'}files$self->{'rq'} < " . $self->{'vq'} . $work{'filec'}->( $stat{'files'} ) . $self->{'vq'}
        );
        my $h = split_url( $values->{'host'} )->{'host'};
        $self->update(
          #sql_update(
          $config{'sql_thost'},
          undef, {
            $self->filter_row( $config{'sql_thost'}, 'primary', $values ),
            'host' => $h,
            #'ip'   => ip_to_name($h),
            ( $values->{'prot'} eq 'dchub' ? () : ( 'ip' => name_to_ip($h) ) ),
            #'scan' => int( time() ),
            #'time' => int( time() )
            %scantime
          }
        );
      }
    },
    %{ $config{'sql'} || {} },
    ( ref $config{'sql_base_up'} eq 'HASH' ? %{ $config{'sql_base_up'} } : ( 'database' => $config{'sql_base_up'} ) ),
  );
  #END {printlog('WOW2', $static{'db'}->{'dbh'});};
  #printlog 'dev', Dumper $static{'db'};
  #printlog 'dev', "user:", $static{'db'}{user}, $config{'sql'}{user}, $config{'sql_base_up'}{user};
  #printlog 'dev', "u", %{ $config{'sql_base_up'} };
  ( $tq, $rq, $vq ) = $static{'db'}->quotes();
#$processor{'out'}{'array'}->();
#my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
#$static{'db'}->query_log( 'SELECT * FROM ' . ( join ',', map { "$tq$_$tq" } sort keys %{ $config{'sql'}{'table'} } ) . ' WHERE 1 LIMIT 1' )
#use Data::Dumper;
#printlog( 'dev', Dumper($static{'db'}));
  undef;
};
$program{ psmisc::program('start') }{'func'} ||= sub { unlink( $config{'stop_file'} ); -f $config{'stop_file'}; };
$program{ psmisc::program('check') }{'func'} ||= sub {
  printlog( 'info', 'checkset' );
  #$config{'sql'}{'auto_repair'}  = 1;
  #$config{'sql'}{'force_repair'} = 1;
  $static{'db'}->check_data();
  #  for my $table ( $_[1] or keys %{ $static{'db'}{'table'} } ) {
  #    printlog ('check', $table,$static{'db'}->query_log("SELECT * FROM $table LIMIT 1"));
  #  }
};
$program{ psmisc::program('drop') }{'func'} ||= sub {
  @_ = keys %{ $config{'sql'}{'table'} } if !@_;
  printlog( 'info', "Dropping ", @_ );
  #printlog( 'info', "Dropping $static{'db'}->{'table_prefix'} [$_]" ), $processor{'out'}{'mysql'}->( drop_table_sql($_) )
  #for sort grep { $_ and $config{'sql'}{'table'}{$_} } @_;
  $static{'db'}->drop_tables( sort grep { $_ and $config{'sql'}{'table'}{$_} } @_ );
  return 0;
};
$program{ psmisc::program('dropdb') }{'func'} ||= sub {
  @_ = $config{'sql'}{'database'} if !@_;
  printlog( 'info', "Dropping ", @_ );
  #printlog( 'info', "Dropping $static{'db'}->{'table_prefix'} [$_]" ), $processor{'out'}{'mysql'}->( drop_table_sql($_) )
  #for sort grep { $_ and $config{'sql'}{'table'}{$_} } @_;
  $static{'db'}->drop_database( sort grep { $_ } @_ );
  return 0;
};
$program{ psmisc::program('install') }{'func'} ||= sub {
  my %bases;
  $bases{ $config{$_} } = $_ for grep { /^sql_base_/ } keys %config;
  $static{'db'}->install( grep { $_ } keys %bases );

=cu
  my ( $tdbi, $tb ) = ( $config{'sql_use_dbi'}, $config{'sql_base'} );
  $config{'sql_use_dbi'} = 0;
  $config{'sql_base'}    = '';
  for ( grep $_, keys %bases ) {
    printlog( 'info', "Creating database '$_' [$bases{$_}]" );
    $processor{'out'}{'mysql'}->(
      "CREATE DATABASE IF NOT EXISTS $_"
        . (
        $config{'sql_default_character_set'}
          and $config{'sql'}{ $config{'sql_driver'} }{'DEFAULT CHARACTER SET'}
        ? " $config{'sql'}{ $config{'sql_driver'} }{'DEFAULT CHARACTER SET'} $config{'sql_default_character_set'}"
        : ''
        )
    );
  }
  ( $config{'sql_base'}, $config{'sql_use_dbi'} ) = ( $tb, $tdbi );
  printlog( 'info', "Creating $static{'db'}->{'table_prefix'} [", ( keys %{ $config{'sql'}{'table'} } ), ']' );
  $processor{'out'}{'mysql'}->( create_table_sql( %{ $config{'sql'}{'table'} } ) );
  $processor{'out'}{'mysql'}->( create_index_sql( %{ $config{'sql'}{'table'} } ) )
    unless $config{'sql'}{ $config{'sql_driver'} }{'index in create table'};
=cut

  printlog( 'info', 'tryweb', `$^X web/index.cgi` );
  `chmod o-rwx tools/rsync_password`;
  return 0;
};
$program{ psmisc::program('index_disable') }{'func'} ||= sub {
  $static{'db'}->index_disable( $config{'sql_tfile'} );
  #my $tim = timer();
  #printlog( 'info', 'Disabling indexes...' );
  #printlog( 'err', 'ALTER TABLE ... DISABLE KEYS available in mysql >= 4' ), return if $config{'sql'}{'driver'} eq 'mysql3';
  #$static{'db'}->query_log("ALTER TABLE $static{'db'}->{'table_prefix'}$config{'sql_tfile'} DISABLE KEYS");
  #printlog( 'time', "Disable index per", psmisc::human( 'time_period', $tim->() ), "sec" );
  return 0;
};
$program{ psmisc::program('upgrade') }{'func'} ||= sub {
  local $config{'sql_base'}        = $config{'sql_base_web'};
  local $config{'sql_error_tries'} = 0;
  local $config{'sql_error_sleep'} = 0;
  printlog( 'info', "Upgrade from $_[0]. dont worry about errors" );
  printlog( 'info', 'Removing very old resource.vote,votelast' ),
    $static{'db'}->do("ALTER TABLE resource DROP `vote`, DROP `votelast`, DROP INDEX votei, DROP INDEX votelasti")
    if $_[0] < 1905;
  printlog( 'info', 'Removing host.votelast' ), $static{'db'}->do("ALTER TABLE host DROP `votelast`, DROP INDEX votelasti"),
    printlog( 'info', 'Adding host voting' ),
    $static{'db'}->do(
"ALTER TABLE host ADD `voteu` INT  NOT NULL  DEFAULT 0, ADD `voted` INT  NOT NULL  DEFAULT 0, ADD INDEX voteui (`voteu`), ADD INDEX votedi (`voted`)"
    ), $static{'db'}->do("ALTER TABLE host ADD `lastip` VARCHAR (15) NOT NULL DEFAULT 0, ADD INDEX lastipi (`lastip`(15))"),
    printlog( 'info', 'Adding top query lastip' ),
    $static{'db'}
    ->do("ALTER TABLE $config{'sql_twordstat'} ADD `lastip` VARCHAR (15) NOT NULL DEFAULT 0, ADD INDEX lastipi (`lastip`(15))"),
    $static{'db'}->do(
    "ALTER TABLE $config{'sql_tquerystat'} ADD `lastip` VARCHAR (15)  NOT NULL  DEFAULT 0, ADD INDEX lastipi (`lastip`(15))")
    if $_[0] < 1933;
  printlog( 'info', '{2618} 0.15.18 -> 0.16.0 (adding port column into host table)' ),
    $static{'db'}
    ->do("ALTER TABLE $config{'sql_thost'} ADD `port` SMALLINT UNSIGNED NOT NULL  DEFAULT 0, ADD INDEX porti (`port`)")
    if $_[0] < 2618;
  printlog( 'info', '{2970} 0.16.1 -> 0.16.2 (adding fulltext query index)' ),
    $static{'db'}->do(
"ALTER TABLE $config{'sql_tquerystat'} ADD FULLTEXT $config{'sql'}{'table'}{$config{'sql_tquerystat'}}{'query'}{'fulltext'} (`query`)"
    ) if $_[0] < 2970 and $config{'sql'}{'table'}{ $config{'sql_tquerystat'} }{'query'}{'fulltext'};
  printlog( 'info', '{3010} 0.16.1 -> 0.16.2 (adding dcuser to filebase and resource)' ),
    $static{'db'}
    ->do("ALTER TABLE `$config{'sql_tfile'}` ADD `dcuser` VARCHAR( 30 ) NOT NULL AFTER `host`, ADD INDEX dcuseri (`dcuser`)"),
    $static{'db'}->do(
    "ALTER TABLE `$config{'sql_tresource'}` ADD `dcuser` VARCHAR( 30 ) NOT NULL AFTER `host`, ADD INDEX dcuseri (`dcuser`)"),
    $static{'db'}->do(
"ALTER TABLE `$config{'sql_tfile'}` DROP PRIMARY KEY , ADD PRIMARY KEY ( `prot` , `host` , `path` , `name` , `ext` , `dcuser` )"
    ),
    $static{'db'}
    ->do("ALTER TABLE `$config{'sql_tresource'}` DROP PRIMARY KEY , ADD PRIMARY KEY ( `prot` , `host` , `path` , `dcuser` )"),
    if $config{'use_dc'} and $_[0] < 3010;
  printlog( 'info', '{3120} 0.16.1 -> 0.16.2 (adding voting to filebase)' ),
    $static{'db'}->do(
"ALTER TABLE `$config{'sql_tfile'}` ADD `voteu` INT  UNSIGNED NOT NULL  DEFAULT '0' , ADD `voted` INT  UNSIGNED NOT NULL  DEFAULT '0' , ADD `lastip` VARCHAR (15)  NOT NULL  DEFAULT '' , ADD INDEX voteui (`voteu`), ADD INDEX votedi (`voted`), ADD INDEX lastipi (`lastip`(15))"
    ),
    if $_[0] < 3120;

  if ( $_[0] < 3939 ) {
    printlog( 'info', '{3939} 0.17.2 -> 0.18.0 (adding added to filebase)' ),
      $static{'db'}->do("ALTER TABLE `$config{'sql_tfile'}` ADD `added` INT  UNSIGNED NOT NULL  DEFAULT '0'");
    printlog( 'info', '{3939} 0.17.2 -> 0.18.0 (adding stem to filebase)' ),
      $static{'db'}->do("ALTER TABLE `$config{'sql_tfile'}` ADD `stem` VARCHAR (128)  NOT NULL  DEFAULT ''"),
      printlog( 'info', '{3939} 0.17.2 -> 0.18.0 (adding stem index to filebase)' ),
      $static{'db'}->do("ALTER TABLE `$config{'sql_tfile'}` ADD FULLTEXT `stemi` (`stem`)"),
      printlog( 'info', '{3939} 0.17.2 -> 0.18.0 (adding stem to querystat)' ),
      $static{'db'}->do("ALTER TABLE `$config{'sql_tquerystat'}` ADD `stem` VARCHAR (128)  NOT NULL  DEFAULT ''"),
      printlog( 'info', '{3939} 0.17.2 -> 0.18.0 (adding stem index to querystat)' ),
      $static{'db'}->do("ALTER TABLE `$config{'sql_tquerystat'}` ADD FULLTEXT `stemi` (`stem`)"),
      if $config{'use_stem'};
  }
  #
  if ( $_[0] < 4617 ) {
    if ( $config{'use_dc'} ) {
      printlog( 'info', '{4617} 0.19.1 -> 0.19.2 (dc: CID on resource table)' ), $static{'db'}
        ->do("ALTER TABLE `$config{'sql_tresource'}` ADD  `cid` VARCHAR (39)  NOT NULL  DEFAULT '', ADD INDEX `cid_i` (`cid`)");
    }
  }
  if ( $_[0] < 4775 ) {
    printlog( 'info', '{4775} 0.19.1 -> 0.19.2 (ranges,host: more stat)' );
    $static{'db'}->do(
"ALTER TABLE `$config{'sql_tranges'}` ADD  `meta` VARCHAR ($config{'sql'}{'table'}{$config{'sql_tranges'}}{'meta'}{'length'})  NOT NULL  DEFAULT ''"
    );
    $static{'db'}->do(
"ALTER TABLE `$config{'sql_thost'}` ADD  `meta` VARCHAR ($config{'sql'}{'table'}{$config{'sql_thost'}}{'meta'}{'length'})  NOT NULL  DEFAULT ''"
    );
  }
  # $Id: crawler.pl 4843 2013-08-14 12:17:58Z pro $#
  $program{$_}{'upgrade'}->(@_) for grep { ref $program{$_}{'upgrade'} eq 'CODE' } keys %program;
  psmisc::program_one('install');
};
$program{ psmisc::program('repair') }{'func'} ||= sub {
  printlog( 'warn', 'repair locked', @_ ), return if !psmisc::lock( 'repair_' . ( join '-', @_ ), { timeout => 1 } );
  $static{'db'}->repair(@_);
};
$program{ psmisc::program('purge') }{'func'} ||= sub {
  my ($purge) = ( $_[0] =~ /(\d+)/ ? $1 : $config{'purge_by'} );
  my ( $cut, $timr, $total, $now ) = ( int( time() ), timer() );
  printlog( 'info', "Purging tables (by $purge). cut =", psmisc::human( 'date_time', $cut -= $config{'purge'} ), $_[2] );
  local $config{'nav_all'} = 1;
  for my $table ( $_[1] or grep { $config{'sql'}{'table_param'}{$_}{'purge'} } keys %{ $config{'sql'}{'table'} } ) {
    #printlog('dev', 'pg', $config{'sql'}{'table_param'}{$table}{'purge'});
    for my $i ( 1 .. $config{'purges'} ) {
      my $timl = timer();
      $total += (
        $now = $static{'db'}->do(
          "DELETE $static{'db'}->{'LOW_PRIORITY'} FROM $tq$static{'db'}->{'table_prefix'}$table$tq " . $static{'db'}->where( {
              $config{'sql'}{'table_param'}{$table}{'purge'} . ''      => $cut,
              $config{'sql'}{'table_param'}{$table}{'purge'} . '_mode' => '<',
              #'glueg1'                                                  => 'or',
              #$config{'sql'}{'table_param'}{$table}{'purge'} . '1'       => 0,
              (
                  ( !$config{'sql'}{'table'}{$table}{'scan'} or $config{'sql'}{'table_param'}{$table}{'purge'} eq 'scan' )
                ? ()
                : ( 'scan' . '1' => 0, 'glueg1' => 'and', 'scan' . '_mode1' => '!', )
              ),
            },
            undef,
            $table
            )
            . " $_[2]"
            . ( $static{'db'}->{'no_delete_limit'} ? () : " LIMIT $purge" )
        )
      );
      local $_ = $timl->();
      printlog(
        'info',
        "purge $table pass $i of $config{'purges'}, $now records purged ($total total) per",
        psmisc::human( 'time_period', $_ ),
        ',', psmisc::human( 'float', $now / ( $_ || 1 ) ), 'fps'
      );
      last if $now < $purge;
      mysleep( $config{'purge_sleep'} ) if $config{'purge_sleep'};
    }
  }
  printlog(
    'time',
    "Purged $total records per",
    psmisc::human( 'time_period', $timr->() ),
    ' (', ( $timr->() > 0 ? psmisc::human( 'float', $total / $timr->() ) : '?' ),
    ' fps)'
  );
  return $total;
};
$program{ psmisc::program('delhost') }{'func'} ||= sub {
  return unless $_[0];
  my ($purge) = ( $config{'purge_by'} );
  my ( $tfiles, $files, $rec );
  my $timr = timer();
  printlog( 'info', "delhost $_[0] (by $purge)." );
  my $purges = ( $param->{'purges'} or 10000 );
  for my $i ( 1 .. $purges ) {
    my $timl = timer();
    $tfiles += (
      $files =
        #$processor{'out'}{'mysql'}
        $static{'db'}->do(
"DELETE $static{'db'}->{'LOW_PRIORITY'} FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tfile'}$tq WHERE ${rq}host${rq} LIKE ${vq}$_[0]${vq} LIMIT $purge"
        )
    );
    printlog( 'info', "pass $i/$purges, $files files deleted, (total $tfiles) per", psmisc::human( 'time_period', $timl->() ) );
    mysleep( $config{'purge_sleep'} ) if $config{'purge_sleep'};
    last if $files < $purge;
  }
  $tfiles +=
    $static{'db'}->do(
    "DELETE $static{'db'}->{'LOW_PRIORITY'} FROM $tq$static{'db'}->{'table_prefix'}$_$tq WHERE ${rq}host${rq} = ${vq}$_[0]${vq}"
    ) for ( $config{'sql_thost'}, $config{'sql_tresource'} );
  printlog(
    'time',
    "Deleted $tfiles files and $rec records per",
    psmisc::human( 'time_period', $timr->() ),
    'sec (', psmisc::human( 'float', $timr->() > 0 ? $tfiles / $timr->() : '?' ),
    ' fps)'
  );
};
$program{ psmisc::program('deldead') }{'func'} ||= sub {
  my $rec;
  $rec +=
    $static{'db'}->do(
"DELETE $static{'db'}->{'LOW_PRIORITY'} FROM $tq$static{'db'}->{'table_prefix'}$_$tq WHERE ${rq}scan${rq} AND ! ${rq}time${rq} AND ! ${rq}files${rq} AND ! ${rq}dl${rq} AND ! ${rq}added${rq}"
    ) for ( $config{'sql_tresource'} );    #, $config{'sql_thost'}
  $rec +=
    $static{'db'}->do(
"DELETE $static{'db'}->{'LOW_PRIORITY'} FROM $tq$static{'db'}->{'table_prefix'}$_$tq WHERE ! ${rq}files${rq} AND ! ${rq}dl${rq} AND ! ${rq}added${rq} AND ! ${rq}voteu${rq} AND ! ${rq}voted${rq} AND ! ${rq}lastip${rq}"
    )                                      # ${rq}scan${rq} AND ! ${rq}time${rq} AND
    for ( $config{'sql_thost'} );
  printlog( 'info', "Deleted  $rec records" );
};
$program{ psmisc::program('reset_dead') }{'func'} ||= sub {
  my $rec;
  $rec +=
    $static{'db'}->do(
"UPDATE $tq$static{'db'}->{'table_prefix'}$_$tq SET ${rq}scan${rq} = ${vq}0${vq}, ${rq}time${rq} = ${vq}0${vq} WHERE ! ${rq}files${rq}"
    ) for ( $config{'sql_tresource'} );    #, $config{'sql_thost'}
  printlog( 'info', "Updated $rec records" );
};
$program{ psmisc::program('reset_res') }{'func'} ||= sub {
  local $_;
  printlog(
    'info',
    'reset_res:',
    $_ = $static{'db'}->do(
"UPDATE $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq SET ${rq}scan${rq} = ${vq}0${vq}, ${rq}time${rq} = ${vq}0${vq}"
    )
  );
  return $_;
};
$program{ psmisc::program('reset_res_bug') }{'func'} ||= sub {
  printlog(
    'info',
    'reset_res:',
    $static{'db'}->do(
"UPDATE $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq SET ${rq}scan${rq} = ${vq}0${vq}, ${rq}time${rq} = ${vq}0${vq} WHERE ${rq}scan${rq} > $vq"
        . int( time() )
        . $vq
    )
  );
};
$program{ psmisc::program('reset_range') }{'func'} ||= sub {
  printlog(
    'info',
    'reset_range:',
    $static{'db'}->do(
"UPDATE $tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq SET ${rq}scan${rq} = ${vq}0${vq}, ${rq}time${rq} = ${vq}0${vq}"
    )
  );
};
$program{ psmisc::program('reset_range_bug') }{'func'} ||= sub {
  printlog(
    'info',
    'reset_range:',
    $static{'db'}->do(
"UPDATE $tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq SET ${rq}scan${rq} = ${vq}0${vq}, ${rq}time${rq} = ${vq}0${vq} WHERE ${rq}scan${rq} > $vq"
        . int( time() )
        . $vq
    )
  );
};
$program{ psmisc::program('reset_period') }{'func'} ||= sub {
  my $rec;
  $rec += $static{'db'}->do("UPDATE $tq$static{'db'}->{'table_prefix'}$_$tq SET ${rq}period${rq} = ${vq}0${vq} ")
    for ( $config{'sql_tresource'}, $config{'sql_tranges'} );    #, $config{'sql_thost'}
  printlog( 'info', "Updated $rec records" );
};
$program{ psmisc::program('skip') }{'func'} ||= sub { $static{'banned'}->{ $_[0] } = 1; };
$program{ psmisc::program('file') }{'func'} ||= sub {
  printlog( 'info', 'loading file', $_[0] );
  $processor{'file'}{'url'}{'func'}->( uni_get( $_[0] ) );
};
$program{ psmisc::program('ipdig') }{'func'} ||= sub {
  my %dig;
  for my $file (@_) {
    printlog( 'info', 'founding ips in', $file );
    open( IF, ( ( $file eq '-' ) ? ($file) : ( '<', uni_get($file) ) ) ) or printlog( 'err', 'unable to open' ), return;
    while (<IF>) {
      s/<.+?>//g if $file =~ /^http/;
      for my $name (m!(?:\W|^)($config{'dig_find_mask'})\W!g) {
        next unless $name;
        next if grep { $name =~ /$_$/ } @{ $config{'dig_not_domain'} };
        my ( $ip, $err, $add );
        my %url = split_url($name);
        ( $ip, $err ) = name_to_ip( $url{'host'} );
        printlog( 'dbg', ' NOT ip', $name, $url{'host'}, $ip ), next if $err;
        printlog( 'dbg', ' ip not in mask:', $ip ), next if $ip !~ /$config{'dig_ip_mask'}/;
        unless ( $config{'dig_no_prot'} and !$url{'prot'} ) {
          next if !defined( $config{'scanner'}{ $url{'prot'} } );
          next if $config{'scanner'}{ $url{'prot'} }{'no_dig'};
        }
        $add = join_url( {
            %url,
            ( $config{'dig_as_ip'} ? ( 'host' => $ip ) : () ),
            ( ( $url{'prot'} eq $static{'port2prot'}{ $url{'port'} } ) ? ( 'port' => '' ) : () ),
            ( ( $config{'dig_prot_add'} and !$url{'prot'} ) ? ( 'prot' => $config{'dig_prot_add'} ) : () ),
            ( $config{'host_by_name_norm'} ? ( 'host' => normalize_ip( $url{'host'} ) ) : () ),
            ( ( $url{'user'} =~ /anonymous|ftp|none|\*+/i ) ? ( 'user' => '', 'pass' => '' ) : () ),
            ( ( $url{'pass'} =~ /none|\*+/i ) ? ( 'pass' => '' ) : () ),
          }
        ) unless $config{'dig_add_netmask'};
        $add = $ip, $add =~ s/\d+$//, $add = $add . '0/' . $config{'dig_add_netmask'} if $config{'dig_add_netmask'};
        printlog( 'dbg', ' digged', $name, '=', $ip, '->', $add ) if !$dig{$add};
        $processor{'url'}->($add) if ( $config{'dig_add_every'} and !$dig{$add} );
        ++$dig{$add};
      }
    }
    close(IF);
  }
  $processor{'url'}->( keys %dig ) unless $config{'dig_add_every'};
  printlog( 'info', ' founded', scalar keys %dig, sort keys %dig );
};
$program{ psmisc::program('ipdigf') }{'func'} ||= sub {
  for my $file (@_) {
    printlog( 'info', 'founding ips hrefs in', $file );
    open( my $fh, ( ( $file eq '-' ) ? ($file) : ( '<', uni_get($file) ) ) ) or printlog( 'err', 'unable to open' ), return;
    while (<$fh>) {
      next if /^\s*[#;]/;
      s/^\s+//;
      s/\s+$//;
      psmisc::program_one( 'ipdig', $_ ) if $_;
    }
    close($fh);
  }
};
$program{ psmisc::program('hublist') }{'func'} ||= sub {
  $_ = ( $_[0] or $config{'hublist'} );
  $processor{'file'}{ /\.(?:list)|(?:config)$/i ? 'list' : 'hublist' }{'func'}->( uni_get($_) );    #/
};
$program{ psmisc::program('filelist') }{'func'} ||= sub {
  return unless psmisc::use_try 'Net::DirectConnect::filelist';
  push @_, grep { -d } @ARGV;
  delete $program{default};
  @_ = @{ $config{fine}{dchub}{share} || [] } unless @_;
  #printlog('params', Dumper $config{fine}{dchub});
  Net::DirectConnect::filelist->new(
    log => sub (@) {
      my $dc = ref $_[0] ? shift : {};
      psmisc::printlog shift(), "[$dc->{'number'}]", @_,;
    },
    #'sql' => $config{'sql'},
    'db' => $static{'db'},
    ,
    %{ $config{fine}{dchub} || {} }
  )->filelist_make(@_),;
  0;
};
$program{ psmisc::program('default') }{'mask'} ||= '\S';
$program{ psmisc::program() }{'multi'}         ||= 1;
$program{ psmisc::program() }{'param_name'}    ||= 1;
$program{ psmisc::program() }{'func'}          ||= sub {
  return if scan_stop;
  for my $current ( keys %program ) {
    next if $current eq 'default';
    return if $program{ psmisc::program() }{'mask'} and $_[0] =~ /$program{psmisc::program()}{'mask'}/i;
  }
  psmisc::program_one( ( -f $_ && -s $_ ? 'file' : 'scan' ), $_ ) for @_;
  #$processor{'url'}->(@_);
};
$program{ psmisc::program('scan') }{'func'} ||= sub {
  #printlog('dev', 'scan', @_);
  $processor{'url'}->(@_);
};
$program{ psmisc::program('upload') }{'func'} ||= sub {
  #close_out_file();
  startn( $_[0], 'upload' );
  $processor{'dir'}->( $config{'datadir'} );
  #$static{'db'}->flush_insert();
};
$program{ psmisc::program('index_enable') }{'func'} ||= sub {
  $static{'db'}->index_enable( $config{'sql_tfile'} );
  #my $tim = timer();
  #printlog( 'info', 'Enabling indexes...' );
  #$static{'db'}->query_log("ALTER TABLE $static{'db'}->{'table_prefix'}$config{'sql_tfile'} ENABLE KEYS");
  #printlog( 'time', 'Enable index per ', psmisc::human( 'time_period', $tim->() ) );
  return 0;
};
$program{ psmisc::program('optimize') }{'func'} ||= sub {
  return $static{'db'}->optimize(@_);
  #@_ = keys %{ $config{'sql'}{'table'} } unless @_;
  #@_ = grep { $_ and $config{'sql'}{'table'}{$_} } @_;
  #printlog( 'info', 'Optimizing table...', @_ );
  #$static{'db'}->query_log( "OPTIMIZE TABLE " . join( ',', map( "$static{'db'}->{'table_prefix'}$_", @_ ) ) );
};
$program{ psmisc::program('analyze') }{'func'} ||= sub {
  return $static{'db'}->analyze(@_);
  #@_ = keys %{ $config{'sql'}{'table'} } unless @_;
  #@_ = grep { $_ and $config{'sql'}{'table'}{$_} } @_;
  #printlog( 'info', 'Analyze table...', @_ );
  #$static{'db'}->query_log( "ANALYZE TABLE " . join( ',', map( "$static{'db'}->{'table_prefix'}$_", @_ ) ) );
};
$program{ psmisc::program('flush') }{'func'} ||= sub {
  #printlog( 'dev', 'Flush');
  return $static{'db'}->flush(@_);
  #my $tim = timer();
  #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
  #$static{'db'}->do( "FLUSH TABLES " . ( join ',', map { "$tq$_$tq" } sort keys %{ $config{'sql'}{'table'} } ) );
  #printlog( 'time', 'Flush per', psmisc::human( 'time_period', $tim->() ) );
  #0;
};
$program{ psmisc::program('prof') }{'func'} ||= sub {
  my $tim = timer();
  #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
  @_ = grep { $_ ne $config{'sql_tfile'} } keys %{ $config{'sql'}{'table'} } unless @_;
  @_ = grep { $_ and $config{'sql'}{'table'}{$_} } @_;
  psmisc::program( $_, @_ ) for qw(repair optimize);
  printlog( 'time', 'Prof per', psmisc::human( 'time_period', $tim->() ) );
  return 0;
};
$program{ psmisc::program('res') }{'proc'} ||= 100;
$program{ psmisc::program() }{'func'} ||= sub {
  #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
  #printlog('err', 'logtest');
  my ( $join, $what, $where, $lock ) = (
    "LEFT JOIN $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq USING (${rq}host$rq)",
    ", $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq.${rq}time$rq AS ${rq}live$rq",
" $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq.${rq}time$rq IS NULL OR $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq.${rq}time$rq = ${vq}0$vq OR $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq.${rq}time$rq > $vq"
      . ( int( time() ) + $config{'timediff'} - $config{'online_minutes'} * 60 )
      . $vq,
    ", $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq WRITE"
  ) if $config{'scan_online_res'} and !$config{'scan_dead'};
##### TODO !!!!!!!!!!!!! sql_where !!!!!!!!!!!
  #printlog( 'dev', 'PRELOCK' );
  my $protos = join( ' OR ',
    map { " $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}prot$rq = $vq$_$vq" }
      grep { $config{'scanner'}{$_}{'scanable'} and !$config{'scanner'}{$_}{'disabled'} and !$config{"no_$_"} }
      keys %{ $config{'scanner'} } )
    or return $config{'nothing_scan_sleep'};
  $static{'db'}->lock_tables("$tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq WRITE $lock");
  local @_ = ( (
      $config{'scan_dead'} ? ()
      : " NOT $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}time$rq OR $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}size$rq > ${vq}0$vq "
    ), (
      $config{'scanner'}{'dchub'}{'disabled'} ? ()
      : ( !%{ $config{'sql'}{'table'}{ $config{'sql_tresource'} }{'dcuser'} or {} }
        ? " $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}host$rq NOT LIKE $vq%/%$vq "
        : " $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}dcuser$rq = $vq$vq " )
    ),
    $protos,
    ( $where or () )
  );
  local $_ = grep( $_, @_ ) ? ' WHERE ( ' . join( ') AND (', grep( $_, @_ ) ) . ' ) ' : '';
  my $res =
    $static{'db'}->line(
"SELECT $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.*$what FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq $join $_ ORDER BY ($tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}scan$rq"
      . ( $config{'res_fast'} ? '' : "+$tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq.${rq}period$rq" )
      . ") LIMIT 1" );
#printlog('dev', 'res selectedp:', ($res), );
#printlog('dev', 'res selectedp:', join_url($res), Dumper $res);
#printlog('dev', 'res selected:',( join_url($res), psmisc::human('date_time',$res->{'scan'}),'p=', $res->{'period'},'=', psmisc::human('time_period',$res->{'period'})));
  our ( $lastres, $lasttime );
  my %origres = %$res;
  $res->{'period'} ||= hconfig( 'period', $res->{'host'}, $res->{'prot'} );
  printlog(
    'dev',
    'res selected:', (
      join_url($res), !!$res->{'scan'},
      psmisc::human( 'time_period', time - $res->{'scan'} ),
      psmisc::human( 'time_period', time - $res->{'time'} ),
      'p=', $res->{'period'}, '=', psmisc::human( 'time_period', $res->{'period'} )
    )
  );
  $_ = ( %origres and allowscan( $res, $config{'sql_tresource'}, $res->{'scan'} + 1, $res->{'period'} ) );
#$_ = ( $static{'db'}->filter_row( $config{'sql_tresource'}, 'primary', $res ) and allowscan( $res, $config{'sql_tresource'}, $res->{'scan'} + 1, $res->{'period'} ) );
#$_ = ( @{$res}{$static{'db'}->filter_row( $config{'sql_tresource'}, 'primary', $res )} and allowscan( $res, $config{'sql_tresource'}, $res->{'scan'} + 1, $res->{'period'} ) );
#my $period = ($res->{'period'} or hconfig( 'period', $res->{'host'}, $res->{'prot'} ));
#$_ = ( %$res and allowscan( $res, $config{'sql_tresource'}, $res->{'scan'} + 1, $period ) );
  $static{'db'}->unlock_tables();
#printlog( 'dev', "resrun[$_]", %$res, 'fr:',   @{$res}{ $static{'db'}->filter_row( $config{'sql_tresource'}, 'primary', $res ) } );
  if ($_) {
    printlog( 'err', "resource table probably corrupted", "duplicate", $lastres ), sleep( 10 + rand(100) ),
      psmisc::program_one( 'repair', $config{'sql_tresource'}, $config{'sql_thost'} ), return 0,
      if $config{'resourse_breakable'}
        and $lastres
        and $lastres eq join_url($res)
        and $lasttime + $config{'resourse_breakable'} > time;
    $lastres  = join_url($res);
    $lasttime = time;
    local $work{'scan_proto_host_reset_force'} = 1 unless $config{'force'};
    local $config{'force'} = 1;
    $processor{'url'}->( join_url($res) );
    return 0;
  } elsif (%$res) {
    my $wait = $res->{'period'} - ( $res->{'scan'} ? int( time() ) - $res->{'scan'} : 0 );
    my $nextscan = ( $_ = $res->{'period'} + $res->{'scan'} - int( time() ) ) > 0 ? $_ : $config{'nothing_scan_sleep'};
    $_ = min( max( $nextscan, 0 ), $config{'nothing_scan_sleep'}, max( $wait, 0 ) + 1 );
    printlog(
      'dbg', 'Res: nothing to do (next:',
      join_url($res), ':', psmisc::human( 'time_period', $nextscan ),
      ') sl(', $_, ')'
    );
    return $_;
  } else {
    printlog( 'dbg', 'all resources is scanned or dead or table is empty?' );
    return $config{'nothing_scan_sleep'};
  }
};
$program{ psmisc::program('dcbot') }{'proc'} ||= 1;
$program{ psmisc::program() }{'func'} ||= sub {
  return $config{'nothing_scan_sleep'} if $config{'scanner'}{'dchub'}{'disabled'};
  local $config{'scan_online_res'}              = 0;
  local $config{'scan_dead'}                    = 1;
  local $config{'host_by_name_norm'}            = 0;
  local $config{'scanner'}{'dchub'}{'scanable'} = 1;
  local $config{'scanner'}{'adc'}{'scanable'}   = 1;
  local $config{'scanner'}{'adcs'}{'scanable'}  = 1;
  local $config{'scanner'}{'ftp'}{'disabled'}   = 1;
  local $config{'scanner'}{'http'}{'disabled'}  = 1;
  local $config{'scanner'}{'file'}{'disabled'}  = 1;
  local $config{'scanner'}{'rsync'}{'disabled'} = 1;
  return psmisc::program_one('res');
};
$program{ psmisc::program('range') }{'proc'} ||= 1;
$program{ psmisc::program() }{'func'} ||= sub {
  #my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
  my $where = $static{'db'}->where( {
      'scan'      => int( time() ),
      'scan_mode' => '<',
      'glueg'     => 'or',
      ( $config{'scan_dead'} ? () : ( 'time1' => 0, 'alive1' => 1, 'alive_mode1' => '>', 'gluel1' => 'or' ) )
    },
    undef,
    $config{'sql_tranges'}
  );
  $static{'db'}->lock_tables("$tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq WRITE");
  #TODO MAKE QUERY HERE:
  my ( $rng, $tim, $period ) = @{
    $static{'db'}->line(
"SELECT ${rq}range$rq, ${rq}scan$rq, ${rq}period$rq FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq $where ORDER BY (${rq}scan$rq+${rq}period$rq) LIMIT 1"
    )
    }{ ( 'range', 'scan', 'period' ) };
  #printlog('dev', 'range selected:',( $rng, psmisc::human('time_period',time-$tim), $period ));
  $static{'db'}->unlock_tables(), return $config{'nothing_scan_sleep'} unless $rng;
  #$period ||= hconfig( 'range_period', $rng );
  $period ||= hconfig( 'period', $rng, 'range' );
  local $config{'scan_timeout'} = $config{'scan_range_timeout'};
  $_ = allowscan( { 'range' => $rng }, $config{'sql_tranges'}, $tim + 1, $period );
  #printlog('dbg', 'range allowscan:', $_);
  $static{'db'}->unlock_tables();
  if ($_) {
    local $config{'force'} = 1;
    $config{'nmap_only'} = 1 unless defined $config{'nmap_only'};
    $processor{'url'}->($rng);
    return 0;
  } else {
    $period ||= hconfig( 'period', $rng );
    my $nextscan = $period + $tim - int( time() );
    $_ = min( max( $nextscan, 0 ), $config{'nothing_scan_sleep'}, $config{'nothing_scan_sleep'}, max( $period, 0 ) + 1 );
    printlog(
      'dbg', 'range: nothing to do, sleeping ',
      $_, 'seconds (next:',
      $rng, ':', psmisc::human( 'time_period', $nextscan ),
      'period:', psmisc::human( 'time_period', $period ),
      'last:', psmisc::human( 'time_period', int( time() ) - $tim ), ')'
    );
    return $_;
  }
};

sub startn {
  my ( $how, $from ) = (@_);
  #printlog('dev', 'startn', @_) ;
  #my $proc = $_[0];
  #printlog('dev', "start1 proc=$how", @ARGV);
  s/\s*($from)=\d+\s*/$1/i for @ARGV;
  #printlog('dev', "start2 proc=$how", @ARGV);
  #printlog('dev', "proc=$how;", join( ' ', grep { /^(-|$from)/ } @ARGV )),
  startself( join( ' ', grep { /^(-|$from)/ } @ARGV ) ) while --$how > 0;
}
$program{ psmisc::program('proc') }{'func'} ||= sub {
  #return unless $config{'sql_use_dbi'};
  return if scan_stop;
  my $only = $config{'scan'};
  if ( int( $_[0] ) ) { startn( $_[0], 'proc' ) }
  elsif ( $program{ $_[0] } ) { $only ||= $_[0]; }
  my $min_sleep;
  #printlog( 'dmp', "gggg" );
  while ( !scan_stop ) {
    my ( $runned, $sleep ) = ( 0, $config{'nothing_scan_sleep'} );
    for my $prog (
      $only
      or sort { $program{$a}{'order'} <=> $program{$b}{'order'} }
      grep { $program{$_}{'proc'} and !$config{ 'noscan_' . $_ } } keys %program
      )
    {
      ++$runned;
      $work{'proc_scans'} = $program{$prog}{'proc'};
      do {
        state("proc: $prog");
        #printlog( 'dev', "proc $prog run" );
        $_ = alarmed( $program{$prog}{'alarm'} || $config{'max_proc_time'}, $program{$prog}{'func'} );
        printlog( 'dbg', 'proc', "prog $prog returned $_;", $work{'proc_scans'} );
        printlog( 'info', "starting child and exit.." ), startself( join( ' ', grep { /^(-|proc)/ } @ARGV ) ), exit
          if ( $config{'reload_time'} and $work{'start_timer'}->() > $config{'reload_time'} )
          or ( $config{'reload_every'} and $work{'scans'} >= $config{'reload_every'} );
      } while --$work{'proc_scans'} > 0 and !$_ and !scan_stop;
      $sleep = min( $sleep, max( $_, 0 ) );
      $min_sleep = 0 unless $_;
      #printlog( 'dbg', "sleep=$sleep, r=$_" );
    }
    printlog( 'info', 'proc: nothing to do, exit' ), last
      if !$runned
        or ( $config{'once'} and $sleep == $config{'nothing_scan_sleep'} );
    $sleep = min( $sleep, ( $min_sleep *= 2 ) ||= 5 );
    $min_sleep = min( $min_sleep, $config{'nothing_scan_sleep'} );
    state( "proc: sleep:", $sleep + $config{'scan_sleep'} );
    printlog( 'dbg', 'sleep..', $sleep, ' + rand', $config{'scan_sleep'}, " min=$min_sleep max=$config{'nothing_scan_sleep'}" );
    mysleep( $sleep + rand( $config{'scan_sleep'} ) );
  }
};
$program{ psmisc::program('stat') }{'func'} ||= sub {
  my ( $qq, $qn );
  $static{'db'}{'auto_repair'}  = 1;
  $static{'db'}{'force_repair'} = 1;
  my ( $tq, $rq, $vq ) = $static{'db'}->quotes();
  $qn = "WHERE ${rq}scan${rq} = ${vq}0${vq}";
  for ( 0 .. $_[0] ) {
    mysleep( $config{'stat_sleep'} or 1 ) if $_;
    unless ( $config{'stat_no_res'} ) {
      my $dq;
      $dq = "  ${rq}dcuser${rq} LIKE $vq$vq " if keys %{ $static{'db'}{'table'}{ $config{'sql_tresource'} }{'dcuser'} };
      $qq = " ${rq}scan${rq} < $vq" . ( int( time() ) - $config{'period'} ) . "$vq ";
      $qq .= " AND ( ${rq}time${rq}=${vq}0${vq} OR ${rq}size${rq}>${vq}0${vq} ) " unless $config{'scan_dead'};
      #printlog( 'dch', keys %{$config{'table'}{$config{'sql_tresource'}}{'dcuser'}});
      my $where = 'WHERE';
      #$where = ' WHERE ' . join (' AND ', grep {$_}$dq, $qq) if $dq or $qq;
      printlog(
        'info',
        #'host=', $static{'db'}->{'host'}, 'db=', $static{'db'}->{'database'},
        "Resources: to scan ",
        values %{
          $static{'db'}->line(
            "SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq "
              . ( $dq || $qq ? $where . join( ' AND ', grep { $_ } $dq, $qq ) : '' )
          )
          },
        'from',
        values %{
          $static{'db'}->line(
            "SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq " . ( $dq ? $where . $dq : '' )
          )
          },
        '; new',
        values %{ $static{'db'}->line("SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq $qn")
          },
      );
    }
    unless ( $config{'stat_no_range'} ) {
      #$qq = 'WHERE ${rq}scan${rq} < \'' . ( int( time() ) - $config{'range_period'} ) . "' ";
      $qq = "WHERE ${rq}scan${rq} < $vq" . ( int( time() ) - hconfig( 'period', 'range' ) ) . "$vq ";
      $qq .= " AND ( ${rq}time${rq}=${vq}0${vq} OR ${rq}alive${rq}>${vq}0${vq} ) " unless $config{'scan_dead'};
      printlog(
        'info',
        'ranges: to scan ',
        values %{ $static{'db'}->line("SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq $qq ")
          },
        'from',
        values %{ $static{'db'}->line("SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq ") },
        '; new',
        values %{ $static{'db'}->line("SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tranges'}$tq $qn") },
      );
    }
    our %total;
    my %totallast = %total;
    unless ( $config{'stat_no_total'} ) {
      printlog(
        'info',
        'totals:',
        map {
          (
            $_,
            '=',
            $total{$_} = ( values %{ $static{'db'}->line("SELECT COUNT(*) FROM $tq$static{'db'}->{'table_prefix'}$_$tq ") } )[0]
            ),
            $totallast{$_}
            ? ( $totallast{$_} = $total{$_} - $totallast{$_} )
              ? ( $totallast{$_} > 0 ? '+' : () ) . $totallast{$_}
              : ()
            : ()
        } keys %{ $config{'sql'}{'table'} }
      );
    }
  }
};
$program{ psmisc::program('statuniq') }{'func'} ||= sub {
  my $table = 'filebase';
  #printlog Dumper
  my $indexes = $static{'db'}->query("show index from $table");
  #printlog Dumper $bykey     ;
  my $oldseq = 1;
  my $n      = 0;
  for my $i (@$indexes) {
    $i->{"Key"} = ++$n if $i->{"Seq_in_index"} <= $oldseq;
    $oldseq = $i->{"Seq_in_index"};
  }
  my $bykey = { map { $_->{Key} => $_ } @$indexes };
  #printlog Dumper $indexes;
  my ( $run, $total );
  for my $s (`$config{myisamchk} -v --description /var/db/storage/$config{sql_base_web}/$table`) {
    $total = $1 if $s =~ /Data records:\s*(\d+)/;
    ++$run if $s =~ /table description/;
    #printlog $s;
    next unless $run;
    #Key Start Len Index   Type                     Rec/key         Root  Blocksize
    #1   2     8   unique  ulonglong                      1    422342656       1024
    $s =~ /^\s*(?<Key>\d+)\s+\d+\s+\d+.*?(?<reckey>\d+)/;
    next unless $+{Key};
    $bykey->{ $+{Key} }{reckey} = $+{reckey} unless $bykey->{ $+{Key} }{reckey};
    #printlog $s, Dumper \%+;
  }
  my ($size) = values %{ $static{'db'}->line("SELECT SUM(size) FROM resource WHERE files>0") };
  printlog "totals: files: $total; size $size";
  my %byname;
  for my $i ( values %$bykey ) {
    $i->{rec} = int( $total / $i->{reckey} ) if $i->{reckey};
    next if $i->{rec} <= 1 or $i->{rec} == $total;
    $byname{ $i->{Column_name} } = $i;
    printlog "unique $i->{Column_name}'s: $i->{rec}";    #" $i->{reckey}";
  }
  printlog
"averages: file copies: $byname{tiger}{reckey}, files per user: $byname{dcuser}{reckey}, files per hub: $byname{host}{reckey}, file names per hash:",
    ( $byname{name}{reckey} / $byname{tiger}{reckey} ), ", file size: ", int( $size / $total )
    if $byname{tiger};
  printlog "files per host: $byname{host}{reckey},", "file size:", int( $size / $total ) unless $byname{tiger};
  #printlog Dumper $bykey;
  #warn "dddd";
  return 0;
};
$program{ psmisc::program('mrtg') }{'func'} ||= sub {
  my ( $first, $second );

=c
  local $config{'allow_auto_repair'}   = 0;
  local $config{'sql_reconnect_tries'} = 0;
  local $config{'sql_reconnect_sleep'} = 0;
  local $config{'sql_error_tries'}     = 0;
  local $config{'sql_error_sleep'}     = 0;
=cut

  $static{'db'}->retry_off();
  if ( $_[0] eq 'online' ) {
    ( $first, $second ) = @{
      $static{'db'}->line(
"SELECT SUM($static{'db'}->{'table_prefix'}$config{'sql_tresource'}.files) AS files, SUM($static{'db'}->{'table_prefix'}$config{'sql_tresource'}.size) AS size FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq LEFT JOIN $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq USING (host) WHERE $static{'db'}->{'table_prefix'}$config{'sql_tresource'}.files > ${vq}0${vq} AND $static{'db'}->{'table_prefix'}$config{'sql_thost'}.time > '"
          . ( int( time() ) + $config{'timediff'} - $config{'online_minutes'} * 60 ) . "'"
      )
      }{ ( 'files', 'size' ) };
    $first  /= $config{'mrtg_online_files'}, $first  = int($first)  if $config{'mrtg_online_files'};
    $second /= $config{'mrtg_online_bytes'}, $second = int($second) if $config{'mrtg_online_bytes'};
  } else {
    ($first) = @{
      $static{'db'}->line(
"SELECT count(*) as shared FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_tresource'}$tq LEFT JOIN $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq USING (host) WHERE $static{'db'}->{'table_prefix'}$config{'sql_tresource'}.files > ${vq}0${vq} AND $static{'db'}->{'table_prefix'}$config{'sql_thost'}.time > '"
          . ( int( time() ) + $config{'timediff'} - $config{'online_minutes'} * 60 ) . "'"
      )
      }{ ('shared') };
    ($second) = @{
      $static{'db'}->line(
            "SELECT count(*) as now   FROM $tq$static{'db'}->{'table_prefix'}$config{'sql_thost'}$tq WHERE ${rq}time${rq}>$vq"
          . ( int( time() ) - $config{'online_minutes'} * 60 )
          . $vq
      )
      }{ ('now') };
  }
  if ( $config{'mrtg_out'} and open( MF, '>', $config{'mrtg_out'} ) ) {
    print MF"$first\n$second\nz\nz\n";
    close(MF);
  } else {
    print "$first\n$second\nz\nz\n";
  }
  $static{'db'}->retry_on();
  return 0;
};
$program{ psmisc::program('cycle') }{'func'} ||= sub {
  if ( $config{'periodic_func'} ) {
    while ( !scan_stop ) {
      my $tim = timer();
      $config{'periodic_func'}->() if $config{'periodic_func'};
      printlog(
        'time', "Cycle done per",
        $tim->(),
        "sec; Sleeping $config{'periodic_time'} seconds to ",
        psmisc::human( 'date_time', int( time() ) + $config{'periodic_time'} )
      );
      last if $config{'cycle_once'};
      mysleep( $config{'periodic_time'} );
    }
  }
};
$program{ psmisc::program('mystatus') }{'func'} ||= sub {
  $static{'db'}->query_log('SHOW FULL PROCESSLIST');

=c
  if ( $config{'my_dump_file'} and open( FM, '>>', $config{'my_dump_file'} ) ) {
    local $config{'sql_use_dbi'} = 0;
    print FM $static{'db'}->query('SHOW FULL PROCESSLIST');
    close(FM);
  }
=cut

};

=for SIG tests
  psmisc::program('dummy');
  $program{psmisc::program()}{'func'} ||= sub {
    $_[0] = 10 if $_[0] eq 'dummy';
    printlog('info', 'dummy', $_), sleep(1) for 0..$_[0];
  };
=cut

$program{ psmisc::program('applyfilter') }{'func'} ||= sub {
  @_ = qw(query file word) unless @_;
  for my $table (@_) {
    #printlog "[$table],", $config{'sql'}{'table_param'}{ $config{ 'sql_t' . $table . 'stat' } }{'filter'}, ;
    next unless my $filter = $config{'sql'}{'table_param'}{ $config{ 'sql_t' . $table . 'stat' } }{'filter'};
    my $by = 10000;
    #my $by = 5;
    printlog $table, $filter;
    my $now = 0;
    my $del = 0;
    while (1) {
      my @rows = $static{'db'}->query( "SELECT * from $tq" . $config{ 'sql_t' . $table . 'stat' } . "$tq LIMIT $now, $by" );
      for my $row (@rows) {
        next unless ref $filter eq 'CODE' and $filter->( undef, $row );
        $static{'db'}->do( "DELETE FROM $tq"
            . $config{ 'sql_t' . $table . 'stat' }
            . "$tq WHERE $table="
            . $static{'db'}->quote( $row->{$table} ) );
        ++$del;
      }
      $now += $by;
      last if scalar @rows < $by;
    }
    printlog "deleted $del";
  }
};
$config{'killer_time'}     ||= 20;
$config{'killer_time_max'} ||= 40;
$config{'killer_sleep'}    ||= 10;
@{ $config{'killer_state'} } = ( 'Sending data', 'Sorting result', 'FULLTEXT initialization', 'Waiting for table', 'Locked' );
$config{'killer_commands'} ||= "select|update";
$config{'killer_mask'} = qr{^\s*(?:/\*.*?\*/)?\s*(?:$config{'killer_commands'})}i;
$config{'log_kill'} ||= 0;
$program{ psmisc::program('killer') }{'func'} ||= sub {

  for ( 1 .. $_[0] || 1 ) {
    sleep( $config{'killer_sleep'} ), next unless psmisc::lock( 'killer', timeout => 10, old => 5 * 60 );
    $static{'db'} = pssql->new( %{ $config{'sql'} || {} },
      ( ref $config{'sql_base_web'} eq 'HASH' ? %{ $config{'sql_base_web'} } : 'database' => $config{'sql_base_web'} ) )
      if $static{'db'}{'database'} ne $config{'sql_base_web'};
    local $static{'db'}->{'auto_repair'}     = 0;
    local $static{'db'}->{'reconnect_tries'} = 1 unless $_[0];
    local $static{'db'}->{'connect_tries'}   = 1 unless $_[0];
    local $static{'db'}->{'reconnect_sleep'} = 0 unless $_[0];
    local $static{'db'}->{'error_tries'}     = 0 unless $_[0];
    local $static{'db'}->{'error_sleep'}     = 0 unless $_[0];
    local $config{'log_default'}             = 'kill.log';
    my $killed;

    for my $row ( sort { $b->{'Time'} <=> $a->{'Time'} } @{ $static{'db'}->query('SHOW FULL PROCESSLIST') } ) {
      next unless $row->{'Id'} and $row->{'db'} and $row->{'Time'} and $row->{'State'};
      printlog( 'kill', 'other base', $_, map( "[$_:$row->{$_}] ", keys %{$row} ) ), next
        unless grep { $row->{'db'} eq $_ } array( $config{'killer_base'} ), $config{'sql_base_web'};
      printlog( 'kill', 'other state', $_, map( "[$_:$row->{$_}] ", keys %{$row} ) ), next
        unless grep { $row->{'State'} } @{ $config{'killer_state'} };
      printlog( 'kill', 'no time', $_, map( "[$_:$row->{$_}] ", keys %{$row} ) ), next
        unless $row->{'Time'} > $config{'killer_time'};
      printlog( 'kill', "not in mask [$row->{'Info'}]" ), next
        if $config{'killer_mask'} and !( $row->{'Info'} =~ $config{'killer_mask'} );
      printlog( 'info', "Killing query:", map( "[$_:$row->{$_}] ", keys %{$row} ) );
      $static{'db'}->do("KILL QUERY $row->{'Id'}");
      ++$killed;
      last if $killed and $_[0] and $row->{'Time'} < $config{'killer_time_max'};
    }
    psmisc::unlock('killer');
    sleep $config{'killer_sleep'} if $_[0];
  }
};
$program{ psmisc::program('stop') }{'func'} ||= sub {
  psmisc::file_rewrite( $config{'stop_file'}, time );
  0;
};
#unless ( $config{'module_crawler'} ) {
psmisc::program_run($param) unless (caller);

sub make_stat {
  return (
    ( defined $work{'start_timer'} ? ( '[run time', psmisc::human( 'time_period', $work{'start_timer'}->() ), ']', ) : () ),
    (
      $stat{'total_bytes'}
      ? " [total $stat{'total_bytes'} bytes per "
        . psmisc::human( 'time_period', $work{'start_timer'}->() ) . ' '
        . ( $work{'start_timer'}->() ? 'at ' . int( $stat{'total_bytes'} / $work{'start_timer'}->() ) : '' ) . ' b/s]'
      : ''
    ), (
      $stat{'files'}
      ? "$stat{'files'} files $stat{'dirs'} dirs scanned."
        . ( $stat{'skipped'} ? " ($stat{'skipped'} skipped)" : '' )
        . (
        $work{'start_timer'}->() ? '(' . psmisc::human( 'float', $stat{'files'} / $work{'start_timer'}->() ) . ' fps)' : '' )
      : ''
    ),
    ( int( $stat{'ftp_reconnects'} ) > 1 ? " with $stat{'ftp_reconnects'} recon." : '' ),
    ( %stat ? ( 'Stat: ', map { "$_=$stat{$_};" } keys %stat ) : () ),
    ,
    ( ref $static{'db'} ? ( '[', $static{'db'}->stat_string(), ']' ) : () ),
    times,
  );
}
#END {printlog('WOW3', $static{'db'}->{'dbh'});};
#sub
END {
  #printlog('dbh4.0=',$static{'db'}->{'dbh'});
  #close_out_file();
  #printlog('dbh4.1=',$static{'db'}->{'dbh'});
  $static{'db'}->flush_insert() if $static{'db'};
  printlog( 'info', 'Finished [', join ' ', map( { $_ . ( $param->{$_} ne '' ? "=$param->{$_}" : '' ) } keys %$param ),
    '] ', make_stat() )
    if $param
      and %$param
      and !$config{'nolog_startstop'};
  #$static{'db'}->log_stat();
}
#print Dumper  \%program;
#print Dumper  \%config;
#print Dumper  $param;
#print "\n\n param:\n";for (sort keys %$param) { print "$_ = $param->{$_}\n"; } # debug #
#print "\n\n config:\n";for (sort keys %config) { print "$_ = $config{$_}\n"; } # debug #
#print "\n\n config:\n", Dumper\%config; # debug #
#warn "\n\n configkeys:\n", scalar keys %config; # debug #
#print "\n\n INC:\n", Dumper(\%INC); # debug #
#$static{'db'}->query('error');
#$static{'db'}->do('error');
#http_dl('127.0.0.1', sub {print "cb:",$_[0], "\n"});
1;