#!/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.
#

BEGIN {
    push @INC, "lib";
    push @INC, "../lib";
    push @INC, "../../lib";
}

use File::Path;
use File::Copy;
use File::Basename;
use File::Find;
use Cwd;
use Cwd 'abs_path';
use Sys::Hostname;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

use POSIX qw (:sys_wait_h);

#
# Get name of the build server
#
my $hostname = hostname();

my $ospackage;

#
# See what OS this is
#
if ($ =~ /MSWin32/) {
    $ospackage = "winsys";
} else {
    $ospackage = "unixsys";
}

require "$hostname.pm";
require "$ospackage.pm";

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

my $cmd = $ARGV[0];

my $dir = getcwd();

my $i = @ARGV;
for ($a=1; $a < $i; $a++) {

    push @Args, $ARGV[$a];

}

my $return = &$cmd(@Args);

exit $return;

sub removecomments {

    my $sqlquery = "delete from comments where comment=\"Information:\n.\"";

    $os->run_sql_remove($sqlquery);

}

sub nqueuetest {

    my $testname   = shift;
    my $buildsvr   = shift;
    my $job        = shift;
    my $num        = shift;
    my $patchname  = shift;

    my $entry;
    my @tests = split(/ /, $testname);

    foreach $entry (@tests) {

        my $sqlquery;
        my @sqlarray;
        my @empty;
        my @submitarray = @empy;

        my $tserver;
        my $tdeploy;
        my $timagename;
        my $tbootscript;
        my $ttitle   = $entry;
        my $tbldsvr  = $buildsvr;
        my $tjobname = $job;
        my $tjob     = $num;

        $sqlquery = "select server, deployto, imagename, bootscript ".
                    "from testconfiguration where binary ".
                    "title=\"$entry\"";

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

        ($tserver, $tdeploy, $timagename, $tbootscript) 
            = split(/;/, $sqlarray[0]);

        $sqlquery = "select * from stage where binary title=\"$entry\" ".
                    "and binary jobname=\"$job\" and binary job=\"$num\"";

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

        if (!@sqlarray) {

            push @submitarray, "$tserver";
            push @submitarray, "$tdeploy";
            push @submitarray, "$timagename";
            push @submitarray, "$tbootscript";
            push @submitarray, "$ttitle";
            push @submitarray, "$tbldsvr";
            push @submitarray, "$tjobname";
            push @submitarray, "$tjob";
            push @submitarray, "0";
            push @submitarray, "$patchname";
    
            $os->run_sql_submit("stage", @submitarray);

        } else {
     
            print "job $tjobname build $tjob from $tbldsvr already ".
                  "staged for deployment on $tdeploy\n";

        }
   
    }

}

sub queuetest {

    my $testname   = shift;
    my $testserver = shift;
    my $deployto   = shift;
    my $buildsvr   = shift;
    my $job        = shift;
    my $num        = shift;

    my $sqlquery;
    my @sqlarray;
    my @empty;

    $sqlquery = "select title from stagetest where binary ".
                "title=\"$testname\"";

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

    if (@sqlarray < 1) {
        @sqlarray = @empty;

        push @sqlarray, "$testserver";
        push @sqlarray, "$deployto";
        push @sqlarray, "$testname";
        push @sqlarray, "$buildsvr";
        push @sqlarray, "$job";
        push @sqlarray, "$num";
        push @sqlarray, "0";

        $os->run_sql_submit("stagetest", @sqlarray);

    }

}

sub cleancvsignore {

    my $dir = shift;

    if (! -d $dir) {

        _logger( "invalid dir $dir\n" );
        exit 1;

    }

    find(\&process_file, $dir);

}

sub p4params {

    my $buildname = shift;

    my $sqlquery  = "select port, client from configuration where binary ".
                    "server=\"$hostname\" and binary title=\"$buildname\"";

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

    my ($port, $client) = split(/,/, $sqlarray[0]);

    my $user = $config->P4USER;
    my $pass = $config->P4PASSWD;

    print "-p $port -c $client -u $user -P $pass";

}

sub getvernum {

    my $buildname = shift;
    my $thisdir   = shift;

    if (! -d "$dir/$thisdir") {
        print 0;
    }
     
    chdir ("$dir/$thisdir");

    $ENV{"PWD"} = "$dir/$thisdir";

    my @c4stuff = `c4 changes -m 1 ...`;

    my @rec = split(/ /, $c4stuff[0]);

    print $rec[1];

}

sub buildinfo {

    my $buildname = shift;
    my $buildnum  = shift;
    my $targetdir = shift;

    my $isbody = 0;
    my $formatted = "%s <a href=http://ultra10/viewcvs/viewcvs.cgi/%s".
                "/%s#rev%s>%s</a> %s";

    open(BIOUT, ">$targetdir/build.info.html") || die "open: $!";

    $old_fh = select(BIOUT);
    $| = 1;
    select($old_fh);

    print BIOUT "<html><head><title>$buildname $buildnum bill of materials</title>".
        "</head>\n";
    print BIOUT "<body><pre>";


    open(BIIN, "<$targetdir/build.info") || die "open: $!";

    while (<BIIN>) {

        chomp;

        if ($isbody == 1) {

            ($mod, $file, $ver) = split(/ /, $_);

            $string = sprintf("$formatted\n", $mod, $mod, $file, $ver, $file, 
                $ver);
            print BIOUT "$string";

        } else {
            print BIOUT "$_\n";
        }

        if ($_ =~ /^---/) {

            $isbody = 1;

        }

    }

    close(BIIN);

    print BIOUT "</pre>\n";
    print BIOUT "</body>\n";
    print BIOUT "</html>\n";

    close(BIOUT);

}

sub metrics {

    my $bname     = shift;
    my $bnumber   = shift;
    my $pid;

    my $home = $ENV{'HOME'};
    $classpath = "$home/jncss/javancss17.37/lib/javancss.jar:".
                 "$home/jncss/javancss17.37/lib/ccl.jar:".
                 "$home/jncss/javancss17.37/lib/jhbasic.jar";

    $ENV{'JAVA_HOME'} = "/usr/java";
    $ENV{'JAVANCSS_HOME'} = "$home/jncss/javancss17.37";

    pipe(READ, WRITE);

    if ($pid = fork) {

        close(WRITE);

    } else { 

        die "cannot fork: $!" unless defined $pid;

        # child
        open (STDERR, ">/dev/null");
        open(STDOUT, ">&=WRITE");
        exec("java", "-classpath", "$classpath", "javancss.Main", "-all", 
            "-recursive");

    }

    _logger( "$bname metrics started $pid" );

    open (METRICS, ">/tmp/$bname.buildmetrics.out") || die "open: $!";

    while (<READ>) {

        print METRICS "$_";

    }

    close(READ);
    close(METRICS);

    _logger( "waiting on $pid" );
    waitpid($pid, 0);
    _logger( "$pid completed" );

}

sub removegenerated {

    my $job = shift;
    my $num = shift;

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

    my $port;
    my $client;
    my $sccs;

    my $bHaschange = 0;

    $sqlquery = "select port, client, sccs from configuration where ".
                "binary server=\"$hostname\" and binary title=".
                "\"$job\" and state=\"0\"";

    open (DBG, ">/tmp/buildfuncs.dbg");

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

    foreach $line (@sqlarray) {
        ($port, $client, $sccs) = split(/;/, $line);
    }

    $ENV{'CVSROOT'} = "$port";

    my @modules = split(/ /,$client);

    foreach $line (@modules) {
        _logger( "removegenerated module=$line" );
    }

    if ($sccs =~ /^cvs$/ ) {

        my @children;

        my $counter = 0;
        my $nm = @modules;
        my $archive;
        my $bcommit;
    
        _logger( "opening read/write pipe" );
        pipe(READ, WRITE);
        _logger( "pipe opened" );
    
        foreach $entry (@modules) {
    
            _logger("processing $entry");
            if ($entry =~ /^!/) {
                $entry =~ s/^!//g;
            }
    
            if ( -d $entry) {
                _logger("going to fork for $entry");
                if ($children[$counter] = fork) {
        
                    if ($counter == $nm-1) {
                        close(WRITE);
                    }
    
                } else {
    
                    die "cannot fork: $!" unless defined $children[$counter];
                    open (STDERR, ">&=STDOUT");
                    open (STDOUT, ">&=WRITE");
                    exec ("cvs", "-n", "up", "-R", "$entry");
    
                }
    
                $counter++;
            }
    
        }

        while (<READ>) {
            chomp $_;
            _logger( "removegenerated $_" );
            print DBG "$_\n";
            ($action, $name) = split(/ /, $_);
            if ($action =~ /^\?$/) {
                if (-f $name) {
                    print DBG "file: $name\n";
                    unlink ($name) || die "unlink: $?";
                }
                if (-d $name) {
                    print DBG "directory: $name\n";
                    rmtree ($name) || die "rmtree: $?";
                }
    
            }
            if ($action =~ /M/) {
                if ($name =~ /\.tar$/ic || $name =~ /\.zip$/ic 
                    || $name =~ /\.war$/ic || $name =~ /\.jar$/ic
                    || $name =~ /\.car$/ic) {
                    if (! -d "/tmp/$job" ) { 
                        system("mkdir -p /tmp/$job");
                    }
                    $archive = basename($name);
                    print DBG "File updated by build: $name\n";
                    system("cp $name /tmp/$job");
                    unlink($name);
                    system ("cvs up -dP $name >/dev/null 2>&1");
                    $bcommit = jdiff($name, "/tmp/$job/$archive");
                    print DBG "bcommit: $bcommit\n";
                    if ($bcommit) {
                        system("cp /tmp/$job/$archive $name >/dev/null 2>&1");
                        system("cvs ci -m \"auto-checkin of $archive from build $num of $job\" $name");
                        print DBG "cvs ci -m \"auto-checkin of $archive from build $num of $job\" $name";
                    }
                } else {
                    print DBG "merge found: $name\n";
                    unlink($name);
                    system ("cvs up -dP $name >/dev/null 2>&1");
                }
            }
        }

        close(READ);
        close(DBG);
    
        foreach $c (@children) {
            waitpid($c, 0);
        }

    } elsif ($sccs =~ /^perforce$/) {

        if (! -f ".p4list.txt") {
            _logger("no .p4list.txt for job $job\n");
            return 0;
        }

        open(I, "<.p4list.txt");
        @modules = <I>;
        close(I);

        my @vmodules;

        my @children;
        my $counter = 0;
        my $nm = @modules;
        my $archive;
        my $bcommit;

        my $here = $ENV{"PWD"};
    
        foreach $entry (@modules) {
            chomp $entry;
            if (-d $entry) {
                push @vmodules, $entry;
            }
        }

        my $nm = @vmodules;

        _logger( "opening read/write pipe" );
        pipe(READ, WRITE);
        _logger( "pipe opened" );
    
        foreach $entry (@vmodules) {

            chomp $entry;

            _logger("processing $entry");
            if ($entry =~ /^!/) {
                $entry =~ s/^!//g;
            }
    
            if ( -d "$dir/$entry") {

                print "chdir to $dir/$entry\n";

                $ENV{"PWD"} = "$dir/$entry";

                _logger("going to fork $entry");

                if ($children[$counter] = fork) {
        
                    if ($counter == $nm-1) {
                        close(WRITE);
                    }
    
                } else {

                    die "cannot fork: $!" unless defined $children[$counter];
                    open (STDERR, ">&=STDOUT");
                    open (STDOUT, ">&=WRITE");
                    chdir "$dir/$entry" || die "chdir: $?";
                    exec ("c4", "update", "-n", "...");
    
                }
    
                $counter++;
            }
    
        }

        while (<READ>) {

            chomp $_;

            if ($_ !~ /^Directory/) {
        
                if ($_ =~ /^\?\?\?/) {
                    my $fn = $_;
                    $fn =~ s/\?+//g; 
                    $fn =~ s/^ +//g; 
                    $fn =~ s/^\t+//g; 
                    $fullname = _getfullpath($fn, @vmodules);
                    print("rm $fullname\n");
                    unlink($fullname) || warn "unlink: $?";
                } elsif ($_ =~ /^edit/) {
                    $fn = $_;
                    $fn =~ s/^edit//g; 
                    $fn =~ s/^ +//g; 
                    $fn =~ s/^\t+//g; 
                    $fullname = _getfullpath($fn, @vmodules);
                    if ( $fullname !~ /propert/) {
                        my $archive = basename($fullname);
                        print "cp $fullname /tmp/$job/$archive\n";
                        system("cp $fullname /tmp/$job/$archive");
                        print("c4 sync -f $fullname");
                        system("c4 sync -f $fullname");
                        print "jdiff $fullname /tmp/$job/$archive\n";
                        my $isdiff = jdiff("$fullname", "/tmp/$job/$archive");
                        print "isdiff = $isdiff\n";
                        if ($isdiff) {
                            $bHaschange = 1;
                            print("cp /tmp/$job/$archive $fullname\n");
                            system("cp /tmp/$job/$archive $fullname");
                            system ("c4 open $fullname");
                        }
                    } else {
                        print "c4 sync -f $fullname\n";
                        system("c4 sync -f $fullname");
                    }
                }
            }
        }

        close(READ);
        close(DBG);
    
        foreach $c (@children) {
            waitpid($c, 0);
        }

        if ($bHaschange) {
            print("c4 change -o |sed \"s/<enter description here>/auto checkin from $job $num/g\" |c4 submit -i");
            system("c4 change -o |sed \"s/<enter description here>/auto checkin from $job $num/g\" |c4 submit -i");
        }

    }

}

sub _getfullpath {

    my $name = shift;
    my @mods = @_;

    my $entry;
    
    $name =~ s/^\.\///g;

    foreach $entry (@mods) {

        if ( -f "$dir/$entry/$name") {
            return "$dir/$entry/$name";
        }
    }

    return "NOTFOUND: $name";

}

sub jdiff {

    my $verbose = 0;
    my $reallyverbose = 0;

    my $file1    = shift;
    my $file2    = shift;
   
    my $members1;
    my $members2;

    my $checksum1;
    my $checksum2;

    my @memberarray1;
    my @memberarray2;

    my @sp;
    my $sc;

    my $ret;

    my $m1;
    my $m2;

    #
    # Make sure the list files exist...
    #
    die "$file1 not readable" if ! -r $file1;
    die "$file2 not readable" if ! -r $file2;

    #
    # Stat the files, if the sizes have changed, then so have the 
    # contents...
    #
    my @stat1 = stat($file1);
    my @stat2 = stat($file2);

    #
    # The 8th element in the stat array is the size (see stat and lstat)
    #
    if ($stat1[7] != $stat2[7]) {
        if ($verbose) {
            print STDERR "jdiff diffs found: filesize ($file1, $file2)\n";
        }
        return 1;
    }

    my $zip1 = Archive::Zip->new();
    my $zip2 = Archive::Zip->new();
    
    if ($verbose) {
        print STDERR "reading $_[0]\n";
    }

    die "whoops" if $zip1->read($file1) != AZ_OK;
    die "whoops" if $zip2->read($file2) != AZ_OK;

    #
    # This will probably never happen, but if for some chance the jar
    # sizes are the same but the number of files in the archive are 
    # different, write to log file...
    #
    $members1 = $zip1->numberOfMembers();
    $members2 = $zip2->numberOfMembers();

    if ($members1 != $members2) {
        if ($verbose) {
            print STDERR "jdiff diffs found: members ($file1, $file2)\n";
        }
        return 1;
    }

    #
    # Generate sorted member arrays...
    #
    @memberarray1 = sort($zip1->memberNames());
    @memberarray2 = sort($zip2->memberNames());

    #
    # Use the first list for testing the second, there are 
    # the same number of entries, so if one has been renamed, we'll
    # find it below...
    #
    foreach (@memberarray1) {
        #
        # We just want the file name...
        #
        @sp = split(/\//, $_);
        $sc = @sp;

        #
        # Get information about the entry in the first jar archive...
        #
        $m1 = $zip1->memberNamed($_);

        #
        # We don't care about directories...
        #
        if (! $m1->isDirectory()) {
            
            #
            # This is where we'll catch the renaming of a file...
            #
            $m2 = $zip2->memberNamed($_);
            if (! defined($m2)) {
                if ($verbose) {
                    print STDERR "jdiff diffs found: noexist ($file1, $file2)\n";
                }
                return 1;
            }

            #
            # Ignore the manifest...
            #
            if ("$sp[$sc-1]" !~ "MANIFEST.MF") {

                #
                # Get 32bit CRC's for entries...
                $checksum1 = $m1->crc32String();
                $checksum2 = $m2->crc32String();

                if ($reallyverbose) {
                    $file1 =~ s/\\/\//g;
                    $file2 =~ s/\\/\//g;
                    print STDERR "\ncrc32 for $file1\->$_: $checksum1\n";
                    print STDERR "crc32 for $file2\->$_: $checksum2\n";
                }

                #
                # If the checksums aren't the same return 1...
                #
                if ($checksum1 !~ /^$checksum2$/) {
                    if ($verbose) {
                        print STDERR "jdiff: checksums ($file1\->$_, $file2\->$_)\n";
                    }
                    return 1;
                }
            }
        }
    }

    return 0;

}

sub logfile {

    open (F, ">>$dir/jdiff.out");
    print F "$_[0], $_[1]\n";
    close(F);
}

sub process_file {

    my $dir;

    $fullname = $File::Find::name;

    if (! -d "$fullname" && $fullname =~ /.cvsignore$/) {

        $file = basename($fullname);
        $dir  = dirname($fullname);

        if ($file =~ /\.cvsignore/) {
    
            _logger( "process_file opening $dir/$file" );
            open (CVSIG, "$dir/$file" ) || die "open: $?";
            @contents = <CVSIG>;
            close(CVSIG) || die "close: $?";
    
            foreach $line (@contents) {
    
                chomp $line;
    
                if ( -f "$file" ) {
                    unlink("$dir/$line");
                }
            }
    
        }
    }

}

sub _logger {

    my $string = shift;

    my $formattime;
    my $reqtime = scalar localtime;

    print "[$reqtime]: $string\n";

}