package Test::Darcs;

use Exporter;
use Shell::Command;
@ISA = qw(Exporter);
@EXPORT = qw(
    &darcs
    &echo_to_darcs
    &cleanup
    $DARCS
);

use strict;

# 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" };

=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 qw/$DARCS/;
sub _find_darcs {
    return $DARCS if defined $DARCS;

    my $darcs = $ENV{DARCS} || "$ENV{PWD}/../darcs";
    die "darcs not found as $darcs" unless -x $darcs;
    $DARCS = $darcs;

    return $DARCS;
}

sub darcs (@) {
    my @commands = @_;
    my $darcs = _find_darcs;
    return `$darcs @commands 2>&1`;
}

=head2 echo_to_darcs()

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

This effectively pipes the first argument to a darcs command
given as the second argument. Similiar to:

 my $out = `echo -n 'y' | darcs pull \a`;

but potentially more portable.

It's only good for sending one bit of input, not for a truly interactive
session.

=cut

sub echo_to_darcs {
    my($input, $command) = @_;

    my $darcs = _find_darcs;

    # This file receives superfluous input not read by darcs.
    use File::Temp qw/tempfile/;
    my ($fh, $filename) = tempfile();

    local(*READ, *WRITE);
    use IPC::Open2;
    my $pid = open2(*READ, *WRITE, "$darcs $command ; cat > $filename");
    print WRITE "$input";
    close WRITE;

    my $output = 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");
    }

    return $output;
}

# 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.

=cut

1;