#!/usr/bin/perl
# @(#) sutsingle   6.1.1   1994-10-27   kern   admin
#
# Eine Liste von Teststromnamen wird vom Standard-Input
# eingelesen und fuer jedes Element das gewuenschte Programm
# aufgerufen. Das entstehende Protokoll mit einem als korrekt
# festgeschriebenen Protokoll verglichen.
#
# 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 Buildprefix;
use scriptex;
use Getopt::Std;
use Win32::Registry;
use Win32::Process;
require "hostname.pl";
do "$TOOL/bin/sutvars$TOOLEXT";

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


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


$USAGE = "usage: sutsingle [-n <node> -R <remote root>] [-stack | -pars] version program [dbname] teststream.vdnts, ... \n";

undef $opt_s;
undef $opt_n;
undef $opt_R;
undef $opt_p;
if (!getopts('s:n:R:p:')) {
  print $USAGE;
  exit (1);
}

if  ( @ARGV < 3 ) { 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: $!";

Buildprefix::set_buildprefix unless (defined $ENV{BUILDPRAEFIX});

$DrWtsnFile = "$WINDIR/drwtsn32.log";
unlink "$WINDIR/drwtsn32.bak";
rename("$WINDIR/drwtsn32.log", "$WINDIR/drwtsn32.bak");

$opt_n =~ s/^ *([^ ].*)/$1/ if ( $opt_n );
$opt_n ? $REMOTENODE = $opt_n : undef $REMOTENODE;

$opt_R =~ s/^ *([^ ].*)/$1/ if ( $opt_R );
$opt_R ? $REMOTEROOT = $opt_R : undef $REMOTEROOT;

$opt_s ? ($stack_test=1) : undef $stack_test;
$opt_p ? ($pars_ex_test=1) : undef $pars_ex_test;
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";
chomp ( local($local_host) = `hostname` );

$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 ( !$opt_n and !-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 = "xci"    if ( $DBUNICODE =~ /^xci$/i );
  $ProtDir = "alluni" if ( ( $DBUNICODE =~ /^xci$/i ) && ( $DEFCODE   =~ /^unicode$/i ) );
}
$ProtDir = "stack" if $stack_test;
$ProtDir = "pars_ex" if $pars_ex_test;
$ProtDir = "$SUT/$ProtDir";

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

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

DBTools::stop_db($DBNAME, undef, $REMOTENODE, $REMOTEROOT);

#   Ermittle ob die Variable DBUNICODE gesetzt ist
#   und setze danach den XPARAM Parameter. (not for Rel 6.1)

$DEF_CODE = "ASCII";

if ( ($RELVER ne "R61") && ($RELVER ne "R80") )
{
    if ( ! $DBUNICODE )
    {
        DBTools::PutParam($DBNAME, "_UNICODE", "NO", undef, $REMOTENODE, $REMOTEROOT);
        DBTools::PutParam($DBNAME, "DEFAULT_CODE", "ASCII", undef, $REMOTENODE, $REMOTEROOT);
    }
    else
    {
        DBTools::PutParam($DBNAME, "_UNICODE", "YES", undef, $REMOTENODE, $REMOTEROOT);
        ( $DEFCODE eq "" ) ? ($DEF_CODE="ASCII") : ($DEF_CODE=$DEFCODE);
    }
}

#   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);

# Variablen fuer DBNAME
if ($RELVER eq "R61")
{
    $RUNDIR  = DBTools::GetParam( $DBNAME, "RUNDIRECTORY");
    $OPMSG3  = DBTools::GetParam( $DBNAME, "DIAGFILE");
    $KDUMP   = DBTools::GetParam( $DBNAME, "KERNELDUMPFILE");
    $KNLDIAG = DBTools::GetParam( $DBNAME, "DIAGFILE");
}
else
{
    $RUNDIR  = DBTools::GetParam( $DBNAME, "RUNDIRECTORY", undef, $REMOTENODE, $REMOTEROOT);
    $OPMSG3  = DBTools::GetParam( $DBNAME, "_KERNELDIAGFILE", undef, $REMOTENODE, $REMOTEROOT);
    $KDUMP   = DBTools::GetParam( $DBNAME, "_KERNELDUMPFILE", undef, $REMOTENODE, $REMOTEROOT);
    $KNLDIAG = DBTools::GetParam( $DBNAME, "_KERNELDIAGFILE", undef, $REMOTENODE, $REMOTEROOT);
    $RDUMP   = DBTools::GetParam( $DBNAME, "_RTEDUMPFILE", undef, $REMOTENODE, $REMOTEROOT);
}

$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 }
}



DBTools::BCheck($DBNAME, $StdColdUser, $REMOTENODE, $REMOTEROOT);


# PTS 1108553
## 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";
if  ( $REMOTENODE ) {
    print " DBNAME  = $REMOTENODE:$DBNAME($REMOTEROOT)";
} else {
    print " DBNAME  = $DBNAME";
}
print " \tProtDir = ".substr($ProtDir, length($SUT)+1)."\tPID: $$\n";

if ( ! $REKURS )
{
    open(FILE_OUT, ">$AllCore"); close(FILE_OUT);
    open(FILE_OUT, ">$AllDiff"); close(FILE_OUT);
    open(FILE_OUT, ">$AllOk");   close(FILE_OUT);
}

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

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

    $TFN =~ s/\.vdnts//i;
    while ( -f "lock" ) { sleep 10 }

    if ( -f ".stop" ) { print "STOP request"; unlink(".stop" ); last }

    # fuer eine gleichmaessige Ausgabe in 'allsut'
    my $PTEST = $TFN." "x(14-length($TFN));

    if ( ! -f "$TFN.vdnts" )
    {
        open(FILE_OUT, ">>$AllSut");
        print FILE_OUT "NOT FOUND: $TFN.vdnts\n"; close(FILE_OUT);
        print "NOT FOUND: $TFN.vdnts\n";
        next;
    }

    # Ueberbleibsel des alten Testlaufs entfernen
    unlink <$RUNDIR/core*>, <*host*>, "shmcore", <*.HOST*>, $CI_PROT;
    unlink "$ProtDir/$TFN.core",  "$ProtDir/$TFN.dump", "$ProtDir/$TFN.rtedump";
    unlink "$ProtDir/$TFN.vprot", "$ProtDir/$TFN.prot", "$ProtDir/$TFN.pdiff";
    unlink "$ProtDir/$TFN.syserr";
    unlink "$ProtDir/$TFN.interrupt";
    unlink <$RMRUNDIR/cokernprotre*>;

    DBTools::PutParam($DBNAME, "_SERVERDB_FOR_SAP", "NO", undef, $REMOTENODE, $REMOTEROOT) if ( $RELVER eq "R72" );

    # Da einige Teststroeme ein spezielles Paramfile benoetigen
    # wird vor dem eigentlichen Lauf das entsprechende Paramfile
    # kopiert.

    CASE:
    {
    	if ( ($ENV{RELVER} lt "R74" ) || ( ($ENV{RELVER} eq "R74") && ($ENV{CORRECTION_LEVEL} < 4 ) ))
    	{
	        if ($TFN =~ /JOIN2TAB|LINKDDL|NIST3|USERTEST/i)
	        {
	            install_paramfile( EBCDIC );
	            last CASE;
	        }
	    }
        if ($TFN =~ /STAV|STAU|UPDSTAT/i)
        {
            install_paramfile( ASCII );
            last CASE;
        }
        if ( ($ENV{RELVER} lt "R72") && ($TFN =~ /SELFET1|SELFET2/i) )
        {
            File::Copy::copy("$RUNDIR/xinitdb.sav", "$RUNDIR/xinitdb.sav2");
            DBTools::PutParam($DBNAME, "_MAXSERVERDB", "1", undef, $REMOTENODE, $REMOTEROOT);

            $REKURS = "X"; $ENV{'REKURS'} = $REKURS;
            local $SaveProtDir = $ProtDir;
            local @ARGV = ($VERSION, "slowci$PROG_EXT", $DBNAME, "XINITDB.vdnts");

            do "$TOOL/bin/sutsingle$TOOLEXT";
            if ( $@ ) { die "Error while executing sutsingle:\n", "$@"; exit }

            $ProtDir = $SaveProtDir;
            undef($REKURS);

            last CASE;
         }
         if ( $TFN =~ /SAPR3|RECORD/i)
         {
            DBTools::PutParam($DBNAME, "_SERVERDB_FOR_SAP", "YES", undef, $REMOTENODE, $REMOTEROOT) if ($RELVER eq "R72");
            last CASE;
         }
    } #CASE


    CASE:
    {
        if ( $TFN =~ /^Y.*/ ) { $RESTORE = "YRESTORE"; last CASE; }
        if ( $TFN =~ /^W.*/ ) { $RESTORE = "WRESTORE"; last CASE; }
        $RESTORE = "XRESTORE";
    }

    if ( $Dbbigcmd != 0 )
    {
        # Um groessere SQL Kommandos zu erhalten werden durch
        # das XCI Kommando "BIGCMD <offset>" Blanks vor jedes
        # SQL  Kommando geschrieben.
        open(FILE_OUT, ">>$RESTORE.cmd");
        print FILE_OUT "BIGCMD $DBBIGCMD !\n"; close(FILE_OUT);
    }
    if ($RELVER ne "R61")
    {
        if ( $DBUNICODE =~ /^xci/i )
        {
            if ( $DBLANG ne "" )
            {
                # Da der XCI hier garantiert nur Zeichen aus dem ASCII-Subset der
                # entsprechenden Kodierung schickt, wird ihm mit TERMINAL ASCII
                # mitgeteilt, dass er bei der Ausgabe von UNICODE-Spalten nur
                # halb soviel Platz benoetigt, wie der Kern ihm mitteilt.
                open(FILE_OUT, ">>$RESTORE.cmd");
                print FILE_OUT "TERMINAL ASCII!\n"; close(FILE_OUT);
            }
            else
            {
                # Diese Kombination der Umgebungsvariablen sagt aus, dass
                # der XCI die Auftragsschnittstelle als Unicode-Client
                # bedienen soll. Das wird ihm durch Aufruf des Kommandos
                # TERMINAL UNICODE am Anfang eines Testlaufs mitgeteilt.
                open(FILE_OUT, ">>$RESTORE.cmd");
                print FILE_OUT "TERMINAL UNICODE!\n"; close(FILE_OUT);
            }
        }
    }
    if ( $DBUPDSTAT )
    {
        # Hier wird jetzt das Diagnose-Kommando abgesetzt, das den Kern
        # dazu bringt, beim UPDATE STATISTICS immer eine grosse Zahl als
        # Page-Anzahl einzutragen. Dadurch werden dann in der Strategie-
        # suche auch mal einige Indizes genommen statt immer nur Table Scan...
        local $tmp = "$TMP/REST$$";
        File::Copy::copy("$RESTORE.cmd", $tmp);
        open(FILE_OUT, ">$RESTORE.cmd"); open(FILE_IN, "<$tmp");
        while(<FILE_IN>)
        {
            print FILE_OUT $_;
            print FILE_OUT "DIAGNOSE OPTIMIZE UPDSTAT ON\n" if /autosave on/;
        }
        close(FILE_IN); close(FILE_OUT);
        unlink($tmp);
    }

    if ( $TFN =~ /^ENTRY/i )
    {
        unlink "$TFN.ori"; rename("$TFN.vdnts", "$TFN.ori") || warn "Can't rename $TFN.vdnts to $TFN.ori: $!";
        open(FILE_IN, "<$TFN.ori" ); open(FILE_OUT, ">$TFN.vdnts" );
        local $dbname = uc($DBNAME);
        while(<FILE_IN>) {
            s/<serverdb>/$dbname/g;
            print FILE_OUT $_;
        }
        close(FILE_IN); close(FILE_OUT);
    }

    print " $PVERS $LEVEL $PTEST ___ ";

    if ($RELVER eq "R61") {
        DBTools::start_db($DBNAME, $DBPROG);
    } else {
        DBTools::start_db($DBNAME, $SUTOPTION, undef, $REMOTENODE, $REMOTEROOT);
    }

    print (scalar localtime);

    # create a watchdog process to avoid endless kernel loops
    # default time for watchdog set to 30 minutes
    $MaxSutDuration = $ENV{MAXSUTDURATION} ? $ENV{MAXSUTDURATION} : 2400;

    Win32::Process::Create($Proc, "$ENV{'TOOLSHELL'}", "perl $TOOL\\bin\\killsut.pl $DBNAME $ProtDir/$TFN.interrupt $MaxSutDuration",
        1, CREATE_DEFAULT_ERROR_MODE, ".") || die Win32::FormatMessage(Win32::GetLastError());

    if ($REMOTENODE) {
        system("$PROG -d $DBNAME -n $REMOTENODE -b $TFN.vdnts > $NULL");
    } else {
        system("$PROG -d $DBNAME -n $local_host -b $TFN.vdnts > $NULL");
    }

    # get rid of watchdog
    $Proc->Kill( 0 );

    # in case of a db core this speeds up the following stop command
    sleep 1;

    DBTools::stop_db($DBNAME, undef, $REMOTENODE, $REMOTEROOT);

    # Ausgabe der '...' zwischen 'slowci' und 'diff'
    print " ___ ";

    if (($RELVER ne "R61") and !$REMOTENODE)
    {
        if ( DBCrash () )
        {
            # Kern Absturz! Auswertung erfolgt später auf $RUNDIR/core_*
            if ( ! -e "$RUNDIR/core" ) {
                system("$TOOL/Posix/touch $RUNDIR/core_$TFN");
            }

        } #if
    }


    open(FILE_OUT, ">>$CI_PROT");
    print FILE_OUT " \n";  # .pibm have empty line beyond end
    close(FILE_OUT);

    if ($ENV{PURIFY}) {
        copyPurifyLog ($TFN);
    }


    # no stack test for remote sut
    if ( $stack_test and !$REMOTENODE )
    {

        system ( "$ENV{INSTROOT}/bin/xkernprot -d $DBNAME ax" );

        unlink "$ProtDir/$TFN.vprot", "$ProtDir/$TFN.s2", "$ProtDir/$TFN.s3", "$ProtDir/$TFN.sort";
        rename("$DBNAME.prt", "$ProtDir/$TFN.vprot");
        open(FILE_OUT, ">$ProtDir/$TFN.s2") || die "Can't open $ProtDir/$TFN.s2(output): $!\n";
        open(FILE_IN, "$ProtDir/$TFN.vprot") || die "Can't open $ProtDir/$TFN.vprot(input): $!\n";
        while(<FILE_IN>)
        {
             if ( /maxstack\s*:\s*(\d+)/ )
             {
                $help = $1;
                $i = $1;
                if ( length($help) eq 5 )
                {
                    $i = "0$1"
                }
                else
                {
                    if ( length($help) eq 4 )
                    {
                        $i = "00$1"
                    }
                }
                print FILE_OUT $i, " ", "$TFN:", $., "\n";
            }
        }
        close(FILE_IN); close(FILE_OUT);

        system("$TOOL/Posix/sort -o $ProtDir/$TFN.s3 -r $ProtDir/$TFN.s2");
        unlink "$ProtDir/$TFN.s2";

        open(FILE_IN, "$ProtDir/$TFN.s3") || die "Can't open $ProtDir/$TFN.s3(input): $!\n";
        open(FILE_OUT, ">$ProtDir/$TFN.sort") || die "Can't open $ProtDir/$TFN.sort(output): $!\n";
        while(<FILE_IN>)
        {
            if (41..eof()) { next }
            print FILE_OUT $_ ;
        }
        close(FILE_IN); close(FILE_OUT);
        unlink "$ProtDir/$TFN.s3";
        unlink "$ProtDir/$TFN.s2";

        @ARGV = ( $CI_PROT );
        do "$TOOL/bin/sed_stack$TOOLEXT";
        if ( $@ ) { die "Error while executing sed_stack:\n", "$@"; exit }

    }

    # Zuruecksetzen des Paramfiles
    install_paramfile( $DEF_CODE );


    #  Absturz des lokalen DB-Kerns:
    @CORE = <$RUNDIR/core*>;
    foreach $CORE (@CORE) {

        if ( ! -f $CORE ) { last }
        open(FILE_OUT, ">>$AllSut");
        print FILE_OUT ToolLib::Timestamp(1), "\t$PVERS $LEVEL $PTEST core$local\n"; close(FILE_OUT);
        open(FILE_OUT, ">>$AllCore");
        print FILE_OUT "$TFN.prot\n"; close(FILE_OUT);
        open(FILE_OUT, ">>$CI_PROT");
        print FILE_OUT "$TFN\n"; close(FILE_OUT);

        open(FILE_OUT, ">>$CI_PROT");
        # hier drwtsn32.log(d.h. $CORE) auswerten -> CI_PROT
        if ($RELVER ne "R61"){
            open(CORE, "$CORE");
            undef $printit, $printfunc;
            while(<CORE>) {
                if (/Application exception occurred|Stack Back Trace/) {
                    $printit = 1;
                    next;
                }
                if (/System Information|Raw Stack Dump|(State Dump for Thread)/) {
                    undef $printit;
                    print FILE_OUT if $1;
                    next;
                }
                if (/function:/) {
                    # fetch and print faulty function part
                    undef $printfunc;
                    undef @Func;
                    while (<CORE>) {
                        push @Func, $_;
                        $printfunc = 1 if /FAULT ->/;
                        if (/^$/) {
                            print FILE_OUT @Func if $printfunc;
                            last;
                        }
                    }
                }
            } continue {
                print FILE_OUT $_ if $printit;
            }
            close(CORE);
        }

        if (($RELVER ge "R76") && !(-r $DIAG)) {
            DBTools::GetDiagFile($DBNAME, $StdColdUser, $REMOTENODE, $REMOTEROOT,$DIAG);
        }

        if  ( -r $DIAG ) {
            print FILE_OUT "save $DIAG\n";
            open(DIAG, "$DIAG");
            while(<DIAG>) { print FILE_OUT $_ unless /^\s+$/ }
            close(DIAG);
        }
        close(FILE_OUT);

        if ( ! $DELSUTCORE ) {

           unlink "$ProtDir/$TFN.core", "$ProtDir/$TFN.dump", "$ProtDir/$TFN.rtedump";
           rename($CORE, "$ProtDir/$TFN.core") || warn "Can't rename $CORE to $ProtDir/$TFN.core: $!";
           rename($DUMP, "$ProtDir/$TFN.dump") || warn "Can't rename $DUMP to $ProtDir/$TFN.dump: $!";

       if ($RELVER ne "R61") {

               if ( -e "$RDMP" ) {
                   rename($RDMP, "$ProtDir/$TFN.rtedump") || warn "Can't rename $RDMP to $ProtDir/$TFN.rtedump: $!";
               }
       }
        }
    else
	{
           unlink $CORE, $DUMP;
           if ($RELVER ne "R61") { unlink $RDMP; }
           # Touchen eines dummys, der ein schnelleres erkennen
           # eines cores ermoeglicht!
           system("$TOOL/Posix/touch $ProtDir/$TFN.core");
           system("$TOOL/Posix/touch $ProtDir/$TFN.dump");
           system("$TOOL/Posix/touch $ProtDir/$TFN.rtedump");
        }
        $HASCORE = "local";

        # im Absturzfall VTRACE ziehen
        system ( "$ENV{INSTROOT}/bin/xkernprot -d $DBNAME akbx > $NULL" );
        unlink ("$ProtDir/$TFN.vprot");
        rename("$DBNAME.prt", "$ProtDir/$TFN.vprot");

    } #foreach


    # save some files to have a chance to analyze reason for
    # never ending sut if not already done by core handling
    if  ( (-f "$ProtDir/$TFN.interrupt") && (0 == @CORE) ) {

        # knldiag
        if  ( -r $DIAG ) {
            open(FILE_OUT, ">>$CI_PROT");
            print FILE_OUT "save $DIAG\n";
            open(DIAG, "$DIAG");
            while(<DIAG>) { print FILE_OUT $_ unless /^\s+$/ }
            close(DIAG);
            close(FILE_OUT);
        }

        # vtrace
        system ( "$ENV{INSTROOT}/bin/xkernprot -d $DBNAME akbx > $NULL" );
        unlink ("$ProtDir/$TFN.vprot");
        rename("$DBNAME.prt", "$ProtDir/$TFN.vprot");

        # dump
        rename($DUMP, "$ProtDir/$TFN.dump") if ( -e "$DUMP" );

        # rtedump
        rename($RDMP, "$ProtDir/$TFN.rtedump") if ( -e "$RDMP" );
    }


    if ( ($Dbbigcmd != 0) or $DBUPDSTAT or ($DBUNICODE =~ /^xci/i) ) {
        # jetzt wrid das XCI Kommando "BIGCMD <offset>"
        # wieder entfernt
        unlink "$RESTORE.tmp";
        rename("$RESTORE.cmd", "$RESTORE.tmp") || warn "Can't rename $RESTORE.cmd to $RESTORE.tmp: $!";
        open(FILE_IN, "<$RESTORE.tmp" ); open(FILE_OUT, ">$RESTORE.cmd" );
        while(<FILE_IN>) {
            next if /^(BIGCMD|TERMINAL|UPDSTAT ON)/;
            next if /UPDSTAT ON/;
            s/\* if rc/if rc/;
            print FILE_OUT $_;
        }
        close(FILE_IN); close(FILE_OUT);
        unlink  "$RESTORE.tmp";
    }


    #===============================================================
    #-------jetzt wird das Protokoll so verbogen, dass moeglichst viele
    #   der laestigen 'ewigen' Differenzen wegfallen (Datum, Zeit, ...)
    #===============================================================

    # We do this in a subshell to leave DBNAME undisturbed...
    @ARGV = ( "$CI_PROT", "$TMPDIR/$TFN.prot" );
    do "$TOOL/bin/sed_sut$TOOLEXT";
    if ( $@ ) { die "Error while executing sed_sut:\n", "$@"; exit }

    if  ( $LEVEL != 1 )
    {
        #  Aendern des Isolation-Levels auf 1; der urspruengliche I.L.
        #  ist nur noch anhand der Zeit der letzten Aenderung bzw. an
        #  der Directory, in der das Protokoll steht, zu erkennen.
        #  Diese Loesung war leider noetig, da 'diff' kein 'ignore'
        #  kennt.
        @ARGV = ( "$LEVEL", "$TMPDIR/$TFN.prot" );
        do "$TOOL/bin/sed_sut-lvl$TOOLEXT";
        if ( $@ ) { die "Error while executing sed_sut-lvl:\n", "$@"; exit }
    }

    if ( $TFN =~ /ENTRY/ )
    {
        unlink "$TFN.vdnts";
        rename "$TFN.ori", "$TFN.vdnts";
    }

    if ( $DBUNICODE )
    {
        # Aendern der Ausgaben, die aufgrund der nur 9 Byte langen
        # Identifier im 'UNICODE'-Lauf anders sind als im normalen
        # Lauf
        @ARGV = ( "$TMPDIR/$TFN.prot" );
        do "$TOOL/bin/sed_sut-uni$TOOLEXT";
        if ( $@ ) { die "Error while executing sed_sut-uni:\n", "$@"; exit }
    }


    unlink $CI_PROT;

    # Die Fehlerpositionen werden aus dem Protokoll entfernt.
    if ( $Dbbigcmd )
    {
        @ARGC = ( "$TMPDIR/$TFN.prot", "$TMPDIR/PROT" );
        do "$TOOL/bin/sed_term$TOOLEXT";
        if ( $@ ) { die "Error while executing sed_term:\n", "$@"; exit }
    }

    #   echo "analyze differences"

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

    if ( $DBUNICODE =~ /^xci/i and
         $DBLANG eq "" and
         $DEF_CODE eq UNICODE and
         -s "$TFN.cpnix" )
    {
        # Unicode-Auftragsschnittstelle mit eigenem Referenzprotokoll...
        $DIFFEXT = "cpnix";
    }
    else
    {
       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;
        if ( $Dbbigcmd )
        {
            @ARGV = ( "$TFN.$DIFFEXT", "$TMPDIR/PUNIX" );
            do "$TOOL/bin/sed_term$TOOLEXT";
            if ( $@ ) { die "Error while executing sed_term:\n", "$@"; exit }
            system("$DIFF $TMPDIR/PUNIX $TMPDIR/PROT > $ProtDir/$TFN.pdiff");
            $DIFFRC = $?;
            unlink "$TMPDIR/PUNIX", "$TMPDIR/PROT";
        }
        else
        {
            $DIFFRC = system("$DIFF $TFN.$DIFFEXT $TMPDIR/$TFN.prot > $ProtDir/$TFN.pdiff");
        }
        if ( $DIFFRC == 2 )
        {
            open(FILE_OUT, ">>$ProtDir/$TFN.pdiff");
            print FILE_OUT "DIFF-ERROR HAPPENED\n";
        }
        elsif ( $DIFFRC != 0 )
        {
            $pdiff = "$ProtDir/$TFN.pdiff";
if ( $ENV{BIT64} eq "1" )
{
            &runStdUndiff ('STDDIFF.diffscr', $pdiff);
}
            if (-s $pdiff) {
                &runStdUndiff ("$TFN.diffscr", $pdiff);
            }

            if ( $pars_ex_test ) {
                &runStdUndiff ("PARS.diffscr", $pdiff);
            }
        }
    }
    else
    {
        open(FILE_OUT, ">$ProtDir/$TFN.pdiff");
        # kein Protokoll zum Vergleichen da !
        print FILE_OUT "new test without protocol: $TFN\n";
    }

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

    if  ( -f "$ProtDir/$TFN.interrupt" ) {
        $Interrupted = "interrupted";
    } else {
        $Interrupted = " ";
    }

    if  ( -s "$ProtDir/$TFN.pdiff" )
    {
        open(DIFF_FILE,"<$ProtDir/$TFN.pdiff");
        while (<DIFF_FILE>) {
            if ( $_ =~ />.*ERROR\s*(-9\d{3}|-602)/ ) {
                system("$TOOL/Posix/touch $ProtDir/$TFN.syserr");
            }
        }
        close (DIFF_FILE);


        $CHARS = `$TOOL/Posix/wc -c < $ProtDir/$TFN.pdiff`; chomp $CHARS;
        open(FILE_OUT, ">>$AllSut");
        print FILE_OUT ToolLib::Timestamp(1), "\t$PVERS $LEVEL $PTEST * $CHARS $DIFFEXT $Interrupted\n";
        if ( -f "$ProtDir/$TFN.core" ) { print "core\n"; }
        else
        {
           print "diff  $CHARS characters $Interrupted\n";
        }

        open(FILE_OUT, ">>$AllDiff");
        print FILE_OUT "$TFN.pdiff $Interrupted", "\n";
        unlink "$ProtDir/$TFN.prot";
        rename("$TMPDIR/$TFN.prot", "$ProtDir/$TFN.prot") || warn "Can't rename $TMPDIR/$TFN.prot to $ProtDir/$TFN.prot: $!";
    }
    else
    {
        open(FILE_OUT, ">>$AllSut");
        print FILE_OUT ToolLib::Timestamp(1), "\t$PVERS $LEVEL $PTEST $DIFFEXT $Interrupted\n";
        if ( -f "$ProtDir/$TFN.core" )
        {
             print "core $Interrupted\n"
        }
        else { print "ok $Interrupted\n" }

        open(FILE_OUT, ">>$AllOk");
        print FILE_OUT ToolLib::Timestamp(1), "\t$PVERS $LEVEL $PTEST $Interrupted";
        unlink "$ProtDir/$TFN.pdiff", "$TMPDIR/$TFN.prot";
    }

    if ( ($ENV{RELVER} lt "R62") && ($TFN =~ /SELFET1|SELFET2/i) )
    {
        unlink("$RUNDIR/xinitdb.sav");
        rename("$RUNDIR/xinitdb.sav2", "$RUNDIR/xinitdb.sav");
        DBTools::PutParam($DBNAME, "_MAXSERVERDB", "2", undef, $REMOTENODE, $REMOTEROOT);
    }

    if ( ($TFN =~ /VZLCTEST/i) )
    {
        DBTools::PutParam($DBNAME, "INSTANCE_TYPE", "OLTP", undef, $REMOTENODE, $REMOTEROOT);
    }


} #while

# PTS 1108553
#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);
close(FILE_OUT);


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

##################################################################
sub install_paramfile {
    if ( ($RELVER ne "R61") && ($RELVER ne "R80") )
    {
        DBTools::PutParam($DBNAME, "DEFAULT_CODE", $_[0], undef, $REMOTENODE, $REMOTEROOT);
    }
}



##################################################################
sub DBCrash ()
{
    return DBTools::GetParam( $DBNAME, "_DIAG_SEM", undef, $REMOTENODE, $REMOTEROOT);
}


##################################################################
sub DrWtsnisDebugger
{

  my $db = shift;

  my $RegADA;
  my $debugger;

  my $DrWtsn = "DRWTSN32";

  return 0 if ($ENV{'RELVER'} eq "R61");

  $main::HKEY_LOCAL_MACHINE->Open("SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\AeDebug", $RegADA)
    || die "Cannot open registry key for default debugger!\n";
  $RegADA->QueryValueEx('Debugger', REG_EXPAND_SZ, $debugger)
    || die "Cannot find default debugger in the registry!\n";
  $RegADA->Close();

  if ( $debugger =~ /.*$DrWtsn.*/i ) {

      if ($ENV{'RELVER'} eq "R62")
      {
      if ($VERSION eq "fast") {
        $main::HKEY_LOCAL_MACHINE->Open("SYSTEM\\CurrentControlSet\\Services\\ADABAS-$db\\Parameters", $RegADA)
          || die "Cannot open registry key!\n";
      } else {
      $main::HKEY_LOCAL_MACHINE->Open("SYSTEM\\CurrentControlSet\\Services\\ADABAS-$db ($VERSION)\\Parameters", $RegADA)
          || die "Cannot open registry key!\n";

      }
      } else {

    if ($VERSION eq "fast") {
        $main::HKEY_LOCAL_MACHINE->Open("SYSTEM\\CurrentControlSet\\Services\\SAP DBTech-$db\\Parameters", $RegADA)
        || die "Cannot open registry key!\n";
    } else {
      $main::HKEY_LOCAL_MACHINE->Open("SYSTEM\\CurrentControlSet\\Services\\SAP DBTech-$db ($VERSION)\\Parameters", $RegADA)
          || die "Cannot open registry key!\n";

      }
    }

      $RegADA->QueryValueEx('Debugger', REG_EXPAND_SZ, $debugger)
      || die "Cannot find default debugger in the registry!\n";

      $RegADA->Close();

      return 1 if ( "$debugger" eq "$DrWtsn" );

  }

  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;
        }
    }
}

#####################################################
sub copyPurifyLog {
    my ($sutname) = @_;
    if (! -d purify) {
        mkdir purify, 0777;
    }
    File::Copy::copy ('purify.log', "purify/$sutname.purlog");
}

__END__

