package Test::Darcs;
use Test::More; # provides diag;

use Exporter;
use Shell::Command;
use File::Temp ();

@ISA = qw(Exporter);
@EXPORT = qw(
    &darcs
    &echo_to_darcs
    &cleanup
    $DARCS
    &init_tmp_repo
);

use strict;
use vars '$DEBUG';

$DEBUG = $ENV{DARCS_DEBUG} || 0;

# Catch SIGPIPE signals.  Without this line, Perl dies silently if a
# write operation to a child process fails.
$SIG{PIPE} = sub { die "SIGPIPE received -- broken testcase?\n" };

use Cwd;

# Override the users default .darcs settings
$ENV{HOME} = cwd();
mkdir '.darcs';
system 'echo ALL --ignore-times >> .darcs/defaults';
# Used for finding darcs, but may not be defined by the shell
$ENV{PWD} = cwd();

# Put the right darcs first in PATH
my $darcspath="$ENV{HOME}/..";
if ($ENV{DARCS}) {
  # User has asked for a particular darcs...
  my $actualdarcs=`which $ENV{DARCS}`;
  my $darcspath=`dirname "$actualdarcs"`;
}
$ENV{PATH} = "$darcspath:$ENV{PATH}";

# Set a default author e-mail address to simplify test script creation. 
$ENV{EMAIL} = $ENV{DARCS_EMAIL} = 'tester';

# Turn off all color and escaping to make tests run faster and independent
# of users environment.
$ENV{DARCS_DONT_COLOR} = 1;
$ENV{DARCS_DONT_ESCAPE_ANYTHING} = 1;



=head1 NAME

Test::Darcs - functions to help testing darcs

=head1 SYNOPSIS

  use Test::More 'no_plan';
  use Test::Darcs;

  darcs 'init';

=head1 DESCRIPTION

Utility functions to help in the testing of darcs.

=head2 Functions

All functions here are exported by default.

=head3 darcs

  my $output = darcs @commands;

Runs darcs with the given @commands returning STDOUT and STDERR
combined.  Similar to:

    my $output = `darcs @commands 2>&1`;

but potentially more portable.

By default the darcs used is the one sitting in the source directory.
This can be overridden using the DARCS environment variable.

The exit code of the darcs command is available as C<$?>.

=cut

use vars '$DARCS';

sub darcs (@) {
    my @commands = @_;
    # The inclusion of "IFS" prevents a space in the path to darcs from causing a problem. 
    my $out = `darcs @commands 2>&1`;

    diag "DEBUG output for darcs @commands:\n\t$out" if ($DEBUG && $out);
    return $out;
}

=head2 echo_to_darcs()

 my $out = echo_to_darcs('pull -a','y',@extra );

This wrapper helps simulate interactive input to darcs.

Here, "y" would answer the first question that darcs asks, and then
each element in @extra would be sent to darcs after a newline. 

=cut

sub echo_to_darcs {
    my $command = shift;
    my $first_input = shift;
    my @rest_of_input = @_;

    # This file receives superfluous input not read by darcs.
    my $fh = File::Temp->new;
    my $filename = $fh->filename;

    local(*READ, *WRITE);
    use IPC::Open2;
    my $pid = open2(*READ, *WRITE, qq( 'darcs' $command ; cat > $filename));
    print WRITE "$first_input";
    for my $i (@rest_of_input) {
      print WRITE "\n$i";
    }
    close WRITE;

    my $out = join '', <READ>;

    close READ;

    # Wait until the process has finished, to make sure that darcs
    # and the following cat have run to completion.
    waitpid $pid, 0;

    my $superfluous = <$fh>;
    unlink $filename;
    if ($superfluous) {
        use Test::Builder;
        my $Test = Test::Builder->new;
        $Test->ok (0, "superfluous input for $command");
    }

    diag "DEBUG:\n\t$out" if ($DEBUG && $out);

    return $out;
}

=head2 init_tmp_repo

 my $path = init_tmp_repo(@args_to_init);

Initialize a temporary repo and 'chdir' into it. 
Any arguments will be passed to init. 
The path name of the repo created is returned. 
The repo will automatically be removed when the script exits. 

Because the name has some randomness to it, you can call it twice
to get two different temporary repo names.

=cut

sub init_tmp_repo {
    my @args_to_init = @_;

    # For good measure, delete the directory if it already exists so we can start clean;
    rm_rf 'temp';

    mkdir 'temp' || die "couldn't makdir temp: $!";

    # Self destruct the directory unless we ask it not to. 
    END { chdir; rm_rf "temp" unless $ENV{DARCS_KEEP_TMPDIR};  };

    chdir 'temp' || die "couldn't chdir to temp: $!";
    darcs('init',@args_to_init);
    
    return 'temp';
}

# The following is a workaround for a bug in Shell::Command which emits an
# error message when given a file that doesn't exist.

sub cleanup {
  my $f;
  foreach $f (@_) {
    rm_rf $f if (-e $f);
  }
}

=head1 ENVIRONMENT

=head3 DARCS

darcs() normally uses the copy of darcs in the source directory but if
DARCS is set it will use that copy of darcs instead.

=head3 DARCS_DEBUG

Set this to see the output of every 'darcs' call made through this script:

 DARCS_DEBUG=1 ./bin/prove -v add.pl pull.pl

=head3 DARCS_KEEP_TMPDIR

Set this if you want the temporary repos created to stick around when the
script exits. They are named like "add.pl-tmpdir"

=cut

1;
