File Coverage

blib/lib/Net/DirectConnect.pm

Criterion	Covered	Total	%
statement	51	907	5.6
branch	2	582	0.3
condition	1	491	0.2
subroutine	16	101	15.8
pod	0	73	0.0
total	70	2154	3.2

#$Id: DirectConnect.pm 1002 2014-08-27 14:35:23Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/lib/Net/DirectConnect.pm $
package Net::DirectConnect;
use strict;
no strict qw(refs);
use warnings "NONFATAL" => "all";
no warnings qw(uninitialized);
no if $] >= 5.017011, warnings => 'experimental::smartmatch';
our $VERSION = '0.14'; # . '_' . ( split ' ', '$Revision: 1002 $' )[1];
use utf8;
use Encode;
use Socket;
use IO::Socket;
use IO::Select;
use POSIX;
#use Fcntl;
use Time::HiRes qw(time sleep);
use Data::Dumper;
$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = $Data::Dumper::Terse = 1;
our $AUTOLOAD;
our %global;
sub is_code ($) { UNIVERSAL::isa( $_[0], 'CODE' ) }
sub code_run ($;@) { my $f = shift; return $f->(@_) if is_code $f }
sub is_object ($) { ref $_[0] and ref $_[0] ne 'HASH' }
sub can_run ($$;@) { my $c = shift || return; return unless is_object $c; my $f = shift || return; my $r = $c->can($f); return $r->( $c, @_ ) if $r; }

sub float {    #v1
  my $self = shift if ref $_[0];
  return ( $_[0] < 8 and $_[0] - int( $_[0] ) )
    ? sprintf( '%.' . ( $_[0] < 1 ? 3 : ( $_[0] < 3 ? 2 : 1 ) ) . 'f', $_[0] )
    : int( $_[0] );
}

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

sub send_udp ($$;@) {
  my $self = shift if ref $_[0];
  my $host = shift;
  #$host =~ s/:(\d+)$//;
  my $port = shift;
  #$port ||= $1;
  $self->log( 'dcdev', "sending UDP to [$host]:[$port] = [$_[0]]" );
  #$self->log( 'dcdev', "sending UDP to [$host] = [$_[0]]" );
  my $opt = $_[1] || {};
  if (
    my $s = $self->{'socket_class'}->new(
      'PeerAddr' => $host,
      ( $port ? ( 'PeerPort' => $port ) : () ),
      'Proto'   => 'udp',
      'Timeout' => $opt->{'Timeout'}, (
        #$opt->{'nonblocking'} ? (
        'Blocking' => 0,
        #'MultiHomed' => 1,    #del
        #) : ()
      ),
      %{ $opt->{'socket_options'} || {} },
    )
    )
  {
    $s->send( Encode::encode $self->{charset_protocol}, $_[0], Encode::FB_WARN );
    $self->{bytes_send} += length $_[0];
    #$s->shutdown(2);
    $s->close();
    #close($s);
    #$self->log( 'dcdev', "sent ",length $_[0]," closed [$s],");
  } else {
    #$self->log( 'dcerr', "FAILED sending UDP to $host :$port = [$_[0]]" );
    $self->log( 'dcerr', "FAILED sending UDP to $host = [$_[0]]" );
  }
}

sub socket_addr ($) {
  my ($socket) = @_;
  return wantarray ? ( $socket->peerhost, $socket->peerport ) : $socket->peerhost;

=old
  local @_;
  #eval { @_ = unpack_sockaddr_in( getpeername($socket) || return ) };
  eval { @_ = unpack_sockaddr_in( $socket->peername || return ) };
  return unless $_[1];
  return unless $_[1] = inet_ntoa( $_[1] );
  return @_;
=cut

=todo
  my ($err, $hostname, $servicename) = Socket::getnameinfo($socket->peername);
if ($err) {
  if (use_try 'Socket6') {
  #warn "Cannot getnameinfo - $err; $hostname, $servicename" ;
  $hostname = Socket6::getnameinfo($socket->peername);
  }
}
warn 'getn', $hostname,$servicename;
  return wantarray ? ($hostname,$servicename) : $hostname;
=cut

}

sub schedule($$;@)
{    #$Id: DirectConnect.pm 1002 2014-08-27 14:35:23Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/lib/Net/DirectConnect.pm $
  our %schedule;
  my ( $every, $func ) = ( shift, shift );
  my $p;
  ( $p->{'wait'}, $p->{'every'}, $p->{'runs'}, $p->{'cond'}, $p->{'id'} ) = @$every if ref $every eq 'ARRAY';
  $p = $every if ref $every eq 'HASH';
  $p->{'every'} ||= $every if !ref $every;
  $p->{'id'} ||= join ';', caller;
  #dmp $p, \%schedule;
  #dmp $schedule{ $p->{'id'} }{'runs'}, $p->{'runs'}, $p, $schedule{ $p->{'id'} } if $p->{'runs'};
  $schedule{ $p->{'id'} }{'func'} = $func if !$schedule{ $p->{'id'} }{'func'} or $p->{'update'};
  $schedule{ $p->{'id'} }{'last'} = time - $p->{'every'} + $p->{'wait'} if $p->{'wait'} and !$schedule{ $p->{'id'} }{'last'};
  #dmp("RUN", $p->{'id'}),
  ++$schedule{ $p->{'id'} }{'runs'}, $schedule{ $p->{'id'} }{'last'} = time, $schedule{ $p->{'id'} }{'func'}->(@_),
        if ( $schedule{ $p->{'id'} }{'last'} + $p->{'every'} < time )
    and ( !$p->{'runs'} or $schedule{ $p->{'id'} }{'runs'} < $p->{'runs'} )
    and ( !( ref $p->{'cond'} eq 'CODE' ) or $p->{'cond'}->( $p, $schedule{ $p->{'id'} }, @_ ) )
    and ref $schedule{ $p->{'id'} }{'func'} eq 'CODE';
}

sub notone (@) {
  @_ = grep { $_ and $_ != 1 } @_;
  wantarray ? @_ : $_[0];
}

sub use_try ($;@) {
  my $self = shift if ref $_[0];
  our %tried;
  ( my $path = ( my $module = shift ) . '.pm' ) =~ s{::}{/}g;
  return $tried{$module} if exists $tried{$module};
  local $SIG{__DIE__} = undef;
  $tried{$module} = ( $INC{$path} or eval 'use ' . $module . ' qw(' . ( join ' ', @_ ) . ');1;' and $INC{$path} );
}

sub module_load {
  my $self = shift if ref $_[0];
  local $_ = shift;
  return unless length $_;
  #$self->log( 'dev', "loading", $_, $self->{'module_loaded'}{$_});
  return if $self->{'module_loaded'}{$_}++;
  my $module = __PACKAGE__ . '::' . $_;
  #eval "use $module;";
  $self->log( 'err', 'cant load', $module, $@ ), return unless use_try $module;
  #$self->log( 'err', 'cant load', $module, $@ ), return if $@;
  #${module}::new($self, @_) if $module->can('new');
  #${module}::init($self, @_) if $module->can('init');
  #$self->log( 'dev', 'can', $module->can('new'));
  #$self->log( 'dev', 'can', $module->can('init'));
  #eval "$module\::new(\$self, \@_);";    #, \@param
  $_->( $self, @_ ) if $_ = $module->can('new') and $_ ne __PACKAGE__->can('new');
  $_->( $self, @_ ) if $_ = $module->can('init');
  #$self->log( 'err', 'cant new', $module, $@ ), return if $@;
  #eval "$module\::init(\$self, \@_);";    #, \@param
  #$self->log( 'err', 'cant init', $module, $@ ), return if $@;
  # $self->log( 'ddev', 'loaded  module', $module, );
  1;
}

sub new {
  #print 'NEW:',Dumper \@_;
  my $class = shift;
  my $self  = {};
  if ( ref $class eq __PACKAGE__ ) { $self = $class; }
  else                             { bless( $self, $class ) unless ref $class; }
  #print ref $self;
  #$self-
  #psmisc::printlog('dev', 'new', @_);
  #psmisc::printlog('dev', 'func', Dumper @_);
  $self->{'number'} ||= ++$global{'total'};
  ++$global{'count'};
  #$self->log('dev', 'new', @_);
  $self->func(@_);    #@param
  eval { $self->{'recv_flags'} = MSG_DONTWAIT; } unless $^O =~ /win/i;
  $self->{'recv_flags'} ||= 0;
  #psmisc::printlog('dev', 'init');
  $self->init_main(@_);    #@param
  $self->init(@_);         #@param
                           #}
  $self->{activity} = time;
#$self->{$_} ||= $self->{'parent'}{$_} for grep { exists $self->{'parent'}{$_} } qw(log sockets select select_send);
#(!$self->{'parent'}{$_} ? () :  $self->{$_} = $self->{'parent'}{$_} ) for qw(log );
#$self->{'log'} = $self->{'parent'}{'log'} if $self->{'parent'}{'log'};
#$self->{$_} ||= $self->{'parent'}{$_} ||= {}
#$self->log( 'dev', '1uphandler my=',$self->{handler},Dumper($self->{handler}) , 'p=',Dumper($self->{'parent'}{handler}),$self->{'parent'}{handler},);
#$self->{'parent'}{$_} ||= {} ,  $self->{$_} ||= $self->{'parent'}{$_},
#$self->log( 'dev', '2uphandler my=',$self->{handler},Dumper($self->{handler}) , 'p=',Dumper($self->{'parent'}{handler}),$self->{'parent'}{handler},);
#$self->log( 'dev', "my number=$self->{'number'} total=$global{'total'} count=$global{'count'}" );
#$self->log( 'dev', $class ,' eq ', __PACKAGE__);
  if ( $class eq __PACKAGE__ ) {
    #local %_ = (@_);
#$self->log( 'dev', $class ,' eq ', __PACKAGE__, Dumper @_);

    #for keys
    #$self->{$_} = $_{$_} for keys %_;
    #$self->log( 'init00', $self, "h=$self->{'host'}", 'p=', $self->{'protocol'}, 'm=', $self->{'module'} );
    if ( $self->{'host'} ~~ m{^(?:\w+://)?broadcast} or $self->{'host'} =~ /^(?:255\.|\[?ff)/i ) {
      #if (use_try 'Socket::Multicast6', 'ipv6') {
        #IPV6_JOIN_GROUP
      #}
      $self->{'protocol'} ||= 'adc';
      $self->{'auto_listen'}                 = 1;
      delete $self->{'auto_connect'};
      $self->{'Proto'}                       = 'udp';
      $self->{'socket_options'}{'Broadcast'} = 1;
      $self->{'socket_options'}{'ReuseAddr'} = 1;
      #$self->{'host'} = $self->{dev_ipv6} ? 'ff02::1' : inet_ntoa(INADDR_BROADCAST) if $self->{'host'} !~ /^(?:255\.|\[?ff)/i;
      $self->{'host'} = inet_ntoa(INADDR_BROADCAST) if $self->{'host'} !~ /^(?:255\.|\[?ff)/i;
      #$self->{socket_options_listen}{'LocalHost'} = 'ff02::1';
      #$self->{'port'},
      #$self->log( 'dev',  "send to", );
      $self->{'broadcast'} = 1;
      #$self->{'lis'} = 1;
      #$self->log('dev', "broadcast=$self->{'host'}, auto_listen=$self->{'auto_listen'} auto_connect=$self->{'auto_connect'}");
    }
    if (
      #!$self->{'module'} and
      !$self->{'protocol'} and $self->{'host'}
      )
    {
      #$self->log( 'proto0 ', $1);
      my $p = lc $1 if $self->{'host'} =~ m{^(.+?)://};
      #$self->protocol_init($p);
      $self->{'protocol'} = $p;
      $self->{'protocol'} = 'nmdc'
        if !$self->{'protocol'}
        or $self->{'protocol'} eq 'dchub';
      #$self->{'protocol'}
      #$self->log( 'proto ', $self->{'protocol'} );
    }
    #$self->{'module'} ||= $self->{'protocol'};
    #if ( $self->{'module'} eq 'nmdc' ) {
    #  $self->{'module'} = [ 'nmdc', ( $self->{'hub'} ? 'hubcli' : 'clihub' ) ];
    #}
    ++$self->{'module'}{ $self->{'protocol'} };
    if ( $self->{'protocol'} eq 'nmdc' ) {
      ++$self->{'module'}{ $self->{'hub'} ? 'hubcli' : 'clihub' };
    }
    #++$self->{'module'}{$_} for grep { $self->{ 'dev_' . $_ } } qw(ipv6);
    #, ($] < 5.014 ? 'ipv6' : ()); #sctp
    #if ( $self->{'module'} ) {
  }
  if ( $self->{'dev_sctp'} ) {
    unless ( $self->{'no_sctp_fallback'} ) {
      $self->log( 'dev', 'make sctp clone', $class );
      $self->{'clients'}{ 'sctp_' . $self->{'number'} } = $class->new(
        @_,
        'dev_sctp'      => undef,
        'parent'        => $self,
        auto_work       => 0,
        no_wait_connect => 1,
        #reconnect_tries=>1,
        #myport_tries=>1,
        #'Proto'       => 'sctp',
        modules => [qw(sctp)],
      );
    } else {
      ++$self->{'module'}{'sctp'};
    }
    $self->info;
  }
  ++$self->{'module'}{$_} for grep { $self->{'protocol'} eq $_ } qw(adcs http);
  #$self->log( 'dev', 'module load', $self->{'module'}, 'p', $self->{'protocol'} );
  my @modules;    #= ($self->{'module'});
  for (qw(module modules)) {
    push @modules, @{ $self->{$_} }      if ref $self->{$_} eq 'ARRAY';
    push @modules, keys %{ $self->{$_} } if ref $self->{$_} eq 'HASH';
    push @modules, split /[;,\s]/, $self->{$_} unless ref $self->{$_};
  }
  #$self->log( 'dev', 'modules load', @modules );
  #$self->log( 'modules load', @modules, @_);
  $self->module_load( $_, @_ ) for @modules;
  #$self->log( 'now proto', $self->{'Proto'});
  $self->{charset_chat} ||= $self->{charset_protocol};
  #$self->protocol_init();
  #$self->log( 'dev', $self, 'new inited', "MT:$self->{'message_type'}", 'autolisten=', $self->{'auto_listen'} );
  #$self->{charset_console} = 'utf8';
  # $self->log( 'dev', "set console encoding  [$self->{charset_console}]");
  #eval qq{use encoding $self->{charset_console}};
  eval qq{use encoding '$self->{charset_internal}', STDOUT=> '$self->{charset_console}', STDIN => '$self->{charset_console}'}
    if !$self->{parent}
    and !$self->{no_charset_console}
    and $self->{charset_internal}
    and $self->{charset_console};
  #$self->log( 'dev', 'utf8: УТф восемь');
  #$self->log( 'dev', Dumper $self);
  $self->log( 'dcdbg',
    "using encodings console:[$self->{charset_console}] protocol:[$self->{charset_protocol}] fs:[$self->{charset_fs}]" )
    unless $self->{parent}{parent};
  if ( $self->{'auto_say'} ) {
    for my $cmd ( @{ $self->{'auto_say_cmd'} || [] } ) {
      #$self->log('AS', $cmd);
      $self->{'handler_int'}{$cmd} = sub {
        my $dc = shift;
        #$self->log('ASH', $cmd);
        $self->say( $cmd, @_ );    #print with console encoding
      };
    }
  }
  #$self->log('dev', 'sctp', $self->{'dev_sctp'});
  #$self->log('dev', "auto_listen=$self->{'auto_listen'} auto_connect=$self->{'auto_connect'}");
  if ( $self->{'auto_listen'} ) {
    #$self->{'disconnect_recursive'} = $self->{'parent'}{'disconnect_recursive'};
    $self->{'incomingclass'} ||= $self->{'parent'}{'incomingclass'};    # if $self->{'parent'};
    $self->listen();
    #$self->log('go conaft');
    $self->connect_aft() if $self->{'broadcast'};
  } elsif ( $self->{'auto_connect'} ) {
    #$self->log( $self, 'new inited', "auto_connect MT:$self->{'message_type'}", ' with' );
    $self->connect();
    #$self->work();
    $self->wait_connect() unless $self->{'no_wait_connect'};
  } else {
    $self->get_my_addr();
    $self->get_peer_addr();
  }
  if ( $self->{'auto_work'} ) {
    #$self->log( $self, '', "auto_work ", $self->active() );
    while ( $self->active() ) {
      $self->work();    #forever
                        #$self->{'auto_work'}->($self) if ref $self->{'auto_work'} eq 'CODE';
                        #Time::HiRes::sleep 0.01;
    }
    $self->disconnect();
  }
  #@  psmisc::file_rewrite( 'dump.new', Dumper $self);
  return $self;
}

sub log(@) {
  my $self = shift;
  return $self->{'log'}->( $self, @_ ) if ref $self->{'log'} eq 'CODE';
  print( join( ' ', "[$self->{'number'}]", @_ ), "\n" );
}

sub cmd {
  my $self = shift;
  #return unless $self->{'cmd'};
  my $dst;
  $dst =    #$_[0]
    shift if $self->{'adc'} and length $_[0] == 1;
  my $cmd = shift;
  my ( @ret, $ret );
  #$self->{'log'}->($self,'dev', 'cmd', $cmd, @_) if $cmd ne 'log';
  #$self->{'log'}->($self,'dev', $self->{number},'cmd', $cmd, @_) if $cmd ne 'log';
  my ( $func, $handler );
  if ( $self->{'cmd'} and ref $self->{'cmd'}{$cmd} eq 'CODE' ) {
    $func    = $self->{'cmd'}{$cmd};
    $handler = '_cmd';
    unshift @_, $dst if $dst;
  } elsif ( ref $self->{$cmd} eq 'CODE' ) {
    $func = $self->{$cmd};
  } elsif ( $self->{'cmd'} and ref $self->{'cmd'}{ $dst . $cmd } eq 'CODE' ) {
    $func    = $self->{'cmd'}{ $dst . $cmd };
    $handler = '_cmd';
    #unshift @_, $dst if $dst;
  } elsif ( $func = $self->can($cmd) ) {
  }
  $self->handler( $cmd . $handler . '_bef_bef', \@_ );
  if ( $self->{'min_cmd_delay'}
    and ( time - $self->{'last_cmd_time'} < $self->{'min_cmd_delay'} ) )
  {
    $self->log( 'dbg', 'sleepcmd', $self->{'min_cmd_delay'} - time + $self->{'last_cmd_time'} );
    sleep( $self->{'min_cmd_delay'} - time + $self->{'last_cmd_time'} );
  }
  $self->{'last_cmd_time'} = time;
  $self->handler( $cmd . $handler . '_bef', \@_ );
  #$self->{'log'}->($self,'dev', $self->{number},'cmdrun', $dst, $cmd, @_, $func) if $cmd ne 'log';
  if ($func) {
    @ret = $func->( $self, @_ );    #$self->{'cmd'}{$cmd}->(@_);
  } elsif ( $self->{'adc'} and length $dst == 1 and length $cmd == 3 ) {
    @ret = $self->cmd_adc( $dst, $cmd, @_ );
  } elsif ( exists $self->{$cmd} ) {
    $self->log( 'dev', "cmd call by var name $cmd=$self->{$cmd}" );
    @ret = ( $self->{$cmd} );
  } else {
    $self->log(
      'dev',
      "UNKNOWN CMD(st[$self->{'status'}]):[$cmd]{@_}: please add \$dc->{'cmd'}{'$cmd'} = sub { ... };",
      "self=", ref $self,
      #Dumper $self->{'cmd'},
      $self->{'parse'}
    ) if !grep { $cmd eq $_ } qw(new init);
    $self->{'cmd'}{$cmd} = sub { }
      if $self->{'cmd'};
  }
  $ret = scalar @ret > 1 ? \@ret : $ret[0];
  $self->handler( $cmd . $handler . '_aft', \@_, $ret );
  if ( $self->{'cmd'} and $self->{'cmd'}{$cmd} ) {
    if    ( $self->{'auto_wait'} ) { $self->wait(); }
    elsif ( $self->{'auto_recv'} ) { $self->select(); }
  }
  $self->handler( $cmd . $handler . '_aft_aft', \@_, $ret );
  return wantarray ? @ret : $ret[0];
}

sub AUTOLOAD {
  #psmisc::printlog('autoload', $AUTOLOAD,@_);
  my $self = shift      || return;
  my $type = ref($self) || return;
  #my @p    = @_;
  my $name = $AUTOLOAD;
  $name =~ s/.*\://;
  #return $self->cmd( $name, @p );
  return $self->cmd( $name, @_ );
}

sub DESTROY {
  my $self = shift;
  #warn "DESTROY [$self->{number}]";
  #$self->log( 'dev', 'DESTROYing' );
  $self->destroy();
  --$global{'count'};
}

sub handler {
  my $self = shift;
  shift if ref $_[0];
  my $cmd = shift;
  #$self->log('dev', 'handler select', $cmd, $self->{'handler_int'}{$cmd}, $self->{'handler'}{$cmd});
  $self->{'handler_int'}{$cmd}->( $self, @_ )
    if $self->{'handler_int'}
    and ref $self->{'handler_int'}{$cmd} eq 'CODE';    #internal lib
  $self->{'handler'}{$cmd}->( $self, @_ )
    if $self->{'handler'} and ref $self->{'handler'}{$cmd} eq 'CODE';
}
#sub baseinit {
#my $self = shift;
#$self->{'number'} = ++$global{'total'};
#$self->myport_generate();
#$self->{'port'} = $1 if $self->{'host'} =~ s/:(\d+)//;
#$self->{'want'}     ||= {};
#$self->{'NickList'} ||= {};
#$self->{'IpList'}   ||= {};
#$self->{'PortList'} ||= {};
#++$global{'count'};
#$self->{'status'} = 'disconnected';
#$self->protocol_init( $self->{'protocol'} );
#}
sub func {
  my $self = shift;
  #$self->log( 'dev', 'func', __PACKAGE__, 'func', __FILE__, __LINE__ );
}

sub init_main {    #$self->{'init_main'} ||= sub {
  my $self = shift;
  #$self->log( 'dev', 'init', __PACKAGE__, 'func', __FILE__, __LINE__ , Dumper \@_);
  local %_ = @_;
  #warn Dumper \%_;
  #$self->log('dev', __LINE__, "Proto=$self->{Proto}");
  $self->{$_} = $_{$_} for keys %_;
  local %_ = (
    'recv'              => 'recv',
    'send'              => 'send',
    'Listen'            => 10,
    'Timeout'           => 10,                                                                #connect
    'Timeout_connected' => 300,
    'myport'            => 412,                                                               #first try
    'myport_base'       => 40000,
    'myport_random'     => 1000,
    'myport_tries'      => 5,
    'cmd_sep'           => ' ',
    'no_print'          => { map { $_ => 1 } qw(Search Quit MyINFO Hello SR UserCommand) },
    'log'               => sub (@) {
      my $self = ref $_[0] ? shift() : {};
      if ( ref $self->{'parent'}{'log'} eq 'CODE' ) {
        return $self->{'parent'}->log( "[$self->{'number'}]", @_ );
      }
      #utf8::valid(join '', @_) and
      print( join( ' ', "[$self->{'number'}]", @_ ), "\n" );
      #Dumper \
    },
    #'auto_recv'          => 1,
    #'max_reads' => 20,
    #'wait_once'          => 0.1,
    #'waits'             => 100,
    #'wait_finish_tries' => 600,
    #'wait_finish_by'    => 1,
    #'wait_connect_tries' => 600,
    'clients_max' => 50,
    #'wait_clients_tries' => 200,
    'wait_finish_tries' => 300,     #5 min
    'wait_clients'      => 300,     #5 min
                                    #del    'wait_clients_by'    => 0.01,
                                    #'work_sleep'        => 0.01,
    'work_sleep'        => 0.005,
    'select_timeout'    => 1,
    'cmd_recurse_sleep' => 0,
    #( $^O eq 'MSWin32' ? () : ( 'nonblocking' => 1 ) ),
    #'nonblocking' => 1,
    'informative' => [qw(number peernick status host port filebytes filetotal proxy bytes_send bytes_recv)],    # sharesize
         #'informative_hash' => [qw(clients)],                   #NickList IpList PortList
         #'disconnect_recursive' => 1,
    'reconnect_sleep' => 5,
    'partial_ext'     => '.partial',
    'file_send_by'    => 1024 * 1024,                     #1024 * 64,
    'local_mask_rfc'  => [qw(10 172.[123]\d 192\.168)],
    'status'          => 'disconnected',
    'time_start'      => time,
    #'peers' => {},
    'download_to' => './downloads/',
    #'partial_prefix' => './downloads/Incomplete/',
    #ADC
    #number => ++$global{'total'},
    #};
    'charset_fs' => (
      $^O eq 'MSWin32'
      ? 'cp1251'
        #: $^O eq 'freebsd' ? 'koi8r'
      : 'utf8'
    ),
    'charset_console' => ( $^O eq 'MSWin32' ? 'cp866' :
        #$^O eq 'freebsd' ? 'koi8r' :
        'utf8' ),
    'charset_protocol' => 'utf8',
    'charset_internal' => 'utf8',
    #charset_nick => 'utf8',
    'socket_class' => ( use_try('IO::Socket::IP') ? 'IO::Socket::IP' : 'IO::Socket::INET' ),
  );
  #$self->log(__LINE__, "Proto=$self->{Proto}, protocol=$self->{protocol} class $self->{'socket_class'}");
  $self->{'wait_connect_tries'} //= $self->{'Timeout'};
  $self->{$_} //= $self->{'parent'}{$_} ||= {} for qw(peers peers_sid peers_cid handler clients);    #want share_full share_tth
         #$self->{$_} ||= $self->{'parent'}{$_} ||= {}, for qw(   );
  $self->{$_} //= $self->{'parent'}{$_} ||= [] for qw(queue_download);
  $self->{$_} //= $self->{'parent'}{$_} ||= $global{$_} ||= {},
    for qw(sockets share_full share_tth want want_download want_download_filename downloading);
  $self->{$_} //= $self->{'parent'}{$_} ||= $global{$_}, for qw(db);
  $self->{'parent'}{$_} ? $self->{$_} //= $self->{'parent'}{$_} : ()
    for
    qw(log disconnect_recursive  partial_prefix partial_ext download_to Proto dev_ipv6 protocol myport_inc no_sctp_fallback)
    ;   #dev_adcs socket_class
        #$self->log( 'dev', "Proto=$self->{Proto}, Listen=$self->{Listen} protocol=$self->{protocol} inc=$self->{myport_inc}" );
  $self->{$_} //= { %{ $self->{'parent'}{$_} } } for qw(socket_options);    # clone, childs can change
  $self->{$_} //= $_{$_} for keys %_;
  $self->{'partial_prefix'} //= $self->{'download_to'} . 'Incomplete/';
  #$self->log(__LINE__, "Proto=$self->{Proto}, protocol=$self->{protocol} class $self->{'socket_class'} ");
  #$self->log("charset_console=$self->{charset_console} charset_fs=$self->{charset_fs}");
  #psmisc::printlog('dev', 'init0', Dumper $self);
}

sub myport_generate {    #$self->{'myport_generate'} ||= sub {
  my $self = shift;
  #$self->log( 'myport', "$self->{'myport'}: $self->{'myport_base'} or $self->{'myport_random'}" );
  return $self->{'myport'}
    unless $self->{'myport_base'}
    or $self->{'myport_random'};
  $self->{'myport'} = undef if $_[0];
  return $self->{'myport'} ||= $self->{'myport_base'} + $self->{'myport_inc'}++ if $self->{'myport_inc'};
  return $self->{'myport'} ||= $self->{'myport_base'} + int( rand( $self->{'myport_random'} ) );
}

sub select_add {         #$self->{'select_add'} ||= sub {
  my $self = shift;
#$self->{'select'} ||= $self->{parent}{'select'}         $self->{'select_send'} ||= $self->{parent}{'select_send'}    if $self->{parent};
#$self->{'sockets'} ||= $self->{parent}{'sockets'} if $self->{parent};
  $self->{$_} ||= $self->{parent}{$_} ||= $global{$_} ||= IO::Select->new() for qw (select select_send);
  #$self->{'select'}      ||= IO::Select->new();    #$self->{'socket'}
  #$self->{'select_send'} ||= IO::Select->new();    #$self->{'socket'}
  return unless $self->{'socket'};
  $self->{'select'}->add( $self->{'socket'} );
  $self->{'select_send'}->add( $self->{'socket'} );
  $self->{'sockets'}{ $self->{'socket'} } = $self;
  #$self->log( 'dev', 'add:', $self->{'socket'},' current select', $self->{'select'}->handles );
}
#$self->{'connect_check'} ||= sub {
sub connect_check {
  my $self = shift;
  #$self->log('dev', 'connect_check', " s=$self->{'status'}, i=$self->{'incoming'}");
  return 0
    if $self->{'Proto'} eq 'udp'
    or $self->{'incoming'}
    #or $self->{'status'} eq 'listening' or
    or $self->{'listener'}
    or (
    $self->{'socket'}
    #and $self->{'socket'}->connected()
    ) or !$self->active();
#$self->log(          'warn', 'connect_check: must reconnect', Dumper $self->{'socket'}->connected(), $self->{'socket'}, $self->{'status'});
  $self->{'status'} = 'reconnecting';
  $self->every(
    $self->{'reconnect_sleep'},
    $self->{'reconnect_func'} ||= sub {
      if ( $self->{'reconnect_tries'}++ < $self->{'reconnects'} ) {
        $self->log(
          'warn',
          "reconnecting ($self->{'host'}) [$self->{'reconnect_tries'}/$self->{'reconnects'}] every",
          $self->{'reconnect_sleep'}
        );
        $self->connect();
      } else {
        $self->{'status'} = 'disconnected';
      }
    }
  );
  return 1;
}

sub connect {    #$self->{'connect'} ||= sub {
  my $self = shift;
  #$self->log( 'c', 'connect0 inited', "MT:$self->{'message_type'}", ' with', $self->{'host'} );
  if ( $_[0] or $self->{'host'} =~ /:/ ) {
    $self->{'host'} = $_[0] if $_[0];
    $self->{'host'} =~ s{^(.*?)://}{};
    my $p = lc $1;
    $self->module_load('adcs') if $p eq 'adcs';
    #$self->protocol_init($p) if $p =~ /^adc/;
    $self->{'host'} =~ s{/.*}{}g;
    ( $self->{'host'}, $self->{'port'} ) = ( $1, $2 ) if $self->{'host'} =~ m{^\[(\S+)\]:(\d+)};     # [::1]:411
    ( $self->{'host'}, $self->{'port'} ) = ( $1, $2 ) if $self->{'host'} =~ s{^([^:]+):(\d+)$}{};    # 1.2.3.4:411
  }
  #$self->log('dev', 'host, port =', $self->{'host'}, $self->{'port'} );
  #$self->log( 'H:', ((),$self->{'host'} =~ /(:)/g)>1 );
  #$self->module_load('ipv6') if @{ [ $self->{'host'} =~ /(:)/g ] } > 1;
  #$self->{'port'} = $_[1] if $_[1];
  #print "Hhohohhhh" ,$self->{'protocol'},$self->{'host'};
  return 0
    if ( $self->{'socket'} and $self->{'socket'}->connected() )
    or grep { $self->{'status'} eq $_ } qw(destroy);    #connected
  $self->log(
    'info',
    "connecting to $self->{'protocol'}://[$self->{'host'}]:$self->{'port'} via $self->{'Proto'} class $self->{'socket_class'}",
    %{ $self->{'socket_options'} || {} }
  );
  #$self->{'status'}   = 'connecting';
  $self->{'status'}   = 'connecting_tcp';
  $self->{'outgoing'} = 1;
  #$self->{'port'}     = $1 if $self->{'host'} =~ s/:(\d+)//;
  delete $self->{'recv_buf'};
  #$self->log('dev', 'conn strt', $self->{'Timeout'}, $self->{'Proto'}, Socket::SOCK_STREAM);
  eval {
    $self->{'socket'} ||= $self->{'socket_class'}->new(
      'PeerAddr' => $self->{'host'},
      ( $self->{'port'}  ? ( 'PeerPort' => $self->{'port'} )  : () ),
      ( $self->{'Proto'} ? ( 'Proto'    => $self->{'Proto'} ) : () ),
      #( $self->{'Proto'} eq 'sctp' ? ( 'Type' => Socket::SOCK_STREAM ) : () ),
      #'Timeout'  => $self->{'Timeout'},
      #(
      #$self->{'nonblocking'} ? (
      'Blocking'   => 0,
      #'MultiHomed' => 1,    #del
                            #) : ()
                            #),
      %{ $self->{'socket_options'} },
      %{ $self->{'socket_options_connect'} },
    );
  };
  #$self->log('dev', 'connect end');
  $self->log(
    'err',
    "connect socket  error: $@,",
    Encode::decode( $self->{charset_fs}, $!, Encode::FB_WARN ),
    "[$self->{'socket'}]"
    ),
    return 1
    if !$self->{'socket'};
  #$self->log( 'dev',  'timeout to', $self->{'Timeout'});
  $self->{'socket'}->timeout( $self->{'Timeout'} ) if $self->{'Timeout'};    #timeout must be after new, ifyou want nonblocking
       #$self->log( 'dev',  'ssltry'), IO::Socket::SSL->start_SSL($self->{'socket'}) if $self->{'protocol'} eq 'adcs';
       #$self->log( 'err', "connect socket  error: $@, $! [$self->{'socket'}]" ), return 1 if !$self->{'socket'};
       #$self->{'socket'}->binmode(":encoding($self->{charset_protocol})");
       #$self->{charset_protocol} = 'utf8';
       #$self->log( 'dev', "set encoding of socket to [$self->{charset_protocol}]");
       #    binmode($self->{'socket'}, ":encoding($self->{charset_protocol})");
       #    binmode($self->{'socket'}, ":raw:encoding($self->{charset_protocol})");
       #    binmode($self->{'socket'}, ":encoding($self->{charset_protocol}):bytes");
       #    binmode($self->{'socket'}, ":$self->{charset_protocol}");
       #eval {$self->{'socket'}->fcntl( Fcntl::O_ASYNC,1);};    $self->log('warn', "cant Fcntl::O_ASYNC : $@") if $@;
       #eval {$self->{'socket'}->fcntl( Fcntl::O_NONBLOCK,1);};    $self->log('warn', "cant Fcntl::O_NONBLOCK : $@") if $@;
  $self->select_add();
  $self->{time_start} = time;
  #$self->log($self, 'connected2 inited',"MT:$self->{'message_type'}", ' with');
  #$self->log( 'dev', "connect_aft after", );
  #!!$self->select();
  #$self->log( 'dev', "connect after", );
  return 0;
}

sub connected {    #$self->{'connected'} ||= sub {
  my $self = shift;
  $self->get_my_addr();
  #$self->log( 'info', 'broken socket, cant get my ip'),
  #$self->destroy(),
  return unless $self->{'myip'};
  $self->{'status'} = 'connecting';
#$self->log( 'dev', "connected0", "[$self->{'socket'}] c=", $self->{'socket'}->connected(), 'p=', $self->{'socket'}->protocol() );
#$self->log( 'dev',  'timeout to', $self->{'Timeout_connected'});
  $self->{'socket'}->timeout( $self->{'Timeout_connected'} ) if $self->{'Timeout_connected'};
  $self->get_peer_addr();
  #$self->get_my_addr();
  #!$self->{'hostip'} ||= $self->{'host'};
  #my $localmask ||= join '|', @{ $self->{'local_mask_rfc'} || [] }, @{ $self->{'local_mask'} || [] };
  my $localmask ||= join '|', map { ref $_ eq 'ARRAY' ? @$_ : $_ }
    grep { $_ } $self->{'local_mask_rfc'},
    $self->{'local_mask'};
  my $is_local_ip = sub ($) {
    #$self->log( 'info', "test ip [$_[0]] in [$localmask] ");
    return $_[0] =~ /^(?:$localmask)\./;
  };
  $self->log( 'info', "my internal ip detected, using passive mode", $self->{'myip'}, $self->{'hostip'}, $localmask ),
    $self->{'M'} = 'P'
    if !$self->{'M'}
    and $is_local_ip->( $self->{'myip'} )
    and !$is_local_ip->( $self->{'hostip'} );
  $self->{'M'} ||= 'A';
  #$self->log( 'info', "mode set [$self->{'M'}] ");
  $self->log( 'info', "connect to $self->{'host'}($self->{'hostip'}):$self->{'port'} [me=$self->{'myip'}] ok ", );
  #$self->log( $self, 'connected1 inited', "MT:$self->{'message_type'}", ' with' );
  #$self->log( 'dev',  'ssltry'),IO::Socket::SSL->start_SSL($self->{'socket'}) if $self->{'protocol'} eq 'adcs';
  $self->connect_aft();
}

sub reconnect {    #$self->{'reconnect'} ||= sub {
  my $self = shift;
  #$self->log(          'dev', 'reconnect');
  $self->disconnect();
  $self->{'status'} = 'reconnecting';
  #!sleep $self->{'reconnect_sleep'};
  #!$self->connect();
}

sub listen {    #$self->{'listen'} ||= sub {
  my $self = shift;
  $self->log( 'err', 'listen off', "[$self->{'Listen'}] [$self->{'M'}] [$self->{'allow_passive_ConnectToMe'}]" ), return
    if !$self->{'Listen'};
  #or ( $self->{'M'} eq 'P' and !$self->{'allow_passive_ConnectToMe'} );    #RENAME
  $self->{'listener'} = 1;
  $self->myport_generate();
  #$self->log( 'dev', 'listen', "p=$self->{'myport'}; proto=$self->{'Proto'} cl=$self->{'socket_class'}",'sockopts', Dumper $self->{'socket_options'}, $self->{'socket_options_listen'} );
  for ( 1 .. $self->{'myport_tries'} ) {
    local @_ = (
      'LocalPort' => $self->{'myport'},
      #'Proto'     => $self->{'Proto'} || 'tcp',
      ( $self->{'Proto'} ? ( 'Proto' => $self->{'Proto'} ) : () ),
      (
        $self->{'Proto'} ne 'udp'
        ? ( 'Listen' => $self->{'Listen'} )
        : ()
      ),
      #( $self->{'Proto'} eq 'sctp' ? ( 'Type' => Socket::SOCK_STREAM ) : () ),
      #( $self->{'nonblocking'} ? ( 'Blocking' => 0 ) : () ),
      Blocking  => 0,
      #ReuseAddr => 1,
      %{ $self->{'socket_options'} },
      %{ $self->{'socket_options_listen'} },
    );
    #$self->log( 'dev', 'listen', $self->{'socket_class'}, @_);
    eval { $self->{'socket'} ||= $self->{'socket_class'}->new(@_); };
    $self->select_add(), last if $self->{'socket'};
    $self->log( 'err', "listen [$_/$self->{'myport_tries'}] ($self->{'Listen'}) $self->{'myport'} socket error: $@" ),
      $self->myport_generate(1),
      unless $self->{'socket'};
  }
  $self->log( 'err', 'cant listen' ), return unless $self->{'socket'};
  eval { $self->{'listener'} = $self->{'socket'}->sockhost; };
  $self->log( 'info', "listening", $self->{'listener'}, "$self->{'myport'} $self->{'Proto'} with $self->{'socket_class'}" );
  $self->{'accept'} = 1 if $self->{'Proto'} ne 'udp';
  $self->{'status'} = 'listening';
  #$self->select();
}

sub disconnect {    #$self->{'disconnect'} ||= sub {
  my $self = shift;
  #$self->log('dev', 'in disconnect', $self->{'status'}, caller);
  #$self->log( 'dev', "[$self->{'number'}] status=",$self->{'status'}, $self->{'destroying'});
  $self->handler('disconnect_bef');
  $self->{'status'} = 'disconnected';
  if ( $self->{'socket'} ) {
    #$self->log( 'dev', "[$self->{'number'}] Closing socket",
    $self->{'select'}->remove( $self->{'socket'} )      if $self->{'select'};
    $self->{'select_send'}->remove( $self->{'socket'} ) if $self->{'select_send'};
    delete $self->{'sockets'}{ $self->{'socket'} };
    #$self->{'socket'}->shutdown(2);
    $self->{'socket'}->close();
    delete $self->{'socket'};
  }
#delete $self->{'select'};
#$self->log('dev',"delclient($self->{'clients'}{$_}->{'number'})[$_][$self->{'clients'}{$_}]\n") for grep {$_} keys %{ $self->{'clients'} };
#$self->log('dev', 'run file_close');
  $self->file_close();
  if ( $self->{'disconnect_recursive'} ) {
    for my $client (
      grep {
        #$self->{'clients'}{$_} and
        !$self->{'clients'}{$_}{'auto_listen'}
      }
      #keys %{ $self->{'clients'} }
      $self->clients_my()
      )
    {
      #next if $self->{'clients'}{$client} eq $self;
      #$self->log( 'dev', "destroy cli", $self->{'clients'}{$_}, ref $self->{'clients'}{$_} ),
      #$self->{'clients'}{$client}->destroy()
      $self->{'clients'}{$client}->disconnect() if ref $self->{'clients'}{$client};
      #and $self->{'clients'}{$client}{'destroy'};
      $self->{$_} += $self->{'clients'}{$client}{$_} for qw(bytes_recv bytes_send);
      #%{$self->{'clients'}{$client}} = ();
      delete $self->{'clients'}{$client};
    }
  }
  $self->handler('disconnect_aft');
  delete $self->{$_} for qw(NickList IpList PortList PortList_udp peers peers_cid peers_sid);
  #$self->log( 'info', "disconnected", __FILE__, __LINE__ );
  #$self->log('dev', caller($_)) for 0..5;
}
#$self->{'destroy'} ||= sub {
sub destroy {
  my $self = shift;
  #$self->log('dev', 'in destroy');
  $self->disconnect();    # if ref $self and !$self->{'destroying'}++;
                          #!?  delete $self->{$_} for keys %$self;
  $self->info();
  $self->{'status'} = 'destroy';
  delete $self->{$_} for grep { ref $self->{$_} and !ref $self->{$_} eq 'CODE' } keys %$self;
  #$self = {};
  #!?%$self = ();
}

sub recv {    # $self->{'recv'} ||= sub {
  my $self   = shift;
  my $client = shift;
  #my $socket = shift;
  #$self->log( 'dev', 'recv', $client, $self->{'socket'}, $self->{'accept'});
  if (
    $self->{'accept'}
    #and $client eq $self->{'socket'}
    )
  {
    local $_ = $self->{'socket'}->accept();
    if ($_) {
      #$self->log( 'traceDEV', 'DC::recv', 'accept', $self->{'incomingclass'} );
      $self->log( 'err', 'cant accept, no incomingclass' ), return,
        unless $self->{'incomingclass'};
      #my $host = $_->peerhost;
      my ($host) = socket_addr $_;
#;    # || $self->{parent}{'allow'};
#$self->log( 'info', "incoming [$host] (".ref($_).")to $self->{'incomingclass'}", ($self->{'allow'} ? "allow=$self->{'allow'}" : ()) );
      $self->log(
        'info',
        "incoming [$host] (" . ref($_) . ") to $self->{'incomingclass'}",
        ( $self->{'allow'} ? "allow=$self->{'allow'}" : () )
      );
      if ( my $allow = $self->{'allow'} ) {
        #my ( undef, $host ) = socket_addr $_;
        $self->log( 'warn', "disallowed connect from $host" ), return
          unless $host eq $allow;
      }
      #$self->log( 'dev', "incp[$self->{'protocol'}]");
      $_ = $self->{'incomingclass'}->new(
        #%$self,                                clear(),
        'socket'    => $_,
        'LocalPort' => $self->{'myport'},
        'incoming'  => 1,
#'want'         => \%{ $self->{'want'} },                'NickList'     => \%{ $self->{'NickList'} },                'IpList'       => \%{ $self->{'IpList'} },                'PortList'     => \%{ $self->{'PortList'} },
#'want'         => $self->{'want'},
#'NickList'     => $self->{'NickList'},
#'IpList'       => $self->{'IpList'},
#'PortList'     => $self->{'PortList'},
#'auto_listen' => 0, 'auto_connect' => 0,
        'parent' => $self,
        #'share_tth'      => $self->{'share_tth'},
        'status' => 'connected',
        #$self->incomingopt(),
        %{ $self->{'incomingopt'} || {} },
      );
      my $name = ( $_->{hostip} || $_->{host} ) . ( $_->{port} ? ':' : () ) . $_->{port};
      $self->{'clients'}{$name} ||= $_;
      $self->{'clients'}{$name}->select_add();
      #$self->log( 'dev', 'child created',            $_,   $self->{'clients'}{$_});
      #++$ret;
    } else {
      $self->log( 'err', "Accepting fail! ($_) [$self->{'Proto'}]", $!, $@ );
    }
    #next;
    return;
  }
  $self->log( 'dev', "SOCKERR", $client, $self->{'socket'}, $self->{'select'} )
    if $client ne $self->{'socket'};
  $self->{'databuf'} = '';
  #my $r;
  my $recv = $self->{'recv'};
  if ( (!defined( $self->{'recv_addr'} = $client->$recv( $self->{'databuf'}, POSIX::BUFSIZ, $self->{'recv_flags'} ) )
    or !length( $self->{'databuf'} )) and $recv ~~ 'recv' )
  {
    #TODO not here
    if (
      $self->active()
      and !$self->{'incoming'}
      #and $self->{'reconnect_tries'}++ < $self->{'reconnects'}
      )
    {
      $self->log( 'dcdbg',
        "recv err, reconnect [$self->{'reconnect_tries'}/$self->{'reconnects'}]. d=[$self->{'databuf'}] i=[$self->{'incoming'}]"
      );
      #$self->log( 'dcdbg',  "recv err, reconnect," );
      $self->reconnect();
    } elsif ( $self->{'status'} ne 'listening' ) {
      $self->log( 'dcdbg', "recv err, destroy," );
      $self->destroy();
    }
  } else {
    #++$readed;
    #++$ret;
    $self->{bytes_recv} += length $self->{'databuf'};
    $self->{activity} = time;
    #$self->log( 'dcdmp', "[$self->{'number'}]", "raw recv ", length( $self->{'databuf'} ), $self->{'databuf'} );
  }
  #$self->log( 'dcdmp', "0rawrawrcv [fh:$self->{'filehandle'}]:", $self->{'databuf'} );
  if ( $self->{'filehandle'} ) {
    $self->file_write( \$self->{'databuf'} );
  } elsif ( length $self->{'databuf'} ) {
    #$self->log( 'dcdmp', "rawrawrcv:", $self->{'databuf'} );
    $self->{'recv_buf'} .= $self->{'databuf'};
    #$self->log( 'dcdmp', "rawrawbuf:", $self->{'recv_buf'} );
    local $self->{'cmd_aft'} = "\x0A"
      if !$self->{'adc'}
      and $self->{'recv_buf'} =~ /^[BCDEFHITU][A-Z]{,5} /;
#$self->log( 'dcdbg', "[$self->{'number'}]", "raw to parse [$self->{'buf'}] sep[$self->{'cmd_aft'}]" ) unless $self->{'filehandle'};
    $self->{'recv_buf'} .= $self->{'cmd_aft'}
      if $self->{'Proto'} eq 'udp' and $self->{'status'} eq 'listening';
    while ( $self->{'recv_buf'} =~ s/^(.*?)\Q$self->{'cmd_aft'}//s ) {
      local $_ = $1;
      #$self->log('dcdmp', 'DC::recv', "parse [$_]($self->{'cmd_aft'})");
      last if $self->{'status'} eq 'destroy';
      #$self->log( 'dcdbg',"[$self->{'number'}] dev cycle ",length $_," [$_]", );
      last unless length $_ and length $self->{'cmd_aft'};
      next unless length;
      $self->get_peer_addr_recv() if $self->{'broadcast'};
      $_ = Encode::decode $self->{charset_protocol}, $_, Encode::FB_WARN;
      #        $Encode::encode $self->{charset_console},
      $self->parser($_);
      #$self->log( 'dcdbg', "[$self->{'number'}]", "left to parse [$self->{'buf'}] sep[$self->{'cmd_aft'}] now was [$_]" );
      last if ( $self->{'filehandle'} );
    }
    $self->file_write( \$self->{'recv_buf'} ), $self->{'recv_buf'} = ''
      if length( $self->{'recv_buf'} )
      and $self->{'filehandle'};
  }
}

sub select {    #$self->{'select'} ||= sub {
  my $self = shift;
  #$self->{'recv_runned'}{ $self->{'number'} } = 1;
  my $sleep  = shift || $self->{'select_timeout'};
  my $nosend = shift;
  my $ret    = 0;
  #$self->connect_check();
  #$self->log( 'dev', 'cant recv, ret' ),
  #return unless $self->{'socket'} and ( $self->{'status'} eq 'listening' or $self->{'socket'}->connected );
  #$self->{'select'} = IO::Select->new( $self->{'socket'} ) if !$self->{'select'} and $self->{'socket'};
  #my ( $readed, $reads );
  #$self->{'databuf'} = '';
  #$self->log( 'dev', 'select', 'bef', $sleep, $nosend , ) if $nosend;
  my ( $recv, $send, $exeption ) =
    IO::Select->select( $self->{'select'}, ( $nosend ? undef : $self->{'select_send'} ), $self->{'select'}, $sleep );
#$self->log( 'traceD', 'DC::select', 'aft' , Dumper ($recv, $send, $exeption));
#schedule(10, sub {        $self->log( 'dev', 'DC::select', 'aft' , Dumper ($recv, $send, $exeption), 'from', $self->{'select'}->handles() ,    'and ', $self->{'select_send'}->handles());        });
#$self->{'select'}->remove(@$exeption) if $exeption;
#for ( keys %{ $self->{sockets} } ) {
#$self->log( 'tracez', 'C:', $self->{sockets}{$_}{socket}, $self->{sockets}{$_}{socket}->connected());
#}
  for (@$exeption) {
    #$self->log( 'dcdbg', 'exeption', $_, $self->{sockets}{$_}{number} ),
    #$self->{'select'}->remove($_);
    #can_run( $self->{sockets}{$_}, 'destroy' );
    can_run( $self->{sockets}{$_}, 'reconnect' );
    #$self->{sockets}{$_}->destroy() if ref $self->{sockets}{$_};
    delete $self->{sockets}{$_};
    ++$ret,;
  }
  #for (@$recv, @$send) {

=hm
  for ( keys %{ $self->{sockets} } ) {
    #$self->log( 'dev', 'connected chk' , $self->{sockets}{$_}{socket}, $self->{sockets}{$_}{socket}->connected());
    #$self->log( 'dev', 'connected call' ),
    $self->{sockets}{$_}->connected(), ++$ret,
      if $self->{sockets}{$_}{status} eq 'connecting_tcp' and $self->{sockets}{$_}{socket}->connected();
  }
=cut
  for (@$send) {
    next unless $self->{sockets}{$_} and $self->{sockets}{$_}{socket};
    #$self->log('connect test', $self->{sockets}{$_}{status}, $self->{sockets}{$_}{socket}->connected(), caller);
    #$self->{'select'}->remove($_),
    $self->{sockets}{$_}->connected(),
      #can_run($self->{sockets}{$_}, 'connected'),
      ++$ret,
      if $self->{sockets}{$_}{status} eq 'connecting_tcp';
    # and $self->{sockets}{$_}{socket}->connected();
    #$self->log( 'err', 'no object for send handle',$_,  ) , next , unless $self->{sockets}{$_};
    #++$self->{sockets}{$_}{send_can};
    #$self->log( 'dev', 'can_send', $_, $self->{sockets}{$_}{number}, $self->{sockets}{$_}{send_can} );
    #$ret += $self->{sockets}{$_}->send_can();
    $ret += can_run( $self->{sockets}{$_}, 'send_can' );
    if ( $self->{sockets}{$_}{'filehandle_send'} ) {
      $ret += $self->{sockets}{$_}->file_send_part();
    }
    #$self->{sockets}{$_}->send();
  }
  for (@$recv) {
    #next unless $self->{sockets}{$_};
    $self->log( 'err', 'no object for recv handle', $_, Dumper $self->{sockets}{$_} ),
      can_run( $self->{'select'}, 'remove', $_ ), next,
      #if !$self->{sockets}{$_} or !ref $self->{sockets}{$_};
      if !ref $self->{sockets}{$_} or ref $self->{sockets}{$_} eq 'HASH';
    #$self->log( 'dev',ref $self->{sockets}{$_});
    $ret += $self->{sockets}{$_}->recv($_);
  }
  #if ( $self->{'filehandle_send'} ) { $self->file_send_part(); }
  #$self->{'recv_runned'}{ $self->{'number'} } = undef;
  return $ret;
}

=no
sub wait {    #$self->{'wait'} ||= sub {
  my $self = shift;
  my ( $waits, $wait_once ) = @_;
  $waits ||= $self->{'waits'};
  #$wait_once ||= $self->{'wait_once'};
  local $_;
  my $ret;
  #$self->log( 'dev', "start wait", $waits, caller, '::::', caller 1, );
  while ( --$waits > 0 and !$ret ) {
    #$ret += $self->select($wait_once);
    last unless $self->active();
    $ret += $self->select(undef, 1);
    #$self->log( 'dev', "wait", $waits, $ret);
    #sleep 0.1 if !$ret;
  }
  #$ret += $self->work($wait_once) while --$waits > 0 and !$ret;
  return $ret;
}
=cut

sub finished {    #$self->{'finished'} ||= sub {
  my $self = shift;
  $self->log( 'dcdev', 'not finished file:', "$self->{'filebytes'} / $self->{'filetotal'}", $self->{'peernick'} ), return 0
    if ($self->{'filebytes'}
    and $self->{'filetotal'}
    and $self->{'filebytes'} < $self->{'filetotal'} - 1 );
  local @_;
  $self->log( 'dcdev', 'not finished clients:', @_ ), return 0
    if @_ =
    grep { !$self->{'clients'}{$_}->finished() } $self->clients_my();    #keys %{ $self->{'clients'} };
  return 1;
}

sub wait_connect {                                                       #$self->{'wait_connect'} ||= sub {
  my $self = shift;
  #$self->log( 'dev', "wait_connect", $self->{'wait_connect_tries'});
  for ( 0 .. ( $_[0] || $self->{'wait_connect_tries'} ) ) {
    #$self->log('dev', 'ws', $self->{'status'}, $_, ( $_[0] , $self->{'wait_connect_tries'}));
    last if grep { $self->{'status'} eq $_ } qw(connected transfer disconnecting disconnected destroy), '';
    #$self->wait(1);
    $self->work(1);
  }
  return $self->{'status'};
}

sub wait_finish {                                                        #$self->{'wait_finish'} ||= sub {
  my $self = shift;
  my $time = time() + ( shift || $self->{'wait_finish'} );
  while ( $time > time() ) {
    #for ( 0 .. $self->{'wait_finish_tries'} ) {
    last if $self->finished();
    #$self->wait( undef, $self->{'wait_finish_by'} );
    #$self->log( 'dev', 'wait_finish', $_);
    #$self->wait();
    $self->work(1);
    #$self->work( undef, $self->{'wait_finish_by'} );
  }
  local @_;
  $self->info(),
    $self->log(
    'info',
    'finished, but clients still active:',
    map { "[$self->{'clients'}{$_}{'number'}]$_;st=$self->{'clients'}{$_}{'status'}" } @_
    ) if @_ = $self->clients_my();    #keys %{ $self->{'clients'} };
}

sub wait_clients {                    #$self->{'wait_clients'} ||= sub {
  my $self = shift;
  #for my $n ( 0 .. $self->{'wait_clients_tries'} ) {
  my $time = time() + ( shift || $self->{'wait_clients'} );
  while ( $time > time() ) {
    local @_;
    last
      if !$self->{'clients_max'}
      or $self->{'clients_max'} > ( @_ = $self->clients_my() );    #keys %{ $self->{'clients'} };
    $self->info() unless $_;
    $self->log(
      'info', "wait clients",
      scalar( @_ = $self->clients_my() ) . "/$self->{'clients_max'}  ",
      int( $time - time() )
    );
    #$self->wait( undef, $self->{'wait_clients_by'} );
    $self->work(10);
  }
}
#sub wait_sleep {                                                     #$self->{'wait_sleep'} ||= sub {
sub wait {                                                         #$self->{'wait_sleep'} ||= sub {
  my $self = shift;
  my $ret;
  my $time = time() + ( shift || 1 );
  #$self->log( 'dev', "wait_sleep", $time );
  while ( $time > time() ) {
    last unless $self->active();
    #$ret += $self->wait(@_);
    $ret += $self->select() || $self->select( 1, 1 );
  }
  return $ret;
  #$self->log( 'dev', "wait_sleep",$starttime , $how , time(), "==", $starttime + $how),
  #$self->work(@_) while $starttime + $how > time();
}

sub work {    #$self->{'work'} ||= sub {
  my $self   = shift;
  #$self->log( 'dev', 'work', ref $self->{parent}, $self->{parent});
  return $self->{parent}->work(@_) if is_object($self->{parent});
  my @params = @_;
  #$self->periodic();
  #$self->log( 'dev', 'work', @params);
  code_run $self->{'auto_work'}, @params;    # if ref $self->{'auto_work'} eq 'CODE';
  schedule(
    1,
    our $___work_every ||= sub {
      my $self = shift;
      $self->connect_check();
      code_run( $_, $self ) for values %{ $self->{periodic} || {} };
      #print ("P:$_\n"),
      #$self->{periodic}{$_}->() for grep {ref$self->{periodic}{$_} eq 'CODE'}keys %{$self->{periodic} || {}};
      #$self->log('dev', 'work for', keys %{$self->{'clients'}});
      for (
        keys %{ $self->{'clients'} }
        #$self->clients_my()
        )
      {
        if (
             !$self->{'clients'}{$_}{'socket'}
          or !length $self->{'clients'}{$_}{'status'}
          or $self->{'clients'}{$_}{'status'} eq 'destroy'
          or (  $self->{'clients'}{$_}{'status'} ne 'listening'
            and $self->{'clients'}{$_}{'status'} ne 'working'
            and $self->{'clients'}{$_}{inactive_timeout}
            and time - $self->{'clients'}{$_}{activity} > $self->{'clients'}{$_}{inactive_timeout} )
          )
        {
          $self->log(
            'dev',
"del client[$self->{'clients'}{$_}{'number'}][$_] socket=[$self->{'clients'}{$_}{'socket'}] status=[$self->{'clients'}{$_}{'status'}] listener=[$self->{'listener'}] last active=",
            int( time - $self->{'clients'}{$_}{activity} )
          );
          #(
          #!ref $self->{'clients'}{$_}{destroy} ? () :
          #  $self->{'clients'}{$_}->destroy()
          #);
          #%{$self->{'clients'}{$_}} = (),
          delete $self->{'clients'}{$_};
          #$self->log('dev', "now clients", map { "$_" }sort keys %{ $self->{'clients'} });
          next;
        }
        #$ret += $self->{'clients'}{$_}->recv();
        #$self->log('dev', 'work', $self->{'clients'}{$_}{'number'}, $self->{'clients'}{$_}, $self);
        #next if $self->{'clients'}{$_} eq $self;
        #$self->{'clients'}{$_}->work();
      }
      for ( keys %{ $self->{'sockets'} } ) {
        next if $self->{'sockets'}{$_} and %{ $self->{'sockets'}{$_} };
        delete $self->{'sockets'}{$_};
      }
#$self->log('dev', 'parent:', $self->{parent}, $self->{parent}{parent}, is_object($self->{parent}));
      if ( !$self->{parent} or !$self->{parent}{parent} ) {    # first parent always autocreated on init
        code_run( $self->{$_}, $self ) for qw(worker);         #auto_work
      }
      #$self->log('dev', 'work parent',  scalar keys %{ $self->{parent}} , scalar keys %{ $self->{parent}{parent}}   );
      for (
        grep { $self->{'clients'}{$_} ne $self }
        keys %{ $self->{'clients'} }
        #$self->clients_my()
        )
      {
        #$self->log('dev', 'starting work on', $self->{'clients'}{$_}{'number'}, $self,$self->{'clients'}{$_});
        $self->{'clients'}{$_}->work() if $self->{'clients'}{$_};
      }
    },
    $self
  );
  schedule(
    10,
    our $___work_downloader ||= sub {
      my $self = shift;
      return unless $self->active();
      return if $self->{'status'} eq 'listening';
      my $time = time;
      for my $tth ( keys %{ $self->{'downloading'} } ) {
        if (  $self->{'downloading'}{$tth}{connect_start}
          and $self->{'downloading'}{$tth}{connect_start} < $time - 60 )
        {
          #$self->log('dev', 'want', $tth,'no connection, return to want queue');
          $self->{'want_download'}{$tth} = $self->{'downloading'}{$tth};
          delete $self->{'downloading'}{$tth};
        }
      }
      for my $tth ( keys %{ $self->{'want_download'} } ) {
        delete $self->{'want_download'}{$tth}{connect_start};
      }
      if ( $self->{'queue_download'}
        and @{ $self->{'queue_download'} } )
      {
        my $file = shift @{ $self->{'queue_download'} };
        $self->search($file);
      }
      #if (!)
      #=todo
      #$self->log('dev', 'work want:', Dumper $self->{'want_download'});
      for my $tth (
        grep { keys %{ $self->{'want_download'}{$_} } }
        keys %{ $self->{'want_download'} }
        )
      {
        my $wdls = $self->{'want_download'}{$tth} || {};
        local @_ = (
          #grep { $wdls->{$_}{slotsfree} or $wdls->{$_}{SL} }
          sort {
            $wdls->{$a}{tries} <=> $wdls->{$b}{tries}
              or ( $wdls->{$b}{slotsfree} || $wdls->{$b}{SL} ) <=> ( $wdls->{$a}{slotsfree} || $wdls->{$a}{SL} )
          } keys %$wdls
        );
        #$self->log('dev', 'from can:',     @_   );
        if ( my ($fromk) = $_[0] ) {
          my $from = $wdls->{$fromk};
          my ($filename);
          for my $file ( keys %{ $self->{'want_download_filename'}{$tth} } ) {
            my $partial = $file;
            $partial = $self->{'partial_prefix'} . $partial . $self->{'partial_ext'};
            $partial = Encode::encode $self->{charset_fs}, $file, Encode::FB_WARN
              if $self->{charset_fs};
            if ( -s $partial ) {
              $self->log( 'dev', 'already downloading: ', $file, -s $partial );
              $filename = $file;
              last;
            }
          }
          $filename //= (
            sort { $self->{'want_download_filename'}{$tth}{$a} <=> $self->{'want_download_filename'}{$tth}{$b} }
              keys %{ $self->{'want_download_filename'}{$tth} }
          )[0];
          $filename //= $from->{FN};
          $filename =~ s{^.*[/\\]}{}g;
#$self->log( "selected22 [$filename] keys",( grep { $wdls->{$_}{slotsfree} or $wdls->{$_}{SL} } sort {$wdls->{$b}{tries} <=> $wdls->{$a}{tries} }keys %$wdls  ),"    from", Dumper $from,);
#my $dst = $self->{'get_dir'} . $filename;
          my $size = $from->{size} || $from->{SI} || 0;
          #my $sizenow = -s $dst || 0;
          #$self->log( 'dcdev', "selected23 -e $dst and ( !$size or $sizenow < $size" );
          #if ( !-e $dst or ( !$size or $sizenow < $size ) ) {
          ++$self->{'want_download'}{$tth}{$fromk}{tries};
          $self->get(
            $from->{nick} || $from->{CID} || $from->{NI},
            #'TTH/' . $tth,
            undef, $filename, undef, undef, $size, $tth
          );
          $self->{'downloading'}{$tth} = $self->{'want_download'}{$tth};
          $self->{'downloading'}{$tth}{connect_start} = $time;
          delete $self->{'want_download'}{$tth};
          last;
          #}
          #$work{'tthfrom'}{$s{tth}}
        }
      }
      #=cut
    },
    $self
  );
  schedule(
    [ $self->{dev_auto_dump_first} || 20, $self->{dev_auto_dump_every} || 100 ],
    our $dump_sub__ ||= sub {
      my $self = shift;
      $self->dumper();
    },
    $self
  ) if $self->{dev_auto_dump};
  #return
  $self->select( 1 || $self->{'work_sleep'} );    # if @{$self->{send_buffer_raw}|| []};    # maybe send
                                                  #$self->log( 'dev', "work -> sleep", @params ),
  return $self->wait(@params) if @params;
  return
       $self->select( undef, 1 )
    || $self->select( $self->{'work_sleep'} )
    || $self->select( undef, 1 );                 # unless @{$self->{send_buffer_raw}|| []};
                                                  #return $self->select( $self->{'work_sleep'} );
}

sub dumper {                                      #$self->{'dumper'} ||= sub {
  my $self = shift;
  my $file = $_[0] || $self->{dev_auto_dump_file} || $0 . ( $self->{dev_auto_dump_timed} ? '.' . time : () ) . '.dump';
  open my $fh, '>', $file or return;
  print $fh Dumper $self;
  close $fh;
  $self->log( 'dev', "Writed dump", -s $file );
}

sub parser {                                      #$self->{'parser'} ||= sub {
  my $self = shift;
  for ( local @_ = @_ ) {
    $self->log(
      'dcdmp',
      "rawrcv["
        . (
          $self->{'recv_hostip'}
        ? $self->{'recv_hostip'} . ':' . $self->{'recv_port'}
        : $self->{'host'}
        )
        . "]:",
      $_
    );
    my ( $dst, $cmd, @param );
    if (/^[<*]/) {
      $cmd = ( $self->{'status'} eq 'connected' ? 'chatline' : 'welcome' );
    }
    s/^\x00*\$?([\w\-]+)\s*//, $cmd = $1 unless $cmd; # \x00 - ssl bug on recv
    #$self->log('dev',"cmd[", Dumper($cmd),"], adc=", $self->{'adc'} );
    if ( $self->{'adc'} ) {
      $cmd =~ s/^([BCDEFHIU])//, $dst = $1;
      @param = ( [$dst], split / / );
      if ( $dst eq 'B'
        or $dst eq 'F'
        or $dst eq 'U'
        or $self->{broadcast} )
      {
        #$self->log( 'dcdmp', "P0 $dst$cmd p=",(Dumper \@param));
        #push @{ $param[0] }, shift@param;
        push @{ $param[0] }, splice @param, 1, 1;
        #$self->log( 'dcdmp', "P0 $dst$cmd p=",(Dumper \@param));
        if ( $dst eq 'F' ) {
          #$self->log( 'dcdmp', 'feature'
          push @{ $param[0] }, splice @param, 1, 1 while $param[1] =~ /^[+\-]/;
        }
        #$self->log( 'dcdmp', "P1 $dst$cmd p=",(Dumper \@param));
      } elsif ( $dst eq 'D' or $dst eq 'E' ) {
        #push @{ $param[0] }, shift@param, shift@param;
        push @{ $param[0] }, splice @param, 1, 2;
      }
      #elsif ( $dst eq 'I'  ) { push @{ $param[0] }, undef }
    } else {
      @param = ($_);
    }
    #$self->log( 'dcdmp', "P3 $dst$cmd p=",(Dumper \@param));
    $cmd = $dst . $cmd
      if !exists $self->{'parse'}{$cmd}
      and exists $self->{'parse'}{ $dst . $cmd };
    #$self->log( 'dcinf', "UNKNOWN PEERCMD:[$cmd]->($_) : please add \$dc->{'parse'}{'$cmd'} = sub { ... };" ),
    $self->{'parse'}{$cmd} = sub { }, $cmd = ( $self->{'status'} eq 'connected' ? 'chatline' : 'welcome' )
      if $self->{'nmdc'} and !exists $self->{'parse'}{$cmd};
    if ( $cmd eq 'chatline' or $cmd eq 'welcome' or $cmd eq 'To' ) {
      #$self->log( 'dev', 'RCV pre encode', ($self->{charset_chat} ), @param, Dumper \@param);
      #$_ =  Encode::decode(($self->{charset_chat} ), $_) for @param;
      #!        $_ = Encode::encode $self->{charset_internal}, Encode::decode $self->{charset_chat}, $_ for @param;
      #$self->log( 'dev', 'RCV postencode', @param, Dumper \@param);
      #Encode::encode $self->{charset_console},;
    } else {
      #$_ =  Encode::encode $self->{charset_internal},
      #TODO $_ = Encode::decode($self->{charset_protocol}, $_),             for @param;
    }
    my ( @ret, $ret );
    #$self->log( 'dcinf', "parsing", $cmd, @_ ,'with',$self->{'parse'}{$cmd}, ref $self->{'parse'}{$cmd});
    my @self;
    #@self = $self if $self->{'adc'};
    @self = $self;    #if !$self->{'nmdc'};
                      #$self->handler( @self, $cmd . '_parse_bef_bef', @param );
    $self->handler( @self, $cmd . '_parse_bef', @param );
    if ( ref $self->{'parse'}{$cmd} eq 'CODE' ) {
      if ( !exists $self->{'no_print'}{$cmd} ) {
        local $_ = $_;
        local @_ =
          map  { "$_:$self->{'skip_print_'.$_}" }
          grep { $self->{ 'skip_print_' . $_ } }
          keys %{ $self->{'no_print'} || {} };
    #$self->log( 'dcdmp', "rcv: $dst$cmd p=[",(Dumper \@param),"] ", ( @_ ? ( '  [', @_, ']' ) : () ) );
    #$self->log( 'dcdmp', "rcv: $dst$cmd p=[", (map {ref $_ eq 'ARRAY'?@$_:$_}@param), "] ", ( @_ ? ( '  [', @_, ']' ) : () ) );
        $self->{ 'skip_print_' . $_ } = 0 for keys %{ $self->{'no_print'} || {} };
      } else {
        ++$self->{ 'skip_print_' . $cmd },
          if exists $self->{'no_print'}{$cmd};
      }
      #$self->handler( @self, $cmd . '_parse_bef', @param );
      @ret = $self->{'parse'}{$cmd}->( @self, @param );
      $ret = scalar @ret > 1 ? \@ret : $ret[0];
      #$self->handler( @self, $cmd . '_parse_aft', @param, $ret );
      ++$self->{'count_parse'}{$cmd};
    } else {
#$self->log( 'dcinf', "unknown", $cmd, @_ ,'with',$self->{'parse'}{$cmd}, ref $self->{'parse'}{$cmd}, 'run=', @self, 'unknown', $cmd,@param,);
      $self->handler( @self, 'unknown', $cmd, @param, );
    }
    #if ($self->{'parent'}{'hub'}) {           }
    $self->handler( @self, $cmd, @param, $ret );
    #$self->handler( @self, $cmd . '_parse_aft_aft', @param, $ret );
  }
}

sub send_can {    #$self->{'send'} ||= sub {
  my $self = shift;
  #$self->log( 'dev', 'send_can');
  my $size;
  my $send = $self->{send};
  eval { $size += $self->{'socket'}->$send($_) for @_ ? @_ : @{ $self->{send_buffer_raw} }; } if $self->{'socket'};
  $self->{send_buffer_raw} = [];
  $self->{bytes_send} += $size;
  $self->log( 'err', 'send error', $@ ), $self->reconnect(), return $size if $@;
  $self->{activity} = time;
  return $size;
}

sub send {    #$self->{'send'} ||= sub {
  my $self = shift;
  return if $self->{'listener'};
  # = join( '', @_ );
  #$self->{bytes_send} += length $_;
  #eval { $_ = $self->{'socket'}->send( join( '', @_ ) ); } if $self->{'socket'};
  push @{ $self->{send_buffer_raw} ||= [] }, @_;
  $self->select();

=no
    unless ($self->{send_can}) {
    	$self->{send_buffer_raw} = \@_;
    	return 0;
    }
    if ($self->{send_buffer_raw}) {
	unshift @_, @{$self->{send_buffer_raw}};
	$self->{send_buffer_raw} = undef;
    }
=cut

  #return unless @_;
}

sub sendcmd {    #$self->{'sendcmd'} ||= sub {
  my $self = shift;
  return if $self->connect_check();
  return if $self->{'listener'} and !$self->{'broadcast'};
  #$self->{'log'}->( $self,'sendcmd0', @_);
  local @_ = @_, $_[0] .= splice @_, 1, 1
    if $self->{'adc'} and length $_[0] == 1;
  $self->log( 'dcdmp', 'sendcmd', $self->{number}, ':', @_ );
  push @{ $self->{'send_buffer'} }, $self->{'cmd_bef'} . join( $self->{'cmd_sep'}, @_ ) . $self->{'cmd_aft'}
    if @_;
  ++$self->{'count_sendcmd'}{ $_[0] };
  if ( ( $self->{'sendbuf'} and @_ )
    or !@{ $self->{'send_buffer'} || [] } )
  {
  } else {
    if ( $self->{'broadcast'} ) {
      $self->send_udp( $self->{'host'}, $self->{'port'}, join( '', @{ $self->{'send_buffer'} }, ) ),;
    } else {
      $self->log( 'err', "ERROR! no socket to send" ), return
        unless $self->{'socket'};
      $self->send( Encode::encode $self->{charset_protocol}, join( '', @{ $self->{'send_buffer'} }, ), Encode::FB_WARN );
      #local $_;
      #eval { $_ = $self->{'socket'}->send( join( '', @{ $self->{'send_buffer'} }, ) ); };
      #$self->log( 'err', 'send error', $@ ) if $@;
    }
    #$self->log( 'dcdmp', "we send [" . join( '', @{ $self->{'send_buffer'} } ) . "]:", $! );
    $self->{'send_buffer'} = [];
    $self->{'sendbuf'}     = 0;
  }
}

sub sendcmd_all {    #$self->{'sendcmd_all'} ||= sub {
  my $self = shift;
  #%{ $self->{'peers_sid'} }
  #eval {
  $_->sendcmd(@_)    #, $self->wait_sleep( $self->{'cmd_recurse_sleep'} )
    for grep { $_ } values( %{ $self->{'clients'} } );    #, $self;
}

sub rcmd {                                                #$self->{'rcmd'} ||= sub {
  my $self = shift;
  eval {
    eval { $_->cmd(@_) }, $self->wait( $self->{'cmd_recurse_sleep'} )
      for grep { $_ } values( %{ $self->{'clients'} } ), $self;
  };
}

sub get {                                                 #$self->{'get'} ||= sub {
  my ( $self, $nick, $file, $as, $from, $to, $size, $tth ) = @_;    #TODO hash
              #$self->log( 'dcdev', 'wantcall', $self, $nick, $file, $as, $from, $to, $size);
              #my $size;
              #$size = $to unless $from;
              #$from, $to
  my ( $sid, $cid );
  $sid = $nick if $nick =~ /^[A-Z0-9]{4}$/;
  $cid = $nick if $nick =~ /^[A-Z0-9]{39}$/;
  $cid ||= $self->{peers}{$sid}{INF}{ID};
  $sid ||= $self->{peers}{$cid}{SID};
  $sid ||= $cid if $self->{broadcast};
  $file //= 'TTH/' . $tth if $tth;
  my $full = ( $as || $file );
  $full = $self->{'download_to'} . $full unless $full =~ m{[/\\]};
  #$self->log( 'dev', "cid[$cid] sid[$sid] nick[$nick] full[$full] as,file[$as || $file]");
  my $sizenow = -s $full;
  if ($sizenow) {
    $self->log( 'info', "file [$_] already exists size=$sizenow must be=$size" );
    return;
    #return if $size and $size == $sizenow;
    #$from = $sizenow  if $sizenow < $size;
  }
  #$to ||= $size - $from;
  #todo by nick
  $self->wait_clients();
  #$self->{'want'}{ $self->{peers}{$cid}{'INF'}{'ID'} || $nick }{$file} = $as || $file || '';
  #$self->log( 'dcdev', "wantid: $self->{peers}{$cid}{'INF'}{'ID'} || $self->{peers}{$sid}{'INF'}{'ID'} ||  $nick");
  $self->{'want'}{ $self->{peers}{$cid}{'INF'}{'ID'} || $self->{peers}{$sid}{'INF'}{'ID'} || $nick }{$file} = {
    'filename'       => $file,
    'fileas'         => $as || $file || '',
    'file_recv_to'   => $to,
    'file_recv_from' => $from,
    'file_recv_size' => $size,
    'file_recv_tth'  => $tth,
    #'file_recv_full'  => $full
  };
  my $peer =
       $self->{peers}{$cid}
    || $self->{peers}{$sid}
    || $self->{peers}{$nick}
    || {};
  $self->log( 'dbg', "getting [$nick] $file as $as sid=[$sid]:$self->{'myport'} p=$self->{'protocol_connect'}" );    #, Dumper $peer->{INF});
  if ( $self->{'adc'} ) {
    #my $token = $self->make_token($nick);
    local @_;
    if (  $self->{'M'} eq 'A'
      and $self->{'myip'}
      and !$self->{'passive_get'} )
    {
      @_ = ( 'CTM', $sid, $self->{'protocol_connect'}, $self->{'myport'}, $self->make_token($nick) );
    } else {
      @_ = ( 'RCM', $sid, $self->{'protocol_connect'}, $self->make_token($nick) );
    }
    $self->cmd( 'D', @_ );
    #$self->cmd( $dst, 'CTM', $peerid, $_[0], $self->{'myport'}, $_[1], )
  } else {
    $self->cmd( ( ( $self->{'M'} eq 'A' and $self->{'myip'} and !$self->{'passive_get'} ) ? '' : 'Rev' ) . 'ConnectToMe',
      $nick );
  }
}

sub file_select {    #$self->{'file_select'} ||= sub {
  my $self = shift;
  return if length $self->{'filename'};
  my $peerid = $self->{'peerid'} || $self->{'peernick'};
  #$self->log( 'dcdev','file_select000',$peerid,  $self->{'filename'}, $self->{'fileas'}, Dumper $self->{'want'});
  for my $file ( keys %{ $self->{'want'}{$peerid} } ) {
    #( $self->{'filename'}, $self->{'fileas'} ) = ( $_, $self->{'want'}{$peerid}{$_} );
    $self->{$_} = $self->{'want'}{$peerid}{$file}{$_} for keys %{ $self->{'want'}{$peerid}{$file} };
    #$self->log( 'dcdev', 'file_select1', $self->{'filename'}, $self->{'fileas'} );
    next unless defined $self->{'filename'};
    $self->{'filecurrent'} = $self->{'filename'};
    #delete  $self->{'want'}{ $peerid }{$_} ;   $self->{'filecurrent'}
    #$self->{'file_recv_from'}
    #$self->{'fileas'}
    last;
  }
  delete $self->{'downloading'}{ $self->{'file_recv_tth'} }{connect_start};
  #$self->log( 'dcdev', 'file_select2', $self->{'filename'}, $self->{'fileas'} );
  return unless defined $self->{'filename'};
  unless ( $self->{'filename'} ) {
    if ( $self->{'peers'}{$peerid}{'SUP'}{'BZIP'}
      or $self->{'NickList'}->{$peerid}{'XmlBZList'} )
    {
      $self->{'fileext'}  = '.xml.bz2';
      $self->{'filename'} = 'files' . $self->{'fileext'};
    } elsif ( $self->{'adc'} ) {
      $self->{'fileext'}  = '.xml';
      $self->{'filename'} = 'files' . $self->{'fileext'};
    } elsif ( $self->{'NickList'}->{$peerid}{'BZList'} ) {
      $self->{'fileext'}  = '.bz2';
      $self->{'filename'} = 'MyList' . $self->{'fileext'};
    } else {
      $self->{'fileext'}  = '.DcLst';
      $self->{'filename'} = 'MyList' . $self->{'fileext'};
    }
    $self->{'fileas'} .= $self->{'fileext'} if $self->{'fileas'};
    $self->{'file_recv_filelist'} = 1;
  }
  $self->{'file_recv_dest'} = ( $self->{'fileas'} || $self->{'filename'} );
  $self->{'file_recv_full'} = $self->{'file_recv_dest'};
  $self->{'file_recv_full'} = $self->{'download_to'} . $self->{'file_recv_full'}
    unless $self->{'file_recv_full'} =~ m{[/\\]};
#$self->log('dcdev', '1full', $self->{'file_recv_full'});
#$self->{'file_recv_dest'} = Encode::encode $self->{charset_fs}, $self->{'file_recv_dest'} if $self->{charset_fs};    # ne $self->{charset_protocol};
#$self->{'file_recv_dest'}
#$self->log( 'dcdev', "pre enc filename [$self->{'file_recv_dest'}] [$self->{charset_fs} ne $self->{charset_protocol}]");
#$self->{'file_recv_dest'} = Encode::encode $self->{charset_fs}, Encode::decode $self->{charset_protocol},
#$self->log( 'dcdev', "pst enc filename [$self->{'file_recv_dest'}]");
  mkdir_rec $self->{'partial_prefix'} if $self->{'partial_prefix'};
  $self->{'file_recv_partial'} =
    "$self->{'file_recv_dest'}" . ( $self->{'file_recv_tth'} ? '.' . $self->{'file_recv_tth'} : () ) . "$self->{'partial_ext'}";
  $self->{'file_recv_partial'} = $self->{'partial_prefix'} . $self->{'file_recv_partial'}
    unless $self->{'file_recv_partial'} =~ m{[/\\]};
  $self->{'file_recv_partial'} = Encode::encode $self->{charset_fs}, $self->{'file_recv_partial'}, Encode::FB_WARN
    if $self->{charset_fs};
  $self->{'filebytes'} = $self->{'file_recv_from'} = -s $self->{'file_recv_partial'};
  $self->{'file_recv_to'} ||= $self->{'file_recv_size'} - $self->{'file_recv_from'}
    if $self->{'file_recv_size'} and $self->{'file_recv_from'};
  #$self->log('dcdev', '1part', $self->{'file_recv_partial'});
  #$self->log('dcdev', 'file_select3',               $self->{'filename'}, $self->{'fileas'},
  #  'part:', $self->{'file_recv_partial'}, 'full:',             $self->{'file_recv_full'},
  #  'from',  $self->{'file_recv_from'});
}

sub file_open {    #$self->{'file_open'} ||= sub {
  my $self = shift;
  #$self->{'fileas'}=$_[0] if !length $self->{'fileas'} or length $_[0];
  #$self->{'filetotal'} = $_[1]if ! $self->{'filetotal'} or $_[1];
  #$self->{'filetotal'} //= $self->{'file_recv_size'}
  #$self->log('dcdev', '2part', $self->{'file_recv_partial'});
  my $oparam = $self->{'fileas'} eq '-' ? '>-' : '>>' . $self->{'file_recv_partial'};
  $self->handler( 'file_open_bef', $oparam );
# $self->log(      'dbg',             "file_open pre", $oparam, 'want bytes', $self->{'filetotal'}, 'as=',      $self->{'fileas'}, 'f=',            $self->{'filename'}    );
#$self->log( 'dcdev', "open [$oparam]" );
  open( $self->{'filehandle'}, $oparam )
    or $self->log( 'dcerr', "file_open error", $!, $oparam ),
    $self->handler( 'file_open_error', $!, $oparam ), return 1;
  binmode( $self->{'filehandle'} );
  $self->{'status'} = 'transfer';
  return 0;
}

sub file_write {    #$self->{'file_write'} ||= sub {
  my $self = shift;
  $self->{'file_start_time'} ||= time;
  my $fh = $self->{'filehandle'}
    or $self->log( 'err', 'cant write, no filehandle' ), return;
  for my $databuf (@_) {
    $self->{'filebytes'} += length $$databuf;
#$self->log( 'dcdbg', "($self->{'number'}) recv ".length($$databuf)." [$self->{'filebytes'}] of $self->{'filetotal'} file $self->{'filename'}" );
#$self->log( 'dcdbg', "recv " . length($$databuf) . " [$$databuf]" ) if length $$databuf < 10;
    print $fh $$databuf;
    schedule(
      10,
      $self->{__stat_recv} ||= sub {
        my $self = shift;
        my $recv = shift;
        #my $read = shift;
        #our ( $lastmark, $lasttime );
        $self->log(
          'dev',                              "recv bytes",           #length $self->{'file_send_buf'},
          "recv=[$recv] now [",               $self->{'filebytes'},
          "] of [$self->{'filetotal'}], now", 's=',
          int( ( $self->{'filebytes'} - $self->{__stat_recv_lastmark} ) /
              ( time - $self->{__stat_recv_lasttime} or 1 ) ),
          "status=[$self->{'status'}]",
          ),
          $self->{__stat_recv_lastmark} = $self->{'filebytes'};
        $self->{__stat_recv_lasttime} = time;
        #if time - $lasttime > 1;
      },
      $self,
      length $$databuf,
    );
    $self->log( 'err', "file download error! extra bytes ($self->{'filebytes'}/$self->{'filetotal'}) " )
      if $self->{'filebytes'} > $self->{'filetotal'};
    $self->log(
      'info',
      "file complete ($self->{'filebytes'}) per",
      $self->float( time - $self->{'file_start_time'} ),
      's at', $self->float( $self->{'filebytes'} / ( ( time - $self->{'file_start_time'} ) or 1 ) ), 'b/s'
      ),
      #$self->disconnect(), $self->{'status'} = 'destroy',
      $self->file_close(),
      $self->{'file_start_time'} = 0, $self->{'filename'} = '',
      $self->{'fileas'} = '',
      delete $self->{'want'}{ $self->{'peerid'} }{ $self->{'filecurrent'} },
      $self->{'filecurrent'} = '', $self->{'file_recv_partial'} = '',
      $self->{'file_recv_from'} = $self->{'file_recv_to'} = undef,
      #!!?$self->destroy(),
      if $self->{'filebytes'} >= $self->{'filetotal'};
  }
}

sub file_close {    #$self->{'file_close'} ||= sub {
  my $self = shift;
  #$self->log( 'dcerr', 'file_close', 1);
  if ( $self->{'filehandle'} ) {
    #$self->log( 'dcerr', 'file_close',2);
    close( $self->{'filehandle'} ), delete $self->{'filehandle'};
    if ( $self->{'filebytes'} == $self->{'filetotal'} ) {
      mkdir_rec $self->{'download_to'} if $self->{'download_to'};
      if ( length $self->{'partial_ext'} ) {
        local $self->{'file_recv_full'} = Encode::encode $self->{charset_fs}, $self->{'file_recv_full'}, Encode::FB_WARN
          if $self->{charset_fs};    # ne $self->{charset_protocol};
            #$self->log( 'dcdev', 'file_close', 3, $self->{'file_recv_partial'}, $self->{'file_recv_full'} );
        $self->log( 'dcerr', 'cant move finished file', $self->{'file_recv_partial'}, '=>', $self->{'file_recv_full'} )
          if !rename $self->{'file_recv_partial'}, $self->{'file_recv_full'};
      }
      delete $self->{'downloading'}{ $self->{'file_recv_tth'} };
      ( $self->{parent} || $self )->handler( 'file_recieved', $self->{'file_recv_full'}, $self->{'filename'} );
    }
  }
  if ( $self->{'downloading'}{ $self->{'file_recv_tth'} } ) {
#$self->log( 'dev', "onclose: downloading [$self->{'file_recv_tth'}], b$self->{'filebytes'} <= t$self->{'filetotal'} || $self->{'file_recv_size'}" );
    if ( $self->{'filebytes'} <= $self->{'filetotal'}
      || $self->{'file_recv_size'} )
    {
      $self->{'want_download'}{ $self->{'file_recv_tth'} } = $self->{'downloading'}{ $self->{'file_recv_tth'} };
    }    #else {                }
    delete $self->{'downloading'}{ $self->{'file_recv_tth'} };
  }
  #$self->{'select_send'}->remove( $self->{'socket'} ),
  close( $self->{'filehandle_send'} ), delete $self->{'filehandle_send'},
    #$self->{'socket'}->flush(),
    if $self->{'select_send'} and $self->{'filehandle_send'};
  delete $self->{$_} for 'file_send_left', 'file_send_total', 'file_recv_filelist';
  $self->{'status'} = 'connected' if $self->{'status'} eq 'transfer';
}

sub file_send_tth {    #$self->{'file_send_tth'} ||= sub {
  my $self = shift;
  my ( $file, $start, $size, $as ) = @_;
#$self->log( 'dcdev', 'my share', $self->{'share_full'}, scalar keys %{$self->{'share_full'} }, 'p share', $self->{'parent'}{'share_full'}, scalar keys %{$self->{'parent'}{'share_full'} }, );
#$self->{'share_tth'} ||=$self->{'parent'}{'share_tth'};
  if ( $self->{'share_full'}{$file} ) {
    $self->{'share_full'}{$file} =~ tr{\\}{/};
    #$self->log( 'dcdev', 'call send', $self->{'share_full'}{$file}, $start, $size, $as );
    $self->file_send( $self->{'share_full'}{$file}, $start, $size, $as );
    $self->search_stat_update( $file, 'hit' );
  } else {
    $self->log(
      'dcerr', 'send', 'cant find file',
      $file, $self->{'share_full'}{$file},
      'from', scalar keys %{ $self->{'share_full'} }
    );
    return 1;
  }
  return undef;
}

sub file_send {    #$self->{'file_send'} ||= sub {
  my $self = shift;
  #$self->log( 'dcdev', 'file_send', Dumper \@_ );
  my ( $file, $start, $size, $as ) = @_;
  $start //= 0;
  my $filesize = -s $file;
  $size = $filesize - $start if $size <= 0;
  $self->log( 'dcerr', "cant find [$file]" ), $self->disconnect(), return
    if !-e $file
    or -d $file;
  if ( open $self->{'filehandle_send'}, '<', $file ) {
    binmode( $self->{'filehandle_send'} );
    seek( $self->{'filehandle_send'}, $start, SEEK_SET ) if $start;
    my $name = $file;
    $name =~ s{^.*[\\/]}{}g;
    $self->{'file_send_total'}  = $filesize;
    $self->{'file_send_offset'} = $start || 0;
    $self->{'file_send_left'}   = $size;
    $self->log( 'dev', "sendsize=$size filesize=$filesize from", $start, 'e', -e $file, $file, $self->{'file_send_total'} );
    #$self->{'filetotal'} = $self->{'file_send_offset'} + $self->{'file_send_left'};
    $self->file_close(), return if $start >= $self->{'file_send_total'};
    if ( $self->{'adc'} ) {
      $self->cmd( 'C', 'SND', 'file', $as || $name, $start, $size );
    } else {
      $self->cmd( 'ADCSND', 'file', $as || $name, $start, $size );
    }
    $self->{'status'} = 'transfer';
    #$self->file_send_part();
    #$self->{'select_send'}->add( $self->{'socket'} );
  } else {
    $self->file_close();
  }
}

sub file_send_part {    #$self->{'file_send_part'} ||= sub {
                        #psmisc::printlog 'call', 'file_send_part', @_;
  my $self = shift;
  #my ($file, $start, $size) = @_;
  #return unless $self->{'file_send_left'};
  #my $buf;
  #$self->disconnect(),
  return
    unless ( $self->{'socket'}
    and $self->{'socket'}->connected()
    and $self->{'filehandle_send'}
    and $self->{'file_send_left'} );
  my $read = $self->{'file_send_left'};
  $read = $self->{'file_send_by'}
    if $self->{'file_send_by'} < $self->{'file_send_left'};
  my $sent;
  if (0) {
  } elsif ( $INC{'Sys/Sendfile.pm'} ) {    #works
                                           #$self->log(      'dev', 'using sys::sendfile ');
    $sent = Sys::Sendfile::sendfile( $self->{'socket'}, $self->{'filehandle_send'}, $read, $self->{'file_send_offset'} );
    $self->{'file_send_offset'} += $sent if $sent > 0;
  } elsif ( $INC{'Sys/Sendfile/FreeBSD.pm'} ) {
    #$self->log(      'dev', 'using sendfile freebsd');
    my $result = Sys::Sendfile::FreeBSD::sendfile(
      fileno( $self->{'filehandle_send'} ),
      fileno( $self->{'socket'} ),
      $self->{'file_send_offset'},
      $read, $sent
    );
    $self->{'file_send_offset'} += $sent if $sent > 0;
#blocking
#elsif ($INC{'IO/AIO.pm'}) {
#  $sent = IO::AIO::sendfile(   fileno($self->{'socket'}), fileno($self->{'filehandle_send'}),$self->{'file_send_offset'}, $read );
#  $self->{'file_send_offset'} += $sent if $sent > 0;
  } else {
    #$self->log(      'dev', 'using read send');
    read( $self->{'filehandle_send'}, $self->{'file_send_buf'}, $read ),
      $self->{'file_send_offset'} = tell $self->{'filehandle_send'},
      unless length $self->{'file_send_buf'};    #$self->{'file_send_by'};
                                                 #send $self->{'socket'},
                                                 #$self->{'socket'}->send( buf, POSIX::BUFSIZ, $self->{'recv_flags'} )
                                                 #my $sent;
                                                 #$self->log(      'snd',      length $self->{'file_send_buf'},
    $sent = $self->send_can( $self->{'file_send_buf'} );
  }
  schedule(
    10,
    $self->{__stat_} ||= sub {
      my $self = shift;
      my $sent = shift;
      my $read = shift;
      #our ( $lastmark, $lasttime );
      $self->log(
        'dev',                   "sent bytes",                      #length $self->{'file_send_buf'},
        "sent=[$sent] of buf [", length $self->{'file_send_buf'},
        "] by [$read:$self->{'file_send_by'}] left $self->{'file_send_left'}, now",
        $self->{'file_send_offset'}, 'of',
        $self->{'file_send_total'},  's=',
        int( ( $self->{'file_send_offset'} - $self->{__stat_lastmark} ) /
            ( time - $self->{__stat_lasttime} or 1 ) ),
        "status=[$self->{'status'}]",
        ),
        $self->{__stat_lastmark} = $self->{'file_send_offset'};
      $self->{__stat_lasttime} = time;
      #if time - $lasttime > 1;
    },
    $self,
    $sent,
    $read
  );
  #$self->{activity} = time if $sent;
  #$self->{bytes_send} += $sent;
  $self->{'file_send_left'} -= $sent;
#$self->log(      'dev', 'send end', $sent, $self->{'file_send_offset'}, $self->{'file_send_total'}, "left=[$self->{'file_send_left'}]");
  substr( $self->{'file_send_buf'}, 0, $sent ) = undef;
#if (length $self->{'file_send_buf'}) {         $self->log( 'info', 'sent small', $sent, 'todo', length $self->{'file_send_buf'});    }
#$readed;
  if ( $self->{'file_send_left'} < 0 ) {
    $self->log( 'err', "oversend [$self->{'file_send_left'}]" );
    $self->{'file_send_left'} = 0;
  }
  if (
    #$readed < $self->{'file_send_by'} or
    $self->{'file_send_left'} <= 0
    )
  {
    $self->log(
      'dev', 'file completed', "r:", length $self->{'file_send_buf'},
      " by:$self->{'file_send_by'} left:$self->{'file_send_left'} total:$self->{'file_send_total'}",
      #caller 2
    );
    $self->file_close();
    #$self->{'status'} = 'connected';
    #?
    #$self->disconnect();
    $self->destroy();
  }
  return $sent;
}

sub file_send_parse {    #$self->{'file_send_parse'} =
                         #$self->{'ADCSND'} =
                         #sub {
  my $self = shift if ref $_[0];
  #$self->log(    'cmd_adcSND', Dumper \@_);
  #my ( $dst, $peerid, $toid ) = @{ shift() };
  if ( $_[0] eq 'file' ) {
    my $file = $_[1];
    if ( $file =~ s{^TTH/}{} ) {
      return $self->file_send_tth( $file, $_[2], $_[3], $_[1] );
    } else {
      #$self->file_send($file, $_[2], $_[3]);
      return $self->file_send_tth( $file, $_[2], $_[3], $_[1] );
    }
  } elsif ( $_[0] eq 'list' ) {
    return $self->file_send_tth( 'files.xml.bz2', );
  } elsif ( $_[0] eq 'tthl' ) {
    #TODO!! now fake
    ( my $tth = $_[1] ) =~ s{^TTH/}{};
    eval q{
        use MIME::Base32 qw( RFC );
        $tth = MIME::Base32::decode $tth;
      };
    if ( $self->{'adc'} ) {
      $self->cmd( 'C', 'SND', $_[0], $_[1], $_[2], length $tth );
    } else {
      $self->cmd( 'ADCSND', $_[0], $_[1], $_[2], length $tth );
    }
    $self->send($tth);
  } else {
    $self->log( 'dcerr', 'SND', "unknown type", @_ );
    return 2;
  }
  return undef;
}

sub download {    #$self->{'download'} ||= sub {
  my $self = shift if ref $_[0];
  #my $self = shift;
  my ($file) = @_;
  #$self->log('dev', "0s=[$self]; download [$file] now $self->{'want_download'}{$file} ", Dumper \@_);
  push @{ $self->{'queue_download'} ||= [] }, $file;
  #$self->log('dev', "1s=[$self]; download [$file] now $self->{'want_download'}{$file} ", Dumper \@_);
  $self->{'want_download'}{$file} ||= {};
}

sub get_peer_addr {    #$self->{'get_peer_addr'} ||= sub () {
  my $self = shift if ref $_[0];
  my ($recv) = @_;
  return unless $self->{'socket'};
  eval {
  $self->{'port'}   = $self->{'socket'}->peerport();
  $self->{'hostip'} = $self->{'socket'}->peerhost();
  $self->{'host'} ||= $self->{'hostip'};
  };
  return $self->{'hostip'};

=no
  local @_ = socket_addr $self->{'socket'};
  #eval { @_ = unpack_sockaddr_in( getpeername( $self->{'socket'} ) || return ) };
  #return unless $_[1];
  #return unless $_[1] = inet_ntoa( $_[1] );
  $self->{'port'} = $_[0] if $_[0];    #;and !$self->{'incoming'};
  $self->{'hostip'} = $_[1], $self->{'host'} ||= $self->{'hostip'}
    if $_[1];
  return $self->{'hostip'};
=cut

}

sub get_peer_addr_recv {    #$self->{'get_peer_addr_recv'} ||= sub (;$) {
  my $self = shift if ref $_[0];
  my ($recv) = @_;
  #return unless $self->{'socket'};
  $recv ||= $self->{'recv_addr'};
  ( $self->{'recv_port'}, my $hostn ) = sockaddr_in($recv);
  $self->{'recv_host'} = gethostbyaddr( $hostn, AF_INET );
  $self->{'recv_hostip'} = inet_ntoa($hostn);
  return $self->{'hostip'};
}

sub get_my_addr {           #$self->{'get_my_addr'} ||= sub {
  my $self = shift if ref $_[0];
  #my ($self) = @_;
  return unless $self->{'socket'};
  #$self->log('dev', 'saddr', $self->{'socket'}->sockhost(),$self->{'socket'}->sockport() );
  $self->{'myport'} ||= $self->{'socket'}->sockport();
  #$self->log('dev', 'myip was:', $self->{'myip'}, '->', $self->{'socket'}->sockhost());
  return $self->{'myip'} ||= $self->{'socket'}->sockhost();

=no
  eval { @_ = unpack_sockaddr_in( getsockname( $self->{'socket'} ) || return ); };
  $self->log( 'dcerr', "cant get my ip [$@]", Dumper \@_ ) if $@;
  #$self->log('dcerr', "cant get my ip [0.0.0.0:$_[0]]"),
  return if $_[1] eq "\0\0\0\0";
  #$self->log('dev', "1my ip", Dumper \@_);
  #return unless $_[1];
  return unless $_[1] and $_[1] = inet_ntoa( $_[1] );
  #$self->log('dev', "2my ip", Dumper \@_);
  #return if $_[1] eq '0.0.0.0';
  #$self->{'log'}->('dev', "MYIP($self->{'myip'}) [$self->{'number'}] SOCKNAME $_[0],$_[1];");
  return $self->{'myip'} ||= $_[1];
=cut
}

sub info {    #$self->{'info'} ||= sub {
  my $self = shift if ref $_[0];
  #my $self = shift;
  $self->log(
    'info',
    map( {"$_=$self->{$_}"} grep { $self->{$_} } @{ $self->{'informative'} } ),
    #map( { $_ . '(' . scalar( keys %{ $self->{$_} } ) . ')=' . join( ',', sort keys %{ $self->{$_} } ) }
    #grep { keys %{ $self->{$_} } } @{ $self->{'informative_hash'} } )
    'clients:', scalar keys %{ $self->{'clients'} },
    map { "($self->{'clients'}{$_}{'number'})$_=$self->{'clients'}{$_}{'status'}" }
      sort keys %{ $self->{'clients'} },
  );
  $self->log(
    'dcdbg',
    "protocol stat",
    Dumper( {
        map { $_ => $self->{$_} }
        grep { $self->{$_} } qw(count_sendcmd count_parse)
      }
    ),
  ) unless $self->{'parent'};
  #( ref $self->{'clients'}{$_}{info} ? $self->{'clients'}{$_}->info() : () ) for sort keys %{ $self->{'clients'} };
}
#sub status {
#now states:
#listening  connecting_tcp connecting   connected   reconnecting transfer  disconnecting disconnected destroy
#need checks:
#\ connected?/             \-----/
#\-----------------------active?-------------------------/
#}
#$self->{'active'} ||= sub {
sub active {
  #my $self = shift;
  my $self = shift if ref $_[0];
  #$self->log('dev', 'active=', $self->{'status'});
  return $self->{'status'}
    if grep { $self->{'status'} eq $_ } qw(connecting_tcp connecting connected reconnecting listening transfer working);
  return 0;
}

sub every {    #$self->{'every'} ||= sub {
  my ( $self, $sec, $func ) = ( shift, shift, shift );
  if (  ( $self->{'every_list'}{$func} + $sec < time )
    and ( ref $func eq 'CODE' ) )
  {
    $self->{'every_list'}{$func} = time;
    $func->(@_);
  }
}

sub adc_make_string {    #$self->{'adc_make_string'} = sub (@) {
  my $self = shift if ref $_[0];
  join ' ', map {
    ref $_ eq 'ARRAY' ? @$_ : ref $_ eq 'HASH' ? do {
      my $h = $_;
      map { "$_$h->{$_}" } keys %$h;
      }
      : $_
  } @_;
}

sub cmd_adc {            #$self->{'cmd_adc'} ||= sub {
  my ( $self, $dst, $cmd ) = ( shift, shift, shift );
  #$self->sendcmd( $dst, $cmd,map {ref $_ eq 'HASH'}@_);
  #$self->log( 'cmd_adc', $dst, $cmd, "SI[$self->{'INF'}{'SID'}]",Dumper \@_ );
  $self->sendcmd(
    $dst, $cmd,
    #map {ref $_ eq 'ARRAY' ? @$_:ref $_ eq 'HASH' ? each : $_)    }@_
    (    #$self->{'broadcast'} ? $self->{'INF'}{'SID'} #$self->{'INF'}{'ID'}
          #:
      ( $dst eq 'C' or !length $self->{'INF'}{'SID'} )
      ? ()
      : $self->{'INF'}{'SID'}
    ),
    $self->adc_make_string(@_)
      #( $dst eq 'D' || !length $self->{'sid'} ? () : $self->{'sid'} ),
  );
}
#sub adc_string_decode ($) {
sub adc_string_decode {    #$self->{'adc_string_decode'} ||= sub ($) {
  my $self = shift;
  local ($_) = @_;
  s{\\s}{ }g;
  s{\\n}{\x0A}g;
  s{\\\\}{\\}g;
  $_;
}
#sub adc_string_encode ($) {
sub adc_string_encode {    #$self->{'adc_string_encode'} = sub ($) {
  my $self = shift;
  local ($_) = @_;
  s{\\}{\\\\}g;
  s{ }{\\s}g;
  s{\x0A}{\\n}g;
  $_;
}

sub adc_path_encode {      #$self->{'adc_path_encode'} = sub ($) {
  my $self = shift;
  local ($_) = @_;
  s{^(\w:)}{/${1}_}g;
  s{\\}{/}g;
  $self->adc_string_encode($_);
}
#sub adc_strings_decode (\@) {
sub adc_strings_decode {    #$self->{'adc_strings_decode'} = sub (\@) {
  my $self = shift;
  map { $self->adc_string_decode($_) } @_;
}
#sub adc_strings_encode (\@) {
sub adc_strings_encode {    #$self->{'adc_strings_encode'} = sub (\@) {
  my $self = shift;
  map { $self->adc_string_encode($_) } @_;
}

sub adc_parse_named {       #$self->{'adc_parse_named'} = sub (@) {
  my $self = shift;
  #sub adc_parse_named (@) {
  #my ($dst,$peerid) = @{ shift() };
  #$self->log('dev', "p0:", @_);
  local %_;
  for ( local @_ = @_ ) {
    s/^([A-Z][A-Z0-9])//;
    #my $name=
    #print "PARSE[$1=$_]\n",
    $_{$1} = $self->adc_string_decode($_);
    #$self->log('dev', "p1:$1=$_{$1}");
  }
  return \%_;
  #return ($dst,$peerid)
}

sub make_token {    #$self->{'make_token'} = sub (;$) {
  my $self   = shift;
  my $peerid = shift;
  my $token;
  local $_;
  $_ = $self->{'peers'}{$peerid}{'INF'}{I4}
    if $peerid and exists $self->{'peers'}{$peerid};
  s/\D//g;
  $token += $_;
  $_ = $self->{myip};
  s/\D//g;
  return $token + $_ + int time;
}

sub say {    #$self->{'say'} = sub (@) {
  my $self = shift;
  @_ = $_[2] if $_[0] eq 'MSG';
  #local $_ = Encode::encode $self->{charset_console} , join ' ', @_;print $_, "\n";
  print Encode::encode( $self->{charset_console}, join( ' ', @_ ), Encode::FB_DEFAULT ), "\n";
}
#local %_ = (
sub search {    #'search' => sub {
  my $self = shift if ref $_[0];
  #$self->log( 'search', @_ );
  return $self->search_tth(@_)
    if length $_[0] == 39 and $_[0] =~ /^[0-9A-Z]+$/;
  return $self->search_string(@_) if length $_[0];
}

sub search_retry {    #'search_retry' => sub {
  my $self = shift if ref $_[0];
  unshift( @{ $self->{'search_todo'} }, $self->{'search_last'} )
    if ref $self->{'search_last'} eq 'ARRAY';
  $self->{'search_last'} = undef;
}

sub search_buffer {    #'search_buffer' => sub {
  my $self = shift if ref $_[0];
  push( @{ $self->{'search_todo'} }, [@_] ) if @_;
  return unless @{ $self->{'search_todo'} || return };
#$self->log($self, 'search', Dumper \@_);
#$self->log( 'dcdev', "search too fast [$self->{'search_every'}], len=", scalar @{ $self->{'search_todo'} } )        if @_ and scalar @{ $self->{'search_todo'} } > 1;
  return
    if time() - $self->{'search_last_time'} < $self->{'search_every'} + 2;
  $self->{'search_last'} = shift( @{ $self->{'search_todo'} } );
  $self->{'search_todo'} = undef unless @{ $self->{'search_todo'} };
  $self->search_send();
#if ( $self->{'adc'} ) {
#}      else {
#$self->sendcmd( 'Search', $self->{'M'} eq 'P' ? 'Hub:' . $self->{'Nick'} : "$self->{'myip'}:$self->{'myport_udp'}", join '?', @{ $self->{'search_last'} } );
#}
  $self->{'search_last_time'} = time();
}

sub nick_generate {    #'nick_generate' => sub {
  my $self = shift if ref $_[0];
  $self->{'nick_base'} ||= $self->{'Nick'};
  $self->{'Nick'} = $self->{'nick_base'} . int( rand( $self->{'nick_random'} || 100 ) );
}

sub clients_my {       #'clients_my' => sub {
  my $self = shift if ref $_[0];
  grep { $self->{'clients'}{$_} and $self->{'clients'}{$_}{parent} eq $self }
    keys %{ $self->{'clients'} };
}
#);
#$self->{$_} = $_{$_} for keys %_;
#}
#print "N:DC:CALLER=", caller, "\n";
do {
  use lib '../';
  __PACKAGE__->new( auto_work => 1, @ARGV ),;
} unless caller;
1;
__END__