The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
# Test fetching

use Test::More;
use DBI;
use strict;
$|=1;

my @len = (1, 10, 50, 100, 1000, 1467, 1468, 2000, 3000, 4000, 4466,
           4467, 5000, 10000, 20000, 30000, 40000);

# 1487 goes into an infinite loop; apparently, so does 1487 + (N * 1500) for
# integer N
my %bad_len = map { $_ => 1 } 1487, 2987, 4487;
push @len, sort keys %bad_len;

if (defined $ENV{DBI_DSN}) {
    plan tests => 22 + 3 * @len;
}
else {
    plan skip_all => 'Cannot run test unless DBI_DSN is defined. See the README file.';
}

my $db = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
                       {RaiseError => 1, PrintError => 0, AutoCommit => 1});

ok(defined $db, "Connect to database for testing result fetches");

# XXX: This test only works on recent-enough versions of PostgreSQL, which
# give a warning for string literals that use backslashes
ok($db->do(q[SELECT '\\\\' AS a]),
   'Syntax warning is handled correctly');

{
    # This tests assembling parsed statements and query arguments into whole
    # statements
    my $data = $db->selectall_arrayref(q[
        SELECT ? AS a, ? AS b, ? AS c
    ], {Slice => {}}, 'a', 'b', undef);
    is_deeply($data, [{a => 'a', b => 'b', c => undef}],
              'Three-param statement returns correct data');
}

{
    my $data = $db->selectall_arrayref(
        q[SELECT /* ? */ '?' AS "a?", ? AS b], {Slice => {}}, 'b?');
    is_deeply($data, [{'a?' => '?', b => 'b?'}],
              'Literal and commented "?" parsed correctly');
}

{
    # This tests that argument values containing "?" don't affect parsing; see
    # https://rt.cpan.org/Ticket/Display.html?id=23900
    my $data = $db->selectall_arrayref(
        q[SELECT ? AS a, ? AS b], {Slice => {}}, 'a?', 'b');
    is_deeply($data, [{a => 'a?', b => 'b'}],
              'Arg with "?" returns correct data');
}

{
    my $st = $db->prepare(q[SELECT 1 AS a WHERE false]);
    ok($st->execute, 'Execute prepared statement');
    is_deeply($st->fetchall_arrayref, [], 'First fetch');
    # XXX: second fetch is likely to block on a non-forthcoming packet if
    # there's a bug.
    is_deeply($st->fetchall_arrayref, [], 'Second fetch');
}

{
    my $data = $db->selectall_arrayref(q[SELECT '\\\\000\\\\001'::bytea AS a]);
    is_deeply($data, [["\000\001"]], 'Bytea demangling works');
}

{
    my $st = $db->prepare(q[SELECT ? AS a]);

    $st->bind_param(1, 'foo');
    $st->execute;
    is_deeply($st->fetchall_arrayref, [['foo']], 'trivial bind_param');

    $st->bind_param(1, 'foo', 25); # type with OID 25 is text
    $st->execute;
    is_deeply($st->fetchall_arrayref, [['foo']], 'minimal typed bind_param');
}

{
    my $data = eval { $db->selectall_arrayref(q[SELECT ? AS a]) };
    my $err = $@;
    ok(!$data, 'Execute with too few params fails');
    like($err, qr/Wrong number /,
         'Execute with too few params dies well');
}

{
    my $data = eval {
        $db->selectall_arrayref(q[SELECT ? AS a], undef, 'a', 'b') };
    my $err = $@;
    ok(!$data, 'Execute with too many params fails');
    like($err, qr/Wrong number /,
         'Execute with too many params dies well');
}

{
    my $st = $db->prepare(q[SELECT ? AS a]);

    my $data = eval { $db->selectall_arrayref($st) };
    my $err = $@;
    ok(!$data, 'Execute with too few bound params fails');
    like($err, qr/Wrong number /,
         'Execute with too few bound params dies well');

    $st->bind_param(1, 'a');
    $st->bind_param(2, 'b');
    $data = eval { $db->selectall_arrayref($st) };
    $err = $@;
    ok(!$data, 'Execute with too many bound params fails');
    like($err, qr/Wrong number /,
         'Execute with too many bound params dies well');
}

{
    my $st = eval { $db->prepare(qq[SELECT ? AS a\0]) };
    my $err = $@;
    ok(!$st, 'Preparing a query containing \0 fails');
    like($err, qr/\\0 byte/, 'Preparing a query containing \0 dies well');
}

{
    my $data = $db->selectall_arrayref(q[SELECT ? AS a], undef, "a\0b");
    is_deeply($data, [['a']], 'Quoting \0 works as well as possible');
}

for (@len) {
    my $value = $db->selectrow_array(qq[SELECT Repeat('a', $_)]);
    ok(defined $value, "Long result row returned ($_)");

    # We avoid testing the fetched value against the expected one directly,
    # because in verbose mode we end up with ginormous strings being dumped
    # to your terminal as the "expected" value.  Instead, just check that
    # every value is "suitable" (contains nothing but 'a'), and that it has
    # the right length; those two together test that it's the expected value.
    like($value, qr/^a*\z/, "Long result row of $_ bytes has suitable value");
    is(length $value, $_, "Long result row has correct length ($_)");
}