my $self = shift @_;
my $test = shift @_;
my $description = $test->{description};
my $query = $test->{subst_query};
my $reference_size = $test->{reference_size};
my $logical_test = $test->{logical_test};
# Final semicolons are removed if present
if ($query =~ /(;\s*$)/) {
$query =~ s/$1
}
$self->say_with_header( "Test description: $description" );
$self->say_with_header( "Checking whether the number of rows $logical_test $reference_size" );
# This could benefit from 'switch' once we move to a more recent version of Perl
my $maxrow = $reference_size;
$maxrow++ if grep {$_ eq $logical_test} qw(= == > <= <> !=);
$query .= " LIMIT $maxrow" unless $query =~ /LIMIT/i;
$self->say_with_header( "Query: $query" );
my $sth = $self->data_dbc()->prepare( $query,
($self->data_dbc->driver eq 'mysql') ? { 'mysql_use_result' => 1 } : undef );
$sth->execute();
my $nrow = 0;
while (defined $sth->fetchrow_arrayref()) {
$nrow++;
}
$sth->finish;
$self->say_with_header( "$nrow rows returned".($nrow == $maxrow ? " (test aborted, there could be more rows)" : "") );
# This could benefit from 'switch' once we move to a more recent version of Perl
my $success = 0;
if ($logical_test eq '=' or $logical_test eq '==') {
$success = 1 if $nrow == $reference_size;
} elsif ($logical_test eq '<' or $logical_test eq '<=') {
$success = 1 if $nrow < $maxrow;
} elsif ($logical_test eq '>' or $logical_test eq '>=') {
$success = 1 if $nrow >= $maxrow;
} elsif ($logical_test eq '<>' or $logical_test eq '!=') {
$success = 1 if $nrow != $reference_size;
} else {
die "This should not happen. A logical test is not checked";
}
$self->say_with_header( $success ? "Success\n" : "Failure\n", 'important');
return $success;
}