---- Steffen Goeldner <[EMAIL PROTECTED]> wrote:
> I further investigated your
> test case: the Jet ADO provider creates for the LONGBINARY column a parameter
> of
> type 202 (adVarWChar) and size 510 - both are wrong. Thus, it's necessary to
> set
> the type in bind_param() - which you did. However, DBD::ADO did not set the
> size.
> Attached is a fixed implementation for bind_param(). It would be nice if you
> (and
> others) give it a trial.
Steffen,
I've tested your fix with my test script (included below), and it seems to
work well. I still need to test with the production code, but my confidence
level is high. :-)
> Steffen
Thanks again for all your great work with DBD::ADO,
amonotod
#!perl -w
use strict;
eval { use DBI; };
if ($@) { die "This system does not have the DBI installed!\n"; }
eval { use DBD::ADO; };
if ($@) { die "Database type ADO not supported!\n"; }
eval { use CGI; };
if ($@) { die "CGI module not supported!\n"; }
eval { use CGI::Carp; };
if ($@) { die "CGI::Carp module not supported!\n"; }
my ($dbh, $Access, $AccessDB, $Workspace);
my $db_name = "C:/development/web/PicsDB/myPics.mdb"; # Will be created by
doDBLoad()...
my $connStr = "dbi:ADO:Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine
Type=5;Data Source=$db_name";
my $tempDir = "C:/Temp/dbd_temp/"; # Must pre-exist...
my $status = 1;
my $q = new CGI;
my $load = $q->param('load');
my $showPic = $q->param('showPic');
my $show_picID = $q->param('picID');
if ($load) {
print "Doing database load...\n";
eval { use Text::CSV_XS; };
if ($@) { die "Text::CSV_XS not supported...\n"; }
doDBLoad();
exportDB();
print "All done!\n";
if ($status) { print "\n\tOperation was a success! :-)\n\n"; }
else { print "\n\tOperation was a failure! :-(\n\n"; }
} else {
connectDB();
if (($showPic) && ($show_picID)) {
showPic();
} else {
showPicLinks();
}
}
$dbh->disconnect();
exit;
sub showPic {
my $sqlStatement = "select picType, picData from myPics where picID = ?";
my $sthSelect = $dbh->prepare($sqlStatement);
eval {$sthSelect->execute($show_picID); };
if ($@) { carp("Select statement '$sqlStatement' failed!\nErrors:
$dbh->errstr \n"); exit; }
my ($picType, $picData) = $sthSelect->fetchrow_array;
$sthSelect->finish;
print $q->header($picType);
print $picData;
}
sub showPicLinks {
print $q->header('text/html');
print $q->start_html("myPics DB Display");
my $sqlStatement = "select picID, picComment from myPics";
my $sthSelect = $dbh->prepare($sqlStatement);
eval {$sthSelect->execute; };
if ($@) { carp("Select statement '$sqlStatement' failed!\nErrors:
$dbh->errstr \n"); exit; }
while (my ($picID, $picComment) = $sthSelect->fetchrow_array ) {
print "<a
href='myPics.pl?showPic=1&picID=$picID'><b>$picComment:</b></a><br><img
src=myPics.pl?showPic=1&picID=$picID><br>\n";
}
$sthSelect->finish;
}
sub connectDB {
eval { $dbh = DBI->connect( $connStr, "Admin", "", {RaiseError => 0,
PrintError => 0, AutoCommit => 1} ); };
if ($@) { die("Database connection [EMAIL PROTECTED]"); }
$dbh->{LongReadLen} = 2000000;
$dbh->{LongTruncOk} = 0;
}
sub doDBLoad {
my $csv = Text::CSV_XS->new;
print "Creating database...";
CreateAccessDB();
print " Done!\n";
connectDB();
my $create_statement = "create table [myPics] ([picID] INT NOT NULL,
[picComment] VARCHAR (50), [picType] VARCHAR (50), [picData] IMAGE , ".
"PRIMARY KEY ([picID] ), CONSTRAINT myPic_PK UNIQUE
([picID] ))";
my $sth = $dbh->prepare($create_statement);
eval {$sth->execute; };
if ($@) { die "Create statement failed!\nErrors: $dbh->errstr \n"; }
my $sqlStatement = "INSERT INTO myPics (picID, picComment, picType, picData)
VALUES (?, ?, ?, ?)";
$sth = $dbh->prepare($sqlStatement);
my $picList = PicList();
foreach (split("\n", $picList)) {
if ($csv->parse($_)) {
my ($picID, $picComment, $picType, $picImage) = $csv->fields;
if (-e $picImage) {
print "Loading $picImage into database...";
my $picData = readblobfile($picImage);
$sth->bind_param(1, $picID);
$sth->bind_param(2, $picComment);
$sth->bind_param(3, $picType);
$sth->bind_param(4, $picData, DBI::SQL_LONGVARBINARY );
eval { $sth->execute; };
if ($@) {
print "Graphic import failed for image $picImage\n";
$dbh->disconnect;
exit(255);
}
print " Done!\n";
} else { print "Could not find image $picImage; not loaded!\n"; }
} else { print "CSV parsing failed!\n"; }
}
}
sub exportDB {
print "Exporting grapics to $tempDir\n";
unless (-d $tempDir) { print "Temp dir $tempDir does not exist!\n"; exit(1); }
my $csv = Text::CSV_XS->new;
my $picList = PicList();
my $sqlStatement = "select picData from myPics where picID = ?";
my $sthSelect = $dbh->prepare($sqlStatement);
foreach (split("\n", $picList)) {
if ($csv->parse($_)) {
my ($picID, $picComment, $picType, $picImage) = $csv->fields;
my $picName = $tempDir .
substr($picImage,rindex($picImage,"\\")+1,length($picImage));
print "picName is $picName\n";
eval {$sthSelect->execute($picID); };
if ($@) { carp("Select statement '$sqlStatement' failed!\nErrors:
$dbh->errstr \n"); exit; }
my ($picData) = $sthSelect->fetchrow;
open(IMAGE, "> $picName") || die("Could not open new image file for
write\n");
binmode(IMAGE);
print IMAGE $picData;
close(IMAGE);
$sthSelect->finish;
my $origSize = (-s $picImage);
my $newSize = (-s $picName);
unless ($origSize == $newSize) {
print "\tError: Imported and exported files DO NOT match in
size....!\n";
$status = 0;
} else {
print "\tSuccess: Imported and exported files match in size....!\n";
}
}
}
}
sub readblobfile($) {
my $file = shift; #get file name
local( $/, *FILE); #see perldoc perlvar for an explanation here
open(FILE, "$file") or die "$!";
binmode(FILE);
my $content = <FILE>;
close(FILE);
return $content;
}
sub CreateAccessDB {
if ( -e "$db_name") { # if the file already exists, delete it
unlink("$db_name") || die("Could not delete the old database file
$db_name\n");
}
eval {
use Win32::OLE;
};
if ($@) { die "Win32::OLE not supported...\n"; }
eval { use Win32::OLE::Const 'Microsoft ActiveX Data Objects'; };
if ($@) { die "ADO maybe not supported...?\n"; }
eval {
$AccessDB = Win32::OLE->new("ADOX.Catalog");
$AccessDB->Create("Provider='Microsoft.Jet.OLEDB.4.0';Jet OLEDB:Engine
Type=5;Data Source='$db_name'");
};
if ($@) { die "Couldn't create the database $db_name...!\n"; }
Win32::OLE->Uninitialize;
}
sub PicList {
my $picList = <<'EOF';
1,The Charter Communications
Logo,image/gif,C:\development\web\PicsDB\Charter_Logo.gif
2,The Google Logo,image/gif,C:\development\web\PicsDB\Google_Logo.gif
3,The Yahoo Logo,image/gif,C:\development\web\PicsDB\Yahoo_Logo.gif
4,The AOL Logo,image/gif,C:\development\web\PicsDB\AOL_Logo.gif
EOF
return($picList);
}
--
`\|||/ amonotod@ | sun|perl|windows
(@@) charter.net | sysadmin|dba
ooO_(_)_Ooo____________________________________
_____|_____|_____|_____|_____|_____|_____|_____|
