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 2008 Sun Microsystems, Inc. All rights reserved. 25# Use is subject to license terms. 26# 27 28# 29# lgrpinfo: display information about locality groups. 30# 31 32require 5.8.4; 33use warnings; 34use strict; 35use Getopt::Long qw(:config no_ignore_case bundling auto_version); 36use File::Basename; 37# Sun::Solaris::Kstat is used to extract per-lgroup load average. 38use Sun::Solaris::Kstat; 39use POSIX qw(locale_h); 40use Sun::Solaris::Utils qw(textdomain gettext); 41use Sun::Solaris::Lgrp ':CONSTANTS'; 42 43use constant KB => 1024; 44 45# 46# Amount of load contributed by a single thread. The value is exported by the 47# kernel in the 'loadscale' variable of lgroup kstat, but in case it is missing 48# we use the current default value as the best guess. 49# 50use constant LGRP_LOADAVG_THREAD_MAX => 65516; 51 52# Get script name 53our $cmdname = basename($0, ".pl"); 54 55# Get liblgrp version 56my $version = Sun::Solaris::Lgrp::lgrp_version(); 57 58our $VERSION = "%I% (liblgrp version $version)"; 59 60# The $loads hash keeps per-lgroup load average. 61our $loads = {}; 62 63######################################## 64# Main body 65## 66 67# Set message locale 68setlocale(LC_ALL, ""); 69textdomain(TEXT_DOMAIN); 70 71# Parse command-line options 72our($opt_a, $opt_l, $opt_m, $opt_c, $opt_C, $opt_e, $opt_t, $opt_h, $opt_u, 73 $opt_r, $opt_L, $opt_P, $opt_I, $opt_T, $opt_G); 74 75GetOptions("a" => \$opt_a, 76 "c" => \$opt_c, 77 "C" => \$opt_C, 78 "e" => \$opt_e, 79 "G" => \$opt_G, 80 "h|?" => \$opt_h, 81 "l" => \$opt_l, 82 "L" => \$opt_L, 83 "I" => \$opt_I, 84 "m" => \$opt_m, 85 "r" => \$opt_r, 86 "t" => \$opt_t, 87 "T" => \$opt_T, 88 "u=s" => \$opt_u, 89 "P" => \$opt_P) || usage(3); 90 91usage(0) if $opt_h; 92 93# Check for conflicting options 94my $nfilters = 0; 95$nfilters++ if $opt_C; 96$nfilters++ if $opt_P; 97$nfilters++ if $opt_T; 98 99if ($nfilters > 1) { 100 printf STDERR 101 gettext("%s: Options -C, -T and -P can not be used together\n"), 102 $cmdname; 103 usage(3); 104} 105 106if ($opt_T && ($opt_I || $opt_t)) { 107 printf STDERR 108 gettext("%s: Option -T can not be used with -I, -t\n"), 109 $cmdname; 110 usage(3); 111} 112 113if ($opt_T && scalar @ARGV) { 114 printf STDERR 115 gettext("%s: Warning: with '-T' all lgroups on the command line "), 116 $cmdname; 117 printf STDERR gettext("are ignored\n\n"); 118} 119 120if ($opt_L && $opt_I) { 121 printf STDERR gettext("%s: Option -I can not be used with -L\n"), 122 $cmdname; 123 usage(3); 124} 125 126# Figure out what to do based on options 127my $do_default = 1 unless 128 $opt_a || $opt_l || $opt_m || $opt_c || $opt_e || $opt_t || $opt_r; 129 130 131my $l = Sun::Solaris::Lgrp->new($opt_G ? LGRP_VIEW_OS : LGRP_VIEW_CALLER) or 132 die(gettext("$cmdname: can not get lgroup information from the system\n")); 133 134 135# Get list of all lgroups, the root and the list of intermediates 136my @lgrps = nsort($l->lgrps); 137my $root = $l->root; 138my @intermediates = grep { $_ != $root && !$l->isleaf($_) } @lgrps; 139my $is_uma = (scalar @lgrps == 1); 140 141# Print everything if -a is specified or it is default without -T 142my $do_all = 1 if $opt_a || ($do_default && !($opt_T || $opt_L)); 143 144# Print individual information if do_all or requested specific print 145my $do_lat = 1 if $do_all || $opt_l; 146my $do_memory = 1 if $do_all || $opt_m; 147my $do_cpu = 1 if $do_all || $opt_c; 148my $do_topo = 1 if $do_all || $opt_t; 149my $do_rsrc = 1 if $do_all || $opt_r; 150my $do_load = 1 if $do_all || $opt_e; 151my $do_table = 1 if $opt_a || $opt_L; 152my $do_something = ($do_lat || $do_memory || $do_cpu || $do_topo || 153 $do_rsrc || $do_load); 154 155# Does the liblgrp(3LIB) has enough capabilities to support resource view? 156if ($do_rsrc && LGRP_VER_CURRENT == 1) { 157 if ($opt_r) { 158 printf STDERR 159 gettext("%s: sorry, your system does not support"), 160 $cmdname; 161 printf STDERR " lgrp_resources(3LGRP)\n"; 162 } 163 $do_rsrc = 0; 164} 165 166# Get list of lgrps from arguments, expanding symbolic names like 167# "root" and "leaves" 168# Use all lgroups if none are specified on the command line 169my @lgrp_list = (scalar (@ARGV) && !$opt_T) ? lgrp_expand($l, @ARGV) : @lgrps; 170 171# Apply 'Parent' or 'Children' operations if requested 172@lgrp_list = map { $l->parents($_) } @lgrp_list if $opt_P; 173@lgrp_list = map { $l->children($_) } @lgrp_list if $opt_C; 174 175# Drop repeating elements and sort lgroups numerically. 176@lgrp_list = uniqsort(@lgrp_list); 177 178# If both -L and -c are specified, just print list of CPUs. 179if ($opt_c && $opt_I) { 180 my @cpus = uniqsort(map { $l->cpus($_, LGRP_CONTENT_HIERARCHY) } 181 @lgrp_list); 182 print "@cpus\n"; 183 exit(0); 184} 185 186my $unit_str = "K"; 187my $units = KB; 188 189# Convert units to canonical numeric and string formats. 190if ($opt_u) { 191 if ($opt_u =~ /^b$/i) { 192 $units = 1; 193 $unit_str = "B"; 194 } elsif ($opt_u =~ /^k$/i) { 195 $units = KB; 196 $unit_str = "K"; 197 } elsif ($opt_u =~ /^m$/i) { 198 $units = KB * KB; 199 $unit_str = "M"; 200 } elsif ($opt_u =~ /^g$/i) { 201 $units = KB * KB * KB; 202 $unit_str = "G"; 203 } elsif ($opt_u =~ /^t$/i) { 204 $units = KB * KB * KB * KB; 205 $unit_str = "T"; 206 } elsif ($opt_u =~ /^p$/i) { 207 $units = KB * KB * KB * KB * KB; 208 $unit_str = "P"; 209 } elsif ($opt_u =~ /^e$/i) { 210 $units = KB * KB * KB * KB * KB * KB; 211 $unit_str = "E"; 212 } elsif (! ($opt_u =~ /^m$/i)) { 213 printf STDERR 214 gettext("%s: invalid unit '$opt_u', should be [b|k|m|g|t|p|e]"), 215 $cmdname; 216 printf STDERR gettext(", using the default.\n\n"); 217 $opt_u = 0; 218 } 219} 220 221# Collect load average data if requested. 222$loads = get_lav() if $do_load; 223 224# Get latency values for each lgroup. 225my %self_latencies; 226map { $self_latencies{$_} = $l->latency($_, $_) } @lgrps; 227 228# If -T is specified, just print topology and return. 229if ($opt_T) { 230 lgrp_prettyprint($l); 231 print_latency_table(\@lgrps, \@lgrps) if $do_table; 232 exit(0); 233} 234 235if (!scalar @lgrp_list) { 236 printf STDERR gettext("%s: No matching lgroups found!\n"), $cmdname; 237 exit(2); 238} 239 240# Just print list of lgrps if doing just filtering 241(print "@lgrp_list\n"), exit 0 if $opt_I; 242 243if ($do_something) { 244 # Walk through each requested lgrp and print whatever is requested. 245 foreach my $lgrp (@lgrp_list) { 246 my $is_leaf = $l->isleaf($lgrp); 247 my ($children, $parents, $cpus, $memstr, $rsrc); 248 249 my $prefix = ($lgrp == $root) ? 250 "root": $is_leaf ? gettext("leaf") : gettext("intermediate"); 251 printf gettext("lgroup %d (%s):"), $lgrp, $prefix; 252 253 if ($do_topo) { 254 # Get children of this lgrp. 255 my @children = $l->children($lgrp); 256 $children = $is_leaf ? 257 gettext("Children: none") : 258 gettext("Children: ") . lgrp_collapse(@children); 259 # Are there any parents for this lgrp? 260 my @parents = $l->parents($lgrp); 261 $parents = @parents ? 262 gettext(", Parent: ") . "@parents" : 263 ""; 264 } 265 266 if ($do_cpu) { 267 $cpus = lgrp_showcpus($lgrp, LGRP_CONTENT_HIERARCHY); 268 } 269 if ($do_memory) { 270 $memstr = lgrp_showmemory($lgrp, LGRP_CONTENT_HIERARCHY); 271 } 272 if ($do_rsrc) { 273 $rsrc = lgrp_showresources($lgrp); 274 } 275 276 # Print all the information about lgrp. 277 print "\n\t$children$parents" if $do_topo; 278 print "\n\t$cpus" if $do_cpu && $cpus; 279 print "\n\t$memstr" if $do_memory && $memstr; 280 print "\n\t$rsrc" if $do_rsrc; 281 print "\n\t$loads->{$lgrp}" if defined ($loads->{$lgrp}); 282 if ($do_lat && defined($self_latencies{$lgrp})) { 283 printf gettext("\n\tLatency: %d"), $self_latencies{$lgrp}; 284 } 285 print "\n"; 286 } 287} 288 289print_latency_table(\@lgrps, \@lgrp_list) if $do_table; 290 291exit 0; 292 293# 294# usage(exit_status) 295# print usage message and exit with the specified exit status. 296# 297sub usage 298{ 299 printf STDERR gettext("Usage:\t%s"), $cmdname; 300 print STDERR " [-aceGlLmrt] [-u unit] [-C|-P] [lgrp] ...\n"; 301 print STDERR " \t$cmdname -I [-c] [-G] [-C|-P] [lgrp] ...\n"; 302 print STDERR " \t$cmdname -T [-aceGlLmr] [-u unit]\n"; 303 print STDERR " \t$cmdname -h\n\n"; 304 305 printf STDERR 306 gettext(" Display information about locality groups\n\n" . 307 "\t-a: Equivalent to \"%s\" without -T and to \"%s\" with -T\n"), 308 "-celLmrt", "-celLmr"; 309 310 print STDERR 311 gettext("\t-c: Print CPU information\n"), 312 gettext("\t-C: Children of the specified lgroups\n"), 313 gettext("\t-e: Print lgroup load average\n"), 314 gettext("\t-h: Print this message and exit\n"), 315 gettext("\t-I: Print lgroup or CPU IDs only\n"), 316 gettext("\t-l: Print information about lgroup latencies\n"), 317 gettext("\t-G: Print OS view of lgroup hierarchy\n"), 318 gettext("\t-L: Print lgroup latency table\n"), 319 gettext("\t-m: Print memory information\n"), 320 gettext("\t-P: Parent(s) of the specified lgroups\n"), 321 gettext("\t-r: Print lgroup resources\n"), 322 gettext("\t-t: Print information about lgroup topology\n"), 323 gettext("\t-T: Print the hierarchy tree\n"), 324 gettext("\t-u unit: Specify memory unit (b,k,m,g,t,p,e)\n\n\n"); 325 326 print STDERR 327 gettext(" The lgrp may be specified as an lgroup ID,"), 328 gettext(" \"root\", \"all\",\n"), 329 gettext(" \"intermediate\" or \"leaves\".\n\n"); 330 331 printf STDERR 332 gettext(" The default set of options is \"%s\"\n\n"), 333 "-celmrt all"; 334 335 print STDERR 336 gettext(" Without any options print topology, CPU and memory " . 337 "information about each\n" . 338 " lgroup. If any lgroup IDs are specified on the " . 339 "command line only print\n" . 340 " information about the specified lgroup.\n\n"); 341 342 exit(shift); 343} 344 345# Return the input list with duplicates removed. 346sub uniq 347{ 348 my %seen; 349 return (grep { ++$seen{$_} == 1 } @_); 350} 351 352# 353# Sort the list numerically 354# Should be called in list context 355# 356sub nsort 357{ 358 return (sort { $a <=> $b } @_); 359} 360 361# 362# Sort list numerically and remove duplicates 363# Should be called in list context 364# 365sub uniqsort 366{ 367 return (sort { $a <=> $b } uniq(@_)); 368} 369 370# Round values 371sub round 372{ 373 my $val = shift; 374 375 return (int($val + 0.5)); 376} 377 378# 379# Expand list of lgrps. 380# Translate 'root' to the root lgrp id 381# Translate 'all' to the list of all lgrps 382# Translate 'leaves' to the list of all lgrps' 383# Translate 'intermediate' to the list of intermediates. 384# 385sub lgrp_expand 386{ 387 my $lobj = shift; 388 my %seen; 389 my @result; 390 391 # create a hash element for every element in @lgrps 392 map { $seen{$_}++ } @lgrps; 393 394 foreach my $lgrp (@_) { 395 push(@result, $lobj->root), next if $lgrp =~ m/^root$/i; 396 push(@result, @lgrps), next if $lgrp =~ m/^all$/i; 397 push(@result, $lobj->leaves), next if $lgrp =~ m/^leaves$/i; 398 push(@result, @intermediates), 399 next if $lgrp =~ m/^intermediate$/i; 400 push(@result, $lgrp), 401 next if $lgrp =~ m/^\d+$/ && $seen{$lgrp}; 402 printf STDERR gettext("%s: skipping invalid lgrp $lgrp\n"), 403 $cmdname; 404 } 405 406 return @result; 407} 408 409# 410# lgrp_tree(class, node) 411# 412# Build the tree of the lgroup hierarchy starting with the specified node or 413# root if no initial node is specified. Calls itself recursively specifying each 414# of the children as a starting node. Builds a reference to the list with the 415# node in the end and each element being a subtree. 416# 417sub lgrp_tree 418{ 419 my $c = shift; 420 my $lgrp = shift || $c->root; 421 422 # Call itself for each of the children and combine results in a list. 423 [ (map { lgrp_tree($c, $_) } $c->children($lgrp)), $lgrp ]; 424} 425 426# 427# lgrp_pp(tree, prefix, childprefix, npeers) 428# 429# pretty-print the hierarchy tree. 430# Input Arguments: 431# Reference to the tree 432# Prefix for me to use 433# Prefix for my children to use 434# Number of peers left 435# 436sub lgrp_pp 437{ 438 my $tree = shift; 439 my $myprefix = shift; 440 my $childprefix = shift; 441 my $npeers = shift; 442 my $el = pop @$tree; 443 my $nchildren = scalar @$tree; 444 my $printprefix = "$childprefix"; 445 my $printpostfix = $npeers ? "| " : " "; 446 447 return unless defined ($el); 448 449 my $bar = $npeers ? "|" : "`"; 450 print $childprefix ? $childprefix : ""; 451 print $myprefix ? "$bar" . "-- " : ""; 452 lgrp_print($el, "$printprefix$printpostfix"); 453 454 my $new_prefix = $npeers ? $myprefix : " "; 455 456 # Pretty-print the subtree with a new offset. 457 map { 458 lgrp_pp($_, "| ", "$childprefix$new_prefix", --$nchildren) 459 } @$tree; 460} 461 462# Pretty print the whole tree 463sub lgrp_prettyprint 464{ 465 my $c = shift; 466 my $tree = lgrp_tree $c; 467 lgrp_pp($tree, '', '', scalar $tree - 1); 468} 469 470sub lgrp_print 471{ 472 my $lgrp = shift; 473 my $prefix = shift; 474 my ($cpus, $memstr, $rsrc); 475 my $is_interm = ($lgrp != $root && !$l->isleaf($lgrp)); 476 my $not_root = $is_uma || $lgrp != $root; 477 478 print "$lgrp"; 479 480 if ($do_cpu && $not_root) { 481 $cpus = lgrp_showcpus($lgrp, LGRP_CONTENT_HIERARCHY); 482 } 483 if ($do_memory && $not_root) { 484 $memstr = lgrp_showmemory($lgrp, LGRP_CONTENT_HIERARCHY); 485 } 486 if ($do_rsrc && ($is_uma || $is_interm)) { 487 $rsrc = lgrp_showresources($lgrp) if $do_rsrc; 488 } 489 490 # Print all the information about lgrp. 491 492 print "\n$prefix$cpus" if $cpus; 493 print "\n$prefix$memstr" if $memstr; 494 print "\n$prefix$rsrc" if $rsrc; 495 print "\n$prefix$loads->{$lgrp}" if defined ($loads->{$lgrp}); 496 497 # Print latency information if requested. 498 if ($do_lat && $lgrp != $root && defined($self_latencies{$lgrp})) { 499 print "\n${prefix}"; 500 printf gettext("Latency: %d"), $self_latencies{$lgrp}; 501 } 502 print "\n"; 503} 504 505# What CPUs are in this lgrp? 506sub lgrp_showcpus 507{ 508 my $lgrp = shift; 509 my $hier = shift; 510 511 my @cpus = $l->cpus($lgrp, $hier); 512 my $ncpus = @cpus; 513 return 0 unless $ncpus; 514 # Sort CPU list if there is something to sort. 515 @cpus = nsort(@cpus) if ($ncpus > 1); 516 my $cpu_string = lgrp_collapse(@cpus); 517 return (($ncpus == 1) ? 518 gettext("CPU: ") . $cpu_string: 519 gettext("CPUs: ") . $cpu_string); 520} 521 522# How much memory does this lgrp contain? 523sub lgrp_showmemory 524{ 525 my $lgrp = shift; 526 my $hier = shift; 527 528 my $memory = $l->mem_size($lgrp, LGRP_MEM_SZ_INSTALLED, $hier); 529 return (0) unless $memory; 530 my $freemem = $l->mem_size($lgrp, LGRP_MEM_SZ_FREE, $hier) || 0; 531 532 my $memory_r = memory_to_string($memory); 533 my $freemem_r = memory_to_string($freemem); 534 my $usedmem = memory_to_string($memory - $freemem); 535 536 my $memstr = sprintf(gettext("Memory: installed %s"), 537 $memory_r); 538 $memstr = $memstr . sprintf(gettext(", allocated %s"), 539 $usedmem); 540 $memstr = $memstr . sprintf(gettext(", free %s"), 541 $freemem_r); 542 return ($memstr); 543} 544 545# Get string containing lgroup resources 546sub lgrp_showresources 547{ 548 my $lgrp = shift; 549 my $rsrc_prefix = gettext("Lgroup resources:"); 550 # What resources does this lgroup contain? 551 my @resources_cpu = nsort($l->resources($lgrp, LGRP_RSRC_CPU)); 552 my @resources_mem = nsort($l->resources($lgrp, LGRP_RSRC_MEM)); 553 my $rsrc = @resources_cpu || @resources_mem ? "" : gettext("none"); 554 $rsrc = $rsrc_prefix . $rsrc; 555 my $rsrc_cpu = lgrp_collapse(@resources_cpu); 556 my $rsrc_mem = lgrp_collapse(@resources_mem); 557 my $lcpu = gettext("CPU"); 558 my $lmemory = gettext("memory"); 559 $rsrc = "$rsrc $rsrc_cpu ($lcpu);" if scalar @resources_cpu; 560 $rsrc = "$rsrc $rsrc_mem ($lmemory)" if scalar @resources_mem; 561 return ($rsrc); 562} 563 564# 565# Consolidate consequtive ids as start-end 566# Input: list of ids 567# Output: string with space-sepated cpu values with ranges 568# collapsed as x-y 569# 570sub lgrp_collapse 571{ 572 return ('') unless @_; 573 my @args = uniqsort(@_); 574 my $start = shift(@args); 575 my $result = ''; 576 my $end = $start; # Initial range consists of the first element 577 foreach my $el (@args) { 578 if ($el == ($end + 1)) { 579 # 580 # Got consecutive ID, so extend end of range without 581 # printing anything since the range may extend further 582 # 583 $end = $el; 584 } else { 585 # 586 # Next ID is not consecutive, so print IDs gotten so 587 # far. 588 # 589 if ($end > $start + 1) { # range 590 $result = "$result $start-$end"; 591 } elsif ($end > $start) { # different values 592 $result = "$result $start $end"; 593 } else { # same value 594 $result = "$result $start"; 595 } 596 597 # Try finding consecutive range starting from this ID 598 $start = $end = $el; 599 } 600 } 601 602 # Print last ID(s) 603 if ($end > $start + 1) { 604 $result = "$result $start-$end"; 605 } elsif ($end > $start) { 606 $result = "$result $start $end"; 607 } else { 608 $result = "$result $start"; 609 } 610 # Remove any spaces in the beginning 611 $result =~ s/^\s+//; 612 return ($result); 613} 614 615# Print latency information if requested and the system has several lgroups. 616sub print_latency_table 617{ 618 my ($lgrps1, $lgrps2) = @_; 619 620 return unless scalar @lgrps; 621 622 # Find maximum lgroup 623 my $max = $root; 624 map { $max = $_ if $max < $_ } @$lgrps1; 625 626 # Field width for lgroup - the width of the largest lgroup and 1 space 627 my $lgwidth = length($max) + 1; 628 # Field width for latency. Get the maximum latency and add 1 space. 629 my $width = length($l->latency($root, $root)) + 1; 630 # Make sure that width is enough to print lgroup itself. 631 $width = $lgwidth if $width < $lgwidth; 632 633 # Print table header 634 print gettext("\nLgroup latencies:\n"); 635 # Print horizontal line 636 print "\n", "-" x ($lgwidth + 1); 637 map { print '-' x $width } @$lgrps1; 638 print "\n", " " x $lgwidth, "|"; 639 map { printf("%${width}d", $_) } @$lgrps1; 640 print "\n", "-" x ($lgwidth + 1); 641 map { print '-' x $width } @$lgrps1; 642 print "\n"; 643 644 # Print the latency table 645 foreach my $l1 (@$lgrps2) { 646 printf "%-${lgwidth}d|", $l1; 647 foreach my $l2 (@lgrps) { 648 my $latency = $l->latency($l1, $l2); 649 if (!defined ($latency)) { 650 printf "%${width}s", "-"; 651 } else { 652 printf "%${width}d", $latency; 653 } 654 } 655 print "\n"; 656 } 657 658 # Print table footer 659 print "-" x ($lgwidth + 1); 660 map { print '-' x $width } @lgrps; 661 print "\n"; 662} 663 664# 665# Convert a number to a string representation 666# The number is scaled down until it is small enough to be in a good 667# human readable format i.e. in the range 0 thru 1023. 668# If it's smaller than 10 there's room enough to provide one decimal place. 669# 670sub number_to_scaled_string 671{ 672 my $number = shift; 673 674 my $scale = KB; 675 my @measurement = ('K', 'M', 'G', 'T', 'P', 'E'); # Measurement 676 my $uom = shift(@measurement); 677 my $result; 678 679 my $save = $number; 680 681 # Get size in K. 682 $number /= KB; 683 684 while (($number >= $scale) && $uom ne 'E') { 685 $uom = shift(@measurement); 686 $save = $number; 687 $number /= $scale; 688 } 689 690 # check if we should output a decimal place after the point 691 if ($save && (($save / $scale) < 10)) { 692 $result = sprintf("%2.1f", $save / $scale); 693 } else { 694 $result = round($number); 695 } 696 return ("$result$uom"); 697} 698 699# 700# Convert memory size to the string representation 701# 702sub memory_to_string 703{ 704 my $number = shift; 705 706 # Zero memory - just print 0 707 return ("0$unit_str") unless $number; 708 709 # 710 # Return memory size scaled to human-readable form unless -u is 711 # specified. 712 # 713 return (number_to_scaled_string($number)) unless $opt_u; 714 715 my $scaled = $number / $units; 716 my $result; 717 718 if ($scaled < 0.1) { 719 $result = sprintf("%2.1g", $scaled); 720 } elsif ($scaled < 10) { 721 $result = sprintf("%2.1f", $scaled); 722 } else { 723 $result = int($scaled + 0.5); 724 } 725 return ("$result$unit_str"); 726} 727 728# 729# Read load averages from lgrp kstats Return hash reference indexed by lgroup ID 730# for each lgroup which has load information. 731# 732sub get_lav 733{ 734 my $load = {}; 735 736 my $ks = Sun::Solaris::Kstat->new(strip_strings => 1) or 737 warn(gettext("$cmdname: kstat_open() failed: %!\n")), 738 return $load; 739 740 my $lgrp_kstats = $ks->{lgrp} or 741 warn(gettext("$cmdname: can not read lgrp kstat\n)")), 742 return $load; 743 744 # Collect load for each lgroup 745 foreach my $i (keys %$lgrp_kstats) { 746 next unless $lgrp_kstats->{$i}->{"lgrp$i"}; 747 my $lav = $lgrp_kstats->{$i}->{"lgrp$i"}->{"load average"}; 748 # Skip this lgroup if can't find its load average 749 next unless defined $lav; 750 my $scale = $lgrp_kstats->{$i}->{"lgrp$i"}->{"loadscale"} || 751 LGRP_LOADAVG_THREAD_MAX; 752 $load->{$i} = sprintf (gettext("Load: %4.3g"), $lav / $scale); 753 } 754 return $load; 755} 756