ACE/bin/diff-builds.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2     & eval 'exec perl -S $0 $argv:q'
   3     if 0;
   4
   5 # -*- perl -*-
   6
   7 use File::Spec qw/ tmpdir /;
   8 use File::Temp qw/ tempfile tempdir /;
   9 use POSIX qw/ strftime /;
  10
  11 my $debugging = 0; # Print additional info
  12 my $verbose = '-q'; # WGET verbosity
  13 my $new_errors_only = 0; # Show new errors only
  14 my $clean_builds_only = 1; # Only diff todays clean builds
  15 my $append_revision_to_new_test_fails = 0;  # Default to not doing this.
  16
  17 # The root of the test statistics
  18 my $teststaturl = "http://teststat.remedy.nl/teststat/builds/";
  19
  20 my $allbuildsurl = "http://teststat.remedy.nl/teststat/buildscore";
  21 my $cleanbuildsurl = "http://teststat.remedy.nl/teststat/cleanbuildtests";
  22
  23 # Determine the available timestamps for a build on a date,
  24 # by scanning the index page (build.html)
  25 sub find_timestamps ($$)  {
  26
  27     my ($file,$date) = @_;
  28
  29 #    print "\nSearching for $file, $date\n";
  30     open (INDEX, "wget " . $verbose . " \'" . $teststaturl . $file . ".html\' -O - |")
  31         || die "***Could not read the index page for $file\n";
  32
  33     # Split at all HTML tags, except <a ..>
  34     my @suffixes = split ( /[<][b-zB-Z\/]+[>]/, <INDEX>);
  35     close (INDEX);
  36
  37     # Select only those of the "href=..." that match our file and date
  38     my $rx = quotemeta ( $file . '_' . $date);
  39     my @temp = map { (/${rx}_([0-9][0-9]_[0-9][0-9])/) ? $1 : "" } @suffixes;
  40     return grep /^[0-9]/, @temp;
  41 }
  42
  43 # Determine the timestamp by scanning the index
  44 sub find_closest_earlier  {
  45
  46     my ($file,$date) = @_;
  47
  48     open (INDEX, "wget " . $verbose . " \'" . $teststaturl . $file . ".html\' -O - |")
  49         || die "***Could not read the index page for $file\n";
  50
  51     # Split at all HTML tags, except <a ..>
  52     my @suffixes = split ( /[<][b-zB-Z\/]+[>]/, <INDEX>);
  53     close (INDEX);
  54
  55     # Select only those of the "href=..." that match our file
  56     my $rx = quotemeta ( $file);
  57     my @temp = map { (/${rx}_([0-9][0-9][0-9][0-9]_[0-9][0-9]_[0-9][0-9])/ && $1 le $date) ? $1 : undef } @suffixes;
  58     my @temp2 = grep /^[0-9]/, @temp;
  59
  60     if ($#temp2 == -1) {
  61         return undef;
  62     }
  63
  64     return $temp2[0];
  65 }
  66
  67 sub select_builds ($$$)
  68 {
  69     my ($rdates, $rbuilds, $rfiles) = @_;
  70     my @dates = @{$rdates};
  71     my @builds = @{$rbuilds};
  72
  73     if ($#dates eq 1) {
  74         $rfiles->[0] = $rbuilds->[0];
  75         $rfiles->[1] = $rbuilds->[0];
  76     }
  77     elsif ($#builds eq 1) {
  78         $rfiles->[0] = $rbuilds->[0];
  79         $rfiles->[1] = $rbuilds->[1];
  80
  81         $rdates->[1] = $rdates->[0];
  82
  83     }
  84     else {
  85         die "Dates: $#dates, Builds: $#builds\n";
  86     }
  87
  88     return 0;
  89 }
  90
  91 sub load_failed_tests_list ($$)
  92 {
  93     my ($file, $original_date) = @_;
  94
  95     my $date = $original_date;
  96     my $last_tried_date = $original_date;
  97     my @timestamps = ();
  98
  99     while ($#timestamps < 0) {
 100
 101         @timestamps = find_timestamps ($file, $date);
 102
 103         if ($#timestamps == -1) {
 104             $date = find_closest_earlier ($file, $date);
 105             if (!$date) {
 106                 print "***Found no builds for $file on, or before $original_date\n";
 107                 return File::Spec->devnull();
 108             }
 109
 110             print "***No builds for $file on $last_tried_date. The closest earlier is "
 111                 . $date . "\n";
 112
 113             $last_tried_date = $date;
 114             next;
 115         }
 116
 117         print "Build times for $file on $date are "
 118             . join (', ', @timestamps) . "\n" unless !$debugging;
 119     }
 120
 121     my $tmpdir = File::Spec->tmpdir();
 122     my $fullfile = $file .'_' . $date . '_' . $timestamps[0];
 123     my ($fh, $tmpfile) = tempfile ($fullfile . ".XXXXXX", UNLINK => 1, DIR => $tmpdir);
 124
 125     print "wget " . $verbose . " \'" .$teststaturl
 126             . $fullfile . ".txt\' -O - | sort >\'" . $tmpfile . '\'' . "\n" unless !$debugging;
 127
 128     system ("wget " . $verbose . " \'" .$teststaturl
 129             . $fullfile . ".txt\' -O - | sort >\'" . $tmpfile . '\'');
 130     close ($fh);
 131
 132     return $tmpfile;
 133 }
 134
 135 sub differentiate ($$$)
 136 {
 137     my ($rfiles, $rdates, $revision) = @_;
 138
 139     print "Difference for dates " . join (', ', @$rdates) . "\n" unless !$debugging;
 140
 141     my $first_file = load_failed_tests_list ($rfiles->[0], $rdates->[0]);
 142     my $second_file = load_failed_tests_list ($rfiles->[1], $rdates->[1]);
 143
 144     open (DIFF, "diff -u \'" . $first_file . "\' \'" . $second_file . "\' 2>&1 |")
 145         || die "***Failed to diff \'" . $first_file . "\' \'" . $second_file . "\'\n";
 146
 147     while (<DIFF>) {
 148
 149         # Don't filter out the build details when printing the new errors only
 150         if (/^---/) {
 151             # Previous Build Date
 152             print;
 153         }
 154         elsif (/^\+\+\+/) {
 155             # Current Build date
 156             if ($revision) {
 157                 chomp;
 158                 print "$_ ($revision)\n";
 159             }
 160             else {
 161                print;
 162             }
 163         }
 164         elsif (/^[^\+]/) {
 165             # Anything except a new error
 166             print unless ($new_errors_only == 1);
 167         }
 168         elsif ($append_revision_to_new_test_fails && $revision) {
 169             chomp;
 170             print "$_ ($revision)\n";
 171         }
 172         else {
 173             print;
 174         }
 175     }
 176
 177     close (DIFF);
 178     print "\n";
 179 }
 180
 181 sub find_builds ($$$$$)
 182 {
 183     my ($rbuilds, $buildscoreurl, $selectcolumn_name, $revision_hash, $selectcolumn_revision) = @_;
 184
 185     print "Reading from $buildscoreurl\n" unless !$debugging;
 186
 187     open (CLEANS, "wget " . $verbose . " \'" . $buildscoreurl . "\' -O - |")
 188         || die "Could not read builds score page $buildscoreurl\n";
 189
 190     # Split at all spaces
 191     for(my $begin=0; <CLEANS>;)
 192     {
 193         chomp;
 194         my @columns = split (/ +/);
 195
 196         if (/=+/) {
 197             $begin++;
 198             next;
 199         }
 200
 201         if ($begin) {
 202            my $temp = %{$revision_hash};
 203            $temp->{$columns[$selectcolumn_name]} = $columns[$selectcolumn_revision];
 204            push (@{$rbuilds}, $columns[$selectcolumn_name]);
 205         }
 206     }
 207     close (CLEANS);
 208     sort @{$rbuilds};
 209
 210     print "Using builds @{$rbuilds}\n" unless !$debugging;
 211 }
 212
 213 my @dates = ();
 214 my @builds = ();
 215 my @files = ();
 216
 217 while ($arg = shift(@ARGV)) {
 218
 219     if ($arg eq "-h" || $arg eq "-?") {
 220       print "Prints a diff for the list of test failures, for two builds on a certain date\n\n";
 221       print "diff-builds [-n] [-d] [-D date] [-A] [build ...]\n";
 222       print "\n";
 223       print "  -n          -- Show only new test failing (default=no)\n";
 224       print "  -d          -- Show debug info\n";
 225       print "  -h          -- Prints this information\n";
 226       print "  -D date     -- Specify a date. Either YYYY_MM_DD or YYYY-MM-DD works\n";
 227       print "                 Use two date parameters to specify an interval\n";
 228       print "  -A          -- Use all builds, not just the clean (successful) ones\n";
 229       print "  -r          -- Append SVN revision numbers to NEW test names\n";
 230       print "  build       -- Specify the build name. As it appears on the scoreboard\n";
 231       print "                 Works with two builds and one date to show the differences\n";
 232       print "                 between them. One build and two dates works, too.\n";
 233       print "                 Just a single date (no builds) implies comparing all of \n";
 234       print "                 today's builds with the builds on the supplied date.\n";
 235       exit 0;
 236     }
 237     if ($arg eq '-D') {
 238         my $date = shift(@ARGV);
 239         $date =~ s/-/_/g;
 240         push (@dates, $date);
 241         print "Date=$date\n"
 242             unless !$debugging;
 243     }
 244     elsif ($arg eq '-v') {
 245         $verbose = undef;
 246     }
 247     elsif ($arg eq '-d') {
 248         $debugging = 1;
 249     }
 250     elsif ($arg eq '-n') {
 251         $new_errors_only = 1;
 252     }
 253     elsif ($arg eq '-A') {
 254         $clean_builds_only = 0;
 255     }
 256     elsif ($arg eq '-r') {
 257         $append_revision_to_new_test_fails = 1;
 258     }
 259     else {
 260         push (@builds, $arg);
 261         print "Build=$arg\n"
 262             unless !$debugging;
 263     }
 264 }
 265
 266 # Diff the todays clean builds with the ones from a specific date
 267 if ($#builds == -1 && $#dates >= 0)
 268 {
 269     my %revisions = {};
 270
 271     # only the start date given - implies we should
 272     # use the today's date
 273     if ($#dates == 0) {
 274         $dates[1] = strftime ("%Y_%m_%d", gmtime);
 275     }
 276
 277     if ($clean_builds_only) {
 278         find_builds (\@builds, $cleanbuildsurl . "-" . $dates[1] . ".txt" , 8, \%revisions, 7);
 279     }
 280     else {
 281         find_builds (\@builds, $allbuildsurl . "-" . $dates[1] . ".txt" , 4, \%revisions, 3);
 282     }
 283
 284     foreach $build (sort @builds) {
 285         $files[0] = $files[1] = $build;
 286         differentiate (\@files, \@dates, $revisions{$build} );
 287     }
 288 }
 289 else
 290 {
 291     die "More than one date or build name are required"
 292         unless ($#dates + $#builds ge 1);
 293
 294     print "dates=@dates ($#dates)\n"
 295         unless !$debugging;
 296
 297     print "builds=@builds ($#builds)\n"
 298         unless !$debugging;
 299
 300     select_builds (\@dates, \@builds, \@files);
 301     differentiate (\@files, \@dates, 0);
 302 }
 303 __END__
 304
 305 =head1 diff-builds.pl Diff the lists of failing tests
 306
 307 =item DESCRIPTION
 308 Prints a diff for the list of test failures, for two builds on a certain date.
 309 Or, for two dates and a certain build.
 310
 311 =item EXAMPLE
 312
 313 diff-builds.pl WinXP_VC71_NET_Static_Debug -D 2006_04_17 -D 2006_05_12
 314
 315 =item AUTHOR
 316 Iliyan Jeliazkov <iliyan@ociweb.com>
 317