eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# -*- perl -*-

use File::Spec qw/ tmpdir /;
use File::Temp qw/ tempfile tempdir /;
use POSIX qw/ strftime /;

my $debugging = 0; # Print additional info
my $verbose = '-q'; # WGET verbosity
my $new_errors_only = 0; # Show new errors only
my $clean_builds_only = 1; # Only diff todays clean builds
my $append_revision_to_new_test_fails = 0;  # Default to not doing this.

# The root of the test statistics
my $teststaturl = "http://teststat.remedy.nl/teststat/builds/";

my $allbuildsurl = "http://teststat.remedy.nl/teststat/buildscore";
my $cleanbuildsurl = "http://teststat.remedy.nl/teststat/cleanbuildtests";

# Determine the available timestamps for a build on a date,
# by scanning the index page (build.html)
sub find_timestamps ($$)  {

    my ($file,$date) = @_;

#    print "\nSearching for $file, $date\n";
    open (INDEX, "wget " . $verbose . " \'" . $teststaturl . $file . ".html\' -O - |")
        || die "***Could not read the index page for $file\n";

    # Split at all HTML tags, except <a ..>
    my @suffixes = split ( /[<][b-zB-Z\/]+[>]/, <INDEX>);
    close (INDEX);

    # Select only those of the "href=..." that match our file and date
    my $rx = quotemeta ( $file . '_' . $date);
    my @temp = map { (/${rx}_([0-9][0-9]_[0-9][0-9])/) ? $1 : "" } @suffixes;
    return grep /^[0-9]/, @temp;
}

# Determine the timestamp by scanning the index
sub find_closest_earlier  {

    my ($file,$date) = @_;

    open (INDEX, "wget " . $verbose . " \'" . $teststaturl . $file . ".html\' -O - |")
        || die "***Could not read the index page for $file\n";

    # Split at all HTML tags, except <a ..>
    my @suffixes = split ( /[<][b-zB-Z\/]+[>]/, <INDEX>);
    close (INDEX);

    # Select only those of the "href=..." that match our file
    my $rx = quotemeta ( $file);
    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;
    my @temp2 = grep /^[0-9]/, @temp;

    if ($#temp2 == -1) {
        return undef;
    }

    return $temp2[0];
}

sub select_builds ($$$)
{
    my ($rdates, $rbuilds, $rfiles) = @_;
    my @dates = @{$rdates};
    my @builds = @{$rbuilds};

    if ($#dates eq 1) {
        $rfiles->[0] = $rbuilds->[0];
        $rfiles->[1] = $rbuilds->[0];
    }
    elsif ($#builds eq 1) {
        $rfiles->[0] = $rbuilds->[0];
        $rfiles->[1] = $rbuilds->[1];

        $rdates->[1] = $rdates->[0];

    }
    else {
        die "Dates: $#dates, Builds: $#builds\n";
    }

    return 0;
}

sub load_failed_tests_list ($$)
{
    my ($file, $original_date) = @_;

    my $date = $original_date;
    my $last_tried_date = $original_date;
    my @timestamps = ();

    while ($#timestamps < 0) {

        @timestamps = find_timestamps ($file, $date);

        if ($#timestamps == -1) {
            $date = find_closest_earlier ($file, $date);
            if (!$date) {
                print "***Found no builds for $file on, or before $original_date\n";
                return File::Spec->devnull();
            }

            print "***No builds for $file on $last_tried_date. The closest earlier is "
                . $date . "\n";

            $last_tried_date = $date;
            next;
        }

        print "Build times for $file on $date are "
            . join (', ', @timestamps) . "\n" unless !$debugging;
    }

    my $tmpdir = File::Spec->tmpdir();
    my $fullfile = $file .'_' . $date . '_' . $timestamps[0];
    my ($fh, $tmpfile) = tempfile ($fullfile . ".XXXXXX", UNLINK => 1, DIR => $tmpdir);

    print "wget " . $verbose . " \'" .$teststaturl
            . $fullfile . ".txt\' -O - | sort >\'" . $tmpfile . '\'' . "\n" unless !$debugging;

    system ("wget " . $verbose . " \'" .$teststaturl
            . $fullfile . ".txt\' -O - | sort >\'" . $tmpfile . '\'');
    close ($fh);

    return $tmpfile;
}

sub differentiate ($$$)
{
    my ($rfiles, $rdates, $revision) = @_;

    print "Difference for dates " . join (', ', @$rdates) . "\n" unless !$debugging;

    my $first_file = load_failed_tests_list ($rfiles->[0], $rdates->[0]);
    my $second_file = load_failed_tests_list ($rfiles->[1], $rdates->[1]);

    open (DIFF, "diff -u \'" . $first_file . "\' \'" . $second_file . "\' 2>&1 |")
        || die "***Failed to diff \'" . $first_file . "\' \'" . $second_file . "\'\n";

    while (<DIFF>) {

        # Don't filter out the build details when printing the new errors only
        if (/^---/) {
            # Previous Build Date
            print;
        }
        elsif (/^\+\+\+/) {
            # Current Build date
            if ($revision) {
                chomp;
                print "$_ ($revision)\n";
            }
            else {
               print;
            }
        }
        elsif (/^[^\+]/) {
            # Anything except a new error
            print unless ($new_errors_only == 1);
        }
        elsif ($append_revision_to_new_test_fails && $revision) {
            chomp;
            print "$_ ($revision)\n";
        }
        else {
            print;
        }
    }

    close (DIFF);
    print "\n";
}

sub find_builds ($$$$$)
{
    my ($rbuilds, $buildscoreurl, $selectcolumn_name, $revision_hash, $selectcolumn_revision) = @_;

    print "Reading from $buildscoreurl\n" unless !$debugging;

    open (CLEANS, "wget " . $verbose . " \'" . $buildscoreurl . "\' -O - |")
        || die "Could not read builds score page $buildscoreurl\n";

    # Split at all spaces
    for(my $begin=0; <CLEANS>;)
    {
        chomp;
        my @columns = split (/ +/);

        if (/=+/) {
            $begin++;
            next;
        }

        if ($begin) {
           my $temp = %{$revision_hash};
           $temp->{$columns[$selectcolumn_name]} = $columns[$selectcolumn_revision];
           push (@{$rbuilds}, $columns[$selectcolumn_name]);
        }
    }
    close (CLEANS);
    sort @{$rbuilds};

    print "Using builds @{$rbuilds}\n" unless !$debugging;
}

my @dates = ();
my @builds = ();
my @files = ();

while ($arg = shift(@ARGV)) {

    if ($arg eq "-h" || $arg eq "-?") {
      print "Prints a diff for the list of test failures, for two builds on a certain date\n\n";
      print "diff-builds [-n] [-d] [-D date] [-A] [build ...]\n";
      print "\n";
      print "  -n          -- Show only new test failing (default=no)\n";
      print "  -d          -- Show debug info\n";
      print "  -h          -- Prints this information\n";
      print "  -D date     -- Specify a date. Either YYYY_MM_DD or YYYY-MM-DD works\n";
      print "                 Use two date parameters to specify an interval\n";
      print "  -A          -- Use all builds, not just the clean (successful) ones\n";
      print "  -r          -- Append SVN revision numbers to NEW test names\n";
      print "  build       -- Specify the build name. As it appears on the scoreboard\n";
      print "                 Works with two builds and one date to show the differences\n";
      print "                 between them. One build and two dates works, too.\n";
      print "                 Just a single date (no builds) implies comparing all of \n";
      print "                 today's builds with the builds on the supplied date.\n";
      exit 0;
    }
    if ($arg eq '-D') {
        my $date = shift(@ARGV);
        $date =~ s/-/_/g;
        push (@dates, $date);
        print "Date=$date\n"
            unless !$debugging;
    }
    elsif ($arg eq '-v') {
        $verbose = undef;
    }
    elsif ($arg eq '-d') {
        $debugging = 1;
    }
    elsif ($arg eq '-n') {
        $new_errors_only = 1;
    }
    elsif ($arg eq '-A') {
        $clean_builds_only = 0;
    }
    elsif ($arg eq '-r') {
        $append_revision_to_new_test_fails = 1;
    }
    else {
        push (@builds, $arg);
        print "Build=$arg\n"
            unless !$debugging;
    }
}

# Diff the todays clean builds with the ones from a specific date
if ($#builds == -1 && $#dates >= 0)
{
    my %revisions = {};

    # only the start date given - implies we should
    # use the today's date
    if ($#dates == 0) {
        $dates[1] = strftime ("%Y_%m_%d", gmtime);
    }

    if ($clean_builds_only) {
        find_builds (\@builds, $cleanbuildsurl . "-" . $dates[1] . ".txt" , 8, \%revisions, 7);
    }
    else {
        find_builds (\@builds, $allbuildsurl . "-" . $dates[1] . ".txt" , 4, \%revisions, 3);
    }

    foreach $build (sort @builds) {
        $files[0] = $files[1] = $build;
        differentiate (\@files, \@dates, $revisions{$build} );
    }
}
else
{
    die "More than one date or build name are required"
        unless ($#dates + $#builds ge 1);

    print "dates=@dates ($#dates)\n"
        unless !$debugging;

    print "builds=@builds ($#builds)\n"
        unless !$debugging;

    select_builds (\@dates, \@builds, \@files);
    differentiate (\@files, \@dates, 0);
}
__END__

=head1 diff-builds.pl Diff the lists of failing tests

=item DESCRIPTION
Prints a diff for the list of test failures, for two builds on a certain date.
Or, for two dates and a certain build.

=item EXAMPLE

diff-builds.pl WinXP_VC71_NET_Static_Debug -D 2006_04_17 -D 2006_05_12

=item AUTHOR
Iliyan Jeliazkov <iliyan@ociweb.com>


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

#   doxygen-convert-h.pl is a script that would be used to convert old
#   documented style ACE/TAO header files to doxygen style.

# TODO List:
#   (Search for @todo in this script)

use File::Copy;
use FileHandle;
use Getopt::Std;

##############################################################################
# Parse the options

if (!getopts ('dDhsu') || $opt_h) {
    print "doxygen-convert-h.pl [-dDhsu] filenames or directories\n";
    print "\n";
    print "    -d         debug script\n";
    print "    -D         really verbose debug\n";
    print "    -h         display this help\n";
    print "    -s         print result to stdout\n";
    print "    -u         turn off file verification\n";
    exit (1);
}

## if verbose debug, also regular debug
$opt_d = 1 if (defined $opt_D);

##############################################################################
# Find the files

@files = ();

sub recursive_find {
  my($file) = shift;
  my(@rfiles) = ();
  my($fh) = new FileHandle();

  if (opendir($fh, $file)) {
    foreach my $f (grep(!/^\.\.?$/, readdir($fh))) {
      if ($f ne '.svn') {
        my($full) = "$file/$f";
        if (-d $full) {
          push(@rfiles, recursive_find($full));
        }
        else {
          push(@rfiles, $full)
          if ($f =~ /\.(h|hxx|hpp|hh|inl|idl|cpp|cxx|cc|c|C)$/)
          ;
        }
      }
    }
    closedir($fh);
  }

  return @rfiles;
}

foreach $arg (@ARGV) {
    my @results = glob $arg;
    if ($#results < 0) {
        print STDERR "File not Found: $arg\n"
    }
    else {
        foreach my $result (@results) {
            if (-d $result) {
                push(@files, recursive_find($result));
            }
            else {
                push(@files, $result);
            }
        }
    }
}

##############################################################################
# Subroutines used to change the file.

$fail = 0;

sub verify (@)
{
    my (@contents) = @_;

    print "Verification\n" if (defined $opt_d);

    my $found_id = 0;
    my $found_filename = 0;

    foreach $line (@contents) {
        $found_id = 1 if ($line =~ /\$Id\:/);
        $found_filename = 1 if ($line =~ /\= FILENAME/);
    }

    return 0 if ($found_id == 1 && $found_filename == 1);

    # failed
    return 1;
}

sub format_description (@)
{
    my (@description) = @_;
    my @after = ();

    my $line;

    if ($#description < 1) {
        foreach $line (@description) {
            $line =~ s/\/\// \*  \@brief /;
            push @after, $line;
        }
    }
    else {
        foreach $line (@description) {
            $line =~ s/\/\// \*/;
            $line =~ s/\*   /\* /;
            push @after, $line;
        }
    }

    return @after;
}

sub fix_file_header (@)
{
    my (@before) = @_;
    my @after = ();
    my @description = ();
    my $id = "\$Id\$\n";
    my $authors = "";

    my $state = 'before';
    ## state = before, filename, description, author, after, done

    print "Fixing File Header\n" if (defined $opt_d);

    LOOP: foreach $line (@before) {
        printf ("%10s %s", $state, $line) if (defined $opt_D);

        if ($state eq 'done') {
            push @after, $line;
            next LOOP;
        }

        if ($state eq 'before') {
            if ($line =~ /\-\*\- C\+\+ \-\*\-/) {
                push @after, $line;
            }
            elsif ($line =~ /\$Id\:(.*)\n/) {
                $id = "\$Id\:$1";
            }
            elsif ($line =~ /===================/) {
                push @after, "//========================================".
                             "=====================================\n";
                push @after, "/**\n";
            }
            elsif ($line =~ /\= FILENAME/) {
                $state = 'filename';
                next LOOP;
            }
            elsif ($line !~ /^\s*\/\//) {
                push @after, $line;
            }
        }

        if ($state eq 'filename') {
            if ($line =~ /\/\/   (.+)/) {
                push @after, " *  \@file   $1\n";
                push @after, " *\n";
                push @after, " *  $id\n";
                push @after, " *\n";
            }
            elsif ($line =~ /\= DESCRIPTION/) {
                $state = 'description';
                next LOOP;
            }
            elsif ($line =~ /\= AUTHOR/) {
                $state = 'author';
                next LOOP;
            }
            elsif ($line =~ /===================/) {
                $state = 'after';
                ### Fall through so the after can put the ending in
            }
        }

        if ($state eq 'description') {
            if ($line =~ /\= AUTHOR/) {
                push @after, format_description (@description);
                @description = ();
                push @after, " *\n";
                $state = 'author';
                next LOOP;
            }
            elsif ($line =~ /===================/) {
                push @after, format_description (@description);
                @description = ();
                push @after, " *\n";
                $state = 'after';
                ### Fall through
            }
            push @description, $line;
        }
        if ($state eq 'author') {
            if ($line =~ /\/\/   (.+)\n/) {
                $authors .= $1;
            }
            elsif ($line =~ /===================/
                   || $line =~ /\= DESCRIPTION/) {
                ## print the authors

                if ($authors ne "") {
                    @authors = split /\,/, $authors;

                    foreach $author (@authors) {
                        if ($author =~ /^ (.*)/) {
                            $author = $1;
                        }
                        push @after, " *  \@author $author\n";
                    }
                }

                if ($line =~ /\= DESCRIPTION/) {
                    push @after, " *\n";
                    $state = 'description';
                    next LOOP;
                }
                else {
                    $state = 'after';
                    ## Fall through
                }
            }
        }

        if ($state eq 'after') {
            if ($line =~ /===================/) {
                ## print the rest
                push @after, " */\n";
                push @after, "//========================================".
                             "=====================================\n";
                push @after, "\n";
                $state = 'done';
            }

            next LOOP;
        }
    }

    return @after;
}

sub fix_class_headers (@)
{
    my (@before) = @_;
    my @after = ();
    my @store = ();
    my $classname = "";

    my $state = 'outside';
    ## state =
    ##  outside   = not in class
    ##  template  = stored template line
    ##  class     = started collecting lines, in case of a class
    ##  header    = after a class foo, but before any methods

    print "Fixing class headers\n" if (defined $opt_d);

    LOOP: foreach $line (@before) {
        printf ("%10s %s", $state, $line) if (defined $opt_D);

        if ($state eq 'outside') {
            if ($line =~ /^\s*template/) {
                push @store, $line;
                $state = 'template';
                next LOOP;
            }
            elsif ($line =~ /^\s*class/) {
                $state = 'class';
                ## Fall through
            }
            else {
                push @after, $line;
            }

        }

        if ($state eq 'template') {
            if ($line =~ /^\s*class/) {
                $state = 'class';
                ## Fall through
            }
            else {
                push @after, @store;
                @store = ();
                push @after, $line;
                $state = 'outside';
                next LOOP;
            }
        }

        if ($state eq 'class') {
            if ($line =~ /^\s*class(.*)\n/) {
                push @store, $line;
                my @s = split / /, $1;
                if ($s[1] =~ /export$/i) {
                    $classname = $s[2];
                }
                else {
                    $classname = $s[1];
                }
            }
            elsif ($line =~ /^\s*\{/) {
                push @store, $line;
            }
            elsif ($line =~ /^\s*\/\//) {
                $state = 'header';
                ### Fall through
            }
            else {
                push @after, @store;
                @store = ();
                push @after, $line;
                $state = 'outside';
                next LOOP;
            }
        }

        if ($state eq 'header') {
            if ($line =~ /^\s*\/\//) {
                push @headers, $line;
            }
            else {
                my $prefix = '';

                $line =~ /^(\s*)[\w\/]/;  ### used to get indent
                my $indent = $1;
                push @after, "$indent/**\n";
                push @after, "$indent * \@class $classname\n";

                foreach $header (@headers) {
                    if ($header =~ /\= TITLE/) {
                        push @after, "$indent *\n";
                        $prefix = "$indent * \@brief";
                    }
                    elsif ($header =~ /\= DESCRIPTION/) {
                        push @after, "$indent *\n";
                        $prefix = "$indent *";
                    }
                    elsif ($header !~ /\/\/\s*\n/) {
                        my $myline = $header;
                        $myline =~ s/\s*\/\/\s*/$prefix /;
                        push @after, $myline;
                        $prefix = "$indent *";

                    }
                }
                push @after, "$indent */\n";
                @headers = ();

                push @after, @store;
                push @after, $line;
                @store = ();
                $state = 'outside';
                next LOOP;
            }
        }
    }

    return @after;
}

sub format_comment (@)
{
    my (@comments) = @_;
    my @after = ();

    my $line;

    if ($#comments < 2) {
        foreach $line (@comments) {
            $line =~ s/\/\//\/\/\//;
            push @after, $line;
        }
    }
    else {
        my $line = $comments[0];
        $line =~ /^(\s*)\//;
        my $indent = $1;

        push @after, "$indent/**\n";
        foreach $line (@comments) {
            $line =~ s/\/\// */;
            push @after, $line;
        }
        push @after, "$indent */\n";
    }

    return @after;
}

sub fix_class_members (@)
{
    my (@before) = @_;
    my @after = ();
    my @method = ();
    my @comment = ();

    my $classfound = 0;
    my $classlevel = 0;
    my $level = 0;

    print "Fixing class methods\n" if (defined $opt_d);

    LOOP: foreach $line (@before) {
        if ($line =~ /\{/ && $line !~ /^\s*\/\//) {
            $level++;
        }

        if ($line =~ /^\s*class/
            && $line !~ /\;/
            && $level == $classlevel)
        {
            $classlevel++;
        }

        if ($line =~ /\}/ && $line !~ /^\s*\/\//) {
            if ($classlevel == $level) {
                $classlevel--;
            }
            $level--;
        }

        printf ("%2d%2d", $level, $classlevel) if (defined $opt_D);

        if ($level == $classlevel && $level > 0) {
            if ($line =~ /^\s*public/
                || $line =~ /^\s*private/
                || $line =~ /\s*protected/
                || $line =~ /^\s*\n$/
                || $line =~ /^\s*\{/
                || $line =~ /^\s*\}/
                || $line =~ /^\s*\#/)
            {
                push @after, format_comment (@comment);
                push @after, @method;
                @comment = ();
                @method = ();

                print "  $line" if (defined $opt_D);
                push @after, $line;
            }
            elsif ($line =~ /^\s*\/\//) {
                print "C $line" if (defined $opt_D);

                if ($#method >= 0) {
                    push @comment, $line;
                }
                else {
                    push @after, $line;
                }
            }
            else {
                print "M $line" if (defined $opt_D);
                push @method, $line;
            }

        }
        else {
            push @after, format_comment (@comment);
            push @after, @method;
            @comment = ();
            @method = ();

            print "  $line" if (defined $opt_D);
            push @after, $line;
        }
    }

    if ($level > 0 || $classlevel > 0) {
        $fail = 1;
        $failmessage = "Brace level recognition failed"
    }

    return @after;
}

##############################################################################
# Read in the files.

FILELOOP: foreach $file (@files) {
    print "\n" if (defined $opt_d);
    print "$file\n";
    print "\n" if (defined $opt_d);

    $fail = 0;

    my @contents = ();

    ### Read file into @contents
    print "Reading\n" if (defined $opt_d);

    unless (open (FILE, "<$file")) {
        print STDERR "$file: $!\n";
        next FILELOOP;
    }

    @contents = <FILE>;

    close (FILE);

    ### Verify file
    print "Verifying file\n" if (defined $opt_d);

    if (!defined $opt_u) {
        if (verify (@contents) == 1) {
            print "$file did not pass verification\n";
            next FILELOOP;
        }
        elsif (defined $opt_d) {
            print "Passed verification\n";
        }
    }

    ### Fix up parts of it
    print "Fixing file\n" if (defined $opt_d);

    @contents = fix_file_header (@contents);
    @contents = fix_class_headers (@contents);
    @contents = fix_class_members (@contents);

    if ($fail != 0) {
        print "$file: $failmessage\n";
    }
    else {
        if (defined $opt_s) {
            print @contents;
        }
        elsif (!defined $opt_D) {
            ### Save @contents back to the file
            print "Saving\n" if (defined $opt_d);

            unless (open (FILE, ">$file")) {
                print STDERR "$file: $!\n";
                next FILELOOP;
            }

            foreach $line (@contents) {
                print FILE $line;
            }

            close (FILE);
        }
    }
}