kstat.pl revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License, Version 1.0 only
# (the "License"). You may not use this file except in compliance
# with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#
#
# Copyright 2004 Sun Microsystems, Inc. All rights reserved.
# Use is subject to license terms.
#
#ident "%Z%%M% %I% %E% SMI"
#
require 5.6.1;
use strict;
use warnings;
use locale;
#
# Print an usage message and exit
#
sub usage(@)
{
my (@msg) = @_;
"Usage:\n" .
"kstat [ -qlp ] [ -T d|u ] [ -c class ]\n" .
" [ -m module ] [ -i instance ] [ -n name ] [ -s statistic ]\n" .
" [ interval [ count ] ]\n" .
"kstat [ -qlp ] [ -T d|u ] [ -c class ]\n" .
" [ module:instance:name:statistic ... ]\n" .
" [ interval [ count ] ]\n"
);
exit(2);
}
#
# Print a fatal error message and exit
#
sub error(@)
{
my (@msg) = @_;
exit(1);
}
#
# Generate an anonymous sub that can be used to filter the kstats we will
# display. The generated sub will take one parameter, the string to match
# against. There are three types of input catered for:
# 1) Empty string. The returned sub will match anything
# 2) String surrounded by '/' characters. This will be interpreted as a
# perl RE. If the RE is syntactically incorrect, an error will be
# reported.
# 3) Any other string. The returned sub will use gmatch(3GEN) to match
# against the passed string
#
sub gen_sub($)
{
my ($pat) = @_;
# Anything undefined or empty will always match
return (sub { 1; });
# Anything surrounded by '/' is a perl RE
} elsif ($pat =~ m!^/[^/]*/$!) {
my $sub;
if (! ($sub = eval "sub { return(\$_[0] =~ $pat); }" )) {
$@ =~ s/\s+at\s+.*\n$//;
usage($@);
}
return ($sub);
# Otherwise default to gmatch
} else {
}
}
#
# Main routine of the script
#
# Set message locale
# Process command options
# Validate -q and -l flags
# Get interval & count if specified
$count = -1;
}
# Get timestamp flag
my $timestamp;
if ($timestamp eq "d") {
} elsif ($timestamp eq "u") {
$timestamp = sub { print(time(), "\n"); };
} else {
}
}
# Deal with -[mins] flags
"-m -i -n -s are mutually exclusive")) if (@ARGV);
qw(m i n s))));
}
# Deal with class, if specified
# If no selectors have been defined, add a dummy one to match everything
# Convert each remaining option into four anonymous subs
foreach my $p (@ARGV) {
}
# Loop, printing the selected kstats as many times and as often as required
my $matched = 0;
# Format strings for displaying data
my $fmt1 = "module: %-30.30s instance: %-6d\n";
my $fmt2 = "name: %-30.30s class: %-.30s\n";
my $fmt3 = "\t%-30s %s\n";
foreach my $m (@matcher) {
foreach my $i (sort({ $a <=> $b }
foreach my $n (sort(grep(&$name($_),
keys(%$ih)))) {
# Prune any not in the required class
if ($quiet) {
} elsif ($parseable) {
foreach my $s
(sort(grep(&$statistic($_),
keys(%$nh)))) {
print("$m:$i:$n:$s");
print("\t$nh->{$s}")
if (! $list);
print("\n");
$matched = 1;
}
# human-readable
} else {
if (my @stats =
sort(grep(&$statistic($_),
keys(%$nh)))) {
printf($fmt1, $m, $i);
printf($fmt2, $n,
foreach my $s
(grep($_ ne "class",
@stats)) {
printf($fmt3,
$s, $nh->{$s});
}
print("\n");
$matched = 1;
}
}
}
}
}
}
$| = 1; $| = 0;
sleep($interval);
print("\n");
}
}