#!/usr/bin/perl # This is a test for correct handling of BLOBS; namely $dbh->quote # is expected to work correctly. use strict; BEGIN { $| = 1; $^W = 1; } use t::lib::Test; use Test::More tests => 10; use Test::NoWarnings; use DBI ':sql_types'; sub ShowBlob($) { my ($blob) = @_; print("showblob length: ", length($blob), "\n"); if ($ENV{SHOW_BLOBS}) { open(OUT, ">>$ENV{SHOW_BLOBS}") } my $i = 0; while (1) { if (defined($blob) && length($blob) > ($i*32)) { $b = substr($blob, $i*32); } else { $b = ""; last; } if ($ENV{SHOW_BLOBS}) { printf OUT "%08lx %s\n", $i*32, unpack("H64", $b) } else { printf("%08lx %s\n", $i*32, unpack("H64", $b)) } $i++; last if $i == 8; } if ($ENV{SHOW_BLOBS}) { close(OUT) } } # Create a database my $dbh = connect_ok(); $dbh->{sqlite_handle_binary_nulls} = 1; # Create the table ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' ); CREATE TABLE one ( id INTEGER NOT NULL, name BLOB (128) NOT NULL ) END_SQL # Create a blob my $blob = ''; my $b = ''; for ( my $j = 0; $j < 256; $j++ ) { $b .= chr($j); } for ( my $i = 0; $i < 128; $i++ ) { $blob .= $b; } # Insert a row into the test table SCOPE: { my $sth = $dbh->prepare("INSERT INTO one VALUES ( 1, ? )"); isa_ok( $sth, 'DBI::st' ); ok( $sth->bind_param(1, $blob, SQL_BLOB), '->bind_param' ); ok( $sth->execute, '->execute' ); } # Now, try SELECT'ing the row out. SCOPE: { my $sth = $dbh->prepare("SELECT * FROM one WHERE id = 1"); isa_ok( $sth, 'DBI::st' ); ok( $sth->execute, '->execute' ); ok( $sth->fetchrow_arrayref->[1] eq $blob, 'Got the blob back ok', ); ok( $sth->finish, '->finish' ); }