source: PSPA/madxPSPA/testing/MadTrigTest.pl @ 430

#!/usr/bin/perl

# trigger build and test if the following condition is satisfied:
# (1) find-out if the latest tag of the form 'madX_3_04_22' 
#     is located below the last 'madX_test' tag, which means
#     some release occured after the last test of the code.
# (2) tag the CVS with 'madX_test'.

# ... then issue a trigger to the do following:
# (3) do the build when extracting for the last release tag, ignoring
#     all changes that occured in between.
# (4) run the test suite

use MIME::Lite; # to send e-mail

use File::Path; # to remove directory trees


my $trigger;


@extractedPackages = ('madX');

$pwd = `pwd`;
chop $pwd;
$extractDir = $pwd . "/MadCvsExtract_trigger" ;
rmtree($extractDir);
mkdir($extractDir, 0777);
chdir($extractDir);


$cvsDir = ":gserver:isscvs.cern.ch:/local/reps/madx" ;


# Do we need to do the check-out or do we rely on FesaBuild.pl instead?
foreach(@extractedPackages) {
    my $pack = $_;
    # print "Extract package $pack from CVS\n";
    `cvs -d $cvsDir checkout $pack`;
}

# find-out the latest release
chdir('./madX');
my $representative = 'madxd.h';
my @log = `cvs log $representative`;

@releases = ();
@tests = ();
foreach $line (@log){
    if ($line =~/^[\s\t]*madX-(\d+)_(\d+)_(\d+)[\s\t]*:[\s\t]*([\d\.]+)[\s\t]*$/){
        my $release = "$1_$2_$3";
        $release_revision{$release}=$4;
        @releases = (@releases, $release);
        # print "found release $1_$2_$3, with revision $4\n";
    }
    if ($line =~/^[\s\t]*test-(\d+)_(\d+)_(\d+)[\s\t]*:[\s\t]*([\d\.]+)[\s\t]*$/){
        my $test = "$1_$2_$3";
        $test_revision{$test}=$4;
        @tests = (@tests, $test);
        # print "found test $1_$2_$3, with revision $4\n";
    }

}

my @sortedReleases = sort byDecreasingReleaseNumber @releases;
my @sortedTests = sort byDecreasingReleaseNumber @tests;

my $lastRelease = @sortedReleases[0];
my $beforeLastRelease = @sortedReleases[1];
my $lastTest = @sortedTests[0];

# decide whether a new release took place, in which case we shall
# trigger the build and test procedure.

if ($lastTest eq $lastRelease) {
        # there's no need to run the test again.
        $trigger = 'do-nothing';
} else {
        # also account for the very first time
        my $newTest = $lastRelease;
        my $newTestTag = "test-" . $newTest;
        # tag the CVS repository
        # ...
        `cvs tag $newTestTag $representative`;
        
        # now find-out all the work from the contributors
        # that went into the CVS in between the two last releases

        @authors = (); # global variable modified by recordWork
        recordWork("madX-$beforeLastRelease", "madX-$lastRelease");

        # sort @authors by alphabetical order
        @authors = sort @authors;

        my $workReport = "";
        $workReport .= "The MAD Build & Test script has detected a tentative candidate release for $lastRelease.\n\n";
        $workReport .= "Since last candidate release, the following changes have been made:\n";
        $workReport .= "\t-Lines-of-code added/deleted between $beforeLastRelease and $lastRelease:\n";
        foreach $auth (@authors){
                $workReport .= "\t\t$auth: +$linesAdded{$auth} -$linesDeleted{$auth}\n";
        }
        $workReport .= "\nSee detailed work report on:\n";
        $workReport .= "http://test-mad-automation.web.cern.ch/test-mad-automation/workReport.html\n";
        $workReport .= "\nFrom now on, the test procedure will start and may take several days.\n";
        $workReport .= "\nAt the end of the test procedure, module keepers will be informed ";
        $workReport .= "in case of discrepancy between the test's outcome and the reference. \n";

        # ... and send a summary to the list of watchers by e-mail

        $msg = MIME::Lite->new(
                       From       => 'Jean-Luc.Nougaret@cern.ch',
                       'Reply-To' => 'mad-automation-admin@cern.ch',
                       To         => 'mad-module-keepers@cern.ch',
                       Subject    => "MAD $lastRelease release candidate ready for testing.",
                       Data       => $workReport
                       );
        $msg->send;
        $trigger = 'run-test';
        # will cause the MadTest.pl script to run.

}
chdir($pwd); # back to the top menu
rmtree($extractDir);

# returned strings for MadBuildAndTest.pl
print "releaseTag=madX-$lastRelease\n"; # \n-terminated
print "trigger=$trigger\n"; # \n-terminated
exit 0;

sub byDecreasingReleaseNumber {
        # sort always assumes $a is to be compared with $b, such as '$f{$a} <=> f{$b}'
        # here, all numbers are of the form x+_x+_x+
        my @aNumbers = split /_/, $a;
        my @bNumbers = split /_/, $b;
        my $counter = 0;
        my $result = 0; # default
        foreach $aNumber (@aNumbers){
                if ($aNumber<@bNumbers[$counter]){
                        $result = 1;
                        return $result;
                }
                if ($aNumber>@bNumbers[$counter]){
                        $result = -1;
                        return $result;
                }
                $counter++;
        }
        return $result;
}

sub recordWork {
        $rel1 = $_[0]; # first release
        $rel2 = $_[1]; # second release
        @files = `ls *.*`;
        @makefiles = `ls Make*`;
        @files = (@files, @makefiles);
        # print "rel1 is $rel1, rel2 is $rel2\n";
        foreach $file (@files){
                chop $file;
                my @logs = `cvs log $file`;
                # first look for the revisions associated to the first and second releases
                foreach $log (@logs){

                        my $pattern1 = "^[\\s\\t]*$rel1\[\\s\\t]*:[\\s\\t]*([\\d\\.]+)[\\s\\t]*\$";
                        # print "pattern is $pattern\n";
                        if ($log =~/$pattern1/){
                                $rev1 = $1;
                                # print "$file: $rel1 -> revision 1 is $rev1\n";
                        }
                        my $pattern2 = "^[\\s\\t]*$rel2\[\\s\\t]*:[\\s\\t]*([\\d\\.]+)[\\s\\t]*\$";
                        if ($log =~ /$pattern2/){
                                $rev2 = $1;
                                # print "$file: $rel2 -> revision 2 is $rev2\n";
                        }
                }
                
                # now look for the authors having modified the code between release 1 and 2
                # (including the latter).
                # to this end, check all revisions located between $rev1 and $rev2 for given file
                
                my @numbers1 = split /\./, $rev1;
                my @numbers2 = split /\./, $rev2;
                
                # re-scan log for this file in order to find-out revision work
                # in a CVS log info looks like the following:
                # revision: 1.2.3
                # date: ... author: ...
                my $retreiveDetailedWorkInfoMode = 0 ; # some state-variable

                LOG_SCAN: foreach $log (@logs){
                        if ($retreiveDetailedWorkInfoMode == 1){
                                #print "Mode: retreive detailed work info\n";
                                #print "Process line $log\n";
                                if ($log =~ /author[\s\t]*:[\s\t]*(\w+);/){
                                        my $candidate = $1;
                                        # print "found work-unit carried-out by $candidate\n";
                                        # make sure author is not already in the list
                                        my $alreadyRecorded = 0;
                                        foreach $auth (@authors){
                                                if ($auth eq $candidate) {
                                                        $alreadyRecorded = 1;
                                                }
                                        }

                                        $log =~ /;[\s\t]+lines:[\s\t]+\+(\d+)[\s\t]+\-(\d+)[\s\t]*;/;
                                        # print "work is +$1 -$2 LOC\n";
                                        if ($alreadyRecorded == 0 ) {
                                                @authors = ( @authors, $candidate );
                                                $linesAdded{$candidate} = $1;
                                                $linesDeleted{$candidate} = $2;  
                                        } else {
                                                $linesAdded{$candidate} += $1;
                                                $linesDeleted{$candidate} += $2;
                                        
                                        }
                                }
                                $retreiveDetailedWorkInfoMode = 0;
                        }
                        if ($log =~ /^[\s\t]*revision[\s\t]+([\d\.]+)[\s\t]*$/){
                                # same number of dots?
                                my $rev = $1;
                                my @numbers = split /\./, $rev; 
                                # print "about to compare $rev1 < $rev < $rev2 ?\n";
                                if (scalar(@numbers) == scalar(@numbers2)) {
                                        # now check that $rev1 < $rev <= $rev2
                                        # and record the author & work in this case
                                        # print "compare $rev1 < $rev < $rev2 ?\n";
                                        my $counter = 0;
                                        foreach $number (@numbers){
                                                if ($number<@numbers1[$counter]) { next LOG_SCAN; }
                                                if ($number>@numbers2[$counter]) { next LOG_SCAN; }
                                                $counter++;
                                        }
                                        
                                        # special case: $rev = $ rev1 => of no interest
                                        if ($rev eq $rev1) { next LOG_SCAN; }
                                                
                                        # if we reach this point, the comparison was succesful
                                        # =>advance to the next log line contains the author
                                        $retreiveDetailedWorkInfoMode = 1;
                                        # print "$file: contribution found $rev1 < $rev <= $rev2\n";
                                        
                                } else {
                                        next LOG_SCAN;
                                }
                                
                        }
                }
                
                
                
        }
}