source: PSPA/madxPSPA/testing/MadTrigRelease.pl @ 478

Last change on this file since 478 was 430, checked in by touze, 11 years ago

import madx-5.01.00
File size: 17.9 KB
Line 
1#!/usr/bin/perl
2
3# trigger build and test if the following condition is satisfied:
4# (1) find-out if the latest tag of the form 'madX_3_04_22_prod'
5#     is located below the last 'madX_prod' tag, which means
6#     some release occured after the last release of the code.
7# (2) tag the CVS with 'madX_prod'.
8# (3) send work report to hep-project-madx@cern.ch
9# (4) trigger Windows compilation and send mails to madx-windows-watchers@cern.ch
10
11# this process is supposed to complete in less than a day, hence it is unnecessary
12# to bother about refreshing the Kerberos/AFS tokens as we do in MadBuildAndTest.pl for instance...
13
14
15# if already running, this script should die or kill the existing instance...
16
17use MIME::Lite; # to send e-mail
18
19use File::Path; # to remove directory trees
20
21$debug = 'no'; # this one is default and is required in automatic mode
22#$debug = 'yes'; # this one for manual tests to avoid sending e-mails to the community, and avoid tagging the CVS
23
24@extractedPackages = ('madX');
25
26$rootDir = '/afs/cern.ch/user/n/nougaret/scratch0/mad-automation';
27
28$extractDir = $rootDir . "/MadCvsExtract_prod_assert" ;
29#rmtree($extractDir); # should check it exists first
30mkdir($extractDir, 0777);
31chdir($extractDir);
32
33$cvsDir = ":gserver:isscvs.cern.ch:/local/reps/madx" ;
34
35# Redo a specific checkout
36foreach(@extractedPackages) {
37    my $pack = $_;
38    # print "Extract package $pack from CVS\n";
39    `cvs -d $cvsDir checkout $pack`;
40}
41
42# find-out the latest release
43chdir('./madX');
44my $representative = 'madxd.h';
45my @log = `cvs log $representative`;
46
47@releases = ();
48@prods = ();
49foreach $line (@log){
50    if ($line =~/^[\s\t]*madX-(\d+)_(\d+)_(\d+)_prod[\s\t]*:[\s\t]*([\d\.]+)[\s\t]*$/){
51        my $release = "$1_$2_$3";
52        $release_revision{$release}=$4;
53        @releases = (@releases, $release);
54         notify("found release $1_$2_$3_prod, with revision $4\n");
55    }
56    if ($line =~/^[\s\t]*prod-(\d+)_(\d+)_(\d+)[\s\t]*:[\s\t]*([\d\.]+)[\s\t]*$/){
57        my $prod = "$1_$2_$3";
58        $prod_revision{$prod}=$4;
59        @prods = (@prods, $prod);
60        # print "found prod $1_$2_$3, with revision $4\n";
61    }
62
63}
64
65my @sortedReleases = sort byDecreasingReleaseNumber @releases;
66my @sortedProds = sort byDecreasingReleaseNumber @prods;
67
68my $lastRelease = @sortedReleases[0];
69my $beforeLastRelease = @sortedReleases[1];
70my $lastProd = @sortedProds[0];
71
72# decide whether a new release took place
73
74if (($lastProd eq $lastRelease) && ($debug ne 'yes')) {
75    # there's no need to release to production.
76    chdir($rootDir);
77    rmtree($extractDir);
78    notify("MadTrigRelease.pl completed (NO RELEASE).");
79    exit 0; 
80} else {
81    # also account for the very first time
82    my $newProd = $lastRelease;
83    my $newProdTag = "prod-" . $newProd;
84    # tag the CVS repository
85    # ...
86    if ($debug ne "yes"){
87        `cvs tag $newProdTag $representative`;
88    }
89   
90    # generate HTML page for the work report between the two production releases
91    my $beforeLastTag = "madX-$beforeLastRelease"."_prod";
92    my $lastTag = "madX-$lastRelease"."_prod";
93    `$rootDir/MadWorkBetweenReleases.pl $beforeLastTag $lastTag`;
94   
95
96    # now find-out all the work from the contributors
97    # that went into the CVS in between the two last releases
98   
99    @authors = (); # global variable modified by recordWork
100    recordWork($beforeLastTag, $lastTag); # between production releases
101   
102    # sort @authors by alphabetical order
103    @authors = sort @authors;
104   
105    my $workReport = "";
106    $workReport .= "MAD-X $lastRelease has been released.\n\n";
107    $workReport .= "Since last release, the following changes have been made:\n";
108    $workReport .= "\t-Lines-of-code added/deleted between $beforeLastRelease and $lastRelease:\n";
109    foreach $auth (@authors){
110        $workReport .= "\t\t$auth: +$linesAdded{$auth} -$linesDeleted{$auth}\n";
111    }
112    $workReport .= "\nSee detailed work log on:\n";
113    $workReport .= "http://test-mad-automation.web.cern.ch/test-mad-automation/workReport.html\n";
114   
115    # ... and send a summary to the list of watchers by e-mail
116    if ($debug ne 'yes'){
117        $msg = MIME::Lite->new(
118                               From       => 'Jean-Luc.Nougaret@cern.ch',
119                               'Reply-To' => 'mad-automation-admin@cern.ch',
120                               To         => 'hep-project-madx@cern.ch',
121                               Subject    => "MAD $lastRelease released.",
122                               Data       => $workReport
123                               );
124        $msg->send;
125    }
126    #
127    # now trigger Windows compilation (note: this one runs as acrontab process with access to both AFS and NFS)
128    #
129    use IO::Socket::INET;
130    use MIME::Lite;
131    use Sys::Hostname;
132
133    my $windowsHost = 'abpc10788';
134    my $thisLinuxHost = hostname;
135    my $socketPortWindows = 7070;
136    my $socketPortLinux = 7071; # could be the same as above (different machine)
137
138    # following should be globals as they are used from subroutines...
139    $executablesAfsWebFolder = "/afs/cern.ch/user/n/nougaret/www/mad/windows-binaries"; # global
140    $madForWindowsSambaFolder = "/user/nougaret/MAD-X-WINDOWS/madX"; 
141    # where binaries are delivered on the web for subsequent retreival by users
142    $madWindowsCompilationDir = $madForWindowsSambaFolder; # global used by other routines
143    $madWindowsDeliveryDir = "/afs/cern.ch/user/n/nougaret/www/mad/windows-binaries"; # global
144    # also used by other routines
145    # @windowsTargets = ('madx.exe','madxp.exe','mpars.exe'); # Windows/DOS deliverables
146    @windowsTargets = ('madx.exe'); # Windows/DOS deliverables
147    # above is global as used by other routines as well
148
149    notify("MadWindowsCompileClient.pl will now forward the compilation request to the Windows host machine.");
150
151    updateMadForWindowsSambaFolder();
152
153    my $sock = new IO::Socket::INET ( 
154                                      PeerAddr => $windowsHost,
155                                      PeerPort => $socketPortWindows,
156                                      Proto => 'tcp'
157                                      ); 
158
159    unless ($sock) {
160        notify("Could not create socket $socketPortWindows to connect to $windowsHost => will die\n");
161        die "Could not create socket: $!\n" unless $sock; 
162    }
163
164    print "will now send message to port $socketPortWindows of $windowsHost\n";
165   
166    print $sock "$thisLinuxHost asks: Compile MAD for Windows!\n";
167       
168    $startTime = localtime; # global
169    $endTime; # global, will be set later-on
170       
171    close($sock);
172       
173    # now wait for the message signalling that the compilation completed
174
175    my $clientSock = new IO::Socket::INET(
176                                          LocalHost => $thisLinuxHost,
177                                          LocalPort => $socketPortLinux,
178                                          Proto => 'tcp',
179                                          Listen => 1,
180                                          Reuse => 1
181                                          );
182
183    die "Could not create client socket: $!\n" unless $clientSock;
184   
185    print "$thisLinuxHost accepts messages sent through socket $socketPortLinux\n";
186    my $newClientSock = $clientSock->accept();
187           
188    INFINITE_LOOP: while (<$newClientSock>){
189        print $_;
190        if (/Compilation completed/){
191            $endTime = localtime;
192            print "OK: the compilation completed on Windows side\n";
193            checkWindowsCompilationOutcome();
194            print "=> installed the executables in the AFS web folder\n";
195            last INFINITE_LOOP; # leave the while loop
196        }
197       
198        # should leave loop (timeout) in case there's no reply by the Windows-side server,
199        # in which case, the executables will need to be delivered manually
200       
201    }
202   
203    close ($clientSock);
204    chdir($rootDir); # back to the top menu
205    rmtree($extractDir);
206    notify("MadTrigRelease.pl completed (RELEASED).");
207    if ($debug ne 'yes'){
208        $msg = MIME::Lite->new(
209                               From       => 'Jean-Luc.Nougaret@cern.ch',
210                               'Reply-To' => 'mad-automation-admin@cern.ch',
211                               To         => 'mad-windows-watchers@cern.ch',
212                               Subject    => "MAD-X for Windows updated",
213                               Data       => "Dear colleagues,\n\nPlease take note that MAD-X version $madVersion is now available on Windows.\n\nThe new releases are available for download on the new Web page:\nhttps://test-mad-automation.web.cern.ch/test-mad-automation/windows-binaries/executables.htm\n\nRegards\nJean-Luc"
214                               );
215        $msg->send;
216    }
217   
218    exit 0; 
219}
220
221
222sub byDecreasingReleaseNumber {
223        # sort always assumes $a is to be compared with $b, such as '$f{$a} <=> f{$b}'
224        # here, all numbers are of the form x+_x+_x+
225        my @aNumbers = split /_/, $a;
226        my @bNumbers = split /_/, $b;
227        my $counter = 0;
228        my $result = 0; # default
229        foreach $aNumber (@aNumbers){
230                if ($aNumber<@bNumbers[$counter]){
231                        $result = 1;
232                        return $result;
233                }
234                if ($aNumber>@bNumbers[$counter]){
235                        $result = -1;
236                        return $result;
237                }
238                $counter++;
239        }
240        return $result;
241}
242
243sub recordWork {
244        $rel1 = $_[0]; # first release
245        $rel2 = $_[1]; # second release
246        @files = `ls *.*`;
247        @makefiles = `ls Make*`;
248        @files = (@files, @makefiles);
249        # print "rel1 is $rel1, rel2 is $rel2\n";
250        foreach $file (@files){
251                chop $file;
252                my @logs = `cvs log $file`;
253                # first look for the revisions associated to the first and second releases
254                foreach $log (@logs){
255
256                        my $pattern1 = "^[\\s\\t]*$rel1\[\\s\\t]*:[\\s\\t]*([\\d\\.]+)[\\s\\t]*\$";
257                        # print "pattern is $pattern\n";
258                        if ($log =~/$pattern1/){
259                                $rev1 = $1;
260                                # print "$file: $rel1 -> revision 1 is $rev1\n";
261                        }
262                        my $pattern2 = "^[\\s\\t]*$rel2\[\\s\\t]*:[\\s\\t]*([\\d\\.]+)[\\s\\t]*\$";
263                        if ($log =~ /$pattern2/){
264                                $rev2 = $1;
265                                # print "$file: $rel2 -> revision 2 is $rev2\n";
266                        }
267                }
268               
269                # now look for the authors having modified the code between release 1 and 2
270                # (including the latter).
271                # to this end, check all revisions located between $rev1 and $rev2 for given file
272               
273                my @numbers1 = split /\./, $rev1;
274                my @numbers2 = split /\./, $rev2;
275               
276                # re-scan log for this file in order to find-out revision work
277                # in a CVS log info looks like the following:
278                # revision: 1.2.3
279                # date: ... author: ...
280                my $retreiveDetailedWorkInfoMode = 0 ; # some state-variable
281
282                LOG_SCAN: foreach $log (@logs){
283                        if ($retreiveDetailedWorkInfoMode == 1){
284                                #print "Mode: retreive detailed work info\n";
285                                #print "Process line $log\n";
286                                if ($log =~ /author[\s\t]*:[\s\t]*(\w+);/){
287                                        my $candidate = $1;
288                                        # print "found work-unit carried-out by $candidate\n";
289                                        # make sure author is not already in the list
290                                        my $alreadyRecorded = 0;
291                                        foreach $auth (@authors){
292                                                if ($auth eq $candidate) {
293                                                        $alreadyRecorded = 1;
294                                                }
295                                        }
296
297                                        $log =~ /;[\s\t]+lines:[\s\t]+\+(\d+)[\s\t]+\-(\d+)[\s\t]*;/;
298                                        # print "work is +$1 -$2 LOC\n";
299                                        if ($alreadyRecorded == 0 ) {
300                                                @authors = ( @authors, $candidate );
301                                                $linesAdded{$candidate} = $1;
302                                                $linesDeleted{$candidate} = $2; 
303                                        } else {
304                                                $linesAdded{$candidate} += $1;
305                                                $linesDeleted{$candidate} += $2;
306                                       
307                                        }
308                                }
309                                $retreiveDetailedWorkInfoMode = 0;
310                        }
311                        if ($log =~ /^[\s\t]*revision[\s\t]+([\d\.]+)[\s\t]*$/){
312                                # same number of dots?
313                                my $rev = $1;
314                                my @numbers = split /\./, $rev; 
315                                # print "about to compare $rev1 < $rev < $rev2 ?\n";
316                                if (scalar(@numbers) == scalar(@numbers2)) {
317                                        # now check that $rev1 < $rev <= $rev2
318                                        # and record the author & work in this case
319                                        # print "compare $rev1 < $rev < $rev2 ?\n";
320                                        my $counter = 0;
321                                        foreach $number (@numbers){
322                                                if ($number<@numbers1[$counter]) { next LOG_SCAN; }
323                                                if ($number>@numbers2[$counter]) { next LOG_SCAN; }
324                                                $counter++;
325                                        }
326                                       
327                                        # special case: $rev = $ rev1 => of no interest
328                                        if ($rev eq $rev1) { next LOG_SCAN; }
329                                               
330                                        # if we reach this point, the comparison was succesful
331                                        # =>advance to the next log line contains the author
332                                        $retreiveDetailedWorkInfoMode = 1;
333                                        # print "$file: contribution found $rev1 < $rev <= $rev2\n";
334                                       
335                                } else {
336                                        next LOG_SCAN;
337                                }
338                               
339                        }
340                }
341               
342               
343               
344        }
345}
346
347
348sub checkWindowsCompilationOutcome {
349    my $initialDir = `pwd`;
350    # check the delivery directory contents
351    foreach $target (@windowsTargets){
352        # check that the executable has been created within the last hour
353        my $ls = `ls -l $madWindowsCompilationDir/$target`;
354
355        # debug
356        notify("for target '$target', we see : '$ls'");
357
358        # pick the date and time at which the executables have been created
359        $ls =~ /(\w{3})[\s\t]+(\d{1,2})[\s\t]+(\d+:\d+)[\s\t]/ ;
360
361        my $month = $1;
362        my $day = $2;
363        my $time = $3;
364
365        my $now = localtime;
366        print "now=$now\n";
367
368        $now =~ /^\w{3}[\s\t]+(\w{3})[\s\t]+(\d{1,2})[\s\t]+(\d+:\d+:)\d+/ ;
369        # forget about the year...
370
371        my $monthNow = $1;
372        my $dayNow = $2;
373        my $time = $3;
374
375        # debug
376        notify("monthNow is '$monthNow', month is '$month', dayNow is '$dayNow', day is '$day'");
377#       if (0){ # for the time being, always deliver the executables, without checking anything
378        if (($monthNow != $month)||($dayNow != $day)){
379            print "Mistmatch of day and month => executables were not created\n";
380        } else {
381            # now check that compilation occured within on hour from now
382           
383            # now install the executables in the AFS web folder
384            my $source = "$madWindowsCompilationDir/$target";
385            my $destination = "$madWindowsDeliveryDir/$target";
386            my $result = `cp $source $destination`;
387           
388            # debug:
389            notify("just copied '$source' into '$destination' => outcome = '$result'");
390
391        }
392
393
394    } # for each $target (@windowsTargets)
395
396    # if everything ok...
397
398
399
400
401    # now notify that the Windows executables are ready
402    my $grepVersion = `grep myversion $madWindowsCompilationDir/madxd.h`; # hard-coded !?
403
404    # debug:
405    notify("now grep my version in '$madWindowsCompilationDir/madx.h'");
406
407    $grepVersion =~ /MAD-X (\d+\.\d+\.\d+)/;
408    $madVersion = $1; # global, also used in subroutine 'deliverHtmlPage';
409
410    deliverHtmlPage();
411   
412
413    if ($debug eq 'no') {
414        my $msg = MIME::Lite->new(
415                                  From => 'Jean-Luc.Nougaret@cern.ch',
416#                                 To => 'mad-windows-watchers@cern.ch',
417                                  To => 'Jean-Luc.Nougaret@cern.ch',
418                                  Subject => 'MAD-X for Windows updated',
419                                  Data => "Dear colleagues,\n\nPlease take note that MAD-X version $madVersion is now available on Windows.\n\nThe new releases are available for download on the new Web page:\nhttps://test-mad-automation.web.cern.ch/test-mad-automation/windows-binaries/executables.htm\n\nRegards,\nJean-Luc"
420                                  );
421        $msg->send;
422    } else {
423        notify("MAD-X for Windows has been updated");
424    }
425   
426    chdir($initialDir);
427
428} # subroutine checkWindowsCompilationOutcome
429
430
431sub deliverHtmlPage {
432   
433    # at this stage, the Windows binaries have been delivered to the
434    # AFS web folder already
435
436    my $htmlFile = "$executablesAfsWebFolder/executables.htm"; 
437    # only for Windows?
438
439    my $contents =''; # blank at first
440
441    # grep size of the binaries located in the AFS web folder
442    # my @binaries = `ls -l $executablesAfsWebFolder/*.exe`;
443    my @binaries = `ls -l $executablesAfsWebFolder/madx.exe`; # from March 26th 2009, only one executable
444
445#    my $nBinaries = scalar(@binaries);
446#    notify("in '$executablesAfsWebFolder', 'found $nBinaries'");
447       
448    $contents .= "<p>Version $madVersion compiled with Lahey Fortran and Microsoft Visual C++:</p>\n";
449    $contents .= "<table width=\"75%\" border=\"0\">\n";
450    my $oddOrEven = 'even'; # to colorize successive lines differently
451    foreach $binary (@binaries){
452        chop $binary; # end of line
453#       notify("line:$binary");
454#       notify("in '$executablesAfsWebFolder', 'found $binary'");
455# -rw-r--r--  1 nougaret pz  658664 Oct  1 12:06 /afs/cern.ch/user/n/nougaret/www/mad/windows-binaries/mpars.exe
456        $binary =~ /(\d+)[\s\t]+(\w{3})[\s\t]+(\d{1,2})[\s\t]+(\d+:\d+)[\s\t]+[^\s]+\/(\w+\.exe)$/;
457        my $size = $1;
458        my $megabytes = $size / 1000000;
459        my $month = $2;
460        my $day = $3;
461        my $time = $4;
462        my $executable = $5;
463#       notify("size='$size',exec='$executable',descr='$description{$executable}'");
464        $description{'madx.exe'} = "standard version";
465#       $description{'madxp.exe'} = "version including PTC";
466#       $description{'mpars.exe'} = "\"parser-only\" version";
467        if ($oddOrEven eq 'odd'){
468            $oddOrEven = 'even';
469        } else {
470            $oddOrEven = 'odd';
471        }
472        $contents .= "<tr class=\"$oddOrEven\"><td>Download</td><td><a href=\"./$executable\">$executable</a></td><td>($megabytes Megabytes)</td><td>for the $description{$executable}.</td></tr>\n";
473    }
474    $contents .= "</table>\n";
475    $contents .= "<p>Version 3.04.53 accepting sequences files with BV flag, as until March 2009:</p>\n";
476    $contents .= "<table width=\"75%\" border=\"0\">\n";
477    $oldExecutable = "";
478    $megabytes = 123456789; # should put the actual value here
479    $contents .= "<tr class=\"even\"><td>Download</td><td><a href=\"./madx-old.exe\">madx-old.exe</a></td><td>(2.6132 Megabytes)</td><td>for the archived version, without PTC.</td></tr>\n";
480    $contents .= "<tr class=\"odd\"><td>Download</td><td><a href=\"./madxp-old.exe\">madxp-old.exe</a></td><td>(6.7554 Megabytes)</td><td>for the archived version, including PTC.</td></tr>\n";
481    $contents .= "</table>\n";
482
483
484    # create web page in the correct AFS web folder location
485    my $html = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">';
486    $html .= "<html>\n";
487    $html .= "<head>\n";
488    $html .= "<title>MAD-X downloadable executables</title>\n";
489    $html .= "<link rel=stylesheet href=\"../MadTestWebStyle.css\" type=\"text/css\">"; # CSS stylesheet one level up
490    $html .= "</head>\n";
491    $html .= "<!-- generated by Windows compilation script -->\n";
492    $html .= "<body>\n";
493    $html .= "<p>Windows compilation started $startTime, ended $endTime</p>\n";
494    $html .= $contents;
495    $html .= "</body>\n";
496    $html .= "</html>\n";
497    open(OUTHTML, ">$htmlFile");
498    print OUTHTML $html;
499    close OUTHTML;
500
501    # debug
502    notify("created file '$htmlFile'");
503   
504    # now move HTML file into the AFS target web folder
505   
506}
507
508
509
510
511sub updateMadForWindowsSambaFolder{
512    my $localDir = `pwd`;
513    chdir($madForWindowsSambaFolder);
514    # ideally we should do a complete clean-up here.
515    print "invoke CVS update in $madForWindowsSambaFolder. Ideally should do a complete clean-up before\n";
516    `cvs update`;
517    $cvsStatus = `cvs status`;
518    if ($debug eq 'yes'){
519        notify("outcome of `cvs update`: $cvsStatus");
520    }
521    chdir ($localDir); # back to where we were before entering the sub
522
523}
524
525
526sub notify{
527    if ($debug eq 'yes'){
528        my $message = $_[0];
529        my $msg = MIME::Lite->new(
530                                  From => 'MAD-X Windows compilation robot',
531                                  ReplyTo => 'Jean-Luc.Nougaret@cern.ch',
532                                  To => 'Jean-Luc.Nougaret@cern.ch',
533                                  Subject => 'automatic notification',
534                                  Data => $message
535                                  );
536        $msg->send;   
537    }
538}
539
Note: See TracBrowser for help on using the repository browser.