#! /usr/perl5/bin/perl # # CDDL HEADER START # # The contents of this file are subject to the terms of the # Common Development and Distribution License (the "License"). # You may not use this file except in compliance with the License. # # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE # or http://www.opensolaris.org/os/licensing. # See the License for the specific language governing permissions # and limitations under the License. # # When distributing Covered Code, include this CDDL HEADER in each # file and include the License file at usr/src/OPENSOLARIS.LICENSE. # If applicable, add the following below this CDDL HEADER, with the # fields enclosed by brackets "[]" replaced with your own identifying # information: Portions Copyright [yyyy] [name of copyright owner] # # CDDL HEADER END # # # Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved. # # # pgstat - tool for displaying Processor Group statistics # use warnings; use strict; use File::Basename; use List::Util qw(first max min); use Errno; use POSIX qw(locale_h strftime); use Getopt::Long qw(:config no_ignore_case bundling auto_version); use Sun::Solaris::Utils qw(textdomain gettext); use Sun::Solaris::Pg; # # Constants section # # It is possible that wnen trying to parse PG kstats, PG generation changes # which will cause PG new method to fail with errno set to EAGAIN In this case # we retry open up to RETRY_COUNT times pausing RETRY_DELAY seconds between each # retry. # # When printing PGs we print them as a little tree with each PG shifted by # LEVEL_OFFSET from each parent. For example: # # PG RELATIONSHIP CPUs # 0 System 0-7 # 3 Socket 0 2 4 6 # 2 Cache 0 2 4 6 # # # DEFAULT_INTERVAL - interval in seconds between snapshot if none is specified # DEFAULT_COUNT - Number of iterations if none is specified # HWLOAD_UNKNOWN - Value that we use to represent unknown hardware load # HWLOAD_UNDEF - Value that we use to represent undefined hardware load # use constant { VERSION => 1.1, DEFAULT_INTERVAL => 1, DEFAULT_COUNT => 1, RETRY_COUNT => 4, RETRY_DELAY => 0.25, HWLOAD_UNKNOWN => -1, HWLOAD_UNDEF => -2, LEVEL_OFFSET => 1, }; # # Format for fields, showing percentage headers # my $pcnt_fmt = "%6s"; # # Format for percentages field # my $pcnt = "%5.1f"; # # Return codes # # 0 Successful completion. # # 1 An error occurred. # # 2 Invalid command-line options were specified. # use constant { E_SUCCESS => 0, E_ERROR => 1, E_USAGE => 2, }; # # Valid sort keys for -s and -S options # my @sort_keys = qw(pg hwload swload user sys idle depth breadth); # Set message locale setlocale(LC_ALL, ""); textdomain(TEXT_DOMAIN); # Get script name for error messages our $cmdname = basename($0, ".pl"); my @pg_list; # -P pg,... - PG arguments my @cpu_list; # -c cpu,... - CPU arguments my @sharing_filter_neg; # -R string,... - Prune PGs my @sharing_filter; # -r string,... - Matching sharing names my $do_aggregate; # -A - Show summary in the end my $do_cpu_utilization; # -C - Show per-CPU utilization my $do_physical; # -p - Show physical relationships my $do_timestamp; # -T - Print timestamp my $do_usage; # -h - Show usage my $do_version; # -V - Verbose output my $show_top; # -t - show top N my $sort_order_a; # -S key - Ascending sort order my $sort_order_d; # -s key - Descending sort order my $verbose; # -v - Verbose output; $verbose = 0; # Parse options from the command line GetOptions("aggregate|A" => \$do_aggregate, "cpus|c=s" => \@cpu_list, "showcpu|C" => \$do_cpu_utilization, "help|h|?" => \$do_usage, "pgs|P=s" => \@pg_list, "physical|p" => \$do_physical, "relationship|r=s" => \@sharing_filter, "norelationship|R=s" => \@sharing_filter_neg, "sort|s=s" => \$sort_order_d, "Sort|S=s" => \$sort_order_a, "top|t=i" => \$show_top, "timestamp|T=s" => \$do_timestamp, "version|V" => \$do_version, "verbose+" => \$verbose, "v+" => \$verbose, ) || usage(E_USAGE); # Print usage message when -h is given usage(E_SUCCESS) if $do_usage; if ($do_version) { printf gettext("%s version %s\n"), $cmdname, VERSION; exit(E_SUCCESS); } # # Verify options # # -T should have either u or d argument if (defined($do_timestamp) && !($do_timestamp eq 'u' || $do_timestamp eq 'd')) { printf STDERR gettext("%s: Invalid -T %s argument\n"), $cmdname, $do_timestamp; usage(E_USAGE); } if ($sort_order_a && $sort_order_d) { printf STDERR gettext("%s: -S and -s flags can not be used together\n"), $cmdname; usage(E_USAGE); } if (defined ($show_top) && $show_top <= 0) { printf STDERR gettext("%s: -t should specify positive integer\n"), $cmdname; usage(E_USAGE); } # # Figure out requested sorting of the output # By default 'depth-first' is used # my $sort_key; my $sort_reverse; if (!($sort_order_a || $sort_order_d)) { $sort_key = 'depth'; $sort_reverse = 1; } else { $sort_key = $sort_order_d || $sort_order_a; $sort_reverse = defined($sort_order_d); } # # Make sure sort key is valid # if (!list_match($sort_key, \@sort_keys, 1)) { printf STDERR gettext("%s: invalid sort key %s\n"), $cmdname, $sort_key; usage(E_USAGE); } # # Convert -[Rr] string1,string2,... into list (string1, string2, ...) # @sharing_filter = map { split /,/ } @sharing_filter; @sharing_filter_neg = map { split /,/ } @sharing_filter_neg; # # We use two PG snapshot to compare utilization between them. One snapshot is # kept behind another in time. # my $p = Sun::Solaris::Pg->new(-cpudata => $do_cpu_utilization, -swload => 1, -tags => $do_physical, -retry => RETRY_COUNT, -delay => RETRY_DELAY); if (!$p) { printf STDERR gettext("%s: can not obtain Processor Group information: $!\n"), $cmdname; exit(E_ERROR); } my $p_initial = $p; my $p_dup = Sun::Solaris::Pg->new(-cpudata => $do_cpu_utilization, -swload => 1, -tags => $do_physical, -retry => RETRY_COUNT, -delay => RETRY_DELAY); if (!$p_dup) { printf STDERR gettext("%s: can not obtain Processor Group information: $!\n"), $cmdname; exit(E_ERROR); } # # Get interval and count # my $count = DEFAULT_COUNT; my $interval = DEFAULT_INTERVAL; if (scalar @ARGV > 0) { $interval = shift @ARGV; if (scalar @ARGV > 0) { $count = $ARGV[0]; } else { $count = 0; } } if (! ($interval=~ m/^\d+\.?\d*$/)) { printf STDERR gettext("%s: Invalid interval %s - should be numeric\n"), $cmdname, $interval; usage(E_USAGE); } if ($count && ! ($count=~ m/^\d+$/)) { printf STDERR gettext("%s: Invalid count %s - should be numeric\n"), $cmdname, $count; usage(E_USAGE); } my $infinite = 1 unless $count; # # Get list of all PGs # my @all_pgs = $p->all_depth_first(); # # get list of all CPUs in the system by looking at the root PG cpus # my @all_cpus = $p->cpus($p->root()); # PGs to work with my @pgs = @all_pgs; my $rc = E_SUCCESS; # # Convert CPU and PG lists into proper Perl lists, converting things like # 1-3,5 into (1, 2, 3, 5). Also convert 'all' into the list of all CPUs or PGs # @cpu_list = map { $_ eq 'all' ? @all_cpus : $_ } # all -> (cpu1, cpu2, ...) map { split /,/ } @cpu_list; # x,y -> (x, y) @cpu_list = $p->expand(@cpu_list); # 1-3 -> 1 2 3 # Same drill for PGs @pg_list = map { $_ eq 'all' ? @all_pgs : $_ } map { split /,/ } @pg_list; @pg_list = $p->expand(@pg_list); # # Convert CPU list to list of PGs # if (scalar @cpu_list) { # # Warn about any invalid CPU IDs in the arguments # @bad_cpus is a list of invalid CPU IDs # my @bad_cpus = $p->set_subtract(\@all_cpus, \@cpu_list); if (scalar @bad_cpus) { printf STDERR gettext("%s: Invalid processor IDs %s\n"), $cmdname, $p->id_collapse(@bad_cpus); $rc = E_ERROR; } # # Find all PGs which have at least some CPUs from @cpu_list # my @pgs_from_cpus = grep { my @cpus = $p->cpus($_); scalar($p->intersect(\@cpus, \@cpu_list)); } @all_pgs; # Combine PGs from @pg_list (if any) with PGs we found @pg_list = (@pg_list, @pgs_from_cpus); } # # If there are any PGs specified by the user, complain about invalid ones # @pgs = get_pg_list($p, \@pg_list, \@sharing_filter, \@sharing_filter_neg); if (scalar @pg_list > 0) { # # Warn about any invalid PG # @bad_pgs is a list of invalid CPUs in the arguments # my @bad_pgs = $p->set_subtract(\@all_pgs, \@pg_list); if (scalar @bad_pgs) { printf STDERR gettext("%s: warning: invalid PG IDs %s\n"), $cmdname, $p->id_collapse(@bad_pgs); } } # Do we have any PGs left? if (scalar(@pgs) == 0) { printf STDERR gettext("%s: No processor groups matching command line arguments\n"), $cmdname; exit(E_USAGE); } # # Set $do_levels if we should provide output identation by level It doesn't make # sense to provide identation if PGs are sorted not in topology order. # my $do_levels = ($sort_key eq 'breadth' || $sort_key eq 'depth'); # # %name_of_pg hash keeps sharing name, possibly with physical tags appended to # it for each PG. # my %name_of_pg; # # For calculating proper offsets we need to know minimum and maximum level for # all PGs # my $max_sharename_len = length('RELATIONSHIP'); my $maxlevel; my $minlevel; if ($do_levels) { my @levels = map { $p->level($_) } @pgs; # Levels for each PG $maxlevel = max(@levels); $minlevel = min(@levels); } # # Walk over all PGs and find out the string length that we need to represent # sharing name + physical tags + indentation level. # foreach my $pg (@pgs) { my $name = $p->sh_name ($pg) || "unknown"; my $level = $p->level($pg) || 0 if $do_levels; if ($do_physical) { my $tags = $p->tags($pg); $name = "$name [$tags]" if $tags; $name_of_pg{$pg} = $name; } $name_of_pg{$pg} = $name; my $length = length($name); $length += $level - $minlevel if $do_levels; $max_sharename_len = $length if $length > $max_sharename_len; } # Maximum length of PG ID field my $max_pg_len = length(max(@pgs)) + 1; $max_pg_len = length('PG') if ($max_pg_len) < length('PG'); # # # %pgs hash contains various statistics per PG that is used for sorting. my %pgs; # Total number of main loop iterations we actually do my $total_iterations = 0; # # For summary, keep track of minimum and maximum data per PG # my $history; # # Provide summary output when aggregation is requested and user hits ^C # $SIG{'INT'} = \&print_totals if $do_aggregate; ###################################################################### # Main loop ########### while ($infinite || $count--) { # # Print timestamp if -T is specified # if ($do_timestamp) { if ($do_timestamp eq 'u') { print time(), "\n"; } else { my $date_str = strftime "%A, %B %e, %Y %r %Z", localtime; print "$date_str\n"; } } # # Wait for the requested interval # select(undef, undef, undef, $interval); # # Print headers # There are two different output formats - one regular and one verbose # if (!$verbose) { printf "%-${max_pg_len}s %-${max_sharename_len}s ". "$pcnt_fmt $pcnt_fmt %-s\n", 'PG', 'RELATIONSHIP', 'HW', 'SW', 'CPUS'; } else { printf "%-${max_pg_len}s %-${max_sharename_len}s" . " $pcnt_fmt %4s %4s $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt %s\n", 'PG','RELATIONSHIP', 'HW', 'UTIL', 'CAP', 'SW', 'USR', 'SYS', 'IDLE', 'CPUS'; } # # Update the data in one of the snapshots # $p_dup->update(); # # Do not show offlined CPUs # my @online_cpus = $p->online_cpus(); # # Check whether both snapshots belong to the same generation # if ($p->generation() != $p_dup->generation()) { printf gettext("Configuration changed!\n"); # Swap $p and $p_dup; $p = $p_dup; $p_dup = Sun::Solaris::Pg->new( -cpudata => $do_cpu_utilization, -swload => 1, -tags => $do_physical, -retry => RETRY_COUNT, -delay => RETRY_DELAY); if (!$p_dup) { printf STDERR gettext( "%s: can not obtain Processor Group information: $!\n"), $cmdname; exit(E_ERROR); } # # Recreate @pg_list since it may have changed # @pgs = get_pg_list($p, \@pg_list, \@sharing_filter, \@sharing_filter_neg); next; } %pgs = (); # # Go over each PG and gets its utilization data # foreach my $pg (@pgs) { my ($hwload, $utilization, $capacity, $accuracy) = get_load($p, $p_dup, $pg); my @cpus = $p->cpus ($pg); my ($user, $sys, $idle, $swload) = $p->sw_utilization($p_dup, $pg); # Adjust idle and swload based on rounding ($swload, $idle) = get_swload($user, $sys); $pgs{$pg}->{pg} = $pg; $pgs{$pg}->{hwload} = $hwload; $pgs{$pg}->{swload} = $swload; $pgs{$pg}->{user} = $user; $pgs{$pg}->{sys} = $sys; $pgs{$pg}->{idle} = $idle; $pgs{$pg}->{utilization} = $utilization; $pgs{$pg}->{capacity} = $capacity; # # Record history # $history->{$pg}->{hwload} += $hwload if $hwload && $hwload >= 0; $history->{$pg}->{swload} += $swload if $swload; $history->{$pg}->{user} += $user if $user; $history->{$pg}->{sys} += $sys if $sys; $history->{$pg}->{idle} += $idle if $idle; $history->{$pg}->{maxhwload} = $hwload if !defined($history->{$pg}->{maxhwload}) || $hwload > $history->{$pg}->{maxhwload}; $history->{$pg}->{minhwload} = $hwload if !defined($history->{$pg}->{minhwload}) || $hwload < $history->{$pg}->{minhwload}; $history->{$pg}->{maxswload} = $swload if !defined($history->{$pg}->{maxswload}) || $swload > $history->{$pg}->{maxswload}; $history->{$pg}->{minswload} = $swload if !defined($history->{$pg}->{minswload}) || $swload < $history->{$pg}->{minswload}; } # # Sort the output # my @sorted_pgs; my $npgs = scalar @pgs; @sorted_pgs = pg_sort_by_key(\%pgs, $sort_key, $sort_reverse, @pgs); # # Should only top N be displayed? # if ($show_top) { $npgs = $show_top if $show_top < $npgs; @sorted_pgs = @sorted_pgs[0..$npgs - 1]; } # # Now print everything # foreach my $pg (@sorted_pgs) { my $shname = $name_of_pg{$pg}; my $level; if ($do_levels) { $level = $p->level($pg) - $minlevel; $shname = (' ' x (LEVEL_OFFSET * $level)) . $shname; } my $hwload = $pgs{$pg}->{hwload} || 0; my $swload = $pgs{$pg}->{swload}; my @cpus = $p->cpus($pg); @cpus = $p->intersect(\@cpus, \@online_cpus); my $cpus = $p->id_collapse(@cpus); my $user = $pgs{$pg}->{user}; my $sys = $pgs{$pg}->{sys}; my $idle = $pgs{$pg}->{idle}; my $utilization = $pgs{$pg}->{utilization}; my $capacity = $pgs{$pg}->{capacity}; if (!$verbose) { printf "%${max_pg_len}d %-${max_sharename_len}s " . "%s %s %s\n", $pg, $shname, load2str($hwload), load2str($swload), $cpus; } else { printf "%${max_pg_len}d %-${max_sharename_len}s " . "%4s %4s %4s %4s %4s %4s %4s %s\n", $pg, $shname, load2str($hwload), number_to_scaled_string($utilization), number_to_scaled_string($capacity), load2str($swload), load2str($user), load2str($sys), load2str($idle), $cpus; } # # If per-CPU utilization is requested, print it after each # corresponding PG # if ($do_cpu_utilization) { my $w = ${max_sharename_len} - length ('CPU'); foreach my $cpu (sort {$a <=> $b } @cpus) { my ($cpu_utilization, $accuracy, $hw_utilization, $swload) = $p->cpu_utilization($p_dup, $pg, $cpu); next unless defined $cpu_utilization; my $cpuname = "CPU$cpu"; if ($do_levels) { $cpuname = (' ' x (LEVEL_OFFSET * $level)) . $cpuname; } printf "%-${max_pg_len}s " . "%-${max_sharename_len}s ", ' ', $cpuname; if ($verbose) { printf "%s %4s %4s\n", load2str($cpu_utilization), number_to_scaled_string($hw_utilization), number_to_scaled_string($capacity); } else { printf "%s %s\n", load2str($cpu_utilization), load2str($swload); } } } } # # Swap $p and $p_dup # ($p, $p_dup) = ($p_dup, $p); $total_iterations++; } print_totals() if $do_aggregate; #################################### # End of main loop #################################### # # Support Subroutines # # # Print aggregated information in the end # sub print_totals { exit ($rc) unless $total_iterations > 1; printf gettext("\n%s SUMMARY: UTILIZATION OVER %d SECONDS\n\n"), ' ' x 10, $total_iterations * $interval; my @sorted_pgs; my $npgs = scalar @pgs; %pgs = (); # # Collect data per PG # foreach my $pg (@pgs) { $pgs{$pg}->{pg} = $pg; my ($hwload, $utilization, $capacity, $accuracy) = get_load($p_initial, $p_dup, $pg); my @cpus = $p->cpus ($pg); my ($user, $sys, $idle, $swload) = $p_dup->sw_utilization($p_initial, $pg); # Adjust idle and swload based on rounding ($swload, $idle) = get_swload($user, $sys); $pgs{$pg}->{pg} = $pg; $pgs{$pg}->{swload} = $swload; $pgs{$pg}->{user} = $user; $pgs{$pg}->{sys} = $sys; $pgs{$pg}->{idle} = $idle; $pgs{$pg}->{hwload} = $hwload; $pgs{$pg}->{utilization} = number_to_scaled_string($utilization); $pgs{$pg}->{capacity} = number_to_scaled_string($capacity); $pgs{$pg}->{minhwload} = $history->{$pg}->{minhwload}; $pgs{$pg}->{maxhwload} = $history->{$pg}->{maxhwload}; $pgs{$pg}->{minswload} = $history->{$pg}->{minswload} || 0; $pgs{$pg}->{maxswload} = $history->{$pg}->{maxswload} || 0; } # # Sort PGs according to the sorting options # @sorted_pgs = pg_sort_by_key(\%pgs, $sort_key, $sort_reverse, @pgs); # # Trim to top N if needed # if ($show_top) { $npgs = $show_top if $show_top < $npgs; @sorted_pgs = @sorted_pgs[0..$npgs - 1]; } # # Print headers # my $d = ' ' . '-' x 4; if ($verbose) { printf "%${max_pg_len}s %-${max_sharename_len}s %s " . " ------HARDWARE------ ------SOFTWARE------\n", ' ', ' ', ' ' x 8; printf "%-${max_pg_len}s %-${max_sharename_len}s", 'PG', 'RELATIONSHIP'; printf " %4s %4s", 'UTIL', ' CAP'; printf " $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt %s\n", 'MIN', 'AVG', 'MAX', 'MIN', 'AVG', 'MAX', 'CPUS'; } else { printf "%${max_pg_len}s %-${max_sharename_len}s " . "------HARDWARE------" . " ------SOFTWARE------\n", ' ', ' '; printf "%-${max_pg_len}s %-${max_sharename_len}s", 'PG', 'RELATIONSHIP'; printf " $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt $pcnt_fmt %s\n", 'MIN', 'AVG', 'MAX', 'MIN', 'AVG', 'MAX', 'CPUS'; } # # Print information per PG # foreach my $pg (@sorted_pgs) { my $cpus = $p->cpus($pg); my $shname = $name_of_pg{$pg}; if ($sort_key eq 'breadth' || $sort_key eq 'depth') { my $level = $p->level($pg) - $minlevel; $shname = (' ' x (LEVEL_OFFSET * $level)) . $shname; } printf "%${max_pg_len}d %-${max_sharename_len}s ", $pg, $shname; if ($verbose) { printf "%4s %4s ", number_to_scaled_string($pgs{$pg}->{utilization}), number_to_scaled_string($pgs{$pg}->{capacity}); } if (!defined($pgs{$pg}->{hwload}) || $pgs{$pg}->{hwload} == HWLOAD_UNDEF) { printf "$pcnt_fmt $pcnt_fmt $pcnt_fmt ", '-', '-', '-'; } else { printf "%s %s %s ", load2str($pgs{$pg}->{minhwload}), load2str($pgs{$pg}->{hwload}), load2str($pgs{$pg}->{maxhwload}); } printf "%s %s %s", load2str($pgs{$pg}->{minswload}), load2str($pgs{$pg}->{swload}), load2str($pgs{$pg}->{maxswload}); printf " %s\n", $cpus; } exit ($rc); } # # pg_sort_by_key(pgs, key, inverse) # Sort pgs according to the key specified # # Arguments: # pgs hash indexed by PG ID # sort keyword # inverse - inverse sort result if this is T # sub pg_sort_by_key { my $pgs = shift; my $key = shift; my $inverse = shift; my @sorted; if ($key eq 'depth' || $key eq 'breadth') { my $root = $p->root; my @pgs = $key eq 'depth' ? $p->all_depth_first() : $p->all_breadth_first(); @sorted = reverse(grep { exists($pgs{$_}) } @pgs); } else { @sorted = sort { $pgs{$a}->{$key} <=> $pgs{$b}->{$key} } @_; } return ($inverse ? reverse(@sorted) : @sorted); } # # Convert numeric load to formatted string # sub load2str { my $load = shift; return (sprintf "$pcnt_fmt", '-') if !defined($load) || $load == HWLOAD_UNDEF; return (sprintf "$pcnt_fmt", '?') if $load == HWLOAD_UNKNOWN; return (sprintf "$pcnt%%", $load); } # # get_load(snapshot1, snapshot2, pg) # # Get various hardware load data for the given PG using two snapshots. # Arguments: two PG snapshots and PG ID # # In scalar context returns the hardware load # In list context returns a list # (load, utilization, capacity, accuracy) # sub get_load { my $p = shift; my $p_dup = shift; my $pg = shift; return HWLOAD_UNDEF if !$p->has_utilization($pg); my ($capacity, $utilization, $accuracy, $tdelta); $accuracy = 100; $utilization = 0; $utilization = $p->utilization($p_dup, $pg) || 0; $capacity = $p_dup->capacity($pg); $accuracy = $p->accuracy($p_dup, $pg) || 0; $tdelta = $p->tdelta($p_dup, $pg); my $utilization_per_second = $utilization; $utilization_per_second /= $tdelta if $tdelta; my $load; if ($accuracy != 100) { $load = HWLOAD_UNKNOWN; } else { $load = $capacity ? $utilization_per_second * 100 / $capacity : HWLOAD_UNKNOWN; $capacity *= $tdelta if $tdelta; } return (wantarray() ? ($load, $utilization, $capacity, $accuracy) : $load); } # # Make sure that with the rounding used, user + system + swload add up to 100%. # # sub get_swload { my $user = shift; my $sys = shift; my $swload; my $idle; $user = sprintf "$pcnt", $user; $sys = sprintf "$pcnt", $sys; $swload = $user + $sys; $idle = 100 - $swload; return ($swload, $idle); } # # get_pg_list(cookie, pg_list, sharing_filter, sharing_filter_neg) Get list OF # PGs to look at based on all PGs available, user-specified PGs and # user-specified filters. # sub get_pg_list { my $p = shift; my $pg_list = shift; my $sharing_filter = shift; my $sharing_filter_neg = shift; my @all = $p->all(); my @pg_list = scalar @$pg_list ? @$pg_list : @all; my @pgs = $p->intersect(\@all_pgs, \@pg_list); # # Now we have list of PGs to work with. Now apply filtering. First list # only those matching -R # @pgs = grep { list_match($p->sh_name($_), \@sharing_filter, 0) } @pgs if @sharing_filter; my @sharing_filter = @$sharing_filter; my @sharing_filter_neg = @$sharing_filter_neg; # Remove any that doesn't match -r @pgs = grep { !list_match($p->sh_name($_), \@sharing_filter_neg, 0) } @pgs if scalar @sharing_filter_neg; return (@pgs); } # # usage(rc) # # Print short usage message and exit with the given return code. # If verbose is T, print a bit more information # sub usage { my $rc = shift || E_SUCCESS; printf STDERR gettext("Usage:\t%s [-A] [-C] [-p] [-s key | -S key] " . "[-t number] [-T u | d]\n"), $cmdname; print STDERR gettext("\t\t[-r string] [-R string] [-P pg ...] [-c processor_id... ]\n"); print STDERR gettext("\t\t[interval [count]]\n\n"); exit ($rc); } # # list_match(val, list_ref, strict) # Return T if argument matches any of the elements on the list, undef otherwise. # sub list_match { my $arg = shift; my $list = shift; my $strict = shift; return first { $arg eq $_ } @$list if $strict; return first { $arg =~ m/$_/i } @$list; } # # Convert a number to a string representation # The number is scaled down until it is small enough to be in a good # human readable format i.e. in the range 0 thru 1000. # If it's smaller than 10 there's room enough to provide one decimal place. # sub number_to_scaled_string { my $number = shift; return '-' unless defined ($number); # Remove any trailing spaces $number =~ s/ //g; return $number unless $number =~ /^[.\d]+$/; my $scale = 1000; return sprintf("%4d", $number) if $number < $scale; my @measurement = ('K', 'M', 'B', 'T'); my $uom = shift(@measurement); my $result; my $save = $number; # Get size in K. $number /= $scale; while (($number >= $scale) && $uom ne 'B') { $uom = shift(@measurement); $save = $number; $number /= $scale; } # check if we should output a decimal place after the point if ($save && (($save / $scale) < 10)) { $result = sprintf("%3.1f$uom", $save / $scale); } else { $result = sprintf("%3d$uom", $number); } return ("$result"); } __END__