package jContinuousBuild;
use strict;
my $gLogFilename = "jContinuousBuild.log"; #the default name of the log
#---
# Known issues:
#- If the CM server and the client this script run on have different times,
# can cause a build to be missed. This occurs only for the first session.
#- If the build command takes longer than the interval, the time delays, etc.
# get confused
#- If the user does a sync/get/update outside of this script, the change
# detection mechanism gets confused
#---
# Enhancements:
#- add unit tests(?)
#- force clean/rebuild at 12::00AM? Forcing a clean once a day should
# detect some problems in the build commands i.e. incorrect dependencies
#- force clean/rebuild every n deltas. Forcing a clean once a day should
# detect some problems in the build commands i.e. incorrect dependencies
#------
#-- format the time for displaying to the log
sub formattime
{
my ($t) = @_;
my ($second, $minute, $hour, $day, $month, $year, $WeekDay, $DayOfYear, $IsDST) = localtime($t);
$year = $year + 1900;
$month = $month + 1;
my $s = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $year, $month, $day, $hour, $minute, $second);
return $s;
}
#------
#-- format the current time appropriately
sub formatnow
{
return formattime(time);
}
#------
#-- log an entry with a timestamp
sub logit
{
print formatnow(), " : ", @_;
open(FH, ">> $gLogFilename");
print FH formatnow(), " : ", @_;
close(FH);
}
#------
#-- execute a command and log it's return code
sub doit
{
my ($rconfig, $cmd) = @_;
my $show = $rconfig->{'Show'};
my $rc = system("$show$cmd");
logit("'$cmd': $rc\n");
return $rc;
}
#------
#-- generate listing for the given CM file into the given local file
sub CountChangedFiles
{
my ($rconfig, $from, $to) = @_;
my $count = 0;
foreach my $line ($rconfig->GetHistory($from, $to))
{
next if !defined $line;
next if !$rconfig->IsChanged($line, $from, $to);
$count++;
logit($line);
}
return $count;
}
#------
#-- save information about the last run
sub SaveLastRun
{
my ($t, $rc, $f) = @_;
open (FH, "> $f");
print FH "$t\n";
print FH $rc;
close(FH);
}
#------
#-- reload the information that was saved
#-- if file isn't found or can't be opened, set the values to defaults
sub LoadLastRun
{
my ($f) = @_;
my $t = 0;
my $rc = 0;
my $force = 0;
if (open(FH, "< $f"))
{
$t = <FH>;
$rc = <FH>;
$rc = 255 if !defined $rc;
close(FH);
}
else
{
print "Can't open file, setting default\n";
$t = time();
$rc = 0;
$force = 1;
}
return ($t, $rc, $force);
}
#------
#-- Do the sync/get/update from the CM depot/respository
sub DoSync
{
my ($rconfig) = @_;
my $x = $rconfig->GetSyncCommand();
my $rc = doit($rconfig, $x);
return $rc;
}
#------
#-- Do the clean
sub DoClean
{
my ($rconfig) = @_;
my $cleanwasdone = 0;
my $rc = 0;
if ($rconfig->{'DoMakeClean'})
{
$cleanwasdone = 1;
my $x = $rconfig->GetCleanCommand();
$rc = doit($rconfig, $x);
}
return ($rc, $cleanwasdone);
}
#------
#-- Do the build; retry if failed
sub DoBuild
{
my ($rconfig, $cleanwasdone) = @_;
my $bcmd = $rconfig->GetBuildCommand();
my $rc = doit($rconfig, $bcmd);
return $rc if $rc == 0; # all ok, all done.
return $rc if !$rconfig->{DoCleanOnFailure}; #user doesn't want us to do the clean&retry.
return $rc if $cleanwasdone; #no sense in doing the clean again
logit("Build failed, attempting clean & rebuild...\n");
($rc, $cleanwasdone) = DoClean($rconfig);
return $rc if $rc != 0; #clean failed, no sense in doing the build again
logit("Clean succeeded, attempting rebuild...\n");
$rc = doit($rconfig, $bcmd);
return $rc;
}
#------
#-- Do the post build step
sub DoPost
{
my ($rconfig) = @_;
my $x = $rconfig->GetPostBuildCommand();
return 0 if !defined $x;
return doit($rconfig, $x);
}
#------
#-- Build it
sub Build
{
my ($rconfig) = @_;
my $rc = 0;
$rc = DoSync($rconfig);
return $rc if $rc != 0;
my $cleanwasdone = 0;
($rc, $cleanwasdone) = DoClean($rconfig);
return $rc if $rc != 0;
$rc = DoBuild($rconfig, $cleanwasdone);
return $rc if $rc != 0;
$rc = DoPost($rconfig);
return $rc;
}
#------
#-- adjust the time to the nearest higher minute
sub AdjustTimeCeiling
{
my ($t) = @_;
return $t - ($t % 60) + 60;
}
#------
#-- adjust the time to the nearest lower minute
sub AdjustTimeFloor
{
my ($t) = @_;
return $t - ($t % 60);
}
#------
#-- sleep until the next scheduled time
sub WaitUntil
{
my ($rconfig, $to) = @_;
# the next scheduled time to run is now + the interval
$to = AdjustTimeFloor($to + $rconfig->{'Interval'});
my $sleeptime = $to - time();
# however, we may have been suspended or turned off or... so the calculation can become negative
return AdjustTimeFloor(time()) if ($sleeptime < 0);
#the normal case, sleep from now until the next scheduled time
print "waiting for $sleeptime seconds, at ", formattime($to),"\n";
sleep($sleeptime);
return $to;
}
#--------
#----------- MAIN ----------------------
#--------
#-- Scenarios:
#- save file does not exist: rebuild, save time and rc to file
#- could not read save file: rebuild, save time and rc to file
#- last build failed : rebuild, save time and rc to file
#- <60s since last build : skip build, do not save
#- no files changed : skip, save time and rc to file
#- 1 or more files changed : rebuild, save time and rc to file
sub Run
{
my ($rconfig) = @_;
$rconfig->{'Interval'} = $rconfig->{'Interval'} * 60; # how often to check CM in minutes
$rconfig->{'Show'} = $rconfig->{'DoShow'} ? "echo " : ""; # if 1, do not execute cmd just echo to screen, 0 executes
$gLogFilename = $rconfig->{'LogFilename'}; #the name of the log
my $to = AdjustTimeCeiling(time());
while(1)
{
my ($from, $rc, $force) = LoadLastRun($rconfig->{'DatFile'});
# bad or missing file, just do the build.
if ($force or $rc != 0)
{
logit("Missing LastRun file, rebuilding...\n") if $force;
logit("Last run failed, rebuilding...\n") if $rc != 0;
$rc = Build($rconfig);
SaveLastRun($to, $rc, $rconfig->{'DatFile'});
}
# we may have been shut down and restarted within the last minute, just wait.
elsif (abs($from - $to) < 60)
{
logit("No time elapsed since last run, waiting...\n");
}
#normal situation: it's been gInterval seconds since the last build, rebuild if any files have changed
else
{
logit("Getting info from ", formattime($from), " to ", formattime($to), "...\n");
my $fileschanged = CountChangedFiles($rconfig, $from, $to);
if ($fileschanged == 0)
{
print "No files changed\n";
}
else
{
logit("From ", formattime($from), " to ", formattime($to), " $fileschanged files were changed, rebuilding...\n");
$rc = Build($rconfig);
}
SaveLastRun($to, $rc, $rconfig->{'DatFile'});
}
$to = WaitUntil($rconfig, $to);
}
}
1;
|
package PerforceConfig;
sub new
{
my($class, $name) = @_; # Class name is in the first parameter
my $self = { name => $name }; # Anonymous hash reference holds instance attributes
#$self->{'RootDir'} -- user must provide this
#defaults-- user can overide
$self->{'Interval'} = 30; # how often to check perforce in minutes
$self->{'DoMakeClean'} = 0; # if 1, does a 'make clean' before the build
$self->{'DoCleanOnFailure'} = 0; # if 1, does a 'make clean' after a failure and retries the build
$self->{'DoShow'} = 0; # if 1, do not execute cmd just echo to screen, 0 executes
$self->{'LogFilename'} = "PerforceContinuousBuild.log"; #the name of the log
$self->{'DatFile'} = 'PerforceContinuousBuild_last_run.dat';
$self->{'CleanCommand'} = "make clean";
$self->{'BuildCommand'} = "make all";
bless($self, $class);
return $self;
}
#-- Mandatory: returns all lines from the history command
#-- input parms:
#-- $from: the starting time to retrieve the history for (in epoch seconds)
#-- $to : the ending time to retrieve the histor for (in epoch seconds)
sub GetHistory
{
my ($self, $from, $to) = @_;
my $cmd = "p4 files \@" . $self->PerforceTime($from) . ",\@" . $self->PerforceTime($to);
my @out = `$cmd`;
return @out;
}
#-- Mandatory: returns true if the history line indicates a file was changed
#-- input parms:
#-- $line: the current line from the history provided by GetHistory
#-- $from: the starting time (in epoch seconds)
#-- $to : the ending time (in epoch seconds)
sub IsChanged
{
my ($self, $line, $from, $to) = @_;
return index(lc $line, lc $self->{'RootDir'}) != -1;
}
#-- Mandatory: returns the command to perform the synchronization with the CM tool
sub GetSyncCommand
{
my ($self) = @_;
my $rootdir = $self->{'RootDir'};
return "p4 sync \"$rootdir/...\"";
}
#-- Mandatory: returns the command to perform a clean
sub GetCleanCommand
{
my ($self) = @_;
return $self->{CleanCommand};
}
#-- Mandatory: returns the command to perform the build
sub GetBuildCommand
{
my ($self) = @_;
return $self->{BuildCommand};
}
#-- Mandatory: returns the command to perform any post-build steps
sub GetPostBuildCommand
{
my ($self) = @_;
return $self->{PostBuildCommand};
}
##--------- PRIVATE --------------
##--------------------
sub PerforceTime
{
my ($self, $t) = @_;
my ($second, $minute, $hour, $day, $month, $year, $WeekDay, $DayOfYear, $IsDST) = localtime($t);
$year = $year + 1900;
$month = $month + 1;
my $s = sprintf("%04d/%02d/%02d:%02d:%02d:%02d", $year, $month, $day, $hour, $minute, $second);
return $s;
}
1;
|
package SubversionConfig;
use Time::Local;
sub new
{
my($class, $name) = @_; # Class name is in the first parameter
my $self = { name => $name }; # Anonymous hash reference holds instance attributes
#$self->{'RootDir'} -- user must provide this
#defaults-- user can overide
$self->{'Interval'} = 30; # how often to check perforce in minutes
$self->{'DoMakeClean'} = 0; # if 1, does a 'make clean' before the build
$self->{'DoCleanOnFailure'} = 0; # if 1, does a 'make clean' after a failure and retries the build
$self->{'DoShow'} = 0; # if 1, do not execute cmd just echo to screen, 0 executes
$self->{'LogFilename'} = "SubversionContinuousBuild.log"; #the name of the log
$self->{'DatFile'} = 'SubversionContinuousBuild_last_run.dat';
$self->{'CleanCommand'} = "make clean";
$self->{'BuildCommand'} = "make all";
bless($self, $class);
return $self;
}
#-- Mandatory: returns all lines from the history command
#-- input parms:
#-- $from: the starting time to retrieve the history for (in epoch seconds)
#-- $to : the ending time to retrieve the histor for (in epoch seconds)
sub GetHistory
{
my ($self, $from, $to) = @_;
my $rootdir = $self->{'RootDir'};
my $cmd = "svn log $rootdir -r \"{" . $self->svnformattime($from) . "}:{" . $self->svnformattime($to) . "}\"";
my @out = `$cmd`;
#print "out=", @out, "\n\n";
return @out;
}
#-- Mandatory: returns true if the history line indicates a file was changed
#-- input parms:
#-- $line: the current line from the history provided by GetHistory
#-- $from: the starting time (in epoch seconds)
#-- $to : the ending time (in epoch seconds)
sub IsChanged
{
my ($self, $line, $from, $to) = @_;
return 0 if $line !~ /^r/;
#This section of code shouldn't be needed. However svn has a
#bug or "enhancement request" to change a svn log -r daterange
#to only print log entries between the dates inclusively.
#0123456789012345678901234567890123456789
#r700 | (no author) | 2005-06-30 18:15:56 -0700 (Thu, 30 Jun 2005) | 1 line
my $dt = substr($line, 21, 19);
#2005-06-29 22:22:16
my ($yy, $mon, $dd, $hh, $mm, $ss) = $dt =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/;
$mon = $mon - 1;
my $dts = timelocal($ss, $mm, $hh, $dd, $mon, $yy);
#print "x=$line";
#print "x=$dt=$yy, $mon, $dd, $hh, $mm $ss=$dts\n";
#print "x=dts :", $self->svnformattime($dts), "\n";
#print "x=from:", $self->svnformattime($from), "\n";
#print "x=to :", $self->svnformattime($to), "\n";
#print "x=res :", ($dts >= $from && $dts <= $to) ? 1 : 0, "\n";
#print "----\n";
return ($dts >= $from && $dts <= $to) ? 1 : 0;
}
#-- Mandatory: returns the command to perform the synchronization with the CM tool
sub GetSyncCommand
{
my ($self) = @_;
return "svn update --non-interactive";
}
#-- Mandatory: returns the command to perform a clean
sub GetCleanCommand
{
my ($self) = @_;
return $self->{CleanCommand};
}
#-- Mandatory: returns the command to perform the build
sub GetBuildCommand
{
my ($self) = @_;
return $self->{BuildCommand};
}
#-- Mandatory: returns the command to perform any post-build steps
sub GetPostBuildCommand
{
my ($self) = @_;
return $self->{PostBuildCommand};
}
##--------- PRIVATE --------------
##--------------------
sub svnformattime
{
my ($self, $t) = @_;
my ($second, $minute, $hour, $day, $month, $year, $WeekDay, $DayOfYear, $IsDST) = localtime($t);
$year = $year + 1900;
$month = $month + 1;
my $s = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $month, $day, $hour, $minute, $second);
return $s;
}
1;
|