cmd/show/data_stats.pl

   1 #
   2 # show the users on this cluster from the routing tables
   3 #
   4 # Copyright (c) 1998 Dirk Koopman G1TLH
   5 #
   6 #
   7 #
   8
   9 sub handle
  10 {
  11         my ($self, $line) = @_;
  12         my @in = map { uc } split /\s+/, $line; # list of callsigns of nodes
  13         my @out;
  14         my @list;
  15
  16         if ($in[0] eq 'ALL') {
  17                 @list = keys %DXChannel::channels;
  18         } else {
  19                 while (@in) {
  20                         my $in = shift @in;
  21                         if ($in =~ /^NOD/){
  22                                 push @list, DXChannel::get_all_node_calls();
  23                         } elsif ($in =~ /^USE/) {
  24                                 push @list, DXChannel::get_all_user_calls();
  25                         } elsif ($in =~ /^RBN|SKI/) {
  26                                 push @list, map {$_->is_rbn ? $_->call : undef} DXChannel::get_all();
  27                         } else {
  28                                 push @list, $in;
  29                         }
  30                 }
  31         }
  32
  33         my $dt = difft($main::starttime, ' ');
  34         push @out, sprintf "Transfered in:%-12.12s     IN                                OUT", $dt;
  35         push @out, "Callsign             Lines             Data            Lines             Data";
  36         push @out, "-----------------------------------------------------------------------------";
  37         push @list, $self->call unless @list;
  38         foreach my $call (sort @list) {
  39                 next if $call eq $main::mycall;
  40                 my $dxchan = DXChannel::get($call);
  41                 if ($dxchan) {
  42                         my $conn = $dxchan->conn;
  43                         push @out, sprintf("%-9.9s %16s %16s %16s %16s", $call, comma($conn->{linesin}), comma($conn->{datain}), comma($conn->{linesout}), comma($conn->{dataout}));
  44                 }
  45         }
  46
  47         push @out, "-----------------------------------------------------------------------------" if @out > 3;
  48         push @out, sprintf("%-9.9s %16s %16s %16s %16s", "TOTALS", comma($Msg::total_lines_in), comma($Msg::total_in), comma($Msg::total_lines_out), comma($Msg::total_out));
  49
  50         return (1, @out);
  51 }
  52
  53 sub comma
  54 {
  55         my $num = shift;
  56         return scalar reverse(join(",",unpack("(A3)*", reverse int($num))));
  57 }
  58