#!/usr/bin/perl

=head1 Darcs Speed Test script 

=head2 SYNOPSIS

 darcs_speed_test.pl ../repo [darcs binaries...]

=head2 DESCRIPTION

This script is used to test the performance of one or more darcs binaries.
The tests that will be run depend on the flags given above. 

The result will be a report printed to the screen, comparing the results for 
each binary. 

The most "interesting" number reported is the "wallclock" time for each test. 

For the most useful results, you should run your tests against the same repo
each time. 

The tests will make some minor modifications to the repo, but have the intent to
"put things back how they find them". Still, you may want to create a copy of
an entire repo for for testing, just in case some accidently mangling occurs. 

=head2 IDEAS

A future version could offer a CSV output format. 

It would be nice (and speed things up) if we accumulated results in a data file
somewhere.  

A "--test-name" flag could be added, to allow running a test by name, instead
of every test.

Less system calls could be used for better portability. 

Add a test for this case:
http://bugs.darcs.net//index.html?q=222

=head2 Contributors

Started by Mark Stosberg <mark@summersault.com>

=head2 License

This code is licensed under the GNU GPL. 

=cut 

use strict;
use Benchmark (qw/:all/);
use Getopt::Long;
use File::Slurp;
use File::Path;

my ($repo,@bins) = @ARGV;
die "usage: $0  ./repo_path/ ./darcs_bin/path\n" unless $repo;

die "not a valid repo" unless (-r "$repo/_darcs");

my @darcs_binaries = validate_darcs_binaries(@bins);

chdir $repo || die "could not chdir to $repo";

=head2 Test definitions

Here you can define the tests you wan to run. The hash keys
work as follows:
 
 - setup    - Optional. Coderef to run once before this group of tests is run.
 - teardown - Optional. Coderef to run once after this group of tests is run.
 - count    - Optional. Number of times to run the test for each binary. Defaults to 1.
 - test     - Required. Coderef for the actual test. If there is any setup that has to
              be done each time the test is run, it will have to be included here.
              This subroutine recieves one argument, the path to a binary. 

=cut

my %tests = (
     'whatsnew -ls' => {
         test     => sub { my $bin = shift; `$bin whatsnew -ls` },
         count    => 5,   
     },
     # using --look-for-adds whe given specific file names is too slow. 
     'whatsnew -ls empty.txt' => {
         setup    => sub { `touch empty.txt`; `darcs add empty.txt`;},
         test     => sub { my $bin = shift; `$bin whatsnew -ls empty.txt 2>&1`; },
         teardown => sub { `rm -f empty.txt`},
         count    => 5,   
     },
     'whatsnew -s empty.txt' => {
         setup    => sub { `touch empty.txt`; `darcs add empty.txt`;},
         test     => sub { my $bin = shift; `$bin whatsnew -s empty.txt 2>&1` },
         teardown => sub { `rm -f empty.txt`},
         count    => 5,   
     },
      'diff file.txt' => {
          setup    => sub { append_file('ChangeLog',"My new line\n") || die "Couldn't append to: ChangeLog: $!"; },
          test     => sub { my $bin = shift; `$bin diff ChangeLog 2>&1` },
          teardown => sub { `echo 'y' | darcs revert -a ChangeLog` },
      },
    'local pull with long shared history and no changes' => {
        # Here I can copy just the _darcs dir to speed things up. 
        setup    => sub { mkpath('../test_repo2/'); `cp -r _darcs ../test_repo2/`;},
        test     => sub { my $bin = shift; `$bin pull ../test_repo2`; },
        teardown => sub { rmtree('../test_repo2') },
        count    => 5,   
    }


);

####

for my $t (sort keys %tests) {
    print "-" x 73, "\n", "Running test: $t \n";

    $tests{$t}{setup}->() if $tests{$t}{setup};

    my %subs;
    for my $bin (@darcs_binaries) {
        my $short_path = $bin;
        $short_path =~ s?$ENV{PWD}??;
        $subs{$short_path} = sub { $tests{$t}{test}->($bin) };
    }

    my $cnt = $tests{$t}{count} || 1;

    timethese( $cnt, \%subs);

    $tests{$t}{teardown}->() if $tests{$t}{teardown};
}

=head2 validate_darcs_binaries()

 my @darcs_binaries = validate_darcs_binaries(@ARGV);

Check darcs binary passed on the command line to see if we can run it. 
Die if any of them don't pass, or return them all as an array.

At least two must be passed in.

=cut

sub validate_darcs_binaries {
    my @bins = @_;
    my @darcs_binaries;

    if (scalar @bins < 2) {
        die "must specify at least two darcs binaries";
    }

    for my $bin (@bins) {
        if (`$bin --version` =~ m/\d/) {
            # Make absolute path unless we have one 
            my $abs_path;
            if ($bin =~ m%^[/~]%) {
                $abs_path = $bin;
            }
            else {
                $abs_path = "$ENV{PWD}/$bin";
            }

            push @darcs_binaries, $abs_path;
        }
        else {
            die "$bin does not appear to be a valid darcs binary";
        }
    }
    return @darcs_binaries;
}