1#!/usr/bin/perl
2#$Id: pinger.pl 990 2012-12-28 20:35:04Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/examples/pinger.pl $
3
4=head1 NAME
5
6get info about hubs
7
8=head1 SYNOPSIS
9
10 ./pinger.pl hub hub ...
11
12 ./pinger.pl adc://dc.hub.com:412  dc.hub.com
13
14=head1 CONFIGURE
15
16 create config.pl:
17 $config{dc}{host} = 'myhub.net';
18
19=cut
20use 5.10.0;
21use strict;
22use Data::Dumper;
23$Data::Dumper::Sortkeys = $Data::Dumper::Useqq = $Data::Dumper::Indent = 1;
24use Time::HiRes qw(time sleep);
25#use Encode;
26use lib::abs '../lib';
27#use lib '../TigerHash/lib';
28#use lib './stat/pslib';
29our (%config);
30use Net::DirectConnect::pslib::psmisc;
31psmisc->import qw(:log);
32#use psmisc;
33#use pssql;
34use Net::DirectConnect;
35$config{disconnect_after}     //= 10;
36$config{disconnect_after_inf} //= 0;
37$config{ 'log_' . $_ } //= 0 for qw (dmp dcdmp dcdbg);
38psmisc::configure();    #psmisc::lib_init();
39printlog("usage: $1 [adc|dchub://]host[:port] [hub..]\n"), exit if !$ARGV[0] and !$config{dc}{host} and !$config{dc}{hosts};
40printlog( 'info', 'started:', $^X, $0, join ' ', @ARGV );
41#$SIG{INT} = $SIG{KILL} = sub { printlog 'exiting', exit; };
42#use Net::DirectConnect::adc;
43#my $dc =
44Net::DirectConnect->new(
45  #modules  => ['filelist'],
46  SUPAD => { H => { PING => 1 } },
47  #botinfo      => 'devperlpinger',
48  auto_GetINFO => 1,
49  auto_connect => 1,
50  auto_say     => 1,
51  dev_http     => 1,
52  'log'        => sub (@) {
53    my $dc = ref $_[0] ? shift : {};
54    psmisc::printlog shift(), "[$dc->{'number'}]", @_,;
55  },
56  'handler' => {
57    INF => sub {
58      my $dc  = shift;
59      my $dst = shift @{ $_[0] };
60      return if $dst ne 'I';
61      my $info = pop;
62      printlog( "getted adc info: $info->{UC} $info->{SS} $info->{SF}, full=", Dumper $info);
63      $dc->destroy() if $config{disconnect_after_inf};    #no manual calc, disconnect
64    },
65  },
66  auto_work => sub {
67    my $dc = shift;
68    #our $starttime ||= time if $dc->{status} eq 'connected';
69    #$BotINFO <bot description>|
70    if ( time - $dc->{time_start} > $config{disconnect_after} ) {    # works only 10 seconds (for users inf getting)
71      my $info = $dc->stat_hub();
72      printlog( "calced info: $info->{UC} $info->{SS} $info->{SF}, full=", Dumper($info) );
73      $dc->destroy();
74    }
75    psmisc::schedule(
76      [ 20, 100 ],
77      our $dump_sub__ ||= sub {
78        printlog("Writing dump");
79        psmisc::file_rewrite( $0 . '.dump', Dumper $dc);
80      }
81    ) if $config{debug};
82  },
83  %{ $config{dc} || {} },
84  ( $_ ? ( 'host' => $_ ) : () ),
85) for ( @ARGV, @{ $config{dc}{hosts} || [] } );
86