#!/usr/bin/perl
use 5.10.0;
$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = 1;
our ( %config, %work );
psmisc->import qw(:log);
psmisc::configure();
psmisc::lib_init();
$config{'auto_get_best'} //= 1;
$config{'hit_to_ask'} //= 5;
$config{'queue_recalc_every'} //= 100;
$config{'get_every'} //= 60;
$config{'get_dir'} //= './downloads/';
$config{ 'log_' . $_ } //= 0 for qw (dmp dcdmp dcdbg);
psmisc::printlog("usage: $1 [adc|dchub://]host[:port] [hub..]\n"), exit if !$ARGV[0] and !$config{dc}{host}; psmisc::printlog( 'info', 'started:', $^X, $0, join ' ', @ARGV );
mkdir $config{'get_dir'};
my @todl = grep { /^[A-Z0-9]{39}$/ } @ARGV;
@ARGV = grep { !/^[A-Z0-9]{39}$/ } @ARGV;
my @dc;
@dc = map {
Net::DirectConnect->new(
modules => ['filelist'],
'filelist_builder' => ( join ' ', $^X, 'share.pl', 'filelist' ),
auto_connect => 1,
dev_http => 1,
'log' => sub (@) {
my $dc = ref $_[0] ? shift : {};
psmisc::printlog shift(), "[$dc->{'number'}]", @_,;
},
'handler' => { (
map {
my $msg = $_;
$msg => sub {
my $dc = shift;
$dc->say($msg, @_);
},
} qw(welcome chatline To)
),
'Search' => sub {
my $dc = shift;
my $who = shift if $dc->{adc};
my $search = shift if $dc->{nmdc};
my $s = $_[0] || {};
$s = pop if $dc->{adc};
return if $dc->{nmdc} and $s->{'nick'} eq $dc->{'Nick'};
my $q = $s->{'tth'} || $s->{'TR'} || return;
++$work{'ask'}{$q};
++$work{'stat'}{'Search'};
},
'SR' => sub {
my $dc = shift;
my %s = %{ $_[1] || return };
++$work{'filename'}{ $s{tth} }{ $s{filename} };
$work{'tthfrom'}{ $s{tth} }{ $s{nick} } = \%s;
},
'UPSR' => sub {
my $dc = shift;
},
'RES' => sub {
my $dc = shift;
psmisc::printlog 'RESparsed:', Dumper( \@_ );
my ( $dst, $peercid ) = @{ $_[0] };
my $s = pop || return;
my ($file) = $s->{FN} =~ m{([^\\/]+)$};
++$work{'filename'}{ $s->{TR} }{$file};
$work{'tthfrom'}{ $s->{TR} }{$peercid} = $s;
},
},
worker => sub {
my $dc = shift;
$dc->{'handler'}{'SCH'} ||= $dc->{'handler'}{'Search'};
psmisc::schedule(
$config{'queue_recalc_every'},
our $queuerecalc_ ||= sub {
my $time = int time;
$work{'toask'} = [ (
sort { $work{'ask'}{$a} <=> $work{'ask'}{$b} } grep {
$work{'ask'}{$_} >= $config{'hit_to_ask'}
and !exists $work{'asked'}{$_}
and !exists $dc->{share_full}{$_}
} keys %{ $work{'ask'} }
)
];
psmisc::printlog(
'info', "queue len=", scalar @{ $work{'toask'} },
" first hits=", $work{'ask'}{ $work{'toask'}[0] },
$work{'toask'}[0]
);
}
);
psmisc::schedule(
[ 3600, 3600 ],
our $hashes_cleaner_ ||= sub {
my $min = scalar keys %{ $work{'hubs'} || {} };
psmisc::printlog 'info', "queue clear min[$min] now", scalar %{ $work{'ask'} || {} };
delete $work{'ask'}{$_} for grep { $work{'ask'}{$_} < $min } keys %{ $work{'ask'} || {} };
psmisc::printlog 'info', "queue clear ok now", scalar %{ $work{'ask'} || {} };
}
);
psmisc::schedule(
$config{'get_every'},
our $get_every_sub__ ||= sub {
psmisc::printlog( 'selecting file from', grep { exists $work{'ask'}{$_} } keys %{ $work{'filename'} } );
for
my $tth
( sort { $work{'ask'}{$b} <=> $work{'ask'}{$a} }
grep { exists $work{'ask'}{$_} and !exists $dc->{share_full}{$_} } keys %{ $work{'filename'} } )
{
my ($filename) =
sort { $work{'filename'}{$tth}{$a} <=> $work{'filename'}{$tth}{$b} } keys %{ $work{'filename'}{$tth} };
psmisc::printlog(
'selected tth', $tth, $work{'ask'}{$tth},
'names=', keys %{ $work{'filename'}{$tth} },
'filename=', $filename, $work{'filename'}{$tth}{$filename},
'nicks=', keys %{ $work{'tthfrom'}{$tth} }
);
my ($from) = ( grep { $_->{slotsopen} or $_->{SL} } values %{ $work{'tthfrom'}{$tth} } ) or next;
psmisc::printlog( 'selected from', Dumper $from);
my $dst = $config{'get_dir'} . $filename;
delete $work{'filename'}{$tth};
my $size = $from->{size} || $from->{SI};
next if ( -e $dst and ( !$size or -s $dst == $size ) );
$dc->get( $from->{nick}, 'TTH/' . $tth, $dst );
last;
}
}
);
if ( $config{'auto_get_best'} ) {
psmisc::schedule(
$dc->{'search_every'},
our $queueask_ ||= sub {
my ($dc) = @_;
my $q;
while ( $q = shift @{ $work{'toask'} } or return ) {
last if ( !exists $work{'asked'}{$q} );
}
return unless length $q;
if ( !$dc->{'search_todo'} ) {
$work{'asked'}{$q} = int time;
psmisc::printlog( 'info', "search", $q, 'on', $dc->{'host'} );
$dc->search($q);
} else {
unshift @{ $work{'toask'} }, $q;
}
},
$dc
);
}
psmisc::schedule(
[ 10, 99999999 ],
our $se_sub__ ||= sub {
}
);
psmisc::schedule(
[ 10, 11 ],
our $dl_sub__ ||= sub {
return unless @todl;
$dc->download( shift @todl );
}
);
psmisc::schedule(
[ 60, 3600 ],
our $dump_sub__ ||= sub {
$dc->{__work} ||= \%work;
psmisc::printlog "Writing dump";
psmisc::file_rewrite( $0 . '.dump', Dumper @dc );
}
) if $config{debug};
},
%{ $config{dc} || {} },
'host' => $_,
)
} (
grep {
$_
} ref $config{dc}{host} eq 'ARRAY' ? @{ $config{dc}{host} } : $config{dc}{host},
@ARGV
);
while ( @dc = grep { $_ and $_->active() } @dc ) {
$_->work() for @dc;
}