#!/usr/bin/perl -w -I./t
# $Id$
#
# rt 78838
#
# DBD::ODBC was stringifying input bound parameters.
# This script creates an object with an overriden stringifcation method
# and tests it is stringified when bound.
#
use strict;
use warnings;
use Test::More;
use DBI;
use_ok('ODBCTEST');
eval "require Test::NoWarnings";
my $has_test_nowarnings = ($@ ? undef : 1);
BEGIN {
if (!defined $ENV{DBI_DSN}) {
plan skip_all => "DBI_DSN is undefined";
}
}
END {
Test::NoWarnings::had_no_warnings()
if ($has_test_nowarnings);
done_testing();
}
my $dbh = DBI->connect();
unless($dbh) {
BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
exit 0;
}
$dbh->{RaiseError} = 0;
my $dbms_name = $dbh->get_info(17);
ok($dbms_name, "got DBMS name: $dbms_name"); # 2
# this needs to be MS SQL Server
if ($dbms_name !~ /Microsoft SQL Server/) {
note('Not Microsoft SQL Server');
exit 0;
}
my $obj = new Object();
my $sth = $dbh->prepare(q/select ? AS result/);
ok($sth, "statement prepared");
$sth->bind_param(1, $obj);
SKIP: {
skip "Failed to prepare statement", 4 if !$sth;
$sth->execute();
my $fetched = $sth->fetchrow_arrayref->[0];
is($fetched, 'Object', "bound parameter correctly stringified"); # 1
bless $obj, 'Subject';
$sth->execute();
$fetched = $sth->fetchrow_arrayref->[0];
is($fetched, 'Object', "bound parameter copied and not a reference"); # 2
$sth->bind_param(1, 'fred');
$sth->execute();
$fetched = $sth->fetchrow_arrayref->[0];
is($fetched, 'fred', "rebound parameter correctly retrieved"); # 3
eval {
$sth->bind_param(1, $obj);
};
ok($@, "cannot bind a plain reference"); # 4
$sth = undef;
}
$dbh->disconnect;
package Object;
use overload '""' => 'to_s';
sub new() { bless { }, shift };
sub to_s() { my $self = shift; ref($self); }