Add inventory.pl to create system inventory in JSON.

This script creates the system inventory listing from
the system topology in the machine readable workbook XML.
It includes all of the FRUs, plus a few other entities that
aren't FRUs.  The Targets.pm module is used to traverse the
MRW XML.  Most of the work of the script is converting MRW
naming conventions to OpenBMC naming conventions.

Change-Id: I2e27dce923d7597bd6eee1dfe73d38aa4755a801
Signed-off-by: Matt Spinler <spinler@us.ibm.com>

1 files changed, 398 insertions, 0 deletions

diff --git a/inventory.pl b/inventory.pl
new file mode 100755
index 0000000..83d7766
--- /dev/null
+++ b/inventory.pl
@@ -0,0 +1,398 @@
+#!/usr/bin/env perl
+
+#Creates the OpenBMC inventory from ServerWiz output XML.
+#Basically, the inventory includes anything with a FRU name,
+#plus some other specific things we always look for since we
+#need more than just FRUs.
+
+
+use strict;
+use XML::Simple;
+use mrw::Targets;
+use Getopt::Long;
+use JSON;
+
+my $serverwizFile;
+my $outputFile, my $target;
+my $fruName, my $type;
+my @items, my %item, my %inventory;
+
+#Ensure we never pick these up
+my %skipFRUTypes = (OCC => 1);
+
+#We always want the targets with these Types
+my %includedTypes = ("CORE" => 1);
+
+#We always want the targets with these MRW Types
+my %includedTargetTypes = ("chip-sp-bmc" => 1,
+                           "chip-apss-psoc" => 1);
+
+#These are never considered FRUs
+my %notFRUTypes = ("CORE" => 1);
+
+GetOptions("x=s" => \$serverwizFile,
+           "o=s" => \$outputFile)
+or printUsage();
+
+if ((not defined $serverwizFile) || (not defined $outputFile)) {
+    printUsage();
+}
+
+my $targetObj = Targets->new;
+$targetObj->loadXML($serverwizFile);
+
+foreach $target (sort keys %{ $targetObj->getAllTargets() })
+{
+    $type = $targetObj->getType($target);
+    if (exists $skipFRUTypes{$type}) {
+        next;
+    }
+
+    $fruName = "";
+
+    if (!$targetObj->isBadAttribute($target, "FRU_NAME")) {
+        $fruName = $targetObj->getAttribute($target,"FRU_NAME");
+    }
+
+    my $targetType = $targetObj->getTargetType($target);
+
+    #We're looking for FRUs, and a few other required parts
+    if (($fruName ne "") || (exists $includedTargetTypes{$targetType}) ||
+        (exists $includedTypes{$type}))
+    {
+        $item{name} = $target;
+        $item{orig_name} = $target;
+        $item{fru_type} = $type;
+        $item{target_type} = $targetType;
+
+        if (($fruName ne "") && (not exists $notFRUTypes{$type})) {
+            $item{is_fru} = 1;
+        } else {
+            $item{is_fru} = 0;
+        }
+        push @items, { %item };
+    }
+
+}
+
+transform(\@items, \%inventory);
+
+#Encode in JSON and write it out
+my $json = JSON->new;
+$json->indent(1);
+$json->canonical(1);
+my $text = $json->encode(\%inventory);
+
+open(FILE, ">$outputFile") or die "Unable to create $outputFile\n";
+print FILE $text;
+close FILE;
+
+print "Created $outputFile\n";
+
+
+#Apply OpenBMC naming conventions to the Serverwiz names
+sub transform
+{
+    my $items = shift @_;
+    my $inventory = shift @_;
+
+    removeConnectors($items);
+
+    removeProcModule($items);
+
+    renameSegmentWithType("PROC", "cpu", $items);
+
+    renameSegmentWithType("SYS", "system", $items);
+    renameType("SYS", "SYSTEM", $items);
+
+    renameSegmentWithType("NODE", "chassis", $items);
+    renameType("NODE", "SYSTEM", $items);
+
+    renameSegmentWithTargetType("card-motherboard", "motherboard", $items);
+    renameTypeWithTargetType("card-motherboard", "MOTHERBOARD", $items);
+
+    renameType("FSP", "BMC", $items);
+
+    removeCoreParentChiplet($items);
+
+    removeInstNumIfOneInstPresent($items);
+
+    removeHyphensFromInstanceNum($items);
+
+    for my $i (@$items) {
+        my $name = "<inventory_root>".$i->{name};
+        delete $i->{name};
+        delete $i->{orig_name};
+        delete $i->{target_type};
+        $inventory{$name} = { %$i };
+    }
+}
+
+
+#Renames a segment in all target names based on its type
+#
+#For example:
+#    renameSegmentWithType("PROC", "foo", $items)
+#  would change
+#    /sys-0/node-0/motherboard-0/module-0/cpu/core0
+#  to
+#    /sys-0/node-0/motherboard-0/module-0/foo/core0
+#  assuming /sys-0/.../cpu had type PROC.
+sub renameSegmentWithType
+{
+    my $type = shift @_;
+    my $newSegment = shift @_;
+    my $items = shift @_;
+    my %segmentsToRename;
+
+    for my $item (@$items) {
+        my @segments = split('/', $item->{orig_name});
+        my $target = "";
+        for my $s (@segments) {
+            if (length($s) > 0) {
+                $target .= "/$s";
+                my $curType = "";
+                if (!$targetObj->isBadAttribute($target, "TYPE")) {
+                    $curType = $targetObj->getType($target);
+                }
+                if ($curType eq $type) {
+                    if (not defined $segmentsToRename{$target}) {
+                        my ($oldSegment) = $target =~ /\b(\w+)(-\d+)?$/;
+                        $segmentsToRename{$target}{old} = $oldSegment;
+                        $segmentsToRename{$target}{new} = $newSegment;
+                    }
+                }
+             }
+        }
+    }
+
+    for my $s (keys %segmentsToRename) {
+        for my $item (@$items) {
+            $item->{name} =~
+                s/$segmentsToRename{$s}{old}/$segmentsToRename{$s}{new}/;
+        }
+    }
+}
+
+
+#Renames a segment in all target names based on its target type
+#
+#For example:
+#    renameSegmentWithType("PROC", "foo", $items)
+#  would change
+#    /sys-0/node-0/motherboard-0/module-0/cpu/core0
+#  to
+#    /sys-0/node-0/motherboard-0/module-0/foo/core0
+#  assuming /sys-0/.../cpu had target type PROC.
+sub renameSegmentWithTargetType
+{
+    my $type = shift @_;
+    my $newSegment = shift @_;
+    my $items = shift @_;
+    my %segmentsToRename;
+
+    for my $item (@$items) {
+        my @segments = split('/', $item->{orig_name});
+        my $target = "";
+        for my $s (@segments) {
+            if (length($s) > 0) {
+                $target .= "/$s";
+                my $curType = $targetObj->getTargetType($target);
+                if ($curType eq $type) {
+                    if (not defined $segmentsToRename{$target}) {
+                        my ($oldSegment) = $target =~ /\b(\w+)(-\d+)?$/;
+                        $segmentsToRename{$target}{old} = $oldSegment;
+                        $segmentsToRename{$target}{new} = $newSegment;
+                    }
+                }
+             }
+        }
+    }
+
+    for my $s (keys %segmentsToRename) {
+        for my $item (@$items) {
+            $item->{name} =~
+                s/$segmentsToRename{$s}{old}/$segmentsToRename{$s}{new}/;
+        }
+    }
+}
+
+
+#Remove the core's parent chiplet, after moving
+#the chiplet's instance number to the core.
+#Note: Serverwiz always puts the core on a chiplet
+sub removeCoreParentChiplet
+{
+    my $items = shift @_;
+
+    for my $item (@$items) {
+        if ($item->{fru_type} eq "CORE") {
+            $item->{name} =~ s/\w+-(\d+)\/(\w+)-\d+$/$2-$1/;
+        }
+    }
+}
+
+
+#Remove path segments that are connectors
+sub removeConnectors
+{
+    my $items = shift @_;
+    my %connectors;
+    my $item;
+
+    for $item (@$items) {
+        my @segments = split('/', $item->{name});
+        my $target = "";
+        for my $s (@segments) {
+            if (length($s) > 0) {
+                $target .= "/$s";
+                my $class = $targetObj->getAttribute($target, "CLASS");
+                if ($class eq "CONNECTOR") {
+                    if (not exists $connectors{$target}) {
+                        $connectors{$target} = 1;
+                    }
+                }
+            }
+        }
+    }
+
+    #remove the connector segments out of the path
+    #Reverse sort so we start with connectors further out
+    for my $connector (sort {$b cmp $a} keys %connectors) {
+        for $item (@$items) {
+            if ($item->{name} =~ /$connector\b/) {
+                my ($inst) = $connector =~ /-(\d+)$/;
+                my ($card) = $item->{name};
+                $card =~ s/^$connector\///;
+
+                #add the connector instance to the child card
+                $card =~ s/^(\w+)-\d+/$1-$inst/;
+
+                #remove the connector segment from the path
+                my $base = $connector;
+                $base =~ s/\w+-\d+$//;
+                $item->{name} = $base . $card;
+            }
+        }
+    }
+}
+
+
+#Remove the processor module card from the path name.
+#Note: Serverwiz always outputs proc_socket-X/module-Y/proc.
+#      where proc_socket, module, and proc can be any name
+#      We already transormed it to module-X/proc.
+#      Our use requires proc-X.
+#      Note: No multichip modules in plan for OpenPower systems.
+sub removeProcModule
+{
+    my $items = shift @_;
+    my $procName = "";
+
+    #Find the name of the processor used in this model
+    for my $item (@$items) {
+        if ($item->{fru_type} eq "PROC") {
+            ($procName) = $item->{name} =~ /\b(\w+)$/;
+            last;
+        }
+    }
+
+    #Now remove it from every instance that it's a part of
+    if ($procName eq "") {
+        print "Could not find the name of the processor in this system\n";
+    } else {
+        for my $item (@$items) {
+            $item->{name} =~ s/\w+-(\d+)\/$procName/$procName-$1/;
+        }
+    }
+}
+
+
+sub renameType
+{
+    my $old = shift @_;
+    my $new = shift @_;
+    my $items = shift @_;
+
+    for my $item (@$items) {
+        $item->{fru_type} =~ s/$old/$new/;
+    }
+}
+
+
+sub renameTypeWithTargetType
+{
+    my $targetType = shift@_;
+    my $newType = shift @_;
+    my $items = shift @_;
+
+    for my $item (@$items) {
+        if ($item->{target_type} eq $targetType) {
+            $item->{fru_type} = $newType;
+        }
+    }
+}
+
+
+sub removeHyphensFromInstanceNum
+{
+    my $items = shift @_;
+
+    for my $item (@$items) {
+        $item->{name} =~ s/-(\d+)\b/$1/g;
+    }
+}
+
+
+sub renameSegment
+{
+    my $old = shift @_;
+    my $new = shift @_;
+    my $items = shift @_;
+
+    for my $item (@$items) {
+      $item->{name} =~ s/\b$old\b/$new/;
+    }
+}
+
+
+sub removeInstNumIfOneInstPresent
+{
+    my $items = shift @_;
+    my %instanceHash;
+    my $segment, my $item;
+
+    for $item (@$items) {
+        my @segments = split('/', $item->{name});
+
+        for $segment (@segments) {
+            my ($s, $inst) = $segment =~ /(\w+)-(\d+)/;
+            if (defined $s) {
+                if (not exists $instanceHash{$s}) {
+                    $instanceHash{$s}{inst} = $inst;
+                }
+                else {
+                    if ($instanceHash{$s}{inst} ne $inst) {
+                        $instanceHash{$s}{keep} = 1;
+                    }
+                }
+            }
+        }
+    }
+
+    for my $segment (keys %instanceHash) {
+
+        if (not exists $instanceHash{$segment}{keep}) {
+            for $item (@$items) {
+               $item->{name} =~ s/$segment-\d+/$segment/;
+            }
+        }
+    }
+}
+
+
+sub printUsage
+{
+    print "inventory.pl -x [XML filename] -o [output filename]\n";
+    exit(1);
+}