TAP: Add easier, more flexible ways to invoke psql

The PostgresNode::psql method is limited - it offers no access
to the return code from psql, ignores SQL errors, and offers
no access to psql's stderr.

Provide a new psql_expert that addresses those limitations and
can be used more flexibly - see the embedded PerlDoc for details.

Also add a new psql_check method that invokes psql and dies if
the SQL fails with any error. Test scripts should use this so
they automatically die if SQL that should succeed fails instead;
with the current psql method such failures would go undetected.

Author: ringerc

src/test/perl/PostgresNode.pm

@@ -21,8 +21,20 @@ PostgresNode - class representing PostgreSQL server instance
   $node->restart('fast');
 
   # run a query with psql
-  # like: psql -qAXt postgres -c 'SELECT 1;'
-  $psql_stdout = $node->psql('postgres', 'SELECT 1');
+  # like:
+  #   echo 'SELECT 1' | psql -qAXt postgres -v ON_ERROR_STOP=1
+  $psql_stdout = $node->psql_check('postgres', 'SELECT 1');
+
+  # Run psql with a timeout, capturing stdout and stderr
+  # as well as the psql exit code. Pass some extra psql
+  # options. If there's an error from psql raise an exception.
+  my ($stdout, $stderr, $timed_out);
+  my $cmdret = $psql_expert('postgres', 'SELECT pg_sleep(60)',
+	  stdout => \$stdout, stderr => \$stderr,
+	  timeout => 30, timed_out => \$timed_out,
+	  extra_params => ['--single-transaction'],
+	  on_error_die => 1)
+  print "Sleep timed out" if $timed_out;
 
   # run query every second until it returns 't'
   # or times out
@@ -69,6 +81,7 @@ use IPC::Run;
 use RecursiveCopy;
 use Test::More;
 use TestLib ();
+use Scalar::Util qw(blessed);
 
 our @EXPORT = qw(
   get_new_node
@@ -780,11 +793,16 @@ sub teardown_node
 
 =item $node->psql(dbname, sql)
 
-Run a query with psql and return stdout, or on error print stderr.
+Run a query with psql and return stdout if psql returns with no error.
 
-Executes a query/script with psql and returns psql's standard output.  psql is
-run in unaligned tuples-only quiet mode with psqlrc disabled so simple queries
-will just return the result row(s) with fields separated by commas.
+psql is run in unaligned tuples-only quiet mode with psqlrc disabled so simple
+queries will just return the result row(s) with fields separated by commas.
+
+If any stderr output is generated it is printed and discarded.
+
+Nonzero return codes from psql are ignored and discarded.
+
+Use psql_expert for more control.
 
 =cut
 
@@ -793,24 +811,215 @@ sub psql
 	my ($self, $dbname, $sql) = @_;
 
 	my ($stdout, $stderr);
+
 	my $name = $self->name;
 	print("### Running SQL command on node \"$name\": $sql\n");
 
-	IPC::Run::run [ 'psql', '-XAtq', '-d', $self->connstr($dbname), '-f',
-		'-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr
-	  or die;
+	# Run the command, ignoring errors
+	$self->psql_expert($dbname, $sql, stdout => \$stdout, stderr => \$stderr,
+	    on_error_die => 0, on_error_stop => 0);
+
+	if ($stderr ne "")
+	{
+		print "#### Begin standard error\n";
+		print $stderr;
+		print "\n#### End standard error\n";
+	}
+	return $stdout;
+}
+
+=pod $node->psql_check($dbname, $sql) => stdout
+
+Invoke 'psql' to run 'sql' on 'dbname' and return its stdout on success.
+Die if the SQL produces an error. Runs with ON_ERROR_STOP set.
+
+Takes optional extra params like timeout and timed_out parameters with the same
+options as psql_expert.
 
+=cut
+
+sub psql_check
+{
+	my ($self, $dbname, $sql, %params) = @_;
+
+	my ($stdout, $stderr);
+
+	my $ret = $self->psql_expert($dbname, $sql,
+	    %params,
+	    stdout => \$stdout, stderr => \$stderr,
+	    on_error_die => 1, on_error_stop => 1);
+
+	# psql can emit stderr from NOTICEs etc
 	if ($stderr ne "")
 	{
 		print "#### Begin standard error\n";
 		print $stderr;
-		print "#### End standard error\n";
+		print "\n#### End standard error\n";
 	}
-	chomp $stdout;
-	$stdout =~ s/\r//g if $Config{osname} eq 'msys';
+
 	return $stdout;
 }
 
+=pod $node->psql_expert($dbname, $sql, %params) => psql_retval
+
+Invoke 'psql' to run 'sql' on 'dbname' and return the return value from
+psql, which is run with on_error_stop by default so that it will stop running
+sql and return 3 if the passed SQL results in an error.
+
+psql is invoked in tuples-only unaligned mode with reading of psqlrc disabled. That
+may be overridden by passing extra psql parameters.
+
+stdout and stderr are transformed to unix line endings if on Windows and any
+trailing newline is removed.
+
+Dies on failure to invoke psql but not if psql exits with a nonzero return code
+(unless on_error_die specified). Dies if psql exits with a signal.
+
+=over
+
+=item stdout => \$stdout
+
+If a scalar to write stdout to is passed as the keyword parameter 'stdout' it
+will be set to psql's stdout.
+
+=item stderr => \$stderr
+
+Same as 'stdout' but gets stderr. If the same scalar is passed for both stdout
+and stderr the results may be interleaved unpredictably.
+
+=item on_error_stop => 1
+
+By default psql_expert invokes psql with ON_ERROR_STOP=1 set so it will
+stop executing SQL at the first error and return exit code 2. If you want
+to ignore errors, pass 0 to on_error_stop.
+
+=item on_error_die => 0
+
+By default psql_expert returns psql's result code. Pass on_error_die to instead
+die with an informative message.
+
+=item timeout => 'interval'
+
+Set a timeout for the psql call as an interval accepted by IPC::Run::timer.
+Integer seconds is fine. psql_expert dies with an exception on timeout unless
+the timed_out parameter is passed.
+
+=item timed_out => \$timed_out
+
+Keyword parameter. Pass a scalar reference and it'll be set to true if the psql
+call timed out instead of dying. Has no effect unless 'timeout' is set.
+
+=item extra_params => ['--single-transaction']
+
+Pass additional parameters to psql. Must be an arrayref.
+
+=back
+
+e.g.
+
+	my ($stdout, $stderr, $timed_out);
+	my $cmdret = $psql_expert('postgres', 'SELECT pg_sleep(60)',
+		stdout => \$stdout, stderr => \$stderr,
+		timeout => 30, timed_out => \$timed_out,
+		extra_params => ['--single-transaction'])
+
+will set $cmdret to undef and $timed_out to a true value.
+
+	$psql_expert('postgres', $sql, on_error_die => 1);
+
+dies with an informative message if $sql fails.
+
+=cut
+
+sub psql_expert
+{
+	my ($self, $dbname, $sql, %params) = @_;
+
+	my $stdout = $params{stdout};
+	my $stderr = $params{stderr};
+	my $timeout = undef;
+	my $timeout_exception = 'psql timed out';
+	my @psql_params = ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-');
+
+	$params{on_error_stop} = 1 unless defined $params{on_error_stop};
+	$params{on_error_die} = 0 unless defined $params{on_error_die};
+
+	push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop};
+	push @psql_params, @{$params{extra_params}} if defined $params{extra_params};
+
+	$timeout = IPC::Run::timeout( $params{timeout}, exception => $timeout_exception)
+		if (defined($params{timeout}));
+
+	# IPC::Run would otherwise append to existing contents:
+	$$stdout = "" if ref($stdout);
+	$$stderr = "" if ref($stderr);
+
+	my $ret;
+
+	# Perl's exception handling is ... interesting. Especially since we have to
+	# support 5.8.8. So we hide that from the caller, returning true/false for
+	# timeout instead.  See
+	# http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm for
+	# background.
+	my $error = do {
+		local $@;
+		eval {
+			IPC::Run::run \@psql_params, '<', \$sql, '>', $stdout, '2>', $stderr, $timeout;
+			$ret = $?;
+		};
+		my $exc_save = $@;
+		if ($exc_save) {
+		  # IPC::Run::run threw an exception. re-throw unless it's a
+		  # timeout, which we'll handle by testing is_expired
+		  if (blessed($exc_save) || $exc_save ne $timeout_exception) {
+			  print "Exception from IPC::Run::run when invoking psql: '$exc_save'\n";
+			  die $exc_save;
+		  } else {
+			  $ret = undef;
+
+			  die "Got timeout exception '$exc_save' but timer not expired?!"
+				  unless $timeout->is_expired;
+
+			  if (defined($params{timed_out}))
+			  {
+			    ${$params{timed_out}} = 1;
+			  } else {
+			    die "psql timed out while running '@psql_params', stderr '$$stderr'";
+			  }
+		  }
+		}
+	};
+
+	chomp $$stdout;
+	$$stdout =~ s/\r//g if $Config{osname} eq 'msys';
+
+	chomp $$stderr;
+	$$stderr =~ s/\r//g if $Config{osname} eq 'msys';
+
+	# See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR
+	# We don't use IPC::Run::Simple to limit dependencies.
+	#
+	# We always die on signal. If someone wants to capture signals
+	# to psql we can return it with another reference out parameter.
+	die "psql exited with signal " . ($ret & 127) . ": '$$stderr' while running '@psql_params'"
+	  if $ret & 127;
+	die "psql exited with core dump: '$$stderr' while running '@psql_params'"
+	  if $ret & 128;
+	$ret = $ret >> 8;
+
+	if ($ret && $params{on_error_die}) {
+	  die "psql command line syntax error or internal error: '$$stderr' while running '@psql_params'"
+	    if $ret == 1;
+	  die "psql connection error: '$$stderr' while running '@psql_params'"
+	    if $ret == 2;
+	  die "error when running passed SQL: '$$stderr' while running '@psql_params'"
+	    if $ret == 3;
+	  die "unexpected error code $ret from psql: '$$stderr' while running '@psql_params'";
+	}
+
+	return $ret;
+}
+
 =pod
 
 =item $node->poll_query_until(dbname, query)