view release on metacpan or  search on metacpan

examples/rxdebug  view on Meta::CPAN

}

if ($all || $tests[12]) {
  print "\n******** TEST 12 ********\n";

  print "\nrxdebug -servers $servers -port $port -allconnections -onlyclient -onlyport $onlyport -onlyhost $onlyhost\n\n";

  $rxdeb = rxdebug(allconnections => 1,
                   onlyclient     => 1,
                   onlyport       => $onlyport,
                   servers        => $servers,
                   port           => $port,
                   onlyhost       => $onlyhost
                  );
  parse_results ($rxdeb);
}

if ($all || $tests[13]) {
  print "\n******** TEST 13 ********\n";

  print "\nrxdebug -servers $servers\n\n";

  $rxdeb = rxdebug(servers => $servers);
  parse_results ($rxdeb);
}

if ($all || $tests[14]) {
  print "\n******** TEST 14 ********\n";

  print "\nrxdebug 0\n\n";

  $rxdeb = rxdebug();
  parse_results ($rxdeb);
}

if ($all || $tests[15]) {
  print "\n******** TEST 15 ********\n";

  print "\nrxdebug 0 -port $port\n\n";

  $rxdeb = rxdebug(port => $port);
  parse_results ($rxdeb);
}

if ($all || $tests[16]) {
  print "\n******** TEST 16 ********\n";

  print "\nrxdebug -servers $servers -port $port -allconnections -peers -long -rxstats\n\n";

  $rxdeb = rxdebug(allconnections => 1,
                   rxstats        => 1,
                   peers          => 1,
                   long           => 1,
                   servers        => $servers,
                   port           => $port
                  );
  parse_results($rxdeb);
}


sub parse_results {
  my $val = shift;

  # if there was an error, print it and then return.
  if ($AFS::CODE) {
    print "Error case: ", ref($val), "\n" if (defined($val));
    # die("Error: AFS::CODE = $AFS::CODE (", ($AFS::CODE+0), ")\n");
    print "Error: AFS::CODE = $AFS::CODE (", ($AFS::CODE+0), ")\n";
    return;
  }

  # print entire hash to screen
  if ($showdump) {
    print Dumper($val);
    return;
  }

  # print ip address and port
  print "For ", $val->{address}, " (port ", $val->{port}, ") ...\n";

  # prints everything as the rxdebug function would

  # print version if it was returned
  if (exists $val->{version}) {
    print "AFS version: ", $val->{version}, "\n";
  }

  # print tstats if they were returned
  if (exists $val->{tstats}) {
    print "Free packets: $val->{tstats}->{nFreePackets}, ";
    print "packet reclaims: $val->{tstats}->{packetReclaims}, ";
    print "calls: $val->{tstats}->{callsExecuted}, ";
    print "used FDs: $val->{tstats}->{usedFDs}\n";
    if (!$val->{tstats}->{waitingForPackets}) {
      print "not ";
    }
    print "waiting for packets.\n";
    if (exists $val->{tstats}->{nWaiting}) {
      print "$val->{tstats}->{nWaiting} calls waiting for a thread\n";
    }
    if (exists $val->{tstats}->{idleThreads}) {
      print "$val->{tstats}->{idleThreads} threads are idle\n";
    }
  }

  # print rxstats if they were returned
  if (exists $val->{rxstats}) {

    print "rx stats: free packets ", $val->{tstats}->{nFreePackets},
          ", allocs ", $val->{rxstats}->{packetRequests}, ", ";

    if ($val->{tstats}->{version} >=
               constant("RX_DEBUGI_VERSION_W_NEWPACKETTYPES")) {

      print "alloc-failures(rcv ", $val->{rxstats}->{receivePktAllocFailures},
        "/", $val->{rxstats}->{receiveCbufPktAllocFailures},
        ",send ", $val->{rxstats}->{sendPktAllocFailures},
        "/", $val->{rxstats}->{sendCbufPktAllocFailures},
        ",ack ", $val->{rxstats}->{specialPktAllocFailures}, ")\n";
    } else {
      print "alloc-failures(rcv ", $val->{rxstats}->{receivePktAllocFailures},