#!/usr/local/bin/perl

#
# Copyright (c) 2002-2004 Eric Wallengren
# This file is part of the Continuous Automated Build and Integration
# Environment (CABIE)
#
# CABIE is distributed under the terms of the GNU General Public
# License version 2 or any later version.  See the file COPYING for copying
# permission or http://www.gnu.org.
#
# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED OR
# IMPLIED, without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  ANY USE IS AT YOUR OWN RISK.
#
# Permission to modify the code and to distribute modified code is granted,
# provided the above notices are retained, and a notice that the code was
# modified is included with the above copyright notice.
#

#
# Build script operations need to be handled differently
# on a non-posix system (Windows)
#
my $POSIX = 1;

my $ospackage;

#
# See if this is a windoz system...
#
if ($^O =~ /MSWin32/) {
    $POSIX = 0;
    $ospackage = "winsys";
} else {
    $ospackage = "unixsys";
}

my $verstring;

#
# Format string for build numbers...
#
format FORMATNUMBER =
@*
$verstring
.

#
# Build script called by the build server.
# 
# File descriptors:
#
#    SF     = Status File, logged output
#    TIMER  = start time of the build
#    REMOTE = .depots file in $top (remote perforce servers)
#

BEGIN{push @INC, "lib";}

# Globals...
use DBI;
use Bldsvr;
use Cwd;
use Mail::Sendmail;
use Sys::Hostname;
use Getopt::Std;
use File::Path;
use File::Find;
use File::Basename;
use IO::Handle;
use threads;

#
# Declarations for watchdog thread
#
my $watchthread;
my $threadnow;
my $threadaverage;

require "$ospackage.pm";

#
# Get name of the build server
#
my $hostname = hostname();
require "$hostname.pm";

#
# Grab configuration data from buildconf
#
my $config = new $hostname;
my $os     = new $ospackage;

use strict;
no  strict "refs";

#
# Get working directory
#
my $dir = cwd();
my $debug = 1;

#
# Readline line from errorfile
#
my $eline;

# Variables for reading from config file...
my $title;
my $port;
my $client;
my $top;
my $type;
my $currenttype;
my $logchange;
my $tools;
my $isimake;
my $keep;
my $comment;
my $sccs;
my $browserlink;

#
# Hash for storing names and locations of build scripts
#
my %scripthash;
my $script;

#
# Step to log in semaphores table
#
my $step = 0;

#
# Declare global job disk usage
#
my $usedspace = 0;

#
# Use for returns from system calls
#
my $shellret;

my $entry;
my $BuildNum;
my $old_fh;

my $_InitNum;

#
# For sccs abstractions...
#
my $sccscommand;

#
# For formatting of build numbers.
#
$config->PRN("0");          # $ProdRelNum
$config->BLDNUM("0");       # $BuildNumber
$config->LSTCHG("0");       # $lastchange
$config->RLCHG("0");        # $RealChange

#
# Initialize variables from buildconf
#
my $BSR        = $config->BSR;
my $JobDir     = $config->JOBDIR;
my $prebuild   = $config->PREBUILD;
my $postbuild  = $config->POSTBUILD;
my $onfail     = $config->ONFAIL;
my $nulldev    = $config->NULL;
my $p4user     = $config->P4USER;
my $p4pass     = $config->P4PASSWD;
my $updatejobs = $config->UPDATEJOBS;
my $bIncrement = $config->INCREMENT;
my $tested     = $config->TESTED;
my $nottested  = $config->NOTTESTED;

my $cvsjobno;
my @cvscmdarray;

my @JobDefinition;

my @maskarray;
my $maskline;

#
# See if theres a file with values to use as a mask 
# on filenames (since CVS doesn't handle updating
# modules). This will correct any filename submitted
# to SQL to utilize the source link from the genweb 
# command.
#
if (-f "$dir/config/maskfile.txt") {
    open (MASK, "<$dir/config/maskfile.txt");
    @maskarray = <MASK>;
    close(MASK);
}


my @empty;

#
# Add pwd/lib to include path...
#
unshift(@INC, "$dir/lib");

#
# Call CM broker 
#
use cmbroker;
my $cmbroker = new cmbroker;

#
# Vars for commandline args
#
my $BuildName;
my $BuildNum;
my $Debug;

my %Options;

getopts('n:j:d', \%Options);

$BuildName  = $Options{n};
$BuildNum   = $Options{j};
$Debug      = $Options{d};

#
# If we're running by hand (testing)...
#
if (!defined($BuildName)) {
    usage();
}

#
# Make separate temp dir for each job. This is handy for Windows
# when building multiple jobs simultaneously...
#
my $TmpDir = sprintf "%s/%s", $config->BTMP, $BuildName;
if (! -d "$TmpDir") {
    mkpath("$TmpDir", 0, 0755);
}

#
# Set both for windows incase we were launched from MKS or Cygnus
# but are using a M$ Compiler
#
$ENV{"TEMP"} = "$TmpDir";
$ENV{"TMP"}  = "$TmpDir";

my @ErrorArray;
my @ErrorExcludeArray;

#
# We need timers for statistics...
#
my $StartTime = $os->_get_hosttime();

# my $StartTime = time();

my $QueueFile       = "$BuildName.queue";

chdir $dir;

#
# See if there's a custom error file
#
if (! -f "$dir/config/$BuildName.errors") {
    
    #
    # Define a default error array where there's no error file
    #
    @ErrorArray = (
        "fatal error",
        "Fatal error",
        ": error",
        "1 error",
        "cannot resolve symbol",
        "Error while building files",
        "Name assignment wrong!",
        "** Error",
        "')' expected",
        "'(' expected",
        "Unexpected Error"
    );

} else {
    #
    # load error file
    #
    open (ERRORFILE, "<$dir/config/$BuildName.errors");
    while (<ERRORFILE>) {

        if ($_ =~ /^\!/) {
            $eline = $_;
            $eline =~ s/\!//g;
            push @ErrorExcludeArray, "$eline";
        } else {
            push @ErrorArray, "$_";
        }
    }
    close(ERRORFILE);
}

#
# Logger for debugging information...
#
if ($debug) {
    my $debuglogdir = $config->BTMP;
    open (DEBUGLOG, ">$debuglogdir/$BuildName.log") || 
          _notifyproblem("opening debuglog $? $!");
    DEBUGLOG->autoflush(1);
}

#
# Read configuration file...
#
if ((GetJobInfo()) == 1) {
    _debug ("no configuration information for $BuildName");
    exit 1;
}

#
# default configurations used for the build process
#
$title       = $JobDefinition[0];
$port        = $JobDefinition[1];
$client      = $JobDefinition[2];
$top         = $JobDefinition[3];
$type        = $JobDefinition[4];
$tools       = $JobDefinition[5];
$isimake     = $JobDefinition[6];
$keep        = $JobDefinition[7];
$sccs        = $JobDefinition[9];
$browserlink = $JobDefinition[10];

foreach $entry (@JobDefinition) {
    _debug("jobdefinition = $entry");
}

#
# Second command line are from say a Perforce Trigger may include
# the build number...
#
if (!defined($BuildNum)) {

    chomp $sccs;

    #
    # Abstract to get an initial identifier for the build
    #
    $sccscommand = $sccs."_initchangeno";
    $BuildNum    = $cmbroker->$sccscommand($port);

} 

chomp $BuildNum;

_debug("initial buildnumber = $BuildNum");

#
# Setup initial values for use with forkprocess
#
$os->jobname("$title");
$os->jobno("$BuildNum");
$os->hostname("$hostname");

$_InitNum = $BuildNum;

#
# Create build semaphores/job files...
#
if ((CreateSemaphores()) == 1) {
    _debug ("semaphore creation failed!");
    exit -1;
}

#
# Run update script if it exists...
#
chdir "$BSR" || die "chdir: $!";
if (-f "$updatejobs") {
    _debug(" updating build scripts");
    if ($POSIX) {
        $os->forkprocess("./$updatejobs >$nulldev 2>&1", 1, 0);
    } else {
        $os->forkprocess("$updatejobs >$nulldev 2>&1", 1, 0);
    }
}

my $GlobalBuildNumber;

_findbuildscripts();

#
# Run the build
#
MainBuildProc();

#
# Close the debug logger...
#
if ($debug) {
    close(DEBUGLOG);
}

sub MainBuildProc() {

    #
    # Declare local variables
    #
    my $numremotes;
    my @RRealChange;
    my $RLCHG;
    my $built_already;
    my $ok;
    my $Mailer = $config->MAILER;

    my $mailerargs;

    # SQL Stuff...
    my $sqlquery;
    my @sqlarray;

    #
    # print debug information
    #
    _debug("in sub MainBuildProc");
    _debug("sleeping for 30 seconds");

    # 
    # Sleep to ensure (especially with CVS) that the checkout or 
    # sync *may* be complete.
    #
    sleep 30;

    #
    # Pull MAX value from last n number of saved good builds
    # as defined in the job configuration.
    #
    $threadaverage = $os->_get_average($hostname, $title);

    #
    # Increase the deviated number by 50%
    #
    $threadaverage += $threadaverage * .5;

    #
    # We need to get the time from SQL
    #
    $threadnow = $os->_get_hosttime();

    if ($POSIX) {
        $watchthread = threads->new("_watchdog");
    } else {
        $watchthread = threads->new(\&_watchdog);
    }

    _debug("just woke up");

    #
    # Message to send to mailer, assume that the build completes
    #
    my $Completion = "completed";

    #
    # Setup build Environment from settings in the build conf file...
    #
    SetupEnvironment();

    #
    # Remove the old sync log.
    #
    if (-f "$top/$title.sync.log") {
        unlink("$top/$title.sync.log") || die "unlink: $?";
    }

    #
    # Sync/checkout sources...
    #
    $sccscommand = $sccs."_update";
            
    _sqljoblog("$title.$BuildNum syncing files");

    #
    # Call the abstracted function...
    #
    $cmbroker->$sccscommand($title, $port, $client, $top, $dir, $title);

    _debug("sync complete");

    #
    # See if there's a version file - the 'marketing' version - 3.01 
    # the '3'
    #
    if ( -f "$top/$title.version") {
        _debug("found version file");

        #
        # Local declaration
        #
        my $PRN;

        #
        # There's a version file, grab the number...
        #
        $PRN = _readversionfile("$top/$title.version");
        $config->PRN("$PRN");

    }

    if ( -f "$top/$title.build") {
        _debug("found local version file");

        #
        # Local declaration
        #
        my $BLDNUM;

        #
        # There's a build number file, grab the number...
        #
        $BLDNUM = _readversionfile("$top/$title.build");
        $config->BLDNUM("$BLDNUM");

        #
        # Set global value to be incremented when the build
        # has completed...
        #
        $GlobalBuildNumber = $BLDNUM;

    }

    _debug("grabbing real change number");

    #
    # Create abstract command for grabbing actual change number...
    #
    $sccscommand = $sccs."_realchangeno";

    #
    # Abstract for grabbing a 'real' change number
    #
    $RLCHG = $cmbroker->$sccscommand($port, $client, $top, $dir, 
        $title, $TmpDir, $BuildNum);

    _debug("RLCHG = $RLCHG");

    #
    # Bail out of the build if there's nbo build number
    #
    if ($RLCHG == 0) {
        _notifyproblem("**Failed to get build number - $BuildName**");
        ReleaseSemaphores();
        exit 1;
    }

    #
    # Set realchange number in config memory
    #
    $config->RLCHG("$RLCHG");

    #
    # Call function to format the build number using FORMATNUMBER
    #
    $BuildNum = _getjobid();
    chomp $BuildNum;

    _debug ("BuildNum = $BuildNum");

    #
    # Reset value now that it's been completed
    #
    $os->jobno("$BuildNum");

    #
    # If we failed to generate a build number bail out
    #
    if (!$BuildNum) {
        _debug("failed to generate build number");
        _notifyproblem("**Failed to generate build number**");
        exit -1;
    }

    #
    # Save this for later...
    #
    $logchange = $RLCHG;

    #
    # See if there's already a job number...
    #
    $built_already = search_build_numbers($BuildNum);

    #
    # If we chance upon this, then theres some admin work that needs 
    # to happen.  For now send email, and let the build administrator 
    # worry about it...
    #
    if ($built_already) {
        _notifyproblem("**Same Job Attempt - $BuildName $BuildNum**");
        ReleaseSemaphores();
        exit 1;
    }

    #
    # We'll replace the initial message in the semaphores table
    #
    my $_updatemsg1 = "$title $_InitNum in progress, run status $title";
    my $_updatemsg2 = "$title $BuildNum in progress, run status $title";

    $sqlquery = "update semaphores set message=\"$_updatemsg2\" where ".
                "message=\"$_updatemsg1\"";

    @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

    #
    # Update the proctree with the build number
    #
    $sqlquery = "update proctree set job=\"$BuildNum\" where binary ".
                "title=\"$title\" and binary server=\"$hostname\"";

    @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

    #
    # Duplicate message in the restore table
    #
    $sqlquery = "update restore set message=\"$_updatemsg2\" where ".
                "message=\"$_updatemsg1\"";

    @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);


    #
    # Log updated files
    #
    $sccscommand = $sccs."_logfilelist";

    $cmbroker->$sccscommand($title, $BuildNum);

    #
    # See if there's a prebuild trigger, and execute it...
    #
    if (defined($scripthash{prebuild})) {
        chdir dirname($scripthash{prebuild}) || die "chdir $!";
        _debug("prebuild trigger found, executing");
        _sqljoblog("$title.$BuildNum running $prebuild");
        $script = basename($scripthash{prebuild});
        if ($POSIX) {
            $os->forkprocess(
                "./$script $top $title $BuildNum \"$client\" ".
                ">$top/$title.prebuild.log 2>&1", 1, 0);
        } else {
            $os->forkprocess(
                "$script $top $title $BuildNum \"$client\" ".
                ">$top/$title.prebuild.log 2>&1", 1, 0);
        }
    }

    #
    # Use this for overriding default environment variables
    #
    my $vars = "$BSR/jobs/$title/$hostname/vars.conf";
    if (-f "$vars") {
        _debug("found variable override file");
        open (VARIN, "<$vars");
        open (VAROUT, ">$vars.set");
        while (<VARIN>) {
            chomp $_;
            my ($envname, $envvalue) = split(/=/, $_);
            $ENV{"$envname"} = "$envvalue";
            print VAROUT "$envname = $envvalue\n";
        }
        close (VAROUT);
        close(VARIN);
    }

    #
    # Create a version number in case packaging needs it...
    #
    _debug("creating version file for packaging");
    open (VERSION, ">$top/version");
    print VERSION "$BuildNum";
    close (VERSION);

    #
    # Simplified running build scripts...
    # 
    if ($type =~ "retail" || $type =~ "debug") {
        $ok = _runjob($type, $title, $BuildNum, $top, "$client");
    }

    if ($type =~ "both") {

        $ok = _runjob("debug", $title, $BuildNum, $top, "$client");

        if ($ok == 0) {

            $ok = _runjob("retail", $title, $BuildNum, $top, "$client");

        }
    }

    #
    # Check result code from build...
    #
    if ($ok != 0) {

        $Completion = "failed";
        _debug("$title build failed");

        #
        # Run fail script if it exists...
        #
        if (defined($scripthash{onfail})) {
            _debug("running failure trigger");
            chdir dirname($scripthash{onfail}) || die "chdir $!";
            $script = basename($scripthash{onfail});
            _sqljoblog("$title.$BuildNum running $onfail");
            if ($POSIX) {
                $os->forkprocess(
                    "./$script $top $currenttype $title $BuildNum \"$client\" ".
                    "$top/$title.$currenttype.onfail.log 2>&1", 1, 0);
            } else {
                $os->forkprocess(
                    "$script $top $currenttype $title $BuildNum \"$client\" ".
                    ">$top/$title.$currenttype.onfail.log 2>&1", 1, 0);
            }
        }

        #
        # Log as a failed build send email.
        #
        chdir "$dir" ||die "chdir: $!";

        _debug("sending build failure notification");

        _sqljoblog("$title.$BuildNum sending build failure notification");

        $mailerargs = "-n $title -t $currenttype -j $BuildNum -s failed";

        $os->forkprocess("$Mailer $mailerargs >$nulldev 2>&1", 1, 0);

        if (! -f "./proc/$title.bad") {
            _debug("creating failure semaphore");
            open(BAD, ">./proc/$title.bad");
            close(BAD);
        } else {
            
            #
            # Last job was bad, just log as a bad build without sending 
            # email.
            #
            open(BADJOB, ">>$BSR/proc/$title.failed");
            print BADJOB "$BuildNum\n";
            close (BADJOB);
        }

        if (-d "$JobDir/$title/$BuildNum") {
            $usedspace = _getusedspace("$JobDir/$title/$BuildNum", 0);
        }

        _incrementbuild("$top/$title.build", 0);

        $step = 7;

    } else {

        #
        # Build has completed without errors...
        #
        # chdir "$BSR/jobs/$hostname/$title" || die "chdir: $!";
        _debug("build completed without errors");

        #
        # See if a postbuild trigger script exists...
        #
        if (defined($scripthash{postbuild})) {
            chdir dirname($scripthash{postbuild}) || die "chdir $!";
            _debug("running postbuild trigger");
            _sqljoblog("$title.$BuildNum running $postbuild");
            $script = basename($scripthash{postbuild});
            if ($POSIX) {
                $os->forkprocess(
                    "./$script $top $type $title $BuildNum \"$client\" ".
                    "$top/$title.postbuild.log 2>&1", 1, 0); 
            } else {
                $os->forkprocess(
                    "$script $top $type $title $BuildNum \"$client\" ".
                    ">$top/$title.postbuild.log 2>&1", 1, 0); 
            }

        }

        if (-d "$JobDir/$title/$BuildNum") {
            $usedspace = _getusedspace("$JobDir/$title/$BuildNum", 1);
        }

        chdir "$dir" ||die "chdir: $!";

        #
        # See if the last build failed, and remove the semaphore
        # to start build breaker email notification...
        #
        if (-f "./proc/$title.bad") {
            _debug("removing failure semaphore");
            _notifygood($title);
            unlink "./proc/$title.bad";
        }

        #
        # Remove any good build > keep builds old...
        #
        if (defined($keep)) {
            _debug("removing builds older than $keep jobs");
            remove_old_builds($keep);
        }

        #
        # Send build completion notification...
        #
        _debug("sending build completion notification");
        _sqljoblog("$title.$BuildNum sending build completion notification");
        $mailerargs = "-n $title -t $currenttype -j $BuildNum -s passed";

        $os->forkprocess("$Mailer $mailerargs >$nulldev 2>&1", 1, 0);

        _incrementbuild("$top/$title.build", 1);

        $step = 7;

    }

    _sqljoblog("$title.$BuildNum $Completion");

    #
    # Here's where we'll deal with locks and pending locks...
    #
    ReleaseSemaphores();

    #
    # Finish timing the build here...
    #
    my $CompleteTime = $os->_get_hosttime();

    #
    # Write results to log file for reading by the buildserver
    #
    if ($ok == 0) {
        _logresults($BuildNum, $StartTime, $CompleteTime, 0);

    } else {
        _logresults($BuildNum, $StartTime, $CompleteTime, 2);
    }

}

#
# Get entry from configuration file associated with this job
#
sub GetJobInfo() {

    _debug("sub GetJobInfo");

    my $ret = 1;

    #
    # SQL Stuff...
    #
    my $sqlquery;
    my @sqlarray;
    my $line;

    #
    # Query SQL for configuration information
    #
    $sqlquery  = "select title, port, client, top, type, toolsdir, ".
                 "isimake, keeplevel, comment, sccs, browserlink ".
                 "from configuration where binary server=\"$hostname\" ".
                 "and binary title=\"$BuildName\" and state=\"0\"";

    @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

    foreach $line (@sqlarray) {
        ($title,$port,$client,$top,$type,$tools,$isimake,$keep,
            $comment,$sccs,$browserlink) = split(/;/, $line);
        $ret = 0;
    }

    @JobDefinition = ($title,$port,$client,$top,$type,$tools,
                      $isimake,$keep,$comment,$sccs,$browserlink);

    return $ret; 

}

#
# Subroutine to setup all lock files...
#
sub CreateSemaphores() {

    #
    # SQL Stuff...
    #
    my $sqlquery;
    my @sqlarray;
    my @sqlsubmit;
    my @emptyarray;
    my $line;

    _debug("sub CreateSemaphores");

    #
    # Log any jobs which may have been missed
    #

    $sqlquery  = "select state from semaphores where ".
                 "binary server=\"$hostname\" and binary ".
                 "title=\"$BuildName\" and state=\"1\"";

    @sqlarray  = $os->run_sql_query("$sqlquery", ";", 0);

    if (@sqlarray > 0) {

        open (QUEUELOG, ">>$QueueFile");
        print QUEUELOG "$BuildNum\n";
        close QUEUELOG;
        return 1;

    } else {
        push @sqlarray, "$hostname";
        push @sqlarray, "$BuildName";
        push @sqlarray, "$BuildName $BuildNum in progress, run status ".
                        "$BuildName\n";
        push @sqlarray, "$StartTime";
        push @sqlarray, "1";

        if (($os->run_sql_submit("semaphores", @sqlarray)) == 0) {
            _debug("failed to write record to semaphore table");
            exit -1;
        }

        #
        # Write backup semaphore in case job becomes 'enabled' during
        # the middle of a build.
        #
        if (($os->run_sql_submit("restore", @sqlarray)) == 0) {
            _debug("failed to write record to restore table");
            exit -1;
        }
        @sqlarray = @empty;
    }

    $sqlquery  = "delete from joblog where server=\"$hostname\" ".
                 "and title=\"$BuildName\"";

    if (($os->run_sql_remove("$sqlquery")) == 0) {
        _debug("failed to remove record from joblog table");
        exit -1;
    }

    _sqljoblog("starting job $BuildNum for $BuildName");

    #
    # See if there's defined jobs which need to be locked while this 
    # job is running...
    #
    _debug("looking for $top/.lockjobs");
    if ( -f "$top/.lockjobs") {
        _debug("I have $top/.lockjobs");
        open (LOCKJOBS, "<$top/.lockjobs");
        while (<LOCKJOBS>) {
            chomp;
            _lockjob("$_", 1);
        }
        close(LOCKJOBS);
    }

    return 0;

}

sub ReleaseSemaphores {

    my $sqlquery;
    my @sqlarray;

    #
    # Remove all semaphores except for pending locks...
    #
    $sqlquery  = "delete from semaphores where server=\"$hostname\" ".
                 "and title=\"$BuildName\" and state != \"2\"";

    if (($os->run_sql_remove("$sqlquery")) == 0) {
        _debug("sql failed to remove semaphores from semaphore table");
    }

    #
    # Release all backed-up locks
    #
    $sqlquery  = "delete from restore where server=\"$hostname\" ".
                 "and title=\"$BuildName\" and state != \"2\"";

    if (($os->run_sql_remove("$sqlquery")) == 0) {
        _debug("sql failed to remove semaphores from restore table");
    }

    #
    # We don't really care if there's any record, SQL will affect 0 rows!
    #
    $sqlquery  = "update semaphores set state=\"1\" where ".
                 "server=\"$hostname\" and title=\"$BuildName\" ".
                 "and state=\"2\"";
    @sqlarray  = $os->run_sql_query("$sqlquery", ";", 0);

    #
    # Do the same thing to the restore table
    #
    $sqlquery  = "update restore set state=\"1\" where ".
                 "server=\"$hostname\" and title=\"$BuildName\" ".
                 "and state=\"2\"";
    @sqlarray  = $os->run_sql_query("$sqlquery", ";", 0);

    #
    # See if there are jobs locked by this build
    #
    if ( -f "$top/.lockjobs") {
        open (LOCKJOBS, "<$top/.lockjobs");
        while (<LOCKJOBS>) {
            chomp $_;
            _lockjob("$_", 0);
        }
        close(LOCKJOBS);
    }

    #
    # Remove all entries from proctree
    #
    $sqlquery  = "delete from proctree where binary server=\"$hostname\" ".
                 "and title=\"$BuildName\"";

    if (($os->run_sql_remove("$sqlquery")) == 0) {
        _debug("sql failed to remove semaphores from proctree table");
    }

}

#
# Search build completion array for selected job...
#
sub search_build_numbers() {

    my $num = shift;

    my $eachone;

    _debug("sub search_build_numbers");

    #
    # SQL Stuff...
    #
    my $sqlquery;
    my @sqlarray;

    $sqlquery  = "select job from jobs where binary ".
                 "server=\"$hostname\" and binary ".
                 "title=\"$BuildName\" order by job";

    @sqlarray  = $os->run_sql_query("$sqlquery", ";", 1);

    _debug("sub search_build_numbers $sqlquery");

    #
    # If there's a global number remove it, we're only looking for
    # the build number generated from the CM system
    #
    if ($GlobalBuildNumber) {
        for $eachone (@sqlarray) {
            $num = s/\.$GlobalBuildNumber//g;
            if ($num =~ /^$eachone/) {
                _debug("sub search_build_numbers $num found");
                return 1;
            }
        }
    }else{
        for $eachone (@sqlarray) {
            if ($num =~ /^$eachone$/) {
                _debug("sub search_build_numbers $num found");
                return 1;
            }
        }
    }

    return 0;

}

#
# Usage message for running/debugging by hand...
#
sub usage() {

    print "builder.pl -n jobname [-j jobno]\n";
    exit 1;

}

#
# Setup build environment...
#
sub SetupEnvironment {

    my $oldpath;
    my $newpath;

    _debug("sub SetupEnvironment");

    $oldpath         = $ENV{"PATH"};
    $ENV{"TOOLS"}    = "$tools";
    $ENV{"PATH"}     = "$oldpath:$tools";

    $newpath = $ENV{"PATH"};

    _debug("$newpath");

}

#
# Search for errors in the build log...
#
sub readlogfile {

    my $LastLine;

    my $in  = shift;
    my $out = shift;

    _debug("sub readlogfile");

    # Assume error free build...
    my $Errors = 0;

    # Open log and error log files...
    open(LOG, "<$in")       || die "open: $in";
    open(ERRORLOG, ">$out") || die "open: $out";

    # Read the log file...
    while (<LOG>) {

        # Strip off the return
        chomp;

        # Search for any errors from the error array
        foreach my $search (@ErrorArray) {
            chomp $search;
            my $x = index ($_,"$search");
            if ($x != -1) {
                $Errors = 1;
                foreach my $excludesearch (@ErrorExcludeArray) {
                    my $ex = index ($_, "$excludesearch");
                    if ($ex != -1) {
                        $Errors = 0;
                    }
                }
                # Search preceeding line if it doesn't have
                # have the same errors then print it to the
                # error file...
                my $s = index ($LastLine, "$search");
                if ($s == -1) {
                    print ERRORLOG "error: $LastLine\n";
                }
                print ERRORLOG "error: $_\n";
            }
        }
        $LastLine = $_;
    }

    close (ERRORLOG) || die "close $out";
    close (LOG)      || die "close $in";

    # See if we found an error
    if ($Errors == 1) {
        _debug("$type $title errors found, logged to $out");
        return -1;
    } else {
        unlink("$out") || die "unlink: $!";
        return 0;
    }

}

#
# Remove any build > $keep old...
#
sub remove_old_builds() {

    _debug("sub remove_old_builds");

    my @Output;
    my @BuildNums;
    my @RemoveNums;
    my $Start;
    my $End;
    my $reqtime;
    my $entry;
    my $Keep = $_[0] + 1;
    my $ret;

    #
    # Values for SQL...
    #
    my $sqlquery;
    my @sqlarray;
    my @emptyarray;
    my $line;
    my $name         = $BuildName;

    my @record;
    my @empty;

    _debug("opening $dir/proc/$BuildName.location");

    #
    # Connect to the database...
    #
    $Keep = $_[0];

    $sqlquery  = "select job from jobs where binary server=\"$hostname\" ".
                 "and binary title=\"$name\" order by job";

    @sqlarray = $os->run_sql_query("$sqlquery", ",", 0);

    foreach $line (@sqlarray) {
        chomp $line;
        push @BuildNums, $line;
    }

    _debug("Used mysql to get build numbers");

    my $c = @BuildNums;

    _debug("c = $c");

    if ($c > $Keep) {
        $Start = 0;
        $End = $c - $Keep;
        @RemoveNums = @BuildNums[$Start..$End];
    }

    my $zoobi = @BuildNums;
    my $zoogi = @BuildNums;
    _debug("BuildNums = $zoobi");
    _debug("RemoveNums = $zoogi");

    $reqtime = sprintf "%s", scalar localtime;

    _debug("opening $BSR/proc/$BuildName.remove");

    foreach $entry (@RemoveNums) {
        
        chomp $entry;
        @record = @empty;

        push @record, "$hostname";
        push @record, "$BuildName";
        push @record, "$entry";
        push @record, "$reqtime";

        if (-d "$JobDir/$BuildName/$entry") {

            if (! -f "$JobDir/$BuildName/$entry/.keep") {

                if ($POSIX) {
                    system "rm -rf $JobDir/$BuildName/$entry &";
                } else {
                    system "rd /s/q $JobDir\\$BuildName\\$entry";
                }

                _debug("removing $JobDir/$BuildName/$entry");

                push @record, "Removed";
                push @record, "$JobDir/$BuildName/$entry";

            } else {
                push @record, "Keeping";
                push @record, "$JobDir/$BuildName/$entry";

                _debug("keeping $JobDir/$BuildName/$entry");

            }
            if (($ret = $os->run_sql_submit("removed", @record)) == 0) {
                _debug("submit to sql failed");
            }
        } 
    }

}

#
# Global notification of a stable tree.
#
sub _notifygood {

    my $title = shift;

    my $admin = $config->ADMIN;

    my %mailhash;
    my $sqlquery;
    my @spamarray;

    $sqlquery  = "select spam from configuration where ".
                 "binary server=\"$hostname\" and ".
                 "binary title=\"$title\"";

    @spamarray  = $os->run_sql_query("$sqlquery", ";", 0);

    if ($spamarray[0]) {

        $mailhash{"To"}      = $config->GLOBMAIL;
        $mailhash{"From"}    = "$hostname ".$config->NOTIFYFROM;
        $mailhash{"Subject"} = "Tree for $BuildName is stable ($BuildNum)"; 
        $mailhash{"Smtp"}    = $config->SMTP;

        sendmail %mailhash;

        if ($Mail::Sendmail::error) {

            print STDERR "$Mail::Sendmail::error\n";

        }

    } 

}

#
# If there's an attempted rebuild, send some email notification...
#
sub _notifyproblem {

    my %mailhash;

    $mailhash{"To"}      = $config->ADMIN;
    $mailhash{"From"}    = "$hostname ".$config->NOTIFYFROM;
    $mailhash{"Subject"} = shift; 
    $mailhash{"Smtp"}    = $config->SMTP;

    sendmail %mailhash;

    if ($Mail::Sendmail::error) {

        _debug( "$Mail::Sendmail::error\n") ;

    }

}

#
# Routine for debugging changes to the build script...
#
sub _debug {

    my $msg = shift;

    if ($debug) {
        print DEBUGLOG "[".scalar localtime()."]: $msg\n";
        print STDERR   "[".scalar localtime()."]: $msg\n";
    }

}

#
# Search for a 'marketing' version...
#
sub _readversionfile {

    my $filename = $_[0];
    my $value;

    open (PRODFILE, "<$filename") || die "open: $?";
    while (<PRODFILE>) {
         $value = $_;
         chomp $value;
    }
    close (PRODFILE);

    return $value;

}

#
# Generate job id by whats in the configuration file...
#
sub _getjobid {

    my $BuildNum;

    $verstring = $config->formatjobid();
    _debug("verstring = $verstring");
    
    pipe (READER, WRITER);
    READER->autoflush(1);
    WRITER->autoflush(1);
    open (FORMATNUMBER, ">&=WRITER");
    write(FORMATNUMBER);
    close(FORMATNUMBER);
    close(WRITER);
    
    while (<READER>) {
       $BuildNum = $_;
    }

    close(READER);

    return $BuildNum;

}

#
# Run debug/retail build job...
#
sub _runjob {

    my $type     = shift;
    my $title    = shift;
    my $BuildNum = shift;
    my $top      = shift;
    my $client   = shift;

    my $ret      = 0;

    _debug("type = $type, starting $type build\n");

    #
    # Global in case a failure occurs
    #
    $currenttype = "$type";
    
    # Log info for joblog
    _sqljoblog("$title.$BuildNum building $type");
    chdir dirname($scripthash{$type}) || die "chdir $!";
    $script = basename($scripthash{$type});

    if ($POSIX) {
        $ret = $os->forkprocess(
            "/usr/bin/ksh $script $top $title $BuildNum \"$client\" ".
            ">$top/$title.$type.log 2>&1",
            1, 0);
    } else {
        $ret = $os->forkprocess(
            "$script $top $title $BuildNum \"$client\" ".
            ">$top/$title.$type.log 2>&1",
            1, 0);
    }

    #
    # Remove file descriptor F stuff when done testing integration
    # of test harness...
    #
    open (F, ">>/tmp/$title.$type");
    print F "$BuildNum ";
    $shellret = $ret;
    print F $shellret;
    print F "\n";
    close(F);

    # Log info for joblog
    _debug("checking $type log file for errors\n");
    _sqljoblog("$title.$BuildNum checking $type buildlog");
    my $ok = readlogfile("$top/$title.$type.log",
                         "$top/$title.$type.error.log");

    return $ok;

}

#
# Log build results to file...
#
sub _logresults {

    my $BuildNum     = shift;
    my $StartTime    = shift;
    my $CompleteTime = shift;
    my $Result       = shift;

    my $underscore;

    my @emptyarray;

    # 
    # For writing build info to a mysql...
    #
    my $dbh;
    my $sth;
    my $bConnected   = 0;

    #
    # SQL Stuff...
    #
    my @sqlarray;
    my $sqlquery;

    my $printstring;

    if ($Result == 0 && $shellret == 5) {
        $Result = 1;
    }

    #
    # Used to generate a single link identifying the build
    # via the web page - for CVS only (perforce has a change
    # number.
    #
    my @lastup;

    if (-f "$TmpDir/cvslast") {
        open (CVSUP, "<$TmpDir/cvslast");
        @lastup = <CVSUP>;
        close(CVSUP);
        chomp $lastup[0];
        $underscore = $lastup[0];
        foreach $maskline(@maskarray) {
            $underscore =~ s/$maskline//g;
        }
    } else {
        push @lastup, "NA";
    }

    $sqlquery  = "select end from jobs where binary server=\"$hostname\" ".
                 "and binary title=\"$BuildName\" and end=\"$StartTime\"";

    @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

    if (@sqlarray > 0) {
        $StartTime++;
    }

    #
    # Initialize as nothing to ensure there's no info here...
    #
    @sqlarray = @emptyarray; 
    
    push @sqlarray, "$hostname";
    push @sqlarray, "$BuildName";
    push @sqlarray, "$BuildNum";
    push @sqlarray, "$StartTime";
    push @sqlarray, "$CompleteTime";
    push @sqlarray, "$Result";
    push @sqlarray, "$underscore";
    push @sqlarray, "$sccs";
    push @sqlarray, "$browserlink";
    push @sqlarray, "$usedspace";
    push @sqlarray, "$port";

    if (($os->run_sql_submit("jobs", @sqlarray)) == 0) {
        _debug("SQL failed submitting record to jobs table");
    }


}

sub _sqljoblog {

    my $string = shift;

    my @sqlarray;

    push @sqlarray, "$hostname";
    push @sqlarray, "$title";
    push @sqlarray, "$string";
    push @sqlarray, "$step";

    _debug("$string");

    if (($os->run_sql_submit("joblog", @sqlarray)) == 0) {
        _debug("string\n");
    }

    $step++;

}

#
# Lock/Unlock jobs defined in a .lockjob file located at the
# top of the build tree
#
sub _lockjob {

    my $lockjob    = shift;
    my $lockunlock = shift;

    my $sqlquery;
    my @sqlarray;
    my @sqlsubmit;

    _debug("locking $lockjob\n");

    #
    # This is the start of the build if set, lock dependent jobs
    #
    if ($lockunlock) {

        $sqlquery  = "select state from semaphores where ".
                     "binary server=\"$hostname\" and binary ".
                     "title=\"$lockjob\" and state=\"1\"";

        @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

        if (@sqlarray == 0) {

            push @sqlsubmit, "$hostname";
            push @sqlsubmit, "$lockjob";
            push @sqlsubmit, "=[$lockjob build job disabled by running ".
                             "job $BuildName]=";
            push @sqlsubmit, "$StartTime";
            push @sqlsubmit, "1";

            if (($os->run_sql_submit("semaphores", @sqlsubmit)) == 0) {
                _debug("failed to write record to semaphore table\n");
            }

        } else {

            $sqlquery  = "select state from semaphores where ".
                         "binary server=\"$hostname\" and binary ".
                         "title=\"$lockjob\" and state=\"2\"";

            @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

            if (@sqlarray == 0) {
                            
                push @sqlsubmit, "$hostname";
                push @sqlsubmit, "$lockjob";
                push @sqlsubmit, "=[$lockjob build job disabled by running ".
                                 "job $BuildName]=";
                push @sqlsubmit, "$StartTime";
                push @sqlsubmit, "2";

                if (($os->run_sql_submit("semaphores", @sqlsubmit)) == 0) {
                    _debug("failed to write record to semaphore table\n");
                }
            }
        }
    
    #
    # This is the end of the build, unlock dependent jobs
    #
    } else {

        $sqlquery  = "select state from semaphores where ".
                     "binary server=\"$hostname\" and binary ".
                     "title=\"$lockjob\" and state=\"1\" and ".
                     "message=\"=[$lockjob build job disabled by ".
                     "running job $BuildName]=\"";

        @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

        if (@sqlarray > 0) {

            $sqlquery  = "delete from semaphores where ".
                         "binary server=\"$hostname\" and ".
                         "binary title=\"$lockjob\"";

            if (($os->run_sql_remove("$sqlquery")) == 0) {
                _debug("sql failed to remove lock semaphore $lockjob");
            }

        } else {

            $sqlquery  = "select state from semaphores where ".
                         "binary server=\"$hostname\" and binary ".
                         "title=\"$lockjob\" and state=\"2\" and ".
                         "message=\"=[$lockjob build job disabled ".
                         "by running job $BuildName]=\"";

            @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);

            if (@sqlarray == 0) {

                $sqlquery  = "delete from semaphores where ".
                             "binary server=\"$hostname\" and ".
                             "binary title=\"$lockjob\" and state=\"2\"";

                if (($os->run_sql_remove("$sqlquery")) == 0) {
                    _debug("sql failed to remove pending semaphore $lockjob");
                }
                            
            }
    
        } 
    
    } 

}

#
# Increment build number
#
sub _incrementbuild {

    my $file   = shift;
    my $result = shift;

    #
    # If we have a build number and the build worked, increment it...
    #
    if (-f "$file") {
        if ($result || $bIncrement) {
            my $UpdateBuildNumber = $GlobalBuildNumber+1;
            open(BUILDFILE, ">$file");
            print BUILDFILE "$UpdateBuildNumber";
            close (BUILDFILE);
        }
    }

}

#
# Determine the amount of space used in a build
#
sub _getusedspace {

    my $dir  = shift;
    my $type = shift;

    my $sum = 0;

    my $sqlquery;
    my @sqlarray;

    find sub { $sum += -s }, $dir;

    #
    # If the build was a success update the master record.
    #
    if ($type) {
        $sqlquery = "update configuration set buildsize=\"$sum\" ".
                    "where binary server=\"$hostname\" and binary ".
                    "title=\"$title\"";

        @sqlarray = $os->run_sql_query("$sqlquery", ";", 0);
    }

    return $sum;

}

#
# Populate hash with names of scripts
#
sub _findbuildscripts {

    my $scriptroot = "$BSR/jobs/$title"; 

    #
    # Need retail and debug scriptnames
    #
    my $retail = $config->{RETAIL};
    my $debug  = $config->{DEBUG};

    #
    # Get prebuild location
    #
    if (-f "$scriptroot/$prebuild" ) {
        $scripthash{"prebuild"} = "$scriptroot/$prebuild";
    }
    if (-f "$scriptroot/$hostname/$prebuild" ) {
        $scripthash{"prebuild"} = "$scriptroot/$hostname/$prebuild";
    }

    #
    # Get postbuild location
    #
    if (-f "$scriptroot/$postbuild" ) {
        $scripthash{"postbuild"} = "$scriptroot/$postbuild";
    }
    if (-f "$scriptroot/$hostname/$postbuild" ) {
        $scripthash{"postbuild"} = "$scriptroot/$hostname/$postbuild";
    }

    #
    # Get onfail location
    #
    if (-f "$scriptroot/$onfail" ) {
        $scripthash{"onfail"} = "$scriptroot/$onfail";
    }
    if (-f "$scriptroot/$hostname/$onfail" ) {
        $scripthash{"onfail"} = "$scriptroot/$hostname/$onfail";
    }

    #
    # Get retail build script location
    #
    if (-f "$scriptroot/$retail" ) {
        $scripthash{"retail"} = "$scriptroot/$retail";
    }
    if (-f "$scriptroot/$hostname/$retail" ) {
        $scripthash{"retail"} = "$scriptroot/$hostname/$retail";
    }

    #
    # Get debug build script location
    #
    if (-f "$scriptroot/$debug" ) {
        $scripthash{"debug"} = "$scriptroot/$debug";
    }
    if (-f "$scriptroot/$hostname/$retail" ) {
        $scripthash{"debug"} = "$scriptroot/$hostname/$debug";
    }

}

#
# Watchdog routine, use via threads to detect a late job
#
sub _watchdog {

    #
    # Ummm, if this gets messed up then something real bad
    # has happened
    #
    if ($threadnow > $StartTime) {

        #
        # Provide some debuggine
        #
        _debug("watchdog sleeping: $threadaverage");

        #
        # Sleep for the standard deviation
        #
        sleep($threadaverage);

        #
        # If the process is still running then the job's 
        # overdue
        #
        _debug("watchdog late build detected");

        #
        # Notify the administrator of the late job
        #
        _notifyproblem("Build $title $GlobalBuildNumber is past due");
    }

}