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