#
# 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.
#
#############################################################################
#
# Here's the list of calls used by the buildserver and associated
# utilities which need to be created for other cm systems.
#
# {cmssystem}_logfilelist
#
#     Log build changes to SQL
#
# {cmssystem}_client
#
#     Return the name of the client (perforce has exclusions by 
#                                    directory name which need
#                                    to be 'trimmed' off.  CVS
#                                    just returns the name sent 
#                                    to it).
# {cmssystem}_formatclientstring
# 
#     Format the name of the client (if needed).  For Perforce
#     it's clientname@p4port.
#
# {cmssystem}_clientport
#
#     Return formatted array with the name and port used by the
#     job.  Used in describe command.
#
# {cmssystem}_stdoutupdate
#
#     Build list of changes to stdout, returned to buildserver for
#     the nextjob command.
#
# {cmssystem}_lastcheckout
#
#     Return formatted list of files used in the last or current 
#     build.  The list may include html tags, and should be able 
#     to grab email addresses.  Used in multiple locations.
#
# {cmssystem}_initchangeno
#
#     Return an initial change number associated with the build.
#     This number will be displayed as the build starts.  Perforce
#     provides actual change numbers, cvs is a unique ID based 
#     upon a date/time stamp.
#
# {cmssystem}_update
#
#     Populate the build trees with real data from the CM system.
#
# {cmssystem}_realchangeno
#
#     Get actual change number for the build.  This happens after
#     the update has completed.  Perforce will have a real change
#     number, CVS is generated from a date/time stamp of the last
#     file(s) checked out.
#
# {cmssystem}_identity
#
#     Create the string shown in the rollover of the CM system
#     icon (like changelist@server:port)
#
# {cmssystem}_useraddress
#
#     Create a string of address:fullname from CM system
#
# {cmssystem}_formaturl
#
#     Create a string of using defined browser, filename and version
#
# {cmssystem}_useradmin
#
#     Create/Delete a user account in CM system
#
# detectsccs
# 
#     Determine what sccs is running by port description 
#     Update when any new sccs system is added
#
#############################################################################

package cmbroker;

BEGIN{push @LIB, "lib";}

our ($VERSION);

$VERSION = "1.0";

use Carp;
use HTTP::Date;
use IO::Handle;
use POSIX qw (:sys_wait_h);
use Sys::Hostname;

my $hostname = hostname();

require "$hostname.pm";

#
# Change to winsys for M$
#
use IO::Handle;

my $config       = new $hostname;

#
# Change to winsys for M$
#
my $p4user       = $config->P4USER;
my $p4pass       = $config->P4PASSWD;
my $TMPDIR       = $config->BTMP;
my $nulldev      = $config->NULL;

my $logger = 0;

#
# The buildserver needs to be handled differently
# on a non-posix system (Windows)
#
my $POSIX = 1;

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

require "$ospackage.pm";

my $os = new $ospackage;

sub usage {

    my $function = shift;
    my $args     = shift;

    print "\n$function() usage:\n";
    print "\n\t$function($args)\n";


}
#
# Log changes to sql
#
sub perforce_logfilelist {

    my $self    = shift;
    my $title   = shift;
    my $buildno = shift;
    
    #
    # sql stuff
    #
    my $sqlquery;
    my @sqlarray;
    my @sqlsubmit;
    my @empty;

    #
    # Client information
    #
    my $port;
    my $client;
    my $top;
    my $p4client;

    my $p4cmd;

    #
    # Number of recs returned from SQL
    #
    my $numrecs;

    #
    # A var to hold lines from the filelog
    #
    my $line;

    #
    # Usage message
    #
    if (!defined($title) || !defined($buildno)) {
        usage("perforce_logfilelist", "jobtitle, buildnumber");
        return;
    }

    #
    # Get job information
    #
    $sqlquery = "select port,client,top from configuration where binary ".
                "title=\"$title\" and binary server=\"$hostname\"";
    @sqlarray = $os->run_sql_query($sqlquery, ";");
 
    #
    # See if we got any records
    #
    $numrecs = @sqlarray;

    if (!$numrecs) {
        return 0;
    } 

    #
    # Grab info needed for logging
    #
    ($port, $client, $top) = split(/;/, $sqlarray[0]);
    $p4client = $self->perforce_client("$client");
  
    #
    # Construct command line
    #
    $p4cmd = "p4 -u $p4user -p $port -P $p4pass -c $p4client";

    #
    # Open sync log and read through contents.
    #
    open(CHANGES,"<$top/$title.sync.log");
    while (<CHANGES>) {

        # 
        # Strip newline
        #
        chomp;

        #
        # Perforce record
        #
        my @p4rec = split(/ - /, $_);

        #
        # Get file and version
        #
        my ($file, $version) = split(/#/, $p4rec[0]);

        if ($p4rec[1] =~ /deleted as/) {
            $version++;
        }

        my @p4log = `$p4cmd filelog -m 1 \"$file#$version\"`;

        #
        # Read through the filelog
        #
        foreach $line (@p4log) {
      
            #
            # See if we've found the version we're looking for
            #
            if ($line =~ /... #$version /) {
                my @commitinfo = split(/ /, $line);
                my ($cuser, $cemail) = split(/\@/, $commitinfo[8]);
              
                push @sqlsubmit, "$hostname";
                push @sqlsubmit, "$title";
                push @sqlsubmit, "$buildno";
                push @sqlsubmit, "$file;$version;$commitinfo[3];$cuser";
                
                if (!$os->run_sql_submit("changes", @sqlsubmit)) {
                    print STDERR "failed to write record to changes ".
                                 "table: $title $buildno\n";
                }

                @sqlsubmit = @empty;
            }

        }
    }

    close(CHANGES);

    return $numrecs;
}

#
# Log changes to sql
#
sub cvs_logfilelist {

    my $self    = shift;
    my $title   = shift;
    my $buildno = shift;

    #
    # Number of recs returned from SQL
    #
    my $numrecs;

    my $tmpdir = sprintf "%s/%s", $TMPDIR, $title;

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

    #
    # Usage message
    #
    if (!defined($title) || !defined($buildno)) {
        usage("cvs_logfilelist", "jobtitle, buildnumber");
        return;
    }

    #
    # Get job information
    #
    $sqlquery = "select port,client,top from configuration where binary ".
                "title=\"$title\" and binary server=\"$hostname\"";
    @sqlarray = $os->run_sql_query($sqlquery, ";");

    $numrecs = @sqlarray;
    
    if (!$numrecs) {
        return 0;
    }

    open (CHANGES, "<$tmpdir/cvsupdate");

    while (<CHANGES>) {
        
        chomp;
        
        push @sqlsubmit, "$hostname";
        push @sqlsubmit, "$title";
        push @sqlsubmit, "$buildno";
        push @sqlsubmit, "$_";
                
        if (!$os->run_sql_submit("changes", @sqlsubmit)) {
            print STDERR "failed to write record to changes ".
                         "table: $title $buildno\n";
        }

        @sqlsubmit = @empty;

    }

    return $numrecs;

}


#
# Return valid client name
#
sub perforce_client {

    my $self   = shift;
    my $client = shift;

    #
    # Usage message
    #
    if (!defined($client)) {
        usage("perforce_client", "clientname");
        return;
    }

    my @full = split(/ /, $client);
    my $p4client = shift @full;

    return $p4client;
}

sub cvs_client {
 
    my $self   = shift;
    my $client = shift;

    #
    # Usage message
    #
    if (!defined($client)) {
        usage("cvs_client", "clientname");
        return;
    }

    return $client;
}
    
#
# Return formatted client string
#
sub perforce_formatclientstring {

    my $self   = shift;
    my $client = shift;
    my $port   = shift;

    my $return;

    #
    # Usage message
    #
    if (!defined($client) || !defined($port)) {
        usage("perforce_formatclientstring", "clientname, port");
        return;
    }

    my $p4client = $self->perforce_client("$client");

    $return = "\@".$p4client;

    return $return;

}

#
# Return formatted client string
#
sub cvs_formatclientstring {

    my $self   = shift;
    my $client = shift;
    my $port   = shift;

    my $return;

    #
    # Usage message
    #
    if (!defined($client) || !defined($port)) {
        usage("cvs_formatclientstring", "clientname, port");
        return;
    }

    $return = "";

    return $return;

}

#
# Return formatted url for a file
#
sub perforce_formaturl {

    my $self = shift;
    my $file = shift;
    my $ver  = shift;
    my $url  = shift;
    my $port = shift;

    my @p4exec;

    my $entry;
    my $return;

    #
    # Usage message
    #
    if (!defined($file) || !defined($ver) || 
        !defined($url)  || !defined($port)) {
        usage("perforce_formaturl", "file, ver, url, port");
        return;
    }

    my $p4cmd = "p4 -p $port -P $p4pass -u $p4user";

    @p4exec = `$p4cmd filelog -m 1 $file#$ver`;

    foreach $line (@p4exec) {
        if ($line =~ /\.\.\./) {
            my @p4rec = split(/ /, $line);
            $return = sprintf("$url", $p4rec[3]);
        }
    }
    return $return;
}

#
# Return formatted url for a file
#
sub cvs_formaturl {

    my $self = shift;
    my $file = shift;
    my $ver  = shift;
    my $url  = shift;
    my $port = shift;

    #
    # Usage message
    #
    if (!defined($file) || !defined($ver) || 
        !defined($url)  || !defined($port)) {
        usage("cvs_formaturl", "file, ver, url, port");
        return;
    }

    my $return;

    $return = sprintf("$url", $file, $ver);

    return $return;
}
            
#
# Return client/port information
#
sub perforce_clientport {

    my $self   = shift;
    my $client = shift;
    my $port   = shift;
    my $change = shift;
    my @cn;

    my @return;

    #
    # Usage message
    #
    if (!defined($client) || !defined($port)) {
        usage("perforce_clientport", "client, port, [change]");
        return;
    }

    my @full = split(/ /, $client);
    my $p4client = shift @full;

    if (defined($change)) {
        @cn = split(/\./, $change);
        push @return, "$p4client $cn[0]\@$port\n";
    } else {
        push @return, "Perforce client: $p4client on $port\n";
    }

    return @return;

}

#
# Return client/port information
#
sub cvs_clientport {

    my $self   = shift;
    my $client = shift;
    my $port   = shift;

    my @return;

    #
    # Usage message
    #
    if (!defined($client) || !defined($port)) {
        usage("cvs_clientport", "client, port");
        return;
    }

    push @return, "CVS module\(s\): $client\n";
    push @return, "CVS root\(s\): \"$port\"\n";

    return @return;

}

#
# Check files out to stdout
#
sub perforce_stdoutupdate {

    my $self   = shift;
    my $title  = shift;
    my $port   = shift;
    my $client = shift;
    my $top    = shift;
    my $dir    = shift;

    my $ignoreline;
    my $p4line;
    my $p4temp;
    my $numentries;
    my @return;

    my $p4client;

    #
    # Usage message
    #
    if (!defined($title)  || !defined($port) || 
        !defined($client) || !defined($top)  ||
        !defined($dir)) {
        usage("perforce_stdoutupdate", "title, port, client, top, dir");
        return;
    }

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

    $p4client = shift @list;

    $numentries = @list;

    my $p4cmd = "p4 -p $port -P $p4pass -u $p4user -c $p4client";

    my @contents = `$p4cmd sync -n 2>$nulldev`;

    foreach $ignoreline (@list) {
        $ignoreline =~ s/\//-/g;
        foreach $p4line (@contents) {
            $p4temp = $p4line;
            $p4temp =~ s/\//-/g;
            if ($p4temp !~ /^$ignoreline/) {
                push @return, $p4line;
            }
        }
    }

    if (!$numentries) {
        return @contents;
    } else {
        return @return;
    }

}

#
# Check files out to stdout
#
sub cvs_stdoutupdate {

    my $self   = shift;
    my $title  = shift;
    my $port   = shift;
    my $client = shift;
    my $top    = shift;
    my $dir    = shift;
 
    my @children;
    my @modules = split(/ /, $client);
    my @validmods;
    my $counter = 0;
    my $entry;
    my @contents;
    my $one;
    my $nm;
    my $NM;
    my $str;

    #
    # Usage message
    #
    if (!defined($title)  || !defined($port) || 
        !defined($client) || !defined($top)  ||
        !defined($dir)) {
        usage("cvs_stdoutupdate", "title, port, client, top, dir");
        return;
    }

    foreach $entry (@modules) {
        if ($entry !~ /^!/) {
            push @validmods, $entry;
        }
    }
 
    $NM = @modules;

    $nm = @validmods;

    chdir $top || die "chdir: to $top $? in cvs.stdoutupdate";

    #
    # Posix is good...
    #
    if ($POSIX) {

        pipe(READ, WRITE);

        READ->autoflush(1);
        WRITE->autoflush(1);
    
        foreach $entry (@modules) {

            if ($entry !~ /^!/) {

                if (! -d $entry) {
                    print STDOUT "cvs_stdoutupdate: no directory $entry\n";
                } 
        
                if ($children[$counter] = fork) {
        
                    if ($counter == $nm-1) {
                        close(WRITE) || die "close: $?";
                    }
        
                } else {

                    die "cannot fork: $!" unless defined $children[$counter];
                    open (STDOUT, ">&=WRITE");
                    open (STDERR, ">&=STDOUT");
                    exec ("cvs", "-n", "-d$port", "up", "-d", "-P", "$entry");
        
                }
        
                $counter++;

            }
    
        }
    
        while (<READ>) {

           if ($_ =~ /^cvs server:/) {
               if ($_ =~ /is no longer in the repository$/) {
                   $str = $_;
                   $str =~ s/^cvs server: //g;
                   $str =~ s/ is no longer in the repository$//g;
                   $str =~ s/^/D /g;
                   push @contents, $str;
               }
           }

           if ($_ !~ /^cvs server:/ ) {
               if ( $_ =~ /^[A-Z] /) {
                   push @contents, $_;
               }
           }
        }

        close(READ) || die "close: $?";

        foreach $one (@children) {
            waitpid($one, 0);
        }

    } else {

        #
        # Windows is bad...
        #
        @contents = $os->cvs_update($title, $port, "$client", 0);

    }

    chdir $dir || die "chdir: $dir $? in cvs.stdoutupdate";

    return @contents;

}

#
# Get individual user addresses
#
sub perforce_useraddress {

    my $self = shift;
    my $uid  = shift;
    my $port = shift;

    my $entry;
    my $email;
    my $fullname;

    #
    # Usage message
    #
    if (!defined($uid) || !defined($port)) {
        usage("perforce_useraddress", "userid, port");
        return;
    }

    my $p4cmd   = "p4 -u $p4user -p $port -P $p4pass";
    my @p4array = `$p4cmd user -o $uid`;

    foreach $entry (@p4array) {
        chomp $entry;
        if ($entry =~ /^Email:\t/) {
            ($null, $email) = split(/^Email:\t/, $entry);
        }
        if ($entry =~ /^FullName:\t/) {
            ($null, $fullname) = split(/^FullName:\t/, $entry);
        }
    }
    return "$email:$fullname";
}

#
# Get individual user addresses
#
sub cvs_useraddress {

    my $self = shift;
    my $uid  = shift;
    my $port = shift;

    my $cvsid;
    my $email;

    my $returnstring = "";

    #
    # Usage message
    #
    if (!defined($uid) || !defined($port)) {
        usage("cvs_useraddress", "userid, port");
        return;
    }

    #
    # Get a user list from CVS
    #
    @users = `cvs -d$port co -p CVSROOT/users`;

    #
    # Search for email address
    #
    foreach $entry (@users) {
        chomp $entry;
        ($cvsid, $email) = split(/:/, $entry);
        if ($uid =~ /^$cvsid$/)  {
            $returnstring = "$email:$cvsid";
        }
    }

    return $returnstring

}

#
# Look at last checkout
#
sub perforce_lastcheckout {

    my $self    = shift;
    my $port    = shift;
    my $client  = shift;
    my $top     = shift;
    my $job     = shift;
    my $number  = shift;
    my $makeurl = shift;

    #
    # Email hash reference for use by mailer
    #
    my $href    = shift;

    my @p4ret;
    my @contents;

    my %rechash;

    my $key;

    my $line;

    my $null;
    my $email;
    my $full;

    my $user;

    #
    # Usage message
    #
    if (!defined($port) || !defined($client) || 
        !defined($top)  || !defined($job)    ||
        !defined($number)) {
        usage("perforce_lastcheckout", 
              "port, client, top, job, [number, makeurl]");
        return;
    }

    my $p4client = $self->perforce_client("$client");

    my $sqlquery = "select job from changes where binary server=".
                   "\"$hostname\" and binary title=\"$job\" order by job ".
                   "desc limit 1";

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

    my $buildnum = $sqlarray[0];

    my $p4cmd = "p4 -p $port -P $p4pass -u $p4user";

    $sqlquery = "select changes from changes where binary server=".
                "\"$hostname\" and binary title=\"$job\" and ".
                "job=\"$buildnum\"";

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

    if (@sqlarray == 0) {
        @contents = `$p4cmd changes -m $number $p4client`;
    } else {
        foreach $line (@sqlarray) {
            my @rec = split(/;/, $line);
            push @contents, "$rec[0]#$rec[1]\n";
            $rechash{$rec[2]} = "$rec[3]";
        }
        push @contents, "\n";
    }

    foreach $key (keys %rechash) {
 
        my $newrec = 0;
        my $format;

        @p4ret = `$p4cmd describe -s $key`;

        foreach my $entry (@p4ret) {
            if ($entry =~ /^Change /) {
                my @rec = split(/ /, $entry);
                my $change = $rec[1];
                $format = sprintf("<a href=\"$makeurl\">%s</a>", 
                    $change, $change);
                $entry =~ s/ $change / $format /g;
                $user = $self->perforce_useraddress($rechash{$key}, $port);
                ($email, $full) = split(/:/, $user);
                if (defined($href)) {
                    $href->{$email} = "";
                }
                if (defined($makeurl)) {
                    $entry =~ 
                        s/ $rec[3] / \<a href=\"mailto\:$email\"\>$full\<a\> /g;
                    push @contents, $entry;
                } else {
                    push @contents, "Change $key by $full\n";
                }
            }
        }

    }

    return @contents;

}

#
# Look at last checkout
#
sub cvs_lastcheckout {

    my $self    = shift;
    my $port    = shift;
    my $client  = shift;
    my $top     = shift;
    my $job     = shift;
    my $number  = shift;
    my $makeurl = shift;

    #
    # Email hash reference for use by mailer
    #
    my $href    = shift;

    my $file;
    my $version;
    my $date;
    my $who;
    my $format;
    my $formatmail;

    my $entry;
    my $cvsid;
    my $email;
    my $emailstring = "<a href=\"mailto:%s\">%s</a>";

    my @contents;

    my @users;

    #
    # Usage message
    #
    if (!defined($port) || !defined($client) || 
        !defined($top)  || !defined($job)    ||
        !defined($number)) {
        usage("cvs_lastcheckout", 
              "port, client, top, job, [number, makeurl]");
        return;
    }

    #
    # We can get the latest info from the update file created
    # by the job rather than through SQL
    #
    if (-f "$TMPDIR/$job/cvsupdate") {
        open (FILECON, "<$TMPDIR/$job/cvsupdate");
        if (defined($makeurl)) {
            while (<FILECON>) {
                chomp $_;
                ($file,$version,$date,$who) = split(/;/,$_);

                $user = $self->cvs_useraddress($who, $port);
                ($email, $cvsid) = split(/:/, $user);

                $formatmail = sprintf("$emailstring", $email, $cvsid);

                if (defined($href)) {
                    $href->{$email} = "";
                }
             
                $format = sprintf("<a href=\"$makeurl\">%s</a> by %s\n", 
                                  $file, $version, $file, $formatmail);
                push @contents, $format;
            }
        } else {
            @contents = <FILECON>;
        }
        close (FILECON);
    }

    return @contents;

}

#
# Get initial change number
#
sub perforce_initchangeno {

    my $self = shift;
    my $port = shift;

    my @p4info;

    #
    # Usage message
    #
    if (!defined($port)) {
        usage("perforce_initchangeno", "port");
        return;
    }

    open (FILECON, "p4 -p $port -P $p4pass -u $p4user counters |grep change|") 
         || die "open: p4 -p $port -P $p4pass -u $p4user counters $?";

    my @countout = <FILECON>;
    close(FILECON);

    @p4info = split(/ /,$countout[0]);

    return $p4info[2];

}

#
# Get initial change number
#
sub cvs_initchangeno {

    my $self = shift;
    my $port = shift;
 
    my $buildnum;

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
        localtime(time());

    #
    # Usage message
    #
    if (!defined($port)) {
        usage("cvs_initchangeno", "port");
        return;
    }

    $buildnum = sprintf("%03d.%02d%02d.%02d%02d%02d", $year, $mon+1, $mday,
        $hour, $min, $sec);

    return $buildnum;

}

#
# Update files from the tree
#
sub perforce_update {

    my $self   = shift;
    my $title  = shift;
    my $port   = shift;
    my $client = shift;
    my $top    = shift;
    my $dir    = shift;

    #
    # Usage message
    #
    if (!defined($title)  || !defined($port) || 
        !defined($client) || !defined($top)  ||
        !defined($dir)) {
        usage("perforce_update", "title, port, client, top, dir");
        return;
    }

    my @full = split(/ /, $client);
    my $p4client = shift @full;
    print STDERR "syncing files from perforce\n";
    
    $os->forkprocess ("p4 -u $p4user -p $port -P $p4pass -c $p4client sync ".
                      ">$top/$title.sync.log", 1, 0);
   
}

#
# Update files from the tree
#
sub cvs_update {

    my $self   = shift;
    my $title  = shift;
    my $port   = shift;
    my $client = shift;
    my $top    = shift;
    my $dir    = shift;
 
    my @children;
    my @modules = split(/ /, $client);
    my $counter = 0;
    my $entry;
    my $nm = @modules;
    my $one;

    #
    # Usage message
    #
    if (!defined($title)  || !defined($port) || 
        !defined($client) || !defined($top)  ||
        !defined($dir)) {
        usage("cvs_update", "title, port, client, top, dir");
        return;
    }

    chdir $top || die "chdir: $! in cvs.update";

    #
    # Posix is good...
    #
    if ($POSIX) {

        pipe(READ, WRITE);
    
        foreach $entry (@modules) {
    
            $entry =~ s/^!//g;

            if ($children[$counter] = fork) {
    
                if ($counter == $nm-1) {
                    close(WRITE);
                }
    
            } else {
    
                die "cannot fork: $!" unless defined $children[$counter];
                open (STDOUT, ">&=WRITE");
                open (STDERR, ">&=STDOUT");
                exec ("cvs", "-d$port", "up", "-d", "-P", "$entry");
    
            }
    
            $counter++;
    
        }
    
        open (SYNCLOG, ">$top/$title.sync.log") 
            || die "open $top/$title.sync.log: $!";
        while (<READ>) {
           if ($_ =~ /^cvs server:/) {
               if ($_ =~ /is no longer in the repository$/) {
                   $str = $_;
                   $str =~ s/^cvs server: //g;
                   $str =~ s/ is no longer in the repository$//g;
                   $str =~ s/^/D /g;
                   print SYNCLOG $str;
               }
           }

           if ($_ !~ /^cvs server:/ ) {
               if ( $_ =~ /^[A-Z] /) {
                   print SYNCLOG "$_";
               }
           }
        }
    
        close(READ);
        close(SYNCLOG);
    
        foreach $one (@children) {
            waitpid($one, 0);
        }

    } else {

        #
        # Windows is bad...
        #
        my @contents = $os->cvs_update($port, "$client", 1);
        open (SYNCLOG, ">$top/$title.sync.log");
        foreach $entry (@contents) {
            print SYNCLOG $entry;
        }
        close(SYNCLOG);

    }

    chdir $dir || die "chdir: $? in cvs.stdoutupdate";

}

#
# Get real change number
#
sub perforce_realchangeno {

    my $self   = shift;
    my $port   = shift;
    my $client = shift;
    my $top    = shift;
    my $dir    = shift;
    my $title  = shift;
    my $tmp    = shift;

    my @p4info;

    #
    # Usage message
    #
    if (!defined($port) || !defined($client) || 
        !defined($top)  || !defined($dir)    ||
        !defined($title)) {
        usage("perforce_realchangeno", "port, client, top, dir, title");
        return;
    }

    my @full = split(/ /, $client);
    my $p4client = shift @full;

    my $p4cmd = "p4 -u $p4user -P $p4pass -p $port -c $p4client";

    my $change = `$p4cmd changes -m1 \@$p4client`;

    @p4info = split(/ /,$change);

    return $p4info[1];

}

#
# Get real change number
#
sub cvs_realchangeno {

    my $self   = shift;
    my $port   = shift;
    my $client = shift;
    my $top    = shift;
    my $dir    = shift;
    my $title  = shift;
    my $tmp    = shift;
    my $curid  = shift;

    #
    # Usage message
    #
    if (!defined($port)  || !defined($client) || 
        !defined($top)   || !defined($dir)    ||
        !defined($title) || !defined($tmp)    ||
        !defined($curid)) {
        usage("cvs_realchangeno", 
              "port, client, top, dir, title, tmpdir, tmpjobno");
        return;
    }

    # 
    # Hold this for the most recent entry...
    #
    my $lastchange;

    #
    # Time for setting a real change number
    #
    my $mtime = 0;
    my $otime = 0;
    my $str;

    my $lineno = 0;

    #
    # File action and the filename
    #
    my $action;
    my $file;
    my $branch;

    #
    # Array for all updated files
    #
    my @updated;
    my @fileinfo;
    my @revision;
    my @clog;
    my @revs;
    my @allinfo;

    my @emptyarray;

    #
    # The current entry
    #
    my $entry;
    my $line;
    my $logline;
    my $date;
    my $time;
    my $gmtime;
    my $author;
    my $string;
    my $deletion;

    my $linecnt = 0;
    my $bNotd   = 0;
    my $bDel    = 0;

    $gmtime = time;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
        = gmtime($gmtime);

    #
    # cd to the top of the build (where the log is)
    #
    chdir $top || die "chdir: $? cvs.realchangeno";

    #
    # Make sure there's a sync log
    #
    if (! -f "$top/$title.sync.log") {
        chdir $dir || die "chdir: $? cvs.realchangeno";
        return -1;
    } else {
        open (CVSLOG, "<$top/$title.sync.log");
        @updated = <CVSLOG>;
        close(CVSLOG);
    }
        
    open(CVSLOG, ">$tmp/cvsupdate");

    foreach $entry (@updated) {

        ($action, $file) = split(/ /, $entry);
        chomp $file;

        # my @cvscommand = `cvs -d$port login`;
        if ($action !~ /^\?$/ || $action !~ /^D/) {
            @fileinfo = `cvs -d$port status $file`;
        } else {
            @fileinfo = @emptyarray;
        }

        if ($action !~ /^D/) {

            # We found something other than a deletion
            #
            $bNotd = 1;

            foreach $line (@fileinfo) {
    
                chomp $line;
        
                if ($line =~ /Working revision:/) {
    
                    @revision= split(/:/,$line);
                    $revision[1] =~ s/\t//g;

                    @revs = _findmissedrevs($title, $file, $revision[1], 
                                            $port);
                    push @revs, $revision[1];

                    foreach my $logrevs (@revs) {

                        @clog = `cvs -d$port log -N -r$logrevs $file`;
    
                        foreach $logline (@clog) {
    
                            chomp $logline;
                    
                            if ($logline =~ /^branch:/) {
                                $branch = $logline;
                            }
                        
                            if ($logline =~ /^date:/) {
                                $dateline = $logline;
        
                                @allinfo = split(/;/,$dateline);
    
                                ($null,$date,$time) = split(/ /,$allinfo[0]);
                                ($null,$null,$null,$author) 
                                    = split(/ /,$allinfo[1]);
                                $mtime = str2time("$date $time");
        
                                if ($mtime > $otime) {
                                    $lastchange = 
                                        "$file;$logrevs;$date ".
                                        "$time;$author\n";
                                    $otime = $mtime;
                                    $newestupdate = "$date $time";
                                }
    
                                print CVSLOG "$file;$logrevs;$date $time;".
                                             "$author\n";
                            }
    
                        }
    
                    }
    
                }
            }
        } else {
            $bDel = 1;
            $str = sprintf ("%04d/%02d/%02d %02d:%02d:%02d", 
                             $year+1900, $mon+1, $mday+1, $hour, 
                             $min, $sec);
            $deletion = _GetCVSLogs($file, $port);
            if (!defined($deletion)) {
                print CVSLOG "$file;NA;$str;removed\n";
            } else {
                print CVSLOG "$deletion\n";
            }
        }

        $linecnt++;
    }

    close(CVSLOG);
    open(CVSLOG, ">$tmp/cvslast");
    print CVSLOG "$lastchange";
    close(CVSLOG);

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 
        = localtime($otime);

    if ($linecnt > 0) {
        $str = sprintf("%03d.%02d%02d.%02d%02d%02d", $year, $mon+1, $mday, 
            $hour, $min, $sec);
    }

    chdir $dir ||die "chdir: $? cvs.realchangeno";

    if ($linecnt > 0 && $bNotd) {
        return $str;
    } elsif ($bDel && !$bNotd) {
        return $curid;
    } else {
        return "0";
    }

}

sub _GetCVSLogs {

    my $self = shift;
    my $file = shift;
    my $port = shift;

    my @filelog;
    my $line;
    my $bStart = 0;
    my $bVer   = 0;
    my $verstring;

    my @authfields;

    @filelog = `cvs -d$port rlog $file`;

    foreach $line (@filelog) {

        chomp $line;

        if ($bVer) {
            if ($line =~ /dead/ ) { 
                $verstring =~ s/revision //g;
                @authfields = split(/;/, $line);
                $authfields[0] =~ s/date://g;
                $authfields[0] =~ s/^ //g;
                $authfields[1] =~ s/author://g;
                $authfields[1] =~ s/ //g;
                return "$file;$verstring;$authfields[0];$authfields[1] ".
                       "(removed)";
            }
            $bVer   = 0;
        }

        if ($bStart) {
            $verstring = $line;
            $bVer   = 1;
            $bStart = 0;
        }

        # startrec
        if ($line =~ /----------------------------/) {
            $bStart = 1;
        }
    }

    return undef;

}

#
# Create identity for the job
#
sub perforce_identity {

    my $self      = shift;
    my $change    = shift;
    my $port      = shift;
    my $cgiaccess = shift;

    #
    # Usage message
    #
    if (!defined($change) || !defined($port) || !defined($cgiaccess)) {
        usage("perforce_identity", "changeno, port, cgiaccess");
        return;
    }

    my ($realchange, $jobno) = split(/\./, $change);

    my @realport = split(/ /, $port);
    my $numrecs  = @realport;

    if (defined($cgiaccess)) {
       if (defined($jobno)) {
           $string = sprintf("<a href=$cgiaccess>%s</a>", $realchange, 
                             $jobno);
       } else {
           $string = sprintf("<a href=$cgiaccess>%s</a>", $realchange, 
                             $realchange);
       }
    } else {
       $string = "$realchange\@$realport[$numrecs-1]";
    }

    return $string;

}

#
# Create identity for job
#
sub cvs_identity {

    my $self      = shift;
    my $change    = shift;
    my $server    = shift;
    my $cgiaccess = shift;

    #
    # Usage message
    #
    if (!defined($change) || !defined($port) || !defined($cgiaccess)) {
        usage("cvs_identity", "changeno, port, cgiaccess");
        return;
    }

    my @realport = split(/ /, $server);
    my $numrecs  = @realport;

    if (defined($cgiaccess)) {
        my @cn = split(/;/, $change);
        $string = sprintf("<a href=$cgiaccess>$cn[1]</a>", $cn[0], $cn[1]);
    } else {

        $year = substr($change, 0, 3);
        $mon  = substr($change, 4, 2);
        $day  = substr($change, 6, 2);
        $hour = substr($change, 9, 2);
        $min  = substr($change, 11, 2);
        $sec  = substr($change, 13, 2);

        $year += 1900;

        $string = "$mon/$day/$year $hour:$min:$sec\n$realport[$numrecs-1]";
    }

    return $string;

}

#
# Perforce adduser routine
#
sub perforce_useradmin {

    my $self      = shift;
    my $port      = shift;
    my $user      = shift;
    my $first     = shift;
    my $last      = shift;
    my $mail      = shift;
    my $group     = shift;
    my $operation = shift;

    my $ret;

    my @ret;
    my $entry;

    my $file;
    my $command;

    my $bFound = 0;

    my $p4args = "-p $port -u $p4user -P $p4pass";

    #
    # Check to see if the port is valid
    #
    @ret = _runcommand("p4 $p4args info 2>$nulldev");
    
    #
    # If the port is valid, this will be 0
    #
    if ($ret[0] =~ /^$/) {
        return "command failed: invalid perforce port";
    }

    #
    # See if the user already exists
    #
    @ret = `p4 $p4args users`;

    foreach $entry (@ret) {
      
        #
        # If a user is here and we're adding a record
        #
        if ($entry =~ /^$user/ic && !$operation) {
            return "command failed: user already exists";
        } elsif ($entry =~ /^$user/ic && $operation) {
            #
            # We're looking for a record to delete
            #
            $bFound = 1;
        }
    }

    #
    # If there's no record found on a delete operation
    #
    if ($operation && !$bFound) {
        return "command failed: no user $user on $port";
    }

    #
    # Reset bFound...
    #
    $bFound = 0;

    #
    # Read groups into an array
    #
    @ret = `p4 $p4args groups`;

    #
    # Search for a valid group
    #
    foreach $entry (@ret) {
        if ($entry =~ /^$group/ic) {
            $bFound = 1;
        }
    }

    #
    # If a group wasn't found
    #
    if (!$bFound) {
        return "command failed: group $group does not exist";
    }

    $file = "$TMPDIR/user.$user";

    #
    # If we're adding a user
    #
    if ($operation) {
        $command = `p4 $p4args user -f -d $user` || 
            return "command failed: failed to delete $user";
    } else {
        #
        # Create a userspec for perforce
        #
    
        open (UAC, ">$file") || die "cannot open user file: $?";
        print UAC "User: $user\n";
        print UAC "Email: $mail\n";
        print UAC "FullName: $first $last\n";
        close(UAC);

        #
        # Add user to Perforce
        #
        $commmand = `p4 $p4args user -i -f < $file`;

        unlink($file);
    } 

    #
    # Read in group information
    #
    @ret = `p4 $p4args group -o $group`;

    #
    # Write group information
    #
    open (UAC, ">$file");

    #
    # Update the group rec
    #
    foreach $entry (@ret) {
        if ($operation) {
            chomp $entry;
            $entry =~ s/$user//ic;
            print UAC "$entry\n";
        } else {
            print UAC $entry;
        }
    }

    #
    # If this is an add append to the file.
    #
    if ($operation) {
        print STDERR "operation is set\n";
    } else {
        print UAC "\t$user\n";
    }

    close(UAC);

    #
    # Update group information in perforce
    #
    $commmand = `p4 $p4args group -i < $file` || 
        return "command failed: failed to update group $group";

    print STDERR "command is done\n";

    if ($operation) {
        return "$user deleted from $port";
    } else {
        return "$user added to $port";
    }

}

#
# Adduser for CVS
#
sub cvs_adduser {
    
    my $self      = shift;

    return "not implemented yet";

}

sub _runcommand {
    
    my $self    = shift;
    my $command = shift;

    print STDERR "running $command\n";

    @ret = `$command` || return undef;

    return @ret;
    
} 

sub _findmissedrevs {

    my $self  = shift;
    my $title = shift;
    my $file  = shift;
    my $crev  = shift;
    my $port  = shift;

    #
    # sql declarations
    #
    my $sqlquery;
    my @sqlarray;

    #
    # declarations for current revision
    #
    my @ver;
    my $cnums;

    #
    # declarations for previous revisions
    #
    my $pfile;
    my $prev;
    my $pdate;
    my $pwho;
    my $pnums;
    my @pver;
    my $pnums;
    my $pverstring;

    #
    # Misc declarations
    #
    my $bBadrec = 0;
    my $missedrecs;
    my @return;
    my $rcount  = 0;

    #
    # Need to see how many fields are in the version
    # (no sequential revisions with cvs 1.2.3.123 yuuch)
    #
    @ver   = split(/\./, $crev);
    $cnums = @ver;

    _logger("_findmissedrevs $title $file $crev $port");

    #
    # Search for last log entry for $file
    #
    $sqlquery = "select changes from changes where binary ".
                "server=\"$hostname\" and binary title=\"$title\" ".
                "and changes rlike \"^$file\" order by job desc limit 1";
    _logger("_findmissedrevs $sqlquery");

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

    _logger("_findmissedrevs $sqlarray[0]");

    if ($sqlarray[0] !~ /^$/) {
        ($pfile, $prev, $pdate, $pwho) = split(/;/, $sqlarray[0]);

        @pver = split(/\./, $prev);
        $pnums = @pver;

        if ($cnums != $pnums) {
            _logger("unbalanced versions for $file, $crev, $prev");
            $bBadrec = 1;
        }

        $missedrecs = $ver[$cnums-1] - $pver[$pnums-1];

        _logger("_findmissedrevs missedrecs, $missedrecs");

        if (!$bBadrec) {

            _logger("_findmissedrevs goodrec!");

            my $start = $pver[$pnums-1];
            my $end   = $ver[$nums-1];
           
            #
            # We should only have a gap of 1 for a
            # standard record, otherwise there's been
            # multiple commits since the last build.
            #
            if ($missedrecs > 1) {
          
                $pverstring = $prev;

                _logger("_findmissedrevs missedrec found, $pverstring");

                for (my $c = $start+1; $c < $end; $c++, $start++) {
                    $pverstring =~ s/\.$start$/\.$c/g;
                    _logger("found missing rev for $file, $pverstring");
                    push @return, $pverstring;
                }

            } else {
                _logger("_findmissedrevs no missedrec");
            }

        }

    }

    $rcount = @return;

    if ($rcount) {
        _logger("_findmissedrec returning @return");
    }

    return @return;

}

#
# Routine to determine CM system from port
#
sub detectsccs {
 
    my $self = shift;
    my $port = shift;
    my $sccs = 'unknown';

    my @portarray;
    my $entries;

    if ($port =~ /\@/) {
        $sccs = 'cvs';
    }

    @portarray = split(/:/, $port);

    $entries = @portarray;

    if ($entries == 2) {
        $sccs = 'perforce';
    }

    return $sccs;

}

sub _logger {
 
    my $self   = shift;
    my $string = shift;

    my $formattime;
 
    if ($logger) {
        my $reqtime = scalar localtime;
        print "[$reqtime]: $string\n";
    }

}

#
# Do not edit anything below this line...
#
# Object constructor...
#
sub new {

    my $that = shift;
    my $class = ref($that) || $that;
    my $self = {
        %fields,
    };
    bless $self, $class;
    return $self;
}

#
# Autoload definitions in this package...
#
sub AUTOLOAD {

    my $self = shift;
    my $type = ref($self) || croak "$self is not an object";
    my $name = $AUTOLOAD;
    $name =~ s/.*://;
    unless (exists $self->{$name}) {
        croak "Can't access `$name` field in an object of class $type";
    }
    if (@_) {
        return $self->{$name} = shift;
    } else {
        return $self->{$name};
    }
}

1;