usr/src/cmd/pgstat/pgstat.pl

   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
  31 use warnings;
  32 use strict;
  33 use File::Basename;
  34 use List::Util qw(first max min);
  35 use Errno;
  36 use POSIX qw(locale_h strftime);
  37 use Getopt::Long qw(:config no_ignore_case bundling auto_version);
  38 use Sun::Solaris::Utils qw(textdomain gettext);
  39 use 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 #
  63 use 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 #
  77 my $pcnt_fmt = "%6s";
  78 #
  79 # Format for percentages field
  80 #
  81 my $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 #
  92 use 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 #
 101 my @sort_keys = qw(pg hwload swload user sys idle depth breadth);
 102
 103 # Set message locale
 104 setlocale(LC_ALL, "");
 105 textdomain(TEXT_DOMAIN);
 106
 107 # Get script name for error messages
 108 our $cmdname = basename($0, ".pl");
 109
 110 my @pg_list;            # -P pg,...     - PG arguments
 111 my @cpu_list;           # -c cpu,...    - CPU arguments
 112 my @sharing_filter_neg; # -R string,... - Prune PGs
 113 my @sharing_filter;     # -r string,... - Matching sharing names
 114 my $do_aggregate;       # -A            - Show summary in the end
 115 my $do_cpu_utilization; # -C            - Show per-CPU utilization
 116 my $do_physical;        # -p            - Show physical relationships
 117 my $do_timestamp;       # -T            - Print timestamp
 118 my $do_usage;           # -h            - Show usage
 119 my $do_version;         # -V            - Verbose output
 120 my $show_top;           # -t            - show top N
 121 my $sort_order_a;       # -S key        - Ascending sort order
 122 my $sort_order_d;       # -s key        - Descending sort order
 123 my $verbose;            # -v            - Verbose output;
 124
 125 $verbose = 0;
 126
 127 # Parse options from the command line
 128 GetOptions("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
 146 usage(E_SUCCESS) if $do_usage;
 147
 148 if ($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
 157 if (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
 163 if ($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
 169 if (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 #
 179 my $sort_key;
 180 my $sort_reverse;
 181
 182 if (!($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 #
 193 if (!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 #
 209 my $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
 215 if (!$p) {
 216         printf STDERR
 217           gettext("%s: can not obtain Processor Group information: $!\n"),
 218             $cmdname;
 219         exit(E_ERROR);
 220 }
 221
 222 my $p_initial = $p;
 223 my $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
 229 if (!$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 #
 239 my $count = DEFAULT_COUNT;
 240 my $interval = DEFAULT_INTERVAL;
 241
 242 if (scalar @ARGV > 0) {
 243         $interval = shift @ARGV;
 244         if (scalar @ARGV > 0) {
 245                 $count = $ARGV[0];
 246         } else {
 247                 $count = 0;
 248         }
 249 }
 250
 251 if (! ($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
 258 if ($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
 265 my $infinite = 1 unless $count;
 266
 267 #
 268 # Get list of all PGs
 269 #
 270 my @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 #
 275 my @all_cpus = $p->cpus($p->root());
 276
 277 # PGs to work with
 278 my @pgs = @all_pgs;
 279
 280 my $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 #
 302 if (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
 333 if (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?
 347 if (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 #
 358 my $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 #
 364 my %name_of_pg;
 365
 366 #
 367 # For calculating proper offsets we need to know minimum and maximum level for
 368 # all PGs
 369 #
 370 my $max_sharename_len = length('RELATIONSHIP');
 371
 372 my $maxlevel;
 373 my $minlevel;
 374
 375 if ($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 #
 385 foreach 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
 402 my $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.
 408 my %pgs;
 409
 410 # Total number of main loop iterations we actually do
 411 my $total_iterations = 0;
 412
 413 #
 414 # For summary, keep track of minimum and maximum data per PG
 415 #
 416 my $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
 427 while ($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
 653 print_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 #
 668 sub 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 #
 802 sub 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 #
 825 sub 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 #
 845 sub 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 #
 886 sub 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 #
 907 sub 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 #
 942 sub 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 #
 961 sub 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 #
 977 sub 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__