parse_cime.cs.status

#!/usr/bin/env perl
#=======================================================================
#
# Parse a cime5 cs.status file to give summary output
#
# Usage:
#
# ./parse_cime.cs.status <cs.status.id filename>
#
#  Erik Kluzek
#  Sep/19/2016
#
#=======================================================================
use Cwd;
use strict;
#use diagnostics;
use English;
use Getopt::Long;
use IO::File;

#-----------------------------------------------------------------------------------------------
# Set the directory that contains this scripts.  If the command was issued using a 
# relative or absolute path, that path is in $ProgDir.  Otherwise assume the
# command was issued from the current working directory.

sub GetNameNDir {
   (my $ProgName = $0) =~ s!(.*)/!!;      # name of this script
   my $ProgDir = $1;                      # name of directory containing this script -- may be a
                                          # relative or absolute path, or null if the script is in
                                          # the user's PATH
   my $cmdline = "@ARGV";                 # Command line arguments to script
   my $cwd = getcwd();                    # current working directory
   my $scrdir;                            # absolute pathname of directory that contains this script
   my $nm = "$ProgName::";                # name to use if script dies
   if ($ProgDir) { 
       $scrdir = absolute_path($ProgDir);
   } else {
       $scrdir = $cwd;
   }
   return( $ProgName, $scrdir );
}


#-----------------------------------------------------------------------------------------------

sub usage {
    my $ProgName = shift;
    die <<EOF;
SYNOPSIS
     $ProgName <cs.status file> [options]    
REQUIRED OPTIONS
     <cs.status files>              cime5 cs.status. file(s) that will be run and parsed
                                    At least one file needs to be given, but you can also
                                    give a list of space seperated files.
OPTIONS
     -die_on_duplicate              Die if find a duplicate testname
     -summarize [or -s]             Summarize results into lists of tests in categories (pend, pass, fail etc.)
     -sum_results_perline           Summarize results categories of each test into one line
     -help [or -h]                  Print usage to STDOUT.
     -verbose [or -v]               Make output more verbose.

-summarize and -sum_results_perline can NOT both be asked for as they contrdict each other.
EOF
}

#-----------------------------------------------------------------------------------------------


sub process_cmdline {
# Process command-line options.
   my $ProgName = shift;

   my %opts = ( 
                 csstatusfiles_ref => undef, 
                 sumintocats      => 0,
                 sumperline       => 0,
                 dieondup         => 0,
                 help             => 0, 
                 verbose          => 0,
              );

   GetOptions(
       "h|help"              => \$opts{'help'},
       "s|summarize"         => \$opts{'sumintocats'},
       "die_on_duplicate"    => \$opts{'dieondup'},
       "sum_results_perline" => \$opts{'sumperline'},
       "v|verbose"           => \$opts{'verbose'},
   )  or usage($ProgName);

   # Give usage message.
   usage($ProgName) if $opts{'help'};

   # If bad input
   if ( $opts{'sumintocats'} && $opts{'sumperline'} ) {
       print "ERROR: options -summarize and -sum_results_perline contradict each other, choose one or the other or neither\n";
       usage($ProgName);
   }

   # Get cs.status filenames
   $opts{'csstatusfiles_ref'} = \@ARGV;

   my $files_ref = $opts{'csstatusfiles_ref'};

   if ( $#$files_ref == -1 ) {
       print "ERROR: cs.status filename(s) was (were) NOT input\n";
       usage($ProgName);
   }

   foreach my $file ( @$files_ref ) {
      if ( ! -x $file ) {
          print "ERROR: cs.status filename does NOT exist: $file\n";
          usage($ProgName);
      }
   }

   return( %opts );
}

#-------------------------------------------------------------------------------

sub absolute_path {
#
# Convert a pathname into an absolute pathname, expanding any . or .. characters.
# Assumes pathnames refer to a local filesystem.
# Assumes the directory separator is "/".
#
  my $path = shift;
  my $cwd = getcwd();  # current working directory
  my $abspath;         # resulting absolute pathname

# Strip off any leading or trailing whitespace.  (This pattern won't match if
# there's embedded whitespace.
  $path =~ s!^\s*(\S*)\s*$!$1!;

# Convert relative to absolute path.

  if ($path =~ m!^\.$!) {          # path is "."
      return $cwd;
  } elsif ($path =~ m!^\./!) {     # path starts with "./"
      $path =~ s!^\.!$cwd!;
  } elsif ($path =~ m!^\.\.$!) {   # path is ".."
      $path = "$cwd/..";
  } elsif ($path =~ m!^\.\./!) {   # path starts with "../"
      $path = "$cwd/$path";
  } elsif ($path =~ m!^[^/]!) {    # path starts with non-slash character
      $path = "$cwd/$path";
  }

  my ($dir, @dirs2);
  my @dirs = split "/", $path, -1;   # The -1 prevents split from stripping trailing nulls
                                     # This enables correct processing of the input "/".

  # Remove any "" that are not leading.
  for (my $i=0; $i<=$#dirs; ++$i) {
      if ($i == 0 or $dirs[$i] ne "") {
          push @dirs2, $dirs[$i];
      }
  }
  @dirs = ();

  # Remove any "."
  foreach $dir (@dirs2) {
      unless ($dir eq ".") {
          push @dirs, $dir;
      }
  }
  @dirs2 = ();

  # Remove the "subdir/.." parts.
  foreach $dir (@dirs) {
    if ( $dir !~ /^\.\.$/ ) {
        push @dirs2, $dir;
    } else {
        pop @dirs2;   # remove previous dir when current dir is ..
    }
  }
  if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; }
  $abspath = join '/', @dirs2;
  return( $abspath );
}

sub run_csstatus {
   # run a cs.status file and parse it's output
   my ( $csstatusfilename, $verbose, $csstatus_ref, $dieondup ) = @_;

   if ( ! -x $csstatusfilename ) {
      die "ERROR: cs.status file does NOT exist or can not execute: $csstatusfilename\n";
   }
   my $csdate = undef;
   if ( $csstatusfilename =~ /cs.status.([0-9_]+)/ ) {
      $csdate = $1;
      chomp( $csdate );
   }
   if ( $verbose ) { print "Parse file: $csstatusfilename\n"; }
   my @lines = `$csstatusfilename`;
   while ( my $line = shift(@lines) ) {
      if ( $line =~ /([^ ]+) \(Overall: ([^ ,]+)\)/ ) {
         my $test = $1;
         my $over = $2;
         my $fails = ""; my $passes = ""; my $pendings = "";
         my $newline;
         my $bfail = 0;
         if ( $verbose ) { print "$test\n"; }
         do {
            $newline = shift(@lines);
            if (       $newline =~ /FAIL[ ]+$test ([^ ]+)/ ) {
               if ( $fails eq "" ) {
                  $fails = $1;
               } else {
                  $fails .= " $1";
               }
               chomp( $fails );
               if ( $1 eq "BASELINE" ) {
                 if ( $newline =~ /ERROR BFAIL baseline directory/ ) {
                    $bfail = 1;
                 }
               }
            } elsif (  $newline =~ /PASS[ ]+$test ([^ ]+)/ ) {
               $passes .= " $1";
               chomp( $passes );
            } elsif (  $newline =~ /PEND[ ]+$test ([^ ]+)/ ) {
               $pendings .= " $1";
               chomp( $pendings );
            } elsif ( (! $newline) || ($newline =~ /Overall:/) ) {
            } else {
               if ( $verbose ) { print "ERROR: parsing line: $newline\n"; }
            }
         } until ( (! $newline) || ($newline =~ /Overall:/) );
         if ( $newline ) {
            unshift( @lines, $newline );
         }
         if ( $over eq "NLFAIL" ) { 
            $over = "PASS";
         }
         elsif ( $over eq "NLCOMP" ) { 
            $over = "PASS";
         }
         elsif ( $over eq "DIFF" ) { 
            if ( $bfail ) {
               $over     = "FAIL_BDNE";
            } else {
               $over     = "DIFF";
            }
         }
         if ( exists($$csstatus_ref{$test}) ) { 
           if ( $dieondup ) {
             die "ERROR: Already had a test that matches this one: $test\n";
           }
           next; 
         }
         $$csstatus_ref{$test}{'over'} = $over;
         $$csstatus_ref{$test}{'FAIL'} = $fails;
         $$csstatus_ref{$test}{'PASS'} = $passes;
         $$csstatus_ref{$test}{'PEND'} = $pendings;
         if ( ! $newline ) { last; }
      } else {
         if ( $verbose ) { print( "WARNING: Didn't parse following line:\n$line" ); }
      }
   }

}

sub print_status {
   # Print status info for each test

   my %csstatus = @_;

   foreach my $key ( keys(%csstatus) ) {
      foreach my $type ( "PASS", "FAIL", "PEND" ) {
         if ( $csstatus{$key}{$type} ne "" ) {
            foreach my $phase ( split( / /, $csstatus{$key}{$type}) ) {
               if ( $phase =~ /[^ ]+/ ) {
                  printf( "%-10s %-90s %s\n", $type, $key, $phase );
               }
            }
         }
      }
   }
}

sub print_sumperline {
   # Print summary info for each test

   my %csstatus = @_;

   foreach my $key ( keys(%csstatus) ) {
      printf( "%-10s %-90s Passing: %s\n", $csstatus{$key}{'over'}, $key, $csstatus{$key}{'PASS'} );
      if ( $csstatus{$key}{'FAIL'} ne "" ) {
         printf( "%-10s %-90s %s\n", "FAIL", $key, $csstatus{$key}{'FAIL'} );
      }
      if ( $csstatus{$key}{'PEND'} ne "" ) {
         printf( "%-10s %-90s %s\n", "PEND", $key, $csstatus{$key}{'PEND'} );
      }
   }
}

sub expectedFails {
   # Query expected fail file for the input testname key
   my ($key, $message, @failfiles) = @_;
   my $expect = "";
   my $expectedfails = "";
   foreach my $expectedfailfile ( @failfiles ) {
      my $fh = IO::File->new($expectedfailfile, '<') or die "ERROR:: failure opening $expectedfailfile\n";
      while( my $line = <$fh> ) {
         if ( $line =~ /$key/ ) {
            $expect = $message;
            # Read past the testname until the test end is found...
            # Keep track of all of the expected fails and return it at the end
            while( my $testline = <$fh> ) {
               if ( $testline =~ /phase\s+name\s*=\s*\"([a-zA-Z0-9_]+)/ ) {
                  if ( $expectedfails eq "" ) {
                    $expectedfails = $1;
                  } else {
                    $expectedfails = "$expectedfails $1";
                  }
               }
               if ( $testline =~ /\<\/test\>/ ) { last; }
            }
         }
      }
   }
   return( $expect, $expectedfails );
}

sub print_categories {
   # Seperate tests into categories

   my $scrdir   = shift(@_);
   my %csstatus = @_;

   my $expectedfailfile = "$scrdir/components/clm/cime_config/testdefs/ExpectedTestFails.xml";
   if ( ! -f $expectedfailfile ) {
      $expectedfailfile = "$scrdir/cime_config/testdefs/ExpectedTestFails.xml";
   }
   my @failfiles = (  $expectedfailfile, "$scrdir/components/mizuRoute/cime_config/testdefs/ExpectedTestFails.xml" );
   my @passes;
   my @fails;
   my @pendings;
   my @compares_diff;
   my @compares_diff_nobase;
   my @keys = sort( keys(%csstatus) );
   foreach my $key ( @keys ) {
      if (      $csstatus{$key}{'over'} eq "PASS" ) {
         push( @passes, $key );
      } elsif ( $csstatus{$key}{'over'} eq "DIFF" ) {
         push( @passes, $key );
         push( @compares_diff, $key );
      } elsif ( $csstatus{$key}{'over'} eq "FAIL_BDNE" ) {
         push( @passes, $key );
         push( @compares_diff_nobase, $key );
      } elsif ( $csstatus{$key}{'over'} eq "FAIL" ) {
         push( @fails, $key );
      } elsif ( $csstatus{$key}{'over'} eq "PEND" ) {
         push( @pendings, $key );
      } else {
         print( "WARNING: unclassified overall status: $key, $csstatus{$key}{'over'}\n" );
      }
   }
   print( "================================================================================\n" );
   print( "Test summary\n" );
   printf( "%d Total tests\n",   $#keys+1 );
   printf( "%d Tests passed\n",  $#passes+1 );
   printf( "%d Tests compare different to baseline\n",  $#compares_diff+1 );
   printf( "%d Tests are new where there is no baseline\n",  $#compares_diff_nobase+1 );
   printf( "%d Tests pending\n", $#pendings+1 );
   printf( "%d Tests failed\n",  $#fails+1 );
   print( "================================================================================\n" );

   if ( $#passes >= 0 ) {
      print( "================================================================================\n" );
      print( "These tests passed\n" );
      print( "================================================================================\n" );
      foreach my $key ( @passes ) {
         my ($expect, $expectFails) = &expectedFails( $key, "FAILED PREVIOUSLY", @failfiles );
         if ( $expect ne "" ) { $expect = "$expect ($expectFails)"; }
         if ($expectFails =~ /BASELINE/ ) { $expect = ""; }
         print( "$key\t\t\t$expect\n" );
      }
   }
   if ( $#compares_diff >= 0 ) {
      print( "================================================================================\n" );
      print( "These tests compare different to the baseline\n" );
      print( "================================================================================\n" );
      foreach my $key ( @compares_diff ) {
         my ($expect, $expectFails) = &expectedFails( $key, "EXPECTED POSSIBILITY", @failfiles );
         if ($expectFails !~ /BASELINE/ ) { $expect = ""; }
         print( "$key\t\t$expect\n" );
      }
   }
   if ( $#compares_diff_nobase >= 0 ) {
      print( "================================================================================\n" );
      print( "These tests don't have a baseline to compare to\n" );
      print( "================================================================================\n" );
      foreach my $key ( @compares_diff_nobase ) {
         print( "$key\n" );
      }
   }
   if ( $#pendings >= 0 ) {
      print( "================================================================================\n" );
      print( "These tests are pending (some tests may fail in the pending state)\n" );
      print( "================================================================================\n" );
      foreach my $key ( @pendings ) {
         my ($expect, $expectFails) = &expectedFails( $key, "EXPECTED", @failfiles );
         if ( $expect ne "" ) { $expect = "$expect ($expectFails)"; }
         print( "$key\t\t$expect\n" );
      }
   }
   if ( $#fails >= 0 ) {
      print( "================================================================================\n" );
      print( "These tests failed\n" );
      print( "Test (what Failed) EXPECTED (what expected to fail)\n" );
      print( "================================================================================\n" );
      foreach my $key ( @fails ) {
         my ($expect, $expectFails) = &expectedFails( $key, "EXPECTED", @failfiles );
         if ( $expect ne "" ) { $expect = "$expect ($expectFails)"; }
         my $fails = $csstatus{$key}{'FAIL'};
         print( "$key\t($fails)\t\t$expect\n" );
      }
   }
}

#-----------------------------------------------------------------------------------------------

sub main {
# main subroutine
   my ($ProgName, $scrdir) = &GetNameNDir( );
   my $pwd = `pwd`;
   chomp( $pwd );
   my %opts = &process_cmdline( $ProgName );
   my %csstatus;
   my $files_ref = $opts{'csstatusfiles_ref'};
   foreach my $file ( @$files_ref ) {
      &run_csstatus( "$pwd/$file", $opts{'verbose'}, \%csstatus, $opts{'dieondup'} );
   }
   if ( $opts{'verbose'} ) {
      print "Print summary of testing:\n";
   }
   if (      $opts{'sumintocats'} ) {
      &print_categories( $scrdir, %csstatus );
   } elsif ( $opts{'sumperline'} ) {
      &print_sumperline( %csstatus );
   } else {
      &print_status( %csstatus );
   }
}

# Invoke the main subroutine
&main();