examples/dcget - metacpan.org

#!/usr/bin/perl
#$Id: dcget 998 2013-08-14 12:21:20Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/examples/dcget $

=head1 NAME

 UNFINISHED!!! [auto] get [popular] files

=head1 SYNOPSIS

 ./dcget dchub://hub [adc://hub] [tth] [-file] ...

 TODO:topath/name:TTH:size

=head1 CONFIGURE 

 create config.pl:
 $config{dc}{host} = 'myhub.net';

=cut

use 5.10.0;
use strict;
no strict qw(refs);
use warnings "NONFATAL" => "all";
no warnings qw(uninitialized);
no if $] >= 5.017011, warnings => 'experimental::smartmatch';
use Data::Dumper;
$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = 1;
use Time::HiRes qw(time sleep);
#use Encode;
use lib::abs '../lib';
#use lib '../TigerHash/lib';
#use lib './stat/pslib';
our ( %config, %work );
#use psmisc;
use Net::DirectConnect::pslib::psmisc;
psmisc->import(qw(:log));
#*config = *main::config;
#require Net::DirectConnect::pslib::psmisc;
#psmisc->import qw(:config :log printlog);
#use pssql;
use Net::DirectConnect;
use Net::DirectConnect::filelist;
#$config{disconnect_after}     //= 10;
#$config{disconnect_after_inf} //= 0;
psmisc::configure();    #psmisc::lib_init();
psmisc::lib_init();     #for die handler
#$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 dcdev adcdev);
psmisc::printlog("usage: $1 [adc|dchub://]host[:port] [hub..]\n"), exit
  if !$ARGV[0] and !( $config{dc}{host} || $config{dcget}{host} );    # and !$config{dc}{hosts};
psmisc::printlog( 'info', 'started:', $^X, $0, join ' ', @ARGV );
#$SIG{INT} = $SIG{KILL} = sub { printlog 'exiting', exit; };
#printlog 'dev', 'mkdir', $config{'get_dir'},
#mkdir $config{'get_dir'};
#exit;
#use Net::DirectConnect::adc;
my $log = sub (@) {
  my $dc = ref $_[0] ? shift : {};
  #print Dumper @_;
  psmisc::printlog shift(), "[$dc->{'number'}]", @_,;
};
my @todl = grep { /^[A-Z0-9]{39}$/ or /^-/ } @ARGV;
s/^-// for @todl;
$log->('info', 'todl:', @todl)if @todl;
@ARGV = grep { !( /^[A-Z0-9]{39}$/ or /^-/ ) } @ARGV;
$SIG{PIPE} = sub { printlog( 'sig', 'PIPE' ) };
my @dirs = grep { -d } @ARGV;
#printlog('dev', 'started', @ARGV),
my $filelist = shift @ARGV if $ARGV[0] ~~ 'filelist';
@ARGV = grep { !-d } @ARGV;
my @hosts = grep { m{^\w+://} } @ARGV;
Net::DirectConnect::filelist->new( log => $log, %{ $config{dc} || {} } )->filelist_make(@dirs), exit
  if ( $filelist and !caller )
  or ( !@hosts and !( $config{dc}{host} || $config{dcget}{host} ) );
my @dc;
@dc = map {
  Net::DirectConnect->new(
    #modules            => ['filelist'],
    share              => \@dirs,
    'filelist_builder' => ( join ' ', $^X, $0, 'filelist' ),
    #'filelist_builder' => ( join ' ', $^X, 'dcshare', 'filelist' ),
    #SUPAD        => { H => { PING => 1 } },
    #botinfo      => 'devperlpinger',
    #auto_GetINFO => 1,
    #Nick         => 'perlgetterrr',
    auto_connect => 1,
    auto_say     => 1,
    #dev_http     => 1,
    'log'     => $log,
    'handler' => {
      'Search' => sub {    #_parse_aft
        my $dc = shift;
        #printlog 'sch', Dumper @_ if $dc->{adc};
        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->{'string'} || $s->{'TR'} || $s->{'AN'} || return;
        my $q = $s->{'tth'} || $s->{'TR'} || return;
        ++$work{'ask'}{$q};
        ++$work{'stat'}{'Search'};
      },
      'SR' => sub {    #_parse_aft
        my $dc = shift;
        #printlog 'SRh', @_;
        my %s = %{ $_[1] || return };
        #printlog 'SRparsed:', Dumper \%s;
        #$db->insert_hash( 'results', \%s );
        ++$work{'filename'}{ $s{tth} }{ $s{filename} };
        $work{'tthfrom'}{ $s{tth} }{ $s{nick} } = \%s;
        #++$work{'stat'}{'SR'};
      },
      'UPSR' => sub {    #_parse_aft
        my $dc = shift;
        #my %s = %{ $_[1] || return };
        #printlog 'UPSRparsed:', $dc, ':', @_;#Dumper \%s;
        #$db->insert_hash( 'results', \%s );
        #++$work{'filename'}{ $s{tth} }{ $s{filename} };
        #$work{'tthfrom'}{ $s{tth} }{ $s{nick} } = \%s;
        #++$work{'stat'}{'SR'};
      },
      'RES' => sub {    #_parse_aft
        my $dc = shift;
        #psmisc::printlog 'RESparsed:', Dumper( \@_ );
        my ( $dst, $peercid ) = @{ $_[0] };
        my $s = pop || return;    #%{ $_[1] || return };
                                  #$db->insert_hash( 'results', \%s );
                                  #my ($file) = $s->{FN} =~ m{([^\\/]+)$};
                                  #++$work{'filename'}{ $s->{TR} }{$file}; # $self->{'want_download_filename'}
                                  #$s->{CID} = $peercid;
                                  #$work{'tthfrom'}{ $s->{TR} }{$peercid} = $s; # $self->{'want_download_tth_from'}
                                  #++$work{'stat'}{'RES'};
      },
    },
    #auto_work
    worker => sub {
      my $dc = shift;
      #printlog('worker',  keys %{$dc->{parent}||{}}    );
      $dc->{'handler'}{'SCH'} ||= $dc->{'handler'}{'Search'};    #_parse_aft _parse_aft
      psmisc::schedule(
        $config{'queue_recalc_every'},
        our $queuerecalc_ ||= sub {
          my $dc   = shift;
          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] },
            "asks=", scalar keys %{ $work{'ask'} },
            $work{'toask'}[0]
          );
        },
        $dc
      );
      psmisc::schedule(
        [ 3600, 3600 ],
        our $hashes_cleaner_ ||= sub {
          my $dc = shift;
          #my $min = scalar keys %{ $work{'hubs'} || {} };
          my $min = scalar @dc;
          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'} || {} } );
        },
        $dc
      );
      if ( $config{'auto_get_best'} ) {
        psmisc::schedule(
          $dc->{'search_every'},
          $dc->{'___queueask_'} ||= sub {
            my $dc = shift;
            return unless $dc->active();
            my $q;
            #psmisc::printlog( 'dev', "getbest run");
            while ( $q = shift @{ $work{'toask'} } or return ) {
              #psmisc::printlog( 'dev', "getbest:", $q);
              psmisc::printlog( 'dev', 'already in share', $q ), next if $dc->{share_full}{$q};
              last if !exists $work{'asked'}{$q};
#$work{'ask_db'}{$q} = $work{'asked'}{$q} = $r->{'time'}, next                  if $r and $r->{'time'};    # + $config{'ask_retry'} > time;
#$work{'ask_db'}{$q} = 0;
#last;
            }
            return unless length $q;
            #psmisc::printlog( 'dev', "getbest todo [$dc->{'search_todo'}]", );
            if ( !$dc->{'search_todo'} ) {
              $work{'asked'}{$q} = int time;
              psmisc::printlog( 'info', "search", $q, 'on', $dc->{'host'} );
              #$dc->search($q);
              $dc->download($q);
            } else {
              unshift @{ $work{'toask'} }, $q;
            }
          },
          $dc
        );
      }
      #printlog 'getev' ,$config{'get_every'};
      psmisc::schedule(
        [ 10, 99999999 ],
        our $se_sub__ ||= sub {
          my $dc = shift;
          #$dc->search('lost');
          #$dc->search($_) for @ARGV;
        },
        $dc
      );
      psmisc::schedule(
        [ 10, 0, 1 ],
        our $update_queue_sub__ ||= sub {
          #my $self = $dc;
          my $self = shift;
          #$self->log('dev', 'dlsub once!!');
          my %partial;
          unless ( $self->{no_auto_load_partial} ) {
            my $dir = $self->{'partial_prefix'};
            #$self->log('dev', 'look', $self->{'partial_prefix'});
            for my $file (<$dir*>) {
              #$self->log('dev', $_);
              local $_ = $file;
              $_ = Encode::decode $self->{charset_fs}, $_, Encode::FB_WARN if $self->{charset_fs};
              #$self->log('dev', 'U', $_);
              next unless s/$self->{'partial_ext'}$//i;
              next unless s/^$self->{'partial_prefix'}//i;
              #$self->log('dev', $_);
              next unless s/\.([A-Z0-9]{39})$//;
              my ($tth) = $1;
              $self->log( 'warn', 'removing already downloaded partial', $_, $tth ), unlink($file), next
                if $self->{'share_full'}{$tth};
              $self->log( 'warn', 'removing already downloading partial', $_, $tth ), unlink($file), next
                if $partial{$tth}{size} > -s $file;
              $self->log( 'warn', 'removing already downloading partial2', $_, $tth, $partial{$tth}{size} ),
                unlink( $partial{$tth}{file} )
                if $partial{$tth}{size} and $partial{$tth}{size} < -s $file;
              $self->log( 'dev', 'adding to queue', $_, $tth, -s $file, $partial{$tth} );
              #$self->{'want_download'}{$tth} //= {};
              push @todl, $tth unless $partial{$tth};
              $partial{$tth}{size} = -s $file;
              $partial{$tth}{file} = $file;
              $self->{'want_download_filename'}{$tth} = { $_ => 100 };
            }
            #$self->dumper();
          }
        },
        $dc
      );
      psmisc::schedule(
        [ 10, 11 ],
        our $dl_sub__ ||= sub {
          return unless @todl;
          #$dc->search('lost');
          #$dc->search($_) for @ARGV;
          $dc->download( shift @todl ) if $dc->{status} ~~ 'connected';
        },
        $dc
      );
    },
    %{ $config{dc}    || {} },
    %{ $config{dcget} || {} },
    #( $_ ? ( 'host' => $_ ) : () ),
    #( $ARGV[0] ? ( 'host' => $ARGV[0] ) : () ),
    'host' => $_,
    )    # for ( @ARGV, @{ $config{dc}{hosts} || [] } );
  } (
  grep {
    $_
    }    #psmisc::array($config{dc}{host}), #ref $config{dc}{host} eq 'ARRAY' ? @{ $config{dc}{host} } : $config{dc}{host},
         #@ARGV
    @hosts ? @hosts : psmisc::array( $config{dc}{host} || $config{dcget}{host} )
  );
$_->{__work} ||= \%work for    #for dumper
  grep { $_->{dev_auto_dump} } @dc;
while ( @_ = grep { $_ and $_->active() } @dc ) {
  $_->work() for @_;
  #Time::HiRes::sleep 0.1;
}
#psmisc::printlog 'dev', 'endst', join ', ', map {$_->status }@dc
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)