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