#!/usr/bin/perl use strict; BEGIN { $| = 1; $^W = 1; } use t::lib::Test; use Test::More tests => 27; use Test::NoWarnings; my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 0, ); ok($dbh->do("CREATE TABLE Blah ( id INTEGER, val VARCHAR )")); ok($dbh->commit); my $blob = ""; my $b = ""; for my $j (0..255) { $b .= chr($j); } for my $i (0..127) { $blob .= $b; } ok($blob); dumpblob($blob); my $sth = $dbh->prepare("INSERT INTO Blah VALUES (?, ?)"); ok($sth); for (1..5) { ok($sth->execute($_, $blob)); } $sth->finish; undef $sth; my $sel = $dbh->prepare("SELECT * FROM Blah WHERE id = ?"); ok($sel); for (1..5) { $sel->execute($_); my $row = $sel->fetch; ok($row->[0] == $_); dumpblob($row->[1]); ok($row->[1] eq $blob); ok(!$sel->fetch); } $dbh->rollback; sub dumpblob { my $blob = shift; 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) } }