view release on metacpan or  search on metacpan

examples/Meltdown.pl  view on Meta::CPAN

#
# run until we get cancelled
#
while (1) {
	#
	# show the column headers for every 20 lines of data
	#
    if ($firstrun == 1) {
        Header;
        $firstrun = 0;
    }
	if ($linecnt >= 20) {
        if ($csvmode != 1) {
    		Header;
        }
		$linecnt = 1;
	}
	else {
		$linecnt++;
	}

	#
	# snag the current time
	#
	($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isDST) = localtime();


	#
	# fire the command and collect the stats
	#

	$rx = rxdebug(servers => $server,
		port => $port,
		rxstats => 1,
		noconns => 1
		);

	# $wpack doesn't seem to have a corresponding value.
        # It is always zero.

	$tstats = $rx->{tstats};

	$wproc = $tstats->{nWaiting};
	$fpack = $tstats->{nFreePackets};
	$calls = $tstats->{callsExecuted};
	if ($oldcall > 0) {
		$delta = $calls - $oldcall;
	}
	else {
		$delta = 0;
	}
	$oldcall = $calls;
	$rxstats = $rx->{rxstats};
	$data = $rxstats->{dataPacketsSent};
	$resend = $rxstats->{dataPacketsReSent};
	$nobuf = $rxstats->{noPacketBuffersOnRead};
	$idle = $tstats->{idleThreads};

	#
	# verify and fix field format lengths
	#
	Check_data;

    if ($csvmode != 1) {
    	#
    	# output the timestamp and current results
    	#
    	printf "%2.2d:%2.2d:%2.2d ", $hour,$min,$sec;
    	printf "%-$Ln[0].0f %-$Ln[1].0f %-$Ln[2].0f %-$Ln[3].0f ",
    		$wproc,$nobuf,$wpack,$fpack;
    	printf "%-$Ln[4].0f %-$Ln[5].0f %-$Ln[6].0f %-$Ln[7].0f %-$Ln[8].0f\n",
    		$calls,$delta,$data,$resend,$idle;
    } else { # must be csv mode then...
    	printf "%2.2d:%2.2d:%2.2d,", $hour,$min,$sec;
    	printf "$wproc,$nobuf,$wpack,$fpack";
    	printf "$calls,$delta,$data,$resend,$idle\n";
    }

  	#
	# delay for the required interval
	#
	sleep($delay);
}

exit();