=over 4
-=item check_req
-
=item compare
=item evcheck
-=item only_files
-
=item save_output
=item restore_output
=cut
-@EXPORT_OK = qw( check_req compare evcheck only_files
+@EXPORT_OK = qw( compare evcheck
save_output restore_output tempdir tmpnam );
# Utility -----------------------------
# PACKAGE FUNCTIONS
# -------------------------------------
-=head2 only_files
-
-=over 4
-
-=item ARGUMENTS
-
-=over 4
-
-=item expect
-
-Arrayref of names of files to expect to exist.
-
-=back
-
-=item RETURNS
-
-=over 4
-
-=item ok
-
-1 if exactly expected files exist, false otherwise.
-
-=back
-
-=back
-
-=cut
-
-sub only_files {
- my ($expect) = @_;
-
- local *MYDIR;
- opendir MYDIR, '.';
- my %files = map { $_ => 1 } readdir MYDIR;
- closedir MYDIR;
-
- my $ok = 1;
-
- for (@$expect, '.', '..') {
- if ( exists $files{$_} ) {
- delete $files{$_};
- } elsif ( ! -e $_ ) { # $_ might be absolute
- carp "File not found: $_\n"
- if $ENV{TEST_DEBUG};
- $ok = 0;
- }
- }
-
- for (keys %files) {
- carp "Extra file found: $_\n"
- if $ENV{TEST_DEBUG};
- $ok = 0;
- }
-
- if ( $ok ) {
- return 1;
- } else {
- return;
- }
-}
-
-# -------------------------------------
-
=head2 evcheck
Eval code, return status
# -------------------------------------
-=head2 check_req
-
-Perform a requisite check on a given executable. This will skip if the
-required modules are not present.
-
-4+(n+m)*2 tests are performed, where n is the number of prerequisites
-expected, and m is the number of outputs expected.
-
-=over 4
-
-=item SYNOPSIS
-
- check_req('ccu-touch',
- ['/etc/passwd'],
- [[REQ_FILE, '/etc/passwd']],
- [[REQ_FILE, 'passwd.foo']],
- 'requisites 1');
-
-
-=item ARGUMENTS
-
-=over 4
-
-=item cmd_name
-
-The name of the command to run. It is assumed that this command is in
-blib/script; hence it should be an executable in this package, and C<make>
-shuold have been run recently.
-
-=item args
-
-The arguments to pass to the cmd_name, as an arrayref.
-
-=item epres
-
-The expected prerequisites, as an arrayref, wherein every member is a
-two-element arrayref, the members being the requisite type, and the requisite
-value.
-
-=item eouts
-
-The expected outputs, in the same format as the L<epres|"epres">.
-
-=item testname
-
-The name to use in error messages.
-
-=back
-
-=back
-
-=cut
-
-sub check_req {
- my ($cmd_name, $args, $epres, $eouts, $testname) = @_;
-
- eval "use Pipeline::DataFlow 1.03 qw( :req_types );";
- my $skip;
- if ( $@ ) {
- print STDERR "$@\n"
- if $ENV{TEST_DEBUG};
- $skip = 'Skipped: Pipeline::DataFlow 1.03 not found';
- } else {
- $skip = 0;
- }
-
- my $count = 1;
- my $test = sub {
- my ($code, $expect) = @_;
- my $name = sprintf "%s (%2d)", $testname, $count++;
- my $value = UNIVERSAL::isa($code, 'CODE') ? $code->($name) : $code;
- skip $skip, $value, $expect, $name;
- };
-
- # Initialize nicely to cope when read_reqs fails
- my ($pres, $outs) = ([], []);
-
- $test->(sub {
- evcheck(sub {
- ($pres, $outs) = Pipeline::DataFlow->read_reqs
- ([catfile($Bin, updir, 'blib', 'script', $cmd_name),
- @$args]);
- }, $_[0]),},
- 1);
-
- $test->(scalar @$pres, scalar @$epres);
-
- my (@epres, @pres);
- @epres = sort { $a->[1] cmp $b->[1] } @$epres;
- @pres = sort { $a->[1] cmp $b->[1] } @$pres;
-
- for (my $i = 0; $i < @epres; $i++) {
- my ($type, $value) = @{$epres[$i]};
- $test->($type, @pres > $i ? $pres[$i]->[0] : undef);
- $test->($value, @pres > $i ? $pres[$i]->[1] : undef);
- }
-
- $test->(scalar @$outs, scalar @$eouts);
-
- my (@eouts, @outs);
- @eouts = sort { $a->[1] cmp $b->[1] } @$eouts;
- @outs = sort { $a->[1] cmp $b->[1] } @$outs;
-
- for (my $i = 0; $i < @eouts; $i++) {
- my ($type, $value) = @{$eouts[$i]};
- $test->($type, @outs > $i ? $outs[$i]->[0] : undef);
- $test->($value, @outs > $i ? $outs[$i]->[1] : undef);
- }
-
- $test->(only_files([]), 1);
-}
-
-# -------------------------------------
-
=head2 find_exec
=over 4