xref: /onnv-gate/usr/src/cmd/pgstat/pgstat.pl (revision 13124:8f28cf08bb11)
1*13124SAlexander.Kolbasov@Sun.COM#! /usr/perl5/bin/perl
2*13124SAlexander.Kolbasov@Sun.COM#
3*13124SAlexander.Kolbasov@Sun.COM# CDDL HEADER START
4*13124SAlexander.Kolbasov@Sun.COM#
5*13124SAlexander.Kolbasov@Sun.COM# The contents of this file are subject to the terms of the
6*13124SAlexander.Kolbasov@Sun.COM# Common Development and Distribution License (the "License").
7*13124SAlexander.Kolbasov@Sun.COM# You may not use this file except in compliance with the License.
8*13124SAlexander.Kolbasov@Sun.COM#
9*13124SAlexander.Kolbasov@Sun.COM# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10*13124SAlexander.Kolbasov@Sun.COM# or http://www.opensolaris.org/os/licensing.
11*13124SAlexander.Kolbasov@Sun.COM# See the License for the specific language governing permissions
12*13124SAlexander.Kolbasov@Sun.COM# and limitations under the License.
13*13124SAlexander.Kolbasov@Sun.COM#
14*13124SAlexander.Kolbasov@Sun.COM# When distributing Covered Code, include this CDDL HEADER in each
15*13124SAlexander.Kolbasov@Sun.COM# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16*13124SAlexander.Kolbasov@Sun.COM# If applicable, add the following below this CDDL HEADER, with the
17*13124SAlexander.Kolbasov@Sun.COM# fields enclosed by brackets "[]" replaced with your own identifying
18*13124SAlexander.Kolbasov@Sun.COM# information: Portions Copyright [yyyy] [name of copyright owner]
19*13124SAlexander.Kolbasov@Sun.COM#
20*13124SAlexander.Kolbasov@Sun.COM# CDDL HEADER END
21*13124SAlexander.Kolbasov@Sun.COM#
22*13124SAlexander.Kolbasov@Sun.COM
23*13124SAlexander.Kolbasov@Sun.COM#
24*13124SAlexander.Kolbasov@Sun.COM# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved.
25*13124SAlexander.Kolbasov@Sun.COM#
26*13124SAlexander.Kolbasov@Sun.COM
27*13124SAlexander.Kolbasov@Sun.COM#
28*13124SAlexander.Kolbasov@Sun.COM# pgstat - tool for displaying Processor Group statistics
29*13124SAlexander.Kolbasov@Sun.COM#
30*13124SAlexander.Kolbasov@Sun.COM
31*13124SAlexander.Kolbasov@Sun.COMuse warnings;
32*13124SAlexander.Kolbasov@Sun.COMuse strict;
33*13124SAlexander.Kolbasov@Sun.COMuse File::Basename;
34*13124SAlexander.Kolbasov@Sun.COMuse List::Util qw(first max min);
35*13124SAlexander.Kolbasov@Sun.COMuse Errno;
36*13124SAlexander.Kolbasov@Sun.COMuse POSIX qw(locale_h strftime);
37*13124SAlexander.Kolbasov@Sun.COMuse Getopt::Long qw(:config no_ignore_case bundling auto_version);
38*13124SAlexander.Kolbasov@Sun.COMuse Sun::Solaris::Utils qw(textdomain gettext);
39*13124SAlexander.Kolbasov@Sun.COMuse Sun::Solaris::Pg;
40*13124SAlexander.Kolbasov@Sun.COM
41*13124SAlexander.Kolbasov@Sun.COM#
42*13124SAlexander.Kolbasov@Sun.COM# Constants section
43*13124SAlexander.Kolbasov@Sun.COM#
44*13124SAlexander.Kolbasov@Sun.COM# It is possible that wnen trying to parse PG kstats, PG generation changes
45*13124SAlexander.Kolbasov@Sun.COM# which will cause PG new method to fail with errno set to EAGAIN In this case
46*13124SAlexander.Kolbasov@Sun.COM# we retry open up to RETRY_COUNT times pausing RETRY_DELAY seconds between each
47*13124SAlexander.Kolbasov@Sun.COM# retry.
48*13124SAlexander.Kolbasov@Sun.COM#
49*13124SAlexander.Kolbasov@Sun.COM# When printing PGs we print them as a little tree with each PG shifted by
50*13124SAlexander.Kolbasov@Sun.COM# LEVEL_OFFSET from each parent. For example:
51*13124SAlexander.Kolbasov@Sun.COM#
52*13124SAlexander.Kolbasov@Sun.COM# PG  RELATIONSHIP                    CPUs
53*13124SAlexander.Kolbasov@Sun.COM# 0   System                          0-7
54*13124SAlexander.Kolbasov@Sun.COM# 3    Socket                         0 2 4 6
55*13124SAlexander.Kolbasov@Sun.COM# 2     Cache                        0 2 4 6
56*13124SAlexander.Kolbasov@Sun.COM#
57*13124SAlexander.Kolbasov@Sun.COM#
58*13124SAlexander.Kolbasov@Sun.COM# DEFAULT_INTERVAL - interval in seconds between snapshot if none is specified
59*13124SAlexander.Kolbasov@Sun.COM# DEFAULT_COUNT	   - Number of iterations if none is specified
60*13124SAlexander.Kolbasov@Sun.COM# HWLOAD_UNKNOWN   - Value that we use to represent unknown hardware load
61*13124SAlexander.Kolbasov@Sun.COM# HWLOAD_UNDEF	   - Value that we use to represent undefined hardware load
62*13124SAlexander.Kolbasov@Sun.COM#
63*13124SAlexander.Kolbasov@Sun.COMuse constant {
64*13124SAlexander.Kolbasov@Sun.COM	VERSION		=> 1.1,
65*13124SAlexander.Kolbasov@Sun.COM	DEFAULT_INTERVAL => 1,
66*13124SAlexander.Kolbasov@Sun.COM        DEFAULT_COUNT	=> 1,
67*13124SAlexander.Kolbasov@Sun.COM	RETRY_COUNT	=> 4,
68*13124SAlexander.Kolbasov@Sun.COM        RETRY_DELAY	=> 0.25,
69*13124SAlexander.Kolbasov@Sun.COM	HWLOAD_UNKNOWN	=> -1,
70*13124SAlexander.Kolbasov@Sun.COM	HWLOAD_UNDEF	=> -2,
71*13124SAlexander.Kolbasov@Sun.COM	LEVEL_OFFSET	=> 1,
72*13124SAlexander.Kolbasov@Sun.COM};
73*13124SAlexander.Kolbasov@Sun.COM
74*13124SAlexander.Kolbasov@Sun.COM#
75*13124SAlexander.Kolbasov@Sun.COM# Format for fields, showing percentage headers
76*13124SAlexander.Kolbasov@Sun.COM#
77*13124SAlexander.Kolbasov@Sun.COMmy $pcnt_fmt = "%6s";
78*13124SAlexander.Kolbasov@Sun.COM#
79*13124SAlexander.Kolbasov@Sun.COM# Format for percentages field
80*13124SAlexander.Kolbasov@Sun.COM#
81*13124SAlexander.Kolbasov@Sun.COMmy $pcnt = "%5.1f";
82*13124SAlexander.Kolbasov@Sun.COM
83*13124SAlexander.Kolbasov@Sun.COM#
84*13124SAlexander.Kolbasov@Sun.COM# Return codes
85*13124SAlexander.Kolbasov@Sun.COM#
86*13124SAlexander.Kolbasov@Sun.COM#     0    Successful completion.
87*13124SAlexander.Kolbasov@Sun.COM#
88*13124SAlexander.Kolbasov@Sun.COM#     1    An error occurred.
89*13124SAlexander.Kolbasov@Sun.COM#
90*13124SAlexander.Kolbasov@Sun.COM#     2    Invalid command-line options were specified.
91*13124SAlexander.Kolbasov@Sun.COM#
92*13124SAlexander.Kolbasov@Sun.COMuse constant {
93*13124SAlexander.Kolbasov@Sun.COM	E_SUCCESS => 0,
94*13124SAlexander.Kolbasov@Sun.COM	E_ERROR => 1,
95*13124SAlexander.Kolbasov@Sun.COM	E_USAGE => 2,
96*13124SAlexander.Kolbasov@Sun.COM};
97*13124SAlexander.Kolbasov@Sun.COM
98*13124SAlexander.Kolbasov@Sun.COM#
99*13124SAlexander.Kolbasov@Sun.COM# Valid sort keys for -s and -S options
100*13124SAlexander.Kolbasov@Sun.COM#
101*13124SAlexander.Kolbasov@Sun.COMmy @sort_keys = qw(pg hwload swload user sys idle depth breadth);
102*13124SAlexander.Kolbasov@Sun.COM
103*13124SAlexander.Kolbasov@Sun.COM# Set message locale
104*13124SAlexander.Kolbasov@Sun.COMsetlocale(LC_ALL, "");
105*13124SAlexander.Kolbasov@Sun.COMtextdomain(TEXT_DOMAIN);
106*13124SAlexander.Kolbasov@Sun.COM
107*13124SAlexander.Kolbasov@Sun.COM# Get script name for error messages
108*13124SAlexander.Kolbasov@Sun.COMour $cmdname = basename($0, ".pl");
109*13124SAlexander.Kolbasov@Sun.COM
110*13124SAlexander.Kolbasov@Sun.COMmy @pg_list;		# -P pg,...	- PG arguments
111*13124SAlexander.Kolbasov@Sun.COMmy @cpu_list;		# -c cpu,...	- CPU arguments
112*13124SAlexander.Kolbasov@Sun.COMmy @sharing_filter_neg; # -R string,... - Prune PGs
113*13124SAlexander.Kolbasov@Sun.COMmy @sharing_filter;	# -r string,...	- Matching sharing names
114*13124SAlexander.Kolbasov@Sun.COMmy $do_aggregate;	# -A		- Show summary in the end
115*13124SAlexander.Kolbasov@Sun.COMmy $do_cpu_utilization; # -C		- Show per-CPU utilization
116*13124SAlexander.Kolbasov@Sun.COMmy $do_physical;	# -p		- Show physical relationships
117*13124SAlexander.Kolbasov@Sun.COMmy $do_timestamp;	# -T		- Print timestamp
118*13124SAlexander.Kolbasov@Sun.COMmy $do_usage;		# -h		- Show usage
119*13124SAlexander.Kolbasov@Sun.COMmy $do_version;		# -V		- Verbose output
120*13124SAlexander.Kolbasov@Sun.COMmy $show_top;		# -t		- show top N
121*13124SAlexander.Kolbasov@Sun.COMmy $sort_order_a;	# -S key	- Ascending sort order
122*13124SAlexander.Kolbasov@Sun.COMmy $sort_order_d;	# -s key	- Descending sort order
123*13124SAlexander.Kolbasov@Sun.COMmy $verbose;		# -v		- Verbose output;
124*13124SAlexander.Kolbasov@Sun.COM
125*13124SAlexander.Kolbasov@Sun.COM$verbose = 0;
126*13124SAlexander.Kolbasov@Sun.COM
127*13124SAlexander.Kolbasov@Sun.COM# Parse options from the command line
128*13124SAlexander.Kolbasov@Sun.COMGetOptions("aggregate|A"	=> \$do_aggregate,
129*13124SAlexander.Kolbasov@Sun.COM	   "cpus|c=s"		=> \@cpu_list,
130*13124SAlexander.Kolbasov@Sun.COM	   "showcpu|C"		=> \$do_cpu_utilization,
131*13124SAlexander.Kolbasov@Sun.COM	   "help|h|?"		=> \$do_usage,
132*13124SAlexander.Kolbasov@Sun.COM	   "pgs|P=s"		=> \@pg_list,
133*13124SAlexander.Kolbasov@Sun.COM	   "physical|p"		=> \$do_physical,
134*13124SAlexander.Kolbasov@Sun.COM	   "relationship|r=s"	=> \@sharing_filter,
135*13124SAlexander.Kolbasov@Sun.COM	   "norelationship|R=s" => \@sharing_filter_neg,
136*13124SAlexander.Kolbasov@Sun.COM	   "sort|s=s"		=> \$sort_order_d,
137*13124SAlexander.Kolbasov@Sun.COM	   "Sort|S=s"		=> \$sort_order_a,
138*13124SAlexander.Kolbasov@Sun.COM	   "top|t=i"		=> \$show_top,
139*13124SAlexander.Kolbasov@Sun.COM	   "timestamp|T=s"	=> \$do_timestamp,
140*13124SAlexander.Kolbasov@Sun.COM	   "version|V"		=> \$do_version,
141*13124SAlexander.Kolbasov@Sun.COM	   "verbose+"		=> \$verbose,
142*13124SAlexander.Kolbasov@Sun.COM	   "v+"			=> \$verbose,
143*13124SAlexander.Kolbasov@Sun.COM) || usage(E_USAGE);
144*13124SAlexander.Kolbasov@Sun.COM
145*13124SAlexander.Kolbasov@Sun.COM# Print usage message when -h is given
146*13124SAlexander.Kolbasov@Sun.COMusage(E_SUCCESS) if $do_usage;
147*13124SAlexander.Kolbasov@Sun.COM
148*13124SAlexander.Kolbasov@Sun.COMif ($do_version) {
149*13124SAlexander.Kolbasov@Sun.COM	printf gettext("%s version %s\n"), $cmdname, VERSION;
150*13124SAlexander.Kolbasov@Sun.COM	exit(E_SUCCESS);
151*13124SAlexander.Kolbasov@Sun.COM}
152*13124SAlexander.Kolbasov@Sun.COM
153*13124SAlexander.Kolbasov@Sun.COM#
154*13124SAlexander.Kolbasov@Sun.COM# Verify options
155*13124SAlexander.Kolbasov@Sun.COM#
156*13124SAlexander.Kolbasov@Sun.COM# -T should have either u or d argument
157*13124SAlexander.Kolbasov@Sun.COMif (defined($do_timestamp) && !($do_timestamp eq 'u' || $do_timestamp eq 'd')) {
158*13124SAlexander.Kolbasov@Sun.COM	printf STDERR gettext("%s: Invalid -T %s argument\n"),
159*13124SAlexander.Kolbasov@Sun.COM	  $cmdname, $do_timestamp;
160*13124SAlexander.Kolbasov@Sun.COM	usage(E_USAGE);
161*13124SAlexander.Kolbasov@Sun.COM}
162*13124SAlexander.Kolbasov@Sun.COM
163*13124SAlexander.Kolbasov@Sun.COMif ($sort_order_a && $sort_order_d) {
164*13124SAlexander.Kolbasov@Sun.COM	printf STDERR gettext("%s: -S and -s flags can not be used together\n"),
165*13124SAlexander.Kolbasov@Sun.COM	  $cmdname;
166*13124SAlexander.Kolbasov@Sun.COM	usage(E_USAGE);
167*13124SAlexander.Kolbasov@Sun.COM}
168*13124SAlexander.Kolbasov@Sun.COM
169*13124SAlexander.Kolbasov@Sun.COMif (defined ($show_top) && $show_top <= 0) {
170*13124SAlexander.Kolbasov@Sun.COM	printf STDERR gettext("%s: -t should specify positive integer\n"),
171*13124SAlexander.Kolbasov@Sun.COM	  $cmdname;
172*13124SAlexander.Kolbasov@Sun.COM	usage(E_USAGE);
173*13124SAlexander.Kolbasov@Sun.COM}
174*13124SAlexander.Kolbasov@Sun.COM
175*13124SAlexander.Kolbasov@Sun.COM#
176*13124SAlexander.Kolbasov@Sun.COM# Figure out requested sorting of the output
177*13124SAlexander.Kolbasov@Sun.COM# By default 'depth-first' is used
178*13124SAlexander.Kolbasov@Sun.COM#
179*13124SAlexander.Kolbasov@Sun.COMmy $sort_key;
180*13124SAlexander.Kolbasov@Sun.COMmy $sort_reverse;
181*13124SAlexander.Kolbasov@Sun.COM
182*13124SAlexander.Kolbasov@Sun.COMif (!($sort_order_a || $sort_order_d)) {
183*13124SAlexander.Kolbasov@Sun.COM	$sort_key = 'depth';
184*13124SAlexander.Kolbasov@Sun.COM	$sort_reverse = 1;
185*13124SAlexander.Kolbasov@Sun.COM} else {
186*13124SAlexander.Kolbasov@Sun.COM	$sort_key = $sort_order_d || $sort_order_a;
187*13124SAlexander.Kolbasov@Sun.COM	$sort_reverse = defined($sort_order_d);
188*13124SAlexander.Kolbasov@Sun.COM}
189*13124SAlexander.Kolbasov@Sun.COM
190*13124SAlexander.Kolbasov@Sun.COM#
191*13124SAlexander.Kolbasov@Sun.COM# Make sure sort key is valid
192*13124SAlexander.Kolbasov@Sun.COM#
193*13124SAlexander.Kolbasov@Sun.COMif (!list_match($sort_key, \@sort_keys, 1)) {
194*13124SAlexander.Kolbasov@Sun.COM	printf STDERR gettext("%s: invalid sort key %s\n"),
195*13124SAlexander.Kolbasov@Sun.COM	  $cmdname, $sort_key;
196*13124SAlexander.Kolbasov@Sun.COM	usage(E_USAGE);
197*13124SAlexander.Kolbasov@Sun.COM}
198*13124SAlexander.Kolbasov@Sun.COM
199*13124SAlexander.Kolbasov@Sun.COM#
200*13124SAlexander.Kolbasov@Sun.COM# Convert -[Rr] string1,string2,... into list (string1, string2, ...)
201*13124SAlexander.Kolbasov@Sun.COM#
202*13124SAlexander.Kolbasov@Sun.COM@sharing_filter = map { split /,/ } @sharing_filter;
203*13124SAlexander.Kolbasov@Sun.COM@sharing_filter_neg = map { split /,/ } @sharing_filter_neg;
204*13124SAlexander.Kolbasov@Sun.COM
205*13124SAlexander.Kolbasov@Sun.COM#
206*13124SAlexander.Kolbasov@Sun.COM# We use two PG snapshot to compare utilization between them. One snapshot is
207*13124SAlexander.Kolbasov@Sun.COM# kept behind another in time.
208*13124SAlexander.Kolbasov@Sun.COM#
209*13124SAlexander.Kolbasov@Sun.COMmy $p = Sun::Solaris::Pg->new(-cpudata => $do_cpu_utilization,
210*13124SAlexander.Kolbasov@Sun.COM			      -swload => 1,
211*13124SAlexander.Kolbasov@Sun.COM			      -tags => $do_physical,
212*13124SAlexander.Kolbasov@Sun.COM			      -retry => RETRY_COUNT,
213*13124SAlexander.Kolbasov@Sun.COM			      -delay => RETRY_DELAY);
214*13124SAlexander.Kolbasov@Sun.COM
215*13124SAlexander.Kolbasov@Sun.COMif (!$p) {
216*13124SAlexander.Kolbasov@Sun.COM	printf STDERR
217*13124SAlexander.Kolbasov@Sun.COM	  gettext("%s: can not obtain Processor Group information: $!\n"),
218*13124SAlexander.Kolbasov@Sun.COM	    $cmdname;
219*13124SAlexander.Kolbasov@Sun.COM	exit(E_ERROR);
220*13124SAlexander.Kolbasov@Sun.COM}
221*13124SAlexander.Kolbasov@Sun.COM
222*13124SAlexander.Kolbasov@Sun.COMmy $p_initial = $p;
223*13124SAlexander.Kolbasov@Sun.COMmy $p_dup = Sun::Solaris::Pg->new(-cpudata => $do_cpu_utilization,
224*13124SAlexander.Kolbasov@Sun.COM				  -swload => 1,
225*13124SAlexander.Kolbasov@Sun.COM				  -tags => $do_physical,
226*13124SAlexander.Kolbasov@Sun.COM				  -retry => RETRY_COUNT,
227*13124SAlexander.Kolbasov@Sun.COM				  -delay => RETRY_DELAY);
228*13124SAlexander.Kolbasov@Sun.COM
229*13124SAlexander.Kolbasov@Sun.COMif (!$p_dup) {
230*13124SAlexander.Kolbasov@Sun.COM	printf STDERR
231*13124SAlexander.Kolbasov@Sun.COM	  gettext("%s: can not obtain Processor Group information: $!\n"),
232*13124SAlexander.Kolbasov@Sun.COM	    $cmdname;
233*13124SAlexander.Kolbasov@Sun.COM	exit(E_ERROR);
234*13124SAlexander.Kolbasov@Sun.COM}
235*13124SAlexander.Kolbasov@Sun.COM
236*13124SAlexander.Kolbasov@Sun.COM#
237*13124SAlexander.Kolbasov@Sun.COM# Get interval and count
238*13124SAlexander.Kolbasov@Sun.COM#
239*13124SAlexander.Kolbasov@Sun.COMmy $count = DEFAULT_COUNT;
240*13124SAlexander.Kolbasov@Sun.COMmy $interval = DEFAULT_INTERVAL;
241*13124SAlexander.Kolbasov@Sun.COM
242*13124SAlexander.Kolbasov@Sun.COMif (scalar @ARGV > 0) {
243*13124SAlexander.Kolbasov@Sun.COM	$interval = shift @ARGV;
244*13124SAlexander.Kolbasov@Sun.COM	if (scalar @ARGV > 0) {
245*13124SAlexander.Kolbasov@Sun.COM		$count = $ARGV[0];
246*13124SAlexander.Kolbasov@Sun.COM	} else {
247*13124SAlexander.Kolbasov@Sun.COM		$count = 0;
248*13124SAlexander.Kolbasov@Sun.COM	}
249*13124SAlexander.Kolbasov@Sun.COM}
250*13124SAlexander.Kolbasov@Sun.COM
251*13124SAlexander.Kolbasov@Sun.COMif (! ($interval=~ m/^\d+\.?\d*$/)) {
252*13124SAlexander.Kolbasov@Sun.COM	printf STDERR
253*13124SAlexander.Kolbasov@Sun.COM	  gettext("%s: Invalid interval %s - should be numeric\n"),
254*13124SAlexander.Kolbasov@Sun.COM	    $cmdname, $interval;
255*13124SAlexander.Kolbasov@Sun.COM	usage(E_USAGE);
256*13124SAlexander.Kolbasov@Sun.COM}
257*13124SAlexander.Kolbasov@Sun.COM
258*13124SAlexander.Kolbasov@Sun.COMif ($count && ! ($count=~ m/^\d+$/)) {
259*13124SAlexander.Kolbasov@Sun.COM	printf STDERR
260*13124SAlexander.Kolbasov@Sun.COM	  gettext("%s: Invalid count %s - should be numeric\n"),
261*13124SAlexander.Kolbasov@Sun.COM	    $cmdname, $count;
262*13124SAlexander.Kolbasov@Sun.COM	usage(E_USAGE);
263*13124SAlexander.Kolbasov@Sun.COM}
264*13124SAlexander.Kolbasov@Sun.COM
265*13124SAlexander.Kolbasov@Sun.COMmy $infinite = 1 unless $count;
266*13124SAlexander.Kolbasov@Sun.COM
267*13124SAlexander.Kolbasov@Sun.COM#
268*13124SAlexander.Kolbasov@Sun.COM# Get list of all PGs
269*13124SAlexander.Kolbasov@Sun.COM#
270*13124SAlexander.Kolbasov@Sun.COMmy @all_pgs = $p->all_depth_first();
271*13124SAlexander.Kolbasov@Sun.COM
272*13124SAlexander.Kolbasov@Sun.COM#
273*13124SAlexander.Kolbasov@Sun.COM# get list of all CPUs in the system by looking at the root PG cpus
274*13124SAlexander.Kolbasov@Sun.COM#
275*13124SAlexander.Kolbasov@Sun.COMmy @all_cpus = $p->cpus($p->root());
276*13124SAlexander.Kolbasov@Sun.COM
277*13124SAlexander.Kolbasov@Sun.COM# PGs to work with
278*13124SAlexander.Kolbasov@Sun.COMmy @pgs = @all_pgs;
279*13124SAlexander.Kolbasov@Sun.COM
280*13124SAlexander.Kolbasov@Sun.COMmy $rc = E_SUCCESS;
281*13124SAlexander.Kolbasov@Sun.COM
282*13124SAlexander.Kolbasov@Sun.COM#
283*13124SAlexander.Kolbasov@Sun.COM# Convert CPU and PG lists into proper Perl lists, converting things like
284*13124SAlexander.Kolbasov@Sun.COM# 1-3,5 into (1, 2, 3, 5). Also convert 'all' into the list of all CPUs or PGs
285*13124SAlexander.Kolbasov@Sun.COM#
286*13124SAlexander.Kolbasov@Sun.COM@cpu_list =
287*13124SAlexander.Kolbasov@Sun.COM  map { $_ eq 'all' ? @all_cpus : $_ }	# all -> (cpu1, cpu2, ...)
288*13124SAlexander.Kolbasov@Sun.COM  map { split /,/ } @cpu_list;		# x,y -> (x, y)
289*13124SAlexander.Kolbasov@Sun.COM
290*13124SAlexander.Kolbasov@Sun.COM@cpu_list = $p->expand(@cpu_list);	# 1-3 -> 1 2 3
291*13124SAlexander.Kolbasov@Sun.COM
292*13124SAlexander.Kolbasov@Sun.COM# Same drill for PGs
293*13124SAlexander.Kolbasov@Sun.COM@pg_list =
294*13124SAlexander.Kolbasov@Sun.COM  map { $_ eq 'all' ? @all_pgs : $_ }
295*13124SAlexander.Kolbasov@Sun.COM  map { split /,/ } @pg_list;
296*13124SAlexander.Kolbasov@Sun.COM
297*13124SAlexander.Kolbasov@Sun.COM@pg_list = $p->expand(@pg_list);
298*13124SAlexander.Kolbasov@Sun.COM
299*13124SAlexander.Kolbasov@Sun.COM#
300*13124SAlexander.Kolbasov@Sun.COM# Convert CPU list to list of PGs
301*13124SAlexander.Kolbasov@Sun.COM#
302*13124SAlexander.Kolbasov@Sun.COMif (scalar @cpu_list) {
303*13124SAlexander.Kolbasov@Sun.COM
304*13124SAlexander.Kolbasov@Sun.COM	#
305*13124SAlexander.Kolbasov@Sun.COM	# Warn about any invalid CPU IDs in the arguments
306*13124SAlexander.Kolbasov@Sun.COM	# @bad_cpus is a list of invalid CPU IDs
307*13124SAlexander.Kolbasov@Sun.COM	#
308*13124SAlexander.Kolbasov@Sun.COM	my @bad_cpus = $p->set_subtract(\@all_cpus, \@cpu_list);
309*13124SAlexander.Kolbasov@Sun.COM	if (scalar @bad_cpus) {
310*13124SAlexander.Kolbasov@Sun.COM		printf STDERR
311*13124SAlexander.Kolbasov@Sun.COM		  gettext("%s: Invalid processor IDs %s\n"),
312*13124SAlexander.Kolbasov@Sun.COM		    $cmdname, $p->id_collapse(@bad_cpus);
313*13124SAlexander.Kolbasov@Sun.COM		$rc = E_ERROR;
314*13124SAlexander.Kolbasov@Sun.COM	}
315*13124SAlexander.Kolbasov@Sun.COM
316*13124SAlexander.Kolbasov@Sun.COM	#
317*13124SAlexander.Kolbasov@Sun.COM	# Find all PGs which have at least some CPUs from @cpu_list
318*13124SAlexander.Kolbasov@Sun.COM	#
319*13124SAlexander.Kolbasov@Sun.COM	my @pgs_from_cpus = grep {
320*13124SAlexander.Kolbasov@Sun.COM		my @cpus = $p->cpus($_);
321*13124SAlexander.Kolbasov@Sun.COM		scalar($p->intersect(\@cpus, \@cpu_list));
322*13124SAlexander.Kolbasov@Sun.COM	} @all_pgs;
323*13124SAlexander.Kolbasov@Sun.COM
324*13124SAlexander.Kolbasov@Sun.COM	# Combine PGs from @pg_list (if any) with PGs we found
325*13124SAlexander.Kolbasov@Sun.COM	@pg_list = (@pg_list, @pgs_from_cpus);
326*13124SAlexander.Kolbasov@Sun.COM}
327*13124SAlexander.Kolbasov@Sun.COM
328*13124SAlexander.Kolbasov@Sun.COM#
329*13124SAlexander.Kolbasov@Sun.COM# If there are any PGs specified by the user, complain about invalid ones
330*13124SAlexander.Kolbasov@Sun.COM#
331*13124SAlexander.Kolbasov@Sun.COM@pgs = get_pg_list($p, \@pg_list, \@sharing_filter, \@sharing_filter_neg);
332*13124SAlexander.Kolbasov@Sun.COM
333*13124SAlexander.Kolbasov@Sun.COMif (scalar @pg_list > 0) {
334*13124SAlexander.Kolbasov@Sun.COM	#
335*13124SAlexander.Kolbasov@Sun.COM	# Warn about any invalid PG
336*13124SAlexander.Kolbasov@Sun.COM	# @bad_pgs is a list of invalid CPUs in the arguments
337*13124SAlexander.Kolbasov@Sun.COM	#
338*13124SAlexander.Kolbasov@Sun.COM	my @bad_pgs = $p->set_subtract(\@all_pgs, \@pg_list);
339*13124SAlexander.Kolbasov@Sun.COM	if (scalar @bad_pgs) {
340*13124SAlexander.Kolbasov@Sun.COM		printf STDERR
341*13124SAlexander.Kolbasov@Sun.COM		  gettext("%s: warning: invalid PG IDs %s\n"),
342*13124SAlexander.Kolbasov@Sun.COM		    $cmdname, $p->id_collapse(@bad_pgs);
343*13124SAlexander.Kolbasov@Sun.COM	}
344*13124SAlexander.Kolbasov@Sun.COM}
345*13124SAlexander.Kolbasov@Sun.COM
346*13124SAlexander.Kolbasov@Sun.COM# Do we have any PGs left?
347*13124SAlexander.Kolbasov@Sun.COMif (scalar(@pgs) == 0) {
348*13124SAlexander.Kolbasov@Sun.COM	printf STDERR
349*13124SAlexander.Kolbasov@Sun.COM	gettext("%s: No processor groups matching command line arguments\n"),
350*13124SAlexander.Kolbasov@Sun.COM	    $cmdname;
351*13124SAlexander.Kolbasov@Sun.COM	exit(E_USAGE);
352*13124SAlexander.Kolbasov@Sun.COM}
353*13124SAlexander.Kolbasov@Sun.COM
354*13124SAlexander.Kolbasov@Sun.COM#
355*13124SAlexander.Kolbasov@Sun.COM# Set $do_levels if we should provide output identation by level It doesn't make
356*13124SAlexander.Kolbasov@Sun.COM# sense to provide identation if PGs are sorted not in topology order.
357*13124SAlexander.Kolbasov@Sun.COM#
358*13124SAlexander.Kolbasov@Sun.COMmy $do_levels = ($sort_key eq 'breadth' || $sort_key eq 'depth');
359*13124SAlexander.Kolbasov@Sun.COM
360*13124SAlexander.Kolbasov@Sun.COM#
361*13124SAlexander.Kolbasov@Sun.COM# %name_of_pg hash keeps sharing name, possibly with physical tags appended to
362*13124SAlexander.Kolbasov@Sun.COM# it for each PG.
363*13124SAlexander.Kolbasov@Sun.COM#
364*13124SAlexander.Kolbasov@Sun.COMmy %name_of_pg;
365*13124SAlexander.Kolbasov@Sun.COM
366*13124SAlexander.Kolbasov@Sun.COM#
367*13124SAlexander.Kolbasov@Sun.COM# For calculating proper offsets we need to know minimum and maximum level for
368*13124SAlexander.Kolbasov@Sun.COM# all PGs
369*13124SAlexander.Kolbasov@Sun.COM#
370*13124SAlexander.Kolbasov@Sun.COMmy $max_sharename_len = length('RELATIONSHIP');
371*13124SAlexander.Kolbasov@Sun.COM
372*13124SAlexander.Kolbasov@Sun.COMmy $maxlevel;
373*13124SAlexander.Kolbasov@Sun.COMmy $minlevel;
374*13124SAlexander.Kolbasov@Sun.COM
375*13124SAlexander.Kolbasov@Sun.COMif ($do_levels) {
376*13124SAlexander.Kolbasov@Sun.COM	my @levels = map { $p->level($_) } @pgs;	# Levels for each PG
377*13124SAlexander.Kolbasov@Sun.COM	$maxlevel = max(@levels);
378*13124SAlexander.Kolbasov@Sun.COM	$minlevel = min(@levels);
379*13124SAlexander.Kolbasov@Sun.COM}
380*13124SAlexander.Kolbasov@Sun.COM
381*13124SAlexander.Kolbasov@Sun.COM#
382*13124SAlexander.Kolbasov@Sun.COM# Walk over all PGs and find out the string length that we need to represent
383*13124SAlexander.Kolbasov@Sun.COM# sharing name + physical tags + indentation level.
384*13124SAlexander.Kolbasov@Sun.COM#
385*13124SAlexander.Kolbasov@Sun.COMforeach my $pg (@pgs) {
386*13124SAlexander.Kolbasov@Sun.COM	my $name =  $p->sh_name ($pg) || "unknown";
387*13124SAlexander.Kolbasov@Sun.COM	my $level = $p->level($pg) || 0 if $do_levels;
388*13124SAlexander.Kolbasov@Sun.COM
389*13124SAlexander.Kolbasov@Sun.COM	if ($do_physical) {
390*13124SAlexander.Kolbasov@Sun.COM		my $tags = $p->tags($pg);
391*13124SAlexander.Kolbasov@Sun.COM		$name = "$name [$tags]" if $tags;
392*13124SAlexander.Kolbasov@Sun.COM		$name_of_pg{$pg} = $name;
393*13124SAlexander.Kolbasov@Sun.COM	}
394*13124SAlexander.Kolbasov@Sun.COM
395*13124SAlexander.Kolbasov@Sun.COM	$name_of_pg{$pg} = $name;
396*13124SAlexander.Kolbasov@Sun.COM	my $length = length($name);
397*13124SAlexander.Kolbasov@Sun.COM	$length += $level - $minlevel if $do_levels;
398*13124SAlexander.Kolbasov@Sun.COM	$max_sharename_len = $length if $length > $max_sharename_len;
399*13124SAlexander.Kolbasov@Sun.COM}
400*13124SAlexander.Kolbasov@Sun.COM
401*13124SAlexander.Kolbasov@Sun.COM# Maximum length of PG ID field
402*13124SAlexander.Kolbasov@Sun.COMmy $max_pg_len = length(max(@pgs)) + 1;
403*13124SAlexander.Kolbasov@Sun.COM$max_pg_len = length('PG') if ($max_pg_len) < length('PG');
404*13124SAlexander.Kolbasov@Sun.COM
405*13124SAlexander.Kolbasov@Sun.COM#
406*13124SAlexander.Kolbasov@Sun.COM#
407*13124SAlexander.Kolbasov@Sun.COM# %pgs hash contains various statistics per PG that is used for sorting.
408*13124SAlexander.Kolbasov@Sun.COMmy %pgs;
409*13124SAlexander.Kolbasov@Sun.COM
410*13124SAlexander.Kolbasov@Sun.COM# Total number of main loop iterations we actually do
411*13124SAlexander.Kolbasov@Sun.COMmy $total_iterations = 0;
412*13124SAlexander.Kolbasov@Sun.COM
413*13124SAlexander.Kolbasov@Sun.COM#
414*13124SAlexander.Kolbasov@Sun.COM# For summary, keep track of minimum and maximum data per PG
415*13124SAlexander.Kolbasov@Sun.COM#
416*13124SAlexander.Kolbasov@Sun.COMmy $history;
417*13124SAlexander.Kolbasov@Sun.COM
418*13124SAlexander.Kolbasov@Sun.COM#
419*13124SAlexander.Kolbasov@Sun.COM# Provide summary output when aggregation is requested and user hits ^C
420*13124SAlexander.Kolbasov@Sun.COM#
421*13124SAlexander.Kolbasov@Sun.COM$SIG{'INT'} = \&print_totals if $do_aggregate;
422*13124SAlexander.Kolbasov@Sun.COM
423*13124SAlexander.Kolbasov@Sun.COM######################################################################
424*13124SAlexander.Kolbasov@Sun.COM# Main loop
425*13124SAlexander.Kolbasov@Sun.COM###########
426*13124SAlexander.Kolbasov@Sun.COM
427*13124SAlexander.Kolbasov@Sun.COMwhile ($infinite || $count--) {
428*13124SAlexander.Kolbasov@Sun.COM	#
429*13124SAlexander.Kolbasov@Sun.COM	# Print timestamp if -T is specified
430*13124SAlexander.Kolbasov@Sun.COM	#
431*13124SAlexander.Kolbasov@Sun.COM	if ($do_timestamp) {
432*13124SAlexander.Kolbasov@Sun.COM		if ($do_timestamp eq 'u') {
433*13124SAlexander.Kolbasov@Sun.COM			print time(), "\n";
434*13124SAlexander.Kolbasov@Sun.COM		} else {
435*13124SAlexander.Kolbasov@Sun.COM			my $date_str = strftime "%A, %B %e, %Y %r %Z",
436*13124SAlexander.Kolbasov@Sun.COM			  localtime;
437*13124SAlexander.Kolbasov@Sun.COM			print "$date_str\n";
438*13124SAlexander.Kolbasov@Sun.COM		}
439*13124SAlexander.Kolbasov@Sun.COM	}
440*13124SAlexander.Kolbasov@Sun.COM
441*13124SAlexander.Kolbasov@Sun.COM	#
442*13124SAlexander.Kolbasov@Sun.COM	# Wait for the requested interval
443*13124SAlexander.Kolbasov@Sun.COM	#
444*13124SAlexander.Kolbasov@Sun.COM	select(undef, undef, undef, $interval);
445*13124SAlexander.Kolbasov@Sun.COM
446*13124SAlexander.Kolbasov@Sun.COM	#
447*13124SAlexander.Kolbasov@Sun.COM	# Print headers
448*13124SAlexander.Kolbasov@Sun.COM	# There are two different output formats - one regular and one verbose
449*13124SAlexander.Kolbasov@Sun.COM	#
450*13124SAlexander.Kolbasov@Sun.COM	if (!$verbose) {
451*13124SAlexander.Kolbasov@Sun.COM		printf "%-${max_pg_len}s  %-${max_sharename_len}s ".
452*13124SAlexander.Kolbasov@Sun.COM		  "$pcnt_fmt  $pcnt_fmt  %-s\n",
453*13124SAlexander.Kolbasov@Sun.COM		  'PG', 'RELATIONSHIP', 'HW', 'SW', 'CPUS';
454*13124SAlexander.Kolbasov@Sun.COM	} else {
455*13124SAlexander.Kolbasov@Sun.COM		printf "%-${max_pg_len}s  %-${max_sharename_len}s" .
456*13124SAlexander.Kolbasov@Sun.COM		  " $pcnt_fmt %4s %4s $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt %s\n",
457*13124SAlexander.Kolbasov@Sun.COM		  'PG','RELATIONSHIP',
458*13124SAlexander.Kolbasov@Sun.COM		  'HW', 'UTIL', 'CAP',
459*13124SAlexander.Kolbasov@Sun.COM		  'SW', 'USR', 'SYS', 'IDLE', 'CPUS';
460*13124SAlexander.Kolbasov@Sun.COM	}
461*13124SAlexander.Kolbasov@Sun.COM
462*13124SAlexander.Kolbasov@Sun.COM	#
463*13124SAlexander.Kolbasov@Sun.COM	# Update the data in one of the snapshots
464*13124SAlexander.Kolbasov@Sun.COM	#
465*13124SAlexander.Kolbasov@Sun.COM	$p_dup->update();
466*13124SAlexander.Kolbasov@Sun.COM
467*13124SAlexander.Kolbasov@Sun.COM	#
468*13124SAlexander.Kolbasov@Sun.COM	# Do not show offlined CPUs
469*13124SAlexander.Kolbasov@Sun.COM	#
470*13124SAlexander.Kolbasov@Sun.COM	my @online_cpus = $p->online_cpus();
471*13124SAlexander.Kolbasov@Sun.COM
472*13124SAlexander.Kolbasov@Sun.COM	#
473*13124SAlexander.Kolbasov@Sun.COM	# Check whether both snapshots belong to the same generation
474*13124SAlexander.Kolbasov@Sun.COM	#
475*13124SAlexander.Kolbasov@Sun.COM	if ($p->generation() != $p_dup->generation()) {
476*13124SAlexander.Kolbasov@Sun.COM		printf gettext("Configuration changed!\n");
477*13124SAlexander.Kolbasov@Sun.COM		# Swap $p and $p_dup;
478*13124SAlexander.Kolbasov@Sun.COM		$p = $p_dup;
479*13124SAlexander.Kolbasov@Sun.COM		$p_dup = Sun::Solaris::Pg->new(
480*13124SAlexander.Kolbasov@Sun.COM					       -cpudata => $do_cpu_utilization,
481*13124SAlexander.Kolbasov@Sun.COM					       -swload => 1,
482*13124SAlexander.Kolbasov@Sun.COM					       -tags => $do_physical,
483*13124SAlexander.Kolbasov@Sun.COM					       -retry => RETRY_COUNT,
484*13124SAlexander.Kolbasov@Sun.COM					       -delay => RETRY_DELAY);
485*13124SAlexander.Kolbasov@Sun.COM		if (!$p_dup) {
486*13124SAlexander.Kolbasov@Sun.COM			printf STDERR gettext(
487*13124SAlexander.Kolbasov@Sun.COM			  "%s: can not obtain Processor Group information: $!\n"),
488*13124SAlexander.Kolbasov@Sun.COM			    $cmdname;
489*13124SAlexander.Kolbasov@Sun.COM			exit(E_ERROR);
490*13124SAlexander.Kolbasov@Sun.COM		}
491*13124SAlexander.Kolbasov@Sun.COM		#
492*13124SAlexander.Kolbasov@Sun.COM		# Recreate @pg_list since it may have changed
493*13124SAlexander.Kolbasov@Sun.COM		#
494*13124SAlexander.Kolbasov@Sun.COM		@pgs = get_pg_list($p, \@pg_list,
495*13124SAlexander.Kolbasov@Sun.COM				   \@sharing_filter, \@sharing_filter_neg);
496*13124SAlexander.Kolbasov@Sun.COM
497*13124SAlexander.Kolbasov@Sun.COM		next;
498*13124SAlexander.Kolbasov@Sun.COM	}
499*13124SAlexander.Kolbasov@Sun.COM
500*13124SAlexander.Kolbasov@Sun.COM	%pgs = ();
501*13124SAlexander.Kolbasov@Sun.COM
502*13124SAlexander.Kolbasov@Sun.COM	#
503*13124SAlexander.Kolbasov@Sun.COM	# Go over each PG and gets its utilization data
504*13124SAlexander.Kolbasov@Sun.COM	#
505*13124SAlexander.Kolbasov@Sun.COM	foreach my $pg (@pgs) {
506*13124SAlexander.Kolbasov@Sun.COM		my ($hwload, $utilization, $capacity, $accuracy) =
507*13124SAlexander.Kolbasov@Sun.COM		  get_load($p, $p_dup, $pg);
508*13124SAlexander.Kolbasov@Sun.COM		my @cpus = $p->cpus ($pg);
509*13124SAlexander.Kolbasov@Sun.COM		my ($user, $sys, $idle, $swload) =
510*13124SAlexander.Kolbasov@Sun.COM		  $p->sw_utilization($p_dup, $pg);
511*13124SAlexander.Kolbasov@Sun.COM
512*13124SAlexander.Kolbasov@Sun.COM		# Adjust idle and swload based on rounding
513*13124SAlexander.Kolbasov@Sun.COM		($swload, $idle) = get_swload($user, $sys);
514*13124SAlexander.Kolbasov@Sun.COM
515*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{pg} = $pg;
516*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{hwload} = $hwload;
517*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{swload} = $swload;
518*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{user} = $user;
519*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{sys} = $sys;
520*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{idle} = $idle;
521*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{utilization} = $utilization;
522*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{capacity} = $capacity;
523*13124SAlexander.Kolbasov@Sun.COM
524*13124SAlexander.Kolbasov@Sun.COM		#
525*13124SAlexander.Kolbasov@Sun.COM		# Record history
526*13124SAlexander.Kolbasov@Sun.COM		#
527*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{hwload} += $hwload if $hwload && $hwload >= 0;
528*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{swload} += $swload if $swload;
529*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{user} += $user if $user;
530*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{sys} += $sys if $sys;
531*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{idle} += $idle if $idle;
532*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{maxhwload} = $hwload if
533*13124SAlexander.Kolbasov@Sun.COM		  !defined($history->{$pg}->{maxhwload}) ||
534*13124SAlexander.Kolbasov@Sun.COM		    $hwload > $history->{$pg}->{maxhwload};
535*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{minhwload} = $hwload if
536*13124SAlexander.Kolbasov@Sun.COM		  !defined($history->{$pg}->{minhwload}) ||
537*13124SAlexander.Kolbasov@Sun.COM		    $hwload < $history->{$pg}->{minhwload};
538*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{maxswload} = $swload if
539*13124SAlexander.Kolbasov@Sun.COM		  !defined($history->{$pg}->{maxswload}) ||
540*13124SAlexander.Kolbasov@Sun.COM		    $swload > $history->{$pg}->{maxswload};
541*13124SAlexander.Kolbasov@Sun.COM		$history->{$pg}->{minswload} = $swload if
542*13124SAlexander.Kolbasov@Sun.COM		  !defined($history->{$pg}->{minswload}) ||
543*13124SAlexander.Kolbasov@Sun.COM		    $swload < $history->{$pg}->{minswload};
544*13124SAlexander.Kolbasov@Sun.COM	}
545*13124SAlexander.Kolbasov@Sun.COM
546*13124SAlexander.Kolbasov@Sun.COM	#
547*13124SAlexander.Kolbasov@Sun.COM	# Sort the output
548*13124SAlexander.Kolbasov@Sun.COM	#
549*13124SAlexander.Kolbasov@Sun.COM	my @sorted_pgs;
550*13124SAlexander.Kolbasov@Sun.COM	my $npgs = scalar @pgs;
551*13124SAlexander.Kolbasov@Sun.COM	@sorted_pgs = pg_sort_by_key(\%pgs, $sort_key, $sort_reverse, @pgs);
552*13124SAlexander.Kolbasov@Sun.COM
553*13124SAlexander.Kolbasov@Sun.COM	#
554*13124SAlexander.Kolbasov@Sun.COM	# Should only top N be displayed?
555*13124SAlexander.Kolbasov@Sun.COM	#
556*13124SAlexander.Kolbasov@Sun.COM	if ($show_top) {
557*13124SAlexander.Kolbasov@Sun.COM		$npgs = $show_top if $show_top < $npgs;
558*13124SAlexander.Kolbasov@Sun.COM		@sorted_pgs = @sorted_pgs[0..$npgs - 1];
559*13124SAlexander.Kolbasov@Sun.COM	}
560*13124SAlexander.Kolbasov@Sun.COM
561*13124SAlexander.Kolbasov@Sun.COM	#
562*13124SAlexander.Kolbasov@Sun.COM	# Now print everything
563*13124SAlexander.Kolbasov@Sun.COM	#
564*13124SAlexander.Kolbasov@Sun.COM	foreach my $pg (@sorted_pgs) {
565*13124SAlexander.Kolbasov@Sun.COM		my $shname = $name_of_pg{$pg};
566*13124SAlexander.Kolbasov@Sun.COM		my $level;
567*13124SAlexander.Kolbasov@Sun.COM
568*13124SAlexander.Kolbasov@Sun.COM		if ($do_levels) {
569*13124SAlexander.Kolbasov@Sun.COM			$level = $p->level($pg) - $minlevel;
570*13124SAlexander.Kolbasov@Sun.COM			$shname = (' ' x (LEVEL_OFFSET * $level)) . $shname;
571*13124SAlexander.Kolbasov@Sun.COM		}
572*13124SAlexander.Kolbasov@Sun.COM
573*13124SAlexander.Kolbasov@Sun.COM		my $hwload = $pgs{$pg}->{hwload} || 0;
574*13124SAlexander.Kolbasov@Sun.COM		my $swload = $pgs{$pg}->{swload};
575*13124SAlexander.Kolbasov@Sun.COM
576*13124SAlexander.Kolbasov@Sun.COM		my @cpus = $p->cpus($pg);
577*13124SAlexander.Kolbasov@Sun.COM		@cpus = $p->intersect(\@cpus, \@online_cpus);
578*13124SAlexander.Kolbasov@Sun.COM
579*13124SAlexander.Kolbasov@Sun.COM		my $cpus = $p->id_collapse(@cpus);
580*13124SAlexander.Kolbasov@Sun.COM		my $user = $pgs{$pg}->{user};
581*13124SAlexander.Kolbasov@Sun.COM		my $sys = $pgs{$pg}->{sys};
582*13124SAlexander.Kolbasov@Sun.COM		my $idle = $pgs{$pg}->{idle};
583*13124SAlexander.Kolbasov@Sun.COM		my $utilization = $pgs{$pg}->{utilization};
584*13124SAlexander.Kolbasov@Sun.COM		my $capacity = $pgs{$pg}->{capacity};
585*13124SAlexander.Kolbasov@Sun.COM
586*13124SAlexander.Kolbasov@Sun.COM		if (!$verbose) {
587*13124SAlexander.Kolbasov@Sun.COM			printf "%${max_pg_len}d  %-${max_sharename_len}s " .
588*13124SAlexander.Kolbasov@Sun.COM			  "%s  %s  %s\n",
589*13124SAlexander.Kolbasov@Sun.COM			    $pg, $shname,
590*13124SAlexander.Kolbasov@Sun.COM			    load2str($hwload),
591*13124SAlexander.Kolbasov@Sun.COM			    load2str($swload),
592*13124SAlexander.Kolbasov@Sun.COM			    $cpus;
593*13124SAlexander.Kolbasov@Sun.COM		} else {
594*13124SAlexander.Kolbasov@Sun.COM			printf
595*13124SAlexander.Kolbasov@Sun.COM			  "%${max_pg_len}d  %-${max_sharename_len}s " .
596*13124SAlexander.Kolbasov@Sun.COM			    "%4s %4s %4s %4s %4s %4s %4s %s\n",
597*13124SAlexander.Kolbasov@Sun.COM			    $pg, $shname,
598*13124SAlexander.Kolbasov@Sun.COM			      load2str($hwload),
599*13124SAlexander.Kolbasov@Sun.COM			      number_to_scaled_string($utilization),
600*13124SAlexander.Kolbasov@Sun.COM			      number_to_scaled_string($capacity),
601*13124SAlexander.Kolbasov@Sun.COM			      load2str($swload),
602*13124SAlexander.Kolbasov@Sun.COM			      load2str($user),
603*13124SAlexander.Kolbasov@Sun.COM			      load2str($sys),
604*13124SAlexander.Kolbasov@Sun.COM			      load2str($idle),
605*13124SAlexander.Kolbasov@Sun.COM			      $cpus;
606*13124SAlexander.Kolbasov@Sun.COM		}
607*13124SAlexander.Kolbasov@Sun.COM
608*13124SAlexander.Kolbasov@Sun.COM		#
609*13124SAlexander.Kolbasov@Sun.COM		# If per-CPU utilization is requested, print it after each
610*13124SAlexander.Kolbasov@Sun.COM		# corresponding PG
611*13124SAlexander.Kolbasov@Sun.COM		#
612*13124SAlexander.Kolbasov@Sun.COM		if ($do_cpu_utilization) {
613*13124SAlexander.Kolbasov@Sun.COM			my $w = ${max_sharename_len} - length ('CPU');
614*13124SAlexander.Kolbasov@Sun.COM			foreach my $cpu (sort {$a <=> $b }  @cpus) {
615*13124SAlexander.Kolbasov@Sun.COM				my ($cpu_utilization,
616*13124SAlexander.Kolbasov@Sun.COM				    $accuracy, $hw_utilization,
617*13124SAlexander.Kolbasov@Sun.COM				   $swload) =
618*13124SAlexander.Kolbasov@Sun.COM				     $p->cpu_utilization($p_dup, $pg, $cpu);
619*13124SAlexander.Kolbasov@Sun.COM				next unless defined $cpu_utilization;
620*13124SAlexander.Kolbasov@Sun.COM				my $cpuname = "CPU$cpu";
621*13124SAlexander.Kolbasov@Sun.COM				if ($do_levels) {
622*13124SAlexander.Kolbasov@Sun.COM					$cpuname =
623*13124SAlexander.Kolbasov@Sun.COM					  (' ' x (LEVEL_OFFSET * $level)) .
624*13124SAlexander.Kolbasov@Sun.COM					    $cpuname;
625*13124SAlexander.Kolbasov@Sun.COM
626*13124SAlexander.Kolbasov@Sun.COM				}
627*13124SAlexander.Kolbasov@Sun.COM
628*13124SAlexander.Kolbasov@Sun.COM				printf "%-${max_pg_len}s  " .
629*13124SAlexander.Kolbasov@Sun.COM				  "%-${max_sharename_len}s ",
630*13124SAlexander.Kolbasov@Sun.COM				  ' ', $cpuname;
631*13124SAlexander.Kolbasov@Sun.COM				if ($verbose) {
632*13124SAlexander.Kolbasov@Sun.COM				    printf "%s %4s %4s\n",
633*13124SAlexander.Kolbasov@Sun.COM				      load2str($cpu_utilization),
634*13124SAlexander.Kolbasov@Sun.COM				      number_to_scaled_string($hw_utilization),
635*13124SAlexander.Kolbasov@Sun.COM				      number_to_scaled_string($capacity);
636*13124SAlexander.Kolbasov@Sun.COM				} else {
637*13124SAlexander.Kolbasov@Sun.COM					printf "%s  %s\n",
638*13124SAlexander.Kolbasov@Sun.COM					  load2str($cpu_utilization),
639*13124SAlexander.Kolbasov@Sun.COM					  load2str($swload);
640*13124SAlexander.Kolbasov@Sun.COM				}
641*13124SAlexander.Kolbasov@Sun.COM			}
642*13124SAlexander.Kolbasov@Sun.COM		}
643*13124SAlexander.Kolbasov@Sun.COM	}
644*13124SAlexander.Kolbasov@Sun.COM
645*13124SAlexander.Kolbasov@Sun.COM	#
646*13124SAlexander.Kolbasov@Sun.COM	# Swap $p and $p_dup
647*13124SAlexander.Kolbasov@Sun.COM	#
648*13124SAlexander.Kolbasov@Sun.COM	($p, $p_dup) = ($p_dup, $p);
649*13124SAlexander.Kolbasov@Sun.COM
650*13124SAlexander.Kolbasov@Sun.COM	$total_iterations++;
651*13124SAlexander.Kolbasov@Sun.COM}
652*13124SAlexander.Kolbasov@Sun.COM
653*13124SAlexander.Kolbasov@Sun.COMprint_totals() if $do_aggregate;
654*13124SAlexander.Kolbasov@Sun.COM
655*13124SAlexander.Kolbasov@Sun.COM
656*13124SAlexander.Kolbasov@Sun.COM####################################
657*13124SAlexander.Kolbasov@Sun.COM# End of main loop
658*13124SAlexander.Kolbasov@Sun.COM####################################
659*13124SAlexander.Kolbasov@Sun.COM
660*13124SAlexander.Kolbasov@Sun.COM
661*13124SAlexander.Kolbasov@Sun.COM#
662*13124SAlexander.Kolbasov@Sun.COM# Support Subroutines
663*13124SAlexander.Kolbasov@Sun.COM#
664*13124SAlexander.Kolbasov@Sun.COM
665*13124SAlexander.Kolbasov@Sun.COM#
666*13124SAlexander.Kolbasov@Sun.COM# Print aggregated information in the end
667*13124SAlexander.Kolbasov@Sun.COM#
668*13124SAlexander.Kolbasov@Sun.COMsub print_totals
669*13124SAlexander.Kolbasov@Sun.COM{
670*13124SAlexander.Kolbasov@Sun.COM	exit ($rc) unless $total_iterations > 1;
671*13124SAlexander.Kolbasov@Sun.COM
672*13124SAlexander.Kolbasov@Sun.COM	printf gettext("\n%s SUMMARY: UTILIZATION OVER %d SECONDS\n\n"),
673*13124SAlexander.Kolbasov@Sun.COM	  ' ' x 10,
674*13124SAlexander.Kolbasov@Sun.COM	  $total_iterations * $interval;
675*13124SAlexander.Kolbasov@Sun.COM
676*13124SAlexander.Kolbasov@Sun.COM	my @sorted_pgs;
677*13124SAlexander.Kolbasov@Sun.COM	my $npgs = scalar @pgs;
678*13124SAlexander.Kolbasov@Sun.COM
679*13124SAlexander.Kolbasov@Sun.COM	%pgs = ();
680*13124SAlexander.Kolbasov@Sun.COM
681*13124SAlexander.Kolbasov@Sun.COM	#
682*13124SAlexander.Kolbasov@Sun.COM	# Collect data per PG
683*13124SAlexander.Kolbasov@Sun.COM	#
684*13124SAlexander.Kolbasov@Sun.COM	foreach my $pg (@pgs) {
685*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{pg} = $pg;
686*13124SAlexander.Kolbasov@Sun.COM
687*13124SAlexander.Kolbasov@Sun.COM		my ($hwload, $utilization, $capacity, $accuracy) =
688*13124SAlexander.Kolbasov@Sun.COM		  get_load($p_initial, $p_dup, $pg);
689*13124SAlexander.Kolbasov@Sun.COM
690*13124SAlexander.Kolbasov@Sun.COM		my @cpus = $p->cpus ($pg);
691*13124SAlexander.Kolbasov@Sun.COM		my ($user, $sys, $idle, $swload) =
692*13124SAlexander.Kolbasov@Sun.COM		  $p_dup->sw_utilization($p_initial, $pg);
693*13124SAlexander.Kolbasov@Sun.COM
694*13124SAlexander.Kolbasov@Sun.COM		# Adjust idle and swload based on rounding
695*13124SAlexander.Kolbasov@Sun.COM		($swload, $idle) = get_swload($user, $sys);
696*13124SAlexander.Kolbasov@Sun.COM
697*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{pg} = $pg;
698*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{swload} = $swload;
699*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{user} = $user;
700*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{sys} = $sys;
701*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{idle} = $idle;
702*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{hwload} = $hwload;
703*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{utilization} = number_to_scaled_string($utilization);
704*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{capacity} = number_to_scaled_string($capacity);
705*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{minhwload} = $history->{$pg}->{minhwload};
706*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{maxhwload} = $history->{$pg}->{maxhwload};
707*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{minswload} = $history->{$pg}->{minswload} || 0;
708*13124SAlexander.Kolbasov@Sun.COM		$pgs{$pg}->{maxswload} = $history->{$pg}->{maxswload} || 0;
709*13124SAlexander.Kolbasov@Sun.COM	}
710*13124SAlexander.Kolbasov@Sun.COM
711*13124SAlexander.Kolbasov@Sun.COM	#
712*13124SAlexander.Kolbasov@Sun.COM	# Sort PGs according to the sorting options
713*13124SAlexander.Kolbasov@Sun.COM	#
714*13124SAlexander.Kolbasov@Sun.COM	@sorted_pgs = pg_sort_by_key(\%pgs, $sort_key, $sort_reverse, @pgs);
715*13124SAlexander.Kolbasov@Sun.COM
716*13124SAlexander.Kolbasov@Sun.COM	#
717*13124SAlexander.Kolbasov@Sun.COM	# Trim to top N if needed
718*13124SAlexander.Kolbasov@Sun.COM	#
719*13124SAlexander.Kolbasov@Sun.COM	if ($show_top) {
720*13124SAlexander.Kolbasov@Sun.COM		$npgs = $show_top if $show_top < $npgs;
721*13124SAlexander.Kolbasov@Sun.COM		@sorted_pgs = @sorted_pgs[0..$npgs - 1];
722*13124SAlexander.Kolbasov@Sun.COM	}
723*13124SAlexander.Kolbasov@Sun.COM
724*13124SAlexander.Kolbasov@Sun.COM	#
725*13124SAlexander.Kolbasov@Sun.COM	# Print headers
726*13124SAlexander.Kolbasov@Sun.COM	#
727*13124SAlexander.Kolbasov@Sun.COM	my $d = ' ' . '-' x 4;
728*13124SAlexander.Kolbasov@Sun.COM	if ($verbose) {
729*13124SAlexander.Kolbasov@Sun.COM		printf "%${max_pg_len}s  %-${max_sharename_len}s %s " .
730*13124SAlexander.Kolbasov@Sun.COM		  "  ------HARDWARE------ ------SOFTWARE------\n",
731*13124SAlexander.Kolbasov@Sun.COM		  ' ', ' ', ' ' x 8;
732*13124SAlexander.Kolbasov@Sun.COM
733*13124SAlexander.Kolbasov@Sun.COM		printf "%-${max_pg_len}s  %-${max_sharename_len}s",
734*13124SAlexander.Kolbasov@Sun.COM		  'PG', 'RELATIONSHIP';
735*13124SAlexander.Kolbasov@Sun.COM
736*13124SAlexander.Kolbasov@Sun.COM		printf " %4s %4s", 'UTIL', ' CAP';
737*13124SAlexander.Kolbasov@Sun.COM		printf "  $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt %s\n",
738*13124SAlexander.Kolbasov@Sun.COM		   'MIN', 'AVG', 'MAX', 'MIN', 'AVG', 'MAX', 'CPUS';
739*13124SAlexander.Kolbasov@Sun.COM	} else {
740*13124SAlexander.Kolbasov@Sun.COM		printf  "%${max_pg_len}s  %-${max_sharename_len}s " .
741*13124SAlexander.Kolbasov@Sun.COM		  "------HARDWARE------" .
742*13124SAlexander.Kolbasov@Sun.COM		  " ------SOFTWARE------\n", ' ', ' ';
743*13124SAlexander.Kolbasov@Sun.COM
744*13124SAlexander.Kolbasov@Sun.COM		printf "%-${max_pg_len}s  %-${max_sharename_len}s",
745*13124SAlexander.Kolbasov@Sun.COM		  'PG', 'RELATIONSHIP';
746*13124SAlexander.Kolbasov@Sun.COM
747*13124SAlexander.Kolbasov@Sun.COM		printf " $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt %s\n",
748*13124SAlexander.Kolbasov@Sun.COM		   'MIN', 'AVG', 'MAX', 'MIN', 'AVG', 'MAX', 'CPUS';
749*13124SAlexander.Kolbasov@Sun.COM	}
750*13124SAlexander.Kolbasov@Sun.COM
751*13124SAlexander.Kolbasov@Sun.COM	#
752*13124SAlexander.Kolbasov@Sun.COM	# Print information per PG
753*13124SAlexander.Kolbasov@Sun.COM	#
754*13124SAlexander.Kolbasov@Sun.COM	foreach my $pg (@sorted_pgs) {
755*13124SAlexander.Kolbasov@Sun.COM		my $cpus = $p->cpus($pg);
756*13124SAlexander.Kolbasov@Sun.COM
757*13124SAlexander.Kolbasov@Sun.COM		my $shname = $name_of_pg{$pg};
758*13124SAlexander.Kolbasov@Sun.COM		if ($sort_key eq 'breadth' || $sort_key eq 'depth') {
759*13124SAlexander.Kolbasov@Sun.COM			my $level = $p->level($pg) - $minlevel;
760*13124SAlexander.Kolbasov@Sun.COM			$shname = (' ' x (LEVEL_OFFSET * $level)) . $shname;
761*13124SAlexander.Kolbasov@Sun.COM		}
762*13124SAlexander.Kolbasov@Sun.COM
763*13124SAlexander.Kolbasov@Sun.COM		printf "%${max_pg_len}d  %-${max_sharename_len}s ",
764*13124SAlexander.Kolbasov@Sun.COM		  $pg, $shname;
765*13124SAlexander.Kolbasov@Sun.COM
766*13124SAlexander.Kolbasov@Sun.COM		if ($verbose) {
767*13124SAlexander.Kolbasov@Sun.COM			printf "%4s %4s  ",
768*13124SAlexander.Kolbasov@Sun.COM			  number_to_scaled_string($pgs{$pg}->{utilization}),
769*13124SAlexander.Kolbasov@Sun.COM			    number_to_scaled_string($pgs{$pg}->{capacity});
770*13124SAlexander.Kolbasov@Sun.COM		}
771*13124SAlexander.Kolbasov@Sun.COM
772*13124SAlexander.Kolbasov@Sun.COM		if (!defined($pgs{$pg}->{hwload}) ||
773*13124SAlexander.Kolbasov@Sun.COM		    $pgs{$pg}->{hwload} == HWLOAD_UNDEF) {
774*13124SAlexander.Kolbasov@Sun.COM			printf "$pcnt_fmt $pcnt_fmt $pcnt_fmt ",
775*13124SAlexander.Kolbasov@Sun.COM			  '-', '-', '-';
776*13124SAlexander.Kolbasov@Sun.COM		} else {
777*13124SAlexander.Kolbasov@Sun.COM			printf "%s %s %s ",
778*13124SAlexander.Kolbasov@Sun.COM			  load2str($pgs{$pg}->{minhwload}),
779*13124SAlexander.Kolbasov@Sun.COM			  load2str($pgs{$pg}->{hwload}),
780*13124SAlexander.Kolbasov@Sun.COM			  load2str($pgs{$pg}->{maxhwload});
781*13124SAlexander.Kolbasov@Sun.COM		}
782*13124SAlexander.Kolbasov@Sun.COM		printf "%s %s %s",
783*13124SAlexander.Kolbasov@Sun.COM		  load2str($pgs{$pg}->{minswload}),
784*13124SAlexander.Kolbasov@Sun.COM		  load2str($pgs{$pg}->{swload}),
785*13124SAlexander.Kolbasov@Sun.COM		  load2str($pgs{$pg}->{maxswload});
786*13124SAlexander.Kolbasov@Sun.COM
787*13124SAlexander.Kolbasov@Sun.COM		printf " %s\n", $cpus;
788*13124SAlexander.Kolbasov@Sun.COM	}
789*13124SAlexander.Kolbasov@Sun.COM
790*13124SAlexander.Kolbasov@Sun.COM	exit ($rc);
791*13124SAlexander.Kolbasov@Sun.COM}
792*13124SAlexander.Kolbasov@Sun.COM
793*13124SAlexander.Kolbasov@Sun.COM#
794*13124SAlexander.Kolbasov@Sun.COM# pg_sort_by_key(pgs, key, inverse)
795*13124SAlexander.Kolbasov@Sun.COM# Sort pgs according to the key specified
796*13124SAlexander.Kolbasov@Sun.COM#
797*13124SAlexander.Kolbasov@Sun.COM# Arguments:
798*13124SAlexander.Kolbasov@Sun.COM#   pgs hash indexed by PG ID
799*13124SAlexander.Kolbasov@Sun.COM#   sort keyword
800*13124SAlexander.Kolbasov@Sun.COM#   inverse - inverse sort result if this is T
801*13124SAlexander.Kolbasov@Sun.COM#
802*13124SAlexander.Kolbasov@Sun.COMsub pg_sort_by_key
803*13124SAlexander.Kolbasov@Sun.COM{
804*13124SAlexander.Kolbasov@Sun.COM	my $pgs = shift;
805*13124SAlexander.Kolbasov@Sun.COM	my $key = shift;
806*13124SAlexander.Kolbasov@Sun.COM	my $inverse = shift;
807*13124SAlexander.Kolbasov@Sun.COM	my @sorted;
808*13124SAlexander.Kolbasov@Sun.COM
809*13124SAlexander.Kolbasov@Sun.COM	if ($key eq 'depth' || $key eq 'breadth') {
810*13124SAlexander.Kolbasov@Sun.COM		my $root = $p->root;
811*13124SAlexander.Kolbasov@Sun.COM		my @pgs = $key eq 'depth' ?
812*13124SAlexander.Kolbasov@Sun.COM		  $p->all_depth_first() :
813*13124SAlexander.Kolbasov@Sun.COM		  $p->all_breadth_first();
814*13124SAlexander.Kolbasov@Sun.COM		@sorted = reverse(grep { exists($pgs{$_}) } @pgs);
815*13124SAlexander.Kolbasov@Sun.COM	} else {
816*13124SAlexander.Kolbasov@Sun.COM		@sorted = sort { $pgs{$a}->{$key} <=> $pgs{$b}->{$key} } @_;
817*13124SAlexander.Kolbasov@Sun.COM	}
818*13124SAlexander.Kolbasov@Sun.COM
819*13124SAlexander.Kolbasov@Sun.COM	return ($inverse ? reverse(@sorted) : @sorted);
820*13124SAlexander.Kolbasov@Sun.COM}
821*13124SAlexander.Kolbasov@Sun.COM
822*13124SAlexander.Kolbasov@Sun.COM#
823*13124SAlexander.Kolbasov@Sun.COM# Convert numeric load to formatted string
824*13124SAlexander.Kolbasov@Sun.COM#
825*13124SAlexander.Kolbasov@Sun.COMsub load2str
826*13124SAlexander.Kolbasov@Sun.COM{
827*13124SAlexander.Kolbasov@Sun.COM	my $load = shift;
828*13124SAlexander.Kolbasov@Sun.COM
829*13124SAlexander.Kolbasov@Sun.COM	return (sprintf "$pcnt_fmt", '-') if
830*13124SAlexander.Kolbasov@Sun.COM	  !defined($load) || $load == HWLOAD_UNDEF;
831*13124SAlexander.Kolbasov@Sun.COM	return (sprintf "$pcnt_fmt", '?') if $load == HWLOAD_UNKNOWN;
832*13124SAlexander.Kolbasov@Sun.COM	return (sprintf "$pcnt%%", $load);
833*13124SAlexander.Kolbasov@Sun.COM}
834*13124SAlexander.Kolbasov@Sun.COM
835*13124SAlexander.Kolbasov@Sun.COM#
836*13124SAlexander.Kolbasov@Sun.COM# get_load(snapshot1, snapshot2, pg)
837*13124SAlexander.Kolbasov@Sun.COM#
838*13124SAlexander.Kolbasov@Sun.COM# Get various hardware load data for the given PG using two snapshots.
839*13124SAlexander.Kolbasov@Sun.COM# Arguments: two PG snapshots and PG ID
840*13124SAlexander.Kolbasov@Sun.COM#
841*13124SAlexander.Kolbasov@Sun.COM# In scalar context returns the hardware load
842*13124SAlexander.Kolbasov@Sun.COM# In list context returns a list
843*13124SAlexander.Kolbasov@Sun.COM# (load, utilization, capacity, accuracy)
844*13124SAlexander.Kolbasov@Sun.COM#
845*13124SAlexander.Kolbasov@Sun.COMsub get_load
846*13124SAlexander.Kolbasov@Sun.COM{
847*13124SAlexander.Kolbasov@Sun.COM	my $p = shift;
848*13124SAlexander.Kolbasov@Sun.COM	my $p_dup = shift;
849*13124SAlexander.Kolbasov@Sun.COM	my $pg = shift;
850*13124SAlexander.Kolbasov@Sun.COM
851*13124SAlexander.Kolbasov@Sun.COM	return HWLOAD_UNDEF if !$p->has_utilization($pg);
852*13124SAlexander.Kolbasov@Sun.COM
853*13124SAlexander.Kolbasov@Sun.COM	my ($capacity, $utilization, $accuracy, $tdelta);
854*13124SAlexander.Kolbasov@Sun.COM
855*13124SAlexander.Kolbasov@Sun.COM
856*13124SAlexander.Kolbasov@Sun.COM	$accuracy = 100;
857*13124SAlexander.Kolbasov@Sun.COM	$utilization = 0;
858*13124SAlexander.Kolbasov@Sun.COM
859*13124SAlexander.Kolbasov@Sun.COM	$utilization = $p->utilization($p_dup, $pg) || 0;
860*13124SAlexander.Kolbasov@Sun.COM	$capacity = $p_dup->capacity($pg);
861*13124SAlexander.Kolbasov@Sun.COM	$accuracy = $p->accuracy($p_dup, $pg) || 0;
862*13124SAlexander.Kolbasov@Sun.COM	$tdelta = $p->tdelta($p_dup, $pg);
863*13124SAlexander.Kolbasov@Sun.COM	my $utilization_per_second = $utilization;
864*13124SAlexander.Kolbasov@Sun.COM	$utilization_per_second /= $tdelta if $tdelta;
865*13124SAlexander.Kolbasov@Sun.COM
866*13124SAlexander.Kolbasov@Sun.COM	my $load;
867*13124SAlexander.Kolbasov@Sun.COM
868*13124SAlexander.Kolbasov@Sun.COM	if ($accuracy != 100) {
869*13124SAlexander.Kolbasov@Sun.COM		$load = HWLOAD_UNKNOWN;
870*13124SAlexander.Kolbasov@Sun.COM	} else {
871*13124SAlexander.Kolbasov@Sun.COM		$load = $capacity ?
872*13124SAlexander.Kolbasov@Sun.COM		  $utilization_per_second * 100 / $capacity :
873*13124SAlexander.Kolbasov@Sun.COM		  HWLOAD_UNKNOWN;
874*13124SAlexander.Kolbasov@Sun.COM		$capacity *= $tdelta if $tdelta;
875*13124SAlexander.Kolbasov@Sun.COM	}
876*13124SAlexander.Kolbasov@Sun.COM
877*13124SAlexander.Kolbasov@Sun.COM	return (wantarray() ?
878*13124SAlexander.Kolbasov@Sun.COM		($load, $utilization, $capacity, $accuracy) :
879*13124SAlexander.Kolbasov@Sun.COM		$load);
880*13124SAlexander.Kolbasov@Sun.COM}
881*13124SAlexander.Kolbasov@Sun.COM
882*13124SAlexander.Kolbasov@Sun.COM#
883*13124SAlexander.Kolbasov@Sun.COM# Make sure that with the rounding used, user + system + swload add up to 100%.
884*13124SAlexander.Kolbasov@Sun.COM#
885*13124SAlexander.Kolbasov@Sun.COM#
886*13124SAlexander.Kolbasov@Sun.COMsub get_swload
887*13124SAlexander.Kolbasov@Sun.COM{
888*13124SAlexander.Kolbasov@Sun.COM	my $user = shift;
889*13124SAlexander.Kolbasov@Sun.COM	my $sys = shift;
890*13124SAlexander.Kolbasov@Sun.COM	my $swload;
891*13124SAlexander.Kolbasov@Sun.COM	my $idle;
892*13124SAlexander.Kolbasov@Sun.COM
893*13124SAlexander.Kolbasov@Sun.COM	$user = sprintf "$pcnt", $user;
894*13124SAlexander.Kolbasov@Sun.COM	$sys  = sprintf  "$pcnt", $sys;
895*13124SAlexander.Kolbasov@Sun.COM
896*13124SAlexander.Kolbasov@Sun.COM	$swload = $user + $sys;
897*13124SAlexander.Kolbasov@Sun.COM	$idle = 100 - $swload;
898*13124SAlexander.Kolbasov@Sun.COM
899*13124SAlexander.Kolbasov@Sun.COM	return ($swload, $idle);
900*13124SAlexander.Kolbasov@Sun.COM}
901*13124SAlexander.Kolbasov@Sun.COM
902*13124SAlexander.Kolbasov@Sun.COM#
903*13124SAlexander.Kolbasov@Sun.COM# get_pg_list(cookie, pg_list, sharing_filter, sharing_filter_neg) Get list OF
904*13124SAlexander.Kolbasov@Sun.COM# PGs to look at based on all PGs available, user-specified PGs and
905*13124SAlexander.Kolbasov@Sun.COM# user-specified filters.
906*13124SAlexander.Kolbasov@Sun.COM#
907*13124SAlexander.Kolbasov@Sun.COMsub get_pg_list
908*13124SAlexander.Kolbasov@Sun.COM{
909*13124SAlexander.Kolbasov@Sun.COM	my $p = shift;
910*13124SAlexander.Kolbasov@Sun.COM	my $pg_list = shift;
911*13124SAlexander.Kolbasov@Sun.COM	my $sharing_filter = shift;
912*13124SAlexander.Kolbasov@Sun.COM	my $sharing_filter_neg = shift;
913*13124SAlexander.Kolbasov@Sun.COM
914*13124SAlexander.Kolbasov@Sun.COM	my @all = $p->all();
915*13124SAlexander.Kolbasov@Sun.COM	my @pg_list = scalar @$pg_list ? @$pg_list : @all;
916*13124SAlexander.Kolbasov@Sun.COM	my @pgs = $p->intersect(\@all_pgs, \@pg_list);
917*13124SAlexander.Kolbasov@Sun.COM
918*13124SAlexander.Kolbasov@Sun.COM	#
919*13124SAlexander.Kolbasov@Sun.COM	# Now we have list of PGs to work with. Now apply filtering. First list
920*13124SAlexander.Kolbasov@Sun.COM	# only those matching -R
921*13124SAlexander.Kolbasov@Sun.COM	#
922*13124SAlexander.Kolbasov@Sun.COM	@pgs = grep { list_match($p->sh_name($_), \@sharing_filter, 0) } @pgs if
923*13124SAlexander.Kolbasov@Sun.COM	  @sharing_filter;
924*13124SAlexander.Kolbasov@Sun.COM
925*13124SAlexander.Kolbasov@Sun.COM	my @sharing_filter = @$sharing_filter;
926*13124SAlexander.Kolbasov@Sun.COM	my @sharing_filter_neg = @$sharing_filter_neg;
927*13124SAlexander.Kolbasov@Sun.COM	# Remove any that doesn't match -r
928*13124SAlexander.Kolbasov@Sun.COM	@pgs = grep {
929*13124SAlexander.Kolbasov@Sun.COM		!list_match($p->sh_name($_), \@sharing_filter_neg, 0)
930*13124SAlexander.Kolbasov@Sun.COM	} @pgs if
931*13124SAlexander.Kolbasov@Sun.COM	  scalar @sharing_filter_neg;
932*13124SAlexander.Kolbasov@Sun.COM
933*13124SAlexander.Kolbasov@Sun.COM	return (@pgs);
934*13124SAlexander.Kolbasov@Sun.COM}
935*13124SAlexander.Kolbasov@Sun.COM
936*13124SAlexander.Kolbasov@Sun.COM#
937*13124SAlexander.Kolbasov@Sun.COM# usage(rc)
938*13124SAlexander.Kolbasov@Sun.COM#
939*13124SAlexander.Kolbasov@Sun.COM# Print short usage message and exit with the given return code.
940*13124SAlexander.Kolbasov@Sun.COM# If verbose is T, print a bit more information
941*13124SAlexander.Kolbasov@Sun.COM#
942*13124SAlexander.Kolbasov@Sun.COMsub usage
943*13124SAlexander.Kolbasov@Sun.COM{
944*13124SAlexander.Kolbasov@Sun.COM	my $rc = shift || E_SUCCESS;
945*13124SAlexander.Kolbasov@Sun.COM
946*13124SAlexander.Kolbasov@Sun.COM	printf STDERR
947*13124SAlexander.Kolbasov@Sun.COM	  gettext("Usage:\t%s [-A] [-C] [-p] [-s key | -S key] " .
948*13124SAlexander.Kolbasov@Sun.COM		  "[-t number] [-T u | d]\n"), $cmdname;
949*13124SAlexander.Kolbasov@Sun.COM	print STDERR
950*13124SAlexander.Kolbasov@Sun.COM	  gettext("\t\t[-r string] [-R string] [-P pg ...] [-c processor_id... ]\n");
951*13124SAlexander.Kolbasov@Sun.COM	print STDERR
952*13124SAlexander.Kolbasov@Sun.COM	  gettext("\t\t[interval [count]]\n\n");
953*13124SAlexander.Kolbasov@Sun.COM
954*13124SAlexander.Kolbasov@Sun.COM	exit ($rc);
955*13124SAlexander.Kolbasov@Sun.COM}
956*13124SAlexander.Kolbasov@Sun.COM
957*13124SAlexander.Kolbasov@Sun.COM#
958*13124SAlexander.Kolbasov@Sun.COM# list_match(val, list_ref, strict)
959*13124SAlexander.Kolbasov@Sun.COM# Return T if argument matches any of the elements on the list, undef otherwise.
960*13124SAlexander.Kolbasov@Sun.COM#
961*13124SAlexander.Kolbasov@Sun.COMsub list_match
962*13124SAlexander.Kolbasov@Sun.COM{
963*13124SAlexander.Kolbasov@Sun.COM	my $arg = shift;
964*13124SAlexander.Kolbasov@Sun.COM	my $list = shift;
965*13124SAlexander.Kolbasov@Sun.COM	my $strict = shift;
966*13124SAlexander.Kolbasov@Sun.COM
967*13124SAlexander.Kolbasov@Sun.COM	return first { $arg eq $_ } @$list if $strict;
968*13124SAlexander.Kolbasov@Sun.COM	return first { $arg =~ m/$_/i } @$list;
969*13124SAlexander.Kolbasov@Sun.COM}
970*13124SAlexander.Kolbasov@Sun.COM
971*13124SAlexander.Kolbasov@Sun.COM#
972*13124SAlexander.Kolbasov@Sun.COM# Convert a number to a string representation
973*13124SAlexander.Kolbasov@Sun.COM# The number is scaled down until it is small enough to be in a good
974*13124SAlexander.Kolbasov@Sun.COM# human readable format i.e. in the range 0 thru 1000.
975*13124SAlexander.Kolbasov@Sun.COM# If it's smaller than 10 there's room enough to provide one decimal place.
976*13124SAlexander.Kolbasov@Sun.COM#
977*13124SAlexander.Kolbasov@Sun.COMsub number_to_scaled_string
978*13124SAlexander.Kolbasov@Sun.COM{
979*13124SAlexander.Kolbasov@Sun.COM	my $number = shift;
980*13124SAlexander.Kolbasov@Sun.COM
981*13124SAlexander.Kolbasov@Sun.COM	return '-' unless defined ($number);
982*13124SAlexander.Kolbasov@Sun.COM
983*13124SAlexander.Kolbasov@Sun.COM	# Remove any trailing spaces
984*13124SAlexander.Kolbasov@Sun.COM	$number =~ s/ //g;
985*13124SAlexander.Kolbasov@Sun.COM
986*13124SAlexander.Kolbasov@Sun.COM	return $number unless $number =~ /^[.\d]+$/;
987*13124SAlexander.Kolbasov@Sun.COM
988*13124SAlexander.Kolbasov@Sun.COM	my $scale = 1000;
989*13124SAlexander.Kolbasov@Sun.COM
990*13124SAlexander.Kolbasov@Sun.COM	return sprintf("%4d", $number) if $number < $scale;
991*13124SAlexander.Kolbasov@Sun.COM
992*13124SAlexander.Kolbasov@Sun.COM	my @measurement = ('K', 'M', 'B', 'T');
993*13124SAlexander.Kolbasov@Sun.COM	my $uom = shift(@measurement);
994*13124SAlexander.Kolbasov@Sun.COM	my $result;
995*13124SAlexander.Kolbasov@Sun.COM
996*13124SAlexander.Kolbasov@Sun.COM	my $save = $number;
997*13124SAlexander.Kolbasov@Sun.COM
998*13124SAlexander.Kolbasov@Sun.COM	# Get size in K.
999*13124SAlexander.Kolbasov@Sun.COM	$number /= $scale;
1000*13124SAlexander.Kolbasov@Sun.COM
1001*13124SAlexander.Kolbasov@Sun.COM	while (($number >= $scale) && $uom ne 'B') {
1002*13124SAlexander.Kolbasov@Sun.COM		$uom = shift(@measurement);
1003*13124SAlexander.Kolbasov@Sun.COM		$save = $number;
1004*13124SAlexander.Kolbasov@Sun.COM		$number /= $scale;
1005*13124SAlexander.Kolbasov@Sun.COM	}
1006*13124SAlexander.Kolbasov@Sun.COM
1007*13124SAlexander.Kolbasov@Sun.COM	# check if we should output a decimal place after the point
1008*13124SAlexander.Kolbasov@Sun.COM	if ($save && (($save / $scale) < 10)) {
1009*13124SAlexander.Kolbasov@Sun.COM		$result = sprintf("%3.1f$uom", $save / $scale);
1010*13124SAlexander.Kolbasov@Sun.COM	} else {
1011*13124SAlexander.Kolbasov@Sun.COM		$result = sprintf("%3d$uom", $number);
1012*13124SAlexander.Kolbasov@Sun.COM	}
1013*13124SAlexander.Kolbasov@Sun.COM
1014*13124SAlexander.Kolbasov@Sun.COM	return ("$result");
1015*13124SAlexander.Kolbasov@Sun.COM}
1016*13124SAlexander.Kolbasov@Sun.COM
1017*13124SAlexander.Kolbasov@Sun.COM
1018*13124SAlexander.Kolbasov@Sun.COM__END__
1019