├── .github ├── ISSUE_TEMPLATE │ ├── bug.yml │ ├── config.yml │ └── feature.yml └── workflows │ ├── ci.yml │ ├── ci_mac.yml │ └── container.yml ├── .gitignore ├── .mailmap ├── Changes ├── Dockerfile ├── LICENSE ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README.md ├── constants.h ├── dbdimp.c ├── dbdimp.h ├── lib └── DBD │ ├── mysql.pm │ └── mysql │ ├── GetInfo.pm │ └── INSTALL.pod ├── myld ├── mysql.xs ├── socket.c └── t ├── 00base.t ├── 01caching_sha2_prime.t ├── 05dbcreate.t ├── 10connect.t ├── 15reconnect.t ├── 16dbi-get_info.t ├── 17quote.t ├── 20createdrop.t ├── 25lockunlock.t ├── 29warnings.t ├── 30insertfetch.t ├── 31insertid.t ├── 32insert_error.t ├── 35limit.t ├── 35prepare.t ├── 40bindparam.t ├── 40bindparam2.t ├── 40bit.t ├── 40blobs.t ├── 40catalog.t ├── 40keyinfo.t ├── 40listfields.t ├── 40nulls.t ├── 40nulls_prepare.t ├── 40numrows.t ├── 40server_prepare.t ├── 40server_prepare_crash.t ├── 40server_prepare_error.t ├── 40types.t ├── 41bindparam.t ├── 41blobs_prepare.t ├── 41int_min_max.t ├── 42bindparam.t ├── 43count_params.t ├── 50chopblanks.t ├── 50commit.t ├── 51bind_type_guessing.t ├── 52comment.t ├── 53comment.t ├── 55utf8.t ├── 55utf8_errors.t ├── 55utf8_identifiers.t ├── 55utf8mb4.t ├── 56connattr.t ├── 57trackgtid.t ├── 60leaks.t ├── 65segfault.t ├── 65types.t ├── 70takeimp.t ├── 71impdata.t ├── 75supported_sql.t ├── 76multi_statement.t ├── 80procs.t ├── 81procs.t ├── 85init_command.t ├── 86_bug_36972.t ├── 87async.t ├── 88async-multi-stmts.t ├── 89async-method-check.t ├── 91errcheck.t ├── 92ssl_backronym_vulnerability.t ├── 92ssl_optional.t ├── 92ssl_riddle_vulnerability.t ├── 99_bug_server_prepare_blob_null.t ├── 99compression.t ├── gh352.t ├── gh360.t ├── gh447-paramvalues.t ├── lib.pl ├── manifest.t ├── pod.t ├── rt110983-valid-mysqlfd.t ├── rt118977-zerofill.t ├── rt25389-bin-case.t ├── rt50304-column_info_parentheses.t ├── rt61849-bind-param-buffer-overflow.t ├── rt75353-innodb-lock-timeout.t ├── rt83494-quotes-comments.t ├── rt85919-fetch-lost-connection.t ├── rt86153-reconnect-fail-memory.t ├── rt88006-bit-prepare.t ├── rt91715.t └── version.t /.github/ISSUE_TEMPLATE/bug.yml: -------------------------------------------------------------------------------- 1 | name: Bug Report 2 | description: File a bug report 3 | labels: ["bug"] 4 | assignees: 5 | - dveeden 6 | body: 7 | - type: input 8 | attributes: 9 | label: DBD::mysql version 10 | value: 11 | validations: 12 | required: false 13 | - type: input 14 | attributes: 15 | label: MySQL client version 16 | placeholder: mysql_config --version 17 | validations: 18 | required: false 19 | - type: input 20 | attributes: 21 | label: Server version 22 | placeholder: SELECT VERSION() 23 | validations: 24 | required: false 25 | - type: input 26 | attributes: 27 | label: Operating system version 28 | validations: 29 | required: false 30 | - type: textarea 31 | attributes: 32 | label: What happened? 33 | validations: 34 | required: true 35 | - type: textarea 36 | attributes: 37 | label: Other information 38 | validations: 39 | required: false 40 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/config.yml: -------------------------------------------------------------------------------- 1 | blank_issues_enabled: true 2 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature.yml: -------------------------------------------------------------------------------- 1 | name: Feature Request 2 | description: Request a new feature 3 | labels: ["enhancement"] 4 | assignees: 5 | - dveeden 6 | body: 7 | - type: textarea 8 | attributes: 9 | label: What enhancement would you like in DBD::mysql? 10 | validations: 11 | required: true 12 | - type: textarea 13 | attributes: 14 | label: Other information 15 | validations: 16 | required: false 17 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request, workflow_dispatch] 4 | jobs: 5 | test-mysql: 6 | strategy: 7 | # https://www.mysql.com/support/supportedplatforms/database.html 8 | matrix: 9 | include: 10 | - os: ubuntu-22.04 11 | client: "8.0" 12 | server: "8.0" 13 | - os: ubuntu-22.04 14 | client: "8.0" 15 | server: "8.4" 16 | - os: ubuntu-22.04 17 | client: "8.4" 18 | server: "8.4" 19 | - os: ubuntu-22.04 20 | client: "8.4" 21 | server: "8.0" 22 | - os: ubuntu-22.04 23 | client: "9.3" 24 | server: "8.4" 25 | - os: ubuntu-22.04 26 | client: "9.3" 27 | server: "9.3" 28 | - os: ubuntu-24.04 29 | client: "9.3" 30 | server: "9.3" 31 | runs-on: ${{ matrix.os }} 32 | services: 33 | mysql: 34 | image: container-registry.oracle.com/mysql/community-server:${{ matrix.server }} 35 | env: 36 | MYSQL_ALLOW_EMPTY_PASSWORD: yes 37 | MYSQL_ROOT_HOST: "%" 38 | MYSQL_DATABASE: test 39 | ports: 40 | - 3306:3306 41 | options: --health-cmd="mysqladmin ping" --health-interval=10s --health-timeout=5s --health-retries=3 42 | steps: 43 | - uses: actions/checkout@v4 44 | - name: "Setup generic dependencies" 45 | run: | 46 | sudo apt update 47 | sudo apt install -y \ 48 | gcc \ 49 | gnupg \ 50 | libdbi-perl \ 51 | libdevel-checklib-perl \ 52 | libtest-deep-perl \ 53 | libtest-pod-perl \ 54 | lsb-release \ 55 | make \ 56 | wget \ 57 | - if: matrix.client == '8.0' 58 | run: | 59 | sudo debconf-set-selections < 2 | Patrick Galbraith 3 | Patrick Galbraith 4 | Patrick Galbraith 5 | Patrick Galbraith 6 | Patrick Galbraith <(no author)@50811bd7-b8ce-0310-adc1-d9db26280581> 7 | Patrick Galbraith 8 | Patrick Galbraith 9 | Patrick Galbraith 10 | Rudy Lippan 11 | Jim Winstead 12 | Michiel Beijen 13 | Michiel Beijen 14 | Michiel Beijen 15 | David Steinbrunner 16 | Daniël van Eeden 17 | Pali 18 | Bernt M. Johnsen 19 | H.Merijn Brand - Tux 20 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM perl:5.40 2 | 3 | # Add MySQL APT Repository 4 | RUN apt-get update 5 | RUN apt-get install -y lsb-release debconf-utils cpanminus 6 | ADD https://dev.mysql.com/get/mysql-apt-config_0.8.32-1_all.deb . 7 | RUN DEBIAN_FRONTEND=noninteractive dpkg -i mysql-apt-config_0.8.32-1_all.deb 8 | 9 | RUN apt-get update 10 | RUN apt-get install -y libmysqlclient-dev 11 | RUN cpanm DBD::mysql 12 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | Changes 2 | constants.h 3 | dbdimp.c 4 | dbdimp.h 5 | lib/DBD/mysql.pm 6 | lib/DBD/mysql/GetInfo.pm 7 | lib/DBD/mysql/INSTALL.pod 8 | LICENSE 9 | Makefile.PL 10 | MANIFEST This list of files 11 | MANIFEST.SKIP 12 | myld 13 | mysql.xs 14 | README.md 15 | socket.c 16 | t/00base.t 17 | t/01caching_sha2_prime.t 18 | t/05dbcreate.t 19 | t/10connect.t 20 | t/15reconnect.t 21 | t/16dbi-get_info.t 22 | t/17quote.t 23 | t/20createdrop.t 24 | t/25lockunlock.t 25 | t/29warnings.t 26 | t/30insertfetch.t 27 | t/31insertid.t 28 | t/32insert_error.t 29 | t/35limit.t 30 | t/35prepare.t 31 | t/40bindparam.t 32 | t/40bindparam2.t 33 | t/40bit.t 34 | t/40blobs.t 35 | t/40catalog.t 36 | t/40keyinfo.t 37 | t/40listfields.t 38 | t/40nulls.t 39 | t/40nulls_prepare.t 40 | t/40numrows.t 41 | t/40server_prepare.t 42 | t/40server_prepare_crash.t 43 | t/40server_prepare_error.t 44 | t/40types.t 45 | t/41bindparam.t 46 | t/41blobs_prepare.t 47 | t/41int_min_max.t 48 | t/42bindparam.t 49 | t/43count_params.t 50 | t/50chopblanks.t 51 | t/50commit.t 52 | t/51bind_type_guessing.t 53 | t/52comment.t 54 | t/53comment.t 55 | t/55utf8.t 56 | t/55utf8_errors.t 57 | t/55utf8_identifiers.t 58 | t/55utf8mb4.t 59 | t/56connattr.t 60 | t/57trackgtid.t 61 | t/60leaks.t 62 | t/65segfault.t 63 | t/65types.t 64 | t/70takeimp.t 65 | t/71impdata.t 66 | t/75supported_sql.t 67 | t/76multi_statement.t 68 | t/80procs.t 69 | t/81procs.t 70 | t/85init_command.t 71 | t/86_bug_36972.t 72 | t/87async.t 73 | t/88async-multi-stmts.t 74 | t/89async-method-check.t 75 | t/91errcheck.t 76 | t/92ssl_optional.t 77 | t/92ssl_backronym_vulnerability.t 78 | t/92ssl_riddle_vulnerability.t 79 | t/99compression.t 80 | t/99_bug_server_prepare_blob_null.t 81 | t/gh352.t 82 | t/gh360.t 83 | t/gh447-paramvalues.t 84 | t/lib.pl 85 | t/manifest.t 86 | t/pod.t 87 | t/rt110983-valid-mysqlfd.t 88 | t/rt118977-zerofill.t 89 | t/rt25389-bin-case.t 90 | t/rt50304-column_info_parentheses.t 91 | t/rt61849-bind-param-buffer-overflow.t 92 | t/rt75353-innodb-lock-timeout.t 93 | t/rt83494-quotes-comments.t 94 | t/rt85919-fetch-lost-connection.t 95 | t/rt86153-reconnect-fail-memory.t 96 | t/rt88006-bit-prepare.t 97 | t/rt91715.t 98 | t/version.t 99 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | \B\.git\b 2 | ^blib\/ 3 | pm_to_blib 4 | \~$ 5 | ^Makefile(\.old)?$ 6 | .gitignore 7 | ^DBD-mysql-\d 8 | \.bak$ 9 | \.tmp$ 10 | \.o$ 11 | t/mysql.mtest 12 | ^mysqlEmb\/ 13 | ^MYMETA 14 | mysql.c 15 | mysql.xsi 16 | mysql.bs 17 | appveyor.yml 18 | .mailmap 19 | .travis.yml 20 | .github 21 | Dockerfile 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![.github/workflows/ci.yml](https://github.com/perl5-dbi/DBD-mysql/actions/workflows/ci.yml/badge.svg)](https://github.com/perl5-dbi/DBD-mysql/actions/workflows/ci.yml) 2 | 3 | # DBD::mysql - database driver for Perl 4 | 5 | This is the Perl [DBI](https://metacpan.org/pod/DBI) driver for access to MySQL and MySQL Compatible databases. 6 | 7 | ## Usage 8 | 9 | Usage is described in [DBD::mysql](https://metacpan.org/pod/DBD::mysql). 10 | 11 | ## Building and Testing 12 | 13 | For building DBD::mysql you need a MySQL 8.x or newer client library. 14 | 15 | ``` 16 | perl Makefile.PL 17 | make 18 | make test 19 | ``` 20 | 21 | See the output of `perl Makefile.PL` for how to set database credentials. 22 | 23 | Testing is also done via GitHub action. 24 | 25 | ## Installation 26 | 27 | Installation is described in [DBD::mysql::INSTALL](https://metacpan.org/pod/DBD::mysql::INSTALL). 28 | 29 | ## Support 30 | 31 | This module is maintained and supported on a mailing list, dbi-users. 32 | To subscribe to this list, send an email to 33 | 34 | dbi-users-subscribe@perl.org 35 | 36 | Mailing list archives are at 37 | 38 | [http://groups.google.com/group/perl.dbi.users](http://groups.google.com/group/perl.dbi.users) 39 | -------------------------------------------------------------------------------- /constants.h: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include 5 | 6 | static double mysql_constant(char* name, char* arg) { 7 | errno = 0; 8 | arg= arg; 9 | switch (*name) { 10 | case 'B': 11 | if (strEQ(name, "BLOB_FLAG")) 12 | return BLOB_FLAG; 13 | break; 14 | case 'F': 15 | if (strnEQ(name, "FIELD_TYPE_", 11)) { 16 | char* n = name+11; 17 | switch(*n) { 18 | case 'B': 19 | if (strEQ(n, "BLOB")) 20 | return FIELD_TYPE_BLOB; 21 | break; 22 | case 'C': 23 | if (strEQ(n, "CHAR")) 24 | return FIELD_TYPE_CHAR; 25 | break; 26 | case 'D': 27 | if (strEQ(n, "DECIMAL")) 28 | return FIELD_TYPE_DECIMAL; 29 | if (strEQ(n, "DATE")) 30 | return FIELD_TYPE_DATE; 31 | if (strEQ(n, "DATETIME")) 32 | return FIELD_TYPE_DATETIME; 33 | if (strEQ(n, "DOUBLE")) 34 | return FIELD_TYPE_DOUBLE; 35 | break; 36 | case 'F': 37 | if (strEQ(n, "FLOAT")) 38 | return FIELD_TYPE_FLOAT; 39 | break; 40 | case 'I': 41 | if (strEQ(n, "INT24")) 42 | return FIELD_TYPE_INT24; 43 | break; 44 | case 'L': 45 | if (strEQ(n, "LONGLONG")) 46 | return FIELD_TYPE_LONGLONG; 47 | if (strEQ(n, "LONG_BLOB")) 48 | return FIELD_TYPE_LONG_BLOB; 49 | if (strEQ(n, "LONG")) 50 | return FIELD_TYPE_LONG; 51 | break; 52 | case 'M': 53 | if (strEQ(n, "MEDIUM_BLOB")) 54 | return FIELD_TYPE_MEDIUM_BLOB; 55 | break; 56 | case 'N': 57 | if (strEQ(n, "NULL")) 58 | return FIELD_TYPE_NULL; 59 | break; 60 | case 'S': 61 | if (strEQ(n, "SHORT")) 62 | return FIELD_TYPE_SHORT; 63 | if (strEQ(n, "STRING")) 64 | return FIELD_TYPE_STRING; 65 | break; 66 | case 'T': 67 | if (strEQ(n, "TINY")) 68 | return FIELD_TYPE_TINY; 69 | if (strEQ(n, "TINY_BLOB")) 70 | return FIELD_TYPE_TINY_BLOB; 71 | if (strEQ(n, "TIMESTAMP")) 72 | return FIELD_TYPE_TIMESTAMP; 73 | if (strEQ(n, "TIME")) 74 | return FIELD_TYPE_TIME; 75 | break; 76 | case 'V': 77 | if (strEQ(n, "VAR_STRING")) 78 | return FIELD_TYPE_VAR_STRING; 79 | break; 80 | } 81 | } 82 | break; 83 | case 'N': 84 | if (strEQ(name, "NOT_NULL_FLAG")) 85 | return NOT_NULL_FLAG; 86 | break; 87 | case 'P': 88 | if (strEQ(name, "PRI_KEY_FLAG")) 89 | return PRI_KEY_FLAG; 90 | break; 91 | } 92 | errno = EINVAL; 93 | return 0; 94 | } 95 | 96 | -------------------------------------------------------------------------------- /dbdimp.h: -------------------------------------------------------------------------------- 1 | /* 2 | * DBD::mysql - DBI driver for the MySQL database 3 | * 4 | * Copyright (c) 2005 Patrick Galbraith 5 | * Copyright (c) 2003 Rudolf Lippan 6 | * Copyright (c) 1997-2003 Jochen Wiedmann 7 | * 8 | * Based on DBD::Oracle; DBD::Oracle is 9 | * 10 | * Copyright (c) 1994,1995 Tim Bunce 11 | * 12 | * You may distribute this under the terms of either the GNU General Public 13 | * License or the Artistic License, as specified in the Perl README file. 14 | */ 15 | 16 | #define PERL_NO_GET_CONTEXT 17 | /* 18 | * Header files we use 19 | */ 20 | #include 21 | #include /* installed by the DBI module */ 22 | #include /* Comes with MySQL-devel */ 23 | #include /* Comes MySQL */ 24 | #include /* Comes with MySQL-devel */ 25 | 26 | 27 | #define true 1 28 | #define false 0 29 | 30 | /* 31 | * The following are return codes passed in $h->err in case of 32 | * errors by DBD::mysql. 33 | */ 34 | enum errMsgs { 35 | JW_ERR_CONNECT = 1, 36 | JW_ERR_SELECT_DB, 37 | JW_ERR_STORE_RESULT, 38 | JW_ERR_NOT_ACTIVE, 39 | JW_ERR_QUERY, 40 | JW_ERR_FETCH_ROW, 41 | JW_ERR_LIST_DB, 42 | JW_ERR_CREATE_DB, 43 | JW_ERR_DROP_DB, 44 | JW_ERR_LIST_TABLES, 45 | JW_ERR_LIST_FIELDS, 46 | JW_ERR_LIST_FIELDS_INT, 47 | JW_ERR_LIST_SEL_FIELDS, 48 | JW_ERR_NO_RESULT, 49 | JW_ERR_NOT_IMPLEMENTED, 50 | JW_ERR_ILLEGAL_PARAM_NUM, 51 | JW_ERR_MEM, 52 | JW_ERR_LIST_INDEX, 53 | JW_ERR_SEQUENCE, 54 | AS_ERR_EMBEDDED, 55 | TX_ERR_AUTOCOMMIT, 56 | TX_ERR_COMMIT, 57 | TX_ERR_ROLLBACK, 58 | SL_ERR_NOTAVAILBLE, 59 | }; 60 | 61 | 62 | /* 63 | * Internal constants, used for fetching array attributes 64 | */ 65 | enum av_attribs { 66 | AV_ATTRIB_NAME = 0, 67 | AV_ATTRIB_TABLE, 68 | AV_ATTRIB_TYPE, 69 | AV_ATTRIB_SQL_TYPE, 70 | AV_ATTRIB_IS_PRI_KEY, 71 | AV_ATTRIB_IS_NOT_NULL, 72 | AV_ATTRIB_NULLABLE, 73 | AV_ATTRIB_LENGTH, 74 | AV_ATTRIB_IS_NUM, 75 | AV_ATTRIB_TYPE_NAME, 76 | AV_ATTRIB_PRECISION, 77 | AV_ATTRIB_SCALE, 78 | AV_ATTRIB_MAX_LENGTH, 79 | AV_ATTRIB_IS_KEY, 80 | AV_ATTRIB_IS_BLOB, 81 | AV_ATTRIB_IS_AUTO_INCREMENT, 82 | AV_ATTRIB_LAST /* Dummy attribute, never used, for allocation */ 83 | }; /* purposes only */ 84 | 85 | 86 | /* 87 | * This is our part of the driver handle. We receive the handle as 88 | * an "SV*", say "drh", and receive a pointer to the structure below 89 | * by declaring 90 | * 91 | * D_imp_drh(drh); 92 | * 93 | * This declares a variable called "imp_drh" of type 94 | * "struct imp_drh_st *". 95 | */ 96 | 97 | struct imp_drh_st { 98 | dbih_drc_t com; /* MUST be first element in structure */ 99 | }; 100 | 101 | 102 | /* 103 | * Likewise, this is our part of the database handle, as returned 104 | * by DBI->connect. We receive the handle as an "SV*", say "dbh", 105 | * and receive a pointer to the structure below by declaring 106 | * 107 | * D_imp_dbh(dbh); 108 | * 109 | * This declares a variable called "imp_dbh" of type 110 | * "struct imp_dbh_st *". 111 | */ 112 | struct imp_dbh_st { 113 | dbih_dbc_t com; /* MUST be first element in structure */ 114 | 115 | MYSQL *pmysql; 116 | bool has_transactions; /* boolean indicating support for 117 | * transactions, currently always TRUE for MySQL 118 | */ 119 | bool auto_reconnect; 120 | bool bind_type_guessing; 121 | bool bind_comment_placeholders; 122 | bool no_autocommit_cmd; 123 | bool use_mysql_use_result; /* TRUE if execute should use 124 | * mysql_use_result rather than 125 | * mysql_store_result 126 | */ 127 | bool use_server_side_prepare; 128 | bool disable_fallback_for_server_prepare; 129 | void* async_query_in_flight; 130 | bool enable_utf8; 131 | bool enable_utf8mb4; 132 | struct { 133 | unsigned int auto_reconnects_ok; 134 | unsigned int auto_reconnects_failed; 135 | } stats; 136 | }; 137 | 138 | 139 | /* 140 | * The bind_param method internally uses this structure for storing 141 | * parameters. 142 | */ 143 | typedef struct imp_sth_ph_st { 144 | SV* value; 145 | int type; 146 | } imp_sth_ph_t; 147 | 148 | /* 149 | * The bind_param method internally uses this structure for storing 150 | * parameters. 151 | */ 152 | typedef struct imp_sth_phb_st { 153 | union 154 | { 155 | IV lval; 156 | double dval; 157 | } numeric_val; 158 | unsigned long length; 159 | bool is_null; 160 | } imp_sth_phb_t; 161 | 162 | /* 163 | * The dbd_describe uses this structure for storing 164 | * fields meta info. 165 | * Added ddata, ldata, lldata for accommodate 166 | * being able to use different data types 167 | * 12.02.20004 PMG 168 | */ 169 | typedef struct imp_sth_fbh_st { 170 | unsigned long length; 171 | bool is_null; 172 | bool error; 173 | char *data; 174 | int charsetnr; 175 | double ddata; 176 | IV ldata; 177 | } imp_sth_fbh_t; 178 | 179 | 180 | typedef struct imp_sth_fbind_st { 181 | unsigned long * length; 182 | bool * is_null; 183 | } imp_sth_fbind_t; 184 | 185 | 186 | /* 187 | * Finally our part of the statement handle. We receive the handle as 188 | * an "SV*", say "dbh", and receive a pointer to the structure below 189 | * by declaring 190 | * 191 | * D_imp_sth(sth); 192 | * 193 | * This declares a variable called "imp_sth" of type 194 | * "struct imp_sth_st *". 195 | */ 196 | struct imp_sth_st { 197 | dbih_stc_t com; /* MUST be first element in structure */ 198 | 199 | MYSQL_STMT *stmt; 200 | MYSQL_BIND *bind; 201 | MYSQL_BIND *buffer; 202 | imp_sth_phb_t *fbind; 203 | imp_sth_fbh_t *fbh; 204 | int has_been_bound; 205 | int use_server_side_prepare; /* server side prepare statements? */ 206 | int disable_fallback_for_server_prepare; 207 | 208 | MYSQL_RES* result; /* result */ 209 | int currow; /* number of current row */ 210 | int fetch_done; /* mark that fetch done */ 211 | my_ulonglong row_num; /* total number of rows */ 212 | 213 | int done_desc; /* have we described this sth yet ? */ 214 | long long_buflen; /* length for long/longraw (if >0) */ 215 | bool long_trunc_ok; /* is truncating a long an error */ 216 | my_ulonglong insertid; /* ID of auto insert */ 217 | int warning_count; /* Number of warnings after execute() */ 218 | imp_sth_ph_t* params; /* Pointer to parameter array */ 219 | AV* av_attr[AV_ATTRIB_LAST];/* For caching array attributes */ 220 | int use_mysql_use_result; /* TRUE if execute should use */ 221 | /* mysql_use_result rather than */ 222 | /* mysql_store_result */ 223 | bool is_async; 224 | }; 225 | 226 | 227 | /* 228 | * And last, not least: The prototype definitions. 229 | * 230 | * These defines avoid name clashes for multiple statically linked DBD's */ 231 | #define dbd_init mysql_dr_init 232 | #define dbd_db_login mysql_db_login 233 | #define dbd_db_do mysql_db_do 234 | #define dbd_db_commit mysql_db_commit 235 | #define dbd_db_rollback mysql_db_rollback 236 | #define dbd_db_disconnect mysql_db_disconnect 237 | #define dbd_db_destroy mysql_db_destroy 238 | #define dbd_db_STORE_attrib mysql_db_STORE_attrib 239 | #define dbd_db_FETCH_attrib mysql_db_FETCH_attrib 240 | #define dbd_discon_all mysql_discon_all 241 | #define dbd_st_prepare mysql_st_prepare 242 | #define dbd_st_execute mysql_st_execute 243 | #define dbd_st_fetch mysql_st_fetch 244 | #define dbd_st_more_results mysql_st_next_results 245 | #define dbd_st_finish mysql_st_finish 246 | #define dbd_st_destroy mysql_st_destroy 247 | #define dbd_st_blob_read mysql_st_blob_read 248 | #define dbd_st_STORE_attrib mysql_st_STORE_attrib 249 | #define dbd_st_FETCH_attrib mysql_st_FETCH_attrib 250 | #define dbd_st_FETCH_internal mysql_st_FETCH_internal 251 | #define dbd_describe mysql_describe 252 | #define dbd_bind_ph mysql_bind_ph 253 | #define BindParam mysql_st_bind_param 254 | #define mymsql_constant mysql_constant 255 | #define do_warn mysql_dr_warn 256 | #define do_error mysql_dr_error 257 | #define dbd_db_type_info_all mysql_db_type_info_all 258 | #define dbd_db_quote mysql_db_quote 259 | #define dbd_db_last_insert_id mysql_db_last_insert_id 260 | 261 | #include 262 | void do_error (SV* h, int rc, const char *what, const char *sqlstate); 263 | 264 | SV *dbd_db_fieldlist (MYSQL_RES* res); 265 | 266 | void dbd_preparse (imp_sth_t *imp_sth, SV *statement); 267 | my_ulonglong mysql_st_internal_execute(SV *, 268 | SV *, 269 | SV *, 270 | int, 271 | imp_sth_ph_t *, 272 | MYSQL_RES **, 273 | MYSQL *, 274 | int); 275 | 276 | my_ulonglong mysql_st_internal_execute41(SV *, 277 | int, 278 | MYSQL_RES **, 279 | MYSQL_STMT *, 280 | MYSQL_BIND *, 281 | int *); 282 | 283 | 284 | int mysql_st_clean_cursor(SV*, imp_sth_t*); 285 | 286 | int mysql_st_next_results(SV*, imp_sth_t*); 287 | 288 | AV* dbd_db_type_info_all (SV* dbh, imp_dbh_t* imp_dbh); 289 | SV* dbd_db_quote(SV*, SV*, SV*); 290 | extern MYSQL* mysql_dr_connect(SV*, MYSQL*, char*, char*, char*, char*, char*, 291 | char*, imp_dbh_t*); 292 | 293 | extern int mysql_db_reconnect(SV*); 294 | int mysql_st_free_result_sets (SV * sth, imp_sth_t * imp_sth); 295 | int mysql_db_async_result(SV* h, MYSQL_RES** resp); 296 | int mysql_db_async_ready(SV* h); 297 | int mysql_socket_ready(my_socket fd); 298 | 299 | SV* my_ulonglong2sv(pTHX_ my_ulonglong val); 300 | -------------------------------------------------------------------------------- /myld: -------------------------------------------------------------------------------- 1 | # -*- cperl -*- 2 | # 3 | # Small frontend for ld that ought to catch common problems 4 | # in the linking stage 5 | # 6 | 7 | use strict; 8 | use Data::Dumper; 9 | 10 | # fix to get link on Mac OSX to work! 11 | if ($ARGV[0] =~ /MACOSX/) 12 | { 13 | my ($macenv, $macenvval) = split('=',$ARGV[0]);; 14 | $ENV{$macenv} = $macenvval; 15 | shift @ARGV; 16 | } 17 | open(OLDSTDERR, ">&STDERR") || die "Failed to backup STDERR: $!"; 18 | open(FILE, ">myld.stderr") || die "Failed to create myld.stderr: $!"; 19 | open(STDERR, ">&FILE") || die "Failed to redirect STDERR: $!"; 20 | my $retval = system(@ARGV); 21 | 22 | open(STDERR, ">&OLDSTDERR"); 23 | close(FILE) || die "Failed to close myld.stderr: $!"; 24 | my $contents = ""; 25 | if (-f "myld.stderr" && !-z _) { 26 | open(FILE, "; 29 | die "Failed to read myld.stderr: $!" unless defined($contents); 30 | close(FILE) || die "Failed to close myld.stderr: $!"; 31 | 32 | if ($contents =~ /cannot find -l(g?z)/i) { 33 | my $missing = $1; 34 | print <<"MSG"; 35 | $contents 36 | 37 | An error occurred while linking the DBD::mysql driver. The error 38 | message seems to indicate that you don't have a lib$missing.a, 39 | or a lib$missing.so. There are a few ways to resolve this: 40 | 41 | 1) You may try to remove the -lz or -lgz flag from the libs list 42 | by using the --libs switch for "perl Makefile.PL". 43 | 2) On Red Hat Linux and SUSE Linux, install the zlib-devel package 44 | (sometimes called libz-devel) 45 | 3) On Debian and Ubuntu, install the zlib1g-dev package 46 | 4) On other systems, please contact the mailing list 47 | 48 | perl\@lists.mysql.com 49 | 50 | For further hints, see DBD::mysql::INSTALL, section Linker flags. 51 | MSG 52 | exit 1; 53 | } 54 | } 55 | 56 | if ($retval) { 57 | print STDERR $contents; 58 | exit 1; 59 | } 60 | 61 | END { unlink "myld.stderr"; } 62 | -------------------------------------------------------------------------------- /socket.c: -------------------------------------------------------------------------------- 1 | #ifdef _WIN32 2 | #include "windows.h" 3 | #include "winsock.h" 4 | #endif 5 | 6 | #ifndef _WIN32 7 | #include 8 | #include 9 | #endif 10 | 11 | #include 12 | 13 | /* 14 | * Warning: Native socket code must be outside of dbdimp.c and dbdimp.h because 15 | * perl header files redefine socket function. This file must not 16 | * include any perl header files! 17 | */ 18 | 19 | int mysql_socket_ready(my_socket fd) 20 | { 21 | int retval; 22 | 23 | #ifdef _WIN32 24 | /* Windows does not have poll(), so use select() instead */ 25 | struct timeval timeout; 26 | fd_set fds; 27 | 28 | FD_ZERO(&fds); 29 | FD_SET(fd, &fds); 30 | 31 | timeout.tv_sec = 0; 32 | timeout.tv_usec = 0; 33 | 34 | retval = select(fd+1, &fds, NULL, NULL, &timeout); 35 | #else 36 | struct pollfd fds; 37 | 38 | fds.fd = fd; 39 | fds.events = POLLIN; 40 | 41 | retval = poll(&fds, 1, 0); 42 | #endif 43 | 44 | if (retval < 0) { 45 | #ifdef _WIN32 46 | /* Windows does not update errno */ 47 | return -WSAGetLastError(); 48 | #else 49 | return -errno; 50 | #endif 51 | } 52 | 53 | return retval; 54 | } 55 | -------------------------------------------------------------------------------- /t/00base.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More tests => 6; 5 | 6 | # 7 | # Include lib.pl 8 | # 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | # Base DBD Driver Test 13 | BEGIN { 14 | use_ok('DBI') or BAIL_OUT "Unable to load DBI"; 15 | use_ok('DBD::mysql') or BAIL_OUT "Unable to load DBD::mysql"; 16 | } 17 | 18 | my $switch = DBI->internal; 19 | cmp_ok ref $switch, 'eq', 'DBI::dr', 'Internal set'; 20 | 21 | # This is a special case. install_driver should not normally be used. 22 | my $drh= DBI->install_driver('mysql'); 23 | 24 | ok $drh, 'Install driver'; 25 | 26 | cmp_ok ref $drh, 'eq', 'DBI::dr', 'DBI::dr set'; 27 | 28 | ok $drh->{Version}, "Version $drh->{Version}"; 29 | diag "Driver version is ", $drh->{Version}, "\n"; 30 | -------------------------------------------------------------------------------- /t/01caching_sha2_prime.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More ; 5 | use DBI; 6 | $|= 1; 7 | 8 | use vars qw($test_user $test_password $test_db $test_dsn); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | # remove database from DSN 13 | $test_dsn =~ s/^DBI:mysql:([^:]+)(:?)/DBI:mysql:$2/; 14 | 15 | # This should result in a cached sha2 password entry 16 | # The result is that subsequent connections don't need 17 | # TLS or the RSA pubkey. 18 | $test_dsn .= ';mysql_ssl=1;mysql_get_server_pubkey=1'; 19 | 20 | my $dbh; 21 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 22 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 23 | if ($@) { 24 | diag $@; 25 | plan skip_all => "no database connection"; 26 | } 27 | plan tests => 2; 28 | 29 | ok defined $dbh, "Connected to database"; 30 | ok $dbh->disconnect(); 31 | -------------------------------------------------------------------------------- /t/05dbcreate.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More ; 5 | use DBI; 6 | $|= 1; 7 | 8 | use vars qw($test_user $test_password $test_db $test_dsn); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | # remove database from DSN 13 | $test_dsn =~ s/^DBI:mysql:([^:;]+)([:;]?)/DBI:mysql:$2/; 14 | 15 | my $dbh; 16 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 17 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 18 | if ($@) { 19 | diag $@; 20 | plan skip_all => "no database connection"; 21 | } 22 | plan tests => 2; 23 | 24 | ok defined $dbh, "Connected to database"; 25 | eval{ $dbh->do("CREATE DATABASE IF NOT EXISTS $test_db") }; 26 | if($@) { 27 | diag "No permission to '$test_db' database on '$test_dsn' for user '$test_user'"; 28 | } else { 29 | diag "Database '$test_db' accessible"; 30 | } 31 | 32 | ok $dbh->disconnect(); 33 | -------------------------------------------------------------------------------- /t/10connect.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More ; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | $|= 1; 8 | 9 | use vars qw($test_dsn $test_user $test_password $test_db); 10 | use lib 't', '.'; 11 | require 'lib.pl'; 12 | 13 | my $dbh; 14 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 15 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 16 | 17 | if ($@) { 18 | diag $@; 19 | plan skip_all => "no database connection"; 20 | } 21 | 22 | ok(defined $dbh, "Connected to database"); 23 | 24 | for my $attribute ( qw( 25 | mysql_clientinfo 26 | mysql_clientversion 27 | mysql_serverversion 28 | mysql_hostinfo 29 | mysql_serverinfo 30 | mysql_stat 31 | mysql_protoinfo 32 | ) ) { 33 | ok($dbh->{$attribute}, "Value of '$attribute'"); 34 | diag "$attribute is: ". $dbh->{$attribute}; 35 | } 36 | 37 | my $sql_dbms_ver = $dbh->get_info($GetInfoType{SQL_DBMS_VER}); 38 | ok($sql_dbms_ver, 'get_info SQL_DBMS_VER'); 39 | diag "SQL_DBMS_VER is $sql_dbms_ver"; 40 | 41 | my $driver_ver = $dbh->get_info($GetInfoType{SQL_DRIVER_VER}); 42 | like( 43 | $driver_ver, 44 | qr/^\d{2}\.\d{2}\.\d{4}$/, 45 | 'get_info SQL_DRIVER_VER like dd.dd.dddd' 46 | ); 47 | 48 | like($driver_ver, qr/^05\./, 'SQL_DRIVER_VER starts with "05." (update for 6.x)'); 49 | 50 | # storage engine function is @@storage_engine in up to 5.5.03 51 | # at that version, @@default_storage_engine is introduced 52 | # http://dev.mysql.com/doc/refman/5.5/en/server-system-variables.html#sysvar_storage_engine 53 | # in MySQL Server 5.7.5 the old option is removed 54 | # http://dev.mysql.com/doc/refman/5.7/en/server-system-variables.html#sysvar_storage_engine 55 | 56 | my $storage_engine = $dbh->{mysql_serverversion} >= 50503 ? '@@default_storage_engine' : '@@storage_engine'; 57 | my $result = $dbh->selectall_arrayref('select ' . $storage_engine); 58 | my $default_storage_engine = $result->[0]->[0] || 'unknown'; 59 | diag "Default storage engine is: $default_storage_engine"; 60 | 61 | my $info_hashref = $dbh->{mysql_dbd_stats}; 62 | 63 | ok($dbh->disconnect(), 'Disconnected'); 64 | 65 | ok( ! $dbh->ping(), 'dbh is disconnected and did not segv'); 66 | 67 | # dbi docs state: 68 | # The username and password can also be specified using the attributes 69 | # Username and Password, in which case they take precedence over the $username 70 | # and $password parameters. 71 | # see https://rt.cpan.org/Ticket/Display.html?id=89835 72 | 73 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 74 | { RaiseError => 1, PrintError => 1, AutoCommit => 0, 75 | Username => '4yZ73s9qeECdWi', Password => '64heUGwAsVoNqo' });}; 76 | ok($@, 'Username and Password attributes override'); 77 | 78 | eval {$dbh= DBI->connect($test_dsn, '4yZ73s9qeECdWi', '64heUGwAsVoNqo', 79 | { RaiseError => 1, PrintError => 1, AutoCommit => 0, 80 | Username => $test_user, Password => $test_password });}; 81 | ok(!$@, 'Username and Password attributes override'); 82 | 83 | done_testing; 84 | -------------------------------------------------------------------------------- /t/15reconnect.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | $|= 1; 7 | 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | my $dbh; 13 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, AutoCommit => 1})}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | plan tests => 34; 20 | 21 | for my $mysql_server_prepare (0, 1) { 22 | $dbh= DBI->connect("$test_dsn;mysql_server_prepare=$mysql_server_prepare;mysql_server_prepare_disable_fallback=1", $test_user, $test_password, 23 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); 24 | 25 | ok(defined $dbh, "Connected to database"); 26 | 27 | ok($dbh->{Active}, "checking for active handle"); 28 | 29 | ok($dbh->{mysql_auto_reconnect} = 1, "enabling reconnect"); 30 | 31 | ok($dbh->{AutoCommit} = 1, "enabling autocommit"); 32 | 33 | ok ($dbh->do("SET SESSION wait_timeout=2")); 34 | sleep(3); 35 | ok($dbh->do("SELECT 1"), "implicitly reconnecting handle with 'do'"); 36 | ok($dbh->{Active}, "checking for reactivated handle"); 37 | 38 | ok($dbh->disconnect(), "disconnecting active handle"); 39 | 40 | ok(!$dbh->{Active}, "checking for inactive handle"); 41 | 42 | ok($dbh->do("SELECT 1"), "implicitly reconnecting handle with 'do'"); 43 | 44 | ok($dbh->{Active}, "checking for reactivated handle"); 45 | 46 | ok(!($dbh->{AutoCommit} = 0), "disabling autocommit"); 47 | 48 | ok($dbh->disconnect(), "disconnecting active handle"); 49 | 50 | ok(!$dbh->{Active}, "checking for inactive handle"); 51 | 52 | ok( ! $dbh->ping(), 'dbh is disconnected and did not segv'); 53 | 54 | ok(!$dbh->do("SELECT 1"), "implicitly reconnecting handle with 'do'"); 55 | 56 | ok(!$dbh->{Active}, "checking for reactivated handle"); 57 | } 58 | -------------------------------------------------------------------------------- /t/16dbi-get_info.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | $|= 1; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | use lib 't', '.'; 11 | require 'lib.pl'; 12 | 13 | my $dbh; 14 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 15 | { RaiseError => 1, AutoCommit => 1})}; 16 | 17 | if ($@) { 18 | plan skip_all => "no database connection"; 19 | } 20 | 21 | # DBI documentation states: 22 | # Because some DBI methods make use of get_info(), drivers are strongly 23 | # encouraged to support at least the following very minimal set of 24 | # information types to ensure the DBI itself works properly 25 | # so let's test them here 26 | 27 | # DBMS_NAME and DBMS_VERSION are not static, all we can check is they are 28 | # there and they have some sane length 29 | my $dbms_name = $dbh->get_info( $GetInfoType{SQL_DBMS_NAME}); 30 | cmp_ok(length($dbms_name), '>', 4, 'SQL_DBMS_NAME'); 31 | 32 | my $dbms_ver = $dbh->get_info( $GetInfoType{SQL_DBMS_VER}); 33 | cmp_ok(length($dbms_ver), '>', 4, 'SQL_DBMS_VER'); 34 | 35 | # these variables are always the same for MySQL 36 | my %info = ( 37 | SQL_IDENTIFIER_QUOTE_CHAR => '`', 38 | SQL_CATALOG_NAME_SEPARATOR => '.', 39 | SQL_CATALOG_LOCATION => 1, 40 | ); 41 | 42 | for my $option ( keys %info ) { 43 | my $value = $dbh->get_info( $GetInfoType{$option}); 44 | is($value, $info{$option}, $option); 45 | } 46 | 47 | $dbh->disconnect(); 48 | 49 | done_testing; 50 | -------------------------------------------------------------------------------- /t/17quote.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib '.', 't'; 8 | require 'lib.pl'; 9 | 10 | my $dbh; 11 | 12 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, AutoCommit => 1}) or ServerError() ;}; 14 | 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | 19 | my @sqlmodes = (qw/ empty ANSI_QUOTES NO_BACKSLASH_ESCAPES/); 20 | my @words = (qw/ foo foo'bar foo\bar /); 21 | my @results_empty = (qw/ 'foo' 'foo\'bar' 'foo\\\\bar'/); 22 | my @results_ansi = (qw/ 'foo' 'foo\'bar' 'foo\\\\bar'/); 23 | my @results_no_backlslash = (qw/ 'foo' 'foo''bar' 'foo\\bar'/); 24 | my @results = (\@results_empty, \@results_ansi, \@results_no_backlslash); 25 | 26 | plan tests => (@sqlmodes * @words * 3 + 1); 27 | 28 | while (my ($i, $sqlmode) = each @sqlmodes) { 29 | $dbh->do("SET sql_mode=?", undef, $sqlmode eq "empty" ? "" : $sqlmode); 30 | for my $j (0..@words-1) { 31 | ok $dbh->quote($words[$j]); 32 | cmp_ok($dbh->quote($words[$j]), "eq", $results[$i][$j], "$sqlmode $words[$j]"); 33 | 34 | is( 35 | $dbh->selectrow_array('SELECT ?', undef, $words[$j]), 36 | $words[$j], 37 | "Round-tripped '$words[$j]' through a placeholder query" 38 | ); 39 | } 40 | } 41 | 42 | ok $dbh->disconnect; 43 | -------------------------------------------------------------------------------- /t/20createdrop.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | $|= 1; 7 | 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | my $dbh; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | plan tests => 4; 20 | 21 | ok(defined $dbh, "Connected to database"); 22 | 23 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t20createdrop"), "making slate clean"); 24 | 25 | ok($dbh->do("CREATE TABLE dbd_mysql_t20createdrop (id INT(4), name VARCHAR(64))"), "creating dbd_mysql_t20createdrop"); 26 | 27 | ok($dbh->do("DROP TABLE dbd_mysql_t20createdrop"), "dropping created dbd_mysql_t20createdrop"); 28 | 29 | $dbh->disconnect(); 30 | -------------------------------------------------------------------------------- /t/25lockunlock.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 14 | 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | 19 | plan tests => 13; 20 | 21 | my $create= <do("DROP TABLE IF EXISTS dbd_mysql_t25lockunlock"), "drop table if exists dbd_mysql_t25lockunlock"; 29 | 30 | ok $dbh->do($create), "create table dbd_mysql_t25lockunlock"; 31 | 32 | ok $dbh->do("LOCK TABLES dbd_mysql_t25lockunlock WRITE"), "lock table dbd_mysql_t25lockunlock"; 33 | 34 | ok $dbh->do("INSERT INTO dbd_mysql_t25lockunlock VALUES(1, 'Alligator Descartes')"), "Insert "; 35 | 36 | ok $dbh->do("DELETE FROM dbd_mysql_t25lockunlock WHERE id = 1"), "Delete"; 37 | 38 | my $sth; 39 | eval {$sth= $dbh->prepare("SELECT * FROM dbd_mysql_t25lockunlock WHERE id = 1")}; 40 | 41 | ok !$@, "Prepare of select"; 42 | 43 | ok defined($sth), "Prepare of select"; 44 | 45 | ok $sth->execute , "Execute"; 46 | 47 | my ($row, $errstr); 48 | $errstr= ''; 49 | $row = $sth->fetchrow_arrayref; 50 | $errstr= $sth->errstr; 51 | ok !defined($row), "Fetch should have failed"; 52 | ok !defined($errstr), "Fetch should have failed"; 53 | 54 | ok $dbh->do("UNLOCK TABLES"), "Unlock tables"; 55 | 56 | ok $dbh->do("DROP TABLE dbd_mysql_t25lockunlock"), "Drop table dbd_mysql_t25lockunlock"; 57 | ok $dbh->disconnect, "Disconnecting"; 58 | -------------------------------------------------------------------------------- /t/29warnings.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib '.', 't'; 7 | require 'lib.pl'; 8 | $|= 1; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | 12 | my $dbh; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, PrintError => 1, AutoCommit => 0});}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | 20 | if ($dbh->{mysql_serverversion} < 40101) { 21 | plan skip_all => "Servers < 4.1.1 do not report warnings"; 22 | } 23 | 24 | my $expected_warnings = 2; 25 | if ($dbh->{mysql_serverversion} >= 50000 && $dbh->{mysql_serverversion} < 50500) { 26 | $expected_warnings = 1; 27 | } 28 | 29 | plan tests => 14; 30 | 31 | ok(defined $dbh, "Connected to database"); 32 | 33 | ok(my $sth= $dbh->prepare("DROP TABLE IF EXISTS no_such_table")); 34 | ok($sth->execute()); 35 | 36 | is($sth->{mysql_warning_count}, 1, 'warnings from sth'); 37 | 38 | ok($dbh->do("SET sql_mode=''")); 39 | ok($dbh->do("CREATE TEMPORARY TABLE dbd_drv_sth_warnings (c CHAR(1))")); 40 | ok($dbh->do("INSERT INTO dbd_drv_sth_warnings (c) VALUES ('perl'), ('dbd'), ('mysql')")); 41 | is($dbh->{mysql_warning_count}, 3, 'warnings from dbh'); 42 | 43 | 44 | # tests to make sure mysql_warning_count is the same as reported by mysql_info(); 45 | # see https://rt.cpan.org/Ticket/Display.html?id=29363 46 | ok($dbh->do("CREATE TEMPORARY TABLE dbd_drv_count_warnings (i TINYINT NOT NULL)") ); 47 | 48 | my $q = "INSERT INTO dbd_drv_count_warnings VALUES (333),('as'),(3)"; 49 | 50 | ok($sth = $dbh->prepare($q)); 51 | ok($sth->execute()); 52 | 53 | is($sth->{'mysql_warning_count'}, 2 ); 54 | 55 | # $dbh->{info} actually uses mysql_info() 56 | my $str = $dbh->{info}; 57 | my $numwarn; 58 | if ( $str =~ /Warnings:\s(\d+)$/ ) { 59 | $numwarn = $1; 60 | } 61 | 62 | # this test passes on mysql 5.5.x and fails on 5.1.x 63 | # but I'm not sure which versions, so I'll just disable it for now 64 | is($numwarn, $expected_warnings); 65 | 66 | ok($dbh->disconnect); 67 | -------------------------------------------------------------------------------- /t/30insertfetch.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | $|= 1; 10 | 11 | use vars qw($test_dsn $test_user $test_password); 12 | 13 | my $dbh; 14 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 15 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 16 | if ($@) { 17 | plan skip_all => 18 | "no database connection"; 19 | } 20 | 21 | ok(defined $dbh, "Connected to database"); 22 | 23 | ok($dbh->do("CREATE TEMPORARY TABLE dbd_mysql_t30 (id INT(4), name VARCHAR(64))"), "creating table"); 24 | 25 | ok($dbh->do(" 26 | INSERT INTO dbd_mysql_t30 27 | VALUES 28 | (1, 'Alligator Descartes'), 29 | (2, 'Tim Bunce') 30 | "), "loading data"); 31 | 32 | ok(my $info = $dbh->{mysql_info}, "mysql_info '" . $dbh->{mysql_info} . "'"); 33 | 34 | like($info, qr/^Records:\s\d/, 'mysql_info: Records'); 35 | like($info, qr/Duplicates:\s0\s/, 'mysql_info: Duplicates'); 36 | like($info, qr/Warnings: 0$/, 'mysql_info: Warnings'); 37 | 38 | ok( 39 | $dbh->do("DELETE FROM dbd_mysql_t30 WHERE id IN (1,2)"), 40 | "deleting from table dbd_mysql_t30" 41 | ); 42 | 43 | ok (my $sth= $dbh->prepare("SELECT * FROM dbd_mysql_t30 WHERE id = 1")); 44 | 45 | ok($sth->execute()); 46 | 47 | ok(not $sth->fetchrow_arrayref()); 48 | 49 | ok($sth->finish()); 50 | 51 | ok($dbh->disconnect()); 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/31insertid.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require "lib.pl"; 10 | 11 | my $dbh; 12 | eval{$dbh = DBI->connect($test_dsn, $test_user, $test_password, 13 | {RaiseError => 1});}; 14 | 15 | if ($@) { 16 | plan skip_all => 17 | "no database connection"; 18 | } 19 | plan tests => 21; 20 | 21 | SKIP: { 22 | skip 'SET @@auto_increment_offset needs MySQL >= 5.0.2', 2 unless $dbh->{mysql_serverversion} >= 50002; 23 | ok $dbh->do('SET @@auto_increment_offset = 1'); 24 | ok $dbh->do('SET @@auto_increment_increment = 1'); 25 | } 26 | 27 | my $create = <do($create), "create dbd_mysql_t31"; 34 | 35 | my $query= "INSERT INTO dbd_mysql_t31 (name) VALUES (?)"; 36 | 37 | my $sth; 38 | ok ($sth= $dbh->prepare($query)); 39 | 40 | ok defined $sth; 41 | 42 | ok $sth->execute("Jochen"); 43 | 44 | is $sth->{mysql_insertid}, 1, "insert id == $sth->{mysql_insertid}"; 45 | is $dbh->{mysql_insertid}, 1, "insert id == $dbh->{mysql_insertid}"; 46 | is $dbh->last_insert_id(undef, undef, undef, undef), 1, "insert id == last_insert_id()"; 47 | 48 | ok $sth->execute("Patrick"); 49 | 50 | $dbh->ping(); 51 | SKIP: { 52 | skip 'using libmysqlclient 5.7 or up we now have an empty dbh insertid', 53 | 1, if ($dbh->{mysql_clientversion} >= 50700 && $dbh->{mysql_clientversion} < 50718) || ($dbh->{mysql_clientversion} >= 60105 && $dbh->{mysql_clientversion} < 69999) || $dbh->{mysql_clientversion} == 80000; 54 | is $dbh->last_insert_id(undef, undef, undef, undef), 2, "insert id == last_insert_id()"; 55 | } 56 | 57 | ok (my $sth2= $dbh->prepare("SELECT max(id) FROM dbd_mysql_t31")); 58 | 59 | ok defined $sth2; 60 | 61 | ok $sth2->execute(); 62 | 63 | my $max_id; 64 | ok ($max_id= $sth2->fetch()); 65 | 66 | ok defined $max_id; 67 | 68 | SKIP: { 69 | skip 'using libmysqlclient 5.7 below 5.7.18 we now have an empty dbh insertid', 70 | 1, if ($dbh->{mysql_clientversion} >= 50700 && $dbh->{mysql_clientversion} < 50718) || ($dbh->{mysql_clientversion} >= 60105 && $dbh->{mysql_clientversion} < 69999) || $dbh->{mysql_clientversion} == 80000; 71 | cmp_ok $dbh->{mysql_insertid}, '==', $max_id->[0], 72 | "dbh insert id $dbh->{'mysql_insertid'} == max(id) $max_id->[0] in dbd_mysql_t31"; 73 | } 74 | cmp_ok $sth->{mysql_insertid}, '==', $max_id->[0], 75 | "sth insert id $sth->{'mysql_insertid'} == max(id) $max_id->[0] in dbd_mysql_t31"; 76 | 77 | ok $sth->finish(); 78 | ok $sth2->finish(); 79 | ok $dbh->disconnect(); 80 | -------------------------------------------------------------------------------- /t/32insert_error.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use lib '.', 't'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | 11 | my $dbh; 12 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, AutoCommit => 1})}; 14 | 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | plan tests => 9; 19 | 20 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t32"); 21 | 22 | my $create = <do($create); 29 | 30 | my $query = "INSERT INTO dbd_mysql_t32 (id, name) VALUES (?,?)"; 31 | ok (my $sth = $dbh->prepare($query)); 32 | 33 | ok $sth->execute(1, "Jocken"); 34 | 35 | $sth->{PrintError} = 0; 36 | eval {$sth->execute(1, "Jochen")}; 37 | ok defined($@), 'fails with duplicate entry'; 38 | 39 | $sth->{PrintError} = 1; 40 | ok $sth->execute(2, "Jochen"); 41 | 42 | ok $sth->finish; 43 | 44 | ok $dbh->do("DROP TABLE dbd_mysql_t32"); 45 | 46 | ok $dbh->disconnect(); 47 | -------------------------------------------------------------------------------- /t/35limit.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | $|= 1; 8 | 9 | my $rows = 0; 10 | my $sth; 11 | my $testInsertVals; 12 | use vars qw($test_dsn $test_user $test_password); 13 | use lib 't', '.'; 14 | require 'lib.pl'; 15 | 16 | my $dbh; 17 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 18 | { mysql_bind_type_guessing => 1, 19 | RaiseError => 1, 20 | PrintError => 1, 21 | AutoCommit => 1 });}; 22 | 23 | if ($@) { 24 | plan skip_all => "no database connection"; 25 | } 26 | plan tests => 117; 27 | 28 | ok(defined $dbh, "Connected to database"); 29 | 30 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t35"), "making slate clean"); 31 | 32 | ok($dbh->do("CREATE TABLE dbd_mysql_t35 (id INT(4), name VARCHAR(64), name_limit VARCHAR(64), limit_by VARCHAR(64))"), "creating table"); 33 | 34 | ok(($sth = $dbh->prepare("INSERT INTO dbd_mysql_t35 VALUES (?,?,?,?)"))); 35 | 36 | for my $i (0..99) { 37 | my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; 38 | my $random_chars = join '', map { $chars[rand @chars] } 0 .. 16; 39 | 40 | # save these values for later testing 41 | $testInsertVals->{$i} = $random_chars; 42 | ok(($rows = $sth->execute($i, $random_chars, $random_chars, $random_chars))); 43 | } 44 | 45 | ok($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t35 LIMIT ?, ?"), 46 | 'testing prepare of select statement with LIMIT placeholders'); 47 | 48 | ok($sth->execute(20, 50), 'testing exec of bind vars for limit'); 49 | 50 | my ($row, $errstr, $array_ref); 51 | ok( (defined($array_ref = $sth->fetchall_arrayref) && 52 | (!defined($errstr = $sth->errstr) || $sth->errstr eq ''))); 53 | 54 | ok(@$array_ref == 50); 55 | 56 | ok($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t35 WHERE limit_by > ?"), 57 | "testing prepare of select statement with started by 'limit' column"); 58 | 59 | ok($sth->execute("foobar"), 'testing exec of bind vars for placeholder'); 60 | 61 | ok($sth->finish); 62 | 63 | ok($dbh->do("UPDATE dbd_mysql_t35 SET name_limit = ? WHERE id = ?", undef, "updated_string", 1)); 64 | 65 | ok($dbh->do("UPDATE dbd_mysql_t35 SET name = ? WHERE name_limit > ?", undef, "updated_string", 999999)); 66 | 67 | # newline before LIMIT 68 | ok($dbh->do(<<'SQL' 69 | UPDATE dbd_mysql_t35 SET name = ? 70 | LIMIT ? 71 | SQL 72 | , undef, "updated_string", 0)); 73 | 74 | # tab before LIMIT 75 | ok($dbh->do(<<'SQL' 76 | UPDATE dbd_mysql_t35 SET name = ? 77 | LIMIT ? 78 | SQL 79 | , undef, "updated_string", 0)); 80 | 81 | ok($dbh->do("DROP TABLE dbd_mysql_t35")); 82 | 83 | ok($dbh->disconnect); 84 | -------------------------------------------------------------------------------- /t/35prepare.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | my ($row, $sth, $dbh); 10 | my ($def, $rows, $errstr, $ret_ref); 11 | use vars qw($test_dsn $test_user $test_password); 12 | 13 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, AutoCommit => 1});}; 15 | 16 | if ($@) { 17 | plan skip_all => 18 | "no database connection"; 19 | } 20 | plan tests => 49; 21 | 22 | ok(defined $dbh, "Connected to database"); 23 | 24 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t35prepare"), "Making slate clean"); 25 | 26 | ok($dbh->do("CREATE TABLE dbd_mysql_t35prepare (id INT(4), name VARCHAR(64))"), 27 | "Creating table"); 28 | 29 | ok($sth = $dbh->prepare("SHOW TABLES LIKE 'dbd_mysql_t35prepare'"), 30 | "Testing prepare show tables"); 31 | 32 | ok($sth->execute(), "Executing 'show tables'"); 33 | 34 | ok((defined($row= $sth->fetchrow_arrayref) && 35 | (!defined($errstr = $sth->errstr) || $sth->errstr eq '')), 36 | "Testing if result set and no errors"); 37 | 38 | ok($row->[0] eq 'dbd_mysql_t35prepare', "Checking if results equal to 'dbd_mysql_t35prepare' \n"); 39 | 40 | ok($sth->finish, "Finishing up with statement handle"); 41 | 42 | ok($dbh->do("INSERT INTO dbd_mysql_t35prepare VALUES (1,'1st first value')"), 43 | "Inserting first row"); 44 | 45 | ok($sth= $dbh->prepare("INSERT INTO dbd_mysql_t35prepare VALUES (2,'2nd second value')"), 46 | "Preparing insert of second row"); 47 | 48 | ok(($rows = $sth->execute()), "Inserting second row"); 49 | 50 | ok($rows == 1, "One row should have been inserted"); 51 | 52 | ok($sth->finish, "Finishing up with statement handle"); 53 | 54 | ok($sth= $dbh->prepare("SELECT id, name FROM dbd_mysql_t35prepare WHERE id = 1"), 55 | "Testing prepare of query"); 56 | 57 | ok($sth->execute(), "Testing execute of query"); 58 | 59 | ok($ret_ref = $sth->fetchall_arrayref(), 60 | "Testing fetchall_arrayref of executed query"); 61 | 62 | ok($sth= $dbh->prepare("INSERT INTO dbd_mysql_t35prepare values (?, ?)"), 63 | "Preparing insert, this time using placeholders"); 64 | 65 | my $testInsertVals = {}; 66 | for (my $i = 0 ; $i < 10; $i++) 67 | { 68 | my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; 69 | my $random_chars= join '', map { $chars[rand @chars] } 0 .. 16; 70 | # save these values for later testing 71 | $testInsertVals->{$i}= $random_chars; 72 | ok($rows= $sth->execute($i, $random_chars), "Testing insert row"); 73 | ok($rows= 1, "Should have inserted one row"); 74 | } 75 | 76 | ok($sth->finish, "Testing closing of statement handle"); 77 | 78 | ok($sth= $dbh->prepare("SELECT * FROM dbd_mysql_t35prepare WHERE id = ? OR id = ?"), 79 | "Testing prepare of query with placeholders"); 80 | 81 | ok($rows = $sth->execute(1,2), 82 | "Testing execution with values id = 1 or id = 2"); 83 | 84 | ok($ret_ref = $sth->fetchall_arrayref(), 85 | "Testing fetchall_arrayref (should be four rows)"); 86 | 87 | note "RETREF " . scalar @$ret_ref . "\n"; 88 | ok(@{$ret_ref} == 4 , "\$ret_ref should contain four rows in result set"); 89 | 90 | ok($sth= $dbh->prepare("DROP TABLE IF EXISTS dbd_mysql_t35prepare"), 91 | "Testing prepare of dropping table"); 92 | 93 | ok($sth->execute(), "Executing drop table"); 94 | 95 | # Bug #20153: Fetching all data from a statement handle does not mark it 96 | # as finished 97 | ok($sth= $dbh->prepare("SELECT 1"), "Prepare - Testing bug #20153"); 98 | ok($sth->execute(), "Execute - Testing bug #20153"); 99 | ok($sth->fetchrow_arrayref(), "Fetch - Testing bug #20153"); 100 | ok(!($sth->fetchrow_arrayref()),"Not Fetch - Testing bug #20153"); 101 | 102 | # Install a handler so that a warning about unfreed resources gets caught 103 | $SIG{__WARN__} = sub { die @_ }; 104 | 105 | ok($dbh->disconnect(), "Testing disconnect"); 106 | -------------------------------------------------------------------------------- /t/40bindparam.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | use vars qw($test_dsn $test_user $test_password); 9 | 10 | my $dbh; 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; 13 | if ($@) { 14 | plan skip_all => "no database connection"; 15 | } 16 | 17 | if (!MinimumVersion($dbh, '4.1')) { 18 | plan skip_all => 19 | "SKIP TEST: You must have MySQL version 4.1 and greater for this test to run"; 20 | } 21 | 22 | plan tests => 41; 23 | 24 | ok ($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40bindparam")); 25 | 26 | my $create = <do($create)); 34 | 35 | ok (my $sth = $dbh->prepare("INSERT INTO dbd_mysql_t40bindparam VALUES (?, ?)")); 36 | 37 | # Automatic type detection 38 | my $numericVal = 1; 39 | my $charVal = "Alligator Descartes"; 40 | ok ($sth->execute($numericVal, $charVal)); 41 | 42 | # Does the driver remember the automatically detected type? 43 | ok ($sth->execute("3", "Jochen Wiedmann")); 44 | 45 | $numericVal = 2; 46 | $charVal = "Tim Bunce"; 47 | ok ($sth->execute($numericVal, $charVal)); 48 | 49 | # Now try the explicit type settings 50 | ok ($sth->bind_param(1, " 4", SQL_INTEGER())); 51 | 52 | # umlaut equivalent is vowel followed by 'e' 53 | ok ($sth->bind_param(2, 'Andreas Koenig')); 54 | ok ($sth->execute); 55 | 56 | # Works undef -> NULL? 57 | ok ($sth->bind_param(1, 5, SQL_INTEGER())); 58 | 59 | ok ($sth->bind_param(2, undef)); 60 | 61 | ok ($sth->execute); 62 | 63 | ok ($sth->bind_param(1, undef, SQL_INTEGER())); 64 | 65 | ok ($sth->bind_param(2, undef)); 66 | 67 | ok ($sth->execute(-1, "abc")); 68 | 69 | ok ($dbh->do("INSERT INTO dbd_mysql_t40bindparam VALUES (6, '?')")); 70 | 71 | ok ($dbh->do('SET @old_sql_mode = @@sql_mode, @@sql_mode = \'\'')); 72 | 73 | ok ($dbh->do("INSERT INTO dbd_mysql_t40bindparam VALUES (7, \"?\")")); 74 | 75 | ok ($dbh->do('SET @@sql_mode = @old_sql_mode')); 76 | 77 | ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40bindparam ORDER BY id")); 78 | 79 | ok($sth->execute); 80 | 81 | my ($id, $name); 82 | 83 | ok ($sth->bind_columns(undef, \$id, \$name)); 84 | 85 | my $ref = $sth->fetch ; 86 | 87 | is $id, -1, 'id set to -1'; 88 | 89 | cmp_ok $name, 'eq', 'abc', 'name eq abc'; 90 | 91 | $ref = $sth->fetch; 92 | is $id, 1, 'id set to 1'; 93 | cmp_ok $name, 'eq', 'Alligator Descartes', '$name set to Alligator Descartes'; 94 | 95 | $ref = $sth->fetch; 96 | is $id, 2, 'id set to 2'; 97 | cmp_ok $name, 'eq', 'Tim Bunce', '$name set to Tim Bunce'; 98 | 99 | $ref = $sth->fetch; 100 | is $id, 3, 'id set to 3'; 101 | cmp_ok $name, 'eq', 'Jochen Wiedmann', '$name set to Jochen Wiedmann'; 102 | 103 | $ref = $sth->fetch; 104 | is $id, 4, 'id set to 4'; 105 | cmp_ok $name, 'eq', 'Andreas Koenig', '$name set to Andreas Koenig'; 106 | 107 | $ref = $sth->fetch; 108 | is $id, 5, 'id set to 5'; 109 | ok !defined($name), 'name not defined'; 110 | 111 | $ref = $sth->fetch; 112 | is $id, 6, 'id set to 6'; 113 | cmp_ok $name, 'eq', '?', "\$name set to '?'"; 114 | 115 | $ref = $sth->fetch; 116 | is $id, 7, '$id set to 7'; 117 | cmp_ok $name, 'eq', '?', "\$name set to '?'"; 118 | 119 | ok ($dbh->do("DROP TABLE dbd_mysql_t40bindparam")); 120 | 121 | ok $sth->finish; 122 | 123 | ok $dbh->disconnect; 124 | -------------------------------------------------------------------------------- /t/40bindparam2.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my $dbh; 11 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, AutoCommit => 1}) or ServerError();}; 13 | 14 | if ($@) { 15 | plan skip_all => "no database connection"; 16 | } 17 | plan tests => 13; 18 | 19 | SKIP: { 20 | skip 'SET @@auto_increment_offset needs MySQL >= 5.0.2', 2 unless $dbh->{mysql_serverversion} >= 50002; 21 | ok $dbh->do('SET @@auto_increment_offset = 1'); 22 | ok $dbh->do('SET @@auto_increment_increment = 1'); 23 | } 24 | 25 | my $create= <do($create), "create table dbd_mysql_t40bindparam2"; 32 | 33 | ok $dbh->do("INSERT INTO dbd_mysql_t40bindparam2 VALUES(NULL, 1)"), "insert into dbd_mysql_t40bindparam2 (null, 1)"; 34 | 35 | my $rows; 36 | ok ($rows= $dbh->selectall_arrayref("SELECT * FROM dbd_mysql_t40bindparam2")); 37 | 38 | is $rows->[0][1], 1, "\$rows->[0][1] == 1"; 39 | 40 | ok (my $sth = $dbh->prepare("UPDATE dbd_mysql_t40bindparam2 SET num = ? WHERE id = ?")); 41 | 42 | ok ($sth->bind_param(2, 1, SQL_INTEGER())); 43 | 44 | ok ($sth->execute()); 45 | 46 | ok ($sth->finish()); 47 | 48 | ok ($rows = $dbh->selectall_arrayref("SELECT * FROM dbd_mysql_t40bindparam2")); 49 | 50 | ok !defined($rows->[0][1]); 51 | 52 | ok ($dbh->disconnect()); 53 | -------------------------------------------------------------------------------- /t/40bit.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib '.', 't'; 8 | require 'lib.pl'; 9 | 10 | sub VerifyBit ($) { 11 | } 12 | 13 | my $dbh; 14 | my $charset= 'DEFAULT CHARSET=utf8'; 15 | 16 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 17 | { RaiseError => 1, AutoCommit => 1}) or ServerError() ;}; 18 | 19 | if ($@) { 20 | plan skip_all => "no database connection"; 21 | } 22 | 23 | if ($dbh->{mysql_serverversion} < 50008) { 24 | plan skip_all => "Servers < 5.0.8 do not support b'' syntax"; 25 | } 26 | 27 | plan tests => 15; 28 | 29 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_b1"), "Drop table if exists dbd_mysql_b1"; 30 | 31 | ok( $dbh->do('CREATE TABLE dbd_mysql_b1 (b BIT(8))') ); 32 | 33 | ok ($dbh->do("insert into dbd_mysql_b1 set b = b'11111111'")); 34 | ok ($dbh->do("insert into dbd_mysql_b1 set b = b'1010'")); 35 | ok ($dbh->do("insert into dbd_mysql_b1 set b = b'0101'")); 36 | 37 | ok (my $sth = $dbh->prepare("select BIN(b+0) FROM dbd_mysql_b1")); 38 | 39 | ok ($sth->execute); 40 | 41 | ok (my $result = $sth->fetchall_arrayref); 42 | 43 | ok defined($result), "result returned defined"; 44 | 45 | is $result->[0][0], 11111111, "should be 11111111"; 46 | is $result->[1][0], 1010, "should be 1010"; 47 | is $result->[2][0], 101, "should be 101"; 48 | 49 | ok ($sth->finish); 50 | 51 | ok $dbh->do("DROP TABLE dbd_mysql_b1"), "Drop table dbd_mysql_b1"; 52 | 53 | ok $dbh->disconnect; 54 | -------------------------------------------------------------------------------- /t/40blobs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib '.', 't'; 8 | require 'lib.pl'; 9 | 10 | sub ShowBlob($) { 11 | my ($blob) = @_; 12 | my $b; 13 | for (my $i = 0; $i < 8; $i++) { 14 | if (defined($blob) && length($blob) > $i) { 15 | $b = substr($blob, $i*32); 16 | } 17 | else { 18 | $b = ""; 19 | } 20 | note sprintf("%08lx %s\n", $i*32, unpack("H64", $b)); 21 | } 22 | } 23 | 24 | my $dbh; 25 | my $charset= 'DEFAULT CHARSET=utf8'; 26 | 27 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 28 | { RaiseError => 1, AutoCommit => 1}) or ServerError() ;}; 29 | 30 | if ($@) { 31 | plan skip_all => "no database connection"; 32 | } 33 | else { 34 | plan tests => 14; 35 | } 36 | 37 | if (!MinimumVersion($dbh, '4.1')) { 38 | $charset= ''; 39 | } 40 | 41 | my $size= 128; 42 | 43 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40blobs"), "Drop table if exists dbd_mysql_t40blobs"; 44 | 45 | my $create = <do($create)); 52 | 53 | my ($blob, $qblob) = ""; 54 | my $b = ""; 55 | for (my $j = 0; $j < 256; $j++) { 56 | $b .= chr($j); 57 | } 58 | for (1 .. $size) { 59 | $blob .= $b; 60 | } 61 | ok ($qblob = $dbh->quote($blob)); 62 | 63 | # Insert a row into the test table....... 64 | my ($query); 65 | $query = "INSERT INTO dbd_mysql_t40blobs VALUES(1, $qblob)"; 66 | ok ($dbh->do($query)); 67 | 68 | # Now, try SELECT'ing the row out. 69 | ok (my $sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40blobs WHERE id = 1")); 70 | 71 | ok ($sth->execute); 72 | 73 | ok (my $row = $sth->fetchrow_arrayref); 74 | 75 | ok defined($row), "row returned defined"; 76 | 77 | is @$row, 2, "records from dbd_mysql_t40blobs returned 2"; 78 | 79 | is $$row[0], 1, 'id set to 1'; 80 | 81 | cmp_ok byte_string($$row[1]), 'eq', byte_string($blob), 'blob set equal to blob returned'; 82 | 83 | ShowBlob($blob), ShowBlob(defined($$row[1]) ? $$row[1] : ""); 84 | 85 | ok ($sth->finish); 86 | 87 | ok $dbh->do("DROP TABLE dbd_mysql_t40blobs"), "Drop table dbd_mysql_t40blobs"; 88 | 89 | ok $dbh->disconnect; 90 | -------------------------------------------------------------------------------- /t/40keyinfo.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | $|= 1; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 14 | 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | 19 | $dbh->{mysql_server_prepare}= 0; 20 | 21 | ok(defined $dbh, "Connected to database for key info tests"); 22 | 23 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_keyinfo"), "Dropped table"); 24 | 25 | # Non-primary key is there as a regression test for Bug #26786. 26 | ok($dbh->do("CREATE TABLE dbd_mysql_keyinfo (a int, b varchar(20), c int, 27 | primary key (a,b(10)), key (c))"), 28 | "Created table dbd_mysql_keyinfo"); 29 | 30 | my $sth= $dbh->primary_key_info(undef, undef, 'dbd_mysql_keyinfo'); 31 | ok($sth, "Got primary key info"); 32 | 33 | my $key_info= $sth->fetchall_arrayref; 34 | 35 | my $expect= [ 36 | [ undef, undef, 'dbd_mysql_keyinfo', 'a', '1', 'PRIMARY' ], 37 | [ undef, undef, 'dbd_mysql_keyinfo', 'b', '2', 'PRIMARY' ], 38 | ]; 39 | is_deeply($key_info, $expect, "Check primary_key_info results"); 40 | 41 | is_deeply([ $dbh->primary_key(undef, undef, 'dbd_mysql_keyinfo') ], [ 'a', 'b' ], 42 | "Check primary_key results"); 43 | 44 | $sth= $dbh->statistics_info(undef, undef, 'dbd_mysql_keyinfo', 0, 0); 45 | my $stats_info = $sth->fetchall_arrayref; 46 | my $n_catalogs = @$stats_info; 47 | my $n_unique = grep $_->[3], @$stats_info; 48 | $sth= $dbh->statistics_info(undef, undef, 'dbd_mysql_keyinfo', 1, 0); 49 | $stats_info = $sth->fetchall_arrayref; 50 | my $n_unique2 = grep $_->[3], @$stats_info; 51 | isnt($n_unique2, $n_unique, "Check statistics_info unique_only flag has an effect"); 52 | $sth= $dbh->statistics_info('nonexist', undef, 'dbd_mysql_keyinfo', 0, 0); 53 | $stats_info = $sth->fetchall_arrayref; 54 | my $n_catalogs2 = @$stats_info; 55 | isnt($n_catalogs2, $n_catalogs, "Check statistics_info catalog arg has an effect"); 56 | 57 | ok($dbh->do("DROP TABLE dbd_mysql_keyinfo"), "Dropped table"); 58 | 59 | $dbh->disconnect(); 60 | 61 | done_testing; 62 | -------------------------------------------------------------------------------- /t/40listfields.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($COL_NULLABLE $test_dsn $test_user $test_password); 7 | use lib '.', 't'; 8 | require 'lib.pl'; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | my $quoted; 12 | 13 | my $create; 14 | 15 | my $dbh; 16 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 17 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 18 | 19 | if ($@) { 20 | plan skip_all => "no database connection"; 21 | } 22 | plan tests => 25; 23 | 24 | $dbh->{mysql_server_prepare}= 0; 25 | 26 | $create = <do($create), "create table dbd_mysql_40listfields"; 35 | 36 | ok $dbh->table_info(undef,undef,'dbd_mysql_40listfields'), "table info for dbd_mysql_40listfields"; 37 | 38 | ok $dbh->column_info(undef,undef,'dbd_mysql_40listfields','%'), "column_info for dbd_mysql_40listfields"; 39 | 40 | my $sth= $dbh->column_info(undef,undef,"this_does_not_exist",'%'); 41 | 42 | ok $sth, "\$sth defined"; 43 | 44 | ok !$sth->err(), "not error"; 45 | 46 | $sth = $dbh->prepare("SELECT * FROM dbd_mysql_40listfields"); 47 | 48 | ok $sth, "prepare succeeded"; 49 | 50 | ok $sth->execute, "execute select"; 51 | 52 | my $res; 53 | $res = $sth->{'NUM_OF_FIELDS'}; 54 | 55 | ok $res, "$sth->{NUM_OF_FIELDS} defined"; 56 | 57 | is $res, 2, "\$res $res == 2"; 58 | 59 | my $ref = $sth->{'NAME'}; 60 | 61 | ok $ref, "\$sth->{NAME} defined"; 62 | 63 | cmp_ok $$ref[0], 'eq', 'id', "$$ref[0] eq 'id'"; 64 | 65 | cmp_ok $$ref[1], 'eq', 'name', "$$ref[1] eq 'name'"; 66 | 67 | $ref = $sth->{'NULLABLE'}; 68 | 69 | ok $ref, "nullable"; 70 | 71 | ok !($$ref[0] xor (0 & $COL_NULLABLE)); 72 | ok !($$ref[1] xor (1 & $COL_NULLABLE)); 73 | 74 | $ref = $sth->{TYPE}; 75 | 76 | cmp_ok $ref->[0], 'eq', DBI::SQL_INTEGER(), "SQL_INTEGER"; 77 | 78 | cmp_ok $ref->[1], 'eq', DBI::SQL_VARCHAR(), "SQL_VARCHAR"; 79 | 80 | $sth = $dbh->prepare("SELECT * FROM dbd_mysql_40listfields"); 81 | if (!$sth) { 82 | die "Error:" . $dbh->errstr . "\n"; 83 | } 84 | if (!$sth->execute) { 85 | die "Error:" . $sth->errstr . "\n"; 86 | } 87 | 88 | ok ($sth= $dbh->prepare("DROP TABLE dbd_mysql_40listfields")); 89 | 90 | ok($sth->execute); 91 | 92 | ok (! defined $sth->{'NUM_OF_FIELDS'}); 93 | 94 | $quoted = eval { $dbh->quote(0, DBI::SQL_INTEGER()) }; 95 | 96 | ok (!$@); 97 | 98 | cmp_ok $quoted, 'eq', '0', "equals '0'"; 99 | 100 | $quoted = eval { $dbh->quote('abc', DBI::SQL_VARCHAR()) }; 101 | 102 | ok (!$@); 103 | 104 | cmp_ok $quoted, 'eq', "\'abc\'", "equals 'abc'"; 105 | 106 | ok($dbh->disconnect()); 107 | -------------------------------------------------------------------------------- /t/40nulls.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my ($dbh, $sth); 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | if ($@) { 14 | plan skip_all => 15 | "no database connection"; 16 | } 17 | plan tests => 10; 18 | 19 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40nulls"), "DROP TABLE IF EXISTS dbd_mysql_t40nulls"; 20 | 21 | my $create= <do($create), "create table $create"; 28 | 29 | ok $dbh->do("INSERT INTO dbd_mysql_t40nulls VALUES ( NULL, 'NULL-valued id' )"), "inserting nulls"; 30 | 31 | ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40nulls WHERE id IS NULL")); 32 | 33 | do $sth->execute; 34 | 35 | ok (my $aref = $sth->fetchrow_arrayref); 36 | 37 | ok !defined($$aref[0]); 38 | 39 | ok defined($$aref[1]); 40 | 41 | ok $sth->finish; 42 | 43 | ok $dbh->do("DROP TABLE dbd_mysql_t40nulls"); 44 | 45 | ok $dbh->disconnect; 46 | -------------------------------------------------------------------------------- /t/40nulls_prepare.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | my ($row, $sth, $dbh); 10 | my ($table, $def, $rows, $errstr, $ret_ref); 11 | use vars qw($table $test_dsn $test_user $test_password); 12 | 13 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, AutoCommit => 1});}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection", 18 | } 19 | 20 | ok(defined $dbh, "Connected to database"); 21 | 22 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40nullsprepare"), "Making slate clean"); 23 | 24 | my $create= <do($create), "creating test table for bug 49719"); 33 | 34 | my ($sth_insert, $sth_lookup); 35 | 36 | my $insert= 'INSERT INTO dbd_mysql_t40nullsprepare (id, value0, value1, value2) VALUES (?, ?, ?, ?)'; 37 | 38 | ok($sth_insert= $dbh->prepare($insert), "Prepare of insert"); 39 | 40 | my $select= "SELECT * FROM dbd_mysql_t40nullsprepare WHERE id = ?"; 41 | 42 | ok($sth_lookup= $dbh->prepare($select), "Prepare of query"); 43 | 44 | # Insert null value 45 | ok($sth_insert->bind_param(1, 42, DBI::SQL_WVARCHAR), "bind_param(1,42, SQL_WARCHAR)"); 46 | ok($sth_insert->bind_param(2, 102, DBI::SQL_WVARCHAR), "bind_param(2,102,SQL_WARCHAR"); 47 | ok($sth_insert->bind_param(3, undef, DBI::SQL_WVARCHAR), "bind_param(3, undef,SQL_WVARCHAR)"); 48 | ok($sth_insert->bind_param(4, 10004, DBI::SQL_WVARCHAR), "bind_param(4, 10004,SQL_WVARCHAR)"); 49 | ok($sth_insert->execute(), "Executing the first insert"); 50 | 51 | # Insert afterwards none null value 52 | # The bug would insert (DBD::MySQL-4.012) corrupted data.... 53 | # incorrect use of MYSQL_TYPE_NULL in prepared statement in dbdimp.c 54 | ok($sth_insert->bind_param(1, 43, DBI::SQL_WVARCHAR),"bind_param(1,43,SQL_WVARCHAR)"); 55 | ok($sth_insert->bind_param(2, 2002, DBI::SQL_WVARCHAR),"bind_param(2,2002,SQL_WVARCHAR)"); 56 | ok($sth_insert->bind_param(3, 20003, DBI::SQL_WVARCHAR),"bind_param(3,20003,SQL_WVARCHAR)"); 57 | ok($sth_insert->bind_param(4, 200004, DBI::SQL_WVARCHAR),"bind_param(4,200004,SQL_WVARCHAR)"); 58 | ok($sth_insert->execute(), "Executing the 2nd insert"); 59 | 60 | # verify 61 | ok($sth_lookup->execute(42), "Query for record of id = 42"); 62 | is_deeply($sth_lookup->fetchrow_arrayref(), [42, 102, undef, 10004]); 63 | 64 | ok($sth_lookup->execute(43), "Query for record of id = 43"); 65 | is_deeply($sth_lookup->fetchrow_arrayref(), [43, 2002, 20003, 200004]); 66 | 67 | ok($sth_insert->finish()); 68 | ok($sth_lookup->finish()); 69 | 70 | ok $dbh->do("DROP TABLE dbd_mysql_t40nullsprepare"); 71 | 72 | ok($dbh->disconnect(), "Testing disconnect"); 73 | 74 | done_testing; 75 | -------------------------------------------------------------------------------- /t/40numrows.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my ($dbh, $sth, $aref); 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | if ($@) { 14 | plan skip_all => "no database connection"; 15 | } 16 | plan tests => 30; 17 | 18 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t40numrows"); 19 | 20 | my $create= <do($create), "CREATE TABLE dbd_mysql_t40numrows"; 28 | 29 | ok $dbh->do("INSERT INTO dbd_mysql_t40numrows VALUES( 1, 'Alligator Descartes' )"), 'inserting first row'; 30 | 31 | ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows WHERE id = 1")); 32 | 33 | ok $sth->execute; 34 | 35 | is $sth->rows, 1, '\$sth->rows should be 1'; 36 | 37 | ok ($aref= $sth->fetchall_arrayref); 38 | 39 | is scalar @$aref, 1, 'Verified rows should be 1'; 40 | 41 | ok $sth->finish; 42 | 43 | ok $dbh->do("INSERT INTO dbd_mysql_t40numrows VALUES( 2, 'Jochen Wiedmann' )"), 'inserting second row'; 44 | 45 | ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows WHERE id >= 1")); 46 | 47 | ok $sth->execute; 48 | 49 | is $sth->rows, 2, '\$sth->rows should be 2'; 50 | 51 | ok ($aref= $sth->fetchall_arrayref); 52 | 53 | is scalar @$aref, 2, 'Verified rows should be 2'; 54 | 55 | ok $sth->finish; 56 | 57 | ok $dbh->do("INSERT INTO dbd_mysql_t40numrows VALUES(3, 'Tim Bunce')"), "inserting third row"; 58 | 59 | ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows WHERE id >= 2")); 60 | 61 | ok $sth->execute; 62 | 63 | is $sth->rows, 2, 'rows should be 2'; 64 | 65 | ok ($aref= $sth->fetchall_arrayref); 66 | 67 | is scalar @$aref, 2, 'Verified rows should be 2'; 68 | 69 | ok $sth->finish; 70 | 71 | ok ($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t40numrows")); 72 | 73 | ok $sth->execute; 74 | 75 | is $sth->rows, 3, 'rows should be 3'; 76 | 77 | ok ($aref= $sth->fetchall_arrayref); 78 | 79 | is scalar @$aref, 3, 'Verified rows should be 3'; 80 | 81 | ok $dbh->do("DROP TABLE dbd_mysql_t40numrows"), "drop table dbd_mysql_t40numrows"; 82 | 83 | ok $dbh->disconnect; 84 | -------------------------------------------------------------------------------- /t/40server_prepare.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | use vars qw($test_dsn $test_user $test_password); 9 | 10 | $|= 1; 11 | 12 | $test_dsn.= ";mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1"; 13 | 14 | my $dbh; 15 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 16 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 17 | 18 | if ($@) { 19 | plan skip_all => "no database connection"; 20 | } 21 | 22 | if ($dbh->{mysql_clientversion} < 40103 or $dbh->{mysql_serverversion} < 40103) { 23 | plan skip_all => "You must have MySQL version 4.1.3 and greater for this test to run"; 24 | } 25 | 26 | plan tests => 31; 27 | 28 | ok(defined $dbh, "connecting"); 29 | 30 | ok($dbh->do(qq{DROP TABLE IF EXISTS dbd_mysql_t40serverprepare1}), "making slate clean"); 31 | 32 | # 33 | # Bug #20559: Program crashes when using server-side prepare 34 | # 35 | ok($dbh->do(qq{CREATE TABLE dbd_mysql_t40serverprepare1 (id INT, num DOUBLE)}), "creating table"); 36 | 37 | my $sth; 38 | ok($sth= $dbh->prepare(qq{INSERT INTO dbd_mysql_t40serverprepare1 VALUES (?,?),(?,?)}), "loading data"); 39 | ok($sth->execute(1, 3.0, 2, -4.5)); 40 | 41 | ok ($sth= $dbh->prepare("SELECT num FROM dbd_mysql_t40serverprepare1 WHERE id = ? FOR UPDATE")); 42 | 43 | ok ($sth->bind_param(1, 1), "binding parameter"); 44 | 45 | ok ($sth->execute(), "fetching data"); 46 | 47 | is_deeply($sth->fetchall_arrayref({}), [ { 'num' => '3' } ]); 48 | 49 | ok ($sth->finish); 50 | 51 | ok ($dbh->do(qq{DROP TABLE dbd_mysql_t40serverprepare1}), "cleaning up"); 52 | 53 | # 54 | # Bug #42723: Binding server side integer parameters results in corrupt data 55 | # 56 | ok($dbh->do(qq{DROP TABLE IF EXISTS dbd_mysql_t40serverprepare2}), "making slate clean"); 57 | 58 | ok($dbh->do(q{CREATE TABLE `dbd_mysql_t40serverprepare2` (`i` int,`si` smallint,`ti` tinyint,`bi` bigint)}), "creating test table"); 59 | 60 | my $sth2; 61 | ok($sth2 = $dbh->prepare('INSERT INTO dbd_mysql_t40serverprepare2 VALUES (?,?,?,?)')); 62 | 63 | #bind test values 64 | ok($sth2->bind_param(1, 101, DBI::SQL_INTEGER), "binding int"); 65 | ok($sth2->bind_param(2, 102, DBI::SQL_SMALLINT), "binding smallint"); 66 | ok($sth2->bind_param(3, 103, DBI::SQL_TINYINT), "binding tinyint"); 67 | ok($sth2->bind_param(4, '8589934697', DBI::SQL_BIGINT), "binding bigint"); 68 | 69 | ok($sth2->execute(), "inserting data"); 70 | 71 | is_deeply($dbh->selectall_arrayref('SELECT * FROM dbd_mysql_t40serverprepare2'), [[101, 102, 103, '8589934697']]); 72 | 73 | ok ($dbh->do(qq{DROP TABLE dbd_mysql_t40serverprepare2}), "cleaning up"); 74 | 75 | # 76 | # Bug LONGBLOB wants 4GB memory 77 | # 78 | ok($dbh->do(qq{DROP TABLE IF EXISTS t3}), "making slate clean"); 79 | ok($dbh->do(q{CREATE TABLE t3 (id INT, mydata LONGBLOB)}), "creating test table"); 80 | my $sth3; 81 | ok($sth3 = $dbh->prepare(q{INSERT INTO t3 VALUES (?,?)})); 82 | ok($sth3->execute(1, 2), "insert t3"); 83 | 84 | is_deeply($dbh->selectall_arrayref('SELECT id, mydata FROM t3'), [[1, 2]]); 85 | 86 | my $dbname = $dbh->selectrow_arrayref("SELECT DATABASE()")->[0]; 87 | 88 | $dbh->{mysql_server_prepare_disable_fallback} = 1; 89 | my $error_handler_called = 0; 90 | $dbh->{HandleError} = sub { $error_handler_called = 1; die $_[0]; }; 91 | eval { $dbh->prepare('PREPARE stmt FROM "SELECT 1"') }; 92 | $dbh->{HandleError} = undef; 93 | ok($error_handler_called, 'PREPARE statement is not supported with mysql_server_prepare_disable_fallback=1'); 94 | 95 | $dbh->{mysql_server_prepare_disable_fallback} = 0; 96 | my $sth4; 97 | ok($sth4 = $dbh->prepare('PREPARE stmt FROM "SELECT 1"'), 'PREPARE statement is supported with mysql_server_prepare_disable_fallback=0'); 98 | ok($sth4->execute()); 99 | ok($sth4->finish()); 100 | 101 | ok ($dbh->do(qq{DROP TABLE t3}), "cleaning up"); 102 | 103 | $dbh->disconnect(); 104 | -------------------------------------------------------------------------------- /t/40server_prepare_crash.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | require "t/lib.pl"; 9 | 10 | my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 1, AutoCommit => 0, mysql_server_prepare => 1, mysql_server_prepare_disable_fallback => 1 }) }; 11 | plan skip_all => "no database connection" if $@ or not $dbh; 12 | plan skip_all => "You must have MySQL version 4.1.3 and greater for this test to run" if $dbh->{mysql_clientversion} < 40103 or $dbh->{mysql_serverversion} < 40103; 13 | 14 | plan tests => 39; 15 | 16 | my $sth; 17 | 18 | ok $dbh->do("CREATE TEMPORARY TABLE t (i INTEGER NOT NULL, n LONGBLOB)"); 19 | 20 | ok $sth = $dbh->prepare("INSERT INTO t(i, n) VALUES(?, ?)"); 21 | ok $sth->execute(1, "x" x 10); 22 | ok $sth->execute(2, "x" x 100); 23 | ok $sth->execute(3, "x" x 1000); 24 | ok $sth->execute(4, "x" x 10000); 25 | ok $sth->execute(5, "x" x 100000); 26 | ok $sth->execute(6, "x" x 1000000); 27 | ok $sth->finish(); 28 | 29 | ok $sth = $dbh->prepare("SELECT * FROM t WHERE i=? AND n=?"); 30 | 31 | ok $sth->bind_param(2, "x" x 1000000); 32 | ok $sth->bind_param(1, "abcx", 12); 33 | ok $sth->execute(); 34 | 35 | ok $sth->bind_param(2, "a" x 1000000); 36 | ok $sth->bind_param(1, 1, 3); 37 | ok $sth->execute(); 38 | 39 | ok $sth->finish(); 40 | 41 | ok $sth = $dbh->prepare("SELECT * FROM t WHERE i=? AND n=?"); 42 | ok $sth->execute(); 43 | ok $sth->finish(); 44 | 45 | ok $sth = $dbh->prepare("SELECT 1 FROM t WHERE i = ?" . (" OR i = ?" x 10000)); 46 | ok $sth->execute((1) x (10001)); 47 | ok $sth->finish(); 48 | 49 | my $test; 50 | ok $sth = $dbh->prepare("SELECT i,n FROM t WHERE i = ?"); 51 | 52 | ok $sth->execute(1); 53 | ok $sth->fetchrow_arrayref(); 54 | 55 | ok $sth->execute(2); 56 | $test = map { $_ } 'a'; 57 | ok $sth->fetchrow_arrayref(); 58 | 59 | ok $sth->execute(3); 60 | $test = map { $_ } 'b' x 10000000; # try to reuse released memory 61 | ok $sth->fetchrow_arrayref(); 62 | 63 | ok $sth->execute(4); 64 | $test = map { $_ } 'cd' x 10000000; # try to reuse of released memory 65 | ok $sth->fetchrow_arrayref(); 66 | 67 | ok $sth->execute(5); 68 | $test = map { $_ } 'efg' x 10000000; # try to reuse of released memory 69 | ok $sth->fetchrow_arrayref(); 70 | 71 | ok $sth->execute(6); 72 | $test = map { $_ } 'hijk' x 10000000; # try to reuse of released memory 73 | ok $sth->fetchrow_arrayref(); 74 | 75 | ok $sth->finish(); 76 | 77 | ok $dbh->do("SELECT 1 FROM t WHERE i = ?" . (" OR i = ?" x 10000), {}, (1) x (10001)); 78 | 79 | ok $dbh->disconnect(); 80 | -------------------------------------------------------------------------------- /t/40server_prepare_error.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use lib '.', 't'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | 11 | $test_dsn.= ";mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1"; 12 | my $dbh; 13 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, AutoCommit => 1})}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | 20 | if ($dbh->{mysql_clientversion} < 40103 or $dbh->{mysql_serverversion} < 40103) { 21 | plan skip_all => 22 | "SKIP TEST: You must have MySQL version 4.1.3 and greater for this test to run"; 23 | } 24 | plan tests => 3; 25 | 26 | # execute invalid SQL to make sure we get an error 27 | my $q = "select select select"; # invalid SQL 28 | $dbh->{PrintError} = 0; 29 | $dbh->{PrintWarn} = 0; 30 | my $sth; 31 | eval {$sth = $dbh->prepare($q);}; 32 | $dbh->{PrintError} = 1; 33 | $dbh->{PrintWarn} = 1; 34 | ok defined($DBI::errstr); 35 | cmp_ok $DBI::errstr, 'ne', ''; 36 | 37 | note "errstr $DBI::errstr\n" if $DBI::errstr; 38 | ok $dbh->disconnect(); 39 | -------------------------------------------------------------------------------- /t/40types.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use B qw(svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV); 5 | use Test::More; 6 | use DBI; 7 | use DBI::Const::GetInfoType; 8 | use lib '.', 't'; 9 | require 'lib.pl'; 10 | $|= 1; 11 | 12 | use vars qw($test_dsn $test_user $test_password); 13 | 14 | my $dbh; 15 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 16 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 17 | if ($@) { 18 | plan skip_all => 19 | "no database connection"; 20 | } 21 | plan tests => 40; 22 | 23 | ok(defined $dbh, "Connected to database"); 24 | 25 | ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean"); 26 | 27 | ok($dbh->do(qq{CREATE TABLE t1 (num INT)}), "creating table"); 28 | ok($dbh->do(qq{INSERT INTO t1 VALUES (100)}), "loading data"); 29 | 30 | my ($val) = $dbh->selectrow_array("SELECT * FROM t1"); 31 | is($val, 100); 32 | 33 | my $sv = svref_2object(\$val); 34 | ok($sv->FLAGS & SVf_IOK, "scalar is integer"); 35 | ok(!($sv->FLAGS & (SVf_IVisUV|SVf_NOK|SVf_POK)), "scalar is not unsigned intger or double or string"); 36 | 37 | ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); 38 | 39 | ok($dbh->do(qq{CREATE TABLE t1 (num VARCHAR(10))}), "creating table"); 40 | ok($dbh->do(qq{INSERT INTO t1 VALUES ('string')}), "loading data"); 41 | 42 | ($val) = $dbh->selectrow_array("SELECT * FROM t1"); 43 | is($val, "string"); 44 | 45 | $sv = svref_2object(\$val); 46 | ok($sv->FLAGS & SVf_POK, "scalar is string"); 47 | ok(!($sv->FLAGS & (SVf_IOK|SVf_NOK)), "scalar is not intger or double"); 48 | 49 | ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); 50 | 51 | SKIP: { 52 | skip "New Data types not supported by server", 26 53 | if !MinimumVersion($dbh, '5.0'); 54 | 55 | ok($dbh->do(qq{CREATE TABLE t1 (d DECIMAL(5,2))}), "creating table"); 56 | 57 | my $sth= $dbh->prepare("SELECT * FROM t1 WHERE 1 = 0"); 58 | ok($sth->execute(), "getting table information"); 59 | 60 | is_deeply($sth->{TYPE}, [ 3 ], "checking column type"); 61 | 62 | ok($sth->finish); 63 | 64 | ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); 65 | 66 | # 67 | # Bug #23936: bind_param() doesn't work with SQL_DOUBLE datatype 68 | # Bug #24256: Another failure in bind_param() with SQL_DOUBLE datatype 69 | # 70 | ok($dbh->do(qq{CREATE TABLE t1 (num DOUBLE)}), "creating table"); 71 | 72 | $sth= $dbh->prepare("INSERT INTO t1 VALUES (?)"); 73 | ok($sth->bind_param(1, 2.1, DBI::SQL_DOUBLE), "binding parameter"); 74 | ok($sth->execute(), "inserting data"); 75 | ok($sth->finish); 76 | ok($sth->bind_param(1, -1, DBI::SQL_DOUBLE), "binding parameter"); 77 | ok($sth->execute(), "inserting data"); 78 | ok($sth->finish); 79 | 80 | my $ret = $dbh->selectall_arrayref("SELECT * FROM t1"); 81 | is_deeply($ret, [ [2.1], [-1] ]); 82 | 83 | $sv = svref_2object(\$ret->[0]->[0]); 84 | ok($sv->FLAGS & SVf_NOK, "scalar is double"); 85 | ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string"); 86 | 87 | $sv = svref_2object(\$ret->[1]->[0]); 88 | ok($sv->FLAGS & SVf_NOK, "scalar is double"); 89 | ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string"); 90 | 91 | ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); 92 | 93 | # 94 | # [rt.cpan.org #19212] Mysql Unsigned Integer Fields 95 | # 96 | ok($dbh->do(qq{CREATE TABLE t1 (num INT UNSIGNED)}), "creating table"); 97 | ok($dbh->do(qq{INSERT INTO t1 VALUES (0),(4294967295)}), "loading data"); 98 | 99 | $ret = $dbh->selectall_arrayref("SELECT * FROM t1"); 100 | is_deeply($ret, [ [0], [4294967295] ]); 101 | 102 | $sv = svref_2object(\$ret->[0]->[0]); 103 | ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer"); 104 | ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string"); 105 | 106 | $sv = svref_2object(\$ret->[1]->[0]); 107 | ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer"); 108 | ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string"); 109 | 110 | ok($dbh->do(qq{DROP TABLE t1}), "cleaning up"); 111 | }; 112 | 113 | $dbh->disconnect(); 114 | 115 | -------------------------------------------------------------------------------- /t/41bindparam.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require 'lib.pl'; 10 | 11 | my ($dbh, $sth); 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 14 | if ($@) { 15 | plan skip_all => 16 | "no database connection"; 17 | } 18 | plan tests => 11; 19 | 20 | my ($rows, $errstr, $ret_ref); 21 | ok $dbh->do("drop table if exists dbd_mysql_41bindparam"), "drop table dbd_mysql_41bindparam"; 22 | 23 | ok $dbh->do("create table dbd_mysql_41bindparam (a int not null, primary key (a))"), "create table dbd_mysql_41bindparam"; 24 | 25 | ok ($sth= $dbh->prepare("insert into dbd_mysql_41bindparam values (?)")); 26 | 27 | ok $sth->bind_param(1,10000,DBI::SQL_INTEGER), "bind param 10000 col1"; 28 | 29 | ok $sth->execute(), 'execute'; 30 | 31 | ok $sth->bind_param(1,10001,DBI::SQL_INTEGER), "bind param 10001 col1"; 32 | 33 | ok $sth->execute(), 'execute'; 34 | 35 | ok ($sth= $dbh->prepare("DROP TABLE dbd_mysql_41bindparam")); 36 | 37 | ok $sth->execute(); 38 | 39 | ok $sth->finish; 40 | 41 | ok $dbh->disconnect; 42 | -------------------------------------------------------------------------------- /t/41blobs_prepare.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | 7 | my $update_blob; 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | my $dbh; 13 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, AutoCommit => 1})}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | plan tests => 25; 20 | 21 | my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; 22 | my $blob1= join '', map { $chars[rand @chars] } 0 .. 10000; 23 | my $blob2 = '"' x 10000; 24 | 25 | sub ShowBlob($) { 26 | my ($blob) = @_; 27 | my $b; 28 | for(my $i = 0; $i < 8; $i++) { 29 | if (defined($blob) && length($blob) > $i) { 30 | $b = substr($blob, $i*32); 31 | } 32 | else { 33 | $b = ""; 34 | } 35 | note sprintf("%08lx %s\n", $i*32, unpack("H64", $b)); 36 | } 37 | } 38 | 39 | my $create = <do("DROP TABLE IF EXISTS dbd_mysql_41blobs_prepare"), "drop table if exists dbd_mysql_41blobs_prepare"; 46 | 47 | ok $dbh->do($create), "create table dbd_mysql_41blobs_prepare"; 48 | 49 | my $query = "INSERT INTO dbd_mysql_41blobs_prepare VALUES(?, ?)"; 50 | my $sth; 51 | ok ($sth= $dbh->prepare($query)); 52 | 53 | ok defined($sth); 54 | 55 | ok $sth->execute(1, $blob1), "inserting \$blob1"; 56 | 57 | ok $sth->finish; 58 | 59 | ok ($sth= $dbh->prepare("SELECT * FROM dbd_mysql_41blobs_prepare WHERE id = 1")); 60 | 61 | ok $sth->execute, "select from dbd_mysql_41blobs_prepare"; 62 | 63 | ok (my $row = $sth->fetchrow_arrayref); 64 | 65 | is @$row, 2, "two rows fetched"; 66 | 67 | is $$row[0], 1, "first row id == 1"; 68 | 69 | cmp_ok $$row[1], 'eq', $blob1, ShowBlob($blob1); 70 | 71 | ok $sth->finish; 72 | 73 | ok ($sth= $dbh->prepare("UPDATE dbd_mysql_41blobs_prepare SET name = ? WHERE id = 1")); 74 | 75 | ok $sth->execute($blob2), 'inserting $blob2'; 76 | 77 | ok ($sth->finish); 78 | 79 | ok ($sth= $dbh->prepare("SELECT * FROM dbd_mysql_41blobs_prepare WHERE id = 1")); 80 | 81 | ok ($sth->execute); 82 | 83 | ok ($row = $sth->fetchrow_arrayref); 84 | 85 | is scalar @$row, 2, 'two rows'; 86 | 87 | is $$row[0], 1, 'row id == 1'; 88 | 89 | cmp_ok $$row[1], 'eq', $blob2, ShowBlob($blob2); 90 | 91 | ok ($sth->finish); 92 | 93 | ok $dbh->do("DROP TABLE dbd_mysql_41blobs_prepare"), "drop dbd_mysql_41blobs_prepare"; 94 | 95 | ok $dbh->disconnect; 96 | -------------------------------------------------------------------------------- /t/41int_min_max.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use bigint; 4 | 5 | use DBI; 6 | use Test::More; 7 | use lib 't', '.'; 8 | use Data::Dumper; 9 | require 'lib.pl'; 10 | use vars qw($test_dsn $test_user $test_password); 11 | 12 | my $dbh; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | 19 | if ($dbh->{mysql_serverversion} < 50002) { 20 | plan skip_all => 21 | "SKIP TEST: You must have MySQL version 5.0.2 and greater for this test to run"; 22 | } 23 | # nostrict tests + strict tests + init/tear down commands 24 | plan tests => (19*8 + 17*8 + 4) * 2; 25 | 26 | my $table = 'dbd_mysql_t41minmax'; # name of the table we will be using 27 | my $mode; # 'strict' or 'nostrict' corresponds to strict SQL mode 28 | 29 | sub test_int_type ($$$$) { 30 | my ($perl_type, $mysql_type, $min, $max) = @_; 31 | 32 | # Disable the warning text clobbering our output 33 | local $SIG{__WARN__} = sub { 1; }; 34 | 35 | # Create the table 36 | ok($dbh->do(qq{DROP TABLE IF EXISTS $table}), "removing $table"); 37 | ok($dbh->do(qq{ 38 | CREATE TABLE `$table` ( 39 | `id` int not null auto_increment, 40 | `val` $mysql_type, 41 | primary key (id) 42 | ) 43 | }), "creating minmax table for type $mysql_type"); 44 | 45 | my ($store, $retrieve); # statements 46 | my $read_value; # retrieved value 47 | ok($store = $dbh->prepare("INSERT INTO $table (val) VALUES (?)")); 48 | ok($retrieve = $dbh->prepare("SELECT val from $table where id=(SELECT MAX(id) FROM $table)")); 49 | 50 | ######################################## 51 | # Insert allowed min value 52 | ######################################## 53 | ok($store->bind_param( 1, $min->bstr(), $perl_type ), "binding minimal $mysql_type, mode=$mode"); 54 | ok($store->execute(), "inserting min data for type $mysql_type, mode=$mode"); 55 | 56 | ######################################## 57 | # Read it back and compare 58 | ######################################## 59 | ok{$retrieve->execute()}; 60 | ($read_value) = $retrieve->fetchrow_array(); 61 | cmp_ok($read_value, 'eq', $min, "retrieved minimal value for $mysql_type, mode=$mode"); 62 | 63 | ######################################## 64 | # Insert allowed max value 65 | ######################################## 66 | ok($store->bind_param( 1, $max->bstr(), $perl_type ), "binding maximal $mysql_type, mode=$mode"); 67 | ok($store->execute(), "inserting max data for type $mysql_type, mode=$mode"); 68 | 69 | ######################################## 70 | # Read it back and compare 71 | ######################################## 72 | ok{$retrieve->execute()}; 73 | ($read_value) = $retrieve->fetchrow_array(); 74 | cmp_ok($read_value, 'eq', $max, "retrieved maximal value for $mysql_type, mode=$mode"); 75 | 76 | ######################################## 77 | # Try to insert under the limit value 78 | ######################################## 79 | ok($store->bind_param( 1, ($min-1)->bstr(), $perl_type ), "binding less than minimal $mysql_type, mode=$mode"); 80 | if ($mode eq 'strict') { 81 | $@ = ''; 82 | eval{$store->execute()}; 83 | like($@, qr/Out of range value (?:adjusted )?for column 'val'/, "Error, you stored ".($min-1)." into $mysql_type, mode=$mode\n". 84 | Data::Dumper->Dump([$dbh->selectall_arrayref("SELECT * FROM $table")]). 85 | Data::Dumper->Dump([$dbh->selectall_arrayref("describe $table")]) 86 | ); 87 | } else { 88 | ok{$store->execute()}; 89 | ######################################## 90 | # Check that it was rounded correctly 91 | ######################################## 92 | ok{$retrieve->execute()}; 93 | ($read_value) = $retrieve->fetchrow_array(); 94 | cmp_ok($read_value, 'eq', $min, "retrieved minimal value for type $mysql_type, mode=$mode"); 95 | }; 96 | 97 | ######################################## 98 | # Try to insert over the limit value 99 | ######################################## 100 | ok($store->bind_param( 1, ($max+1)->bstr(), $perl_type ), "binding more than maximal $mysql_type, mode=$mode"); 101 | if ($mode eq 'strict') { 102 | $@ = ''; 103 | eval{$store->execute()}; 104 | like($@, qr/Out of range value (?:adjusted )?for column 'val'/, "Error, you stored ".($max+1)." into $mysql_type, mode=$mode\n". 105 | Data::Dumper->Dump([$dbh->selectall_arrayref("SELECT * FROM $table")]). 106 | Data::Dumper->Dump([$dbh->selectall_arrayref("describe $table")]) 107 | ); 108 | } else { 109 | ok{$store->execute()}; 110 | ######################################## 111 | # Check that it was rounded correctly 112 | ######################################## 113 | ok{$retrieve->execute()}; 114 | ($read_value) = $retrieve->fetchrow_array(); 115 | cmp_ok($read_value, 'eq', $max, "retrieved maximal value for type $mysql_type, mode=$mode"); 116 | }; 117 | } 118 | 119 | $dbh->disconnect; 120 | 121 | for my $mysql_server_prepare (0, 1) { 122 | $dbh= DBI->connect($test_dsn . ';mysql_server_prepare=' . $mysql_server_prepare, $test_user, $test_password, 123 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); 124 | 125 | # Set strict SQL mode 126 | ok($dbh->do("SET SQL_MODE='STRICT_ALL_TABLES'"),"Enter strict SQL mode."); 127 | $mode = 'strict'; 128 | 129 | test_int_type(DBI::SQL_TINYINT, 'tinyint signed', -2**7, 2**7-1); 130 | test_int_type(DBI::SQL_TINYINT, 'tinyint unsigned', 0, 2**8-1); 131 | test_int_type(DBI::SQL_SMALLINT, 'smallint signed', -2**15, 2**15-1); 132 | test_int_type(DBI::SQL_SMALLINT, 'smallint unsigned', 0, 2**16-1); 133 | test_int_type(DBI::SQL_INTEGER, 'int signed', -2**31, 2**31-1); 134 | test_int_type(DBI::SQL_INTEGER, 'int unsigned', 0, 2**32-1); 135 | test_int_type(DBI::SQL_BIGINT, 'bigint signed', -2**63, 2**63-1); 136 | test_int_type(DBI::SQL_BIGINT, 'bigint unsigned', 0, 2**64-1); 137 | 138 | # Do not use strict SQL mode 139 | ok($dbh->do("SET SQL_MODE=''"),"Leave strict SQL mode."); 140 | $mode = 'nostrict'; 141 | 142 | test_int_type(DBI::SQL_TINYINT, 'tinyint signed', -2**7, 2**7-1); 143 | test_int_type(DBI::SQL_TINYINT, 'tinyint unsigned', 0, 2**8-1); 144 | test_int_type(DBI::SQL_SMALLINT, 'smallint signed', -2**15, 2**15-1); 145 | test_int_type(DBI::SQL_SMALLINT, 'smallint unsigned', 0, 2**16-1); 146 | test_int_type(DBI::SQL_INTEGER, 'int signed', -2**31, 2**31-1); 147 | test_int_type(DBI::SQL_INTEGER, 'int unsigned', 0, 2**32-1); 148 | test_int_type(DBI::SQL_BIGINT, 'bigint signed', -2**63, 2**63-1); 149 | test_int_type(DBI::SQL_BIGINT, 'bigint unsigned', 0, 2**64-1); 150 | 151 | ok ($dbh->do("DROP TABLE $table")); 152 | 153 | ok $dbh->disconnect; 154 | } 155 | -------------------------------------------------------------------------------- /t/42bindparam.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use vars qw($test_dsn $test_user $test_password $mdriver); 5 | use Test::More; 6 | use DBI; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my $dbh; 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | if ($@) { 14 | plan skip_all => "no database connection"; 15 | } 16 | 17 | plan tests => 12; 18 | 19 | ok $dbh->do("drop table if exists dbd_mysql_t42bindparams"); 20 | 21 | my $create= <do($create); 29 | 30 | ok (my $sth= $dbh->prepare("insert into dbd_mysql_t42bindparams values (?, ?)")); 31 | 32 | ok $sth->bind_param(1,"10000 ",DBI::SQL_INTEGER); 33 | 34 | ok $sth->bind_param(2,"1.22 ",DBI::SQL_DOUBLE); 35 | 36 | ok $sth->execute(); 37 | 38 | ok $sth->bind_param(1,10001,DBI::SQL_INTEGER); 39 | 40 | ok $sth->bind_param(2,.3333333,DBI::SQL_DOUBLE); 41 | 42 | ok $sth->execute(); 43 | 44 | ok $dbh->do("DROP TABLE dbd_mysql_t42bindparams"); 45 | 46 | ok $sth->finish; 47 | 48 | ok $dbh->disconnect; 49 | -------------------------------------------------------------------------------- /t/43count_params.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | use vars qw($test_dsn $test_user $test_password); 9 | 10 | my $dbh; 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | if ($@) { 14 | plan skip_all => "no database connection"; 15 | } 16 | if (!MinimumVersion($dbh, '4.1') ) { 17 | plan skip_all => 18 | "SKIP TEST: You must have MySQL version 4.1 and greater for this test to run"; 19 | } 20 | 21 | plan tests => 17; 22 | 23 | ok ($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t43count_params")); 24 | 25 | my $create = <do($create)); 33 | 34 | ok (my $sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (name, id)" . 35 | " VALUES ('Charles de Batz de Castelmore, comte d\\'Artagnan', ?)")); 36 | 37 | ok ($sth->execute(1)); 38 | 39 | ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (name, id)" . 40 | " VALUES ('Charles de Batz de Castelmore, comte d\\'Artagnan', 2)")); 41 | 42 | ok ($sth->execute()); 43 | 44 | ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (name, id) VALUES (?, ?)")); 45 | 46 | ok ($sth->execute("Charles de Batz de Castelmore, comte d\\'Artagnan", 3)); 47 | 48 | ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (id, name)" . 49 | " VALUES (?, 'Charles de Batz de Castelmore, comte d\\'Artagnan')")); 50 | 51 | ok ($sth->execute(1)); 52 | 53 | ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (id, name)" . 54 | " VALUES (2, 'Charles de Batz de Castelmore, comte d\\'Artagnan')")); 55 | 56 | ok ($sth->execute()); 57 | 58 | ok ($sth = $dbh->prepare("INSERT INTO dbd_mysql_t43count_params (id, name) VALUES (?, ?)")); 59 | 60 | ok ($sth->execute(3, "Charles de Batz de Castelmore, comte d\\'Artagnan")); 61 | 62 | ok ($dbh->do("DROP TABLE dbd_mysql_t43count_params")); 63 | 64 | ok $sth->finish; 65 | 66 | ok $dbh->disconnect; 67 | -------------------------------------------------------------------------------- /t/50chopblanks.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; 14 | if ($@) { 15 | plan skip_all => "no database connection"; 16 | } 17 | if ($dbh->{mysql_serverversion} < 50000) { 18 | plan skip_all => "You must have MySQL version 5.0.0 and greater for this test to run"; 19 | } 20 | 21 | for my $mysql_server_prepare (0, 1) { 22 | eval {$dbh= DBI->connect("$test_dsn;mysql_server_prepare=$mysql_server_prepare;mysql_server_prepare_disable_fallback=1", $test_user, $test_password, 23 | { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; 24 | 25 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t50chopblanks"), "drop table if exists dbd_mysql_t50chopblanks"; 26 | 27 | my $create= <do($create), "create table dbd_mysql_t50chopblanks"; 43 | 44 | my @fields = qw(c_varchar c_text c_tinytext c_mediumtext c_longtext b_blob b_tinyblob b_mediumblob b_longblob); 45 | my $numfields = scalar @fields; 46 | my $fieldlist = join(', ', @fields); 47 | 48 | ok (my $sth= $dbh->prepare("INSERT INTO dbd_mysql_t50chopblanks (id, $fieldlist) VALUES (".('?, ' x $numfields)."?)")); 49 | 50 | ok (my $sth2= $dbh->prepare("SELECT $fieldlist FROM dbd_mysql_t50chopblanks WHERE id = ?")); 51 | 52 | my $rows; 53 | 54 | $rows = [ [1, ''], [2, ' '], [3, ' a b c '], [4, 'blah'] ]; 55 | 56 | for my $ref (@$rows) { 57 | my ($id, $value) = @$ref; 58 | ok $sth->execute($id, ($value) x $numfields), "insert into dbd_mysql_t50chopblanks values ($id ".(", '$value'" x $numfields).")"; 59 | ok $sth2->execute($id), "select $fieldlist from dbd_mysql_t50chopblanks where id = $id"; 60 | 61 | # First try to retrieve without chopping blanks. 62 | $sth2->{'ChopBlanks'} = 0; 63 | my $ret_ref = []; 64 | ok ($ret_ref = $sth2->fetchrow_arrayref); 65 | for my $i (0 .. $#{$ret_ref}) { 66 | cmp_ok $ret_ref->[$i], 'eq', $value, "NoChopBlanks: $fields[$i] should not have blanks chopped"; 67 | } 68 | 69 | # Now try to retrieve with chopping blanks. 70 | $sth2->{'ChopBlanks'} = 1; 71 | 72 | ok $sth2->execute($id); 73 | 74 | $ret_ref = []; 75 | ok ($ret_ref = $sth2->fetchrow_arrayref); 76 | for my $i (0 .. $#{$ret_ref}) { 77 | my $choppedvalue = $value; 78 | my $character_field = ($fields[$i] =~ /^c/); 79 | $choppedvalue =~ s/\s+$// if $character_field; # only chop character, not binary 80 | cmp_ok $ret_ref->[$i], 'eq', $choppedvalue, "ChopBlanks: $fields[$i] should ".($character_field ? "" : "not ")."have blanks chopped"; 81 | } 82 | 83 | } 84 | ok $sth->finish; 85 | ok $sth2->finish; 86 | ok $dbh->do("DROP TABLE dbd_mysql_t50chopblanks"), "drop dbd_mysql_t50chopblanks"; 87 | ok $dbh->disconnect; 88 | } 89 | done_testing; 90 | -------------------------------------------------------------------------------- /t/50commit.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($got_warning $test_dsn $test_user $test_password); 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 14 | if ($@) { 15 | plan skip_all => "no database connection"; 16 | } 17 | 18 | sub catch_warning ($) { 19 | $got_warning = 1; 20 | } 21 | 22 | sub num_rows($$$) { 23 | my($dbh, $table, $num) = @_; 24 | my($sth, $got); 25 | 26 | if (!($sth = $dbh->prepare("SELECT * FROM dbd_mysql_t50commit"))) { 27 | return "Failed to prepare: err " . $dbh->err . ", errstr " 28 | . $dbh->errstr; 29 | } 30 | if (!$sth->execute) { 31 | return "Failed to execute: err " . $dbh->err . ", errstr " 32 | . $dbh->errstr; 33 | } 34 | $got = 0; 35 | while ($sth->fetchrow_arrayref) { 36 | ++$got; 37 | } 38 | if ($got ne $num) { 39 | return "Wrong result: Expected $num rows, got $got.\n"; 40 | } 41 | return ''; 42 | } 43 | 44 | plan tests => 22; 45 | 46 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t50commit"), "drop table if exists dbd_mysql_t50commit"; 47 | my $create =<do($create), 'create dbd_mysql_t50commit'; 55 | 56 | ok !$dbh->{AutoCommit}, "\$dbh->{AutoCommit} not defined |$dbh->{AutoCommit}|"; 57 | 58 | $dbh->{AutoCommit} = 0; 59 | ok !$dbh->err; 60 | ok !$dbh->errstr; 61 | ok !$dbh->{AutoCommit}; 62 | 63 | ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (1, 'Jochen')"), 64 | "insert into dbd_mysql_t50commit (1, 'Jochen')"; 65 | 66 | my $msg; 67 | $msg = num_rows($dbh, 'dbd_mysql_t50commit', 1); 68 | ok !$msg; 69 | 70 | ok $dbh->rollback, 'rollback'; 71 | 72 | $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); 73 | ok !$msg; 74 | 75 | ok $dbh->do("DELETE FROM dbd_mysql_t50commit WHERE id = 1"), "delete from dbd_mysql_t50commit where id = 1"; 76 | 77 | $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); 78 | ok !$msg; 79 | ok $dbh->commit, 'commit'; 80 | 81 | $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); 82 | ok !$msg; 83 | 84 | # Check auto rollback after disconnect 85 | ok $dbh->do("INSERT INTO dbd_mysql_t50commit VALUES (1, 'Jochen')"); 86 | 87 | $msg = num_rows($dbh, 'dbd_mysql_t50commit', 1); 88 | ok !$msg; 89 | 90 | ok $dbh->disconnect; 91 | 92 | ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password)); 93 | 94 | ok $dbh, "connected"; 95 | 96 | $msg = num_rows($dbh, 'dbd_mysql_t50commit', 0); 97 | ok !$msg; 98 | 99 | ok $dbh->{AutoCommit}, "\$dbh->{AutoCommit} $dbh->{AutoCommit}"; 100 | ok $dbh->do("DROP TABLE dbd_mysql_t50commit"); 101 | -------------------------------------------------------------------------------- /t/51bind_type_guessing.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use DBI::Const::GetInfoType; 6 | use Test::More; 7 | select(($|=1,select(STDERR),$|=1)[1]); 8 | use lib 't', '.'; 9 | require 'lib.pl'; 10 | 11 | use vars qw($test_dsn $test_user $test_password); 12 | 13 | my ($dbh, $t); 14 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 15 | { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | 20 | # FIXME: Get this test working against MariaDB. 21 | if ($dbh->{'mysql_serverinfo'} =~ 'MariaDB') { 22 | plan skip_all => "This test isn't made to work with MariaDB yet"; 23 | } 24 | 25 | # Tested with TiDB v8.5.1. 26 | # https://github.com/pingcap/tidb/issues/60671 27 | if ($dbh->{'mysql_serverinfo'} =~ 'TiDB') { 28 | plan skip_all => 29 | "SKIP TEST: test disabled on TiDB"; 30 | } 31 | 32 | plan tests => 98; 33 | 34 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t51bind_type_guessing"), 35 | "drop table if exists dbd_mysql_t51bind_type_guessing"; 36 | 37 | my $create= <<"EOTABLE"; 38 | create table dbd_mysql_t51bind_type_guessing ( 39 | id bigint unsigned not null default 0 40 | ) 41 | EOTABLE 42 | 43 | ok $dbh->do($create), "creating table"; 44 | 45 | my $statement= "insert into dbd_mysql_t51bind_type_guessing (id) values (?)"; 46 | 47 | my $sth1; 48 | ok $sth1= $dbh->prepare($statement); 49 | 50 | my $rows; 51 | ok $rows= $sth1->execute('9999999999999999'); 52 | cmp_ok $rows, '==', 1; 53 | 54 | $statement= "update dbd_mysql_t51bind_type_guessing set id = ?"; 55 | my $sth2; 56 | ok $sth2= $dbh->prepare($statement); 57 | 58 | ok $rows= $sth2->execute('9999999999999998'); 59 | cmp_ok $rows, '==', 1; 60 | 61 | $dbh->{mysql_bind_type_guessing}= 1; 62 | ok $rows= $sth1->execute('9999999999999997'); 63 | cmp_ok $rows, '==', 1; 64 | 65 | $statement= "update dbd_mysql_t51bind_type_guessing set id = ? where id = ?"; 66 | 67 | ok $sth2= $dbh->prepare($statement); 68 | ok $rows= $sth2->execute('9999999999999996', '9999999999999997'); 69 | 70 | my $retref; 71 | ok $retref= $dbh->selectall_arrayref( 72 | "select * from dbd_mysql_t51bind_type_guessing"); 73 | 74 | cmp_ok $retref->[0][0], '==', 9999999999999998; 75 | cmp_ok $retref->[1][0], '==', 9999999999999996; 76 | 77 | # checking varchars/empty strings/misidentification: 78 | $create= <<"EOTABLE"; 79 | create table dbd_mysql_t51bind_type_guessing ( 80 | id bigint default 0 not null, 81 | nn bigint default 0, 82 | dd double(12,4), 83 | str varchar(80), 84 | primary key (id) 85 | ) engine=innodb 86 | EOTABLE 87 | 88 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t51bind_type_guessing"), "drop table if exists dbd_mysql_t51bind_type_guessing"; 89 | 90 | ok $dbh->do($create), "creating table with int, double, and varchar"; 91 | 92 | my @sts; 93 | $t= "prepare insert integer col nn into dbd_mysql_t51bind_type_guessing"; 94 | ok $sts[0] = $dbh->prepare("insert into dbd_mysql_t51bind_type_guessing (id,nn) values (?,?)"), $t; 95 | $t= "prepare update double col dd dbd_mysql_t51bind_type_guessing"; 96 | ok $sts[1] = $dbh->prepare("update dbd_mysql_t51bind_type_guessing set dd = ? where id = ?"), $t; 97 | $t= "prepare update string col str dbd_mysql_t51bind_type_guessing"; 98 | ok $sts[2] = $dbh->prepare("update dbd_mysql_t51bind_type_guessing set str = ? where id = ?"), $t; 99 | 100 | # various values to try including issue 251 101 | my @vals = ( 52.3, 102 | ' 77.7777', 103 | '.1', 104 | '5e3', 105 | +1, 106 | -1, 107 | undef, 108 | '5e', 109 | '1+', 110 | '+', 111 | '.', 112 | 'e5', 113 | ); 114 | 115 | my $val; 116 | # the tests for 'like' are when values fail to be inserted/updated 117 | for my $i (0 .. 11) { 118 | $val = $vals[$i]; 119 | if (defined $val) { 120 | $t= "insert int val $val id $i" 121 | } 122 | else { 123 | $t= "insert undef into int id $i"; 124 | } 125 | if ($i >= 8) { 126 | eval { 127 | $rows= $sts[0]->execute($i, $val); 128 | }; 129 | if ($i == 8) { 130 | like ($@, qr{Data truncated for column}, $t); 131 | } 132 | else { 133 | like ($@, qr{Incorrect integer value}, $t); 134 | } 135 | $rows= $sts[0]->execute($i, 0); 136 | } 137 | else { 138 | ok $rows= $sts[0]->execute($i, $val),$t; 139 | } 140 | 141 | if (defined $val) { 142 | $t= "update double val $val id $i"; 143 | } 144 | else { 145 | $t= "update double val undefined id $i"; 146 | } 147 | if ($i >= 7) { 148 | eval { 149 | $rows = $sts[1]->execute($val, $i); 150 | }; 151 | if ($dbh->{mysql_serverversion} < 90000) { 152 | like ($@, qr{Data truncated for column}, $t); 153 | } else { 154 | like ($@, qr{Incorrect DOUBLE value}, $t); 155 | } 156 | $rows= $sts[1]->execute(0, $i); 157 | } 158 | else { 159 | ok $rows= $sts[1]->execute($val,$i),$t; 160 | } 161 | 162 | if (defined $val) { 163 | $t= "update string val $val id $i"; 164 | } 165 | else { 166 | $t= "update string val undef id $i"; 167 | } 168 | ok $rows = $sts[2]->execute($val,$i),$t; 169 | } 170 | 171 | for my $i (0 .. 2) { 172 | $sts[$i]->finish(); 173 | } 174 | 175 | # expected results 176 | my $res= [ 177 | [ 0, 52, '52.3', '52.3' ], 178 | [ 1, 78, '77.7777', '77.7777' ], 179 | [ 2, 0, '0.1', '0.1' ], 180 | [ 3, 5000, '5000', '5e3' ], 181 | [ 4, 1, '1', '1' ], 182 | [ 5, -1, '-1', '-1' ], 183 | [ 6, undef, undef, undef ], 184 | [ 7, 5, '0', '5e' ], 185 | [ 8, 0, '0', '1+' ], 186 | [ 9, 0, '0', '+' ], 187 | [ 10, 0, '0', '.' ], 188 | [ 11, 0, '0', 'e5' ] 189 | ]; 190 | 191 | $t= "Select all values"; 192 | my $query= "select * from dbd_mysql_t51bind_type_guessing"; 193 | 194 | ok $retref = $dbh->selectall_arrayref($query), $t; 195 | 196 | for my $i (0 .. $#$res) { 197 | if ($i == 6) { 198 | is($retref->[$i][1], undef, "$i: nn undefined as expected"); 199 | is($retref->[$i][2], undef, "$i: dd undefined as expected"); 200 | is($retref->[$i][3], undef, "$i: str undefined as expected"); 201 | } 202 | else { 203 | cmp_ok $retref->[$i][1], '==', $res->[$i][1], 204 | "test: " . "$retref->[$i][1], '==', $res->[$i][1]"; 205 | cmp_ok $retref->[$i][2], 'eq', $res->[$i][2], 206 | "test: " . "$retref->[$i][2], '==', $res->[$i][2]"; 207 | cmp_ok $retref->[$i][3], 'eq', $res->[$i][3], 208 | "test: " . "$retref->[$i][2], '==', $res->[$i][2]"; 209 | } 210 | } 211 | 212 | my $sth3; 213 | $t = "Prepare limit statement"; 214 | ok $sth3= $dbh->prepare("select * from dbd_mysql_t51bind_type_guessing limit ?"), $t; 215 | $val = 1; 216 | $t = "select with limit $val statement"; 217 | ok $rows= $sth3->execute($val), $t; 218 | $val = ' 1'; 219 | $t = "select with limit $val statement"; 220 | ok $rows= $sth3->execute($val), $t; 221 | $sth3->finish(); 222 | 223 | ok $dbh->do("DROP TABLE dbd_mysql_t51bind_type_guessing"); 224 | ok $dbh->disconnect; 225 | -------------------------------------------------------------------------------- /t/52comment.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use DBI::Const::GetInfoType; 6 | use Test::More; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | 12 | my $dbh; 13 | eval { $dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, 15 | PrintError => 1, 16 | AutoCommit => 0, } 17 | ); 18 | }; 19 | if ($@) { 20 | plan skip_all => 21 | plan skip_all => "no database connection"; 22 | } 23 | plan tests => 30; 24 | 25 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t52comment"), "drop table if exists dbd_mysql_t52comment"; 26 | 27 | my $create= <<"EOTABLE"; 28 | create table dbd_mysql_t52comment ( 29 | id bigint unsigned not null default 0 30 | ) 31 | EOTABLE 32 | 33 | 34 | ok $dbh->do($create), "creating table"; 35 | 36 | my $statement= "insert into dbd_mysql_t52comment (id) values (?)"; 37 | 38 | my $sth; 39 | ok $sth= $dbh->prepare($statement); 40 | 41 | my $rows; 42 | ok $rows= $sth->execute('1'); 43 | cmp_ok $rows, '==', 1; 44 | $sth->finish(); 45 | 46 | $statement= <selectrow_arrayref($statement, {}, 1); 54 | cmp_ok $retrow->[0], '==', 1; 55 | 56 | $statement= "SELECT id FROM dbd_mysql_t52comment /* it's a bug? */ WHERE id = ?"; 57 | 58 | $retrow= $dbh->selectrow_arrayref($statement, {}, 1); 59 | cmp_ok $retrow->[0], '==', 1; 60 | 61 | $statement= "SELECT id FROM dbd_mysql_t52comment WHERE id = ? /* it's a bug? */"; 62 | 63 | $retrow= $dbh->selectrow_arrayref($statement, {}, 1); 64 | cmp_ok $retrow->[0], '==', 1; 65 | 66 | $statement= "SELECT id FROM dbd_mysql_t52comment WHERE id = ? "; 67 | my $comment = "/* it's/a_directory/does\ this\ work/bug? */"; 68 | 69 | for (0 .. 9) { 70 | $retrow= $dbh->selectrow_arrayref($statement . $comment, {}, 1); 71 | cmp_ok $retrow->[0], '==', 1; 72 | } 73 | 74 | $comment = "/* $0 */"; 75 | 76 | for (0 .. 9) { 77 | $retrow= $dbh->selectrow_arrayref($statement . $comment, {}, 1); 78 | cmp_ok $retrow->[0], '==', 1; 79 | } 80 | 81 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t52comment"), "drop table if exists dbd_mysql_t52comment"; 82 | 83 | ok $dbh->disconnect; 84 | -------------------------------------------------------------------------------- /t/53comment.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use DBI::Const::GetInfoType; 6 | use Test::More; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | 12 | my $dbh; 13 | eval { $dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, 15 | PrintError => 1, 16 | AutoCommit => 0, 17 | mysql_bind_comment_placeholders => 1,} 18 | ); 19 | }; 20 | if ($@) { 21 | plan skip_all => 22 | "no database connection"; 23 | } 24 | 25 | my $create= <<"EOTABLE"; 26 | CREATE TEMPORARY TABLE dbd_mysql_53 ( 27 | id bigint unsigned not null default 0 28 | ) 29 | EOTABLE 30 | 31 | 32 | ok $dbh->do($create), "creating table"; 33 | 34 | my $statement= "insert into dbd_mysql_53 (id) values (?)"; 35 | 36 | my $sth; 37 | ok $sth= $dbh->prepare($statement); 38 | 39 | my $rows; 40 | ok $rows= $sth->execute('1'); 41 | cmp_ok $rows, '==', 1; 42 | $sth->finish(); 43 | 44 | 45 | my $retrow; 46 | 47 | if ( $test_dsn =~ m/mysql_server_prepare=1/ ) { 48 | # server_prepare can't bind placeholder on comment. 49 | ok 1; 50 | ok 2; 51 | } 52 | else { 53 | $statement= <selectrow_arrayref($statement, {}, 'hey', 1); 60 | cmp_ok $retrow->[0], '==', 1; 61 | 62 | $statement= "SELECT id FROM dbd_mysql_53 /* Some value here ? */ WHERE id = ?"; 63 | 64 | $retrow= $dbh->selectrow_arrayref($statement, {}, "hello", 1); 65 | cmp_ok $retrow->[0], '==', 1; 66 | } 67 | 68 | 69 | $statement= "SELECT id FROM dbd_mysql_53 WHERE id = ? "; 70 | my $comment = "/* it's/a_directory/does\ this\ work/bug? */"; 71 | $statement= $statement . $comment; 72 | 73 | for (0 .. 9) { 74 | $retrow= $dbh->selectrow_arrayref($statement, {}, 1); 75 | cmp_ok $retrow->[0], '==', 1; 76 | } 77 | 78 | $comment = "/* $0 */"; 79 | 80 | for (0 .. 9) { 81 | $retrow= $dbh->selectrow_arrayref($statement . $comment, {}, 1); 82 | cmp_ok $retrow->[0], '==', 1; 83 | } 84 | 85 | ok $dbh->disconnect; 86 | 87 | done_testing; 88 | -------------------------------------------------------------------------------- /t/55utf8.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use vars qw($COL_NULLABLE $COL_KEY); 8 | use lib 't', '.'; 9 | require 'lib.pl'; 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 14 | if ($@) { 15 | plan skip_all => "no database connection"; 16 | } 17 | 18 | # 19 | # DROP/CREATE PROCEDURE will give syntax error for these versions 20 | # 21 | if ($dbh->{mysql_serverversion} < 50000) { 22 | plan skip_all => 23 | "SKIP TEST: You must have MySQL version 5.0 and greater for this test to run"; 24 | } 25 | 26 | # Tested with TiDB v8.5.1. 27 | if ($dbh->{'mysql_serverinfo'} =~ 'TiDB') { 28 | plan skip_all => 29 | "SKIP TEST: TiDB doesn't support GEOMETRY data type"; 30 | } 31 | 32 | plan tests => 16 * 2; 33 | 34 | for my $mysql_server_prepare (0, 1) { 35 | $dbh= DBI->connect("$test_dsn;mysql_server_prepare=$mysql_server_prepare;mysql_server_prepare_disable_fallback=1", $test_user, $test_password, 36 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); 37 | 38 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t55utf8"); 39 | 40 | my $create =<do($create); 51 | 52 | my $utf8_str = "\x{0100}dam"; # "Adam" with a macron. 53 | my $quoted_utf8_str = "'\x{0100}dam'"; 54 | 55 | my $blob = "\x{c4}\x{80}dam"; # same as utf8_str but not utf8 encoded 56 | my $quoted_blob = "'\x{c4}\x{80}dam'"; 57 | 58 | cmp_ok $dbh->quote($utf8_str), 'eq', $quoted_utf8_str, 'testing quoting of utf 8 string'; 59 | 60 | cmp_ok $dbh->quote($blob), 'eq', $quoted_blob, 'testing quoting of blob'; 61 | 62 | #ok $dbh->{mysql_enable_utf8}, "mysql_enable_utf8 survive connect()"; 63 | $dbh->{mysql_enable_utf8}=1; 64 | 65 | # GeomFromText() is deprecated as of MySQL 5.7.6, use ST_GeomFromText() instead 66 | my $geomfromtext = $dbh->{mysql_serverversion} >= 50706 ? 'ST_GeomFromText' : 'GeomFromText'; 67 | my $query = <do($query, {}, $utf8_str, $blob, $utf8_str, $utf8_str), "INSERT query $query\n"; 73 | 74 | # AsBinary() is deprecated as of MySQL 5.7.6, use ST_AsBinary() instead 75 | my $asbinary = $dbh->{mysql_serverversion} >= 50706 ? 'ST_AsBinary' : 'AsBinary'; 76 | 77 | $query = "SELECT name,bincol,$asbinary(shape), binutf, profile FROM dbd_mysql_t55utf8 LIMIT 1"; 78 | 79 | my $sth = $dbh->prepare($query) or die "$DBI::errstr"; 80 | ok $sth->execute; 81 | 82 | my $ref; 83 | $ref = $sth->fetchrow_arrayref ; 84 | 85 | ok defined $ref; 86 | 87 | cmp_ok $ref->[0], 'eq', $utf8_str; 88 | 89 | cmp_ok $ref->[3], 'eq', $utf8_str; 90 | cmp_ok $ref->[4], 'eq', $utf8_str; 91 | 92 | SKIP: { 93 | eval {use Encode;}; 94 | skip "Can't test is_utf8 tests 'use Encode;' not available", 2, if $@; 95 | ok !Encode::is_utf8($ref->[1]), "blob was made utf8!."; 96 | 97 | ok !Encode::is_utf8($ref->[2]), "shape was made utf8!."; 98 | } 99 | 100 | cmp_ok $ref->[1], 'eq', $blob, "compare $ref->[1] eq $blob"; 101 | 102 | ok $sth->finish; 103 | 104 | ok $dbh->do("DROP TABLE dbd_mysql_t55utf8"); 105 | 106 | ok $dbh->disconnect; 107 | } 108 | -------------------------------------------------------------------------------- /t/55utf8_errors.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use Encode; 7 | 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require "lib.pl"; 11 | 12 | sub skip_rt_102404 { 13 | skip "(Perl 5.13.1 and DBI 1.635) or DBI 1.639 is required due to bug RT 102404", $_[0] unless ($] >= 5.013001 and eval { DBI->VERSION(1.635) }) or eval { DBI->VERSION(1.639) }; 14 | } 15 | 16 | my $dbh; 17 | eval { 18 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, 19 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); 20 | }; 21 | if ($@) { 22 | plan skip_all => "no database connection"; 23 | } 24 | 25 | # Tested with TiDB v8.5.1. 26 | if ($dbh->{'mysql_serverinfo'} =~ 'TiDB') { 27 | plan skip_all => 28 | "SKIP TEST: lc_messages not supported on TiDB"; 29 | } 30 | 31 | $dbh->disconnect(); 32 | 33 | plan tests => 10 * 3; 34 | 35 | # All in internal Perl Unicode 36 | my $jpnErr = qr/\x{4ed8}\x{8fd1}.*\x{884c}\x{76ee}/; # Use \x{...} instead \N{U+...} due to Perl 5.12.0 bug 37 | 38 | foreach my $mysql_enable_utf8 (0, 1, 2) { 39 | my %utf8_params = (); 40 | if ($mysql_enable_utf8 == 1) { 41 | $utf8_params{'mysql_enable_utf8'} = 1; 42 | diag "Enabled mysql_enable_utf8."; 43 | # XXX There are no utf8mb4 error characters 44 | } elsif ($mysql_enable_utf8 == 2) { 45 | $utf8_params{'mysql_enable_utf8mb4'} = 1; 46 | diag "Enabled mysql_enable_utf8mb4."; 47 | } else { 48 | diag "Disabled mysql_enable_utf8."; 49 | } 50 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, 51 | { RaiseError => 1, PrintError => 1, AutoCommit => 1, %utf8_params }); 52 | 53 | eval { 54 | $dbh->do("SET lc_messages = 'ja_JP'"); 55 | } or do { 56 | $dbh->disconnect(); 57 | plan skip_all => "Server lc_messages ja_JP are needed for this test"; 58 | }; 59 | 60 | my $sth; 61 | my $warn; 62 | my $dieerr; 63 | my $dbierr; 64 | my $failed; 65 | 66 | $failed = 0; 67 | $dieerr = undef; 68 | $dbierr = undef; 69 | $dbh->{HandleError} = sub { $dbierr = $_[0]; die $_[0]; }; 70 | eval { 71 | $sth = $dbh->prepare("foo"); 72 | $sth->execute(); 73 | 1; 74 | } or do { 75 | $dieerr = $@; 76 | $failed = 1; 77 | }; 78 | $dbh->{HandleError} = undef; 79 | 80 | ok($failed, 'Execution of bad statement is failing (HandleError version).'); 81 | like(Encode::decode('UTF-8', $dbierr), $jpnErr, 'DBI error is in octets (HandleError version).'); # XXX 82 | like(Encode::decode('UTF-8', $DBI::errstr), $jpnErr, 'DBI::errstr is in octets (HandleError version).'); # XXX 83 | like(Encode::decode('UTF-8', $dbh->errstr), $jpnErr, 'DBI handler errstr() method is in octets (HandleError version).'); # XXX 84 | 85 | SKIP : { 86 | skip_rt_102404 1; 87 | like(Encode::decode('UTF-8', $dieerr), $jpnErr, 'Error from eval is in octets (HandleError version).'); 88 | } 89 | 90 | $failed = 0; 91 | $warn = undef; 92 | $dieerr = undef; 93 | $dbh->{PrintError} = 1; 94 | $SIG{__WARN__} = sub { $warn = $_[0] }; 95 | eval { 96 | $sth = $dbh->prepare("foo"); 97 | $sth->execute(); 98 | 1; 99 | } or do { 100 | $dieerr = $@; 101 | $failed = 1; 102 | }; 103 | $dbh->{PrintError} = 0; 104 | $SIG{__WARN__} = 'DEFAULT'; 105 | 106 | ok($failed, 'Execution of bad statement is failing (PrintError version).'); 107 | like(Encode::decode('UTF-8', $DBI::errstr), $jpnErr, 'DBI::errstr is in octets (PrintError version).'); # XXX 108 | like(Encode::decode('UTF-8', $dbh->errstr), $jpnErr, 'DBI handler errstr() method is in octets (PrintError version).'); # XXX 109 | 110 | SKIP : { 111 | skip_rt_102404 2; 112 | like(Encode::decode('UTF-8', $warn), $jpnErr, 'Warning is in octets (PrintError version).'); # XXX 113 | like(Encode::decode('UTF-8', $dieerr), $jpnErr, 'Error from eval is in octets (PrintError version).'); # XXX 114 | } 115 | 116 | $dbh->disconnect(); 117 | } 118 | done_testing; 119 | -------------------------------------------------------------------------------- /t/55utf8_identifiers.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use Encode; 7 | 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require "lib.pl"; 11 | 12 | sub for_db { 13 | my ($mysql_enable_utf8, $value) = @_; # Value is in internal Perl Unicode. 14 | 15 | my $ret; 16 | if ($mysql_enable_utf8 >= 1) { 17 | $ret = $value; 18 | } else { 19 | $ret = Encode::encode('UTF-8', $value); 20 | } 21 | 22 | return $ret; 23 | } 24 | 25 | my $dbh; 26 | eval { 27 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, 28 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 }); 29 | }; 30 | if ($@) { 31 | plan skip_all => "no database connection"; 32 | } 33 | $dbh->disconnect(); 34 | 35 | plan tests => 12 * 3 + 12 * 2; 36 | 37 | # All in internal Perl Unicode 38 | my $jpnTable = "\N{U+8868}"; # Japanese table 39 | my $jpnColumn = "\N{U+6027}\N{U+5225}"; # Japanese column - word "gender" 40 | my $jpnData1 = "\N{U+5c71}\N{U+7530}\N{U+592a}\N{U+90ce}"; # Japanese data - person name 41 | my $jpnData2 = "\N{U+7537}"; # Japanese daya - word "male" 42 | my $chiTable = "\N{U+5927}\N{U+99AC}"; # Chinese table XXX MySQL doesn't support utf8mb4 in table names 43 | my $chiColumn = "\N{U+5C0F}\N{U+96EA}\N{U+4EBA}"; # Chinese column XXX MySQL doesn't support utf8mb4 in column names 44 | my $chiData1 = "\N{U+30001}"; # Chinese data 45 | my $chiData2 = "\N{U+30002}"; # Chinese data 46 | 47 | foreach my $mysql_enable_utf8 (0, 1, 2) { 48 | my %utf8_params = (); 49 | if ($mysql_enable_utf8 == 1) { 50 | $utf8_params{'mysql_enable_utf8'} = 1; 51 | diag "Enabled mysql_enable_utf8."; 52 | } elsif ($mysql_enable_utf8 == 2) { 53 | $utf8_params{'mysql_enable_utf8mb4'} = 1; 54 | diag "Enabled mysql_enable_utf8mb4."; 55 | } else { 56 | diag "Disabled mysql_enable_utf8."; 57 | } 58 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, 59 | { RaiseError => 1, PrintError => 1, AutoCommit => 1, %utf8_params }); 60 | 61 | my $jpnTable_db = for_db($mysql_enable_utf8, $jpnTable); 62 | my $jpnColumn_db = for_db($mysql_enable_utf8, $jpnColumn); 63 | my $jpnData1_db = for_db($mysql_enable_utf8, $jpnData1); 64 | my $jpnData2_db = for_db($mysql_enable_utf8, $jpnData2); 65 | my ($chiTable_db, $chiColumn_db, $chiData1_db, $chiData2_db); 66 | if ($mysql_enable_utf8 == 0 || $mysql_enable_utf8 == 2) { 67 | $chiTable_db = for_db($mysql_enable_utf8, $chiTable); 68 | $chiColumn_db = for_db($mysql_enable_utf8, $chiColumn); 69 | $chiData1_db = for_db($mysql_enable_utf8, $chiData1); 70 | $chiData2_db = for_db($mysql_enable_utf8, $chiData2); 71 | } 72 | 73 | my $sth; 74 | my $row; 75 | 76 | ok($dbh->do("DROP TABLE IF EXISTS $jpnTable_db"), 'Drop table for Japanese testing.'); 77 | if ($mysql_enable_utf8 == 0 || $mysql_enable_utf8 == 2) { 78 | ok($dbh->do("DROP TABLE IF EXISTS $chiTable_db"), 'Drop table for Chinese testings.'); 79 | } 80 | 81 | ok($dbh->do(<<"END" 82 | CREATE TABLE IF NOT EXISTS $jpnTable_db ( 83 | name VARCHAR(20), 84 | $jpnColumn_db CHAR(1) 85 | ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_bin 86 | END 87 | ), 'Create temporay table with Japanese characters.'); 88 | if ($mysql_enable_utf8 == 0 || $mysql_enable_utf8 == 2) { 89 | ok($dbh->do(<<"END" 90 | CREATE TABLE IF NOT EXISTS $chiTable_db ( 91 | name VARCHAR(20), 92 | $chiColumn_db CHAR(1) 93 | ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_bin 94 | END 95 | ), 'Create temporay table with Chinese characters.'); 96 | } 97 | 98 | ok($sth = $dbh->prepare("INSERT INTO $jpnTable_db (name, $jpnColumn_db) VALUES (?, ?)"), 'Prepare insert statement with Japanese values.'); 99 | ok($sth->execute($jpnData1_db, $jpnData2_db), 'Execute insert statement with Japanese values.'); 100 | if ($mysql_enable_utf8 == 0 || $mysql_enable_utf8 == 2) { 101 | ok($sth = $dbh->prepare("INSERT INTO $chiTable_db (name, $chiColumn_db) VALUES (?, ?)"), 'Prepare insert statement with Chinese values.'); 102 | ok($sth->execute($chiData1_db, $chiData2_db), 'Execute insert statement with Chinese values.'); 103 | } 104 | 105 | ok($sth = $dbh->prepare("SELECT * FROM $jpnTable_db"), 'Prepare select statement with Japanese values.'); 106 | ok($sth->execute(), 'Execute select statement with Japanese values.'); 107 | ok($row = $sth->fetchrow_hashref(), 'Fetch hashref with Japanese values.'); 108 | is($row->{name}, $jpnData1_db, "Japanese value."); 109 | ok(!exists $row->{$jpnColumn}, 'Not exists Japanese key in internal Perl Unicode.'); # XXX 110 | is($row->{Encode::encode('UTF-8', $jpnColumn)}, $jpnData2_db, 'Exists Japanese key in octets and value.'); # XXX 111 | is_deeply($sth->{NAME}, [ 'name', Encode::encode('UTF-8', $jpnColumn) ], 'Statement Japanese column name is in octets.'); # XXX 112 | is_deeply($sth->{mysql_table}, [ Encode::encode('UTF-8', $jpnTable), Encode::encode('UTF-8', $jpnTable) ], 'Statement Japanese table name is in octets.'); # XXX 113 | if ($mysql_enable_utf8 == 0 || $mysql_enable_utf8 == 2) { 114 | ok($sth = $dbh->prepare("SELECT * FROM $chiTable_db"), 'Prepare select statement with Chinese values.'); 115 | ok($sth->execute(), 'Execute select statement with Chinese values.'); 116 | ok($row = $sth->fetchrow_hashref(), 'Fetch hashref with Chinese values.'); 117 | is($row->{name}, $chiData1_db, "Chinese value."); 118 | ok(!exists $row->{$chiColumn}, 'Not exists Chinese key in internal Perl Unicode.'); # XXX 119 | is($row->{Encode::encode('UTF-8', $chiColumn)}, $chiData2_db, 'Exists Chinese key in octets and value.'); # XXX 120 | is_deeply($sth->{NAME}, [ 'name', Encode::encode('UTF-8', $chiColumn) ], 'Statement Chinese column name is in octets.'); # XXX 121 | is_deeply($sth->{mysql_table}, [ Encode::encode('UTF-8', $chiTable), Encode::encode('UTF-8', $chiTable) ], 'Statement Chinese table name is in octets.'); # XXX 122 | } 123 | 124 | $sth->finish(); 125 | $dbh->disconnect(); 126 | } 127 | done_testing; 128 | -------------------------------------------------------------------------------- /t/55utf8mb4.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my $dbh; 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | if ($@) { 14 | plan skip_all => "no database connection"; 15 | } 16 | 17 | eval { 18 | $dbh->{PrintError} = 0; 19 | $dbh->do("SET NAMES 'utf8mb4'"); 20 | $dbh->{PrintError} = 1; 21 | 1; 22 | } or do { 23 | $dbh->disconnect(); 24 | plan skip_all => "no support for utf8mb4"; 25 | }; 26 | 27 | ok $dbh->do("CREATE TEMPORARY TABLE dbd_mysql_t55utf8mb4 (id SERIAL, val TEXT CHARACTER SET utf8mb4)"); 28 | 29 | my $sth = $dbh->prepare("INSERT INTO dbd_mysql_t55utf8mb4(val) VALUES('😈')"); 30 | $sth->execute(); 31 | 32 | my $query = "SELECT val, HEX(val) FROM dbd_mysql_t55utf8mb4 LIMIT 1"; 33 | $sth = $dbh->prepare($query) or die "$DBI::errstr"; 34 | ok $sth->execute; 35 | 36 | ok(my $ref = $sth->fetchrow_arrayref, 'fetch row'); 37 | ok($sth->finish, 'close sth'); 38 | cmp_ok $ref->[0], 'eq', "😈"; 39 | cmp_ok $ref->[1], 'eq', "F09F9888"; 40 | 41 | $dbh->disconnect(); 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/56connattr.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use DBI; 7 | use DBI::Const::GetInfoType; 8 | use Test::More; 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | use vars qw($test_dsn $test_user $test_password $table); 13 | 14 | my $dbh; 15 | eval { $dbh= DBI->connect($test_dsn, $test_user, $test_password, 16 | { RaiseError => 1, 17 | PrintError => 0, 18 | AutoCommit => 0, 19 | mysql_conn_attrs => { foo => 'bar' }, 20 | } 21 | ); 22 | }; 23 | if ($@) { 24 | plan skip_all => "no database connection"; 25 | } 26 | 27 | my @pfenabled = $dbh->selectrow_array("show variables like 'performance_schema'"); 28 | if (!@pfenabled) { 29 | plan skip_all => 'performance schema not available'; 30 | } 31 | if ($pfenabled[1] ne 'ON') { 32 | plan skip_all => 'performance schema not enabled'; 33 | } 34 | 35 | if ($dbh->{mysql_clientversion} < 50606) { 36 | plan skip_all => 'client version should be 5.6.6 or later'; 37 | } 38 | 39 | eval {$dbh->do("select * from performance_schema.session_connect_attrs where processlist_id=connection_id()");}; 40 | if ($@) { 41 | $dbh->disconnect(); 42 | plan skip_all => "no permission on performance_schema tables"; 43 | } 44 | 45 | plan tests => 8; 46 | 47 | my $rows = $dbh->selectall_hashref("select * from performance_schema.session_connect_attrs where processlist_id=connection_id()", "ATTR_NAME"); 48 | 49 | my $pid =$rows->{_pid}->{ATTR_VALUE}; 50 | cmp_ok $pid, '==', $$; 51 | 52 | my $progname =$rows->{program_name}->{ATTR_VALUE}; 53 | cmp_ok $progname, 'eq', $0; 54 | 55 | my $foo_attr =$rows->{foo}->{ATTR_VALUE}; 56 | cmp_ok $foo_attr, 'eq', 'bar'; 57 | 58 | for my $key ('_platform','_client_name','_client_version','_os') { 59 | my $row = $rows->{$key}; 60 | 61 | cmp_ok defined $row, '==', 1, "attribute $key"; 62 | } 63 | 64 | ok $dbh->disconnect; 65 | -------------------------------------------------------------------------------- /t/57trackgtid.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require "lib.pl"; 10 | 11 | my $dbh; 12 | eval{$dbh = DBI->connect($test_dsn, $test_user, $test_password, 13 | {RaiseError => 1});}; 14 | 15 | if ($@) { 16 | plan skip_all => 17 | "no database connection"; 18 | } 19 | 20 | if ($dbh->{mysql_serverversion} > 100000) { 21 | plan skip_all => "GTID tracking is not available on MariaDB"; 22 | } 23 | 24 | if ($dbh->{mysql_serverversion} < 50000) { 25 | plan skip_all => "You must have MySQL version 5.0.0 and greater for this test to run"; 26 | } 27 | 28 | my @gtidtrackenabled = $dbh->selectrow_array('select @@global.session_track_gtids'); 29 | if (!@gtidtrackenabled) { 30 | plan skip_all => 'GTID tracking not available'; 31 | } elsif ($gtidtrackenabled[0] eq 'OFF') { 32 | plan skip_all => 'GTID tracking not enabled'; 33 | } else { 34 | plan tests => 2; 35 | } 36 | 37 | $dbh->do('FLUSH PRIVILEGES'); 38 | cmp_ok(length($dbh->{'mysql_gtids'}),'>=',38); 39 | 40 | ok $dbh->disconnect(); 41 | -------------------------------------------------------------------------------- /t/60leaks.t: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl5-dbi/DBD-mysql/8c6c960f081587c794a68d8389a42ef31ab757eb/t/60leaks.t -------------------------------------------------------------------------------- /t/65segfault.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | $|= 1; 10 | 11 | use vars qw($test_dsn $test_user $test_password); 12 | 13 | my $dbh; 14 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 15 | { 16 | mysql_auto_reconnect => 1, 17 | RaiseError => 1, 18 | PrintError => 1, 19 | AutoCommit => 1 }); 20 | }; 21 | 22 | if ($@) { 23 | plan skip_all => 24 | "no database connection"; 25 | } 26 | my $dbh2; 27 | eval {$dbh2= DBI->connect($test_dsn, $test_user, $test_password);}; 28 | 29 | if ($@) { 30 | plan skip_all => 31 | "no database connection"; 32 | } 33 | plan tests => 5; 34 | 35 | ok(defined $dbh, "Handle 1 Connected to database"); 36 | ok(defined $dbh2, "Handle 2 Connected to database"); 37 | 38 | #kill first db connection to trigger an auto reconnect 39 | ok ($dbh2->do('kill ' . $dbh->{'mysql_thread_id'})); 40 | 41 | #insert a temporary delay, try uncommenting this if it's not seg-faulting at first, 42 | # one of my initial tests without this delay didn't seg fault 43 | sleep 1; 44 | 45 | #ping first dbh handle to trigger auto-reconnect 46 | $dbh->ping; 47 | 48 | ok ($dbh); 49 | ok ($dbh2); 50 | -------------------------------------------------------------------------------- /t/65types.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use vars qw($test_dsn $test_user $test_password); 5 | use Test::More; 6 | use DBI; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my $dbh; 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | if ($@) { 14 | plan skip_all => "no database connection"; 15 | } 16 | plan tests => 19; 17 | 18 | ok $dbh->do("drop table if exists dbd_mysql_65types"); 19 | 20 | my $create= <do($create); 28 | 29 | my $sth; 30 | eval {$sth= $dbh->prepare("insert into dbd_mysql_65types values (?)")}; 31 | 32 | ok ! $@, "prepare: $@"; 33 | 34 | ok $sth->bind_param(1,10000,DBI::SQL_INTEGER); 35 | 36 | ok $sth->execute(); 37 | 38 | ok $sth->bind_param(1,10001,DBI::SQL_INTEGER); 39 | 40 | ok $sth->execute(); 41 | 42 | ok $dbh->do("DROP TABLE dbd_mysql_65types"); 43 | 44 | ok $dbh->do("create table dbd_mysql_65types (a int, b double, primary key (a))"); 45 | 46 | eval { $sth= $dbh->prepare("insert into dbd_mysql_65types values (?, ?)")}; 47 | 48 | ok ! $@, "prepare: $@"; 49 | 50 | ok $sth->bind_param(1,"10000 ",DBI::SQL_INTEGER); 51 | 52 | ok $sth->bind_param(2,"1.22 ",DBI::SQL_DOUBLE); 53 | 54 | ok $sth->execute(); 55 | 56 | ok $sth->bind_param(1,10001,DBI::SQL_INTEGER); 57 | 58 | ok $sth->bind_param(2,.3333333,DBI::SQL_DOUBLE); 59 | 60 | ok $sth->execute(); 61 | 62 | ok $sth->finish; 63 | 64 | ok $dbh->do("DROP TABLE dbd_mysql_65types"); 65 | 66 | ok $dbh->disconnect; 67 | -------------------------------------------------------------------------------- /t/70takeimp.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | $|= 1; 9 | use vars qw($test_dsn $test_user $test_password); 10 | 11 | my $drh; 12 | eval {$drh = DBI->install_driver('mysql')}; 13 | 14 | if ($@) { 15 | plan skip_all => "Can't obtain driver handle ERROR: $@. Can't continue test"; 16 | } 17 | 18 | my $dbh; 19 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 20 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 })}; 21 | 22 | if ($@) { 23 | plan skip_all => "no database connection"; 24 | } 25 | plan tests => 21; 26 | 27 | pass("obtained driver handle"); 28 | pass("connected to database"); 29 | 30 | my $id= connection_id($dbh); 31 | ok defined($id), "Initial connection: $id\n"; 32 | 33 | $drh = $dbh->{Driver}; 34 | ok $drh, "Driver handle defined\n"; 35 | 36 | my $imp_data; 37 | $imp_data = $dbh->take_imp_data; 38 | 39 | ok $imp_data, "Didn't get imp_data"; 40 | 41 | my $imp_data_length= length($imp_data); 42 | cmp_ok $imp_data_length, '>=', 80, 43 | "test that our imp_data is greater than or equal to 80, actual $imp_data_length"; 44 | 45 | is $drh->{Kids}, 0, 46 | 'our Driver should have 0 Kid(s) after calling take_imp_data'; 47 | 48 | { 49 | my $warn; 50 | local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /after take_imp_data/ }; 51 | 52 | my $drh = $dbh->{Driver}; 53 | ok !defined($drh), '... our Driver should be undefined'; 54 | 55 | my $trace_level = $dbh->{TraceLevel}; 56 | ok !defined($trace_level) ,'our TraceLevel should be undefined'; 57 | 58 | ok !defined($dbh->disconnect), 'disconnect should return undef'; 59 | 60 | ok !defined($dbh->quote(42)), 'quote should return undefined'; 61 | 62 | is $warn, 4, 'we should have received 4 warnings'; 63 | } 64 | 65 | my $dbh2 = DBI->connect($test_dsn, $test_user, $test_password, 66 | { dbi_imp_data => $imp_data }); 67 | 68 | # XXX: how can we test that the same connection is used? 69 | my $id2 = connection_id($dbh2); 70 | note "Overridden connection: $id2\n"; 71 | 72 | cmp_ok $id,'==', $id2, "the same connection: $id => $id2\n"; 73 | 74 | my $drh2; 75 | ok $drh2 = $dbh2->{Driver}, "can't get the driver\n"; 76 | 77 | ok $dbh2->isa("DBI::db"), 'isa test'; 78 | # need a way to test dbi_imp_data has been used 79 | 80 | is $drh2->{Kids}, 1, 81 | "our Driver should have 1 Kid(s) again: having " . $drh2->{Kids} . "\n"; 82 | 83 | is $drh2->{ActiveKids}, 1, 84 | "our Driver should have 1 ActiveKid again: having " . $drh2->{ActiveKids} . "\n"; 85 | 86 | read_write_test($dbh2); 87 | 88 | # must cut the connection data again 89 | ok ($imp_data = $dbh2->take_imp_data, "didn't get imp_data"); 90 | 91 | 92 | sub read_write_test { 93 | my ($dbh)= @_; 94 | 95 | # now the actual test: 96 | 97 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t70takeimp"); 98 | 99 | my $create= <do($create); 106 | 107 | ok $dbh->do("DROP TABLE dbd_mysql_t70takeimp"); 108 | } 109 | 110 | -------------------------------------------------------------------------------- /t/71impdata.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | use Test::More; 10 | 11 | $| = 1; 12 | 13 | use vars qw($test_dsn $test_user $test_password); 14 | 15 | my $dbh; 16 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 17 | { RaiseError => 1, AutoCommit => 1})}; 18 | 19 | if ($@) { 20 | plan skip_all => "no database connection"; 21 | } 22 | 23 | my $drh = $dbh->{Driver}; 24 | if (! defined $drh) { 25 | plan skip_all => "Can't obtain driver handle. Can't continue test"; 26 | } 27 | 28 | plan tests => 10; 29 | 30 | pass("Connected to database"); 31 | pass("Obtained driver handle"); 32 | 33 | my $connection_id1 = connection_id($dbh); 34 | 35 | is $drh->{Kids}, 1, "1 kid"; 36 | is $drh->{ActiveKids}, 1, "1 active kid"; 37 | 38 | my $imp_data = $dbh->take_imp_data; 39 | is $drh->{Kids}, 0, "no kids"; 40 | is $drh->{ActiveKids}, 0, "no active kids"; 41 | $dbh = DBI->connect( $test_dsn, $test_user, $test_password, 42 | { dbi_imp_data => $imp_data } ); 43 | my $connection_id2 = connection_id($dbh); 44 | is $connection_id1, $connection_id2, "got same session"; 45 | 46 | is $drh->{Kids}, 1, "1 kid"; 47 | is $drh->{ActiveKids}, 1, "1 active kid"; 48 | 49 | ok $dbh->disconnect, "Disconnect OK"; 50 | -------------------------------------------------------------------------------- /t/75supported_sql.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use vars qw($test_dsn $test_user $test_password); 5 | use DBI; 6 | use Test::More; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my ($row, $vers, $test_procs); 11 | 12 | my $dbh; 13 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, AutoCommit => 1})}; 15 | 16 | if ($@) { 17 | plan skip_all => "no database connection"; 18 | } 19 | plan tests => 12; 20 | 21 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t75supported"); 22 | 23 | my $create = <do($create),"create dbd_mysql_t75supported"; 31 | 32 | my $sth; 33 | ok ($sth= $dbh->prepare("SHOW TABLES LIKE 'dbd_mysql_t75supported'")); 34 | 35 | ok $sth->execute(); 36 | 37 | ok ($row= $sth->fetchrow_arrayref); 38 | 39 | cmp_ok $row->[0], 'eq', 'dbd_mysql_t75supported', "\$row->[0] eq dbd_mysql_t75supported"; 40 | 41 | ok $sth->finish; 42 | 43 | ok $dbh->do("DROP TABLE dbd_mysql_t75supported"), "drop dbd_mysql_t75supported"; 44 | 45 | ok $dbh->do("CREATE TABLE dbd_mysql_t75supported (a int)"), "creating dbd_mysql_t75supported again with 1 col"; 46 | 47 | ok $dbh->do("ALTER TABLE dbd_mysql_t75supported ADD COLUMN b varchar(31)"), "alter dbd_mysql_t75supported ADD COLUMN"; 48 | 49 | ok $dbh->do("DROP TABLE dbd_mysql_t75supported"), "drop dbd_mysql_t75supported"; 50 | 51 | ok $dbh->disconnect; 52 | -------------------------------------------------------------------------------- /t/76multi_statement.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | $|= 1; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | 12 | my $dbh; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, PrintError => 1, AutoCommit => 0, 15 | mysql_multi_statements => 1 });}; 16 | 17 | if ($@) { 18 | plan skip_all => "no database connection"; 19 | } 20 | plan tests => 26; 21 | 22 | ok (defined $dbh, "Connected to database with multi statement support"); 23 | 24 | $dbh->{mysql_server_prepare}= 0; 25 | 26 | SKIP: { 27 | skip "Server doesn't support multi statements", 25 28 | if $dbh->{mysql_clientversion} < 40101 or $dbh->{mysql_serverversion} < 40101; 29 | 30 | skip "Server has deadlock bug 16581", 25 31 | if $dbh->{mysql_clientversion} < 50025 or ($dbh->{mysql_serverversion} >= 50100 and $dbh->{mysql_serverversion} < 50112); 32 | 33 | ok($dbh->do("SET SQL_MODE=''"),"init connection SQL_MODE non strict"); 34 | 35 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_t76multi"), "clean up"); 36 | 37 | ok($dbh->do("CREATE TABLE dbd_mysql_t76multi (a INT)"), "create table"); 38 | 39 | ok($dbh->do("INSERT INTO dbd_mysql_t76multi VALUES (1); INSERT INTO dbd_mysql_t76multi VALUES (2);"), "2 inserts"); 40 | 41 | # Check that a second do() doesn't fail with an 'Out of sync' error 42 | ok($dbh->do("INSERT INTO dbd_mysql_t76multi VALUES (3); INSERT INTO dbd_mysql_t76multi VALUES (4);"), "2 more inserts"); 43 | 44 | # Check that more_results works for non-SELECT results too 45 | my $sth; 46 | ok($sth = $dbh->prepare("UPDATE dbd_mysql_t76multi SET a=5 WHERE a=1; UPDATE dbd_mysql_t76multi SET a='6-' WHERE a<4")); 47 | ok($sth->execute(), "Execute updates"); 48 | is($sth->rows, 1, "First update affected 1 row"); 49 | is($sth->{mysql_warning_count}, 0, "First update had no warnings"); 50 | ok($sth->{Active}, "Statement handle is Active"); 51 | ok($sth->more_results()); 52 | is($sth->rows, 2, "Second update affected 2 rows"); 53 | is($sth->{mysql_warning_count}, 2, "Second update had 2 warnings"); 54 | ok(not $sth->more_results()); 55 | ok($sth->finish()); 56 | 57 | # Now run it again without calling more_results(). 58 | ok($sth->execute(), "Execute updates again"); 59 | ok($sth->finish()); 60 | 61 | # Check that do() doesn't fail with an 'Out of sync' error 62 | is($dbh->do("DELETE FROM dbd_mysql_t76multi"), 4, "Delete all rows"); 63 | 64 | # Test that do() reports errors from all result sets 65 | $dbh->{RaiseError} = $dbh->{PrintError} = 0; 66 | ok(!$dbh->do("INSERT INTO dbd_mysql_t76multi VALUES (1); INSERT INTO bad_dbd_mysql_t76multi VALUES (2);"), "do() reports errors"); 67 | 68 | # Test that execute() reports errors from only the first result set 69 | ok($sth = $dbh->prepare("UPDATE dbd_mysql_t76multi SET a=2; UPDATE bad_dbd_mysql_t76multi SET a=3")); 70 | ok($sth->execute(), "Execute updates"); 71 | ok(!$sth->err(), "Err was not set after execute"); 72 | ok(!$sth->more_results()); 73 | ok($sth->err(), "Err was set after more_results"); 74 | ok $dbh->do("DROP TABLE dbd_mysql_t76multi"); 75 | }; 76 | 77 | $dbh->disconnect(); 78 | -------------------------------------------------------------------------------- /t/80procs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use lib 't', '.'; 5 | require 'lib.pl'; 6 | use DBI; 7 | use Test::More; 8 | use vars qw($test_dsn $test_user $test_password); 9 | 10 | my ($row, $vers, $test_procs, $dbh, $sth); 11 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, AutoCommit => 1})}; 13 | 14 | if ($@) { 15 | plan skip_all => 16 | "no database connection"; 17 | } 18 | 19 | # 20 | # DROP/CREATE PROCEDURE will give syntax error 21 | # for versions < 5.0 22 | # 23 | if ($dbh->{mysql_serverversion} < 50000) { 24 | plan skip_all => 25 | "You must have MySQL version 5.0 and greater for this test to run"; 26 | } 27 | 28 | # Tested with TiDB v8.5.1. 29 | if ($dbh->{'mysql_serverinfo'} =~ 'TiDB') { 30 | plan skip_all => 31 | "SKIP TEST: TiDB doesn't support stored procedures"; 32 | } 33 | 34 | if (!CheckRoutinePerms($dbh)) { 35 | plan skip_all => 36 | "Your test user does not have ALTER_ROUTINE privileges."; 37 | } 38 | 39 | plan tests => 31; 40 | 41 | $dbh->disconnect(); 42 | 43 | ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password, 44 | { RaiseError => 1, AutoCommit => 1})); 45 | 46 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t80procs"); 47 | 48 | my $drop_proc= "DROP PROCEDURE IF EXISTS dbd_mysql_t80testproc"; 49 | 50 | ok ($dbh->do($drop_proc), "DROP PROCEDURE") or diag "errstr=$DBI::errstr, err=$DBI::err"; 51 | 52 | 53 | my $proc_create = <do($proc_create); 69 | 70 | my $proc_call = 'CALL dbd_mysql_t80testproc()'; 71 | 72 | ok $dbh->do($proc_call); 73 | 74 | my $proc_select = 'SELECT @a'; 75 | ok ($sth = $dbh->prepare($proc_select)); 76 | 77 | ok $sth->execute(); 78 | 79 | ok $sth->finish; 80 | 81 | ok $dbh->do("DROP PROCEDURE dbd_mysql_t80testproc"); 82 | 83 | ok $dbh->do("drop procedure if exists test_multi_sets"); 84 | 85 | $proc_create = <do($proc_create); 96 | 97 | ok ($sth = $dbh->prepare("call test_multi_sets()")); 98 | 99 | ok $sth->execute(); 100 | 101 | is $sth->{NUM_OF_FIELDS}, 1, "num_of_fields == 1"; 102 | 103 | my $resultset; 104 | ok ($resultset = $sth->fetchrow_arrayref()); 105 | 106 | ok defined $resultset; 107 | 108 | is @$resultset, 1, "1 row in resultset"; 109 | 110 | undef $resultset; 111 | 112 | ok $sth->more_results(); 113 | 114 | is $sth->{NUM_OF_FIELDS}, 2, "NUM_OF_FIELDS == 2"; 115 | 116 | ok ($resultset= $sth->fetchrow_arrayref()); 117 | 118 | ok defined $resultset; 119 | 120 | is @$resultset, 2, "2 rows in resultset"; 121 | 122 | undef $resultset; 123 | 124 | ok $sth->more_results(); 125 | 126 | is $sth->{NUM_OF_FIELDS}, 3, "NUM_OF_FIELDS == 3"; 127 | 128 | ok ($resultset= $sth->fetchrow_arrayref()); 129 | 130 | ok defined $resultset; 131 | 132 | is @$resultset, 3, "3 Rows in resultset"; 133 | 134 | ok $sth->more_results(); 135 | 136 | is $sth->{NUM_OF_FIELDS}, 0, "NUM_OF_FIELDS == 0"; + 137 | 138 | local $SIG{__WARN__} = sub { die @_ }; 139 | 140 | ok $sth->finish; 141 | 142 | ok $dbh->disconnect(); 143 | -------------------------------------------------------------------------------- /t/81procs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use lib 't', '.'; 5 | require 'lib.pl'; 6 | use DBI; 7 | use Test::More; 8 | use vars qw($test_dsn $test_user $test_password); 9 | 10 | my ($row, $vers, $test_procs, $dbh, $sth); 11 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, AutoCommit => 1})}; 13 | 14 | if ($@) { 15 | plan skip_all => 16 | "no database connection"; 17 | } 18 | 19 | # 20 | # DROP/CREATE PROCEDURE will give syntax error 21 | # for versions < 5.0 22 | # 23 | if ($dbh->{mysql_serverversion} < 50000) { 24 | plan skip_all => 25 | "You must have MySQL version 5.0 and greater for this test to run"; 26 | } 27 | 28 | # Tested with TiDB v8.5.1. 29 | if ($dbh->{'mysql_serverinfo'} =~ 'TiDB') { 30 | plan skip_all => 31 | "SKIP TEST: TiDB doesn't support stored procedures"; 32 | } 33 | 34 | if (!CheckRoutinePerms($dbh)) { 35 | plan skip_all => 36 | "Your test user does not have ALTER_ROUTINE privileges."; 37 | } 38 | 39 | plan tests => 32; 40 | 41 | $dbh->disconnect(); 42 | 43 | ok ($dbh = DBI->connect($test_dsn, $test_user, $test_password, 44 | { RaiseError => 1, AutoCommit => 1})); 45 | 46 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t81procs"); 47 | 48 | my $drop_proc= "DROP PROCEDURE IF EXISTS testproc"; 49 | 50 | ok $dbh->do($drop_proc); 51 | 52 | 53 | my $proc_create = <do($proc_create); 69 | 70 | my $proc_call = 'CALL testproc()'; 71 | 72 | ok $dbh->do($proc_call); 73 | 74 | my $proc_select = 'SELECT @a'; 75 | ok ($sth = $dbh->prepare($proc_select)); 76 | 77 | ok $sth->execute(); 78 | 79 | ok $sth->finish; 80 | 81 | ok $dbh->do("DROP PROCEDURE testproc"); 82 | 83 | ok $dbh->do("drop procedure if exists test_multi_sets"); 84 | 85 | $proc_create = <do($proc_create); 96 | 97 | ok ($sth = $dbh->prepare("call test_multi_sets()")); 98 | 99 | ok $sth->execute(); 100 | 101 | is $sth->{NUM_OF_FIELDS}, 1, "num_of_fields == 1"; 102 | 103 | my $resultset; 104 | ok ($resultset = $sth->fetchrow_arrayref()); 105 | 106 | ok defined $resultset; 107 | 108 | is @$resultset, 1, "1 row in resultset"; 109 | 110 | undef $resultset; 111 | 112 | ok $sth->more_results(); 113 | 114 | is $sth->{NUM_OF_FIELDS}, 2, "NUM_OF_FIELDS == 2"; 115 | 116 | ok ($resultset= $sth->fetchrow_arrayref()); 117 | 118 | ok defined $resultset; 119 | 120 | is @$resultset, 2, "2 rows in resultset"; 121 | 122 | undef $resultset; 123 | 124 | ok $sth->more_results(); 125 | 126 | is $sth->{NUM_OF_FIELDS}, 3, "NUM_OF_FIELDS == 3"; 127 | 128 | ok ($resultset= $sth->fetchrow_arrayref()); 129 | 130 | ok defined $resultset; 131 | 132 | is @$resultset, 3, "3 Rows in resultset"; 133 | 134 | is $sth->more_results(), 1, "each CALL returns a result to indicate the call status"; 135 | 136 | is $sth->{NUM_OF_FIELDS}, 0, "NUM_OF_FIELDS == 0"; 137 | 138 | ok !$sth->more_results(); 139 | 140 | local $SIG{__WARN__} = sub { die @_ }; 141 | 142 | ok $sth->finish; 143 | 144 | ok $dbh->disconnect(); 145 | -------------------------------------------------------------------------------- /t/85init_command.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | $|= 1; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | use lib 't', '.'; 11 | require 'lib.pl'; 12 | 13 | my $dbh; 14 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 15 | { RaiseError => 1, 16 | PrintError => 1, 17 | AutoCommit => 0, 18 | mysql_init_command => 'SET SESSION wait_timeout=7' });}; 19 | 20 | if ($@) { 21 | plan skip_all => "no database connection"; 22 | } 23 | plan tests => 5; 24 | 25 | ok(defined $dbh, "Connected to database"); 26 | 27 | ok(my $sth=$dbh->prepare("SHOW SESSION VARIABLES like 'wait_timeout'")); 28 | 29 | ok($sth->execute()); 30 | 31 | ok(my @fetchrow = $sth->fetchrow_array()); 32 | 33 | is($fetchrow[1],'7','session variable is 7'); 34 | 35 | $sth->finish(); 36 | 37 | $dbh->disconnect(); 38 | 39 | -------------------------------------------------------------------------------- /t/86_bug_36972.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | use vars qw($test_dsn $test_user $test_password); 9 | 10 | $|= 1; 11 | 12 | my $dbh; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | plan tests => 11; 19 | 20 | ok(defined $dbh, "connecting"); 21 | 22 | # 23 | # Bug #42723: Binding server side integer parameters results in corrupt data 24 | # 25 | ok($dbh->do('DROP TABLE IF EXISTS dbd_mysql_t86'), "making slate clean"); 26 | 27 | ok($dbh->do('CREATE TABLE dbd_mysql_t86 (`i` int,`si` smallint,`ti` tinyint,`bi` bigint)'), "creating test table"); 28 | 29 | my $sth2; 30 | ok($sth2 = $dbh->prepare('INSERT INTO dbd_mysql_t86 VALUES (?,?,?,?)')); 31 | 32 | #bind test values 33 | ok($sth2->bind_param(1, 101, DBI::SQL_INTEGER), "binding int"); 34 | ok($sth2->bind_param(2, 102, DBI::SQL_SMALLINT), "binding smallint"); 35 | ok($sth2->bind_param(3, 103, DBI::SQL_TINYINT), "binding tinyint"); 36 | ok($sth2->bind_param(4, 104, DBI::SQL_INTEGER), "binding bigint"); 37 | 38 | ok($sth2->execute(), "inserting data"); 39 | 40 | is_deeply($dbh->selectall_arrayref('SELECT * FROM dbd_mysql_t86'), [[101, 102, 103, 104]]); 41 | 42 | ok ($dbh->do('DROP TABLE dbd_mysql_t86'), "cleaning up"); 43 | 44 | $dbh->disconnect(); 45 | -------------------------------------------------------------------------------- /t/87async.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::Deep; 5 | use Test::More; 6 | use DBI; 7 | use DBI::Const::GetInfoType; 8 | use Time::HiRes; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | use lib 't', '.'; 12 | require 'lib.pl'; 13 | 14 | my $dbh; 15 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 16 | { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; 17 | if (!$dbh) { 18 | plan skip_all => "no database connection"; 19 | } 20 | if ($dbh->{mysql_serverversion} < 50012) { 21 | plan skip_all => "Servers < 5.0.12 do not support SLEEP()"; 22 | } 23 | plan tests => 92; 24 | 25 | is $dbh->get_info($GetInfoType{'SQL_ASYNC_MODE'}), 2; # statement-level async 26 | is $dbh->get_info($GetInfoType{'SQL_MAX_ASYNC_CONCURRENT_STATEMENTS'}), 1; 27 | 28 | $dbh->do(<mysql_fd; 37 | ok !defined($dbh->mysql_async_ready); 38 | 39 | my ( $start, $end ); 40 | my $rows; 41 | my $sth; 42 | my ( $a, $b, $c ); 43 | 44 | $start = Time::HiRes::gettimeofday(); 45 | $rows = $dbh->do('INSERT INTO async_test VALUES (SLEEP(2), 0, 0)'); 46 | $end = Time::HiRes::gettimeofday(); 47 | 48 | is $rows, 1; 49 | ok(($end - $start) >= 2); 50 | 51 | $start = Time::HiRes::gettimeofday(); 52 | $rows = $dbh->do('INSERT INTO async_test VALUES (SLEEP(2), 0, 0)', { async => 1 }); 53 | ok(defined($dbh->mysql_async_ready)) or die; 54 | $end = Time::HiRes::gettimeofday(); 55 | 56 | ok $rows; 57 | is $rows, '0E0'; 58 | 59 | ok(($end - $start) < 2); 60 | 61 | sleep 1 until $dbh->mysql_async_ready; 62 | $end = Time::HiRes::gettimeofday(); 63 | ok(($end - $start) >= 2); 64 | 65 | $rows = $dbh->mysql_async_result; 66 | ok !defined($dbh->mysql_async_ready); 67 | 68 | is $rows, 1; 69 | 70 | ( $rows ) = $dbh->selectrow_array('SELECT COUNT(1) FROM async_test'); 71 | 72 | is $rows, 2; 73 | 74 | $dbh->do('DELETE FROM async_test'); 75 | 76 | $start = Time::HiRes::gettimeofday(); 77 | $rows = $dbh->do('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', { async => 1 }, 1, 2); 78 | $end = Time::HiRes::gettimeofday(); 79 | 80 | ok $rows; 81 | is $rows, '0E0'; 82 | 83 | ok(($end - $start) < 2); 84 | 85 | sleep 1 until $dbh->mysql_async_ready; 86 | $end = Time::HiRes::gettimeofday(); 87 | ok(($end - $start) >= 2); 88 | 89 | $rows = $dbh->mysql_async_result; 90 | 91 | is $rows, 1; 92 | 93 | ( $a, $b, $c ) = $dbh->selectrow_array('SELECT * FROM async_test'); 94 | 95 | is $a, 0; 96 | is $b, 1; 97 | is $c, 2; 98 | 99 | $sth = $dbh->prepare('SELECT SLEEP(2)'); 100 | ok !defined($sth->mysql_async_ready); 101 | $start = Time::HiRes::gettimeofday(); 102 | ok $sth->execute; 103 | $end = Time::HiRes::gettimeofday(); 104 | ok(($end - $start) >= 2); 105 | 106 | $sth = $dbh->prepare('SELECT SLEEP(2)', { async => 1 }); 107 | ok !defined($sth->mysql_async_ready); 108 | $start = Time::HiRes::gettimeofday(); 109 | ok $sth->execute; 110 | ok defined($sth->mysql_async_ready); 111 | $end = Time::HiRes::gettimeofday(); 112 | ok(($end - $start) < 2); 113 | 114 | sleep 1 until $sth->mysql_async_ready; 115 | 116 | my $row = $sth->fetch; 117 | $end = Time::HiRes::gettimeofday(); 118 | ok $row; 119 | is $row->[0], 0; 120 | ok(($end - $start) >= 2); 121 | 122 | $rows = $dbh->do('INSERT INTO async_test VALUES(SLEEP(2), ?, ?', { async => 1 }, 1, 2); 123 | 124 | ok $rows; 125 | ok !$dbh->errstr; 126 | $rows = $dbh->mysql_async_result; 127 | ok !$rows; 128 | ok $dbh->errstr; 129 | 130 | $dbh->do('DELETE FROM async_test'); 131 | 132 | $sth = $dbh->prepare('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', { async => 1 }); 133 | $start = Time::HiRes::gettimeofday(); 134 | $rows = $sth->execute(1, 2); 135 | $end = Time::HiRes::gettimeofday(); 136 | ok(($end - $start) < 2); 137 | ok $rows; 138 | is $rows, '0E0'; 139 | 140 | $rows = $sth->mysql_async_result; 141 | $end = Time::HiRes::gettimeofday(); 142 | ok(($end - $start) >= 2); 143 | is $rows, 1; 144 | 145 | ( $a, $b, $c ) = $dbh->selectrow_array('SELECT * FROM async_test'); 146 | 147 | is $a, 0; 148 | is $b, 1; 149 | is $c, 2; 150 | 151 | $sth = $dbh->prepare('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', { async => 1 }); 152 | $rows = $dbh->do('INSERT INTO async_test VALUES(SLEEP(2), ?, ?)', undef, 1, 2); 153 | is $rows, 1; 154 | 155 | $start = Time::HiRes::gettimeofday(); 156 | $dbh->selectrow_array('SELECT SLEEP(2)', { async => 1 }); 157 | $end = Time::HiRes::gettimeofday(); 158 | 159 | ok(($end - $start) >= 2); 160 | ok !defined($dbh->mysql_async_result); 161 | ok !defined($dbh->mysql_async_ready); 162 | 163 | $rows = $dbh->do('UPDATE async_test SET value0 = 0 WHERE value0 = 999', { async => 1 }); 164 | ok $rows; 165 | is $rows, '0E0'; 166 | $rows = $dbh->mysql_async_result; 167 | ok $rows; 168 | is $rows, '0E0'; 169 | 170 | $sth = $dbh->prepare('UPDATE async_test SET value0 = 0 WHERE value0 = 999', { async => 1 }); 171 | $rows = $sth->execute; 172 | ok $rows; 173 | is $rows, '0E0'; 174 | $rows = $sth->mysql_async_result; 175 | ok $rows; 176 | is $rows, '0E0'; 177 | 178 | $sth->execute; 179 | $rows = $dbh->do('INSERT INTO async_test VALUES(1, 2, 3)'); 180 | ok !$rows; 181 | undef $sth; 182 | $rows = $dbh->do('INSERT INTO async_test VALUES(1, 2, 3)'); 183 | is $rows, 1; 184 | 185 | $sth = $dbh->prepare('SELECT 1, value0, value1, value2 FROM async_test WHERE value0 = ?', { async => 1 }); 186 | $sth->execute(1); 187 | is $sth->{'NUM_OF_FIELDS'}, undef; 188 | is $sth->{'NUM_OF_PARAMS'}, 1; 189 | is $sth->{'NAME'}, undef; 190 | is $sth->{'NAME_lc'}, undef; 191 | is $sth->{'NAME_uc'}, undef; 192 | is $sth->{'NAME_hash'}, undef; 193 | is $sth->{'NAME_lc_hash'}, undef; 194 | is $sth->{'NAME_uc_hash'}, undef; 195 | is $sth->{'TYPE'}, undef; 196 | is $sth->{'PRECISION'}, undef; 197 | is $sth->{'SCALE'}, undef; 198 | is $sth->{'NULLABLE'}, undef; 199 | is $sth->{'Database'}, $dbh; 200 | is $sth->{'Statement'}, 'SELECT 1, value0, value1, value2 FROM async_test WHERE value0 = ?'; 201 | $sth->mysql_async_result; 202 | is $sth->{'NUM_OF_FIELDS'}, 4; 203 | is $sth->{'NUM_OF_PARAMS'}, 1; 204 | cmp_bag $sth->{'NAME'}, [qw/1 value0 value1 value2/]; 205 | cmp_bag $sth->{'NAME_lc'}, [qw/1 value0 value1 value2/]; 206 | cmp_bag $sth->{'NAME_uc'}, [qw/1 VALUE0 VALUE1 VALUE2/]; 207 | cmp_bag [ keys %{$sth->{'NAME_hash'}} ], [qw/1 value0 value1 value2/]; 208 | cmp_bag [ keys %{$sth->{'NAME_lc_hash'}} ], [qw/1 value0 value1 value2/]; 209 | cmp_bag [ keys %{$sth->{'NAME_uc_hash'}} ], [qw/1 VALUE0 VALUE1 VALUE2/]; 210 | is ref($sth->{'TYPE'}), 'ARRAY'; 211 | is ref($sth->{'PRECISION'}), 'ARRAY'; 212 | is ref($sth->{'SCALE'}), 'ARRAY'; 213 | is ref($sth->{'NULLABLE'}), 'ARRAY'; 214 | is $sth->{'Database'}, $dbh; 215 | is $sth->{'Statement'}, 'SELECT 1, value0, value1, value2 FROM async_test WHERE value0 = ?'; 216 | $sth->finish; 217 | 218 | $sth->execute(1); 219 | $row = $sth->fetch; 220 | is_deeply $row, [1, 1, 2, 3]; 221 | $sth->finish; 222 | 223 | $sth->execute(1); 224 | $row = $sth->fetchrow_arrayref; 225 | is_deeply $row, [1, 1, 2, 3]; 226 | $sth->finish; 227 | 228 | $sth->execute(1); 229 | my @row = $sth->fetchrow_array; 230 | is_deeply \@row, [1, 1, 2, 3]; 231 | $sth->finish; 232 | 233 | $sth->execute(1); 234 | $row = $sth->fetchrow_hashref; 235 | cmp_bag [ keys %$row ], [qw/1 value0 value1 value2/]; 236 | cmp_bag [ values %$row ], [1, 1, 2, 3]; 237 | $sth->finish; 238 | 239 | undef $sth; 240 | ok $dbh->disconnect; 241 | -------------------------------------------------------------------------------- /t/88async-multi-stmts.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | my $dbh; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; 15 | if (!$dbh) { 16 | plan skip_all => "no database connection"; 17 | } 18 | plan tests => 8; 19 | 20 | $dbh->do(<prepare('INSERT INTO async_test VALUES(0)', { async => 1 }); 27 | my $sth1 = $dbh->prepare('INSERT INTO async_test VALUES(1)', { async => 1 }); 28 | 29 | $sth0->execute; 30 | ok !defined($sth1->mysql_async_ready); 31 | ok $sth1->errstr; 32 | ok !defined($sth1->mysql_async_result); 33 | ok $sth1->errstr; 34 | 35 | ok defined($sth0->mysql_async_ready); 36 | ok !$sth1->errstr; 37 | ok defined($sth0->mysql_async_result); 38 | ok !$sth1->errstr; 39 | 40 | undef $sth0; 41 | undef $sth1; 42 | 43 | $dbh->disconnect; 44 | -------------------------------------------------------------------------------- /t/89async-method-check.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use DBI::Const::GetInfoType; 7 | 8 | use vars qw($test_dsn $test_user $test_password); 9 | use lib 't', '.'; 10 | require 'lib.pl'; 11 | 12 | my @common_safe_methods = qw/ 13 | can err errstr parse_trace_flag parse_trace_flags 14 | private_attribute_info trace trace_msg visit_child_handles 15 | /; 16 | 17 | my @db_safe_methods = (@common_safe_methods, qw/ 18 | clone mysql_async_ready 19 | /); 20 | 21 | my @db_unsafe_methods = qw/ 22 | data_sources do last_insert_id selectrow_array 23 | selectrow_arrayref selectrow_hashref selectall_arrayref selectall_hashref 24 | selectcol_arrayref prepare prepare_cached commit 25 | rollback begin_work ping get_info 26 | table_info column_info primary_key_info primary_key 27 | foreign_key_info statistics_info tables type_info_all 28 | type_info quote quote_identifier 29 | /; 30 | 31 | my @st_safe_methods = qw/ 32 | fetchrow_arrayref fetch fetchrow_array fetchrow_hashref 33 | fetchall_arrayref fetchall_hashref finish rows 34 | /; 35 | 36 | my @st_unsafe_methods = qw/ 37 | bind_param bind_param_inout bind_param_array execute execute_array 38 | execute_for_fetch bind_col bind_columns 39 | /; 40 | 41 | my %dbh_args = ( 42 | can => ['can'], 43 | parse_trace_flag => ['SQL'], 44 | parse_trace_flags => ['SQL'], 45 | trace_msg => ['message'], 46 | visit_child_handles => [sub { }], 47 | quote => ['string'], 48 | quote_identifier => ['Users'], 49 | do => ['SELECT 1'], 50 | last_insert_id => [undef, undef, undef, undef], 51 | selectrow_array => ['SELECT 1'], 52 | selectrow_arrayref => ['SELECT 1'], 53 | selectrow_hashref => ['SELECT 1'], 54 | selectall_arrayref => ['SELECT 1'], 55 | selectall_hashref => ['SELECT 1', '1'], 56 | selectcol_arrayref => ['SELECT 1'], 57 | prepare => ['SELECT 1'], 58 | prepare_cached => ['SELECT 1'], 59 | get_info => [$GetInfoType{'SQL_DBMS_NAME'}], 60 | column_info => [undef, undef, '%', '%'], 61 | primary_key_info => [undef, undef, 'async_test'], 62 | primary_key => [undef, undef, 'async_test'], 63 | foreign_key_info => [undef, undef, 'async_test', undef, undef, undef], 64 | statistics_info => [undef, undef, 'async_test', 0, 1], 65 | ); 66 | 67 | my %sth_args = ( 68 | fetchall_hashref => [1], 69 | bind_param => [1, 1], 70 | bind_param_inout => [1, \(my $scalar = 1), 64], 71 | bind_param_array => [1, [1]], 72 | execute_array => [{ ArrayTupleStatus => [] }, [1]], 73 | execute_for_fetch => [sub { undef } ], 74 | bind_col => [1, \(my $scalar2 = 1)], 75 | bind_columns => [\(my $scalar3)], 76 | ); 77 | 78 | my $dbh; 79 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 80 | { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; 81 | if (!$dbh) { 82 | plan skip_all => "no database connection"; 83 | } 84 | plan tests => 85 | 2 * @db_safe_methods + 86 | 4 * @db_unsafe_methods + 87 | 7 * @st_safe_methods + 88 | 3 * @common_safe_methods + 89 | 2 * @st_unsafe_methods + 90 | 3; 91 | 92 | $dbh->do(<do('SELECT 1', { async => 1 }); 100 | my $args = $dbh_args{$method} || []; 101 | $dbh->$method(@$args); 102 | ok !$dbh->errstr, "Testing method '$method' on DBD::mysql::db during asynchronous operation"; 103 | 104 | ok defined($dbh->mysql_async_result); 105 | } 106 | 107 | $dbh->do('SELECT 1', { async => 1 }); 108 | ok defined($dbh->mysql_async_result); 109 | 110 | foreach my $method (@db_unsafe_methods) { 111 | $dbh->do('SELECT 1', { async => 1 }); 112 | my $args = $dbh_args{$method} || []; 113 | my @values = $dbh->$method(@$args); # some methods complain unless they're called in list context 114 | like $dbh->errstr, qr/Calling a synchronous function on an asynchronous handle/, "Testing method '$method' on DBD::mysql::db during asynchronous operation"; 115 | 116 | ok defined($dbh->mysql_async_result); 117 | } 118 | 119 | foreach my $method (@common_safe_methods) { 120 | my $sth = $dbh->prepare('SELECT 1', { async => 1 }); 121 | $sth->execute; 122 | my $args = $dbh_args{$method} || []; # they're common methods, so this should be ok! 123 | $sth->$method(@$args); 124 | ok !$sth->errstr, "Testing method '$method' on DBD::mysql::db during asynchronous operation"; 125 | ok defined($sth->mysql_async_result); 126 | ok defined($sth->mysql_async_result); 127 | } 128 | 129 | foreach my $method (@st_safe_methods) { 130 | my $sth = $dbh->prepare('SELECT 1', { async => 1 }); 131 | $sth->execute; 132 | my $args = $sth_args{$method} || []; 133 | $sth->$method(@$args); 134 | ok !$sth->errstr, "Testing method '$method' on DBD::mysql::st during asynchronous operation"; 135 | 136 | # statement safe methods cache async result and mysql_async_result can be called multiple times 137 | ok defined($sth->mysql_async_result), "Testing DBD::mysql::st method '$method' for async result"; 138 | ok defined($sth->mysql_async_result), "Testing DBD::mysql::st method '$method' for async result"; 139 | } 140 | 141 | foreach my $method (@st_safe_methods) { 142 | my $sync_sth = $dbh->prepare('SELECT 1'); 143 | my $async_sth = $dbh->prepare('SELECT 1', { async => 1 }); 144 | $dbh->do('SELECT 1', { async => 1 }); 145 | ok !$sync_sth->execute; 146 | ok $sync_sth->errstr; 147 | ok !$async_sth->execute; 148 | ok $async_sth->errstr; 149 | $dbh->mysql_async_result; 150 | } 151 | 152 | foreach my $method (@db_unsafe_methods) { 153 | my $sth = $dbh->prepare('SELECT 1', { async => 1 }); 154 | $sth->execute; 155 | ok !$dbh->do('SELECT 1', { async => 1 }); 156 | ok $dbh->errstr; 157 | $sth->mysql_async_result; 158 | } 159 | 160 | foreach my $method (@st_unsafe_methods) { 161 | my $sth = $dbh->prepare('SELECT value FROM async_test WHERE value = ?', { async => 1 }); 162 | $sth->execute(1); 163 | my $args = $sth_args{$method} || []; 164 | my @values = $sth->$method(@$args); 165 | like $dbh->errstr, qr/Calling a synchronous function on an asynchronous handle/, "Testing method '$method' on DBD::mysql::st during asynchronous operation"; 166 | 167 | ok(defined $sth->mysql_async_result); 168 | } 169 | 170 | my $sth = $dbh->prepare('SELECT 1', { async => 1 }); 171 | $sth->execute; 172 | ok defined($sth->mysql_async_ready); 173 | ok $sth->mysql_async_result; 174 | 175 | undef $sth; 176 | $dbh->disconnect; 177 | -------------------------------------------------------------------------------- /t/91errcheck.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require 'lib.pl'; 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 0, PrintError => 0, AutoCommit => 0 });}; 14 | if (!$dbh) { 15 | plan skip_all => "no database connection"; 16 | } 17 | 18 | plan tests => 1; 19 | 20 | $dbh->do( 'this should die' ); 21 | ok $DBI::errstr, 'error string should be set on a bad call'; 22 | 23 | $dbh->disconnect; 24 | -------------------------------------------------------------------------------- /t/92ssl_backronym_vulnerability.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require "lib.pl"; 10 | 11 | my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); 12 | my $have_ssl = eval { $dbh->selectrow_hashref("SHOW VARIABLES WHERE Variable_name = 'have_ssl'") }; 13 | $dbh->disconnect(); 14 | plan skip_all => 'Server supports SSL connections, cannot test false-positive enforcement' if $have_ssl and $have_ssl->{Value} eq 'YES'; 15 | 16 | # `have_ssl` has been deprecated in 8.0.26 and removed in 8.4.0... 17 | plan skip_all => 'Server might support SSL connections, cannot test false-positive enforcement' if not $have_ssl; 18 | 19 | plan tests => 4; 20 | 21 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 0, mysql_ssl => 1 }); 22 | ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1 and correct user and password'); 23 | is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); 24 | 25 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 0, mysql_ssl => 1, mysql_ssl_verify_server_cert => 1, mysql_ssl_ca_file => "" }); 26 | ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1, mysql_ssl_verify_server_cert=1 and correct user and password'); 27 | is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); 28 | -------------------------------------------------------------------------------- /t/92ssl_optional.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require "lib.pl"; 10 | 11 | my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); 12 | my $have_ssl = eval { $dbh->selectrow_hashref("SHOW VARIABLES WHERE Variable_name = 'have_ssl'") }; 13 | $dbh->disconnect(); 14 | plan skip_all => 'Server supports SSL connections, cannot test fallback to plain text' if $have_ssl and $have_ssl->{Value} eq 'YES'; 15 | 16 | # `have_ssl` has been deprecated in 8.0.26 and removed in 8.4.0... 17 | plan skip_all => 'Server might support SSL connections, cannot test false-positive enforcement' if not $have_ssl; 18 | 19 | plan tests => 2; 20 | 21 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 0, mysql_ssl => 1, mysql_ssl_optional => 1 }); 22 | ok(defined $dbh, 'DBD::mysql supports mysql_ssl_optional=1 and connect via plain text protocol when SSL is not supported by server') or diag('Error code: ' . ($DBI::err || 'none') . "\n" . 'Error message: ' . ($DBI::errstr || 'unknown')); 23 | 24 | $dbh = DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 0, mysql_ssl => 1, mysql_ssl_optional => 1, mysql_ssl_ca_file => "" }); 25 | ok(defined $dbh, 'DBD::mysql supports mysql_ssl_optional=1 and connect via plain text protocol when SSL is not supported by server even with mysql_ssl_ca_file') or diag('Error code: ' . ($DBI::err || 'none') . "\n" . 'Error message: ' . ($DBI::errstr || 'unknown')); 26 | 27 | -------------------------------------------------------------------------------- /t/92ssl_riddle_vulnerability.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | use lib 't', '.'; 9 | require "lib.pl"; 10 | 11 | my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); 12 | my $have_ssl = eval { $dbh->selectrow_hashref("SHOW VARIABLES WHERE Variable_name = 'have_ssl'") }; 13 | $dbh->disconnect(); 14 | plan skip_all => 'Server supports SSL connections, cannot test false-positive enforcement' if $have_ssl and $have_ssl->{Value} eq 'YES'; 15 | 16 | # `have_ssl` has been deprecated in 8.0.26 and removed in 8.4.0... 17 | plan skip_all => 'Server might support SSL connections, cannot test false-positive enforcement' if not $have_ssl; 18 | 19 | plan tests => 4; 20 | 21 | $dbh = DBI->connect($test_dsn, '4yZ73s9qeECdWi', '64heUGwAsVoNqo', { PrintError => 0, RaiseError => 0, mysql_ssl => 1 }); 22 | ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1 and incorrect user and password'); 23 | is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); 24 | 25 | $dbh = DBI->connect($test_dsn, '4yZ73s9qeECdWi', '64heUGwAsVoNqo', { PrintError => 0, RaiseError => 0, mysql_ssl => 1, mysql_ssl_verify_server_cert => 1, mysql_ssl_ca_file => "" }); 26 | ok(!defined $dbh, 'DBD::mysql refused connection to non-SSL server with mysql_ssl=1, mysql_ssl_verify_server_cert=1 and incorrect user and password'); 27 | is($DBI::err, 2026, 'DBD::mysql error message is SSL related') or diag('Error message: ' . ($DBI::errstr || 'unknown')); 28 | -------------------------------------------------------------------------------- /t/99_bug_server_prepare_blob_null.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use vars qw($COL_NULLABLE $COL_KEY); 8 | use lib 't', '.'; 9 | require 'lib.pl'; 10 | 11 | my $dbh; 12 | $test_dsn .= ';mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1'; 13 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 14 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 15 | if ($@) { 16 | plan skip_all => "no database connection"; 17 | } 18 | 19 | # 20 | # DROP/CREATE PROCEDURE will give syntax error for these versions 21 | # 22 | if (!MinimumVersion($dbh, '5.0')) { 23 | plan skip_all => 24 | "SKIP TEST: You must have MySQL version 5.0 and greater for this test to run"; 25 | } 26 | 27 | plan tests => 11; 28 | 29 | ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t99_prepare"); 30 | 31 | my $create =<do($create); 38 | 39 | $dbh->do("insert into dbd_mysql_t99_prepare (data) values(null)"); 40 | 41 | my $sth = $dbh->prepare("select data from dbd_mysql_t99_prepare"); 42 | ok $sth->execute; 43 | my $row = $sth->fetch; 44 | is $row->[0] => undef; 45 | 46 | ok $sth->finish; 47 | 48 | $dbh->do("insert into dbd_mysql_t99_prepare (data) values('a')"); 49 | $sth = $dbh->prepare("select data from dbd_mysql_t99_prepare"); 50 | ok $sth->execute; 51 | $row = $sth->fetch; 52 | is $row->[0] => undef; 53 | $row = $sth->fetch; 54 | is $row->[0] => 'a'; 55 | 56 | ok $sth->finish; 57 | 58 | ok $dbh->do("DROP TABLE dbd_mysql_t99_prepare"); 59 | 60 | ok $dbh->disconnect; 61 | -------------------------------------------------------------------------------- /t/99compression.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | my $dbh; 11 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 12 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 13 | 14 | if ($@) { 15 | diag $@; 16 | plan skip_all => "no database connection"; 17 | } 18 | 19 | if ($dbh->{mysql_serverversion} < 80000) { 20 | diag $dbh->{mysql_serverversion}; 21 | plan skip_all => "test requires 8.x or newer"; 22 | } 23 | 24 | if ($dbh->{'mysql_serverinfo'} =~ 'MariaDB') { 25 | plan skip_all => "No zstd or Compression_algorithm on MariaDB"; 26 | } 27 | 28 | foreach my $compression ( "zlib", "zstd", "0", "1" ) { 29 | my ($dbh, $sth, $row); 30 | 31 | eval {$dbh = DBI->connect($test_dsn . ";mysql_compression=$compression", $test_user, $test_password, 32 | { RaiseError => 1, AutoCommit => 1});}; 33 | 34 | ok ($sth= $dbh->prepare("SHOW SESSION STATUS LIKE 'Compression_algorithm'")); 35 | 36 | ok $sth->execute(); 37 | 38 | ok ($row= $sth->fetchrow_arrayref); 39 | 40 | my $exp = $compression; 41 | if ($exp eq "1") { $exp = "zlib" }; 42 | if ($exp eq "0") { $exp = "" }; 43 | cmp_ok $row->[1], 'eq', $exp, "\$row->[1] eq $exp"; 44 | 45 | ok $sth->finish; 46 | } 47 | 48 | plan tests => 4*5; 49 | -------------------------------------------------------------------------------- /t/gh352.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | use vars qw($test_dsn $test_user $test_password); 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; 14 | 15 | if ($@) { 16 | diag $@; 17 | plan skip_all => "no database connection"; 18 | } 19 | plan tests => 2; 20 | 21 | # https://github.com/perl5-dbi/DBD-mysql/issues/352 22 | # Calling prepare on a disconnected handle causes the call to mysql_real_escape_string to segfault 23 | 24 | my $sth; 25 | ok $dbh->disconnect; 26 | my $result = eval { 27 | $dbh->prepare('SELECT ?'); 28 | }; 29 | ok !$result 30 | -------------------------------------------------------------------------------- /t/gh360.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | use lib 't', '.'; 7 | require 'lib.pl'; 8 | 9 | # https://github.com/perl5-dbi/DBD-mysql/issues/360 10 | 11 | my ($dbhA, $dbhB); 12 | use vars qw($test_dsn $test_user $test_password); 13 | 14 | my $dsnA = $test_dsn . ';mysql_enable_utf8mb4=1'; 15 | eval {$dbhA = DBI->connect($dsnA, $test_user, $test_password, 16 | { RaiseError => 1, AutoCommit => 1});}; 17 | 18 | if ($@) { 19 | diag $@; 20 | plan skip_all => "no database connection"; 21 | } 22 | 23 | my $dsnB = $test_dsn; 24 | $dsnB =~ s/DBI:mysql/DBI:mysql(mysql_enable_utf8mb4=1)/; 25 | eval {$dbhB = DBI->connect($dsnB . ';mysql_enable_utf8mb4=1', $test_user, $test_password, 26 | { RaiseError => 1, AutoCommit => 1});}; 27 | 28 | plan tests => 2; 29 | 30 | ok($dbhA->{mysql_enable_utf8mb4} == 1, 'mysql_enable_utf8mb4 == 1 with regular DSN'); 31 | 32 | ok($dbhB->{mysql_enable_utf8mb4} == 1, 'mysql_enable_utf8mb4 == 1 with driver DSN'); 33 | -------------------------------------------------------------------------------- /t/gh447-paramvalues.t: -------------------------------------------------------------------------------- 1 | #! /bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | #"set tabstop=4 softtabstop=4 shiftwidth=4 expandtab 7 | 8 | use Data::Dumper; 9 | use Test::More; 10 | use DBI; 11 | use lib 't', '.'; 12 | require 'lib.pl'; 13 | 14 | my ($row, $sth, $dbh); 15 | my ($def, $rows, $errstr, $ret_ref); 16 | use vars qw($test_dsn $test_user $test_password); 17 | my $table = 'dbd_mysql_gh447'; 18 | 19 | eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password, 20 | { RaiseError => 1, AutoCommit => 1});}; 21 | 22 | if ($@) { 23 | plan skip_all => "no database connection"; 24 | } 25 | 26 | # in case of exit early, ensure we clean up 27 | END { 28 | if ($dbh) { 29 | $dbh->do("DROP TABLE IF EXISTS $table"); 30 | $dbh->disconnect(); 31 | } 32 | } 33 | 34 | # this is the starting index for the placeholder keys 35 | # in the ParamValues attribute hashref. gh#447 showed 36 | # the keys begin counting with 0, but DBI requires they 37 | # start counting at 1. 38 | # so, if this value is 0, tests pass under DBD::mysql 4.050. 39 | # but the value should be 1, when the issue is fixed. 40 | my $ofs = 1; 41 | 42 | # ------ set up 43 | ok(defined $dbh, "Connected to database"); 44 | $dbh->do("DROP TABLE IF EXISTS $table"); 45 | $dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"); 46 | 47 | # test prepare/execute statement without a placeholder 48 | 49 | $sth = $dbh->prepare("SHOW TABLES LIKE '$table'"); 50 | is_deeply($sth->{ParamValues}, {}, "ParamValues is empty hashref before SHOW"); 51 | $sth->execute(); 52 | 53 | is_deeply($sth->{ParamValues}, {}, "ParamValues is still empty after execution"); 54 | 55 | $sth->finish; 56 | is_deeply($sth->{ParamValues}, {}, "ParamValues empty after finish"); 57 | undef $sth; 58 | 59 | 60 | # test prepare/execute statement with a placeholder 61 | $sth = $dbh->prepare("INSERT INTO $table values (?, ?)"); 62 | is_deeply($sth->{ParamValues}, {0+$ofs => undef, 1+$ofs => undef}, 63 | "ParamValues is correct hashref before INSERT") 64 | || print Dumper($sth->{ParamValues}); 65 | 66 | # insert rows with placeholder 67 | my %rowdata; 68 | my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z'; 69 | 70 | for (my $i = 1 ; $i < 4; $i++) { 71 | my $word = join '', $i, '-', map { $chars[rand @chars] } 0 .. 16; 72 | $rowdata{$i} = $word; # save for later 73 | $rows = $sth->execute($i, $word); 74 | is($rows, 1, "Should have inserted one row"); 75 | is_deeply($sth->{ParamValues}, {0+$ofs => $i, 1+$ofs => $word}, 76 | "row $i ParamValues hashref as expected"); 77 | } 78 | 79 | $sth->finish; 80 | is_deeply($sth->{ParamValues}, {0+$ofs => 3, 1+$ofs => $rowdata{3}}, 81 | "ParamValues still hold last values after finish"); 82 | undef $sth; 83 | 84 | 85 | # test prepare/execute with bind_param 86 | 87 | $sth = $dbh->prepare("SELECT * FROM $table WHERE id = ? OR name = ?"); 88 | is_deeply($sth->{ParamValues}, {0+$ofs => undef, 1+$ofs => undef}, 89 | "ParamValues is hashref with keys before bind_param"); 90 | $sth->bind_param(1, 1, DBI::SQL_INTEGER); 91 | $sth->bind_param(2, $rowdata{1}); 92 | is_deeply($sth->{ParamValues}, {0+$ofs => 1, 1+$ofs => $rowdata{1}}, 93 | "ParamValues contains bound values after bind_param"); 94 | 95 | $rows = $sth->execute; 96 | is($rows, 1, 'execute selected 1 row'); 97 | is_deeply($sth->{ParamValues}, {0+$ofs => 1, 1+$ofs => $rowdata{1}}, 98 | "ParamValues still contains values after execute"); 99 | 100 | # try changing one parameter only (so still param 1 => 1) 101 | $sth->bind_param(2, $rowdata{2}); 102 | is_deeply($sth->{ParamValues}, {0+$ofs => 1, 1+$ofs => $rowdata{2}}, 103 | "ParamValues updated with another bind_param"); 104 | $rows = $sth->execute; 105 | is($rows, 2, 'execute selected 2 rows because changed param value'); 106 | 107 | # try execute with args (the previously bound values are overridden) 108 | $rows = $sth->execute(3, $rowdata{3}); 109 | is($rows, 1, 'execute used exec args, overrode bound params'); 110 | is_deeply($sth->{ParamValues}, {0+$ofs => 3, 1+$ofs => $rowdata{3}}, 111 | "ParamValues reflect execute args -- bound params overwritten"); 112 | 113 | $sth->bind_param(1, undef, DBI::SQL_INTEGER); 114 | is_deeply($sth->{ParamValues}, {0+$ofs => undef, 1+$ofs => $rowdata{3}}, 115 | "ParamValues includes undef param after binding"); 116 | 117 | $rows = $sth->execute(1, $rowdata{2}); 118 | is($rows, 2, 'execute used exec args, not bound values'); 119 | is_deeply($sth->{ParamValues}, {0+$ofs => 1, 1+$ofs => $rowdata{2}}, 120 | "ParamValues changed by execution"); 121 | 122 | undef $sth; 123 | 124 | 125 | # clean up 126 | $dbh->do("DROP TABLE IF EXISTS $table"); 127 | 128 | # Install a handler so that a warning about unfreed resources gets caught 129 | $SIG{__WARN__} = sub { die @_ }; 130 | 131 | $dbh->disconnect(); 132 | 133 | undef $dbh; 134 | 135 | done_testing(); 136 | 137 | -------------------------------------------------------------------------------- /t/lib.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI::Const::GetInfoType; 6 | use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password); 7 | 8 | $| = 1; # flush stdout asap to keep in sync with stderr 9 | 10 | # 11 | # Driver names; EDIT THIS! 12 | # 13 | $mdriver = 'mysql'; 14 | $dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver. 15 | # The exception is DBD::pNET where we have to 16 | # to separate between local driver (pNET) and 17 | # the remote driver ($dbdriver) 18 | 19 | 20 | # 21 | # DSN being used; do not edit this, edit "$dbdriver.dbtest" instead 22 | # 23 | 24 | 25 | $::COL_NULLABLE = 1; 26 | $::COL_KEY = 2; 27 | 28 | 29 | my $file; 30 | if (-f ($file = "t/$dbdriver.dbtest") || 31 | -f ($file = "$dbdriver.dbtest") || 32 | -f ($file = "../tests/$dbdriver.dbtest") || 33 | -f ($file = "tests/$dbdriver.dbtest")) { 34 | eval { require $file; }; 35 | if ($@) { 36 | print STDERR "Cannot execute $file: $@.\n"; 37 | print "1..0\n"; 38 | exit 0; 39 | } 40 | $::test_dsn = $::test_dsn || $ENV{'DBI_DSN'} || 'DBI:mysql:database=test'; 41 | $::test_user = $::test_user|| $ENV{'DBI_USER'} || ''; 42 | $::test_password = $::test_password || $ENV{'DBI_PASS'} || ''; 43 | } 44 | if (-f ($file = "t/$mdriver.mtest") || 45 | -f ($file = "$mdriver.mtest") || 46 | -f ($file = "../tests/$mdriver.mtest") || 47 | -f ($file = "tests/$mdriver.mtest")) { 48 | eval { require $file; }; 49 | if ($@) { 50 | print STDERR "Cannot execute $file: $@.\n"; 51 | print "1..0\n"; 52 | exit 0; 53 | } 54 | } 55 | 56 | sub DbiTestConnect { 57 | return (eval { DBI->connect(@_) } or do { 58 | my $err; 59 | if ( $@ ) { 60 | $err = $@; 61 | $err =~ s/ at \S+ line \d+\s*$//; 62 | } 63 | if ( not $err ) { 64 | $err = $DBI::errstr; 65 | $err = "unknown error" unless $err; 66 | my $user = $_[1]; 67 | my $dsn = $_[0]; 68 | $dsn =~ s/^DBI:mysql://; 69 | $err = "DBI connect('$dsn','$user',...) failed: $err"; 70 | } 71 | if ( $ENV{CONNECTION_TESTING} ) { 72 | BAIL_OUT "no database connection: $err"; 73 | } else { 74 | plan skip_all => "no database connection: $err"; 75 | } 76 | }); 77 | } 78 | 79 | # 80 | # Print a DBI error message 81 | # 82 | # TODO - This is on the chopping block 83 | sub DbiError ($$) { 84 | my ($rc, $err) = @_; 85 | $rc ||= 0; 86 | $err ||= ''; 87 | $::numTests ||= 0; 88 | print "Test $::numTests: DBI error $rc, $err\n"; 89 | } 90 | 91 | sub connection_id { 92 | my $dbh = shift; 93 | return 0 unless $dbh; 94 | 95 | # Paul DuBois says the following is more reliable than 96 | # $dbh->{'mysql_thread_id'}; 97 | my @row = $dbh->selectrow_array("SELECT CONNECTION_ID()"); 98 | 99 | return $row[0]; 100 | } 101 | 102 | # nice function I saw in DBD::Pg test code 103 | sub byte_string { 104 | my $ret = join( "|" ,unpack( "C*" ,$_[0] ) ); 105 | return $ret; 106 | } 107 | 108 | sub SQL_VARCHAR { 12 }; 109 | sub SQL_INTEGER { 4 }; 110 | 111 | =item CheckRoutinePerms() 112 | 113 | Check if the current user of the DBH has permissions to create/drop procedures 114 | 115 | if (!CheckRoutinePerms($dbh)) { 116 | plan skip_all => 117 | "Your test user does not have ALTER_ROUTINE privileges."; 118 | } 119 | 120 | =cut 121 | 122 | sub CheckRoutinePerms { 123 | my $dbh = shift @_; 124 | 125 | # check for necessary privs 126 | local $dbh->{PrintError} = 0; 127 | eval { $dbh->do('DROP PROCEDURE IF EXISTS testproc') }; 128 | return if $@ =~ qr/alter routine command denied to user/; 129 | 130 | return 1; 131 | }; 132 | 133 | =item MinimumVersion() 134 | 135 | Check to see if the database where the test run against is 136 | of a certain minimum version 137 | 138 | if (!MinimumVersion($dbh, '5.0')) { 139 | plan skip_all => 140 | "You must have MySQL version 5.0 and greater for this test to run"; 141 | } 142 | 143 | =cut 144 | 145 | sub MinimumVersion { 146 | my $dbh = shift @_; 147 | my $version = shift @_; 148 | 149 | my ($major, $minor) = split (/\./, $version); 150 | 151 | if ( $dbh->get_info($GetInfoType{SQL_DBMS_VER}) =~ /(^\d+)\.(\d+)\./ ) { 152 | 153 | # major version higher than requested 154 | return 1 if $1 > $major; 155 | 156 | # major version too low 157 | return if $1 < $major; 158 | 159 | # check minor version 160 | return 1 if $2 >= $minor; 161 | } 162 | 163 | return; 164 | } 165 | 166 | 1; 167 | -------------------------------------------------------------------------------- /t/manifest.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | unless ($ENV{RELEASE_TESTING}) { 3 | require Test::More; 4 | Test::More::plan(skip_all => 'these tests are for release testing'); 5 | } 6 | } 7 | 8 | use Test::More; 9 | 10 | eval 'use Test::DistManifest'; 11 | if ($@) { 12 | plan skip_all => 'Test::DistManifest required to test MANIFEST'; 13 | } 14 | 15 | manifest_ok(); 16 | -------------------------------------------------------------------------------- /t/pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::Pod 1.00"; 3 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 4 | all_pod_files_ok(); 5 | -------------------------------------------------------------------------------- /t/rt110983-valid-mysqlfd.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | require "t/lib.pl"; 9 | 10 | my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0 }) }; 11 | plan skip_all => "no database connection" if $@ or not $dbh; 12 | 13 | plan tests => 4; 14 | 15 | ok($dbh->mysql_fd >= 0, '$dbh->mysql_fd returns valid file descriptor when $dbh connection is open'); 16 | ok($dbh->{sockfd} >= 0, '$dbh->{sockfd} returns valid file descriptor when $dbh connection is open'); 17 | 18 | $dbh->disconnect; 19 | 20 | ok(!defined $dbh->mysql_fd, '$dbh->mysql_fd returns undef when $dbh connection was closed'); 21 | ok(!defined $dbh->{sockfd}, '$dbh->{sockfd} returns undef when $dbh connection was closed'); 22 | -------------------------------------------------------------------------------- /t/rt118977-zerofill.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | require "t/lib.pl"; 9 | 10 | my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 1, RaiseError => 1 }) }; 11 | plan skip_all => "no database connection" if $@ or not $dbh; 12 | 13 | # Tested with TiDB v8.5.1. 14 | if ($dbh->{'mysql_serverinfo'} =~ 'TiDB') { 15 | plan skip_all => 16 | # https://docs.pingcap.com/tidb/stable/mysql-compatibility/#incompatibility-due-to-deprecated-features 17 | "SKIP TEST: TiDB doesn't support ZEROFILL"; 18 | } 19 | 20 | plan tests => 4*2; 21 | 22 | for my $mysql_server_prepare (0, 1) { 23 | 24 | $dbh->{mysql_server_prepare} = $mysql_server_prepare; 25 | 26 | ok $dbh->do("DROP TABLE IF EXISTS t"); 27 | ok $dbh->do("CREATE TEMPORARY TABLE t(id smallint(5) unsigned zerofill)"); 28 | ok $dbh->do("INSERT INTO t(id) VALUES(1)"); 29 | is $dbh->selectcol_arrayref("SELECT id FROM t")->[0], "00001"; 30 | 31 | } 32 | -------------------------------------------------------------------------------- /t/rt25389-bin-case.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | 6 | use vars qw($test_dsn $test_user $test_password); 7 | require "t/lib.pl"; 8 | 9 | use Test::More; 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 0, AutoCommit => 1 });}; 14 | if ($@) { 15 | plan skip_all => "no database connection"; 16 | } 17 | 18 | if (!MinimumVersion($dbh, '5.1')) { 19 | plan skip_all => 20 | "You must have MySQL version 5.1 or greater for this test" 21 | } 22 | 23 | plan tests => 8; 24 | 25 | my ( $sth, $i ); 26 | my @test = qw(AA Aa aa aA); 27 | 28 | for my $charset (qw(latin1 utf8)) { 29 | for my $unique ( "", "unique" ) { 30 | 31 | my $table = "dbd-mysql-$charset-$unique"; 32 | my $create = 33 | "CREATE TEMPORARY TABLE `$table` (name VARCHAR(8) CHARACTER SET $charset COLLATE ${charset}_bin $unique)"; 34 | 35 | $dbh->do($create) or die $DBI::errstr; 36 | for (@test) { 37 | $dbh->do("insert into `$table` values ('$_')"); 38 | } 39 | my $q1 = "select name from `$table`"; 40 | $sth = $dbh->prepare($q1); 41 | $sth->execute; 42 | $i = 0; 43 | while ( my @row = $sth->fetchrow ) { 44 | $i++; 45 | } 46 | is( $i, scalar @test, $q1 ); 47 | $sth->finish; 48 | 49 | my $q2 = "select name from `$table` where " 50 | . join( " OR ", map { "name = '$_'" } @test ); 51 | $sth = $dbh->prepare($q2); 52 | $sth->execute; 53 | $i = 0; 54 | while ( my @row = $sth->fetchrow ) { 55 | $i++; 56 | } 57 | is( $i, scalar @test, $q2 ); 58 | } 59 | } 60 | -------------------------------------------------------------------------------- /t/rt50304-column_info_parentheses.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | 6 | use vars qw($test_dsn $test_user $test_password $state); 7 | require "t/lib.pl"; 8 | 9 | use Test::More; 10 | 11 | my $dbh; 12 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 13 | { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; 14 | if ($@) { 15 | plan skip_all => "no database connection"; 16 | } 17 | 18 | ok($dbh->do("DROP TABLE IF EXISTS dbd_mysql_rt50304_column_info")); 19 | 20 | my $create = <do($create), "create table dbd_mysql_rt50304_column_info"); 31 | 32 | my $sth = $dbh->column_info(undef, undef, 'dbd_mysql_rt50304_column_info', 'problem_column'); 33 | my $info = $sth->fetchall_arrayref({}); 34 | is ( scalar @{$info->[0]->{mysql_values}}, 2, 'problem_column values'); 35 | is ( $info->[0]->{mysql_values}->[0], '', 'problem_column first value'); 36 | is ( $info->[0]->{mysql_values}->[1], '(Some Text)', 'problem_column second value'); 37 | 38 | $sth= $dbh->column_info(undef, undef, 'dbd_mysql_rt50304_column_info', 'regular_column'); 39 | $info = $sth->fetchall_arrayref({}); 40 | is ( scalar @{$info->[0]->{mysql_values}}, 2, 'regular_column values'); 41 | is ( $info->[0]->{mysql_values}->[0], '', 'regular_column first value'); 42 | is ( $info->[0]->{mysql_values}->[1], 'Some Text', 'regular_column second value'); 43 | 44 | ok($dbh->do("DROP TABLE dbd_mysql_rt50304_column_info")); 45 | ok($dbh->disconnect()); 46 | done_testing; 47 | -------------------------------------------------------------------------------- /t/rt61849-bind-param-buffer-overflow.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | require "t/lib.pl"; 9 | 10 | my $INSECURE_VALUE_FROM_USER = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; 11 | 12 | my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1, AutoCommit => 0 }) }; 13 | plan skip_all => "no database connection" if $@ or not $dbh; 14 | 15 | plan tests => 2; 16 | my $sth = $dbh->prepare("select * from unknown_table where id=?"); 17 | eval { $sth->bind_param(1, $INSECURE_VALUE_FROM_USER, 3) }; 18 | like $@, qr/Binding non-numeric field 1, value '$INSECURE_VALUE_FROM_USER' as a numeric!/, "bind_param failed on incorrect numeric value"; 19 | pass "perl interpreter did not crash"; 20 | -------------------------------------------------------------------------------- /t/rt75353-innodb-lock-timeout.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use DBI; 6 | 7 | use vars qw($test_dsn $test_user $test_password); 8 | require "t/lib.pl"; 9 | 10 | my $dbh1 = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0 }) }; 11 | plan skip_all => "no database connection" if $@ or not $dbh1; 12 | 13 | if ($dbh1->{'mysql_serverinfo'} =~ 'TiDB') { 14 | plan skip_all => 15 | # https://docs.pingcap.com/tidb/stable/pessimistic-transaction/#difference-with-mysql-innodb 16 | "SKIP TEST: locking behavior on TiDB is different"; 17 | } 18 | 19 | my $dbh2 = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0 }) }; 20 | plan skip_all => "no database connection" if $@ or not $dbh2; 21 | 22 | my @ilwtenabled = $dbh1->selectrow_array("SHOW VARIABLES LIKE 'innodb_lock_wait_timeout'"); 23 | if (!@ilwtenabled) { 24 | plan skip_all => 'innodb_lock_wait_timeout not available'; 25 | } 26 | 27 | my $have_innodb = 0; 28 | if (!MinimumVersion($dbh1, '5.6')) { 29 | my $dummy; 30 | ($dummy,$have_innodb)= 31 | $dbh1->selectrow_array("SHOW VARIABLES LIKE 'have_innodb'") 32 | or DbiError($dbh1->err, $dbh1->errstr); 33 | } else { 34 | my $engines = $dbh1->selectall_arrayref('SHOW ENGINES'); 35 | if (!$engines) { 36 | DbiError($dbh1->err, $dbh1->errstr); 37 | } else { 38 | STORAGE_ENGINE: 39 | for my $engine (@$engines) { 40 | next STORAGE_ENGINE if lc $engine->[0] ne 'innodb'; 41 | next STORAGE_ENGINE if lc $engine->[1] eq 'no'; 42 | $have_innodb = 1; 43 | } 44 | } 45 | } 46 | if (!$have_innodb) { 47 | plan skip_all => "Server doesn't support InnoDB, needed for testing innodb_lock_wait_timeout"; 48 | } 49 | 50 | eval { 51 | $dbh2->{PrintError} = 0; 52 | $dbh2->do("SET innodb_lock_wait_timeout=1"); 53 | $dbh2->{PrintError} = 1; 54 | 1; 55 | } or do { 56 | $dbh1->disconnect(); 57 | $dbh2->disconnect(); 58 | plan skip_all => "innodb_lock_wait_timeout is not modifyable on this version of MySQL"; 59 | }; 60 | 61 | ok $dbh1->do("DROP TABLE IF EXISTS dbd_mysql_rt75353_innodb_lock_timeout"), "drop table if exists dbd_mysql_rt75353_innodb_lock_timeout"; 62 | ok $dbh1->do("CREATE TABLE dbd_mysql_rt75353_innodb_lock_timeout(id INT PRIMARY KEY) ENGINE=INNODB"), "create table dbd_mysql_rt75353_innodb_lock_timeout"; 63 | 64 | ok $dbh1->do("INSERT INTO dbd_mysql_rt75353_innodb_lock_timeout VALUES(1)"), "dbh1: acquire a row lock on table dbd_mysql_rt75353_innodb_lock_timeout"; 65 | 66 | my $error_handler_called = 0; 67 | $dbh2->{HandleError} = sub { $error_handler_called = 1; die $_[0]; }; 68 | eval { $dbh2->selectcol_arrayref("SELECT id FROM dbd_mysql_rt75353_innodb_lock_timeout FOR UPDATE") }; 69 | my $error_message = $@; 70 | $dbh2->{HandleError} = undef; 71 | ok $error_message, "dbh2: acquiring same lock as dbh1 on table dbd_mysql_rt75353_innodb_lock_timeout failed"; 72 | 73 | like $error_message, qr/Lock wait timeout exceeded; try restarting transaction/, "dbh2: error message for acquiring lock is 'Lock wait timeout exceeded'"; 74 | ok $error_handler_called, "dbh2: error handler code ref was called"; 75 | 76 | $dbh2->disconnect(); 77 | 78 | ok $dbh1->do("DROP TABLE dbd_mysql_rt75353_innodb_lock_timeout"), "drop table dbd_mysql_rt75353_innodb_lock_timeout"; 79 | $dbh1->disconnect(); 80 | 81 | done_testing; 82 | -------------------------------------------------------------------------------- /t/rt83494-quotes-comments.t: -------------------------------------------------------------------------------- 1 | # Test special characters inside comments 2 | # http://bugs.debian.org/311040 3 | # http://bugs.mysql.com/27625 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use DBI; 9 | use Test::More; 10 | 11 | use vars qw($test_dsn $test_user $test_password $state); 12 | require "t/lib.pl"; 13 | 14 | my $dbh; 15 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 16 | { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; 17 | if ($@) { 18 | plan skip_all => "no database connection"; 19 | } 20 | 21 | my %tests = ( 22 | questionmark => " -- Does the question mark at the end confuse DBI::MySQL?\nselect ?", 23 | quote => " -- 'Tis the quote that confuses DBI::MySQL\nSELECT ?" 24 | ); 25 | 26 | for my $test ( sort keys %tests ) { 27 | 28 | my $sth = $dbh->prepare($tests{$test}); 29 | ok($sth, 'created statement hande'); 30 | ok($sth->execute(), 'executing'); 31 | ok($sth->{ParamValues}, 'values'); 32 | ok($sth->finish(), 'finish'); 33 | 34 | } 35 | 36 | ok ($dbh->disconnect(), 'disconnecting from dbh'); 37 | done_testing; 38 | -------------------------------------------------------------------------------- /t/rt85919-fetch-lost-connection.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use DBI; 4 | use Test::More; 5 | use lib 't', '.'; 6 | use vars qw($test_dsn $test_user $test_password $mdriver); 7 | require 'lib.pl'; 8 | 9 | my $dbh; 10 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 11 | { RaiseError => 1, PrintError => 0, AutoCommit => 0 });}; 12 | if ($@) { 13 | plan skip_all => "no database connection"; 14 | } 15 | my $sth; 16 | my $ok = eval { 17 | note "Connecting...\n"; 18 | ok( $sth = $dbh->do('SET wait_timeout = 5'), 'set wait_timeout'); 19 | note "Sleeping...\n"; 20 | sleep 7; 21 | my $sql = 'SELECT 1'; 22 | if (1) { 23 | ok( $sth = $dbh->prepare($sql), 'prepare SQL'); 24 | ok( $sth->execute(), 'execute SQL'); 25 | my @res = $sth->fetchrow_array(); 26 | is ( $res[0], undef, 'no rows returned'); 27 | ok( $sth->finish(), 'finish'); 28 | $sth = undef; 29 | } 30 | else { 31 | note "Selecting...\n"; 32 | my @res = $dbh->selectrow_array($sql); 33 | } 34 | $dbh->disconnect(); 35 | $dbh = undef; 36 | 1; 37 | }; 38 | if (not $ok) { 39 | # if we're connected via a local socket we receive error 2006 40 | # (CR_SERVER_GONE_ERROR) but if we're connected using TCP/IP we get 41 | # 2013 (CR_SERVER_LOST) 42 | # 43 | # as of 8.0.24 MySQL writes the reason the connection was closed 44 | # before closing it, so 4031 (ER_CLIENT_INTERACTION_TIMEOUT) is 45 | # now an valid return code 46 | if ($DBI::err == 2006) { 47 | pass("received error 2006 (CR_SERVER_GONE_ERROR)"); 48 | } elsif ($DBI::err == 2013) { 49 | pass("received error 2013 (CR_SERVER_LOST)"); 50 | } elsif ($DBI::err == 4031) { 51 | pass("received error 4031 (ER_CLIENT_INTERACTION_TIMEOUT)"); 52 | } else { 53 | fail('Should return error 2006 or 2013'); 54 | } 55 | eval { $sth->finish(); } if defined $sth; 56 | eval { $dbh->disconnect(); } if defined $dbh; 57 | } 58 | 59 | if (0) { 60 | # This causes the use=after-free crash in RT #97625. 61 | # different testcase by killing the service. which is of course 62 | # not doable in a general testscript and highly system dependent. 63 | system(qw(sudo service mysql start)); 64 | use DBI; 65 | my $dbh = DBI->connect("DBI:mysql:database=test:port=3306"); 66 | $dbh->{mysql_auto_reconnect} = 1; # without this is works 67 | my $select = sub { $dbh->do(q{SELECT 1}) for 1 .. 10; }; 68 | $select->(); 69 | system qw(sudo service mysql stop); 70 | $select->(); 71 | ok(1, "dbh did not crash on closed connection"); 72 | system(qw(sudo service mysql start)); 73 | } 74 | 75 | done_testing(); 76 | -------------------------------------------------------------------------------- /t/rt86153-reconnect-fail-memory.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | use vars qw($test_dsn $test_user $test_password); 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | my $COUNT_CONNECT = 4000; # Number of connect/disconnect iterations 11 | 12 | my $have_storable; 13 | 14 | if (!$ENV{EXTENDED_TESTING}) { 15 | plan skip_all => "\$ENV{EXTENDED_TESTING} is not set\n"; 16 | } 17 | 18 | eval { require Proc::ProcessTable; }; 19 | if ($@) { 20 | plan skip_all => "module Proc::ProcessTable not installed \n"; 21 | } 22 | 23 | eval { require Storable }; 24 | $have_storable = $@ ? 0 : 1; 25 | 26 | my $have_pt_size = grep { $_ eq 'size' } Proc::ProcessTable->new('cache_ttys' => $have_storable)->fields; 27 | 28 | unless ($have_pt_size) { 29 | plan skip_all => "module Proc::ProcessTable does not support size attribute on current platform\n"; 30 | } 31 | 32 | plan tests => 3; 33 | 34 | sub size { 35 | my($p, $pt); 36 | $pt = Proc::ProcessTable->new('cache_ttys' => $have_storable); 37 | for $p (@{$pt->table()}) { 38 | if ($p->pid() == $$) { 39 | return $p->size(); 40 | } 41 | } 42 | die "Cannot find my own process?!?\n"; 43 | exit 0; 44 | } 45 | 46 | 47 | my ($size, $prev_size, $ok, $not_ok, $dbh2); 48 | note "Testing memory leaks in connect/disconnect\n"; 49 | 50 | $ok = 0; 51 | $not_ok = 0; 52 | $prev_size= undef; 53 | 54 | # run reconnect with a bad password 55 | for (my $i = 0; $i < $COUNT_CONNECT; $i++) { 56 | eval { $dbh2 = DBI->connect($test_dsn, $test_user, "$test_password ", 57 | { RaiseError => 1, 58 | PrintError => 1, 59 | AutoCommit => 0 });}; 60 | 61 | if ($i % 100 == 99) { 62 | $size = size(); 63 | if (defined($prev_size)) { 64 | if ($size == $prev_size) { 65 | $ok++; 66 | } 67 | else { 68 | diag "$prev_size => $size" if $ENV{TEST_VERBOSE}; 69 | $not_ok++; 70 | } 71 | } 72 | else { 73 | $prev_size = $size; 74 | $size = size(); 75 | } 76 | $prev_size = $size; 77 | } 78 | } 79 | 80 | ok $ok, "\$ok $ok"; 81 | ok !$not_ok, "\$not_ok $not_ok"; 82 | cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok"; 83 | -------------------------------------------------------------------------------- /t/rt88006-bit-prepare.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use vars qw($test_dsn $test_user $test_password); 5 | use DBI; 6 | use Test::More; 7 | use lib 't', '.'; 8 | require 'lib.pl'; 9 | 10 | for my $scenario (qw(prepare noprepare)) { 11 | 12 | my $dbh; 13 | my $sth; 14 | 15 | my $dsn = $test_dsn; 16 | $dsn .= ';mysql_server_prepare=1;mysql_server_prepare_disable_fallback=1' if $scenario eq 'prepare'; 17 | eval {$dbh = DBI->connect($dsn, $test_user, $test_password, 18 | { RaiseError => 1, AutoCommit => 1})}; 19 | 20 | if ($@) { 21 | plan skip_all => "no database connection"; 22 | } 23 | 24 | if ($dbh->{mysql_serverversion} < 50008) { 25 | plan skip_all => "Servers < 5.0.8 do not support b'' syntax"; 26 | } 27 | 28 | if ($dbh->{mysql_serverversion} < 50026) { 29 | plan skip_all => "Servers < 5.0.26 do not support BIN() for BIT values"; 30 | } 31 | 32 | my $create = <do($create),"create table for $scenario"; 42 | 43 | ok $dbh->do("INSERT INTO dbd_mysql_rt88006_bit_prep (id, flags) VALUES (1, b'10'), (2, b'1'), (3, b'1111011111101111101101111111101111111101')"); 44 | 45 | ok $sth = $dbh->prepare("INSERT INTO dbd_mysql_rt88006_bit_prep (id, flags) VALUES (?, ?)"); 46 | ok $sth->bind_param(1, 4, DBI::SQL_INTEGER); 47 | ok $sth->bind_param(2, pack("B*", '1110000000000000011101100000000011111101'), DBI::SQL_BINARY); 48 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 49 | ok $sth->finish; 50 | 51 | ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 1"); 52 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 53 | ok (my $r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario"); 54 | is ($r->{id}, 1, 'id test contents'); 55 | is (unpack("B*", $r->{flags}), '0000000000000000000000000000000000000010', 'flags has contents'); 56 | ok $sth->finish; 57 | 58 | ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 3"); 59 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 60 | ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with more then 32 bits"); 61 | is ($r->{id}, 3, 'id test contents'); 62 | is (unpack("B*", $r->{flags}), '1111011111101111101101111111101111111101', 'flags has contents'); 63 | ok $sth->finish; 64 | 65 | ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 4"); 66 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 67 | ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with binary insert"); 68 | is ($r->{id}, 4, 'id test contents'); 69 | is (unpack("B*", $r->{flags}), '1110000000000000011101100000000011111101', 'flags has contents'); 70 | ok $sth->finish; 71 | 72 | ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =1"); 73 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 74 | ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN()"); 75 | is ($r->{id}, 1, 'id test contents'); 76 | is ($r->{'BIN(flags)'}, '10', 'flags has contents'); 77 | 78 | ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =3"); 79 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 80 | ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN() and more then 32 bits"); 81 | is ($r->{id}, 3, 'id test contents'); 82 | is ($r->{'BIN(flags)'}, '1111011111101111101101111111101111111101', 'flags has contents'); 83 | 84 | ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =4"); 85 | ok $sth->execute() or die("Execute failed: ".$DBI::errstr); 86 | ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN() and with binary insert"); 87 | is ($r->{id}, 4, 'id test contents'); 88 | is ($r->{'BIN(flags)'}, '1110000000000000011101100000000011111101', 'flags has contents'); 89 | 90 | ok $sth->finish; 91 | ok $dbh->disconnect; 92 | } 93 | 94 | done_testing; 95 | -------------------------------------------------------------------------------- /t/rt91715.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBI; 5 | use Test::More; 6 | 7 | use vars qw($mdriver); 8 | $|= 1; 9 | 10 | use vars qw($test_dsn $test_user $test_password); 11 | use lib 't', '.'; 12 | require 'lib.pl'; 13 | my $dbh; 14 | 15 | # yes, we will reconnect, but I want to keep the "fail if not connect" 16 | # separate from the actual test where we reconnect 17 | eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password, 18 | { RaiseError => 1, PrintError => 1, AutoCommit => 1 });}; 19 | if ($@) { 20 | plan skip_all => "no database connection"; 21 | } 22 | plan tests => 6; 23 | 24 | for my $ur (0,1) { 25 | $test_dsn .= ";mysql_use_result=1" if $ur; 26 | # reconnect 27 | ok ($dbh->disconnect()); 28 | ok ($dbh= DBI->connect($test_dsn, $test_user, $test_password, 29 | { RaiseError => 1, PrintError => 1, AutoCommit => 0 })); 30 | is $dbh->{mysql_use_result}, $ur, "mysql_use_result set to $ur"; 31 | } 32 | -------------------------------------------------------------------------------- /t/version.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use DBD::mysql; 5 | use Test::More; 6 | 7 | like($DBD::mysql::VERSION, qr/^\d\.\d{2,3}(|_\d\d)$/, 'version format'); 8 | like($DBD::mysql::VERSION, qr/^5\./, 'version starts with "5." (update for 6.x)'); 9 | 10 | diag("mysql_get_client_version: ", DBD::mysql->client_version); 11 | cmp_ok(DBD::mysql->client_version, ">", 0, "mysql_get_client_version is available as a standalone function"); 12 | 13 | done_testing; 14 | --------------------------------------------------------------------------------