#!perl
# vim: ft=perl
#
# $Id: 40blobs.t 1103 2008-04-29 02:53:28Z capttofu $
#
# This is a test for correct handling of BLOBS; namely $dbh->quote
# is expected to work correctly.
#
#
# Thank you to Brad Choate for finding the bug that resulted in this test,
# which he kindly sent code that this test uses!
#
use strict;
use DBI;
use Test::More;
my $update_blob;
use vars qw($table $test_dsn $test_user $test_password);
use lib 't', '.';
require 'lib.pl';
my ($dbh, $row);
eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
{ RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
if ($@) {
plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
plan tests => 25;
my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
my $blob1= join '', map { $chars[rand @chars] } 0 .. 10000;
my $blob2 = '"' x 10000;
sub ShowBlob($) {
my ($blob) = @_;
my $b;
for(my $i = 0; $i < 8; $i++) {
if (defined($blob) && length($blob) > $i) {
$b = substr($blob, $i*32);
}
else {
$b = "";
}
printf("%08lx %s\n", $i*32, unpack("H64", $b));
}
}
my $create = <<EOT;
CREATE TABLE $table (
id int(4),
name text)
EOT
ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
ok $dbh->do($create), "create table $table";
my $query = "INSERT INTO $table VALUES(?, ?)";
my $sth;
ok ($sth= $dbh->prepare($query));
ok defined($sth);
ok $sth->execute(1, $blob1), "inserting \$blob1";
ok $sth->finish;
ok ($sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1"));
ok $sth->execute, "select from $table";
ok ($row = $sth->fetchrow_arrayref);
is @$row, 2, "two rows fetched";
is $$row[0], 1, "first row id == 1";
cmp_ok $$row[1], 'eq', $blob1, ShowBlob($blob1);
ok $sth->finish;
ok ($sth= $dbh->prepare("UPDATE $table SET name = ? WHERE id = 1"));
ok $sth->execute($blob2), 'inserting $blob2';
ok ($sth->finish);
ok ($sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1"));
ok ($sth->execute);
ok ($row = $sth->fetchrow_arrayref);
is scalar @$row, 2, 'two rows';
is $$row[0], 1, 'row id == 1';
cmp_ok $$row[1], 'eq', $blob2, ShowBlob($blob2);
ok ($sth->finish);
ok $dbh->do("DROP TABLE $table"), "drop $table";
ok $dbh->disconnect;