view release on metacpan or  search on metacpan

t/09arrays.t  view on Meta::CPAN

1::text
['1']
Text number should quote

1,2,3
[1,2,3]
Unspecified int should not quote

1::int
[1]
Integer number should quote

'(1,2),(4,5)'::box,'(5,3),(4,5)'
['(4,5),(1,2)','(5,5),(4,3)']
Type 'box' works

!;

$Data::Dumper::Indent = 0;

for my $test (split /\n\n/ => $array_tests_out) {
    next unless $test =~ /\w/;
    my ($input,$expected,$msg) = split /\n/ => $test;
    my $qexpected = $expected;
    if ($expected =~ s/\s*quote:\s*(.+)//) {
        $qexpected = $1;
    }
    if ($msg =~ s/NEED ([0-9]+):\s*//) {
        my $ver = $1;
        if ($pgversion < $ver) {
            my ($maj, $min, $patch) = $ver =~ /\A([0-9]{1,2})([0-9]{2})([0-9]{2})\z/;
            $_ += 0 for $maj, $min, $patch;
          SKIP: {
                skip ("$msg requires PostgreSQL $maj.$min.$patch or newer", 1);
            }
            next;
        }
    }

    $t="Array test $msg : $input";
    $SQL = qq{SELECT ARRAY[$input]};
    $result = '';
    eval {
        $result = $dbh->selectall_arrayref($SQL)->[0][0];
    };
    if ($result =~ /error:\s+(.+)/i) {
        like ($@, qr{$1}, "Array failed : $msg : $input");
    }
    else {
        $expected = eval $expected;
        ## is_deeply does not handle type differences
        is ((Dumper $result), (Dumper $expected), $t);
    }
}

## Check utf-8 in and out of the database

SKIP: {
    eval { require Encode; };
    skip ('Encode module is needed for unicode tests', 14) if $@;

    my $server_encoding = $dbh->selectall_arrayref('SHOW server_encoding')->[0][0];
    skip ('Cannot reliably test unicode without a UTF8 database', 14)
        if $server_encoding ne 'UTF8';

    $t='String should be UTF-8';
    local $dbh->{pg_enable_utf8} = 1;
    my $utf8_str = chr(0x100).'dam'; # LATIN CAPITAL LETTER A WITH MACRON
    ok (Encode::is_utf8( $utf8_str ), $t);

    $t='quote() handles utf8';
    my $quoted = $dbh->quote($utf8_str);
    is ($quoted, qq{'$utf8_str'}, $t);

    $t='Quoted string should be UTF-8';
    ok (Encode::is_utf8( $quoted ), $t);

    $t='quote() handles utf8 inside array';
    $quoted = $dbh->quote([$utf8_str, $utf8_str]);
    is ($quoted, qq!'{"$utf8_str","$utf8_str"}'!, $t);

    $t='Quoted array of strings should be UTF-8';
    ok (Encode::is_utf8( $quoted ), $t);

    $t='Inserting utf-8 into an array via quoted do() works';
    $dbh->do('DELETE FROM dbd_pg_test');
    $SQL = qq{INSERT INTO dbd_pg_test (id, testarray, val) VALUES (1, $quoted, 'one')};
    eval {
        $dbh->do($SQL);
    };
    is ($@, q{}, $t);

    $t='Retreiving an array containing utf-8 works';
    $SQL = q{SELECT id, testarray, val FROM dbd_pg_test WHERE id = 1};
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    $result = $sth->fetchall_arrayref()->[0];
    my $expected = [1,[$utf8_str,$utf8_str],'one'];
    is_deeply ($result, $expected, $t);

    $t='Selected string should be UTF-8';
    ok (Encode::is_utf8( $result->[1][0] ), $t);

    $t='Selected string should be UTF-8';
    ok (Encode::is_utf8( $result->[1][1] ), $t);

    $t='Inserting utf-8 into an array via prepare and arrayref works';
    $dbh->do('DELETE FROM dbd_pg_test');
    $SQL = q{INSERT INTO dbd_pg_test (id, testarray, val) VALUES (?, ?, 'one')};
    $sth = $dbh->prepare($SQL);
    eval {
        $sth->execute(1,['Bob',$utf8_str]);
    };
    is ($@, q{}, $t);

    local $dbh->{pg_enable_utf8} = 1;

    $t='Retreiving an array containing utf-8 works';
    $SQL = q{SELECT id, testarray, val FROM dbd_pg_test WHERE id = 1};
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    $result = $sth->fetchall_arrayref()->[0];
    $expected = [1,['Bob',$utf8_str],'one'];