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
}
print "Test description: $description\n";
print "Checking whether the number of rows $logical_test $reference_size\n";
# 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;
print "Query: $query\n";
my $sth = $self->data_dbc()->prepare($query);
$sth->{mysql_use_result} = 1 if $self->data_dbc->driver eq 'mysql';
$sth->execute();
my $nrow = 0;
while (defined $sth->fetchrow_arrayref()) {
$nrow++;
}
$sth->finish;
print "$nrow rows returned".($nrow == $maxrow ? " (test aborted, there could be more rows)" : "")."\n";
# 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";
}
warn $success ? "Success\n\n" : "Failure\n\n";
return $success;
}