DBD-mysql-4.025/0000755000175000017500000000000012235705160011731 5ustar patgpatgDBD-mysql-4.025/META.yml0000664000175000017500000000126112235705160013204 0ustar patgpatg--- #YAML:1.0 name: DBD-mysql version: 4.025 abstract: A MySQL driver for the Perl5 Database Interface (DBI) author: - Patrick Galbraith license: perl distribution_type: module configure_requires: DBI: 1.08 build_requires: Test::Deep: 0 Test::More: 0 requires: Data::Dumper: 0 DBI: 1.08 perl: 5.008001 resources: repository: https://github.com/perl5-dbi/DBD-mysql no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 DBD-mysql-4.025/Makefile.PL0000644000175000017500000007560612230034435013714 0ustar patgpatg# -*- cperl -*- use 5.008_001; use Config; use strict; use warnings; use Getopt::Long(); use ExtUtils::MakeMaker(); use Data::Dumper (); use File::Path; use File::Copy; use File::Basename; require DBI::DBD; my $TESTDB = "test"; our $opt = { "help" => \&Usage, }; Getopt::Long::GetOptions( $opt, "help", "testdb=s", "testhost=s", "testport=s", "testuser=s", "testpassword=s", "testsocket=s", "cflags=s", "libs=s", "verbose", "ps-protocol", "bind-type-guessing", "nocatchstderr", "ssl!", "nofoundrows!", "embedded=s", "mysql_config=s", "force-embedded", "with-mysql=s" ) || die Usage(); my $source = {}; #Check for mysql_config first $source->{'mysql_config'}="guessed"; if ($opt->{'mysql_config'}) { $opt->{'mysql_config'} = Win32::GetShortPathName($opt->{'mysql_config'}) if $^O eq 'MSWin32'; if (-f $opt->{'mysql_config'}) { $source->{'mysql_config'} = "Users choice"; } else { print <<"MSG"; Specified mysql configuration script '$opt->{'mysql_config'}' doesn't exist. Please check path/permissions. Will try to use default mysql_config script found through PATH. MSG $opt->{'mysql_config'}= "mysql_config"; } } else { if ($^O eq 'MSWin32') { win32_mysql_config($opt->{'with-mysql'}); } if (! `mysql_config`) { print <{'mysql_config'} = "mysql_config"; } for my $key (qw/testdb testhost testuser testpassword testsocket testport cflags embedded libs nocatchstderr ssl nofoundrows ps-protocol bind-type-guessing force-embedded/) { Configure($opt, $source, $key); } #if we have a testport but no host, assume localhost if ( $opt->{testport} && !$opt->{testhost} ) { $opt->{testhost} = 'localhost'; $source->{testhost} = 'guessed'; } #We have to rename/move Makefile.PL in mysqlEmb directory #since MakeMaker will find it and will try to execute it. if (-f "mysqlEmb/Makefile.PL") { eval { require File::Copy }; move ("mysqlEmb/Makefile.PL", "mysqlEmb/Makefile.PL.old"); } #Disable of building of dbd::mysqlEmb driver by default $opt->{'embedded'}="" if !$opt->{'force-embedded'}; if ($opt->{'embedded'}) { if ($source->{'embedded'} eq 'mysql_config') { #We have to use libmygcc to resolve linking problem # this causes problems for cygwin #$opt->{'embedded'} .= " -lmygcc"; # Under Cygwin (at least) we have to use libstdc++ to resolve linking # problem because libmysqld is built using g++ rather than gcc. $opt->{'embedded'} .= " -lstdc++"; } my @files = ($^O =~ /mswin32/i) ? qw(mysqlclient.lib) : qw(libmysqld.a); my @dirs = $opt->{'embedded'} =~ /-L(.*?)(?:\s|$)/g; if( !(SearchFor('lib', @files)) && !(SearchFor2(\@files,\@dirs)) ) { warn <<"MSG"; You intended to build DBD::mysqlEmb driver by using option: --embedded=$opt->{'embedded'}. But we failed to determine directory of @files. Building of DBD::mysqlEmb driver was disabled. Please use perl Makefile.PL --embedded="-L " to set correct directory. For details see DBD::mysql::INSTALL, section "Linker flags" or type perl Makefile.PL --help MSG $source->{'embedded'} = "guessed"; $opt->{'embedded'}=""; } } if ($opt->{'embedded'} && !check_include_version($opt->{'cflags'}, 40003)) { die <<"MSG"; WARNING: Wrong version or unable to check version of mysql include files. To build embedded version of DBD you ought to be sure that you use include files from MySQL server >= 4.0.3. MSG } print <<"MSG"; I will use the following settings for compiling and testing: MSG delete $opt->{'help'}; my $keylen = 0; for my $key (keys %$opt) { $keylen = length($key) if length($key) > $keylen; } my $slen = 0; for my $val (values %$source) { $slen = length($val) if length($val) > $slen; } for my $key (sort { $a cmp $b} keys %$opt) { printf(" %-" . $keylen . "s (%-" . $slen . "s) = %s\n", $key, $source->{$key}, $opt->{$key}) } print <<"MSG"; To change these settings, see 'perl Makefile.PL --help' and 'perldoc DBD::mysql::INSTALL'. MSG sleep 5; eval { require File::Spec }; my $dsn= ''; if (exists $opt->{'ps-protocol'}) { $dsn = "\$::test_dsn .= \";mysql_server_prepare=1\";\n"; } elsif (exists $opt->{'bind-type-guessing'}) { $dsn= "\$::test_dsn .= \";mysql_bind_type_guessing=1\";\n"; } my $fileName = $@ ? "t/mysql.mtest" : File::Spec->catfile("t", "mysql.mtest"); (open(FILE, ">$fileName") && (print FILE ("{ local " . Data::Dumper->Dump([$opt], ["opt"]) . "\$::test_host = \$opt->{'testhost'};\n" . "\$::test_port = \$opt->{'testport'};\n" . "\$::test_user = \$opt->{'testuser'};\n" . "\$::test_socket = \$opt->{'testsocket'};\n" . "\$::test_password = \$opt->{'testpassword'};\n" . "\$::test_db = \$opt->{'testdb'};\n" . "\$::test_dsn = \"DBI:mysql:\$::test_db\";\n" . "\$::test_dsn .= \";mysql_socket=\$::test_socket\" if \$::test_socket;\n" . "\$::test_dsn .= \":\$::test_host\" if \$::test_host;\n" . "\$::test_dsn .= \":\$::test_port\" if \$::test_port;\n". $dsn . "} 1;\n")) && close(FILE)) || die "Failed to create $fileName: $!"; my $cflags = "-I\$(DBI_INSTARCH_DIR) $opt->{'cflags'}"; if ($^O eq 'VMS') { $cflags = "\$(DBI_INSTARCH_DIR),$opt->{'cflags'}"; } $cflags .= " -DDBD_MYSQL_WITH_SSL" if $opt->{'ssl'}; $cflags .= " -DDBD_MYSQL_INSERT_ID_IS_GOOD" if $DBI::VERSION > 1.42; $cflags .= " -DDBD_NO_CLIENT_FOUND_ROWS" if $opt->{'nofoundrows'}; $cflags .= " -g "; my %o = ( 'NAME' => 'DBD::mysql', 'INC' => $cflags, 'dist' => { 'SUFFIX' => ".gz", 'DIST_DEFAULT' => 'all tardist', 'COMPRESS' => "gzip -9f" }, 'clean' => { 'FILES' => '*.xsi' }, 'realclean' => { 'FILES' => 't/mysql.mtest' }, 'C' => ["dbdimp.c", "mysql.c"], 'XS' => {'mysql.xs' => 'mysql.c'}, 'OBJECT' => '$(O_FILES)', 'LIBS' => $opt->{'libs'}, $opt->{'ldflags'} ? ('LDFLAGS' => $opt->{'ldflags'}) : (), 'VERSION_FROM' => 'lib/DBD/mysql.pm' ); my %embedded_files=(); if ($opt->{'embedded'}) { %embedded_files = ( 'mysql.xs' => { filename => 'mysqlEmb/mysqlEmb.xs', replace => { ':mysql' => ':mysqlEmb', 'mysql.xsi' => 'mysqlEmb.xsi'}, makedir => 'mysqlEmb' }, 'lib/DBD/mysql.pm' => { filename => 'mysqlEmb/lib/DBD/mysqlEmb.pm', replace => { ':mysql' => ':mysqlEmb', '=> \'mysql\'' => '=> \'mysqlEmb\''}, makedir => 'mysqlEmb/lib/DBD' }, 'lib/DBD/mysql/GetInfo.pm' => { filename => 'mysqlEmb/lib/DBD/mysqlEmb/GetInfo.pm', replace => {':mysql' => ':mysqlEmb', '\'mysql\'' => '\'mysqlEmb\''}, makedir => 'mysqlEmb/lib/DBD/mysqlEmb' }, 't/mysql.dbtest' => { filename => 'mysqlEmb/t/mysqlEmb.dbtest', makedir => 'mysqlEmb/t' }, 't/mysql.mtest' => { filename => 'mysqlEmb/t/mysqlEmb.mtest', makedir => 'mysqlEmb/t', replace => { 'DBI:mysql'=> 'DBI:mysqlEmb', 'test_db";' => 'test_db;mysql_embedded_options=--datadir=./t,--skip-innodb,--skip-bdb";' } }, 't/lib.pl' => { filename => 'mysqlEmb/t/lib.pl', replace => { '\$mdriver =.*' => "\$mdriver =\'mysqlEmb\';"}, makedir => 'mysqlEmb/t' }, 't/20createdrop.t' => { filename => 'mysqlEmb/t/20createdrop.t', makedir => 'mysqlEmb/t' }, 't/30insertfetch.t' => { filename => 'mysqlEmb/t/30insertfetch.t', makedir => 'mysqlEmb/t' }, 't/40bindparam.t' => { filename => 'mysqlEmb/t/40bindparam.t', makedir => 'mysqlEmb/t' }, 't/40blobs.t' => { filename => 'mysqlEmb/t/40blobs.t', makedir => 'mysqlEmb/t' }, 't/40listfields.t' => { filename => 'mysqlEmb/t/40listfields.t', makedir => 'mysqlEmb/t' }, 't/40nulls.t' => { filename => 'mysqlEmb/t/40nulls.t', makedir => 'mysqlEmb/t' }, 't/40numrows.t' => { filename => 'mysqlEmb/t/40numrows.t', makedir => 'mysqlEmb/t' }, 't/50chopblanks.t' => { filename => 'mysqlEmb/t/50chopblanks.t', makedir => 'mysqlEmb/t' }, 't/50commit.t' => { filename => 'mysqlEmb/t/50commit.t', makedir => 'mysqlEmb/t' }, 't/60leaks.t' => { filename => 'mysqlEmb/t/60leaks.t', makedir => 'mysqlEmb/t' }, 't/00base.t' => { filename => 'mysqlEmb/t/00base.t', makedir => 'mysqlEmb/t' }, 'myld' => { filename => 'mysqlEmb/myld', makedir => 'mysqlEmb' }, 'dbdimp.c' => { filename => 'mysqlEmb/dbdimp.c', makedir => 'mysqlEmb' }, 'dbdimp.h' => { filename => 'mysqlEmb/dbdimp.h', makedir => 'mysqlEmb' }, 'constants.h' => { filename => 'mysqlEmb/constants.h', makedir => 'mysqlEmb' }, 'Makefile.PL.embedded' => { filename => 'mysqlEmb/Makefile.PL', makedir => 'mysqlEmb' }, ); #Create embedded files from original ones prepare_files(\%embedded_files); my %e=%o; $o{'clean'}->{'FILES'} .= " ./mysqlEmb"; $o{'DIR'}=['mysqlEmb']; $e{'NAME'} = 'DBD::mysqlEmb'; $e{'C'} = ["dbdimp.c", "mysqlEmb.c"]; $e{'XS'} = {'mysqlEmb.xs' => 'mysqlEmb.c'}; $e{'VERSION_FROM'} = 'lib/DBD/mysqlEmb.pm'; $e{'LIBS'} = $opt->{'embedded'}; $e{'INC'} .= " -DDBD_MYSQL_EMBEDDED"; print "Preparing embedded Makefile\n"; #Create Makefile.conf for mysqlEmb Makefile.PL create_makefile(Data::Dumper->Dump([\%e], ["o"])); } if (eval $ExtUtils::MakeMaker::VERSION >= 5.43) { $o{'CAPI'} = 'TRUE' if (eval $ExtUtils::MakeMaker::VERSION >= 5.43 && $Config::Config{'archname'} =~ /-object\b/i); $o{'AUTHOR'} = 'Patrick Galbraith '; $o{'ABSTRACT'} = 'A MySQL driver for the Perl5 Database Interface (DBI)'; $o{'PREREQ_PM'} = { 'DBI' => 1.08, 'Data::Dumper' => 0 }; %o=(%o, LICENSE => 'perl', MIN_PERL_VERSION => '5.008001', META_MERGE => { resources => { repository => 'https://github.com/perl5-dbi/DBD-mysql', }, }, BUILD_REQUIRES => { 'Test::More' => 0, 'Test::Deep' => 0, }, CONFIGURE_REQUIRES => { 'DBI' => 1.08, }, ); } WriteMakefile1(%o); exit 0; ############################################################################ # # Name: Usage # # Purpose: Print Usage message and exit with error status. # ############################################################################ sub Usage { print STDERR <<"USAGE"; Usage: perl $0 [options] Possible options are: --cflags= Use for running the C compiler; defaults to the value of "mysql_config --cflags" or a guessed value --libs= Use for running the linker; defaults to the value of "mysql_config --libs" or a gussed value --force-embedded Build version of driver supporting mysqlEmb --embedded= Use these libs when building the embedded version of DBD (with --force-embedded). Defaults to the value of "mysql_config --embedded". --testdb= Use the database for running the test suite; defaults to $TESTDB --testuser= Use the username for running the test suite; defaults to no username --testpassword= Use the password for running the test suite; defaults to no password --testhost= Use as a database server for running the test suite; defaults to localhost. --testport= Use as the port number of the database; by default the port number is choosen from the mysqlclient library --mysql_config= Specify for mysql_config script --with-mysql= Specify for the root of the MySQL installation. --nocatchstderr Supress using the "myld" script that redirects STDERR while running the linker. --nofoundrows Change the behavior of \$sth->rows() so that it returns the number of rows physically modified instead of the rows matched --ps-protocol Toggle the use of driver emulated prepared statements prepare, requires MySQL server >= 4.1.3 for server side prepared statements, off by default --bind-type-guessing Toggle the use of driver attribute mysql_bind_type_guessing This feature makes it so driver-emulated prepared statements try to "guess" if a value being bound is numeric, in which case, quotes will not be put around the value. --ssl Enable SSL support --help Print this message and exit All options may be configured on the command line. If they are not present on the command line, then mysql_config is called (if it can be found): mysql_config --cflags mysql_config --libs mysql_config --embedded mysql_config --testdb and so on. See DBD::mysql::INSTALL for details. USAGE exit 1; } ############################################################################ # # Name: Configure # # Purpose: Automatic configuration # # Inputs: $param - Name of the parameter being configured # # Returns: Generated value, never undef # ############################################################################ sub Configure { my($opt, $source, $param) = @_; if ($param eq 'bind-type-guessing') { $source->{$param}= ($opt->{$param}) ? "User's choice" : 'default'; return; } if ($param eq 'ps-protocol') { $source->{$param}= ($opt->{$param}) ? "User's choice" : 'default'; return; } if (exists($opt->{$param})) { $source->{$param} = "User's choice"; return; } # First try to get options values from mysql_config my $command = $opt->{'mysql_config'} . " --$param"; eval { open(PIPE, "$command |") or die "Can't find mysql_config."; }; if (!$@) { my $str = ""; while (defined(my $line = )) { $str .= $line; } if ($str ne "" && $str !~ /Options:/) { $str =~ s/\s+$//s; $str =~ s/^\s+//s; # Unfortunately ExtUtils::MakeMaker doesn't deal very well # with -L'...' $str =~ s/\-L\'(.*?)\'/-L$1/sg; $str =~ s/\-L\"(.*?)\"/-L$1/sg; # Separate libs from ldflags if ($param eq 'libs') { my (@libs, @ldflags); for (split ' ', $str) { if (/^-[Ll]/) { push @libs, $_ } else { push @ldflags, $_ } } $str = "@libs"; $opt->{ldflags} = "@ldflags"; $source->{ldflags} = "mysql_config"; } $opt->{$param} = $str; $source->{$param} = "mysql_config"; return; } } else { print "Can't find mysql_config. Use --mysql_config option to specify where mysql_config is located\n"; } # Ok, mysql_config doesn't work. We need to do our best # First check environment variables if (defined($ENV{'DBD_MYSQL_'.uc($param)})) { $opt->{$param} = $ENV{'DBD_MYSQL_'.uc($param)}; $source->{$param} = 'environment'; } # Then try to guess unless ($opt->{$param}) { if ($param eq 'testuser') { my $user = $ENV{USER} || ''; print " PLEASE NOTE: For 'make test' to run properly, you must ensure that the database user '$user' can connect to your MySQL server and has the proper privileges that these tests require such as 'drop table', 'create table', 'drop procedure', 'create procedure' as well as others. mysql> grant all privileges on test.* to '$user'\@'localhost' identified by 's3kr1t'; You can also optionally set the user to run 'make test' with: perl Makefile.PL --testuser=username "; $opt->{$param} = $user; $source->{$param} = 'guessed'; } elsif ($param eq "nocatchstderr" || $param eq "nofoundrows") { $source->{$param} = "default"; $opt->{$param} = 0; } elsif ($param eq "testdb") { $source->{$param} = "default"; $opt->{$param} = $TESTDB; } elsif ($param eq "testhost" || $param eq "testport" || $param eq "testpassword" || $param eq "testsocket" ) { $source->{$param} = "default"; $opt->{$param} = ""; } elsif($param eq 'force-embedded') { $source->{$param} = $opt->{$param} ? "default" : 'not set'; } elsif ($param eq "cflags") { $source->{$param} = "guessed"; my $dir = SearchFor('include', 'mysql.h'); if ($dir) { $opt->{$param} = "-I$dir"; return; } die <<"MSG"; Failed to determine directory of mysql.h. Use perl Makefile.PL --cflags=-I to set this directory. For details see DBD::mysql::INSTALL, section "C Compiler flags" or type perl Makefile.PL --help MSG } elsif ($param eq "libs" || $param eq "embedded") { $source->{$param} = "guessed"; if ($param eq "embedded" && !$opt->{'embedded'}) { $opt->{$param}=""; return; } my @files=(); my $default_libs; if ($param eq "embedded") { $default_libs= "-lmysqld -lpthread -lz -lm -lcrypt -lnsl"; @files = ($^O =~ /mswin32/i) ? qw(mysqlclient.lib) : qw(libmysqld.a); } else { $default_libs= "-lmysqlclient -lz -lm -lcrypt -lnsl"; @files = ($^O =~ /mswin32/i) ? qw(mysqlclient.lib) : qw(libmysqlclient.a libmysqlclient.so); } my $dir = SearchFor('lib', @files); if ($dir) { $opt->{$param} = "-L$dir $default_libs"; return; } my $f = join("|", @files); die <<"MSG"; Failed to determine directory of $f. Use perl Makefile.PL "--$param=-L $default_libs" to set this directory. For details see the DBD::mysql::INSTALL, section "Linker flags" or type perl Makefile.PL --help MSG } elsif ($param eq "ssl") { $opt->{$param} = ($opt->{"libs"} =~ /ssl/) ? 1 : 0; $source->{$param} = "guessed"; } else { die "Unknown configuration parameter: $param"; } } } my $haveFileSpec; my $fineDir; sub SearchFor { my($subdir, @files) = @_; $haveFileSpec = eval { require File::Spec } unless defined($haveFileSpec); my @dirs = ($^O =~ /mswin32/i) ? qw(C:) : qw(/usr/local /usr /opt); unshift(@dirs, $fineDir) if defined($fineDir); for my $f (@files) { for my $dir (@dirs) { my $try1 = $haveFileSpec ? File::Spec->catdir($dir, $subdir) : "$dir/$subdir"; my $try2 = $haveFileSpec ? File::Spec->catdir($dir, "mysql") : "$dir/mysql"; my $try3 = $haveFileSpec ? File::Spec->catdir($try1, "mysql") : "$try1/mysql"; my $try4 = $haveFileSpec ? File::Spec->catdir($try2, $subdir) : "$try2/$subdir"; for my $path ($try3, $try4, $try2, $try1, $dir) { my $file = $haveFileSpec ? File::Spec->catfile($path, $f) : "$path/$f"; if (-f $file) { $fineDir = $dir; return $path; } } } } } sub SearchFor2 { my($files, $dirs) = @_; for my $f (@{$files}) { for my $dir (@{$dirs}) { my $file = $haveFileSpec ? File::Spec->catfile($dir, $f) : "$dir/$f"; if (-f $file) { $fineDir = $dir; return $dir; } } } } sub check_include_version { my ($dir, $ver) = @_; my $headerfile; $dir =~ s/-I//; $dir =~ s/'//g; $dir =~ s/\s.*//g; open(HEADERFILE ,"<${dir}/mysql_version.h") or (print "Unable to open header file ${dir}/mysql_version.h" && exit(0)); { local undef $/; $headerfile = ; } close(HEADERFILE); my ($version_id) = ($headerfile =~ /MYSQL_VERSION_ID[\t\s]+(\d+)[\n\r]/); if ($version_id < $ver) { print <<"MSG"; Version of MySQL include files in $dir - $1 MSG return 0; } return 1; } sub replace { my ($str, $ref)=@_; for my $find (keys %{$ref}) { $str =~ s/$find/$ref->{$find}/g; } $str; } sub prepare_files { my ($files)= @_; my $line; my @lib; for my $file (keys %{$files}) { if ($files->{$file}->{makedir}) { mkpath $files->{$file}->{makedir} or die "Can't create dir $files->{$file}->{makedir}" unless (-e $files->{$file}->{makedir} && -d $files->{$file}->{makedir}); } my $replace=$files->{$file}->{replace}; if ($replace) { open(FILE, $file) or die "Can't open file $file"; @lib= map { $replace ? replace($_, $replace) : $_; } ; close(FILE); open(FILE, ">".$files->{$file}->{filename}) or die "Can't open file $files->{$file}->{filename}"; print FILE @lib; close(FILE); } else { if(!copy($file, $files->{$file}->{filename})) { die "Unable to copy $file to $files->{$file}->{filename}\n"; } } } } sub create_makefile { my ($cnf)=@_; open(LOG, ">mysqlEmb/Makefile.conf") or die "Can't write to file mysqlEmb/Makefile.conf"; print LOG $cnf; close(LOG); } sub win32_mysql_config { my ($mysql_dir) = @_; my $mysqladmin; if ($mysql_dir) { unless (-d $mysql_dir) { die qq{"$mysql_dir" does not exist}; } $mysqladmin = File::Spec->catfile($mysql_dir, 'bin', 'mysqladmin.exe'); unless (-f $mysqladmin) { die qq{"bin/mysqladmin.exe" not found under "$mysql_dir"}; } } my (@path_ext) = path_ext(); unless ($mysqladmin) { $mysqladmin = which('mysqladmin', @path_ext); unless ($mysqladmin) { die << 'DEATH'; mysqladmin.exe was not found in your PATH. Please either add the directory containing mysqladmin.exe to your PATH environment variable, or rerun this script with the --with-mysql=C:\Path\to\Mysql option, giving the root directory of your MySQL installation. DEATH } ($mysql_dir = dirname($mysqladmin)) =~ s{[/\\]bin[/\\]?$}{}; } my $basedir = Win32::GetShortPathName($mysql_dir); my $ldata = File::Spec->catdir($basedir, 'data'); my $execdir = File::Spec->catdir($basedir, 'bin'); my $bindir = File::Spec->catdir($basedir, 'bin'); my $pkglibdir= File::Spec->catdir($basedir, 'lib', 'opt'); my $pkgincludedir = File::Spec->catdir($basedir, 'include'); my $ldflags = ''; my $client_libs = $Config{'cc'} eq 'gcc' ? '-lmysql -lzlib' : '-lmysqlclient -lzlib'; if (($Config{'_a'} eq '.a') and (! -e File::Spec->catfile($pkglibdir, 'libmysql.a'))) { # This is done because ExtUtils::Liblist expects .a files, not .lib files. copy(File::Spec->catfile($pkglibdir, 'libmysql.lib'), File::Spec->catfile($pkglibdir, 'libmysql.a')); copy(File::Spec->catfile($pkglibdir, 'zlib.lib'), File::Spec->catfile($pkglibdir, 'libzlib.a')); } $mysqladmin = Win32::GetShortPathName($mysqladmin); my $v; if ( defined $opt->{'testuser'} and defined $opt->{'testpassword'}) { my $custom_mysqladmin = sprintf('%s --user=%s --password=%s version', $mysqladmin , $opt->{'testuser'}, $opt->{'testpassword'}); $v = qx($custom_mysqladmin); } else { $v = qx($mysqladmin version); } unless ($v) { print STDERR "Problem running $mysqladmin - aborting ...\n"; exit(1); } my ($version, $port); if ($v =~ /Server version\s+(.*?)\n/m) { $version = $1; } if ($v =~ /TCP port\s+(.*?)\n/m) { $port = $1; } my $libs = qq{$ldflags -L"$pkglibdir" $client_libs}; my $cflags = qq{-I"$pkgincludedir"}; my $embedded_libs = qq{$ldflags -L"$pkglibdir"}; my $license = <<'EOL'; # Copyright (C) 2005 MySQL AB & MySQL Finland AB & TCX DataKonsult AB # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # This script reports various configuration settings that may be needed # when using the MySQL client library. EOL my $mysql_config = File::Spec->catfile($basedir, 'bin', 'mysql_config.pl'); open(my $fh, '>', $mysql_config) or die "Cannot open $mysql_config for writing: $!"; print $fh <<"EOL"; #!$^X use strict; use warnings; use Getopt::Long; $license my \$basedir = q{$basedir}; my \$ldata = q{$ldata}; my \$execdir = q{$execdir}; my \$bindir = q{$bindir}; my \$pkglibdir = q{$pkglibdir}; my \$pkgincludedir = q{$pkgincludedir}; my \$ldflags = q{$ldflags}; my \$client_libs = q{$client_libs}; my \$version = q{$version}; my \$port = q{$port}; my \$libs = q{$libs}; my \$cflags = q{$cflags}; my \$embedded_libs = q{$embedded_libs}; EOL while () { print $fh $_; } close $fh; my @args = ('pl2bat', $mysql_config); system(@args) == 0 or die "System @args failed: $?"; print << "END"; mysql_config.pl, and an associated bat file, has been successfully created under $basedir\\bin END return; } sub path_ext { my @path_ext; if ($ENV{PATHEXT}) { push @path_ext, split ';', $ENV{PATHEXT}; for my $ext (@path_ext) { $ext =~ s/^\.*(.+)$/$1/; } } else { #Win9X: doesn't have PATHEXT push @path_ext, qw(com exe bat); } return @path_ext; } sub which { my $program = shift; my @path_ext = @_; return unless $program; my @a = map {File::Spec->catfile($_, $program) } File::Spec->path(); for my $base (@a) { return $base if -x $base; for my $ext (@path_ext) { return "$base.$ext" if -x "$base.$ext"; } } return; } package MY; sub libscan { my($self, $path) = @_; return '' if $path =~ /\B\.svn\b|~#|\BSCCS\b/; $path; } sub macro { "\n" . DBI::DBD::dbd_postamble(@_) . <<"POSTAMBLE"; installhtml: lib/DBD/mysql/INSTALL.pod \tpod2html --infile=lib/DBD/mysql/INSTALL.pod --outfile=INSTALL.html POSTAMBLE }; sub 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; } package main; sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; ExtUtils::MakeMaker::WriteMakefile(%params); } __DATA__ my %opts = (); GetOptions(\%opts, 'cflags', 'libs', 'port', 'version', 'libmysqld-libs', 'embedded', 'embedded-libs', 'help', ) or usage(); usage() if ($opts{help} or not %opts); SWITCH : { local $\ = "\n"; $opts{cflags} and do { print $cflags; last SWITCH; }; $opts{libs} and do { print $libs; last SWITCH; }; $opts{port} and do { print $port; last SWITCH; }; $opts{version} and do { print $version; last SWITCH; }; ($opts{'libmysqld-libs'} or $opts{embedded} or $opts{'libmysqld-libs'} ) and do { print $embedded_libs; last SWITCH; }; usage(); } exit(0); sub usage { print << "EOU"; Usage: $0 [OPTIONS] Options: --cflags [$cflags] --libs [$libs] --port [$port] --version [$version] --libmysqld-libs [$embedded_libs] EOU exit(1); } DBD-mysql-4.025/myld0000644000175000017500000000326412230034435012621 0ustar patgpatg# -*- cperl -*- # # Small frontend for ld that ought to catch common problems # in the linking stage # use strict; use Data::Dumper; # fix to get link on Mac OSX to work! if ($ARGV[0] =~ /MACOSX/) { my ($macenv, $macenvval) = split('=',$ARGV[0]);; $ENV{$macenv} = $macenvval; shift @ARGV; } open(OLDSTDERR, ">&STDERR") || die "Failed to backup STDERR: $!"; open(FILE, ">myld.stderr") || die "Failed to create myld.stderr: $!"; open(STDERR, ">&FILE") || die "Failed to redirect STDERR: $!"; my $retval = system(@ARGV); open(STDERR, ">&OLDSTDERR"); close(FILE) || die "Failed to close myld.stderr: $!"; my $contents = ""; if (-f "myld.stderr" && !-z _) { open(FILE, "; die "Failed to read myld.stderr: $!" unless defined($contents); close(FILE) || die "Failed to close myld.stderr: $!"; if ($contents =~ /cannot find -l(g?z)/i) { my $missing = $1; print <<"MSG"; $contents An error occurred while linking the DBD::mysql driver. The error message seems to indicate that you don't have a lib$missing.a, or a lib$missing.so. There are a few ways to resolve this: 1) You may try to remove the -lz or -lgz flag from the libs list by using the --libs switch for "perl Makefile.PL". 2) On Red Hat Linux and SUSE Linux, install the zlib-devel package (sometimes called libz-devel) 3) On Debian and Ubuntu, install the zlib1g-dev package 4) On other systems, please contact the mailing list perl\@lists.mysql.com For further hints, see DBD::mysql::INSTALL, section Linker flags. MSG exit 1; } } if ($retval) { print STDERR $contents; exit 1; } END { unlink "myld.stderr"; } DBD-mysql-4.025/Makefile.PL.embedded0000644000175000017500000000131112230034435015422 0ustar patgpatguse 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.025/t/0000755000175000017500000000000012235705157012202 5ustar patgpatgDBD-mysql-4.025/t/65types.t0000644000175000017500000000244312230034435013676 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use vars qw($table $test_dsn $test_user $test_password); use Test::More; use DBI; use Carp qw(croak); 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 => "ERROR: $@. Can't continue test"; } plan tests => 19; ok $dbh->do("drop table if exists $table"); my $create= <do($create); my $sth; eval {$sth= $dbh->prepare("insert into $table 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 $table"); ok $dbh->do("create table $table (a int, b double, primary key (a))"); eval { $sth= $dbh->prepare("insert into $table 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 $table"); ok $dbh->disconnect; DBD-mysql-4.025/t/70takeimp.t0000644000175000017500000000575612230034435014172 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "Can't connect to database ERROR: $@. Can't continue test"; } unless ($DBI::VERSION ge '1.607') { plan skip_all => "version of DBI $DBI::VERSION doesn't support this test. Can't continue test"; } unless ($dbh->can('take_imp_data')) { plan skip_all => "version of DBI $DBI::VERSION doesn't support this test. Can't continue test"; } 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'; } print "here\n"; my $dbh2 = DBI->connect($test_dsn, $test_user, $test_password, { dbi_imp_data => $imp_data }); print "there\n"; # XXX: how can we test that the same connection is used? my $id2 = connection_id($dbh2); print "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: my $table= 't1'; ok $dbh->do("DROP TABLE IF EXISTS $table"); my $create= <do($create); ok $dbh->do("DROP TABLE $table"); } DBD-mysql-4.025/t/51bind_type_guessing.t0000644000175000017500000000404612230034435016407 0ustar patgpatg#!/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 => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 25; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; my $create= <<"EOTABLE"; create table $table ( id bigint unsigned not null default 0 ) EOTABLE ok $dbh->do($create), "creating table"; my $statement= "insert into $table (id) values (?)"; my $sth1; ok $sth1= $dbh->prepare($statement); my $rows; ok $rows= $sth1->execute('9999999999999999'); cmp_ok $rows, '==', 1; $statement= "update $table 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 $table set id = ? where id = ?"; ok $sth2= $dbh->prepare($statement); ok $rows= $sth2->execute('9999999999999996', '9999999999999997'); my $retref; ok $retref= $dbh->selectall_arrayref("select * from $table"); cmp_ok $retref->[0][0], '==', 9999999999999998; cmp_ok $retref->[1][0], '==', 9999999999999996; # checking varchars/empty strings/misidentification: $create= <<"EOTABLE"; create table $table ( str varchar(80), num bigint ) EOTABLE ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; ok $dbh->do($create), "creating table w/ varchar"; my $sth3; ok $sth3= $dbh->prepare("insert into $table (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 $table limit ?"); ok $rows= $sth3->execute(1); ok $rows= $sth3->execute(' 1'); $sth3->finish(); ok $dbh->disconnect; DBD-mysql-4.025/t/71impdata.t0000644000175000017500000000246112230034435014146 0ustar patgpatg#!/usr/bin/perl $| = 1; use strict; use DBI; use lib 't', '.'; require 'lib.pl'; use Test::More; use vars qw($test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect( $test_dsn, $test_user, $test_password);}; if ($@) { plan skip_all => "$@. Can't continue test"; } my $drh = $dbh->{Driver}; if (! defined $drh) { plan skip_all => "Can't obtain driver handle. Can't continue test"; } unless ($DBI::VERSION ge '1.607') { plan skip_all => "version of DBI $DBI::VERSION doesn't support this test. Can't continue test"; } unless ($dbh->can('take_imp_data')) { plan skip_all => "version of DBI $DBI::VERSION doesn't support this test. 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.025/t/mysql.dbtest0000644000175000017500000000303012230034435014537 0ustar patgpatg#!/usr/bin/perl use 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.025/t/00base.t0000644000175000017500000000125312230034435013427 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More tests => 6; # # Include lib.pl # use vars qw($mdriver $table); 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($mdriver); ok $drh, 'Install driver'; cmp_ok ref $drh, 'eq', 'DBI::dr', 'DBI::dr set'; ok $drh->{Version}, "Version $drh->{Version}"; print "Driver version is ", $drh->{Version}, "\n"; DBD-mysql-4.025/t/85init_command.t0000644000175000017500000000143212230034435015172 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; $|= 1; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } 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.025/t/40listfields.t0000644000175000017500000000402712230034435014665 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use vars qw($COL_NULLABLE $table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 26; $dbh->{mysql_server_prepare}= 0; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; $create = <do($create), "create table $table"; ok $dbh->table_info(undef,undef,$table), "table info for $table"; ok $dbh->column_info(undef,undef,$table,'%'), "column_info for $table"; 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 $table"); 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"; ok ($sth= $dbh->prepare("DROP TABLE $table")); 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.025/t/rt83494-quotes-comments.t0000644000175000017500000000207312230034435016560 0ustar patgpatg#!/usr/bin/perl # Test special characters inside comments # http://bugs.debian.org/311040 # http://bugs.mysql.com/27625 use strict; use warnings; use DBI (); use vars qw($test_dsn $test_user $test_password $state); require "t/lib.pl"; while (Testing()) { my ($dbh, $sth); # # Connect to the database Test($state or ($dbh = DBI->connect($test_dsn, $test_user, $test_password, {RaiseError => 0}))); my $q; # # Placeholder inside a comment # $q = " -- Does the question mark at the end confuse DBI::MySQL?\nselect ?"; Test($state or ($sth = $dbh->prepare($q))); Test($state or ($sth->execute(42))); Test($state or ($sth->{ParamValues})); Test($state or ($sth->finish)); # # Quote inside a comment # $q = " -- 'Tis the quote that confuses DBI::MySQL\nSELECT ?"; Test($state or ($sth = $dbh->prepare($q))); Test($state or ($sth->execute(42))); Test($state or ($sth->{ParamValues})); Test($state or ($sth->finish)); # # Close the database connection Test($state or ($dbh->disconnect() or 1)); } DBD-mysql-4.025/t/76multi_statement.t0000644000175000017500000000515712230034435015757 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "ERROR: $@. Can't continue test"; } plan tests => 25; ok (defined $dbh, "Connected to database with multi statement support"); $dbh->{mysql_server_prepare}= 0; SKIP: { my $v= $dbh->get_info($GetInfoType{SQL_DBMS_VER}); diag "Testing multicall against SQL_DBMS_VER: $v"; skip "Server doesn't support multi statements", 24 if !MinimumVersion($dbh, '4.1'); ok($dbh->do("SET SQL_MODE=''"),"init connection SQL_MODE non strict"); ok($dbh->do("DROP TABLE IF EXISTS $table"), "clean up"); ok($dbh->do("CREATE TABLE $table (a INT)"), "create table"); ok($dbh->do("INSERT INTO $table VALUES (1); INSERT INTO $table VALUES (2);"), "2 inserts"); # Check that a second do() doesn't fail with an 'Out of sync' error ok($dbh->do("INSERT INTO $table VALUES (3); INSERT INTO $table VALUES (4);"), "2 more inserts"); # Check that more_results works for non-SELECT results too my $sth; ok($sth = $dbh->prepare("UPDATE $table SET a=5 WHERE a=1; UPDATE $table 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 $table"), 4, "Delete all rows"); # Test that do() reports errors from all result sets $dbh->{RaiseError} = $dbh->{PrintError} = 0; ok(!$dbh->do("INSERT INTO $table VALUES (1); INSERT INTO bad_$table VALUES (2);"), "do() reports errors"); # Test that execute() reports errors from only the first result set ok($sth = $dbh->prepare("UPDATE $table SET a=2; UPDATE bad_$table 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"); }; $dbh->disconnect(); DBD-mysql-4.025/t/87async.t0000644000175000017500000001422612230034435013655 0ustar patgpatg#!/usr/bin/perl use 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 });}; unless($dbh) { plan skip_all => "ERROR: $DBI::errstr Can't continue test"; } unless($dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'})) { plan skip_all => "Async support wasn't built into this version of DBD::mysql"; } 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); $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.025/t/40catalog.t0000644000175000017500000002366012230034435014141 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More; use DBI; use lib '.', 't'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } 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 ($dummy,$have_innodb)= $dbh->selectrow_array("SHOW VARIABLES LIKE 'have_innodb'") or DbiError($dbh->err, $dbh->errstr); skip "Server doesn't support InnoDB, needed for testing foreign keys", 16 unless defined $have_innodb && $have_innodb eq "YES"; 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.025/t/52comment.t0000644000175000017500000000354312230034435014172 0ustar patgpatg#!/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 => 1, AutoCommit => 0, } ); }; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 30; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; my $create= <<"EOTABLE"; create table $table ( id bigint unsigned not null default 0 ) EOTABLE ok $dbh->do($create), "creating table"; my $statement= "insert into $table (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 $table /* it's a bug? */ WHERE id = ?"; $retrow= $dbh->selectrow_arrayref($statement, {}, 1); cmp_ok $retrow->[0], '==', 1; $statement= "SELECT id FROM $table WHERE id = ? /* it's a bug? */"; $retrow= $dbh->selectrow_arrayref($statement, {}, 1); cmp_ok $retrow->[0], '==', 1; $statement= "SELECT id FROM $table 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 $table"), "drop table if exists $table"; ok $dbh->disconnect; DBD-mysql-4.025/t/rt86153-reconnect-fail-memory.t0000644000175000017500000000340212232405223017603 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Carp qw(croak); use vars qw($table $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 => "Skip \$ENV{EXTENDED_TESTING} is not set\n"; } eval { require Proc::ProcessTable; }; if ($@) { plan skip_all => "Skip Proc::ProcessTable not installed \n"; } eval { require Storable }; $have_storable = $@ ? 0 : 1; 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, $msg); print "Testing memory leaks in connect/disconnect\n"; $msg = "Possible memory leak in connect/disconnect detected"; $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 { $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.025/t/31insertid.t0000644000175000017500000000255712230034435014352 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Data::Dumper; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 18; ok $dbh->do('SET @@auto_increment_offset = 1'); ok $dbh->do('SET @@auto_increment_increment = 1'); my $create = <do($create), "create $table"; my $query= "INSERT INTO $table (name) VALUES (?)"; my $sth; ok ($sth= $dbh->prepare($query)); ok defined $sth; ok $sth->execute("Jochen"); is $dbh->{'mysql_insertid'}, 1, "insert id == $dbh->{mysql_insertid}"; ok $sth->execute("Patrick"); ok (my $sth2= $dbh->prepare("SELECT max(id) FROM $table")); ok defined $sth2; ok $sth2->execute(); my $max_id; ok ($max_id= $sth2->fetch()); ok defined $max_id; cmp_ok $sth->{'mysql_insertid'}, '==', $max_id->[0], "sth insert id $sth->{'mysql_insertid'} == max(id) $max_id->[0] in $table"; cmp_ok $dbh->{'mysql_insertid'}, '==', $max_id->[0], "dbh insert id $dbh->{'mysql_insertid'} == max(id) $max_id->[0] in $table"; ok $sth->finish(); ok $sth2->finish(); ok $dbh->disconnect(); DBD-mysql-4.025/t/60leaks.t0000644000175000017500000001222012232406125013617 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Carp qw(croak); use vars qw($table $test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my $COUNT_CONNECT = 4000; # Number of connect/disconnect iterations my $COUNT_PREPARE = 10000; # Number of prepare/execute/finish 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 => "Skip Proc::ProcessTable not installed \n"; } eval { require Storable }; $have_storable = $@ ? 0 : 1; my ($dbh, $sth); eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $@. Can't continue test"; } plan tests => 21; 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; } ok $dbh->do("DROP TABLE IF EXISTS $table"); my $create= <do($create); my ($size, $prev_size, $ok, $not_ok, $dbh2, $msg); print "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 });}; 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"; print "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 $table"); $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"; print "Testing memory leaks in fetchrow_arrayref\n"; $msg= "Possible memory leak in fetchrow_arrayref detected"; $sth= $dbh->prepare("INSERT INTO $table 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 $table 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 $table"); $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"; print "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 $table"); $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 $table"); ok $dbh->disconnect; DBD-mysql-4.025/t/40types.t0000644000175000017500000000371212230034435013667 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use lib '.', 't'; require 'lib.pl'; $|= 1; use vars qw($table $test_dsn $test_user $test_password); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; print "err perl $@\n"; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 20; ok(defined $dbh, "Connected to database"); SKIP: { skip "New Data types not supported by server", 19 if !MinimumVersion($dbh, '5.0'); ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean"); 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); is_deeply($dbh->selectall_arrayref("SELECT * FROM t1"), [ ['2.1'], ['-1'] ]); 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"); is_deeply($dbh->selectall_arrayref("SELECT * FROM t1"), [ ['0'], ['4294967295'] ]); ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); }; $dbh->disconnect(); DBD-mysql-4.025/t/75supported_sql.t0000644000175000017500000000207012230034435015433 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use vars qw($table $test_dsn $test_user $test_password); use Carp qw(croak); 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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 12; ok $dbh->do("DROP TABLE IF EXISTS $table"); my $create = <do($create),"create $table"; my $sth; ok ($sth= $dbh->prepare("SHOW TABLES LIKE '$table'")); ok $sth->execute(); ok ($row= $sth->fetchrow_arrayref); cmp_ok $row->[0], 'eq', $table, "\$row->[0] eq $table"; ok $sth->finish; ok $dbh->do("DROP TABLE $table"), "drop $table"; ok $dbh->do("CREATE TABLE $table (a int)"), "creating $table again with 1 col"; ok $dbh->do("ALTER TABLE $table ADD COLUMN b varchar(31)"), "alter $table ADD COLUMN"; ok $dbh->do("DROP TABLE $table"), "drop $table"; ok $dbh->disconnect; DBD-mysql-4.025/t/65segfault.t0000644000175000017500000000227212230034435014344 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } my $dbh2; eval {$dbh2= DBI->connect($test_dsn, $test_user, $test_password);}; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } 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.025/t/43count_params.t0000644000175000017500000000346712230034435015230 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } 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 $table")); my $create = <do($create)); ok (my $sth = $dbh->prepare("INSERT INTO $table (name, id)" . " VALUES ('Charles de Batz de Castelmore, comte d\\'Artagnan', ?)")); ok ($sth->execute(1)); ok ($sth = $dbh->prepare("INSERT INTO $table (name, id)" . " VALUES ('Charles de Batz de Castelmore, comte d\\'Artagnan', 2)")); ok ($sth->execute()); ok ($sth = $dbh->prepare("INSERT INTO $table (name, id) VALUES (?, ?)")); ok ($sth->execute("Charles de Batz de Castelmore, comte d\\'Artagnan", 3)); ok ($sth = $dbh->prepare("INSERT INTO $table (id, name)" . " VALUES (?, 'Charles de Batz de Castelmore, comte d\\'Artagnan')")); ok ($sth->execute(1)); ok ($sth = $dbh->prepare("INSERT INTO $table (id, name)" . " VALUES (2, 'Charles de Batz de Castelmore, comte d\\'Artagnan')")); ok ($sth->execute()); ok ($sth = $dbh->prepare("INSERT INTO $table (id, name) VALUES (?, ?)")); ok ($sth->execute(3, "Charles de Batz de Castelmore, comte d\\'Artagnan")); ok ($dbh->do("DROP TABLE $table")); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.025/t/pod.t0000644000175000017500000000020112230034435013127 0ustar patgpatguse 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.025/t/rt85919-fetch-lost-connection.t0000644000175000017500000000242612230034435017630 0ustar patgpatguse strict; use warnings; use DBI; use Test::More; use lib 't', '.'; use vars qw($table $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 => "ERROR: $@. Can't continue test"; } my $sth; my $ok = eval { print "Connecting...\n"; ok( $sth = $dbh->do('SET wait_timeout = 5'), 'set wait_timeout'); print "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 { print "Selecting...\n"; my @res = $dbh->selectrow_array($sql); } $dbh->disconnect(); $dbh = undef; 1; }; if (not $ok) { is ( $DBI::err, 2006, 'Received error 2006' ); is ( $DBI::errstr, 'MySQL server has gone away', 'Received MySQL server has gone away'); eval { $sth->finish(); } if defined $sth; eval { $dbh->disconnect(); } if defined $dbh; } done_testing(); DBD-mysql-4.025/t/53comment.t0000644000175000017500000000376212230034435014176 0ustar patgpatg#!/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 => 1, AutoCommit => 0, mysql_bind_comment_placeholders => 1,} ); }; if ($@) { plan skip_all => "ERROR: $DBI::errstr, $@. Can't continue test"; } plan tests => 29; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; my $create= <<"EOTABLE"; create table $table ( id bigint unsigned not null default 0 ) EOTABLE ok $dbh->do($create), "creating table"; my $statement= "insert into $table (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 $table /* Some value here ? */ WHERE id = ?"; $retrow= $dbh->selectrow_arrayref($statement, {}, "hello", 1); cmp_ok $retrow->[0], '==', 1; } $statement= "SELECT id FROM $table 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->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; ok $dbh->disconnect; DBD-mysql-4.025/t/41blobs_prepare.t0000644000175000017500000000365412230034435015350 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; my $update_blob; use vars qw($table $test_dsn $test_user $test_password); use lib 't', '.'; require 'lib.pl'; my ($dbh, $row); eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 25; my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; my $blob1= join '', map { $chars[rand @chars] } 0 .. 10000; my $blob2 = '"' x 10000; sub ShowBlob($) { my ($blob) = @_; my $b; for(my $i = 0; $i < 8; $i++) { if (defined($blob) && length($blob) > $i) { $b = substr($blob, $i*32); } else { $b = ""; } printf("%08lx %s\n", $i*32, unpack("H64", $b)); } } my $create = <do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; ok $dbh->do($create), "create table $table"; my $query = "INSERT INTO $table VALUES(?, ?)"; my $sth; ok ($sth= $dbh->prepare($query)); ok defined($sth); ok $sth->execute(1, $blob1), "inserting \$blob1"; ok $sth->finish; ok ($sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")); ok $sth->execute, "select from $table"; ok ($row = $sth->fetchrow_arrayref); is @$row, 2, "two rows fetched"; is $$row[0], 1, "first row id == 1"; cmp_ok $$row[1], 'eq', $blob1, ShowBlob($blob1); ok $sth->finish; ok ($sth= $dbh->prepare("UPDATE $table SET name = ? WHERE id = 1")); ok $sth->execute($blob2), 'inserting $blob2'; ok ($sth->finish); ok ($sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")); ok ($sth->execute); ok ($row = $sth->fetchrow_arrayref); is scalar @$row, 2, 'two rows'; is $$row[0], 1, 'row id == 1'; cmp_ok $$row[1], 'eq', $blob2, ShowBlob($blob2); ok ($sth->finish); ok $dbh->do("DROP TABLE $table"), "drop $table"; ok $dbh->disconnect; DBD-mysql-4.025/t/29warnings.t0000644000175000017500000000276312230034435014367 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use lib '.', 't'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "ERROR: $@. Can't continue test"; } if ( !MinimumVersion($dbh, '4.1') ) { plan skip_all => "Servers < 4.1 do not report warnings"; } 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; } is($numwarn, 2 ); ok($dbh->disconnect); DBD-mysql-4.025/t/81procs.t0000644000175000017500000000540212230034435013654 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use lib 't', '.'; require 'lib.pl'; use DBI; use Test::More; use Carp qw(croak); use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } # # DROP/CREATE PROCEDURE will give syntax error # for versions < 5.0 # if (!MinimumVersion($dbh, '5.0')) { 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 $table"); 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.025/t/35prepare.t0000644000175000017500000000635412230034435014172 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use Carp qw(croak); use Data::Dumper; 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 => "Can't connect to database ERROR: $DBI::errstr. Can't continue test"; } plan tests => 49; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS t1"), "Making slate clean"); ok($dbh->do("CREATE TABLE t1 (id INT(4), name VARCHAR(64))"), "Creating table"); ok($sth = $dbh->prepare("SHOW TABLES LIKE 't1'"), "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 't1', "Checking if results equal to 't1' \n"); ok($sth->finish, "Finishing up with statement handle"); ok($dbh->do("INSERT INTO t1 VALUES (1,'1st first value')"), "Inserting first row"); ok($sth= $dbh->prepare("INSERT INTO t1 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 t1 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 t1 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 t1 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)"); print "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 t1"), "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.025/t/99_bug_server_prepare_blob_null.t0000644000175000017500000000244412230034435020612 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Carp qw(croak); use Test::More; use vars qw($table $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'; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $@. Can't continue test"; } # # 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 $table"); my $create =<do($create); $dbh->do("insert into $table (data) values(null)"); my $sth = $dbh->prepare("select data from $table"); ok $sth->execute; my $row = $sth->fetch; is $row->[0] => undef; ok $sth->finish; $dbh->do("insert into $table (data) values('a')"); $sth = $dbh->prepare("select data from $table"); 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 $table"); ok $dbh->disconnect; DBD-mysql-4.025/t/20createdrop.t0000644000175000017500000000127612230034435014654 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; $|= 1; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 4; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean"); ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating $table"); ok($dbh->do("DROP TABLE $table"), "dropping created $table"); $dbh->disconnect(); DBD-mysql-4.025/t/40server_prepare.t0000644000175000017500000000444712230034435015555 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use vars qw($table $test_dsn $test_user $test_password); $|= 1; $test_dsn.= ";mysql_server_prepare=1"; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $@. Can't continue test"; } plan tests => 27; ok(defined $dbh, "connecting"); ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean"); # # Bug #20559: Program crashes when using server-side prepare # ok($dbh->do(qq{CREATE TABLE t1 (id INT, num DOUBLE)}), "creating table"); my $sth; ok($sth= $dbh->prepare(qq{INSERT INTO t1 VALUES (?,?),(?,?)}), "loading data"); ok($sth->execute(1, 3.0, 2, -4.5)); ok ($sth= $dbh->prepare("SELECT num FROM t1 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 t1}), "cleaning up"); # # Bug #42723: Binding server side integer parameters results in corrupt data # ok($dbh->do(qq{DROP TABLE IF EXISTS t2}), "making slate clean"); ok($dbh->do(q{CREATE TABLE `t2` (`i` int,`si` smallint,`ti` tinyint,`bi` bigint)}), "creating test table"); my $sth2; ok($sth2 = $dbh->prepare('INSERT INTO t2 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 t2'), [[101, 102, 103, 104]]); ok ($dbh->do(qq{DROP TABLE t2}), "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]]); ok ($dbh->do(qq{DROP TABLE t3}), "cleaning up"); $dbh->disconnect(); DBD-mysql-4.025/t/40keyinfo.t0000644000175000017500000000246412230034435014172 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } 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 $table"), "Dropped table"); # Non-primary key is there as a regression test for Bug #26786. ok($dbh->do("CREATE TABLE $table (a int, b varchar(20), c int, primary key (a,b(10)), key (c))"), "Created table $table"); my $sth= $dbh->primary_key_info(undef, undef, $table); ok($sth, "Got primary key info"); my $key_info= $sth->fetchall_arrayref; my $expect= [ [ undef, undef, $table, 'a', '1', 'PRIMARY' ], [ undef, undef, $table, 'b', '2', 'PRIMARY' ], ]; is_deeply($key_info, $expect, "Check primary_key_info results"); is_deeply([ $dbh->primary_key(undef, undef, $table) ], [ 'a', 'b' ], "Check primary_key results"); ok($dbh->do("DROP TABLE $table"), "Dropped table"); $dbh->disconnect(); DBD-mysql-4.025/t/50commit.t0000644000175000017500000000736512230034435014024 0ustar patgpatg#!/usr/bin/perl use 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 $table); my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } sub catch_warning ($) { $got_warning = 1; } sub num_rows($$$) { my($dbh, $table, $num) = @_; my($sth, $got); if (!($sth = $dbh->prepare("SELECT * FROM $table"))) { 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 => 21; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; my $create =<do($create), 'create $table'; 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 $table VALUES (1, 'Jochen')"), "insert into $table (1, 'Jochen')"; my $msg; $msg = num_rows($dbh, $table, 1); ok !$msg; ok $dbh->rollback, 'rollback'; $msg = num_rows($dbh, $table, 0); ok !$msg; ok $dbh->do("DELETE FROM $table WHERE id = 1"), "delete from $table where id = 1"; $msg = num_rows($dbh, $table, 0); ok !$msg; ok $dbh->commit, 'commit'; $msg = num_rows($dbh, $table, 0); ok !$msg; # Check auto rollback after disconnect ok $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"); $msg = num_rows($dbh, $table, 1); ok !$msg; ok $dbh->disconnect; ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password)); ok $dbh, "connected"; $msg = num_rows($dbh, $table, 0); ok !$msg; ok $dbh->{AutoCommit}, "\$dbh->{AutoCommit} $dbh->{AutoCommit}"; } else { plan tests => 13; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; my $create =<do($create), 'create $table'; # Tests for databases that don't support transactions # Check whether AutoCommit mode works. ok $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"); my $msg = num_rows($dbh, $table, 1); ok !$msg; ok $dbh->disconnect; ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password)); $msg = num_rows($dbh, $table, 1); ok !$msg; ok $dbh->do("INSERT INTO $table 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 $table 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 $table"); ok $dbh->disconnect(); } DBD-mysql-4.025/t/25lockunlock.t0000644000175000017500000000261112230034435014667 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; # # Make -w happy # use vars qw($table $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 => "Can't connect to database ERROR: $DBI::errstr. Can't continue test"; } plan tests => 13; my $create= <do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; ok $dbh->do($create), "create table $table"; ok $dbh->do("LOCK TABLES $table WRITE"), "lock table $table"; ok $dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "Insert "; ok $dbh->do("DELETE FROM $table WHERE id = 1"), "Delete"; my $sth; eval {$sth= $dbh->prepare("SELECT * FROM $table 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 $table"), "Drop table $table"; ok $dbh->disconnect, "Disconnecting"; DBD-mysql-4.025/t/40nulls.t0000644000175000017500000000176412230034435013665 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Carp qw(croak); use Data::Dumper; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 10; ok $dbh->do("DROP TABLE IF EXISTS $table"), "DROP TABLE IF EXISTS $table"; my $create= <do($create), "create table $create"; ok $dbh->do("INSERT INTO $table VALUES ( NULL, 'NULL-valued id' )"), "inserting nulls"; ok ($sth = $dbh->prepare("SELECT * FROM $table 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 $table"); ok $dbh->disconnect; DBD-mysql-4.025/t/mysql.mtest0000644000175000017500000000222112235676313014423 0ustar patgpatg{ local $opt = { 'mysql_config' => 'mysql_config', 'embedded' => '', 'ssl' => 1, 'ldflags' => '', 'nocatchstderr' => 0, 'libs' => '-L/usr/lib -lmysqlclient -lpthread -lm -lrt -lssl -lcrypto -ldl', 'testhost' => '', 'nofoundrows' => 0, 'testport' => '', 'cflags' => '-I/usr/include -g -fstack-protector --param=ssp-buffer-size=4 -Wformat-security -fPIC -g -static-libgcc -fno-omit-frame-pointer -DPERCONA_INNODB_VERSION=rel61.0 -fPIC -g -fabi-version=2 -fno-omit-frame-pointer -fno-strict-aliasing -DMY_PTHREAD_FASTMUTEX=1', 'testdb' => 'test', 'testuser' => 'patg', 'testpassword' => 'foo', 'testsocket' => '' }; $::test_host = $opt->{'testhost'}; $::test_port = $opt->{'testport'}; $::test_user = $opt->{'testuser'}; $::test_socket = $opt->{'testsocket'}; $::test_password = $opt->{'testpassword'}; $::test_db = $opt->{'testdb'}; $::test_dsn = "DBI:mysql:$::test_db"; $::test_dsn .= ";mysql_socket=$::test_socket" if $::test_socket; $::test_dsn .= ":$::test_host" if $::test_host; $::test_dsn .= ":$::test_port" if $::test_port; } 1; DBD-mysql-4.025/t/40bindparam2.t0000644000175000017500000000217112230034435014540 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI (); use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 13; ok $dbh->do('SET @@auto_increment_offset = 1'); ok $dbh->do('SET @@auto_increment_increment = 1'); my $create= <do($create), "create table $table"; ok $dbh->do("INSERT INTO $table VALUES(NULL, 1)"), "insert into $table (null, 1)"; my $rows; ok ($rows= $dbh->selectall_arrayref("SELECT * FROM $table")); is $rows->[0][1], 1, "\$rows->[0][1] == 1"; ok (my $sth = $dbh->prepare("UPDATE $table 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 $table")); ok !defined($rows->[0][1]); ok ($dbh->disconnect()); DBD-mysql-4.025/t/40nulls_prepare.t0000644000175000017500000000466412230034435015405 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use Carp qw(croak); 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 => "Can't connect to database ERROR: $DBI::errstr. Can't continue test"; } plan tests => 22; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS t1"), "Making slate clean"); my $create= <do($create), "creating test table for bug 49719"); my ($sth_insert, $sth_lookup); my $insert= 'INSERT INTO t1 (id, value0, value1, value2) VALUES (?, ?, ?, ?)'; ok($sth_insert= $dbh->prepare($insert), "Prepare of insert"); my $select= "SELECT * FROM t1 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->disconnect(), "Testing disconnect"); DBD-mysql-4.025/t/15reconnect.t0000644000175000017500000000212612230074264014507 0ustar patgpatg#!/usr/bin/perl use 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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 8 * 2; 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 }); 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"); $dbh->disconnect(); } DBD-mysql-4.025/t/lib.pl0000644000175000017500000001670312230034435013301 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI::Const::GetInfoType; use vars qw($table $mdriver $dbdriver $childPid $test_dsn $test_user $test_password); $table= 't1'; $| = 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; } } # # The Testing() function builds the frame of the test; it can be called # in many ways, see below. # # Usually there's no need for you to modify this function. # # Testing() (without arguments) indicates the beginning of the # main loop; it will return, if the main loop should be # entered (which will happen twice, once with $state = 1 and # once with $state = 0) # Testing('off') disables any further tests until the loop ends # Testing('group') indicates the begin of a group of tests; you # may use this, for example, if there's a certain test within # the group that should make all other tests fail. # Testing('disable') disables further tests within the group; must # not be called without a preceding Testing('group'); by default # tests are enabled # Testing('enabled') reenables tests after calling Testing('disable') # Testing('finish') terminates a group; any Testing('group') must # be paired with Testing('finish') # # You may nest test groups. # { # Note the use of the pairing {} in order to get local, but static, # variables. my (@stateStack, $count, $off, $skip_all_reason, $skip_n_reason, @skip_n); $::numTests = 0; $count = 0; @skip_n = (); sub Testing(;$) { my ($command) = shift; if (!defined($command)) { @stateStack = (); $off = 0; if ($count == 0) { ++$count; $::state = 1; } elsif ($count == 1) { my($d); if ($off) { print "1..0\n"; exit 0; } ++$count; $::state = 0; print "1..$::numTests\n"; } else { return 0; } if ($off) { $::state = 1; } $::numTests = 0; } elsif ($command eq 'off') { $off = 1; $::state = 0; } elsif ($command eq 'group') { push(@stateStack, $::state); } elsif ($command eq 'disable') { $::state = 0; } elsif ($command eq 'enable') { if ($off) { $::state = 0; } else { my $s; $::state = 1; foreach $s (@stateStack) { if (!$s) { $::state = 0; last; } } } return; } elsif ($command eq 'finish') { $::state = pop(@stateStack); } else { die("Testing: Unknown argument\n"); } return 1; } # # Read a single test result # sub Test ($;$$) { my($result, $error, $diag) = @_; return Skip($skip_all_reason) if (defined($skip_all_reason)); if (scalar(@skip_n)) { my $skipped = 0; my $t = $::numTests + 1; foreach my $n (@skip_n) { return Skip($skip_n_reason) if ($n == $t); } } ++$::numTests; if ($count == 2) { if (defined($diag)) { printf("$diag%s", (($diag =~ /\n$/) ? "" : "\n")); } if ($::state || $result) { print "ok $::numTests\n"; return 1; } else { my ($pack, $file, $line) = caller(); printf("not ok $::numTests%s at line $line\n", (defined($error) ? " $error" : "")); return 0; } } return 1; } # # Skip some test # sub Skip ($) { my $reason = shift; ++$::numTests; if ($count == 2) { if ($reason) { print "ok $::numTests # Skip $reason\n"; } else { print "ok $::numTests # Skip\n"; } } return 1; } sub SkipAll($) { $skip_all_reason = shift; } sub SkipN($@) { $skip_n_reason = shift; @skip_n = @_; } } # # Print a DBI error message # # TODO - This is on the chopping block sub DbiError ($$) { my ($rc, $err) = @_; $rc ||= 0; $err ||= ''; print "Test $::numTests: DBI error $rc, $err\n"; } # # These functions generates a list of possible DSN's aka # databases and returns a possible table name for a new # table being created. # { my(@tables, $testtable, $listed); $testtable = "testaa"; $listed = 0; sub FindNewTable($) { my($dbh) = @_; if (UNIVERSAL::isa($dbh, "Mysql")) { $dbh = $dbh->{'dbh'}; } if (!$listed) { @tables = grep {s/(?:^.*\.)|`//g} $dbh->tables(); $listed = 1; } # A small loop to find a free test table we can use to mangle stuff in # and out of. This starts at testaa and loops until testaz, then testba # - testbz and so on until testzz. my $foundtesttable = 1; my $table; while ($foundtesttable) { $foundtesttable = 0; foreach $table (@tables) { if ($table eq $testtable) { $testtable++; $foundtesttable = 1; } } } $table = $testtable; $testtable++; $table; } } 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 }; sub ErrMsg (@) { print (@_); } sub ErrMsgF (@) { printf (@_); } =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.025/t/50chopblanks.t0000644000175000017500000000352712230034435014654 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; 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 => 1, AutoCommit => 1 });}; if ($@) { plan skip_all => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 36; for my $mysql_server_prepare (0) { eval {$dbh= DBI->connect($test_dsn . ';mysql_server_prepare=' . $mysql_server_prepare, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; my $create= <do($create), "create table $table"; ok (my $sth= $dbh->prepare("INSERT INTO $table (id, name) VALUES (?, ?)")); ok (my $sth2= $dbh->prepare("SELECT id, name FROM $table WHERE id = ?")); my $rows; $rows = [ [1, ''], [2, ' '], [3, ' a b c '], [4, 'blah'] ]; for my $ref (@$rows) { my ($id, $name) = @$ref; ok $sth->execute($id, $name), "insert into $table values ($id, '$name')"; ok $sth2->execute($id), "select id, name from $table where id = $id"; # First try to retreive without chopping blanks. $sth2->{'ChopBlanks'} = 0; my $ret_ref = []; ok ($ret_ref = $sth2->fetchrow_arrayref); cmp_ok $ret_ref->[1], 'eq', $name, "\$name should not have blanks chopped"; # Now try to retreive with chopping blanks. $sth2->{'ChopBlanks'} = 1; ok $sth2->execute($id); my $n = $name; $n =~ s/\s+$//; $ret_ref = []; ok ($ret_ref = $sth2->fetchrow_arrayref); cmp_ok $ret_ref->[1], 'eq', $n, "should have blanks chopped"; } ok $sth->finish; ok $sth2->finish; ok $dbh->do("DROP TABLE $table"), "drop $table"; ok $dbh->disconnect; } DBD-mysql-4.025/t/89async-method-check.t0000644000175000017500000001403612230034435016207 0ustar patgpatg#!/usr/bin/perl use 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 });}; unless($dbh) { plan skip_all => "ERROR: $DBI::errstr Can't continue test"; } unless($dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'})) { plan skip_all => "Async support wasn't built into this version of DBD::mysql"; } plan tests => 2 * @db_safe_methods + 4 * @db_unsafe_methods + 7 * @st_safe_methods + 2 * @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); } 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 clear async state ok !defined($sth->mysql_async_result), "Testing DBD::mysql::st method '$method' clears async state"; like $sth->errstr, qr/Gathering asynchronous results for a synchronous handle/; } 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.025/t/32insert_error.t0000644000175000017500000000161112230034435015235 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use lib '.', 't'; require 'lib.pl'; use vars qw($table $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 => "ERROR: $@. Can't continue test"; } plan tests => 9; ok $dbh->do("DROP TABLE IF EXISTS $table"); my $create = <do($create); my $query = "INSERT INTO $table (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 $table"); ok $dbh->disconnect(); DBD-mysql-4.025/t/10connect.t0000644000175000017500000000125212232420104014140 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More ; use DBI; use vars qw($mdriver); $|= 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 ($@) { # https://rt.cpan.org/Ticket/Display.html?id=31823 if ($DBI::err == 1045) { Test::More::BAIL_OUT("ERROR: $DBI::errstr\nAborting remaining tests!"); } plan skip_all => "ERROR: $DBI::errstr $DBI::err Can't continue test"; } plan tests => 2; ok defined $dbh, "Connected to database"; ok $dbh->disconnect(); DBD-mysql-4.025/t/40blobs.t0000644000175000017500000000351212230034435013622 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use vars qw($table $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 = ""; } printf("%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 => "ERROR: $DBI::errstr. Can't continue test"; } else { plan tests => 14; } if (!MinimumVersion($dbh, '4.1')) { $charset= ''; } my $size= 128; ok $dbh->do("DROP TABLE IF EXISTS $table"), "Drop table if exists $table"; 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 $table VALUES(1, $qblob)"; ok ($dbh->do($query)); # Now, try SELECT'ing the row out. ok (my $sth = $dbh->prepare("SELECT * FROM $table WHERE id = 1")); ok ($sth->execute); ok (my $row = $sth->fetchrow_arrayref); ok defined($row), "row returned defined"; is @$row, 2, "records from $table 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 $table"), "Drop table $table"; ok $dbh->disconnect; DBD-mysql-4.025/t/42bindparam.t0000644000175000017500000000172412230034435014463 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use vars qw($table $test_dsn $test_user $test_password $mdriver); use Test::More; use DBI; use Carp qw(croak); 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 => "ERROR: $@. Can't continue test"; } plan tests => 12; ok $dbh->do("drop table if exists $table"); my $create= <do($create); ok (my $sth= $dbh->prepare("insert into $table 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 $table"); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.025/t/80procs.t0000644000175000017500000000535512230034435013662 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use lib 't', '.'; require 'lib.pl'; use DBI; use Test::More; use Carp qw(croak); use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } # # DROP/CREATE PROCEDURE will give syntax error # for versions < 5.0 # if (!MinimumVersion($dbh, '5.0') ) { 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 $table"); my $drop_proc= "DROP PROCEDURE IF EXISTS testproc"; 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 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"; 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.025/t/41bindparam.t0000644000175000017500000000177112230034435014464 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Carp qw(croak); use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 11; my ($rows, $errstr, $ret_ref); ok $dbh->do("drop table if exists $table"), "drop table $table"; ok $dbh->do("create table $table (a int not null, primary key (a))"), "create table $table"; ok ($sth= $dbh->prepare("insert into $table 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 $table")); ok $sth->execute(); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.025/t/88async-multi-stmts.t0000644000175000017500000000230512230034435016151 0ustar patgpatg#!/usr/bin/perl use 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 });}; unless($dbh) { plan skip_all => "ERROR: $DBI::errstr Can't continue test"; } unless($dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'})) { my $mode = $dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'}); plan skip_all => "Async support wasn't built into this version of DBD::mysql (mode is $mode, $GetInfoType{'SQL_ASYNC_MODE'})"; } 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.025/t/40bindparam.t0000644000175000017500000000547112230034435014464 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use lib 't', '.'; require 'lib.pl'; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } 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 $table")); my $create = <do($create)); ok (my $sth = $dbh->prepare("INSERT INTO $table 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 equivelant 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 $table VALUES (6, '?')")); ok ($dbh->do('SET @old_sql_mode = @@sql_mode, @@sql_mode = \'\'')); ok ($dbh->do("INSERT INTO $table VALUES (7, \"?\")")); ok ($dbh->do('SET @@sql_mode = @old_sql_mode')); ok ($sth = $dbh->prepare("SELECT * FROM $table 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 $table")); ok $sth->finish; ok $dbh->disconnect; DBD-mysql-4.025/t/90no-async.t0000644000175000017500000000201012230034435014245 0ustar patgpatg#!/usr/bin/perl use 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 });}; unless($dbh) { plan skip_all => "ERROR: $DBI::errstr Can't continue test"; } if($dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'})) { plan skip_all => "Async support was built into this version of DBD::mysql"; } plan tests => 14; is $dbh->get_info($GetInfoType{'SQL_MAX_ASYNC_CONCURRENT_STATEMENTS'}), 0; ok !$dbh->do('SELECT 1', { async => 1 }); ok $dbh->errstr; ok !$dbh->prepare('SELECT 1', { async => 1 }); ok $dbh->errstr; ok !$dbh->mysql_async_result; ok $dbh->errstr; ok !$dbh->mysql_async_ready; ok $dbh->errstr; my $sth = $dbh->prepare('SELECT 1'); ok $sth; ok !$sth->mysql_async_result; ok $dbh->errstr; ok !$sth->mysql_async_ready; ok $dbh->errstr; $dbh->disconnect; DBD-mysql-4.025/t/30insertfetch.t0000644000175000017500000000202012230034435015027 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; use lib 't', '.'; require 'lib.pl'; $|= 1; use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 10; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean"); ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating table"); ok($dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "loading data"); ok($dbh->do("DELETE FROM $table WHERE id = 1"), "deleting from table $table"); ok (my $sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")); ok($sth->execute()); ok(not $sth->fetchrow_arrayref()); ok($sth->finish()); ok($dbh->do("DROP TABLE $table"),"Dropping table"); $dbh->disconnect(); DBD-mysql-4.025/t/40numrows.t0000644000175000017500000000357212230034435014241 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Carp qw(croak); use vars qw($table $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 => "ERROR: $DBI::errstr. Can't continue test"; } plan tests => 30; ok $dbh->do("DROP TABLE IF EXISTS $table"); my $create= <do($create), "CREATE TABLE $table"; ok $dbh->do("INSERT INTO $table VALUES( 1, 'Alligator Descartes' )"), 'inserting first row'; ok ($sth = $dbh->prepare("SELECT * FROM $table 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 $table VALUES( 2, 'Jochen Wiedmann' )"), 'inserting second row'; ok ($sth = $dbh->prepare("SELECT * FROM $table 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 $table VALUES(3, 'Tim Bunce')"), "inserting third row"; ok ($sth = $dbh->prepare("SELECT * FROM $table 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 $table")); 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 $table"), "drop table $table"; ok $dbh->disconnect; DBD-mysql-4.025/t/40server_prepare_error.t0000644000175000017500000000172212230034435016757 0ustar patgpatg#!/usr/bin/perl use 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"; my $dbh; eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 1})}; if ($@) { plan skip_all => "ERROR: $@. Can't continue test"; } # # DROP/CREATE PROCEDURE will give syntax error # for versions < 5.0 # 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 => 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', ''; print "errstr $DBI::errstr\n" if $DBI::errstr; ok $dbh->disconnect(); DBD-mysql-4.025/t/35limit.t0000644000175000017500000000313612230034435013645 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use DBI::Const::GetInfoType; $|= 1; my $rows = 0; my $sth; my $testInsertVals; use vars qw($table $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 => "ERROR: $@. Can't continue test"; } plan tests => 111; ok(defined $dbh, "Connected to database"); ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean"); ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating table"); ok(($sth = $dbh->prepare("INSERT INTO $table VALUES (?,?)"))); print "PERL testing insertion of values from previous prepare of insert statement:\n"; for (my $i = 0 ; $i < 100; $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))); } print "PERL rows : " . $rows . "\n"; print "PERL testing prepare of select statement with LIMIT placeholders:\n"; ok($sth = $dbh->prepare("SELECT * FROM $table LIMIT ?, ?")); print "PERL testing exec of bind vars for LIMIT\n"; ok($sth->execute(20, 50)); 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("DROP TABLE $table")); ok($dbh->disconnect); DBD-mysql-4.025/t/55utf8.t0000644000175000017500000000511512230034435013416 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Carp qw(croak); use Test::More; use vars qw($table $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 => "ERROR: $@. Can't continue test"; } # # 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 => 16 * 2; 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 }); ok $dbh->do("DROP TABLE IF EXISTS $table"); 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; my $query = <do($query, {}, $utf8_str, $blob, $utf8_str, $utf8_str), "INSERT query $query\n"; $query = "SELECT name,bincol,asbinary(shape), binutf, profile FROM $table 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 $table"); ok $dbh->disconnect; } DBD-mysql-4.025/t/91errcheck.t0000644000175000017500000000077112230034435014321 0ustar patgpatguse 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 });}; unless($dbh) { plan skip_all => "ERROR: $DBI::errstr Can't continue test"; } 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.025/t/86_bug_36972.t0000644000175000017500000000234112230034435014220 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Test::More; use DBI; use lib 't', '.'; require 'lib.pl'; use vars qw($table $test_dsn $test_user $test_password); $|= 1; my $dbh; eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; if ($@) { plan skip_all => "ERROR: $@. Can't continue test"; } 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 t1'), "making slate clean"); ok($dbh->do('CREATE TABLE `t1` (`i` int,`si` smallint,`ti` tinyint,`bi` bigint)'), "creating test table"); my $sth2; ok($sth2 = $dbh->prepare('INSERT INTO t1 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 t1'), [[101, 102, 103, 104]]); ok ($dbh->do('DROP TABLE t1'), "cleaning up"); $dbh->disconnect(); DBD-mysql-4.025/eg/0000755000175000017500000000000012235705157012332 5ustar patgpatgDBD-mysql-4.025/eg/proc_example2.pl0000644000175000017500000000263312230034435015420 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Data::Dumper; my $db='test'; my $host='localhost'; my $user='root'; my $password=''; my $i= 0; my $dbh = DBI->connect("DBI:mysql:$db:$host", "$user", "$password", { PrintError => 0}) || die $DBI::errstr; # DROP TABLE IF EXISTS $dbh->do("DROP TABLE IF EXISTS users") or print $DBI::errstr; # CREATE TABLE $dbh->do("CREATE TABLE users (id INT, name VARCHAR(32))") or print $DBI::errstr; my $sth= $dbh->prepare("INSERT INTO users VALUES (?, ?)"); for $i(1 .. 20) { my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; my $random_chars = join '', map { $chars[rand @chars] } 0 .. 31; my $rows = $sth->execute($i, $random_chars); } $dbh->do("DROP PROCEDURE IF EXISTS users_proc") or print $DBI::errstr; $dbh->do("CREATE PROCEDURE users_proc() DETERMINISTIC BEGIN SELECT id, name FROM users; SELECT name, id FROM users; END") or print $DBI::errstr; $sth = $dbh->prepare('call users_proc()') || die $DBI::err.": ".$DBI::errstr; $sth->execute || die DBI::err.": ".$DBI::errstr; do { print "\nResult set ".++$i."\n---------------------------------------\n\n"; for my $colno (0..$sth->{NUM_OF_FIELDS}-1) { print $sth->{NAME}->[$colno]."\t"; } print "\n"; while (my $rowref=$sth->fetchrow_arrayref()) { for my $field (0..$#$rowref) { print $rowref->[$field]."\t"; } print "\n"; } } while ($sth->more_results()) DBD-mysql-4.025/eg/bug30033pg.pl0000644000175000017500000000071012230034435014347 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use DBI; my $dsn = "DBI:Pg:database=postgres;host=localhost"; my $dbh = DBI->connect( $dsn, 'postgres', '', { RaiseError => 1 } ) or die $DBI::errstr; $dbh->do('CREATE TABLE buggy ( id INT )'); $dbh->do('INSERT INTO buggy (id) VALUES (1)'); my $ref= $dbh->selectrow_arrayref(<do('DROP TABLE buggy'); DBD-mysql-4.025/eg/bigint_quotes.pl0000644000175000017500000000157412230034435015537 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Data::Dumper; my $create= <<'EOTABLE'; create table bigt1 ( id bigint unsigned not null default 0 ) EOTABLE #my $dbh= DBI->connect('DBI:mysql:test', 'root', 'root', { mysql_bind_type_guessing => 2}) # or die "unable to connect $DBI::errstr"; my $dbh= DBI->connect('DBI:mysql:test', 'root', 'root') or die "unable to connect $DBI::errstr"; $dbh->{mysql_bind_type_guessing}= 1; $dbh->do('drop table if exists bigt1'); $dbh->do($create); my $statement= 'insert into bigt1 (id) values (?)'; my $sth= $dbh->prepare($statement); my $rows= $sth->execute('9999999999999999'); print "rows $rows\n"; $statement= 'update bigt1 set id = ?'; $sth= $dbh->prepare($statement); $rows= $sth->execute('9999999999999998'); print "rows $rows\n"; my $retref= $dbh->selectall_arrayref('select * from bigt1'); print Dumper $retref; DBD-mysql-4.025/eg/bug30033.pl0000644000175000017500000000154412230034435014026 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Getopt::Long; use DBI; our $opt_prepared; GetOptions ( "p|prepared" => \$opt_prepared ); my $dsn = "DBI:mysql:database=test;host=localhost"; $dsn .= ";mysql_server_prepare=1" if $opt_prepared; my $dbh = DBI->connect( $dsn, 'root', '', { RaiseError => 1 } ) or die $DBI::errstr; unlink('./bug3033.trace.log'); $dbh->trace(4, './bug3033_trace.log'); $dbh->do('DROP TABLE IF EXISTS buggy'); $dbh->do('CREATE TABLE buggy ( id int(3) )'); $dbh->do('INSERT INTO buggy (id) VALUES (1)'); my $query= "SELECT id FROM -- It's a bug buggy WHERE id = ?"; print "with var:\n"; my $ref= $dbh->selectall_arrayref($query, {}, 1); print Dumper $ref; print "with string terminator:\n"; $ref= $dbh->selectall_arrayref(<connect('DBI:mysql:test;mysql_emulated_prepare=1', 'root'); my $table = 'mysql5bug'; my $drop = "DROP TABLE IF EXISTS $table"; my $create = "CREATE TABLE $table (value decimal(5,2));"; my $select = "SELECT * FROM $table WHERE 1 = 0"; ## create table and get column types $dbh->do($drop) or die $dbh->errstr; $dbh->do($create) or die $dbh->errstr; my $sth = $dbh->prepare( $select ); my $rv = $sth->execute; my $fields = $sth->{NAME}; my $types = $sth->{TYPE}; ## print out column types foreach (0..$#$fields) { printf("%8s %3d %s\n", $fields->[$_], $types->[$_], $map{$types->[$_]}); } ## cleanup $dbh->do($drop) or die $dbh->errstr; $sth->finish; $dbh->disconnect; 1; DBD-mysql-4.025/eg/proc_example3.pl0000644000175000017500000000160512230034435015417 0ustar patgpatg#!/usr/bin/perl use strict; use DBI; use Data::Dumper; my $db='test'; my $host='localhost'; my $user='root'; my $password=''; my $dbh = DBI->connect("DBI:mysql:$db:$host", "$user", "$password", { PrintError => 0}) || die $DBI::errstr; $dbh->do("drop procedure if exists testproc") or print $DBI::errstr; $dbh->do("create procedure testproc() deterministic begin declare a,b,c,d,e,f int; set a=1; set b=2; set c=3; set d=4; set e=5; set f=6; select a, b, c, d; select d, c, b, a; select b, a, c, d; select c, b, d, a; select a, d; select f; select a, b, c, d, e, f; end") or print $DBI::errstr; my $sth= $dbh->prepare('call testproc()') || die $DBI::err.": ".$DBI::errstr; $sth->execute || die DBI::err.": ".$DBI::errstr; do { my $row= $sth->fetchrow_arrayref(); print Dumper $row; } while ($sth->more_results()) DBD-mysql-4.025/eg/bug14979.pl0000644000175000017500000000142512230034435014051 0ustar patgpatg#! /usr/bin/perl -wT use strict; use DBI(); MAIN: { $ENV{'DBI_DSN'} ||= 'dbi:mysql:dbname=mysql:mysql_server_prepare=1'; $ENV{'DBI_USER'} ||= 'root'; $ENV{'DBI_PASS'} ||= ''; my ($dbh) = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS}, {RaiseError => 1, PrintError => 0, AutoCommit => 0}); $dbh->trace(3,"bug14979.trace"); my ($sql) = qq[SELECT * FROM mysql.user WHERE user LIKE ?]; my ($sth) = $dbh->prepare($sql); $sth->execute('foo'); $sth->finish(); my ($pid); if ($pid = fork()) { waitpid($pid, 0); unless ($? == 0) { die("Child failed to execute successfully\n"); } } elsif (defined $pid) { $dbh->{'InactiveDestroy'} = 1; exit(0); } else { die("Failed to fork:$!\n"); } $sth->execute('foo'); $sth->finish(); $dbh->disconnect(); } DBD-mysql-4.025/eg/proc_example2b.pl0000644000175000017500000000242612230034435015562 0ustar patgpatg#!/usr/bin/perl use strict; use DBI; use Data::Dumper; my $db='test'; my $host='localhost'; my $user='root'; my $password=''; my $i= 0; my $dbh = DBI->connect("DBI:mysql:$db:$host", "$user", "$password", { PrintError => 0}) || die $DBI::errstr; $dbh->trace(3,"proc2.trace"); # DROP TABLE IF EXISTS $dbh->do("DROP TABLE IF EXISTS users") or print $DBI::errstr; # CREATE TABLE $dbh->do("CREATE TABLE users (id INT, name VARCHAR(32))") or print $DBI::errstr; my $sth= $dbh->prepare("INSERT INTO users VALUES (?, ?)"); for $i(1 .. 20) { my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; my $random_chars = join '', map { $chars[rand @chars] } 0 .. 31; my $rows = $sth->execute($i, $random_chars); } $dbh->do("DROP PROCEDURE IF EXISTS users_proc") or print $DBI::errstr; $dbh->do("CREATE PROCEDURE users_proc() DETERMINISTIC BEGIN SELECT id, name FROM users; SELECT name, id FROM users; END") or print $DBI::errstr; $sth = $dbh->prepare('call users_proc()') || die $DBI::err.": ".$DBI::errstr; $sth->execute || die DBI::err.": ".$DBI::errstr; $i= 1; do { print "\nResult set $i\n---------------------\n"; for (0 .. 19) { my $rowref=$sth->fetchrow_arrayref(); print "$rowref->[0] $rowref->[1]\n"; } $i++; } while ($sth->more_results()) DBD-mysql-4.025/eg/proc_example1.pl0000644000175000017500000000205612230034435015416 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; my $db='test'; my $host='localhost'; my $user='root'; my $password=''; my $i= 0; my $dbh = DBI->connect("DBI:mysql:$db:$host", "$user", "$password", { PrintError => 0}) || die $DBI::errstr; $dbh->do("drop procedure if exists testproc") or print $DBI::errstr; $dbh->do("create procedure testproc() deterministic begin declare a,b,c,d int; set a=1; set b=2; set c=3; set d=4; select a, b, c, d; select d, c, b, a; select b, a, c, d; select c, b, d, a; end") or print $DBI::errstr; my $sth= $dbh->prepare('call testproc()') || die $DBI::err.": ".$DBI::errstr; $sth->execute || die DBI::err.": ".$DBI::errstr; do { print "\nResult set ".++$i."\n---------------------------------------\n\n"; for my $colno (0..$sth->{NUM_OF_FIELDS}-1) { print $sth->{NAME}->[$colno]."\t"; } print "\n"; while (my @row= $sth->fetchrow_array()) { for my $field (0..$#row) { print $row[$field]."\t"; } print "\n"; } } until (!$sth->more_results) DBD-mysql-4.025/eg/proc_example2a.pl0000644000175000017500000000244612230034435015563 0ustar patgpatg#!/usr/bin/perl use strict; use DBI; use Data::Dumper; my $db='test'; my $host='localhost'; my $user='root'; my $password=''; my $i= 0; my $dbh = DBI->connect("DBI:mysql:$db:$host", "$user", "$password", { PrintError => 0}) || die $DBI::errstr; $dbh->trace(3,"proc1.trace"); # DROP TABLE IF EXISTS $dbh->do("DROP TABLE IF EXISTS users") or print $DBI::errstr; # CREATE TABLE $dbh->do("CREATE TABLE users (id INT, name VARCHAR(32))") or print $DBI::errstr; my $sth= $dbh->prepare("INSERT INTO users VALUES (?, ?)"); for $i(1 .. 20) { my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; my $random_chars = join '', map { $chars[rand @chars] } 0 .. 31; my $rows = $sth->execute($i, $random_chars); } $dbh->do("DROP PROCEDURE IF EXISTS users_proc") or print $DBI::errstr; $dbh->do("CREATE PROCEDURE users_proc() DETERMINISTIC BEGIN SELECT id, name FROM users; SELECT name, id FROM users; END") or print $DBI::errstr; $sth = $dbh->prepare('call users_proc()') || die $DBI::err.": ".$DBI::errstr; $sth->execute || die DBI::err.": ".$DBI::errstr; $i= 1; do { print "\nResult set $i\n---------------------\n"; my $resultref=$sth->fetchall_arrayref(); for my $rowref (@$resultref) { print "$rowref->[0] $rowref->[1]\n"; } $i++; } while ($sth->more_results()) DBD-mysql-4.025/eg/bug21028.pl0000644000175000017500000000425212230034435014031 0ustar patgpatg#!/usr/bin/perl use strict; use warnings; use DBI; use Test::More; use Data::Dumper; use English qw( -no_match_vars ); my $CONF = $ENV{MYCONF} || "$ENV{HOME}/.my.cnf"; my $emulate = 0; my $dbh; eval { # # change the connection statements # to suit your purposes $dbh = DBI->connect("dbi:mysql:test", 'root', '', {RaiseError => 1, PrintError => 1} ) or die "can't connect : $DBI::errstr\n"; }; if ($EVAL_ERROR) { plan (skip_all => " -- no connection available $EVAL_ERROR"); } else { plan ( tests => 10 ); } print "\nEmulation of ps: $emulate, version: $DBD::mysql::VERSION\n"; print $dbh->{mysql_server_prepare},"\n"; my $drop_proc = qq{ drop procedure if exists test_multi_sets }; my $create_proc = qq{ create procedure test_multi_sets () deterministic begin select user() as first_col; select user() as first_col, now() as second_col; select user() as first_col, now() as second_col, now() as third_col; end }; eval { $dbh->do($drop_proc) }; ok( ! $EVAL_ERROR, 'drop procedure' ); eval { $dbh->do($create_proc) }; ok( ! $EVAL_ERROR , 'create procedure'); my $sth; print $dbh->{mysql_server_prepare},"\n"; eval { $sth = $dbh->prepare(qq{call test_multi_sets() }) } ; ok( $sth , 'preparing statement handler'); eval { $sth->execute() }; ok( ! $EVAL_ERROR, 'executing sth - 1st time ' ); diag $EVAL_ERROR if $EVAL_ERROR; my $dataset; eval { $dataset = $sth->fetchrow_arrayref(); } ; print Dumper($dataset),"\n"; ok( $dataset && @$dataset == 1 , 'fetching first dataset'); my $more_results; eval { $more_results = $sth->more_results() }; ok( $more_results, 'more results available (1st time) ' ) ; eval { $dataset = $sth->fetchrow_arrayref(); } ; print Dumper($dataset),"\n"; ok( $dataset && @$dataset == 2 , 'fetching second dataset'); eval { $more_results = $sth->more_results() }; ok( $more_results, 'more results available (2nd time) ' ) ; eval { $dataset = $sth->fetchrow_arrayref(); } ; print Dumper($dataset),"\n"; ok( $dataset && @$dataset == 3 , 'fetching third dataset'); eval { $more_results = $sth->more_results() }; ok( ! $more_results, 'no more results available' ) ; DBD-mysql-4.025/eg/issue21946.pl0000644000175000017500000000152012230034435014410 0ustar patgpatg#!/usr/bin/perl use GD; use DBI; # Load Database Interface Module use Data::Dumper; # Connect to database my $dbh = DBI->connect ('DBI:mysql:database=test;host=localhost:mysql_server_prepare=1', 'myUser', 'myPassword', {RaiseError => 1}) or die "$0: Can not connect to database: " . $DBI::errstr; # create a new image $im = new GD::Image(6490,4000); # allocate color black $black = $im->colorAllocate(0,0,0); # The maximum id value in table is 25958999 my $sth = $dbh->prepare("SELECT id FROM myTable WHERE id=?"); my $id = 1; foreach $x (0..6489) { print "x=$x/6490 id=$id\n"; foreach $y (0..3999){ $sth->execute($id); if ($sth->fetchrow_array) { $im->setPixel($x,$y,$black); } $id = $id + 1; } open(OUT,">/tmp/id.png") or die "can not write output file"; binmode OUT; print OUT $im->png; close(OUT); } DBD-mysql-4.025/eg/proc_example4.pl0000644000175000017500000000255412230034435015424 0ustar patgpatg#!/usr/bin/perl use DBI; use strict; use Data::Dumper; use warnings; my $connect_string = 'DBI:mysql:database=test'; my $username = 'root'; my $password = ''; my $attributes = {}; my $dbh = DBI->connect($connect_string, $username, $password, $attributes) || die $DBI::errstr; # Execute this AT LEAST once so the stored procedure someproc() exists # at least $dbh->do("drop procedure if exists someproc") or print $DBI::errstr; # Comment this out to reproduce the bug $dbh->do("create procedure someproc() deterministic begin ". "declare a,b,c,d int; set a=1; set b=2; set c=3; set d=4; ". "select a, b, c, d; select d, c, b, a; select b, a, c, d; ". "select c, b, d, a; end") or print $DBI::errstr; my $sth=$dbh->prepare('call someproc()') || die $DBI::errstr; $sth->execute || die $DBI::errstr; my @row= $sth->fetchrow_array(); print Dumper \@row; my $more_results = $sth->more_results(); print $more_results . "\n"; @row= $sth->fetchrow_array(); print Dumper \@row; $more_results = $sth->more_results(); print $more_results . "\n"; @row= $sth->fetchrow_array(); print Dumper \@row; $more_results = $sth->more_results(); print $more_results . "\n"; @row= $sth->fetchrow_array(); print Dumper \@row; $more_results = $sth->more_results(); print $more_results . "\n"; @row= $sth->fetchrow_array(); print Dumper \@row; $more_results = $sth->more_results(); print $more_results . "\n"; DBD-mysql-4.025/eg/prepare_memory_usage.pl0000644000175000017500000000070212230034435017065 0ustar patgpatg#!/usr/bin/perl -w use strict; use DBI; my $ssp = 1; my $count = 0; my $query = "SELECT 1 FROM DUAL"; my $dbh = DBI->connect ( "dbi:mysql:database=test:host=localhost;mysql_emulated_prepare=0", "root", "", { RaiseError => 1, PrintError => 0 }, ); my $s_q = $dbh->prepare($query); while (1) { $s_q->execute(); my @data = $s_q->fetchrow_array(); $s_q->finish; $count++; print "ran $count queries\r"; sleep(0.3); } DBD-mysql-4.025/MANIFEST0000644000175000017500000000276512235342050013067 0ustar patgpatgChangeLog constants.h dbdimp.c dbdimp.h eg/bigint_quotes.pl eg/bug14979.pl eg/bug21028.pl eg/bug30033.pl eg/bug30033pg.pl eg/decimal_test.pl eg/issue21946.pl eg/prepare_memory_usage.pl eg/proc_example1.pl eg/proc_example2.pl eg/proc_example2a.pl eg/proc_example2b.pl eg/proc_example3.pl eg/proc_example4.pl lib/Bundle/DBD/mysql.pm lib/DBD/mysql.pm lib/DBD/mysql/GetInfo.pm lib/DBD/mysql/INSTALL.pod Makefile.PL Makefile.PL.embedded MANIFEST MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) META.json myld mysql.xs README.pod t/00base.t t/10connect.t t/15reconnect.t t/20createdrop.t t/25lockunlock.t t/29warnings.t t/30insertfetch.t t/31insertid.t t/32insert_error.t t/35limit.t t/35prepare.t t/40bindparam.t t/40bindparam2.t t/40blobs.t t/40catalog.t t/40keyinfo.t t/40listfields.t t/40nulls.t t/40nulls_prepare.t t/40numrows.t t/40server_prepare.t t/40server_prepare_error.t t/40types.t t/41bindparam.t t/41blobs_prepare.t t/42bindparam.t t/43count_params.t t/50chopblanks.t t/50commit.t t/51bind_type_guessing.t t/52comment.t t/53comment.t t/55utf8.t t/60leaks.t t/65segfault.t t/65types.t t/70takeimp.t t/71impdata.t t/75supported_sql.t t/76multi_statement.t t/80procs.t t/81procs.t t/85init_command.t t/86_bug_36972.t t/87async.t t/88async-multi-stmts.t t/89async-method-check.t t/90no-async.t t/91errcheck.t t/99_bug_server_prepare_blob_null.t t/lib.pl t/mem_leak.pl t/mysql.dbtest t/mysql.mtest t/pod.t t/rt83494-quotes-comments.t t/rt85919-fetch-lost-connection.t t/rt86153-reconnect-fail-memory.t TODO DBD-mysql-4.025/dbdimp.c0000644000175000017500000044450112232404401013333 0ustar patgpatg/* * DBD::mysql - DBI driver for the mysql database * * Copyright (c) 2005-2009 Patrick Galbraith * Copyright (c) 2003-2005 Rudolf Lippan * Copyright (c) 1997-2003 Jochen Wiedmann * * 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. */ #ifdef WIN32 #include "windows.h" #include "winsock.h" #endif #include "dbdimp.h" #if defined(WIN32) && defined(WORD) #undef WORD typedef short WORD; #endif #if MYSQL_ASYNC # include # define ASYNC_CHECK_RETURN(h, value)\ if(imp_dbh->async_query_in_flight) {\ do_error(h, 2000, "Calling a synchronous function on an asynchronous handle", "HY000");\ return (value);\ } #else # define ASYNC_CHECK_RETURN(h, value) #endif static int parse_number(char *string, STRLEN len, char **end); DBISTATE_DECLARE; typedef struct sql_type_info_s { const char *type_name; int data_type; int column_size; const char *literal_prefix; const char *literal_suffix; const char *create_params; int nullable; int case_sensitive; int searchable; int unsigned_attribute; int fixed_prec_scale; int auto_unique_value; const char *local_type_name; int minimum_scale; int maximum_scale; int num_prec_radix; int sql_datatype; int sql_datetime_sub; int interval_precision; int native_type; int is_num; } sql_type_info_t; /* This function manually counts the number of placeholders in an SQL statement, used for emulated prepare statements < 4.1.3 */ static int count_params(imp_xxh_t *imp_xxh, pTHX_ char *statement, bool bind_comment_placeholders) { bool comment_end= false; char* ptr= statement; int num_params= 0; int comment_length= 0; char c; if (DBIc_DBISTATE(imp_xxh)->debug >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), ">count_params statement %s\n", statement); while ( (c = *ptr++) ) { switch (c) { /* so, this is a -- comment, so let's burn up characters */ case '-': { if (bind_comment_placeholders) { c = *ptr++; break; } else { comment_length= 1; /* let's see if the next one is a dash */ c = *ptr++; if (c == '-') { /* if two dashes, ignore everything until newline */ while ((c = *ptr)) { if (DBIc_DBISTATE(imp_xxh)->debug >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "%c\n", c); ptr++; comment_length++; if (c == '\n') { comment_end= true; break; } } /* if not comment_end, the comment never ended and we need to iterate back to the beginning of where we started and let the database handle whatever is in the statement */ if (! comment_end) ptr-= comment_length; } /* otherwise, only one dash/hyphen, backtrack by one */ else ptr--; break; } } /* c-type comments */ case '/': { if (bind_comment_placeholders) { c = *ptr++; break; } else { c = *ptr++; /* let's check if the next one is an asterisk */ if (c == '*') { comment_length= 0; comment_end= false; /* ignore everything until closing comment */ while ((c= *ptr)) { ptr++; comment_length++; if (c == '*') { c = *ptr++; /* alas, end of comment */ if (c == '/') { comment_end= true; break; } /* nope, just an asterisk, not so fast, not end of comment, go back one */ else ptr--; } } /* if the end of the comment was never found, we have to backtrack to whereever we first started skipping over the possible comment. This means we will pass the statement to the database to see its own fate and issue the error */ if (!comment_end) ptr -= comment_length; } else ptr--; break; } } case '`': case '"': case '\'': /* Skip string */ { char end_token = c; while ((c = *ptr) && c != end_token) { if (c == '\\') if (! *(++ptr)) continue; ++ptr; } if (c) ++ptr; break; } case '?': ++num_params; break; default: break; } } return num_params; } /* allocate memory in statement handle per number of placeholders */ static imp_sth_ph_t *alloc_param(int num_params) { imp_sth_ph_t *params; if (num_params) Newz(908, params, (unsigned int) num_params, imp_sth_ph_t); else params= NULL; return params; } #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION /* allocate memory in MYSQL_BIND bind structure per number of placeholders */ static MYSQL_BIND *alloc_bind(int num_params) { MYSQL_BIND *bind; if (num_params) Newz(908, bind, (unsigned int) num_params, MYSQL_BIND); else bind= NULL; return bind; } /* allocate memory in fbind imp_sth_phb_t structure per number of placeholders */ static imp_sth_phb_t *alloc_fbind(int num_params) { imp_sth_phb_t *fbind; if (num_params) Newz(908, fbind, (unsigned int) num_params, imp_sth_phb_t); else fbind= NULL; return fbind; } /* alloc memory for imp_sth_fbh_t fbuffer per number of fields */ static imp_sth_fbh_t *alloc_fbuffer(int num_fields) { imp_sth_fbh_t *fbh; if (num_fields) Newz(908, fbh, (unsigned int) num_fields, imp_sth_fbh_t); else fbh= NULL; return fbh; } /* free MYSQL_BIND bind struct */ static void free_bind(MYSQL_BIND *bind) { if (bind) Safefree(bind); } /* free imp_sth_phb_t fbind structure */ static void free_fbind(imp_sth_phb_t *fbind) { if (fbind) Safefree(fbind); } /* free imp_sth_fbh_t fbh structure */ static void free_fbuffer(imp_sth_fbh_t *fbh) { if (fbh) Safefree(fbh); } #endif /* free statement param structure per num_params */ static void free_param(pTHX_ imp_sth_ph_t *params, int num_params) { if (params) { int i; for (i= 0; i < num_params; i++) { imp_sth_ph_t *ph= params+i; if (ph->value) { (void) SvREFCNT_dec(ph->value); ph->value= NULL; } } Safefree(params); } } #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION /* Convert a MySQL type to a type that perl can handle NOTE: In the future we may want to return a struct with a lot of information for each type */ static enum enum_field_types mysql_to_perl_type(enum enum_field_types type) { static enum enum_field_types enum_type; switch (type) { case MYSQL_TYPE_DOUBLE: case MYSQL_TYPE_FLOAT: enum_type= MYSQL_TYPE_DOUBLE; break; case MYSQL_TYPE_SHORT: case MYSQL_TYPE_TINY: case MYSQL_TYPE_LONG: case MYSQL_TYPE_INT24: case MYSQL_TYPE_YEAR: #if MYSQL_VERSION_ID > NEW_DATATYPE_VERSION case MYSQL_TYPE_BIT: #endif enum_type= MYSQL_TYPE_LONG; break; #if MYSQL_VERSION_ID > NEW_DATATYPE_VERSION case MYSQL_TYPE_NEWDECIMAL: #endif case MYSQL_TYPE_DECIMAL: enum_type= MYSQL_TYPE_DECIMAL; break; case MYSQL_TYPE_LONGLONG: /* No longlong in perl */ case MYSQL_TYPE_DATE: case MYSQL_TYPE_TIME: case MYSQL_TYPE_DATETIME: case MYSQL_TYPE_NEWDATE: case MYSQL_TYPE_TIMESTAMP: case MYSQL_TYPE_VAR_STRING: #if MYSQL_VERSION_ID > NEW_DATATYPE_VERSION case MYSQL_TYPE_VARCHAR: #endif case MYSQL_TYPE_STRING: enum_type= MYSQL_TYPE_STRING; break; #if MYSQL_VERSION_ID > GEO_DATATYPE_VERSION case MYSQL_TYPE_GEOMETRY: #endif case MYSQL_TYPE_BLOB: case MYSQL_TYPE_TINY_BLOB: enum_type= MYSQL_TYPE_BLOB; break; default: enum_type= MYSQL_TYPE_STRING; /* MySQL can handle all types as strings */ } return(enum_type); } #endif #if defined(DBD_MYSQL_EMBEDDED) /* count embedded options */ int count_embedded_options(char *st) { int rc; char c; char *ptr; ptr= st; rc= 0; if (st) { while ((c= *ptr++)) { if (c == ',') rc++; } rc++; } return rc; } /* Free embbedded options */ int free_embedded_options(char ** options_list, int options_count) { int i; for (i= 0; i < options_count; i++) { if (options_list[i]) free(options_list[i]); } free(options_list); return 1; } /* Print out embbedded option settings */ int print_embedded_options(char ** options_list, int options_count) { int i; for (i=0; idebug >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), ">parse_params statement %s\n", statement); if (num_params == 0) return NULL; while (isspace(*statement)) { ++statement; --slen; } /* Calculate the number of bytes being allocated for the statement */ alen= slen; for (i= 0, ph= params; i < num_params; i++, ph++) { int defined= 0; if (ph->value) { if (SvMAGICAL(ph->value)) mg_get(ph->value); if (SvOK(ph->value)) defined=1; } if (!defined) alen+= 3; /* Erase '?', insert 'NULL' */ else { valbuf= SvPV(ph->value, vallen); alen+= 2+vallen+1; /* this will most likely not happen since line 214 */ /* of mysql.xs hardcodes all types to SQL_VARCHAR */ if (!ph->type) { if (bind_type_guessing) { valbuf= SvPV(ph->value, vallen); ph->type= SQL_INTEGER; if (parse_number(valbuf, vallen, &end) != 0) { ph->type= SQL_VARCHAR; } } else ph->type= SQL_VARCHAR; } } } /* Allocate memory, why *2, well, because we have ptr and statement_ptr */ New(908, salloc, alen*2, char); ptr= salloc; i= 0; /* Now create the statement string; compare count_params above */ statement_ptr_end= (statement_ptr= statement)+ slen; while (statement_ptr < statement_ptr_end) { /* LIMIT should be the last part of the query, in most cases */ if (! limit_flag) { /* it would be good to be able to handle any number of cases and orders */ if ((*statement_ptr == 'l' || *statement_ptr == 'L') && (!strncmp(statement_ptr+1, "imit ?", 6) || !strncmp(statement_ptr+1, "IMIT ?", 6))) { limit_flag = 1; } } switch (*statement_ptr) { /* comment detection. Anything goes in a comment */ case '-': { if (bind_comment_placeholders) { *ptr++= *statement_ptr++; break; } else { comment_length= 1; comment_end= false; *ptr++ = *statement_ptr++; if (*statement_ptr == '-') { /* ignore everything until newline or end of string */ while (*statement_ptr) { comment_length++; *ptr++ = *statement_ptr++; if (!*statement_ptr || *statement_ptr == '\n') { comment_end= true; break; } } /* if not end of comment, go back to where we started, no end found */ if (! comment_end) { statement_ptr -= comment_length; ptr -= comment_length; } } break; } } /* c-type comments */ case '/': { if (bind_comment_placeholders) { *ptr++= *statement_ptr++; break; } else { comment_length= 1; comment_end= false; *ptr++ = *statement_ptr++; if (*statement_ptr == '*') { /* use up characters everything until newline */ while (*statement_ptr) { *ptr++ = *statement_ptr++; comment_length++; if (!strncmp(statement_ptr, "*/", 2)) { comment_length += 2; comment_end= true; break; } } /* Go back to where started if comment end not found */ if (! comment_end) { statement_ptr -= comment_length; ptr -= comment_length; } } break; } } case '`': case '\'': case '"': /* Skip string */ { char endToken = *statement_ptr++; *ptr++ = endToken; while (statement_ptr != statement_ptr_end && *statement_ptr != endToken) { if (*statement_ptr == '\\') { *ptr++ = *statement_ptr++; if (statement_ptr == statement_ptr_end) break; } *ptr++= *statement_ptr++; } if (statement_ptr != statement_ptr_end) *ptr++= *statement_ptr++; } break; case '?': /* Insert parameter */ statement_ptr++; if (i >= num_params) { break; } ph = params+ (i++); if (!ph->value || !SvOK(ph->value)) { *ptr++ = 'N'; *ptr++ = 'U'; *ptr++ = 'L'; *ptr++ = 'L'; } else { int is_num = FALSE; valbuf= SvPV(ph->value, vallen); if (valbuf) { switch (ph->type) { case SQL_NUMERIC: case SQL_DECIMAL: case SQL_INTEGER: case SQL_SMALLINT: case SQL_FLOAT: case SQL_REAL: case SQL_DOUBLE: case SQL_BIGINT: case SQL_TINYINT: is_num = TRUE; break; } /* (note this sets *end, which we use if is_num) */ if ( parse_number(valbuf, vallen, &end) != 0 && is_num) { if (bind_type_guessing) { /* .. not a number, so apparerently we guessed wrong */ is_num = 0; ph->type = SQL_VARCHAR; } } /* we're at the end of the query, so any placeholders if */ /* after a LIMIT clause will be numbers and should not be quoted */ if (limit_flag == 1) is_num = TRUE; if (!is_num) { *ptr++ = '\''; ptr += mysql_real_escape_string(sock, ptr, valbuf, vallen); *ptr++ = '\''; } else { for (cp= valbuf; cp < end; cp++) *ptr++= *cp; } } } break; /* in case this is a nested LIMIT */ case ')': limit_flag = 0; *ptr++ = *statement_ptr++; break; default: *ptr++ = *statement_ptr++; break; } } *slen_ptr = ptr - salloc; *ptr++ = '\0'; return(salloc); } int bind_param(imp_sth_ph_t *ph, SV *value, IV sql_type) { dTHX; if (ph->value) { if (SvMAGICAL(ph->value)) mg_get(ph->value); (void) SvREFCNT_dec(ph->value); } ph->value= newSVsv(value); if (sql_type) ph->type = sql_type; return TRUE; } static const sql_type_info_t SQL_GET_TYPE_INFO_values[]= { { "varchar", SQL_VARCHAR, 255, "'", "'", "max length", 1, 0, 3, 0, 0, 0, "variable length string", 0, 0, 0, SQL_VARCHAR, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_VAR_STRING, 0, #else MYSQL_TYPE_STRING, 0, #endif }, { "decimal", SQL_DECIMAL, 15, NULL, NULL, "precision,scale", 1, 0, 3, 0, 0, 0, "double", 0, 6, 2, SQL_DECIMAL, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_DECIMAL, 1 #else MYSQL_TYPE_DECIMAL, 1 #endif }, { "tinyint", SQL_TINYINT, 3, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "Tiny integer", 0, 0, 10, SQL_TINYINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_TINY, 1 #else MYSQL_TYPE_TINY, 1 #endif }, { "smallint", SQL_SMALLINT, 5, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "Short integer", 0, 0, 10, SQL_SMALLINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_SHORT, 1 #else MYSQL_TYPE_SHORT, 1 #endif }, { "integer", SQL_INTEGER, 10, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "integer", 0, 0, 10, SQL_INTEGER, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONG, 1 #else MYSQL_TYPE_LONG, 1 #endif }, { "float", SQL_REAL, 7, NULL, NULL, NULL, 1, 0, 0, 0, 0, 0, "float", 0, 2, 10, SQL_FLOAT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_FLOAT, 1 #else MYSQL_TYPE_FLOAT, 1 #endif }, { "double", SQL_FLOAT, 15, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "double", 0, 4, 2, SQL_FLOAT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_DOUBLE, 1 #else MYSQL_TYPE_DOUBLE, 1 #endif }, { "double", SQL_DOUBLE, 15, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "double", 0, 4, 10, SQL_DOUBLE, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_DOUBLE, 1 #else MYSQL_TYPE_DOUBLE, 1 #endif }, /* FIELD_TYPE_NULL ? */ { "timestamp", SQL_TIMESTAMP, 14, "'", "'", NULL, 0, 0, 3, 0, 0, 0, "timestamp", 0, 0, 0, SQL_TIMESTAMP, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_TIMESTAMP, 0 #else MYSQL_TYPE_TIMESTAMP, 0 #endif }, { "bigint", SQL_BIGINT, 19, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "Longlong integer", 0, 0, 10, SQL_BIGINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONGLONG, 1 #else MYSQL_TYPE_LONGLONG, 1 #endif }, { "mediumint", SQL_INTEGER, 8, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "Medium integer", 0, 0, 10, SQL_INTEGER, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_INT24, 1 #else MYSQL_TYPE_INT24, 1 #endif }, { "date", SQL_DATE, 10, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "date", 0, 0, 0, SQL_DATE, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_DATE, 0 #else MYSQL_TYPE_DATE, 0 #endif }, { "time", SQL_TIME, 6, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "time", 0, 0, 0, SQL_TIME, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_TIME, 0 #else MYSQL_TYPE_TIME, 0 #endif }, { "datetime", SQL_TIMESTAMP, 21, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "datetime", 0, 0, 0, SQL_TIMESTAMP, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_DATETIME, 0 #else MYSQL_TYPE_DATETIME, 0 #endif }, { "year", SQL_SMALLINT, 4, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "year", 0, 0, 10, SQL_SMALLINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_YEAR, 0 #else MYSQL_TYPE_YEAR, 0 #endif }, { "date", SQL_DATE, 10, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "date", 0, 0, 0, SQL_DATE, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_NEWDATE, 0 #else MYSQL_TYPE_NEWDATE, 0 #endif }, { "enum", SQL_VARCHAR, 255, "'", "'", NULL, 1, 0, 1, 0, 0, 0, "enum(value1,value2,value3...)", 0, 0, 0, 0, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_ENUM, 0 #else MYSQL_TYPE_ENUM, 0 #endif }, { "set", SQL_VARCHAR, 255, "'", "'", NULL, 1, 0, 1, 0, 0, 0, "set(value1,value2,value3...)", 0, 0, 0, 0, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_SET, 0 #else MYSQL_TYPE_SET, 0 #endif }, { "blob", SQL_LONGVARBINARY, 65535, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "binary large object (0-65535)", 0, 0, 0, SQL_LONGVARBINARY, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_BLOB, 0 #else MYSQL_TYPE_BLOB, 0 #endif }, { "tinyblob", SQL_VARBINARY, 255, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "binary large object (0-255) ", 0, 0, 0, SQL_VARBINARY, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_TINY_BLOB, 0 #else FIELD_TYPE_TINY_BLOB, 0 #endif }, { "mediumblob", SQL_LONGVARBINARY, 16777215, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "binary large object", 0, 0, 0, SQL_LONGVARBINARY, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_MEDIUM_BLOB, 0 #else MYSQL_TYPE_MEDIUM_BLOB, 0 #endif }, { "longblob", SQL_LONGVARBINARY, 2147483647, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "binary large object, use mediumblob instead", 0, 0, 0, SQL_LONGVARBINARY, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONG_BLOB, 0 #else MYSQL_TYPE_LONG_BLOB, 0 #endif }, { "char", SQL_CHAR, 255, "'", "'", "max length", 1, 0, 3, 0, 0, 0, "string", 0, 0, 0, SQL_CHAR, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_STRING, 0 #else MYSQL_TYPE_STRING, 0 #endif }, { "decimal", SQL_NUMERIC, 15, NULL, NULL, "precision,scale", 1, 0, 3, 0, 0, 0, "double", 0, 6, 2, SQL_NUMERIC, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_DECIMAL, 1 #else MYSQL_TYPE_DECIMAL, 1 #endif }, { "tinyint unsigned", SQL_TINYINT, 3, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "Tiny integer unsigned", 0, 0, 10, SQL_TINYINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_TINY, 1 #else MYSQL_TYPE_TINY, 1 #endif }, { "smallint unsigned", SQL_SMALLINT, 5, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "Short integer unsigned", 0, 0, 10, SQL_SMALLINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_SHORT, 1 #else MYSQL_TYPE_SHORT, 1 #endif }, { "mediumint unsigned", SQL_INTEGER, 8, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "Medium integer unsigned", 0, 0, 10, SQL_INTEGER, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_INT24, 1 #else MYSQL_TYPE_INT24, 1 #endif }, { "int unsigned", SQL_INTEGER, 10, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "integer unsigned", 0, 0, 10, SQL_INTEGER, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONG, 1 #else MYSQL_TYPE_LONG, 1 #endif }, { "int", SQL_INTEGER, 10, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "integer", 0, 0, 10, SQL_INTEGER, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONG, 1 #else MYSQL_TYPE_LONG, 1 #endif }, { "integer unsigned", SQL_INTEGER, 10, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "integer", 0, 0, 10, SQL_INTEGER, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONG, 1 #else MYSQL_TYPE_LONG, 1 #endif }, { "bigint unsigned", SQL_BIGINT, 20, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "Longlong integer unsigned", 0, 0, 10, SQL_BIGINT, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_LONGLONG, 1 #else MYSQL_TYPE_LONGLONG, 1 #endif }, { "text", SQL_LONGVARCHAR, 65535, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "large text object (0-65535)", 0, 0, 0, SQL_LONGVARCHAR, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_BLOB, 0 #else MYSQL_TYPE_BLOB, 0 #endif }, { "mediumtext", SQL_LONGVARCHAR, 16777215, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "large text object", 0, 0, 0, SQL_LONGVARCHAR, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 FIELD_TYPE_MEDIUM_BLOB, 0 #else MYSQL_TYPE_MEDIUM_BLOB, 0 #endif }, { "mediumint unsigned auto_increment", SQL_INTEGER, 8, NULL, NULL, NULL, 0, 0, 3, 1, 0, 1, "Medium integer unsigned auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_INT24, 1, #else SQL_INTEGER, 0, 0, MYSQL_TYPE_INT24, 1, #endif }, { "tinyint unsigned auto_increment", SQL_TINYINT, 3, NULL, NULL, NULL, 0, 0, 3, 1, 0, 1, "tinyint unsigned auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_TINYINT, 0, 0, FIELD_TYPE_TINY, 1 #else SQL_TINYINT, 0, 0, MYSQL_TYPE_TINY, 1 #endif }, { "smallint auto_increment", SQL_SMALLINT, 5, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "smallint auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_SMALLINT, 0, 0, FIELD_TYPE_SHORT, 1 #else SQL_SMALLINT, 0, 0, MYSQL_TYPE_SHORT, 1 #endif }, { "int unsigned auto_increment", SQL_INTEGER, 10, NULL, NULL, NULL, 0, 0, 3, 1, 0, 1, "integer unsigned auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_LONG, 1 #else SQL_INTEGER, 0, 0, MYSQL_TYPE_LONG, 1 #endif }, { "mediumint", SQL_INTEGER, 7, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "Medium integer", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_INT24, 1 #else SQL_INTEGER, 0, 0, MYSQL_TYPE_INT24, 1 #endif }, { "bit", SQL_BIT, 1, NULL, NULL, NULL, 1, 0, 3, 0, 0, 0, "char(1)", 0, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_BIT, 0, 0, FIELD_TYPE_TINY, 0 #else SQL_BIT, 0, 0, MYSQL_TYPE_TINY, 0 #endif }, { "numeric", SQL_NUMERIC, 19, NULL, NULL, "precision,scale", 1, 0, 3, 0, 0, 0, "numeric", 0, 19, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_NUMERIC, 0, 0, FIELD_TYPE_DECIMAL, 1, #else SQL_NUMERIC, 0, 0, MYSQL_TYPE_DECIMAL, 1, #endif }, { "integer unsigned auto_increment", SQL_INTEGER, 10, NULL, NULL, NULL, 0, 0, 3, 1, 0, 1, "integer unsigned auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_LONG, 1, #else SQL_INTEGER, 0, 0, MYSQL_TYPE_LONG, 1, #endif }, { "mediumint unsigned", SQL_INTEGER, 8, NULL, NULL, NULL, 1, 0, 3, 1, 0, 0, "Medium integer unsigned", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_INT24, 1 #else SQL_INTEGER, 0, 0, MYSQL_TYPE_INT24, 1 #endif }, { "smallint unsigned auto_increment", SQL_SMALLINT, 5, NULL, NULL, NULL, 0, 0, 3, 1, 0, 1, "smallint unsigned auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_SMALLINT, 0, 0, FIELD_TYPE_SHORT, 1 #else SQL_SMALLINT, 0, 0, MYSQL_TYPE_SHORT, 1 #endif }, { "int auto_increment", SQL_INTEGER, 10, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "integer auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_LONG, 1 #else SQL_INTEGER, 0, 0, MYSQL_TYPE_LONG, 1 #endif }, { "long varbinary", SQL_LONGVARBINARY, 16777215, "0x", NULL, NULL, 1, 0, 3, 0, 0, 0, "mediumblob", 0, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_LONGVARBINARY, 0, 0, FIELD_TYPE_LONG_BLOB, 0 #else SQL_LONGVARBINARY, 0, 0, MYSQL_TYPE_LONG_BLOB, 0 #endif }, { "double auto_increment", SQL_FLOAT, 15, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "double auto_increment", 0, 4, 2, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_FLOAT, 0, 0, FIELD_TYPE_DOUBLE, 1 #else SQL_FLOAT, 0, 0, MYSQL_TYPE_DOUBLE, 1 #endif }, { "double auto_increment", SQL_DOUBLE, 15, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "double auto_increment", 0, 4, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_DOUBLE, 0, 0, FIELD_TYPE_DOUBLE, 1 #else SQL_DOUBLE, 0, 0, MYSQL_TYPE_DOUBLE, 1 #endif }, { "integer auto_increment", SQL_INTEGER, 10, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "integer auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_LONG, 1, #else SQL_INTEGER, 0, 0, MYSQL_TYPE_LONG, 1, #endif }, { "bigint auto_increment", SQL_BIGINT, 19, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "bigint auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_BIGINT, 0, 0, FIELD_TYPE_LONGLONG, 1 #else SQL_BIGINT, 0, 0, MYSQL_TYPE_LONGLONG, 1 #endif }, { "bit auto_increment", SQL_BIT, 1, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "char(1) auto_increment", 0, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_BIT, 0, 0, FIELD_TYPE_TINY, 1 #else SQL_BIT, 0, 0, MYSQL_TYPE_TINY, 1 #endif }, { "mediumint auto_increment", SQL_INTEGER, 7, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "Medium integer auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_INTEGER, 0, 0, FIELD_TYPE_INT24, 1 #else SQL_INTEGER, 0, 0, MYSQL_TYPE_INT24, 1 #endif }, { "float auto_increment", SQL_REAL, 7, NULL, NULL, NULL, 0, 0, 0, 0, 0, 1, "float auto_increment", 0, 2, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_FLOAT, 0, 0, FIELD_TYPE_FLOAT, 1 #else SQL_FLOAT, 0, 0, MYSQL_TYPE_FLOAT, 1 #endif }, { "long varchar", SQL_LONGVARCHAR, 16777215, "'", "'", NULL, 1, 0, 3, 0, 0, 0, "mediumtext", 0, 0, 0, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_LONGVARCHAR, 0, 0, FIELD_TYPE_MEDIUM_BLOB, 1 #else SQL_LONGVARCHAR, 0, 0, MYSQL_TYPE_MEDIUM_BLOB, 1 #endif }, { "tinyint auto_increment", SQL_TINYINT, 3, NULL, NULL, NULL, 0, 0, 3, 0, 0, 1, "tinyint auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_TINYINT, 0, 0, FIELD_TYPE_TINY, 1 #else SQL_TINYINT, 0, 0, MYSQL_TYPE_TINY, 1 #endif }, { "bigint unsigned auto_increment", SQL_BIGINT, 20, NULL, NULL, NULL, 0, 0, 3, 1, 0, 1, "bigint unsigned auto_increment", 0, 0, 10, #if MYSQL_VERSION_ID < MYSQL_VERSION_5_0 SQL_BIGINT, 0, 0, FIELD_TYPE_LONGLONG, 1 #else SQL_BIGINT, 0, 0, MYSQL_TYPE_LONGLONG, 1 #endif }, /* END MORE STUFF */ }; /* static const sql_type_info_t* native2sql (int t) */ static const sql_type_info_t *native2sql(int t) { switch (t) { case FIELD_TYPE_VAR_STRING: return &SQL_GET_TYPE_INFO_values[0]; case FIELD_TYPE_DECIMAL: return &SQL_GET_TYPE_INFO_values[1]; #ifdef FIELD_TYPE_NEWDECIMAL case FIELD_TYPE_NEWDECIMAL: return &SQL_GET_TYPE_INFO_values[1]; #endif case FIELD_TYPE_TINY: return &SQL_GET_TYPE_INFO_values[2]; case FIELD_TYPE_SHORT: return &SQL_GET_TYPE_INFO_values[3]; case FIELD_TYPE_LONG: return &SQL_GET_TYPE_INFO_values[4]; case FIELD_TYPE_FLOAT: return &SQL_GET_TYPE_INFO_values[5]; /* 6 */ case FIELD_TYPE_DOUBLE: return &SQL_GET_TYPE_INFO_values[7]; case FIELD_TYPE_TIMESTAMP: return &SQL_GET_TYPE_INFO_values[8]; case FIELD_TYPE_LONGLONG: return &SQL_GET_TYPE_INFO_values[9]; case FIELD_TYPE_INT24: return &SQL_GET_TYPE_INFO_values[10]; case FIELD_TYPE_DATE: return &SQL_GET_TYPE_INFO_values[11]; case FIELD_TYPE_TIME: return &SQL_GET_TYPE_INFO_values[12]; case FIELD_TYPE_DATETIME: return &SQL_GET_TYPE_INFO_values[13]; case FIELD_TYPE_YEAR: return &SQL_GET_TYPE_INFO_values[14]; case FIELD_TYPE_NEWDATE: return &SQL_GET_TYPE_INFO_values[15]; case FIELD_TYPE_ENUM: return &SQL_GET_TYPE_INFO_values[16]; case FIELD_TYPE_SET: return &SQL_GET_TYPE_INFO_values[17]; case FIELD_TYPE_BLOB: return &SQL_GET_TYPE_INFO_values[18]; case FIELD_TYPE_TINY_BLOB: return &SQL_GET_TYPE_INFO_values[19]; case FIELD_TYPE_MEDIUM_BLOB: return &SQL_GET_TYPE_INFO_values[20]; case FIELD_TYPE_LONG_BLOB: return &SQL_GET_TYPE_INFO_values[21]; case FIELD_TYPE_STRING: return &SQL_GET_TYPE_INFO_values[22]; default: return &SQL_GET_TYPE_INFO_values[0]; } } #define SQL_GET_TYPE_INFO_num \ (sizeof(SQL_GET_TYPE_INFO_values)/sizeof(sql_type_info_t)) /*************************************************************************** * * Name: dbd_init * * Purpose: Called when the driver is installed by DBI * * Input: dbistate - pointer to the DBI state variable, used for some * DBI internal things * * Returns: Nothing * **************************************************************************/ void dbd_init(dbistate_t* dbistate) { dTHX; DBISTATE_INIT; } /************************************************************************** * * Name: do_error, do_warn * * Purpose: Called to associate an error code and an error message * to some handle * * Input: h - the handle in error condition * rc - the error code * what - the error message * * Returns: Nothing * **************************************************************************/ void do_error(SV* h, int rc, const char* what, const char* sqlstate) { dTHX; D_imp_xxh(h); STRLEN lna; SV *errstr; SV *errstate; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\t--> do_error\n"); errstr= DBIc_ERRSTR(imp_xxh); sv_setiv(DBIc_ERR(imp_xxh), (IV)rc); /* set err early */ sv_setpv(errstr, what); #if MYSQL_VERSION_ID >= SQL_STATE_VERSION if (sqlstate) { errstate= DBIc_STATE(imp_xxh); sv_setpvn(errstate, sqlstate, 5); } #endif /* NO EFFECT DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), errstr); */ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "%s error %d recorded: %s\n", what, rc, SvPV(errstr,lna)); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\t<-- do_error\n"); } /* void do_warn(SV* h, int rc, char* what) */ void do_warn(SV* h, int rc, char* what) { dTHX; D_imp_xxh(h); STRLEN lna; SV *errstr = DBIc_ERRSTR(imp_xxh); sv_setiv(DBIc_ERR(imp_xxh), (IV)rc); /* set err early */ sv_setpv(errstr, what); /* NO EFFECT DBIh_EVENT2(h, WARN_event, DBIc_ERR(imp_xxh), errstr);*/ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "%s warning %d recorded: %s\n", what, rc, SvPV(errstr,lna)); warn("%s", what); } #if defined(DBD_MYSQL_EMBEDDED) #define DBD_MYSQL_NAMESPACE "DBD::mysqlEmb::QUIET"; #else #define DBD_MYSQL_NAMESPACE "DBD::mysql::QUIET"; #endif #define doquietwarn(s) \ { \ SV* sv = perl_get_sv(DBD_MYSQL_NAMESPACE, FALSE); \ if (!sv || !SvTRUE(sv)) { \ warn s; \ } \ } /*************************************************************************** * * Name: mysql_dr_connect * * Purpose: Replacement for mysql_connect * * Input: MYSQL* sock - Pointer to a MYSQL structure being * initialized * char* mysql_socket - Name of a UNIX socket being used * or NULL * char* host - Host name being used or NULL for localhost * char* port - Port number being used or NULL for default * char* user - User name being used or NULL * char* password - Password being used or NULL * char* dbname - Database name being used or NULL * char* imp_dbh - Pointer to internal dbh structure * * Returns: The sock argument for success, NULL otherwise; * you have to call do_error in the latter case. * **************************************************************************/ MYSQL *mysql_dr_connect( SV* dbh, MYSQL* sock, char* mysql_socket, char* host, char* port, char* user, char* password, char* dbname, imp_dbh_t *imp_dbh) { int portNr; unsigned int client_flag; MYSQL* result; dTHX; D_imp_xxh(dbh); /* per Monty, already in client.c in API */ /* but still not exist in libmysqld.c */ #if defined(DBD_MYSQL_EMBEDDED) if (host && !*host) host = NULL; #endif portNr= (port && *port) ? atoi(port) : 0; /* already in client.c in API */ /* if (user && !*user) user = NULL; */ /* if (password && !*password) password = NULL; */ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: host = |%s|, port = %d," \ " uid = %s, pwd = %s\n", host ? host : "NULL", portNr, user ? user : "NULL", password ? password : "NULL"); { #if defined(DBD_MYSQL_EMBEDDED) if (imp_dbh) { D_imp_drh_from_dbh; SV* sv = DBIc_IMP_DATA(imp_dbh); if (sv && SvROK(sv)) { SV** svp; STRLEN lna; char * options; int server_args_cnt= 0; int server_groups_cnt= 0; int rc= 0; char ** server_args = NULL; char ** server_groups = NULL; HV* hv = (HV*) SvRV(sv); if (SvTYPE(hv) != SVt_PVHV) return NULL; if (!imp_drh->embedded.state) { /* Init embedded server */ if ((svp = hv_fetch(hv, "mysql_embedded_groups", 21, FALSE)) && *svp && SvTRUE(*svp)) { options = SvPV(*svp, lna); imp_drh->embedded.groups=newSVsv(*svp); if ((server_groups_cnt=count_embedded_options(options))) { /* number of server_groups always server_groups+1 */ server_groups=fill_out_embedded_options(options, 0, (int)lna, ++server_groups_cnt); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh), "Groups names passed to embedded server:\n"); print_embedded_options(DBIc_LOGPIO(imp_xxh), server_groups, server_groups_cnt); } } } if ((svp = hv_fetch(hv, "mysql_embedded_options", 22, FALSE)) && *svp && SvTRUE(*svp)) { options = SvPV(*svp, lna); imp_drh->embedded.args=newSVsv(*svp); if ((server_args_cnt=count_embedded_options(options))) { /* number of server_options always server_options+1 */ server_args=fill_out_embedded_options(options, 1, (int)lna, ++server_args_cnt); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh), "Server options passed to embedded server:\n"); print_embedded_options(DBIc_LOGPIO(imp_xxh), server_args, server_args_cnt); } } } if (mysql_server_init(server_args_cnt, server_args, server_groups)) { do_warn(dbh, AS_ERR_EMBEDDED, "Embedded server was not started. \ Could not initialize environment."); return NULL; } imp_drh->embedded.state=1; if (server_args_cnt) free_embedded_options(server_args, server_args_cnt); if (server_groups_cnt) free_embedded_options(server_groups, server_groups_cnt); } else { /* * Check if embedded parameters passed to connect() differ from * first ones */ if ( ((svp = hv_fetch(hv, "mysql_embedded_groups", 21, FALSE)) && *svp && SvTRUE(*svp))) rc =+ abs(sv_cmp(*svp, imp_drh->embedded.groups)); if ( ((svp = hv_fetch(hv, "mysql_embedded_options", 22, FALSE)) && *svp && SvTRUE(*svp)) ) rc =+ abs(sv_cmp(*svp, imp_drh->embedded.args)); if (rc) { do_warn(dbh, AS_ERR_EMBEDDED, "Embedded server was already started. You cannot pass init\ parameters to embedded server once"); return NULL; } } } } #endif #ifdef MYSQL_NO_CLIENT_FOUND_ROWS client_flag = 0; #else client_flag = CLIENT_FOUND_ROWS; #endif mysql_init(sock); if (imp_dbh) { SV* sv = DBIc_IMP_DATA(imp_dbh); DBIc_set(imp_dbh, DBIcf_AutoCommit, TRUE); if (sv && SvROK(sv)) { HV* hv = (HV*) SvRV(sv); SV** svp; STRLEN lna; /* thanks to Peter John Edwards for mysql_init_command */ if ((svp = hv_fetch(hv, "mysql_init_command", 18, FALSE)) && *svp && SvTRUE(*svp)) { char* df = SvPV(*svp, lna); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Setting" \ " init command (%s).\n", df); mysql_options(sock, MYSQL_INIT_COMMAND, df); } if ((svp = hv_fetch(hv, "mysql_compression", 17, FALSE)) && *svp && SvTRUE(*svp)) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Enabling" \ " compression.\n"); mysql_options(sock, MYSQL_OPT_COMPRESS, NULL); } if ((svp = hv_fetch(hv, "mysql_connect_timeout", 21, FALSE)) && *svp && SvTRUE(*svp)) { int to = SvIV(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Setting" \ " connect timeout (%d).\n",to); mysql_options(sock, MYSQL_OPT_CONNECT_TIMEOUT, (const char *)&to); } if ((svp = hv_fetch(hv, "mysql_write_timeout", 19, FALSE)) && *svp && SvTRUE(*svp)) { int to = SvIV(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Setting" \ " write timeout (%d).\n",to); mysql_options(sock, MYSQL_OPT_WRITE_TIMEOUT, (const char *)&to); } if ((svp = hv_fetch(hv, "mysql_read_timeout", 18, FALSE)) && *svp && SvTRUE(*svp)) { int to = SvIV(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Setting" \ " read timeout (%d).\n",to); mysql_options(sock, MYSQL_OPT_READ_TIMEOUT, (const char *)&to); } if ((svp = hv_fetch(hv, "mysql_read_default_file", 23, FALSE)) && *svp && SvTRUE(*svp)) { char* df = SvPV(*svp, lna); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Reading" \ " default file %s.\n", df); mysql_options(sock, MYSQL_READ_DEFAULT_FILE, df); } if ((svp = hv_fetch(hv, "mysql_read_default_group", 24, FALSE)) && *svp && SvTRUE(*svp)) { char* gr = SvPV(*svp, lna); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Using" \ " default group %s.\n", gr); mysql_options(sock, MYSQL_READ_DEFAULT_GROUP, gr); } if ((svp = hv_fetch(hv, "mysql_client_found_rows", 23, FALSE)) && *svp) { if (SvTRUE(*svp)) client_flag |= CLIENT_FOUND_ROWS; else client_flag &= ~CLIENT_FOUND_ROWS; } if ((svp = hv_fetch(hv, "mysql_use_result", 16, FALSE)) && *svp) { imp_dbh->use_mysql_use_result = SvTRUE(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->use_mysql_use_result: %d\n", imp_dbh->use_mysql_use_result); } if ((svp = hv_fetch(hv, "mysql_bind_type_guessing", 24, TRUE)) && *svp) { imp_dbh->bind_type_guessing= SvTRUE(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->bind_type_guessing: %d\n", imp_dbh->bind_type_guessing); } if ((svp = hv_fetch(hv, "mysql_bind_comment_placeholders", 31, FALSE)) && *svp) { imp_dbh->bind_comment_placeholders = SvTRUE(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->bind_comment_placeholders: %d\n", imp_dbh->bind_comment_placeholders); } if ((svp = hv_fetch(hv, "mysql_no_autocommit_cmd", 23, FALSE)) && *svp) { imp_dbh->no_autocommit_cmd= SvTRUE(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->no_autocommit_cmd: %d\n", imp_dbh->no_autocommit_cmd); } #if defined(CLIENT_MULTI_STATEMENTS) if ((svp = hv_fetch(hv, "mysql_multi_statements", 22, FALSE)) && *svp) { if (SvTRUE(*svp)) client_flag |= CLIENT_MULTI_STATEMENTS; else client_flag &= ~CLIENT_MULTI_STATEMENTS; } #endif #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION /* took out client_flag |= CLIENT_PROTOCOL_41; */ /* because libmysql.c already sets this no matter what */ if ((svp = hv_fetch(hv, "mysql_server_prepare", 20, FALSE)) && *svp) { if (SvTRUE(*svp)) { client_flag |= CLIENT_PROTOCOL_41; imp_dbh->use_server_side_prepare = TRUE; } else { client_flag &= ~CLIENT_PROTOCOL_41; imp_dbh->use_server_side_prepare = FALSE; } } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->use_server_side_prepare: %d\n", imp_dbh->use_server_side_prepare); #endif /* HELMUT */ #if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION if ((svp = hv_fetch(hv, "mysql_enable_utf8", 17, FALSE)) && *svp) { /* Do not touch imp_dbh->enable_utf8 as we are called earlier * than it is set and mysql_options() must be before: * mysql_real_connect() */ mysql_options(sock, MYSQL_SET_CHARSET_NAME, (SvTRUE(*svp) ? "utf8" : "latin1")); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "mysql_options: MYSQL_SET_CHARSET_NAME=%s\n", (SvTRUE(*svp) ? "utf8" : "latin1")); } #endif #if defined(DBD_MYSQL_WITH_SSL) && !defined(DBD_MYSQL_EMBEDDED) && \ (defined(CLIENT_SSL) || (MYSQL_VERSION_ID >= 40000)) if ((svp = hv_fetch(hv, "mysql_ssl", 9, FALSE)) && *svp) { if (SvTRUE(*svp)) { char *client_key = NULL; char *client_cert = NULL; char *ca_file = NULL; char *ca_path = NULL; char *cipher = NULL; STRLEN lna; #if MYSQL_VERSION_ID >= SSL_VERIFY_VERSION /* New code to utilise MySQLs new feature that verifies that the server's hostname that the client connects to matches that of the certificate */ my_bool ssl_verify_true = 0; if ((svp = hv_fetch(hv, "mysql_ssl_verify_server_cert", 28, FALSE)) && *svp) ssl_verify_true = SvTRUE(*svp); #endif if ((svp = hv_fetch(hv, "mysql_ssl_client_key", 20, FALSE)) && *svp) client_key = SvPV(*svp, lna); if ((svp = hv_fetch(hv, "mysql_ssl_client_cert", 21, FALSE)) && *svp) client_cert = SvPV(*svp, lna); if ((svp = hv_fetch(hv, "mysql_ssl_ca_file", 17, FALSE)) && *svp) ca_file = SvPV(*svp, lna); if ((svp = hv_fetch(hv, "mysql_ssl_ca_path", 17, FALSE)) && *svp) ca_path = SvPV(*svp, lna); if ((svp = hv_fetch(hv, "mysql_ssl_cipher", 16, FALSE)) && *svp) cipher = SvPV(*svp, lna); mysql_ssl_set(sock, client_key, client_cert, ca_file, ca_path, cipher); #if MYSQL_VERSION_ID >= SSL_VERIFY_VERSION mysql_options(sock, MYSQL_OPT_SSL_VERIFY_SERVER_CERT, &ssl_verify_true); #endif client_flag |= CLIENT_SSL; } } #endif #if (MYSQL_VERSION_ID >= 32349) /* * MySQL 3.23.49 disables LOAD DATA LOCAL by default. Use * mysql_local_infile=1 in the DSN to enable it. */ if ((svp = hv_fetch( hv, "mysql_local_infile", 18, FALSE)) && *svp) { unsigned int flag = SvTRUE(*svp); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: Using" \ " local infile %u.\n", flag); mysql_options(sock, MYSQL_OPT_LOCAL_INFILE, (const char *) &flag); } #endif } } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: client_flags = %d\n", client_flag); #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION client_flag|= CLIENT_MULTI_RESULTS; #endif result = mysql_real_connect(sock, host, user, password, dbname, portNr, mysql_socket, client_flag); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->mysql_dr_connect: <-"); if (result) { #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION /* connection succeeded. */ /* imp_dbh == NULL when mysql_dr_connect() is called from mysql.xs functions (_admin_internal(),_ListDBs()). */ if (!(result->client_flag & CLIENT_PROTOCOL_41) && imp_dbh) imp_dbh->use_server_side_prepare = FALSE; #endif #if MYSQL_ASYNC if(imp_dbh) { imp_dbh->async_query_in_flight = NULL; } #endif /* we turn off Mysql's auto reconnect and handle re-connecting ourselves so that we can keep track of when this happens. */ result->reconnect=0; } else { /* sock was allocated with mysql_init() fixes: https://rt.cpan.org/Ticket/Display.html?id=86153 */ Safefree(sock); } return result; } } /* safe_hv_fetch */ static char *safe_hv_fetch(pTHX_ HV *hv, const char *name, int name_length) { SV** svp; STRLEN len; char *res= NULL; if ((svp= hv_fetch(hv, name, name_length, FALSE))) { res= SvPV(*svp, len); if (!len) res= NULL; } return res; } /* Frontend for mysql_dr_connect */ static int my_login(pTHX_ SV* dbh, imp_dbh_t *imp_dbh) { SV* sv; HV* hv; char* dbname; char* host; char* port; char* user; char* password; char* mysql_socket; D_imp_xxh(dbh); /* TODO- resolve this so that it is set only if DBI is 1.607 */ #define TAKE_IMP_DATA_VERSION 1 #if TAKE_IMP_DATA_VERSION if (DBIc_has(imp_dbh, DBIcf_IMPSET)) { /* eg from take_imp_data() */ if (DBIc_has(imp_dbh, DBIcf_ACTIVE)) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "my_login skip connect\n"); /* tell our parent we've adopted an active child */ ++DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_dbh)); return TRUE; } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "my_login IMPSET but not ACTIVE so connect not skipped\n"); } #endif sv = DBIc_IMP_DATA(imp_dbh); if (!sv || !SvROK(sv)) return FALSE; hv = (HV*) SvRV(sv); if (SvTYPE(hv) != SVt_PVHV) return FALSE; host= safe_hv_fetch(aTHX_ hv, "host", 4); port= safe_hv_fetch(aTHX_ hv, "port", 4); user= safe_hv_fetch(aTHX_ hv, "user", 4); password= safe_hv_fetch(aTHX_ hv, "password", 8); dbname= safe_hv_fetch(aTHX_ hv, "database", 8); mysql_socket= safe_hv_fetch(aTHX_ hv, "mysql_socket", 12); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->my_login : dbname = %s, uid = %s, pwd = %s," \ "host = %s, port = %s\n", dbname ? dbname : "NULL", user ? user : "NULL", password ? password : "NULL", host ? host : "NULL", port ? port : "NULL"); if (!imp_dbh->pmysql) { Newz(908, imp_dbh->pmysql, 1, MYSQL); } return mysql_dr_connect(dbh, imp_dbh->pmysql, mysql_socket, host, port, user, password, dbname, imp_dbh) ? TRUE : FALSE; } /************************************************************************** * * Name: dbd_db_login * * Purpose: Called for connecting to a database and logging in. * * Input: dbh - database handle being initialized * imp_dbh - drivers private database handle data * dbname - the database we want to log into; may be like * "dbname:host" or "dbname:host:port" * user - user name to connect as * password - passwort to connect with * * Returns: TRUE for success, FALSE otherwise; do_error has already * been called in the latter case * **************************************************************************/ int dbd_db_login(SV* dbh, imp_dbh_t* imp_dbh, char* dbname, char* user, char* password) { #ifdef dTHR dTHR; #endif dTHX; D_imp_xxh(dbh); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->connect: dsn = %s, uid = %s, pwd = %s\n", dbname ? dbname : "NULL", user ? user : "NULL", password ? password : "NULL"); imp_dbh->stats.auto_reconnects_ok= 0; imp_dbh->stats.auto_reconnects_failed= 0; imp_dbh->bind_type_guessing= FALSE; imp_dbh->bind_comment_placeholders= FALSE; imp_dbh->has_transactions= TRUE; /* Safer we flip this to TRUE perl side if we detect a mod_perl env. */ imp_dbh->auto_reconnect = FALSE; /* HELMUT */ #if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION imp_dbh->enable_utf8 = FALSE; /* initialize mysql_enable_utf8 */ #endif if (!my_login(aTHX_ dbh, imp_dbh)) { do_error(dbh, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql) ,mysql_sqlstate(imp_dbh->pmysql)); return FALSE; } /* * Tell DBI, that dbh->disconnect should be called for this handle */ DBIc_ACTIVE_on(imp_dbh); /* Tell DBI, that dbh->destroy should be called for this handle */ DBIc_on(imp_dbh, DBIcf_IMPSET); return TRUE; } /*************************************************************************** * * Name: dbd_db_commit * dbd_db_rollback * * Purpose: You guess what they should do. * * Input: dbh - database handle being commited or rolled back * imp_dbh - drivers private database handle data * * Returns: TRUE for success, FALSE otherwise; do_error has already * been called in the latter case * **************************************************************************/ int dbd_db_commit(SV* dbh, imp_dbh_t* imp_dbh) { if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) return FALSE; ASYNC_CHECK_RETURN(dbh, FALSE); if (imp_dbh->has_transactions) { #if MYSQL_VERSION_ID < SERVER_PREPARE_VERSION if (mysql_real_query(imp_dbh->pmysql, "COMMIT", 6)) #else if (mysql_commit(imp_dbh->pmysql)) #endif { do_error(dbh, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql) ,mysql_sqlstate(imp_dbh->pmysql)); return FALSE; } } else do_warn(dbh, JW_ERR_NOT_IMPLEMENTED, "Commit ineffective because transactions are not available"); return TRUE; } /* dbd_db_rollback */ int dbd_db_rollback(SV* dbh, imp_dbh_t* imp_dbh) { /* croak, if not in AutoCommit mode */ if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) return FALSE; ASYNC_CHECK_RETURN(dbh, FALSE); if (imp_dbh->has_transactions) { #if MYSQL_VERSION_ID < SERVER_PREPARE_VERSION if (mysql_real_query(imp_dbh->pmysql, "ROLLBACK", 8)) #else if (mysql_rollback(imp_dbh->pmysql)) #endif { do_error(dbh, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql) ,mysql_sqlstate(imp_dbh->pmysql)); return FALSE; } } else do_error(dbh, JW_ERR_NOT_IMPLEMENTED, "Rollback ineffective because transactions are not available" ,NULL); return TRUE; } /* *************************************************************************** * * Name: dbd_db_disconnect * * Purpose: Disconnect a database handle from its database * * Input: dbh - database handle being disconnected * imp_dbh - drivers private database handle data * * Returns: TRUE for success, FALSE otherwise; do_error has already * been called in the latter case * **************************************************************************/ int dbd_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh) { #ifdef dTHR dTHR; #endif dTHX; D_imp_xxh(dbh); /* We assume that disconnect will always work */ /* since most errors imply already disconnected. */ DBIc_ACTIVE_off(imp_dbh); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->pmysql: %lx\n", (long) imp_dbh->pmysql); mysql_close(imp_dbh->pmysql ); /* We don't free imp_dbh since a reference still exists */ /* The DESTROY method is the only one to 'free' memory. */ return TRUE; } /*************************************************************************** * * Name: dbd_discon_all * * Purpose: Disconnect all database handles at shutdown time * * Input: dbh - database handle being disconnected * imp_dbh - drivers private database handle data * * Returns: TRUE for success, FALSE otherwise; do_error has already * been called in the latter case * **************************************************************************/ int dbd_discon_all (SV *drh, imp_drh_t *imp_drh) { #if defined(dTHR) dTHR; #endif dTHX; D_imp_xxh(drh); #if defined(DBD_MYSQL_EMBEDDED) if (imp_drh->embedded.state) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "Stop embedded server\n"); mysql_server_end(); if (imp_drh->embedded.groups) { (void) SvREFCNT_dec(imp_drh->embedded.groups); imp_drh->embedded.groups = NULL; } if (imp_drh->embedded.args) { (void) SvREFCNT_dec(imp_drh->embedded.args); imp_drh->embedded.args = NULL; } } #else mysql_server_end(); #endif /* The disconnect_all concept is flawed and needs more work */ if (!PL_dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) { sv_setiv(DBIc_ERR(imp_drh), (IV)1); sv_setpv(DBIc_ERRSTR(imp_drh), (char*)"disconnect_all not implemented"); /* NO EFFECT DBIh_EVENT2(drh, ERROR_event, DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh)); */ return FALSE; } PL_perl_destruct_level = 0; return FALSE; } /**************************************************************************** * * Name: dbd_db_destroy * * Purpose: Our part of the dbh destructor * * Input: dbh - database handle being destroyed * imp_dbh - drivers private database handle data * * Returns: Nothing * **************************************************************************/ void dbd_db_destroy(SV* dbh, imp_dbh_t* imp_dbh) { /* * Being on the safe side never hurts ... */ if (DBIc_ACTIVE(imp_dbh)) { if (imp_dbh->has_transactions) { if (!DBIc_has(imp_dbh, DBIcf_AutoCommit)) #if MYSQL_VERSION_ID < SERVER_PREPARE_VERSION if ( mysql_real_query(imp_dbh->pmysql, "ROLLBACK", 8)) #else if (mysql_rollback(imp_dbh->pmysql)) #endif do_error(dbh, TX_ERR_ROLLBACK,"ROLLBACK failed" ,NULL); } dbd_db_disconnect(dbh, imp_dbh); } Safefree(imp_dbh->pmysql); /* Tell DBI, that dbh->destroy must no longer be called */ DBIc_off(imp_dbh, DBIcf_IMPSET); } /* *************************************************************************** * * Name: dbd_db_STORE_attrib * * Purpose: Function for storing dbh attributes; we currently support * just nothing. :-) * * Input: dbh - database handle being modified * imp_dbh - drivers private database handle data * keysv - the attribute name * valuesv - the attribute value * * Returns: TRUE for success, FALSE otherwise * **************************************************************************/ int dbd_db_STORE_attrib( SV* dbh, imp_dbh_t* imp_dbh, SV* keysv, SV* valuesv ) { dTHX; STRLEN kl; char *key = SvPV(keysv, kl); SV *cachesv = Nullsv; int cacheit = FALSE; bool bool_value = SvTRUE(valuesv); if (kl==10 && strEQ(key, "AutoCommit")) { if (imp_dbh->has_transactions) { bool oldval = DBIc_has(imp_dbh,DBIcf_AutoCommit) ? 1 : 0; if (bool_value == oldval) return TRUE; /* if setting AutoCommit on ... */ if (!imp_dbh->no_autocommit_cmd) { if ( #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION mysql_autocommit(imp_dbh->pmysql, bool_value) #else mysql_real_query(imp_dbh->pmysql, bool_value ? "SET AUTOCOMMIT=1" : "SET AUTOCOMMIT=0", 16) #endif ) { do_error(dbh, TX_ERR_AUTOCOMMIT, bool_value ? "Turning on AutoCommit failed" : "Turning off AutoCommit failed" ,NULL); return TRUE; /* TRUE means we handled it - important to avoid spurious errors */ } } DBIc_set(imp_dbh, DBIcf_AutoCommit, bool_value); } else { /* * We do support neither transactions nor "AutoCommit". * But we stub it. :-) */ if (!bool_value) { do_error(dbh, JW_ERR_NOT_IMPLEMENTED, "Transactions not supported by database" ,NULL); croak("Transactions not supported by database"); } } } else if (kl == 16 && strEQ(key,"mysql_use_result")) imp_dbh->use_mysql_use_result = bool_value; else if (kl == 20 && strEQ(key,"mysql_auto_reconnect")) imp_dbh->auto_reconnect = bool_value; else if (kl == 20 && strEQ(key, "mysql_server_prepare")) imp_dbh->use_server_side_prepare=SvTRUE(valuesv); else if (kl == 23 && strEQ(key,"mysql_no_autocommit_cmd")) imp_dbh->no_autocommit_cmd= SvTRUE(valuesv); else if (kl == 24 && strEQ(key,"mysql_bind_type_guessing")) imp_dbh->bind_type_guessing = SvTRUE(valuesv); else if (kl == 31 && strEQ(key,"mysql_bind_comment_placeholders")) imp_dbh->bind_type_guessing = SvTRUE(valuesv); #if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION else if (kl == 17 && strEQ(key, "mysql_enable_utf8")) imp_dbh->enable_utf8 = bool_value; #endif else return FALSE; /* Unknown key */ if (cacheit) /* cache value for later DBI 'quick' fetch? */ hv_store((HV*)SvRV(dbh), key, kl, cachesv, 0); return TRUE; } /*************************************************************************** * * Name: dbd_db_FETCH_attrib * * Purpose: Function for fetching dbh attributes * * Input: dbh - database handle being queried * imp_dbh - drivers private database handle data * keysv - the attribute name * * Returns: An SV*, if sucessfull; NULL otherwise * * Notes: Do not forget to call sv_2mortal in the former case! * **************************************************************************/ static SV* my_ulonglong2str(pTHX_ my_ulonglong val) { char buf[64]; char *ptr = buf + sizeof(buf) - 1; if (val == 0) return newSVpv("0", 1); *ptr = '\0'; while (val > 0) { *(--ptr) = ('0' + (val % 10)); val = val / 10; } return newSVpv(ptr, (buf+ sizeof(buf) - 1) - ptr); } SV* dbd_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) { dTHX; STRLEN kl; char *key = SvPV(keysv, kl); char* fine_key = NULL; SV* result = NULL; dbh= dbh; switch (*key) { case 'A': if (strEQ(key, "AutoCommit")) { if (imp_dbh->has_transactions) return sv_2mortal(boolSV(DBIc_has(imp_dbh,DBIcf_AutoCommit))); /* Default */ return &PL_sv_yes; } break; } if (strncmp(key, "mysql_", 6) == 0) { fine_key = key; key = key+6; kl = kl-6; } /* MONTY: Check if kl should not be used or used everywhere */ switch(*key) { case 'a': if (kl == strlen("auto_reconnect") && strEQ(key, "auto_reconnect")) result= sv_2mortal(newSViv(imp_dbh->auto_reconnect)); break; case 'b': if (kl == strlen("bind_type_guessing") && strEQ(key, "bind_type_guessing")) { result = sv_2mortal(newSViv(imp_dbh->bind_type_guessing)); } else if (kl == strlen("bind_comment_placeholders") && strEQ(key, "bind_comment_placeholders")) { result = sv_2mortal(newSViv(imp_dbh->bind_comment_placeholders)); } break; case 'c': if (kl == 10 && strEQ(key, "clientinfo")) { const char* clientinfo = mysql_get_client_info(); result= clientinfo ? sv_2mortal(newSVpv(clientinfo, strlen(clientinfo))) : &PL_sv_undef; } else if (kl == 13 && strEQ(key, "clientversion")) { result= sv_2mortal(my_ulonglong2str(aTHX_ mysql_get_client_version())); } break; case 'e': if (strEQ(key, "errno")) result= sv_2mortal(newSViv((IV)mysql_errno(imp_dbh->pmysql))); else if ( strEQ(key, "error") || strEQ(key, "errmsg")) { /* Note that errmsg is obsolete, as of 2.09! */ const char* msg = mysql_error(imp_dbh->pmysql); result= sv_2mortal(newSVpv(msg, strlen(msg))); } /* HELMUT */ #if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION else if (kl == strlen("enable_utf8") && strEQ(key, "enable_utf8")) result = sv_2mortal(newSViv(imp_dbh->enable_utf8)); #endif break; case 'd': if (strEQ(key, "dbd_stats")) { HV* hv = newHV(); hv_store( hv, "auto_reconnects_ok", strlen("auto_reconnects_ok"), newSViv(imp_dbh->stats.auto_reconnects_ok), 0 ); hv_store( hv, "auto_reconnects_failed", strlen("auto_reconnects_failed"), newSViv(imp_dbh->stats.auto_reconnects_failed), 0 ); result= sv_2mortal((newRV_noinc((SV*)hv))); } case 'h': if (strEQ(key, "hostinfo")) { const char* hostinfo = mysql_get_host_info(imp_dbh->pmysql); result= hostinfo ? sv_2mortal(newSVpv(hostinfo, strlen(hostinfo))) : &PL_sv_undef; } break; case 'i': if (strEQ(key, "info")) { const char* info = mysql_info(imp_dbh->pmysql); result= info ? sv_2mortal(newSVpv(info, strlen(info))) : &PL_sv_undef; } else if (kl == 8 && strEQ(key, "insertid")) /* We cannot return an IV, because the insertid is a long. */ result= sv_2mortal(my_ulonglong2str(aTHX_ mysql_insert_id(imp_dbh->pmysql))); break; case 'n': if (kl == strlen("no_autocommit_cmd") && strEQ(key, "no_autocommit_cmd")) result = sv_2mortal(newSViv(imp_dbh->no_autocommit_cmd)); break; case 'p': if (kl == 9 && strEQ(key, "protoinfo")) result= sv_2mortal(newSViv(mysql_get_proto_info(imp_dbh->pmysql))); break; case 's': if (kl == 10 && strEQ(key, "serverinfo")) { const char* serverinfo = mysql_get_server_info(imp_dbh->pmysql); result= serverinfo ? sv_2mortal(newSVpv(serverinfo, strlen(serverinfo))) : &PL_sv_undef; } else if (kl == 13 && strEQ(key, "serverversion")) result= sv_2mortal(my_ulonglong2str(aTHX_ mysql_get_server_version(imp_dbh->pmysql))); else if (strEQ(key, "sock")) result= sv_2mortal(newSViv((IV) imp_dbh->pmysql)); else if (strEQ(key, "sockfd")) result= sv_2mortal(newSViv((IV) imp_dbh->pmysql->net.fd)); else if (strEQ(key, "stat")) { const char* stats = mysql_stat(imp_dbh->pmysql); result= stats ? sv_2mortal(newSVpv(stats, strlen(stats))) : &PL_sv_undef; } else if (strEQ(key, "stats")) { /* Obsolete, as of 2.09 */ const char* stats = mysql_stat(imp_dbh->pmysql); result= stats ? sv_2mortal(newSVpv(stats, strlen(stats))) : &PL_sv_undef; } else if (kl == 14 && strEQ(key,"server_prepare")) result= sv_2mortal(newSViv((IV) imp_dbh->use_server_side_prepare)); break; case 't': if (kl == 9 && strEQ(key, "thread_id")) result= sv_2mortal(newSViv(mysql_thread_id(imp_dbh->pmysql))); break; case 'w': if (kl == 13 && strEQ(key, "warning_count")) result= sv_2mortal(newSViv(mysql_warning_count(imp_dbh->pmysql))); break; } if (result== NULL) return Nullsv; return result; } /* ************************************************************************** * * Name: dbd_st_prepare * * Purpose: Called for preparing an SQL statement; our part of the * statement handle constructor * * Input: sth - statement handle being initialized * imp_sth - drivers private statement handle data * statement - pointer to string with SQL statement * attribs - statement attributes, currently not in use * * Returns: TRUE for success, FALSE otherwise; do_error will * be called in the latter case * **************************************************************************/ int dbd_st_prepare( SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs) { int i; SV **svp; dTHX; #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION char *str_ptr; int col_type, prepare_retval, limit_flag=0; MYSQL_BIND *bind, *bind_end; imp_sth_phb_t *fbind; #endif D_imp_xxh(sth); D_imp_dbh_from_sth; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t-> dbd_st_prepare MYSQL_VERSION_ID %d, SQL statement: %s\n", MYSQL_VERSION_ID, statement); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION /* Set default value of 'mysql_server_prepare' attribute for sth from dbh */ imp_sth->use_server_side_prepare= imp_dbh->use_server_side_prepare; if (attribs) { svp= DBD_ATTRIB_GET_SVP(attribs, "mysql_server_prepare", 20); imp_sth->use_server_side_prepare = (svp) ? SvTRUE(*svp) : imp_dbh->use_server_side_prepare; svp = DBD_ATTRIB_GET_SVP(attribs, "async", 5); if(svp && SvTRUE(*svp)) { #if MYSQL_ASYNC imp_sth->is_async = TRUE; imp_sth->use_server_side_prepare = FALSE; #else do_error(sth, 2000, "Async support was not built into this version of DBD::mysql", "HY000"); return 0; #endif } } imp_sth->fetch_done= 0; #endif imp_sth->done_desc= 0; imp_sth->result= NULL; imp_sth->currow= 0; /* Set default value of 'mysql_use_result' attribute for sth from dbh */ svp= DBD_ATTRIB_GET_SVP(attribs, "mysql_use_result", 16); imp_sth->use_mysql_use_result= svp ? SvTRUE(*svp) : imp_dbh->use_mysql_use_result; for (i= 0; i < AV_ATTRIB_LAST; i++) imp_sth->av_attr[i]= Nullav; /* Clean-up previous result set(s) for sth to prevent 'Commands out of sync' error */ mysql_st_free_result_sets(sth, imp_sth); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tuse_server_side_prepare set, check LIMIT\n"); /* This code is here because mysql < 5.1 didn't support placeholders in prepared statements and also we have to disable some statements for PS mode */ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tneed to test for LIMIT\n"); for (str_ptr= statement; *str_ptr; str_ptr++) { /* Processing of multi-result-set is not possible due to lack of some calls in PS API. CALL() statement is disabled for PS mode as it may cause multi-resut-set. */ if ( (tolower(*(str_ptr + 0)) == 'c') && (tolower(*(str_ptr + 1)) == 'a') && (tolower(*(str_ptr + 2)) == 'l') && (tolower(*(str_ptr + 3)) == 'l') && (tolower(*(str_ptr + 4)) == ' ')) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "Disable PS mode for CALL()\n"); imp_sth->use_server_side_prepare= 0; } #if MYSQL_VERSION_ID < LIMIT_PLACEHOLDER_VERSION /* If there is a 'limit' in the statement and placeholders are NOT supported */ if ( (tolower(*(str_ptr + 0)) == 'l') && (tolower(*(str_ptr + 1)) == 'i') && (tolower(*(str_ptr + 2)) == 'm') && (tolower(*(str_ptr + 3)) == 'i') && (tolower(*(str_ptr + 4)) == 't')) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "LIMIT set limit flag to 1\n"); limit_flag= 1; } if (limit_flag) { /* ... and place holders after the limit flag is set... */ if (*str_ptr == '?') { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tLIMIT and ? found, set to use_server_side_prepare=0\n"); /* ... then we do not want to try server side prepare (use emulation) */ imp_sth->use_server_side_prepare= 0; break; } } #endif } } #endif #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tuse_server_side_prepare set\n"); /* do we really need this? If we do, we should return, not just continue */ if (imp_sth->stmt) fprintf(stderr, "ERROR: Trying to prepare new stmt while we have \ already not closed one \n"); imp_sth->stmt= mysql_stmt_init(imp_dbh->pmysql); if (! imp_sth->stmt) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tERROR: Unable to return MYSQL_STMT structure \ from mysql_stmt_init(): ERROR NO: %d ERROR MSG:%s\n", mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql)); } prepare_retval= mysql_stmt_prepare(imp_sth->stmt, statement, strlen(statement)); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tmysql_stmt_prepare returned %d\n", prepare_retval); if (prepare_retval) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tmysql_stmt_prepare %d %s\n", mysql_stmt_errno(imp_sth->stmt), mysql_stmt_error(imp_sth->stmt)); /* For commands that are not supported by server side prepared statement mechanism lets try to pass them through regular API */ if (mysql_stmt_errno(imp_sth->stmt) == ER_UNSUPPORTED_PS) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tSETTING imp_sth->use_server_side_prepare to 0\n"); imp_sth->use_server_side_prepare= 0; } else { do_error(sth, mysql_stmt_errno(imp_sth->stmt), mysql_stmt_error(imp_sth->stmt), mysql_sqlstate(imp_dbh->pmysql)); mysql_stmt_close(imp_sth->stmt); imp_sth->stmt= NULL; return FALSE; } } else { DBIc_NUM_PARAMS(imp_sth)= mysql_stmt_param_count(imp_sth->stmt); /* mysql_stmt_param_count */ if (DBIc_NUM_PARAMS(imp_sth) > 0) { int has_statement_fields= imp_sth->stmt->fields != 0; /* Allocate memory for bind variables */ imp_sth->bind= alloc_bind(DBIc_NUM_PARAMS(imp_sth)); imp_sth->fbind= alloc_fbind(DBIc_NUM_PARAMS(imp_sth)); imp_sth->has_been_bound= 0; /* Initialize ph variables with NULL values */ for (i= 0, bind= imp_sth->bind, fbind= imp_sth->fbind, bind_end= bind+DBIc_NUM_PARAMS(imp_sth); bind < bind_end ; bind++, fbind++, i++ ) { /* if this statement has a result set, field types will be correctly identified. If there is no result set, such as with an INSERT, fields will not be defined, and all buffer_type will default to MYSQL_TYPE_VAR_STRING */ col_type= (has_statement_fields ? imp_sth->stmt->fields[i].type : MYSQL_TYPE_STRING); bind->buffer_type= mysql_to_perl_type(col_type); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tmysql_to_perl_type returned %d\n", col_type); bind->buffer= NULL; bind->length= &(fbind->length); bind->is_null= (char*) &(fbind->is_null); fbind->is_null= 1; fbind->length= 0; } } } } #endif #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION /* Count the number of parameters (driver, vs server-side) */ if (imp_sth->use_server_side_prepare == 0) DBIc_NUM_PARAMS(imp_sth) = count_params((imp_xxh_t *)imp_dbh, aTHX_ statement, imp_dbh->bind_comment_placeholders); #else DBIc_NUM_PARAMS(imp_sth) = count_params((imp_xxh_t *)imp_dbh, aTHX_ statement, imp_dbh->bind_comment_placeholders); #endif /* Allocate memory for parameters */ imp_sth->params= alloc_param(DBIc_NUM_PARAMS(imp_sth)); DBIc_IMPSET_on(imp_sth); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_prepare\n"); return 1; } /*************************************************************************** * Name: dbd_st_free_result_sets * * Purpose: Clean-up single or multiple result sets (if any) * * Inputs: sth - Statement handle * imp_sth - driver's private statement handle * * Returns: 1 ok * 0 error *************************************************************************/ int mysql_st_free_result_sets (SV * sth, imp_sth_t * imp_sth) { dTHX; D_imp_dbh_from_sth; D_imp_xxh(sth); int next_result_rc= -1; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t>- dbd_st_free_result_sets\n"); #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION do { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_free_result_sets RC %d\n", next_result_rc); if (next_result_rc == 0) { if (!(imp_sth->result = mysql_use_result(imp_dbh->pmysql))) { /* Check for possible error */ if (mysql_field_count(imp_dbh->pmysql)) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_free_result_sets ERROR: %s\n", mysql_error(imp_dbh->pmysql)); do_error(sth, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql), mysql_sqlstate(imp_dbh->pmysql)); return 0; } } } if (imp_sth->result) { mysql_free_result(imp_sth->result); imp_sth->result=NULL; } } while ((next_result_rc=mysql_next_result(imp_dbh->pmysql))==0); if (next_result_rc > 0) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_free_result_sets: Error while processing multi-result set: %s\n", mysql_error(imp_dbh->pmysql)); do_error(sth, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql), mysql_sqlstate(imp_dbh->pmysql)); } #else if (imp_sth->result) { mysql_free_result(imp_sth->result); imp_sth->result=NULL; } #endif if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_free_result_sets\n"); return 1; } #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION /*************************************************************************** * Name: dbd_st_more_results * * Purpose: Move onto the next result set (if any) * * Inputs: sth - Statement handle * imp_sth - driver's private statement handle * * Returns: 1 if there are more results sets * 0 if there are not * -1 for errors. *************************************************************************/ int dbd_st_more_results(SV* sth, imp_sth_t* imp_sth) { dTHX; D_imp_dbh_from_sth; D_imp_xxh(sth); int use_mysql_use_result=imp_sth->use_mysql_use_result; int next_result_return_code, i; MYSQL* svsock= imp_dbh->pmysql; if (!SvROK(sth) || SvTYPE(SvRV(sth)) != SVt_PVHV) croak("Expected hash array"); if (!mysql_more_results(svsock)) { /* No more pending result set(s)*/ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\n <- dbs_st_more_results no more results\n"); return 0; } if (imp_sth->use_server_side_prepare) { do_warn(sth, JW_ERR_NOT_IMPLEMENTED, "Processing of multiple result set is not possible with server side prepare"); return 0; } /* * Free cached array attributes */ for (i= 0; i < AV_ATTRIB_LAST; i++) { if (imp_sth->av_attr[i]) SvREFCNT_dec(imp_sth->av_attr[i]); imp_sth->av_attr[i]= Nullav; } /* Release previous MySQL result*/ if (imp_sth->result) mysql_free_result(imp_sth->result); if (DBIc_ACTIVE(imp_sth)) DBIc_ACTIVE_off(imp_sth); next_result_return_code= mysql_next_result(svsock); imp_sth->warning_count = mysql_warning_count(imp_dbh->pmysql); /* mysql_next_result returns 0 if there are more results -1 if there are no more results >0 if there was an error */ if (next_result_return_code > 0) { do_error(sth, mysql_errno(svsock), mysql_error(svsock), mysql_sqlstate(svsock)); return 0; } else if(next_result_return_code == -1) { return 0; } else { /* Store the result from the Query */ imp_sth->result = use_mysql_use_result ? mysql_use_result(svsock) : mysql_store_result(svsock); if (mysql_errno(svsock)) { do_error(sth, mysql_errno(svsock), mysql_error(svsock), mysql_sqlstate(svsock)); return 0; } imp_sth->row_num= mysql_affected_rows(imp_dbh->pmysql); if (imp_sth->result == NULL) { /* No "real" rowset*/ DBIc_NUM_FIELDS(imp_sth)= 0; /* for DBI <= 1.53 */ DBIS->set_attr_k(sth, sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0, sv_2mortal(newSViv(0))); return 1; } else { /* We have a new rowset */ imp_sth->currow=0; /* delete cached handle attributes */ /* XXX should be driven by a list to ease maintenance */ hv_delete((HV*)SvRV(sth), "NAME", 4, G_DISCARD); hv_delete((HV*)SvRV(sth), "NULLABLE", 8, G_DISCARD); hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD); hv_delete((HV*)SvRV(sth), "PRECISION", 9, G_DISCARD); hv_delete((HV*)SvRV(sth), "SCALE", 5, G_DISCARD); hv_delete((HV*)SvRV(sth), "TYPE", 4, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_insertid", 14, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_is_auto_increment", 23, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_is_blob", 13, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_is_key", 12, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_is_num", 12, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_is_pri_key", 16, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_length", 12, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_max_length", 16, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_table", 11, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_type", 10, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_type_name", 15, G_DISCARD); hv_delete((HV*)SvRV(sth), "mysql_warning_count", 20, G_DISCARD); /* Adjust NUM_OF_FIELDS - which also adjusts the row buffer size */ DBIc_NUM_FIELDS(imp_sth)= 0; /* for DBI <= 1.53 */ DBIc_DBISTATE(imp_sth)->set_attr_k(sth, sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0, sv_2mortal(newSViv(mysql_num_fields(imp_sth->result))) ); DBIc_ACTIVE_on(imp_sth); imp_sth->done_desc = 0; } imp_dbh->pmysql->net.last_errno= 0; return 1; } } #endif /************************************************************************** * * Name: mysql_st_internal_execute * * Purpose: Internal version for executing a statement, called both from * within the "do" and the "execute" method. * * Inputs: h - object handle, for storing error messages * statement - query being executed * attribs - statement attributes, currently ignored * num_params - number of parameters being bound * params - parameter array * result - where to store results, if any * svsock - socket connected to the database * **************************************************************************/ my_ulonglong mysql_st_internal_execute( SV *h, /* could be sth or dbh */ SV *statement, SV *attribs, int num_params, imp_sth_ph_t *params, MYSQL_RES **result, MYSQL *svsock, int use_mysql_use_result ) { dTHX; bool bind_type_guessing= FALSE; bool bind_comment_placeholders= TRUE; STRLEN slen; char *sbuf = SvPV(statement, slen); char *table; char *salloc; int htype; int errno; #if MYSQL_ASYNC bool async = FALSE; #endif my_ulonglong rows= 0; /* thank you DBI.c for this info! */ D_imp_xxh(h); attribs= attribs; htype= DBIc_TYPE(imp_xxh); /* It is important to import imp_dbh properly according to the htype that it is! Also, one might ask why bind_type_guessing is assigned in each block. Well, it's because D_imp_ macros called in these blocks make it so imp_dbh is not "visible" or defined outside of the if/else (when compiled, it fails for imp_dbh not being defined). */ /* h is a dbh */ if (htype == DBIt_DB) { D_imp_dbh(h); /* if imp_dbh is not available, it causes segfault (proper) on OpenBSD */ if (imp_dbh && imp_dbh->bind_type_guessing) { bind_type_guessing= imp_dbh->bind_type_guessing; bind_comment_placeholders= bind_comment_placeholders; } #if MYSQL_ASYNC async = (bool) (imp_dbh->async_query_in_flight != NULL); #endif } /* h is a sth */ else { D_imp_sth(h); D_imp_dbh_from_sth; /* if imp_dbh is not available, it causes segfault (proper) on OpenBSD */ if (imp_dbh) { bind_type_guessing= imp_dbh->bind_type_guessing; bind_comment_placeholders= imp_dbh->bind_comment_placeholders; } #if MYSQL_ASYNC async = imp_sth->is_async; if(async) { imp_dbh->async_query_in_flight = imp_sth; } else { imp_dbh->async_query_in_flight = NULL; } #endif } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "mysql_st_internal_execute MYSQL_VERSION_ID %d\n", MYSQL_VERSION_ID ); salloc= parse_params(imp_xxh, aTHX_ svsock, sbuf, &slen, params, num_params, bind_type_guessing, bind_comment_placeholders); if (salloc) { sbuf= salloc; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "Binding parameters: %s\n", sbuf); } if (slen >= 11 && (!strncmp(sbuf, "listfields ", 11) || !strncmp(sbuf, "LISTFIELDS ", 11))) { /* remove pre-space */ slen-= 10; sbuf+= 10; while (slen && isspace(*sbuf)) { --slen; ++sbuf; } if (!slen) { do_error(h, JW_ERR_QUERY, "Missing table name" ,NULL); return -2; } if (!(table= malloc(slen+1))) { do_error(h, JW_ERR_MEM, "Out of memory" ,NULL); return -2; } strncpy(table, sbuf, slen); sbuf= table; while (slen && !isspace(*sbuf)) { --slen; ++sbuf; } *sbuf++= '\0'; *result= mysql_list_fields(svsock, table, NULL); free(table); if (!(*result)) { do_error(h, mysql_errno(svsock), mysql_error(svsock) ,mysql_sqlstate(svsock)); return -2; } return 0; } #if MYSQL_ASYNC if(async) { if((mysql_send_query(svsock, sbuf, slen)) && (!mysql_db_reconnect(h) || (mysql_send_query(svsock, sbuf, slen)))) { rows = -2; } else { rows = 0; } } else { #endif if ((mysql_real_query(svsock, sbuf, slen)) && (!mysql_db_reconnect(h) || (mysql_real_query(svsock, sbuf, slen)))) { rows = -2; } else { /** Store the result from the Query */ *result= use_mysql_use_result ? mysql_use_result(svsock) : mysql_store_result(svsock); if (mysql_errno(svsock)) do_error(h, mysql_errno(svsock), mysql_error(svsock) ,mysql_sqlstate(svsock)); if (!*result) rows= mysql_affected_rows(svsock); else rows= mysql_num_rows(*result); } #if MYSQL_ASYNC } #endif Safefree(salloc); if(rows == -2) { do_error(h, mysql_errno(svsock), mysql_error(svsock), mysql_sqlstate(svsock)); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "IGNORING ERROR errno %d\n", errno); rows = -2; } return(rows); } /************************************************************************** * * Name: mysql_st_internal_execute41 * * Purpose: Internal version for executing a prepared statement, called both * from within the "do" and the "execute" method. * MYSQL 4.1 API * * * Inputs: h - object handle, for storing error messages * statement - query being executed * attribs - statement attributes, currently ignored * num_params - number of parameters being bound * params - parameter array * result - where to store results, if any * svsock - socket connected to the database * **************************************************************************/ #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION my_ulonglong mysql_st_internal_execute41( SV *sth, int num_params, MYSQL_RES **result, MYSQL_STMT *stmt, MYSQL_BIND *bind, int *has_been_bound ) { int i; enum enum_field_types enum_type; dTHX; int execute_retval; my_ulonglong rows=0; D_imp_xxh(sth); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t-> mysql_st_internal_execute41\n"); /* free result if exists */ if (*result) { mysql_free_result(*result); *result= 0; } /* If were performed any changes with ph variables we have to rebind them */ if (num_params > 0 && !(*has_been_bound)) { if (mysql_stmt_bind_param(stmt,bind)) goto error; *has_been_bound= 1; } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tmysql_st_internal_execute41 calling mysql_execute with %d num_params\n", num_params); execute_retval= mysql_stmt_execute(stmt); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tmysql_stmt_execute returned %d\n", execute_retval); if (execute_retval) goto error; /* This statement does not return a result set (INSERT, UPDATE...) */ if (!(*result= mysql_stmt_result_metadata(stmt))) { if (mysql_stmt_errno(stmt)) goto error; rows= mysql_stmt_affected_rows(stmt); } /* This statement returns a result set (SELECT...) */ else { for (i = mysql_stmt_field_count(stmt) - 1; i >=0; --i) { enum_type = mysql_to_perl_type(stmt->fields[i].type); if (enum_type != MYSQL_TYPE_DOUBLE && enum_type != MYSQL_TYPE_LONG) { /* mysql_stmt_store_result to update MYSQL_FIELD->max_length */ my_bool on = 1; mysql_stmt_attr_set(stmt, STMT_ATTR_UPDATE_MAX_LENGTH, &on); break; } } /* Get the total rows affected and return */ if (mysql_stmt_store_result(stmt)) goto error; else rows= mysql_stmt_num_rows(stmt); } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- mysql_internal_execute_41 returning %d rows\n", (int) rows); return(rows); error: if (*result) { mysql_free_result(*result); *result= 0; } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " errno %d err message %s\n", mysql_stmt_errno(stmt), mysql_stmt_error(stmt)); do_error(sth, mysql_stmt_errno(stmt), mysql_stmt_error(stmt), mysql_stmt_sqlstate(stmt)); mysql_stmt_reset(stmt); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- mysql_st_internal_execute41\n"); return -2; } #endif /*************************************************************************** * * Name: dbd_st_execute * * Purpose: Called for preparing an SQL statement; our part of the * statement handle constructor * * Input: sth - statement handle being initialized * imp_sth - drivers private statement handle data * * Returns: TRUE for success, FALSE otherwise; do_error will * be called in the latter case * **************************************************************************/ int dbd_st_execute(SV* sth, imp_sth_t* imp_sth) { dTHX; char actual_row_num[64]; int i; SV **statement; D_imp_dbh_from_sth; D_imp_xxh(sth); #if defined (dTHR) dTHR; #endif ASYNC_CHECK_RETURN(sth, -2); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " -> dbd_st_execute for %08lx\n", (u_long) sth); if (!SvROK(sth) || SvTYPE(SvRV(sth)) != SVt_PVHV) croak("Expected hash array"); /* Free cached array attributes */ for (i= 0; i < AV_ATTRIB_LAST; i++) { if (imp_sth->av_attr[i]) SvREFCNT_dec(imp_sth->av_attr[i]); imp_sth->av_attr[i]= Nullav; } statement= hv_fetch((HV*) SvRV(sth), "Statement", 9, FALSE); /* Clean-up previous result set(s) for sth to prevent 'Commands out of sync' error */ mysql_st_free_result_sets (sth, imp_sth); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare && ! imp_sth->use_mysql_use_result) { imp_sth->row_num= mysql_st_internal_execute41( sth, DBIc_NUM_PARAMS(imp_sth), &imp_sth->result, imp_sth->stmt, imp_sth->bind, &imp_sth->has_been_bound ); } else { #endif imp_sth->row_num= mysql_st_internal_execute( sth, *statement, NULL, DBIc_NUM_PARAMS(imp_sth), imp_sth->params, &imp_sth->result, imp_dbh->pmysql, imp_sth->use_mysql_use_result ); #if MYSQL_ASYNC if(imp_dbh->async_query_in_flight) { DBIc_ACTIVE_on(imp_sth); return 0; } #endif } if (imp_sth->row_num+1 != (my_ulonglong)-1) { if (!imp_sth->result) { imp_sth->insertid= mysql_insert_id(imp_dbh->pmysql); #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION if (mysql_more_results(imp_dbh->pmysql)) DBIc_ACTIVE_on(imp_sth); #endif } else { /** Store the result in the current statement handle */ DBIc_NUM_FIELDS(imp_sth)= mysql_num_fields(imp_sth->result); DBIc_ACTIVE_on(imp_sth); if (!imp_sth->use_server_side_prepare) imp_sth->done_desc= 0; imp_sth->fetch_done= 0; } } imp_sth->warning_count = mysql_warning_count(imp_dbh->pmysql); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { /* PerlIO_printf doesn't always handle imp_sth->row_num %llu consistantly!! */ sprintf(actual_row_num, "%llu", imp_sth->row_num); PerlIO_printf(DBIc_LOGPIO(imp_xxh), " <- dbd_st_execute returning imp_sth->row_num %s\n", actual_row_num); } return (int)imp_sth->row_num; } /************************************************************************** * * Name: dbd_describe * * Purpose: Called from within the fetch method to describe the result * * Input: sth - statement handle being initialized * imp_sth - our part of the statement handle, there's no * need for supplying both; Tim just doesn't remove it * * Returns: TRUE for success, FALSE otherwise; do_error will * be called in the latter case * **************************************************************************/ int dbd_describe(SV* sth, imp_sth_t* imp_sth) { dTHX; D_imp_xxh(sth); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t--> dbd_describe\n"); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare) { int i; int col_type; int num_fields= DBIc_NUM_FIELDS(imp_sth); imp_sth_fbh_t *fbh; MYSQL_BIND *buffer; MYSQL_FIELD *fields; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tdbd_describe() num_fields %d\n", num_fields); if (imp_sth->done_desc) return TRUE; if (!num_fields || !imp_sth->result) { /* no metadata */ do_error(sth, JW_ERR_SEQUENCE, "no metadata information while trying describe result set", NULL); return 0; } /* allocate fields buffers */ if ( !(imp_sth->fbh= alloc_fbuffer(num_fields)) || !(imp_sth->buffer= alloc_bind(num_fields)) ) { /* Out of memory */ do_error(sth, JW_ERR_SEQUENCE, "Out of memory in dbd_sescribe()",NULL); return 0; } fields= mysql_fetch_fields(imp_sth->result); for ( fbh= imp_sth->fbh, buffer= (MYSQL_BIND*)imp_sth->buffer, i= 0; i < num_fields; i++, fbh++, buffer++ ) { /* get the column type */ col_type = fields ? fields[i].type : MYSQL_TYPE_STRING; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh),"\t\ti %d col_type %d fbh->length %d\n", i, col_type, (int) fbh->length); PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tfields[i].length %lu fields[i].max_length %lu fields[i].type %d fields[i].charsetnr %d\n", (long unsigned int) fields[i].length, (long unsigned int) fields[i].max_length, fields[i].type, fields[i].charsetnr); } fbh->charsetnr = fields[i].charsetnr; #if MYSQL_VERSION_ID < FIELD_CHARSETNR_VERSION fbh->flags = fields[i].flags; #endif buffer->buffer_type= mysql_to_perl_type(col_type); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tmysql_to_perl_type returned %d\n", col_type); buffer->length= &(fbh->length); buffer->is_null= &(fbh->is_null); switch (buffer->buffer_type) { case MYSQL_TYPE_DOUBLE: buffer->buffer_length= sizeof(fbh->ddata); buffer->buffer= (char*) &fbh->ddata; break; case MYSQL_TYPE_LONG: buffer->buffer_length= sizeof(fbh->ldata); buffer->buffer= (char*) &fbh->ldata; buffer->is_unsigned= (fields[i].flags & UNSIGNED_FLAG) ? 1 : 0; break; default: buffer->buffer_length= fields[i].max_length ? fields[i].max_length : 1; Newz(908, fbh->data, buffer->buffer_length, char); buffer->buffer= (char *) fbh->data; } } if (mysql_stmt_bind_result(imp_sth->stmt, imp_sth->buffer)) { do_error(sth, mysql_stmt_errno(imp_sth->stmt), mysql_stmt_error(imp_sth->stmt), mysql_stmt_sqlstate(imp_sth->stmt)); return 0; } } #endif imp_sth->done_desc= 1; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_describe\n"); return TRUE; } /************************************************************************** * * Name: dbd_st_fetch * * Purpose: Called for fetching a result row * * Input: sth - statement handle being initialized * imp_sth - drivers private statement handle data * * Returns: array of columns; the array is allocated by DBI via * DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth), even the values * of the array are prepared, we just need to modify them * appropriately * **************************************************************************/ AV* dbd_st_fetch(SV *sth, imp_sth_t* imp_sth) { dTHX; int num_fields, ChopBlanks, i, rc; unsigned long *lengths; AV *av; int av_length, av_readonly; MYSQL_ROW cols; D_imp_dbh_from_sth; MYSQL* svsock= imp_dbh->pmysql; imp_sth_fbh_t *fbh; D_imp_xxh(sth); #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION MYSQL_BIND *buffer; #endif MYSQL_FIELD *fields; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t-> dbd_st_fetch\n"); #if MYSQL_ASYNC if(imp_dbh->async_query_in_flight) { if(mysql_db_async_result(sth, &imp_sth->result) <= 0) { return Nullav; } } #endif #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare) { if (!DBIc_ACTIVE(imp_sth) ) { do_error(sth, JW_ERR_SEQUENCE, "no statement executing\n",NULL); return Nullav; } if (imp_sth->fetch_done) { do_error(sth, JW_ERR_SEQUENCE, "fetch() but fetch already done",NULL); return Nullav; } if (!imp_sth->done_desc) { if (!dbd_describe(sth, imp_sth)) { do_error(sth, JW_ERR_SEQUENCE, "Error while describe result set.", NULL); return Nullav; } } } #endif ChopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tdbd_st_fetch for %08lx, chopblanks %d\n", (u_long) sth, ChopBlanks); if (!imp_sth->result) { do_error(sth, JW_ERR_SEQUENCE, "fetch() without execute()" ,NULL); return Nullav; } /* fix from 2.9008 */ imp_dbh->pmysql->net.last_errno = 0; #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tdbd_st_fetch calling mysql_fetch\n"); if ((rc= mysql_stmt_fetch(imp_sth->stmt))) { if (rc == 1) do_error(sth, mysql_stmt_errno(imp_sth->stmt), mysql_stmt_error(imp_sth->stmt), mysql_stmt_sqlstate(imp_sth->stmt)); #if MYSQL_VERSION_ID >= MYSQL_VERSION_5_0 if (rc == MYSQL_DATA_TRUNCATED) if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tdbd_st_fetch data truncated\n"); #endif if (rc == MYSQL_NO_DATA) { /* Update row_num to affected_rows value */ imp_sth->row_num= mysql_stmt_affected_rows(imp_sth->stmt); imp_sth->fetch_done=1; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tdbd_st_fetch no data\n"); } dbd_st_finish(sth, imp_sth); return Nullav; } imp_sth->currow++; av= DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth); num_fields=mysql_stmt_field_count(imp_sth->stmt); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tdbd_st_fetch called mysql_fetch, rc %d num_fields %d\n", rc, num_fields); for ( buffer= imp_sth->buffer, fbh= imp_sth->fbh, i= 0; i < num_fields; i++, fbh++, buffer++ ) { SV *sv= AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */ STRLEN len; /* This is wrong, null is not being set correctly * This is not the way to determine length (this would break blobs!) */ if (fbh->is_null) (void) SvOK_off(sv); /* Field is NULL, return undef */ else { /* In case of BLOB/TEXT fields we allocate only 8192 bytes in dbd_describe() for data. Here we know real size of field so we should increase buffer size and refetch column value */ if (fbh->length > buffer->buffer_length) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh),"\t\tRefetch BLOB/TEXT column: %d\n", i); Renew(fbh->data, fbh->length, char); buffer->buffer_length= fbh->length; buffer->buffer= (char *) fbh->data; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh),"\t\tbuffer->buffer: %s\n", (char *) buffer->buffer); /*TODO: Use offset instead of 0 to fetch only remain part of data*/ if (mysql_stmt_fetch_column(imp_sth->stmt, buffer , i, 0)) do_error(sth, mysql_stmt_errno(imp_sth->stmt), mysql_stmt_error(imp_sth->stmt), mysql_stmt_sqlstate(imp_sth->stmt)); } /* This does look a lot like Georg's PHP driver doesn't it? --Brian */ /* Credit due to Georg - mysqli_api.c ;) --PMG */ switch (buffer->buffer_type) { case MYSQL_TYPE_DOUBLE: if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tst_fetch double data %f\n", fbh->ddata); sv_setnv(sv, fbh->ddata); break; case MYSQL_TYPE_LONG: if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tst_fetch int data %d, unsigned? %d\n", (int) fbh->ldata, buffer->is_unsigned); if (buffer->is_unsigned) sv_setuv(sv, fbh->ldata); else sv_setiv(sv, fbh->ldata); break; default: if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tERROR IN st_fetch_string"); len= fbh->length; /* ChopBlanks server-side prepared statement */ if (ChopBlanks) { /* see bottom of: http://www.mysql.org/doc/refman/5.0/en/c-api-datatypes.html */ if (fbh->charsetnr != 63) while (len && fbh->data[len-1] == ' ') { --len; } } /* END OF ChopBlanks */ sv_setpvn(sv, fbh->data, len); /* UTF8 */ /*HELMUT*/ #if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION #if MYSQL_VERSION_ID >= FIELD_CHARSETNR_VERSION /* see bottom of: http://www.mysql.org/doc/refman/5.0/en/c-api-datatypes.html */ if (imp_dbh->enable_utf8 && fbh->charsetnr != 63) #else if (imp_dbh->enable_utf8 && !(fbh->flags & BINARY_FLAG)) #endif sv_utf8_decode(sv); #endif /* END OF UTF8 */ break; } } } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_fetch, %d cols\n", num_fields); return av; } else { #endif imp_sth->currow++; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tdbd_st_fetch result set details\n"); PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\timp_sth->result=%08lx\n",(long unsigned int) imp_sth->result); PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tmysql_num_fields=%llu\n", (long long unsigned int) mysql_num_fields(imp_sth->result)); PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tmysql_num_rows=%llu\n", mysql_num_rows(imp_sth->result)); PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tmysql_affected_rows=%llu\n", mysql_affected_rows(imp_dbh->pmysql)); PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tdbd_st_fetch for %08lx, currow= %d\n", (u_long) sth,imp_sth->currow); } if (!(cols= mysql_fetch_row(imp_sth->result))) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tdbd_st_fetch, no more rows to fetch"); } if (mysql_errno(imp_dbh->pmysql)) do_error(sth, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql), mysql_sqlstate(imp_dbh->pmysql)); #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION if (!mysql_more_results(svsock)) #endif dbd_st_finish(sth, imp_sth); return Nullav; } num_fields= mysql_num_fields(imp_sth->result); fields= mysql_fetch_fields(imp_sth->result); lengths= mysql_fetch_lengths(imp_sth->result); if ((av= DBIc_FIELDS_AV(imp_sth)) != Nullav) { av_length= av_len(av)+1; if (av_length != num_fields) /* Resize array if necessary */ { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_fetch, size of results array(%d) != num_fields(%d)\n", av_length, num_fields); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_fetch, result fields(%d)\n", DBIc_NUM_FIELDS(imp_sth)); av_readonly = SvREADONLY(av); if (av_readonly) SvREADONLY_off( av ); /* DBI sets this readonly */ while (av_length < num_fields) { av_store(av, av_length++, newSV(0)); } while (av_length > num_fields) { SvREFCNT_dec(av_pop(av)); av_length--; } if (av_readonly) SvREADONLY_on(av); } } av= DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth); for (i= 0; i < num_fields; ++i) { char *col= cols[i]; SV *sv= AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */ if (col) { STRLEN len= lengths[i]; if (ChopBlanks) { while (len && col[len-1] == ' ') { --len; } } sv_setpvn(sv, col, len); /* UTF8 */ /*HELMUT*/ #if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION /* see bottom of: http://www.mysql.org/doc/refman/5.0/en/c-api-datatypes.html */ if (imp_dbh->enable_utf8 && fields[i].charsetnr != 63) sv_utf8_decode(sv); #endif /* END OF UTF8 */ } else (void) SvOK_off(sv); /* Field is NULL, return undef */ } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t<- dbd_st_fetch, %d cols\n", num_fields); return av; #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION } #endif } #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION /* We have to fetch all data from stmt There is may be usefull for 2 cases: 1. st_finish when we have undef statement 2. call st_execute again when we have some unfetched data in stmt */ int mysql_st_clean_cursor(SV* sth, imp_sth_t* imp_sth) { if (DBIc_ACTIVE(imp_sth) && dbd_describe(sth, imp_sth) && !imp_sth->fetch_done) mysql_stmt_free_result(imp_sth->stmt); return 1; } #endif /*************************************************************************** * * Name: dbd_st_finish * * Purpose: Called for freeing a mysql result * * Input: sth - statement handle being finished * imp_sth - drivers private statement handle data * * Returns: TRUE for success, FALSE otherwise; do_error() will * be called in the latter case * **************************************************************************/ int dbd_st_finish(SV* sth, imp_sth_t* imp_sth) { dTHX; D_imp_xxh(sth); #if defined (dTHR) dTHR; #endif #if MYSQL_ASYNC D_imp_dbh_from_sth; if(imp_dbh->async_query_in_flight) { mysql_db_async_result(sth, &imp_sth->result); } #endif #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\n--> dbd_st_finish\n"); } if (imp_sth->use_server_side_prepare) { if (imp_sth && imp_sth->stmt) { if (!mysql_st_clean_cursor(sth, imp_sth)) { do_error(sth, JW_ERR_SEQUENCE, "Error happened while tried to clean up stmt",NULL); return 0; } } } #endif /* Cancel further fetches from this cursor. We don't close the cursor till DESTROY. The application may re execute it. */ if (imp_sth && DBIc_ACTIVE(imp_sth)) { /* Clean-up previous result set(s) for sth to prevent 'Commands out of sync' error */ mysql_st_free_result_sets(sth, imp_sth); } DBIc_ACTIVE_off(imp_sth); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) { PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\n<-- dbd_st_finish\n"); } return 1; } /************************************************************************** * * Name: dbd_st_destroy * * Purpose: Our part of the statement handles destructor * * Input: sth - statement handle being destroyed * imp_sth - drivers private statement handle data * * Returns: Nothing * **************************************************************************/ void dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) { dTHX; D_imp_xxh(sth); #if defined (dTHR) dTHR; #endif int i; #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION imp_sth_fbh_t *fbh; int n; n= DBIc_NUM_PARAMS(imp_sth); if (n) { if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\tFreeing %d parameters, bind %p fbind %p\n", n, imp_sth->bind, imp_sth->fbind); free_bind(imp_sth->bind); free_fbind(imp_sth->fbind); } fbh= imp_sth->fbh; if (fbh) { n = DBIc_NUM_FIELDS(imp_sth); i = 0; while (i < n) { if (fbh[i].data) Safefree(fbh[i].data); ++i; } free_fbuffer(fbh); if (imp_sth->buffer) free_bind(imp_sth->buffer); } if (imp_sth->stmt) { if (mysql_stmt_close(imp_sth->stmt)) { do_error(DBIc_PARENT_H(imp_sth), mysql_stmt_errno(imp_sth->stmt), mysql_stmt_error(imp_sth->stmt), mysql_stmt_sqlstate(imp_sth->stmt)); } } #endif /* dbd_st_finish has already been called by .xs code if needed. */ /* Free values allocated by dbd_bind_ph */ if (imp_sth->params) { free_param(aTHX_ imp_sth->params, DBIc_NUM_PARAMS(imp_sth)); imp_sth->params= NULL; } /* Free cached array attributes */ for (i= 0; i < AV_ATTRIB_LAST; i++) { if (imp_sth->av_attr[i]) SvREFCNT_dec(imp_sth->av_attr[i]); imp_sth->av_attr[i]= Nullav; } /* let DBI know we've done it */ DBIc_IMPSET_off(imp_sth); } /* ************************************************************************** * * Name: dbd_st_STORE_attrib * * Purpose: Modifies a statement handles attributes; we currently * support just nothing * * Input: sth - statement handle being destroyed * imp_sth - drivers private statement handle data * keysv - attribute name * valuesv - attribute value * * Returns: TRUE for success, FALSE otrherwise; do_error will * be called in the latter case * **************************************************************************/ int dbd_st_STORE_attrib( SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv ) { dTHX; STRLEN(kl); char *key= SvPV(keysv, kl); int retval= FALSE; D_imp_xxh(sth); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\t-> dbd_st_STORE_attrib for %08lx, key %s\n", (u_long) sth, key); if (strEQ(key, "mysql_use_result")) { imp_sth->use_mysql_use_result= SvTRUE(valuesv); } if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\t<- dbd_st_STORE_attrib for %08lx, result %d\n", (u_long) sth, retval); return retval; } /* ************************************************************************** * * Name: dbd_st_FETCH_internal * * Purpose: Retrieves a statement handles array attributes; we use * a separate function, because creating the array * attributes shares much code and it aids in supporting * enhanced features like caching. * * Input: sth - statement handle; may even be a database handle, * in which case this will be used for storing error * messages only. This is only valid, if cacheit (the * last argument) is set to TRUE. * what - internal attribute number * res - pointer to a DBMS result * cacheit - TRUE, if results may be cached in the sth. * * Returns: RV pointing to result array in case of success, NULL * otherwise; do_error has already been called in the latter * case. * **************************************************************************/ #ifndef IS_KEY #define IS_KEY(A) (((A) & (PRI_KEY_FLAG | UNIQUE_KEY_FLAG | MULTIPLE_KEY_FLAG)) != 0) #endif #if !defined(IS_AUTO_INCREMENT) && defined(AUTO_INCREMENT_FLAG) #define IS_AUTO_INCREMENT(A) (((A) & AUTO_INCREMENT_FLAG) != 0) #endif SV* dbd_st_FETCH_internal( SV *sth, int what, MYSQL_RES *res, int cacheit ) { dTHX; D_imp_sth(sth); AV *av= Nullav; MYSQL_FIELD *curField; /* Are we asking for a legal value? */ if (what < 0 || what >= AV_ATTRIB_LAST) do_error(sth, JW_ERR_NOT_IMPLEMENTED, "Not implemented", NULL); /* Return cached value, if possible */ else if (cacheit && imp_sth->av_attr[what]) av= imp_sth->av_attr[what]; /* Does this sth really have a result? */ else if (!res) do_error(sth, JW_ERR_NOT_ACTIVE, "statement contains no result" ,NULL); /* Do the real work. */ else { av= newAV(); mysql_field_seek(res, 0); while ((curField= mysql_fetch_field(res))) { SV *sv; switch(what) { case AV_ATTRIB_NAME: sv= newSVpv(curField->name, strlen(curField->name)); break; case AV_ATTRIB_TABLE: sv= newSVpv(curField->table, strlen(curField->table)); break; case AV_ATTRIB_TYPE: sv= newSViv((int) curField->type); break; case AV_ATTRIB_SQL_TYPE: sv= newSViv((int) native2sql(curField->type)->data_type); break; case AV_ATTRIB_IS_PRI_KEY: sv= boolSV(IS_PRI_KEY(curField->flags)); break; case AV_ATTRIB_IS_NOT_NULL: sv= boolSV(IS_NOT_NULL(curField->flags)); break; case AV_ATTRIB_NULLABLE: sv= boolSV(!IS_NOT_NULL(curField->flags)); break; case AV_ATTRIB_LENGTH: sv= newSViv((int) curField->length); break; case AV_ATTRIB_IS_NUM: sv= newSViv((int) native2sql(curField->type)->is_num); break; case AV_ATTRIB_TYPE_NAME: sv= newSVpv((char*) native2sql(curField->type)->type_name, 0); break; case AV_ATTRIB_MAX_LENGTH: sv= newSViv((int) curField->max_length); break; case AV_ATTRIB_IS_AUTO_INCREMENT: #if defined(AUTO_INCREMENT_FLAG) sv= boolSV(IS_AUTO_INCREMENT(curField->flags)); break; #else croak("AUTO_INCREMENT_FLAG is not supported on this machine"); #endif case AV_ATTRIB_IS_KEY: sv= boolSV(IS_KEY(curField->flags)); break; case AV_ATTRIB_IS_BLOB: sv= boolSV(IS_BLOB(curField->flags)); break; case AV_ATTRIB_SCALE: sv= newSViv((int) curField->decimals); break; case AV_ATTRIB_PRECISION: sv= newSViv((int) (curField->length > curField->max_length) ? curField->length : curField->max_length); break; default: sv= &PL_sv_undef; break; } av_push(av, sv); } /* Ensure that this value is kept, decremented in * dbd_st_destroy and dbd_st_execute. */ if (!cacheit) return sv_2mortal(newRV_noinc((SV*)av)); imp_sth->av_attr[what]= av; } if (av == Nullav) return &PL_sv_undef; return sv_2mortal(newRV_inc((SV*)av)); } /* ************************************************************************** * * Name: dbd_st_FETCH_attrib * * Purpose: Retrieves a statement handles attributes * * Input: sth - statement handle being destroyed * imp_sth - drivers private statement handle data * keysv - attribute name * * Returns: NULL for an unknown attribute, "undef" for error, * attribute value otherwise. * **************************************************************************/ #define ST_FETCH_AV(what) \ dbd_st_FETCH_internal(sth, (what), imp_sth->result, TRUE) SV* dbd_st_FETCH_attrib( SV *sth, imp_sth_t *imp_sth, SV *keysv ) { dTHX; STRLEN(kl); char *key= SvPV(keysv, kl); SV *retsv= Nullsv; D_imp_xxh(sth); if (kl < 2) return Nullsv; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " -> dbd_st_FETCH_attrib for %08lx, key %s\n", (u_long) sth, key); switch (*key) { case 'N': if (strEQ(key, "NAME")) retsv= ST_FETCH_AV(AV_ATTRIB_NAME); else if (strEQ(key, "NULLABLE")) retsv= ST_FETCH_AV(AV_ATTRIB_NULLABLE); break; case 'P': if (strEQ(key, "PRECISION")) retsv= ST_FETCH_AV(AV_ATTRIB_PRECISION); if (strEQ(key, "ParamValues")) { HV *pvhv= newHV(); if (DBIc_NUM_PARAMS(imp_sth)) { int n; char key[100]; I32 keylen; for (n= 0; n < DBIc_NUM_PARAMS(imp_sth); n++) { keylen= sprintf(key, "%d", n); hv_store(pvhv, key, keylen, newSVsv(imp_sth->params[n].value), 0); } } retsv= newRV_noinc((SV*)pvhv); } break; case 'S': if (strEQ(key, "SCALE")) retsv= ST_FETCH_AV(AV_ATTRIB_SCALE); break; case 'T': if (strEQ(key, "TYPE")) retsv= ST_FETCH_AV(AV_ATTRIB_SQL_TYPE); break; case 'm': switch (kl) { case 10: if (strEQ(key, "mysql_type")) retsv= ST_FETCH_AV(AV_ATTRIB_TYPE); break; case 11: if (strEQ(key, "mysql_table")) retsv= ST_FETCH_AV(AV_ATTRIB_TABLE); break; case 12: if ( strEQ(key, "mysql_is_key")) retsv= ST_FETCH_AV(AV_ATTRIB_IS_KEY); else if (strEQ(key, "mysql_is_num")) retsv= ST_FETCH_AV(AV_ATTRIB_IS_NUM); else if (strEQ(key, "mysql_length")) retsv= ST_FETCH_AV(AV_ATTRIB_LENGTH); else if (strEQ(key, "mysql_result")) retsv= sv_2mortal(newSViv((IV) imp_sth->result)); break; case 13: if (strEQ(key, "mysql_is_blob")) retsv= ST_FETCH_AV(AV_ATTRIB_IS_BLOB); break; case 14: if (strEQ(key, "mysql_insertid")) { /* We cannot return an IV, because the insertid is a long. */ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "INSERT ID %d\n", (int) imp_sth->insertid); return sv_2mortal(my_ulonglong2str(aTHX_ imp_sth->insertid)); } break; case 15: if (strEQ(key, "mysql_type_name")) retsv = ST_FETCH_AV(AV_ATTRIB_TYPE_NAME); break; case 16: if ( strEQ(key, "mysql_is_pri_key")) retsv= ST_FETCH_AV(AV_ATTRIB_IS_PRI_KEY); else if (strEQ(key, "mysql_max_length")) retsv= ST_FETCH_AV(AV_ATTRIB_MAX_LENGTH); else if (strEQ(key, "mysql_use_result")) retsv= boolSV(imp_sth->use_mysql_use_result); break; case 19: if (strEQ(key, "mysql_warning_count")) retsv= sv_2mortal(newSViv((IV) imp_sth->warning_count)); break; case 20: if (strEQ(key, "mysql_server_prepare")) #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION retsv= sv_2mortal(newSViv((IV) imp_sth->use_server_side_prepare)); #else retsv= boolSV(0); #endif break; case 23: if (strEQ(key, "mysql_is_auto_increment")) retsv = ST_FETCH_AV(AV_ATTRIB_IS_AUTO_INCREMENT); break; } break; } return retsv; } /*************************************************************************** * * Name: dbd_st_blob_read * * Purpose: Used for blob reads if the statement handles "LongTruncOk" * attribute (currently not supported by DBD::mysql) * * Input: SV* - statement handle from which a blob will be fetched * imp_sth - drivers private statement handle data * field - field number of the blob (note, that a row may * contain more than one blob) * offset - the offset of the field, where to start reading * len - maximum number of bytes to read * destrv - RV* that tells us where to store * destoffset - destination offset * * Returns: TRUE for success, FALSE otrherwise; do_error will * be called in the latter case * **************************************************************************/ int dbd_st_blob_read ( SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, SV *destrv, long destoffset) { /* quell warnings */ sth= sth; imp_sth=imp_sth; field= field; offset= offset; len= len; destrv= destrv; destoffset= destoffset; return FALSE; } /*************************************************************************** * * Name: dbd_bind_ph * * Purpose: Binds a statement value to a parameter * * Input: sth - statement handle * imp_sth - drivers private statement handle data * param - parameter number, counting starts with 1 * value - value being inserted for parameter "param" * sql_type - SQL type of the value * attribs - bind parameter attributes, currently this must be * one of the values SQL_CHAR, ... * inout - TRUE, if parameter is an output variable (currently * this is not supported) * maxlen - ??? * * Returns: TRUE for success, FALSE otherwise * **************************************************************************/ int dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *param, SV *value, IV sql_type, SV *attribs, int is_inout, IV maxlen) { dTHX; int rc; int param_num= SvIV(param); int idx= param_num - 1; char err_msg[64]; D_imp_xxh(sth); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION STRLEN slen; char *buffer= NULL; int buffer_is_null= 0; int buffer_length= slen; unsigned int buffer_type= 0; #endif D_imp_dbh_from_sth; ASYNC_CHECK_RETURN(sth, FALSE); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " Called: dbd_bind_ph\n"); attribs= attribs; maxlen= maxlen; if (param_num <= 0 || param_num > DBIc_NUM_PARAMS(imp_sth)) { do_error(sth, JW_ERR_ILLEGAL_PARAM_NUM, "Illegal parameter number", NULL); return FALSE; } /* This fixes the bug whereby no warning was issued upone binding a defined non-numeric as numeric */ if (SvOK(value) && (sql_type == SQL_NUMERIC || sql_type == SQL_DECIMAL || sql_type == SQL_INTEGER || sql_type == SQL_SMALLINT || sql_type == SQL_FLOAT || sql_type == SQL_REAL || sql_type == SQL_DOUBLE) ) { if (! looks_like_number(value)) { sprintf(err_msg, "Binding non-numeric field %d, value %s as a numeric!", param_num, neatsvpv(value,0)); do_error(sth, JW_ERR_ILLEGAL_PARAM_NUM, err_msg, NULL); } } if (is_inout) { do_error(sth, JW_ERR_NOT_IMPLEMENTED, "Output parameters not implemented", NULL); return FALSE; } rc = bind_param(&imp_sth->params[idx], value, sql_type); #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION if (imp_sth->use_server_side_prepare) { switch(sql_type) { case SQL_NUMERIC: case SQL_INTEGER: case SQL_SMALLINT: case SQL_BIGINT: case SQL_TINYINT: buffer_type= MYSQL_TYPE_LONG; break; case SQL_DOUBLE: case SQL_DECIMAL: case SQL_FLOAT: case SQL_REAL: buffer_type= MYSQL_TYPE_DOUBLE; break; case SQL_CHAR: case SQL_VARCHAR: case SQL_DATE: case SQL_TIME: case SQL_TIMESTAMP: case SQL_LONGVARCHAR: case SQL_BINARY: case SQL_VARBINARY: case SQL_LONGVARBINARY: buffer_type= MYSQL_TYPE_BLOB; break; default: buffer_type= MYSQL_TYPE_STRING; } buffer_is_null = !(SvOK(imp_sth->params[idx].value) && imp_sth->params[idx].value); if (! buffer_is_null) { switch(buffer_type) { case MYSQL_TYPE_LONG: /* INT */ if (!SvIOK(imp_sth->params[idx].value) && DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tTRY TO BIND AN INT NUMBER\n"); buffer_length = sizeof imp_sth->fbind[idx].numeric_val.lval; imp_sth->fbind[idx].numeric_val.lval= SvIV(imp_sth->params[idx].value); buffer=(void*)&(imp_sth->fbind[idx].numeric_val.lval); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " SCALAR type %d ->%ld<- IS A INT NUMBER\n", (int) sql_type, (long) (*buffer)); break; case MYSQL_TYPE_DOUBLE: if (!SvNOK(imp_sth->params[idx].value) && DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tTRY TO BIND A FLOAT NUMBER\n"); buffer_length = sizeof imp_sth->fbind[idx].numeric_val.dval; imp_sth->fbind[idx].numeric_val.dval= SvNV(imp_sth->params[idx].value); buffer=(char*)&(imp_sth->fbind[idx].numeric_val.dval); if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " SCALAR type %d ->%f<- IS A FLOAT NUMBER\n", (int) sql_type, (double)(*buffer)); break; case MYSQL_TYPE_BLOB: if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " SCALAR type BLOB\n"); break; case MYSQL_TYPE_STRING: if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " SCALAR type STRING %d, buffertype=%d\n", (int) sql_type, buffer_type); break; default: croak("Bug in DBD::Mysql file dbdimp.c#dbd_bind_ph: do not know how to handle unknown buffer type."); } if (buffer_type == MYSQL_TYPE_STRING || buffer_type == MYSQL_TYPE_BLOB) { buffer= SvPV(imp_sth->params[idx].value, slen); buffer_length= slen; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " SCALAR type %d ->length %d<- IS A STRING or BLOB\n", (int) sql_type, buffer_length); } } else { /*case: buffer_is_null != 0*/ buffer= NULL; if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " SCALAR NULL VALUE: buffer type is: %d\n", buffer_type); } /* Type of column was changed. Force to rebind */ if (imp_sth->bind[idx].buffer_type != buffer_type) { /* Note: this looks like being another bug: * if type of parameter N changes, then a bind is triggered * with an only partially filled bind structure ?? */ if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " FORCE REBIND: buffer type changed from %d to %d, sql-type=%d\n", (int) imp_sth->bind[idx].buffer_type, buffer_type, (int) sql_type); imp_sth->has_been_bound = 0; } /* prepare has not been called */ if (imp_sth->has_been_bound == 0) { imp_sth->bind[idx].buffer_type= buffer_type; imp_sth->bind[idx].buffer= buffer; imp_sth->bind[idx].buffer_length= buffer_length; } else /* prepare has been called */ { imp_sth->stmt->params[idx].buffer= buffer; imp_sth->stmt->params[idx].buffer_length= buffer_length; } imp_sth->fbind[idx].length= buffer_length; imp_sth->fbind[idx].is_null= buffer_is_null; } #endif return rc; } /*************************************************************************** * * Name: mysql_db_reconnect * * Purpose: If the server has disconnected, try to reconnect. * * Input: h - database or statement handle * * Returns: TRUE for success, FALSE otherwise * **************************************************************************/ int mysql_db_reconnect(SV* h) { dTHX; D_imp_xxh(h); imp_dbh_t* imp_dbh; MYSQL save_socket; if (DBIc_TYPE(imp_xxh) == DBIt_ST) { imp_dbh = (imp_dbh_t*) DBIc_PARENT_COM(imp_xxh); h = DBIc_PARENT_H(imp_xxh); } else imp_dbh= (imp_dbh_t*) imp_xxh; if (mysql_errno(imp_dbh->pmysql) != CR_SERVER_GONE_ERROR) /* Other error */ return FALSE; if (!DBIc_has(imp_dbh, DBIcf_AutoCommit) || !imp_dbh->auto_reconnect) { /* We never reconnect if AutoCommit is turned off. * Otherwise we might get an inconsistent transaction * state. */ return FALSE; } /* my_login will blow away imp_dbh->mysql so we save a copy of * imp_dbh->mysql and put it back where it belongs if the reconnect * fail. Think server is down & reconnect fails but the application eval{}s * the execute, so next time $dbh->quote() gets called, instant SIGSEGV! */ save_socket= *(imp_dbh->pmysql); memcpy (&save_socket, imp_dbh->pmysql,sizeof(save_socket)); memset (imp_dbh->pmysql,0,sizeof(*(imp_dbh->pmysql))); /* we should disconnect the db handle before reconnecting, this will * prevent my_login from thinking it's adopting an active child which * would prevent the handle from actually reconnecting */ if (!dbd_db_disconnect(h, imp_dbh) || !my_login(aTHX_ h, imp_dbh)) { do_error(h, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql), mysql_sqlstate(imp_dbh->pmysql)); memcpy (imp_dbh->pmysql, &save_socket, sizeof(save_socket)); ++imp_dbh->stats.auto_reconnects_failed; return FALSE; } /* * Tell DBI, that dbh->disconnect should be called for this handle */ DBIc_ACTIVE_on(imp_dbh); ++imp_dbh->stats.auto_reconnects_ok; return TRUE; } /************************************************************************** * * Name: dbd_db_type_info_all * * Purpose: Implements $dbh->type_info_all * * Input: dbh - database handle * imp_sth - drivers private database handle data * * Returns: RV to AV of types * **************************************************************************/ #define PV_PUSH(c) \ if (c) { \ sv= newSVpv((char*) (c), 0); \ SvREADONLY_on(sv); \ } else { \ sv= &PL_sv_undef; \ } \ av_push(row, sv); #define IV_PUSH(i) sv= newSViv((i)); SvREADONLY_on(sv); av_push(row, sv); AV *dbd_db_type_info_all(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; AV *av= newAV(); AV *row; HV *hv; SV *sv; int i; const char *cols[] = { "TYPE_NAME", "DATA_TYPE", "COLUMN_SIZE", "LITERAL_PREFIX", "LITERAL_SUFFIX", "CREATE_PARAMS", "NULLABLE", "CASE_SENSITIVE", "SEARCHABLE", "UNSIGNED_ATTRIBUTE", "FIXED_PREC_SCALE", "AUTO_UNIQUE_VALUE", "LOCAL_TYPE_NAME", "MINIMUM_SCALE", "MAXIMUM_SCALE", "NUM_PREC_RADIX", "SQL_DATATYPE", "SQL_DATETIME_SUB", "INTERVAL_PRECISION", "mysql_native_type", "mysql_is_num" }; dbh= dbh; imp_dbh= imp_dbh; hv= newHV(); av_push(av, newRV_noinc((SV*) hv)); for (i= 0; i < (int)(sizeof(cols) / sizeof(const char*)); i++) { if (!hv_store(hv, (char*) cols[i], strlen(cols[i]), newSViv(i), 0)) { SvREFCNT_dec((SV*) av); return Nullav; } } for (i= 0; i < (int)SQL_GET_TYPE_INFO_num; i++) { const sql_type_info_t *t= &SQL_GET_TYPE_INFO_values[i]; row= newAV(); av_push(av, newRV_noinc((SV*) row)); PV_PUSH(t->type_name); IV_PUSH(t->data_type); IV_PUSH(t->column_size); PV_PUSH(t->literal_prefix); PV_PUSH(t->literal_suffix); PV_PUSH(t->create_params); IV_PUSH(t->nullable); IV_PUSH(t->case_sensitive); IV_PUSH(t->searchable); IV_PUSH(t->unsigned_attribute); IV_PUSH(t->fixed_prec_scale); IV_PUSH(t->auto_unique_value); PV_PUSH(t->local_type_name); IV_PUSH(t->minimum_scale); IV_PUSH(t->maximum_scale); if (t->num_prec_radix) { IV_PUSH(t->num_prec_radix); } else av_push(row, &PL_sv_undef); IV_PUSH(t->sql_datatype); /* SQL_DATATYPE*/ IV_PUSH(t->sql_datetime_sub); /* SQL_DATETIME_SUB*/ IV_PUSH(t->interval_precision); /* INTERVAL_PERCISION */ IV_PUSH(t->native_type); IV_PUSH(t->is_num); } return av; } /* dbd_db_quote Properly quotes a value */ SV* dbd_db_quote(SV *dbh, SV *str, SV *type) { dTHX; SV *result; if (SvGMAGICAL(str)) mg_get(str); if (!SvOK(str)) result= newSVpv("NULL", 4); else { char *ptr, *sptr; STRLEN len; D_imp_dbh(dbh); if (type && SvMAGICAL(type)) mg_get(type); if (type && SvOK(type)) { int i; int tp= SvIV(type); for (i= 0; i < (int)SQL_GET_TYPE_INFO_num; i++) { const sql_type_info_t *t= &SQL_GET_TYPE_INFO_values[i]; if (t->data_type == tp) { if (!t->literal_prefix) return Nullsv; break; } } } ptr= SvPV(str, len); result= newSV(len*2+3); #ifdef SvUTF8 if (SvUTF8(str)) SvUTF8_on(result); #endif sptr= SvPVX(result); *sptr++ = '\''; sptr+= mysql_real_escape_string(imp_dbh->pmysql, sptr, ptr, len); *sptr++= '\''; SvPOK_on(result); SvCUR_set(result, sptr - SvPVX(result)); /* Never hurts NUL terminating a Per string */ *sptr++= '\0'; } return result; } #ifdef DBD_MYSQL_INSERT_ID_IS_GOOD SV *mysql_db_last_insert_id(SV *dbh, imp_dbh_t *imp_dbh, SV *catalog, SV *schema, SV *table, SV *field, SV *attr) { dTHX; /* all these non-op settings are to stifle OS X compile warnings */ imp_dbh= imp_dbh; dbh= dbh; catalog= catalog; schema= schema; table= table; field= field; attr= attr; ASYNC_CHECK_RETURN(dbh, &PL_sv_undef); return sv_2mortal(my_ulonglong2str(aTHX_ mysql_insert_id(imp_dbh->pmysql))); } #endif #if MYSQL_ASYNC int mysql_db_async_result(SV* h, MYSQL_RES** resp) { dTHX; D_imp_xxh(h); imp_dbh_t* dbh; MYSQL* svsock = NULL; MYSQL_RES* _res; int retval = 0; int htype; if(! resp) { resp = &_res; } htype = DBIc_TYPE(imp_xxh); if(htype == DBIt_DB) { D_imp_dbh(h); dbh = imp_dbh; } else { D_imp_sth(h); D_imp_dbh_from_sth; dbh = imp_dbh; } if(! dbh->async_query_in_flight) { do_error(h, 2000, "Gathering asynchronous results for a synchronous handle", "HY000"); return -1; } if(dbh->async_query_in_flight != imp_xxh) { do_error(h, 2000, "Gathering async_query_in_flight results for the wrong handle", "HY000"); return -1; } dbh->async_query_in_flight = NULL; svsock= dbh->pmysql; retval= mysql_read_query_result(svsock); if(! retval) { *resp= mysql_store_result(svsock); if (mysql_errno(svsock)) do_error(h, mysql_errno(svsock), mysql_error(svsock), mysql_sqlstate(svsock)); if (!*resp) retval= mysql_affected_rows(svsock); else { retval= mysql_num_rows(*resp); if(resp == &_res) { mysql_free_result(*resp); } } if(htype == DBIt_ST) { D_imp_sth(h); D_imp_dbh_from_sth; if(retval+1 != (my_ulonglong)-1) { if(! *resp) { imp_sth->insertid= mysql_insert_id(svsock); #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION if(! mysql_more_results(svsock)) DBIc_ACTIVE_off(imp_sth); #endif } else { DBIc_NUM_FIELDS(imp_sth)= mysql_num_fields(imp_sth->result); imp_sth->done_desc= 0; imp_sth->fetch_done= 0; } } imp_sth->warning_count = mysql_warning_count(imp_dbh->pmysql); } } else { do_error(h, mysql_errno(svsock), mysql_error(svsock), mysql_sqlstate(svsock)); return -1; } return retval; } int mysql_db_async_ready(SV* h) { dTHX; D_imp_xxh(h); imp_dbh_t* dbh; int htype; htype = DBIc_TYPE(imp_xxh); if(htype == DBIt_DB) { D_imp_dbh(h); dbh = imp_dbh; } else { D_imp_sth(h); D_imp_dbh_from_sth; dbh = imp_dbh; } if(dbh->async_query_in_flight) { if(dbh->async_query_in_flight == imp_xxh) { struct pollfd fds; int retval; fds.fd = dbh->pmysql->net.fd; fds.events = POLLIN; retval = poll(&fds, 1, 0); if(retval < 0) { do_error(h, errno, strerror(errno), "HY000"); } return retval; } else { do_error(h, 2000, "Calling mysql_async_ready on the wrong handle", "HY000"); return -1; } } else { do_error(h, 2000, "Handle is not in asynchronous mode", "HY000"); return -1; } } #endif static int parse_number(char *string, STRLEN len, char **end) { int seen_neg; int seen_dec; int seen_e; int seen_plus; int seen_digit; char *cp; seen_neg= seen_dec= seen_e= seen_plus= seen_digit= 0; if (len <= 0) { len= strlen(string); } cp= string; /* Skip leading whitespace */ while (*cp && isspace(*cp)) cp++; for ( ; *cp; cp++) { if ('-' == *cp) { if (seen_neg >= 2) { /* third '-'. number can contains two '-'. because -1e-10 is valid number */ break; } seen_neg += 1; } else if ('.' == *cp) { if (seen_dec) { /* second '.' */ break; } seen_dec= 1; } else if ('e' == *cp) { if (seen_e) { /* second 'e' */ break; } seen_e= 1; } else if ('+' == *cp) { if (seen_plus) { /* second '+' */ break; } seen_plus= 1; } else if (!isdigit(*cp)) { /* Not sure why this was changed */ /* seen_digit= 1; */ break; } } *end= cp; /* length 0 -> not a number */ /* Need to revisit this */ /*if (len == 0 || cp - string < (int) len || seen_digit == 0) {*/ if (len == 0 || cp - string < (int) len) { return -1; } return 0; } DBD-mysql-4.025/README.pod0000644000175000017500000000113112230034435013361 0ustar patgpatg=head1 DBD::mysql - database driver for Perl This is the Perl L driver for access to MySQL databases. =head2 Usage Usage is described in L. =head2 Installation Installation is described in L. =head2 Support The driver is maintained by a mailing list: 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 L You can also get help from the maintainer, Patrick Galbraith patg@patg.net DBD-mysql-4.025/mysql.xs0000644000175000017500000005415512230034435013457 0ustar patgpatg/* Hej, Emacs, this is -*- C -*- mode! Copyright (c) 2003 Rudolf Lippan Copyright (c) 1997-2003 Jochen Wiedmann You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. */ #include "dbdimp.h" #include "constants.h" #include #include #if MYSQL_ASYNC # define ASYNC_CHECK_XS(h)\ if(imp_dbh->async_query_in_flight) {\ do_error(h, 2000, "Calling a synchronous function on an asynchronous handle", "HY000");\ XSRETURN_UNDEF;\ } #else # define ASYNC_CHECK_XS(h) #endif DBISTATE_DECLARE; MODULE = DBD::mysql PACKAGE = DBD::mysql INCLUDE: mysql.xsi MODULE = DBD::mysql PACKAGE = DBD::mysql double constant(name, arg) char* name char* arg CODE: RETVAL = mysql_constant(name, arg); OUTPUT: RETVAL MODULE = DBD::mysql PACKAGE = DBD::mysql::dr void _ListDBs(drh, host=NULL, port=NULL, user=NULL, password=NULL) SV * drh char * host char * port char * user char * password PPCODE: { MYSQL mysql; MYSQL* sock = mysql_dr_connect(drh, &mysql, NULL, host, port, user, password, NULL, NULL); if (sock != NULL) { MYSQL_ROW cur; MYSQL_RES* res = mysql_list_dbs(sock, NULL); if (!res) { do_error(drh, mysql_errno(sock), mysql_error(sock), mysql_sqlstate(sock)); } else { EXTEND(sp, mysql_num_rows(res)); while ((cur = mysql_fetch_row(res))) { PUSHs(sv_2mortal((SV*)newSVpv(cur[0], strlen(cur[0])))); } mysql_free_result(res); } mysql_close(sock); } } void _admin_internal(drh,dbh,command,dbname=NULL,host=NULL,port=NULL,user=NULL,password=NULL) SV* drh SV* dbh char* command char* dbname char* host char* port char* user char* password PPCODE: { MYSQL mysql; int retval; MYSQL* sock; /* * Connect to the database, if required. */ if (SvOK(dbh)) { D_imp_dbh(dbh); sock = imp_dbh->pmysql; } else { sock = mysql_dr_connect(drh, &mysql, NULL, host, port, user, password, NULL, NULL); if (sock == NULL) { do_error(drh, mysql_errno(&mysql), mysql_error(&mysql), mysql_sqlstate(&mysql)); XSRETURN_NO; } } if (strEQ(command, "shutdown")) #if MYSQL_VERSION_ID < 40103 retval = mysql_shutdown(sock); #else retval = mysql_shutdown(sock, SHUTDOWN_DEFAULT); #endif else if (strEQ(command, "reload")) retval = mysql_reload(sock); else if (strEQ(command, "createdb")) { #if MYSQL_VERSION_ID < 40000 retval = mysql_create_db(sock, dbname); #else char* buffer = malloc(strlen(dbname)+50); if (buffer == NULL) { do_error(drh, JW_ERR_MEM, "Out of memory" ,NULL); XSRETURN_NO; } else { strcpy(buffer, "CREATE DATABASE "); strcat(buffer, dbname); retval = mysql_real_query(sock, buffer, strlen(buffer)); free(buffer); } #endif } else if (strEQ(command, "dropdb")) { #if MYSQL_VERSION_ID < 40000 retval = mysql_drop_db(sock, dbname); #else char* buffer = malloc(strlen(dbname)+50); if (buffer == NULL) { do_error(drh, JW_ERR_MEM, "Out of memory" ,NULL); XSRETURN_NO; } else { strcpy(buffer, "DROP DATABASE "); strcat(buffer, dbname); retval = mysql_real_query(sock, buffer, strlen(buffer)); free(buffer); } #endif } else { croak("Unknown command: %s", command); } if (retval) { do_error(SvOK(dbh) ? dbh : drh, mysql_errno(sock), mysql_error(sock) ,mysql_sqlstate(sock)); } if (SvOK(dbh)) { mysql_close(sock); } if (retval) XSRETURN_NO; else XSRETURN_YES; } MODULE = DBD::mysql PACKAGE = DBD::mysql::db void type_info_all(dbh) SV* dbh PPCODE: { /* static AV* types = NULL; */ /* if (!types) { */ /* D_imp_dbh(dbh); */ /* if (!(types = dbd_db_type_info_all(dbh, imp_dbh))) { */ /* croak("Cannot create types array (out of memory?)"); */ /* } */ /* } */ /* ST(0) = sv_2mortal(newRV_inc((SV*) types)); */ D_imp_dbh(dbh); ASYNC_CHECK_XS(dbh); ST(0) = sv_2mortal(newRV_noinc((SV*) dbd_db_type_info_all(dbh, imp_dbh))); XSRETURN(1); } void _ListDBs(dbh) SV* dbh PPCODE: MYSQL_RES* res; MYSQL_ROW cur; D_imp_dbh(dbh); ASYNC_CHECK_XS(dbh); res = mysql_list_dbs(imp_dbh->pmysql, NULL); if (!res && (!mysql_db_reconnect(dbh) || !(res = mysql_list_dbs(imp_dbh->pmysql, NULL)))) { do_error(dbh, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql), mysql_sqlstate(imp_dbh->pmysql)); } else { EXTEND(sp, mysql_num_rows(res)); while ((cur = mysql_fetch_row(res))) { PUSHs(sv_2mortal((SV*)newSVpv(cur[0], strlen(cur[0])))); } mysql_free_result(res); } void do(dbh, statement, attr=Nullsv, ...) SV * dbh SV * statement SV * attr PROTOTYPE: $$;$@ CODE: { D_imp_dbh(dbh); int num_params= 0; int retval; struct imp_sth_ph_st* params= NULL; MYSQL_RES* result= NULL; SV* async = NULL; #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION int next_result_rc; #endif #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION STRLEN slen; char *str_ptr, *statement_ptr, *buffer; int has_binded; int col_type= MYSQL_TYPE_STRING; int buffer_is_null= 0; int buffer_length= slen; int buffer_type= 0; int param_type= SQL_VARCHAR; int use_server_side_prepare= 0; MYSQL_STMT *stmt= NULL; MYSQL_BIND *bind= NULL; imp_sth_phb_t *fbind= NULL; #endif ASYNC_CHECK_XS(dbh); #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION while (mysql_next_result(imp_dbh->pmysql)==0) { MYSQL_RES* res = mysql_use_result(imp_dbh->pmysql); if (res) mysql_free_result(res); } #endif #if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION /* * Globaly enabled using of server side prepared statement * for dbh->do() statements. It is possible to force driver * to use server side prepared statement mechanism by adding * 'mysql_server_prepare' attribute to do() method localy: * $dbh->do($stmt, {mysql_server_prepared=>1}); */ use_server_side_prepare = imp_dbh->use_server_side_prepare; if (attr) { SV** svp; DBD_ATTRIBS_CHECK("do", dbh, attr); svp = DBD_ATTRIB_GET_SVP(attr, "mysql_server_prepare", 20); use_server_side_prepare = (svp) ? SvTRUE(*svp) : imp_dbh->use_server_side_prepare; svp = DBD_ATTRIB_GET_SVP(attr, "async", 5); async = (svp) ? *svp : &PL_sv_no; } if (DBIc_DBISTATE(imp_dbh)->debug >= 2) PerlIO_printf(DBIc_LOGPIO(imp_dbh), "mysql.xs do() use_server_side_prepare %d, async %d\n", use_server_side_prepare, SvTRUE(async)); hv_store((HV*)SvRV(dbh), "Statement", 9, SvREFCNT_inc(statement), 0); if(SvTRUE(async)) { #if MYSQL_ASYNC use_server_side_prepare = FALSE; /* for now */ imp_dbh->async_query_in_flight = imp_dbh; #else do_error(dbh, 2000, "Async support was not built into this version of DBD::mysql", "HY000"); XSRETURN_UNDEF; #endif } if (use_server_side_prepare) { str_ptr= SvPV(statement, slen); stmt= mysql_stmt_init(imp_dbh->pmysql); if ((mysql_stmt_prepare(stmt, str_ptr, strlen(str_ptr))) && (!mysql_db_reconnect(dbh) || (mysql_stmt_prepare(stmt, str_ptr, strlen(str_ptr))))) { /* For commands that are not supported by server side prepared statement mechanism lets try to pass them through regular API */ if (mysql_stmt_errno(stmt) == ER_UNSUPPORTED_PS) { use_server_side_prepare= 0; } else { do_error(dbh, mysql_stmt_errno(stmt), mysql_stmt_error(stmt) ,mysql_stmt_sqlstate(stmt)); retval=-2; } mysql_stmt_close(stmt); stmt= NULL; } else { /* 'items' is the number of arguments passed to XSUB, supplied by xsubpp compiler, as listed in manpage for perlxs */ if (items > 3) { /* Handle binding supplied values to placeholders assume user has passed the correct number of parameters */ int i; num_params= items - 3; /*num_params = mysql_stmt_param_count(stmt);*/ Newz(0, params, sizeof(*params)*num_params, struct imp_sth_ph_st); Newz(0, bind, (unsigned int) num_params, MYSQL_BIND); Newz(0, fbind, (unsigned int) num_params, imp_sth_phb_t); for (i = 0; i < num_params; i++) { int defined= 0; params[i].value= ST(i+3); if (params[i].value) { if (SvMAGICAL(params[i].value)) mg_get(params[i].value); if (SvOK(params[i].value)) defined= 1; } if (defined) { buffer= SvPV(params[i].value, slen); buffer_is_null= 0; buffer_length= slen; } else { buffer= NULL; buffer_is_null= 1; buffer_length= 0; } /* if this statement has a result set, field types will be correctly identified. If there is no result set, such as with an INSERT, fields will not be defined, and all buffer_type will default to MYSQL_TYPE_VAR_STRING */ col_type= (stmt->fields) ? stmt->fields[i].type : MYSQL_TYPE_STRING; switch (col_type) { #if MYSQL_VERSION_ID > 50003 case MYSQL_TYPE_NEWDECIMAL: #endif case MYSQL_TYPE_DECIMAL: param_type= SQL_DECIMAL; buffer_type= MYSQL_TYPE_DOUBLE; break; case MYSQL_TYPE_DOUBLE: param_type= SQL_DOUBLE; buffer_type= MYSQL_TYPE_DOUBLE; break; case MYSQL_TYPE_FLOAT: buffer_type= MYSQL_TYPE_DOUBLE; param_type= SQL_FLOAT; break; case MYSQL_TYPE_SHORT: buffer_type= MYSQL_TYPE_DOUBLE; param_type= SQL_FLOAT; break; case MYSQL_TYPE_TINY: buffer_type= MYSQL_TYPE_DOUBLE; param_type= SQL_FLOAT; break; case MYSQL_TYPE_LONG: buffer_type= MYSQL_TYPE_LONG; param_type= SQL_BIGINT; break; case MYSQL_TYPE_INT24: case MYSQL_TYPE_YEAR: buffer_type= MYSQL_TYPE_LONG; param_type= SQL_INTEGER; break; case MYSQL_TYPE_LONGLONG: /* perl handles long long as double * so we'll set this to string */ buffer_type= MYSQL_TYPE_STRING; param_type= SQL_VARCHAR; break; case MYSQL_TYPE_NEWDATE: case MYSQL_TYPE_DATE: buffer_type= MYSQL_TYPE_STRING; param_type= SQL_DATE; break; case MYSQL_TYPE_TIME: buffer_type= MYSQL_TYPE_STRING; param_type= SQL_TIME; break; case MYSQL_TYPE_TIMESTAMP: buffer_type= MYSQL_TYPE_STRING; param_type= SQL_TIMESTAMP; break; case MYSQL_TYPE_VAR_STRING: case MYSQL_TYPE_STRING: case MYSQL_TYPE_DATETIME: buffer_type= MYSQL_TYPE_STRING; param_type= SQL_VARCHAR; break; case MYSQL_TYPE_BLOB: buffer_type= MYSQL_TYPE_BLOB; param_type= SQL_BINARY; break; case MYSQL_TYPE_GEOMETRY: buffer_type= MYSQL_TYPE_BLOB; param_type= SQL_BINARY; break; default: buffer_type= MYSQL_TYPE_STRING; param_type= SQL_VARCHAR; break; } bind[i].buffer_type = buffer_type; bind[i].buffer_length= buffer_length; bind[i].buffer= buffer; fbind[i].length= buffer_length; fbind[i].is_null= buffer_is_null; params[i].type= param_type; } has_binded= 0; } retval = mysql_st_internal_execute41(dbh, num_params, &result, stmt, bind, &has_binded); if (bind) Safefree(bind); if (fbind) Safefree(fbind); if(mysql_stmt_close(stmt)) { fprintf(stderr, "\n failed while closing the statement"); fprintf(stderr, "\n %s", mysql_stmt_error(stmt)); } } } if (! use_server_side_prepare) { #endif if (items > 3) { /* Handle binding supplied values to placeholders */ /* Assume user has passed the correct number of parameters */ int i; num_params= items-3; Newz(0, params, sizeof(*params)*num_params, struct imp_sth_ph_st); for (i= 0; i < num_params; i++) { params[i].value= ST(i+3); params[i].type= SQL_VARCHAR; } } retval = mysql_st_internal_execute(dbh, statement, attr, num_params, params, &result, imp_dbh->pmysql, 0); #if MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION } #endif if (params) Safefree(params); if (result) { mysql_free_result(result); result= 0; } #if MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION if (retval != -2 && !SvTRUE(async)) /* -2 means error */ { /* more results? -1 = no, >0 = error, 0 = yes (keep looping) */ while ((next_result_rc= mysql_next_result(imp_dbh->pmysql)) == 0) { result = mysql_use_result(imp_dbh->pmysql); if (result) mysql_free_result(result); } if (next_result_rc > 0) { if (DBIc_DBISTATE(imp_dbh)->debug >= 2) PerlIO_printf(DBIc_LOGPIO(imp_dbh), "\t<- do() ERROR: %s\n", mysql_error(imp_dbh->pmysql)); do_error(dbh, mysql_errno(imp_dbh->pmysql), mysql_error(imp_dbh->pmysql), mysql_sqlstate(imp_dbh->pmysql)); retval= -2; } } #endif /* remember that dbd_st_execute must return <= -2 for error */ if (retval == 0) /* ok with no rows affected */ XST_mPV(0, "0E0"); /* (true but zero) */ else if (retval < -1) /* -1 == unknown number of rows */ XST_mUNDEF(0); /* <= -2 means error */ else XST_mIV(0, retval); /* typically 1, rowcount or -1 */ } SV* ping(dbh) SV* dbh; PROTOTYPE: $ CODE: { int retval; D_imp_dbh(dbh); ASYNC_CHECK_XS(dbh); retval = (mysql_ping(imp_dbh->pmysql) == 0); if (!retval) { if (mysql_db_reconnect(dbh)) { retval = (mysql_ping(imp_dbh->pmysql) == 0); } } RETVAL = boolSV(retval); } OUTPUT: RETVAL void quote(dbh, str, type=NULL) SV* dbh SV* str SV* type PROTOTYPE: $$;$ PPCODE: { SV* quoted; D_imp_dbh(dbh); ASYNC_CHECK_XS(dbh); quoted = dbd_db_quote(dbh, str, type); ST(0) = quoted ? sv_2mortal(quoted) : str; XSRETURN(1); } int mysql_fd(dbh) SV* dbh CODE: { D_imp_dbh(dbh); RETVAL = imp_dbh->pmysql->net.fd; } OUTPUT: RETVAL void mysql_async_result(dbh) SV* dbh PPCODE: { #if MYSQL_ASYNC int retval; retval = mysql_db_async_result(dbh, NULL); if(retval > 0) { XSRETURN_IV(retval); } else if(retval == 0) { XSRETURN_PV("0E0"); } else { XSRETURN_UNDEF; } #else do_error(dbh, 2000, "Async support was not built into this version of DBD::mysql", "HY000"); XSRETURN_UNDEF; #endif } void mysql_async_ready(dbh) SV* dbh PPCODE: { #if MYSQL_ASYNC int retval; retval = mysql_db_async_ready(dbh); if(retval > 0) { XSRETURN_YES; } else if(retval == 0) { XSRETURN_NO; } else { XSRETURN_UNDEF; } #else do_error(dbh, 2000, "Async support was not built into this version of DBD::mysql", "HY000"); XSRETURN_UNDEF; #endif } void _async_check(dbh) SV* dbh PPCODE: { D_imp_dbh(dbh); ASYNC_CHECK_XS(dbh); XSRETURN_YES; } MODULE = DBD::mysql PACKAGE = DBD::mysql::st int more_results(sth) SV * sth CODE: { #if (MYSQL_VERSION_ID >= MULTIPLE_RESULT_SET_VERSION) D_imp_sth(sth); int retval; if (dbd_st_more_results(sth, imp_sth)) { RETVAL=1; } else { RETVAL=0; } #endif } OUTPUT: RETVAL int dataseek(sth, pos) SV* sth int pos PROTOTYPE: $$ CODE: { D_imp_sth(sth); #if (MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION) if (imp_sth->use_server_side_prepare) { if (imp_sth->use_mysql_use_result || 1) { if (imp_sth->result && imp_sth->stmt) { mysql_stmt_data_seek(imp_sth->stmt, pos); imp_sth->fetch_done=0; RETVAL = 1; } else { RETVAL = 0; do_error(sth, JW_ERR_NOT_ACTIVE, "Statement not active" ,NULL); } } else { RETVAL = 0; do_error(sth, JW_ERR_NOT_ACTIVE, "No result set" ,NULL); } } else { #endif if (imp_sth->result) { mysql_data_seek(imp_sth->result, pos); RETVAL = 1; } else { RETVAL = 0; do_error(sth, JW_ERR_NOT_ACTIVE, "Statement not active" ,NULL); } #if (MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION) } #endif } OUTPUT: RETVAL void rows(sth) SV* sth CODE: D_imp_sth(sth); char buf[64]; #if MYSQL_ASYNC D_imp_dbh_from_sth; if(imp_dbh->async_query_in_flight) { if(mysql_db_async_result(sth, &imp_sth->result) < 0) { XSRETURN_UNDEF; } } #endif /* fix to make rows able to handle errors and handle max value from affected rows. if mysql_affected_row returns an error, it's value is 18446744073709551614, while a (my_ulonglong)-1 is 18446744073709551615, so we have to add 1 to imp_sth->row_num to know if there's an error */ if (imp_sth->row_num+1 == (my_ulonglong) -1) sprintf(buf, "%d", -1); else sprintf(buf, "%llu", imp_sth->row_num); ST(0) = sv_2mortal(newSVpvn(buf, strlen(buf))); int mysql_async_result(sth) SV* sth CODE: { #if MYSQL_ASYNC D_imp_sth(sth); int retval; retval= mysql_db_async_result(sth, &imp_sth->result); if(retval > 0) { imp_sth->row_num = retval; XSRETURN_IV(retval); } else if(retval == 0) { imp_sth->row_num = retval; XSRETURN_PV("0E0"); } else { XSRETURN_UNDEF; } #else do_error(sth, 2000, "Async support was not built into this version of DBD::mysql", "HY000"); XSRETURN_UNDEF; #endif } OUTPUT: RETVAL void mysql_async_ready(sth) SV* sth PPCODE: { #if MYSQL_ASYNC int retval; retval = mysql_db_async_ready(sth); if(retval > 0) { XSRETURN_YES; } else if(retval == 0) { XSRETURN_NO; } else { XSRETURN_UNDEF; } #else do_error(sth, 2000, "Async support was not built into this version of DBD::mysql", "HY000"); XSRETURN_UNDEF; #endif } void _async_check(sth) SV* sth PPCODE: { D_imp_sth(sth); D_imp_dbh_from_sth; ASYNC_CHECK_XS(sth); XSRETURN_YES; } MODULE = DBD::mysql PACKAGE = DBD::mysql::GetInfo # This probably should be grabed out of some ODBC types header file #define SQL_CATALOG_NAME_SEPARATOR 41 #define SQL_CATALOG_TERM 42 #define SQL_DBMS_VER 18 #define SQL_IDENTIFIER_QUOTE_CHAR 29 #define SQL_MAXIMUM_STATEMENT_LENGTH 105 #define SQL_MAXIMUM_TABLES_IN_SELECT 106 #define SQL_MAX_TABLE_NAME_LEN 35 #define SQL_SERVER_NAME 13 #define SQL_ASYNC_MODE 10021 #define SQL_MAX_ASYNC_CONCURRENT_STATEMENTS 10022 #define SQL_AM_NONE 0 #define SQL_AM_CONNECTION 1 #define SQL_AM_STATEMENT 2 # dbd_mysql_getinfo() # Return ODBC get_info() information that must needs be accessed from C # This is an undocumented function that should only # be used by DBD::mysql::GetInfo. void dbd_mysql_get_info(dbh, sql_info_type) SV* dbh SV* sql_info_type CODE: D_imp_dbh(dbh); IV type = 0; SV* retsv=NULL; bool using_322=0; if (SvMAGICAL(sql_info_type)) mg_get(sql_info_type); if (SvOK(sql_info_type)) type = SvIV(sql_info_type); else croak("get_info called with an invalied parameter"); switch(type) { case SQL_CATALOG_NAME_SEPARATOR: /* (dbc->flag & FLAG_NO_CATALOG) ? WTF is in flag ? */ retsv = newSVpv(".",1); break; case SQL_CATALOG_TERM: /* (dbc->flag & FLAG_NO_CATALOG) ? WTF is in flag ? */ retsv = newSVpv("database",8); break; case SQL_DBMS_VER: retsv = newSVpv( imp_dbh->pmysql->server_version, strlen(imp_dbh->pmysql->server_version) ); break; case SQL_IDENTIFIER_QUOTE_CHAR: /*XXX What about a DB started in ANSI mode? */ /* Swiped from MyODBC's get_info.c */ using_322 = ((strncmp(mysql_get_server_info(imp_dbh->pmysql),"3.22",4) == 0) ? 1 : 0 ); retsv = newSVpv(!using_322 ? "`" : " ", 1); break; case SQL_MAXIMUM_STATEMENT_LENGTH: retsv = newSViv(net_buffer_length); break; case SQL_MAXIMUM_TABLES_IN_SELECT: /* newSViv((sizeof(int) > 32) ? sizeof(int)-1 : 31 ); in general? */ retsv= newSViv((sizeof(int) == 64 ) ? 63 : 31 ); break; case SQL_MAX_TABLE_NAME_LEN: retsv= newSViv(NAME_LEN); break; case SQL_SERVER_NAME: retsv= newSVpv(imp_dbh->pmysql->host_info,strlen(imp_dbh->pmysql->host_info)); break; case SQL_ASYNC_MODE: #if MYSQL_ASYNC retsv = newSViv(SQL_AM_STATEMENT); #else retsv = newSViv(SQL_AM_NONE); #endif break; case SQL_MAX_ASYNC_CONCURRENT_STATEMENTS: #if MYSQL_ASYNC retsv = newSViv(1); #else retsv = newSViv(0); #endif break; default: croak("Unknown SQL Info type: %i",dbh); } ST(0) = sv_2mortal(retsv); DBD-mysql-4.025/TODO0000644000175000017500000000160012230034435012411 0ustar patgpatg- update tests to use get_info(SQL_IDENTIFIER_QUOTE_CHAR) for quoting (when s///ing suff out or update tests to use quoted names). x use DBD::ODBC & its type_info_all() to test type_info_all in DBD::mysql - write test scripts for quote_idenitifer(); - add tests for autoreconnect (dev only -- since these will require restarting mysqld ?) - Write up test for found_rows = 1 + document change of behaviour in found_rows + Document compile time options to change found_rows behaviour + Document compile time option for SSL: 'perl Makefile.PL -ssl' is not documented - dbd_login6 with attrib (maybe) - f_key_info() func & tests. + update type_info_all. - Warnings when invalid GetTypeInfo type is passed into get_type_info; - make tests should test all mysql column types for native2sql() -- or better yet have native2sql be generated by a script that also generates the types table. DBD-mysql-4.025/constants.h0000644000175000017500000000363412230034435014117 0ustar patgpatg#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include static double mysql_constant(char* name, char* arg) { errno = 0; arg= arg; switch (*name) { case 'B': if (strEQ(name, "BLOB_FLAG")) return BLOB_FLAG; break; case 'F': if (strnEQ(name, "FIELD_TYPE_", 11)) { char* n = name+11; switch(*n) { case 'B': if (strEQ(n, "BLOB")) return FIELD_TYPE_BLOB; break; case 'C': if (strEQ(n, "CHAR")) return FIELD_TYPE_CHAR; break; case 'D': if (strEQ(n, "DECIMAL")) return FIELD_TYPE_DECIMAL; if (strEQ(n, "DATE")) return FIELD_TYPE_DATE; if (strEQ(n, "DATETIME")) return FIELD_TYPE_DATETIME; if (strEQ(n, "DOUBLE")) return FIELD_TYPE_DOUBLE; break; case 'F': if (strEQ(n, "FLOAT")) return FIELD_TYPE_FLOAT; break; case 'I': if (strEQ(n, "INT24")) return FIELD_TYPE_INT24; break; case 'L': if (strEQ(n, "LONGLONG")) return FIELD_TYPE_LONGLONG; if (strEQ(n, "LONG_BLOB")) return FIELD_TYPE_LONG_BLOB; if (strEQ(n, "LONG")) return FIELD_TYPE_LONG; break; case 'M': if (strEQ(n, "MEDIUM_BLOB")) return FIELD_TYPE_MEDIUM_BLOB; break; case 'N': if (strEQ(n, "NULL")) return FIELD_TYPE_NULL; break; case 'S': if (strEQ(n, "SHORT")) return FIELD_TYPE_SHORT; if (strEQ(n, "STRING")) return FIELD_TYPE_STRING; break; case 'T': if (strEQ(n, "TINY")) return FIELD_TYPE_TINY; if (strEQ(n, "TINY_BLOB")) return FIELD_TYPE_TINY_BLOB; if (strEQ(n, "TIMESTAMP")) return FIELD_TYPE_TIMESTAMP; if (strEQ(n, "TIME")) return FIELD_TYPE_TIME; break; case 'V': if (strEQ(n, "VAR_STRING")) return FIELD_TYPE_VAR_STRING; break; } } break; case 'N': if (strEQ(name, "NOT_NULL_FLAG")) return NOT_NULL_FLAG; break; case 'P': if (strEQ(name, "PRI_KEY_FLAG")) return PRI_KEY_FLAG; break; } errno = EINVAL; return 0; } DBD-mysql-4.025/ChangeLog0000644000175000017500000020007312235676756013527 0ustar patgpatg2013-11-05 Patrick Galbraith, Michiel Beijen, DBI/DBD community (4.025) * Fix method redefinition warnings in threads on Perl >= 5.16 - Dagfinn Ilmari Mannsåker * use strict and warnings everywhere. * Minimum perl version is now 5.8.1, just as for DBI. * Improved database version check so tests run correctly on MariaDB 10. * Fix manifest - RT89106, reported by Joe Grasse. * set auto_increment_offset explicitly to make tests pass if they are set on server - RT83487, reported by Ian Barton. * Assume 'localhost' when testport is set but no testhost in Makefile.PL - RT83496, reported by Philip Stoev. * Corrected documentation for mysql_init_command option - Alexey Molchanov * Skip stored procedure tests if user is unpriviliged - RT83348 - Chris Weyl * Fix example in POD doc for NUM_OF_FIELDS - RT36730, reported by tapoutmma. * Fix for memory leak (RT86153) when connecting with incorrect password * Bail if connect fails early on (RT31823) 2013-09-17 Michiel Beijen, Patrick Galbraith, DBI/DBD community (4.024) * Fix memory leak if mysql_server_prepare is enabled - RT76462 - Masahiro Chiba * Small dist improvements: Michiel Beijen * Undefined $DBI::errstr on execute fail on Windows: Michiel Beijen * Better diagnostics for 80procs.t Fixes RT#71199: Alexandr Ciornii * Fix #64013: INSTALL.pod is shown with 'man install': Juergen Weigert * Added 'testport' to keys in Makefile.PL Fixes RT#83492: Michiel Beijen * Fixed test 70takeimp warning. Michiel Beijen * Made test t/87async.t not stop on Win32. Michiel Beijen * Update github location. Update support information. Michiel Beijen * POD Fixes Patch from RT77043 by Gunnar Wolf, Debian Perl Group. Michiel Beijen 2013-04-12 Patrick Galbraith et open source community (4.023) Fix memory leak if mysql_server_prepare is enabled. * Fix primary_key_info result ordering - https://github.com/CaptTofu/DBD-mysql/pull/39 - Dagfinn Ilmari Mannsåker * allow compilation with msvc - https://github.com/CaptTofu/DBD-mysql/pull/37 - Walde Christian * just to set MYSQL_OPT_WRITE_TIMEOUT and MYSQL_OPT_READ_TIMEOUT by dsn - https://github.com/CaptTofu/DBD-mysql/pull/36 - Naosuke Yokoe * just remove unnecessary "my" - https://github.com/CaptTofu/DBD-mysql/pull/34 - Shoichi Kaji * eval $ExtUtils::MakeMaker::VERSION requires for old ExtUtils::MakeMaker - https://github.com/CaptTofu/DBD-mysql/pull/32 - Daisuke Murase * Updated documentation to reflect that bugs will be reported at rt.cpan.org * Updated version * Chased tail finding issue with -1 being converted to max unsigned int in PS mode * Various typos and other unicode fixes dsteinbrunner * Fixed permissions on files. * Clarified documentation and bumped version for next release 2012-08-28 Patrick Galbraith et open source community (4.022) * Fixes for Win32 from Rom Hoelz (https://github.com/hoelzro) * Pulling back in work for 4.021 that didn't get pushed and much other work from Chip Salzenberg (https://github.com/chipdude) * Column info order fix from Tokuhiro Matsuno (https://github.com/tokuhirom) * Fix AutoCommit comparison logic to avoid spurious commands to mysql from Matthew Horsfall (https://github.com/wolfsage) * server_preapre can't bind placeholder on comment. from Misahiro Chiba (https://github.com/nihen) * server_prepare; data is null, allocate big memory bug. from Misahiro Chiba (https://github.com/nihen) 2012-04-15 Patrick Galbraith (work of others) (4.021) * Fix to enable PERL_NO_GET_CONTEXT to spee up DBD on thread Perls (Dave Mitchell ) Thank you! * Fix to is_prefix not being exported by mysql Aran Deltax Thank you! * Eliminate DBIS usage Dagfinn Ilmari Mannsåker Thank you! * Enhanced / Fixed server side prepared statement checks (Steven Hartland) Thank you! * Fix missprint in doc of DBD::mysql of mysql_bind_type_guessing (Perlover http://blog.perloever.com) Thank you! * Misprint in lib/DBD/mysql.pm (Perlover) Thank you! 2011-08-15 Patrick Galbraith (4.020) * Numerous (!! Thank you!!) fixes for prepared statements: Masahiro Chiba - Chop blanks fixed - UTF8 improvements - fixed memory allocation for BLOBs - auto-reconnect * Fix in leak test, which failed sometime due to first assignment $prev_size over paging (Masahiro Chiba) * Catalog test allows use of schemas other than 'test' (Masahiro Chiba) * Documentation fix for auto_reconnect (Karen Etheridge ) * Win32 and general installation fixes (Alexandr Ciornii, http://chorny.net) 2011-05-08 Patrick Galbraith Rob Hoelz (4.019) * Asynchronous support added by Rob Hoelz - Thanks! * Amiri Barksdale - Enable environment variables for installation options, add docs to POD - Thanks! * Pedro Melo - fix to change sv_undef to PL_sv_undef from 4.018 - Thanks! 2010-10-11 Patrick Galbraith (4.018) * Added client and server info patch from Robert M. Jansen * Added documentation and tests for new features * More code cleanup 2010-08-11 Patrick Galbraith (4.017) * BUG #60085, Andreas Koenig's patch for DBI changes * Updated documents 2010-07-10 Patrick Galbraith (4.016) * Disabled mysql_bind_type_guessing due to one performance issue querying on a indexed character column unquoted will mean the index is not used * Fixed int types that should be bools 2010-07-09 Patrick Galbraith (4.015) * BUG #56664 fixed t/40blobs.t skip_all logic (W. Phillip Moore) * BUG #57253 Fixed iteration past end of string (crash). (Chris Butler) * Added a new parameter for old behavior- mysql_bind_comment_placeholders which will make it possible to have placeholders bound for those who really want that behavior. * Fixed bind_type_guessing - always on now 2010-04-14 Patrick Galbraith (4.014) * BUG #30033 Fixed handling of comments to allow comments that contain characters that might otherwise cause placeholder detection to not work properly * BUG #53844, Fix for memory leak in stats. (Gregory Burmistrov) * BUG #49719, Fix for handling of NULLs in prepared statements (Gert Pache) * BUG #55627, Fix for testing failure due to strict mode (Yves) * BUG #51784, Fix for mysqladmin on Windows in Makefile (Zeeshan Muhammad) * BUG #41630, Typo in Makefile * Had to define true and false in dbdimp.h. Didn't work out of the box on Linux 2009-09-16 Patrick Galbraith (4.013) * #49484: PATCH add support for MYSQL_INIT_COMMAND - Peter John Edwards * #48242: 'mysql_bind_type_guessing' doesn't work correctly with minus sign - Thanks Serguei Trouchelle! * #45616: t/40blobs.t cannot pass without database access - ServerError() not declared - Thanks ysth http://ysth.livejournal.com/ 2009-06-18 Patrick Galbraith (4.012) * Patch to bind_type_guessing from Craigslist, Thanks to Chris! Happiness is no quoted numbers. Fixed ChopBlanks to work with bind_type_guessing * Patch for win32 strawberry build Thanks to Curtis Jewell! Windows needs love * Patch for auto-reconnect to set active flag Thanks to Doug Fischer! * Fixed bug 32464 http://bugs.mysql.com/bug.php?id=32464. See https://rt.cpan.org/Ticket/Display.html?id=46308 Add connection flag mysql_no_autocommit_cmd which users of MySQL Proxy can use to prevent 'set autocommit=#' from being issued by the driver. 'perldoc DBD::mysql' to see how to use this new flag * Added bind-type-guessing options to Makefile.PL so the entire test suite can be run with bind_type_guessing set. 2009-04-13 Patrick Galbraith (4.011) * Renamed unsafe_bind_type_guessing, fixed some of the logic. This can be used to deal with bug 43822 (https://rt.cpan.org/Ticket/Display.html?id=43822) * Patch from Daniel Frett (daniel Dot frett At ccci Dot org) to fix issue of binding sever side integer parameters (server-side prepare statements) resulting in corrupt data, bug 42723 (https://rt.cpan.org/Ticket/Display.html?id=42723) * Updated documentation, cruft cleanup (as always) 2008-10-24 Patrick Galbraith (4.010) * Fix to dbd_bind_ph() for uninitialized value 'buffer_length' thanks for bug report and patch from Askniel.com (thanks!) 2008-10-21 Patrick Galbraith (4.009) * Fix to re-enable TAKE_IMP_DATA_VERSION. Still have to ensure DBI version 1.607 or higher * Fix to escaped single quotes throwing off bind param detection. Patch from Zhurs (zhurs@yandex.ru) Spasibo! 2008-8-15 Patrick Galbraith (4.008) * Multi statement patch, thanks to Chris Heath! * Disabled TAKE_IMP_DATA_VERSION because segfault with DBI < 1.607 * #29528: bind_param(..., SQL_FLOAT) ignores exponents - fixed, Thanks to Tokuhiro Matsuno! * Cleanups to make mysqlEmb work under Cygwin - Thanks to Chris Rodgers ! * Modified and disabled tests for MySQL version < 4.1 for unsupported features 2008-5-11 Patrick Galbraith (4.007) * Took out mysql_server_init call where not needed * Complete re-write of test suit to use Test::More - tons of cleanups! * Makefile.PL changes to use current user in 'make test' if not defined 2007-12-26 Patrick Galbraith (4.006) * Cleanups on OS X compile * Fixes to syntax errors on AIX * Removed test code that was leaving trace files around 2007-3-22 Patrick Galbraith (4.005) * Fixed mysql_warning issue < 4.1 (reminers, patches, help from ROAM, (issue 25713) * makerealclean patch from ROAM (issue #25714) * sqlstate cleanup patch from ROAM * Replaced all references to dbis to use imp_xxh per DBI best practices * Fix to dbd_st_destroy - added back previously removed 'free everything' code which had been moved to dbd_st_finish, causing a crash upon freeing of bind values after all rows resulting from one execution of a query have been fetched. This meant that next attempt to execute the prepared statement would segfault. This work thanks to Rainer Weikusat! * Removed all 'FindNewTable' calls in all tests. Just use 't1' for all tests to simplify things. Plus, this is how MySQL internall tests. * Better 'skip test' logic in some tests that were still running when they shouldn't have been. 2007-3-22 Patrick Galbraith Jim Winstead (4.004) * Work around a bug in old 3.23 servers by specifying NOT NULL for fields used as a primary key in tests. (Bug #20325, reported by Julian Ladisch) * Add support for mysql_warning_count statement handle attribute. (Bug #25457, patch from Philip Stoev) * Add support for mysql_multi_statements connection option. (RT #12322, based on patch from Doug Morris) * Had to bump to 4.003 do to print statement in mysql.pm that made it into the dist. Even though you can delete a file on CPAN, you cannot re-upload it if it's the same name. Mea Culpa. * UTF8-Flag not set with flag mysql_enable_utf8 and column collation utf8_bin patch, Joost Diepenmaat, (RT #24738) * Fixed do_error definition (Scott Hildreth, Tim Bunce) * Conversion of test suite to Test::More 2007-3-5 Patrick Galbraith Jim Winstead (4.003) * Fix inclusion of non-primary keys in primary_key_info. (Bug #26786, reported and patch by Dave Rolsky) 2007-3-1 Patrick Galbraith Jim Winstead (4.002) * Fix re-exec of Makefile.PL when forcing $ENV{LANG} to 'C'. (RT #25233, reported by Slaven Rezic) * Rewrote table_info method to support all arguments (previously it would only ever return all of the tables in the current database, no matter what was specified) * Fixed $DBD::mysql::VERSION to be a string instead of a float, which caused problems for certain locales * Fixed bug #23974. $dbh->column_info now returns handle with no rows upon table not existing. Much thanks to Tim Bunce for help fixing the problem in mysql.pm vs. dbdimp.c * Removed #ifdefs for do error (sqlstate being passed as last arg depending on version) * Fixed insertid test to work with auto_increment_increment replication setup. * Patch from Tim Bunce fixing do() not set $dbh->{Statement} attribute, which prevented DBD::Profile from giving correct results for calls to do() and causing ShowErrorStatement to possibly report the wrong statement in the error message * Patch from Tim Bunce clearing out the sth attribute cache when switching between result, sets which prevented the adjustedment of NUM_OF_FIELDS * Cleanup of several unused variables * Added support for wildcards in last argument of column_info(). * Add mysql_is_auto_increment to results of column_info(). (Bug #26603, original patch from Dave Rolsky) * Return the correct table type for both tables and views from the table_info() method. (Bug #26603, original patch from Dave Rolsky) * Add implementation of foreign_key_info() (Bug #26604, original patch from Dave Rolsky, and final implementation based on Connector/J code) 2007-1-8 Jim Winstead Patrick Galbraith (4.001) * Fix handling of unsigned integer values in result sets when using server-side prepared statements (they were not retrieved at all). * Fix handling of signed integer values when using server-side prepared statements (they were being forced to unsigned values). * Do not tell Perl that the contents of binary fields are UTF-8. [rt.cpan.org #22123], original patch by Joost Diepenmaat * Fix double-free of bound parameters when freeing statements. (Bug #20559) * Make sure to handle "magical" values in a couple of places. (Bug #20104) * Update the hints about what to do when zlib is found missing while linking. (Bug #13803, reported by Philip Stoev) * Explicitly initialize the MySQL client library to avoid possible race conditions in a multithreaded application. (Bug #21792) * Fix warning when no connection attributes are passed to the connect method (Bug #17323, reported by Phil Randal) * Removed redundant warnings when commit or rollback is called while AutoCommit is enabled. [rt.cpan.org #15802], reported by Tyler MacDonald * Report correct type for decimal columns from MySQL 5.0 and later [rt.cpan.org #18294], reported by Ray Zimmerman * Fix t/40bindparam.t to work when ANSI_QUOTES SQL_MODE is set. [rt.cpan.org #21521], reported by David Wheeler * Return a statement handle with an error when column_info is called on a table that does not exist. (Bug #23974, patch by Philip Stoev) * Fix handling of table names with characters that did not match /\w/ in the column_info method. (Bug #22005, reported by Philip Stoev) * Fix handling of negative integers bound to a column marked as SQL_INTEGER. [rt.cpan.org #18976], patch from Mike Schilli. * Add support for the primary_key_info method. [rt.cpan.org #8541] * Fixed Bundle::DBD::mysql to only include modules required for using DBD::mysql, not the old Mysql package. [rt.cpan.org #24096] * Updated Makefile.PL to not include files in .svn directories * Fixed various compile warnings in mysql.xs (ISO C) * Cleaned up stored procedure examples, made strict * Fixed bug that blew away subsequent result sets if you fetched all rows, only in result sets that had more than one row * Added test for bug #14979 http://rt.cpan.org/Ticket/Display.html?id=14979, which still fails * Tested with ALL mysql versions, fixed 40types, 40bind_param tests to work with 4.0, 4.1 * Fixed dbdimp.c to not test for MYSQL_DATA_TRUNCATED unless >= mysql 5.0 2006-12-22 Patrick Galbraith , Alexey Stroganov (4.00) * Added Alexey Stroganov's patch which fixes varying number of columns in multiple result sets. Added new test cases to 80procs.t based of his test script (bug #21028) (Thanks Alexey!). Also fixed 80procs.t to allow 'CALL' to be prepared * Added Philip Stoev's patch for DATA_TYPE date and time columns (bug #23988) (Thanks Philip!) * Reworked (for working with 4.0, which doesn't support sqlstate) Philip Stoev's patch for sqlstate, bug #23935 (Thanks Philip!) * New Versioning! 4.00 now. This dev tree will now become trunk * Cleaned up much code that failed between versions (!!!) * Turned off prepared statements by default * Tested this with 5.1, 5.0, 4.1, 4.0. Works with ALL these versions! 2006-10-10 Patrick Galbraith , Alexey Stroganov (3.0009_1) * Added fbind and bind alloc to dbd_st_describe. This was causing a crash when using with mod_perl 2006-10-10 Patrick Galbraith (3.0008_1) * Added patch for SSL Verify Certificate (Thanks Eric Chen!) * Added multiple fixes to dbd_st_prepare which fixed variable overwrite and unset increment counter. Also improved loop which checks statements for presence of "LIMIT" by using a pointer as opposed to char array increment variable. These errors were showing up in OpenBSD and other Unixen (which I think all BSD-based) (Thanks to Kyle George!) * Added fix to Makefile.PL to obtain correct build flags on VMS (Thanks to Eric Milkie!) * Fixed casting of num_params to unsigned int in calls to NewZ in mysql.xs 2006-10-07 Patrick Galbraith , Jim Winstead (3.0007_2) * Added UTF8 patch from Dominic Mitchell (Thanks!) * Fixed declaration of "row" in mysql_st_internal_execute which caused compile errors on some platforms * Fix documentation for _ListDBs to remove incorrect information about limitations of data_sources(). (RT #20843, patch by Ann Barcomb) * Fix typo in example (missing quote). (RT #15086) * Mention in POD that 'localhost' always means to connect via UNIX socket, and 127.0.0.1 must be used for TCP/IP to localhost (RT #14942, reported by Alessandro Ranellucci) * Fix typos in Makefile.PL (RT#16178, reported by Gavin Shelley) 2006-09-08 Jim Winstead , Patrick Galbraith (3.0007_1) (3.0006/3.0006_1 is the same as 3.0005/3.0005_1) * Make sure to call dbd_st_finish when all rows from a statement handle have been fetched. (Bug #20153, Bug #21607, RT #20464, RT #21241) * Patch from Steve Hay to fix bind_param to deal properly with insertion of a NULL into an INT or DOUBLE column using server-side prepare. Converted Steve's dbi.pl script to expose this problem to 40bindparam2 test. * Fix to mysql_st_internal_execute to keep from passing undefined dbh handle member (bind_type_guessing) to parse_param causing crash on OpenBSD. Reported on rt.cpan.org (#20868) by Kyle Georg, as well as info from Sam Smith and Federico Giannici * Cleaned up tests to make sure test table is dropped at end of test. 2006-06-10 Patrick Galbraith do, and bind_param to deal with passing substr to "do" for placeholder value. Thanks Martin Waite for the patch to parse_params (extended to mysql.xs "do" and bind_param for server-side prepared statements. 2006-05-17 Patrick Galbraith do("set character set utf8"); $dbh->do("set names utf8"); to get utf8 back and even then you only get it back if the column is defined as utf8 in mysql. * Fix to dbd_bind_ph to deal with numbers (ints, floats) correctly (Alexey Stroganov) * Test changes - bind_param 41 and 42 * Turned off 70takeimp test 2006-04-29 Patrick Galbraith (3.0002_5) * Fixed bugs 15546 (selectcol_arrayref failing on SHOW TABLES) and 15665, 'USE dbname' failing when driver is not in emulated prepare mode 2005-10-26 Patrick Galbraith (3.0002_4) * Added Guy Harrison's patch for multiple result sets * Fixed bugs with declarations in middle of functions * Cleaned up code, rewrote several loops using pointers instead of iterators * Rewrote 'SHOW', 'ALTER', 'CALL', 'CREATE' toggling code that turns off server prepared statements (these calls are not supported) * Updated documentation 2005-09-28 Patrick Galbraith (3.0002_3) * Added code to mysql_st_internal_execute that determines whether the SV *h is a sth or dbh, and then imports imp_dbh appropriately 2005-09-26 Patrick Galbraith (3.0002_2) * Fixed bug in dbd_st_execute where imp_sth was being imported unecessarily, when only imp_dbh is needed. This caused a core dump in some cases. Thanks to Andy Maas at Proofpoint for his execellent detective work! * Small changes to Makefile.PL to make sure --ps-protocol works as advertised. * Updated install.html with current info about prepared statements and FC RPM/YUM packages. 2005-08-04 Patrick Galbraith (3.0002_1) * Prepared statement support is default now. To turn it off a parameter 'mysql_emulated_prepare' must be turned ON * Better error handling in mysql_internal_execute_ps (renamed from mysql_internal_execute41). Also free the result if error - that could have been a memory bug * Added a simply 'do' to t/35prepare.test to see if you can turn off prepared statements in the 'do' call. * Cleaned up a LOT of cruft. Added more 'caveat' blurbage to old Mysql.pm lib, which will not work with prepared statements 2005-07-06 Parick Galbraith (3.0001_3) * Fix to ensure MYSQL_BIND is only defined when mysql client version is >= 4.1.3. Thanks to Tom Parkison 2005-07-06 Patrick Galbraith (3.0001_2) * Fixed runtime bug (when inserting or updating quotes or double quotes) (Thanks to Brad Choate, Six Apart Ltd.) 2005-07-04 Patrick Galbraith (3.0001_1) * Changed uint argument in safe_sv_fetch to int due to uint not being available on windows unless you include my_globals.h in dbdimp.h, which also breaks on unixen! * Removed // comments from mysql.xs (thanks Bodo Bergman!) 2005-07-03 Patrick Galbraith (3.0000_0) * Special Thanks to Steve Hay for his patch to fix windows * Fixed Makefile.PM for windows compiles * Removed long long type from dbdimp.h * Changed strncasecmp to strncmp (still need a better long-term solution) in dbdimp.c * Modified Makefile.PM to make prepared statements on by default 2005-04-26 Patrick Galbraith (2.9015_3) * Added patch from Stas Beckman for new DBI feature take_imp_data, needed for DBI::Pool * Fix to Statement.pm for old API call for numfields that caused warnings on 40numrows and akmisc tests * Fix to bind_ph to throw an error if trying to bind a non-numeric value as numeric * Better fix for dealing with error condition in $sth->rows() * Fix to bind_param to throw error when trying to bind a non-numeric as numeric 2005-04-04 Patrick Galbraith (2.9015_2) * Merged all code changes from 2.900x tree from the last 9 months - unsafe bind type guessing patch from Dragonchild - Removed mysql.mtest - Fixed sth->rows to return my_ulongloong and also handle error from client API - Fix to make autocommit work was already part of this version - Auto-reconnect bug fixed in 2.9006 included * Added simple test to 35limit test to check if using malicious code in LIMIT ?, ? placeholders works, which it doesn't. * Fix that sets mysql_server_prepare to 0 if SQL statement is 'SHOW ...' which is not supported by prepared statement API currently 2004-10-28 Rudolf Lippan (2.9015_1) * Merged Makefile.PL from 2.9005_3 * Bumped version number to 2.9015 for release of Dev Branch. Which will become 2.9020 when tested and merged into HEAD. * fixed typo/compiler warning in bind_param_guessing '*testchar' should have been 'testchar'. 2004-10-20 Patrick Galbraith patg@mysql.com (Dev-2_9 - 2.9005) * merged changes from 2.9005_1 * fix to blob in dbd_st_fetch (Alexey Stroganov ranger@mysql.com) In case of BLOB/TEXT fields we allocate only 8192 bytes in dbd_describe() for data. Here we know real size of field so we should increase buffer size and refetch column value 2004-07-25 Patrick Galbraith patg@mysql.com (2.9004) * Prepared statement support * Use of mysql_stmt_* API (>= 4.1.3) * mysql_shutdown fix * MySQL Embedded Server support (Alexey Stroganov) * Fixed link failure on MacOSX * Cleaned up tests * Fixed various compile warnings 2003-10-26 Rudy Lippan (2.9003) * Applied patch from Aaron and Chuck that added basic testing of the table_info/column_info functions [Aaron Ross ] * Applied patch removing Jochen Wiedmann's contanct information and also removing the restriction on CD ROM distribution. [Jochen Wiedmen ] * The check for the innodb table type was broken so the transaction tests were skipped even though the database supported transactions. * :sql_types were not being inported in column info, so SQL_VARCAR was thowing an error. Also, the :sql_types were not being pulled into DBD::mysq::db package * Patch for dbdadmin.t so that it respects username and password [Alexey Stroganov ] * Fix for memory leak in bind_param() introduced in 2.9002 (2.9002 changed bind_param so that changing the value of a scalar after binding would not affect what was passed to execute eg: $sth->bind_param(1,$foo); $foo = 'bar' $sth->execute() -- $foo would contain 'bar') [reported by ] * don't define dbd_discon_all so that mysql uses DBI's This fixes a bug whereby DBD::mysql was dropping perl's destruct level. * patch to myld so that it uses strict and fixes scoping problem with $contents [Jochen Wiedmann ] * Modified Makefile.PL so that it gives a usage message if any unknown options are passed in. * patch to INSTALL.pod on how to link DBD::mysql against a static libmysqlclient [Jochen Wiedmann ] 2003-06-22 Rudy Lippan (2.9002) * moved pod into mysql.pm from mysql.pod * Changed the default behaviour of mysql_found_rows, so now 'UPDATE table set field=?' will return the number of rows matched and not the number of rows physically changed. You can get the old behaviour back by adding "mysql_found_rows=0" to the dsn passed to connect. * Updated type_info_all() to be more inline with what DBD::ODBC returns. * Added attribute 'mysql_auto_reconnect' that allows the auto reconnect behaviour to be toggled. : ** NOTE** The behaviour of auto reconnect has changed. If either the MOD_PERL or the GATEWAY_INTERFACE environment variable is set, auto_reconnect will default to ON; otherwise auto_reconnect will default to off. Earlier versions of this driver would always try to reconnect to the database on error; however, this is dangerous because table locks could be lost without the application knowing. * Fixed a segfault with failed reconnects that were trapped in an eval. The next tine DBD::mysql tried to reconnect, the process would segfault. * Added statistics attribute, 'mysql_dbd_stats' which returns a hash ref that contains 2 keys 'auto_reconnects_ok' and 'auto_reconnects_failed'. * Fixed bug where strings that were used in numeric context were not getting quoted on execute(). Now all parameters are bound as varchar by default. **NOTE** this is a change in behaviour that MAY cause problems with some SQL statements. If quoted integers, for example, cause any problems, use bind_param(, undef, SQL_INTEGER) to force a column to be bound as an integer. * Added get_info() method. See 'perldoc DBI' for more info * Added column_info(). See 'perldoc DBI' for more info [Tim Bunce] 2003-03-03 Jochen Wiedmann (2.1026) * Fixed the handling of case insensitive file names. Jan Dubois, * lib/Mysql.pm (listdbs): Added support for user name and password. 2003-01-21 Jochen Wiedmann (2.1025) * lib/DBD/mysql.pm: added support for optional DBI->data_sources() \%attributes parameter. Georg Rehfeld, * lib/DBD/mysql.pod: documented optional DBI->data_sources() \%attributes parameter. Georg Rehfeld, * t/dbdadmin.t: changed to use optional DBI->data_sources() \%attributes parameter. Georg Rehfeld, 2003-01-20 Jochen Wiedmann (2.1024) * dbdimp.c: Fixed missing support for double quotes in ParseParam. JUERD@cpan.org * Test suite: Multiple patches for Windows/CygWin (case insensitive file names and the like). Georg Rehfeld, * lib/DBD/mysql/INSTALL.pod: Added description on how to install with Windows/CygWin. Georg Rehfeld, 2003-01-18 Jochen Wiedmann (2.1023) * Remove compiler warnings Fix some small issues to get it to work with MySQL 4.1 (Mostly checking return values from MySQL API functions) Michael Widenius (2.1022a) 2003-01-03 Jochen Wiedmann (2.1022) * Added hints to Randy Kobes PPM repository, because DBD::mysql is currently missing in ActiveState's repository. 2002-11-18 Jochen Wiedmann (2.1021) * lib/Mysql.pm (errno): Added handling for non-ref arguments. Raphael Hertzog 2002-09-23 Jochen Wiedmann (2.1020) * Added mysql_local_infile option. (Paul DuBois, paul@snake.net) 2002-09-16 Jochen Wiedmann (2.1019) * Added hints to installing DBD::mysql with PPM 3. (Stefan Prehn, stefanprehngmx.de) * Added $DBD::mysql::CLONE 2002-08-12 Jochen Wiedmann (0.2018) * t/dbdadmin.t: The call to func('createdb') was missing user name and password. Wolfgang Friebel * mysql.xs: If the connect in func('...', 'admin') failed, a core dump was triggered. Wolfgang Friebel 2002-05-02 Jochen Wiedmann (0.2017) * dbdimp.c: Added a required check for mysql_errno. Steve Hay 2002-05-01 Jochen Wiedmann (0.2016) * dbdimp.c: Removed use of mysql_eof. Jay Lawrence 2002-04-30 Jochen Wiedmann (0.2015) * Makefile.PL: Removed dbimon and pmysql from the EXE_FILES list. Andreas Koenig 2002-04-17 Jochen Wiedmann (2.1014) * dbdimp.c: Fixed mysql_is_auto_increment. Paul Walmsley and Paul Dubois 2002-04-12 Jochen Wiedmann (2.1013) * dbdimp.c: Added use of mysql_ssl_set. Chris Hanes 2002-04-12 Jochen Wiedmann (2.1012) * Some fixes in the docs. Paul Dubois * Added mysql_is_auto_increment. (Someone else, but forgot his email, sorry!) 2002-02-12 Jochen Wiedmann (2.1011) * Makefile.PL: DBI::DBD is no longer loaded by default, to allow CPAN's requirements detection note and install a missing DBI. 2001-12-28 Jochen Wiedmann (2.1010) * Bumped version number in Mysql/Statement.pm to 1.24, so that it is always higher than that from the Msql-Mysql-modules. 2001-12-28 Jochen Wiedmann (2.1008) * lib/DBD/mysql.pod: Fixed minor bug in an example. 2001-12-27 Jochen Wiedmann (2.1007) * Bumped version number in Mysql.pm to 1.24, so that it is always higher than that from the Msql-Mysql- modules. 2001-12-27 Jochen Wiedmann (2.1006) * Within AutoCommit mode, reconnect is now turned off, because the transaction state is unpredictable otherwise. 2001-12-13 Jochen Wiedmann (2.1005) * dbdimp.c: Added use of SvMAGICAL to dbd_db_quote. Rudy Lippan 2001-11-13 Jochen Wiedmann (2.1004) * Makefile.PL: Fixed handling of --testdb, --testuser, ... 2001-11-05 Jochen Wiedmann (2.1003) * bind_param now using mysql_real_escape_string as well. Dave Rolsky 2001-11-04 Jochen Wiedmann (2.1002) * Added mysql_ssl flag to DBI->connect. 2001-11-04 Jochen Wiedmann (2.1001) * Quoting now based on mysql_real_escape_string. Thanks to Dave Rolsky for suggesting this. 2001-11-02 Jochen Wiedmann (2.1000) * Portability changes for MySQL 4. 2001-05-25 Jochen Wiedmann (2.0901) * dbdimp.c: Fixed $dbh->{mysql_insertid}; added t/insertid.t 2001-04-01 Jochen Wiedmann (2.0900) * Added transaction support for MySQL. (Bob Lyons ) * dbd/dbdimp.c: Fixed MAXLENGTH warning; used to hint for a not existing mysql_maxlength, which should read mysql_max_length. (Paul DuBois ) * Fixed installation problem when a directory was specified, but did not exist. (Will Partain ) * Fixed that mysql_errno wasn't used properly. (Chris Adams ) * Fixed test suite problem, when user name and password have been interpolated. (Bruno Hivert (LMC) ) * mysql_insertid and mysql_affectedrows are no longer treated as integers, but longs. Thanks to Michael G Schwern . 2000-08-20 Jochen Wiedmann (1.2215) * lib/DBD/mysql/Install.pm (Initialize): Adding -lz -lgz by default now. * dbd/dbd.pm.in: Minor doc change. 2000-05-10 Jochen Wiedmann (1.2214) * dbd/dbdimp.c: Fixed bug that timestamp fields weren't quoted. Chris Winters 2000-04-26 Jochen Wiedmann (1.2213) * dbd/dbimon.in: Fixed tags in pod. 2000-04-15 Jochen Wiedmann (1.2212) * Makefile.PL: Fixed use of builder-provided passwords. Buck Huppmann * Makefile.PL: Fixed WIN32 installation. 2000-04-03 Jochen Wiedmann (1.2211) * Fixed $dbh->{Name} (David Jacobs ) 1999-11-30 Jochen Wiedmann (1.2210) * Makefile.PL (SelectDrivers): Hopefully ensured that a README is always created successfully. * Makefile.PL: Fixed docs of --mysql-install etc. (loic@ceic.com) 1999-10-13 Jochen Wiedmann (1.2209) * Fixed bug in $dbh->tables(): Didnt't work with empty databases. 1999-09-17 Jochen Wiedmann (1.2208) * dbd/bindparam.h: Added support for MySQL's double quotes. (Although I don't like it. :-) * dbd/dbd.pm.in: Fixed a lot of docs for deprecated features in favour of current. * Makefile.PL: Fixed use of -e (should be exists). tschulth@debis.com (Thomas Schultheis) * MONEY seems to be a numeric type with mSQL. Ernst Paalvast 1999-09-15 Jochen Wiedmann (1.2207) * dbd/dbdimp.c: Added mysql_connect_timeout. Matthias Urlichs () 1999-08-29 Jochen Wiedmann (1.2206) * dbd/dbimon.in: Fixed a bug in tab completion. (FieldList was used in scalar context). Thanks to "Scott R. Every" * lib/DBD/mysql/Install.pm (Initialize): Now checking for MySQL version 3.22 or later. 1999-08-22 Jochen Wiedmann * lib/DBD/mysql/Install.pm (Initialize): Added sco\d+* to the list of SCO-like operating systems. Thanks to Jukka Inkeri 1999-08-22 Jochen Wiedmann (1.2203) * dbd/dbd.xs.in: Fixed a memory leak in $dbh->quote(). Arun Bhalla 1999-07-22 Jochen Wiedmann (1.2202) * dbd/dbd.pm.in: The hint for experimental software is now enabled or disabled automatically, thanks to ExtUtils::PerlPP. * dbd/dbdimp.c: Changed fprintf to PerlIO_printf, required by DBI 1.14. * nodbd/nodbd.pm.in (quote): Changed ~DBD_DRIVER~ to ~~dbd_driver~~, thanks to Maurice Aubrey . 1999-07-08 Jochen Wiedmann (1.2201) * lib/DBD/mSQL/Install.pm (Initialize): Fixed an ugly bug, that caused unusable Config.pm files. 1999-03-09 Jochen Wiedmann * lib/DBD/mysql/Install.pm (CheckForLibGcc): No longer linking against libgcc.a with OpenBSD. * nodbd/nodbd.pm.in (selectdb): Calling selectdb twice triggered a warning. (Nick Hibma ) * dbd/dbdimp.c: Date and time types now have literal_prefix and suffix set to "'". 1999-01-25 Jochen Wiedmann (1.21_15) * dbd/myMsql.h: mSQL 2.0.6 requires including common/ portability.h. * dbd/dbdimp.c: Fixed some instances of ~var~ to ~~var~~. * Makefile.PL: Added PREREQ_PM to WriteMakefile options. * Renamed Bundle::M(y)sql to Bundle::DBD::mysql and Bundle::DBD::mSQL. 1999-01-05 Jochen Wiedmann (1.21_13) * nodbd/nodbd.pm.in (query): Now setting $db_errstr (Andreas König, andreas.koenig@anima.de). * dbd/dbdimp.c (dbd_db_quote): Giving up to use "NULL" as a static string. :-( My thanks to David Foo (dfoo@web.fairfax.com.au) and Christian Schwarz (schwarz@monet.m.isar.de) for convincing me. * nodbd/nodbd.pm.in (listdbs): Now setting $db_errstr. 1998-12-30 Jochen Wiedmann (1.21_12) * dbd/dbd.pm.in (prepare): Fixed missing attribs argument. Thanks to Peter Ludemann (ludemann@inxight.com). * dbd/dbdimp.c: Portability fixes for Perl 5.005_54. 1998-12-29 Jochen Wiedmann (1.21_11) * Makefile.PL: .pm files are no longer removed, because they are missing in MANIFEST otherwise. 1998-12-22 Jochen Wiedmann (1.21_09) * INSTALL: Updated the WIN32 INSTALLATION section. * nodbd/statement.pm.in (fetchrow): Enhanced compatibility to previous Msql versions by returning the first column now in scalar context. (Andreas König, andreas.koenig@anima.de) * Makefile.PL (Init): Default of installing Msql, Mysql and Msql1 is now "no", unless you already have the Mysql emulation layer installed. * Makefile.PL: Added --config option. 1998-11-20 Jochen Wiedmann (1.21_08) * lib/DBD/mysql/Install.pm (Initialize): Added -lc on Unixware; thanks to Orion Poplawski . * lib/DBD/mysql/Install.pm (Initialize): Added -lzlib on Win32. * dbd/dbd.pm.in (connect): Added $dbh->{'Name'}. * t/dbdadmin.t: Forgot to change _DropDB to func("dropdb", ..., "admin). My thanks to schinder@pobox.com. * Some patches for compatibility with ActiveState Perl. 1998-11-08 Jochen Wiedmann (1.21_07) * _ListTables is now obsolete. * _InsertID, affected_rows, IS_PRI_KEY, is_pri_key, IS_NOT_NULL, is_not_null, IS_KEY, is_key, IS_BLOB, is_blob, IS_NUM, is_num, LENGTH, length, MAXLENGTH, maxlength, NUMROWS, NUMFIELDS, RESULT, result, TABLE, table, format_max_size, format_default_size and format_type_name are now deprecated. * _CreateDB, _DropDB, _ListFields, _ListSelectedFields and _NumRows have been removed. * dbd/dbd.xs.in: $dbh->func('_ListDBs') was closing the socket. Thanks to Lars Kellogg-Stedman . * dbd/dbd.pm.in: $drh->func('_ListDBs' was documented wrong. Thanks to Lars Kellogg-Stedman . 1998-11-06 Jochen Wiedmann (1.21_06) * dbd/dbdimp.c: Changed isspace(c) to c == ' ' in ChopBlanks handling. * dbd/dbdimp.c: Added $dbh->{'mysql_read_default_file'} and $dbh->{'mysql_read_default_group'}. * dbd/dbdimp.c: Added $dbh->{'mysql_insertid'}. 1998-10-23 Jochen Wiedmann (1.21_05) * dbd/dbd.xs.in: Fixed bug in $dbh->quote($n, SQL_INTEGER). * Makefile.PL (CheckForLibGcc()): Disabled linking against libgcc.a under NetBSD. (Curt Sampson, cjs@portal.com) * Forgot to remove the warning for experimental software. * Added Monty's patches for use of mysqlclients. * dbd/dbdimp.c: Added msql_configfile. * Makefile.PL: Added option -static. 1998-10-06 Jochen Wiedmann (1.21_04) * INSTALL: Added hints for Win32 installation. * lib/DBD/mysql/Install.pm: Added portability fixes for Win32 installation with MyODBC. This is now the recommended way of installing DBD::mysql under Win32. 1998-09-27 Jochen Wiedmann (1.21_02) * INSTALL: Added a hint for Remote_Access in msql.conf * nodbd/nodbd.pm.in (quote): Made quote a class method; Andreas König . * dbd/myMsql.h (MyReconnect): Fixed $dbh->ping() for MySQL. My thanks to Nikki Chumakov (nikki@paranoia.ru). * dbd/dbimon.in: Added dump mode. * dbd/dbimon.in: TableList now based on $dbh->tables(), thus portable. * dbd/dbimon.in: Shell completion with TableList case independent. * tests/60leaks.t: No longer calling exit() within BEGIN. (Workaround for a bug within Perl 5.00404) * tests/ak-dbd.t: Removed "local $sth->{PrintError} = 0"; yet another workaround. 1998-07-28 Jochen Wiedmann (1.21_00) * INSTALL: Added a description of the missing-libgcc problem. * INSTALL: Added a patch for the mSQL problem with ORDER BY. * dbd/dbd.pm.in: Added a description of mSQL's problem with ORDER BY. * Fixed pointers to DBI home (was www.hermetica.com, now www.arcana.co.uk) * lib/DBD/mysql/Install.pm (Initialize): Added $ENV{'MYSQL_HEADERDIR'} and $ENV{'MYSQL_LIBDIR'}. * dbd/dbdimp.c: mysql_fetch_lengths() returns longs under MySQL 3.22.04 * nodbd/nodbd.pm.in (errno): Fixed missing definition of $self. * Makefile.PL (InitializeMysql): Looking for libmysqlclient.a and libmysqlclient.so now. * dbd/dbdimp.c (dbd_st_internal_execute): Fixed memory leak, *cdaPtr was not checked for <> NULL. My thanks to Marc Lehmann for the report. * dbd/dbd.pm.in: Added table_info(). 1998-07-16 Jochen Wiedmann (1.19_22) * dbd/dbdimp.c: Added dTHR to some more functions for 5.005 compatibility. Thanks to Chris Leach . * nodbd/statement.pm.in: Changed length to CORE::length in some cases to prevent 5.005 warnings. * Added a section on multithrading to the manual. 1998-07-07 Jochen Wiedmann (1.19_21) * nodbd/nodbd.pm.in (query): Fixed a missing "bless($sth, ...)". My thanks to Ray Zimmermann . (Gives me a familiar feeling to always meet the same people ... :-) 1998-07-06 Jochen Wiedmann (1.19_20) * Makefile.lib (InitializeMsql): Added /usr to the search path for mSQL headers and libraries. * tests/msql1.t (unctrl): Renamed "character" column to "chrctr". ("character" is not a valid column name under msql-2.0.4.1) * dbd/dbd.xs.in (DBD::mysql::ping): Now using mysql_ping(). * dbd/dbdimp.c (_MyLogin): Added mysql_compression. 1998-06-25 Jochen Wiedmann (1.19_19) * dbd/dbdimp.c: Added $sth->{mysql_type} and $sth->{msql_type}, which are in fact just what $sth->{TYPE} used to be. $sth->{TYPE} is now returning portable SQL types. * MANIFEST: Removed nodbd/Makefile.PL.in. * Makefile.PL: Made test databases configurable. 1998-06-14 Jochen Wiedmann (1.19_18) * Makefile.PL: dbdadmin.t was missing in the list of tests * nodbd/nodbd.pm.in (query): Now really returning undef in case of errors. (Possible Perl bug?) * Makefile.PL: Fixed realclean attribute of WriteMakefile. * Makefile.PL (Init): Setting $Data::Dumper::Indent to 1. * Makefile.PL (InitializeMsql): Fixed query for mSQL, if only one version gets installed. * dbd/dbdimp.c: Now calling mysql_init before mysql_connect. * dbd/dbdimp.c: For whatever reason, MyGetProtoInfo was treated like returning a char* under Mysql. 1998-05-16 Jochen Wiedmann (1.19_17) * Makefile.PL: Fixed typo in InitializeMsql (dbiDriver = mSQL1). * dbd/dbdimp.c: mysql_real_connect is now using a dbname argument 1998-05-07 Jochen Wiedmann (1.19_16) * dbd/dbdimp.c: ChopBlanks no longer chops from the left side. * dbd/dbdimp.c: Fixed memory leak in dbd_st_FETCH_internal. 1998-04-13 Jochen Wiedmann (1.19_15) * Added the DBD::mSQL1 and Msql1 drivers. * Fixed minor icompatibilities with perl 5.005. * nodbd/nodbd.pm.in (errmsg): Msql->errmsg() should now recognize error messages in $DBI::errstr (hopefully ...) 1998-04-03 Jochen Wiedmann (1.19_13) * dbd/dbdimp.c: msqlGetProtoInfo returns an int, not a char* (Erik Bertelsen, erik@mediator.uni-c.dk) * dbd/dbdimp.c: Fixed typo in _MyLogin: User was set to NULL when password had zero length. (Erik Bertelsen, erik@mediator.uni-c.dk) * dbd/dbdimp.c: One more time fixing reconnect problems with Mysql and old client libraries (without mysql_real_connect it's just too ugly! :-( 1998-03-15 Jochen Wiedmann (1.19_11) * Makefile.PL: Fixed Bugs in _OdbcParse and version numbers. * dbd/dbimon.in: Fixed bugs in export mode (Nem W. Schlecht ) 1998-02-26 Jochen Wiedmann (1.19_10) * M(y)sqlPerl now emulated by DBI drivers. * dbd/dbdimp.c: Added $dbh->{'info'} and $dbh->{'thread_id'} (mysql only) * dbd/dbimon.in: Fixed minor bug in "rel db test" * dbd/dbimon.in (Connect): Added noecho mode for entering passwords. * dbd/myMsql.c: Fixed bugs in OdbcParse. 1998-02-06 Jochen Wiedmann (1.19_03) * dbd/dbd.xs.in: Fixed $dbh->quote(undef) to return "NULL" and not 'undef'. * Requires DBI 0.93. (I assume it still works with 0.91, but whoever reinstalls Msql-Mysql-modules can well reinstall DBI.) * dbd/dbdimp.c: $sth->fetch* now inactivates the sth in case of errors or no more data; this follows the specification of the 'Active' attribute. * Added a missing DROP TABLE in ak-dbd.t. * Added ODBC style DSN's like DBI:mysql:database=test;host=localhost. 1998-01-20 Jochen Wiedmann (1.19_02) * dbd/dbd.xs.in (quote): Fixed "int len" to "STRLEN len"; the Irix compiler refuses to compile this. (A little bit picky, a warning would really be sufficient here ...) My thanks to Simon Matthews . * Added "LISTINDEX" handling. * Makefile.lib: Now always linking against libgcc.a when using gcc and compiling for MySQL. * tests/mysql.dbtest: Now using "IS NULL" in SQL queries instead of "= NULL". (Required as of mysql 3.21.22) 1998-01-18 Jochen Wiedmann (1.19_01) * README: Added hint for not using msqlperl mailing lists except for MsqlPerl and MysqlPerl related things. * Makefile.lib: Modified version number to contain underscores, so that CPAN considers 1.18xx as the correct version. * dbd/dbimon.in: Leaving pager mode worked unreliable; fixed. Andreas Koenig * tests/akmisc.t, tests/mysql.t, tests/mysql2.t: Minor modifications in the connect parameters for passing the test suite under Windows/NT. 1998-01-07 Jochen Wiedmann (1.1900) * dbd/dbd.xs.in: Implemented $dbh->quote() in XS. * dbd/dbd.xs.in: Added '_Admin' function. * dbd/dbd.xs.in, dbd/dbdimp.c: Added automatic reconnect when mysql returns CR_SERVER_GONE_ERROR. * Makefile.lib (InitializeMysql): Modified order of -I statements (Inside MySQL distribution it can happen that headers of recently installed DBI versions are used instead of the correct headers.) * nodbd/nodbd.xs.in, nodbd/typemap: Supressed warning for undef'd argument in connect method. (Chris Holt, ) * nodbd/nodbd.xs.in: Fixed definition of 'HOST' attribute in dbh's. * Makefile.lib (InitializeMsql): Fixed typo that made MSQL_HOME useless. (Ray Zimmermann, ) * Makefile.lib (InitializeMysql): Fixed typo "lib/mysqlclient.a" to "lib/libmysqlclient.a". (Michael 'Monty' Widenius, ) 1997-12-31 Jochen Wiedmann (1.1823) * Added support for mysql_use_result, requested by Jesse Eversole . * nodbd/typemap: Replaced sv_isa with sv_derived_from so that subclassing works, reported by Gisle Aas . 1997-12-11 Jochen Wiedmann (1.1822) * dbd/myMsql.c: DSN's like DBI:mysql:test;hostname=$host;port=$port haven't been working. * dbd/dbimon.in: POD modifications, suggested by Jesse N. Glick * INSTALL: Added hints for "make test". * nodbd/statement.pm.in (as_string): Still bugs in the new as_string method, thanks to Frank D. Cringle . * Enabled SQL_DATE, SQL_TIME, ... (available in DBI 0.91) * Makefiles: Modified postamble to use a common function which calls module dependent hooks. * nodbd/nodbd.xs.in/fetchinternal: Fixed the problem RETVAL == NULL. Wed Nov 19 19:50:29 1997 Jochen Wiedmann (1.1821) * dbd/dbd.pm.in: Added AUTOLOAD for constants like DBD::mysql::FIELD_TYPE_STRING or DBD::mSQL::CHAR_TYPE. * xtract, dbd/Makefile.PL.in nodbd/Makefile.PL.in: Removed first line in case users perl is different from /usr/local/bin/perl. * All Makefiles: Added chmod for xtracted files. * Added bindparam.h for reuse in DBD::pNET. * Makefile.lib: Some (hopefully) upward compatible modifications for integration into the MySQL distribution. Sat Nov 1 17:04:27 1997 Jochen Wiedmann (1.1820) * xtract: Added "#xtract " ... "#endxtract". * nodbd/statement.pm.in, nodbd/nodbd.pm.in, nodbd/pmsql.in: Using "#xtract now". * Reorganized source tree (again). Wed Oct 29 00:41:41 1997 Jochen Wiedmann (1.1819) * nodbd/bundle.pm.in: Fixed syntax error. * Fixed distribution problems. Not all .pm files have been included. (Only PAUSE should have noticed.) Mon Oct 27 00:50:08 1997 Jochen Wiedmann (1.1818) * nodbd/Makefile.PL.in: Fixed dependencies for "xtract" files. * nodbd/nodbd.xs.in: Fixed ISNUM attribute in fetchinternal. * nodbd/statement.pm.in: Yet one more fix in the new as_string method. :-( * nodbd/statement.pm.in: Msql::Statement::maxlength caches its return value now Sat Oct 25 16:30:01 1997 Jochen Wiedmann (1.1817) * Makefile.PL,dbd/Makefile.PL.in,nodbd/Makefile.PL.in: Added dependencies for files being created from dbd and nodbd directories via the "xtract" script. * nodbd/pmsql.in,nodbd/statement.pm.in: Fixed minor problems with mSQL1; suggested by Andreas Koenig * dbd/dbd.pm.in,tests/ak-dbd.t: Removed support and tests for the old connect methods. * nodbd/statement.pm.in: Fixed bug in Msql::Statement::maxlength. Fri Oct 24 01:29:08 1997 Jochen Wiedmann (1.1816) * dbd/myMsql.c (MyConnect): Fixed use of mysql_real_connect * dbd/dbdimp.c: Added automatic type detection to bind_param * nodbd/statement.pm.in: Modified as_string for more efficiency under MySQL. Added maxlength and isnum methods. (Direct attribute fetches under MySQL, calculated under mSQL.) * nodbd/pmsql.pm.in: Fixed bug in creation of @typelabels: defined &Msql::TEXT_TYPE doesn't work before autoloading it. 1997-10-02 Jochen Wiedmann (1.1815) * dbd/dbd.xs: Fixed bug in insertid; &svsock was used instead of svsock * Fixed bug in nodbd.xs (formerly Mysql.xs): key INSERTID had length of 9 (reported by Maurice Aubrey, ) * t/ak-dbd.t, t/akmisc.t: Added tests for mysql's insertid feature. * Merged source trees of Mysql and Msql. * lib/M(y)sql.pm: Added some words on createdb, dropdb and shutdown to the man page. Missed by Ray Zimmermann (rz10@cornell.edu) * dbd/dbd.xs.in: Implemented $dbh->do as a direct XS call. * dbd/dbd.xs.in, nodbd/nodbd.xs.in: Suppressed some warnings due to uninitialized RETVAL. George Hartlieb (ghartlieb@mail.arc.nasa.gov) 1997-09-29 Andreas Koenig (1.1814) * t/50commit.t: Fixed printing of warning message when commit issues a warning. * lib/DBD/mSQL.pm (connect): Fixed warning in connect, if attrhash is present. * pmsql.PL: Fixed use of Msql 2 constants in @typelabel definition and similar things. * lib/Msql/Statement.pm: Fixed use of Msql::TEXT_TYPE without checking whether we are running Msql 1. DBD::mysql for DBI - Written by Jochen Wiedmann 97.09.27 V1.1812 Added t/50commit.t to test suite. Included in myMsql.h for redefining my_setenv(). Made AutoCommit, Commit and Rollback DBI conformant. Fixed reconnect problems with Mysql: mysql_port was 0 on some systems. Added support of mysql_real_connect to myMsql.c. Fixed Msql::errno returning a char*. Added lib/Bundle::Mysql.pm. Fixed 'use Mysql' to 'require Mysql' in t/mysql2.t. 97.09.12 V1.1810 Fixed bug in dbd_st_FETCH_internal: newRV_noinc was used for the return value. This resulted in invalid cache values, reported by Michael Bletzinger 97.09.12 V1.1809 Adapted changes from DBD-Oracle 0.46 to 0.47; in particular the files Driver.xst and dbd_xsh.h from the DBI distribution are used now. (LongReadLen, LongTruncOk, ... are still meaningless, but they are not that important for m(y)sql: The complete results are in RAM anyways ...) Fixed man page of DBD::M(y)SQL: "@names = $sth->{'NAME'}". Added parameter completion for "set" command to dbimon. 97.09.08 V1.1808 Fixed bug in dbimon, a closing brace was missing causing a syntax error. Fixed problems in the Term::ReadLine::GNU support, reported by Nem W. Schlecht (nem@abattoir.cc.ndsu.nodak.edu). Modified dbimon for internally using the Data::ShowTable module. My thanks to Tim Bunce for the hint. Compatibility fixes for SunOS and Solaris, supplied by Neil Bowers (neilb@cre.canon.co.uk). 97.09.03 V1.1806 Fixed bug in Mysql.xs: $sth->numfields dumped core because no check for a result was done. Fixed bug in lib/Mysql/Statement.pm: Mysql::Statement.as_string did not check for $sth->numfields != 0. Added patch from Nem W. Schlecht (nem@abattoir.cc.ndsu.nodak.edu) for Term::ReadLine::GNU support to pmysql and dbimon. 97.09.03 V1.1805 Fixed bug in DBD::mysql: Executing a non-select statement always returned -1 (unknown number of rows) although the correct number was returned by $sth->rows(). Fixed bug in DBD::mysql: strlen was executed on a NULL value when mysql_fetch_rows returned a NULL field. Added all _ListField attributes to statement handles. Added support for "LISTFIELDS " to $sth->execute. Modified $sth->func("_ListSelectedFields") and $dbh->func("
", "_ListFields") to use the new possibilities; in fact these are only stubs now. Added dbimon. Added some internal attributes for dbimon to DBD::mysql: format_default_size, format_max_size, format_type_name and format_right_justification. 97.08.30 V1.1804 Added "fancy", "quote", "separator" and "escape" commands to pm(y)sql.PL, patch supplied by Nem W Schlecht (nem@abattoir.cc.ndsu.nodak.edu). Modified pm(y)sql.PL and pmsql.PL so that it automatically adapts pm(y)sql for use with Msql and Mysql, respectively. Makefile.PL and M(y)sqlPerl/Makefile.PL now automatically adapt lib/M(y)sql.pm, lib/M(y)sql/Statement.pm and lib/DBD/mSQL.pm or lib/DBD/mysql.pm for use in Msql-modules or Mysql-modules; just copy these files, rename them and run "perl Makefile.PL". 97.08.29 V1.1803 Added mysql_errno() Modified perl modules for use of $driver and isa($driver). Modified Msql.xs and Mysql.xs for use of Package and StPackage. Modified test for fetch of non-result sth in akmisc.t: Msql returns number of rows and not an sth. 97.08.27 Removed use of TEXT_TYPE from pmysql and Mysql/Statement.pm. 97.08.16 Modified mysql.xs, dbdimp.h and dbdimp.c for use in DBD::mSQL. Now using Andreas König´s Makefile.PL from the DBD::mSQL distribution. Added check for disabled '-lgcc' on Linux; this leads to a missing __moddi3 symbol in libmysqlclient.a, when running mysql.so. Added mysqlperl support. 97.08.02 Almost completely rewritten, with the exception of private functions like _ListTables. Implemented bind_param. Test suite rewritten for portability. Many sources moved from mysql.pm and mysql.xs to dbdimp.h; mysql.pm and mysql.xs are now close to Oracle.xs and Oracle.pm. 97.07.28 Added $dbh->quote method. Modified internal use of "char* statement" to "SV* statement". Modified use of mysql_query to mysql_real_query. (The above three things should fix blob problems hopefully.) Bumped revision number to 2.00 because of API changes: The connect method works now as described in the DBI man page, compatibility to DBD::msql seems deprecated. Heavy internal modifications in order to use DBIS->get_fbav(); this gives compatibility to DBI 0.88. Modified test suite to use Test::Harness. Added blob tests. DBD::mysql for DBI - Written by Alligator Descartes 96.06.22 Get new patched version 1.65 from gnat@frii.com Added the memory bug patch to this. 96.06.18 Added pod documentation to mysql.pm and the possibility to retreive insert_id. This was done by Nathan Torkington. Fixed memory bug that sql results never was freed. Now a result is freed when one calls the 'finish' action. The patch was done by gareth@netcom.co.uk & Monty 96.05.27 Changed Makefile.PL after suggestions from Raymond Wiker 96.04.25 Changed the README and fixed a typo in mysql.xs Changed version to DBD-mysql-1.63.1 to have a reference to mSQL-0.63 96.04.19 Updated with differences from DBD:mSQL-0.63 96.11.03 Changed from DBD:mysql-0.60pl10 to DBD:mysql-1.0 by Michael Widenius Original ChangeLog: 18/07/95: Started. Version 0.0.0 ( Totally pre-alpha! ) 19/07/95:22:00 Code now basically seems to work. I've got connection to a database, and clean disconnection. 23:45 I'm now working on the statement cycle stuff, which I've mapped out. It's just a case of coding, which shouldn't take too long, hopefully. Posted notice of approaching doom to perldb-interest. 20/07/95:01:25 Fetching appears to work OK now. I need to read the API on msqlFieldSeek, since I can't work out why fetch is returning the same row over and over! 21/07/95:09:22 Added a field into imp_sth (currow) which keeps track of the current row that's been fetched from the result struct. If I can fix the return codes coming from fetchrow, it'll work! 21/07/95:10:30 Pondered bind variables in cursors. Since there isn't a bind function in the API, I may have to frig the way that prepare/ execute works, ie, move the call to msqlQuery *after* it's done some parsing for bind values......Hm. 21/07/95:10:35 Twiddled some bits in the fetchrow cycle. 23/07/95:15:50 Fetch is fetching a row, but it's not returning it to the calling cycle, so I need to fart about with the sv stuff, which is not amusing me greatly! 26/07/95:23:42 Decided in agreement with Andreas that the first release is to be 0.61! 27/07/95:14:14 Finally! It fucking works! After splendid quantities of hacking around with the prepare/execute/fetchrow/finish cycle it's actually returning rows correctly! NOTE: The SV handling within dbd_describe is shot to buggery, but I've kludged it in mSQL.xs::fetchrow to do a sv_2mortal instead of a sv_mortalcopy. 27/07/95:14:22 Tidied up mSQL.xs::finish to do an msqlFreeResult. Annoyingly enough, there's no return code to msqlFR, so I can't test whether or not it's worked! Bah! 27/07/95:15:15 Altered test to do several bits and bobs. I'm testing INSERT statements now. These only execute an msqlQuery, but the stuff needs to continue to pass through the execute and finish stages cleanly.......*sigh* 27/07/95:15:22 My dubious 'INSERT' check hack works, sort of. Pity it converts the entire statement to lower case.....! 27/07/95:17:33 Twiddled some more stuff so it seems to do CREATE TABLE, INSERT statements too. Of course, there's no error checking yet, but it seems to be OK........Hm. 27/07/95:17:38 Mailed out a statement saying the 0.61 code would be up for grabs as of Monday 31st July! Still waiting on Alpha reports. 27/07/95:12:11 Fixed the lower-case all the INSERT/CREATE &c. statement bug. It now checks to see if you're in quotes. 28/07/95:xx:xx Got a report back from Andreas to say compilation barfs on his Indy. Fixed a load of do_error bugs in dbdimp.c. 13/08/95:18:25 Finally got back to this after a rather long break. Fixed some Makefile.PL bugs that were kicking about. Finally fixed ( or appeared to fix ) the strlen signedness bug in dbdimp.c that may halt compilation on the Indy. Emailed Karsten the debug info to see what's causing problems on the NeXTStep platform. 14/08/95:13:48 Got email back from Andreas. signedness broke mSQL.xs as well! Fixed that and emailed him a quick patch. 14/08/95:14:45 Andreas now has a successful compile. The tests are crap, but appear to ( sort of ) work. 29/08/95:23:18 Converted driver across to new DBI format. It now appears to compile, install and run fairly reasonably. There are some serious messes that need cleared up in it, but it's fundamentally OK, I hope. Announced for pl0 testing. 04/09/95:15:04 Started back on getting the 0.60pl0 out. Tidied up the parsing of statements for INSERT, CREATE &c statements. It just takes the first word of the statement now. 04/09/95:15:19 Looks OK. Tested against DBI 0.63 and looks reasonable. Announced release of 0.60pl1 and put up for ftp. 20/09/95:15:20 Patched a load of stuff including NULLs, and local device handling ( SV ). Released pl4, which was bogus. Released pl5 which should fix those issues. 20/09/95:22:17 Fixed overhang of old DBI bug with DBIc_ENDING remaining in DESTROY in mSQL.xs. Spotted by Marti Rijken and fixed. ( Hopefully! ) 18/10/95:15:13 Added in the missing API chunks for ListTables, ListDBs and ListFields. ListFields isnae working, but I'll fix that sometime soon.... 05/11/95:11:32 Fixed $sth->readblob to return undef. Fixed Makefile.PL, dbdimp.h, mSQL.h, dbdimp.c for release of 0.60pl7. Also tested 'make test' which now works! 23/11/95:19:22 Fixed ListFields from the pointers given to me by Sven V. 24/11/95:03:13 Fixed error handling in all the func methods 24/11/95:13:01 Added 'NumRows' method to statement handles to return the number of rows returned ( or affected ) by a statement.o 30/12/95:18:10 Altered mSQL.pm to allow for hostname:port style connections to known remote port machines. Sets ENV var since the msqlConnect API call doesn't support port arguments. 30/12/95:18:15 Added 'length' key into the hash returned by ListFields, so we can get the scale of the field. 24/03/96:22:34 Fixed bugs and upgraded versioning for perl5.002 to work properly. Released as pl10 -> Lamentable lack of ChangeLog information here! 27/03/97: Tidied up things with regard to 0.61 release. 28/03/97: Patched NULL as undef bug DBD-mysql-4.025/MANIFEST.SKIP0000644000175000017500000000020212230034435013614 0ustar patgpatg\B\.git\b ^blib\/ pm_to_blib \~$ ^Makefile(\.old)?$ .gitignore ^DBD-mysql-\d \.bak$ \.tmp$ \.o$ ^MYMETA mysql.c mysql.xsi mysql.bsDBD-mysql-4.025/lib/0000755000175000017500000000000012235705157012505 5ustar patgpatgDBD-mysql-4.025/lib/DBD/0000755000175000017500000000000012235705157013076 5ustar patgpatgDBD-mysql-4.025/lib/DBD/mysql/0000755000175000017500000000000012235705157014243 5ustar patgpatgDBD-mysql-4.025/lib/DBD/mysql/INSTALL.pod0000644000175000017500000005346012230034435016052 0ustar patgpatg=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, using ActivePerl or Strawberry Perl is recommended, see L and L for details. =item MySQL You need not install the actual MySQL database server, the client files and the development files are sufficient. For example, Fedora Core 4 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. I give some examples: =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 ppm install DBI install DBD-mysql This will fetch the modules 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 DBI 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 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 Koenig. Otherwise you will need to do a manual installation. Some of you, in particular system administrators of multiple sites, will choose automatic installation. All of these installation types have an own section. L. L. 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. e.g. PATH=$PATH:/usr/local/mysql/bin export PATH =head2 CPAN installation Installation of DBD::mysql can be incredibly easy: cpan DBD::mysql 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 are using an older version of Perl, you might instead need a perl -MCPAN -e shell install DBD::mysql 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 gzip -cd DBD-mysql-1.2216.tar.gz | tar xf - 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 SPECIAL SYSTEMS Below you find information on particular systems: =head2 Mac OS X Please see the the post at L (Thanks to Kris Davey for pointing this out to me). I plan to see if I can get the build process to be more intelligent about using build flags that work. It is very difficult as it's not a driver problem per se but a problem in how one builds DBD::mysql with a binary client lib built on a different compiler than the one the user is using. =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 MySQL (if you haven't already) =over =item - download the MySQL Windows Binaries from http://www.mysql.com/downloads/index.html =item - unzip mysql--win.zip into some temporary location =item - start the setup.exe there and follow the instructions =item - start the server =item - alternatively download, install and start the server on a remote server, on what supported OS ever =back Build MySQL clients under Cygwin: =over =item - download the MySQL LINUX source from http://www.mysql.com/downloads/index.html =item - unpack mysql-.tar.gz into some tmp location =item - cd into the unpacked dir mysql- ./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. =item - make This builds all MySQL client parts ... be patient. It should finish finally without any error. =item - 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: =item - 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. =back 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! Build DBD::mysql: =over =item - download DBD-mysql-.tar.gz from CPAN =item - unpack DBD-mysql-.tar.gz =item - cd into unpacked dir DBD-mysql- you probably did that already, if you are reading this! =item - 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. =item - 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. =item - make This should run without error =item - make test with DBD-mysql-2.1022 or earlier you will see several errors in dbdadmin.t, mysql.t and mysql2.t; with later versions you should not get errors (except possibly one, indicating, that some tables could not be dropped. I'm hunting for a solution to that problem, but have none yet). =item - make install This installs DBD::mysql into the Perl hierarchy. =back Notes: This was tested with MySQL version 3.23.54a and DBD::mysql version 2.1022. I patched the above mentioned test scripts and sent the patches to the author of DBD::mysql Jochen Wiedman. Georg Rehfeld 15. Jan. 2003 =head1 KNOWN PROBLEMS =over =item 1.) 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. =item 2.) 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. =item 3.) There are known problems with shared versions of libmysqlclient, at least on some Linux boxes. If you receive an error message similar to install_driver(mysql) failed: Can't load '/usr/lib/perl5/site_perl/i586-linux/auto/DBD/mysql/mysql.so' for module DBD::mysql: File not found at /usr/lib/perl5/i586-linux/5.00404/DynaLoader.pm line 166 then this error message can be misleading: It's not mysql.so that fails being loaded, but libmysqlclient.so! The usual problem is that this file is located in a directory like /usr/lib/mysql where the linker doesn't look for it. The best workaround is using a statically linked mysqlclient library, for example /usr/lib/mysql/libmysqlclient.a The use of a statically linked library is described in the previous section on linker flags. L. L. =item 4.) Red Hat 8 & 9 set the Default locale to UTF which causes problems with MakeMaker. To build DBD::mysql on these systems, do a 'unset LANG' before running 'perl Makefile.PL' =back =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.025/lib/DBD/mysql/GetInfo.pm0000644000175000017500000003723112230034435016127 0ustar patgpatgpackage DBD::mysql::GetInfo; ######################################## # DBD::mysql::GetInfo # # # Generated by DBI::DBD::Metadata # $Author$ <-- the person to blame # $Revision$ # $Date$ use strict; 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'; my $sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.##### my $sql_driver_ver = do { no warnings; sprintf $sql_ver_fmt, split (/./, $DBD::mysql::VERSION); }; 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.025/lib/DBD/mysql.pm0000644000175000017500000017354212235676757014632 0ustar patgpatg#!/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); our $VERSION = '4.025'; 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; } 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 ||= {}; # 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']); if ($DBI::VERSION >= 1.49) { $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; } # Call msqlConnect func in mSQL.xs file # and populate internal handle data. 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 mSQL 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 = $2; my $attr = $3; 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/) { # 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; } 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 statistics_info 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; $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port"; $dbh = DBI->connect($dsn, $user, $password); $drh = DBI->install_driver("mysql"); @databases = DBI->data_sources("mysql"); or @databases = DBI->data_sources("mysql", {"host" => $host, "port" => $port, "user" => $user, password => $pass}); $sth = $dbh->prepare("SELECT * FROM foo WHERE bla"); or $sth = $dbh->prepare("LISTFIELDS $table"); or $sth = $dbh->prepare("LISTINDEX $table $index"); $sth->execute; $numRows = $sth->rows; $numFields = $sth->{'NUM_OF_FIELDS'}; $sth->finish; $rc = $drh->func('createdb', $database, $host, $user, $password, 'admin'); $rc = $drh->func('dropdb', $database, $host, $user, $password, 'admin'); $rc = $drh->func('shutdown', $host, $user, $password, 'admin'); $rc = $drh->func('reload', $host, $user, $password, 'admin'); $rc = $dbh->func('createdb', $database, 'admin'); $rc = $dbh->func('dropdb', $database, 'admin'); $rc = $dbh->func('shutdown', 'admin'); $rc = $dbh->func('reload', 'admin'); =head1 EXAMPLE #!/usr/bin/perl use strict; 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 $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 sections on L, and L below. 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); A C must always be specified. =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). =item mysql_client_found_rows Enables (TRUE value) or disables (FALSE value) the flag CLIENT_FOUND_ROWS while connecting to the MySQL server. This has a somewhat funny effect: Without mysql_client_found_rows, if you perform a query like UPDATE $table SET id = 1 WHERE id = 1 then the MySQL engine will always return 0, because no rows have changed. With mysql_client_found_rows however, it will return the number of rows that have an id 1, as some people are expecting. (At least for compatibility to other engines.) =item mysql_compression As of MySQL 3.22.3, a new feature is supported: 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_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 As of MySQL 3.21.15, 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 database: mysql_ssl=1 This means that your communication with the server will be encrypted. If you turn mysql_ssl on, you might also wish to use the following flags: =item mysql_ssl_client_key =item mysql_ssl_client_cert =item mysql_ssl_ca_file =item mysql_ssl_ca_path =item mysql_ssl_cipher These are used to specify the respective parameters of a call to mysql_ssl_set, if mysql_ssl is turned on. =item mysql_local_infile As of MySQL 3.23.49, 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 As of MySQL 4.1, 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 Prepared statement support (server side prepare) As of 3.0002_1, server side prepare statements were on by default (if your server was >= 4.1.3). As of 3.0009, they were off by default again due to issues with the prepared statement API (all other mysql connectors are set this way until C API issues are resolved). The requirement to use prepared statements still remains that you have a server >= 4.1.3 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 } ); * Note: delimiter for this param is ';' 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 =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"; =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 =head2 Server Administration =over =item admin $rc = $drh->func("createdb", $dbname, [host, user, password,], 'admin'); $rc = $drh->func("dropdb", $dbname, [host, user, password,], 'admin'); $rc = $drh->func("shutdown", [host, user, password,], 'admin'); $rc = $drh->func("reload", [host, user, password,], 'admin'); or $rc = $dbh->func("createdb", $dbname, 'admin'); $rc = $dbh->func("dropdb", $dbname, 'admin'); $rc = $dbh->func("shutdown", 'admin'); $rc = $dbh->func("reload", 'admin'); For server administration you need a server connection. For obtaining this connection you have two options: Either use a driver handle (drh) and supply the appropriate arguments (host, defaults localhost, user, defaults to '' and password, defaults to ''). A driver handle can be obtained with $drh = DBI->install_driver('mysql'); Otherwise reuse the existing connection of a database handle (dbh). There's only one function available for administrative purposes, comparable to the m(y)sqladmin programs. The command being execute depends on the first argument: =over =item createdb Creates the database $dbname. Equivalent to "m(y)sqladmin create $dbname". =item dropdb Drops the database $dbname. Equivalent to "m(y)sqladmin drop $dbname". It should be noted that database deletion is I in any way. Nor is it undo-able from DBI. Once you issue the dropDB() method, the database will be gone! These method should be used at your own risk. =item shutdown Silently shuts down the database engine. (Without prompting!) Equivalent to "m(y)sqladmin shutdown". =item reload Reloads the servers configuration files and/or tables. This can be particularly important if you modify access privileges or create new users. =back =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. $info_hashref = $dhb->{mysql_dbd_stats} DBD::mysql keeps track of some statistics in the mysql_dbd_stats attribute. The following stats are being maintained: =over =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 The DBD::mysql driver also supports the following attribute(s) of database handles (read/write): $bool_value = $dbh->{mysql_auto_reconnect}; $dbh->{mysql_auto_reconnect} = $AutoReconnect ? 1 : 0; =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>. 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 using several ways: - through DSN $dbh= DBI->connect("DBI:mysql:test;mysql_use_result=1", "root", ""); - after creation of database handle $dbh->{'mysql_use_result'}=0; #disable $dbh->{'mysql_use_result'}=1; #enable It is possible to set/unset the C attribute after creation of the statement handle. See below. =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 Chapter 10 of the mysql manual for details. 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. This option is experimental and may change in future versions. =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 via - through DSN my $dbh= DBI->connect('DBI:mysql:test', 'username', 'pass', { mysql_no_autocommit_cmd => 1}) - OR after handle creation $dbh->{mysql_no_autocommit_cmd} = 1; =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 in that case. The most important exception is the C attribute: This 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("QUERY"); $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"); if (!$sth) { die "Error:" . $dbh->errstr . "\n"; } if (!$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_insertid MySQL has the ability to choose unique key values automatically. If this happened, the new ID will be stored in this attribute. An alternative way for accessing this attribute is via $dbh->{'mysql_insertid'}. (Note we are using the $dbh in this case!) =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 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 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