#!/usr/local/bin/perl -w

package Elinfo;

sub new {
    bless { MINLEV  => undef,
            ATAB    => {} }, shift;
}

package main;

use English;
use Getopt::Long;
use XML::Parser;
use Config;

my $benchFailed=0;
format =
-------------------------
	@<<<<< bench failed
	$benchFailed
.

my $help = 0;
my $verboseLevel = 0;
my $root = $ENV{ROOT};
my $benchDir = $root . '/bench';
my $dataDir = $benchDir . '/data';
my $databaseFile = $dataDir . '/benchDb.xml';

my $os = 'linux';
my $version = '2_4';
my %filter = ();

my $maxSlept = 30;

my $indentCnt = 0;
my $indentInc = 2;
my $statusCol = 73;
my $lineLength = 0;
my $seenEOL = 1;

my $isLog = 0;
my $isGenerate = 0;

$Getopt::Long::ignorecase = 0;
die
    unless GetOptions("args=s" => \$extraArgs,
		      "databaseFile=s" => \$databaseFile,
		      "generate!" => \$isGenerate,
		      "help" => \$help,
		      "indent=i" => \$indentInc,
		      "log!" => \$isLog,
		      "filterName=s" => \$filter{'name'},
		      "os=s" => \$os,
		      "verbose=i" => \$verboseLevel,
		      "version=s" => \$version);

usage() if $help;

# Set destination directory:
if ($verboseLevel > 1) {
    printf "OS: $os\n";
}

# Severity enumeration:
# 0 - stop execution
# 1 - 
# 2 - 
# 3 - stop bench
# 4 - failure
# 5 - warning
# 6 - information
my @errors =
(
 {'code' => 0, svr => 6, usr => 0, msg => 'Really nothing!'},
 {'code' => 1, svr => 0, usr => 0, msg => 'reserved'},
 {'code' => 2, svr => 0, usr => 0, msg => 'reserved'},
 {'code' => 3, svr => 3, usr => 0, msg => 'reserved'},
 {'code' => 4, svr => 3, usr => 0, msg => 'reserved'},
 {'code' => 5, svr => 3, usr => 0, msg => 'Time elapsed!'},
 {'code' => 6, svr => 3, usr => 0, msg => 'Source file does not exist!'},
 {'code' => 7, svr => 3, usr => 0, msg => 'Destination file does not exist!'},
 {'code' => 8, svr => 4, usr => 1, msg => 'Snapshot is different than golden!'},
 {'code' => 9, svr => 4, usr => 1, msg => 'At least one bench failed!'},
 {'code' => 10, svr => 5, usr => 0, msg => 'Cannot read temporary file!'}
 );
my ($errn, $errt, $ie);
my $maxSvr = 10;
my $curSvr = $maxSvr;

my @Attrs;
my %Files = ();
my %Clos = ();
my $elementRoot;

my $subform = '      @<<<<<<<<<<<<<<<<<<<<<<<  @>>>>';

$databaseFile =$dataDir . '/' . $databaseFile unless -f $databaseFile;
die "Can't find file \"$databaseFile\"" unless -f $databaseFile;

doStart();

printEnv();

my $parser = new XML::Parser(ErrorContext => 2,
			     Handlers     => {Start      => \&start_handler,
					      End        => \&end_handler,
					      Char       => \&char_handler,
					      CdataStart => \&cdata_start,
					      CdataEnd   => \&cdata_end
					      }
			     );

$parser->parsefile($databaseFile);

doExit(0);

################
## End of main
################

#
#
#
sub start_handler
{
  my $xp = shift;
  my $currentElement = shift;		# innermost currently opened element
  my $element;
  my $parentEnable = 'true';
  my $parentAttrTable = 0;

  if (defined($xp->current_element)) {
    $parentAttrTable = $Attrs[$#Attrs];
    $parentEnable = $parentAttrTable->{'enable'};
  }

  # Create attributes:
  $attrTable = {};

  # Initialize attributes:
  if (($currentElement ne 'file') && ($currentElement ne 'clo')) {
    for $attr (keys %$parentAttrTable) {
      $attrTable->{$attr} = $parentAttrTable->{$attr};
    }
    $attrTable->{'enable'} = $parentEnable;
  }

  push @Attrs, $attrTable;
  
  # Update attributes:
  while (@_) {
    my $id = shift;
    my $val = shift;
    $val = $xp->xml_escape($val, "'");
    $attrTable->{$id} = $val;
  }

  return if ($currentElement eq 'class');
  
  if ($currentElement eq 'clo') {
    processStartClo($attrTable);
    return;
  }
  
  if ($currentElement eq 'file') {
    processStartFile($attrTable);
    return;
  }

  # Don't process if bench is disable:
  return if ($attrTable->{'enable'} ne 'true');

  # Process 'bench':
  if ($currentElement eq 'bench') {
    processStartBench($attrTable);
    return;
  }

  # Disable it, if filter{name} has been specified and there is no match:
  return if (defined($filter{'name'}) &&
	     ($element !~ m/(?:^|\/)$filter{'name'}(?:$|\/)/));

  # run the command
  processStartCmd($currentElement, $attrTable);
}

#
#
#
sub end_handler
{
  my $xp = shift;
  my $currentElement = shift;
  my $element = $currentElement;

  my $attrTable = pop @Attrs;
  my $parentAttrTable = 0;
  $parentAttrTable = $Attrs[$#Attrs] if (defined($xp->current_element));

  return if ($currentElement eq 'class');
  return if ($currentElement eq 'file');
  return if ($currentElement eq 'clo');
  return if ($attrTable->{'enable'} ne 'true');

  # Process 'bench':
  if ($currentElement eq 'bench') {
    processEndBench($parentAttrTable, $attrTable);
    return;
  }

  # Disable it, if filter{name} has been specified and there is no match:
  return if (defined($filter{'name'}) &&
	     ($element !~ m/(?:^|\/)$filter{'name'}(?:$|\/)/));

  # Process the command:
  processEndCmd($currentElement, $parentAttrTable, $attrTable);
}

#
sub char_handler
{
  my ($xp, $data) = @_;
}

#
sub cdata_start
{
  my $xp = shift;
}

#
sub cdata_end
{
  my $xp = shift;
}

#
sub showtab
{
  my ($title, $table, $dosum) = @_;
  my @list = sort keys %{$table};
  if (@list) {
    print "\n   $title:\n";
    my $item;
    my $sum = 0;
    foreach $item (@list) {
      my $cnt = $table->{$item};
      formline($subform, $item, $cnt);
      print $ACCUMULATOR, "\n";
      $ACCUMULATOR = '';
    }
    if ($dosum and @list > 1) {
      print  "                                =====\n";
      formline($subform, '', $sum);
      print $ACCUMULATOR, "\n";
      $ACCUMULATOR = '';
    }
  }
}

#
sub usage {
  printf "Usage: MakeHtmlPage [options]\n";
printf "  -args <args>\tset additional arguments to bench program
  -help\t\t\tprint this help message
  -verbose <level>\tset verbose level to <level> on
  -databaseFile <file>\tset database xml file to <file>
  -filterName <name>\tselect <name> bench (and sub benches).\n";
    
  exit(0);
}

#
sub processError
{
  my ($errCode, $errMsg, $attrTable) = @_;
  if (!$errors[$errCode]{usr} || $verboseLevel > 1) {
    printInfo("$errMsg", 1) if $errMsg;
    printInfo("$errors[$errCode]{msg}", 1);
  }
  my $svr = $errors[$errCode]{svr};
  $attrTable->{'status'} = 'failed' if ($svr <= 4);
  doExit($errCode) if ($svr == 0);
  return $svr;
}

#
sub printStatus
{
  my ($attrTable) = @_;
  printInfo("Bench status", 0) if ($seenEOL);
  my $statusIndentCnt = $statusCol - $lineLength;
  my $fmt = '%' . $statusIndentCnt . 's';
  my $spacing = sprintf($fmt, ' ');
  printInfo($spacing . $attrTable->{'status'}, 1);
}

#
sub doStart
{
  print scalar localtime; printf "\n";
}

#
sub doExit
{
  print scalar localtime; printf "\n";
  my $rc = shift;
  write() if ($verboseLevel > 1 && $benchFailed > 0);
  exit($rc);
}

#
sub printInfo
{
  my ($line, $endOfLine) = @_;
  return unless $verboseLevel;
    
  if ($seenEOL && $indentCnt) {
    my $fmt = '%' . $indentCnt . 's';
    printf ($fmt, ' ');
    $lineLength += $indentCnt;
  }
  print $line;
  if ($endOfLine) {
    printf "\n";	
    $seenEOL = 1;
    $lineLength = 0;
  } else {
    $seenEOL = 0;
    $lineLength += length $line;
  }
}

#
sub processStartClo
{
  my ($attrTable) = @_;
  printInfo("Adding comman line option $attrTable->{'name'}", 1)
    if ($verboseLevel > 1);
  $Clos{$attrTable->{'name'}} = $attrTable;
}

#
sub processStartFile
{
  my ($attrTable) = @_;
  return if ($curSvr <= 1);
  printInfo("Adding file $attrTable->{'name'}", 1) if ($verboseLevel > 1);
  $Files{$attrTable->{'name'}} = $attrTable;
}

#
sub processStartBench
{
  my ($attrTable) = @_;
  return if ($curSvr <= 1);
  printInfo("Performing bench", 1);
  $attrTable->{'status'} = 'passed';
  $indentCnt += $indentInc;	
}

#
sub processStartCmd
{
  my ($currentElement, $attrTable) = @_;
  return if ($curSvr <= 3);
  printInfo("Performing $currentElement ($attrTable->{'file'}) ", 0);
  $attrTable->{'status'} = 'unknow';
  $indentCnt += $indentInc;	

  my $fileAttrTable = $Files{$attrTable->{'file'}};
  my $filename = $fileAttrTable->{'name'};
  my $command = $currentElement;
  @args = ();
  push @args, $command;

  foreach $clo (keys %Clos) {
    $cmd = $Clos{$clo}->{'string'};
    push @args, $cmd . $fileAttrTable->{$clo}
      if exists($fileAttrTable->{$clo});
    push @args, $cmd . $attrTable->{$clo} if exists($attrTable->{$clo});
  }

  push @args, $extraArgs if defined($extraArgs);
  push @args, $filename;

  # print command
  printInfo("@args", 1) if ($verboseLevel > 1);
  printInfo('.', 0);

  printInfo("@args", 1);
  if (1) {
  $rc = 0xffff & system @args;
  print("system(%s) returned %#04x: ", "@args", $rc) if ($verboseLevel > 1);
  if ($rc == 0) {
    print("ran with normal exit\n") if ($verboseLevel > 1);
  } elsif ($rc == 0xff00) {
    print "command failed : $!\n";
  } elsif ($rc > 0x80) {
    $rc >>= 8;
    print "ran with non-zero exit status $rc\n";
  } else {
    print "ran with ";
    if ($rc & 0x80) {
      $rc &= ~0x80;
      print "coredump from ";
    }
    print "signal $rc\n";
  }
  $attrTable->{'status'} = ($rc == 0) ? 'passed' : 'failed';
  }

  printInfo("", 1) if ($verboseLevel > 1);
}

#
sub updateParentStatus
{
  my ($parentAttrTable, $attrTable) = @_;
  $parentAttrTable->{'status'} = 'failed'
    if ($attrTable->{'status'} eq 'failed');
  $parentAttrTable->{'status'} = 'unknow'
    if ($parentAttrTable->{'status'} eq 'passed') &&
    ($attrTable->{'status'} eq 'unknow');
}

#
sub processEndBench
{
  my ($parentAttrTable, $attrTable) = @_;
  return if ($curSvr < 1);
  printInfo("Analyzing bench ", 0) if ($verboseLevel > 2);
  printStatus($attrTable);
  updateParentStatus($parentAttrTable, $attrTable) if ($parentAttrTable);
  $curSvr = $maxSvr;
  $indentCnt -= $indentInc;
}

#
sub processEndCmd
{
  my ($currentElement, $parentAttrTable, $attrTable) = @_;
  return if ($curSvr < 3);
  printInfo("Analyzing $currentElement $attrTable->{'file'}", 1)
    if ($verboseLevel > 2);

  if ($attrTable->{'status'} ne 'failed') {
    # do something
  }
  
  printStatus($attrTable);
  updateParentStatus($parentAttrTable, $attrTable);

  $benchFailed++  if ($attrTable->{'status'}  eq 'failed');
  $indentCnt -= $indentInc;
  $curSvr = $maxSvr;
}

sub printEnv
{
  # Compiler
  # --------
  OS_SWITCH: {
      @infoLines = `cl -? 2>&1`, $compInfo = $infoLines[0], chop $compInfo,
        $compName = 'cl', last OS_SWITCH if $OSNAME =~ /MSWin32/;
      $compInfo = `gcc --version`, $compName = 'gcc',
        last OS_SWITCH if $OSNAME =~ /Linux/i;
      $compInfo = '', $compName = 'unrecognized';
  }
  printf("COMPILER NAME: $compName\n");
  printf("COMPILER INFO: $compInfo\n");

  # System
  # ------
  $sysInfo = `uname -a`;
  printf("OS NAME: $OSNAME\n");
  printf("OS INFO: $sysInfo\n");

  # Hardware
  # --------
  @cpus = ();
  $memSize = 'unknown';
  $gfxBoard = 'unknown';
  if ($OSNAME =~ /MSWin32/i) {
  } elsif ($OSNAME =~ /IRIX/i) {
    # Extract the information:
    @infoLines = `hinv`;

    # Initialize the fields
    $numCpus = 0;
    $cpuSpeed = 'unknown';
    $cpuType = 'unknown';
    $primDataCache = 'unknown';
    $secDataCache = 'unknown';
    $instCache = 'unknown';

    # Parse:
    for $record (@infoLines) {
      if ($record =~ /([^\s])+ ([^\s]+) MHZ ([^\s]+) Processor/) {
	$numCpus = $1;
	$cpuSpeed = $2;
	$cpuType = $3;
      } elsif ($record =~ /Data cache size:[\s]+([^\n]*)/) {
        $primDataCache = $1;
      } elsif ($record =~ /Secondary cache size:[\s]+([^\n]*)/) {
        $secDataCache = $1;
      } elsif ($record =~ /Instruction cache size:[\s]+([^\n]*)/) {
        $instCache = $1;
      } elsif ($record =~ /Graphics board:[\s]+([^\n]*)/) {
        $gfxBoard = $1;
      } elsif ($record =~ /Main memory size:[\s]+([^\n]*)/) {
        $memSize = $1;
      }
    }

    # Update:
    for $i (0 .. $numCpus-1) {
      $cpus[$i]{'cpuSpeed'} = $cpuSpeed;
      $cpus[$i]{'cpuType'} = $cpuType;
      $cpus[$i]{'primDataCache'} = $primDataCache;
      $cpus[$i]{'secDataCache'} = $secDataCache;
      $cpus[$i]{'instCache'} = $instCache;
    }
    
  } elsif ($OSNAME =~ /linux/i) {
    open CPUFILE, '/proc/cpuinfo' or die "Can't open file: /proc/cpuinfo\n";
    @infoLines = <CPUFILE>;
    close CPUFILE;

    for $record (@infoLines) {
      chop $record;
      if ($record =~ /processor[\s]*:[\s]+([^\s]+)/) {
	$i = $1;
	$cpus[$i]{'cpuSpeed'} = 0;
	$cpus[$i]{'cpuType'} = 0;
	$cpus[$i]{'primDataCache'} = 0;
	$cpus[$i]{'secDataCache'} = 0;
	$cpus[$i]{'instCache'} = 0;
      } elsif ($record =~ /cpu MHz[\s]*:[\s]+([^\s].*)/) {
	$cpus[$i]{'cpuSpeed'} = $1 . ' MHz';
      } elsif ($record =~ /model name[\s]*:[\s]+([^\s].*)/) {
	$cpus[$i]{'cpuType'} = $1;
      } elsif ($record =~ /cache size[\s]*:[\s]+([^\s].*)/) {
	$cpus[$i]{'primDataCache'} = $1;
      }
    }
    
    open MEMFILE, '/proc/meminfo' or die "Can't open file: /proc/meminfo\n";
    @infoLines = <MEMFILE>;
    close MEMFILE;
    for $record (@infoLines) {
      chop $record;
      if ($record =~ /Mem:[\s]+([^\s]+)/) {
        $memSize = int($1 / 1048576) . ' MBytes';
      }
    }
  } elsif ($OSNAME =~ /Solaris/i) {
#     Processor=`psrinfo -v | sed -n -e '1,4 s/.*The \(.*\)
#     processor operates at \(.*\),/\2 \1/p'`

#     Memory size=`prtconf -pv`:Memory.size[\s:]+(.*)

#     Instruction cache=0x`prtconf -pv`:icache-size Bytes
#     L1 data cache=0x`prtconf -pv`:dcache-size Bytes
#     L2 data cache=0x`prtconf -pv`:ecache-size Bytes    
  }

  for $i (0 .. $#cpus) {
    print "PROCESSOR: $i\n";
    print "CPU SPEED: $cpus[$i]{'cpuSpeed'}\n";
    print "CPU TYPE: $cpus[$i]{'cpuType'}\n";
    print "PRIMARY DATA CACHE: $cpus[$i]{'primDataCache'}\n";
    print "SECONDARY DATA CACHE: $cpus[$i]{'secDataCache'}\n";
    print "INSTRUCTION CACHE: $cpus[$i]{'instCache'}\n";
  }
	   
  print "MEM SIZE: $memSize\n";
  print "GFX BOARD: $gfxBoard\n";

  # CGAL version
  # ------------
  $cgalVersion = 'unknown';
  $cgalFile = "$ENV{CGALROOT}/include/CGAL/config.h";
  if (open CGALFILE, $cgalFile) {
    undef $/;			# input record separator
    $_ = <CGALFILE>;		# whole file
    if (/#define CGAL_VERSION\s+([^\s]+)/) {
      $cgalVersion = $1;
    }
  }
  print "CGAL VERSION: $cgalVersion\n";
 
  # LEDA version
  # ------------
  $ledaVersion = 'unknown';
  $ledaFile = "$ENV{LEDAROOT}/CHANGES";

  $cgalMakeFile = "$ENV{CGAL_MAKEFILE}";
  if (open CGALMAKEFILE, $cgalMakeFile) {
    undef $/;			# input record separator
    $_ = <CGALMAKEFILE>;	# whole file
    if (/^(.*LEDA)\/incl/) {
      $ledaFile = $1;
    }
    open LEDAFILE, $ledaFile or die "Can't open file: $ledaFile\n";
    undef $/;			# input record separator
    $_ = <LEDAFILE>;		# whole file
    if (/#define __LEDA__\s+([^\s]+)/) {
      $ledaVersion = $1;
    }
  }
  print "LEDA VERSION: $ledaVersion\n";

  # Qt version
  # ----------
  $qtVersion = 'unknown';
  $qtFile = "$ENV{QTROOT}/README";
  if (open QTFILE, $qtFile) { 
    undef $/;			# input record separator
    $_ = <QTFILE>;		# whole file
    if (/version\s+([^\s]+)/) {
      $qtVersion = $1;
    }
  }
  print "QT VERSION: $qtVersion\n";
}

# Tell Emacs that this is really a perl script
# Local Variables:
# mode:perl
# End: