#!/devtool/local/bin/perl
#
#    NACHT.ALL.neu.pl - Performs a nightly make, new version.
#
#    @(#)NACHT.ALL.neu.pl     2003-02-24
#
#    U. Jansen, SAP AG - Original by F. Strassenburg, SAP AG
#
#    ========== licence begin LGPL
#    Copyright (C) 2002 SAP AG
#
#    This library is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser General Public
#    License as published by the Free Software Foundation; either
#    version 2.1 of the License, or (at your option) any later version.
#
#    This library 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
#    Lesser General Public License for more details.
#
#    You should have received a copy of the GNU Lesser General Public
#    License along with this library; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#    ========== licence end
#

################################################################################
# Includes:
################################################################################

unshift @INC, "$ENV{TOOL}/lib/Perl";

use strict;

use FileHandle;
use File::Path;
use File::Copy;
use Getopt::Long;
use XML::DOM;
use POSIX;
use qadb;
use imake;
use CCVers;
use BuildPackage::Vars;

################################################################################
# Globals:
################################################################################

my $RC              =   0;
my $Glob            =  {};
my $Check           =   0;
my @LocalTime       = localtime (time);
my $ProgramName     = "NACHT.ALL.neu";
my $Version         = "1.06";
my $VerDate         = "2003-03-19";

################################################################################
# Main routine:
################################################################################

#-------------------------------------------------------------------------------
# Basic settings
#-------------------------------------------------------------------------------

$Glob->{'MACHINE_CONFIG'} = $ENV{'MACHINE_CONFIG'};
$Glob->{'OWN'}            = $ENV{'OWN'};
$Glob->{'QA_ID'}          = 0;
$Glob->{'LC_POOL_ID'}     = 0;

#-------------------------------------------------------------------------------
# Console initialisation
#-------------------------------------------------------------------------------

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

#-------------------------------------------------------------------------------
# Read and check configuration (cmdline, machine info, env vars, xml-settings)
#-------------------------------------------------------------------------------

my $CMDParamHash = CheckCmdLineParams() or Usage();

HashRefToGlobVar ($CMDParamHash);

ProtHeader("Reading Makeprofile.xml (_default, $Glob->{'MACHINE_CONFIG'})");

FillPlatformHash("$Glob->{'OWN'}/sys/wrk/config/Nachtmake.xml", "_default");
FillPlatformHash("$Glob->{'OWN'}/sys/wrk/config/Nachtmake.xml", "$Glob->{'MACHINE_CONFIG'}");

HashRefToGlobVar ($CMDParamHash);

CheckConfigIntegrity();

#-------------------------------------------------------------------------------
# Prepare make phase
#-------------------------------------------------------------------------------

ProtHeader("Prepare make");

if ($Glob->{'SCRATCH_MAKE'} eq "1")
{
    chdir("$Glob->{'OWN'}");
    system("$Glob->{'DEL_CMD'} @{$Glob->{'DEL_TREE'}}");
}

mkpath (["$Glob->{'PROT_DIR'}"], 0, 0775);

if ($Glob->{'SCRATCH_MAKE'} eq "1")
{
    my $imf_exit;

    eval
    {
        $imf_exit = imf ( "config" ) ;
    };

    if ($@)
    {
        print STDERR "ERROR: parsing imf('config')!\n$@\n";
    }
    elsif ($imf_exit != 0)
    {
        print STDERR "ERROR: imf('config') returned with an error!\n$!\n";
    }
}

#-------------------------------------------------------------------------------
# Redirect STDOUT and STDERR
#-------------------------------------------------------------------------------

ProtHeader("Redirect STDOUT and STDERR");

if ($Check)
{
    print "redirection of STDOUT and STDERR\n";
}
else
{
    print "OUTPUT_FILTER: OPEN FILE $Glob->{'PROT_DIR'}$Glob->{'PATH_SEP'}$Glob->{'PROT_NAME'}\n";
}

#-------------------------------------------------------------------------------
# Creating new qadb entry
#-------------------------------------------------------------------------------

ProtHeader("Creating new qadb entry");
QADBCreateHandle();
QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{'SET_TOOL_CL'}, 'TOOLCL' => $Glob->{'TOOL_CHLIST'}}) if ($Glob->{'TOOL_CHLIST'} ne "");

#-------------------------------------------------------------------------------
# Final configuration
#-------------------------------------------------------------------------------

ProtHeader("Final configuration");
print "SCRIPT_VERSION   = $ProgramName v$Version ($VerDate)\n";
ShowHashRef($Glob);

#-------------------------------------------------------------------------------
# Store make id
#-------------------------------------------------------------------------------

ProtHeader("Store make id");
if ($Check) { print "makeid into $Glob->{'MAKEID_FILE'}\n" }
else        { WriteFileLine($Glob->{'MAKEID_FILE'}, $Glob->{'QA_ID'}) if (QADBCheckHandle()) }

#-------------------------------------------------------------------------------
# make process
#-------------------------------------------------------------------------------

ProtHeader("Start make");

#QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{'INIT_START'}});

$Glob->{'MAKE_RESULT'}      = 1;
$Glob->{'ARCH_PCR_RESULT'}  = 1;
$Glob->{'BUILDPKG_RESULT'}  = 1;

if ($Glob->{'CLI_32_BIT'} eq "1")
{
    MakeTarget("CLI32", "32 bit client", "MAKE_RESULT");
}
elsif ($Glob->{'PCR_32_BIT'} eq "1")
{
    MakeTarget("PCR32", "32 bit precompiler runtime library", "MAKE_RESULT");
}
else
{
    MakeTarget("SERVER", "liveCache/SAP DB", "MAKE_RESULT");
}

ProtHeader("End make");

#-------------------------------------------------------------------------------
# build packages
#-------------------------------------------------------------------------------

if ($Glob->{'MAKE_RESULT'})
{
    ProtHeader("Buildpackage");
    MakeTarget("BUILDPKG", "buildpackage", "BUILDPKG_RESULT");
}

#-------------------------------------------------------------------------------
# archive precompiler runtimes
#-------------------------------------------------------------------------------

if ($Glob->{'MAKE_RESULT'} and $Glob->{'BUILDPKG_RESULT'})
{
    ProtHeader("Archiving precompiler runtimes");
    MakeTarget("ARCH_PCR", "precompiler runtime archive", "ARCH_PCR_RESULT");
}

#-------------------------------------------------------------------------------
# Expand e0 files
#-------------------------------------------------------------------------------

ProtHeader("Expanding e0 file paths");

push @{$Glob->{'TARGETS_WITH_PATH'}}, ExpandPath("FAST", @{$Glob->{'MAKE_TARGETS_FAST'}});
push @{$Glob->{'TARGETS_WITH_PATH'}}, ExpandPath("FAST_32", @{$Glob->{'MAKE_TARGETS_32'}});
push @{$Glob->{'TARGETS_WITH_PATH'}}, ExpandPath("QUICK", @{$Glob->{'MAKE_TARGETS_QUICK'}});
push @{$Glob->{'TARGETS_WITH_PATH'}}, ExpandPath("SLOW", @{$Glob->{'MAKE_TARGETS_SLOW'}});

if ($Check)
{
    print "MAKE_TARGETS_FAST  = " . join(", ", @{$Glob->{'MAKE_TARGETS_FAST'}}) . "\n";
    print "MAKE_TARGETS_32    = " . join(", ", @{$Glob->{'MAKE_TARGETS_32'}}) . "\n";
    print "MAKE_TARGETS_QUICK = " . join(", ", @{$Glob->{'MAKE_TARGETS_QUICK'}}) . "\n";
    print "MAKE_TARGETS_SLOW  = " . join(", ", @{$Glob->{'MAKE_TARGETS_SLOW'}}) . "\n";
    print "TARGETS_WITH_PATH  = " . join(", ", @{$Glob->{'TARGETS_WITH_PATH'}}) . "\n";
}

#-------------------------------------------------------------------------------
# Send mail
#-------------------------------------------------------------------------------

ProtHeader("Sending mails");

if ( $Check )
{
    print "system ( checkmake ... )\n";
}
else
{
    my $ret = system("$ENV{TOOLSHELL}", "$ENV{'TOOL'}/bin/checkmake.pl", "-qaid", "$Glob->{'QA_ID'}", "-chlist",  "$Glob->{'CHLIST_NUM'}", @{$Glob->{'TARGETS_WITH_PATH'}});
    if (( !defined $ret ) and ( $ret != 0 ))
    {
        print STDERR "ERROR: file \"checkmake.pl\" failed\n";
    }
}

#-------------------------------------------------------------------------------
# update LC pool ID
#-------------------------------------------------------------------------------

ProtHeader("Get LC pool ID");

if ($Glob->{'MAKE_RESULT'} and $Glob->{'ARCH_PCR_RESULT'} and $Glob->{'BUILDPKG_RESULT'})
{
    $Glob->{'LC_POOL_ID'} = GetLCPoolID();
}
else
{
    $Glob->{'LC_POOL_ID'} = 0;
    print "Since there have been errors, LC_POOL_ID is set to 0.\n";
}

QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{'SET_LC_POOL_ID'}, 'LCPOOLID' => $Glob->{'LC_POOL_ID'}});

#-------------------------------------------------------------------------------
# Finalize QADB status
#-------------------------------------------------------------------------------

ProtHeader("Finalizing");

if ($Glob->{'MAKE_RESULT'} and $Glob->{'ARCH_PCR_RESULT'} and $Glob->{'BUILDPKG_RESULT'} and ($Glob->{'LC_POOL_ID'} =~ /^\d(\d)+$/))
{
    print "\nMAIN EXIT: Congratulations!!! No make errors occured!\n" ;

    if ($Glob->{'PCR_32_BIT'})
    {
        QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{'PCR_MAKE_OK'}});
    }
    else
    {
        QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{'MAKE_OK'}});
    }

    $Glob->{'MAIN_EXIT'} = 0;
}
else
{
    QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{'MAKE_NOT_OK'}});
    print "\nMAIN EXIT: ATTENTION---ERRORS---ATTENTION---ERRORS---ATTENTION\n" ;
    print "MAIN EXIT: MAKE=" . ($Glob->{'MAKE_RESULT'} ? "OK" : "NOT OK") . " PCR_ARCHIVE=" . ($Glob->{'ARCH_PCR_RESULT'} ? "OK" : "NOT OK") . " BUILDPACKAGE=" . ($Glob->{'BUILDPKG_RESULT'} ? "OK" : "NOT OK") . "\n" ;
    $Glob->{'MAIN_EXIT'} = 1;
}

#-------------------------------------------------------------------------------
# Resetting file output
#-------------------------------------------------------------------------------

if ($Check)
{
    print "Resetting file output\n";
}
else
{
    print "OUTPUT_FILTER: CLOSE FILE\n";
}

#-------------------------------------------------------------------------------
# Write make protocol into QADB
#-------------------------------------------------------------------------------

QADBWriteProt("$Glob->{'PROT_DIR'}$Glob->{'PATH_SEP'}$Glob->{'PROT_NAME'}", "$Glob->{'PROT_NAME'}", "Make Protocol (complete)");

#-------------------------------------------------------------------------------
# Results
#-------------------------------------------------------------------------------

ProtHeader("Final results");

if ($Check)
{
   print "main: \$MAKE_RESULT       = $Glob->{'MAKE_RESULT'}\n" ;
   print "main: \$ARCH_PCR_RESULT   = $Glob->{'ARCH_PCR_RESULT'}\n" ;
   print "main: \$BUILDPKG_RESULT   = $Glob->{'BUILDPKG_RESULT'}\n" ;
   print "main: \$MAIN_EXIT         = $Glob->{'MAIN_EXIT'}\n" ;
}


CleanExit($Glob->{'MAIN_EXIT'});

################################################################################
# CheckCmdLineParams() - Checks, if the correct cmdline parameters were given
################################################################################

sub CheckCmdLineParams
{
    my %Opts;
    my $hashref = {};

    ProtHeader ("Read and check command line parameters") ;

    if (!GetOptions( \%Opts, 'force_rm|scratch', 'cli_bit_32', 'pcr_bit_32', 'make_type=s', 'check', 'h|help|?') || $Opts{'h'})
    {
        return;
    }

    $hashref->{'SCRATCH_MAKE'}  = defined $Opts{'force_rm'}     ? "1" : "0";
    $hashref->{'CLI_32_BIT'}    = defined $Opts{'cli_bit_32'}   ? "1" : "0";
    $hashref->{'PCR_32_BIT'}    = defined $Opts{'pcr_bit_32'}   ? "1" : "0";
    $Check                      = defined $Opts{'check'}        ?  1  :  0;

    if (defined $Opts{'make_type'})
    {
        if (($Opts{'make_type'} eq 'OLTP')  or
            ($Opts{'make_type'} eq 'LC')    or
            ($Opts{'make_type'} eq 'LC_OLTP'))
        {
            $hashref->{'MAKE_TYPE'} = $Opts{'make_type'};
        }
        else
        {
            print STDERR "ERROR: Wrong make type >>>$Opts{'make_type'}<<<!\n";
            return;
        }
    }


    if ($Check)
    {
        ShowHashRef($hashref);
    }

    return($hashref);
}

################################################################################
# CheckConfigIntegrity() - Checks for errors in configuration.
################################################################################

sub CheckConfigIntegrity
{
    ProtHeader("Checking configuration integrity");

    if ($Glob->{'64_BIT_ONLY'} and $Glob->{'32_BIT_ONLY'})
    {
        print STDERR "ERROR: '64_BIT_ONLY' *AND* '32_BIT_ONLY' are set! This makes no sense...\n";
        CleanExit(1);
    }

    if ($Glob->{'CLI_32_BIT'} and $Glob->{'PCR_32_BIT'})
    {
        print STDERR "ERROR: '-cli_bit_32' *AND* '-pcr_bit_32' are set! This makes no sense...\n";
        CleanExit(1);
    }

    if ($Glob->{'64_BIT_ONLY'})
    {
        if ($Glob->{'32_BIT_ONLY'} or $Glob->{'CLI_32_BIT'} or $Glob->{'PCR_32_BIT'})
        {
            $Glob->{'32_BIT_ONLY'}  = "0";
            $Glob->{'CLI_32_BIT'}   = "0";
            $Glob->{'PCR_32_BIT'}   = "0";
            print "WARNING: No 32 bit client makes allowed.\n" ;
        }
    }
    elsif ($Glob->{'CLI_32_BIT'} or $Glob->{'PCR_32_BIT'})
    {
        $Glob->{'32_BIT_ONLY'} = "1";
    }

    if (!$Glob->{'32_BIT_ONLY'} and !$Glob->{'64_BIT_ONLY'})
    {
        push @{$Glob->{'DEL_TREE'}}, ("sys" . $Glob->{'PATH_SEP'} . "wrk32");
    }

    if ($Glob->{'REL_VER'} eq "")
    {
        print STDERR "ERROR: Wrong Release >>>$Glob->{'REL_VER'}<<<\n"; CleanExit(1);
    }

    if ($Check)
    {
        print "64_BIT_ONLY      = $Glob->{'64_BIT_ONLY'}\n";
        print "32_BIT_ONLY      = $Glob->{'32_BIT_ONLY'}\n";
        print "CLI_32_BIT       = $Glob->{'CLI_32_BIT'}\n";
        print "PCR_32_BIT       = $Glob->{'PCR_32_BIT'}\n";
        print "REL_VER          = $Glob->{'REL_VER'}\n";
        print "CORR_LEVEL       = $Glob->{'CORR_LEVEL'}\n";
        print "BUILD_PREFIX     = $Glob->{'BUILD_PREFIX'}\n";
        print "DEL_TREE         = " . join(", ", @{$Glob->{'DEL_TREE'}}) . "\n";
    }
}

################################################################################
# CleanExit() - Cleans up and exits the module.
################################################################################

sub CleanExit
{
    $RC = shift;

    goto PROGRAM_END;
}


################################################################################
# ExpandPath() - Takes a protocol array and adds paths to it.
################################################################################

sub ExpandPath
{
    my $arrname = shift;
    my @arr     = @_;
    my @erg     = ();

    foreach my $target (@arr)
    {
        push @erg, $Glob->{$arrname . '_PROT'} . $target . '.e0';
    }

    return @erg;
}

################################################################################
# FillPlatformHash() - Reads platform settings from a XML-File
################################################################################

sub FillPlatformHash
{
    my $XMLFile  = shift;
    my $platform = shift;
    my $node;
    my $parser   = new XML::DOM::Parser or return;
    my $doc      = $parser->parsefile($XMLFile) or return;

    foreach my $elem ($doc->getElementsByTagName("platform"))
    {
        if ($elem->getAttribute("id") eq $platform) { $node = $elem; last; }
    }

    return unless ($node);

    foreach my $elem ($node->getChildNodes())
    {
        if (($elem->getNodeType() == 1) and ($elem->getNodeName() eq "option"))
        {
            my $name = $elem->getAttribute("name");
            my $type = $elem->getAttribute("type");
            my $val  = $elem->getFirstChild()->getData();

            if      ($type eq "scalar") { $$Glob{$name} = $elem->getFirstChild()->getData() }
            elsif   ($type eq "array")
            {
                my @tmparr = split(/,/, $elem->getFirstChild()->getData());
                $Glob->{$name} = \@tmparr;
            }
            elsif   ($type eq "hash")
            {
                my %tmphash     = split(/,/, $elem->getFirstChild()->getData());
                $Glob->{$name}  = \%tmphash;
            }
            elsif ($type eq "strevl")
            {
                eval '$Glob->{$name} = "' . $elem->getFirstChild()->getData() . '";';
                if ($@) { print STDERR "XMLparse eval error: $@\n" }
            }
            elsif ($type eq "cmdevl")
            {
                eval '$Glob->{$name} = ' . $elem->getFirstChild()->getData() . ';';
                if ($@) { print STDERR "XMLparse eval error: $@\n" }
            }
            else { print STDERR "XMLparse type error: Unknown option format found ($name, $type, $val)\n" }
        }
    }
}

################################################################################
# GetLCPoolID() - Retrieves the correct LC pool ID
################################################################################

sub GetLCPoolID
{
    my $cmdstr;
    my $erg;

    if($^O=~/.*win32.*/i)
    {
        require WinLink;
        import WinLink;
        $erg = readLink ("$Glob->{'LB_SYM_LINK'}");
    }
    else
    {   $erg = readlink "$Glob->{'LB_SYM_LINK'}"; }

    if (!($erg > 0))
    {
        QADBWriteLog("ERROR: Fetching LC_POOL_ID failed! [File: '$Glob->{'LB_SYM_LINK'}']");
        $erg = 0;
        print STDERR "Fetching LC_POOL_ID failed! [File: '$Glob->{'LB_SYM_LINK'}']\n";
    }

    print "LB_SYM_LINK      = $Glob->{'LB_SYM_LINK'}\n";
    print "LC_POOL_ID       = $erg\n";

    return $erg;
}

################################################################################
# HashRefToGlobVar() - Copies a hash into the global variable.
################################################################################

sub HashRefToGlobVar
{
    my $hashref = shift;
    foreach (keys %{$hashref}) { $Glob->{$_} = $hashref->{$_} }
}

################################################################################
# MakeTarget() - Makes a target given as parameter
################################################################################

sub MakeTarget
{
    my $targetname  = shift;
    my $longname    = shift;
    my $resname     = shift;
    my $imf_erg     = 1;
    my $do_make;

    print "Making $longname...\n\n";
    QADBWriteLog("MAKE START: Make of '$longname' started.");

    QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{$targetname . '_MAKE_START'}});

    for (my $count = 1; $count <= $Glob->{$targetname . '_RUNS'}; $count ++)
    {
        $Glob->{$resname} = 1;

        my $last = ($count == $Glob->{$targetname . '_RUNS'}) ? 1 : 0;

        foreach my $trg (@{$Glob->{$targetname . "_PARTS"}})
        {
            my @opts    = @{$Glob->{$trg . "_OPT"}};
            my @targets = @{$Glob->{$trg . "_TRG"}};
            $do_make    = 0;

            eval ('$do_make = ' . "$opts[0];");

            if ($@)
            {
                print STDERR "ERROR: parsing '\$do_make' -> $@\n";
                $Glob->{$resname} = 0;
                QADBWriteLog("SCRIPT ERROR: Parse error while parsing make condition '$opts[0]'! [SEC='$longname', AFFECTED TARGETS='@targets', ERRORTEXT='$@']");
            }
            elsif ($do_make)
            {
                my $sharpmake = (defined $opts[3] ? ($opts[3] == 0 ? 0 : $last) : $last);

                if ($sharpmake)
                {
                    foreach my $target (@targets)
                    {
                        my $tmptrg = $target;
                        $tmptrg =~ s/://g;
                        unless ($tmptrg =~ /^-.*$/) { push @{$Glob->{$opts[2]}}, $tmptrg }
                    }
                }

                if ($Check)
                {
                    print "MAKE: $trg STEP: $count LAST: " . ($last ? "yes" : "no") . " SHARP: " . ($sharpmake ? "yes" : "no") . "\n";
                    print "CMD : '$opts[1](@targets)'\n";
                    print "$opts[2] = (" . join(", ", @{$Glob->{$opts[2]}}) . ")\n" if ($sharpmake);
                    $imf_erg = 0;
                    $Glob->{$resname} = 1;
                }
                else
                {
                    QADBWriteLog("START: '$opts[1](@targets)' started." . ($sharpmake ? "" : " (Errors will not be logged.)"));
                    print "Start making '$opts[1](@targets)'...\n";
                    eval ('$imf_erg = ' . "$opts[1]" . '(@targets);');
                    if ($@)
                    {
                        print STDERR "Make/Parse error ($opts[1](@targets)): $@\n";
                        $Glob->{$resname} = 0 if ($sharpmake);
                        QADBWriteLog("SCRIPT ERROR: Parse error while parsing make command '$opts[1]'! [SEC='$longname', AFFECTED TARGETS='@targets', ERRORTEXT='$@']") if ($sharpmake);
                    }
                    elsif($imf_erg != 0)
                    {
                        $Glob->{$resname} = 0 if ($sharpmake);
                        QADBWriteLog("ERROR: '$opts[1](@targets)' reported errors! [SEC='$longname', ERROR CODE='$imf_erg']") if ($sharpmake);
                        print "Make of '$opts[1](@targets)' *FAILED*!\n";
                    }
                    else
                    {
                        QADBWriteLog("SUCCESS: '$opts[1](@targets)' successfully finished.") if ($sharpmake);
                        print "Make of '$opts[1](@targets)' is OK.\n";
                    }
                }
            }
            else
            {
                QADBWriteLog("INFO: Skipping '$opts[1](@targets)' since make rule does not apply.");
                print "Skipping '$opts[1](@targets)' since make rule does not apply.\n";
            }
        }
    }

    QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{$targetname . '_MAKE_END'}});

    if ($Glob->{$resname})
    {
        QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{$targetname . '_MAKE_OK'}});
        QADBWriteLog("MAKE SUCCESS: Make of '$longname' was successful.");
        print "\nMake of $longname is OK!\n";
    }
    else
    {
        QADBUpdateCol({'IDOBJSTATUS' => $Glob->{'QA_STATUS'}->{$targetname . '_MAKE_NOT_OK'}});
        QADBWriteLog("MAKE ERROR: Make of '$longname' was not successful.");
        print STDERR "\nERROR: Can't build $longname!\n";
    }
}

################################################################################
# ProtHeader() - Prints a small protocol header to STDOUT.
################################################################################

sub ProtHeader
{
   my $prot_part = shift ;

   print "\n\n===========================================================\n" ;
   print "=   $prot_part\n" ;
   print "===========================================================\n\n" ;
}

################################################################################
# QADBCheckHandle() - Checks whether the QA handle is ok or not.
################################################################################

sub QADBCheckHandle
{
    if (($Glob->{'QAH'}->{'error_code'} != 0) or (!$Glob->{'QA_ID'}))
    {
        if ($Glob->{'QAH'}->{'error_code'} != 0)
        {
            print STDERR "ERROR: QADB got an error: '$Glob->{'QAH'}->{'error_text'}'\n" ;
        }
        else
        {
            print STDERR "ERROR: QADB handle is zero!\n";
        }

        QADBCreateHandle();

        if (($Glob->{'QAH'}->{'error_code'} != 0) or (!$Glob->{'QA_ID'}))
        {
        return 0;
        }
    }

    return 1;
}

################################################################################
# QADBCreateHandle() - Creates a new QADB handle
################################################################################

sub QADBCreateHandle
{
    # Create a new QADB handle:

    $Glob->{'QAH'} = undef;

    if ($Check)
    {
        if ($Glob->{'QA_ID'} > 0)
        {
            print "qadb -> new ( {'ID'        => \"$Glob->{'QA_ID'}\" } );\n";
        }
        else
        {
            print "qadb -> new ( {'VERSION'    => \"$Glob->{'REL_VER'}$Glob->{'CORR_LEVEL'}\" ,\n";
            print "               'BUILDPFX'   => \"$Glob->{'BUILD_PREFIX'}\" ,\n";
            print "               'QASTATUS'   => \"$Glob->{LC_STATE}\" ,\n";
            print "               'CHANGELIST' => \"$Glob->{'CHLIST_NUM'}\" ,\n";
            print "               'PLATFORM'   => \"$Glob->{'QADB_SYSNAME'}\" ,\n";
        }
    }
    else
    {
        if ($Glob->{'QA_ID'} > 0)
        {
            $Glob->{'QAH'} = qadb->new( {'ID'        => "$Glob->{'QA_ID'}" } );
        }
        else
        {
            $Glob->{'QAH'} = qadb->new( {'VERSION'    => "$Glob->{'REL_VER'}$Glob->{'CORR_LEVEL'}" ,
                                         'BUILDPFX'   => "$Glob->{'BUILD_PREFIX'}" ,
                                         'QASTATUS'   => "$Glob->{LC_STATE}" ,
                                         'CHANGELIST' => "$Glob->{'CHLIST_NUM'}" ,
                                         'PLATFORM'   => "$Glob->{'QADB_SYSNAME'}" });
        }

        $Glob->{'QA_ID'} = (($Glob->{'QAH'}->{'error_code'} == 0) ? $Glob->{'QAH'}->{'ID'} : 0);
    }
}

################################################################################
# QADBUpdateCol() - updates a column in the QADB
################################################################################

sub QADBUpdateCol
{
    my ($hash) = @_;

    if ($Check)
    {
        print "QADB ($Glob->{'QA_ID'}): updating col(s):\n";
        foreach my $key (keys %$hash) { print "    '$key' => '$hash->{$key}'\n"; }
        return;
    }

    if (QADBCheckHandle())
    {
        $Glob->{'QAH'}->update_columns($hash);
        QADBCheckHandle();
    }
    else
    {
        print STDERR "ERROR: Can't update QADB because of an open error\n" ;
    }
}

################################################################################
# QADBWriteLog() - writes a log entry into QADB
################################################################################

sub QADBWriteLog
{
    my $logtext = shift;

    if ($Check)
    {
        print "QADB ($Glob->{'QA_ID'}): writing log entry '$logtext'\n" ;
        return;
    }

    if (QADBCheckHandle())
    {
        $Glob->{'QAH'}->write_log($logtext);
        QADBCheckHandle();
    }
    else
    {
        print STDERR "ERROR: Can't write log entry because of an open error\n" ;
    }
}

################################################################################
# QADBWriteProt() - writes a protocol file into QADB
################################################################################

sub QADBWriteProt
{
    my $protpath = shift;
    my $protname = shift;
    my $showname = shift;

    if ($Check)
    {
        print "QADB ($Glob->{'QA_ID'}): writing protocol file '$protname'\n" ;
        return;
    }

    my $protocol = ReadFileLines($protpath, 0);

    if (QADBCheckHandle())
    {
        if ($showname)
        {
            $Glob->{'QAH'}->write_prot("$protname", $protocol, $showname);
        }
        else
        {
            $Glob->{'QAH'}->write_prot("$protname", $protocol);
        }
        QADBCheckHandle();
    }
    else
    {
        print STDERR "ERROR: Can't write protocol because of an open error\n" ;
    }
}

################################################################################
# ReadFileLines() - Reads [n] lines from a file
################################################################################

sub ReadFileLines
{
    my $file    = shift;
    my $lines   = shift;
    my $line    = 1;
    my $tmpvar;

    unless (open (IN_FILE, "<$file"))
    {
        print STDERR "ERROR: Can't open file '$file'!\n" ;
        return 0;
    }

    while (<IN_FILE>)
    {
        chomp $_;
        $tmpvar .= ($tmpvar eq "" ? "$_" : "\n$_");
        last if ($line == $lines);
        $line ++;
    }

    close (IN_FILE) or print STDERR "ERROR: Can't close file '$file'!\n$!\n";

    return $tmpvar;
}

################################################################################
# ShowHashRef() - Displays a hash reference on screen.
################################################################################

sub ShowHashRef
{
    my $ref = shift;

    foreach my $key (sort keys %{$ref})
    {
        if (ref($ref->{$key}) eq "ARRAY")
        {
            my $tmpstr = sprintf("%-16s = %s\n", $key, join(", ", @{$ref->{$key}}));
            print $tmpstr;
        }
        elsif (ref($ref->{$key}) eq "HASH")
        {
            my $tmpstr = sprintf("%-16s = HASH:\n", $key);
            print $tmpstr;
            foreach my $hkey (sort keys %{$ref->{$key}})
            {
                print "    $hkey => $ref->{$key}->{$hkey}\n";
            }
        }
        else
        {
            my $tmpstr = sprintf("%-16s = %s\n", $key, $ref->{$key});
            print $tmpstr;
        }
    }
}

################################################################################
# Usage() - Prints out the program usage and exits.
################################################################################

sub Usage
{
    print "usage: $0\n\n";
    print "       [-force_rm]\n" ;
    print "          initialise a scratch make\n\n" ;
    print "       [-cli_bit_32]\n" ;
    print "          make the 32 bit client package\n\n" ;
    print "       [-pcr_bit_32]\n" ;
    print "          make the 32 bit precompiler runtime library\n\n" ;
    print "       [-make_type=<OLTP | LC | LC_OLTP>]\n" ;
    print "          specifies the type of the make, default is LC_OLTP\n\n" ;
    print "       [-check]\n" ;
    print "          checks and shows only the workflow, don't execute anything\n\n" ;
    print "       [-help | -h]\n" ;
    print "          show this help message\n" ;

    CleanExit(1);
}

################################################################################
# WriteFileLine() - Writes a string into a file
################################################################################

sub WriteFileLine
{
    my ($file, $line) = @_;

    unless (open (OUT_FILE, ">$file"))
    {
        print "WARNING: Can't open file '$file' for writing!\n" ;
        return 0;
    }

    print OUT_FILE $line;
    close (OUT_FILE);
}

################################################################################

PROGRAM_END:

caller () ? return ( $RC ) : exit ( $RC );