#!/usr/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
#  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]
#
# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
# ident	"@(#)psrinfo.pl	1.5	06/02/28 SMI"
#
# psrinfo: displays information about processors
#
# Author: Alexander Kolbasov <akolb@eng.sun.com>
#

use strict;
use warnings;
use POSIX qw(strftime);
use File::Basename;
use Getopt::Long qw(:config no_ignore_case bundling auto_version);
use Sun::Solaris::Kstat;
use Data::Dumper;

my $cmdname = basename($0, ".pl");
my (@cpus, %cpu_list, @id_list, %chips, @chip_list, %cores, $ptree);

my %translations = ('chip_id' => 'physical processor');

# Regexp describing valid xxx_id entries in cpu_info kstats to examine.
my $valid_id_exp = 'chip_id|core_id';

sub usage(;$)
{
    my $msg = shift;
    die ("$cmdname: $msg\n") if $msg;
    die ("usage: \n\t$cmdname [-v] [-p] [processor_id ...]\n\t$cmdname" .
	 " -s [-p] processor_id\n")
      unless $msg;
}


##
# Set manipulations
#

# Return the input list with duplicates removed.
sub uniq(@)
{
    my %seen;
    return grep { ++$seen{$_} == 1 } @_;
}

# Return the intersection of two sets passed by reference
sub intersect ($$)
{
    my ($left, $right) = @_;
    my %seen;
    @seen{@$left} = (1) x @$left;
    return grep { $seen{$_} } @$right;
}

#
# End of set manipulations
##

# Sort the list numerically
sub nsort (@)
{
    sort { $a <=> $b } @_;
}

# Sort list numerically and remove duplicates
sub uniqsort (@)
{
    nsort(uniq(@_));
}

##
# Plurize name if needed
sub plurize($$)
{
    my ($name, $count) = @_;
    return ($count > 1 ? "${name}s" : $name);
}

##
# Translate id name into printable form
#
sub id_translate($)
{
    my $name = shift;
    return unless defined $name;
    $name = $translations{$name} || $name;
    $name =~ s/_id$//;
    return ($name);
}

# Return specified field from specific cpu_info kstat
sub getinfo ($$)
{
    my ($ci, $arg) = @_;
    return ${ci}->{$arg};
}

##
# Return list of property values
# Arguments:
#   Property name
#   list of CPUs
#
sub property_list($@)
{
    my $prop_name = shift;
    uniqsort(map { getinfo($cpu_list{$_}, $prop_name) } @_);
}

##
# Return sublist of CPUs having specified property value
#
sub cpus_by_prop($$@)
{
    my $prop_name = shift;
    my $prop_val = shift;

    grep { getinfo($cpu_list{$_}, $prop_name) == $prop_val } @_;
}

# Consolidate consequtive CPU ids as start-end
sub collapse(@)
{
    return "" unless @_;
    my $result = "";
    my $start = shift;
    my $end = $start;
    foreach my $el (@_) {
	if ($el == ($end + 1)) {
	    $end = $el;
	} else {
	    if ($end > $start + 1) {
		$result = "$result $start-$end";
	    } elsif ($end > $start) {
		$result = "$result $start $end";
	    } else {
		$result = "$result $start";
	    }
	    $start = $end = $el;
	}
    }
    if ($end > $start + 1) {
	$result = "$result $start-$end";
    } elsif ($end > $start) {
	$result = "$result $start $end";
    } else {
	$result = "$result $start";
    }
    # Remove any spaces in the beginning
    $result =~ s/^\s+//;
    return ($result);
}

# Expand start-end into the list of values
sub expand($)
{
    my $arg = shift;

    return ($arg) if $arg =~ m/^\d+$/;
    return unless $arg =~ m/(\d+)\-(\d+)/;

    my $start = $1;
    my $end = $2;
    my @result;

    for (my $i = $start; $i <= $end; $i++) {
	push (@result, $i);
    }

    return @result;
}

##
# Build property tree
#
# Arguments:
#    List of CPUs
#    List of subproperties
#
# Here is an example of the tree on dual-core system:
# $tree = 
# {
#  'name' => 'chip_id',
#  'cpus' => [ '0', '1', '2', '3' ]
#  'values' =>
#  {
#   '0' =>
#   {
#    'name' => 'core_id',
#    'cpus' => [ '0', '1', '2', '3' ]
#    'values' =>
#    {
#     '1' => { 'cpus' => [ '2', '3' ] },
#     '0' => { 'cpus' => [ '0', '1' ] }
#    },
#   }
#  },
# };
#
sub build_prop_tree($$);
sub build_prop_tree($$)
{
    my ($cpu_list, $prop_list) = @_;
    my ($prop_name, @props) = @$prop_list;
    my $tree = {};
    if (!$prop_name) {
	$tree->{cpus} = $cpu_list;
	return $tree;
    }

    # Get all possible property values
    foreach my $v (property_list($prop_name, @$cpu_list)) {
	my @prop_cpus = cpus_by_prop ($prop_name, $v, @$cpu_list);
	$tree->{name} = $prop_name;
	$tree->{cpus} = $cpu_list;
	$tree->{values}->{$v} = build_prop_tree(\@prop_cpus, \@props);
    }
    return $tree;
}

##
# Print property tree
# Arguments:
#   Reference to a tree
#   parent name
#   identation
sub print_prop_tree($$);
sub print_prop_tree($$)
{
    my ($tree, $ident) = @_;
    my $spaces = ' ' x $ident;
    my $id_name = $tree->{name};
    my $vals = $tree->{values};
    my $id_name_p = id_translate($id_name);
    my $retval = $ident;
    if ($vals) {
	my @prop_vals = nsort keys %$vals;
	my $nprops = scalar @prop_vals;
	my $prop_number = 0;
	foreach my $prop_val (@prop_vals) {
	    my $child_tree = $vals->{$prop_val};
	    my $child_id = $child_tree->{name};
	    my $cpulist = $child_tree->{cpus};
	    my @cpus = @$cpulist;
	    my $ncpus = scalar @cpus;
	    my $cpuname = plurize("processor", $ncpus);
	    my $cl = collapse(@cpus);
	    if (!$child_id) {
		print "${spaces}The $id_name_p has $ncpus virtual";
		print " $cpuname ($cl)\n";
		$retval = print_prop_tree($child_tree, $ident + 2);
	    } else {
		my $subchild_tree = $child_tree->{values};
		my @child_vals = keys %$subchild_tree;
		my $nvals = scalar @child_vals;
		my $child_id_name = plurize(id_translate($child_id), $nvals);
		print "${spaces}The $id_name_p has $nvals $child_id_name";
		print " and $ncpus virtual $cpuname ($cl)\n";
		$retval = print_prop_tree($child_tree, $ident + 2);
	    }
	    $prop_number++;
	}
    }
    return ($retval);
}

##
# Option processing
#
my ($opt_v, $opt_p, $opt_silent);

GetOptions("p" => \$opt_p,
 	   "v" => \$opt_v,
 	   "s" => \$opt_silent) || usage();


my $verbosity = 1;
my $phys_view;

$verbosity |= 2 if $opt_v;
$verbosity &= ~1 if $opt_silent;
$phys_view = 1 if $opt_p;

my $phys_verbose = $phys_view && ($verbosity > 1);

# Verify options
usage("options -s and -v are mutually exclusive") if $verbosity == 2;


##
# Read cpu_info kstats
#
my $ks = Sun::Solaris::Kstat->new() or
  die "$cmdname: kstat_open() failed: %!\n";
my $cpu_info = $ks->{cpu_info} or die "can not read cpu_info kstat\n";

###
# Get list of existing xxx_id entries in cpu_info kstats into @id_list
#
if ($phys_verbose) {
    my $id = (keys %$cpu_info)[0];
    my $info = $cpu_info->{$id};
    my $name = (keys %$info)[0];
    my $ci = $info->{$name};
    @id_list = grep(/$valid_id_exp/, keys(%$ci));
}

###
# Get information about each CPU.
#
#   Collect list of all CPUs in @cpu_list array
#
#   Construct %cpu_list hash keyed by CPU ID with cpu_info kstat hash as its
#   value.
#
#   Construct %chips hash keyed by chip ID. It has to entries: cpus and cores.
#   The cpus is a reference to a list of CPU IDs within a chip. The cores is a
#   reference to a list of core IDs within a chip.
#
foreach my $id (nsort(keys %$cpu_info)) {
    my $info = $cpu_info->{$id};
    foreach my $name (keys %$info) {
	my $ci = $info->{$name};	# cpu_info kstat for specific CPU
	$cpu_list{$id} = $ci;
	my $chip_id = getinfo($ci, 'chip_id');
	# Collect CPUs within the chip
	push (@{$chips{$chip_id}->{cpus}}, $id) if defined $chip_id;
	push (@cpus, $id);
    }
}

##
# Figure oput what CPUs to examine.
# Look at specific CPUs if any are specified on the command line or at all CPUs
# CPU ranges specified in the command line are expanded into lists of CPUs
#
my @cpu_args = uniqsort(scalar @ARGV ? map { expand $_ } @ARGV : @cpus);

usage("must specify exactly one processor if -s used") if
    (($verbosity == 0) && (scalar @cpu_args != 1));

@cpu_args = intersect(\@cpu_args, \@cpus);
@cpus = @cpu_args;

##
# Look at all possible xxx_id properties and remove those that have NCPU values
# or one value. Sort the rest.
##
# Drop ids which have the same number of entries as number of CPUs
#
if ($phys_verbose) {
    my $ncpus = scalar @cpus;
    my @chips = property_list('chip_id', @cpus);
    my $nchips = scalar @chips;
    @id_list = grep {
	my @ids = property_list($_, @cpus);
	my $nids = scalar @ids;
	($_ eq "chip_id") ||
	  (($nids > $nchips) && ($nids > 1) && ($nids < $ncpus));
    } @id_list;
    ##
    # Sort @id_list by number of values in it.
    #
    @id_list = sort {
	my @left =  property_list($a, @cpus);
	my @right = property_list($b, @cpus);
	(scalar @left) <=> (scalar @right)
    } @id_list;

    $ptree = build_prop_tree(\@cpus, \@id_list);
}


# Walk all CPUs specified and print information about them.
# If phys_view is set, collect data to be printed later
foreach my $id (@cpu_args) {
    my $cpu = $cpu_list{$id} or next;	# silently ignore non-existing CPUs

    # Get CPU state and its modification time
    my $mtime = getinfo ($cpu, "state_begin");
    my $mstring = strftime "%m/%d/%Y %T", localtime($mtime);
    my $status = getinfo ($cpu, "state") || "unknown";

    if ($phys_view) {
	# Get list of physical processors spanning CPUs from the arguments.
	push (@chip_list, getinfo($cpu, "chip_id"));
    } elsif (! $verbosity) {
 	# Print 1 if CPU is online, 0 if offline.
	printf("%d\n", $status =~ /on-line/ ? 1 : 0);
    } elsif (! ($verbosity & 2)) {
	printf ("%d\t%-8s  since %s\n", $id, $status, $mstring);
    } else {
	my $fpu = getinfo($cpu, "fpu_type");
	my $fpu_prefix = ($fpu =~ /^[aeiouy]/) ? "an" : "a";
	print "Status of virtual processor $id as of: ";
	print strftime("%m/%d/%Y %T", localtime());
	print "\n";
	print "  $status since $mstring.\n";
	print "  The ", getinfo ($cpu, "cpu_type"), " processor operates at ",
	  getinfo ($cpu, "clock_MHz"), " MHz,\n";
	print "\tand has $fpu_prefix $fpu floating point processor.\n";
    }
}

# Remove duplicates from the chip list.
@chip_list = uniqsort @chip_list;

# Physical view print
if ($phys_view) {
    if ($verbosity == 1) {
	print scalar @chip_list, "\n";
    } elsif ($verbosity == 0) {
	# Print 1 if all CPUs are online, 0 otherwise.
	foreach my $chip_id (@chip_list) {
	    # Get CPUs on a chip
	    my @chip_cpus = uniqsort @{$chips{$chip_id}->{cpus}};
	    # List of all on-line CPUs on a chip
	    my @online_cpus = grep {getinfo ($_, "state") =~ /on-line/ }
	      map { $cpu_list{$_} } @chip_cpus;

	    # Print 1 if number of online CPUs equals number of all CPUs
	    printf("%d\n", scalar @online_cpus == scalar @chip_cpus);
	}
    } else {
	# Walk the property tree and print everything in it.
	my $tcores = $ptree->{values};
	my $cname = id_translate($ptree->{name});
	foreach my $chip (nsort keys %$tcores) {
	    my $chipref = $tcores->{$chip};
	    my @chip_cpus = @{$chipref->{cpus}};
	    my $ncpus = scalar @chip_cpus;
	    my $cpu_id = $chip_cpus[0];
	    my $cpu = $cpu_list{$cpu_id};
	    my $brand = getinfo ($cpu, "brand");
	    my $impl = getinfo ($cpu, "implementation");
	    # Remove cpuid and chipid information from implementation string
	    # and print it.
	    $impl =~ s/(cpuid|chipid)\s*\w+\s+// if $impl;
	    $brand = '' unless defined $brand;
	    $brand = '' if $impl && $impl =~ /^$brand/;
	    # List of CPUs on a chip
	    my $cpu_name = plurize("processor", $ncpus);
	    # Collapse range of CPUs into a-b string
	    my $cl = collapse(@chip_cpus);
	    my $childname = $chipref->{name};
	    if (! $childname) {
		print "The $cname has $ncpus ";
		print "virtual $cpu_name ($cl)\n";
		print "  $impl\n" if $impl;
		print "\t$brand\n" if $brand;
	    } else {
		# Get child count
		my $nchildren = scalar(keys(%{$chipref->{values}}));
		$childname = plurize(id_translate($childname), $nchildren);
		print "The $cname has $nchildren $childname";
		print " and $ncpus virtual $cpu_name ($cl)\n";
		my $ident = print_prop_tree ($chipref, 2);
		my $spaces = ' ' x $ident;
		print "$spaces$impl\n" if $impl;
		print "$spaces  $brand\n" if $brand;
	    }
	}
    }
}

exit 0;

######################################################################
# Pod section is a copy of psrinfo(1M) man page.
##
=pod

=head1 NAME

psrinfo - displays information about processors

=head1 SYNOPSYS

  psrinfo [-p] [-v] [processor_id...]

  psrinfo [-p] -s processor_id

=head1 DESCRIPTION

psrinfo displays information about processors. Each physical processor may
support multiple virtual processors. Each virtual processor is an entity with
its own interrupt ID, capable of executing independent threads.

Without the processor_id operand, psrinfo displays one line for each configured
processor, displaying whether it is on-line, non-interruptible (designated by
no-intr), spare, off-line, faulted or powered off, and when that status last
changed. Use the processor_id operand to display information about a specific
processor. See OPERANDS.

=head1 OPTIONS

The following options are supported:

=over

=item -s processor_id

Silent mode. Displays 1 if the specified processor is fully on-line. Displays 0
if the specified processor is non- interruptible, spare, off-line, faulted or
powered off.

Use silent mode when using psrinfo in shell scripts.

=item -p

Display the number of physical processors in a system.

When combined with the -v option, reports additional information about each
physical processor.

=item -v

Verbose mode. Displays additional informa- tion about the specified processors,
including: processor type, floating point unit type and clock speed. If any of
this information cannot be determined, psrinfo displays unknown.

When combined with the -p option, reports additional information about each
physical processor. On systems with multiple cores per chip, reports information
about each core if the core information is provided by the OS in the core_id
field of the cpu_info kstat.

=back

=head1 OPERANDS

The following operands are supported:

=over

=item C<processor_id>

The processor ID of the processor about which information is to be displayed.

Specify processor_id as an individual processor number (for example, 3),
multiple processor numbers separated by spaces (for example, 1 2 3), or a range
of processor numbers (for example, 1-4). It is also possible to combine ranges
and (individual or multiple) processor_ids (for example, 1-3 5 7-8 9).

=back

=head1 EXIT STATUS

The following exit values are returned:

=over

=item 0

Successful completion.

=item >0

An error occurred.

=back

=head1 SEE ALSO

L<psrinfo(1M)>, L<psradm(1M)>, L<p_online(2)>, L<processor_info(2)>

=cut