#!/devtool/local/bin/perl
# @(#) sutsingle   6.1.1   1994-10-27   kern   admin
#
# Eine Liste von Teststromnamen wird vom Standard-Input
# eingelesen und fuer jedes Element wird das bestehende Protokoll
# mit dem aktuell dazu passenden :punix/typunx/uunix/upnix etc.
# verglichen. Nützlich, wenn man Globaländerungen (Page count o.ä.)
# in punix/tpunx... macht und dann die existierenden Protokolle
# damit vergleichen will. E.Z. 15.11.99
#
# Aenderungen:
#
#
#    ========== licence begin  GPL
#    Copyright (C) 2001 SAP AG
#
#    This program is free software; you can redistribute it and/or
#    modify it under the terms of the GNU General Public License
#    as published by the Free Software Foundation; either version 2
#    of the License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#    ========== licence end
#

use Env;
use File::Basename;
use File::Copy;
use Carp;
use Cwd;
use FileHandle;
use ToolLib;
use DBTools;
use scriptex;
use IO::Handle;
require "hostname.pl";
do "$TOOL/bin/sutvars$TOOLEXT";

# forces a flush after every write or print
$| = 1;


#unlink ($DbmcliProt);
#unlink ($DbmcliOutput);


$USAGE = "usage: sutsingle [-stack] version program [dbname] teststream.vdnts, ... \n";
if  ( @ARGV < 2 ) { print "$USAGE"; exit 1 }

die "teststreams have to named with the extension '.vdnts'"
    if ( $ARGV[$#ARGV] !~ /.+\.vdnts/ );

chdir($SUT) || die "Can't change to directory $SUT: $!";

CreateDebuggerInput();

my $stack_test;
if ( $ARGV[0] =~ /-stack/i) { shift; $stack_test = 1; }
my $VERSION = shift;
my $PROGRAM = shift;
my $DBPROG;
my $SUTOPTION;
$PROGRAM .= $PROG_EXT if $PROGRAM !~ /^.+$PROG_EXT$/;
my $PVERS = substr($VERSION, 0, 1);
my $PROG = "$DBROOT/pgm/$PROGRAM";

$DBNAME = shift
    if ( $ARGV[0] !~ /.+\.vdnts/i );

croak "ERROR: name of the database is not defined!\n" if !$DBNAME;

$_ = $VERSION;
CASE:
{
    if (/^fast$/i) {
        $DBPROG = "$DBROOT/pgm/kernel$PROG_EXT";
        $SUTOPTION = "-fast";
        last CASE
    }

    if (/^slow$/i) {
        $DBPROG = "$DBROOT/pgm/slowknl$PROG_EXT";
        $SUTOPTION = "-slow";
        last CASE
    }

    if (/^quick$/i) {
        $DBPROG = "$DBROOT/pgm/quickknl$PROG_EXT";
        $SUTOPTION = "-quick";
        last CASE
    }
    print "$USAGE";
    print "version: fast|quick|slow\n";
    exit 1;
} # CASE
die "can't find $DBPROG\n"           if ( ! -f $DBPROG );
die "program $PROG not executable\n" if ( ! -x $PROG   );

$LEVEL = ToolLib::GetConnectLevel();

# ermittle $ProtDir in Abhängigkeit von $VERSION, $DBUNICODE,
# $DEFCODE und $LEVEL

$ProtDir = lc $VERSION;
$ProtDir = "lvl_$LEVEL" if ( $LEVEL != 1 );
if ( $DBUNICODE )
{
  $ProtDir = "dbuni";
  $ProtDir = "uni"    if ( $DEFCODE   =~ /^unicode$/i );
  $ProtDir = "xciuni" if ( $DBUNICODE =~ /^xci$/i );
}
$ProtDir = "stack" if $stack_test;
$ProtDir = "$SUT/$ProtDir";

$ENV{SUTOPTION} = $SUTOPTION;
$ENV{SERVERDB} = $DBNAME;

$DBBIGCMD ? ($Dbbigcmd=1) : ($Dbbigcmd=0);



$DEF_CODE = "ASCII";


#   Ermittle den Namen des Protokolls durch Aufruf des Programmes
#   und auflisten der dadurch erzeugten Datei.

$CI_PROT = ToolLib::ProtokollName($PROG);

( $TMP eq "" ) ? ($TMPDIR = "/tmp") : ($TMPDIR = $TMP);


$dir = dirname($KNLDIAG);
if ( $dir eq "." or $dir eq ".." ) { $DIAG = "$RUNDIR/$KNLDIAG" } else { $DIAG = $KNLDIAG }
$dir = dirname($KDUMP);
if ( $dir eq "." or $dir eq ".." ) { $DUMP = "$RUNDIR/$KDUMP" } else { $DUMP = $KDUMP }
if ($RELVER ne "R62")
{
    $dir = dirname($RDUMP);
    if ( $dir eq "." or $dir eq ".." ) { $RDMP = "$RUNDIR/$RDUMP" } else { $RDMP = $RDUMP }
}




# Note, that it is important to rename old style xuser files, too...
if ( -f "$HOME\\.XUSER"    ) { unlink "$HOME/.XUSER.sav"; rename("$HOME/.XUSER",    "$HOME/.XUSER.sav") }
if ( -f "$HOME\\.XUSER.62" ) { unlink "$HOME/.XUS62.sav"; rename("$HOME/.XUSER.62", "$HOME/.XUS62.sav") }

unlink "lock";
$DBHIF = $TERM;

print scalar localtime, "\n";
print " DBNAME  = $DBNAME";
print " \t\tProtDir = ".substr($ProtDir, length($SUT)+1)."\n";


#===================================================================
# Abarbeiten der Teststroeme
#===================================================================
# Die SUTs laufen mit einem vorgefertigten Paramfile

# transsize: 100 datasize: 400 code: ASCII archivesize: 200
my @TFNS = @ARGV;
foreach $TFN ( @TFNS )
{

    $TFN =~ s/\.vdnts//i;

    #   echo "analyze differences"

    $DIFFEXT = "punix";
    if ( $VERSION =~ /fast|quick/ ) { if ( -s "$TFN.tpunx" ) { $DIFFEXT = "tpunx" } }

    if ( $DBUNICODE =~ /^xci/i and  $DBLANG eq "" and -s "$TFN.cunix" )
    {
        # Unicode-Auftragsschnittstelle mit eigenem Referenzprotokoll...
        $DIFFEXT = "cunix";
    }
    else
    {
        if ( $DBUNICODE )
        {
            if ( $DEF_CODE eq UNICODE )
            {
                if         ( -s "$TFN.upnix" ) { $DIFFEXT = "upnix" }
                else { if  ( -s "$TFN.uunix" ) { $DIFFEXT = "uunix" } }
            }
            else { if  ( -s "$TFN.uunix" ) { $DIFFEXT = "uunix" } }
        }
    }

    if  ( -s "$TFN.$DIFFEXT" )
    {
        $DIFFRC = 0;
        $DIFFRC = system("$DIFF $TFN.$DIFFEXT $ProtDir/$TFN.prot > $ProtDir/$TFN.pdiff");
        if ( $DIFFRC != 0 )
        {
            $pdiff = "$ProtDir/$TFN.pdiff";
        }
    }

    if ( $DIFFEXT =~ /punix|tpunx/) { $DIFFEXT = "" }

    if  ( -s "$ProtDir/$TFN.pdiff" )
    {
        $CHARS = `$TOOL/Posix/wc -c < $ProtDir/$TFN.pdiff`; chomp $CHARS;
	}

    else
    {
        unlink "$ProtDir/$TFN.pdiff", "$ProtDir/$TFN.prot";
    }


} #while

if ( -f "$HOME/.XUSER.sav" ) { unlink "$HOME/.XUSER"   ; rename("$HOME/.XUSER.sav", "$HOME/.XUSER")    }
if ( -f "$HOME/.XUS62.sav" ) { unlink "$HOME/.XUSER.62"; rename("$HOME/.XUS62.sav", "$HOME/.XUSER.62") }

undef($SUTOPTION);


##################### END OF SUTSINGLE ###########################

##################################################################
sub install_paramfile {
}


##################################################################
sub CreateDebuggerInput
{
    my $fh;
    if ( $fh = new FileHandle "debuginput", "w" )
    {
        $DEBUG = "sdb";
        print $fh "t\nx\nq\n";
        $fh->close;
    }
}

##################################################################
sub DBCrash
{

    open(DIAG, "$DIAG");

    while(<DIAG>) {
    last if (  /=*begin of write cycle=*/ );
    }

    while(<DIAG>) {

    my @Columns = split(/ +/, $_);

    if ( $Columns[4] =~ /DBCRASH|EXCEPT/i ) {
        close (DIAG);
        return 1;
    }

    last if (  /-*current write position-*/ );
    }

    close(DIAG);

    return 0

}



#####################################################
sub runStdUndiff () {
    my ($diffScript, $protFile) = @_;

    if (-r $diffScript)
    {
        $scriptRC = scriptex::script ($diffScript, $protFile);
        if ($scriptRC != 0)
        {
            open PDIFF, ">>$protFile";
            print PDIFF "script ($diffScript, $protFile) failed with $scriptRC";
            close PDIFF;
        }
    }
}


__END__

