DBD-mysql-4.054/0000755000175000017500000000000015043620456013733 5ustar dvaneedendvaneedenDBD-mysql-4.054/t/0000755000175000017500000000000015043620456014176 5ustar dvaneedendvaneedenDBD-mysql-4.054/t/51bind_type_guessing.t0000644000175000017500000000453215043617710020415 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use DBI::Const::GetInfoType; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 26; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t51bind_type_guessing"), "drop table if exists dbd_mysql_t51bind_type_guessing"; my $create= <<"EOTABLE"; create table dbd_mysql_t51bind_type_guessing ( id bigint unsigned not null default 0 ) EOTABLE ok $dbh->do($create), "creating table"; my $statement= "insert into dbd_mysql_t51bind_type_guessing (id) values (?)"; my $sth1; ok $sth1= $dbh->prepare($statement); my $rows; ok $rows= $sth1->execute('9999999999999999'); cmp_ok $rows, '==', 1; $statement= "update dbd_mysql_t51bind_type_guessing set id = ?"; my $sth2; ok $sth2= $dbh->prepare($statement); ok $rows= $sth2->execute('9999999999999998'); cmp_ok $rows, '==', 1; $dbh->{mysql_bind_type_guessing}= 1; ok $rows= $sth1->execute('9999999999999997'); cmp_ok $rows, '==', 1; $statement= "update dbd_mysql_t51bind_type_guessing set id = ? where id = ?"; ok $sth2= $dbh->prepare($statement); ok $rows= $sth2->execute('9999999999999996', '9999999999999997'); my $retref; ok $retref= $dbh->selectall_arrayref("select * from dbd_mysql_t51bind_type_guessing"); cmp_ok $retref->[0][0], '==', 9999999999999998; cmp_ok $retref->[1][0], '==', 9999999999999996; # checking varchars/empty strings/misidentification: $create= <<"EOTABLE"; create table dbd_mysql_t51bind_type_guessing ( str varchar(80), num bigint ) EOTABLE ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t51bind_type_guessing"), "drop table if exists dbd_mysql_t51bind_type_guessing"; ok $dbh->do($create), "creating table w/ varchar"; my $sth3; ok $sth3= $dbh->prepare("insert into dbd_mysql_t51bind_type_guessing (str, num) values (?, ?)"); ok $rows= $sth3->execute(52.3, 44); ok $rows= $sth3->execute('', ' 77'); ok $rows= $sth3->execute(undef, undef); ok $sth3= $dbh->prepare("select * from dbd_mysql_t51bind_type_guessing limit ?"); ok $rows= $sth3->execute(1); ok $rows= $sth3->execute(' 1'); $sth3->finish(); ok $dbh->do("DROP TABLE dbd_mysql_t51bind_type_guessing"); ok $dbh->disconnect; DBD-mysql-4.054/t/92ssl_optional.t0000644000175000017500000000245615043617710017252 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require "lib.pl"; my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); my $have_ssl = eval { $dbh->selectrow_hashref("SHOW VARIABLES WHERE Variable_name = 'have_ssl'") }; $dbh->disconnect(); plan skip_all => 'Server supports SSL connections, cannot test fallback to plain text' if $have_ssl and $have_ssl->{Value} eq 'YES'; plan tests => 2; $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 0, mysql_ssl => 1, mysql_ssl_optional => 1 }); ok(defined $dbh, 'DBD::mysql supports mysql_ssl_optional=1 and connect via plain text protocol when SSL is not supported by server') or diag('Error code: ' . ($DBI::err || 'none') . "\n" . 'Error message: ' . ($DBI::errstr || 'unknown')); $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 0, mysql_ssl => 1, mysql_ssl_optional => 1, mysql_ssl_ca_file => "" }); ok(defined $dbh, 'DBD::mysql supports mysql_ssl_optional=1 and connect via plain text protocol when SSL is not supported by server even with mysql_ssl_ca_file') or diag('Error code: ' . ($DBI::err || 'none') . "\n" . 'Error message: ' . ($DBI::errstr || 'unknown')); DBD-mysql-4.054/t/rt61849-bind-param-buffer-overflow.t0000644000175000017500000000130714471320024022535 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); require "t/lib.pl"; my $INSECURE_VALUE_FROM_USER = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1, AutoCommit => 0 }) }; plan skip_all => "no database connection" if $@ or not $dbh; plan tests => 2; my $sth = $dbh->prepare("select * from unknown_table where id=?"); eval { $sth->bind_param(1, $INSECURE_VALUE_FROM_USER, 3) }; like $@, qr/Binding non-numeric field 1, value '$INSECURE_VALUE_FROM_USER' as a numeric!/, "bind_param failed on incorrect numeric value"; pass "perl interpreter did not crash"; DBD-mysql-4.054/t/65segfault.t0000644000175000017500000000217614471320024016346 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { mysql_auto_reconnect => 1, RaiseError => 1, PrintError => 1, AutoCommit => 1 }); }; if ($@) { plan skip_all => "no database connection"; } my $dbh2; eval {$dbh2= DBI->connect($test_dsn, $test_user, $test_password);}; if ($@) { plan skip_all => "no database connection"; } plan tests => 5; ok(defined $dbh, "Handle 1 Connected to database"); ok(defined $dbh2, "Handle 2 Connected to database"); #kill first db connection to trigger an auto reconnect ok ($dbh2->do('kill ' . $dbh->{'mysql_thread_id'})); #insert a temporary delay, try uncommenting this if it's not seg-faulting at first, # one of my initial tests without this delay didn't seg fault sleep 1; #ping first dbh handle to trigger auto-reconnect $dbh->ping; ok ($dbh); ok ($dbh2); DBD-mysql-4.054/t/rt118977-zerofill.t0000644000175000017500000000117715043617710017342 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); require "t/lib.pl"; my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 1 }) }; plan skip_all => "no database connection" if $@ or not $dbh; plan tests => 4*2; for my $mysql_server_prepare (0, 1) { $dbh->{mysql_server_prepare} = $mysql_server_prepare; ok $dbh->do("DROP TABLE IF EXISTS t"); ok $dbh->do("CREATE TEMPORARY TABLE t(id smallint(5) unsigned zerofill)"); ok $dbh->do("INSERT INTO t(id) VALUES(1)"); is $dbh->selectcol_arrayref("SELECT id FROM t")->[0], "00001"; } DBD-mysql-4.054/t/55utf8mb4.t0000644000175000017500000000205514471320024016020 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } eval { $dbh->{PrintError} = 0; $dbh->do("SET NAMES 'utf8mb4'"); $dbh->{PrintError} = 1; 1; } or do { $dbh->disconnect(); plan skip_all => "no support for utf8mb4"; }; ok $dbh->do("CREATE TEMPORARY TABLE dbd_mysql_t55utf8mb4 (id SERIAL, val TEXT CHARACTER SET utf8mb4)"); my $sth = $dbh->prepare("INSERT INTO dbd_mysql_t55utf8mb4(val) VALUES('😈')"); $sth->execute(); my $query = "SELECT val, HEX(val) FROM dbd_mysql_t55utf8mb4 LIMIT 1"; $sth = $dbh->prepare($query) or die "$DBI::errstr"; ok $sth->execute; ok(my $ref = $sth->fetchrow_arrayref, 'fetch row'); ok($sth->finish, 'close sth'); cmp_ok $ref->[0], 'eq', "😈"; cmp_ok $ref->[1], 'eq', "F09F9888"; $dbh->disconnect(); done_testing; DBD-mysql-4.054/t/rt25389-bin-case.t0000644000175000017500000000270414471320024017075 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use vars qw($test_dsn $test_user $test_password); require "t/lib.pl"; use Test::More; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0, AutoCommit => 1 });}; if ($@) { plan skip_all => "no database connection"; } if (!MinimumVersion($dbh, '5.1')) { plan skip_all => "You must have MySQL version 5.1 or greater for this test" } plan tests => 8; my ( $sth, $i ); my @test = qw(AA Aa aa aA); for my $charset (qw(latin1 utf8)) { for my $unique ( "", "unique" ) { my $table = "dbd-mysql-$charset-$unique"; my $create = "CREATE TEMPORARY TABLE `$table` (name VARCHAR(8) CHARACTER SET $charset COLLATE ${charset}_bin $unique)"; $dbh->do($create) or die $DBI::errstr; for (@test) { $dbh->do("insert into `$table` values ('$_')"); } my $q1 = "select name from `$table`"; $sth = $dbh->prepare($q1); $sth->execute; $i = 0; while ( my @row = $sth->fetchrow ) { $i++; } is( $i, scalar @test, $q1 ); $sth->finish; my $q2 = "select name from `$table` where " . join( " OR ", map { "name = '$_'" } @test ); $sth = $dbh->prepare($q2); $sth->execute; $i = 0; while ( my @row = $sth->fetchrow ) { $i++; } is( $i, scalar @test, $q2 ); } } DBD-mysql-4.054/t/32insert_error.t0000644000175000017500000000160514471320024017237 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib '.', 't'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } plan tests => 9; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t32"); my $create = <do($create); my $query = "INSERT INTO dbd_mysql_t32 (id, name) VALUES (?,?)"; ok (my $sth = $dbh->prepare($query)); ok $sth->execute(1, "Jocken"); $sth->{PrintError} = 0; eval {$sth->execute(1, "Jochen")}; ok defined($@), 'fails with duplicate entry'; $sth->{PrintError} = 1; ok $sth->execute(2, "Jochen"); ok $sth->finish; ok $dbh->do("DROP TABLE dbd_mysql_t32"); ok $dbh->disconnect(); DBD-mysql-4.054/t/92ssl_backronym_vulnerability.t0000644000175000017500000000244415043617710022360 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require "lib.pl"; my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); my $have_ssl = eval { $dbh->selectrow_hashref("SHOW VARIABLES WHERE Variable_name = 'have_ssl'") }; $dbh->disconnect(); plan skip_all => 'Server supports SSL connections, cannot test false-positive enforcement' if $have_ssl and $have_ssl->{Value} eq 'YES'; plan tests => 4; $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 0, mysql_ssl => 1 }); ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1 and correct user and password'); is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 0, mysql_ssl => 1, mysql_ssl_verify_server_cert => 1, mysql_ssl_ca_file => "" }); ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1, mysql_ssl_verify_server_cert=1 and correct user and password'); is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); DBD-mysql-4.054/t/35prepare.t0000644000175000017500000000647714471320024016177 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; my ($row, $sth, $dbh); my ($def, $rows, $errstr, $ret_ref); use vars qw($test_dsn $test_user $test_password); eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1});}; if ($@) { plan skip_all => "no database connection"; } plan tests => 49; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t35prepare"), "Making slate clean"); ok($dbh->do("CREATE TABLE dbd_mysql_t35prepare (id INT(4), name VARCHAR(64))"), "Creating table"); ok($sth = $dbh->prepare("SHOW TABLES LIKE 'dbd_mysql_t35prepare'"), "Testing prepare show tables"); ok($sth->execute(), "Executing 'show tables'"); ok((defined($row= $sth->fetchrow_arrayref) && (!defined($errstr = $sth->errstr) || $sth->errstr eq '')), "Testing if result set and no errors"); ok($row->[0] eq 'dbd_mysql_t35prepare', "Checking if results equal to 'dbd_mysql_t35prepare' \n"); ok($sth->finish, "Finishing up with statement handle"); ok($dbh->do("INSERT INTO dbd_mysql_t35prepare VALUES (1,'1st first value')"), "Inserting first row"); ok($sth= $dbh->prepare("INSERT INTO dbd_mysql_t35prepare VALUES (2,'2nd second value')"), "Preparing insert of second row"); ok(($rows = $sth->execute()), "Inserting second row"); ok($rows == 1, "One row should have been inserted"); ok($sth->finish, "Finishing up with statement handle"); ok($sth= $dbh->prepare("SELECT id, name FROM dbd_mysql_t35prepare WHERE id = 1"), "Testing prepare of query"); ok($sth->execute(), "Testing execute of query"); ok($ret_ref = $sth->fetchall_arrayref(), "Testing fetchall_arrayref of executed query"); ok($sth= $dbh->prepare("INSERT INTO dbd_mysql_t35prepare values (?, ?)"), "Preparing insert, this time using placeholders"); my $testInsertVals = {}; for (my $i = 0 ; $i < 10; $i++) { my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; my $random_chars= join '', map { $chars[rand @chars] } 0 .. 16; # save these values for later testing $testInsertVals->{$i}= $random_chars; ok($rows= $sth->execute($i, $random_chars), "Testing insert row"); ok($rows= 1, "Should have inserted one row"); } ok($sth->finish, "Testing closing of statement handle"); ok($sth= $dbh->prepare("SELECT * FROM dbd_mysql_t35prepare WHERE id = ? OR id = ?"), "Testing prepare of query with placeholders"); ok($rows = $sth->execute(1,2), "Testing execution with values id = 1 or id = 2"); ok($ret_ref = $sth->fetchall_arrayref(), "Testing fetchall_arrayref (should be four rows)"); note "RETREF " . scalar @$ret_ref . "\n"; ok(@{$ret_ref} == 4 , "\$ret_ref should contain four rows in result set"); ok($sth= $dbh->prepare("DROP TABLE IF EXISTS dbd_mysql_t35prepare"), "Testing prepare of dropping table"); ok($sth->execute(), "Executing drop table"); # Bug #20153: Fetching all data from a statement handle does not mark it # as finished ok($sth= $dbh->prepare("SELECT 1"), "Prepare - Testing bug #20153"); ok($sth->execute(), "Execute - Testing bug #20153"); ok($sth->fetchrow_arrayref(), "Fetch - Testing bug #20153"); ok(!($sth->fetchrow_arrayref()),"Not Fetch - Testing bug #20153"); # Install a handler so that a warning about unfreed resources gets caught $SIG{__WARN__} = sub { die @_ }; ok($dbh->disconnect(), "Testing disconnect"); DBD-mysql-4.054/t/00base.t0000644000175000017500000000117214471320024015426 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More tests => 6; # # Include lib.pl # use lib 't', '.'; require 'lib.pl'; # Base DBD Driver Test BEGIN { use_ok('DBI') or BAIL_OUT "Unable to load DBI"; use_ok('DBD::mysql') or BAIL_OUT "Unable to load DBD::mysql"; } my $switch = DBI->internal; cmp_ok ref $switch, 'eq', 'DBI::dr', 'Internal set'; # This is a special case. install_driver should not normally be used. my $drh= DBI->install_driver('mysql'); ok $drh, 'Install driver'; cmp_ok ref $drh, 'eq', 'DBI::dr', 'DBI::dr set'; ok $drh->{Version}, "Version $drh->{Version}"; diag "Driver version is ", $drh->{Version}, "\n"; DBD-mysql-4.054/t/57trackgtid.t0000644000175000017500000000166014525366521016522 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require "lib.pl"; my $dbh; eval{$dbh = DBI->connect($test_dsn, $test_user, $test_password, {RaiseError => 1});}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} > 100000) { plan skip_all => "GTID tracking is not available on MariaDB"; } if ($dbh->{mysql_serverversion} < 50000) { plan skip_all => "You must have MySQL version 5.0.0 and greater for this test to run"; } my @gtidtrackenabled = $dbh->selectrow_array('select @@global.session_track_gtids'); if (!@gtidtrackenabled) { plan skip_all => 'GTID tracking not available'; } elsif ($gtidtrackenabled[0] eq 'OFF') { plan skip_all => 'GTID tracking not enabled'; } else { plan tests => 2; } $dbh->do('FLUSH PRIVILEGES'); cmp_ok(length($dbh->{'mysql_gtids'}),'>=',38); ok $dbh->disconnect(); DBD-mysql-4.054/t/40bindparam2.t0000644000175000017500000000250114471320024016534 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1}) or ServerError();}; if ($@) { plan skip_all => "no database connection"; } plan tests => 13; SKIP: { skip 'SET @@auto_increment_offset needs MySQL >= 5.0.2', 2 unless $dbh->{mysql_serverversion} >= 50002; ok $dbh->do('SET @@auto_increment_offset = 1'); ok $dbh->do('SET @@auto_increment_increment = 1'); } my $create= <do($create), "create table dbd_mysql_t40bindparam2"; ok $dbh->do("INSERT INTO dbd_mysql_t40bindparam2 VALUES(NULL, 1)"), "insert into dbd_mysql_t40bindparam2 (null, 1)"; my $rows; ok ($rows= $dbh->selectall_arrayref("SELECT * FROM dbd_mysql_t40bindparam2")); is $rows->[0][1], 1, "\$rows->[0][1] == 1"; ok (my $sth = $dbh->prepare("UPDATE dbd_mysql_t40bindparam2 SET num = ? WHERE id = ?")); ok ($sth->bind_param(2, 1, SQL_INTEGER())); ok ($sth->execute()); ok ($sth->finish()); ok ($rows = $dbh->selectall_arrayref("SELECT * FROM dbd_mysql_t40bindparam2")); ok !defined($rows->[0][1]); ok ($dbh->disconnect()); DBD-mysql-4.054/t/40server_prepare_crash.t0000644000175000017500000000431614471320024020727 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); require "t/lib.pl"; my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 1, AutoCommit => 0, mysql_server_prepare => 1, mysql_server_prepare_disable_fallback => 1 }) }; plan skip_all => "no database connection" if $@ or not $dbh; plan skip_all => "You must have MySQL version 4.1.3 and greater for this test to run" if $dbh->{mysql_clientversion} < 40103 or $dbh->{mysql_serverversion} < 40103; plan tests => 39; my $sth; ok $dbh->do("CREATE TEMPORARY TABLE t (i INTEGER NOT NULL, n LONGBLOB)"); ok $sth = $dbh->prepare("INSERT INTO t(i, n) VALUES(?, ?)"); ok $sth->execute(1, "x" x 10); ok $sth->execute(2, "x" x 100); ok $sth->execute(3, "x" x 1000); ok $sth->execute(4, "x" x 10000); ok $sth->execute(5, "x" x 100000); ok $sth->execute(6, "x" x 1000000); ok $sth->finish(); ok $sth = $dbh->prepare("SELECT * FROM t WHERE i=? AND n=?"); ok $sth->bind_param(2, "x" x 1000000); ok $sth->bind_param(1, "abcx", 12); ok $sth->execute(); ok $sth->bind_param(2, "a" x 1000000); ok $sth->bind_param(1, 1, 3); ok $sth->execute(); ok $sth->finish(); ok $sth = $dbh->prepare("SELECT * FROM t WHERE i=? AND n=?"); ok $sth->execute(); ok $sth->finish(); ok $sth = $dbh->prepare("SELECT 1 FROM t WHERE i = ?" . (" OR i = ?" x 10000)); ok $sth->execute((1) x (10001)); ok $sth->finish(); my $test; ok $sth = $dbh->prepare("SELECT i,n FROM t WHERE i = ?"); ok $sth->execute(1); ok $sth->fetchrow_arrayref(); ok $sth->execute(2); $test = map { $_ } 'a'; ok $sth->fetchrow_arrayref(); ok $sth->execute(3); $test = map { $_ } 'b' x 10000000; # try to reuse released memory ok $sth->fetchrow_arrayref(); ok $sth->execute(4); $test = map { $_ } 'cd' x 10000000; # try to reuse of released memory ok $sth->fetchrow_arrayref(); ok $sth->execute(5); $test = map { $_ } 'efg' x 10000000; # try to reuse of released memory ok $sth->fetchrow_arrayref(); ok $sth->execute(6); $test = map { $_ } 'hijk' x 10000000; # try to reuse of released memory ok $sth->fetchrow_arrayref(); ok $sth->finish(); ok $dbh->do("SELECT 1 FROM t WHERE i = ?" . (" OR i = ?" x 10000), {}, (1) x (10001)); ok $dbh->disconnect(); DBD-mysql-4.054/t/60leaks.t0000644000175000017500000001730114471320024015622 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $COUNT_CONNECT = 4000; # Number of connect/disconnect iterations my $COUNT_PREPARE = 30000; # Number of prepare/execute/finish iterations my $COUNT_BIND = 10000; # Number of bind_param iterations my $have_storable; if (!$ENV{EXTENDED_TESTING}) { plan skip_all => "Skip \$ENV{EXTENDED_TESTING} is not set\n"; } eval { require Proc::ProcessTable; }; if ($@) { plan skip_all => "module Proc::ProcessTable not installed \n"; } eval { require Storable }; $have_storable = $@ ? 0 : 1; my $have_pt_size = grep { $_ eq 'size' } Proc::ProcessTable->new('cache_ttys' => $have_storable)->fields; unless ($have_pt_size) { plan skip_all => "module Proc::ProcessTable does not support size attribute on current platform\n"; } my ($dbh, $sth); eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } $dbh->disconnect; plan tests => 27 * 2; sub size { my($p, $pt); $pt = Proc::ProcessTable->new('cache_ttys' => $have_storable); for $p (@{$pt->table()}) { if ($p->pid() == $$) { return $p->size(); } } die "Cannot find my own process?!?\n"; exit 0; } for my $mysql_server_prepare (0, 1) { note "Testing memory leaks with mysql_server_prepare=$mysql_server_prepare\n"; $dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, mysql_server_prepare => $mysql_server_prepare, mysql_server_prepare_disable_fallback => 1 }); ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t60leaks"); my $create= <do($create); my ($size, $prev_size, $ok, $not_ok, $dbh2, $msg); note "Testing memory leaks in connect/disconnect\n"; $msg = "Possible memory leak in connect/disconnect detected"; $ok = 0; $not_ok = 0; $prev_size= undef; for (my $i = 0; $i < $COUNT_CONNECT; $i++) { eval {$dbh2 = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, mysql_server_prepare => $mysql_server_prepare, });}; if ($@) { $not_ok++; last; } if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { $ok++; } else { $not_ok++; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } $dbh2->disconnect; ok $ok, "\$ok $ok"; ok !$not_ok, "\$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; note "Testing memory leaks in prepare/execute/finish\n"; $msg = "Possible memory leak in prepare/execute/finish detected"; $ok = 0; $not_ok = 0; undef $prev_size; for (my $i = 0; $i < $COUNT_PREPARE; $i++) { my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t60leaks"); $sth->execute(); $sth->finish(); if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { $ok++; } else { $not_ok++; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } ok $ok; ok !$not_ok, "\$ok $ok \$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; note "Testing memory leaks in execute/finish\n"; $msg = "Possible memory leak in execute/finish detected"; $ok = 0; $not_ok = 0; undef $prev_size; { my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t60leaks"); for (my $i = 0; $i < $COUNT_PREPARE; $i++) { $sth->execute(); $sth->finish(); if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { $ok++; } else { $not_ok++; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } } ok $ok; ok !$not_ok, "\$ok $ok \$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; note "Testing memory leaks in bind_param\n"; $msg = "Possible memory leak in bind_param detected"; $ok = 0; $not_ok = 0; undef $prev_size; { my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t60leaks WHERE id = ? AND name = ?"); for (my $i = 0; $i < $COUNT_BIND; $i++) { $sth->bind_param(1, 0); my $val = "x" x 1000000; $sth->bind_param(2, $val); if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { $ok++; } else { $not_ok++; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } } ok $ok; ok !$not_ok, "\$ok $ok \$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; note "Testing memory leaks in fetchrow_arrayref\n"; $msg= "Possible memory leak in fetchrow_arrayref detected"; $sth= $dbh->prepare("INSERT INTO dbd_mysql_t60leaks VALUES (?, ?)") ; my $dataref= [[1, 'Jochen Wiedmann'], [2, 'Andreas König'], [3, 'Tim Bunce'], [4, 'Alligator Descartes'], [5, 'Jonathan Leffler']]; for (@$dataref) { ok $sth->execute($_->[0], $_->[1]), "insert into dbd_mysql_t60leaks values ($_->[0], '$_->[1]')"; } $ok = 0; $not_ok = 0; undef $prev_size; for (my $i = 0; $i < $COUNT_PREPARE; $i++) { { my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t60leaks"); $sth->execute(); my $row; while ($row = $sth->fetchrow_arrayref()) { } $sth->finish(); } if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { ++$ok; } else { ++$not_ok; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } ok $ok; ok !$not_ok, "\$ok $ok \$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; note "Testing memory leaks in fetchrow_hashref\n"; $msg = "Possible memory leak in fetchrow_hashref detected"; $ok = 0; $not_ok = 0; undef $prev_size; for (my $i = 0; $i < $COUNT_PREPARE; $i++) { { my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t60leaks"); $sth->execute(); my $row; while ($row = $sth->fetchrow_hashref()) { } $sth->finish(); } if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { ++$ok; } else { ++$not_ok; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } ok $ok; ok !$not_ok, "\$ok $ok \$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; ok $dbh->do("DROP TABLE dbd_mysql_t60leaks"); ok $dbh->disconnect; } DBD-mysql-4.054/t/30insertfetch.t0000644000175000017500000000231014471320024017030 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } ok(defined $dbh, "Connected to database"); ok($dbh->do("CREATE TEMPORARY TABLE dbd_mysql_t30 (id INT(4), name VARCHAR(64))"), "creating table"); ok($dbh->do(" INSERT INTO dbd_mysql_t30 VALUES (1, 'Alligator Descartes'), (2, 'Tim Bunce') "), "loading data"); ok(my $info = $dbh->{mysql_info}, "mysql_info '" . $dbh->{mysql_info} . "'"); like($info, qr/^Records:\s\d/, 'mysql_info: Records'); like($info, qr/Duplicates:\s0\s/, 'mysql_info: Duplicates'); like($info, qr/Warnings: 0$/, 'mysql_info: Warnings'); ok( $dbh->do("DELETE FROM dbd_mysql_t30 WHERE id IN (1,2)"), "deleting from table dbd_mysql_t30" ); ok (my $sth= $dbh->prepare("SELECT * FROM dbd_mysql_t30 WHERE id = 1")); ok($sth->execute()); ok(not $sth->fetchrow_arrayref()); ok($sth->finish()); ok($dbh->disconnect()); done_testing; DBD-mysql-4.054/t/71impdata.t0000644000175000017500000000211614471320024016142 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use Test::More; $| = 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } my $drh = $dbh->{Driver}; if (! defined $drh) { plan skip_all => "Can't obtain driver handle. Can't continue test"; } plan tests => 10; pass("Connected to database"); pass("Obtained driver handle"); my $connection_id1 = connection_id($dbh); is $drh->{Kids}, 1, "1 kid"; is $drh->{ActiveKids}, 1, "1 active kid"; my $imp_data = $dbh->take_imp_data; is $drh->{Kids}, 0, "no kids"; is $drh->{ActiveKids}, 0, "no active kids"; $dbh = DBI->connect( $test_dsn, $test_user, $test_password, { dbi_imp_data => $imp_data } ); my $connection_id2 = connection_id($dbh); is $connection_id1, $connection_id2, "got same session"; is $drh->{Kids}, 1, "1 kid"; is $drh->{ActiveKids}, 1, "1 active kid"; ok $dbh->disconnect, "Disconnect OK"; DBD-mysql-4.054/t/29warnings.t0000644000175000017500000000335714471320024016366 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib '.', 't'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0});}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} < 40101) { plan skip_all => "Servers < 4.1.1 do not report warnings"; } my $expected_warnings = 2; if ($dbh->{mysql_serverversion} >= 50000 && $dbh->{mysql_serverversion} < 50500) { $expected_warnings = 1; } plan tests => 14; ok(defined $dbh, "Connected to database"); ok(my $sth= $dbh->prepare("DROP TABLE IF EXISTS no_such_table")); ok($sth->execute()); is($sth->{mysql_warning_count}, 1, 'warnings from sth'); ok($dbh->do("SET sql_mode=''")); ok($dbh->do("CREATE TEMPORARY TABLE dbd_drv_sth_warnings (c CHAR(1))")); ok($dbh->do("INSERT INTO dbd_drv_sth_warnings (c) VALUES ('perl'), ('dbd'), ('mysql')")); is($dbh->{mysql_warning_count}, 3, 'warnings from dbh'); # tests to make sure mysql_warning_count is the same as reported by mysql_info(); # see https://rt.cpan.org/Ticket/Display.html?id=29363 ok($dbh->do("CREATE TEMPORARY TABLE dbd_drv_count_warnings (i TINYINT NOT NULL)") ); my $q = "INSERT INTO dbd_drv_count_warnings VALUES (333),('as'),(3)"; ok($sth = $dbh->prepare($q)); ok($sth->execute()); is($sth->{'mysql_warning_count'}, 2 ); # $dbh->{info} actually uses mysql_info() my $str = $dbh->{info}; my $numwarn; if ( $str =~ /Warnings:\s(\d+)$/ ) { $numwarn = $1; } # this test passes on mysql 5.5.x and fails on 5.1.x # but I'm not sure which versions, so I'll just disable it for now is($numwarn, $expected_warnings); ok($dbh->disconnect); DBD-mysql-4.054/t/41bindparam.t0000644000175000017500000000202614471320024016455 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my ($dbh, $sth); eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 11; my ($rows, $errstr, $ret_ref); ok $dbh->do("drop table if exists dbd_mysql_41bindparam"), "drop table dbd_mysql_41bindparam"; ok $dbh->do("create table dbd_mysql_41bindparam (a int not null, primary key (a))"), "create table dbd_mysql_41bindparam"; ok ($sth= $dbh->prepare("insert into dbd_mysql_41bindparam values (?)")); ok $sth->bind_param(1,10000,DBI::SQL_INTEGER), "bind param 10000 col1"; ok $sth->execute(), 'execute'; ok $sth->bind_param(1,10001,DBI::SQL_INTEGER), "bind param 10001 col1"; ok $sth->execute(), 'execute'; ok ($sth= $dbh->prepare("DROP TABLE dbd_mysql_41bindparam")); ok $sth->execute(); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.054/t/40keyinfo.t0000644000175000017500000000255215043617710016176 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 7; $dbh->{mysql_server_prepare}= 0; ok(defined $dbh, "Connected to database for key info tests"); ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_keyinfo"), "Dropped table"); # Non-primary key is there as a regression test for Bug #26786. ok($dbh->do("CREATE TABLE dbd_mysql_keyinfo (a int, b varchar(20), c int, primary key (a,b(10)), key (c))"), "Created table dbd_mysql_keyinfo"); my $sth= $dbh->primary_key_info(undef, undef, 'dbd_mysql_keyinfo'); ok($sth, "Got primary key info"); my $key_info= $sth->fetchall_arrayref; my $expect= [ [ undef, undef, 'dbd_mysql_keyinfo', 'a', '1', 'PRIMARY' ], [ undef, undef, 'dbd_mysql_keyinfo', 'b', '2', 'PRIMARY' ], ]; is_deeply($key_info, $expect, "Check primary_key_info results"); is_deeply([ $dbh->primary_key(undef, undef, 'dbd_mysql_keyinfo') ], [ 'a', 'b' ], "Check primary_key results"); ok($dbh->do("DROP TABLE dbd_mysql_keyinfo"), "Dropped table"); $dbh->disconnect(); DBD-mysql-4.054/t/rt83494-quotes-comments.t0000644000175000017500000000163214471320024020557 0ustar dvaneedendvaneeden# Test special characters inside comments # http://bugs.debian.org/311040 # http://bugs.mysql.com/27625 use strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password $state); require "t/lib.pl"; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } my %tests = ( questionmark => " -- Does the question mark at the end confuse DBI::MySQL?\nselect ?", quote => " -- 'Tis the quote that confuses DBI::MySQL\nSELECT ?" ); for my $test ( sort keys %tests ) { my $sth = $dbh->prepare($tests{$test}); ok($sth, 'created statement hande'); ok($sth->execute(), 'executing'); ok($sth->{ParamValues}, 'values'); ok($sth->finish(), 'finish'); } ok ($dbh->disconnect(), 'disconnecting from dbh'); done_testing; DBD-mysql-4.054/t/88async-multi-stmts.t0000644000175000017500000000164314471320024020154 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; if (!$dbh) { plan skip_all => "no database connection"; } plan tests => 8; $dbh->do(<prepare('INSERT INTO async_test VALUES(0)', { async => 1 }); my $sth1 = $dbh->prepare('INSERT INTO async_test VALUES(1)', { async => 1 }); $sth0->execute; ok !defined($sth1->mysql_async_ready); ok $sth1->errstr; ok !defined($sth1->mysql_async_result); ok $sth1->errstr; ok defined($sth0->mysql_async_ready); ok !$sth1->errstr; ok defined($sth0->mysql_async_result); ok !$sth1->errstr; undef $sth0; undef $sth1; $dbh->disconnect; DBD-mysql-4.054/t/42bindparam.t0000644000175000017500000000174514471320024016465 0ustar dvaneedendvaneedenuse strict; use warnings; use vars qw($test_dsn $test_user $test_password $mdriver); use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 12; ok $dbh->do("drop table if exists dbd_mysql_t42bindparams"); my $create= <do($create); ok (my $sth= $dbh->prepare("insert into dbd_mysql_t42bindparams values (?, ?)")); ok $sth->bind_param(1,"10000 ",DBI::SQL_INTEGER); ok $sth->bind_param(2,"1.22 ",DBI::SQL_DOUBLE); ok $sth->execute(); ok $sth->bind_param(1,10001,DBI::SQL_INTEGER); ok $sth->bind_param(2,.3333333,DBI::SQL_DOUBLE); ok $sth->execute(); ok $dbh->do("DROP TABLE dbd_mysql_t42bindparams"); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.054/t/17quote.t0000644000175000017500000000225014736675345015706 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib '.', 't'; require 'lib.pl'; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1}) or ServerError() ;}; if ($@) { plan skip_all => "no database connection"; } my @sqlmodes = (qw/ empty ANSI_QUOTES NO_BACKSLASH_ESCAPES/); my @words = (qw/ foo foo'bar foo\bar /); my @results_empty = (qw/ 'foo' 'foo\'bar' 'foo\\\\bar'/); my @results_ansi = (qw/ 'foo' 'foo\'bar' 'foo\\\\bar'/); my @results_no_backlslash = (qw/ 'foo' 'foo''bar' 'foo\\bar'/); my @results = (\@results_empty, \@results_ansi, \@results_no_backlslash); plan tests => (@sqlmodes * @words * 3 + 1); while (my ($i, $sqlmode) = each @sqlmodes) { $dbh->do("SET sql_mode=?", undef, $sqlmode eq "empty" ? "" : $sqlmode); for my $j (0..@words-1) { ok $dbh->quote($words[$j]); cmp_ok($dbh->quote($words[$j]), "eq", $results[$i][$j], "$sqlmode $words[$j]"); is( $dbh->selectrow_array('SELECT ?', undef, $words[$j]), $words[$j], "Round-tripped '$words[$j]' through a placeholder query" ); } } ok $dbh->disconnect; DBD-mysql-4.054/t/15reconnect.t0000644000175000017500000000257215043617710016516 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; $|= 1; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } plan tests => 28; for my $mysql_server_prepare (0, 1) { $dbh= DBI->connect("$test_dsn;mysql_server_prepare=$mysql_server_prepare;mysql_server_prepare_disable_fallback=1", $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); ok(defined $dbh, "Connected to database"); ok($dbh->{Active}, "checking for active handle"); ok($dbh->{mysql_auto_reconnect} = 1, "enabling reconnect"); ok($dbh->{AutoCommit} = 1, "enabling autocommit"); ok($dbh->disconnect(), "disconnecting active handle"); ok(!$dbh->{Active}, "checking for inactive handle"); ok($dbh->do("SELECT 1"), "implicitly reconnecting handle with 'do'"); ok($dbh->{Active}, "checking for reactivated handle"); ok(!($dbh->{AutoCommit} = 0), "disabling autocommit"); ok($dbh->disconnect(), "disconnecting active handle"); ok(!$dbh->{Active}, "checking for inactive handle"); ok( ! $dbh->ping(), 'dbh is disconnected and did not segv'); ok(!$dbh->do("SELECT 1"), "implicitly reconnecting handle with 'do'"); ok(!$dbh->{Active}, "checking for reactivated handle"); } DBD-mysql-4.054/t/53comment.t0000644000175000017500000000352014471320024016165 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use DBI::Const::GetInfoType; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval { $dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, mysql_bind_comment_placeholders => 1,} ); }; if ($@) { plan skip_all => "no database connection"; } my $create= <<"EOTABLE"; CREATE TEMPORARY TABLE dbd_mysql_53 ( id bigint unsigned not null default 0 ) EOTABLE ok $dbh->do($create), "creating table"; my $statement= "insert into dbd_mysql_53 (id) values (?)"; my $sth; ok $sth= $dbh->prepare($statement); my $rows; ok $rows= $sth->execute('1'); cmp_ok $rows, '==', 1; $sth->finish(); my $retrow; if ( $test_dsn =~ m/mysql_server_prepare=1/ ) { # server_prepare can't bind placeholder on comment. ok 1; ok 2; } else { $statement= <selectrow_arrayref($statement, {}, 'hey', 1); cmp_ok $retrow->[0], '==', 1; $statement= "SELECT id FROM dbd_mysql_53 /* Some value here ? */ WHERE id = ?"; $retrow= $dbh->selectrow_arrayref($statement, {}, "hello", 1); cmp_ok $retrow->[0], '==', 1; } $statement= "SELECT id FROM dbd_mysql_53 WHERE id = ? "; my $comment = "/* it's/a_directory/does\ this\ work/bug? */"; $statement= $statement . $comment; for (0 .. 9) { $retrow= $dbh->selectrow_arrayref($statement, {}, 1); cmp_ok $retrow->[0], '==', 1; } $comment = "/* $0 */"; for (0 .. 9) { $retrow= $dbh->selectrow_arrayref($statement . $comment, {}, 1); cmp_ok $retrow->[0], '==', 1; } ok $dbh->disconnect; done_testing; DBD-mysql-4.054/t/50commit.t0000644000175000017500000001012615043617710016017 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($have_transactions $got_warning $test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } sub catch_warning ($) { $got_warning = 1; } sub num_rows($$$) { my($dbh, $table, $num) = @_; my($sth, $got); if (!($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t50commit"))) { return "Failed to prepare: err " . $dbh->err . ", errstr " . $dbh->errstr; } if (!$sth->execute) { return "Failed to execute: err " . $dbh->err . ", errstr " . $dbh->errstr; } $got = 0; while ($sth->fetchrow_arrayref) { ++$got; } if ($got ne $num) { return "Wrong result: Expected $num rows, got $got.\n"; } return ''; } $have_transactions = have_transactions($dbh); my $engine= $have_transactions ? 'InnoDB' : 'MyISAM'; if ($have_transactions) { plan tests => 22; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t50commit"), "drop table if exists dbd_mysql_t50commit"; my $create =<do($create), 'create dbd_mysql_t50commit'; ok !$dbh->{AutoCommit}, "\$dbh->{AutoCommit} not defined |$dbh->{AutoCommit}|"; $dbh->{AutoCommit} = 0; ok !$dbh->err; ok !$dbh->errstr; ok !$dbh->{AutoCommit}; ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (1, 'Jochen')"), "insert into dbd_mysql_t50commit (1, 'Jochen')"; my $msg; $msg = num_rows($dbh, 'dbd_mysql_t50commit', 1); ok !$msg; ok $dbh->rollback, 'rollback'; $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); ok !$msg; ok $dbh->do("DELETE FROM dbd_mysql_t50commit WHERE id = 1"), "delete from dbd_mysql_t50commit where id = 1"; $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); ok !$msg; ok $dbh->commit, 'commit'; $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); ok !$msg; # Check auto rollback after disconnect ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (1, 'Jochen')"); $msg = num_rows($dbh, 'dbd_mysql_t50commit', 1); ok !$msg; ok $dbh->disconnect; ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password)); ok $dbh, "connected"; $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); ok !$msg; ok $dbh->{AutoCommit}, "\$dbh->{AutoCommit} $dbh->{AutoCommit}"; ok $dbh->do("DROP TABLE dbd_mysql_t50commit"); } else { plan tests => 13; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t50commit"), "drop table if exists dbd_mysql_t50commit"; my $create =<do($create), 'create dbd_mysql_t50commit'; # Tests for databases that don't support transactions # Check whether AutoCommit mode works. ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (1, 'Jochen')"); my $msg = num_rows($dbh, 'dbd_mysql_t50commit', 1); ok !$msg; ok $dbh->disconnect; ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password)); $msg = num_rows($dbh, 'dbd_mysql_t50commit', 1); ok !$msg; ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (2, 'Tim')"); my $result; $@ = ''; $SIG{__WARN__} = \&catch_warning; $got_warning = 0; eval { $result = $dbh->commit; }; $SIG{__WARN__} = 'DEFAULT'; ok $got_warning; # Check whether rollback issues a warning in AutoCommit mode # We accept error messages as being legal, because the DBI # requirement of just issuing a warning seems scary. ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (3, 'Alligator')"); $@ = ''; $SIG{__WARN__} = \&catch_warning; $got_warning = 0; eval { $result = $dbh->rollback; }; $SIG{__WARN__} = 'DEFAULT'; ok $got_warning, "Should be warning defined upon rollback of non-trx table"; ok $dbh->do("DROP TABLE dbd_mysql_t50commit"); ok $dbh->disconnect(); } DBD-mysql-4.054/t/rt75353-innodb-lock-timeout.t0000644000175000017500000000536015043617710021303 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); require "t/lib.pl"; my $dbh1 = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0 }) }; plan skip_all => "no database connection" if $@ or not $dbh1; my $dbh2 = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0 }) }; plan skip_all => "no database connection" if $@ or not $dbh2; my @ilwtenabled = $dbh1->selectrow_array("SHOW VARIABLES LIKE 'innodb_lock_wait_timeout'"); if (!@ilwtenabled) { plan skip_all => 'innodb_lock_wait_timeout not available'; } my $have_innodb = 0; if (!MinimumVersion($dbh1, '5.6')) { my $dummy; ($dummy,$have_innodb)= $dbh1->selectrow_array("SHOW VARIABLES LIKE 'have_innodb'") or DbiError($dbh1->err, $dbh1->errstr); } else { my $engines = $dbh1->selectall_arrayref('SHOW ENGINES'); if (!$engines) { DbiError($dbh1->err, $dbh1->errstr); } else { STORAGE_ENGINE: for my $engine (@$engines) { next STORAGE_ENGINE if lc $engine->[0] ne 'innodb'; next STORAGE_ENGINE if lc $engine->[1] eq 'no'; $have_innodb = 1; } } } if (!$have_innodb) { plan skip_all => "Server doesn't support InnoDB, needed for testing innodb_lock_wait_timeout"; } eval { $dbh2->{PrintError} = 0; $dbh2->do("SET innodb_lock_wait_timeout=1"); $dbh2->{PrintError} = 1; 1; } or do { $dbh1->disconnect(); $dbh2->disconnect(); plan skip_all => "innodb_lock_wait_timeout is not modifyable on this version of MySQL"; }; ok $dbh1->do("DROP TABLE IF EXISTS dbd_mysql_rt75353_innodb_lock_timeout"), "drop table if exists dbd_mysql_rt75353_innodb_lock_timeout"; ok $dbh1->do("CREATE TABLE dbd_mysql_rt75353_innodb_lock_timeout(id INT PRIMARY KEY) ENGINE=INNODB"), "create table dbd_mysql_rt75353_innodb_lock_timeout"; ok $dbh1->do("INSERT INTO dbd_mysql_rt75353_innodb_lock_timeout VALUES(1)"), "dbh1: acquire a row lock on table dbd_mysql_rt75353_innodb_lock_timeout"; my $error_handler_called = 0; $dbh2->{HandleError} = sub { $error_handler_called = 1; die $_[0]; }; eval { $dbh2->selectcol_arrayref("SELECT id FROM dbd_mysql_rt75353_innodb_lock_timeout FOR UPDATE") }; my $error_message = $@; $dbh2->{HandleError} = undef; ok $error_message, "dbh2: acquiring same lock as dbh1 on table dbd_mysql_rt75353_innodb_lock_timeout failed"; like $error_message, qr/Lock wait timeout exceeded; try restarting transaction/, "dbh2: error message for acquiring lock is 'Lock wait timeout exceeded'"; ok $error_handler_called, "dbh2: error handler code ref was called"; $dbh2->disconnect(); ok $dbh1->do("DROP TABLE dbd_mysql_rt75353_innodb_lock_timeout"), "drop table dbd_mysql_rt75353_innodb_lock_timeout"; $dbh1->disconnect(); done_testing; DBD-mysql-4.054/t/40blobs.t0000644000175000017500000000360614471320024015625 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib '.', 't'; require 'lib.pl'; 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 = ""; } note sprintf("%08lx %s\n", $i*32, unpack("H64", $b)); } } my $dbh; my $charset= 'DEFAULT CHARSET=utf8'; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1}) or ServerError() ;}; if ($@) { plan skip_all => "no database connection"; } else { plan tests => 14; } if (!MinimumVersion($dbh, '4.1')) { $charset= ''; } my $size= 128; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40blobs"), "Drop table if exists dbd_mysql_t40blobs"; my $create = <do($create)); my ($blob, $qblob) = ""; my $b = ""; for (my $j = 0; $j < 256; $j++) { $b .= chr($j); } for (1 .. $size) { $blob .= $b; } ok ($qblob = $dbh->quote($blob)); # Insert a row into the test table....... my ($query); $query = "INSERT INTO dbd_mysql_t40blobs VALUES(1, $qblob)"; ok ($dbh->do($query)); # Now, try SELECT'ing the row out. ok (my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40blobs WHERE id = 1")); ok ($sth->execute); ok (my $row = $sth->fetchrow_arrayref); ok defined($row), "row returned defined"; is @$row, 2, "records from dbd_mysql_t40blobs returned 2"; is $$row[0], 1, 'id set to 1'; cmp_ok byte_string($$row[1]), 'eq', byte_string($blob), 'blob set equal to blob returned'; ShowBlob($blob), ShowBlob(defined($$row[1]) ? $$row[1] : ""); ok ($sth->finish); ok $dbh->do("DROP TABLE dbd_mysql_t40blobs"), "Drop table dbd_mysql_t40blobs"; ok $dbh->disconnect; DBD-mysql-4.054/t/56connattr.t0000755000175000017500000000322615043617710016373 0ustar dvaneedendvaneeden#!/usr/bin/perl use strict; use warnings; use DBI; use DBI::Const::GetInfoType; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password $table); my $dbh; eval { $dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0, AutoCommit => 0, mysql_conn_attrs => { foo => 'bar' }, } ); }; if ($@) { plan skip_all => "no database connection"; } my @pfenabled = $dbh->selectrow_array("show variables like 'performance_schema'"); if (!@pfenabled) { plan skip_all => 'performance schema not available'; } if ($pfenabled[1] ne 'ON') { plan skip_all => 'performance schema not enabled'; } if ($dbh->{mysql_clientversion} < 50606) { plan skip_all => 'client version should be 5.6.6 or later'; } eval {$dbh->do("select * from performance_schema.session_connect_attrs where processlist_id=connection_id()");}; if ($@) { $dbh->disconnect(); plan skip_all => "no permission on performance_schema tables"; } plan tests => 8; my $rows = $dbh->selectall_hashref("select * from performance_schema.session_connect_attrs where processlist_id=connection_id()", "ATTR_NAME"); my $pid =$rows->{_pid}->{ATTR_VALUE}; cmp_ok $pid, '==', $$; my $progname =$rows->{program_name}->{ATTR_VALUE}; cmp_ok $progname, 'eq', $0; my $foo_attr =$rows->{foo}->{ATTR_VALUE}; cmp_ok $foo_attr, 'eq', 'bar'; for my $key ('_platform','_client_name','_client_version','_os') { my $row = $rows->{$key}; cmp_ok defined $row, '==', 1, "attribute $key"; } ok $dbh->disconnect; DBD-mysql-4.054/t/gh352.t0000644000175000017500000000116214730347136015216 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { diag $@; plan skip_all => "no database connection"; } plan tests => 2; # https://github.com/perl5-dbi/DBD-mysql/issues/352 # Calling prepare on a disconnected handle causes the call to mysql_real_escape_string to segfault my $sth; ok $dbh->disconnect; my $result = eval { $dbh->prepare('SELECT ?'); }; ok !$result DBD-mysql-4.054/t/40server_prepare_error.t0000644000175000017500000000171014471320024020753 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib '.', 't'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); $test_dsn.= ";mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1"; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_clientversion} < 40103 or $dbh->{mysql_serverversion} < 40103) { plan skip_all => "SKIP TEST: You must have MySQL version 4.1.3 and greater for this test to run"; } plan tests => 3; # execute invalid SQL to make sure we get an error my $q = "select select select"; # invalid SQL $dbh->{PrintError} = 0; $dbh->{PrintWarn} = 0; my $sth; eval {$sth = $dbh->prepare($q);}; $dbh->{PrintError} = 1; $dbh->{PrintWarn} = 1; ok defined($DBI::errstr); cmp_ok $DBI::errstr, 'ne', ''; note "errstr $DBI::errstr\n" if $DBI::errstr; ok $dbh->disconnect(); DBD-mysql-4.054/t/40bit.t0000644000175000017500000000240314471320024015274 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib '.', 't'; require 'lib.pl'; sub VerifyBit ($) { } my $dbh; my $charset= 'DEFAULT CHARSET=utf8'; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1}) or ServerError() ;}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} < 50008) { plan skip_all => "Servers < 5.0.8 do not support b'' syntax"; } plan tests => 15; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_b1"), "Drop table if exists dbd_mysql_b1"; ok( $dbh->do('CREATE TABLE dbd_mysql_b1 (b BIT(8))') ); ok ($dbh->do("insert into dbd_mysql_b1 set b = b'11111111'")); ok ($dbh->do("insert into dbd_mysql_b1 set b = b'1010'")); ok ($dbh->do("insert into dbd_mysql_b1 set b = b'0101'")); ok (my $sth = $dbh->prepare("select BIN(b+0) FROM dbd_mysql_b1")); ok ($sth->execute); ok (my $result = $sth->fetchall_arrayref); ok defined($result), "result returned defined"; is $result->[0][0], 11111111, "should be 11111111"; is $result->[1][0], 1010, "should be 1010"; is $result->[2][0], 101, "should be 101"; ok ($sth->finish); ok $dbh->do("DROP TABLE dbd_mysql_b1"), "Drop table dbd_mysql_b1"; ok $dbh->disconnect; DBD-mysql-4.054/t/40listfields.t0000644000175000017500000000434514471320024016667 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($COL_NULLABLE $test_dsn $test_user $test_password); use lib '.', 't'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $quoted; my $create; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 25; $dbh->{mysql_server_prepare}= 0; $create = <do($create), "create table dbd_mysql_40listfields"; ok $dbh->table_info(undef,undef,'dbd_mysql_40listfields'), "table info for dbd_mysql_40listfields"; ok $dbh->column_info(undef,undef,'dbd_mysql_40listfields','%'), "column_info for dbd_mysql_40listfields"; my $sth= $dbh->column_info(undef,undef,"this_does_not_exist",'%'); ok $sth, "\$sth defined"; ok !$sth->err(), "not error"; $sth = $dbh->prepare("SELECT * FROM dbd_mysql_40listfields"); ok $sth, "prepare succeeded"; ok $sth->execute, "execute select"; my $res; $res = $sth->{'NUM_OF_FIELDS'}; ok $res, "$sth->{NUM_OF_FIELDS} defined"; is $res, 2, "\$res $res == 2"; my $ref = $sth->{'NAME'}; ok $ref, "\$sth->{NAME} defined"; cmp_ok $$ref[0], 'eq', 'id', "$$ref[0] eq 'id'"; cmp_ok $$ref[1], 'eq', 'name', "$$ref[1] eq 'name'"; $ref = $sth->{'NULLABLE'}; ok $ref, "nullable"; ok !($$ref[0] xor (0 & $COL_NULLABLE)); ok !($$ref[1] xor (1 & $COL_NULLABLE)); $ref = $sth->{TYPE}; cmp_ok $ref->[0], 'eq', DBI::SQL_INTEGER(), "SQL_INTEGER"; cmp_ok $ref->[1], 'eq', DBI::SQL_VARCHAR(), "SQL_VARCHAR"; $sth = $dbh->prepare("SELECT * FROM dbd_mysql_40listfields"); if (!$sth) { die "Error:" . $dbh->errstr . "\n"; } if (!$sth->execute) { die "Error:" . $sth->errstr . "\n"; } ok ($sth= $dbh->prepare("DROP TABLE dbd_mysql_40listfields")); ok($sth->execute); ok (! defined $sth->{'NUM_OF_FIELDS'}); $quoted = eval { $dbh->quote(0, DBI::SQL_INTEGER()) }; ok (!$@); cmp_ok $quoted, 'eq', '0', "equals '0'"; $quoted = eval { $dbh->quote('abc', DBI::SQL_VARCHAR()) }; ok (!$@); cmp_ok $quoted, 'eq', "\'abc\'", "equals 'abc'"; ok($dbh->disconnect()); DBD-mysql-4.054/t/50chopblanks.t0000644000175000017500000000547114525366521016667 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} < 50000) { plan skip_all => "You must have MySQL version 5.0.0 and greater for this test to run"; } for my $mysql_server_prepare (0, 1) { eval {$dbh= DBI->connect("$test_dsn;mysql_server_prepare=$mysql_server_prepare;mysql_server_prepare_disable_fallback=1", $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t50chopblanks"), "drop table if exists dbd_mysql_t50chopblanks"; my $create= <do($create), "create table dbd_mysql_t50chopblanks"; my @fields = qw(c_varchar c_text c_tinytext c_mediumtext c_longtext b_blob b_tinyblob b_mediumblob b_longblob); my $numfields = scalar @fields; my $fieldlist = join(', ', @fields); ok (my $sth= $dbh->prepare("INSERT INTO dbd_mysql_t50chopblanks (id, $fieldlist) VALUES (".('?, ' x $numfields)."?)")); ok (my $sth2= $dbh->prepare("SELECT $fieldlist FROM dbd_mysql_t50chopblanks WHERE id = ?")); my $rows; $rows = [ [1, ''], [2, ' '], [3, ' a b c '], [4, 'blah'] ]; for my $ref (@$rows) { my ($id, $value) = @$ref; ok $sth->execute($id, ($value) x $numfields), "insert into dbd_mysql_t50chopblanks values ($id ".(", '$value'" x $numfields).")"; ok $sth2->execute($id), "select $fieldlist from dbd_mysql_t50chopblanks where id = $id"; # First try to retrieve without chopping blanks. $sth2->{'ChopBlanks'} = 0; my $ret_ref = []; ok ($ret_ref = $sth2->fetchrow_arrayref); for my $i (0 .. $#{$ret_ref}) { cmp_ok $ret_ref->[$i], 'eq', $value, "NoChopBlanks: $fields[$i] should not have blanks chopped"; } # Now try to retrieve with chopping blanks. $sth2->{'ChopBlanks'} = 1; ok $sth2->execute($id); $ret_ref = []; ok ($ret_ref = $sth2->fetchrow_arrayref); for my $i (0 .. $#{$ret_ref}) { my $choppedvalue = $value; my $character_field = ($fields[$i] =~ /^c/); $choppedvalue =~ s/\s+$// if $character_field; # only chop character, not binary cmp_ok $ret_ref->[$i], 'eq', $choppedvalue, "ChopBlanks: $fields[$i] should ".($character_field ? "" : "not ")."have blanks chopped"; } } ok $sth->finish; ok $sth2->finish; ok $dbh->do("DROP TABLE dbd_mysql_t50chopblanks"), "drop dbd_mysql_t50chopblanks"; ok $dbh->disconnect; } done_testing; DBD-mysql-4.054/t/89async-method-check.t0000644000175000017500000001373114471320024020207 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my @common_safe_methods = qw/ can err errstr parse_trace_flag parse_trace_flags private_attribute_info trace trace_msg visit_child_handles /; my @db_safe_methods = (@common_safe_methods, qw/ clone mysql_async_ready /); my @db_unsafe_methods = qw/ data_sources do last_insert_id selectrow_array selectrow_arrayref selectrow_hashref selectall_arrayref selectall_hashref selectcol_arrayref prepare prepare_cached commit rollback begin_work ping get_info table_info column_info primary_key_info primary_key foreign_key_info statistics_info tables type_info_all type_info quote quote_identifier /; my @st_safe_methods = qw/ fetchrow_arrayref fetch fetchrow_array fetchrow_hashref fetchall_arrayref fetchall_hashref finish rows /; my @st_unsafe_methods = qw/ bind_param bind_param_inout bind_param_array execute execute_array execute_for_fetch bind_col bind_columns /; my %dbh_args = ( can => ['can'], parse_trace_flag => ['SQL'], parse_trace_flags => ['SQL'], trace_msg => ['message'], visit_child_handles => [sub { }], quote => ['string'], quote_identifier => ['Users'], do => ['SELECT 1'], last_insert_id => [undef, undef, undef, undef], selectrow_array => ['SELECT 1'], selectrow_arrayref => ['SELECT 1'], selectrow_hashref => ['SELECT 1'], selectall_arrayref => ['SELECT 1'], selectall_hashref => ['SELECT 1', '1'], selectcol_arrayref => ['SELECT 1'], prepare => ['SELECT 1'], prepare_cached => ['SELECT 1'], get_info => [$GetInfoType{'SQL_DBMS_NAME'}], column_info => [undef, undef, '%', '%'], primary_key_info => [undef, undef, 'async_test'], primary_key => [undef, undef, 'async_test'], foreign_key_info => [undef, undef, 'async_test', undef, undef, undef], statistics_info => [undef, undef, 'async_test', 0, 1], ); my %sth_args = ( fetchall_hashref => [1], bind_param => [1, 1], bind_param_inout => [1, \(my $scalar = 1), 64], bind_param_array => [1, [1]], execute_array => [{ ArrayTupleStatus => [] }, [1]], execute_for_fetch => [sub { undef } ], bind_col => [1, \(my $scalar2 = 1)], bind_columns => [\(my $scalar3)], ); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; if (!$dbh) { plan skip_all => "no database connection"; } plan tests => 2 * @db_safe_methods + 4 * @db_unsafe_methods + 7 * @st_safe_methods + 3 * @common_safe_methods + 2 * @st_unsafe_methods + 3; $dbh->do(<do('SELECT 1', { async => 1 }); my $args = $dbh_args{$method} || []; $dbh->$method(@$args); ok !$dbh->errstr, "Testing method '$method' on DBD::mysql::db during asynchronous operation"; ok defined($dbh->mysql_async_result); } $dbh->do('SELECT 1', { async => 1 }); ok defined($dbh->mysql_async_result); foreach my $method (@db_unsafe_methods) { $dbh->do('SELECT 1', { async => 1 }); my $args = $dbh_args{$method} || []; my @values = $dbh->$method(@$args); # some methods complain unless they're called in list context like $dbh->errstr, qr/Calling a synchronous function on an asynchronous handle/, "Testing method '$method' on DBD::mysql::db during asynchronous operation"; ok defined($dbh->mysql_async_result); } foreach my $method (@common_safe_methods) { my $sth = $dbh->prepare('SELECT 1', { async => 1 }); $sth->execute; my $args = $dbh_args{$method} || []; # they're common methods, so this should be ok! $sth->$method(@$args); ok !$sth->errstr, "Testing method '$method' on DBD::mysql::db during asynchronous operation"; ok defined($sth->mysql_async_result); ok defined($sth->mysql_async_result); } foreach my $method (@st_safe_methods) { my $sth = $dbh->prepare('SELECT 1', { async => 1 }); $sth->execute; my $args = $sth_args{$method} || []; $sth->$method(@$args); ok !$sth->errstr, "Testing method '$method' on DBD::mysql::st during asynchronous operation"; # statement safe methods cache async result and mysql_async_result can be called multiple times ok defined($sth->mysql_async_result), "Testing DBD::mysql::st method '$method' for async result"; ok defined($sth->mysql_async_result), "Testing DBD::mysql::st method '$method' for async result"; } foreach my $method (@st_safe_methods) { my $sync_sth = $dbh->prepare('SELECT 1'); my $async_sth = $dbh->prepare('SELECT 1', { async => 1 }); $dbh->do('SELECT 1', { async => 1 }); ok !$sync_sth->execute; ok $sync_sth->errstr; ok !$async_sth->execute; ok $async_sth->errstr; $dbh->mysql_async_result; } foreach my $method (@db_unsafe_methods) { my $sth = $dbh->prepare('SELECT 1', { async => 1 }); $sth->execute; ok !$dbh->do('SELECT 1', { async => 1 }); ok $dbh->errstr; $sth->mysql_async_result; } foreach my $method (@st_unsafe_methods) { my $sth = $dbh->prepare('SELECT value FROM async_test WHERE value = ?', { async => 1 }); $sth->execute(1); my $args = $sth_args{$method} || []; my @values = $sth->$method(@$args); like $dbh->errstr, qr/Calling a synchronous function on an asynchronous handle/, "Testing method '$method' on DBD::mysql::st during asynchronous operation"; ok(defined $sth->mysql_async_result); } my $sth = $dbh->prepare('SELECT 1', { async => 1 }); $sth->execute; ok defined($sth->mysql_async_ready); ok $sth->mysql_async_result; undef $sth; $dbh->disconnect; DBD-mysql-4.054/t/rt91715.t0000644000175000017500000000152214471320024015407 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($mdriver); $|= 1; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; # yes, we will reconnect, but I want to keep the "fail if not connect" # separate from the actual test where we reconnect eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 6; for my $ur (0,1) { $test_dsn .= ";mysql_use_result=1" if $ur; # reconnect ok ($dbh->disconnect()); ok ($dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 })); is $dbh->{mysql_use_result}, $ur, "mysql_use_result set to $ur"; } DBD-mysql-4.054/t/35limit.t0000644000175000017500000000365015043617710015654 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; $|= 1; my $rows = 0; my $sth; my $testInsertVals; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 115; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t35"), "making slate clean"); ok($dbh->do("CREATE TABLE dbd_mysql_t35 (id INT(4), name VARCHAR(64), name_limit VARCHAR(64))"), "creating table"); ok(($sth = $dbh->prepare("INSERT INTO dbd_mysql_t35 VALUES (?,?,?)"))); for my $i (0..99) { my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; my $random_chars = join '', map { $chars[rand @chars] } 0 .. 16; # save these values for later testing $testInsertVals->{$i} = $random_chars; ok(($rows = $sth->execute($i, $random_chars, $random_chars))); } ok($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t35 LIMIT ?, ?"), 'testing prepare of select statement with LIMIT placeholders'); ok($sth->execute(20, 50), 'testing exec of bind vars for limit'); my ($row, $errstr, $array_ref); ok( (defined($array_ref = $sth->fetchall_arrayref) && (!defined($errstr = $sth->errstr) || $sth->errstr eq ''))); ok(@$array_ref == 50); ok($sth->finish); ok($dbh->do("UPDATE dbd_mysql_t35 SET name_limit = ? WHERE id = ?", undef, "updated_string", 1)); ok($dbh->do("UPDATE dbd_mysql_t35 SET name = ? WHERE name_limit > ?", undef, "updated_string", 999999)); # newline before LIMIT ok($dbh->do(<<'SQL' UPDATE dbd_mysql_t35 SET name = ? LIMIT ? SQL , undef, "updated_string", 0)); # tab before LIMIT ok($dbh->do(<<'SQL' UPDATE dbd_mysql_t35 SET name = ? LIMIT ? SQL , undef, "updated_string", 0)); ok($dbh->do("DROP TABLE dbd_mysql_t35")); ok($dbh->disconnect); DBD-mysql-4.054/t/81procs.t0000644000175000017500000000532615043617710015667 0ustar dvaneedendvaneedenuse strict; use warnings; use lib 't', '.'; require 'lib.pl'; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); my ($row, $vers, $test_procs, $dbh, $sth); eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } # # DROP/CREATE PROCEDURE will give syntax error # for versions < 5.0 # if ($dbh->{mysql_serverversion} < 50000) { plan skip_all => "You must have MySQL version 5.0 and greater for this test to run"; } if (!CheckRoutinePerms($dbh)) { plan skip_all => "Your test user does not have ALTER_ROUTINE privileges."; } plan tests => 32; $dbh->disconnect(); ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})); ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t81procs"); my $drop_proc= "DROP PROCEDURE IF EXISTS testproc"; ok $dbh->do($drop_proc); my $proc_create = <do($proc_create); my $proc_call = 'CALL testproc()'; ok $dbh->do($proc_call); my $proc_select = 'SELECT @a'; ok ($sth = $dbh->prepare($proc_select)); ok $sth->execute(); ok $sth->finish; ok $dbh->do("DROP PROCEDURE testproc"); ok $dbh->do("drop procedure if exists test_multi_sets"); $proc_create = <do($proc_create); ok ($sth = $dbh->prepare("call test_multi_sets()")); ok $sth->execute(); is $sth->{NUM_OF_FIELDS}, 1, "num_of_fields == 1"; my $resultset; ok ($resultset = $sth->fetchrow_arrayref()); ok defined $resultset; is @$resultset, 1, "1 row in resultset"; undef $resultset; ok $sth->more_results(); is $sth->{NUM_OF_FIELDS}, 2, "NUM_OF_FIELDS == 2"; ok ($resultset= $sth->fetchrow_arrayref()); ok defined $resultset; is @$resultset, 2, "2 rows in resultset"; undef $resultset; ok $sth->more_results(); is $sth->{NUM_OF_FIELDS}, 3, "NUM_OF_FIELDS == 3"; ok ($resultset= $sth->fetchrow_arrayref()); ok defined $resultset; is @$resultset, 3, "3 Rows in resultset"; is $sth->more_results(), 1, "each CALL returns a result to indicate the call status"; is $sth->{NUM_OF_FIELDS}, 0, "NUM_OF_FIELDS == 0"; ok !$sth->more_results(); local $SIG{__WARN__} = sub { die @_ }; ok $sth->finish; ok $dbh->disconnect(); DBD-mysql-4.054/t/70takeimp.t0000644000175000017500000000522114471320024016154 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $drh; eval {$drh = DBI->install_driver('mysql')}; if ($@) { plan skip_all => "Can't obtain driver handle ERROR: $@. Can't continue test"; } my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 })}; if ($@) { plan skip_all => "no database connection"; } plan tests => 21; pass("obtained driver handle"); pass("connected to database"); my $id= connection_id($dbh); ok defined($id), "Initial connection: $id\n"; $drh = $dbh->{Driver}; ok $drh, "Driver handle defined\n"; my $imp_data; $imp_data = $dbh->take_imp_data; ok $imp_data, "Didn't get imp_data"; my $imp_data_length= length($imp_data); cmp_ok $imp_data_length, '>=', 80, "test that our imp_data is greater than or equal to 80, actual $imp_data_length"; is $drh->{Kids}, 0, 'our Driver should have 0 Kid(s) after calling take_imp_data'; { my $warn; local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /after take_imp_data/ }; my $drh = $dbh->{Driver}; ok !defined($drh), '... our Driver should be undefined'; my $trace_level = $dbh->{TraceLevel}; ok !defined($trace_level) ,'our TraceLevel should be undefined'; ok !defined($dbh->disconnect), 'disconnect should return undef'; ok !defined($dbh->quote(42)), 'quote should return undefined'; is $warn, 4, 'we should have received 4 warnings'; } my $dbh2 = DBI->connect($test_dsn, $test_user, $test_password, { dbi_imp_data => $imp_data }); # XXX: how can we test that the same connection is used? my $id2 = connection_id($dbh2); note "Overridden connection: $id2\n"; cmp_ok $id,'==', $id2, "the same connection: $id => $id2\n"; my $drh2; ok $drh2 = $dbh2->{Driver}, "can't get the driver\n"; ok $dbh2->isa("DBI::db"), 'isa test'; # need a way to test dbi_imp_data has been used is $drh2->{Kids}, 1, "our Driver should have 1 Kid(s) again: having " . $drh2->{Kids} . "\n"; is $drh2->{ActiveKids}, 1, "our Driver should have 1 ActiveKid again: having " . $drh2->{ActiveKids} . "\n"; read_write_test($dbh2); # must cut the connection data again ok ($imp_data = $dbh2->take_imp_data, "didn't get imp_data"); sub read_write_test { my ($dbh)= @_; # now the actual test: ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t70takeimp"); my $create= <do($create); ok $dbh->do("DROP TABLE dbd_mysql_t70takeimp"); } DBD-mysql-4.054/t/91errcheck.t0000644000175000017500000000074514471320024016321 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; if (!$dbh) { plan skip_all => "no database connection"; } plan tests => 1; $dbh->do( 'this should die' ); ok $DBI::errstr, 'error string should be set on a bad call'; $dbh->disconnect; DBD-mysql-4.054/t/40server_prepare.t0000644000175000017500000000647415043617710017565 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); $|= 1; $test_dsn.= ";mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1"; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_clientversion} < 40103 or $dbh->{mysql_serverversion} < 40103) { plan skip_all => "You must have MySQL version 4.1.3 and greater for this test to run"; } plan tests => 31; ok(defined $dbh, "connecting"); ok($dbh->do(qq{DROP TABLE IF EXISTS dbd_mysql_t40serverprepare1}), "making slate clean"); # # Bug #20559: Program crashes when using server-side prepare # ok($dbh->do(qq{CREATE TABLE dbd_mysql_t40serverprepare1 (id INT, num DOUBLE)}), "creating table"); my $sth; ok($sth= $dbh->prepare(qq{INSERT INTO dbd_mysql_t40serverprepare1 VALUES (?,?),(?,?)}), "loading data"); ok($sth->execute(1, 3.0, 2, -4.5)); ok ($sth= $dbh->prepare("SELECT num FROM dbd_mysql_t40serverprepare1 WHERE id = ? FOR UPDATE")); ok ($sth->bind_param(1, 1), "binding parameter"); ok ($sth->execute(), "fetching data"); is_deeply($sth->fetchall_arrayref({}), [ { 'num' => '3' } ]); ok ($sth->finish); ok ($dbh->do(qq{DROP TABLE dbd_mysql_t40serverprepare1}), "cleaning up"); # # Bug #42723: Binding server side integer parameters results in corrupt data # ok($dbh->do(qq{DROP TABLE IF EXISTS dbd_mysql_t40serverprepare2}), "making slate clean"); ok($dbh->do(q{CREATE TABLE `dbd_mysql_t40serverprepare2` (`i` int,`si` smallint,`ti` tinyint,`bi` bigint)}), "creating test table"); my $sth2; ok($sth2 = $dbh->prepare('INSERT INTO dbd_mysql_t40serverprepare2 VALUES (?,?,?,?)')); #bind test values ok($sth2->bind_param(1, 101, DBI::SQL_INTEGER), "binding int"); ok($sth2->bind_param(2, 102, DBI::SQL_SMALLINT), "binding smallint"); ok($sth2->bind_param(3, 103, DBI::SQL_TINYINT), "binding tinyint"); ok($sth2->bind_param(4, '8589934697', DBI::SQL_BIGINT), "binding bigint"); ok($sth2->execute(), "inserting data"); is_deeply($dbh->selectall_arrayref('SELECT * FROM dbd_mysql_t40serverprepare2'), [[101, 102, 103, '8589934697']]); ok ($dbh->do(qq{DROP TABLE dbd_mysql_t40serverprepare2}), "cleaning up"); # # Bug LONGBLOB wants 4GB memory # ok($dbh->do(qq{DROP TABLE IF EXISTS t3}), "making slate clean"); ok($dbh->do(q{CREATE TABLE t3 (id INT, mydata LONGBLOB)}), "creating test table"); my $sth3; ok($sth3 = $dbh->prepare(q{INSERT INTO t3 VALUES (?,?)})); ok($sth3->execute(1, 2), "insert t3"); is_deeply($dbh->selectall_arrayref('SELECT id, mydata FROM t3'), [[1, 2]]); my $dbname = $dbh->selectrow_arrayref("SELECT DATABASE()")->[0]; $dbh->{mysql_server_prepare_disable_fallback} = 1; my $error_handler_called = 0; $dbh->{HandleError} = sub { $error_handler_called = 1; die $_[0]; }; eval { $dbh->prepare("USE $dbname") }; $dbh->{HandleError} = undef; ok($error_handler_called, 'USE is not supported with mysql_server_prepare_disable_fallback=1'); $dbh->{mysql_server_prepare_disable_fallback} = 0; my $sth4; ok($sth4 = $dbh->prepare("USE $dbname"), 'USE is supported with mysql_server_prepare_disable_fallback=0'); ok($sth4->execute()); ok($sth4->finish()); ok ($dbh->do(qq{DROP TABLE t3}), "cleaning up"); $dbh->disconnect(); DBD-mysql-4.054/t/01caching_sha2_prime.t0000644000175000017500000000133714471320024020225 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More ; use DBI; $|= 1; use vars qw($test_user $test_password $test_db $test_dsn); use lib 't', '.'; require 'lib.pl'; # remove database from DSN $test_dsn =~ s/^DBI:mysql:([^:]+)(:?)/DBI:mysql:$2/; # This should result in a cached sha2 password entry # The result is that subsequent connections don't need # TLS or the RSA pubkey. $test_dsn .= ';mysql_ssl=1;mysql_get_server_pubkey=1'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { diag $@; plan skip_all => "no database connection"; } plan tests => 2; ok defined $dbh, "Connected to database"; ok $dbh->disconnect(); DBD-mysql-4.054/t/75supported_sql.t0000644000175000017500000000233414471320024017435 0ustar dvaneedendvaneedenuse strict; use warnings; use vars qw($test_dsn $test_user $test_password); use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; my ($row, $vers, $test_procs); my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } plan tests => 12; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t75supported"); my $create = <do($create),"create dbd_mysql_t75supported"; my $sth; ok ($sth= $dbh->prepare("SHOW TABLES LIKE 'dbd_mysql_t75supported'")); ok $sth->execute(); ok ($row= $sth->fetchrow_arrayref); cmp_ok $row->[0], 'eq', 'dbd_mysql_t75supported', "\$row->[0] eq dbd_mysql_t75supported"; ok $sth->finish; ok $dbh->do("DROP TABLE dbd_mysql_t75supported"), "drop dbd_mysql_t75supported"; ok $dbh->do("CREATE TABLE dbd_mysql_t75supported (a int)"), "creating dbd_mysql_t75supported again with 1 col"; ok $dbh->do("ALTER TABLE dbd_mysql_t75supported ADD COLUMN b varchar(31)"), "alter dbd_mysql_t75supported ADD COLUMN"; ok $dbh->do("DROP TABLE dbd_mysql_t75supported"), "drop dbd_mysql_t75supported"; ok $dbh->disconnect; DBD-mysql-4.054/t/41int_min_max.t0000644000175000017500000001447714471320024017037 0ustar dvaneedendvaneedenuse strict; use warnings; use bigint; use DBI; use Test::More; use lib 't', '.'; use Data::Dumper; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} < 50002) { plan skip_all => "SKIP TEST: You must have MySQL version 5.0.2 and greater for this test to run"; } # nostrict tests + strict tests + init/tear down commands plan tests => (19*8 + 17*8 + 4) * 2; my $table = 'dbd_mysql_t41minmax'; # name of the table we will be using my $mode; # 'strict' or 'nostrict' corresponds to strict SQL mode sub test_int_type ($$$$) { my ($perl_type, $mysql_type, $min, $max) = @_; # Disable the warning text clobbering our output local $SIG{__WARN__} = sub { 1; }; # Create the table ok($dbh->do(qq{DROP TABLE IF EXISTS $table}), "removing $table"); ok($dbh->do(qq{ CREATE TABLE `$table` ( `id` int not null auto_increment, `val` $mysql_type, primary key (id) ) }), "creating minmax table for type $mysql_type"); my ($store, $retrieve); # statements my $read_value; # retrieved value ok($store = $dbh->prepare("INSERT INTO $table (val) VALUES (?)")); ok($retrieve = $dbh->prepare("SELECT val from $table where id=(SELECT MAX(id) FROM $table)")); ######################################## # Insert allowed min value ######################################## ok($store->bind_param( 1, $min->bstr(), $perl_type ), "binding minimal $mysql_type, mode=$mode"); ok($store->execute(), "inserting min data for type $mysql_type, mode=$mode"); ######################################## # Read it back and compare ######################################## ok{$retrieve->execute()}; ($read_value) = $retrieve->fetchrow_array(); cmp_ok($read_value, 'eq', $min, "retrieved minimal value for $mysql_type, mode=$mode"); ######################################## # Insert allowed max value ######################################## ok($store->bind_param( 1, $max->bstr(), $perl_type ), "binding maximal $mysql_type, mode=$mode"); ok($store->execute(), "inserting max data for type $mysql_type, mode=$mode"); ######################################## # Read it back and compare ######################################## ok{$retrieve->execute()}; ($read_value) = $retrieve->fetchrow_array(); cmp_ok($read_value, 'eq', $max, "retrieved maximal value for $mysql_type, mode=$mode"); ######################################## # Try to insert under the limit value ######################################## ok($store->bind_param( 1, ($min-1)->bstr(), $perl_type ), "binding less than minimal $mysql_type, mode=$mode"); if ($mode eq 'strict') { $@ = ''; eval{$store->execute()}; like($@, qr/Out of range value (?:adjusted )?for column 'val'/, "Error, you stored ".($min-1)." into $mysql_type, mode=$mode\n". Data::Dumper->Dump([$dbh->selectall_arrayref("SELECT * FROM $table")]). Data::Dumper->Dump([$dbh->selectall_arrayref("describe $table")]) ); } else { ok{$store->execute()}; ######################################## # Check that it was rounded correctly ######################################## ok{$retrieve->execute()}; ($read_value) = $retrieve->fetchrow_array(); cmp_ok($read_value, 'eq', $min, "retrieved minimal value for type $mysql_type, mode=$mode"); }; ######################################## # Try to insert over the limit value ######################################## ok($store->bind_param( 1, ($max+1)->bstr(), $perl_type ), "binding more than maximal $mysql_type, mode=$mode"); if ($mode eq 'strict') { $@ = ''; eval{$store->execute()}; like($@, qr/Out of range value (?:adjusted )?for column 'val'/, "Error, you stored ".($max+1)." into $mysql_type, mode=$mode\n". Data::Dumper->Dump([$dbh->selectall_arrayref("SELECT * FROM $table")]). Data::Dumper->Dump([$dbh->selectall_arrayref("describe $table")]) ); } else { ok{$store->execute()}; ######################################## # Check that it was rounded correctly ######################################## ok{$retrieve->execute()}; ($read_value) = $retrieve->fetchrow_array(); cmp_ok($read_value, 'eq', $max, "retrieved maximal value for type $mysql_type, mode=$mode"); }; } $dbh->disconnect; for my $mysql_server_prepare (0, 1) { $dbh= DBI->connect($test_dsn . ';mysql_server_prepare=' . $mysql_server_prepare, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); # Set strict SQL mode ok($dbh->do("SET SQL_MODE='STRICT_ALL_TABLES'"),"Enter strict SQL mode."); $mode = 'strict'; test_int_type(DBI::SQL_TINYINT, 'tinyint signed', -2**7, 2**7-1); test_int_type(DBI::SQL_TINYINT, 'tinyint unsigned', 0, 2**8-1); test_int_type(DBI::SQL_SMALLINT, 'smallint signed', -2**15, 2**15-1); test_int_type(DBI::SQL_SMALLINT, 'smallint unsigned', 0, 2**16-1); test_int_type(DBI::SQL_INTEGER, 'int signed', -2**31, 2**31-1); test_int_type(DBI::SQL_INTEGER, 'int unsigned', 0, 2**32-1); test_int_type(DBI::SQL_BIGINT, 'bigint signed', -2**63, 2**63-1); test_int_type(DBI::SQL_BIGINT, 'bigint unsigned', 0, 2**64-1); # Do not use strict SQL mode ok($dbh->do("SET SQL_MODE=''"),"Leave strict SQL mode."); $mode = 'nostrict'; test_int_type(DBI::SQL_TINYINT, 'tinyint signed', -2**7, 2**7-1); test_int_type(DBI::SQL_TINYINT, 'tinyint unsigned', 0, 2**8-1); test_int_type(DBI::SQL_SMALLINT, 'smallint signed', -2**15, 2**15-1); test_int_type(DBI::SQL_SMALLINT, 'smallint unsigned', 0, 2**16-1); test_int_type(DBI::SQL_INTEGER, 'int signed', -2**31, 2**31-1); test_int_type(DBI::SQL_INTEGER, 'int unsigned', 0, 2**32-1); test_int_type(DBI::SQL_BIGINT, 'bigint signed', -2**63, 2**63-1); test_int_type(DBI::SQL_BIGINT, 'bigint unsigned', 0, 2**64-1); ok ($dbh->do("DROP TABLE $table")); ok $dbh->disconnect; } DBD-mysql-4.054/t/manifest.t0000644000175000017500000000044214471320024016161 0ustar dvaneedendvaneedenBEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release testing'); } } use Test::More; eval 'use Test::DistManifest'; if ($@) { plan skip_all => 'Test::DistManifest required to test MANIFEST'; } manifest_ok(); DBD-mysql-4.054/t/40types.t0000644000175000017500000000667714640734223015713 0ustar dvaneedendvaneedenuse strict; use warnings; use B qw(svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV); use Test::More; use DBI; use DBI::Const::GetInfoType; use lib '.', 't'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 40; ok(defined $dbh, "Connected to database"); ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean"); ok($dbh->do(qq{CREATE TABLE t1 (num INT)}), "creating table"); ok($dbh->do(qq{INSERT INTO t1 VALUES (100)}), "loading data"); my ($val) = $dbh->selectrow_array("SELECT * FROM t1"); is($val, 100); my $sv = svref_2object(\$val); ok($sv->FLAGS & SVf_IOK, "scalar is integer"); ok(!($sv->FLAGS & (SVf_IVisUV|SVf_NOK|SVf_POK)), "scalar is not unsigned intger or double or string"); ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); ok($dbh->do(qq{CREATE TABLE t1 (num VARCHAR(10))}), "creating table"); ok($dbh->do(qq{INSERT INTO t1 VALUES ('string')}), "loading data"); ($val) = $dbh->selectrow_array("SELECT * FROM t1"); is($val, "string"); $sv = svref_2object(\$val); ok($sv->FLAGS & SVf_POK, "scalar is string"); ok(!($sv->FLAGS & (SVf_IOK|SVf_NOK)), "scalar is not intger or double"); ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); SKIP: { skip "New Data types not supported by server", 26 if !MinimumVersion($dbh, '5.0'); ok($dbh->do(qq{CREATE TABLE t1 (d DECIMAL(5,2))}), "creating table"); my $sth= $dbh->prepare("SELECT * FROM t1 WHERE 1 = 0"); ok($sth->execute(), "getting table information"); is_deeply($sth->{TYPE}, [ 3 ], "checking column type"); ok($sth->finish); ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); # # Bug #23936: bind_param() doesn't work with SQL_DOUBLE datatype # Bug #24256: Another failure in bind_param() with SQL_DOUBLE datatype # ok($dbh->do(qq{CREATE TABLE t1 (num DOUBLE)}), "creating table"); $sth= $dbh->prepare("INSERT INTO t1 VALUES (?)"); ok($sth->bind_param(1, 2.1, DBI::SQL_DOUBLE), "binding parameter"); ok($sth->execute(), "inserting data"); ok($sth->finish); ok($sth->bind_param(1, -1, DBI::SQL_DOUBLE), "binding parameter"); ok($sth->execute(), "inserting data"); ok($sth->finish); my $ret = $dbh->selectall_arrayref("SELECT * FROM t1"); is_deeply($ret, [ [2.1], [-1] ]); $sv = svref_2object(\$ret->[0]->[0]); ok($sv->FLAGS & SVf_NOK, "scalar is double"); ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string"); $sv = svref_2object(\$ret->[1]->[0]); ok($sv->FLAGS & SVf_NOK, "scalar is double"); ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string"); ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); # # [rt.cpan.org #19212] Mysql Unsigned Integer Fields # ok($dbh->do(qq{CREATE TABLE t1 (num INT UNSIGNED)}), "creating table"); ok($dbh->do(qq{INSERT INTO t1 VALUES (0),(4294967295)}), "loading data"); $ret = $dbh->selectall_arrayref("SELECT * FROM t1"); is_deeply($ret, [ [0], [4294967295] ]); $sv = svref_2object(\$ret->[0]->[0]); ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer"); ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string"); $sv = svref_2object(\$ret->[1]->[0]); ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer"); ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string"); ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); }; $dbh->disconnect(); DBD-mysql-4.054/t/31insertid.t0000644000175000017500000000446714471320024016353 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require "lib.pl"; my $dbh; eval{$dbh = DBI->connect($test_dsn, $test_user, $test_password, {RaiseError => 1});}; if ($@) { plan skip_all => "no database connection"; } plan tests => 21; SKIP: { skip 'SET @@auto_increment_offset needs MySQL >= 5.0.2', 2 unless $dbh->{mysql_serverversion} >= 50002; ok $dbh->do('SET @@auto_increment_offset = 1'); ok $dbh->do('SET @@auto_increment_increment = 1'); } my $create = <do($create), "create dbd_mysql_t31"; my $query= "INSERT INTO dbd_mysql_t31 (name) VALUES (?)"; my $sth; ok ($sth= $dbh->prepare($query)); ok defined $sth; ok $sth->execute("Jochen"); is $sth->{mysql_insertid}, 1, "insert id == $sth->{mysql_insertid}"; is $dbh->{mysql_insertid}, 1, "insert id == $dbh->{mysql_insertid}"; is $dbh->last_insert_id(undef, undef, undef, undef), 1, "insert id == last_insert_id()"; ok $sth->execute("Patrick"); $dbh->ping(); SKIP: { skip 'using libmysqlclient 5.7 or up we now have an empty dbh insertid', 1, if ($dbh->{mysql_clientversion} >= 50700 && $dbh->{mysql_clientversion} < 50718) || ($dbh->{mysql_clientversion} >= 60105 && $dbh->{mysql_clientversion} < 69999) || $dbh->{mysql_clientversion} == 80000; is $dbh->last_insert_id(undef, undef, undef, undef), 2, "insert id == last_insert_id()"; } ok (my $sth2= $dbh->prepare("SELECT max(id) FROM dbd_mysql_t31")); ok defined $sth2; ok $sth2->execute(); my $max_id; ok ($max_id= $sth2->fetch()); ok defined $max_id; SKIP: { skip 'using libmysqlclient 5.7 below 5.7.18 we now have an empty dbh insertid', 1, if ($dbh->{mysql_clientversion} >= 50700 && $dbh->{mysql_clientversion} < 50718) || ($dbh->{mysql_clientversion} >= 60105 && $dbh->{mysql_clientversion} < 69999) || $dbh->{mysql_clientversion} == 80000; cmp_ok $dbh->{mysql_insertid}, '==', $max_id->[0], "dbh insert id $dbh->{'mysql_insertid'} == max(id) $max_id->[0] in dbd_mysql_t31"; } cmp_ok $sth->{mysql_insertid}, '==', $max_id->[0], "sth insert id $sth->{'mysql_insertid'} == max(id) $max_id->[0] in dbd_mysql_t31"; ok $sth->finish(); ok $sth2->finish(); ok $dbh->disconnect(); DBD-mysql-4.054/t/52comment.t0000644000175000017500000000372214471320024016170 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use DBI::Const::GetInfoType; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval { $dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, } ); }; if ($@) { plan skip_all => plan skip_all => "no database connection"; } plan tests => 30; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t52comment"), "drop table if exists dbd_mysql_t52comment"; my $create= <<"EOTABLE"; create table dbd_mysql_t52comment ( id bigint unsigned not null default 0 ) EOTABLE ok $dbh->do($create), "creating table"; my $statement= "insert into dbd_mysql_t52comment (id) values (?)"; my $sth; ok $sth= $dbh->prepare($statement); my $rows; ok $rows= $sth->execute('1'); cmp_ok $rows, '==', 1; $sth->finish(); $statement= <selectrow_arrayref($statement, {}, 1); cmp_ok $retrow->[0], '==', 1; $statement= "SELECT id FROM dbd_mysql_t52comment /* it's a bug? */ WHERE id = ?"; $retrow= $dbh->selectrow_arrayref($statement, {}, 1); cmp_ok $retrow->[0], '==', 1; $statement= "SELECT id FROM dbd_mysql_t52comment WHERE id = ? /* it's a bug? */"; $retrow= $dbh->selectrow_arrayref($statement, {}, 1); cmp_ok $retrow->[0], '==', 1; $statement= "SELECT id FROM dbd_mysql_t52comment WHERE id = ? "; my $comment = "/* it's/a_directory/does\ this\ work/bug? */"; for (0 .. 9) { $retrow= $dbh->selectrow_arrayref($statement . $comment, {}, 1); cmp_ok $retrow->[0], '==', 1; } $comment = "/* $0 */"; for (0 .. 9) { $retrow= $dbh->selectrow_arrayref($statement . $comment, {}, 1); cmp_ok $retrow->[0], '==', 1; } ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t52comment"), "drop table if exists dbd_mysql_t52comment"; ok $dbh->disconnect; DBD-mysql-4.054/t/99_bug_server_prepare_blob_null.t0000644000175000017500000000260114471320024022604 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use vars qw($COL_NULLABLE $COL_KEY); use lib 't', '.'; require 'lib.pl'; my $dbh; $test_dsn .= ';mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1'; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } # # DROP/CREATE PROCEDURE will give syntax error for these versions # if (!MinimumVersion($dbh, '5.0')) { plan skip_all => "SKIP TEST: You must have MySQL version 5.0 and greater for this test to run"; } plan tests => 11; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t99_prepare"); my $create =<do($create); $dbh->do("insert into dbd_mysql_t99_prepare (data) values(null)"); my $sth = $dbh->prepare("select data from dbd_mysql_t99_prepare"); ok $sth->execute; my $row = $sth->fetch; is $row->[0] => undef; ok $sth->finish; $dbh->do("insert into dbd_mysql_t99_prepare (data) values('a')"); $sth = $dbh->prepare("select data from dbd_mysql_t99_prepare"); ok $sth->execute; $row = $sth->fetch; is $row->[0] => undef; $row = $sth->fetch; is $row->[0] => 'a'; ok $sth->finish; ok $dbh->do("DROP TABLE dbd_mysql_t99_prepare"); ok $dbh->disconnect; DBD-mysql-4.054/t/lib.pl0000644000175000017500000000762314471320024015301 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI::Const::GetInfoType; use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password); $| = 1; # flush stdout asap to keep in sync with stderr # # Driver names; EDIT THIS! # $mdriver = 'mysql'; $dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver. # The exception is DBD::pNET where we have to # to separate between local driver (pNET) and # the remote driver ($dbdriver) # # DSN being used; do not edit this, edit "$dbdriver.dbtest" instead # $::COL_NULLABLE = 1; $::COL_KEY = 2; my $file; if (-f ($file = "t/$dbdriver.dbtest") || -f ($file = "$dbdriver.dbtest") || -f ($file = "../tests/$dbdriver.dbtest") || -f ($file = "tests/$dbdriver.dbtest")) { eval { require $file; }; if ($@) { print STDERR "Cannot execute $file: $@.\n"; print "1..0\n"; exit 0; } $::test_dsn = $::test_dsn || $ENV{'DBI_DSN'} || 'DBI:mysql:database=test'; $::test_user = $::test_user|| $ENV{'DBI_USER'} || ''; $::test_password = $::test_password || $ENV{'DBI_PASS'} || ''; } if (-f ($file = "t/$mdriver.mtest") || -f ($file = "$mdriver.mtest") || -f ($file = "../tests/$mdriver.mtest") || -f ($file = "tests/$mdriver.mtest")) { eval { require $file; }; if ($@) { print STDERR "Cannot execute $file: $@.\n"; print "1..0\n"; exit 0; } } sub DbiTestConnect { return (eval { DBI->connect(@_) } or do { my $err; if ( $@ ) { $err = $@; $err =~ s/ at \S+ line \d+\s*$//; } if ( not $err ) { $err = $DBI::errstr; $err = "unknown error" unless $err; my $user = $_[1]; my $dsn = $_[0]; $dsn =~ s/^DBI:mysql://; $err = "DBI connect('$dsn','$user',...) failed: $err"; } if ( $ENV{CONNECTION_TESTING} ) { BAIL_OUT "no database connection: $err"; } else { plan skip_all => "no database connection: $err"; } }); } # # Print a DBI error message # # TODO - This is on the chopping block sub DbiError ($$) { my ($rc, $err) = @_; $rc ||= 0; $err ||= ''; $::numTests ||= 0; print "Test $::numTests: DBI error $rc, $err\n"; } sub connection_id { my $dbh = shift; return 0 unless $dbh; # Paul DuBois says the following is more reliable than # $dbh->{'mysql_thread_id'}; my @row = $dbh->selectrow_array("SELECT CONNECTION_ID()"); return $row[0]; } # nice function I saw in DBD::Pg test code sub byte_string { my $ret = join( "|" ,unpack( "C*" ,$_[0] ) ); return $ret; } sub SQL_VARCHAR { 12 }; sub SQL_INTEGER { 4 }; =item CheckRoutinePerms() Check if the current user of the DBH has permissions to create/drop procedures if (!CheckRoutinePerms($dbh)) { plan skip_all => "Your test user does not have ALTER_ROUTINE privileges."; } =cut sub CheckRoutinePerms { my $dbh = shift @_; # check for necessary privs local $dbh->{PrintError} = 0; eval { $dbh->do('DROP PROCEDURE IF EXISTS testproc') }; return if $@ =~ qr/alter routine command denied to user/; return 1; }; =item MinimumVersion() Check to see if the database where the test run against is of a certain minimum version if (!MinimumVersion($dbh, '5.0')) { plan skip_all => "You must have MySQL version 5.0 and greater for this test to run"; } =cut sub MinimumVersion { my $dbh = shift @_; my $version = shift @_; my ($major, $minor) = split (/\./, $version); if ( $dbh->get_info($GetInfoType{SQL_DBMS_VER}) =~ /(^\d+)\.(\d+)\./ ) { # major version higher than requested return 1 if $1 > $major; # major version too low return if $1 < $major; # check minor version return 1 if $2 >= $minor; } return; } 1; DBD-mysql-4.054/t/85init_command.t0000644000175000017500000000136014471320024017171 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; $|= 1; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, mysql_init_command => 'SET SESSION wait_timeout=7' });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 5; ok(defined $dbh, "Connected to database"); ok(my $sth=$dbh->prepare("SHOW SESSION VARIABLES like 'wait_timeout'")); ok($sth->execute()); ok(my @fetchrow = $sth->fetchrow_array()); is($fetchrow[1],'7','session variable is 7'); $sth->finish(); $dbh->disconnect(); DBD-mysql-4.054/t/16dbi-get_info.t0000644000175000017500000000241414471320024017051 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; $|= 1; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } # DBI documentation states: # Because some DBI methods make use of get_info(), drivers are strongly # encouraged to support at least the following very minimal set of # information types to ensure the DBI itself works properly # so let's test them here # DBMS_NAME and DBMS_VERSION are not static, all we can check is they are # there and they have some sane length my $dbms_name = $dbh->get_info( $GetInfoType{SQL_DBMS_NAME}); cmp_ok(length($dbms_name), '>', 4, 'SQL_DBMS_NAME'); my $dbms_ver = $dbh->get_info( $GetInfoType{SQL_DBMS_VER}); cmp_ok(length($dbms_ver), '>', 4, 'SQL_DBMS_VER'); # these variables are always the same for MySQL my %info = ( SQL_IDENTIFIER_QUOTE_CHAR => '`', SQL_CATALOG_NAME_SEPARATOR => '.', SQL_CATALOG_LOCATION => 1, ); for my $option ( keys %info ) { my $value = $dbh->get_info( $GetInfoType{$option}); is($value, $info{$option}, $option); } $dbh->disconnect(); done_testing; DBD-mysql-4.054/t/87async.t0000644000175000017500000001413014471320024015646 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::Deep; use Test::More; use DBI; use DBI::Const::GetInfoType; use Time::HiRes; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; if (!$dbh) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} < 50012) { plan skip_all => "Servers < 5.0.12 do not support SLEEP()"; } plan tests => 92; is $dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'}), 2; # statement-level async is $dbh->get_info($GetInfoType{'SQL_MAX_ASYNC_CONCURRENT_STATEMENTS'}), 1; $dbh->do(<mysql_fd; ok !defined($dbh->mysql_async_ready); my ( $start, $end ); my $rows; my $sth; my ( $a, $b, $c ); $start = Time::HiRes::gettimeofday(); $rows = $dbh->do('INSERT INTO async_test VALUES (SLEEP(2), 0, 0)'); $end = Time::HiRes::gettimeofday(); is $rows, 1; ok(($end - $start) >= 2); $start = Time::HiRes::gettimeofday(); $rows = $dbh->do('INSERT INTO async_test VALUES (SLEEP(2), 0, 0)', { async => 1 }); ok(defined($dbh->mysql_async_ready)) or die; $end = Time::HiRes::gettimeofday(); ok $rows; is $rows, '0E0'; ok(($end - $start) < 2); sleep 1 until $dbh->mysql_async_ready; $end = Time::HiRes::gettimeofday(); ok(($end - $start) >= 2); $rows = $dbh->mysql_async_result; ok !defined($dbh->mysql_async_ready); is $rows, 1; ( $rows ) = $dbh->selectrow_array('SELECT COUNT(1) FROM async_test'); is $rows, 2; $dbh->do('DELETE FROM async_test'); $start = Time::HiRes::gettimeofday(); $rows = $dbh->do('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', { async => 1 }, 1, 2); $end = Time::HiRes::gettimeofday(); ok $rows; is $rows, '0E0'; ok(($end - $start) < 2); sleep 1 until $dbh->mysql_async_ready; $end = Time::HiRes::gettimeofday(); ok(($end - $start) >= 2); $rows = $dbh->mysql_async_result; is $rows, 1; ( $a, $b, $c ) = $dbh->selectrow_array('SELECT * FROM async_test'); is $a, 0; is $b, 1; is $c, 2; $sth = $dbh->prepare('SELECT SLEEP(2)'); ok !defined($sth->mysql_async_ready); $start = Time::HiRes::gettimeofday(); ok $sth->execute; $end = Time::HiRes::gettimeofday(); ok(($end - $start) >= 2); $sth = $dbh->prepare('SELECT SLEEP(2)', { async => 1 }); ok !defined($sth->mysql_async_ready); $start = Time::HiRes::gettimeofday(); ok $sth->execute; ok defined($sth->mysql_async_ready); $end = Time::HiRes::gettimeofday(); ok(($end - $start) < 2); sleep 1 until $sth->mysql_async_ready; my $row = $sth->fetch; $end = Time::HiRes::gettimeofday(); ok $row; is $row->[0], 0; ok(($end - $start) >= 2); $rows = $dbh->do('INSERT INTO async_test VALUES(SLEEP(2), ?, ?', { async => 1 }, 1, 2); ok $rows; ok !$dbh->errstr; $rows = $dbh->mysql_async_result; ok !$rows; ok $dbh->errstr; $dbh->do('DELETE FROM async_test'); $sth = $dbh->prepare('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', { async => 1 }); $start = Time::HiRes::gettimeofday(); $rows = $sth->execute(1, 2); $end = Time::HiRes::gettimeofday(); ok(($end - $start) < 2); ok $rows; is $rows, '0E0'; $rows = $sth->mysql_async_result; $end = Time::HiRes::gettimeofday(); ok(($end - $start) >= 2); is $rows, 1; ( $a, $b, $c ) = $dbh->selectrow_array('SELECT * FROM async_test'); is $a, 0; is $b, 1; is $c, 2; $sth = $dbh->prepare('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', { async => 1 }); $rows = $dbh->do('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', undef, 1, 2); is $rows, 1; $start = Time::HiRes::gettimeofday(); $dbh->selectrow_array('SELECT SLEEP(2)', { async => 1 }); $end = Time::HiRes::gettimeofday(); ok(($end - $start) >= 2); ok !defined($dbh->mysql_async_result); ok !defined($dbh->mysql_async_ready); $rows = $dbh->do('UPDATE async_test SET value0 = 0 WHERE value0 = 999', { async => 1 }); ok $rows; is $rows, '0E0'; $rows = $dbh->mysql_async_result; ok $rows; is $rows, '0E0'; $sth = $dbh->prepare('UPDATE async_test SET value0 = 0 WHERE value0 = 999', { async => 1 }); $rows = $sth->execute; ok $rows; is $rows, '0E0'; $rows = $sth->mysql_async_result; ok $rows; is $rows, '0E0'; $sth->execute; $rows = $dbh->do('INSERT INTO async_test VALUES(1, 2, 3)'); ok !$rows; undef $sth; $rows = $dbh->do('INSERT INTO async_test VALUES(1, 2, 3)'); is $rows, 1; $sth = $dbh->prepare('SELECT 1, value0, value1, value2 FROM async_test WHERE value0 = ?', { async => 1 }); $sth->execute(1); is $sth->{'NUM_OF_FIELDS'}, undef; is $sth->{'NUM_OF_PARAMS'}, 1; is $sth->{'NAME'}, undef; is $sth->{'NAME_lc'}, undef; is $sth->{'NAME_uc'}, undef; is $sth->{'NAME_hash'}, undef; is $sth->{'NAME_lc_hash'}, undef; is $sth->{'NAME_uc_hash'}, undef; is $sth->{'TYPE'}, undef; is $sth->{'PRECISION'}, undef; is $sth->{'SCALE'}, undef; is $sth->{'NULLABLE'}, undef; is $sth->{'Database'}, $dbh; is $sth->{'Statement'}, 'SELECT 1, value0, value1, value2 FROM async_test WHERE value0 = ?'; $sth->mysql_async_result; is $sth->{'NUM_OF_FIELDS'}, 4; is $sth->{'NUM_OF_PARAMS'}, 1; cmp_bag $sth->{'NAME'}, [qw/1 value0 value1 value2/]; cmp_bag $sth->{'NAME_lc'}, [qw/1 value0 value1 value2/]; cmp_bag $sth->{'NAME_uc'}, [qw/1 VALUE0 VALUE1 VALUE2/]; cmp_bag [ keys %{$sth->{'NAME_hash'}} ], [qw/1 value0 value1 value2/]; cmp_bag [ keys %{$sth->{'NAME_lc_hash'}} ], [qw/1 value0 value1 value2/]; cmp_bag [ keys %{$sth->{'NAME_uc_hash'}} ], [qw/1 VALUE0 VALUE1 VALUE2/]; is ref($sth->{'TYPE'}), 'ARRAY'; is ref($sth->{'PRECISION'}), 'ARRAY'; is ref($sth->{'SCALE'}), 'ARRAY'; is ref($sth->{'NULLABLE'}), 'ARRAY'; is $sth->{'Database'}, $dbh; is $sth->{'Statement'}, 'SELECT 1, value0, value1, value2 FROM async_test WHERE value0 = ?'; $sth->finish; $sth->execute(1); $row = $sth->fetch; is_deeply $row, [1, 1, 2, 3]; $sth->finish; $sth->execute(1); $row = $sth->fetchrow_arrayref; is_deeply $row, [1, 1, 2, 3]; $sth->finish; $sth->execute(1); my @row = $sth->fetchrow_array; is_deeply \@row, [1, 1, 2, 3]; $sth->finish; $sth->execute(1); $row = $sth->fetchrow_hashref; cmp_bag [ keys %$row ], [qw/1 value0 value1 value2/]; cmp_bag [ values %$row ], [1, 1, 2, 3]; $sth->finish; undef $sth; ok $dbh->disconnect; DBD-mysql-4.054/t/40bindparam.t0000644000175000017500000000557714471320024016472 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; if ($@) { plan skip_all => "no database connection"; } if (!MinimumVersion($dbh, '4.1')) { plan skip_all => "SKIP TEST: You must have MySQL version 4.1 and greater for this test to run"; } plan tests => 41; ok ($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40bindparam")); my $create = <do($create)); ok (my $sth = $dbh->prepare("INSERT INTO dbd_mysql_t40bindparam VALUES (?, ?)")); # Automatic type detection my $numericVal = 1; my $charVal = "Alligator Descartes"; ok ($sth->execute($numericVal, $charVal)); # Does the driver remember the automatically detected type? ok ($sth->execute("3", "Jochen Wiedmann")); $numericVal = 2; $charVal = "Tim Bunce"; ok ($sth->execute($numericVal, $charVal)); # Now try the explicit type settings ok ($sth->bind_param(1, " 4", SQL_INTEGER())); # umlaut equivalent is vowel followed by 'e' ok ($sth->bind_param(2, 'Andreas Koenig')); ok ($sth->execute); # Works undef -> NULL? ok ($sth->bind_param(1, 5, SQL_INTEGER())); ok ($sth->bind_param(2, undef)); ok ($sth->execute); ok ($sth->bind_param(1, undef, SQL_INTEGER())); ok ($sth->bind_param(2, undef)); ok ($sth->execute(-1, "abc")); ok ($dbh->do("INSERT INTO dbd_mysql_t40bindparam VALUES (6, '?')")); ok ($dbh->do('SET @old_sql_mode = @@sql_mode, @@sql_mode = \'\'')); ok ($dbh->do("INSERT INTO dbd_mysql_t40bindparam VALUES (7, \"?\")")); ok ($dbh->do('SET @@sql_mode = @old_sql_mode')); ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40bindparam ORDER BY id")); ok($sth->execute); my ($id, $name); ok ($sth->bind_columns(undef, \$id, \$name)); my $ref = $sth->fetch ; is $id, -1, 'id set to -1'; cmp_ok $name, 'eq', 'abc', 'name eq abc'; $ref = $sth->fetch; is $id, 1, 'id set to 1'; cmp_ok $name, 'eq', 'Alligator Descartes', '$name set to Alligator Descartes'; $ref = $sth->fetch; is $id, 2, 'id set to 2'; cmp_ok $name, 'eq', 'Tim Bunce', '$name set to Tim Bunce'; $ref = $sth->fetch; is $id, 3, 'id set to 3'; cmp_ok $name, 'eq', 'Jochen Wiedmann', '$name set to Jochen Wiedmann'; $ref = $sth->fetch; is $id, 4, 'id set to 4'; cmp_ok $name, 'eq', 'Andreas Koenig', '$name set to Andreas Koenig'; $ref = $sth->fetch; is $id, 5, 'id set to 5'; ok !defined($name), 'name not defined'; $ref = $sth->fetch; is $id, 6, 'id set to 6'; cmp_ok $name, 'eq', '?', "\$name set to '?'"; $ref = $sth->fetch; is $id, 7, '$id set to 7'; cmp_ok $name, 'eq', '?', "\$name set to '?'"; ok ($dbh->do("DROP TABLE dbd_mysql_t40bindparam")); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.054/t/41blobs_prepare.t0000644000175000017500000000405514471320024017343 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; my $update_blob; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } 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 = ""; } note sprintf("%08lx %s\n", $i*32, unpack("H64", $b)); } } my $create = <do("DROP TABLE IF EXISTS dbd_mysql_41blobs_prepare"), "drop table if exists dbd_mysql_41blobs_prepare"; ok $dbh->do($create), "create table dbd_mysql_41blobs_prepare"; my $query = "INSERT INTO dbd_mysql_41blobs_prepare 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 dbd_mysql_41blobs_prepare WHERE id = 1")); ok $sth->execute, "select from dbd_mysql_41blobs_prepare"; ok (my $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 dbd_mysql_41blobs_prepare SET name = ? WHERE id = 1")); ok $sth->execute($blob2), 'inserting $blob2'; ok ($sth->finish); ok ($sth= $dbh->prepare("SELECT * FROM dbd_mysql_41blobs_prepare 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 dbd_mysql_41blobs_prepare"), "drop dbd_mysql_41blobs_prepare"; ok $dbh->disconnect; DBD-mysql-4.054/t/40nulls_prepare.t0000644000175000017500000000475214471320024017402 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; my ($row, $sth, $dbh); my ($table, $def, $rows, $errstr, $ret_ref); use vars qw($table $test_dsn $test_user $test_password); eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1});}; if ($@) { plan skip_all => "no database connection", } ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40nullsprepare"), "Making slate clean"); my $create= <do($create), "creating test table for bug 49719"); my ($sth_insert, $sth_lookup); my $insert= 'INSERT INTO dbd_mysql_t40nullsprepare (id, value0, value1, value2) VALUES (?, ?, ?, ?)'; ok($sth_insert= $dbh->prepare($insert), "Prepare of insert"); my $select= "SELECT * FROM dbd_mysql_t40nullsprepare WHERE id = ?"; ok($sth_lookup= $dbh->prepare($select), "Prepare of query"); # Insert null value ok($sth_insert->bind_param(1, 42, DBI::SQL_WVARCHAR), "bind_param(1,42, SQL_WARCHAR)"); ok($sth_insert->bind_param(2, 102, DBI::SQL_WVARCHAR), "bind_param(2,102,SQL_WARCHAR"); ok($sth_insert->bind_param(3, undef, DBI::SQL_WVARCHAR), "bind_param(3, undef,SQL_WVARCHAR)"); ok($sth_insert->bind_param(4, 10004, DBI::SQL_WVARCHAR), "bind_param(4, 10004,SQL_WVARCHAR)"); ok($sth_insert->execute(), "Executing the first insert"); # Insert afterwards none null value # The bug would insert (DBD::MySQL-4.012) corrupted data.... # incorrect use of MYSQL_TYPE_NULL in prepared statement in dbdimp.c ok($sth_insert->bind_param(1, 43, DBI::SQL_WVARCHAR),"bind_param(1,43,SQL_WVARCHAR)"); ok($sth_insert->bind_param(2, 2002, DBI::SQL_WVARCHAR),"bind_param(2,2002,SQL_WVARCHAR)"); ok($sth_insert->bind_param(3, 20003, DBI::SQL_WVARCHAR),"bind_param(3,20003,SQL_WVARCHAR)"); ok($sth_insert->bind_param(4, 200004, DBI::SQL_WVARCHAR),"bind_param(4,200004,SQL_WVARCHAR)"); ok($sth_insert->execute(), "Executing the 2nd insert"); # verify ok($sth_lookup->execute(42), "Query for record of id = 42"); is_deeply($sth_lookup->fetchrow_arrayref(), [42, 102, undef, 10004]); ok($sth_lookup->execute(43), "Query for record of id = 43"); is_deeply($sth_lookup->fetchrow_arrayref(), [43, 2002, 20003, 200004]); ok($sth_insert->finish()); ok($sth_lookup->finish()); ok $dbh->do("DROP TABLE dbd_mysql_t40nullsprepare"); ok($dbh->disconnect(), "Testing disconnect"); done_testing; DBD-mysql-4.054/t/40catalog.t0000644000175000017500000002442414471320024016137 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib '.', 't'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1, mysql_server_prepare => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 78; ok(defined $dbh, "connecting"); my $sth; # # Bug #26604: foreign_key_info() implementation # # The tests for this are adapted from the Connector/J test suite. # SKIP: { skip "Server is too old to support INFORMATION_SCHEMA for foreign keys", 16 if !MinimumVersion($dbh, '5.0'); my $have_innodb = 0; if (!MinimumVersion($dbh, '5.6')) { my $dummy; ($dummy,$have_innodb)= $dbh->selectrow_array("SHOW VARIABLES LIKE 'have_innodb'") or DbiError($dbh->err, $dbh->errstr); } else { my $engines = $dbh->selectall_arrayref('SHOW ENGINES'); if (!$engines) { DbiError($dbh->err, $dbh->errstr); } else { STORAGE_ENGINE: for my $engine (@$engines) { next STORAGE_ENGINE if lc $engine->[0] ne 'innodb'; next STORAGE_ENGINE if lc $engine->[1] eq 'no'; $have_innodb = 1; } } } skip "Server doesn't support InnoDB, needed for testing foreign keys", 16 if !$have_innodb; ok($dbh->do(qq{DROP TABLE IF EXISTS child, parent}), "cleaning up"); ok($dbh->do(qq{CREATE TABLE parent(id INT NOT NULL, PRIMARY KEY (id)) ENGINE=INNODB})); ok($dbh->do(qq{CREATE TABLE child(id INT, parent_id INT, FOREIGN KEY (parent_id) REFERENCES parent(id) ON DELETE SET NULL) ENGINE=INNODB})); $sth= $dbh->foreign_key_info(undef, undef, 'parent', undef, undef, 'child'); my ($info)= $sth->fetchall_arrayref({}); is($info->[0]->{PKTABLE_NAME}, "parent"); is($info->[0]->{PKCOLUMN_NAME}, "id"); is($info->[0]->{FKTABLE_NAME}, "child"); is($info->[0]->{FKCOLUMN_NAME}, "parent_id"); $sth= $dbh->foreign_key_info(undef, undef, 'parent', undef, undef, undef); ($info)= $sth->fetchall_arrayref({}); is($info->[0]->{PKTABLE_NAME}, "parent"); is($info->[0]->{PKCOLUMN_NAME}, "id"); is($info->[0]->{FKTABLE_NAME}, "child"); is($info->[0]->{FKCOLUMN_NAME}, "parent_id"); $sth= $dbh->foreign_key_info(undef, undef, undef, undef, undef, 'child'); ($info)= $sth->fetchall_arrayref({}); is($info->[0]->{PKTABLE_NAME}, "parent"); is($info->[0]->{PKCOLUMN_NAME}, "id"); is($info->[0]->{FKTABLE_NAME}, "child"); is($info->[0]->{FKCOLUMN_NAME}, "parent_id"); ok($dbh->do(qq{DROP TABLE IF EXISTS child, parent}), "cleaning up"); }; # # table_info() tests # # These tests assume that no other tables name like 't_dbd_mysql_%' exist on # the server we are using for testing. # SKIP: { skip "Server can't handle tricky table names", 33 if !MinimumVersion($dbh, '4.1'); my $sth = $dbh->table_info("%", undef, undef, undef); is(scalar @{$sth->fetchall_arrayref()}, 0, "No catalogs expected"); $sth = $dbh->table_info(undef, "%", undef, undef); ok(scalar @{$sth->fetchall_arrayref()} > 0, "Some schemas expected"); $sth = $dbh->table_info(undef, undef, undef, "%"); ok(scalar @{$sth->fetchall_arrayref()} > 0, "Some table types expected"); ok($dbh->do(qq{DROP TABLE IF EXISTS t_dbd_mysql_t1, t_dbd_mysql_t11, t_dbd_mysql_t2, t_dbd_mysqlat2, `t_dbd_mysql_a'b`, `t_dbd_mysql_a``b`}), "cleaning up"); ok($dbh->do(qq{CREATE TABLE t_dbd_mysql_t1 (a INT)}) and $dbh->do(qq{CREATE TABLE t_dbd_mysql_t11 (a INT)}) and $dbh->do(qq{CREATE TABLE t_dbd_mysql_t2 (a INT)}) and $dbh->do(qq{CREATE TABLE t_dbd_mysqlat2 (a INT)}) and $dbh->do(qq{CREATE TABLE `t_dbd_mysql_a'b` (a INT)}) and $dbh->do(qq{CREATE TABLE `t_dbd_mysql_a``b` (a INT)}), "creating test tables"); # $base is our base table name, with the _ escaped to avoid extra matches my $esc = $dbh->get_info(14); # SQL_SEARCH_PATTERN_ESCAPE (my $base = "t_dbd_mysql_") =~ s/([_%])/$esc$1/g; # Test fetching info on a single table $sth = $dbh->table_info(undef, undef, $base . "t1", undef); my $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_CAT}, undef); is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_t1"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is(scalar @$info, 1, "one row expected"); # Test fetching info on a wildcard $sth = $dbh->table_info(undef, undef, $base . "t1%", undef); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_CAT}, undef); is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_t1"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is($info->[1]->{TABLE_CAT}, undef); is($info->[1]->{TABLE_NAME}, "t_dbd_mysql_t11"); is($info->[1]->{TABLE_TYPE}, "TABLE"); is(scalar @$info, 2, "two rows expected"); # Test fetching info on a single table with escaped wildcards $sth = $dbh->table_info(undef, undef, $base . "t2", undef); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_CAT}, undef); is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_t2"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is(scalar @$info, 1, "only one table expected"); # Test fetching info on a single table with ` in name $sth = $dbh->table_info(undef, undef, $base . "a`b", undef); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_CAT}, undef); is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_a`b"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is(scalar @$info, 1, "only one table expected"); # Test fetching info on a single table with ' in name $sth = $dbh->table_info(undef, undef, $base . "a'b", undef); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_CAT}, undef); is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_a'b"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is(scalar @$info, 1, "only one table expected"); # Test fetching our tables with a wildcard schema # NOTE: the performance of this could be bad if the mysql user we # are connecting as can see lots of databases. $sth = $dbh->table_info(undef, "%", $base . "%", undef); $info = $sth->fetchall_arrayref({}); is(scalar @$info, 5, "five tables expected"); # Check that tables() finds and escapes the tables named with quotes $info = [ $dbh->tables(undef, undef, $base . 'a%') ]; like($info->[0], qr/\.`t_dbd_mysql_a'b`$/, "table with single quote"); like($info->[1], qr/\.`t_dbd_mysql_a``b`$/, "table with back quote"); is(scalar @$info, 2, "two tables expected"); # Clean up ok($dbh->do(qq{DROP TABLE IF EXISTS t_dbd_mysql_t1, t_dbd_mysql_t11, t_dbd_mysql_t2, t_dbd_mysqlat2, `t_dbd_mysql_a'b`, `t_dbd_mysql_a``b`}), "cleaning up"); }; # # view-related table_info tests # SKIP: { skip "Server is too old to support views", 19 if !MinimumVersion($dbh, '5.0'); # # Bug #26603: (one part) support views in table_info() # ok($dbh->do(qq{DROP VIEW IF EXISTS bug26603_v1}) and $dbh->do(qq{DROP TABLE IF EXISTS bug26603_t1}), "cleaning up"); ok($dbh->do(qq{CREATE TABLE bug26603_t1 (a INT)}) and $dbh->do(qq{CREATE VIEW bug26603_v1 AS SELECT * FROM bug26603_t1}), "creating resources"); # Try without any table type specified $sth = $dbh->table_info(undef, undef, "bug26603%"); my $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_NAME}, "bug26603_t1"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is($info->[1]->{TABLE_NAME}, "bug26603_v1"); is($info->[1]->{TABLE_TYPE}, "VIEW"); is(scalar @$info, 2, "two rows expected"); # Just get the view $sth = $dbh->table_info(undef, undef, "bug26603%", "VIEW"); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_NAME}, "bug26603_v1"); is($info->[0]->{TABLE_TYPE}, "VIEW"); is(scalar @$info, 1, "one row expected"); # Just get the table $sth = $dbh->table_info(undef, undef, "bug26603%", "TABLE"); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_NAME}, "bug26603_t1"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is(scalar @$info, 1, "one row expected"); # Get both tables and views $sth = $dbh->table_info(undef, undef, "bug26603%", "'TABLE','VIEW'"); $info = $sth->fetchall_arrayref({}); is($info->[0]->{TABLE_NAME}, "bug26603_t1"); is($info->[0]->{TABLE_TYPE}, "TABLE"); is($info->[1]->{TABLE_NAME}, "bug26603_v1"); is($info->[1]->{TABLE_TYPE}, "VIEW"); is(scalar @$info, 2, "two rows expected"); ok($dbh->do(qq{DROP VIEW IF EXISTS bug26603_v1}) and $dbh->do(qq{DROP TABLE IF EXISTS bug26603_t1}), "cleaning up"); }; # # column_info() tests # SKIP: { ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "cleaning up"); ok($dbh->do(qq{CREATE TABLE t1 (a INT PRIMARY KEY AUTO_INCREMENT, b INT, `a_` INT, `a'b` INT, bar INT )}), "creating table"); # # Bug #26603: (one part) add mysql_is_autoincrement # $sth= $dbh->column_info(undef, undef, "t1", 'a'); my ($info)= $sth->fetchall_arrayref({}); is($info->[0]->{mysql_is_auto_increment}, 1); $sth= $dbh->column_info(undef, undef, "t1", 'b'); ($info)= $sth->fetchall_arrayref({}); is($info->[0]->{mysql_is_auto_increment}, 0); # # Test that wildcards and odd names are handled correctly # $sth= $dbh->column_info(undef, undef, "t1", "a%"); ($info)= $sth->fetchall_arrayref({}); is(scalar @$info, 3); $sth= $dbh->column_info(undef, undef, "t1", "a" . $dbh->get_info(14) . "_"); ($info)= $sth->fetchall_arrayref({}); is(scalar @$info, 1); $sth= $dbh->column_info(undef, undef, "t1", "a'b"); ($info)= $sth->fetchall_arrayref({}); is(scalar @$info, 1); # # The result set is ordered by TABLE_CAT, TABLE_SCHEM, TABLE_NAME and ORDINAL_POSITION. # $sth= $dbh->column_info(undef, undef, "t1", undef); ($info)= $sth->fetchall_arrayref({}); is(join(' ++ ', map { $_->{COLUMN_NAME} } @{$info}), "a ++ b ++ a_ ++ a'b ++ bar"); ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "cleaning up"); $dbh->disconnect(); }; $dbh->disconnect(); DBD-mysql-4.054/t/mysql.dbtest0000644000175000017500000000300715043617710016551 0ustar dvaneedendvaneedenuse strict; use warnings; # database specific definitions for a 'mysql' database my $have_transactions; # # This function generates a list of tables associated to a # given DSN. # sub ListTables(@) { my($dbh) = shift; my(@tables); @tables = $dbh->func('_ListTables'); if ($dbh->errstr) { die "Cannot create table list: " . $dbh->errstr; } @tables; } # # This function is called by DBD::pNET; given a hostname and a # dsn without hostname, return a dsn for connecting to dsn at # host. sub HostDsn ($$) { my($hostname, $dsn) = @_; "$dsn:$hostname"; } # # Return TRUE, if database supports transactions # sub have_transactions () { my ($dbh) = @_; return 1 unless $dbh; if (!defined($have_transactions)) { $have_transactions = ""; my $sth = $dbh->prepare("SHOW VARIABLES"); $sth->execute(); while (my $row = $sth->fetchrow_hashref()) { if ($row->{'Variable_name'} eq 'have_bdb' && $row->{'Value'} eq 'YES') { $have_transactions = "bdb"; last; } if ($row->{'Variable_name'} eq 'have_innodb' && $row->{'Value'} eq 'YES') { $have_transactions = "innodb"; last; } if ($row->{'Variable_name'} eq 'have_gemini' && $row->{'Value'} eq 'YES') { $have_transactions = "gemini"; last; } } } return $have_transactions; } 1; DBD-mysql-4.054/t/20createdrop.t0000644000175000017500000000135114471320024016645 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; $|= 1; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 4; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t20createdrop"), "making slate clean"); ok($dbh->do("CREATE TABLE dbd_mysql_t20createdrop (id INT(4), name VARCHAR(64))"), "creating dbd_mysql_t20createdrop"); ok($dbh->do("DROP TABLE dbd_mysql_t20createdrop"), "dropping created dbd_mysql_t20createdrop"); $dbh->disconnect(); DBD-mysql-4.054/t/65types.t0000644000175000017500000000247414471320024015701 0ustar dvaneedendvaneedenuse strict; use warnings; use vars qw($test_dsn $test_user $test_password); use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 19; ok $dbh->do("drop table if exists dbd_mysql_65types"); my $create= <do($create); my $sth; eval {$sth= $dbh->prepare("insert into dbd_mysql_65types values (?)")}; ok ! $@, "prepare: $@"; ok $sth->bind_param(1,10000,DBI::SQL_INTEGER); ok $sth->execute(); ok $sth->bind_param(1,10001,DBI::SQL_INTEGER); ok $sth->execute(); ok $dbh->do("DROP TABLE dbd_mysql_65types"); ok $dbh->do("create table dbd_mysql_65types (a int, b double, primary key (a))"); eval { $sth= $dbh->prepare("insert into dbd_mysql_65types values (?, ?)")}; ok ! $@, "prepare: $@"; ok $sth->bind_param(1,"10000 ",DBI::SQL_INTEGER); ok $sth->bind_param(2,"1.22 ",DBI::SQL_DOUBLE); ok $sth->execute(); ok $sth->bind_param(1,10001,DBI::SQL_INTEGER); ok $sth->bind_param(2,.3333333,DBI::SQL_DOUBLE); ok $sth->execute(); ok $sth->finish; ok $dbh->do("DROP TABLE dbd_mysql_65types"); ok $dbh->disconnect; DBD-mysql-4.054/t/76multi_statement.t0000644000175000017500000000555214471320024017755 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, mysql_multi_statements => 1 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 26; ok (defined $dbh, "Connected to database with multi statement support"); $dbh->{mysql_server_prepare}= 0; SKIP: { skip "Server doesn't support multi statements", 25 if $dbh->{mysql_clientversion} < 40101 or $dbh->{mysql_serverversion} < 40101; skip "Server has deadlock bug 16581", 25 if $dbh->{mysql_clientversion} < 50025 or ($dbh->{mysql_serverversion} >= 50100 and $dbh->{mysql_serverversion} < 50112); ok($dbh->do("SET SQL_MODE=''"),"init connection SQL_MODE non strict"); ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t76multi"), "clean up"); ok($dbh->do("CREATE TABLE dbd_mysql_t76multi (a INT)"), "create table"); ok($dbh->do("INSERT INTO dbd_mysql_t76multi VALUES (1); INSERT INTO dbd_mysql_t76multi VALUES (2);"), "2 inserts"); # Check that a second do() doesn't fail with an 'Out of sync' error ok($dbh->do("INSERT INTO dbd_mysql_t76multi VALUES (3); INSERT INTO dbd_mysql_t76multi VALUES (4);"), "2 more inserts"); # Check that more_results works for non-SELECT results too my $sth; ok($sth = $dbh->prepare("UPDATE dbd_mysql_t76multi SET a=5 WHERE a=1; UPDATE dbd_mysql_t76multi SET a='6-' WHERE a<4")); ok($sth->execute(), "Execute updates"); is($sth->rows, 1, "First update affected 1 row"); is($sth->{mysql_warning_count}, 0, "First update had no warnings"); ok($sth->{Active}, "Statement handle is Active"); ok($sth->more_results()); is($sth->rows, 2, "Second update affected 2 rows"); is($sth->{mysql_warning_count}, 2, "Second update had 2 warnings"); ok(not $sth->more_results()); ok($sth->finish()); # Now run it again without calling more_results(). ok($sth->execute(), "Execute updates again"); ok($sth->finish()); # Check that do() doesn't fail with an 'Out of sync' error is($dbh->do("DELETE FROM dbd_mysql_t76multi"), 4, "Delete all rows"); # Test that do() reports errors from all result sets $dbh->{RaiseError} = $dbh->{PrintError} = 0; ok(!$dbh->do("INSERT INTO dbd_mysql_t76multi VALUES (1); INSERT INTO bad_dbd_mysql_t76multi VALUES (2);"), "do() reports errors"); # Test that execute() reports errors from only the first result set ok($sth = $dbh->prepare("UPDATE dbd_mysql_t76multi SET a=2; UPDATE bad_dbd_mysql_t76multi SET a=3")); ok($sth->execute(), "Execute updates"); ok(!$sth->err(), "Err was not set after execute"); ok(!$sth->more_results()); ok($sth->err(), "Err was set after more_results"); ok $dbh->do("DROP TABLE dbd_mysql_t76multi"); }; $dbh->disconnect(); DBD-mysql-4.054/t/92ssl_riddle_vulnerability.t0000644000175000017500000000247015043617710021635 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require "lib.pl"; my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); my $have_ssl = eval { $dbh->selectrow_hashref("SHOW VARIABLES WHERE Variable_name = 'have_ssl'") }; $dbh->disconnect(); plan skip_all => 'Server supports SSL connections, cannot test false-positive enforcement' if $have_ssl and $have_ssl->{Value} eq 'YES'; plan tests => 4; $dbh = DBI->connect($test_dsn, '4yZ73s9qeECdWi', '64heUGwAsVoNqo', { PrintError => 0, RaiseError => 0, mysql_ssl => 1 }); ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1 and incorrect user and password'); is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); $dbh = DBI->connect($test_dsn, '4yZ73s9qeECdWi', '64heUGwAsVoNqo', { PrintError => 0, RaiseError => 0, mysql_ssl => 1, mysql_ssl_verify_server_cert => 1, mysql_ssl_ca_file => "" }); ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1, mysql_ssl_verify_server_cert=1 and incorrect user and password'); is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); DBD-mysql-4.054/t/05dbcreate.t0000644000175000017500000000137014471320024016272 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More ; use DBI; $|= 1; use vars qw($test_user $test_password $test_db $test_dsn); use lib 't', '.'; require 'lib.pl'; # remove database from DSN $test_dsn =~ s/^DBI:mysql:([^:;]+)([:;]?)/DBI:mysql:$2/; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { diag $@; plan skip_all => "no database connection"; } plan tests => 2; ok defined $dbh, "Connected to database"; eval{ $dbh->do("CREATE DATABASE IF NOT EXISTS $test_db") }; if($@) { diag "No permission to '$test_db' database on '$test_dsn' for user '$test_user'"; } else { diag "Database '$test_db' accessible"; } ok $dbh->disconnect(); DBD-mysql-4.054/t/55utf8.t0000644000175000017500000000570415043617710015430 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use vars qw($COL_NULLABLE $COL_KEY); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } # # DROP/CREATE PROCEDURE will give syntax error for these versions # if ($dbh->{mysql_serverversion} < 50000) { plan skip_all => "SKIP TEST: You must have MySQL version 5.0 and greater for this test to run"; } plan tests => 16 * 2; for my $mysql_server_prepare (0, 1) { $dbh= DBI->connect("$test_dsn;mysql_server_prepare=$mysql_server_prepare;mysql_server_prepare_disable_fallback=1", $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t55utf8"); my $create =<do($create); my $utf8_str = "\x{0100}dam"; # "Adam" with a macron. my $quoted_utf8_str = "'\x{0100}dam'"; my $blob = "\x{c4}\x{80}dam"; # same as utf8_str but not utf8 encoded my $quoted_blob = "'\x{c4}\x{80}dam'"; cmp_ok $dbh->quote($utf8_str), 'eq', $quoted_utf8_str, 'testing quoting of utf 8 string'; cmp_ok $dbh->quote($blob), 'eq', $quoted_blob, 'testing quoting of blob'; #ok $dbh->{mysql_enable_utf8}, "mysql_enable_utf8 survive connect()"; $dbh->{mysql_enable_utf8}=1; # GeomFromText() is deprecated as of MySQL 5.7.6, use ST_GeomFromText() instead my $geomfromtext = $dbh->{mysql_serverversion} >= 50706 ? 'ST_GeomFromText' : 'GeomFromText'; my $query = <do($query, {}, $utf8_str, $blob, $utf8_str, $utf8_str), "INSERT query $query\n"; # AsBinary() is deprecated as of MySQL 5.7.6, use ST_AsBinary() instead my $asbinary = $dbh->{mysql_serverversion} >= 50706 ? 'ST_AsBinary' : 'AsBinary'; $query = "SELECT name,bincol,$asbinary(shape), binutf, profile FROM dbd_mysql_t55utf8 LIMIT 1"; my $sth = $dbh->prepare($query) or die "$DBI::errstr"; ok $sth->execute; my $ref; $ref = $sth->fetchrow_arrayref ; ok defined $ref; cmp_ok $ref->[0], 'eq', $utf8_str; cmp_ok $ref->[3], 'eq', $utf8_str; cmp_ok $ref->[4], 'eq', $utf8_str; SKIP: { eval {use Encode;}; skip "Can't test is_utf8 tests 'use Encode;' not available", 2, if $@; ok !Encode::is_utf8($ref->[1]), "blob was made utf8!."; ok !Encode::is_utf8($ref->[2]), "shape was made utf8!."; } cmp_ok $ref->[1], 'eq', $blob, "compare $ref->[1] eq $blob"; ok $sth->finish; ok $dbh->do("DROP TABLE dbd_mysql_t55utf8"); ok $dbh->disconnect; } DBD-mysql-4.054/t/rt110983-valid-mysqlfd.t0000644000175000017500000000132414471320024020240 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use vars qw($test_dsn $test_user $test_password); require "t/lib.pl"; my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0 }) }; plan skip_all => "no database connection" if $@ or not $dbh; plan tests => 4; ok($dbh->mysql_fd >= 0, '$dbh->mysql_fd returns valid file descriptor when $dbh connection is open'); ok($dbh->{sockfd} >= 0, '$dbh->{sockfd} returns valid file descriptor when $dbh connection is open'); $dbh->disconnect; ok(!defined $dbh->mysql_fd, '$dbh->mysql_fd returns undef when $dbh connection was closed'); ok(!defined $dbh->{sockfd}, '$dbh->{sockfd} returns undef when $dbh connection was closed'); DBD-mysql-4.054/t/10connect.t0000644000175000017500000000514415043617710016160 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More ; use DBI; use DBI::Const::GetInfoType; $|= 1; use vars qw($test_dsn $test_user $test_password $test_db); use lib 't', '.'; require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { diag $@; plan skip_all => "no database connection"; } ok(defined $dbh, "Connected to database"); for my $attribute ( qw( mysql_clientinfo mysql_clientversion mysql_serverversion mysql_hostinfo mysql_serverinfo mysql_stat mysql_protoinfo ) ) { ok($dbh->{$attribute}, "Value of '$attribute'"); diag "$attribute is: ". $dbh->{$attribute}; } my $sql_dbms_ver = $dbh->get_info($GetInfoType{SQL_DBMS_VER}); ok($sql_dbms_ver, 'get_info SQL_DBMS_VER'); diag "SQL_DBMS_VER is $sql_dbms_ver"; my $driver_ver = $dbh->get_info($GetInfoType{SQL_DRIVER_VER}); like( $driver_ver, qr/^\d{2}\.\d{2}\.\d{4}$/, 'get_info SQL_DRIVER_VER like dd.dd.dddd' ); like($driver_ver, qr/^04\./, 'SQL_DRIVER_VER starts with "04." (update for 5.x)'); # storage engine function is @@storage_engine in up to 5.5.03 # at that version, @@default_storage_engine is introduced # http://dev.mysql.com/doc/refman/5.5/en/server-system-variables.html#sysvar_storage_engine # in MySQL Server 5.7.5 the old option is removed # http://dev.mysql.com/doc/refman/5.7/en/server-system-variables.html#sysvar_storage_engine my $storage_engine = $dbh->{mysql_serverversion} >= 50503 ? '@@default_storage_engine' : '@@storage_engine'; my $result = $dbh->selectall_arrayref('select ' . $storage_engine); my $default_storage_engine = $result->[0]->[0] || 'unknown'; diag "Default storage engine is: $default_storage_engine"; my $info_hashref = $dbh->{mysql_dbd_stats}; ok($dbh->disconnect(), 'Disconnected'); ok( ! $dbh->ping(), 'dbh is disconnected and did not segv'); # dbi docs state: # The username and password can also be specified using the attributes # Username and Password, in which case they take precedence over the $username # and $password parameters. # see https://rt.cpan.org/Ticket/Display.html?id=89835 eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0, Username => '4yZ73s9qeECdWi', Password => '64heUGwAsVoNqo' });}; ok($@, 'Username and Password attributes override'); eval {$dbh= DBI->connect($test_dsn, '4yZ73s9qeECdWi', '64heUGwAsVoNqo', { RaiseError => 1, PrintError => 1, AutoCommit => 0, Username => $test_user, Password => $test_password });}; ok(!$@, 'Username and Password attributes override'); done_testing; DBD-mysql-4.054/t/40nulls.t0000644000175000017500000000175414471320024015663 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my ($dbh, $sth); eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 10; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40nulls"), "DROP TABLE IF EXISTS dbd_mysql_t40nulls"; my $create= <do($create), "create table $create"; ok $dbh->do("INSERT INTO dbd_mysql_t40nulls VALUES ( NULL, 'NULL-valued id' )"), "inserting nulls"; ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40nulls WHERE id IS NULL")); do $sth->execute; ok (my $aref = $sth->fetchrow_arrayref); ok !defined($$aref[0]); ok defined($$aref[1]); ok $sth->finish; ok $dbh->do("DROP TABLE dbd_mysql_t40nulls"); ok $dbh->disconnect; DBD-mysql-4.054/t/40numrows.t0000644000175000017500000000373414471320024016240 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my ($dbh, $sth, $aref); eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 30; ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40numrows"); my $create= <do($create), "CREATE TABLE dbd_mysql_t40numrows"; ok $dbh->do("INSERT INTO dbd_mysql_t40numrows VALUES( 1, 'Alligator Descartes' )"), 'inserting first row'; ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows WHERE id = 1")); ok $sth->execute; is $sth->rows, 1, '\$sth->rows should be 1'; ok ($aref= $sth->fetchall_arrayref); is scalar @$aref, 1, 'Verified rows should be 1'; ok $sth->finish; ok $dbh->do("INSERT INTO dbd_mysql_t40numrows VALUES( 2, 'Jochen Wiedmann' )"), 'inserting second row'; ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows WHERE id >= 1")); ok $sth->execute; is $sth->rows, 2, '\$sth->rows should be 2'; ok ($aref= $sth->fetchall_arrayref); is scalar @$aref, 2, 'Verified rows should be 2'; ok $sth->finish; ok $dbh->do("INSERT INTO dbd_mysql_t40numrows VALUES(3, 'Tim Bunce')"), "inserting third row"; ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows WHERE id >= 2")); ok $sth->execute; is $sth->rows, 2, 'rows should be 2'; ok ($aref= $sth->fetchall_arrayref); is scalar @$aref, 2, 'Verified rows should be 2'; ok $sth->finish; ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows")); ok $sth->execute; is $sth->rows, 3, 'rows should be 3'; ok ($aref= $sth->fetchall_arrayref); is scalar @$aref, 3, 'Verified rows should be 3'; ok $dbh->do("DROP TABLE dbd_mysql_t40numrows"), "drop table dbd_mysql_t40numrows"; ok $dbh->disconnect; DBD-mysql-4.054/t/80procs.t0000644000175000017500000000536515043617710015671 0ustar dvaneedendvaneedenuse strict; use warnings; use lib 't', '.'; require 'lib.pl'; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); my ($row, $vers, $test_procs, $dbh, $sth); eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } # # DROP/CREATE PROCEDURE will give syntax error # for versions < 5.0 # if ($dbh->{mysql_serverversion} < 50000) { plan skip_all => "You must have MySQL version 5.0 and greater for this test to run"; } if (!CheckRoutinePerms($dbh)) { plan skip_all => "Your test user does not have ALTER_ROUTINE privileges."; } plan tests => 31; $dbh->disconnect(); ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})); ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t80procs"); my $drop_proc= "DROP PROCEDURE IF EXISTS dbd_mysql_t80testproc"; ok ($dbh->do($drop_proc), "DROP PROCEDURE") or diag "errstr=$DBI::errstr, err=$DBI::err"; my $proc_create = <do($proc_create); my $proc_call = 'CALL dbd_mysql_t80testproc()'; ok $dbh->do($proc_call); my $proc_select = 'SELECT @a'; ok ($sth = $dbh->prepare($proc_select)); ok $sth->execute(); ok $sth->finish; ok $dbh->do("DROP PROCEDURE dbd_mysql_t80testproc"); ok $dbh->do("drop procedure if exists test_multi_sets"); $proc_create = <do($proc_create); ok ($sth = $dbh->prepare("call test_multi_sets()")); ok $sth->execute(); is $sth->{NUM_OF_FIELDS}, 1, "num_of_fields == 1"; my $resultset; ok ($resultset = $sth->fetchrow_arrayref()); ok defined $resultset; is @$resultset, 1, "1 row in resultset"; undef $resultset; ok $sth->more_results(); is $sth->{NUM_OF_FIELDS}, 2, "NUM_OF_FIELDS == 2"; ok ($resultset= $sth->fetchrow_arrayref()); ok defined $resultset; is @$resultset, 2, "2 rows in resultset"; undef $resultset; ok $sth->more_results(); is $sth->{NUM_OF_FIELDS}, 3, "NUM_OF_FIELDS == 3"; ok ($resultset= $sth->fetchrow_arrayref()); ok defined $resultset; is @$resultset, 3, "3 Rows in resultset"; ok $sth->more_results(); is $sth->{NUM_OF_FIELDS}, 0, "NUM_OF_FIELDS == 0"; + local $SIG{__WARN__} = sub { die @_ }; ok $sth->finish; ok $dbh->disconnect(); DBD-mysql-4.054/t/25lockunlock.t0000644000175000017500000000275314471320024016675 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 13; my $create= <do("DROP TABLE IF EXISTS dbd_mysql_t25lockunlock"), "drop table if exists dbd_mysql_t25lockunlock"; ok $dbh->do($create), "create table dbd_mysql_t25lockunlock"; ok $dbh->do("LOCK TABLES dbd_mysql_t25lockunlock WRITE"), "lock table dbd_mysql_t25lockunlock"; ok $dbh->do("INSERT INTO dbd_mysql_t25lockunlock VALUES(1, 'Alligator Descartes')"), "Insert "; ok $dbh->do("DELETE FROM dbd_mysql_t25lockunlock WHERE id = 1"), "Delete"; my $sth; eval {$sth= $dbh->prepare("SELECT * FROM dbd_mysql_t25lockunlock WHERE id = 1")}; ok !$@, "Prepare of select"; ok defined($sth), "Prepare of select"; ok $sth->execute , "Execute"; my ($row, $errstr); $errstr= ''; $row = $sth->fetchrow_arrayref; $errstr= $sth->errstr; ok !defined($row), "Fetch should have failed"; ok !defined($errstr), "Fetch should have failed"; ok $dbh->do("UNLOCK TABLES"), "Unlock tables"; ok $dbh->do("DROP TABLE dbd_mysql_t25lockunlock"), "Drop table dbd_mysql_t25lockunlock"; ok $dbh->disconnect, "Disconnecting"; DBD-mysql-4.054/t/rt85919-fetch-lost-connection.t0000644000175000017500000000451114525366521021640 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib 't', '.'; use vars qw($test_dsn $test_user $test_password $mdriver); require 'lib.pl'; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } my $sth; my $ok = eval { note "Connecting...\n"; ok( $sth = $dbh->do('SET wait_timeout = 5'), 'set wait_timeout'); note "Sleeping...\n"; sleep 7; my $sql = 'SELECT 1'; if (1) { ok( $sth = $dbh->prepare($sql), 'prepare SQL'); ok( $sth->execute(), 'execute SQL'); my @res = $sth->fetchrow_array(); is ( $res[0], undef, 'no rows returned'); ok( $sth->finish(), 'finish'); $sth = undef; } else { note "Selecting...\n"; my @res = $dbh->selectrow_array($sql); } $dbh->disconnect(); $dbh = undef; 1; }; if (not $ok) { # if we're connected via a local socket we receive error 2006 # (CR_SERVER_GONE_ERROR) but if we're connected using TCP/IP we get # 2013 (CR_SERVER_LOST) # # as of 8.0.24 MySQL writes the reason the connection was closed # before closing it, so 4031 (ER_CLIENT_INTERACTION_TIMEOUT) is # now an valid return code if ($DBI::err == 2006) { pass("received error 2006 (CR_SERVER_GONE_ERROR)"); } elsif ($DBI::err == 2013) { pass("received error 2013 (CR_SERVER_LOST)"); } elsif ($DBI::err == 4031) { pass("received error 4031 (ER_CLIENT_INTERACTION_TIMEOUT)"); } else { fail('Should return error 2006 or 2013'); } eval { $sth->finish(); } if defined $sth; eval { $dbh->disconnect(); } if defined $dbh; } if (0) { # This causes the use=after-free crash in RT #97625. # different testcase by killing the service. which is of course # not doable in a general testscript and highly system dependent. system(qw(sudo service mysql start)); use DBI; my $dbh = DBI->connect("DBI:mysql:database=test:port=3306"); $dbh->{mysql_auto_reconnect} = 1; # without this is works my $select = sub { $dbh->do(q{SELECT 1}) for 1 .. 10; }; $select->(); system qw(sudo service mysql stop); $select->(); ok(1, "dbh did not crash on closed connection"); system(qw(sudo service mysql start)); } done_testing(); DBD-mysql-4.054/t/version.t0000644000175000017500000000057615043617710016057 0ustar dvaneedendvaneedenuse strict; use warnings; use DBD::mysql; use Bundle::DBD::mysql; use Test::More; like($DBD::mysql::VERSION, qr/^\d\.\d{2,3}(|_\d\d)$/, 'version format'); like($DBD::mysql::VERSION, qr/^4\./, 'version starts with "4." (update for 5.x)'); is( $DBD::mysql::VERSION, $Bundle::DBD::mysql::VERSION, 'VERSION strings should be the same in all .pm files in dist' ); done_testing; DBD-mysql-4.054/t/pod.t0000644000175000017500000000020114471320024015126 0ustar dvaneedendvaneedenuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); DBD-mysql-4.054/t/43count_params.t0000644000175000017500000000367014471320024017223 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } if (!MinimumVersion($dbh, '4.1') ) { plan skip_all => "SKIP TEST: You must have MySQL version 4.1 and greater for this test to run"; } plan tests => 17; ok ($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t43count_params")); my $create = <do($create)); ok (my $sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (name, id)" . " VALUES ('Charles de Batz de Castelmore, comte d\\'Artagnan', ?)")); ok ($sth->execute(1)); ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (name, id)" . " VALUES ('Charles de Batz de Castelmore, comte d\\'Artagnan', 2)")); ok ($sth->execute()); ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (name, id) VALUES (?, ?)")); ok ($sth->execute("Charles de Batz de Castelmore, comte d\\'Artagnan", 3)); ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (id, name)" . " VALUES (?, 'Charles de Batz de Castelmore, comte d\\'Artagnan')")); ok ($sth->execute(1)); ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (id, name)" . " VALUES (2, 'Charles de Batz de Castelmore, comte d\\'Artagnan')")); ok ($sth->execute()); ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (id, name) VALUES (?, ?)")); ok ($sth->execute(3, "Charles de Batz de Castelmore, comte d\\'Artagnan")); ok ($dbh->do("DROP TABLE dbd_mysql_t43count_params")); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.054/t/86_bug_36972.t0000644000175000017500000000236514471320024016225 0ustar dvaneedendvaneedenuse strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use vars qw($test_dsn $test_user $test_password); $|= 1; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } plan tests => 11; ok(defined $dbh, "connecting"); # # Bug #42723: Binding server side integer parameters results in corrupt data # ok($dbh->do('DROP TABLE IF EXISTS dbd_mysql_t86'), "making slate clean"); ok($dbh->do('CREATE TABLE dbd_mysql_t86 (`i` int,`si` smallint,`ti` tinyint,`bi` bigint)'), "creating test table"); my $sth2; ok($sth2 = $dbh->prepare('INSERT INTO dbd_mysql_t86 VALUES (?,?,?,?)')); #bind test values ok($sth2->bind_param(1, 101, DBI::SQL_INTEGER), "binding int"); ok($sth2->bind_param(2, 102, DBI::SQL_SMALLINT), "binding smallint"); ok($sth2->bind_param(3, 103, DBI::SQL_TINYINT), "binding tinyint"); ok($sth2->bind_param(4, 104, DBI::SQL_INTEGER), "binding bigint"); ok($sth2->execute(), "inserting data"); is_deeply($dbh->selectall_arrayref('SELECT * FROM dbd_mysql_t86'), [[101, 102, 103, 104]]); ok ($dbh->do('DROP TABLE dbd_mysql_t86'), "cleaning up"); $dbh->disconnect(); DBD-mysql-4.054/t/rt50304-column_info_parentheses.t0000644000175000017500000000304714471320024022307 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use vars qw($test_dsn $test_user $test_password $state); require "t/lib.pl"; use Test::More; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; if ($@) { plan skip_all => "no database connection"; } ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_rt50304_column_info")); my $create = <do($create), "create table dbd_mysql_rt50304_column_info"); my $sth = $dbh->column_info(undef, undef, 'dbd_mysql_rt50304_column_info', 'problem_column'); my $info = $sth->fetchall_arrayref({}); is ( scalar @{$info->[0]->{mysql_values}}, 2, 'problem_column values'); is ( $info->[0]->{mysql_values}->[0], '', 'problem_column first value'); is ( $info->[0]->{mysql_values}->[1], '(Some Text)', 'problem_column second value'); $sth= $dbh->column_info(undef, undef, 'dbd_mysql_rt50304_column_info', 'regular_column'); $info = $sth->fetchall_arrayref({}); is ( scalar @{$info->[0]->{mysql_values}}, 2, 'regular_column values'); is ( $info->[0]->{mysql_values}->[0], '', 'regular_column first value'); is ( $info->[0]->{mysql_values}->[1], 'Some Text', 'regular_column second value'); ok($dbh->do("DROP TABLE dbd_mysql_rt50304_column_info")); ok($dbh->disconnect()); done_testing; DBD-mysql-4.054/t/rt86153-reconnect-fail-memory.t0000644000175000017500000000370314471320024021607 0ustar dvaneedendvaneedenuse strict; use warnings; use DBI; use Test::More; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $COUNT_CONNECT = 4000; # Number of connect/disconnect iterations my $have_storable; if (!$ENV{EXTENDED_TESTING}) { plan skip_all => "\$ENV{EXTENDED_TESTING} is not set\n"; } eval { require Proc::ProcessTable; }; if ($@) { plan skip_all => "module Proc::ProcessTable not installed \n"; } eval { require Storable }; $have_storable = $@ ? 0 : 1; my $have_pt_size = grep { $_ eq 'size' } Proc::ProcessTable->new('cache_ttys' => $have_storable)->fields; unless ($have_pt_size) { plan skip_all => "module Proc::ProcessTable does not support size attribute on current platform\n"; } plan tests => 3; sub size { my($p, $pt); $pt = Proc::ProcessTable->new('cache_ttys' => $have_storable); for $p (@{$pt->table()}) { if ($p->pid() == $$) { return $p->size(); } } die "Cannot find my own process?!?\n"; exit 0; } my ($size, $prev_size, $ok, $not_ok, $dbh2); note "Testing memory leaks in connect/disconnect\n"; $ok = 0; $not_ok = 0; $prev_size= undef; # run reconnect with a bad password for (my $i = 0; $i < $COUNT_CONNECT; $i++) { eval { $dbh2 = DBI->connect($test_dsn, $test_user, "$test_password ", { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($i % 100 == 99) { $size = size(); if (defined($prev_size)) { if ($size == $prev_size) { $ok++; } else { diag "$prev_size => $size" if $ENV{TEST_VERBOSE}; $not_ok++; } } else { $prev_size = $size; $size = size(); } $prev_size = $size; } } ok $ok, "\$ok $ok"; ok !$not_ok, "\$not_ok $not_ok"; cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; DBD-mysql-4.054/t/rt88006-bit-prepare.t0000644000175000017500000000724014471320024017621 0ustar dvaneedendvaneedenuse strict; use warnings; use vars qw($test_dsn $test_user $test_password); use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; for my $scenario (qw(prepare noprepare)) { my $dbh; my $sth; my $dsn = $test_dsn; $dsn .= ';mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1' if $scenario eq 'prepare'; eval {$dbh = DBI->connect($dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "no database connection"; } if ($dbh->{mysql_serverversion} < 50008) { plan skip_all => "Servers < 5.0.8 do not support b'' syntax"; } if ($dbh->{mysql_serverversion} < 50026) { plan skip_all => "Servers < 5.0.26 do not support BIN() for BIT values"; } my $create = <do($create),"create table for $scenario"; ok $dbh->do("INSERT INTO dbd_mysql_rt88006_bit_prep (id, flags) VALUES (1, b'10'), (2, b'1'), (3, b'1111011111101111101101111111101111111101')"); ok $sth = $dbh->prepare("INSERT INTO dbd_mysql_rt88006_bit_prep (id, flags) VALUES (?, ?)"); ok $sth->bind_param(1, 4, DBI::SQL_INTEGER); ok $sth->bind_param(2, pack("B*", '1110000000000000011101100000000011111101'), DBI::SQL_BINARY); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok $sth->finish; ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 1"); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok (my $r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario"); is ($r->{id}, 1, 'id test contents'); is (unpack("B*", $r->{flags}), '0000000000000000000000000000000000000010', 'flags has contents'); ok $sth->finish; ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 3"); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with more then 32 bits"); is ($r->{id}, 3, 'id test contents'); is (unpack("B*", $r->{flags}), '1111011111101111101101111111101111111101', 'flags has contents'); ok $sth->finish; ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 4"); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with binary insert"); is ($r->{id}, 4, 'id test contents'); is (unpack("B*", $r->{flags}), '1110000000000000011101100000000011111101', 'flags has contents'); ok $sth->finish; ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =1"); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN()"); is ($r->{id}, 1, 'id test contents'); is ($r->{'BIN(flags)'}, '10', 'flags has contents'); ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =3"); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN() and more then 32 bits"); is ($r->{id}, 3, 'id test contents'); is ($r->{'BIN(flags)'}, '1111011111101111101101111111101111111101', 'flags has contents'); ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =4"); ok $sth->execute() or die("Execute failed: ".$DBI::errstr); ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN() and with binary insert"); is ($r->{id}, 4, 'id test contents'); is ($r->{'BIN(flags)'}, '1110000000000000011101100000000011111101', 'flags has contents'); ok $sth->finish; ok $dbh->disconnect; } done_testing; DBD-mysql-4.054/README.md0000644000175000017500000000154415043617710015215 0ustar dvaneedendvaneeden# DBD::mysql - database driver for Perl This is the Perl [DBI](https://metacpan.org/pod/DBI) driver for access to MySQL databases. ## Usage Usage is described in [DBD::mysql](https://metacpan.org/pod/DBD::mysql). ## Building and Testing Using Docker We've include some basic docker support for building and testing. This uses an Ubuntu image. It can be used as follows: docker-compose build docker-compose up --abort-on-container-exit --exit-code-from test ## Installation Installation is described in [DBD::mysql::INSTALL](https://metacpan.org/pod/DBD::mysql::INSTALL). ## Support This module is maintained and supported on a mailing list, dbi-users. To subscribe to this list, send an email to dbi-users-subscribe@perl.org Mailing list archives are at [http://groups.google.com/group/perl.dbi.users](http://groups.google.com/group/perl.dbi.users) DBD-mysql-4.054/Makefile.PL.embedded0000644000175000017500000000131115043617710017430 0ustar dvaneedendvaneedenuse ExtUtils::MakeMaker; use File::Path; $/="\n"; chomp($pwd = `pwd`); $pwd = "." if ($pwd eq ''); require "$pwd/Makefile.conf" || die "Can't read Configuration file: $!\n"; if (! -d "$pwd/t/test") { eval { mkpath "$pwd/t/test" }; if ($@) { print "Couldn't create $pwd/t/test directory for test database: $@\n"; } } ExtUtils::MakeMaker::WriteMakefile(%{$o}); package MY; no warnings; sub MY::postamble { require DBI::DBD; "\n" . DBI::DBD::dbd_postamble(@_); }; sub MY::dynamic_lib { my $self = shift; my $result = $self->SUPER::dynamic_lib(@_); if (!$::opt->{nocatchstderr} && $result =~ /\$\(LD\)/) { $result =~ s/(\$\(LD\))/\$\(PERL\) myld \$(LD)/sg; } return $result; }; DBD-mysql-4.054/dbdimp.h0000644000175000017500000003127115043617710015346 0ustar dvaneedendvaneeden/* * DBD::mysql - DBI driver for the MySQL database * * Copyright (c) 2005 Patrick Galbraith * Copyright (c) 2003 Rudolf Lippan * Copyright (c) 1997-2003 Jochen Wiedmann * * Based on DBD::Oracle; DBD::Oracle is * * Copyright (c) 1994,1995 Tim Bunce * * You may distribute this under the terms of either the GNU General Public * License or the Artistic License, as specified in the Perl README file. */ #define PERL_NO_GET_CONTEXT /* * Header files we use */ #include /* installed by the DBI module */ #include /* Comes with MySQL-devel */ #include /* Comes MySQL */ #include /* Comes with MySQL-devel */ /* * This is the version of MySQL wherer * the server will be used to process prepare * statements as opposed to emulation in the driver */ #define SQL_STATE_VERSION 40101 #define WARNING_COUNT_VERSION 40101 #define FIELD_CHARSETNR_VERSION 40101 /* should equivalent to 4.1.0 */ #define MULTIPLE_RESULT_SET_VERSION 40102 #define SERVER_PREPARE_VERSION 40103 #define CALL_PLACEHOLDER_VERSION 50503 #define LIMIT_PLACEHOLDER_VERSION 50007 #define GEO_DATATYPE_VERSION 50007 #define NEW_DATATYPE_VERSION 50003 #define MYSQL_VERSION_5_0 50001 /* This is to avoid the ugly #ifdef mess in dbdimp.c */ #if MYSQL_VERSION_ID < SQL_STATE_VERSION #define mysql_sqlstate(svsock) (NULL) #endif /* * This is the versions of libmysql that supports MySQL Fabric. */ #define LIBMYSQL_FABRIC_VERSION 60200 #define LIBMYSQL_LAST_FABRIC_VERSION 69999 #if LIBMYSQL_VERSION_ID >= LIBMYSQL_FABRIC_VERSION && LIBMYSQL_VERSION_ID <= LIBMYSQL_LAST_FABRIC_VERSION #define FABRIC_SUPPORT 1 #else #define FABRIC_SUPPORT 0 #endif #if MYSQL_VERSION_ID < WARNING_COUNT_VERSION #define mysql_warning_count(svsock) 0 #endif #if MYSQL_VERSION_ID < WARNING_COUNT_VERSION #define mysql_warning_count(svsock) 0 #endif #if !defined(MARIADB_BASE_VERSION) && MYSQL_VERSION_ID >= 80001 #define my_bool bool #endif /* MYSQL_TYPE_BIT is not available on MySQL 4.1 */ #ifndef MYSQL_TYPE_BIT #define MYSQL_TYPE_BIT 16 #endif #define true 1 #define false 0 /* * Check which SSL settings are supported by API at compile time */ /* Use mysql_options with MYSQL_OPT_SSL_VERIFY_SERVER_CERT */ #if ((MYSQL_VERSION_ID >= 50023 && MYSQL_VERSION_ID < 50100) || MYSQL_VERSION_ID >= 50111) && (MYSQL_VERSION_ID < 80000 || defined(MARIADB_BASE_VERSION)) #define HAVE_SSL_VERIFY #endif /* Use mysql_options with MYSQL_OPT_SSL_ENFORCE */ #if !defined(MARIADB_BASE_VERSION) && MYSQL_VERSION_ID >= 50703 && MYSQL_VERSION_ID < 80000 && MYSQL_VERSION_ID != 60000 #define HAVE_SSL_ENFORCE #endif /* Use mysql_options with MYSQL_OPT_SSL_MODE */ #if !defined(MARIADB_BASE_VERSION) && MYSQL_VERSION_ID >= 50711 && MYSQL_VERSION_ID != 60000 #define HAVE_SSL_MODE #endif /* Use mysql_options with MYSQL_OPT_SSL_MODE, but only SSL_MODE_REQUIRED is supported */ #if !defined(MARIADB_BASE_VERSION) && ((MYSQL_VERSION_ID >= 50636 && MYSQL_VERSION_ID < 50700) || (MYSQL_VERSION_ID >= 50555 && MYSQL_VERSION_ID < 50600)) #define HAVE_SSL_MODE_ONLY_REQUIRED #endif /* * Check which SSL settings are supported by API at runtime */ /* MYSQL_OPT_SSL_VERIFY_SERVER_CERT automatically enforce SSL mode */ static inline bool ssl_verify_also_enforce_ssl(void) { #ifdef MARIADB_BASE_VERSION my_ulonglong version = mysql_get_client_version(); return ((version >= 50544 && version < 50600) || (version >= 100020 && version < 100100) || version >= 100106); #else return false; #endif } /* MYSQL_OPT_SSL_VERIFY_SERVER_CERT is not vulnerable (CVE-2016-2047) and can be used */ static inline bool ssl_verify_usable(void) { my_ulonglong version = mysql_get_client_version(); #ifdef MARIADB_BASE_VERSION return ((version >= 50547 && version < 50600) || (version >= 100023 && version < 100100) || version >= 100110); #else return ((version >= 50549 && version < 50600) || (version >= 50630 && version < 50700) || version >= 50712); #endif } /* * The following are return codes passed in $h->err in case of * errors by DBD::mysql. */ enum errMsgs { JW_ERR_CONNECT = 1, JW_ERR_SELECT_DB, JW_ERR_STORE_RESULT, JW_ERR_NOT_ACTIVE, JW_ERR_QUERY, JW_ERR_FETCH_ROW, JW_ERR_LIST_DB, JW_ERR_CREATE_DB, JW_ERR_DROP_DB, JW_ERR_LIST_TABLES, JW_ERR_LIST_FIELDS, JW_ERR_LIST_FIELDS_INT, JW_ERR_LIST_SEL_FIELDS, JW_ERR_NO_RESULT, JW_ERR_NOT_IMPLEMENTED, JW_ERR_ILLEGAL_PARAM_NUM, JW_ERR_MEM, JW_ERR_LIST_INDEX, JW_ERR_SEQUENCE, AS_ERR_EMBEDDED, TX_ERR_AUTOCOMMIT, TX_ERR_COMMIT, TX_ERR_ROLLBACK, SL_ERR_NOTAVAILBLE, }; /* * Internal constants, used for fetching array attributes */ enum av_attribs { AV_ATTRIB_NAME = 0, AV_ATTRIB_TABLE, AV_ATTRIB_TYPE, AV_ATTRIB_SQL_TYPE, AV_ATTRIB_IS_PRI_KEY, AV_ATTRIB_IS_NOT_NULL, AV_ATTRIB_NULLABLE, AV_ATTRIB_LENGTH, AV_ATTRIB_IS_NUM, AV_ATTRIB_TYPE_NAME, AV_ATTRIB_PRECISION, AV_ATTRIB_SCALE, AV_ATTRIB_MAX_LENGTH, AV_ATTRIB_IS_KEY, AV_ATTRIB_IS_BLOB, AV_ATTRIB_IS_AUTO_INCREMENT, AV_ATTRIB_LAST /* Dummy attribute, never used, for allocation */ }; /* purposes only */ /* * This is our part of the driver handle. We receive the handle as * an "SV*", say "drh", and receive a pointer to the structure below * by declaring * * D_imp_drh(drh); * * This declares a variable called "imp_drh" of type * "struct imp_drh_st *". */ typedef struct imp_drh_embedded_st { int state; SV * args; SV * groups; } imp_drh_embedded_t; struct imp_drh_st { dbih_drc_t com; /* MUST be first element in structure */ #if defined(DBD_MYSQL_EMBEDDED) imp_drh_embedded_t embedded; /* */ #endif }; /* * Likewise, this is our part of the database handle, as returned * by DBI->connect. We receive the handle as an "SV*", say "dbh", * and receive a pointer to the structure below by declaring * * D_imp_dbh(dbh); * * This declares a variable called "imp_dbh" of type * "struct imp_dbh_st *". */ struct imp_dbh_st { dbih_dbc_t com; /* MUST be first element in structure */ MYSQL *pmysql; bool has_transactions; /* boolean indicating support for * transactions, currently always TRUE for MySQL */ bool auto_reconnect; bool bind_type_guessing; bool bind_comment_placeholders; bool no_autocommit_cmd; bool use_mysql_use_result; /* TRUE if execute should use * mysql_use_result rather than * mysql_store_result */ bool use_server_side_prepare; bool disable_fallback_for_server_prepare; void* async_query_in_flight; bool enable_utf8; bool enable_utf8mb4; struct { unsigned int auto_reconnects_ok; unsigned int auto_reconnects_failed; } stats; }; /* * The bind_param method internally uses this structure for storing * parameters. */ typedef struct imp_sth_ph_st { SV* value; int type; } imp_sth_ph_t; /* * The bind_param method internally uses this structure for storing * parameters. */ typedef struct imp_sth_phb_st { union { IV lval; double dval; } numeric_val; unsigned long length; my_bool is_null; } imp_sth_phb_t; /* * The dbd_describe uses this structure for storing * fields meta info. * Added ddata, ldata, lldata for accommodate * being able to use different data types * 12.02.20004 PMG */ typedef struct imp_sth_fbh_st { unsigned long length; my_bool is_null; bool error; char *data; int charsetnr; double ddata; IV ldata; #if MYSQL_VERSION_ID < FIELD_CHARSETNR_VERSION unsigned int flags; #endif } imp_sth_fbh_t; typedef struct imp_sth_fbind_st { unsigned long * length; my_bool * is_null; } imp_sth_fbind_t; /* * Finally our part of the statement handle. We receive the handle as * an "SV*", say "dbh", and receive a pointer to the structure below * by declaring * * D_imp_sth(sth); * * This declares a variable called "imp_sth" of type * "struct imp_sth_st *". */ struct imp_sth_st { dbih_stc_t com; /* MUST be first element in structure */ #if (MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION) MYSQL_STMT *stmt; MYSQL_BIND *bind; MYSQL_BIND *buffer; imp_sth_phb_t *fbind; imp_sth_fbh_t *fbh; int has_been_bound; int use_server_side_prepare; /* server side prepare statements? */ int disable_fallback_for_server_prepare; #endif MYSQL_RES* result; /* result */ int currow; /* number of current row */ int fetch_done; /* mark that fetch done */ my_ulonglong row_num; /* total number of rows */ int done_desc; /* have we described this sth yet ? */ long long_buflen; /* length for long/longraw (if >0) */ bool long_trunc_ok; /* is truncating a long an error */ my_ulonglong insertid; /* ID of auto insert */ int warning_count; /* Number of warnings after execute() */ imp_sth_ph_t* params; /* Pointer to parameter array */ AV* av_attr[AV_ATTRIB_LAST];/* For caching array attributes */ int use_mysql_use_result; /* TRUE if execute should use */ /* mysql_use_result rather than */ /* mysql_store_result */ bool is_async; }; /* * And last, not least: The prototype definitions. * * These defines avoid name clashes for multiple statically linked DBD's */ #define dbd_init mysql_dr_init #define dbd_db_login mysql_db_login #define dbd_db_do mysql_db_do #define dbd_db_commit mysql_db_commit #define dbd_db_rollback mysql_db_rollback #define dbd_db_disconnect mysql_db_disconnect #define dbd_db_destroy mysql_db_destroy #define dbd_db_STORE_attrib mysql_db_STORE_attrib #define dbd_db_FETCH_attrib mysql_db_FETCH_attrib #define dbd_st_prepare mysql_st_prepare #define dbd_st_execute mysql_st_execute #define dbd_st_fetch mysql_st_fetch #define dbd_st_more_results mysql_st_next_results #define dbd_st_finish mysql_st_finish #define dbd_st_destroy mysql_st_destroy #define dbd_st_blob_read mysql_st_blob_read #define dbd_st_STORE_attrib mysql_st_STORE_attrib #define dbd_st_FETCH_attrib mysql_st_FETCH_attrib #define dbd_st_FETCH_internal mysql_st_FETCH_internal #define dbd_describe mysql_describe #define dbd_bind_ph mysql_bind_ph #define BindParam mysql_st_bind_param #define mymsql_constant mysql_constant #define do_warn mysql_dr_warn #define do_error mysql_dr_error #define dbd_db_type_info_all mysql_db_type_info_all #define dbd_db_quote mysql_db_quote #define dbd_db_last_insert_id mysql_db_last_insert_id #include void do_error (SV* h, int rc, const char *what, const char *sqlstate); SV *dbd_db_fieldlist (MYSQL_RES* res); void dbd_preparse (imp_sth_t *imp_sth, SV *statement); my_ulonglong mysql_st_internal_execute(SV *, SV *, SV *, int, imp_sth_ph_t *, MYSQL_RES **, MYSQL *, int); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION my_ulonglong mysql_st_internal_execute41(SV *, int, MYSQL_RES **, MYSQL_STMT *, MYSQL_BIND *, int *); int mysql_st_clean_cursor(SV*, imp_sth_t*); #endif #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION int mysql_st_next_results(SV*, imp_sth_t*); #endif #if defined(DBD_MYSQL_EMBEDDED) int count_embedded_options(char *); char ** fill_out_embedded_options(PerlIO *, char *, int , int , int); int free_embedded_options(char **, int); /* We have to define dbd_discon_all method for mysqlEmb driver at least to be able to stop embedded server properly */ #define dbd_discon_all dbd_discon_all #endif AV* dbd_db_type_info_all (SV* dbh, imp_dbh_t* imp_dbh); SV* dbd_db_quote(SV*, SV*, SV*); extern MYSQL* mysql_dr_connect(SV*, MYSQL*, char*, char*, char*, char*, char*, char*, imp_dbh_t*); extern int mysql_db_reconnect(SV*); int mysql_st_free_result_sets (SV * sth, imp_sth_t * imp_sth); int mysql_db_async_result(SV* h, MYSQL_RES** resp); int mysql_db_async_ready(SV* h); int mysql_socket_ready(my_socket fd); DBD-mysql-4.054/socket.c0000644000175000017500000000163314523376642015401 0ustar dvaneedendvaneeden#ifdef _WIN32 #include "windows.h" #include "winsock.h" #endif #ifndef _WIN32 #include #include #endif #include /* * Warning: Native socket code must be outside of dbdimp.c and dbdimp.h because * perl header files redefine socket function. This file must not * include any perl header files! */ int mysql_socket_ready(my_socket fd) { int retval; #ifdef _WIN32 /* Windows does not have poll(), so use select() instead */ struct timeval timeout; fd_set fds; FD_ZERO(&fds); FD_SET(fd, &fds); timeout.tv_sec = 0; timeout.tv_usec = 0; retval = select(fd+1, &fds, NULL, NULL, &timeout); #else struct pollfd fds; fds.fd = fd; fds.events = POLLIN; retval = poll(&fds, 1, 0); #endif if (retval < 0) { #ifdef _WIN32 /* Windows does not update errno */ return -WSAGetLastError(); #else return -errno; #endif } return retval; } DBD-mysql-4.054/lib/0000755000175000017500000000000015043620456014501 5ustar dvaneedendvaneedenDBD-mysql-4.054/lib/DBD/0000755000175000017500000000000015043620456015072 5ustar dvaneedendvaneedenDBD-mysql-4.054/lib/DBD/mysql/0000755000175000017500000000000015043620456016237 5ustar dvaneedendvaneedenDBD-mysql-4.054/lib/DBD/mysql/INSTALL.pod0000644000175000017500000005606515043617710020064 0ustar dvaneedendvaneeden=encoding utf8 =head1 NAME DBD::mysql::INSTALL - How to install and configure DBD::mysql =head1 SYNOPSIS perl Makefile.PL [options] make make test make install =head1 DESCRIPTION This document describes the installation and configuration of DBD::mysql, the Perl DBI driver for the MySQL database. Before reading on, make sure that you have the prerequisites available: Perl, MySQL and DBI. For details see the separate section L. Depending on your version of Perl, it might be possible to use a binary distribution of DBD::mysql. If possible, this is recommended. Otherwise you need to install from the sources. If so, you will definitely need a C compiler. Installation from binaries and sources are both described in separate sections. L. L. Finally, if you encounter any problems, do not forget to read the section on known problems L. If that doesn't help, you should check the section on L. =head1 PREREQUISITES =over =item Perl Preferably a version of Perl, that comes preconfigured with your system. For example, all Linux and FreeBSD distributions come with Perl. For Windows, use L or L. =item MySQL You need not install the actual MySQL database server, the client files and the development files are sufficient. For example, Fedora Linux distribution comes with RPM files (using YUM) B and B (use "yum search" to find exact package names). These are sufficient, if the MySQL server is located on a foreign machine. You may also create client files by compiling from the MySQL source distribution and using configure --without-server If you are using Windows and need to compile from sources (which is only the case if you are not using ActivePerl or Strawberry Perl), then you must ensure that the header and library files are installed. This may require choosing a "Custom installation" and selecting the appropriate option when running the MySQL setup program. =item DBI DBD::mysql is a DBI driver, hence you need DBI. It is available from the same source where you got the DBD::mysql distribution from. =item C compiler A C compiler is only required if you install from source. In most cases there are binary distributions of DBD::mysql available. However, if you need a C compiler, make sure, that it is the same C compiler that was used for compiling Perl and MySQL! Otherwise you will almost definitely encounter problems because of differences in the underlying C runtime libraries. In the worst case, this might mean to compile Perl and MySQL yourself. But believe me, experience shows that a lot of problems are fixed this way. =item Gzip libraries Late versions of MySQL come with support for compression. Thus it B be required that you have install an RPM package like libz-devel, libgz-devel or something similar. =back =head1 BINARY INSTALLATION Binary installation is possible in the most cases, depending on your system. =head2 Windows =head3 Strawberry Perl Strawberry Perl comes bundled with DBD::mysql and the needed client libraries. =head3 ActiveState Perl ActivePerl offers a PPM archive of DBD::mysql. All you need to do is typing in a cmd.exe window: ppm install DBD-mysql This will fetch the module via HTTP and install them. If you need to use a WWW proxy server, the environment variable HTTP_proxy must be set: set HTTP_proxy=http://myproxy.example.com:8080/ ppm install DBD-mysql Of course you need to replace the host name C and the port number C<8080> with your local values. If the above procedure doesn't work, please upgrade to the latest version of ActivePerl. ActiveState has a policy where it only provides access free-of-charge for the PPM mirrors of the last few stable Perl releases. If you have an older perl, you'd either need to upgrade your perl or contact ActiveState about a subscription. =head2 Red Hat Enterprise Linux (RHEL), CentOS and Fedora Red Hat Enterprise Linux, its community derivatives such as CentOS, and Fedora come with MySQL and DBD::mysql. Use the following command to install DBD::mysql: yum install "perl(DBD::mysql)" =head2 Debian and Ubuntu On Debian, Ubuntu and derivatives you can install DBD::mysql from the repositories with the following command: sudo apt-get install libdbd-mysql-perl =head2 SLES and openSUSE On SUSE Linux Enterprise and the community version openSUSE, you can install DBD::mysql from the repositories with the following command: zypper install perl-DBD-mysql =head2 Other systems In the case of other Linux or FreeBSD distributions it is very likely that all you need comes with your distribution. I just cannot give you names, as I am not using these systems. Please let me know if you find the files in your favorite Linux or FreeBSD distribution so that I can extend the above list. =head1 SOURCE INSTALLATION So you need to install from sources. If you are lucky, the Perl module C will do all for you, thanks to the excellent work of Andreas König. Otherwise you will need to do a manual installation. All of these installation types have their own section: L, L and L. The DBD::mysql Makefile.PL needs to know where to find your MySQL installation. This may be achieved using command line switches (see L) or automatically using the mysql_config binary which comes with most MySQL distributions. If your MySQL distribution contains mysql_config the easiest method is to ensure this binary is on your path. Typically, this is the case if you've installed the mysql library from your systems' package manager. e.g. PATH=$PATH:/usr/local/mysql/bin export PATH As stated, to compile DBD::mysql you'll need a C compiler. This should be the same compiler as the one used to build perl AND the mysql client libraries. If you're on linux, this is most typically the case and you need not worry. If you're on UNIX systems, you might want to pay attention. Also you'll need to get the MySQL client and development headers on your system. The easiest is to get these from your package manager. To run the tests that ship with the module, you'll need access to a running MySQL server. This can be running on localhost, but it can also be on a remote machine. On Fedora the process is as follows. Please note that Fedora actually ships with MariaDB but not with MySQL. This is not a problem, it will work just as well. In this example we install and start a local server for running the tests against. yum -y install make gcc mariadb-devel mariadb-libs mariadb-server yum -y install "perl(Test::Deep)" "perl(Test::More)" systemctl start mariadb.service =head2 Environment Variables For ease of use, you can set environment variables for DBD::mysql installation. You can set any or all of the options, and export them by putting them in your .bashrc or the like: export DBD_MYSQL_CFLAGS=-I/usr/local/mysql/include/mysql export DBD_MYSQL_LIBS="-L/usr/local/mysql/lib/mysql -lmysqlclient" export DBD_MYSQL_EMBEDDED= export DBD_MYSQL_CONFIG=mysql_config export DBD_MYSQL_NOCATCHSTDERR=0 export DBD_MYSQL_NOFOUNDROWS=0 export DBD_MYSQL_NOSSL= export DBD_MYSQL_TESTDB=test export DBD_MYSQL_TESTHOST=localhost export DBD_MYSQL_TESTPASSWORD=s3kr1+ export DBD_MYSQL_TESTPORT=3306 export DBD_MYSQL_TESTUSER=me The most useful may be the host, database, port, socket, user, and password. Installation will first look to your mysql_config, and then your environment variables, and then it will guess with intelligent defaults. =head2 CPAN installation Installation of DBD::mysql can be incredibly easy: cpan DBD::mysql Please note that this will only work if the prerequisites are fulfilled, which means you have a C-compiler installed, and you have the development headers and mysql client libraries available on your system. If you are using the CPAN module for the first time, just answer the questions by accepting the defaults which are fine in most cases. If you cannot get the CPAN module working, you might try manual installation. If installation with CPAN fails because the your local settings have been guessed wrong, you need to ensure MySQL's mysql_config is on your path (see L) or alternatively create a script called C. This is described in more details later. L. =head2 Manual installation For a manual installation you need to fetch the DBD::mysql source distribution. The latest version is always available from https://metacpan.org/module/DBD::mysql The name is typically something like DBD-mysql-4.025.tar.gz The archive needs to be extracted. On Windows you may use a tool like 7-zip, on *nix you type tar xf DBD-mysql-4.025.tar.gz This will create a subdirectory DBD-mysql-4.025. Enter this subdirectory and type perl Makefile.PL make make test (On Windows you may need to replace "make" with "dmake" or "nmake".) If the tests seem to look fine, you may continue with make install If the compilation (make) or tests fail, you might need to configure some settings. For example you might choose a different database, the C compiler or the linker might need some flags. L. L. L. For Cygwin there is a special section below. L. =head2 Configuration The install script "Makefile.PL" can be configured via a lot of switches. All switches can be used on the command line. For example, the test database: perl Makefile.PL --testdb= If you do not like configuring these switches on the command line, you may alternatively create a script called C. This is described later on. Available switches are: =over =item testdb Name of the test database, defaults to B. =item testuser Name of the test user, defaults to empty. If the name is empty, then the currently logged in users name will be used. =item testpassword Password of the test user, defaults to empty. =item testhost Host name or IP number of the test database; defaults to localhost. =item testport Port number of the test database =item ps-protcol=1 or 0 Whether to run the test suite using server prepared statements or driver emulated prepared statements. ps-protocol=1 means use server prepare, ps-protocol=0 means driver emulated. =item cflags This is a list of flags that you want to give to the C compiler. The most important flag is the location of the MySQL header files. For example, on Red Hat Linux the header files are in /usr/include/mysql and you might try -I/usr/include/mysql On Windows the header files may be in C:\mysql\include and you might try -IC:\mysql\include The default flags are determined by running mysql_config --cflags More details on the C compiler flags can be found in the following section. L. =item libs This is a list of flags that you want to give to the linker or loader. The most important flags are the locations and names of additional libraries. For example, on Red Hat Linux your MySQL client libraries are in /usr/lib/mysql and you might try -L/usr/lib/mysql -lmysqlclient -lz On Windows the libraries may be in C:\mysql\lib and -LC:\mysql\lib -lmysqlclient might be a good choice. The default flags are determined by running mysql_config --libs More details on the linker flags can be found in a separate section. L. =back If a switch is not present on the command line, then the script C will be executed. This script comes as part of the MySQL distribution. For example, to determine the C compiler flags, we are executing mysql_config --cflags mysql_config --libs If you want to configure your own settings for database name, database user and so on, then you have to create a script with the same name, that replies =head2 Compiler flags Note: the following info about compiler and linker flags, you shouldn't have to use these options because Makefile.PL is pretty good at utilizing mysql_config to get the flags that you need for a successful compile. It is typically not so difficult to determine the appropriate flags for the C compiler. The linker flags, which you find in the next section, are another story. The determination of the C compiler flags is usually left to a configuration script called F, which can be invoked with mysql_config --cflags When doing so, it will emit a line with suggested C compiler flags, for example like this: -L/usr/include/mysql The C compiler must find some header files. Header files have the extension C<.h>. MySQL header files are, for example, F and F. In most cases the header files are not installed by default. For example, on Windows it is an installation option of the MySQL setup program (Custom installation), whether the header files are installed or not. On Red Hat Linux, you need to install an RPM archive F or F. If you know the location of the header files, then you will need to add an option -L
to the C compiler flags, for example C<-L/usr/include/mysql>. =head2 Linker flags Appropriate linker flags are the most common source of problems while installing DBD::mysql. I will only give a rough overview, you'll find more details in the troubleshooting section. L The determination of the C compiler flags is usually left to a configuration script called F, which can be invoked with mysql_config --libs When doing so, it will emit a line with suggested C compiler flags, for example like this: -L'/usr/lib/mysql' -lmysqlclient -lnsl -lm -lz -lcrypt The following items typically need to be configured for the linker: =over =item The mysqlclient library The MySQL client library comes as part of the MySQL distribution. Depending on your system it may be a file called F statically linked library, Unix F dynamically linked library, Unix F statically linked library, Windows F dynamically linked library, Windows or something similar. As in the case of the header files, the client library is typically not installed by default. On Windows you will need to select them while running the MySQL setup program (Custom installation). On Red Hat Linux an RPM archive F or F must be installed. The linker needs to know the location and name of the mysqlclient library. This can be done by adding the flags -L -lmysqlclient or by adding the complete path name. Examples: -L/usr/lib/mysql -lmysqlclient -LC:\mysql\lib -lmysqlclient If you would like to use the static libraries (and there are excellent reasons to do so), you need to create a separate directory, copy the static libraries to that place and use the -L switch above to point to your new directory. For example: mkdir /tmp/mysql-static cp /usr/lib/mysql/*.a /tmp/mysql-static perl Makefile.PL --libs="-L/tmp/mysql-static -lmysqlclient" make make test make install rm -rf /tmp/mysql-static =item The gzip library The MySQL client can use compression when talking to the MySQL server, a nice feature when sending or receiving large texts over a slow network. On Unix you typically find the appropriate file name by running ldconfig -p | grep libz ldconfig -p | grep libgz Once you know the name (libz.a or libgz.a is best), just add it to the list of linker flags. If this seems to be causing problem you may also try to link without gzip libraries. =back =head1 ENCRYPTED CONNECTIONS via SSL Connecting to your servers over an encrypted connection (SSL) is only possible if you enabled this setting at build time. Since version 4.034, this is the default. Attempting to connect to a server that requires an encrypted connection without first having L compiled with the C<--ssl> option will result in an error that makes things appear as if your password is incorrect. If you want to compile L without SSL support, which you might probably only want if you for some reason can't install libssl headers, you can do this by passing the C<--nossl> option to Makefile.PL or by setting the DBD_MYSQL_NOSSL environment variable to '1'. =head1 MARIADB NATIVE CLIENT INSTALLATION The MariaDB native client is another option for connecting to a MySQL· database licensed LGPL 2.1. To build DBD::mysql against this client, you will first need to build the client. Generally, this is done with the following: cd path/to/src/mariadb-native-client cmake -G "Unix Makefiles' make sudo make install Once the client is built and installed, you can build DBD::mysql against it: perl Makefile.PL --testuser=xxx --testpassword=xxx --testsocket=/path/to//mysqld.sock --mysql_config=/usr/local/bin/mariadb_config· make make test make install =head1 SPECIAL SYSTEMS Below you find information on particular systems: =head2 macOS For installing DBD::mysql you need to have the libssl header files and the mysql client libs. The easiest way to install these is using Homebrew (L). Once you have Homebrew set up, you can simply install the dependencies using brew install openssl mysql-connector-c Then you can install DBD::mysql using your cpan client. =head2 Cygwin If you are a user of Cygwin you already know, it contains a nicely running perl 5.6.1, installation of additional modules usually works like a charm via the standard procedure of perl makefile.PL make make test make install The Windows binary distribution of MySQL runs smoothly under Cygwin. You can start/stop the server and use all Windows clients without problem. But to install DBD::mysql you have to take a little special action. Don't attempt to build DBD::mysql against either the MySQL Windows or Linux/Unix BINARY distributions: neither will work! You MUST compile the MySQL clients yourself under Cygwin, to get a 'libmysqlclient.a' compiled under Cygwin. Really! You'll only need that library and the header files, you don't need any other client parts. Continue to use the Windows binaries. And don't attempt (currently) to build the MySQL Server part, it is unnecessary, as MySQL AB does an excellent job to deliver optimized binaries for the mainstream operating systems, and it is told, that the server compiled under Cygwin is unstable. Install a MySQL server for testing against. You can install the regular Windows MySQL server package on your Windows machine, or you can also test against a MySQL server on a remote host. =head3 Build MySQL clients under Cygwin: download the MySQL LINUX source from L, unpack mysql-.tar.gz into some tmp location and from this directory run configure: ./configure --prefix=/usr/local/mysql --without-server This prepares the Makefile with the installed Cygwin features. It takes some time, but should finish without error. The 'prefix', as given, installs the whole Cygwin/MySQL thingy into a location not normally in your PATH, so that you continue to use already installed Windows binaries. The --without-server parameter tells configure to only build the clients. make This builds all MySQL client parts ... be patient. It should finish finally without any error. make install This installs the compiled client files under /usr/local/mysql/. Remember, you don't need anything except the library under /usr/local/mysql/lib and the headers under /usr/local/mysql/include! Essentially you are now done with this part. If you want, you may try your compiled binaries shortly; for that, do: cd /usr/local/mysql/bin ./mysql -h 127.0.0.1 The host (-h) parameter 127.0.0.1 targets the local host, but forces the mysql client to use a TCP/IP connection. The default would be a pipe/socket connection (even if you say '-h localhost') and this doesn't work between Cygwin and Windows (as far as I know). If you have your MySQL server running on some other box, then please substitute '127.0.0.1' with the name or IP-number of that box. Please note, in my environment the 'mysql' client did not accept a simple RETURN, I had to use CTRL-RETURN to send commands ... strange, but I didn't attempt to fix that, as we are only interested in the built lib and headers. At the 'mysql>' prompt do a quick check: mysql> use mysql mysql> show tables; mysql> select * from db; mysql> exit You are now ready to build DBD::mysql! =head3 compile DBD::mysql download and extract DBD-mysql-.tar.gz from CPAN cd into unpacked dir DBD-mysql- you probably did that already, if you are reading this! cp /usr/local/mysql/bin/mysql_config . This copies the executable script mentioned in the DBD::mysql docs from your just built Cywin/MySQL client directory; it knows about your Cygwin installation, especially about the right libraries to link with. perl Makefile.PL --testhost=127.0.0.1 The --testhost=127.0.0.1 parameter again forces a TCP/IP connection to the MySQL server on the local host instead of a pipe/socket connection for the 'make test' phase. make This should run without error make test make install This installs DBD::mysql into the Perl hierarchy. =head1 KNOWN PROBLEMS =head2 no gzip on your system Some Linux distributions don't come with a gzip library by default. Running "make" terminates with an error message like LD_RUN_PATH="/usr/lib/mysql:/lib:/usr/lib" gcc -o blib/arch/auto/DBD/mysql/mysql.so -shared -L/usr/local/lib dbdimp.o mysql.o -L/usr/lib/mysql -lmysqlclient -lm -L/usr/lib/gcc-lib/i386-redhat-linux/2.96 -lgcc -lz /usr/bin/ld: cannot find -lz collect2: ld returned 1 exit status make: *** [blib/arch/auto/DBD/mysql/mysql.so] Error 1 If this is the case for you, install an RPM archive like libz-devel, libgz-devel, zlib-devel or gzlib-devel or something similar. =head2 different compiler for mysql and perl If Perl was compiled with gcc or egcs, but MySQL was compiled with another compiler or on another system, an error message like this is very likely when running "Make test": t/00base............install_driver(mysql) failed: Can't load '../blib/arch/auto/DBD/mysql/mysql.so' for module DBD::mysql: ../blib/arch/auto/DBD/mysql/mysql.so: undefined symbol: _umoddi3 at /usr/local/perl-5.005/lib/5.005/i586-linux-thread/DynaLoader.pm line 168. This means, that your linker doesn't include libgcc.a. You have the following options: The solution is telling the linker to use libgcc. Run gcc --print-libgcc-file to determine the exact location of libgcc.a or for older versions of gcc gcc -v to determine the directory. If you know the directory, add a -L -lgcc to the list of C compiler flags. L. L. =head1 SUPPORT Finally, if everything else fails, you are not alone. First of all, for an immediate answer, you should look into the archives of the dbi-users mailing list, which is available at L To subscribe to this list, send and email to dbi-users-subscribe@perl.org If you don't find an appropriate posting and reply in the mailing list, please post a question. Typically a reply will be seen within one or two days. DBD-mysql-4.054/lib/DBD/mysql/GetInfo.pm0000644000175000017500000003736215043617710020142 0ustar dvaneedendvaneedenpackage DBD::mysql::GetInfo; ######################################## # DBD::mysql::GetInfo # # # Generated by DBI::DBD::Metadata # $Author$ <-- the person to blame # $Revision$ # $Date$ use strict; use warnings; use DBD::mysql; # Beware: not officially documented interfaces... # use DBI::Const::GetInfoType qw(%GetInfoType); # use DBI::Const::GetInfoReturn qw(%GetInfoReturnTypes %GetInfoReturnValues); my $sql_driver = 'mysql'; # SQL_DRIVER_VER should be formatted as dd.dd.dddd my $dbdversion = $DBD::mysql::VERSION; $dbdversion .= '_00' if $dbdversion =~ /^\d+\.\d+$/; my $sql_driver_ver = sprintf("%02d.%02d.%04d", split(/[\._]/,$dbdversion)); my @Keywords = qw( BIGINT BLOB DEFAULT KEYS LIMIT LONGBLOB MEDIMUMBLOB MEDIUMINT MEDIUMTEXT PROCEDURE REGEXP RLIKE SHOW TABLES TINYBLOB TINYTEXT UNIQUE UNSIGNED ZEROFILL ); sub sql_keywords { return join ',', @Keywords; } sub sql_data_source_name { my $dbh = shift; return "dbi:$sql_driver:" . $dbh->{Name}; } sub sql_user_name { my $dbh = shift; # Non-standard attribute return $dbh->{CURRENT_USER}; } #################### # makefunc() # returns a ref to a sub that calls into XS to get # values for info types that must needs be coded in C sub makefunk ($) { my $type = shift; return sub {dbd_mysql_get_info(shift, $type)} } our %info = ( 20 => 'N', # SQL_ACCESSIBLE_PROCEDURES 19 => 'Y', # SQL_ACCESSIBLE_TABLES 0 => 0, # SQL_ACTIVE_CONNECTIONS 116 => 0, # SQL_ACTIVE_ENVIRONMENTS 1 => 0, # SQL_ACTIVE_STATEMENTS 169 => 127, # SQL_AGGREGATE_FUNCTIONS 117 => 0, # SQL_ALTER_DOMAIN 86 => 3, # SQL_ALTER_TABLE 10021 => makefunk 10021, # SQL_ASYNC_MODE 120 => 2, # SQL_BATCH_ROW_COUNT 121 => 2, # SQL_BATCH_SUPPORT 82 => 0, # SQL_BOOKMARK_PERSISTENCE 114 => 1, # SQL_CATALOG_LOCATION 10003 => 'Y', # SQL_CATALOG_NAME 41 => makefunk 41, # SQL_CATALOG_NAME_SEPARATOR 42 => makefunk 42, # SQL_CATALOG_TERM 92 => 29, # SQL_CATALOG_USAGE 10004 => '', # SQL_COLLATING_SEQUENCE 10004 => '', # SQL_COLLATION_SEQ 87 => 'Y', # SQL_COLUMN_ALIAS 22 => 0, # SQL_CONCAT_NULL_BEHAVIOR 53 => 259071, # SQL_CONVERT_BIGINT 54 => 0, # SQL_CONVERT_BINARY 55 => 259071, # SQL_CONVERT_BIT 56 => 259071, # SQL_CONVERT_CHAR 57 => 259071, # SQL_CONVERT_DATE 58 => 259071, # SQL_CONVERT_DECIMAL 59 => 259071, # SQL_CONVERT_DOUBLE 60 => 259071, # SQL_CONVERT_FLOAT 48 => 0, # SQL_CONVERT_FUNCTIONS # 173 => undef, # SQL_CONVERT_GUID 61 => 259071, # SQL_CONVERT_INTEGER 123 => 0, # SQL_CONVERT_INTERVAL_DAY_TIME 124 => 0, # SQL_CONVERT_INTERVAL_YEAR_MONTH 71 => 0, # SQL_CONVERT_LONGVARBINARY 62 => 259071, # SQL_CONVERT_LONGVARCHAR 63 => 259071, # SQL_CONVERT_NUMERIC 64 => 259071, # SQL_CONVERT_REAL 65 => 259071, # SQL_CONVERT_SMALLINT 66 => 259071, # SQL_CONVERT_TIME 67 => 259071, # SQL_CONVERT_TIMESTAMP 68 => 259071, # SQL_CONVERT_TINYINT 69 => 0, # SQL_CONVERT_VARBINARY 70 => 259071, # SQL_CONVERT_VARCHAR 122 => 0, # SQL_CONVERT_WCHAR 125 => 0, # SQL_CONVERT_WLONGVARCHAR 126 => 0, # SQL_CONVERT_WVARCHAR 74 => 1, # SQL_CORRELATION_NAME 127 => 0, # SQL_CREATE_ASSERTION 128 => 0, # SQL_CREATE_CHARACTER_SET 129 => 0, # SQL_CREATE_COLLATION 130 => 0, # SQL_CREATE_DOMAIN 131 => 0, # SQL_CREATE_SCHEMA 132 => 1045, # SQL_CREATE_TABLE 133 => 0, # SQL_CREATE_TRANSLATION 134 => 0, # SQL_CREATE_VIEW 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR 10001 => 0, # SQL_CURSOR_SENSITIVITY 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME 25 => 'N', # SQL_DATA_SOURCE_READ_ONLY 119 => 7, # SQL_DATETIME_LITERALS 17 => 'MySQL', # SQL_DBMS_NAME 18 => makefunk 18, # SQL_DBMS_VER 170 => 3, # SQL_DDL_INDEX 26 => 2, # SQL_DEFAULT_TRANSACTION_ISOLATION 26 => 2, # SQL_DEFAULT_TXN_ISOLATION 10002 => 'N', # SQL_DESCRIBE_PARAMETER # 171 => undef, # SQL_DM_VER 3 => 137076632, # SQL_DRIVER_HDBC # 135 => undef, # SQL_DRIVER_HDESC 4 => 137076088, # SQL_DRIVER_HENV # 76 => undef, # SQL_DRIVER_HLIB # 5 => undef, # SQL_DRIVER_HSTMT 6 => 'libmyodbc3.so', # SQL_DRIVER_NAME 77 => '03.51', # SQL_DRIVER_ODBC_VER 7 => $sql_driver_ver, # SQL_DRIVER_VER 136 => 0, # SQL_DROP_ASSERTION 137 => 0, # SQL_DROP_CHARACTER_SET 138 => 0, # SQL_DROP_COLLATION 139 => 0, # SQL_DROP_DOMAIN 140 => 0, # SQL_DROP_SCHEMA 141 => 7, # SQL_DROP_TABLE 142 => 0, # SQL_DROP_TRANSLATION 143 => 0, # SQL_DROP_VIEW 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY 8 => 63, # SQL_FETCH_DIRECTION 84 => 0, # SQL_FILE_USAGE 146 => 97863, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 147 => 6016, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 81 => 11, # SQL_GETDATA_EXTENSIONS 88 => 3, # SQL_GROUP_BY 28 => 4, # SQL_IDENTIFIER_CASE #29 => sub {dbd_mysql_get_info(shift,$GetInfoType {SQL_IDENTIFIER_QUOTE_CHAR})}, 29 => makefunk 29, # SQL_IDENTIFIER_QUOTE_CHAR 148 => 0, # SQL_INDEX_KEYWORDS 149 => 0, # SQL_INFO_SCHEMA_VIEWS 172 => 7, # SQL_INSERT_STATEMENT 73 => 'N', # SQL_INTEGRITY 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 89 => \&sql_keywords, # SQL_KEYWORDS 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE 78 => 0, # SQL_LOCK_TYPES 34 => 64, # SQL_MAXIMUM_CATALOG_NAME_LENGTH 97 => 0, # SQL_MAXIMUM_COLUMNS_IN_GROUP_BY 98 => 32, # SQL_MAXIMUM_COLUMNS_IN_INDEX 99 => 0, # SQL_MAXIMUM_COLUMNS_IN_ORDER_BY 100 => 0, # SQL_MAXIMUM_COLUMNS_IN_SELECT 101 => 0, # SQL_MAXIMUM_COLUMNS_IN_TABLE 30 => 64, # SQL_MAXIMUM_COLUMN_NAME_LENGTH 1 => 0, # SQL_MAXIMUM_CONCURRENT_ACTIVITIES 31 => 18, # SQL_MAXIMUM_CURSOR_NAME_LENGTH 0 => 0, # SQL_MAXIMUM_DRIVER_CONNECTIONS 10005 => 64, # SQL_MAXIMUM_IDENTIFIER_LENGTH 102 => 500, # SQL_MAXIMUM_INDEX_SIZE 104 => 0, # SQL_MAXIMUM_ROW_SIZE 32 => 0, # SQL_MAXIMUM_SCHEMA_NAME_LENGTH 105 => makefunk 105, # SQL_MAXIMUM_STATEMENT_LENGTH # 20000 => undef, # SQL_MAXIMUM_STMT_OCTETS # 20001 => undef, # SQL_MAXIMUM_STMT_OCTETS_DATA # 20002 => undef, # SQL_MAXIMUM_STMT_OCTETS_SCHEMA 106 => makefunk 106, # SQL_MAXIMUM_TABLES_IN_SELECT 35 => 64, # SQL_MAXIMUM_TABLE_NAME_LENGTH 107 => 16, # SQL_MAXIMUM_USER_NAME_LENGTH 10022 => makefunk 10022, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS 112 => 0, # SQL_MAX_BINARY_LITERAL_LEN 34 => 64, # SQL_MAX_CATALOG_NAME_LEN 108 => 0, # SQL_MAX_CHAR_LITERAL_LEN 97 => 0, # SQL_MAX_COLUMNS_IN_GROUP_BY 98 => 32, # SQL_MAX_COLUMNS_IN_INDEX 99 => 0, # SQL_MAX_COLUMNS_IN_ORDER_BY 100 => 0, # SQL_MAX_COLUMNS_IN_SELECT 101 => 0, # SQL_MAX_COLUMNS_IN_TABLE 30 => 64, # SQL_MAX_COLUMN_NAME_LEN 1 => 0, # SQL_MAX_CONCURRENT_ACTIVITIES 31 => 18, # SQL_MAX_CURSOR_NAME_LEN 0 => 0, # SQL_MAX_DRIVER_CONNECTIONS 10005 => 64, # SQL_MAX_IDENTIFIER_LEN 102 => 500, # SQL_MAX_INDEX_SIZE 32 => 0, # SQL_MAX_OWNER_NAME_LEN 33 => 0, # SQL_MAX_PROCEDURE_NAME_LEN 34 => 64, # SQL_MAX_QUALIFIER_NAME_LEN 104 => 0, # SQL_MAX_ROW_SIZE 103 => 'Y', # SQL_MAX_ROW_SIZE_INCLUDES_LONG 32 => 0, # SQL_MAX_SCHEMA_NAME_LEN 105 => 8192, # SQL_MAX_STATEMENT_LEN 106 => 31, # SQL_MAX_TABLES_IN_SELECT 35 => makefunk 35, # SQL_MAX_TABLE_NAME_LEN 107 => 16, # SQL_MAX_USER_NAME_LEN 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN 36 => 'Y', # SQL_MULT_RESULT_SETS 111 => 'N', # SQL_NEED_LONG_DATA_LEN 75 => 1, # SQL_NON_NULLABLE_COLUMNS 85 => 2, # SQL_NULL_COLLATION 49 => 16777215, # SQL_NUMERIC_FUNCTIONS 9 => 1, # SQL_ODBC_API_CONFORMANCE 152 => 2, # SQL_ODBC_INTERFACE_CONFORMANCE 12 => 1, # SQL_ODBC_SAG_CLI_CONFORMANCE 15 => 1, # SQL_ODBC_SQL_CONFORMANCE 73 => 'N', # SQL_ODBC_SQL_OPT_IEF 10 => '03.80', # SQL_ODBC_VER 115 => 123, # SQL_OJ_CAPABILITIES 90 => 'Y', # SQL_ORDER_BY_COLUMNS_IN_SELECT 38 => 'Y', # SQL_OUTER_JOINS 115 => 123, # SQL_OUTER_JOIN_CAPABILITIES 39 => '', # SQL_OWNER_TERM 91 => 0, # SQL_OWNER_USAGE 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS 154 => 3, # SQL_PARAM_ARRAY_SELECTS 80 => 3, # SQL_POSITIONED_STATEMENTS 79 => 31, # SQL_POS_OPERATIONS 21 => 'N', # SQL_PROCEDURES 40 => '', # SQL_PROCEDURE_TERM 114 => 1, # SQL_QUALIFIER_LOCATION 41 => '.', # SQL_QUALIFIER_NAME_SEPARATOR 42 => 'database', # SQL_QUALIFIER_TERM 92 => 29, # SQL_QUALIFIER_USAGE 93 => 3, # SQL_QUOTED_IDENTIFIER_CASE 11 => 'N', # SQL_ROW_UPDATES 39 => '', # SQL_SCHEMA_TERM 91 => 0, # SQL_SCHEMA_USAGE 43 => 7, # SQL_SCROLL_CONCURRENCY 44 => 17, # SQL_SCROLL_OPTIONS 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE 13 => makefunk 13, # SQL_SERVER_NAME 94 => 'ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜáíóúñÑ', # SQL_SPECIAL_CHARACTERS 155 => 7, # SQL_SQL92_DATETIME_FUNCTIONS 156 => 0, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE 157 => 0, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE 158 => 8160, # SQL_SQL92_GRANT 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS 160 => 0, # SQL_SQL92_PREDICATES 161 => 466, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS 162 => 32640, # SQL_SQL92_REVOKE 163 => 7, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR 164 => 255, # SQL_SQL92_STRING_FUNCTIONS 165 => 0, # SQL_SQL92_VALUE_EXPRESSIONS 118 => 4, # SQL_SQL_CONFORMANCE 166 => 2, # SQL_STANDARD_CLI_CONFORMANCE 167 => 97863, # SQL_STATIC_CURSOR_ATTRIBUTES1 168 => 6016, # SQL_STATIC_CURSOR_ATTRIBUTES2 83 => 7, # SQL_STATIC_SENSITIVITY 50 => 491519, # SQL_STRING_FUNCTIONS 95 => 0, # SQL_SUBQUERIES 51 => 7, # SQL_SYSTEM_FUNCTIONS 45 => 'table', # SQL_TABLE_TERM 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS 52 => 106495, # SQL_TIMEDATE_FUNCTIONS 46 => 3, # SQL_TRANSACTION_CAPABLE 72 => 15, # SQL_TRANSACTION_ISOLATION_OPTION 46 => 3, # SQL_TXN_CAPABLE 72 => 15, # SQL_TXN_ISOLATION_OPTION 96 => 0, # SQL_UNION 96 => 0, # SQL_UNION_STATEMENT 47 => \&sql_user_name, # SQL_USER_NAME 10000 => 1992, # SQL_XOPEN_CLI_YEAR ); 1; __END__ DBD-mysql-4.054/lib/DBD/mysql.pm0000644000175000017500000017504315043620051016576 0ustar dvaneedendvaneeden#!/usr/bin/perl use strict; use warnings; require 5.008_001; # just as DBI package DBD::mysql; use DBI; use DynaLoader(); use Carp; our @ISA = qw(DynaLoader); # please make sure the sub-version does not increase above '099' # SQL_DRIVER_VER is formatted as dd.dd.dddd # for version 5.x please switch to 5.00(_00) version numbering # keep $VERSION in Bundle/DBD/mysql.pm in sync our $VERSION = '4.054'; bootstrap DBD::mysql $VERSION; our $err = 0; # holds error code for DBI::err our $errstr = ""; # holds error string for DBI::errstr our $drh = undef; # holds driver handle once initialised my $methods_are_installed = 0; sub driver{ return $drh if $drh; my($class, $attr) = @_; $class .= "::dr"; # not a 'my' since we use it above to prevent multiple drivers $drh = DBI::_new_drh($class, { 'Name' => 'mysql', 'Version' => $VERSION, 'Err' => \$DBD::mysql::err, 'Errstr' => \$DBD::mysql::errstr, 'Attribution' => 'DBD::mysql by Patrick Galbraith' }); if (!$methods_are_installed) { DBD::mysql::db->install_method('mysql_fd'); DBD::mysql::db->install_method('mysql_async_result'); DBD::mysql::db->install_method('mysql_async_ready'); DBD::mysql::st->install_method('mysql_async_result'); DBD::mysql::st->install_method('mysql_async_ready'); $methods_are_installed++; } $drh; } sub CLONE { undef $drh; } sub _OdbcParse($$$) { my($class, $dsn, $hash, $args) = @_; my($var, $val); if (!defined($dsn)) { return; } while (length($dsn)) { if ($dsn =~ /([^:;]*\[.*]|[^:;]*)[:;](.*)/) { $val = $1; $dsn = $2; $val =~ s/\[|]//g; # Remove [] if present, the rest of the code prefers plain IPv6 addresses } else { $val = $dsn; $dsn = ''; } if ($val =~ /([^=]*)=(.*)/) { $var = $1; $val = $2; if ($var eq 'hostname' || $var eq 'host') { $hash->{'host'} = $val; } elsif ($var eq 'db' || $var eq 'dbname') { $hash->{'database'} = $val; } else { $hash->{$var} = $val; } } else { foreach $var (@$args) { if (!defined($hash->{$var})) { $hash->{$var} = $val; last; } } } } } sub _OdbcParseHost ($$) { my($class, $dsn) = @_; my($hash) = {}; $class->_OdbcParse($dsn, $hash, ['host', 'port']); ($hash->{'host'}, $hash->{'port'}); } sub AUTOLOAD { my ($meth) = $DBD::mysql::AUTOLOAD; my ($smeth) = $meth; $smeth =~ s/(.*)\:\://; my $val = constant($smeth, @_ ? $_[0] : 0); if ($! == 0) { eval "sub $meth { $val }"; return $val; } Carp::croak "$meth: Not defined"; } 1; package DBD::mysql::dr; # ====== DRIVER ====== use strict; use DBI qw(:sql_types); use DBI::Const::GetInfoType; sub connect { my($drh, $dsn, $username, $password, $attrhash) = @_; my($port); my($cWarn); my $connect_ref= { 'Name' => $dsn }; my $dbi_imp_data; # Avoid warnings for undefined values $username ||= ''; $password ||= ''; $attrhash ||= {}; $attrhash->{mysql_conn_attrs} ||= {}; $attrhash->{mysql_conn_attrs}->{'program_name'} ||= $0; # create a 'blank' dbh my($this, $privateAttrHash) = (undef, $attrhash); $privateAttrHash = { %$privateAttrHash, 'Name' => $dsn, 'user' => $username, 'password' => $password }; DBD::mysql->_OdbcParse($dsn, $privateAttrHash, ['database', 'host', 'port']); $dbi_imp_data = delete $attrhash->{dbi_imp_data}; $connect_ref->{'dbi_imp_data'} = $dbi_imp_data; if (!defined($this = DBI::_new_dbh($drh, $connect_ref, $privateAttrHash))) { return undef; } DBD::mysql::db::_login($this, $dsn, $username, $password) or $this = undef; if ($this && ($ENV{MOD_PERL} || $ENV{GATEWAY_INTERFACE})) { $this->{mysql_auto_reconnect} = 1; } $this; } sub data_sources { my($self) = shift; my($attributes) = shift; my($host, $port, $user, $password) = ('', '', '', ''); if ($attributes) { $host = $attributes->{host} || ''; $port = $attributes->{port} || ''; $user = $attributes->{user} || ''; $password = $attributes->{password} || ''; } my(@dsn) = $self->func($host, $port, $user, $password, '_ListDBs'); my($i); for ($i = 0; $i < @dsn; $i++) { $dsn[$i] = "DBI:mysql:$dsn[$i]"; } @dsn; } sub admin { my($drh) = shift; my($command) = shift; my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ? shift : ''; my($host, $port) = DBD::mysql->_OdbcParseHost(shift(@_) || ''); my($user) = shift || ''; my($password) = shift || ''; $drh->func(undef, $command, $dbname || '', $host || '', $port || '', $user, $password, '_admin_internal'); } package DBD::mysql::db; # ====== DATABASE ====== use strict; use DBI qw(:sql_types); %DBD::mysql::db::db2ANSI = ( "INT" => "INTEGER", "CHAR" => "CHAR", "REAL" => "REAL", "IDENT" => "DECIMAL" ); ### ANSI datatype mapping to MySQL datatypes %DBD::mysql::db::ANSI2db = ( "CHAR" => "CHAR", "VARCHAR" => "CHAR", "LONGVARCHAR" => "CHAR", "NUMERIC" => "INTEGER", "DECIMAL" => "INTEGER", "BIT" => "INTEGER", "TINYINT" => "INTEGER", "SMALLINT" => "INTEGER", "INTEGER" => "INTEGER", "BIGINT" => "INTEGER", "REAL" => "REAL", "FLOAT" => "REAL", "DOUBLE" => "REAL", "BINARY" => "CHAR", "VARBINARY" => "CHAR", "LONGVARBINARY" => "CHAR", "DATE" => "CHAR", "TIME" => "CHAR", "TIMESTAMP" => "CHAR" ); sub prepare { my($dbh, $statement, $attribs)= @_; return unless $dbh->func('_async_check'); # create a 'blank' dbh my $sth = DBI::_new_sth($dbh, {'Statement' => $statement}); # Populate internal handle data. if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) { $sth = undef; } $sth; } sub db2ANSI { my $self = shift; my $type = shift; return $DBD::mysql::db::db2ANSI{"$type"}; } sub ANSI2db { my $self = shift; my $type = shift; return $DBD::mysql::db::ANSI2db{"$type"}; } sub admin { my($dbh) = shift; my($command) = shift; my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ? shift : ''; $dbh->{'Driver'}->func($dbh, $command, $dbname, '', '', '', '_admin_internal'); } sub _SelectDB ($$) { die "_SelectDB is removed from this module; use DBI->connect instead."; } sub table_info ($) { my ($dbh, $catalog, $schema, $table, $type, $attr) = @_; $dbh->{mysql_server_prepare}||= 0; my $mysql_server_prepare_save= $dbh->{mysql_server_prepare}; $dbh->{mysql_server_prepare}= 0; my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS); my @rows; my $sponge = DBI->connect("DBI:Sponge:", '','') or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); # Return the list of catalogs if (defined $catalog && $catalog eq "%" && (!defined($schema) || $schema eq "") && (!defined($table) || $table eq "")) { @rows = (); # Empty, because MySQL doesn't support catalogs (yet) } # Return the list of schemas elsif (defined $schema && $schema eq "%" && (!defined($catalog) || $catalog eq "") && (!defined($table) || $table eq "")) { my $sth = $dbh->prepare("SHOW DATABASES") or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return undef); $sth->execute() or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return DBI::set_err($dbh, $sth->err(), $sth->errstr())); while (my $ref = $sth->fetchrow_arrayref()) { push(@rows, [ undef, $ref->[0], undef, undef, undef ]); } } # Return the list of table types elsif (defined $type && $type eq "%" && (!defined($catalog) || $catalog eq "") && (!defined($schema) || $schema eq "") && (!defined($table) || $table eq "")) { @rows = ( [ undef, undef, undef, "TABLE", undef ], [ undef, undef, undef, "VIEW", undef ], ); } # Special case: a catalog other than undef, "", or "%" elsif (defined $catalog && $catalog ne "" && $catalog ne "%") { @rows = (); # Nothing, because MySQL doesn't support catalogs yet. } # Uh oh, we actually have a meaty table_info call. Work is required! else { my @schemas; # If no table was specified, we want them all $table ||= "%"; # If something was given for the schema, we need to expand it to # a list of schemas, since it may be a wildcard. if (defined $schema && $schema ne "") { my $sth = $dbh->prepare("SHOW DATABASES LIKE " . $dbh->quote($schema)) or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return undef); $sth->execute() or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return DBI::set_err($dbh, $sth->err(), $sth->errstr())); while (my $ref = $sth->fetchrow_arrayref()) { push @schemas, $ref->[0]; } } # Otherwise we want the current database else { push @schemas, $dbh->selectrow_array("SELECT DATABASE()"); } # Figure out which table types are desired my ($want_tables, $want_views); if (defined $type && $type ne "") { $want_tables = ($type =~ m/table/i); $want_views = ($type =~ m/view/i); } else { $want_tables = $want_views = 1; } for my $database (@schemas) { my $sth = $dbh->prepare("SHOW /*!50002 FULL*/ TABLES FROM " . $dbh->quote_identifier($database) . " LIKE " . $dbh->quote($table)) or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return undef); $sth->execute() or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return DBI::set_err($dbh, $sth->err(), $sth->errstr())); while (my $ref = $sth->fetchrow_arrayref()) { my $type = (defined $ref->[1] && $ref->[1] =~ /view/i) ? 'VIEW' : 'TABLE'; next if $type eq 'TABLE' && not $want_tables; next if $type eq 'VIEW' && not $want_views; push @rows, [ undef, $database, $ref->[0], $type, undef ]; } } } my $sth = $sponge->prepare("table_info", { rows => \@rows, NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return $dbh->DBI::set_err($sponge->err(), $sponge->errstr())); $dbh->{mysql_server_prepare}= $mysql_server_prepare_save; return $sth; } sub _ListTables { my $dbh = shift; if (!$DBD::mysql::QUIET) { warn "_ListTables is deprecated, use \$dbh->tables()"; } return map { $_ =~ s/.*\.//; $_ } $dbh->tables(); } sub column_info { my ($dbh, $catalog, $schema, $table, $column) = @_; return unless $dbh->func('_async_check'); $dbh->{mysql_server_prepare}||= 0; my $mysql_server_prepare_save= $dbh->{mysql_server_prepare}; $dbh->{mysql_server_prepare}= 0; # ODBC allows a NULL to mean all columns, so we'll accept undef $column = '%' unless defined $column; my $ER_NO_SUCH_TABLE= 1146; my $table_id = $dbh->quote_identifier($catalog, $schema, $table); my @names = qw( TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME DATA_TYPE TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS NUM_PREC_RADIX NULLABLE REMARKS COLUMN_DEF SQL_DATA_TYPE SQL_DATETIME_SUB CHAR_OCTET_LENGTH ORDINAL_POSITION IS_NULLABLE CHAR_SET_CAT CHAR_SET_SCHEM CHAR_SET_NAME COLLATION_CAT COLLATION_SCHEM COLLATION_NAME UDT_CAT UDT_SCHEM UDT_NAME DOMAIN_CAT DOMAIN_SCHEM DOMAIN_NAME SCOPE_CAT SCOPE_SCHEM SCOPE_NAME MAX_CARDINALITY DTD_IDENTIFIER IS_SELF_REF mysql_is_pri_key mysql_type_name mysql_values mysql_is_auto_increment ); my %col_info; local $dbh->{FetchHashKeyName} = 'NAME_lc'; # only ignore ER_NO_SUCH_TABLE in internal_execute if issued from here my $desc_sth = $dbh->prepare("DESCRIBE $table_id " . $dbh->quote($column)); my $desc = $dbh->selectall_arrayref($desc_sth, { Columns=>{} }); #return $desc_sth if $desc_sth->err(); if (my $err = $desc_sth->err()) { # return the error, unless it is due to the table not # existing per DBI spec if ($err != $ER_NO_SUCH_TABLE) { $dbh->{mysql_server_prepare}= $mysql_server_prepare_save; return undef; } $dbh->set_err(undef,undef); $desc = []; } my $ordinal_pos = 0; my @fields; for my $row (@$desc) { my $type = $row->{type}; $type =~ m/^(\w+)(\((.+)\))?\s?(.*)?$/; my $basetype = lc($1); my $typemod = $3; my $attr = $4; push @fields, $row->{field}; my $info = $col_info{ $row->{field} }= { TABLE_CAT => $catalog, TABLE_SCHEM => $schema, TABLE_NAME => $table, COLUMN_NAME => $row->{field}, NULLABLE => ($row->{null} eq 'YES') ? 1 : 0, IS_NULLABLE => ($row->{null} eq 'YES') ? "YES" : "NO", TYPE_NAME => uc($basetype), COLUMN_DEF => $row->{default}, ORDINAL_POSITION => ++$ordinal_pos, mysql_is_pri_key => ($row->{key} eq 'PRI'), mysql_type_name => $row->{type}, mysql_is_auto_increment => ($row->{extra} =~ /auto_increment/i ? 1 : 0), }; # # This code won't deal with a pathological case where a value # contains a single quote followed by a comma, and doesn't unescape # any escaped values. But who would use those in an enum or set? # my @type_params= ($typemod && index($typemod,"'")>=0) ? ("$typemod," =~ /'(.*?)',/g) # assume all are quoted : split /,/, $typemod||''; # no quotes, plain list s/''/'/g for @type_params; # undo doubling of quotes my @type_attr= split / /, $attr||''; $info->{DATA_TYPE}= SQL_VARCHAR(); if ($basetype =~ /^(char|varchar|\w*text|\w*blob)/) { $info->{DATA_TYPE}= SQL_CHAR() if $basetype eq 'char'; if ($type_params[0]) { $info->{COLUMN_SIZE} = $type_params[0]; } else { $info->{COLUMN_SIZE} = 65535; $info->{COLUMN_SIZE} = 255 if $basetype =~ /^tiny/; $info->{COLUMN_SIZE} = 16777215 if $basetype =~ /^medium/; $info->{COLUMN_SIZE} = 4294967295 if $basetype =~ /^long/; } } elsif ($basetype =~ /^(binary|varbinary)/) { $info->{COLUMN_SIZE} = $type_params[0]; # SQL_BINARY & SQL_VARBINARY are tempting here but don't match the # semantics for mysql (not hex). SQL_CHAR & SQL_VARCHAR are correct here. $info->{DATA_TYPE} = ($basetype eq 'binary') ? SQL_CHAR() : SQL_VARCHAR(); } elsif ($basetype =~ /^(enum|set)/) { if ($basetype eq 'set') { $info->{COLUMN_SIZE} = length(join ",", @type_params); } else { my $max_len = 0; length($_) > $max_len and $max_len = length($_) for @type_params; $info->{COLUMN_SIZE} = $max_len; } $info->{"mysql_values"} = \@type_params; } elsif ($basetype =~ /int/ || $basetype eq 'bit' ) { # big/medium/small/tiny etc + unsigned? $info->{DATA_TYPE} = SQL_INTEGER(); $info->{NUM_PREC_RADIX} = 10; $info->{COLUMN_SIZE} = $type_params[0]; } elsif ($basetype =~ /^decimal/) { $info->{DATA_TYPE} = SQL_DECIMAL(); $info->{NUM_PREC_RADIX} = 10; $info->{COLUMN_SIZE} = $type_params[0]; $info->{DECIMAL_DIGITS} = $type_params[1]; } elsif ($basetype =~ /^(float|double)/) { $info->{DATA_TYPE} = ($basetype eq 'float') ? SQL_FLOAT() : SQL_DOUBLE(); $info->{NUM_PREC_RADIX} = 2; $info->{COLUMN_SIZE} = ($basetype eq 'float') ? 32 : 64; } elsif ($basetype =~ /date|time/) { # date/datetime/time/timestamp if ($basetype eq 'time' or $basetype eq 'date') { #$info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TYPE_TIME() : SQL_TYPE_DATE(); $info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TIME() : SQL_DATE(); $info->{COLUMN_SIZE} = ($basetype eq 'time') ? 8 : 10; } else { # datetime/timestamp #$info->{DATA_TYPE} = SQL_TYPE_TIMESTAMP(); $info->{DATA_TYPE} = SQL_TIMESTAMP(); $info->{SQL_DATA_TYPE} = SQL_DATETIME(); $info->{SQL_DATETIME_SUB} = $info->{DATA_TYPE} - ($info->{SQL_DATA_TYPE} * 10); $info->{COLUMN_SIZE} = ($basetype eq 'datetime') ? 19 : $type_params[0] || 14; } $info->{DECIMAL_DIGITS}= 0; # no fractional seconds } elsif ($basetype eq 'year') { # no close standard so treat as int $info->{DATA_TYPE} = SQL_INTEGER(); $info->{NUM_PREC_RADIX} = 10; $info->{COLUMN_SIZE} = 4; } else { Carp::carp("column_info: unrecognized column type '$basetype' of $table_id.$row->{field} treated as varchar"); } $info->{SQL_DATA_TYPE} ||= $info->{DATA_TYPE}; #warn Dumper($info); } my $sponge = DBI->connect("DBI:Sponge:", '','') or ( $dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr")); my $sth = $sponge->prepare("column_info $table", { rows => [ map { [ @{$_}{@names} ] } map { $col_info{$_} } @fields ], NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or return ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && $dbh->DBI::set_err($sponge->err(), $sponge->errstr())); $dbh->{mysql_server_prepare}= $mysql_server_prepare_save; return $sth; } sub primary_key_info { my ($dbh, $catalog, $schema, $table) = @_; return unless $dbh->func('_async_check'); $dbh->{mysql_server_prepare}||= 0; my $mysql_server_prepare_save= $dbh->{mysql_server_prepare}; my $table_id = $dbh->quote_identifier($catalog, $schema, $table); my @names = qw( TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME ); my %col_info; local $dbh->{FetchHashKeyName} = 'NAME_lc'; my $desc_sth = $dbh->prepare("SHOW KEYS FROM $table_id"); my $desc= $dbh->selectall_arrayref($desc_sth, { Columns=>{} }); my $ordinal_pos = 0; for my $row (grep { $_->{key_name} eq 'PRIMARY'} @$desc) { $col_info{ $row->{column_name} }= { TABLE_CAT => $catalog, TABLE_SCHEM => $schema, TABLE_NAME => $table, COLUMN_NAME => $row->{column_name}, KEY_SEQ => $row->{seq_in_index}, PK_NAME => $row->{key_name}, }; } my $sponge = DBI->connect("DBI:Sponge:", '','') or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr")); my $sth= $sponge->prepare("primary_key_info $table", { rows => [ map { [ @{$_}{@names} ] } sort { $a->{KEY_SEQ} <=> $b->{KEY_SEQ} } values %col_info ], NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save && return $dbh->DBI::set_err($sponge->err(), $sponge->errstr())); $dbh->{mysql_server_prepare}= $mysql_server_prepare_save; return $sth; } sub foreign_key_info { my ($dbh, $pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table, ) = @_; return unless $dbh->func('_async_check'); # INFORMATION_SCHEMA.KEY_COLUMN_USAGE was added in 5.0.6 # no one is going to be running 5.0.6, taking out the check for $point > .6 my ($maj, $min, $point) = _version($dbh); return if $maj < 5 ; my $sql = <<'EOF'; SELECT NULL AS PKTABLE_CAT, A.REFERENCED_TABLE_SCHEMA AS PKTABLE_SCHEM, A.REFERENCED_TABLE_NAME AS PKTABLE_NAME, A.REFERENCED_COLUMN_NAME AS PKCOLUMN_NAME, A.TABLE_CATALOG AS FKTABLE_CAT, A.TABLE_SCHEMA AS FKTABLE_SCHEM, A.TABLE_NAME AS FKTABLE_NAME, A.COLUMN_NAME AS FKCOLUMN_NAME, A.ORDINAL_POSITION AS KEY_SEQ, NULL AS UPDATE_RULE, NULL AS DELETE_RULE, A.CONSTRAINT_NAME AS FK_NAME, NULL AS PK_NAME, NULL AS DEFERABILITY, NULL AS UNIQUE_OR_PRIMARY FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE A, INFORMATION_SCHEMA.TABLE_CONSTRAINTS B WHERE A.TABLE_SCHEMA = B.TABLE_SCHEMA AND A.TABLE_NAME = B.TABLE_NAME AND A.CONSTRAINT_NAME = B.CONSTRAINT_NAME AND B.CONSTRAINT_TYPE IS NOT NULL EOF my @where; my @bind; # catalogs are not yet supported by MySQL # if (defined $pk_catalog) { # push @where, 'A.REFERENCED_TABLE_CATALOG = ?'; # push @bind, $pk_catalog; # } if (defined $pk_schema) { push @where, 'A.REFERENCED_TABLE_SCHEMA = ?'; push @bind, $pk_schema; } if (defined $pk_table) { push @where, 'A.REFERENCED_TABLE_NAME = ?'; push @bind, $pk_table; } # if (defined $fk_catalog) { # push @where, 'A.TABLE_CATALOG = ?'; # push @bind, $fk_schema; # } if (defined $fk_schema) { push @where, 'A.TABLE_SCHEMA = ?'; push @bind, $fk_schema; } if (defined $fk_table) { push @where, 'A.TABLE_NAME = ?'; push @bind, $fk_table; } if (@where) { $sql .= ' AND '; $sql .= join ' AND ', @where; } $sql .= " ORDER BY A.TABLE_SCHEMA, A.TABLE_NAME, A.ORDINAL_POSITION"; local $dbh->{FetchHashKeyName} = 'NAME_uc'; my $sth = $dbh->prepare($sql); $sth->execute(@bind); return $sth; } # #86030: PATCH: adding statistics_info support # Thank you to David Dick http://search.cpan.org/~ddick/ sub statistics_info { my ($dbh, $catalog, $schema, $table, $unique_only, $quick, ) = @_; return unless $dbh->func('_async_check'); # INFORMATION_SCHEMA.KEY_COLUMN_USAGE was added in 5.0.6 # no one is going to be running 5.0.6, taking out the check for $point > .6 my ($maj, $min, $point) = _version($dbh); return if $maj < 5 ; my $sql = <<'EOF'; SELECT TABLE_CATALOG AS TABLE_CAT, TABLE_SCHEMA AS TABLE_SCHEM, TABLE_NAME AS TABLE_NAME, NON_UNIQUE AS NON_UNIQUE, NULL AS INDEX_QUALIFIER, INDEX_NAME AS INDEX_NAME, LCASE(INDEX_TYPE) AS TYPE, SEQ_IN_INDEX AS ORDINAL_POSITION, COLUMN_NAME AS COLUMN_NAME, COLLATION AS ASC_OR_DESC, CARDINALITY AS CARDINALITY, NULL AS PAGES, NULL AS FILTER_CONDITION FROM INFORMATION_SCHEMA.STATISTICS EOF my @where; my @bind; # catalogs are not yet supported by MySQL # if (defined $catalog) { # push @where, 'TABLE_CATALOG = ?'; # push @bind, $catalog; # } if (defined $schema) { push @where, 'TABLE_SCHEMA = ?'; push @bind, $schema; } if (defined $table) { push @where, 'TABLE_NAME = ?'; push @bind, $table; } if (@where) { $sql .= ' WHERE '; $sql .= join ' AND ', @where; } $sql .= " ORDER BY TABLE_SCHEMA, TABLE_NAME, ORDINAL_POSITION"; local $dbh->{FetchHashKeyName} = 'NAME_uc'; my $sth = $dbh->prepare($sql); $sth->execute(@bind); return $sth; } sub _version { my $dbh = shift; return $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_VER}) =~ /(\d+)\.(\d+)\.(\d+)/; } #################### # get_info() # Generated by DBI::DBD::Metadata sub get_info { my($dbh, $info_type) = @_; return unless $dbh->func('_async_check'); require DBD::mysql::GetInfo; my $v = $DBD::mysql::GetInfo::info{int($info_type)}; $v = $v->($dbh) if ref $v eq 'CODE'; return $v; } BEGIN { my @needs_async_check = qw/data_sources quote_identifier begin_work/; foreach my $method (@needs_async_check) { no strict 'refs'; my $super = "SUPER::$method"; *$method = sub { my $h = shift; return unless $h->func('_async_check'); return $h->$super(@_); }; } } package DBD::mysql::st; # ====== STATEMENT ====== use strict; BEGIN { my @needs_async_result = qw/fetchrow_hashref fetchall_hashref/; my @needs_async_check = qw/bind_param_array bind_col bind_columns execute_for_fetch/; foreach my $method (@needs_async_result) { no strict 'refs'; my $super = "SUPER::$method"; *$method = sub { my $sth = shift; if(defined $sth->mysql_async_ready) { return unless $sth->mysql_async_result; } return $sth->$super(@_); }; } foreach my $method (@needs_async_check) { no strict 'refs'; my $super = "SUPER::$method"; *$method = sub { my $h = shift; return unless $h->func('_async_check'); return $h->$super(@_); }; } } 1; __END__ =pod =encoding utf8 =head1 NAME DBD::mysql - MySQL driver for the Perl5 Database Interface (DBI) =head1 SYNOPSIS use DBI; my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port"; my $dbh = DBI->connect($dsn, $user, $password); my $sth = $dbh->prepare( 'SELECT id, first_name, last_name FROM authors WHERE last_name = ?') or die "prepare statement failed: $dbh->errstr()"; $sth->execute('Eggers') or die "execution failed: $dbh->errstr()"; print $sth->rows . " rows found.\n"; while (my $ref = $sth->fetchrow_hashref()) { print "Found a row: id = $ref->{'id'}, fn = $ref->{'first_name'}\n"; } $sth->finish; =head1 EXAMPLE #!/usr/bin/perl use strict; use warnings; use DBI; # Connect to the database. my $dbh = DBI->connect("DBI:mysql:database=test;host=localhost", "joe", "joe's password", {'RaiseError' => 1}); # Drop table 'foo'. This may fail, if 'foo' doesn't exist # Thus we put an eval around it. eval { $dbh->do("DROP TABLE foo") }; print "Dropping foo failed: $@\n" if $@; # Create a new table 'foo'. This must not fail, thus we don't # catch errors. $dbh->do("CREATE TABLE foo (id INTEGER, name VARCHAR(20))"); # INSERT some data into 'foo'. We are using $dbh->quote() for # quoting the name. $dbh->do("INSERT INTO foo VALUES (1, " . $dbh->quote("Tim") . ")"); # same thing, but using placeholders (recommended!) $dbh->do("INSERT INTO foo VALUES (?, ?)", undef, 2, "Jochen"); # now retrieve data from the table. my $sth = $dbh->prepare("SELECT * FROM foo"); $sth->execute(); while (my $ref = $sth->fetchrow_hashref()) { print "Found a row: id = $ref->{'id'}, name = $ref->{'name'}\n"; } $sth->finish(); # Disconnect from the database. $dbh->disconnect(); =head1 DESCRIPTION B is the Perl5 Database Interface driver for the MySQL database. In other words: DBD::mysql is an interface between the Perl programming language and the MySQL programming API that comes with the MySQL relational database management system. Most functions provided by this programming API are supported. Some rarely used functions are missing, mainly because no-one ever requested them. :-) In what follows we first discuss the use of DBD::mysql, because this is what you will need the most. For installation, see the separate document L. See L for a simple example above. From perl you activate the interface with the statement use DBI; After that you can connect to multiple MySQL database servers and send multiple queries to any of them via a simple object oriented interface. Two types of objects are available: database handles and statement handles. Perl returns a database handle to the connect method like so: $dbh = DBI->connect("DBI:mysql:database=$db;host=$host", $user, $password, {RaiseError => 1}); Once you have connected to a database, you can execute SQL statements with: my $query = sprintf("INSERT INTO foo VALUES (%d, %s)", $number, $dbh->quote("name")); $dbh->do($query); See L for details on the quote and do methods. An alternative approach is $dbh->do("INSERT INTO foo VALUES (?, ?)", undef, $number, $name); in which case the quote method is executed automatically. See also the bind_param method in L. See L below for more details on database handles. If you want to retrieve results, you need to create a so-called statement handle with: $sth = $dbh->prepare("SELECT * FROM $table"); $sth->execute(); This statement handle can be used for multiple things. First of all you can retrieve a row of data: my $row = $sth->fetchrow_hashref(); If your table has columns ID and NAME, then $row will be hash ref with keys ID and NAME. See L below for more details on statement handles. But now for a more formal approach: =head2 Class Methods =over =item B use DBI; $dsn = "DBI:mysql:$database"; $dsn = "DBI:mysql:database=$database;host=$hostname"; $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port"; $dbh = DBI->connect($dsn, $user, $password); The C is not a required attribute, but please note that MySQL has no such thing as a default database. If you don't specify the database at connection time your active database will be null and you'd need to prefix your tables with the database name; i.e. 'SELECT * FROM mydb.mytable'. This is similar to the behavior of the mysql command line client. Also, 'SELECT DATABASE()' will return the current database active for the handle. =over =item host =item port The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server running on the local machine using the default for the UNIX socket. To connect to a MySQL server on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host. Should the MySQL server be running on a non-standard port number, you may explicitly state the port number to connect to in the C argument, by concatenating the I and I together separated by a colon ( C<:> ) character or by using the C argument. To connect to a MySQL server on localhost using TCP/IP, you must specify the hostname as 127.0.0.1 (with the optional port). When connecting to a MySQL Server with IPv6, a bracketed IPv6 address should be used. Example DSN: my $dsn = "DBI:mysql:;host=[1a12:2800:6f2:85::f20:8cf];port=3306"; =item mysql_client_found_rows If TRUE (Default), sets the CLIENT_FOUND_ROWS flag when connecting to MySQL. This causes UPDATE statements to return the number of rows *matched*, not the number of rows actually changed. If you want the number of rows changed in response to an UPDATE statement, specify "mysql_client_found_rows=0" in the DSN. =item mysql_compression If your DSN contains the option "mysql_compression=1", then the communication between client and server will be compressed. =item mysql_connect_timeout If your DSN contains the option "mysql_connect_timeout=##", the connect request to the server will timeout if it has not been successful after the given number of seconds. =item mysql_write_timeout If your DSN contains the option "mysql_write_timeout=##", the write operation to the server will timeout if it has not been successful after the given number of seconds. =item mysql_read_timeout If your DSN contains the option "mysql_read_timeout=##", the read operation to the server will timeout if it has not been successful after the given number of seconds. =item mysql_init_command If your DSN contains the option "mysql_init_command=##", then this SQL statement is executed when connecting to the MySQL server. It is automatically re-executed if reconnection occurs. =item mysql_skip_secure_auth This option is for older mysql databases that don't have secure auth set. =item mysql_read_default_file =item mysql_read_default_group These options can be used to read a config file like /etc/my.cnf or ~/.my.cnf. By default MySQL's C client library doesn't use any config files unlike the client programs (mysql, mysqladmin, ...) that do, but outside of the C client library. Thus you need to explicitly request reading a config file, as in $dsn = "DBI:mysql:test;mysql_read_default_file=/home/joe/my.cnf"; $dbh = DBI->connect($dsn, $user, $password) The option mysql_read_default_group can be used to specify the default group in the config file: Usually this is the I group, but see the following example: [client] host=localhost [perl] host=perlhost (Note the order of the entries! The example won't work, if you reverse the [client] and [perl] sections!) If you read this config file, then you'll be typically connected to I. However, by using $dsn = "DBI:mysql:test;mysql_read_default_group=perl;" . "mysql_read_default_file=/home/joe/my.cnf"; $dbh = DBI->connect($dsn, $user, $password); you'll be connected to I. Note that if you specify a default group and do not specify a file, then the default config files will all be read. See the documentation of the C function mysql_options() for details. =item mysql_socket It is possible to choose the Unix socket that is used for connecting to the server. This is done, for example, with mysql_socket=/dev/mysql Usually there's no need for this option, unless you are using another location for the socket than that built into the client. =item mysql_ssl A true value turns on the CLIENT_SSL flag when connecting to the MySQL server and enforce SSL encryption. A false value (which is default) disable SSL encryption with the MySQL server. When enabling SSL encryption you should set also other SSL options, at least mysql_ssl_ca_file or mysql_ssl_ca_path. mysql_ssl=1 mysql_ssl_verify_server_cert=1 mysql_ssl_ca_file=/path/to/ca_cert.pem This means that your communication with the server will be encrypted. Please note that this can only work if you enabled SSL when compiling DBD::mysql; this is the default starting version 4.034. See L for more details. =item mysql_ssl_ca_file The path to a file in PEM format that contains a list of trusted SSL certificate authorities. When set MySQL server certificate is checked that it is signed by some CA certificate in the list. Common Name value is not verified unless C is enabled. =item mysql_ssl_ca_path The path to a directory that contains trusted SSL certificate authority certificates in PEM format. When set MySQL server certificate is checked that it is signed by some CA certificate in the list. Common Name value is not verified unless C is enabled. Please note that this option is supported only if your MySQL client was compiled with OpenSSL library, and not with default yaSSL library. =item mysql_ssl_verify_server_cert Checks the server's Common Name value in the certificate that the server sends to the client. The client verifies that name against the host name the client uses for connecting to the server, and the connection fails if there is a mismatch. For encrypted connections, this option helps prevent man-in-the-middle attacks. Verification of the host name is disabled by default. =item mysql_ssl_client_key The name of the SSL key file in PEM format to use for establishing a secure connection. =item mysql_ssl_client_cert The name of the SSL certificate file in PEM format to use for establishing a secure connection. =item mysql_ssl_cipher A list of permissible ciphers to use for connection encryption. If no cipher in the list is supported, encrypted connections will not work. mysql_ssl_cipher=AES128-SHA mysql_ssl_cipher=DHE-RSA-AES256-SHA:AES128-SHA =item mysql_ssl_optional Setting C to true disables strict SSL enforcement and makes SSL connection optional. This option opens security hole for man-in-the-middle attacks. Default value is false which means that C set to true enforce SSL encryption. This option was introduced in 4.043 version of DBD::mysql. Due to L and L vulnerabilities in libmysqlclient library, enforcement of SSL encryption was not possbile and therefore C was effectively set for all DBD::mysql versions prior to 4.043. Starting with 4.043, DBD::mysql with C could refuse connection to MySQL server if underlaying libmysqlclient library is vulnerable. Option C can be used to make SSL connection vulnerable. =item mysql_server_pubkey Path to the RSA public key of the server. This is used for the sha256_password and caching_sha2_password authentication plugins. =item mysql_get_server_pubkey Setting C to true requests the public RSA key of the server. =item mysql_local_infile The LOCAL capability for LOAD DATA may be disabled in the MySQL client library by default. If your DSN contains the option "mysql_local_infile=1", LOAD DATA LOCAL will be enabled. (However, this option is *ineffective* if the server has also been configured to disallow LOCAL.) =item mysql_multi_statements Support for multiple statements separated by a semicolon (;) may be enabled by using this option. Enabling this option may cause problems if server-side prepared statements are also enabled. =item mysql_server_prepare This option is used to enable server side prepared statements. To use server side prepared statements, all you need to do is set the variable mysql_server_prepare in the connect: $dbh = DBI->connect( "DBI:mysql:database=test;host=localhost;mysql_server_prepare=1", "", "", { RaiseError => 1, AutoCommit => 1 } ); or: $dbh = DBI->connect( "DBI:mysql:database=test;host=localhost", "", "", { RaiseError => 1, AutoCommit => 1, mysql_server_prepare => 1 } ); There are many benefits to using server side prepare statements, mostly if you are performing many inserts because of that fact that a single statement is prepared to accept multiple insert values. To make sure that the 'make test' step tests whether server prepare works, you just need to export the env variable MYSQL_SERVER_PREPARE: export MYSQL_SERVER_PREPARE=1 Please note that mysql server cannot prepare or execute some prepared statements. In this case DBD::mysql fallbacks to normal non-prepared statement and tries again. =item mysql_server_prepare_disable_fallback This option disable fallback to normal non-prepared statement when mysql server does not support execution of current statement as prepared. Useful when you want to be sure that statement is going to be executed as server side prepared. Error message and code in case of failure is propagated back to DBI. =item mysql_embedded_options The option can be used to pass 'command-line' options to embedded server. Example: use DBI; $testdsn="DBI:mysqlEmb:database=test;mysql_embedded_options=--help,--verbose"; $dbh = DBI->connect($testdsn,"a","b"); This would cause the command line help to the embedded MySQL server library to be printed. =item mysql_embedded_groups The option can be used to specify the groups in the config file(I) which will be used to get options for embedded server. If not specified [server] and [embedded] groups will be used. Example: $testdsn="DBI:mysqlEmb:database=test;mysql_embedded_groups=embedded_server,common"; =item mysql_conn_attrs The option is a hash of attribute names and values which can be used to send custom connection attributes to the server. Some attributes like '_os', '_platform', '_client_name' and '_client_version' are added by libmysqlclient and 'program_name' is added by DBD::mysql. You can then later read these attributes from the performance schema tables which can be quite helpful for profiling your database or creating statistics. You'll have to use a MySQL 5.6 server and libmysqlclient or newer to leverage this feature. my $dbh= DBI->connect($dsn, $user, $password, { AutoCommit => 0, mysql_conn_attrs => { foo => 'bar', wiz => 'bang' }, }); Now you can select the results from the performance schema tables. You can do this in the same session, but also afterwards. It can be very useful to answer questions like 'which script sent this query?'. my $results = $dbh->selectall_hashref( 'SELECT * FROM performance_schema.session_connect_attrs', 'ATTR_NAME' ); This returns: $result = { 'foo' => { 'ATTR_VALUE' => 'bar', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => 'foo', 'ORDINAL_POSITION' => '6' }, 'wiz' => { 'ATTR_VALUE' => 'bang', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => 'wiz', 'ORDINAL_POSITION' => '3' }, 'program_name' => { 'ATTR_VALUE' => './foo.pl', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => 'program_name', 'ORDINAL_POSITION' => '5' }, '_client_name' => { 'ATTR_VALUE' => 'libmysql', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => '_client_name', 'ORDINAL_POSITION' => '1' }, '_client_version' => { 'ATTR_VALUE' => '5.6.24', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => '_client_version', 'ORDINAL_POSITION' => '7' }, '_os' => { 'ATTR_VALUE' => 'osx10.8', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => '_os', 'ORDINAL_POSITION' => '0' }, '_pid' => { 'ATTR_VALUE' => '59860', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => '_pid', 'ORDINAL_POSITION' => '2' }, '_platform' => { 'ATTR_VALUE' => 'x86_64', 'PROCESSLIST_ID' => '3', 'ATTR_NAME' => '_platform', 'ORDINAL_POSITION' => '4' } }; =back =back =head2 Private MetaData Methods =over =item B my $drh = DBI->install_driver("mysql"); @dbs = $drh->func("$hostname:$port", '_ListDBs'); @dbs = $drh->func($hostname, $port, '_ListDBs'); @dbs = $dbh->func('_ListDBs'); Returns a list of all databases managed by the MySQL server running on C<$hostname>, port C<$port>. This is a legacy method. Instead, you should use the portable method @dbs = DBI->data_sources("mysql"); =back =head1 DATABASE HANDLES The DBD::mysql driver supports the following attributes of database handles (read only): $errno = $dbh->{'mysql_errno'}; $error = $dbh->{'mysql_error'}; $info = $dbh->{'mysql_hostinfo'}; $info = $dbh->{'mysql_info'}; $insertid = $dbh->{'mysql_insertid'}; $info = $dbh->{'mysql_protoinfo'}; $info = $dbh->{'mysql_serverinfo'}; $info = $dbh->{'mysql_stat'}; $threadId = $dbh->{'mysql_thread_id'}; These correspond to mysql_errno(), mysql_error(), mysql_get_host_info(), mysql_info(), mysql_insert_id(), mysql_get_proto_info(), mysql_get_server_info(), mysql_stat() and mysql_thread_id(), respectively. =over 2 =item mysql_clientinfo List information of the MySQL client library that DBD::mysql was built against: print "$dbh->{mysql_clientinfo}\n"; 5.2.0-MariaDB =item mysql_clientversion print "$dbh->{mysql_clientversion}\n"; 50200 =item mysql_serverversion print "$dbh->{mysql_serverversion}\n"; 50200 =item mysql_dbd_stats $info_hashref = $dbh->{mysql_dbd_stats}; DBD::mysql keeps track of some statistics in the mysql_dbd_stats attribute. The following stats are being maintained: =over 8 =item auto_reconnects_ok The number of times that DBD::mysql successfully reconnected to the mysql server. =item auto_reconnects_failed The number of times that DBD::mysql tried to reconnect to mysql but failed. =back =back The DBD::mysql driver also supports the following attributes of database handles (read/write): =over =item mysql_auto_reconnect This attribute determines whether DBD::mysql will automatically reconnect to mysql if the connection be lost. This feature defaults to off; however, if either the GATEWAY_INTERFACE or MOD_PERL environment variable is set, DBD::mysql will turn mysql_auto_reconnect on. Setting mysql_auto_reconnect to on is not advised if 'lock tables' is used because if DBD::mysql reconnect to mysql all table locks will be lost. This attribute is ignored when AutoCommit is turned off, and when AutoCommit is turned off, DBD::mysql will not automatically reconnect to the server. It is also possible to set the default value of the C attribute for the $dbh by passing it in the C<\%attr> hash for Cconnect>. $dbh->{mysql_auto_reconnect} = 1; or my $dbh = DBI->connect($dsn, $user, $password, { mysql_auto_reconnect => 1, }); Note that if you are using a module or framework that performs reconnections for you (for example L in fixup mode), this value must be set to 0. =item mysql_use_result This attribute forces the driver to use mysql_use_result rather than mysql_store_result. The former is faster and less memory consuming, but tends to block other processes. mysql_store_result is the default due to that fact storing the result is expected behavior with most applications. It is possible to set the default value of the C attribute for the $dbh via the DSN: $dbh = DBI->connect("DBI:mysql:test;mysql_use_result=1", "root", ""); You can also set it after creation of the database handle: $dbh->{mysql_use_result} = 0; # disable $dbh->{mysql_use_result} = 1; # enable You can also set or unset the C setting on your statement handle, when creating the statement handle or after it has been created. See L. =item mysql_enable_utf8 This attribute determines whether DBD::mysql should assume strings stored in the database are utf8. This feature defaults to off. When set, a data retrieved from a textual column type (char, varchar, etc) will have the UTF-8 flag turned on if necessary. This enables character semantics on that string. You will also need to ensure that your database / table / column is configured to use UTF8. See for more information the chapter on character set support in the MySQL manual: L Additionally, turning on this flag tells MySQL that incoming data should be treated as UTF-8. This will only take effect if used as part of the call to connect(). If you turn the flag on after connecting, you will need to issue the command C to get the same effect. =item mysql_enable_utf8mb4 This is similar to mysql_enable_utf8, but is capable of handling 4-byte UTF-8 characters. =item mysql_bind_type_guessing This attribute causes the driver (emulated prepare statements) to attempt to guess if a value being bound is a numeric value, and if so, doesn't quote the value. This was created by Dragonchild and is one way to deal with the performance issue of using quotes in a statement that is inserting or updating a large numeric value. This was previously called C because it is experimental. I have successfully run the full test suite with this option turned on, the name can now be simply C. CAVEAT: Even though you can insert an integer value into a character column, if this column is indexed, if you query that column with the integer value not being quoted, it will not use the index: MariaDB [test]> explain select * from test where value0 = '3' \G *************************** 1. row *************************** id: 1 select_type: SIMPLE table: test type: ref possible_keys: value0 key: value0 key_len: 13 ref: const rows: 1 Extra: Using index condition 1 row in set (0.00 sec) MariaDB [test]> explain select * from test where value0 = 3 -> \G *************************** 1. row *************************** id: 1 select_type: SIMPLE table: test type: ALL possible_keys: value0 key: NULL key_len: NULL ref: NULL rows: 6 Extra: Using where 1 row in set (0.00 sec) See bug: https://rt.cpan.org/Ticket/Display.html?id=43822 C can be turned on via - through DSN my $dbh= DBI->connect('DBI:mysql:test', 'username', 'pass', { mysql_bind_type_guessing => 1}) - OR after handle creation $dbh->{mysql_bind_type_guessing} = 1; =item mysql_bind_comment_placeholders This attribute causes the driver (emulated prepare statements) will cause any placeholders in comments to be bound. This is not correct prepared statement behavior, but some developers have come to depend on this behavior, so I have made it available in 4.015 =item mysql_no_autocommit_cmd This attribute causes the driver to not issue 'set autocommit' either through explicit or using mysql_autocommit(). This is particularly useful in the case of using MySQL Proxy. See the bug report: https://rt.cpan.org/Public/Bug/Display.html?id=46308 C can be turned on when creating the database handle: my $dbh = DBI->connect('DBI:mysql:test', 'username', 'pass', { mysql_no_autocommit_cmd => 1}); or using an existing database handle: $dbh->{mysql_no_autocommit_cmd} = 1; =item ping This can be used to send a ping to the server. $rc = $dbh->ping(); =back =head1 STATEMENT HANDLES The statement handles of DBD::mysql support a number of attributes. You access these by using, for example, my $numFields = $sth->{NUM_OF_FIELDS}; Note, that most attributes are valid only after a successful I. An C value will returned otherwise. The most important exception is the C attribute, which forces the driver to use mysql_use_result rather than mysql_store_result. The former is faster and less memory consuming, but tends to block other processes. (That's why mysql_store_result is the default.) To set the C attribute, use either of the following: my $sth = $dbh->prepare("QUERY", { mysql_use_result => 1}); or my $sth = $dbh->prepare($sql); $sth->{mysql_use_result} = 1; Column dependent attributes, for example I, the column names, are returned as a reference to an array. The array indices are corresponding to the indices of the arrays returned by I and similar methods. For example the following code will print a header of table names together with all rows: my $sth = $dbh->prepare("SELECT * FROM $table") || die "Error:" . $dbh->errstr . "\n"; $sth->execute || die "Error:" . $sth->errstr . "\n"; my $names = $sth->{NAME}; my $numFields = $sth->{'NUM_OF_FIELDS'} - 1; for my $i ( 0..$numFields ) { printf("%s%s", $i ? "," : "", $$names[$i]); } print "\n"; while (my $ref = $sth->fetchrow_arrayref) { for my $i ( 0..$numFields ) { printf("%s%s", $i ? "," : "", $$ref[$i]); } print "\n"; } For portable applications you should restrict yourself to attributes with capitalized or mixed case names. Lower case attribute names are private to DBD::mysql. The attribute list includes: =over =item ChopBlanks this attribute determines whether a I will chop preceding and trailing blanks off the column values. Chopping blanks does not have impact on the I attribute. =item mysql_gtids Returns GTID(s) if GTID session tracking is ensabled in the server via session_track_gtids. =item mysql_insertid If the statement you executed performs an INSERT, and there is an AUTO_INCREMENT column in the table you inserted in, this attribute holds the value stored into the AUTO_INCREMENT column, if that value is automatically generated, by storing NULL or 0 or was specified as an explicit value. Typically, you'd access the value via $sth->{mysql_insertid}. The value can also be accessed via $dbh->{mysql_insertid} but this can easily produce incorrect results in case one database handle is shared. =item mysql_is_blob Reference to an array of boolean values; TRUE indicates, that the respective column is a blob. This attribute is valid for MySQL only. =item mysql_is_key Reference to an array of boolean values; TRUE indicates, that the respective column is a key. This is valid for MySQL only. =item mysql_is_num Reference to an array of boolean values; TRUE indicates, that the respective column contains numeric values. =item mysql_is_pri_key Reference to an array of boolean values; TRUE indicates, that the respective column is a primary key. =item mysql_is_auto_increment Reference to an array of boolean values; TRUE indicates that the respective column is an AUTO_INCREMENT column. This is only valid for MySQL. =item mysql_length =item mysql_max_length A reference to an array of maximum column sizes. The I is the maximum physically present in the result table, I gives the theoretically possible maximum. I is valid for MySQL only. =item NAME A reference to an array of column names. =item NULLABLE A reference to an array of boolean values; TRUE indicates that this column may contain NULL's. =item NUM_OF_FIELDS Number of fields returned by a I